From 34d3ad3987785642be58fb2f26557d3314215577 Mon Sep 17 00:00:00 2001 From: Cezary Czaplewski Date: Thu, 12 Mar 2020 22:52:34 +0100 Subject: [PATCH] update --- PARAM/bond_AM1_ext.parm | 8 +- PARAM/pot_theta_G631_DIL.parm | 2 +- PARAM/rotamers_AM1_aura.10022007.ext.parm | 1520 --- PARAM/sc2scext | Bin 10735 -> 0 bytes PARAM/sc2scext.f | 37 - ...c_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k | 146 +- PARAM/scinter_GB.parm | 144 +- PARAM/scinter_GB_ext.parm | 109 + PARAM/scparm.adam_30_10_2013 | 212 - source/cluster/wham/src-M/CMakeLists.txt | 147 +- source/cluster/wham/src-M/COMMON.CHAIN | 18 +- source/cluster/wham/src-M/COMMON.CLUSTER | 21 +- source/cluster/wham/src-M/COMMON.CONTACTS | 73 - source/cluster/wham/src-M/COMMON.CONTROL | 11 +- source/cluster/wham/src-M/COMMON.DERIV | 30 - source/cluster/wham/src-M/COMMON.FFIELD | 4 +- source/cluster/wham/src-M/COMMON.IOUNITS | 10 +- source/cluster/wham/src-M/COMMON.LOCAL | 36 - source/cluster/wham/src-M/COMMON.NAMES | 2 +- source/cluster/wham/src-M/COMMON.SBRIDGE | 23 +- source/cluster/wham/src-M/COMMON.SCCOR | 25 +- source/cluster/wham/src-M/COMMON.SCROT | 2 +- source/cluster/wham/src-M/COMMON.TORSION | 25 - source/cluster/wham/src-M/COMMON.VAR | 5 +- source/cluster/wham/src-M/DIMENSIONS | 15 +- source/cluster/wham/src-M/Makefile | 2 +- source/cluster/wham/src-M/Makefile-MPI | 34 - source/cluster/wham/src-M/Makefile-MPI-INTEL | 33 - source/cluster/wham/src-M/Makefile-MPI-INTEL-old | 35 - source/cluster/wham/src-M/Makefile-MPI-opteron | 39 - source/cluster/wham/src-M/Makefile-MPI-opteron-old | 39 - source/cluster/wham/src-M/Makefile-MPI-w-opteron | 39 - source/cluster/wham/src-M/Makefile-MPICH-ifort | 58 +- source/cluster/wham/src-M/arcos.f | 2 +- source/cluster/wham/src-M/chainbuild.f | 4 +- source/cluster/wham/src-M/contact.f | 4 +- source/cluster/wham/src-M/energy_p_new.F | 5446 ++++++--- source/cluster/wham/src-M/geomout.F | 10 +- source/cluster/wham/src-M/gnmr1.f | 31 + source/cluster/wham/src-M/hc.f | 18 +- .../cluster/wham/src-M/include_unres/COMMON.CALC | 4 +- .../wham/src-M/include_unres/COMMON.CONTACTS | 23 +- .../cluster/wham/src-M/include_unres/COMMON.DERIV | 70 +- .../wham/src-M/include_unres/COMMON.INTERACT | 20 +- .../cluster/wham/src-M/include_unres/COMMON.LOCAL | 49 +- .../cluster/wham/src-M/include_unres/COMMON.NAMES | 7 - .../cluster/wham/src-M/include_unres/COMMON.SCCOR | 4 +- .../cluster/wham/src-M/include_unres/COMMON.SCROT | 2 +- .../wham/src-M/include_unres/COMMON.TORCNSTR | 20 +- .../wham/src-M/include_unres/COMMON.TORSION | 71 +- .../wham/src-M/include_unres/COMMON.WEIGHTS | 6 +- source/cluster/wham/src-M/initialize.f | 11 +- source/cluster/wham/src-M/initialize_p.F | 241 +- source/cluster/wham/src-M/int_from_cart1.f | 3 + source/cluster/wham/src-M/main_clust.F | 89 +- source/cluster/wham/src-M/obackup/arcos.o | Bin 3624 -> 0 bytes source/cluster/wham/src-M/obackup/cartprint.o | Bin 21112 -> 0 bytes source/cluster/wham/src-M/obackup/chainbuild.o | Bin 127040 -> 0 bytes source/cluster/wham/src-M/obackup/contact.o | Bin 33256 -> 0 bytes source/cluster/wham/src-M/obackup/convert.o | Bin 23008 -> 0 bytes source/cluster/wham/src-M/obackup/energy_p_new.o | Bin 2890680 -> 0 bytes source/cluster/wham/src-M/obackup/fitsq.o | Bin 155472 -> 0 bytes source/cluster/wham/src-M/obackup/geomout.o | Bin 154736 -> 0 bytes source/cluster/wham/src-M/obackup/gnmr1.o | Bin 5208 -> 0 bytes source/cluster/wham/src-M/obackup/hc.o | Bin 98952 -> 0 bytes source/cluster/wham/src-M/obackup/icant.o | Bin 2464 -> 0 bytes source/cluster/wham/src-M/obackup/initialize_p.o | Bin 134344 -> 0 bytes source/cluster/wham/src-M/obackup/int_from_cart1.o | Bin 52760 -> 0 bytes source/cluster/wham/src-M/obackup/intcor.o | Bin 30192 -> 0 bytes source/cluster/wham/src-M/obackup/main_clust.o | Bin 143320 -> 0 bytes source/cluster/wham/src-M/obackup/matmult.o | Bin 7984 -> 0 bytes source/cluster/wham/src-M/obackup/misc.o | Bin 37448 -> 0 bytes source/cluster/wham/src-M/obackup/noyes.o | Bin 4120 -> 0 bytes source/cluster/wham/src-M/obackup/parmread.o | Bin 393688 -> 0 bytes source/cluster/wham/src-M/obackup/permut.o | Bin 4264 -> 0 bytes source/cluster/wham/src-M/obackup/pinorm.o | Bin 3448 -> 0 bytes source/cluster/wham/src-M/obackup/printmat.o | Bin 8296 -> 0 bytes source/cluster/wham/src-M/obackup/probabl.o | Bin 86936 -> 0 bytes source/cluster/wham/src-M/obackup/proc_proc.o | Bin 2504 -> 0 bytes source/cluster/wham/src-M/obackup/read_coords.o | Bin 251944 -> 0 bytes source/cluster/wham/src-M/obackup/read_ref_str.o | Bin 65136 -> 0 bytes source/cluster/wham/src-M/obackup/readpdb.o | Bin 121456 -> 0 bytes source/cluster/wham/src-M/obackup/readrtns.o | Bin 207888 -> 0 bytes source/cluster/wham/src-M/obackup/rescode.o | Bin 12872 -> 0 bytes source/cluster/wham/src-M/obackup/setup_var.o | Bin 17888 -> 0 bytes source/cluster/wham/src-M/obackup/srtclust.o | Bin 41760 -> 0 bytes source/cluster/wham/src-M/obackup/timing.o | Bin 18920 -> 0 bytes source/cluster/wham/src-M/obackup/track.o | Bin 104352 -> 0 bytes source/cluster/wham/src-M/obackup/work_partition.o | Bin 29640 -> 0 bytes source/cluster/wham/src-M/obackup/wrtclust.o | Bin 212888 -> 0 bytes source/cluster/wham/src-M/parmread.F | 1231 +- source/cluster/wham/src-M/probabl.F | 104 +- source/cluster/wham/src-M/read_coords.F | 66 +- source/cluster/wham/src-M/read_ref_str.F | 14 +- source/cluster/wham/src-M/readpdb.f | 215 +- source/cluster/wham/src-M/readrtns.F | 508 +- source/cluster/wham/src-M/rescode.f | 4 +- source/cluster/wham/src-M/sizesclu.dat | 2 +- source/cluster/wham/src-M/srtclust.f | 49 +- source/cluster/wham/src-M/work_partition.F | 13 +- source/cluster/wham/src-M/wrtclust.f | 64 +- source/cluster/wham/src-M/xdrf/Makefile | 27 - source/cluster/wham/src-M/xdrf/Makefile_jubl | 31 - source/cluster/wham/src-M/xdrf/Makefile_linux | 27 - source/cluster/wham/src-M/xdrf/RS6K.m4 | 20 - source/cluster/wham/src-M/xdrf/ftocstr.c | 35 - source/cluster/wham/src-M/xdrf/libxdrf.m4 | 1238 -- source/cluster/wham/src-M/xdrf/types.h | 99 - source/cluster/wham/src-M/xdrf/underscore.m4 | 19 - source/cluster/wham/src-M/xdrf/xdr.c | 752 -- source/cluster/wham/src-M/xdrf/xdr.h | 379 - source/cluster/wham/src-M/xdrf/xdr_array.c | 174 - source/cluster/wham/src-M/xdrf/xdr_float.c | 307 - source/cluster/wham/src-M/xdrf/xdr_stdio.c | 196 - source/cluster/wham/src-M/xdrf/xdrf.h | 10 - source/cluster/wham/src/CMakeLists.txt | 214 +- source/cluster/wham/src/COMMON.CLUSTER | 4 +- source/cluster/wham/src/COMMON.CONTROL | 6 +- source/cluster/wham/src/COMMON.SCCOR | 2 +- source/cluster/wham/src/DIMENSIONS | 4 +- source/cluster/wham/src/Makefile-MPICH-ifort | 61 +- source/cluster/wham/src/arcos.f | 2 +- source/cluster/wham/src/energy_p_new.F | 86 +- .../cluster/wham/src/include_unres/COMMON.CONTACTS | 68 - .../cluster/wham/src/include_unres/COMMON.FFIELD | 28 - source/cluster/wham/src/include_unres/COMMON.NAMES | 7 - .../cluster/wham/src/include_unres/COMMON.SBRIDGE | 19 +- source/cluster/wham/src/include_unres/COMMON.SCCOR | 6 - source/cluster/wham/src/initialize_p.F | 6 +- source/cluster/wham/src/main_clust.F | 69 +- source/cluster/wham/src/parmread.F | 25 +- source/cluster/wham/src/probabl.F | 48 +- source/cluster/wham/src/read_coords.F | 54 +- source/cluster/wham/src/readrtns.F | 72 +- source/cluster/wham/src/wrtclust.f | 11 +- source/cluster/wham/src/xdrf/Makefile | 27 - source/cluster/wham/src/xdrf/Makefile_jubl | 31 - source/cluster/wham/src/xdrf/Makefile_linux | 27 - source/cluster/wham/src/xdrf/RS6K.m4 | 20 - source/cluster/wham/src/xdrf/ftocstr.c | 35 - source/cluster/wham/src/xdrf/libxdrf.m4 | 1238 -- source/cluster/wham/src/xdrf/types.h | 99 - source/cluster/wham/src/xdrf/underscore.m4 | 19 - source/cluster/wham/src/xdrf/xdr.c | 752 -- source/cluster/wham/src/xdrf/xdr.h | 379 - source/cluster/wham/src/xdrf/xdr_array.c | 174 - source/cluster/wham/src/xdrf/xdr_float.c | 307 - source/cluster/wham/src/xdrf/xdr_stdio.c | 196 - source/cluster/wham/src/xdrf/xdrf.h | 10 - source/pymol/UNRESInpGen.py | 288 +- source/pymol/show_UNRES.py | 77 +- source/unres/src_CSA/CMakeLists.txt | 43 +- source/unres/src_CSA/COMMON.DFA | 4 +- source/unres/src_CSA/COMMON.SCCOR | 2 +- source/unres/src_CSA/COMMON.TORSION | 16 +- source/unres/src_CSA/Makefile | 2 +- source/unres/src_CSA/Makefile-DFA-NEWPARM.kias | 101 - source/unres/src_CSA/Makefile-DFA-NEWPARM.piasek | 108 - source/unres/src_CSA/Makefile-DFA-OLDPARM.galera | 96 - source/unres/src_CSA/Makefile-DFA-OLDPARM.gfortran | 103 - source/unres/src_CSA/Makefile-DFA-OLDPARM.kias | 101 - source/unres/src_CSA/Makefile-DFA-OLDPARM.piasek | 102 - source/unres/src_CSA/Makefile-single_4P | 91 - source/unres/src_CSA/Makefile_4P | 100 - source/unres/src_CSA/Makefile_CASP3 | 100 - source/unres/src_CSA/csa.f | 366 - source/unres/src_CSA/energy_p_new_barrier.F | 2 +- source/unres/src_CSA/initialize_p.F | 37 +- source/unres/src_CSA/local_move.f | 7 +- source/unres/src_CSA/parmread.F | 2 +- source/unres/src_CSA/readrtns_csa.F | 5 +- source/unres/src_CSA/together.F | 1 + source/unres/src_CSA_DiL/CMakeLists.txt | 53 +- source/unres/src_CSA_DiL/COMMON.BANK | 29 - source/unres/src_CSA_DiL/COMMON.BOUNDS | 2 - source/unres/src_CSA_DiL/COMMON.CALC | 15 - source/unres/src_CSA_DiL/COMMON.CHAIN | 12 - source/unres/src_CSA_DiL/COMMON.CONTACTS | 75 - source/unres/src_CSA_DiL/COMMON.CONTACTS.MOMENT | 7 - source/unres/src_CSA_DiL/COMMON.CONTROL | 13 - source/unres/src_CSA_DiL/COMMON.CSA | 11 - source/unres/src_CSA_DiL/COMMON.DERIV | 38 - source/unres/src_CSA_DiL/COMMON.DFA | 101 - source/unres/src_CSA_DiL/COMMON.DISTFIT | 14 - source/unres/src_CSA_DiL/COMMON.FFIELD | 26 - source/unres/src_CSA_DiL/COMMON.GEO | 2 - source/unres/src_CSA_DiL/COMMON.HAIRPIN | 5 - source/unres/src_CSA_DiL/COMMON.HEADER | 2 - source/unres/src_CSA_DiL/COMMON.INFO | 21 - source/unres/src_CSA_DiL/COMMON.INTERACT | 34 - source/unres/src_CSA_DiL/COMMON.IOUNITS | 69 - source/unres/src_CSA_DiL/COMMON.LOCAL | 55 - source/unres/src_CSA_DiL/COMMON.LOCMOVE | 19 - source/unres/src_CSA_DiL/COMMON.MAXGRAD | 12 - source/unres/src_CSA_DiL/COMMON.MCM | 70 - source/unres/src_CSA_DiL/COMMON.MD_ | 74 - source/unres/src_CSA_DiL/COMMON.MINIM | 5 - source/unres/src_CSA_DiL/COMMON.NAMES | 8 - source/unres/src_CSA_DiL/COMMON.SBRIDGE | 12 - source/unres/src_CSA_DiL/COMMON.SCCOR | 6 - source/unres/src_CSA_DiL/COMMON.SCROT | 3 - source/unres/src_CSA_DiL/COMMON.SETUP | 21 - source/unres/src_CSA_DiL/COMMON.SPLITELE | 2 - source/unres/src_CSA_DiL/COMMON.THREAD | 7 - source/unres/src_CSA_DiL/COMMON.TIME1 | 28 - source/unres/src_CSA_DiL/COMMON.TORCNSTR | 6 - source/unres/src_CSA_DiL/COMMON.TORSION | 33 - source/unres/src_CSA_DiL/COMMON.VAR | 20 - source/unres/src_CSA_DiL/COMMON.VECTORS | 3 - source/unres/src_CSA_DiL/DIMENSIONS | 139 - source/unres/src_CSA_DiL/MP.F | 516 - source/unres/src_CSA_DiL/Makefile | 2 +- source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.kias | 101 - .../unres/src_CSA_DiL/Makefile-DFA-NEWPARM.matrix | 108 - .../unres/src_CSA_DiL/Makefile-DFA-NEWPARM.piasek | 108 - .../unres/src_CSA_DiL/Makefile-DFA-OLDPARM.galera | 96 - .../src_CSA_DiL/Makefile-DFA-OLDPARM.gfortran | 103 - source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.kias | 101 - .../unres/src_CSA_DiL/Makefile-DFA-OLDPARM.piasek | 102 - source/unres/src_CSA_DiL/Makefile-single_4P | 91 - source/unres/src_CSA_DiL/Makefile_4P | 100 - source/unres/src_CSA_DiL/Makefile_CASP3 | 100 - source/unres/src_CSA_DiL/README.Juyong | 13 - source/unres/src_CSA_DiL/TMscore_subroutine.f | 536 - source/unres/src_CSA_DiL/arcos.f | 9 - source/unres/src_CSA_DiL/banach.f | 99 - source/unres/src_CSA_DiL/bank.F | 1353 --- source/unres/src_CSA_DiL/cartder.F | 314 - source/unres/src_CSA_DiL/cartprint.f | 19 - source/unres/src_CSA_DiL/chainbuild.F | 274 - source/unres/src_CSA_DiL/checkder_p.F | 694 -- source/unres/src_CSA_DiL/cinfo.f | 8 - source/unres/src_CSA_DiL/compinfo.c | 82 - source/unres/src_CSA_DiL/contact.f | 195 - source/unres/src_CSA_DiL/convert.f | 196 - source/unres/src_CSA_DiL/cored.f | 3151 ----- source/unres/src_CSA_DiL/csa.f | 366 - source/unres/src_CSA_DiL/dfa.F | 3455 ------ source/unres/src_CSA_DiL/diff12.f | 82 - source/unres/src_CSA_DiL/distfit.f | 207 - source/unres/src_CSA_DiL/djacob.f | 107 - source/unres/src_CSA_DiL/econstr_local.F | 91 - source/unres/src_CSA_DiL/elecont.f | 509 - source/unres/src_CSA_DiL/energy_p_new_barrier.F | 9192 -------------- source/unres/src_CSA_DiL/fitsq.f | 364 - source/unres/src_CSA_DiL/gen_rand_conf.F | 911 -- source/unres/src_CSA_DiL/geomout_min.F | 348 - source/unres/src_CSA_DiL/gradient_p.F | 408 - source/unres/src_CSA_DiL/indexx.f | 81 - source/unres/src_CSA_DiL/initialize_p.F | 1416 --- source/unres/src_CSA_DiL/int_to_cart.f | 119 - source/unres/src_CSA_DiL/intcartderiv.F | 466 - source/unres/src_CSA_DiL/intcor.f | 91 - source/unres/src_CSA_DiL/intlocal.f | 517 - source/unres/src_CSA_DiL/local_move.f | 970 -- source/unres/src_CSA_DiL/matmult.f | 18 - source/unres/src_CSA_DiL/minim_jlee.F | 452 - source/unres/src_CSA_DiL/minim_mult.F | 131 - source/unres/src_CSA_DiL/minimize_p.F | 641 - source/unres/src_CSA_DiL/misc.f | 203 - source/unres/src_CSA_DiL/newconf.F | 2456 ---- source/unres/src_CSA_DiL/parmread.F | 1132 -- source/unres/src_CSA_DiL/pinorm.f | 17 - source/unres/src_CSA_DiL/printmat.f | 16 - source/unres/src_CSA_DiL/prng_32.F | 1077 -- source/unres/src_CSA_DiL/ran.f | 128 - source/unres/src_CSA_DiL/randgens.f | 99 - source/unres/src_CSA_DiL/readpdb.F | 428 - source/unres/src_CSA_DiL/readrtns_csa.F | 1920 --- source/unres/src_CSA_DiL/refsys.f | 59 - source/unres/src_CSA_DiL/rescode.f | 33 - source/unres/src_CSA_DiL/rmdd.f | 159 - source/unres/src_CSA_DiL/rmsd.F | 184 - source/unres/src_CSA_DiL/sc_move.F | 823 -- source/unres/src_CSA_DiL/shift.F | 105 - source/unres/src_CSA_DiL/sumsld.f | 1446 --- source/unres/src_CSA_DiL/test.F | 2800 ----- source/unres/src_CSA_DiL/timing.F | 340 - source/unres/src_CSA_DiL/together.F | 1293 -- source/unres/src_CSA_DiL/unres_csa.F | 556 - source/unres/src_Eshel/Makefile_single_gfortran | 8 +- source/unres/src_Eshel/readpdb.F | 158 +- source/unres/src_Eshel/readpdb.F.safe | 441 - source/unres/src_MD-DFA-restraints/CMakeLists.txt | 398 - source/unres/src_MD-DFA-restraints/COMMON.BOUNDS | 2 - source/unres/src_MD-DFA-restraints/COMMON.CACHE | 6 - source/unres/src_MD-DFA-restraints/COMMON.CALC | 15 - source/unres/src_MD-DFA-restraints/COMMON.CHAIN | 13 - source/unres/src_MD-DFA-restraints/COMMON.CONTACTS | 82 - .../src_MD-DFA-restraints/COMMON.CONTACTS.moment | 68 - source/unres/src_MD-DFA-restraints/COMMON.CONTROL | 15 - source/unres/src_MD-DFA-restraints/COMMON.DBASE | 3 - source/unres/src_MD-DFA-restraints/COMMON.DERIV | 37 - source/unres/src_MD-DFA-restraints/COMMON.DFA | 101 - source/unres/src_MD-DFA-restraints/COMMON.DISTFIT | 14 - source/unres/src_MD-DFA-restraints/COMMON.FFIELD | 26 - source/unres/src_MD-DFA-restraints/COMMON.GEO | 2 - source/unres/src_MD-DFA-restraints/COMMON.HAIRPIN | 5 - source/unres/src_MD-DFA-restraints/COMMON.HEADER | 2 - source/unres/src_MD-DFA-restraints/COMMON.INFO | 21 - source/unres/src_MD-DFA-restraints/COMMON.INTERACT | 34 - source/unres/src_MD-DFA-restraints/COMMON.IOUNITS | 69 - source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN | 21 - .../src_MD-DFA-restraints/COMMON.LANGEVIN.lang0 | 11 - source/unres/src_MD-DFA-restraints/COMMON.LOCAL | 55 - source/unres/src_MD-DFA-restraints/COMMON.LOCMOVE | 19 - source/unres/src_MD-DFA-restraints/COMMON.MAP | 4 - source/unres/src_MD-DFA-restraints/COMMON.MAXGRAD | 12 - source/unres/src_MD-DFA-restraints/COMMON.MCE | 13 - source/unres/src_MD-DFA-restraints/COMMON.MCM | 70 - source/unres/src_MD-DFA-restraints/COMMON.MD | 87 - source/unres/src_MD-DFA-restraints/COMMON.MINIM | 5 - source/unres/src_MD-DFA-restraints/COMMON.MUCA | 10 - source/unres/src_MD-DFA-restraints/COMMON.NAMES | 7 - source/unres/src_MD-DFA-restraints/COMMON.REMD | 36 - source/unres/src_MD-DFA-restraints/COMMON.SBRIDGE | 17 - source/unres/src_MD-DFA-restraints/COMMON.SCCOR | 17 - source/unres/src_MD-DFA-restraints/COMMON.SCROT | 3 - source/unres/src_MD-DFA-restraints/COMMON.SETUP | 21 - source/unres/src_MD-DFA-restraints/COMMON.SPLITELE | 2 - source/unres/src_MD-DFA-restraints/COMMON.THREAD | 7 - source/unres/src_MD-DFA-restraints/COMMON.TIME1 | 28 - source/unres/src_MD-DFA-restraints/COMMON.TORCNSTR | 6 - source/unres/src_MD-DFA-restraints/COMMON.TORSION | 23 - source/unres/src_MD-DFA-restraints/COMMON.VAR | 21 - source/unres/src_MD-DFA-restraints/COMMON.VECTORS | 3 - source/unres/src_MD-DFA-restraints/DIMENSIONS | 142 - source/unres/src_MD-DFA-restraints/DIMENSIONS.2100 | 80 - source/unres/src_MD-DFA-restraints/DIMENSIONS.4100 | 80 - source/unres/src_MD-DFA-restraints/MD_A-MTS.F | 3461 ------ source/unres/src_MD-DFA-restraints/MP.F | 516 - source/unres/src_MD-DFA-restraints/MREMD.F | 2117 ---- source/unres/src_MD-DFA-restraints/Makefile | 133 - .../Makefile-intrepid-with-tau | 154 - .../src_MD-DFA-restraints/Makefile.tau-mpi-f77-pdt | 860 -- .../unres/src_MD-DFA-restraints/Makefile_MPICH_PGI | 126 - .../src_MD-DFA-restraints/Makefile_MPICH_ifort | 127 - .../unres/src_MD-DFA-restraints/Makefile_aix_xlf | 113 - source/unres/src_MD-DFA-restraints/Makefile_bigben | 138 - .../src_MD-DFA-restraints/Makefile_bigben-oldparm | 136 - .../src_MD-DFA-restraints/Makefile_bigben-tau | 137 - source/unres/src_MD-DFA-restraints/Makefile_galera | 147 - .../unres/src_MD-DFA-restraints/Makefile_intrepid | 151 - .../src_MD-DFA-restraints/Makefile_single_gfortran | 130 - .../src_MD-DFA-restraints/Makefile_single_ifort | 127 - source/unres/src_MD-DFA-restraints/README | 2 - source/unres/src_MD-DFA-restraints/add.f | 28 - source/unres/src_MD-DFA-restraints/arcos.f | 9 - source/unres/src_MD-DFA-restraints/banach.f | 99 - source/unres/src_MD-DFA-restraints/blas.f | 575 - source/unres/src_MD-DFA-restraints/bond_move.f | 124 - source/unres/src_MD-DFA-restraints/build.txt | 1 - source/unres/src_MD-DFA-restraints/cartder.F | 314 - source/unres/src_MD-DFA-restraints/cartprint.f | 19 - source/unres/src_MD-DFA-restraints/chainbuild.F | 274 - source/unres/src_MD-DFA-restraints/change.awk | 11 - source/unres/src_MD-DFA-restraints/check_bond.f | 20 - .../unres/src_MD-DFA-restraints/check_sc_distr.f | 43 - source/unres/src_MD-DFA-restraints/checkder_p.F | 713 -- source/unres/src_MD-DFA-restraints/compare_s1.F | 188 - source/unres/src_MD-DFA-restraints/compinfo.c | 82 - source/unres/src_MD-DFA-restraints/contact.f | 195 - source/unres/src_MD-DFA-restraints/convert.f | 196 - source/unres/src_MD-DFA-restraints/cored.f | 3151 ----- source/unres/src_MD-DFA-restraints/dfa.F | 3455 ------ source/unres/src_MD-DFA-restraints/dihed_cons.F | 185 - source/unres/src_MD-DFA-restraints/djacob.f | 107 - source/unres/src_MD-DFA-restraints/econstr_local.F | 91 - source/unres/src_MD-DFA-restraints/eigen.f | 2351 ---- source/unres/src_MD-DFA-restraints/elecont.f | 509 - .../energy_p_new-sep_barrier.F | 2322 ---- .../src_MD-DFA-restraints/energy_p_new_barrier.F | 9496 --------------- .../unres/src_MD-DFA-restraints/energy_split-sep.F | 500 - source/unres/src_MD-DFA-restraints/entmcm.F | 684 -- source/unres/src_MD-DFA-restraints/fitsq.f | 364 - source/unres/src_MD-DFA-restraints/gauss.f | 69 - source/unres/src_MD-DFA-restraints/gen_rand_conf.F | 910 -- source/unres/src_MD-DFA-restraints/geomout.F | 522 - source/unres/src_MD-DFA-restraints/gnmr1.f | 43 - source/unres/src_MD-DFA-restraints/gradient_p.F | 421 - source/unres/src_MD-DFA-restraints/initialize_p.F | 1439 --- source/unres/src_MD-DFA-restraints/int_to_cart.f | 278 - source/unres/src_MD-DFA-restraints/intcartderiv.F | 725 -- source/unres/src_MD-DFA-restraints/intcor.f | 91 - source/unres/src_MD-DFA-restraints/intlocal.f | 517 - .../unres/src_MD-DFA-restraints/kinetic_lesyng.f | 104 - .../src_MD-DFA-restraints/lagrangian_lesyng.F | 726 -- source/unres/src_MD-DFA-restraints/local_move.f | 972 -- source/unres/src_MD-DFA-restraints/map.f | 90 - source/unres/src_MD-DFA-restraints/matmult.f | 18 - source/unres/src_MD-DFA-restraints/mc.F | 819 -- source/unres/src_MD-DFA-restraints/mcm.F | 1481 --- source/unres/src_MD-DFA-restraints/minim_mcmf.F | 121 - source/unres/src_MD-DFA-restraints/minimize_p.F | 641 - source/unres/src_MD-DFA-restraints/misc.f | 203 - source/unres/src_MD-DFA-restraints/moments.f | 328 - source/unres/src_MD-DFA-restraints/muca_md.f | 334 - source/unres/src_MD-DFA-restraints/parmread.F | 1036 -- source/unres/src_MD-DFA-restraints/pinorm.f | 17 - source/unres/src_MD-DFA-restraints/printmat.f | 16 - source/unres/src_MD-DFA-restraints/prng.f | 525 - source/unres/src_MD-DFA-restraints/prng_32.F | 1077 -- source/unres/src_MD-DFA-restraints/proc_proc.c | 139 - source/unres/src_MD-DFA-restraints/q_measure.F | 487 - source/unres/src_MD-DFA-restraints/q_measure1.F | 470 - source/unres/src_MD-DFA-restraints/q_measure3.F | 529 - source/unres/src_MD-DFA-restraints/randgens.f | 99 - source/unres/src_MD-DFA-restraints/rattle.F | 706 -- source/unres/src_MD-DFA-restraints/readpdb.F | 432 - source/unres/src_MD-DFA-restraints/readrtns.F | 2868 ----- source/unres/src_MD-DFA-restraints/refsys.f | 60 - source/unres/src_MD-DFA-restraints/regularize.F | 76 - source/unres/src_MD-DFA-restraints/rescode.f | 32 - source/unres/src_MD-DFA-restraints/rmdd.f | 159 - source/unres/src_MD-DFA-restraints/rmsd.F | 140 - source/unres/src_MD-DFA-restraints/sc_move.F | 823 -- source/unres/src_MD-DFA-restraints/sizes.i | 83 - source/unres/src_MD-DFA-restraints/sort.f | 589 - source/unres/src_MD-DFA-restraints/ssMD.F | 1951 --- source/unres/src_MD-DFA-restraints/stochfric.F | 626 - source/unres/src_MD-DFA-restraints/sumsld.f | 1446 --- source/unres/src_MD-DFA-restraints/surfatom.f | 494 - source/unres/src_MD-DFA-restraints/test.F | 863 -- source/unres/src_MD-DFA-restraints/thread.F | 549 - source/unres/src_MD-DFA-restraints/timing.F | 344 - source/unres/src_MD-DFA-restraints/unres.F | 796 -- .../src_MD-DFA-restraints/xdrf/CMakeLists.txt | 19 - source/unres/src_MD-DFA-restraints/xdrf/Makefile | 27 - .../unres/src_MD-DFA-restraints/xdrf/Makefile_jubl | 31 - .../src_MD-DFA-restraints/xdrf/Makefile_linux | 27 - source/unres/src_MD-DFA-restraints/xdrf/RS6K.m4 | 20 - source/unres/src_MD-DFA-restraints/xdrf/ftocstr.c | 35 - source/unres/src_MD-DFA-restraints/xdrf/libxdrf.m4 | 1238 -- source/unres/src_MD-DFA-restraints/xdrf/types.h | 99 - .../unres/src_MD-DFA-restraints/xdrf/underscore.m4 | 19 - source/unres/src_MD-DFA-restraints/xdrf/xdr.c | 752 -- source/unres/src_MD-DFA-restraints/xdrf/xdr.h | 379 - .../unres/src_MD-DFA-restraints/xdrf/xdr_array.c | 174 - .../unres/src_MD-DFA-restraints/xdrf/xdr_float.c | 307 - .../unres/src_MD-DFA-restraints/xdrf/xdr_stdio.c | 196 - source/unres/src_MD-DFA-restraints/xdrf/xdrf.h | 10 - .../src_MD-M-SAXS-homology/COMMON.CONTACTS_safe1 | 82 - .../unres/src_MD-M-SAXS-homology/COMMON.DERIV_safe | 35 - .../unres/src_MD-M-SAXS-homology/DIMENSIONS_safe1 | 135 - source/unres/src_MD-M-SAXS-homology/MD.F | 2566 ---- source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F | 10 +- .../unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe | 2327 ---- .../unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe1 | 2356 ---- source/unres/src_MD-M-SAXS-homology/MREMD.F | 2 +- source/unres/src_MD-M-SAXS-homology/MREMD.F.safe | 1756 --- .../Makefile_MPICH_ifort-okeanos | 2 +- source/unres/src_MD-M-SAXS-homology/brown_step.F | 2 +- source/unres/src_MD-M-SAXS-homology/chainbuild.F | 1 + source/unres/src_MD-M-SAXS-homology/checkder_p.F | 5 +- source/unres/src_MD-M-SAXS-homology/cored.T | 16 +- source/unres/src_MD-M-SAXS-homology/cored.Tfe | 16 +- source/unres/src_MD-M-SAXS-homology/cored.f | 1 + source/unres/src_MD-M-SAXS-homology/dfa.F | 8 +- source/unres/src_MD-M-SAXS-homology/energy_p_new.F | 8385 ------------- .../src_MD-M-SAXS-homology/energy_p_new_barrier.F | 94 +- .../energy_p_new_barrier.F.safe |12561 -------------------- .../src_MD-M-SAXS-homology/energy_split-sep.F | 94 +- source/unres/src_MD-M-SAXS-homology/energy_split.F | 447 - .../unres/src_MD-M-SAXS-homology/gen_rand_conf.F | 3 + source/unres/src_MD-M-SAXS-homology/geomout.F | 12 +- source/unres/src_MD-M-SAXS-homology/gradient_p.F | 2 +- source/unres/src_MD-M-SAXS-homology/initialize_p.F | 4 +- source/unres/src_MD-M-SAXS-homology/minimize_p.F | 12 +- source/unres/src_MD-M-SAXS-homology/parmread.F | 28 +- .../unres/src_MD-M-SAXS-homology/parmread.F.safe | 1727 --- source/unres/src_MD-M-SAXS-homology/readpdb.F | 61 +- source/unres/src_MD-M-SAXS-homology/readpdb.F.safe | 609 - source/unres/src_MD-M-SAXS-homology/readrtns_CSA.F | 75 +- source/unres/src_MD-M-SAXS-homology/rmscalc.F | 2 +- source/unres/src_MD-M-SAXS-homology/sc_move.F | 2 + source/unres/src_MD-M-SAXS-homology/unres.F | 16 +- source/unres/src_MD-M-SAXS-homology/xdrf | 1 - source/unres/src_MD-M-newcorr/CMakeLists.txt | 56 +- source/unres/src_MD-M-newcorr/COMMON.DERIV | 2 +- source/unres/src_MD-M-newcorr/COMMON.SBRIDGE | 17 +- source/unres/src_MD-M-newcorr/MREMD.F | 31 +- source/unres/src_MD-M-newcorr/Makefile_MPICH_ifort | 2 +- .../src_MD-M-newcorr/energy_p_new-sep_barrier.F | 44 +- .../unres/src_MD-M-newcorr/energy_p_new_barrier.F | 97 +- source/unres/src_MD-M-newcorr/geomout.F | 32 +- source/unres/src_MD-M-newcorr/initialize_p.F | 1 + source/unres/src_MD-M-newcorr/parmread.F | 41 +- source/unres/src_MD-M-newcorr/readrtns_CSA.F | 56 +- source/unres/src_MD-M-newcorr/stochfric.F | 8 +- source/unres/src_MD-M/CMakeCache.txt | 326 - .../unres/src_MD-M/CMakeFiles/CMakeCCompiler.cmake | 41 - .../src_MD-M/CMakeFiles/CMakeCXXCompiler.cmake | 42 - .../CMakeFiles/CMakeDetermineCompilerABI_C.bin | Bin 6997 -> 0 bytes .../CMakeFiles/CMakeDetermineCompilerABI_CXX.bin | Bin 7283 -> 0 bytes .../CMakeDetermineCompilerABI_Fortran.bin | Bin 8365 -> 0 bytes .../src_MD-M/CMakeFiles/CMakeFortranCompiler.cmake | 34 - source/unres/src_MD-M/CMakeFiles/CMakeOutput.log | 380 - source/unres/src_MD-M/CMakeFiles/CMakeSystem.cmake | 15 - .../CMakeFiles/CompilerIdC/CMakeCCompilerId.c | 188 - source/unres/src_MD-M/CMakeFiles/CompilerIdC/a.out | Bin 6478 -> 0 bytes .../CompilerIdCXX/CMakeCXXCompilerId.cpp | 175 - .../unres/src_MD-M/CMakeFiles/CompilerIdCXX/a.out | Bin 6851 -> 0 bytes .../CompilerIdFortran/CMakeFortranCompilerId.F | 108 - .../src_MD-M/CMakeFiles/CompilerIdFortran/a.out | Bin 7916 -> 0 bytes source/unres/src_MD-M/CMakeFiles/cmake.check_cache | 1 - source/unres/src_MD-M/CMakeLists.txt | 49 +- source/unres/src_MD-M/COMMON.CALC | 4 +- source/unres/src_MD-M/COMMON.CHAIN | 20 +- source/unres/src_MD-M/COMMON.CONTACTS | 8 +- source/unres/src_MD-M/COMMON.CONTROL | 19 +- source/unres/src_MD-M/COMMON.DERIV | 66 +- source/unres/src_MD-M/COMMON.FFIELD | 6 +- source/unres/src_MD-M/COMMON.INTERACT | 32 +- source/unres/src_MD-M/COMMON.IOUNITS | 13 +- source/unres/src_MD-M/COMMON.LOCAL | 45 +- source/unres/src_MD-M/COMMON.MD | 11 +- source/unres/src_MD-M/COMMON.NAMES | 3 +- source/unres/src_MD-M/COMMON.REMD | 4 +- source/unres/src_MD-M/COMMON.SBRIDGE | 18 +- source/unres/src_MD-M/COMMON.SCCOR | 24 +- source/unres/src_MD-M/COMMON.SCROT | 2 +- source/unres/src_MD-M/COMMON.TORCNSTR | 20 +- source/unres/src_MD-M/COMMON.TORSION | 69 +- source/unres/src_MD-M/COMMON.VAR | 2 + source/unres/src_MD-M/DIMENSIONS | 23 +- source/unres/src_MD-M/MD.F | 57 +- source/unres/src_MD-M/MD_A-MTS.F | 235 +- source/unres/src_MD-M/MP.F | 4 +- source/unres/src_MD-M/MREMD.F | 179 +- source/unres/src_MD-M/Makefile | 141 +- source/unres/src_MD-M/Makefile-biosim | 127 - source/unres/src_MD-M/Makefile-intrepid-with-tau | 154 - source/unres/src_MD-M/Makefile-matrix-intel | 124 - source/unres/src_MD-M/Makefile-matrix3 | 141 - source/unres/src_MD-M/Makefile-matrix3-oldparm | 127 - source/unres/src_MD-M/Makefile-oldparm | 130 - source/unres/src_MD-M/Makefile-rstconv | 40 - source/unres/src_MD-M/Makefile-tau-temp | 148 - source/unres/src_MD-M/Makefile.tau-mpi-f77-pdt | 860 -- source/unres/src_MD-M/Makefile.tau-mpi-pdt-pgi.org | 836 -- source/unres/src_MD-M/Makefile_aix_xlf | 112 - source/unres/src_MD-M/Makefile_bigben | 138 - source/unres/src_MD-M/Makefile_bigben-oldparm | 136 - source/unres/src_MD-M/Makefile_bigben-tau | 137 - source/unres/src_MD-M/Makefile_intrepid | 151 - source/unres/src_MD-M/Makefile_jubl | 132 - source/unres/src_MD-M/Makefile_jubl-debug | 141 - source/unres/src_MD-M/Makefile_jubl-opt | 117 - source/unres/src_MD-M/Makefile_jubl-opt-oldparm | 116 - source/unres/src_MD-M/Makefile_lnx_ifc | 104 - source/unres/src_MD-M/Makefile_lnx_ifc10_em64 | 128 - .../unres/src_MD-M/Makefile_lnx_ifc10_em64_galera | 130 - .../Makefile_lnx_ifc10_em64_galera-oldparm | 131 - source/unres/src_MD-M/Makefile_lnx_ifc10_em64_mpi2 | 146 - source/unres/src_MD-M/Makefile_lnx_ifc8 | 127 - source/unres/src_MD-M/Makefile_lnx_pgf90 | 120 - source/unres/src_MD-M/Makefile_osf_f90 | 79 - source/unres/src_MD-M/Makefile_win_ifl | 53 - source/unres/src_MD-M/Makefile_win_pgf90 | 43 - source/unres/src_MD-M/arcos.f | 2 +- source/unres/src_MD-M/bank.F | 2 +- source/unres/src_MD-M/bigsymbols-lang0.txt | 7 - source/unres/src_MD-M/brown_step.F | 1 + source/unres/src_MD-M/chainbuild.F | 368 +- source/unres/src_MD-M/change.awk | 11 - source/unres/src_MD-M/checkder_p.F | 87 +- source/unres/src_MD-M/contact.f | 6 +- source/unres/src_MD-M/csa.f | 6 +- source/unres/src_MD-M/dihed_cons.F | 5 +- source/unres/src_MD-M/elecont.f | 60 +- source/unres/src_MD-M/energy_p_new-sep.F | 135 +- source/unres/src_MD-M/energy_p_new-sep_barrier.F | 921 +- source/unres/src_MD-M/energy_p_new.F | 6 +- source/unres/src_MD-M/energy_p_new_barrier.F | 4376 ++++++- source/unres/src_MD-M/energy_split-sep.F | 63 +- source/unres/src_MD-M/energy_split.F | 38 +- source/unres/src_MD-M/entmcm.F | 9 +- source/unres/src_MD-M/fitsq.f | 2 +- source/unres/src_MD-M/gen_rand_conf.F | 266 +- source/unres/src_MD-M/geomout.F | 110 +- source/unres/src_MD-M/gnmr1.f | 30 + source/unres/src_MD-M/gradient_p.F | 90 +- source/unres/src_MD-M/initialize_p.F | 177 +- source/unres/src_MD-M/int_to_cart.f | 182 +- source/unres/src_MD-M/intcartderiv.F | 294 +- source/unres/src_MD-M/intcor.f | 4 + source/unres/src_MD-M/kinetic_lesyng.f | 4 +- source/unres/src_MD-M/lagrangian_lesyng.F | 30 +- source/unres/src_MD-M/load.map | 8080 ------------- source/unres/src_MD-M/load.map-lang0 | 8158 ------------- source/unres/src_MD-M/loadmap.2400 | 8072 ------------- source/unres/src_MD-M/local_move.f | 8 +- source/unres/src_MD-M/map.f | 2 +- source/unres/src_MD-M/mc.F | 3 +- source/unres/src_MD-M/mcm.F | 16 +- source/unres/src_MD-M/minim_jlee.F | 6 +- source/unres/src_MD-M/minimize_p.F | 17 +- source/unres/src_MD-M/module.log | 11 - source/unres/src_MD-M/moments.f | 41 +- source/unres/src_MD-M/objects.sizes | 168 - source/unres/src_MD-M/parmread.F | 1442 ++- source/unres/src_MD-M/pdtf5579.pdb | 1195 -- source/unres/src_MD-M/prng.f | 525 - source/unres/src_MD-M/prng_32.F | 21 +- source/unres/src_MD-M/q_measure.F | 293 +- source/unres/src_MD-M/readpdb.F | 270 +- source/unres/src_MD-M/readpdb.f.safe | Bin 43512 -> 0 bytes source/unres/src_MD-M/readrtns_CSA.F | 871 +- source/unres/src_MD-M/refsys.f | 32 +- source/unres/src_MD-M/rescode.f | 4 +- source/unres/src_MD-M/rmsd.F | 22 +- source/unres/src_MD-M/sc_move.F | 129 +- source/unres/src_MD-M/shift.F | 4 +- source/unres/src_MD-M/stochfric.F | 47 +- source/unres/src_MD-M/symbols-lang0.txt | 257 - source/unres/src_MD-M/symbolsizes.txt | 257 - source/unres/src_MD-M/test.F | 124 + source/unres/src_MD-M/thread.F | 6 +- source/unres/src_MD-M/timing.F | 15 + source/unres/src_MD-M/together.F | 4 +- source/unres/src_MD-M/unres.F | 100 +- source/unres/src_MD-NEWSC-NEWC/CMakeLists.txt | 398 - source/unres/src_MD-NEWSC-NEWC/COMMON.BOUNDS | 2 - source/unres/src_MD-NEWSC-NEWC/COMMON.CACHE | 6 - source/unres/src_MD-NEWSC-NEWC/COMMON.CALC | 15 - source/unres/src_MD-NEWSC-NEWC/COMMON.CHAIN | 13 - source/unres/src_MD-NEWSC-NEWC/COMMON.CONTACTS | 82 - .../unres/src_MD-NEWSC-NEWC/COMMON.CONTACTS.moment | 68 - source/unres/src_MD-NEWSC-NEWC/COMMON.CONTROL | 13 - source/unres/src_MD-NEWSC-NEWC/COMMON.DBASE | 3 - source/unres/src_MD-NEWSC-NEWC/COMMON.DERIV | 40 - source/unres/src_MD-NEWSC-NEWC/COMMON.DISTFIT | 14 - source/unres/src_MD-NEWSC-NEWC/COMMON.EMP | 126 - source/unres/src_MD-NEWSC-NEWC/COMMON.FFIELD | 26 - source/unres/src_MD-NEWSC-NEWC/COMMON.GEO | 2 - source/unres/src_MD-NEWSC-NEWC/COMMON.HAIRPIN | 5 - source/unres/src_MD-NEWSC-NEWC/COMMON.HEADER | 2 - source/unres/src_MD-NEWSC-NEWC/COMMON.INFO | 21 - source/unres/src_MD-NEWSC-NEWC/COMMON.INTERACT | 45 - source/unres/src_MD-NEWSC-NEWC/COMMON.IOUNITS | 69 - source/unres/src_MD-NEWSC-NEWC/COMMON.LANGEVIN | 21 - .../unres/src_MD-NEWSC-NEWC/COMMON.LANGEVIN.lang0 | 11 - source/unres/src_MD-NEWSC-NEWC/COMMON.LOCAL | 55 - source/unres/src_MD-NEWSC-NEWC/COMMON.LOCMOVE | 19 - source/unres/src_MD-NEWSC-NEWC/COMMON.MAP | 4 - source/unres/src_MD-NEWSC-NEWC/COMMON.MAXGRAD | 12 - source/unres/src_MD-NEWSC-NEWC/COMMON.MCE | 13 - source/unres/src_MD-NEWSC-NEWC/COMMON.MCM | 70 - source/unres/src_MD-NEWSC-NEWC/COMMON.MD | 77 - source/unres/src_MD-NEWSC-NEWC/COMMON.MINIM | 5 - source/unres/src_MD-NEWSC-NEWC/COMMON.MUCA | 10 - source/unres/src_MD-NEWSC-NEWC/COMMON.NAMES | 7 - source/unres/src_MD-NEWSC-NEWC/COMMON.REMD | 36 - source/unres/src_MD-NEWSC-NEWC/COMMON.SBRIDGE | 17 - source/unres/src_MD-NEWSC-NEWC/COMMON.SCCOR | 17 - source/unres/src_MD-NEWSC-NEWC/COMMON.SCROT | 3 - source/unres/src_MD-NEWSC-NEWC/COMMON.SETUP | 21 - source/unres/src_MD-NEWSC-NEWC/COMMON.SPLITELE | 2 - source/unres/src_MD-NEWSC-NEWC/COMMON.THREAD | 7 - source/unres/src_MD-NEWSC-NEWC/COMMON.TIME1 | 28 - source/unres/src_MD-NEWSC-NEWC/COMMON.TORCNSTR | 6 - source/unres/src_MD-NEWSC-NEWC/COMMON.TORSION | 29 - source/unres/src_MD-NEWSC-NEWC/COMMON.VAR | 21 - source/unres/src_MD-NEWSC-NEWC/COMMON.VECTORS | 3 - source/unres/src_MD-NEWSC-NEWC/DIMENSIONS | 139 - source/unres/src_MD-NEWSC-NEWC/DIMENSIONS.2100 | 80 - source/unres/src_MD-NEWSC-NEWC/DIMENSIONS.4100 | 80 - source/unres/src_MD-NEWSC-NEWC/MD_A-MTS.F | 3461 ------ source/unres/src_MD-NEWSC-NEWC/MP.F | 516 - source/unres/src_MD-NEWSC-NEWC/MREMD.F | 2106 ---- source/unres/src_MD-NEWSC-NEWC/Makefile | 1 - .../src_MD-NEWSC-NEWC/Makefile-intrepid-with-tau | 154 - .../src_MD-NEWSC-NEWC/Makefile.tau-mpi-f77-pdt | 860 -- .../unres/src_MD-NEWSC-NEWC/Makefile_MPICH_ifort | 127 - .../Makefile_MPICH_ifort_09_05_2013 | 127 - source/unres/src_MD-NEWSC-NEWC/Makefile_aix_xlf | 113 - source/unres/src_MD-NEWSC-NEWC/Makefile_bigben | 138 - .../src_MD-NEWSC-NEWC/Makefile_bigben-oldparm | 136 - source/unres/src_MD-NEWSC-NEWC/Makefile_bigben-tau | 137 - source/unres/src_MD-NEWSC-NEWC/Makefile_galera | 147 - source/unres/src_MD-NEWSC-NEWC/Makefile_gitdefault | 127 - source/unres/src_MD-NEWSC-NEWC/Makefile_intrepid | 151 - .../src_MD-NEWSC-NEWC/Makefile_single_gfortran | 130 - .../unres/src_MD-NEWSC-NEWC/Makefile_single_ifort | 127 - source/unres/src_MD-NEWSC-NEWC/README | 2 - source/unres/src_MD-NEWSC-NEWC/add.f | 28 - source/unres/src_MD-NEWSC-NEWC/arcos.f | 9 - source/unres/src_MD-NEWSC-NEWC/banach.f | 99 - source/unres/src_MD-NEWSC-NEWC/blas.f | 575 - source/unres/src_MD-NEWSC-NEWC/bond_move.f | 124 - source/unres/src_MD-NEWSC-NEWC/build.txt | 1 - source/unres/src_MD-NEWSC-NEWC/cartder.F | 314 - source/unres/src_MD-NEWSC-NEWC/cartprint.f | 19 - source/unres/src_MD-NEWSC-NEWC/chainbuild.F | 274 - source/unres/src_MD-NEWSC-NEWC/change.awk | 11 - source/unres/src_MD-NEWSC-NEWC/check_bond.f | 20 - source/unres/src_MD-NEWSC-NEWC/check_sc_distr.f | 43 - source/unres/src_MD-NEWSC-NEWC/checkder_p.F | 713 -- source/unres/src_MD-NEWSC-NEWC/compare_s1.F | 188 - source/unres/src_MD-NEWSC-NEWC/compinfo.c | 82 - source/unres/src_MD-NEWSC-NEWC/contact.f | 195 - source/unres/src_MD-NEWSC-NEWC/convert.f | 196 - source/unres/src_MD-NEWSC-NEWC/cored.f | 3151 ----- source/unres/src_MD-NEWSC-NEWC/dihed_cons.F | 185 - source/unres/src_MD-NEWSC-NEWC/djacob.f | 107 - source/unres/src_MD-NEWSC-NEWC/econstr_local.F | 91 - source/unres/src_MD-NEWSC-NEWC/eigen.f | 2351 ---- source/unres/src_MD-NEWSC-NEWC/elecont.f | 509 - .../src_MD-NEWSC-NEWC/energy_p_new-sep_barrier.F | 2322 ---- .../unres/src_MD-NEWSC-NEWC/energy_p_new_barrier.F |10979 ----------------- .../src_MD-NEWSC-NEWC/energy_p_new_barrier_v3ok1.F |10958 ----------------- source/unres/src_MD-NEWSC-NEWC/energy_split-sep.F | 476 - source/unres/src_MD-NEWSC-NEWC/entmcm.F | 684 -- source/unres/src_MD-NEWSC-NEWC/fitsq.f | 364 - source/unres/src_MD-NEWSC-NEWC/gauss.f | 69 - source/unres/src_MD-NEWSC-NEWC/gen_rand_conf.F | 910 -- source/unres/src_MD-NEWSC-NEWC/geomout.F | 507 - source/unres/src_MD-NEWSC-NEWC/gnmr1.f | 43 - source/unres/src_MD-NEWSC-NEWC/gradient_p.F | 421 - source/unres/src_MD-NEWSC-NEWC/initialize_p.F | 1399 --- source/unres/src_MD-NEWSC-NEWC/int_to_cart.f | 278 - source/unres/src_MD-NEWSC-NEWC/intcartderiv.F | 725 -- source/unres/src_MD-NEWSC-NEWC/intcor.f | 91 - source/unres/src_MD-NEWSC-NEWC/intlocal.f | 517 - source/unres/src_MD-NEWSC-NEWC/kinetic_lesyng.f | 104 - source/unres/src_MD-NEWSC-NEWC/lagrangian_lesyng.F | 726 -- source/unres/src_MD-NEWSC-NEWC/local_move.f | 972 -- source/unres/src_MD-NEWSC-NEWC/map.f | 90 - source/unres/src_MD-NEWSC-NEWC/matmult.f | 18 - source/unres/src_MD-NEWSC-NEWC/mc.F | 819 -- source/unres/src_MD-NEWSC-NEWC/mcm.F | 1481 --- source/unres/src_MD-NEWSC-NEWC/minim_mcmf.F | 121 - source/unres/src_MD-NEWSC-NEWC/minimize_p.F | 641 - source/unres/src_MD-NEWSC-NEWC/misc.f | 203 - source/unres/src_MD-NEWSC-NEWC/moments.f | 328 - source/unres/src_MD-NEWSC-NEWC/muca_md.f | 334 - source/unres/src_MD-NEWSC-NEWC/parmread.F | 1223 -- source/unres/src_MD-NEWSC-NEWC/parmread_v3ok1.F | 1245 -- source/unres/src_MD-NEWSC-NEWC/pinorm.f | 17 - source/unres/src_MD-NEWSC-NEWC/printmat.f | 16 - source/unres/src_MD-NEWSC-NEWC/prng.f | 525 - source/unres/src_MD-NEWSC-NEWC/prng_32.F | 1077 -- source/unres/src_MD-NEWSC-NEWC/proc_proc.c | 139 - source/unres/src_MD-NEWSC-NEWC/q_measure.F | 487 - source/unres/src_MD-NEWSC-NEWC/q_measure1.F | 470 - source/unres/src_MD-NEWSC-NEWC/q_measure3.F | 529 - source/unres/src_MD-NEWSC-NEWC/randgens.f | 99 - source/unres/src_MD-NEWSC-NEWC/rattle.F | 706 -- source/unres/src_MD-NEWSC-NEWC/readpdb.F | 432 - source/unres/src_MD-NEWSC-NEWC/readrtns.F | 2711 ----- source/unres/src_MD-NEWSC-NEWC/refsys.f | 60 - source/unres/src_MD-NEWSC-NEWC/regularize.F | 76 - source/unres/src_MD-NEWSC-NEWC/rescode.f | 32 - source/unres/src_MD-NEWSC-NEWC/rmdd.f | 159 - source/unres/src_MD-NEWSC-NEWC/rmsd.F | 140 - source/unres/src_MD-NEWSC-NEWC/sc_move.F | 823 -- source/unres/src_MD-NEWSC-NEWC/sizes.i | 83 - source/unres/src_MD-NEWSC-NEWC/sort.f | 589 - source/unres/src_MD-NEWSC-NEWC/ssMD.F | 1951 --- source/unres/src_MD-NEWSC-NEWC/stochfric.F | 626 - source/unres/src_MD-NEWSC-NEWC/sumsld.f | 1446 --- source/unres/src_MD-NEWSC-NEWC/surfatom.f | 494 - source/unres/src_MD-NEWSC-NEWC/test.F | 863 -- source/unres/src_MD-NEWSC-NEWC/thread.F | 549 - source/unres/src_MD-NEWSC-NEWC/timing.F | 344 - source/unres/src_MD-NEWSC-NEWC/unres.F | 799 -- source/unres/src_MD-NEWSC-NEWC/xdrf/CMakeLists.txt | 19 - source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile | 27 - source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_jubl | 31 - source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_linux | 27 - source/unres/src_MD-NEWSC-NEWC/xdrf/RS6K.m4 | 20 - source/unres/src_MD-NEWSC-NEWC/xdrf/ftocstr.c | 35 - source/unres/src_MD-NEWSC-NEWC/xdrf/libxdrf.m4 | 1238 -- source/unres/src_MD-NEWSC-NEWC/xdrf/types.h | 99 - source/unres/src_MD-NEWSC-NEWC/xdrf/underscore.m4 | 19 - source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.c | 752 -- source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.h | 379 - source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_array.c | 174 - source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_float.c | 307 - source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_stdio.c | 196 - source/unres/src_MD-NEWSC-NEWC/xdrf/xdrf.h | 10 - source/unres/src_MD-NEWSC/MREMD.F | 14 +- source/unres/src_MD-restraints/CMakeLists.txt | 398 - source/unres/src_MD-restraints/COMMON.BOUNDS | 2 - source/unres/src_MD-restraints/COMMON.CACHE | 6 - source/unres/src_MD-restraints/COMMON.CALC | 15 - source/unres/src_MD-restraints/COMMON.CHAIN | 13 - source/unres/src_MD-restraints/COMMON.CONTACTS | 82 - .../unres/src_MD-restraints/COMMON.CONTACTS.moment | 68 - source/unres/src_MD-restraints/COMMON.CONTROL | 15 - source/unres/src_MD-restraints/COMMON.DBASE | 3 - source/unres/src_MD-restraints/COMMON.DERIV | 36 - source/unres/src_MD-restraints/COMMON.DISTFIT | 14 - source/unres/src_MD-restraints/COMMON.FFIELD | 25 - source/unres/src_MD-restraints/COMMON.GEO | 2 - source/unres/src_MD-restraints/COMMON.HAIRPIN | 5 - source/unres/src_MD-restraints/COMMON.HEADER | 2 - source/unres/src_MD-restraints/COMMON.INFO | 21 - source/unres/src_MD-restraints/COMMON.INTERACT | 34 - source/unres/src_MD-restraints/COMMON.IOUNITS | 69 - source/unres/src_MD-restraints/COMMON.LANGEVIN | 21 - .../unres/src_MD-restraints/COMMON.LANGEVIN.lang0 | 11 - source/unres/src_MD-restraints/COMMON.LOCAL | 55 - source/unres/src_MD-restraints/COMMON.LOCMOVE | 19 - source/unres/src_MD-restraints/COMMON.MAP | 4 - source/unres/src_MD-restraints/COMMON.MAXGRAD | 12 - source/unres/src_MD-restraints/COMMON.MCE | 13 - source/unres/src_MD-restraints/COMMON.MCM | 70 - source/unres/src_MD-restraints/COMMON.MD | 87 - source/unres/src_MD-restraints/COMMON.MINIM | 5 - source/unres/src_MD-restraints/COMMON.MUCA | 10 - source/unres/src_MD-restraints/COMMON.NAMES | 7 - source/unres/src_MD-restraints/COMMON.REMD | 36 - source/unres/src_MD-restraints/COMMON.SBRIDGE | 17 - source/unres/src_MD-restraints/COMMON.SCCOR | 17 - source/unres/src_MD-restraints/COMMON.SCROT | 3 - source/unres/src_MD-restraints/COMMON.SETUP | 21 - source/unres/src_MD-restraints/COMMON.SPLITELE | 2 - source/unres/src_MD-restraints/COMMON.THREAD | 7 - source/unres/src_MD-restraints/COMMON.TIME1 | 28 - source/unres/src_MD-restraints/COMMON.TORCNSTR | 6 - source/unres/src_MD-restraints/COMMON.TORSION | 23 - source/unres/src_MD-restraints/COMMON.VAR | 21 - source/unres/src_MD-restraints/COMMON.VECTORS | 3 - source/unres/src_MD-restraints/DIMENSIONS | 142 - source/unres/src_MD-restraints/DIMENSIONS.2100 | 80 - source/unres/src_MD-restraints/DIMENSIONS.4100 | 80 - source/unres/src_MD-restraints/MD_A-MTS.F | 3461 ------ source/unres/src_MD-restraints/MP.F | 516 - source/unres/src_MD-restraints/MREMD.F | 2117 ---- source/unres/src_MD-restraints/Makefile | 1 - .../src_MD-restraints/Makefile-intrepid-with-tau | 154 - .../src_MD-restraints/Makefile.tau-mpi-f77-pdt | 860 -- source/unres/src_MD-restraints/Makefile_MPICH_PGI | 126 - .../unres/src_MD-restraints/Makefile_MPICH_ifort | 127 - source/unres/src_MD-restraints/Makefile_aix_xlf | 113 - source/unres/src_MD-restraints/Makefile_bigben | 138 - .../src_MD-restraints/Makefile_bigben-oldparm | 136 - source/unres/src_MD-restraints/Makefile_bigben-tau | 137 - source/unres/src_MD-restraints/Makefile_galera | 147 - source/unres/src_MD-restraints/Makefile_intrepid | 151 - source/unres/src_MD-restraints/Makefile_nostromo | 135 - .../src_MD-restraints/Makefile_single_gfortran | 130 - .../unres/src_MD-restraints/Makefile_single_ifort | 127 - source/unres/src_MD-restraints/README | 2 - source/unres/src_MD-restraints/add.f | 28 - source/unres/src_MD-restraints/arcos.f | 9 - source/unres/src_MD-restraints/banach.f | 99 - source/unres/src_MD-restraints/blas.f | 575 - source/unres/src_MD-restraints/bond_move.f | 124 - source/unres/src_MD-restraints/build.txt | 1 - source/unres/src_MD-restraints/cartder.F | 314 - source/unres/src_MD-restraints/cartprint.f | 19 - source/unres/src_MD-restraints/chainbuild.F | 274 - source/unres/src_MD-restraints/change.awk | 11 - source/unres/src_MD-restraints/check_bond.f | 20 - source/unres/src_MD-restraints/check_sc_distr.f | 43 - source/unres/src_MD-restraints/checkder_p.F | 713 -- source/unres/src_MD-restraints/compare_s1.F | 188 - source/unres/src_MD-restraints/compinfo.c | 82 - source/unres/src_MD-restraints/contact.f | 195 - source/unres/src_MD-restraints/convert.f | 196 - source/unres/src_MD-restraints/cored.f | 3151 ----- source/unres/src_MD-restraints/dihed_cons.F | 185 - source/unres/src_MD-restraints/djacob.f | 107 - source/unres/src_MD-restraints/econstr_local.F | 91 - source/unres/src_MD-restraints/eigen.f | 2351 ---- source/unres/src_MD-restraints/elecont.f | 509 - .../src_MD-restraints/energy_p_new-sep_barrier.F | 2322 ---- .../unres/src_MD-restraints/energy_p_new_barrier.F | 9431 --------------- source/unres/src_MD-restraints/energy_split-sep.F | 486 - source/unres/src_MD-restraints/entmcm.F | 684 -- source/unres/src_MD-restraints/fitsq.f | 364 - source/unres/src_MD-restraints/gauss.f | 69 - source/unres/src_MD-restraints/gen_rand_conf.F | 910 -- source/unres/src_MD-restraints/geomout.F | 522 - source/unres/src_MD-restraints/gnmr1.f | 43 - source/unres/src_MD-restraints/gradient_p.F | 421 - source/unres/src_MD-restraints/initialize_p.F | 1439 --- source/unres/src_MD-restraints/int_to_cart.f | 278 - source/unres/src_MD-restraints/intcartderiv.F | 725 -- source/unres/src_MD-restraints/intcor.f | 91 - source/unres/src_MD-restraints/intlocal.f | 517 - source/unres/src_MD-restraints/kinetic_lesyng.f | 104 - source/unres/src_MD-restraints/lagrangian_lesyng.F | 726 -- source/unres/src_MD-restraints/local_move.f | 972 -- source/unres/src_MD-restraints/log | 956 -- source/unres/src_MD-restraints/map.f | 90 - source/unres/src_MD-restraints/matmult.f | 18 - source/unres/src_MD-restraints/mc.F | 819 -- source/unres/src_MD-restraints/mcm.F | 1481 --- source/unres/src_MD-restraints/minim_mcmf.F | 121 - source/unres/src_MD-restraints/minimize_p.F | 641 - source/unres/src_MD-restraints/misc.f | 203 - source/unres/src_MD-restraints/moments.f | 328 - source/unres/src_MD-restraints/muca_md.f | 334 - source/unres/src_MD-restraints/parmread.F | 1036 -- source/unres/src_MD-restraints/pinorm.f | 17 - source/unres/src_MD-restraints/printmat.f | 16 - source/unres/src_MD-restraints/prng.f | 525 - source/unres/src_MD-restraints/prng_32.F | 1077 -- source/unres/src_MD-restraints/proc_proc.c | 139 - source/unres/src_MD-restraints/q_measure.F | 487 - source/unres/src_MD-restraints/q_measure1.F | 470 - source/unres/src_MD-restraints/q_measure3.F | 529 - source/unres/src_MD-restraints/randgens.f | 99 - source/unres/src_MD-restraints/rattle.F | 706 -- source/unres/src_MD-restraints/readpdb.F | 432 - source/unres/src_MD-restraints/readrtns.F | 2835 ----- source/unres/src_MD-restraints/refsys.f | 60 - source/unres/src_MD-restraints/regularize.F | 76 - source/unres/src_MD-restraints/rescode.f | 32 - source/unres/src_MD-restraints/rmdd.f | 159 - source/unres/src_MD-restraints/rmsd.F | 140 - source/unres/src_MD-restraints/sc_move.F | 823 -- source/unres/src_MD-restraints/sizes.i | 83 - source/unres/src_MD-restraints/sort.f | 589 - source/unres/src_MD-restraints/ssMD.F | 1951 --- source/unres/src_MD-restraints/stochfric.F | 626 - source/unres/src_MD-restraints/sumsld.f | 1446 --- source/unres/src_MD-restraints/surfatom.f | 494 - source/unres/src_MD-restraints/test.F | 863 -- source/unres/src_MD-restraints/thread.F | 549 - source/unres/src_MD-restraints/timing.F | 344 - source/unres/src_MD-restraints/unres.F | 796 -- source/unres/src_MD-restraints/xdrf | 1 - source/unres/src_MD/CMakeLists.txt | 265 +- source/unres/src_MD/COMMON.DERIV | 9 +- source/unres/src_MD/COMMON.REMD | 2 +- source/unres/src_MD/COMMON.SBRIDGE | 11 +- source/unres/src_MD/COMMON.SCCOR | 27 +- source/unres/src_MD/MD_A-MTS.F | 16 +- source/unres/src_MD/MREMD.F | 25 +- source/unres/src_MD/Makefile-intrepid-with-tau | 154 - source/unres/src_MD/Makefile.tau-mpi-f77-pdt | 860 -- source/unres/src_MD/Makefile_MPICH_ifort | 38 +- source/unres/src_MD/Makefile_aix_xlf | 113 - source/unres/src_MD/Makefile_bigben | 138 - source/unres/src_MD/Makefile_bigben-oldparm | 136 - source/unres/src_MD/Makefile_bigben-tau | 137 - source/unres/src_MD/Makefile_galera | 147 - source/unres/src_MD/Makefile_intrepid | 151 - source/unres/src_MD/Makefile_lnx_ifc10_opteron | 143 - .../src_MD/Makefile_lnx_ifc10_opteron_oldparm | 143 - source/unres/src_MD/Makefile_single_gfortran | 25 +- source/unres/src_MD/Makefile_single_ifort | 24 +- source/unres/src_MD/Makefile~HEAD | 1 - source/unres/src_MD/Makefile~adam | 1 - source/unres/src_MD/checkder_p.F | 5 +- source/unres/src_MD/energy_p_new_barrier.F | 89 +- source/unres/src_MD/geomout.F | 41 +- source/unres/src_MD/initialize_p.F | 42 +- source/unres/src_MD/int_to_cart.f | 9 + source/unres/src_MD/intcartderiv.F | 51 +- source/unres/src_MD/lagrangian_lesyng.F | 16 +- source/unres/src_MD/minimize_p.F | 11 + source/unres/src_MD/parmread.F | 4 +- source/unres/src_MD/prng.f | 525 - source/unres/src_MD/readrtns.F | 76 +- source/unres/src_MD/readrtns.F.orig | 2668 ----- source/unres/src_MD/unres.F | 42 +- source/unres/src_MD_DFA/CMakeLists.txt | 48 +- source/unres/src_MD_DFA/COMMON.DFA | 4 +- source/unres/src_MD_DFA/COMMON.REMD | 2 +- source/unres/src_MD_DFA/MREMD.F | 14 +- source/unres/src_MD_DFA/initialize_p.F | 37 +- source/unres/src_MD_DFA/unres.F | 2 +- source/unres/src_MIN/CMakeLists.txt | 37 +- source/unres/src_MIN/COMMON.SCCOR | 2 +- source/unres/src_MIN/Makefile_gfortran_single | 21 +- source/unres/src_MIN/Makefile_ifort_single | 16 +- source/wham/src-M-SAXS-homology/COMMON.CHAIN | 9 +- source/wham/src-M-SAXS-homology/COMMON.CONTROL | 20 +- source/wham/src-M-SAXS-homology/COMMON.FREE | 5 +- source/wham/src-M-SAXS-homology/COMMON.HOMOLOGY | 3 +- source/wham/src-M-SAXS-homology/COMMON.VAR | 7 +- .../Makefile_MPICH_ifort-okeanos | 9 +- source/wham/src-M-SAXS-homology/conf_compar.F | 6 +- source/wham/src-M-SAXS-homology/dfa.F | 9 +- source/wham/src-M-SAXS-homology/enecalc1.F | 14 +- source/wham/src-M-SAXS-homology/energy_p_new.F | 114 +- source/wham/src-M-SAXS-homology/initialize_p.F | 65 +- source/wham/src-M-SAXS-homology/make_ensemble1.F | 2 + source/wham/src-M-SAXS-homology/molread_zs.F | 34 +- source/wham/src-M-SAXS-homology/openunits.F | 2 + source/wham/src-M-SAXS-homology/parmread.F | 99 +- .../src-M-SAXS-homology/read_constr_homology.F | 47 +- source/wham/src-M-SAXS-homology/readrtns.F | 9 +- source/wham/src-M-SAXS-homology/wham_calc1.F | 17 +- source/wham/src-M-SAXS-homology/wham_multparm.F | 20 +- source/wham/src-M/CMakeLists.txt | 45 +- source/wham/src-M/COMMON.ALLPARM | 123 +- source/wham/src-M/COMMON.CHAIN | 6 + source/wham/src-M/COMMON.CONTROL | 8 +- source/wham/src-M/COMMON.IOUNITS | 11 +- source/wham/src-M/COMMON.VAR | 5 +- source/wham/src-M/DIMENSIONS | 19 +- source/wham/src-M/DIMENSIONS.FREE | 9 +- source/wham/src-M/DIMENSIONS.ZSCOPT | 6 +- source/wham/src-M/Makefile | 2 +- source/wham/src-M/Makefile-ifort-MPICH | 82 - source/wham/src-M/Makefile-pgi | 74 - source/wham/src-M/Makefile1_jump | 60 - source/wham/src-M/Makefile1_matrix | 73 - source/wham/src-M/Makefile_jubl | 95 - source/wham/src-M/Makefile_jump | 69 - source/wham/src-M/Makefile_matrix | 67 - source/wham/src-M/Makefile_matrix-oldparm | 76 - source/wham/src-M/Makefile_matrix_PGI | 77 - source/wham/src-M/Makefile_matrix_PGI-SCT-oldparm | 76 - source/wham/src-M/Makefile_matrix_PGI-SCTF-oldparm | 76 - source/wham/src-M/Makefile_matrix_PGI-oldparm | 77 - source/wham/src-M/arcos.f | 2 +- source/wham/src-M/cartder.f | 2 +- source/wham/src-M/contact.f | 6 +- source/wham/src-M/cxread.F | 47 +- source/wham/src-M/elecont.f | 59 +- source/wham/src-M/enecalc1.F | 92 +- source/wham/src-M/energy_p_new.F | 5426 ++++++--- source/wham/src-M/geomout.F | 29 +- source/wham/src-M/gnmr1.f | 30 + source/wham/src-M/include_unres/COMMON.CALC | 4 +- source/wham/src-M/include_unres/COMMON.CONTACTS | 9 +- source/wham/src-M/include_unres/COMMON.DERIV | 70 +- source/wham/src-M/include_unres/COMMON.FFIELD | 4 +- source/wham/src-M/include_unres/COMMON.INTERACT | 18 +- source/wham/src-M/include_unres/COMMON.LOCAL | 69 +- source/wham/src-M/include_unres/COMMON.NAMES | 3 +- source/wham/src-M/include_unres/COMMON.SBRIDGE | 25 +- source/wham/src-M/include_unres/COMMON.SCCOR | 26 +- source/wham/src-M/include_unres/COMMON.SCROT | 2 +- source/wham/src-M/include_unres/COMMON.TORCNSTR | 20 +- source/wham/src-M/include_unres/COMMON.TORSION | 71 +- source/wham/src-M/include_unres/COMMON.WEIGHTS | 6 +- source/wham/src-M/initialize_p.F | 248 +- source/wham/src-M/int_from_cart.f | 3 + source/wham/src-M/make_ensemble1.F | 39 +- source/wham/src-M/molread_zs.F | 151 +- source/wham/src-M/openunits.F | 20 +- source/wham/src-M/parmread.F | 1287 +- source/wham/src-M/promienie.f | 2 +- source/wham/src-M/read_dist_constr.F | 26 +- source/wham/src-M/read_ref_str.F | 6 + source/wham/src-M/readpdb.f | 89 +- source/wham/src-M/readrtns.F | 230 +- source/wham/src-M/rescode.f | 4 +- source/wham/src-M/rmscalc.f | 12 +- source/wham/src-M/secondary.f | 4 +- source/wham/src-M/store_parm.F | 351 +- source/wham/src-M/timing.F | 119 +- source/wham/src-M/wham_calc1.F | 752 +- source/wham/src-M/wham_multparm.F | 37 +- source/wham/src-NEWSC-NEWCORR/energy_p_new.F | 214 +- source/wham/src-NEWSC-NEWCORR/parmread.F | 8 +- source/wham/src-NEWSC-NEWCORR/xdrf/Makefile | 27 - source/wham/src-NEWSC-NEWCORR/xdrf/ftocstr.c | 35 - source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4 | 1233 -- source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4.org | 1230 -- source/wham/src-NEWSC-NEWCORR/xdrf/underscore.m4 | 19 - source/wham/src-NEWSC-NEWCORR/xdrf/xdrf.h | 10 - source/wham/src-NEWSC/Makefile | 90 +- source/wham/src-NEWSC/Makefile_MPICH_ifort | 2 +- source/wham/src-NEWSC/energy_p_new.F | 21 +- source/wham/src-NEWSC/xdrf/Makefile | 27 - source/wham/src-NEWSC/xdrf/ftocstr.c | 35 - source/wham/src-NEWSC/xdrf/libxdrf.m4 | 1233 -- source/wham/src-NEWSC/xdrf/libxdrf.m4.org | 1230 -- source/wham/src-NEWSC/xdrf/underscore.m4 | 19 - source/wham/src-NEWSC/xdrf/xdrf.h | 10 - source/wham/src/CMakeLists.txt | 195 +- source/wham/src/COMMON.ALLPARM | 4 +- source/wham/src/DIMENSIONS | 8 +- source/wham/src/DIMENSIONS.FREE | 6 +- source/wham/src/DIMENSIONS.FREE.orig | 14 - source/wham/src/DIMENSIONS.ZSCOPT | 3 +- source/wham/src/DIMENSIONS.orig | 142 - source/wham/src/Makefile-pgi | 74 - source/wham/src/Makefile1_jump | 60 - source/wham/src/Makefile_MPICH_ifort | 56 +- source/wham/src/Makefile_jubl | 95 - source/wham/src/Makefile_jump | 69 - source/wham/src/Makefile_matrix | 67 - source/wham/src/Makefile_matrix_PGI | 76 - source/wham/src/Makefile_matrix_PGI-SCT-oldparm | 76 - source/wham/src/Makefile_matrix_PGI-SCTF-oldparm | 76 - source/wham/src/Makefile_matrix_PGI-oldparm | 76 - source/wham/src/arcos.f | 2 +- source/wham/src/bxread.F | 12 +- source/wham/src/cxread.F | 15 + source/wham/src/cxread.F.orig | 330 - source/wham/src/enecalc1.F | 83 +- source/wham/src/energy_p_new.F | 107 +- source/wham/src/geomout.F | 4 + source/wham/src/include_unres/COMMON.NAMES | 7 - source/wham/src/include_unres/COMMON.SBRIDGE | 19 +- source/wham/src/include_unres/COMMON.SCCOR | 18 +- source/wham/src/include_unres/COMMON.VAR | 21 - source/wham/src/initialize_p.F | 8 +- source/wham/src/make_ensemble1.F | 20 +- source/wham/src/molread_zs.F | 32 + source/wham/src/parmread.F | 81 +- source/wham/src/readrtns.F | 5 + source/wham/src/readrtns.F.orig | 779 -- source/wham/src/store_parm.F | 4 + source/wham/src/wham_calc1.F | 62 +- source/xdrfpdb/src/xdrf/Makefile | 27 - source/xdrfpdb/src/xdrf/Makefile_jubl | 31 - source/xdrfpdb/src/xdrf/Makefile_linux | 27 - source/xdrfpdb/src/xdrf/RS6K.m4 | 20 - source/xdrfpdb/src/xdrf/ftocstr.c | 35 - source/xdrfpdb/src/xdrf/libxdrf.m4 | 1238 -- source/xdrfpdb/src/xdrf/types.h | 99 - source/xdrfpdb/src/xdrf/underscore.m4 | 19 - source/xdrfpdb/src/xdrf/xdr.c | 752 -- source/xdrfpdb/src/xdrf/xdr.h | 379 - source/xdrfpdb/src/xdrf/xdr_array.c | 174 - source/xdrfpdb/src/xdrf/xdr_float.c | 307 - source/xdrfpdb/src/xdrf/xdr_stdio.c | 196 - source/xdrfpdb/src/xdrf/xdrf.h | 10 - 1119 files changed, 26229 insertions(+), 356248 deletions(-) delete mode 100644 PARAM/rotamers_AM1_aura.10022007.ext.parm delete mode 100755 PARAM/sc2scext delete mode 100644 PARAM/sc2scext.f delete mode 100644 PARAM/scparm.adam_30_10_2013 delete mode 100644 source/cluster/wham/src-M/COMMON.CONTACTS delete mode 100644 source/cluster/wham/src-M/COMMON.DERIV delete mode 100644 source/cluster/wham/src-M/COMMON.LOCAL delete mode 100644 source/cluster/wham/src-M/COMMON.TORSION delete mode 100644 source/cluster/wham/src-M/Makefile-MPI delete mode 100644 source/cluster/wham/src-M/Makefile-MPI-INTEL delete mode 100644 source/cluster/wham/src-M/Makefile-MPI-INTEL-old delete mode 100644 source/cluster/wham/src-M/Makefile-MPI-opteron delete mode 100644 source/cluster/wham/src-M/Makefile-MPI-opteron-old delete mode 100644 source/cluster/wham/src-M/Makefile-MPI-w-opteron delete mode 100644 source/cluster/wham/src-M/include_unres/COMMON.NAMES delete mode 100644 source/cluster/wham/src-M/obackup/arcos.o delete mode 100644 source/cluster/wham/src-M/obackup/cartprint.o delete mode 100644 source/cluster/wham/src-M/obackup/chainbuild.o delete mode 100644 source/cluster/wham/src-M/obackup/contact.o delete mode 100644 source/cluster/wham/src-M/obackup/convert.o delete mode 100644 source/cluster/wham/src-M/obackup/energy_p_new.o delete mode 100644 source/cluster/wham/src-M/obackup/fitsq.o delete mode 100644 source/cluster/wham/src-M/obackup/geomout.o delete mode 100644 source/cluster/wham/src-M/obackup/gnmr1.o delete mode 100644 source/cluster/wham/src-M/obackup/hc.o delete mode 100644 source/cluster/wham/src-M/obackup/icant.o delete mode 100644 source/cluster/wham/src-M/obackup/initialize_p.o delete mode 100644 source/cluster/wham/src-M/obackup/int_from_cart1.o delete mode 100644 source/cluster/wham/src-M/obackup/intcor.o delete mode 100644 source/cluster/wham/src-M/obackup/main_clust.o delete mode 100644 source/cluster/wham/src-M/obackup/matmult.o delete mode 100644 source/cluster/wham/src-M/obackup/misc.o delete mode 100644 source/cluster/wham/src-M/obackup/noyes.o delete mode 100644 source/cluster/wham/src-M/obackup/parmread.o delete mode 100644 source/cluster/wham/src-M/obackup/permut.o delete mode 100644 source/cluster/wham/src-M/obackup/pinorm.o delete mode 100644 source/cluster/wham/src-M/obackup/printmat.o delete mode 100644 source/cluster/wham/src-M/obackup/probabl.o delete mode 100644 source/cluster/wham/src-M/obackup/proc_proc.o delete mode 100644 source/cluster/wham/src-M/obackup/read_coords.o delete mode 100644 source/cluster/wham/src-M/obackup/read_ref_str.o delete mode 100644 source/cluster/wham/src-M/obackup/readpdb.o delete mode 100644 source/cluster/wham/src-M/obackup/readrtns.o delete mode 100644 source/cluster/wham/src-M/obackup/rescode.o delete mode 100644 source/cluster/wham/src-M/obackup/setup_var.o delete mode 100644 source/cluster/wham/src-M/obackup/srtclust.o delete mode 100644 source/cluster/wham/src-M/obackup/timing.o delete mode 100644 source/cluster/wham/src-M/obackup/track.o delete mode 100644 source/cluster/wham/src-M/obackup/work_partition.o delete mode 100644 source/cluster/wham/src-M/obackup/wrtclust.o delete mode 100644 source/cluster/wham/src-M/xdrf/Makefile delete mode 100644 source/cluster/wham/src-M/xdrf/Makefile_jubl delete mode 100644 source/cluster/wham/src-M/xdrf/Makefile_linux delete mode 100644 source/cluster/wham/src-M/xdrf/RS6K.m4 delete mode 100644 source/cluster/wham/src-M/xdrf/ftocstr.c delete mode 100644 source/cluster/wham/src-M/xdrf/libxdrf.m4 delete mode 100644 source/cluster/wham/src-M/xdrf/types.h delete mode 100644 source/cluster/wham/src-M/xdrf/underscore.m4 delete mode 100644 source/cluster/wham/src-M/xdrf/xdr.c delete mode 100644 source/cluster/wham/src-M/xdrf/xdr.h delete mode 100644 source/cluster/wham/src-M/xdrf/xdr_array.c delete mode 100644 source/cluster/wham/src-M/xdrf/xdr_float.c delete mode 100644 source/cluster/wham/src-M/xdrf/xdr_stdio.c delete mode 100644 source/cluster/wham/src-M/xdrf/xdrf.h delete mode 100644 source/cluster/wham/src/include_unres/COMMON.CONTACTS delete mode 100644 source/cluster/wham/src/include_unres/COMMON.FFIELD delete mode 100644 source/cluster/wham/src/include_unres/COMMON.NAMES delete mode 100644 source/cluster/wham/src/include_unres/COMMON.SCCOR delete mode 100644 source/cluster/wham/src/xdrf/Makefile delete mode 100644 source/cluster/wham/src/xdrf/Makefile_jubl delete mode 100644 source/cluster/wham/src/xdrf/Makefile_linux delete mode 100644 source/cluster/wham/src/xdrf/RS6K.m4 delete mode 100644 source/cluster/wham/src/xdrf/ftocstr.c delete mode 100644 source/cluster/wham/src/xdrf/libxdrf.m4 delete mode 100644 source/cluster/wham/src/xdrf/types.h delete mode 100644 source/cluster/wham/src/xdrf/underscore.m4 delete mode 100644 source/cluster/wham/src/xdrf/xdr.c delete mode 100644 source/cluster/wham/src/xdrf/xdr.h delete mode 100644 source/cluster/wham/src/xdrf/xdr_array.c delete mode 100644 source/cluster/wham/src/xdrf/xdr_float.c delete mode 100644 source/cluster/wham/src/xdrf/xdr_stdio.c delete mode 100644 source/cluster/wham/src/xdrf/xdrf.h mode change 100755 => 100644 source/pymol/UNRESInpGen.py delete mode 100644 source/unres/src_CSA/Makefile-DFA-NEWPARM.kias delete mode 100644 source/unres/src_CSA/Makefile-DFA-NEWPARM.piasek delete mode 100644 source/unres/src_CSA/Makefile-DFA-OLDPARM.galera delete mode 100644 source/unres/src_CSA/Makefile-DFA-OLDPARM.gfortran delete mode 100644 source/unres/src_CSA/Makefile-DFA-OLDPARM.kias delete mode 100644 source/unres/src_CSA/Makefile-DFA-OLDPARM.piasek delete mode 100644 source/unres/src_CSA/Makefile-single_4P delete mode 100644 source/unres/src_CSA/Makefile_4P delete mode 100644 source/unres/src_CSA/Makefile_CASP3 delete mode 100644 source/unres/src_CSA/csa.f delete mode 100644 source/unres/src_CSA_DiL/COMMON.BANK delete mode 100644 source/unres/src_CSA_DiL/COMMON.BOUNDS delete mode 100644 source/unres/src_CSA_DiL/COMMON.CALC delete mode 100644 source/unres/src_CSA_DiL/COMMON.CHAIN delete mode 100644 source/unres/src_CSA_DiL/COMMON.CONTACTS delete mode 100644 source/unres/src_CSA_DiL/COMMON.CONTACTS.MOMENT delete mode 100644 source/unres/src_CSA_DiL/COMMON.CONTROL delete mode 100644 source/unres/src_CSA_DiL/COMMON.CSA delete mode 100644 source/unres/src_CSA_DiL/COMMON.DERIV delete mode 100644 source/unres/src_CSA_DiL/COMMON.DFA delete mode 100644 source/unres/src_CSA_DiL/COMMON.DISTFIT delete mode 100644 source/unres/src_CSA_DiL/COMMON.FFIELD delete mode 100644 source/unres/src_CSA_DiL/COMMON.GEO delete mode 100644 source/unres/src_CSA_DiL/COMMON.HAIRPIN delete mode 100644 source/unres/src_CSA_DiL/COMMON.HEADER delete mode 100644 source/unres/src_CSA_DiL/COMMON.INFO delete mode 100644 source/unres/src_CSA_DiL/COMMON.INTERACT delete mode 100644 source/unres/src_CSA_DiL/COMMON.IOUNITS delete mode 100644 source/unres/src_CSA_DiL/COMMON.LOCAL delete mode 100644 source/unres/src_CSA_DiL/COMMON.LOCMOVE delete mode 100644 source/unres/src_CSA_DiL/COMMON.MAXGRAD delete mode 100644 source/unres/src_CSA_DiL/COMMON.MCM delete mode 100644 source/unres/src_CSA_DiL/COMMON.MD_ delete mode 100644 source/unres/src_CSA_DiL/COMMON.MINIM delete mode 100644 source/unres/src_CSA_DiL/COMMON.NAMES delete mode 100644 source/unres/src_CSA_DiL/COMMON.SBRIDGE delete mode 100644 source/unres/src_CSA_DiL/COMMON.SCCOR delete mode 100644 source/unres/src_CSA_DiL/COMMON.SCROT delete mode 100644 source/unres/src_CSA_DiL/COMMON.SETUP delete mode 100644 source/unres/src_CSA_DiL/COMMON.SPLITELE delete mode 100644 source/unres/src_CSA_DiL/COMMON.THREAD delete mode 100644 source/unres/src_CSA_DiL/COMMON.TIME1 delete mode 100644 source/unres/src_CSA_DiL/COMMON.TORCNSTR delete mode 100644 source/unres/src_CSA_DiL/COMMON.TORSION delete mode 100644 source/unres/src_CSA_DiL/COMMON.VAR delete mode 100644 source/unres/src_CSA_DiL/COMMON.VECTORS delete mode 100644 source/unres/src_CSA_DiL/DIMENSIONS delete mode 100644 source/unres/src_CSA_DiL/MP.F delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.kias delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.matrix delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.piasek delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.galera delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.gfortran delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.kias delete mode 100644 source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.piasek delete mode 100644 source/unres/src_CSA_DiL/Makefile-single_4P delete mode 100644 source/unres/src_CSA_DiL/Makefile_4P delete mode 100644 source/unres/src_CSA_DiL/Makefile_CASP3 delete mode 100644 source/unres/src_CSA_DiL/README.Juyong delete mode 100644 source/unres/src_CSA_DiL/TMscore_subroutine.f delete mode 100644 source/unres/src_CSA_DiL/arcos.f delete mode 100644 source/unres/src_CSA_DiL/banach.f delete mode 100644 source/unres/src_CSA_DiL/bank.F delete mode 100644 source/unres/src_CSA_DiL/cartder.F delete mode 100644 source/unres/src_CSA_DiL/cartprint.f delete mode 100644 source/unres/src_CSA_DiL/chainbuild.F delete mode 100644 source/unres/src_CSA_DiL/checkder_p.F delete mode 100644 source/unres/src_CSA_DiL/cinfo.f delete mode 100644 source/unres/src_CSA_DiL/compinfo.c delete mode 100644 source/unres/src_CSA_DiL/contact.f delete mode 100644 source/unres/src_CSA_DiL/convert.f delete mode 100644 source/unres/src_CSA_DiL/cored.f delete mode 100644 source/unres/src_CSA_DiL/csa.f delete mode 100644 source/unres/src_CSA_DiL/dfa.F delete mode 100644 source/unres/src_CSA_DiL/diff12.f delete mode 100644 source/unres/src_CSA_DiL/distfit.f delete mode 100644 source/unres/src_CSA_DiL/djacob.f delete mode 100644 source/unres/src_CSA_DiL/econstr_local.F delete mode 100644 source/unres/src_CSA_DiL/elecont.f delete mode 100644 source/unres/src_CSA_DiL/energy_p_new_barrier.F delete mode 100644 source/unres/src_CSA_DiL/fitsq.f delete mode 100644 source/unres/src_CSA_DiL/gen_rand_conf.F delete mode 100644 source/unres/src_CSA_DiL/geomout_min.F delete mode 100644 source/unres/src_CSA_DiL/gradient_p.F delete mode 100644 source/unres/src_CSA_DiL/indexx.f delete mode 100644 source/unres/src_CSA_DiL/initialize_p.F delete mode 100644 source/unres/src_CSA_DiL/int_to_cart.f delete mode 100644 source/unres/src_CSA_DiL/intcartderiv.F delete mode 100644 source/unres/src_CSA_DiL/intcor.f delete mode 100644 source/unres/src_CSA_DiL/intlocal.f delete mode 100644 source/unres/src_CSA_DiL/local_move.f delete mode 100644 source/unres/src_CSA_DiL/matmult.f delete mode 100644 source/unres/src_CSA_DiL/minim_jlee.F delete mode 100644 source/unres/src_CSA_DiL/minim_mult.F delete mode 100644 source/unres/src_CSA_DiL/minimize_p.F delete mode 100644 source/unres/src_CSA_DiL/misc.f delete mode 100644 source/unres/src_CSA_DiL/newconf.F delete mode 100644 source/unres/src_CSA_DiL/parmread.F delete mode 100644 source/unres/src_CSA_DiL/pinorm.f delete mode 100644 source/unres/src_CSA_DiL/printmat.f delete mode 100644 source/unres/src_CSA_DiL/prng_32.F delete mode 100644 source/unres/src_CSA_DiL/ran.f delete mode 100644 source/unres/src_CSA_DiL/randgens.f delete mode 100644 source/unres/src_CSA_DiL/readpdb.F delete mode 100644 source/unres/src_CSA_DiL/readrtns_csa.F delete mode 100644 source/unres/src_CSA_DiL/refsys.f delete mode 100644 source/unres/src_CSA_DiL/rescode.f delete mode 100644 source/unres/src_CSA_DiL/rmdd.f delete mode 100644 source/unres/src_CSA_DiL/rmsd.F delete mode 100644 source/unres/src_CSA_DiL/sc_move.F delete mode 100644 source/unres/src_CSA_DiL/shift.F delete mode 100644 source/unres/src_CSA_DiL/sumsld.f delete mode 100644 source/unres/src_CSA_DiL/test.F delete mode 100644 source/unres/src_CSA_DiL/timing.F delete mode 100644 source/unres/src_CSA_DiL/together.F delete mode 100644 source/unres/src_CSA_DiL/unres_csa.F delete mode 100644 source/unres/src_Eshel/readpdb.F.safe delete mode 100644 source/unres/src_MD-DFA-restraints/CMakeLists.txt delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.BOUNDS delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CACHE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CALC delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CHAIN delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CONTACTS delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CONTACTS.moment delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.CONTROL delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.DBASE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.DERIV delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.DFA delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.DISTFIT delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.FFIELD delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.GEO delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.HAIRPIN delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.HEADER delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.INFO delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.INTERACT delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.IOUNITS delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN.lang0 delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.LOCAL delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.LOCMOVE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MAP delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MAXGRAD delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MCE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MCM delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MD delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MINIM delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.MUCA delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.NAMES delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.REMD delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.SBRIDGE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.SCCOR delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.SCROT delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.SETUP delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.SPLITELE delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.THREAD delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.TIME1 delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.TORCNSTR delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.TORSION delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.VAR delete mode 100644 source/unres/src_MD-DFA-restraints/COMMON.VECTORS delete mode 100644 source/unres/src_MD-DFA-restraints/DIMENSIONS delete mode 100644 source/unres/src_MD-DFA-restraints/DIMENSIONS.2100 delete mode 100644 source/unres/src_MD-DFA-restraints/DIMENSIONS.4100 delete mode 100644 source/unres/src_MD-DFA-restraints/MD_A-MTS.F delete mode 100644 source/unres/src_MD-DFA-restraints/MP.F delete mode 100644 source/unres/src_MD-DFA-restraints/MREMD.F delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile-intrepid-with-tau delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile.tau-mpi-f77-pdt delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_MPICH_PGI delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_MPICH_ifort delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_aix_xlf delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_bigben delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_bigben-oldparm delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_bigben-tau delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_galera delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_intrepid delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_single_gfortran delete mode 100644 source/unres/src_MD-DFA-restraints/Makefile_single_ifort delete mode 100644 source/unres/src_MD-DFA-restraints/README delete mode 100644 source/unres/src_MD-DFA-restraints/add.f delete mode 100644 source/unres/src_MD-DFA-restraints/arcos.f delete mode 100644 source/unres/src_MD-DFA-restraints/banach.f delete mode 100644 source/unres/src_MD-DFA-restraints/blas.f delete mode 100644 source/unres/src_MD-DFA-restraints/bond_move.f delete mode 100644 source/unres/src_MD-DFA-restraints/build.txt delete mode 100644 source/unres/src_MD-DFA-restraints/cartder.F delete mode 100644 source/unres/src_MD-DFA-restraints/cartprint.f delete mode 100644 source/unres/src_MD-DFA-restraints/chainbuild.F delete mode 100644 source/unres/src_MD-DFA-restraints/change.awk delete mode 100644 source/unres/src_MD-DFA-restraints/check_bond.f delete mode 100644 source/unres/src_MD-DFA-restraints/check_sc_distr.f delete mode 100644 source/unres/src_MD-DFA-restraints/checkder_p.F delete mode 100644 source/unres/src_MD-DFA-restraints/compare_s1.F delete mode 100644 source/unres/src_MD-DFA-restraints/compinfo.c delete mode 100644 source/unres/src_MD-DFA-restraints/contact.f delete mode 100644 source/unres/src_MD-DFA-restraints/convert.f delete mode 100644 source/unres/src_MD-DFA-restraints/cored.f delete mode 100644 source/unres/src_MD-DFA-restraints/dfa.F delete mode 100644 source/unres/src_MD-DFA-restraints/dihed_cons.F delete mode 100644 source/unres/src_MD-DFA-restraints/djacob.f delete mode 100644 source/unres/src_MD-DFA-restraints/econstr_local.F delete mode 100644 source/unres/src_MD-DFA-restraints/eigen.f delete mode 100644 source/unres/src_MD-DFA-restraints/elecont.f delete mode 100644 source/unres/src_MD-DFA-restraints/energy_p_new-sep_barrier.F delete mode 100644 source/unres/src_MD-DFA-restraints/energy_p_new_barrier.F delete mode 100644 source/unres/src_MD-DFA-restraints/energy_split-sep.F delete mode 100644 source/unres/src_MD-DFA-restraints/entmcm.F delete mode 100644 source/unres/src_MD-DFA-restraints/fitsq.f delete mode 100644 source/unres/src_MD-DFA-restraints/gauss.f delete mode 100644 source/unres/src_MD-DFA-restraints/gen_rand_conf.F delete mode 100644 source/unres/src_MD-DFA-restraints/geomout.F delete mode 100644 source/unres/src_MD-DFA-restraints/gnmr1.f delete mode 100644 source/unres/src_MD-DFA-restraints/gradient_p.F delete mode 100644 source/unres/src_MD-DFA-restraints/initialize_p.F delete mode 100644 source/unres/src_MD-DFA-restraints/int_to_cart.f delete mode 100644 source/unres/src_MD-DFA-restraints/intcartderiv.F delete mode 100644 source/unres/src_MD-DFA-restraints/intcor.f delete mode 100644 source/unres/src_MD-DFA-restraints/intlocal.f delete mode 100644 source/unres/src_MD-DFA-restraints/kinetic_lesyng.f delete mode 100644 source/unres/src_MD-DFA-restraints/lagrangian_lesyng.F delete mode 100644 source/unres/src_MD-DFA-restraints/local_move.f delete mode 100644 source/unres/src_MD-DFA-restraints/map.f delete mode 100644 source/unres/src_MD-DFA-restraints/matmult.f delete mode 100644 source/unres/src_MD-DFA-restraints/mc.F delete mode 100644 source/unres/src_MD-DFA-restraints/mcm.F delete mode 100644 source/unres/src_MD-DFA-restraints/minim_mcmf.F delete mode 100644 source/unres/src_MD-DFA-restraints/minimize_p.F delete mode 100644 source/unres/src_MD-DFA-restraints/misc.f delete mode 100644 source/unres/src_MD-DFA-restraints/moments.f delete mode 100644 source/unres/src_MD-DFA-restraints/muca_md.f delete mode 100644 source/unres/src_MD-DFA-restraints/parmread.F delete mode 100644 source/unres/src_MD-DFA-restraints/pinorm.f delete mode 100644 source/unres/src_MD-DFA-restraints/printmat.f delete mode 100644 source/unres/src_MD-DFA-restraints/prng.f delete mode 100644 source/unres/src_MD-DFA-restraints/prng_32.F delete mode 100644 source/unres/src_MD-DFA-restraints/proc_proc.c delete mode 100644 source/unres/src_MD-DFA-restraints/q_measure.F delete mode 100644 source/unres/src_MD-DFA-restraints/q_measure1.F delete mode 100644 source/unres/src_MD-DFA-restraints/q_measure3.F delete mode 100644 source/unres/src_MD-DFA-restraints/randgens.f delete mode 100644 source/unres/src_MD-DFA-restraints/rattle.F delete mode 100644 source/unres/src_MD-DFA-restraints/readpdb.F delete mode 100644 source/unres/src_MD-DFA-restraints/readrtns.F delete mode 100644 source/unres/src_MD-DFA-restraints/refsys.f delete mode 100644 source/unres/src_MD-DFA-restraints/regularize.F delete mode 100644 source/unres/src_MD-DFA-restraints/rescode.f delete mode 100644 source/unres/src_MD-DFA-restraints/rmdd.f delete mode 100644 source/unres/src_MD-DFA-restraints/rmsd.F delete mode 100644 source/unres/src_MD-DFA-restraints/sc_move.F delete mode 100644 source/unres/src_MD-DFA-restraints/sizes.i delete mode 100644 source/unres/src_MD-DFA-restraints/sort.f delete mode 100644 source/unres/src_MD-DFA-restraints/ssMD.F delete mode 100644 source/unres/src_MD-DFA-restraints/stochfric.F delete mode 100644 source/unres/src_MD-DFA-restraints/sumsld.f delete mode 100644 source/unres/src_MD-DFA-restraints/surfatom.f delete mode 100644 source/unres/src_MD-DFA-restraints/test.F delete mode 100644 source/unres/src_MD-DFA-restraints/thread.F delete mode 100644 source/unres/src_MD-DFA-restraints/timing.F delete mode 100644 source/unres/src_MD-DFA-restraints/unres.F delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/CMakeLists.txt delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/Makefile delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/Makefile_jubl delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/Makefile_linux delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/RS6K.m4 delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/ftocstr.c delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/libxdrf.m4 delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/types.h delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/underscore.m4 delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdr.c delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdr.h delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdr_array.c delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdr_float.c delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdr_stdio.c delete mode 100644 source/unres/src_MD-DFA-restraints/xdrf/xdrf.h delete mode 100644 source/unres/src_MD-M-SAXS-homology/COMMON.CONTACTS_safe1 delete mode 100644 source/unres/src_MD-M-SAXS-homology/COMMON.DERIV_safe delete mode 100644 source/unres/src_MD-M-SAXS-homology/DIMENSIONS_safe1 delete mode 100644 source/unres/src_MD-M-SAXS-homology/MD.F delete mode 100644 source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe delete mode 100644 source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe1 delete mode 100644 source/unres/src_MD-M-SAXS-homology/MREMD.F.safe delete mode 100644 source/unres/src_MD-M-SAXS-homology/energy_p_new.F delete mode 100644 source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F.safe delete mode 100644 source/unres/src_MD-M-SAXS-homology/energy_split.F delete mode 100644 source/unres/src_MD-M-SAXS-homology/parmread.F.safe delete mode 100644 source/unres/src_MD-M-SAXS-homology/readpdb.F.safe delete mode 120000 source/unres/src_MD-M-SAXS-homology/xdrf delete mode 100644 source/unres/src_MD-M/CMakeCache.txt delete mode 100644 source/unres/src_MD-M/CMakeFiles/CMakeCCompiler.cmake delete mode 100644 source/unres/src_MD-M/CMakeFiles/CMakeCXXCompiler.cmake delete mode 100755 source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_C.bin delete mode 100755 source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_CXX.bin delete mode 100755 source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_Fortran.bin delete mode 100644 source/unres/src_MD-M/CMakeFiles/CMakeFortranCompiler.cmake delete mode 100644 source/unres/src_MD-M/CMakeFiles/CMakeOutput.log delete mode 100644 source/unres/src_MD-M/CMakeFiles/CMakeSystem.cmake delete mode 100644 source/unres/src_MD-M/CMakeFiles/CompilerIdC/CMakeCCompilerId.c delete mode 100755 source/unres/src_MD-M/CMakeFiles/CompilerIdC/a.out delete mode 100644 source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/CMakeCXXCompilerId.cpp delete mode 100755 source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/a.out delete mode 100644 source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/CMakeFortranCompilerId.F delete mode 100755 source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/a.out delete mode 100644 source/unres/src_MD-M/CMakeFiles/cmake.check_cache mode change 100644 => 120000 source/unres/src_MD-M/Makefile delete mode 100644 source/unres/src_MD-M/Makefile-biosim delete mode 100644 source/unres/src_MD-M/Makefile-intrepid-with-tau delete mode 100644 source/unres/src_MD-M/Makefile-matrix-intel delete mode 100644 source/unres/src_MD-M/Makefile-matrix3 delete mode 100644 source/unres/src_MD-M/Makefile-matrix3-oldparm delete mode 100644 source/unres/src_MD-M/Makefile-oldparm delete mode 100644 source/unres/src_MD-M/Makefile-rstconv delete mode 100644 source/unres/src_MD-M/Makefile-tau-temp delete mode 100644 source/unres/src_MD-M/Makefile.tau-mpi-f77-pdt delete mode 100755 source/unres/src_MD-M/Makefile.tau-mpi-pdt-pgi.org delete mode 100644 source/unres/src_MD-M/Makefile_aix_xlf delete mode 100644 source/unres/src_MD-M/Makefile_bigben delete mode 100644 source/unres/src_MD-M/Makefile_bigben-oldparm delete mode 100644 source/unres/src_MD-M/Makefile_bigben-tau delete mode 100644 source/unres/src_MD-M/Makefile_intrepid delete mode 100644 source/unres/src_MD-M/Makefile_jubl delete mode 100644 source/unres/src_MD-M/Makefile_jubl-debug delete mode 100644 source/unres/src_MD-M/Makefile_jubl-opt delete mode 100644 source/unres/src_MD-M/Makefile_jubl-opt-oldparm delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc10_em64 delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera-oldparm delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc10_em64_mpi2 delete mode 100644 source/unres/src_MD-M/Makefile_lnx_ifc8 delete mode 100644 source/unres/src_MD-M/Makefile_lnx_pgf90 delete mode 100644 source/unres/src_MD-M/Makefile_osf_f90 delete mode 100644 source/unres/src_MD-M/Makefile_win_ifl delete mode 100644 source/unres/src_MD-M/Makefile_win_pgf90 delete mode 100644 source/unres/src_MD-M/bigsymbols-lang0.txt delete mode 100644 source/unres/src_MD-M/change.awk delete mode 100644 source/unres/src_MD-M/load.map delete mode 100644 source/unres/src_MD-M/load.map-lang0 delete mode 100644 source/unres/src_MD-M/loadmap.2400 delete mode 100644 source/unres/src_MD-M/module.log delete mode 100644 source/unres/src_MD-M/objects.sizes delete mode 100644 source/unres/src_MD-M/pdtf5579.pdb delete mode 100644 source/unres/src_MD-M/prng.f delete mode 100644 source/unres/src_MD-M/readpdb.f.safe delete mode 100644 source/unres/src_MD-M/symbols-lang0.txt delete mode 100644 source/unres/src_MD-M/symbolsizes.txt delete mode 100644 source/unres/src_MD-NEWSC-NEWC/CMakeLists.txt delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.BOUNDS delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CACHE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CALC delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CHAIN delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CONTACTS delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CONTACTS.moment delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.CONTROL delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.DBASE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.DERIV delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.DISTFIT delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.EMP delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.FFIELD delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.GEO delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.HAIRPIN delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.HEADER delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.INFO delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.INTERACT delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.IOUNITS delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.LANGEVIN delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.LANGEVIN.lang0 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.LOCAL delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.LOCMOVE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MAP delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MAXGRAD delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MCE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MCM delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MD delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MINIM delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.MUCA delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.NAMES delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.REMD delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.SBRIDGE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.SCCOR delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.SCROT delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.SETUP delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.SPLITELE delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.THREAD delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.TIME1 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.TORCNSTR delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.TORSION delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.VAR delete mode 100644 source/unres/src_MD-NEWSC-NEWC/COMMON.VECTORS delete mode 100644 source/unres/src_MD-NEWSC-NEWC/DIMENSIONS delete mode 100644 source/unres/src_MD-NEWSC-NEWC/DIMENSIONS.2100 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/DIMENSIONS.4100 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/MD_A-MTS.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/MP.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/MREMD.F delete mode 120000 source/unres/src_MD-NEWSC-NEWC/Makefile delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile-intrepid-with-tau delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile.tau-mpi-f77-pdt delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_MPICH_ifort delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_MPICH_ifort_09_05_2013 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_aix_xlf delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_bigben delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_bigben-oldparm delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_bigben-tau delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_galera delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_gitdefault delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_intrepid delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_single_gfortran delete mode 100644 source/unres/src_MD-NEWSC-NEWC/Makefile_single_ifort delete mode 100644 source/unres/src_MD-NEWSC-NEWC/README delete mode 100644 source/unres/src_MD-NEWSC-NEWC/add.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/arcos.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/banach.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/blas.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/bond_move.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/build.txt delete mode 100644 source/unres/src_MD-NEWSC-NEWC/cartder.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/cartprint.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/chainbuild.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/change.awk delete mode 100644 source/unres/src_MD-NEWSC-NEWC/check_bond.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/check_sc_distr.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/checkder_p.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/compare_s1.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/compinfo.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/contact.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/convert.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/cored.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/dihed_cons.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/djacob.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/econstr_local.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/eigen.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/elecont.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/energy_p_new-sep_barrier.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier_v3ok1.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/energy_split-sep.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/entmcm.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/fitsq.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/gauss.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/gen_rand_conf.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/geomout.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/gnmr1.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/gradient_p.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/initialize_p.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/int_to_cart.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/intcartderiv.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/intcor.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/intlocal.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/kinetic_lesyng.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/lagrangian_lesyng.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/local_move.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/map.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/matmult.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/mc.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/mcm.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/minim_mcmf.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/minimize_p.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/misc.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/moments.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/muca_md.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/parmread.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/parmread_v3ok1.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/pinorm.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/printmat.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/prng.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/prng_32.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/proc_proc.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/q_measure.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/q_measure1.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/q_measure3.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/randgens.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/rattle.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/readpdb.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/readrtns.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/refsys.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/regularize.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/rescode.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/rmdd.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/rmsd.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/sc_move.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/sizes.i delete mode 100644 source/unres/src_MD-NEWSC-NEWC/sort.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/ssMD.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/stochfric.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/sumsld.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/surfatom.f delete mode 100644 source/unres/src_MD-NEWSC-NEWC/test.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/thread.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/timing.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/unres.F delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/CMakeLists.txt delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_jubl delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_linux delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/RS6K.m4 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/ftocstr.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/libxdrf.m4 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/types.h delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/underscore.m4 delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.h delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_array.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_float.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_stdio.c delete mode 100644 source/unres/src_MD-NEWSC-NEWC/xdrf/xdrf.h delete mode 100644 source/unres/src_MD-restraints/CMakeLists.txt delete mode 100644 source/unres/src_MD-restraints/COMMON.BOUNDS delete mode 100644 source/unres/src_MD-restraints/COMMON.CACHE delete mode 100644 source/unres/src_MD-restraints/COMMON.CALC delete mode 100644 source/unres/src_MD-restraints/COMMON.CHAIN delete mode 100644 source/unres/src_MD-restraints/COMMON.CONTACTS delete mode 100644 source/unres/src_MD-restraints/COMMON.CONTACTS.moment delete mode 100644 source/unres/src_MD-restraints/COMMON.CONTROL delete mode 100644 source/unres/src_MD-restraints/COMMON.DBASE delete mode 100644 source/unres/src_MD-restraints/COMMON.DERIV delete mode 100644 source/unres/src_MD-restraints/COMMON.DISTFIT delete mode 100644 source/unres/src_MD-restraints/COMMON.FFIELD delete mode 100644 source/unres/src_MD-restraints/COMMON.GEO delete mode 100644 source/unres/src_MD-restraints/COMMON.HAIRPIN delete mode 100644 source/unres/src_MD-restraints/COMMON.HEADER delete mode 100644 source/unres/src_MD-restraints/COMMON.INFO delete mode 100644 source/unres/src_MD-restraints/COMMON.INTERACT delete mode 100644 source/unres/src_MD-restraints/COMMON.IOUNITS delete mode 100644 source/unres/src_MD-restraints/COMMON.LANGEVIN delete mode 100644 source/unres/src_MD-restraints/COMMON.LANGEVIN.lang0 delete mode 100644 source/unres/src_MD-restraints/COMMON.LOCAL delete mode 100644 source/unres/src_MD-restraints/COMMON.LOCMOVE delete mode 100644 source/unres/src_MD-restraints/COMMON.MAP delete mode 100644 source/unres/src_MD-restraints/COMMON.MAXGRAD delete mode 100644 source/unres/src_MD-restraints/COMMON.MCE delete mode 100644 source/unres/src_MD-restraints/COMMON.MCM delete mode 100644 source/unres/src_MD-restraints/COMMON.MD delete mode 100644 source/unres/src_MD-restraints/COMMON.MINIM delete mode 100644 source/unres/src_MD-restraints/COMMON.MUCA delete mode 100644 source/unres/src_MD-restraints/COMMON.NAMES delete mode 100644 source/unres/src_MD-restraints/COMMON.REMD delete mode 100644 source/unres/src_MD-restraints/COMMON.SBRIDGE delete mode 100644 source/unres/src_MD-restraints/COMMON.SCCOR delete mode 100644 source/unres/src_MD-restraints/COMMON.SCROT delete mode 100644 source/unres/src_MD-restraints/COMMON.SETUP delete mode 100644 source/unres/src_MD-restraints/COMMON.SPLITELE delete mode 100644 source/unres/src_MD-restraints/COMMON.THREAD delete mode 100644 source/unres/src_MD-restraints/COMMON.TIME1 delete mode 100644 source/unres/src_MD-restraints/COMMON.TORCNSTR delete mode 100644 source/unres/src_MD-restraints/COMMON.TORSION delete mode 100644 source/unres/src_MD-restraints/COMMON.VAR delete mode 100644 source/unres/src_MD-restraints/COMMON.VECTORS delete mode 100644 source/unres/src_MD-restraints/DIMENSIONS delete mode 100644 source/unres/src_MD-restraints/DIMENSIONS.2100 delete mode 100644 source/unres/src_MD-restraints/DIMENSIONS.4100 delete mode 100644 source/unres/src_MD-restraints/MD_A-MTS.F delete mode 100644 source/unres/src_MD-restraints/MP.F delete mode 100644 source/unres/src_MD-restraints/MREMD.F delete mode 120000 source/unres/src_MD-restraints/Makefile delete mode 100644 source/unres/src_MD-restraints/Makefile-intrepid-with-tau delete mode 100644 source/unres/src_MD-restraints/Makefile.tau-mpi-f77-pdt delete mode 100644 source/unres/src_MD-restraints/Makefile_MPICH_PGI delete mode 100644 source/unres/src_MD-restraints/Makefile_MPICH_ifort delete mode 100644 source/unres/src_MD-restraints/Makefile_aix_xlf delete mode 100644 source/unres/src_MD-restraints/Makefile_bigben delete mode 100644 source/unres/src_MD-restraints/Makefile_bigben-oldparm delete mode 100644 source/unres/src_MD-restraints/Makefile_bigben-tau delete mode 100644 source/unres/src_MD-restraints/Makefile_galera delete mode 100644 source/unres/src_MD-restraints/Makefile_intrepid delete mode 100644 source/unres/src_MD-restraints/Makefile_nostromo delete mode 100644 source/unres/src_MD-restraints/Makefile_single_gfortran delete mode 100644 source/unres/src_MD-restraints/Makefile_single_ifort delete mode 100644 source/unres/src_MD-restraints/README delete mode 100644 source/unres/src_MD-restraints/add.f delete mode 100644 source/unres/src_MD-restraints/arcos.f delete mode 100644 source/unres/src_MD-restraints/banach.f delete mode 100644 source/unres/src_MD-restraints/blas.f delete mode 100644 source/unres/src_MD-restraints/bond_move.f delete mode 100644 source/unres/src_MD-restraints/build.txt delete mode 100644 source/unres/src_MD-restraints/cartder.F delete mode 100644 source/unres/src_MD-restraints/cartprint.f delete mode 100644 source/unres/src_MD-restraints/chainbuild.F delete mode 100644 source/unres/src_MD-restraints/change.awk delete mode 100644 source/unres/src_MD-restraints/check_bond.f delete mode 100644 source/unres/src_MD-restraints/check_sc_distr.f delete mode 100644 source/unres/src_MD-restraints/checkder_p.F delete mode 100644 source/unres/src_MD-restraints/compare_s1.F delete mode 100644 source/unres/src_MD-restraints/compinfo.c delete mode 100644 source/unres/src_MD-restraints/contact.f delete mode 100644 source/unres/src_MD-restraints/convert.f delete mode 100644 source/unres/src_MD-restraints/cored.f delete mode 100644 source/unres/src_MD-restraints/dihed_cons.F delete mode 100644 source/unres/src_MD-restraints/djacob.f delete mode 100644 source/unres/src_MD-restraints/econstr_local.F delete mode 100644 source/unres/src_MD-restraints/eigen.f delete mode 100644 source/unres/src_MD-restraints/elecont.f delete mode 100644 source/unres/src_MD-restraints/energy_p_new-sep_barrier.F delete mode 100644 source/unres/src_MD-restraints/energy_p_new_barrier.F delete mode 100644 source/unres/src_MD-restraints/energy_split-sep.F delete mode 100644 source/unres/src_MD-restraints/entmcm.F delete mode 100644 source/unres/src_MD-restraints/fitsq.f delete mode 100644 source/unres/src_MD-restraints/gauss.f delete mode 100644 source/unres/src_MD-restraints/gen_rand_conf.F delete mode 100644 source/unres/src_MD-restraints/geomout.F delete mode 100644 source/unres/src_MD-restraints/gnmr1.f delete mode 100644 source/unres/src_MD-restraints/gradient_p.F delete mode 100644 source/unres/src_MD-restraints/initialize_p.F delete mode 100644 source/unres/src_MD-restraints/int_to_cart.f delete mode 100644 source/unres/src_MD-restraints/intcartderiv.F delete mode 100644 source/unres/src_MD-restraints/intcor.f delete mode 100644 source/unres/src_MD-restraints/intlocal.f delete mode 100644 source/unres/src_MD-restraints/kinetic_lesyng.f delete mode 100644 source/unres/src_MD-restraints/lagrangian_lesyng.F delete mode 100644 source/unres/src_MD-restraints/local_move.f delete mode 100644 source/unres/src_MD-restraints/log delete mode 100644 source/unres/src_MD-restraints/map.f delete mode 100644 source/unres/src_MD-restraints/matmult.f delete mode 100644 source/unres/src_MD-restraints/mc.F delete mode 100644 source/unres/src_MD-restraints/mcm.F delete mode 100644 source/unres/src_MD-restraints/minim_mcmf.F delete mode 100644 source/unres/src_MD-restraints/minimize_p.F delete mode 100644 source/unres/src_MD-restraints/misc.f delete mode 100644 source/unres/src_MD-restraints/moments.f delete mode 100644 source/unres/src_MD-restraints/muca_md.f delete mode 100644 source/unres/src_MD-restraints/parmread.F delete mode 100644 source/unres/src_MD-restraints/pinorm.f delete mode 100644 source/unres/src_MD-restraints/printmat.f delete mode 100644 source/unres/src_MD-restraints/prng.f delete mode 100644 source/unres/src_MD-restraints/prng_32.F delete mode 100644 source/unres/src_MD-restraints/proc_proc.c delete mode 100644 source/unres/src_MD-restraints/q_measure.F delete mode 100644 source/unres/src_MD-restraints/q_measure1.F delete mode 100644 source/unres/src_MD-restraints/q_measure3.F delete mode 100644 source/unres/src_MD-restraints/randgens.f delete mode 100644 source/unres/src_MD-restraints/rattle.F delete mode 100644 source/unres/src_MD-restraints/readpdb.F delete mode 100644 source/unres/src_MD-restraints/readrtns.F delete mode 100644 source/unres/src_MD-restraints/refsys.f delete mode 100644 source/unres/src_MD-restraints/regularize.F delete mode 100644 source/unres/src_MD-restraints/rescode.f delete mode 100644 source/unres/src_MD-restraints/rmdd.f delete mode 100644 source/unres/src_MD-restraints/rmsd.F delete mode 100644 source/unres/src_MD-restraints/sc_move.F delete mode 100644 source/unres/src_MD-restraints/sizes.i delete mode 100644 source/unres/src_MD-restraints/sort.f delete mode 100644 source/unres/src_MD-restraints/ssMD.F delete mode 100644 source/unres/src_MD-restraints/stochfric.F delete mode 100644 source/unres/src_MD-restraints/sumsld.f delete mode 100644 source/unres/src_MD-restraints/surfatom.f delete mode 100644 source/unres/src_MD-restraints/test.F delete mode 100644 source/unres/src_MD-restraints/thread.F delete mode 100644 source/unres/src_MD-restraints/timing.F delete mode 100644 source/unres/src_MD-restraints/unres.F delete mode 120000 source/unres/src_MD-restraints/xdrf delete mode 100644 source/unres/src_MD/Makefile-intrepid-with-tau delete mode 100644 source/unres/src_MD/Makefile.tau-mpi-f77-pdt delete mode 100644 source/unres/src_MD/Makefile_aix_xlf delete mode 100644 source/unres/src_MD/Makefile_bigben delete mode 100644 source/unres/src_MD/Makefile_bigben-oldparm delete mode 100644 source/unres/src_MD/Makefile_bigben-tau delete mode 100644 source/unres/src_MD/Makefile_galera delete mode 100644 source/unres/src_MD/Makefile_intrepid delete mode 100644 source/unres/src_MD/Makefile_lnx_ifc10_opteron delete mode 100644 source/unres/src_MD/Makefile_lnx_ifc10_opteron_oldparm delete mode 120000 source/unres/src_MD/Makefile~HEAD delete mode 120000 source/unres/src_MD/Makefile~adam delete mode 100644 source/unres/src_MD/prng.f delete mode 100644 source/unres/src_MD/readrtns.F.orig delete mode 100644 source/wham/src-M/Makefile-ifort-MPICH delete mode 100644 source/wham/src-M/Makefile-pgi delete mode 100644 source/wham/src-M/Makefile1_jump delete mode 100644 source/wham/src-M/Makefile1_matrix delete mode 100644 source/wham/src-M/Makefile_jubl delete mode 100644 source/wham/src-M/Makefile_jump delete mode 100644 source/wham/src-M/Makefile_matrix delete mode 100644 source/wham/src-M/Makefile_matrix-oldparm delete mode 100644 source/wham/src-M/Makefile_matrix_PGI delete mode 100644 source/wham/src-M/Makefile_matrix_PGI-SCT-oldparm delete mode 100644 source/wham/src-M/Makefile_matrix_PGI-SCTF-oldparm delete mode 100644 source/wham/src-M/Makefile_matrix_PGI-oldparm delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/Makefile delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/ftocstr.c delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4 delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4.org delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/underscore.m4 delete mode 100644 source/wham/src-NEWSC-NEWCORR/xdrf/xdrf.h mode change 100644 => 100755 source/wham/src-NEWSC/CMakeLists.txt mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.ALLPARM mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.CHAIN mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.COMPAR mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.CONTACTS1 mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.CONTROL mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.CONTROL.org mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.EMP mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.ENEPS mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.ENERGIES mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.FREE mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.IOUNITS mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.MPI mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.OBCINKA mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.PEPTCONT mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.PROT mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.PROTFILES mode change 100644 => 100755 source/wham/src-NEWSC/COMMON.VAR mode change 100644 => 100755 source/wham/src-NEWSC/DIMENSIONS mode change 100644 => 100755 source/wham/src-NEWSC/DIMENSIONS.COMPAR mode change 100644 => 100755 source/wham/src-NEWSC/DIMENSIONS.FREE mode change 100644 => 100755 source/wham/src-NEWSC/DIMENSIONS.FREE.old mode change 100644 => 100755 source/wham/src-NEWSC/DIMENSIONS.ZSCOPT mode change 120000 => 100755 source/wham/src-NEWSC/Makefile mode change 100644 => 100755 source/wham/src-NEWSC/Makefile-pgi mode change 100644 => 100755 source/wham/src-NEWSC/Makefile1_jump mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_MPICH_ifort mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_jubl mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_jump mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_matrix mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_matrix_PGI mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_matrix_PGI-SCT-oldparm mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_matrix_PGI-SCTF-oldparm mode change 100644 => 100755 source/wham/src-NEWSC/Makefile_matrix_PGI-oldparm mode change 100644 => 100755 source/wham/src-NEWSC/a.sh mode change 100644 => 100755 source/wham/src-NEWSC/angnorm.f mode change 100644 => 100755 source/wham/src-NEWSC/arcos.f mode change 100644 => 100755 source/wham/src-NEWSC/bxread.F mode change 100644 => 100755 source/wham/src-NEWSC/cartder.f mode change 100644 => 100755 source/wham/src-NEWSC/cartprint.f mode change 100644 => 100755 source/wham/src-NEWSC/chainbuild.F mode change 100644 => 100755 source/wham/src-NEWSC/chainbuild.f mode change 100644 => 100755 source/wham/src-NEWSC/compinfo.c mode change 100644 => 100755 source/wham/src-NEWSC/conf_compar.F mode change 100644 => 100755 source/wham/src-NEWSC/cont_frag.f mode change 100644 => 100755 source/wham/src-NEWSC/contact.f mode change 100644 => 100755 source/wham/src-NEWSC/contfunc.f mode change 100644 => 100755 source/wham/src-NEWSC/cxread.F mode change 100644 => 100755 source/wham/src-NEWSC/cxread.F.org mode change 100644 => 100755 source/wham/src-NEWSC/define_pairs.f mode change 100644 => 100755 source/wham/src-NEWSC/elecont.f mode change 100644 => 100755 source/wham/src-NEWSC/enecalc1.F mode change 100644 => 100755 source/wham/src-NEWSC/energy_p_new.F mode change 100644 => 100755 source/wham/src-NEWSC/energy_p_new.F.org mode change 100644 => 100755 source/wham/src-NEWSC/fitsq.f mode change 100644 => 100755 source/wham/src-NEWSC/geomout.F mode change 100644 => 100755 source/wham/src-NEWSC/gnmr1.f mode change 100644 => 100755 source/wham/src-NEWSC/icant.f mode change 100644 => 100755 source/wham/src-NEWSC/initialize_p.F mode change 100644 => 100755 source/wham/src-NEWSC/initialize_p.F.org mode change 100644 => 100755 source/wham/src-NEWSC/int_from_cart.f mode change 100644 => 100755 source/wham/src-NEWSC/intcor.f mode change 100644 => 100755 source/wham/src-NEWSC/make_ensemble1.F mode change 100644 => 100755 source/wham/src-NEWSC/match_contact.f mode change 100644 => 100755 source/wham/src-NEWSC/matmult.f mode change 100644 => 100755 source/wham/src-NEWSC/misc.f mode change 100644 => 100755 source/wham/src-NEWSC/molread_zs.F mode change 100644 => 100755 source/wham/src-NEWSC/mygetenv.F mode change 100644 => 100755 source/wham/src-NEWSC/mysort.f mode change 100644 => 100755 source/wham/src-NEWSC/odlodc.f mode change 100644 => 100755 source/wham/src-NEWSC/openunits.F mode change 100644 => 100755 source/wham/src-NEWSC/parmread.F mode change 100644 => 100755 source/wham/src-NEWSC/pinorm.f mode change 100644 => 100755 source/wham/src-NEWSC/printmat.f mode change 100644 => 100755 source/wham/src-NEWSC/proc_cont.f mode change 100644 => 100755 source/wham/src-NEWSC/proc_proc.c mode change 100644 => 100755 source/wham/src-NEWSC/promienie.f mode change 100644 => 100755 source/wham/src-NEWSC/qwolynes.f mode change 100644 => 100755 source/wham/src-NEWSC/read_ref_str.F mode change 100644 => 100755 source/wham/src-NEWSC/readpdb.f mode change 100644 => 100755 source/wham/src-NEWSC/readrtns.F mode change 100644 => 100755 source/wham/src-NEWSC/readrtns.F.org mode change 100644 => 100755 source/wham/src-NEWSC/readrtns_compar.F mode change 100644 => 100755 source/wham/src-NEWSC/rescode.f mode change 100644 => 100755 source/wham/src-NEWSC/rmscalc.f mode change 100644 => 100755 source/wham/src-NEWSC/secondary.f mode change 100644 => 100755 source/wham/src-NEWSC/setup_var.f mode change 100644 => 100755 source/wham/src-NEWSC/slices.F mode change 100644 => 100755 source/wham/src-NEWSC/store_parm.F mode change 100644 => 100755 source/wham/src-NEWSC/timing.F mode change 100644 => 100755 source/wham/src-NEWSC/wham_calc1.F mode change 100644 => 100755 source/wham/src-NEWSC/wham_calc1.F.safe mode change 100644 => 100755 source/wham/src-NEWSC/wham_multparm.F delete mode 100644 source/wham/src-NEWSC/xdrf/Makefile delete mode 100644 source/wham/src-NEWSC/xdrf/ftocstr.c delete mode 100644 source/wham/src-NEWSC/xdrf/libxdrf.m4 delete mode 100644 source/wham/src-NEWSC/xdrf/libxdrf.m4.org delete mode 100644 source/wham/src-NEWSC/xdrf/underscore.m4 delete mode 100644 source/wham/src-NEWSC/xdrf/xdrf.h mode change 100644 => 100755 source/wham/src-NEWSC/xread.F delete mode 100644 source/wham/src/DIMENSIONS.FREE.orig delete mode 100644 source/wham/src/DIMENSIONS.orig delete mode 100644 source/wham/src/Makefile-pgi delete mode 100644 source/wham/src/Makefile1_jump delete mode 100644 source/wham/src/Makefile_jubl delete mode 100644 source/wham/src/Makefile_jump delete mode 100644 source/wham/src/Makefile_matrix delete mode 100644 source/wham/src/Makefile_matrix_PGI delete mode 100644 source/wham/src/Makefile_matrix_PGI-SCT-oldparm delete mode 100644 source/wham/src/Makefile_matrix_PGI-SCTF-oldparm delete mode 100644 source/wham/src/Makefile_matrix_PGI-oldparm delete mode 100644 source/wham/src/cxread.F.orig delete mode 100644 source/wham/src/include_unres/COMMON.NAMES delete mode 100644 source/wham/src/include_unres/COMMON.VAR delete mode 100644 source/wham/src/readrtns.F.orig delete mode 100644 source/xdrfpdb/src/xdrf/Makefile delete mode 100644 source/xdrfpdb/src/xdrf/Makefile_jubl delete mode 100644 source/xdrfpdb/src/xdrf/Makefile_linux delete mode 100644 source/xdrfpdb/src/xdrf/RS6K.m4 delete mode 100644 source/xdrfpdb/src/xdrf/ftocstr.c delete mode 100644 source/xdrfpdb/src/xdrf/libxdrf.m4 delete mode 100644 source/xdrfpdb/src/xdrf/types.h delete mode 100644 source/xdrfpdb/src/xdrf/underscore.m4 delete mode 100644 source/xdrfpdb/src/xdrf/xdr.c delete mode 100644 source/xdrfpdb/src/xdrf/xdr.h delete mode 100644 source/xdrfpdb/src/xdrf/xdr_array.c delete mode 100644 source/xdrfpdb/src/xdrf/xdr_float.c delete mode 100644 source/xdrfpdb/src/xdrf/xdr_stdio.c delete mode 100644 source/xdrfpdb/src/xdrf/xdrf.h diff --git a/PARAM/bond_AM1_ext.parm b/PARAM/bond_AM1_ext.parm index 7e5e837..0f7bb5e 100644 --- a/PARAM/bond_AM1_ext.parm +++ b/PARAM/bond_AM1_ext.parm @@ -19,7 +19,7 @@ 3 2.644 48.8 1.707 3.433 34.8 .00123 4.080 899.9 1.175 114.0 38.00 6.8 ! Arg 3 2.379 99.0 1.974 2.704 157.5 0.546 3.073 164.7 0.055 86.0 28.67 6.3 ! Lys 1 1.422 605.2 0.000 71.0 23.67 5.6 ! Pro -2 2.103 71.3 0.850 2.500 128.0 0.033 135.0 45.00 6.2 ! SeMet # adapted from Met -2 3.368 123.1 0.000 3.686 129.1 .00049 149.0 49.76 7.2 ! Dap(Bz) # adapted from Trp -1 0.778 353.0 0.000 42.0 14.00 4.7 ! Aib # adapted from Ala -1 1.210 353.0 0.000 42.0 14.00 5.6 ! Abu # Adapted from Ala +2 2.142 71.3 0.850 2.500 128.0 0.033 135.0 45.00 6.2 ! SeMet +1 3.799 124.6 0.000 149.0 49.67 7.2 ! Dap(Bz) +1 0.743 353.00 0.000 42.0 14.00 4.7 ! Aib +1 1.210 353.00 0.000 42.0 14.00 5.6 ! Abu diff --git a/PARAM/pot_theta_G631_DIL.parm b/PARAM/pot_theta_G631_DIL.parm index 3b94e8b..47d6fb1 100644 --- a/PARAM/pot_theta_G631_DIL.parm +++ b/PARAM/pot_theta_G631_DIL.parm @@ -1,5 +1,5 @@ 2 10 4 4 6 4 -1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 2 +1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 2 3 4 Gppreg 4.58415E+01 1.05721E+03 diff --git a/PARAM/rotamers_AM1_aura.10022007.ext.parm b/PARAM/rotamers_AM1_aura.10022007.ext.parm deleted file mode 100644 index e79c2eb..0000000 --- a/PARAM/rotamers_AM1_aura.10022007.ext.parm +++ /dev/null @@ -1,1520 +0,0 @@ -cys -2.516050 -1.519290 --0.549712 --1.031160 -1.143970 -2.488560 --1.092110 -2.234960 --0.755595 -1.289450 -1.853910 -4.001970 --0.082907 -0.826224 -1.632090 -0.593940 --0.364204 --1.171220 -1.667710 --1.599100 --2.976120 --2.507130 -1.072030 --0.956779 --2.533370 --1.691250 -1.266100 --0.870809 -1.513010 -2.242270 --1.570990 -0.964612 -0.482876 -0.654966 -1.063640 -0.999274 --2.492650 --1.951980 --0.535164 --0.771304 --2.293140 --2.335450 --0.858895 --0.116272 --1.427930 --1.834970 -0.975263 --0.416979 --1.447500 -0.127525 --0.663205 --1.101400 -0.162302 --0.060514 -0.180357 --1.109550 --0.456202 --0.571306 -0.314586 --1.498430 --0.195562 --1.682240 -0.767131 -6.286060 -4.999080 -met -0.242385 --3.867820 --2.519440 --1.840060 -0.346345 -0.104127 --0.232111 --0.456953 -2.560720 --1.205500 -2.222330 -3.339340 -4.420270 -0.229703 --0.059912 -2.543360 --0.293651 --0.050722 -2.341280 --0.042924 -0.373985 -0.807829 -0.707855 --0.993956 --1.432900 -2.581280 --0.794355 --2.675380 -4.672100 -2.112750 -0.401415 --1.225100 -0.323175 -1.696930 --0.723040 --1.083670 --0.604380 -1.495140 -0.235245 --0.748861 --0.536377 -1.078860 --2.003290 --0.713276 -0.498966 --2.266150 -1.213190 --1.843220 --3.535470 -1.424330 --0.126241 --0.887041 --0.274146 --0.492489 --0.686889 -0.543455 -0.237177 -0.666361 --0.619648 -1.448780 --0.001620 --1.655960 -5.119950 -3.850810 -6.772310 -phe -2.905280 -1.563400 -0.260704 --1.436610 -1.035990 -1.024140 -0.840447 -0.324290 -1.078110 -1.582520 -0.766660 -2.290690 --0.135215 --1.649520 -0.534748 -0.163339 -0.063276 --1.823560 --0.359499 --1.494990 --0.983586 -0.284312 --0.312291 --1.074510 --0.659699 --0.828137 -0.500521 --3.527010 -0.428427 --0.142418 --0.771393 --0.097615 -0.289041 -0.230247 --0.782115 --0.229896 --0.587347 -1.285140 --0.443417 --0.812455 --0.805578 -0.384103 --0.636362 --0.321168 -0.534795 --1.278490 --0.064930 --2.042540 --0.800358 --0.244451 --0.002745 --0.445024 -0.477842 --0.470867 --0.692151 --0.102851 --0.110080 -0.490363 -0.280005 --0.390101 --0.411756 --1.548200 -2.443590 -3.917670 -3.425880 -ile -2.547010 --0.480555 --0.215172 -0.837321 -0.729540 -0.043286 -1.774070 -0.045433 -0.389008 --0.849535 -1.303160 --0.116116 -0.036272 --0.297137 -0.131116 -1.057620 -0.114229 -0.195998 --0.425898 -0.189526 --1.451270 -1.337360 -0.613895 --1.300010 --1.115540 -0.279502 --0.615356 -0.182825 -0.051340 -0.108723 -0.496082 -0.576282 --1.245120 --0.159551 -0.461861 -0.754533 --0.516837 -0.086829 -0.197196 -0.005101 --1.071330 -1.017270 --0.714900 --0.956747 --0.565657 --0.093550 --0.412198 -0.416137 -0.107666 --0.577227 -0.150543 --1.242490 --0.698236 -0.585429 -0.395118 -0.364855 --0.653697 -0.501917 --0.057772 -0.445256 --0.362675 --1.518600 -2.525450 -0.374404 -0.682944 -leu -1.680740 -2.206260 --1.020490 --4.442000 -1.740900 -1.505040 --1.447370 -0.359811 --0.556261 -1.452810 -2.989010 -4.116870 -0.112662 --0.159364 -0.673536 -0.586452 -1.865760 --3.334100 -0.060408 --2.004410 --4.576780 --4.974520 -1.658540 -2.955230 --3.053830 --0.617349 --0.816079 -4.289990 -1.903920 -1.499120 --2.080390 -0.496676 -1.354440 -0.236928 -2.237880 --0.772602 --0.600654 --2.207890 -0.925248 --1.403310 -0.907402 -2.736260 --0.042247 --2.761980 -2.254060 --2.655420 -1.394610 --6.677840 --0.368599 -0.291979 -0.697959 --0.306545 -0.002515 --0.214417 --3.297980 --0.685060 -0.585051 -2.654060 -0.476247 --0.642854 --0.224549 --1.778700 -1.643520 -8.321350 -8.662130 -val -2.853420 -2.372460 -0.347315 --1.687860 -1.167160 -2.017490 --0.321584 -1.574110 -1.450650 -0.966125 -2.343690 -1.163800 --0.910076 --0.266744 --0.563304 -1.765470 -1.150000 -0.945044 --2.124250 --3.053060 --3.243560 --1.337950 -1.407690 --0.439212 --0.482510 --2.719870 --0.035101 --3.712790 -1.500760 -0.800428 --0.590109 -0.503066 -0.749586 -0.017932 -0.069581 --0.752567 --1.256130 -0.000240 -0.887223 --0.746863 --1.302360 --0.133817 --0.070895 --1.012470 --0.255720 --1.585790 -0.545734 --2.406620 -0.266017 -1.527210 --0.059205 -0.078433 --0.453017 -0.252419 -1.112470 --0.299918 --1.668670 -0.220561 --0.401384 --0.756521 --0.411065 --1.569620 -1.493110 -5.922200 -4.609540 -trp -2.921620 -0.684920 --0.599147 --1.786150 -1.272310 -1.207640 -0.446673 -0.990996 --1.442880 -0.174451 -0.745048 -3.226680 -0.573147 --0.374842 -0.584342 -0.374784 --0.207986 --1.031510 -0.674108 --0.390621 --1.465510 --0.603164 --0.228428 --0.701186 --1.343350 --0.431420 -0.312777 --3.304840 -3.352130 -0.892130 --0.807663 --0.149322 -0.432795 -0.373168 --0.568305 --0.426774 --0.559088 -0.633184 --0.453757 --0.873045 --0.986508 -0.621304 --1.482100 --0.080794 -1.285140 --1.991150 --0.276781 --2.516300 --0.972887 -0.721706 -0.470161 --0.420591 -0.454982 --1.389310 --1.260280 -0.335462 -0.729529 --0.183500 -0.327032 --0.218261 --0.364944 --1.523350 -2.591340 -3.992920 -3.500820 -tyr -2.848390 -1.220450 -0.164588 --1.416060 -0.864915 -0.959356 -1.020760 -0.346926 -1.091540 -1.440250 -0.515721 -1.825900 -0.328914 --1.270620 -0.346300 -0.327131 --0.161742 --1.593460 --0.222144 --1.405750 --0.955410 -0.352884 --0.374064 --0.939478 --0.774774 --0.536210 -0.352785 --3.080560 -0.836825 --0.506611 --0.776758 --0.211439 -0.184199 -0.377714 --0.478433 --0.171748 --0.650885 -1.300680 --0.539006 --1.333370 --0.964979 -0.290092 --0.846196 --0.297355 -0.400525 --1.367340 --0.000126 --1.621890 --0.615022 --0.529794 --0.066040 --0.797892 -0.462295 --0.386974 --0.333067 -0.016663 --0.429482 -0.339500 -0.338939 --0.896894 --0.390244 --1.524800 -2.793770 -3.087750 -2.543540 -ala -29.581800 -5.302400 --8.747850 -6.252030 -53.434500 -11.092900 -26.127600 -15.726000 -0.066585 -68.839800 -12.858300 -8.451450 --3.332160 -6.671050 --15.863800 -1.456490 --0.410963 -8.873910 -3.570870 --17.554000 --30.977100 --4.646740 -8.804110 --27.391600 --15.911000 --5.664230 --12.905200 --12.063900 -8.869960 --1.839190 --3.407650 -12.814000 --9.468340 --8.090890 -5.999440 -3.456650 --23.923700 --4.696260 -4.081510 -3.765870 --3.646730 --6.890210 --3.788290 --15.397100 --7.145120 -7.975680 --4.482870 --4.678150 --11.878400 --9.343300 --2.332450 -0.687960 --4.130170 --3.224060 -8.454630 -4.189470 --19.724500 --8.742350 --1.249890 --12.608200 -0.643325 --1.817150 --2.059430 -10.866800 -1.832750 -gly -no side-chain -thr -2.552870 -0.908677 -0.013694 --1.912020 -0.374026 -2.534850 --0.358242 -1.314570 --0.002403 --0.339657 -1.182830 -0.571142 --2.281230 --0.362873 --0.513174 --0.309246 -2.008470 -0.834209 --3.807740 --1.651370 --2.468030 --0.628244 -1.982210 -0.353341 --0.372571 --1.191460 --0.908825 --2.598860 -4.084590 -0.794012 --0.447691 --0.558372 -0.686901 -0.706404 -0.570963 --0.359765 --0.908598 -0.181491 -1.827310 --0.391557 --1.079830 --0.148791 --0.238554 -0.168299 -0.449106 --1.445600 --0.078064 --0.544035 -0.494414 -2.771950 -0.662545 -0.581236 --0.716348 --0.641217 -1.142900 --0.502831 --0.253750 --0.309933 --0.182098 -0.467125 --0.435565 --1.536860 -0.657918 -5.468580 -4.348550 -ser -3.261260 -2.372320 --0.441888 --7.144530 -1.440980 -0.892894 -0.967241 --0.883910 --0.944144 -3.267120 -2.454180 -5.861420 --1.770560 -0.282070 -1.153690 -0.324110 -1.000110 --5.381160 --1.037120 --3.287730 --4.500800 --4.680830 -1.271610 -4.062690 --2.100630 --0.620598 --1.751340 -5.047890 -2.318850 -0.772142 --1.676040 -0.548819 -1.828580 -0.481638 -1.905550 --1.055500 -0.347758 --1.972810 -0.263296 --0.884153 --0.717223 -0.058630 -1.748850 --0.549066 -0.233948 --1.675870 -0.743669 --2.786440 -2.582160 --1.611050 --0.418236 -0.214639 -0.299815 -0.653207 --1.614910 --1.122350 -0.779347 -1.581610 -0.907118 --2.092000 --0.319132 --1.760880 -3.277280 -10.253200 -8.112910 -glu -0.070526 -0.913876 -0.970204 --1.418860 -1.519230 -2.363470 -1.081950 --1.141770 -3.408860 --1.998530 -2.035560 -2.802280 -1.986150 --1.296320 -1.860060 -2.806320 -0.930869 --0.049774 -0.030898 --0.319751 --5.890110 --3.467340 -3.128240 -1.891450 --0.751099 --2.948590 -1.299560 -0.943981 -3.945590 --0.885366 --1.286460 -1.379920 -0.835779 -2.274900 -1.066560 --4.810250 -2.487680 --0.815236 -0.825560 --0.133447 --1.847050 -0.642237 --1.740230 --1.127830 -1.302210 --2.245610 -2.246220 --2.465710 --1.162500 -0.821033 --0.618164 --1.400750 -0.045507 -0.398040 --0.880369 --2.039250 -1.389940 -0.044041 --0.500567 --1.652310 --0.447018 --1.224190 -9.871030 -1.155810 -5.541080 -asn -2.887160 -1.505510 --0.880658 --1.802050 -1.318050 -0.853847 -0.728651 --0.450756 -0.406586 -1.918440 -1.067310 -3.575890 -0.260153 --0.523274 -1.166750 -0.115179 --0.202976 --0.886999 --0.844886 --1.510850 --1.495980 --1.305910 --0.006770 --1.018110 --1.196710 --0.152800 --0.135317 --2.751090 -1.718150 -0.784398 --0.582188 --0.092762 -0.689656 -0.320720 --0.915587 --0.715622 --0.786048 --0.013911 --0.230284 -0.144000 --0.095310 -0.066526 -0.327789 --1.946870 --0.961993 --1.139090 -2.011190 --3.389190 -1.069160 --0.480208 --0.900915 -0.021566 --0.754257 -0.146208 --0.930949 --0.772920 --0.259499 -1.736500 -0.162489 --0.932451 --0.431414 --1.573430 -1.702680 -4.384230 -5.557500 -glu -0.070526 -0.913876 -0.970204 --1.418860 -1.519230 -2.363470 -1.081950 --1.141770 -3.408860 --1.998530 -2.035560 -2.802280 -1.986150 --1.296320 -1.860060 -2.806320 -0.930869 --0.049774 -0.030898 --0.319751 --5.890110 --3.467340 -3.128240 -1.891450 --0.751099 --2.948590 -1.299560 -0.943981 -3.945590 --0.885366 --1.286460 -1.379920 -0.835779 -2.274900 -1.066560 --4.810250 -2.487680 --0.815236 -0.825560 --0.133447 --1.847050 -0.642237 --1.740230 --1.127830 -1.302210 --2.245610 -2.246220 --2.465710 --1.162500 -0.821033 --0.618164 --1.400750 -0.045507 -0.398040 --0.880369 --2.039250 -1.389940 -0.044041 --0.500567 --1.652310 --0.447018 --1.224190 -9.871030 -1.155810 -5.541080 -asp -3.393100 -1.530490 --0.056195 --1.829370 -0.141299 -0.771783 -2.517790 --2.256840 -1.947970 -2.418020 -0.641765 -3.385780 --1.085960 --1.751340 -1.666850 -0.082569 --1.067290 --0.953673 --1.956880 --0.130965 --2.165850 --2.021030 -0.465149 -0.849165 --1.408640 --0.396844 --0.332769 -0.203629 -0.950651 --1.758780 --1.002960 -0.174170 -0.586997 -0.665809 --0.036146 --0.823361 -0.314356 --0.212134 --0.371333 -0.187511 -0.279874 -1.091480 -0.597046 --1.809290 -0.561474 --1.582770 -1.327560 --4.028240 -0.663853 --1.131780 --0.099988 -0.155690 --0.329172 -0.299049 --1.895480 --0.927719 -0.431330 -2.101560 -0.144432 -0.026490 --0.468977 --1.619670 -0.674945 -5.389650 -6.091920 -his -2.771840 -1.871420 -0.642667 --1.621980 -1.040560 -0.858055 -0.864645 -0.156787 -1.255050 -2.113910 -0.967605 -2.535960 --0.255966 --1.687760 -0.740406 -0.097038 -0.120513 --2.171050 --0.576881 --2.281680 --0.949819 -0.202620 --0.108227 --1.119410 --0.294544 --1.029800 -0.367984 --3.538760 -0.558602 -0.039279 --0.569377 --0.037731 -0.571981 -0.288592 --1.038140 --0.439625 --0.660975 -1.212290 --0.357194 --0.827404 --0.637842 --0.027649 --0.510968 --0.721916 --0.315069 --1.222220 -0.893482 --2.230320 --0.429219 -0.038562 --0.667068 --0.322006 --0.026325 --0.384665 --0.805183 --0.584237 -0.104319 -1.225640 -0.196774 --0.568376 --0.404463 --1.585910 -2.504960 -4.242010 -4.344010 -arg -15.635000 -15.480100 -6.648870 --18.867400 -8.112720 -1.091870 -6.428840 --5.933360 -0.563115 --1.135150 --3.091790 -0.253889 --13.733700 -7.578930 -0.670338 --1.723080 --1.999990 --3.289380 --5.317610 -6.425830 --11.558600 --9.164840 -0.615527 -6.209540 --4.682290 --5.909200 --0.913172 -4.976140 -1.524290 -3.750960 --2.577270 -1.538390 -1.621870 -0.113149 -0.840945 --5.173650 -3.728470 --1.250960 --1.053350 -0.256049 --4.819690 --4.631460 -0.267787 -3.154990 --2.481970 --0.005787 --2.416910 -3.124050 --3.999920 --1.868040 -0.112267 -1.347600 -1.780410 --2.247470 -0.415467 --3.660360 -0.892497 --0.918464 -1.156950 -3.541130 -0.209257 -0.052619 -16.451300 -29.575700 -16.781700 -lys -3.629200 -8.354760 --5.316650 --6.442250 -3.029120 --0.253504 -1.095740 --4.598450 --1.232190 --0.188861 -3.902230 -1.638270 -5.393420 --0.498152 -1.255330 -3.180320 --0.267965 --2.358320 --1.556550 -0.516286 --4.359970 --5.661280 -2.927070 -3.790640 --4.595660 -2.104740 --1.689900 -4.922930 -2.532640 -0.448579 --2.297530 -0.332371 -1.576610 -1.927500 -1.400070 --1.447210 -0.984547 --1.969040 -0.618915 --1.514840 --3.391120 --2.581270 --2.370860 -2.161890 --1.264640 --1.934220 --0.016963 -1.932110 --2.249750 -2.818560 --1.075660 -0.433778 -0.863336 --2.522350 --0.160333 --0.729450 -1.572090 --0.855726 --0.301598 -3.318270 --0.585549 --1.112810 -6.153790 -15.332000 -10.158700 -pro -4.181670 -0.818431 -1.557990 --2.590020 -3.171380 -2.036200 --0.972179 -2.330640 --3.042700 -3.502460 -3.108800 -0.727264 -1.380870 -0.382058 -1.953450 -0.248880 -0.962273 -0.672548 --2.864740 --4.209440 --2.663210 -0.061483 -0.338868 --1.111720 -0.407801 --2.285720 --0.748390 --1.232650 -4.219010 -0.595086 -3.794940 --1.492820 -0.985205 -2.047750 --2.326250 --1.786200 -0.262373 --1.959410 --0.225483 --0.414578 --2.540780 -0.607528 --2.705600 --0.472333 --0.260711 --1.019870 --1.220640 --2.372380 -0.977973 -1.609700 --0.776966 -0.530990 -1.137450 --2.496770 --1.364430 -3.473310 --0.209746 --2.099850 --0.749455 --0.820907 --0.327475 --1.714150 -2.053060 -6.348730 -5.232300 -sme -0.242385 --3.867820 --2.519440 --1.840060 -0.346345 -0.104127 --0.232111 --0.456953 -2.560720 --1.205500 -2.222330 -3.339340 -4.420270 -0.229703 --0.059912 -2.543360 --0.293651 --0.050722 -2.341280 --0.042924 -0.373985 -0.807829 -0.707855 --0.993956 --1.432900 -2.581280 --0.794355 --2.675380 -4.672100 -2.112750 -0.401415 --1.225100 -0.323175 -1.696930 --0.723040 --1.083670 --0.604380 -1.495140 -0.235245 --0.748861 --0.536377 -1.078860 --2.003290 --0.713276 -0.498966 --2.266150 -1.213190 --1.843220 --3.535470 -1.424330 --0.126241 --0.887041 --0.274146 --0.492489 --0.686889 -0.543455 -0.237177 -0.666361 --0.619648 -1.448780 --0.001620 --1.655960 -5.119950 -3.850810 -6.772310 -dbz -2.921620 -0.684920 --0.599147 --1.786150 -1.272310 -1.207640 -0.446673 -0.990996 --1.442880 -0.174451 -0.745048 -3.226680 -0.573147 --0.374842 -0.584342 -0.374784 --0.207986 --1.031510 -0.674108 --0.390621 --1.465510 --0.603164 --0.228428 --0.701186 --1.343350 --0.431420 -0.312777 --3.304840 -3.352130 -0.892130 --0.807663 --0.149322 -0.432795 -0.373168 --0.568305 --0.426774 --0.559088 -0.633184 --0.453757 --0.873045 --0.986508 -0.621304 --1.482100 --0.080794 -1.285140 --1.991150 --0.276781 --2.516300 --0.972887 -0.721706 -0.470161 --0.420591 -0.454982 --1.389310 --1.260280 -0.335462 -0.729529 --0.183500 -0.327032 --0.218261 --0.364944 --1.523350 -2.591340 -3.992920 -3.500820 -aib -29.581800 -5.302400 --8.747850 -6.252030 -53.434500 -11.092900 -26.127600 -15.726000 -0.066585 -68.839800 -12.858300 -8.451450 --3.332160 -6.671050 --15.863800 -1.456490 --0.410963 -8.873910 -3.570870 --17.554000 --30.977100 --4.646740 -8.804110 --27.391600 --15.911000 --5.664230 --12.905200 --12.063900 -8.869960 --1.839190 --3.407650 -12.814000 --9.468340 --8.090890 -5.999440 -3.456650 --23.923700 --4.696260 -4.081510 -3.765870 --3.646730 --6.890210 --3.788290 --15.397100 --7.145120 -7.975680 --4.482870 --4.678150 --11.878400 --9.343300 --2.332450 -0.687960 --4.130170 --3.224060 -8.454630 -4.189470 --19.724500 --8.742350 --1.249890 --12.608200 -0.643325 --1.817150 --2.059430 -10.866800 -1.832750 -abu -29.581800 -5.302400 --8.747850 -6.252030 -53.434500 -11.092900 -26.127600 -15.726000 -0.066585 -68.839800 -12.858300 -8.451450 --3.332160 -6.671050 --15.863800 -1.456490 --0.410963 -8.873910 -3.570870 --17.554000 --30.977100 --4.646740 -8.804110 --27.391600 --15.911000 --5.664230 --12.905200 --12.063900 -8.869960 --1.839190 --3.407650 -12.814000 --9.468340 --8.090890 -5.999440 -3.456650 --23.923700 --4.696260 -4.081510 -3.765870 --3.646730 --6.890210 --3.788290 --15.397100 --7.145120 -7.975680 --4.482870 --4.678150 --11.878400 --9.343300 --2.332450 -0.687960 --4.130170 --3.224060 -8.454630 -4.189470 --19.724500 --8.742350 --1.249890 --12.608200 -0.643325 --1.817150 --2.059430 -10.866800 -1.832750 diff --git a/PARAM/sc2scext b/PARAM/sc2scext deleted file mode 100755 index 5553d362be7a643d326fd18a041feb1653c82aba..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 10735 zcmcIqeQ;FO6~DWigor>w2oM2f(cpk1YZ8HhqV@$6c+nLwLWdUgWyx+nFkjt$(cs7s zo5Z@4M&i`z*!BRV$aR zT<(js`zoaWg)m65+puw~G|llS0!MXISm<6-`KrT*Yrp%C{2RyK9yql4*8`O=G=BOU z(&az0lTIH%lIn0K!n{rp{Gu$l7nNtSvm5f6@D*9`hAjAfS@5G-@VBzygIVwcS#W{- z*4WSP}pd0GeeD`utOmbZnR5BOd}i$1dU*OTgWDvG=jnw8y+#+!yzNo6*4*k zW>Z>$@mRRowA)aoGYDC=q4BNM>XkAK_4P)CxN_p^E!;3DucFZ!Xl@f5{55OW85O`OUrS8xd z7$TTORr&robrPqssip$S#}qyVoD!Az2^-F1n+k?)xPAURX~XT~f5e7U9h~AeoaX>4 z8@J(TU@~2>;Zu_+GIQ%BN4Bq*IqQ;d!>8GBy=N>xeilIdaWpsnbCl^lujL<0thlYv zD-w%u$F*Rgh8*!tq&Yg0Kw5k=@f4!bVad-UoAiUDRiUzCGRGl zLN+=m`7aB=Q>aF}CI2b$)Qr&%$)6#fLNi(?`BTJGNJck)HAo%&Dr z`(7T#BL-^UBef^bo*?e%MUUQd)}^mL87XZjSXd5}T!oS1BCvXD=lZ`cU7=cp|YM;85QPauoQXzG39LW$rEHDA@Xd1oh}p{Kup> zFmTrx5sChmZjT;)lS;Q+r8_d0-YrX$rY?P*!3Ak-sIO!+k$6e^l*B@J{_%&_w0!m@7-asdi{z1>bPD%tVf4+S4?*e>qkdC z`aq6LAK3gM8dOJ~A3X(VS|PWO;-%X65?m&G1<%C_4##?`<1U2zMXHdI(}eUXRSHQ- zrdCpqMf9(_mGfcD-pVS~tmolA-H(H3F6;i-SLD9K*;g)Su;c7y4gU114c1W~$R6N( zuiBs&!}Br*zqpvG$+r8`1%aVH4fmaeG?4dY+$i)nir%8_Ox!_bX&& z_{Rn|7Z0H;Kxy^Xc)`9ekg*E%=k=brtG`#8UsE05(J8rc1U7}}0ldcA10hXPWO|BYhtZf_= z^j?Qs0b@O}+19Wt+54Ckhn`sRA@4Lyin+5S^Tc z?E26kiea5>G0i~*y^CmIIA{19WzSBZ;pJqMn&E$O0eV?y_}x}%mKlD#EKSbvU;W!Y zU6mB13y~0=_s?z!zO( z%NC`FZtqpj^zIBEny=WJ5ICQqcieo9&YCcmdWw`xaP|sMk*!ci|4j>LnzM(_WpMVE zYjk!9#xCdV6`oKBpnh3rr(|-r^ctO=cLis!@btU*`4yb~4g~ZkU!%n#)|Ps7N9nj8 zZ7IDFy@+LOiQa#Y9z7R7PD0UtMgJLp1iAPx;Zu1`@84011#wGhAr_`3SZE@BMypf% z`V^*4`lG?p5q)6UEVozq2Nq8w0zB@Inx*6Z=o6(Es9LP1$5#25zF!&rx+Z#FKl-(& zCi=Jd4?jcAeIJ<%%HO8<34ioUfAoA+^yA7z@jH6YF|47_hR>ut@%INyOZ@Q3>+d&9 zm-zdiC@q6`t1Rz$Eo?31pLTh%e!h?}Z+Mxujnq2)Y(CcY{dme;NOXRpR@~OwKfaKn zKyNv?m06N2?X7U4P^7*hQXlFveGOvC@`j2sUwPS5yHpjJgdIShmKBtUy5@V<&|VQO zl9!V^pwwMEK=*?Vf*u4t07{AWb11nUuNAJYLf8ChQ}PF4hJZ*${B@E zxz|n4tL^c4W>19_FeH*8pW;|{t|7qxl)J}MHN(4WhLj-tLHzSkr~Q4H>_36O03Id! zzz=et$}?tYJyZ6%pYaUjxVKpbs0;}cr%V<%k!Rc<3&NPcqy(7HR~hE%ou3lF!#3q< zlAkWGLTtmE2BmYC6759m+#0T_y~!gUi>Id#rEa%|s}TGSeV?+=@6NovI$KJmE*_OV zpx(ndX5$Ly`^E407?m=0Q*Q35xtTlWp`66|O$^)B}<_pR_& zl$Dp2mzP&~m(+%WUOix1__7KNMPFohs~Ok{YKAS^#5vkU3wH=#Te}(ZRj#dBW(FD+ z*VxwS+u7NSZP(_Y@DbM(h%^abaCaN*S=0<$C69)}5p2|@F$T)Qp_TwCs9Z;jDSXXs z&A6JFFodrG49ePr0W%{RM6fTx#Fl zE4kDqCzX}Ca$N2Dceyo*-=z$eN-lMA>Q|u%Yms)Yzs{`zq4_|PWB*XqISUipl#gz5y)Vxxs^tqi}KkGBz>(J+U zuS+TLJV`9g- zyFPz+E2B<{w1gi(7Mt8>R;>65GIo7_E^Slak7lr-qFg`2`;j4ij(@j$u5~N@I+WRy z*Ulh+0Drqaf2ZQ_SG4x9CujYKQE1mMEY_rWp?a|W%&v?)-#><9$dEoiC;59Gf9K;k zv%FJ($e~X=sgzEr`mdz_CS>jP(>5xllSP?w_1Uj? zP-d^6zc=ikBh@Cvi}jhl=g{YM#sQ_@WSL1`S&!)%hkoJQIw@PI79!63?c~QHO}4oG zB}%_o>2o`!Q6g{JD~bt0FszMbc>!x+&R z?N1<$s~bnVD0kq`apQS~)?bmZc1Y$u=v_RY*$X}R^33y8Iz9{YPMsZ+ zc@N&ocwVs=dc>fJ8oQ~vX~*`;u=nrC=Cb}2jK z4m;WW@0E6nM9dNYXC*#U98}LSurj@Xt1H8Od@LJ18{GOP3AhY;8AI3;yB$W@uYe(L!Vw|iq!b!=g{wf7iMVJ@3YwXI14@t4bOC* zWO)|+A>cFJ1>$MPecvVVS%N+S+tXvx&U8VanJLk_lhXII*gpWg5aX^`^>a&Fh(lTA z-%|2R9P)pc^3z3ez9vn`y&vR8ve?PP^D0xl(}8DjNz< zwv#TRK5RzJPV6Ao;{?pQEt_f$f6aqi=m3mSmB!t>&Q=s`HyT^ocLrJv`QmE?I=cj3 zYCBp&W+>=edFP$01Qi&~!7gyi%Y^mr9PDgu-Ocq>Z>*Bltgo%SzuI7qs^NU97WtMf zYq4$UsRKAZZ0fBj#{r%V{!MEu{l=#C>mRJ%Vr;2g>#wF}&^x^m2!{i^jZj-K9gwGe zgi-bFjg|M;tP}K#Zk>67m^=VeAL%sYMgYU9BS5Bg>_(ob(X_N9F_Sqx5(C$g{Ad%CNlu+u#(q(1nkWyBGn@L!q`Fp diff --git a/PARAM/sc2scext.f b/PARAM/sc2scext.f deleted file mode 100644 index 1d23d3a..0000000 --- a/PARAM/sc2scext.f +++ /dev/null @@ -1,37 +0,0 @@ - double precision eps(24,24),sigma0(24),sigii(24),chip(24),alp(24) - integer ind(4) - read(*,*) ipot,iexpon - read (*,'(4f20.10)')((eps(i,j),j=i,20),i=1,20) - read (*,'(4f20.10)')(sigma0(i),i=1,20),(sigii(i),i=1,20), - & (chip(i),i=1,20),(alp(i),i=1,20) - ind(1)=2 - ind(2)=7 - ind(3)=9 - ind(4)=9 - do k=1,4 - do j=1,k+20 - if (j.gt.ind(k)) then - eps(j,k+20)=eps(ind(k),j) - else - eps(j,k+20)=eps(j,ind(k)) - endif - enddo - do j=k+21,24 - eps(k+20,j)=eps(ind(k),j) - enddo - enddo - do i=1,4 - sigma0(i+20)=sigma0(ind(i)) - sigii(i+20)=sigii(ind(i)) - chip(i+20)=chip(ind(i)) - alp(i+20)=alp(ind(i)) - enddo - print *,ipot,iexpon - do i=1,24 - print '(4f20.10)',(eps(i,j),j=i,24) - enddo - print '(4f20.10)',(sigma0(i),i=1,24) - print '(4f20.10)',(sigii(i),i=1,24) - print '(4f20.10)',(chip(i),i=1,24) - print '(4f20.10)',(alp(i),i=1,24) - end diff --git a/PARAM/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k b/PARAM/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k index d66c9c9..f371faa 100644 --- a/PARAM/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k +++ b/PARAM/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k @@ -4,71 +4,101 @@ 5.263842382200000 5.496195412400000 4.292812416200000 4.358225054000000 4.266775592100000 3.681384595800000 3.540542964700000 3.702698591200000 4.717759615600000 3.381199222700000 3.793608545800000 4.515749058500000 + 6.629674668000000 6.671726050800000 6.816887694500000 6.837896015200000 6.351203998600000 6.142519242300000 5.520020640600000 5.485893602400000 4.938257326200000 4.279512916600000 4.053485701800000 4.208642852500000 3.538808627900000 3.420973032700000 2.799574419300000 4.816426855300000 - 3.879075507100000 3.587826217700000 4.645743255500000 5.434261193691611 - 6.009504353949445 5.751833613689151 4.388369927131041 6.139482146000000 - 4.432779364180328 3.635448013213493 3.042556269070575 1.858255457238648 - 3.619846653665197 3.902273188000000 2.840826371233924 1.901219059651194 - 3.010635482615414 2.681361243261458 3.871192813400000 3.639660062795308 - 4.487266103000000 7.144249845164532 5.950132764851209 5.636408114630104 - 6.256568766200000 4.721753486138623 5.072743940945156 4.725634408062251 - 3.773513014441411 3.537762800513723 4.309235277900000 4.002278495651890 - 4.124103654261368 1.771213000543424 3.864752062532702 4.468184401000000 - 4.481956278333824 4.902394508200000 5.956274037802311 7.211686591187319 - 6.204787608200000 5.376059458542183 5.023511032618925 3.156887023825594 - 2.932344993803476 2.999897908513799 3.895407345300000 2.991138620007669 - 2.096199593475473 1.780803572610500 3.558049006448599 4.023841260600000 - 3.682633555857166 4.808718037700000 5.741243604492526 5.884448203300000 - 3.398137040446693 5.432746439707773 4.729707784043235 3.970010356404483 - 3.414577863946629 3.650628980600000 2.605234605568324 2.392978757746573 - 3.096075853472831 4.009206356643173 3.441595274000000 3.721594130855455 - 4.593424600900000 5.282881132500000 4.829846631500000 4.757532777700000 - 4.724977904200000 3.565638428500000 3.561336656700000 3.927304556400000 - 3.766477911800000 3.586169976100000 3.552319162700000 4.650867246300000 - 4.242430826000000 4.098772778300000 4.507966992900000 4.222264575400000 - 3.568880377430671 1.710507474941357 0.726915001472055 2.519422404183540 - 3.136598518800000 2.564808696931206 3.101026335222954 2.213396947938416 - 3.343125814753411 3.444306825200000 2.416478592751639 4.091530576300000 + 3.879075507100000 3.587826217700000 4.645743255500000 + + 5.434261193691611 6.009504353949445 5.751833613689151 4.388369927131041 + 6.139482146000000 4.432779364180328 3.635448013213493 3.042556269070575 + 1.858255457238648 3.619846653665197 3.902273188000000 2.840826371233924 + 1.901219059651194 3.010635482615414 2.681361243261458 3.871192813400000 + 3.639660062795308 4.487266103000000 + + 7.144249845164532 5.950132764851209 5.636408114630104 6.256568766200000 + 4.721753486138623 5.072743940945156 4.725634408062251 3.773513014441411 + 3.537762800513723 4.309235277900000 4.002278495651890 4.124103654261368 + 1.771213000543424 3.864752062532702 4.468184401000000 4.481956278333824 + 4.902394508200000 + + 5.956274037802311 7.211686591187319 6.204787608200000 5.376059458542183 + 5.023511032618925 3.156887023825594 2.932344993803476 2.999897908513799 + 3.895407345300000 2.991138620007669 2.096199593475473 1.780803572610500 + 3.558049006448599 4.023841260600000 3.682633555857166 4.808718037700000 + + 5.741243604492526 5.884448203300000 3.398137040446693 5.432746439707773 + 4.729707784043235 3.970010356404483 3.414577863946629 3.650628980600000 + 2.605234605568324 2.392978757746573 3.096075853472831 4.009206356643173 + 3.441595274000000 3.721594130855455 4.593424600900000 + + 5.282881132500000 4.829846631500000 4.757532777700000 4.724977904200000 + 3.565638428500000 3.561336656700000 3.927304556400000 3.766477911800000 + 3.586169976100000 3.552319162700000 4.650867246300000 4.242430826000000 + 4.098772778300000 4.507966992900000 + + 4.222264575400000 3.568880377430671 1.710507474941357 0.726915001472055 + 2.519422404183540 3.136598518800000 2.564808696931206 3.101026335222954 + 2.213396947938416 3.343125814753411 3.444306825200000 2.416478592751639 + 4.091530576300000 + 4.157487725645439 3.262380685905436 2.953659747759453 1.237209789211462 2.500185737000000 1.984183152198450 1.368828812773212 2.060401072298498 2.863410468895249 2.015232903800000 1.541966676954322 3.639585254600000 + 2.501655793500000 2.394681323067151 2.071384505085577 1.074154474700000 0.985099710786774 0.001985439127056 0.921773098679111 5.126752085199419 - 1.500212764900000 -0.018286801754111 3.538112898500000 2.248058879145623 - 2.683627337507786 1.505360785600000 -0.706299059260768 1.284606704482992 - 1.109202790492530 2.070407759035996 1.983305353800000 -0.008577364700000 - 2.955755366600000 1.280003824300000 0.768980610000000 0.625889188870640 - 1.535343520692143 0.574105444778441 1.174671233709513 1.497548217400000 - -0.665902088339257 2.941502147900000 -0.679242885900000 0.453238323900000 - -0.759038766000000 -0.361703484600000 1.680327505800000 0.677520998800000 - -0.535483746800000 2.620859136300000 0.290068410287431 -0.092399325129687 - 1.982203632452388 0.078357579868221 0.389638827500000 -0.177470106993247 - 2.325532607700000 -3.392465857895507 -1.871634582322480 1.071505323254014 - 2.748917412400000 1.802089391960750 1.797571866700000 -1.397996047062832 - 0.263585152937208 2.820287379000000 1.642062410367716 1.862509124700000 + 1.500212764900000 -0.018286801754111 3.538112898500000 + + 2.248058879145623 2.683627337507786 1.505360785600000 -0.706299059260768 + 1.284606704482992 1.109202790492530 2.070407759035996 1.983305353800000 + -0.008577364700000 2.955755366600000 + + 1.280003824300000 0.768980610000000 0.625889188870640 1.535343520692143 + 0.574105444778441 1.174671233709513 1.497548217400000 -0.665902088339257 + 2.941502147900000 + + -0.679242885900000 0.453238323900000 -0.759038766000000 -0.361703484600000 + 1.680327505800000 0.677520998800000 -0.535483746800000 2.620859136300000 + + 0.290068410287431 -0.092399325129687 1.982203632452388 0.078357579868221 + 0.389638827500000 -0.177470106993247 2.325532607700000 + + -3.392465857895507 -1.871634582322480 1.071505323254014 2.748917412400000 + 1.802089391960750 1.797571866700000 + + -1.397996047062832 0.263585152937208 2.820287379000000 1.642062410367716 + 1.862509124700000 + 3.729277869700000 2.294443648100000 -0.070327972331951 3.111577617700000 - -0.082736296100000 -1.604311318200000 2.443983743500000 -3.048709356063184 - 2.366463453300000 4.192796926000000 2.674806001700000 2.733881014500000 - 2.966464722900000 2.881963673700000 3.021073815000000 2.841428615200000 - 2.477343866000000 2.461194378800000 2.465320121300000 2.492508737100000 - 2.573476775100000 2.456402674400000 2.484782528100000 2.488928923300000 - 2.508951764500000 2.508333838300000 2.422062272300000 2.271460977000000 - 2.452070308900000 2.702612978800000 4.927215476100000 5.105428423000000 - 4.207351616500000 4.851397283700000 2.784887529300000 3.582986163400000 - 7.866021757600000 7.429920984700000 1.962593983200000 0.798776956900000 - 4.058089968100000 1.888902103200000 3.198719702600000 3.267327453800000 - 2.684813190400000 2.004302740400000 6.244634191000000 8.195945209500000 - 13.474829585800000 2.663237683700000 0.869902301100000 1.054066001400000 - 0.938590929800000 1.026327410100000 1.083527704500000 1.054318388600000 - 0.788868699600000 0.898930583300000 1.003996287500000 1.242751812800000 - 0.893280172400000 0.917392899000000 1.615769565700000 1.431586037300000 - 2.049831787900000 1.419961554600000 0.993367797100000 1.431962560000000 - 27.495176328800000 0.778802528600000 0.010369755600000 0.061138567400000 - 0.044830334600000 0.039283178200000 0.085416633800000 0.039889661900000 - 0.024949656900000 0.023241090800000 0.086137910000000 -0.075479418500000 - -0.026614602100000 -0.016342909900000 0.057216710300000 -0.046860882500000 - 0.015104845500000 0.008496367800000 0.027893039700000 0.007692291100000 - 0.103353673800000 -0.009825603600000 + + -0.082736296100000 -1.604311318200000 2.443983743500000 + + -3.048709356063184 2.366463453300000 + + 4.192796926000000 + + 2.674806001700000 2.733881014500000 2.966464722900000 2.881963673700000 + 3.021073815000000 2.841428615200000 2.477343866000000 2.461194378800000 + 2.465320121300000 2.492508737100000 2.573476775100000 2.456402674400000 + 2.484782528100000 2.488928923300000 2.508951764500000 2.508333838300000 + 2.422062272300000 2.271460977000000 2.452070308900000 2.702612978800000 + + 4.927215476100000 5.105428423000000 4.207351616500000 4.851397283700000 + 2.784887529300000 3.582986163400000 7.866021757600000 7.429920984700000 + 1.962593983200000 0.798776956900000 4.058089968100000 1.888902103200000 + 3.198719702600000 3.267327453800000 2.684813190400000 2.004302740400000 + 6.244634191000000 8.195945209500000 13.474829585800000 2.663237683700000 + + 0.869902301100000 1.054066001400000 0.938590929800000 1.026327410100000 + 1.083527704500000 1.054318388600000 0.788868699600000 0.898930583300000 + 1.003996287500000 1.242751812800000 0.893280172400000 0.917392899000000 + 1.615769565700000 1.431586037300000 2.049831787900000 1.419961554600000 + 0.993367797100000 1.431962560000000 27.495176328800000 0.778802528600000 + + 0.010369755600000 0.061138567400000 0.044830334600000 0.039283178200000 + 0.085416633800000 0.039889661900000 0.024949656900000 0.023241090800000 + 0.086137910000000 -0.075479418500000 -0.026614602100000 -0.016342909900000 + 0.057216710300000 -0.046860882500000 0.015104845500000 0.008496367800000 + 0.027893039700000 0.007692291100000 0.103353673800000 -0.009825603600000 diff --git a/PARAM/scinter_GB.parm b/PARAM/scinter_GB.parm index f719e87..aff048a 100644 --- a/PARAM/scinter_GB.parm +++ b/PARAM/scinter_GB.parm @@ -4,71 +4,99 @@ 5.2638423822 5.4961954124 4.2928124162 4.3582250540 4.2667755921 3.6813845958 3.5405429647 3.7026985912 4.7177596156 3.3811992227 3.7936085458 4.5157490585 + 6.6296746680 6.6717260508 6.8168876945 6.8378960152 6.3512039986 6.1425192423 5.5200206406 5.4858936024 4.9382573262 4.2795129166 4.0534857018 4.2086428525 3.5388086279 3.4209730327 2.7995744193 4.8164268553 - 3.8790755071 3.5878262177 4.6457432555 6.6424306340 - 6.9715947250 6.9241225787 6.5291325353 6.1394821460 - 5.4415971840 5.2914044780 4.7881880526 4.1302408718 - 3.9405275117 3.9022731880 3.6078928145 3.0809713206 - 3.0182595342 4.7935507272 3.8711928134 3.6826168780 - 4.4872661030 7.3271707934 7.2970176793 7.0494948235 - 6.2565687662 5.8133715113 5.8845382769 5.3463553241 - 4.7146928716 4.4864793359 4.3092352779 3.6928361281 - 4.0100566871 3.6584608489 4.5901676001 4.4681844010 - 4.6334334282 4.9023945082 7.0106342493 6.8341607204 - 6.2047876082 5.5802122247 5.6716968726 5.2011344932 - 4.1966522349 4.2383931955 3.8954073453 3.5679086118 - 3.1136348127 2.7622561241 4.5092053374 4.0238412606 - 3.9799853578 4.8087180377 6.5353606708 5.8844482033 - 5.1100976261 5.5515360893 4.9587559238 4.2030790774 - 4.0351600709 3.6506289806 3.4640416936 3.1611022087 - 2.7976192835 4.0422832763 3.4415952740 3.8620694983 - 4.5934246009 5.2828811325 4.8298466315 4.7575327777 - 4.7249779042 3.5656384285 3.5613366567 3.9273045564 - 3.7664779118 3.5861699761 3.5523191627 4.6508672463 - 4.2424308260 4.0987727783 4.5079669929 4.2222645754 - 4.1627149417 3.9786372270 3.1623319201 2.9379696734 - 3.1365985188 2.8025851476 2.6576343487 2.8733395837 - 3.8785891655 3.4443068252 3.4405132673 4.0915305763 + 3.8790755071 3.5878262177 4.6457432555 + + 6.6424306340 6.9715947250 6.9241225787 6.5291325353 + 6.1394821460 5.4415971840 5.2914044780 4.7881880526 + 4.1302408718 3.9405275117 3.9022731880 3.6078928145 + 3.0809713206 3.0182595342 4.7935507272 3.8711928134 + 3.6826168780 4.4872661030 + + 7.3271707934 7.2970176793 7.0494948235 6.2565687662 + 5.8133715113 5.8845382769 5.3463553241 4.7146928716 + 4.4864793359 4.3092352779 3.6928361281 4.0100566871 + 3.6584608489 4.5901676001 4.4681844010 4.6334334282 + 4.9023945082 + 7.0106342493 6.8341607204 6.2047876082 5.5802122247 + 5.6716968726 5.2011344932 4.1966522349 4.2383931955 + 3.8954073453 3.5679086118 3.1136348127 2.7622561241 + 4.5092053374 4.0238412606 3.9799853578 4.8087180377 + + 6.5353606708 5.8844482033 5.1100976261 5.5515360893 + 4.9587559238 4.2030790774 4.0351600709 3.6506289806 + 3.4640416936 3.1611022087 2.7976192835 4.0422832763 + 3.4415952740 3.8620694983 4.5934246009 + + 5.2828811325 4.8298466315 4.7575327777 4.7249779042 + 3.5656384285 3.5613366567 3.9273045564 3.7664779118 + 3.5861699761 3.5523191627 4.6508672463 4.2424308260 + 4.0987727783 4.5079669929 + + 4.2222645754 4.1627149417 3.9786372270 3.1623319201 + 2.9379696734 3.1365985188 2.8025851476 2.6576343487 + 2.8733395837 3.8785891655 3.4443068252 3.4405132673 + 4.0915305763 + 4.3860654351 3.6520014167 3.0264937881 2.5680579493 2.5001857370 2.1393094782 1.4707077389 1.7373181916 3.1045342752 2.0152329038 1.8196209136 3.6395852546 + 2.5016557935 2.7879606493 2.1424756816 1.0741544747 1.3236438850 -.2712356678 .7613312181 2.8627348285 - 1.5002127649 -.2392577636 3.5381128985 2.2903847447 - 2.2466771550 1.5053607856 1.4031797188 .9676209687 - 1.3075541842 2.8595118604 1.9833053538 -.0085773647 - 2.9557553666 1.2800038243 .7689806100 .9119606366 - -.0744371793 .3669965427 2.4288563200 1.4975482174 - -.2134101897 2.9415021479 -.6792428859 .4532383239 - -.7590387660 -.3617034846 1.6803275058 .6775209988 - -.5354837468 2.6208591363 .4136122500 -.1637152873 - .2212564728 2.1287126020 .3896388275 -.2354089650 - 2.3255326077 -3.5193531074 -2.0157307929 1.8355926160 - 2.7489174124 2.0098391558 1.7975718667 -1.3532688232 - 2.5504275249 2.8202873790 1.6253609671 1.8625091247 + 1.5002127649 -.2392577636 3.5381128985 + + 2.2903847447 2.2466771550 1.5053607856 1.4031797188 + .9676209687 1.3075541842 2.8595118604 1.9833053538 + -.0085773647 2.9557553666 + + 1.2800038243 .7689806100 .9119606366 -.0744371793 + .3669965427 2.4288563200 1.4975482174 -.2134101897 + 2.9415021479 + -.6792428859 .4532383239 -.7590387660 -.3617034846 + 1.6803275058 .6775209988 -.5354837468 2.6208591363 + + .4136122500 -.1637152873 .2212564728 2.1287126020 + .3896388275 -.2354089650 2.3255326077 + + -3.5193531074 -2.0157307929 1.8355926160 2.7489174124 + 2.0098391558 1.7975718667 + + -1.3532688232 2.5504275249 2.8202873790 1.6253609671 + 1.8625091247 + 3.7292778697 2.2944436481 -.0303565255 3.1115776177 - -.0827362961 -1.6043113182 2.4439837435 -4.3897783280 - 2.3664634533 4.1927969260 2.6748060017 2.7338810145 - 2.9664647229 2.8819636737 3.0210738150 2.8414286152 - 2.4773438660 2.4611943788 2.4653201213 2.4925087371 - 2.5734767751 2.4564026744 2.4847825281 2.4889289233 - 2.5089517645 2.5083338383 2.4220622723 2.2714609770 - 2.4520703089 2.7026129788 4.9272154761 5.1054284230 - 4.2073516165 4.8513972837 2.7848875293 3.5829861634 - 7.8660217576 7.4299209847 1.9625939832 .7987769569 - 4.0580899681 1.8889021032 3.1987197026 3.2673274538 - 2.6848131904 2.0043027404 6.2446341910 8.1959452095 - 13.4748295858 2.6632376837 .8699023011 1.0540660014 - .9385909298 1.0263274101 1.0835277045 1.0543183886 - .7888686996 .8989305833 1.0039962875 1.2427518128 - .8932801724 .9173928990 1.6157695657 1.4315860373 - 2.0498317879 1.4199615546 .9933677971 1.4319625600 - 27.4951763288 .7788025286 .0103697556 .0611385674 - .0448303346 .0392831782 .0854166338 .0398896619 - .0249496569 .0232410908 .0861379100 -.0754794185 - -.0266146021 -.0163429099 .0572167103 -.0468608825 - .0151048455 .0084963678 .0278930397 .0076922911 - .1033536738 -.0098256036 + + -.0827362961 -1.6043113182 2.4439837435 + + -4.3897783280 2.3664634533 + + 4.1927969260 + + 2.6748060017 2.7338810145 2.9664647229 2.8819636737 + 3.0210738150 2.8414286152 2.4773438660 2.4611943788 + 2.4653201213 2.4925087371 2.5734767751 2.4564026744 + 2.4847825281 2.4889289233 2.5089517645 2.5083338383 + 2.4220622723 2.2714609770 2.4520703089 2.7026129788 + + 4.9272154761 5.1054284230 4.2073516165 4.8513972837 + 2.7848875293 3.5829861634 7.8660217576 7.4299209847 + 1.9625939832 .7987769569 4.0580899681 1.8889021032 + 3.1987197026 3.2673274538 2.6848131904 2.0043027404 + 6.2446341910 8.1959452095 13.4748295858 2.6632376837 + + .8699023011 1.0540660014 .9385909298 1.0263274101 + 1.0835277045 1.0543183886 .7888686996 .8989305833 + 1.0039962875 1.2427518128 .8932801724 .9173928990 + 1.6157695657 1.4315860373 2.0498317879 1.4199615546 + .9933677971 1.4319625600 27.4951763288 .7788025286 + + .0103697556 .0611385674 .0448303346 .0392831782 + .0854166338 .0398896619 .0249496569 .0232410908 + .0861379100 -.0754794185 -.0266146021 -.0163429099 + .0572167103 -.0468608825 .0151048455 .0084963678 + .0278930397 .0076922911 .1033536738 -.0098256036 diff --git a/PARAM/scinter_GB_ext.parm b/PARAM/scinter_GB_ext.parm index 7f3e726..cae5b65 100644 --- a/PARAM/scinter_GB_ext.parm +++ b/PARAM/scinter_GB_ext.parm @@ -134,3 +134,112 @@ .0572167103 -.0468608825 .0151048455 .0084963678 .0278930397 .0076922911 .1033536738 -.0098256036 .0611385674 .0448303346 .0861379100 .0861379100 + + 5.6053537261 6.2200032154 6.2159898496 6.4386968963 + 6.2098101231 5.9596374798 5.4310222662 4.8790085257 + 5.2638423822 5.4961954124 4.2928124162 4.3582250540 + 4.2667755921 3.6813845958 3.5405429647 3.7026985912 + 4.7177596156 3.3811992227 3.7936085458 4.5157490585 + 6.2200032154 6.2159898496 5.2638423822 5.2638423822 + + 6.6296746680 6.6717260508 6.8168876945 6.8378960152 + 6.3512039986 6.1425192423 5.5200206406 5.4858936024 + 4.9382573262 4.2795129166 4.0534857018 4.2086428525 + 3.5388086279 3.4209730327 2.7995744193 4.8164268553 + 3.8790755071 3.5878262177 4.6457432555 6.6296746680 + 6.6717260508 5.4858936024 5.4858936024 + + 6.6424306340 6.9715947250 6.9241225787 6.5291325353 + 6.1394821460 5.4415971840 5.2914044780 4.7881880526 + 4.1302408718 3.9405275117 3.9022731880 3.6078928145 + 3.0809713206 3.0182595342 4.7935507272 3.8711928134 + 3.6826168780 4.4872661030 6.6717260508 6.6424306340 + 5.2914044780 5.2914044780 + + 7.3271707934 7.2970176793 7.0494948235 6.2565687662 + 5.8133715113 5.8845382769 5.3463553241 4.7146928716 + 4.4864793359 4.3092352779 3.6928361281 4.0100566871 + 3.6584608489 4.5901676001 4.4681844010 4.6334334282 + 4.9023945082 6.8168876945 6.9715947250 5.8845382769 + 5.8845382769 + + 7.0106342493 6.8341607204 6.2047876082 5.5802122247 + 5.6716968726 5.2011344932 4.1966522349 4.2383931955 + 3.8954073453 3.5679086118 3.1136348127 2.7622561241 + 4.5092053374 4.0238412606 3.9799853578 4.8087180377 + 6.8378960152 6.9241225787 5.6716968726 5.6716968726 + + 6.5353606708 5.8844482033 5.1100976261 5.5515360893 + 4.9587559238 4.2030790774 4.0351600709 3.6506289806 + 3.4640416936 3.1611022087 2.7976192835 4.0422832763 + 3.4415952740 3.8620694983 4.5934246009 6.3512039986 + 6.5291325353 5.5515360893 5.5515360893 + + 5.2828811325 4.8298466315 4.7575327777 4.7249779042 + 3.5656384285 3.5613366567 3.9273045564 3.7664779118 + 3.5861699761 3.5523191627 4.6508672463 4.2424308260 + 4.0987727783 4.5079669929 6.1425192423 6.1394821460 + 4.7575327777 4.7575327777 + + 4.2222645754 4.1627149417 3.9786372270 3.1623319201 + 2.9379696734 3.1365985188 2.8025851476 2.6576343487 + 2.8733395837 3.8785891655 3.4443068252 3.4405132673 + 4.0915305763 5.5200206406 5.4415971840 4.1627149417 + 4.1627149417 + + 4.3860654351 3.6520014167 3.0264937881 2.5680579493 + 2.5001857370 2.1393094782 1.4707077389 1.7373181916 + 3.1045342752 2.0152329038 1.8196209136 3.6395852546 + 5.4858936024 5.2914044780 4.3860654351 4.3860654351 + + 2.5016557935 2.7879606493 2.1424756816 1.0741544747 + 1.3236438850 -.2712356678 .7613312181 2.8627348285 + 1.5002127649 -.2392577636 3.5381128985 4.9382573262 + 4.7881880526 3.6520014167 3.6520014167 + + 2.2903847447 2.2466771550 1.5053607856 1.4031797188 + .9676209687 1.3075541842 2.8595118604 1.9833053538 + -.0085773647 2.9557553666 4.2795129166 4.1302408718 + 3.0264937881 3.0264937881 + + 1.2800038243 .7689806100 .9119606366 -.0744371793 + .3669965427 2.4288563200 1.4975482174 -.2134101897 + 2.9415021479 4.0534857018 3.9405275117 2.5680579493 + 2.5680579493 + + -.6792428859 .4532383239 -.7590387660 -.3617034846 + 1.6803275058 .6775209988 -.5354837468 2.6208591363 + 4.2086428525 3.9022731880 2.5001857370 2.5001857370 + + .4136122500 -.1637152873 .2212564728 2.1287126020 + .3896388275 -.2354089650 2.3255326077 3.5388086279 + 3.6078928145 2.1393094782 2.1393094782 + + -3.5193531074 -2.0157307929 1.8355926160 2.7489174124 + 2.0098391558 1.7975718667 3.4209730327 3.0809713206 + 1.4707077389 1.4707077389 + + -1.3532688232 2.5504275249 2.8202873790 1.6253609671 + 1.8625091247 2.7995744193 3.0182595342 1.7373181916 + 1.7373181916 + + 3.7292778697 2.2944436481 -.0303565255 3.1115776177 + 4.8164268553 4.7935507272 3.1045342752 3.1045342752 + + -.0827362961 -1.6043113182 2.4439837435 3.8790755071 + 3.8711928134 2.0152329038 2.0152329038 + + -4.3897783280 2.3664634533 3.5878262177 3.6826168780 + 1.8196209136 1.8196209136 + + 4.1927969260 4.6457432555 4.4872661030 3.6395852546 + 3.6395852546 + + 6.6296746680 6.6717260508 5.4858936024 5.4858936024 + + 6.6424306340 5.2914044780 5.2914044780 + + 4.3860654351 4.3860654351 + + 4.3860654351 + diff --git a/PARAM/scparm.adam_30_10_2013 b/PARAM/scparm.adam_30_10_2013 deleted file mode 100644 index 5975e53..0000000 --- a/PARAM/scparm.adam_30_10_2013 +++ /dev/null @@ -1,212 +0,0 @@ - 6 6 0 -2 0 0 0 0 0 0 2 0 0 2 2 2 2 -1 -1 2 1 1 0 -0.000197 7.877 0.080 0.080 -0.212 -0.212 0.3271 10.9336 9.3925 32.1007 5.930 5.930 0.080 0.080 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.95 183.96 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Cys Cys -0.006280 5.701 0.286 0.003 0.207 -0.998 0.1875 10.4300 10.8900 4.4000 7.570 4.030 0.043 -0.039 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Met Cys -0.222400 4.390 0.587 0.587 0.892 0.892 9.1300 -0.2700 0.6570 33.0700 9.590 0.000 0.210 0.210 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Met Met -0.000080 7.550 0.167 -0.011 -0.036 -0.998 0.1100 0.1380 6.2041 4.6801 6.670 3.550 0.203 0.027 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Phe Cys -0.003194 6.010 0.370 0.374 0.078 -0.487 0.2127 12.9137 11.7580 4.5435 3.784 7.777 0.172 0.279 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Phe Met -0.235600 4.760 0.581 0.581 0.914 0.914 0.8380 2.8800 2.8400 33.0900 10.830 0.000 0.157 0.157 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Phe Phe -0.000290 7.360 -0.030 0.186 -0.998 0.225 0.2800 12.9400 12.4300 4.4000 3.730 7.020 0.040 0.080 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ile Cys -0.010800 5.450 0.444 0.464 0.419 0.960 13.5000 -0.2200 0.6900 32.7000 6.900 7.040 0.270 0.210 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ile Met -0.000600 6.790 0.346 0.279 -0.372 0.371 0.2700 13.2400 11.8100 4.5000 8.000 3.890 0.250 0.130 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ile Phe -0.042804 6.204 0.322 0.322 0.546 0.546 135.4970 -0.5891 0.4237 14.3730 10.360 0.000 0.171 0.171 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ile Ile -0.001160 7.365 0.186 -0.003 0.225 -0.998 0.3000 12.9400 12.4300 4.4000 7.017 3.733 0.080 0.041 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Leu Cys -0.043412 5.454 0.464 0.444 0.960 0.419 13.4913 -0.2275 0.6761 32.7382 7.040 6.897 0.213 0.267 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Leu Met -0.002156 6.778 0.278 0.346 0.371 -0.372 0.2682 13.2550 11.8186 4.4958 3.893 8.000 0.128 0.254 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Leu Phe -0.042804 6.204 0.322 0.322 0.546 0.546 135.4970 -0.5891 0.4237 14.3730 10.360 0.000 0.171 0.171 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Leu Ile -0.042804 6.204 0.322 0.322 0.546 0.546 135.4970 -0.5891 0.4237 14.3730 10.360 0.000 0.171 0.171 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Leu Leu -0.009880 6.210 0.009 0.001 0.078 -0.998 0.3500 12.6700 11.7100 4.4000 6.760 3.600 0.053 0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Cys -0.067200 5.210 0.586 0.253 0.969 0.531 4.5500 1.4100 2.1100 11.0000 4.630 6.420 0.060 -0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Met -0.007200 6.020 0.308 0.414 0.734 0.314 0.3300 8.3600 7.5100 3.8000 4.280 8.040 0.040 0.200 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Phe -0.094380 5.685 0.425 0.245 0.990 0.250 9.6350 0.1459 0.9445 31.8673 5.686 7.894 0.067 -0.198 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Ile -0.094380 5.685 0.425 0.245 0.990 0.250 9.6350 0.1459 0.9445 31.8673 5.686 7.894 0.067 -0.198 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Leu -0.009271 7.054 0.158 0.158 0.267 0.267 149.7620 -0.5569 0.4477 5.8356 8.890 0.000 0.105 0.105 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Val Val -0.000108 7.106 0.112 0.089 -0.998 -0.032 0.1223 11.8285 11.0475 4.0572 4.828 9.076 -0.098 -0.126 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Cys -0.007200 5.460 0.481 0.411 -0.505 0.191 0.2072 12.7699 12.4181 4.4804 8.160 3.970 0.220 0.150 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Met -0.179176 4.690 0.589 0.664 0.849 0.993 0.1885 13.8793 12.6256 4.2956 9.020 4.389 0.167 0.349 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Phe -0.024976 5.334 0.547 0.445 0.428 0.978 0.2044 13.2230 12.1844 4.4618 8.227 4.003 0.234 0.017 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Ile -0.024976 5.334 0.547 0.445 0.428 0.978 0.2044 13.2230 12.1844 4.4618 8.227 4.003 0.234 0.017 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Leu -0.009600 5.720 0.505 0.310 0.424 0.779 0.2000 13.1600 12.2500 4.5000 8.230 4.000 0.190 -0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Val -0.756400 3.864 0.750 0.750 0.992 0.992 6.8186 -1.0347 0.3512 32.7335 8.716 0.000 0.002 0.002 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Trp Trp -0.003008 5.596 0.103 0.148 -0.997 0.121 0.1128 12.8934 13.3251 4.2332 4.299 8.082 -0.099 -0.065 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 1.69 179.36 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Cys -0.000140 7.130 0.062 0.203 -0.998 0.074 0.2000 12.8000 11.0300 3.9000 5.220 9.810 -0.200 -0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Met -0.000116 8.160 0.015 0.129 -0.998 0.056 0.1625 15.3200 13.7100 3.8000 5.230 9.830 -0.010 -0.360 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Phe -0.000400 7.300 0.084 0.196 -0.998 0.199 0.1925 14.1200 13.2400 4.1000 4.580 8.610 -0.080 -0.060 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Ile -0.000400 7.300 0.084 0.196 -0.998 0.199 0.1925 14.1200 13.2400 4.1000 4.580 8.610 -0.080 -0.060 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Leu -0.000200 7.847 0.083 0.081 -0.998 0.059 0.1695 13.5461 13.3751 4.1859 4.368 8.210 -0.043 -0.009 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Val -0.000057 8.490 0.091 0.027 -0.024 -0.998 0.1510 16.4500 13.8400 3.4000 10.950 5.820 -0.326 -0.030 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Trp -0.000324 7.329 0.063 0.063 -0.304 -0.304 0.2174 14.2600 11.6496 32.0500 8.598 8.598 -0.232 -0.232 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.58 183.50 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Tyr Tyr -0.008364 5.626 0.013 0.186 -0.998 0.118 0.3450 11.8400 11.0800 4.6000 3.240 6.080 0.090 0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Cys -0.029696 4.997 0.377 0.383 0.821 0.386 12.1823 -0.2949 0.6215 31.2556 5.388 7.464 0.099 0.831 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Met -0.000272 7.170 0.142 0.206 -0.006 -0.750 0.1790 12.6554 11.4120 4.3202 3.899 7.330 0.074 0.092 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Phe -0.001472 7.202 0.154 0.249 0.088 0.704 12.2400 -0.1000 0.7600 31.3000 5.341 7.415 0.096 0.126 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Ile -0.000400 7.200 0.154 0.249 0.088 0.704 12.2400 -0.1000 0.7600 31.3000 5.340 7.410 0.100 0.130 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Leu -0.002052 7.006 0.317 0.111 0.869 0.121 9.3652 0.2400 0.9894 32.0718 7.046 5.075 0.066 0.081 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Val -0.000236 7.034 0.103 0.324 -0.290 -0.096 0.1648 13.1732 11.7606 4.4984 3.898 8.010 0.084 -0.175 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Trp -0.000165 7.120 0.100 0.099 0.023 -0.998 0.1400 13.1600 12.7400 4.2000 8.010 4.260 -0.100 -0.100 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Tyr -0.002000 6.400 0.238 0.238 0.503 0.503 16.6000 -0.0800 0.7800 31.7000 7.460 0.000 0.160 0.160 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ala Ala -0.016040 5.080 0.005 0.097 0.024 -0.588 0.3150 11.7200 10.8400 4.5815 3.104 5.835 0.105 -0.003 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Cys -0.000002 9.490 0.124 -0.006 -0.997 -0.085 12.1500 -0.3600 0.5900 31.3000 5.160 7.160 0.230 -0.120 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Met -0.000010 6.930 0.423 0.033 -0.997 0.225 15.3800 -1.3100 -0.0500 31.4000 3.330 4.620 0.530 -0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Phe -0.000020 8.790 0.018 -0.011 -0.997 -0.042 12.6200 -0.1500 0.7300 31.3000 4.940 6.860 0.150 -0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Ile -0.000020 8.790 0.018 -0.011 -0.997 -0.042 12.6200 -0.1500 0.7300 31.3000 4.940 6.860 0.150 -0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Leu -0.000100 7.690 -0.036 0.007 -0.997 0.000 12.8800 -0.0900 0.7700 31.3000 4.800 6.660 0.110 -0.020 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Val -0.000002 8.050 0.132 0.004 -0.997 0.014 15.6200 -1.0900 0.0900 31.4000 3.140 4.360 0.620 -0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Trp -0.001400 5.530 -0.013 0.143 -0.062 -0.998 0.1175 11.1700 10.9600 4.3751 7.506 3.993 -0.075 0.004 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Tyr -0.000020 7.920 0.039 0.005 -0.997 0.002 13.6700 -0.0500 0.8100 31.3000 4.240 5.880 0.190 0.010 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Ala -0.004000 5.130 0.000 0.000 0.000 0.000 90.0000 -39.9000 50.6000 0.0100 0.000 0.000 0.000 0.000 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gly Gly -0.013480 5.828 -0.032 0.161 -0.997 0.084 0.2731 11.9626 11.5580 4.5258 3.356 6.309 0.134 0.075 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.61 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Cys -0.005600 6.080 -0.032 0.240 -0.998 0.063 0.2100 10.4100 10.6400 4.4000 3.930 7.380 0.090 0.080 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Met -0.000078 8.080 -0.019 0.146 -0.998 -0.056 0.1125 0.1100 5.9200 4.7000 3.430 6.450 0.160 0.210 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Phe -0.018120 6.100 -0.008 0.232 -0.998 0.259 0.3550 10.4200 10.3000 4.5000 3.720 7.000 0.110 0.100 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Ile -0.018120 6.100 -0.008 0.232 -0.998 0.259 0.3550 10.4200 10.3000 4.5000 3.720 7.000 0.110 0.100 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Leu -0.020280 6.130 0.043 0.078 -0.553 0.012 0.3600 12.7700 11.6800 4.4000 3.620 6.800 0.120 0.050 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Val -0.000024 8.230 0.115 0.128 0.073 -0.998 0.1120 0.0400 6.8500 4.7000 6.780 3.610 0.090 0.300 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Trp -0.009648 5.192 0.030 0.326 -0.997 0.249 0.0859 10.2929 14.4122 4.4484 3.827 7.194 0.037 0.068 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.48 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Tyr -0.014760 5.570 0.042 0.176 -0.732 0.079 0.3500 11.9100 11.2500 4.5000 3.250 6.100 0.150 0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Ala -0.015080 5.400 0.045 -0.036 -0.669 -0.071 0.3500 11.7900 10.8400 4.6000 3.100 5.830 0.170 -0.010 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Gly -0.000688 7.762 0.048 0.048 -0.250 -0.250 0.3906 11.4382 9.2197 32.0969 6.086 6.086 0.142 0.142 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 1.61 184.04 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Thr Thr -0.015776 5.424 0.024 0.177 -0.997 0.124 0.2647 12.1584 11.1709 4.5274 3.318 6.237 0.103 0.081 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.59 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Cys -0.000480 7.040 -0.008 0.220 -0.998 0.061 0.1700 12.7200 12.4300 4.4000 3.770 7.080 0.010 0.080 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Met -0.000060 7.910 -0.063 0.109 -0.998 -0.248 0.1100 0.0300 5.9500 4.7000 3.430 6.450 0.060 0.270 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Phe -0.002000 6.990 0.003 0.199 -0.998 0.262 0.2900 12.6200 12.1800 4.5000 3.580 6.730 0.060 0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Ile -0.002000 6.990 0.003 0.199 -0.998 0.262 0.2900 12.6200 12.1800 4.5000 3.580 6.730 0.060 0.070 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Leu -0.026800 5.730 0.092 0.082 -0.410 0.019 0.3525 12.3500 11.5600 4.5000 3.460 6.500 0.100 0.060 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Val -0.000087 7.110 0.100 0.108 -0.041 -0.998 0.1000 0.1600 5.7473 4.7378 6.290 3.350 0.490 0.470 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Trp -0.000112 7.362 -0.032 0.190 -0.997 0.030 0.0685 9.1227 14.8259 4.5192 3.679 6.916 -0.025 0.059 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 1.56 179.40 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Tyr -0.016000 5.390 0.093 0.158 -0.554 -0.061 0.4400 11.7300 10.9400 4.6000 3.070 5.770 0.140 0.110 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Ala -0.024400 4.970 0.109 -0.032 -0.545 -0.079 0.3700 11.6600 10.5500 4.6000 2.980 5.600 0.160 -0.010 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Gly -0.010352 5.840 -0.001 0.131 -0.997 0.067 0.2772 12.0542 11.2851 4.5199 3.342 6.282 0.101 0.137 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.42 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Thr -0.000528 7.070 0.068 0.068 -0.324 -0.324 0.3661 10.8060 8.7194 32.1058 5.522 5.522 0.134 0.134 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 2.30 184.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Ser Ser -0.010052 5.703 0.257 -0.013 0.249 -0.997 0.1875 12.1825 12.1306 4.4446 6.843 3.640 0.033 0.014 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.42 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Cys -0.000400 7.400 0.044 0.201 -0.998 0.217 0.2000 11.4100 10.8600 4.2000 4.420 8.310 -0.000 -0.050 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Met -0.000093 7.683 0.086 0.148 -0.998 -0.042 0.1150 7.8500 11.6600 4.4000 4.090 7.700 0.020 0.090 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Phe -0.007320 6.360 0.105 0.218 -0.998 0.336 0.3100 11.0100 10.6000 4.4000 4.010 7.530 0.070 0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Ile -0.007320 6.360 0.105 0.218 -0.998 0.336 0.3100 11.0100 10.6000 4.4000 4.010 7.530 0.070 0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Leu -0.000800 7.690 0.069 0.081 -0.998 0.109 0.3500 10.7100 10.2600 4.5000 3.750 7.050 0.090 0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Val -0.000288 6.720 0.255 0.109 0.289 -0.998 0.1750 12.8300 10.9800 3.8000 9.900 5.270 -0.100 -0.120 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Trp -0.000180 7.336 0.186 0.037 0.044 -0.997 0.1452 14.4248 13.2877 4.0013 8.985 4.780 -0.051 -0.081 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.013 179.48 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Tyr -0.003600 6.010 0.074 0.154 -0.998 0.109 0.2450 12.5600 11.6400 4.4300 3.640 6.850 0.060 -0.010 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Ala -0.003360 5.790 0.113 -0.112 -0.755 -0.409 0.2200 12.4000 11.2600 4.5000 3.460 6.500 0.150 0.000 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Gly -0.015524 5.754 0.278 -0.027 0.265 -0.997 0.2006 12.2612 11.9510 4.4501 6.780 3.610 0.121 0.125 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.51 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Thr -0.009616 5.714 0.231 -0.015 0.182 -0.997 0.1950 12.1742 11.8768 4.4644 3.563 6.797 0.049 0.053 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.30 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Ser -0.000697 7.245 0.118 0.118 -0.228 -0.228 0.2061 12.2797 11.0383 32.0897 6.725 6.725 0.060 0.060 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.014 183.35 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Gln Gln -0.006096 5.806 0.164 -0.009 -0.039 -0.997 0.1973 12.1786 11.7390 4.4732 6.628 3.526 0.094 0.063 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.424 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Cys -0.007708 5.605 0.043 0.296 -0.998 0.285 0.1800 10.5948 10.7968 4.3661 4.070 7.660 0.000 0.000 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Met -0.000106 7.428 0.014 0.158 -0.998 -0.051 0.1175 0.2640 6.2841 4.6946 3.510 6.600 0.055 0.198 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Phe -0.011252 6.000 0.041 0.216 -0.998 0.217 0.2500 12.2800 12.4400 4.4000 3.666 6.874 0.086 0.061 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Ile -0.011252 6.000 0.041 0.216 -0.998 0.217 0.2500 12.2800 12.4400 4.4000 3.666 6.874 0.086 0.061 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Leu -0.006752 6.267 0.037 0.089 -0.998 0.058 0.2850 12.9700 11.8700 4.4000 3.720 6.980 0.120 0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Val -0.000143 7.175 0.117 0.082 0.035 -0.998 0.1450 12.6300 11.2200 3.9000 9.850 5.240 -0.050 -0.200 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Trp -0.003332 5.556 0.192 0.106 0.140 -0.997 0.1008 11.2155 14.0582 4.3836 7.448 3.962 0.009 -0.002 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.35 179.43 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Tyr -0.009459 5.433 0.123 0.148 -0.495 -0.052 0.2551 11.9224 11.4828 4.5211 3.356 6.309 0.127 0.024 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Ala -0.009383 5.171 0.120 -0.062 -0.474 -0.218 0.2150 12.4599 10.8459 4.5009 3.365 6.326 0.163 -0.010 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Gly -0.011308 5.747 0.195 -0.019 0.081 -0.997 0.2110 11.9417 11.8032 4.4950 6.518 3.467 0.116 0.128 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.40 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Thr -0.007644 5.648 0.184 0.006 0.031 -0.997 0.2223 12.1536 11.4410 4.4967 6.448 3.430 0.130 0.080 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.31 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Ser -0.006264 5.872 0.022 0.231 -0.997 0.136 0.1547 11.3067 12.8547 4.828 3.597 6.762 0.085 0.066 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.016 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Gln -0.000215 7.676 0.079 0.079 -0.270 -0.270 0.3700 2.9643 4.5246 32.1181 5.584 5.584 0.108 0.108 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.021 183.35 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asn Asn -0.000090 7.820 0.033 0.126 -0.998 0.130 0.3700 12.4900 11.4300 4.5000 3.460 6.510 0.010 0.040 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 2.860000 1.14 2.08 0.00 1.15 0.00 0.69 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Cys -0.006550 6.004 -0.311 0.205 -0.998 0.011 2.4000 1.1648 1.9383 13.5638 4.412 7.954 -0.250 0.150 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 2.80 3.52 0.00 0.00 0.00 1.26 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Met -0.003800 6.250 -0.422 0.150 -0.998 -0.300 2.4600 0.0900 1.3900 13.6000 4.060 7.320 -0.230 0.260 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 2.07 2.72 0.00 0.00 0.00 1.24 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Phe -0.001900 7.340 -0.150 0.195 -0.998 0.348 2.6200 1.6200 2.3200 13.6000 4.190 7.550 0.350 -0.120 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 2.76 3.49 0.00 0.00 0.00 0.08 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Ile -0.001900 7.340 -0.150 0.195 -0.998 0.348 2.6200 1.6200 2.3200 13.6000 4.190 7.550 0.350 -0.120 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 2.76 3.49 0.00 0.00 0.00 1.29 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Leu -0.000470 8.250 -0.117 0.079 -0.998 0.148 2.5000 1.8500 2.4300 13.6000 4.070 7.330 -0.080 0.060 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 1.86 2.96 0.00 0.00 0.00 1.10 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Val -0.003250 5.950 -0.587 0.202 -0.998 -0.335 1.6500 0.1000 1.5500 13.7000 4.130 7.440 -0.290 0.290 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 1.45 2.63 0.00 0.00 0.00 1.16 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Trp -0.000068 7.844 -0.048 0.165 -0.998 -0.014 0.0568 6.4976 15.7526 4.6377 3.459 6.502 -0.069 0.290 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 2.753050 1.01 2.01 -0.045 1.07 0.00 0.07 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Tyr -0.000960 7.010 -0.149 0.139 -0.998 0.184 2.5500 1.4600 2.1500 13.6000 3.790 6.830 -0.130 0.060 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 1.68 2.70 0.00 0.00 0.00 0.98 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Ala -0.000760 6.830 -0.140 -0.031 -0.998 -0.110 2.7000 1.4300 1.9500 13.6000 3.540 6.390 -0.050 0.030 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.60 0.00 0.0000 0.000000 1.60 2.65 0.00 0.00 0.00 0.82 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Gly -0.000210 7.520 0.042 0.098 -0.998 0.129 0.2900 12.6400 11.5200 4.5000 3.550 6.670 0.040 0.080 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 2.960000 0.93 1.96 0.01 1.12 0.00 0.08 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Thr -0.000270 6.910 0.050 0.098 -0.998 -0.026 0.2600 12.5900 11.0500 4.5000 3.410 6.420 0.110 0.160 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 3.370000 0.96 1.98 5.29 1.24 0.00 0.09 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Ser -0.000150 7.510 0.035 0.195 -0.998 0.187 0.2500 13.1800 11.6900 4.4000 3.820 7.180 -0.010 0.050 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 2.820000 1.05 2.03 0.00 1.19 0.00 0.18 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Gln -0.002240 5.760 0.072 0.211 -0.998 0.162 0.2500 12.3600 11.7800 4.5000 3.570 6.720 -0.040 0.080 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.60 0.00 0.0100 2.960000 1.04 2.02 0.01 1.16 0.00 0.63 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Glu Asn -0.000002 5.543 -0.991 -0.991 -0.990 -0.990 1.3764 2.6088 5.6220 1.3378 4.376 4.376 0.077 0.077 1 0.00 0.00 0.00 0.00 0.50 0.00 0.50 0.00 0.60 0.60 0.0166 4.917740 0.34 0.34 0.00 0.00 0.00 0.88 0.88 -2.6781 1.7077 2.6394 1.9437 8.025 0.000 1.00 Glu Glu -0.002000 5.940 -0.019 0.151 -0.998 0.067 0.3800 12.2300 11.0100 4.5000 3.260 6.130 0.100 0.060 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 3.600000 2.96 3.97 0.13 0.99 0.00 0.86 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Cys -0.007600 5.530 -0.594 0.266 -0.998 -0.224 2.3150 0.0300 1.3700 13.7000 3.630 6.540 -0.110 0.340 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 2.53 3.29 0.00 0.00 0.00 1.24 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Met -0.003590 6.230 -0.445 0.162 -0.998 -0.255 1.9500 0.1500 1.5700 13.7000 3.810 6.860 -0.070 0.310 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 2.08 2.99 0.00 0.00 0.00 1.25 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Phe -0.011110 6.150 -0.232 0.249 -0.998 0.356 2.5000 0.0000 1.4900 13.7000 3.580 6.450 -0.050 0.130 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 2.68 3.54 0.00 0.00 0.00 1.30 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Ile -0.011110 6.150 -0.232 0.249 -0.998 0.356 2.5000 0.0000 1.4900 13.7000 3.580 6.450 -0.050 0.130 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 2.68 3.54 0.00 0.00 0.00 1.30 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Leu -0.001800 7.270 -0.152 0.069 -0.998 0.084 2.6500 1.9100 2.4600 13.6000 3.880 6.990 0.010 0.080 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 0.42 2.19 0.00 0.00 0.00 1.10 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Val -0.000100 6.890 -0.556 0.100 -0.599 -0.998 1.8500 0.0300 1.3500 13.7000 7.210 4.000 -0.150 0.370 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 0.56 2.36 0.00 0.00 0.00 1.11 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Trp -0.000019 8.712 -0.089 0.140 -0.998 -0.108 0.0369 1.1387 16.2194 4.8019 3.053 5.740 0.132 0.549 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 4.683640 3.02 4.02 -0.039 0.9107 0.00 0.06 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Tyr -0.000640 7.240 -0.166 0.136 -0.998 0.102 2.6000 1.6500 2.2700 13.7000 3.540 6.380 0.010 0.110 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 2.16 3.14 0.00 0.00 0.00 1.02 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Ala -0.000560 6.950 -0.138 -0.017 -0.998 -0.047 2.7000 1.6200 2.1200 13.7000 3.320 5.980 0.060 0.020 1 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.00 0.50 0.00 0.0000 0.000000 0.29 2.29 0.00 0.00 0.00 0.75 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Gly -0.003760 5.730 -0.054 0.189 -0.998 0.123 0.2500 13.0500 11.2200 4.5000 3.490 6.880 0.080 0.090 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 3.180000 3.05 3.82 1.69 1.18 0.00 0.10 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Thr -0.000090 7.650 -0.019 0.123 -0.998 0.039 0.3400 12.4100 10.9500 4.5000 3.290 6.180 0.100 0.100 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 2.810000 2.25 3.47 0.00 0.97 0.00 0.75 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Ser -0.002110 5.890 -0.026 0.246 -0.998 0.156 0.2200 12.4800 11.4700 4.5000 3.520 6.610 0.030 0.100 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 4.070000 3.04 4.03 0.10 1.00 0.00 0.32 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Gln -0.002910 5.530 0.030 0.199 -0.998 0.091 0.2300 12.0100 11.1100 4.5000 3.290 6.180 0.120 0.160 1 0.00 0.00 0.00 0.00 0.50 0.00 0.60 0.00 0.50 0.00 0.0100 2.900000 2.05 3.03 0.16 1.08 0.00 0.35 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Asp Asn -0.917580 3.967 0.083 0.059 0.992 0.395 2.3800 0.9900 1.6900 13.7000 3.500 6.300 0.480 -0.090 1 0.00 0.00 0.00 0.00 0.50 0.00 0.50 0.00 0.50 0.60 0.0001 4.990000 4.37 0.68 0.00 0.00 0.00 0.04 0.64 79.7000 51.2000 34.5000 4.6000 0.610 0.690 1.00 Asp Glu -0.000002 5.549 -0.279 -0.279 -0.990 -0.990 0.0300 -156.3600 15.7600 13.0000 4.440 4.440 0.070 0.070 1 0.00 0.00 0.00 0.00 0.50 0.00 0.50 0.00 0.50 0.50 0.0009 5.000000 0.34 0.34 0.00 0.00 0.00 0.94 0.94 13.2341 -1.0427 0.0983 33.2754 9.290 0.000 1.00 Asp Asp -0.005160 5.560 0.216 0.002 0.024 -0.997 0.1350 6.9300 9.7000 4.6000 6.780 3.610 0.130 0.003 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.43 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Cys -0.003400 5.670 0.081 0.294 -0.998 0.160 0.1175 11.9600 13.7300 4.3200 4.090 7.700 -0.090 -0.040 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Met -0.004080 5.550 0.100 0.299 -0.998 0.325 0.1400 10.5400 11.5200 4.3000 4.410 8.280 -0.150 -0.000 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Phe -0.004880 6.160 0.070 0.230 -0.998 0.209 0.1725 12.0700 13.2900 4.4000 3.960 7.430 0.020 -0.000 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Ile -0.004880 6.160 0.070 0.230 -0.998 0.209 0.1725 12.0700 13.2900 4.4000 3.960 7.430 0.020 -0.000 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Leu -0.000376 7.810 0.045 0.068 -0.998 0.034 0.2100 13.2400 12.2400 4.3000 4.030 7.570 0.050 0.030 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Val -0.000360 7.000 0.168 0.073 0.190 -0.998 0.2400 10.4400 11.0000 4.3000 7.940 4.220 -0.360 -0.260 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Trp -0.005976 5.487 0.244 0.115 0.291 -0.997 0.1560 12.4536 13.3776 4.3034 7.721 4.107 -0.175 -0.119 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.43 179.43 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Tyr -0.003216 5.682 0.089 0.150 -0.998 0.072 0.1450 11.8531 12.1434 4.4212 3.775 7.096 0.129 -0.065 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Ala -0.000056 7.620 0.055 -0.036 -0.998 -0.147 0.1350 6.7100 9.4100 4.7000 3.100 5.840 0.210 -0.010 1 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Gly -0.330940 4.205 0.439 0.092 0.886 -0.997 0.0246 -0.1247 17.0179 4.7732 6.062 3.225 0.335 0.096 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 1.88 179.43 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Thr -0.000328 7.070 0.152 -0.026 0.002 -0.997 0.1238 11.8770 12.6687 4.4350 3.714 6.982 0.038 0.028 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.37 179.42 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Ser -0.005392 5.709 0.204 0.108 0.130 -0.997 0.1300 11.7871 13.4240 4.3840 7.352 3.910 -0.013 0.013 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.36 179.43 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Gln -0.000428 6.873 0.164 0.027 0.025 -0.997 0.1008 5.2468 10.7848 4.6802 6.349 3.477 0.140 0.111 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 -0.017 179.45 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Asn -0.000090 7.800 0.005 0.160 -0.998 0.080 0.2100 13.5300 11.8900 4.3000 4.010 7.540 -0.100 0.060 1 0.00 0.00 0.00 0.00 0.60 0.00 0.50 0.00 0.00 0.60 0.0100 2.570000 1.15 2.08 0.00 1.07 0.00 0.30 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Glu -0.000090 7.670 -0.043 0.153 -0.998 0.017 0.1800 12.8100 11.4700 4.4000 3.660 6.870 0.040 0.030 1 0.00 0.00 0.00 0.00 0.60 0.00 0.50 0.00 0.00 0.50 0.0100 2.610000 1.09 2.05 0.00 1.08 0.00 0.03 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His Asp -0.000774 6.590 0.140 0.140 -0.155 -0.155 0.1475 13.9418 11.2867 32.0631 8.023 8.023 -0.033 -0.033 1 0.00 0.00 0.00 0.00 0.60 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.088 183.37 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 His His -0.000266 6.268 0.149 0.144 -0.998 0.138 0.1314 13.1833 12.5436 4.2357 4.222 7.937 0.051 -0.110 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 2.905420 1.02 2.01 -0.047 1.38 0.00 0.14 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Cys -0.000080 7.830 -0.131 0.130 -0.998 -0.346 2.4000 0.3700 1.1600 13.4000 5.360 9.660 -0.110 -0.050 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 4.28 4.87 0.00 0.00 0.00 0.10 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Met -0.000060 7.502 0.105 0.161 -0.998 0.244 2.5900 0.4000 1.3100 13.5000 4.503 8.119 -0.084 -0.076 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.53 2.18 0.00 0.00 0.00 0.01 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Phe -0.000290 7.740 0.112 0.143 -0.998 0.355 2.3300 0.8200 1.5000 13.5000 5.160 9.300 0.020 -0.090 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.53 2.18 0.00 0.00 0.00 0.08 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Ile -0.000290 7.740 0.112 0.143 -0.998 0.355 2.3300 0.8200 1.5000 13.5000 5.160 9.300 0.020 -0.090 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.53 2.18 0.00 0.00 0.00 0.08 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Leu -0.000220 7.818 0.162 0.068 -0.998 0.115 2.4700 0.7000 1.4900 13.6000 4.460 8.040 0.163 -0.018 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.53 2.18 0.00 0.00 0.00 0.09 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Val -0.000049 7.006 0.151 0.023 -0.001 -0.998 2.7300 1.1100 1.9300 13.6000 7.510 4.160 0.057 -0.074 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 5.02 4.46 0.00 0.00 0.00 0.00 0.04 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Trp -0.000100 6.420 0.154 0.087 -0.998 0.060 0.2400 12.0400 12.6500 4.3000 3.950 7.430 0.040 -0.050 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 3.280000 1.01 2.00 0.09 3.42 0.00 0.02 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Tyr -0.000260 6.863 0.122 0.083 -0.998 0.396 2.2500 0.2500 1.1000 13.5000 4.780 8.610 0.030 -0.220 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.28 2.13 0.00 0.00 0.00 0.59 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Ala -0.000075 7.150 0.141 -0.060 -0.998 -0.259 2.1500 0.1500 1.0200 13.6000 4.150 7.480 0.180 -0.030 1 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.00 0.30 0.00 0.0000 0.000000 0.39 2.15 0.00 0.00 0.00 0.59 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Gly -0.000058 7.383 0.129 0.109 -0.998 0.077 0.4945 3.4266 4.1466 1.6660 3.906 7.343 0.096 0.025 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 2.928930 0.53 2.18 0.0001 1.36 0.00 0.20 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Thr -0.000141 6.477 0.145 0.152 -0.998 0.172 0.1312 12.5793 12.5274 4.3168 4.021 7.559 0.043 -0.176 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 2.829920 1.02 2.01 -0.024 1.45 0.00 0.16 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Ser -0.000230 6.640 0.106 0.227 -0.998 0.340 0.1600 13.5100 12.6900 4.2000 4.390 8.250 0.030 -0.090 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 3.100000 1.01 2.01 0.00 1.58 0.00 0.10 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Gln -0.000059 7.222 0.010 0.146 -0.998 0.163 2.5624 0.0021 1.0296 13.5889 4.379 7.186 0.130 -0.052 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 2.866620 0.54 2.18 0.03 1.32 0.00 0.42 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg Asn -0.080000 4.170 -0.279 0.227 0.000 0.000 5.6100 -0.1800 0.7600 13.2100 3.290 6.000 0.430 -0.990 4 1.24 0.47 1.00 1.00 0.10 2.27 0.50 1.84 0.03 0.83 0.0100 5.740000 3.34 2.51 0.00 0.00 39.77 1.55 1.34 0.1500 0.1500 0.1500 16.3800 4.000 7.790 2.28 Arg Glu -0.010000 3.517 0.050 -0.924 0.000 0.000 3.6900 -0.4100 0.8800 13.6000 5.860 3.220 0.660 0.050 4 1.16 0.18 1.00 1.00 0.14 1.40 0.20 2.35 0.53 0.13 0.0100 5.537210 3.72 2.00 0.00 0.00 18.31 1.50 1.62 1.0000 1.0000 1.0000 34.0100 8.287 4.000 2.32 Arg Asp -0.000210 6.210 0.134 0.215 -0.998 0.320 0.1300 13.6300 12.6500 4.1000 4.450 8.360 0.030 -0.040 1 0.00 0.00 0.00 0.00 0.80 0.00 0.60 0.00 0.30 0.00 0.0100 3.030000 1.01 2.00 0.00 1.75 0.00 0.04 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Arg His -0.000022 7.578 0.146 0.146 -0.107 -0.107 0.3600 7.8000 7.9600 33.0000 6.470 0.000 0.170 0.170 1 0.00 0.00 0.00 0.00 0.80 0.00 0.80 0.00 0.30 0.30 0.0100 3.180000 0.41 0.41 0.00 0.00 0.00 0.01 0.01 87.6000 0.7301 0.4193 21.2000 1.210 0.000 1.00 Arg Arg -0.001410 6.110 0.119 0.163 -0.998 0.230 0.1100 11.3400 12.6400 4.5000 3.580 6.720 -0.150 -0.020 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 2.950000 0.98 1.99 0.04 1.16 0.00 0.40 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Cys -0.150000 4.810 -0.206 -0.152 -0.998 -0.566 2.3000 0.5100 1.3000 13.4000 10.260 5.730 -1.000 -0.660 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 2.41 0.17 0.00 0.00 0.00 0.94 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Met -0.000045 7.980 0.002 0.125 -0.998 0.067 2.7000 0.2000 1.0800 13.4000 4.880 8.800 -0.330 -0.130 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.16 2.12 0.00 0.00 0.00 0.71 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Phe -0.009900 6.219 -0.072 0.206 -0.998 0.353 2.4863 0.1000 1.3347 13.6170 3.920 7.068 -0.160 0.028 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.56 2.18 0.00 0.00 0.00 1.06 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Ile -0.009900 6.219 -0.072 0.206 -0.998 0.353 2.4863 0.1000 1.3347 13.6170 3.920 7.068 -0.160 0.028 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.56 2.18 0.00 0.00 0.00 1.06 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Leu -0.005015 6.461 -0.030 -0.062 -0.998 0.096 2.7200 0.1000 1.3300 13.6000 3.900 7.030 -0.090 0.010 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.50 2.17 0.00 0.00 0.00 1.03 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Val -0.253010 3.820 0.150 0.296 -0.998 0.997 3.2000 0.3100 1.2900 13.6000 3.830 6.910 -1.000 -0.140 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 4.46 5.01 0.00 0.00 0.00 0.02 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Trp -0.000040 7.140 0.131 0.202 -0.998 0.223 0.2000 13.2200 12.8900 4.2000 4.300 8.080 -0.250 0.000 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 3.070000 1.00 1.20 1.10 1.72 0.00 0.04 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Tyr -0.000450 7.300 -0.080 0.120 -0.998 0.263 2.6250 0.7100 1.5400 13.6000 4.070 7.340 -0.170 -0.050 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.37 2.14 0.00 0.00 0.00 0.88 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Ala -0.000270 7.141 -0.065 -0.057 -0.998 -0.161 2.5000 0.7400 1.4800 13.6000 3.773 6.801 -0.033 0.020 1 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.00 0.70 0.00 0.0000 0.000000 0.22 2.12 0.00 0.00 0.00 0.80 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Gly -0.023936 5.047 0.047 -0.052 -0.419 -0.998 0.0917 4.3851 15.5174 4.7736 5.724 3.045 -0.997 -0.033 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 2.976480 3.45 3.84 -0.147 1.63 0.00 1.03 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Thr -0.000042 7.558 0.112 0.147 -0.998 0.139 0.0849 7.9696 14.3032 4.6636 3.225 6.068 0.070 -0.001 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 3.145200 0.92 1.96 1.15 1.37 0.00 0.64 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Ser -0.000040 8.120 0.097 0.149 -0.998 0.225 0.1100 11.3600 13.1300 4.4000 3.730 7.010 -0.070 -0.030 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 2.780000 1.40 2.23 3.29 1.23 0.00 0.72 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Gln -0.000060 7.640 0.122 0.151 -0.998 0.182 0.1400 11.8600 12.4900 4.4000 3.840 7.210 -0.050 -0.120 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 3.460000 4.83 5.09 3.02 2.50 0.00 1.16 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys Asn -0.010000 5.489 0.200 -0.859 0.000 0.000 5.7400 -0.0300 0.9700 13.0400 6.790 3.730 0.230 0.010 4 0.20 1.41 1.00 1.00 0.20 2.25 1.30 2.25 0.13 1.13 0.0100 4.600000 3.43 2.00 0.00 0.00 43.61 1.72 1.80 0.0332 1.0000 1.0000 15.0452 3.350 4.000 5.99 Lys Glu -0.010000 5.143 0.131 0.071 0.000 0.000 2.8500 0.4800 1.6100 13.7000 5.680 3.150 -1.000 0.200 4 0.04 1.16 1.00 1.00 0.20 1.93 1.24 2.20 0.13 0.26 0.0100 4.150000 3.66 2.00 0.00 0.00 26.41 1.34 1.99 0.0398 1.0000 1.0000 14.6000 5.279 4.000 8.92 Lys Asp -0.000056 7.189 0.132 0.139 -0.998 0.039 0.1139 13.4212 12.6255 4.2295 4.250 7.990 -0.119 0.058 1 0.00 0.00 0.00 0.00 1.00 0.00 0.60 0.00 0.70 0.00 0.0100 3.171840 0.98 1.99 2.76 1.34 0.00 0.075 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Lys His -0.431851 3.889 0.036 0.352 0.998 0.625 0.8968 0.0685 1.4970 13.7330 4.284 7.724 0.058 0.077 1 0.00 0.00 0.00 0.00 1.00 0.00 0.80 0.00 0.70 0.30 0.0070 3.295780 4.34 0.47 0.00 0.00 0.00 0.016 0.041 79.6633 0.6422 0.4326 4.5546 0.690 0.774 1.00 Lys Arg -0.000542 5.582 0.397 0.397 0.257 0.257 0.3000 -0.5100 10.2600 33.0000 5.129 5.129 -0.160 -0.160 1 0.00 0.00 0.00 0.00 1.00 0.00 1.00 0.00 0.70 0.70 0.0001 3.000000 2.11 2.11 0.00 0.00 0.00 0.01 0.01 87.6000 64.0000 36.7000 21.2000 2.510 0.000 1.00 Lys Lys -0.012840 5.650 0.188 0.065 0.121 -0.670 0.3100 12.0700 11.6700 4.5000 6.440 3.430 0.089 0.061 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Cys -0.704308 4.079 0.343 0.456 0.464 -0.390 1.5888 1.7915 2.0459 31.6076 5.462 7.583 0.204 0.138 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Met -0.056000 4.810 0.476 0.462 0.955 0.408 3.0600 0.2200 0.9900 32.9000 6.360 8.010 0.090 0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Phe -0.022467 5.934 0.219 0.216 0.181 0.556 12.1155 -0.1817 0.7221 31.2463 5.457 7.579 0.119 0.001 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Ile -0.022467 5.934 0.219 0.216 0.181 0.556 12.1155 -0.1817 0.7221 31.2463 5.457 7.579 0.119 0.001 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Leu -0.373600 4.730 0.407 0.079 0.663 -0.564 1.8900 2.9400 2.8800 33.1000 5.160 7.160 0.210 0.030 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Val -0.062836 4.579 0.534 0.500 0.507 0.998 7.4018 -0.3757 0.6282 9.6398 7.830 4.610 0.092 0.019 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Trp -0.002120 6.040 0.163 0.120 0.128 -0.998 0.1850 10.7400 11.1900 4.3000 8.030 4.270 -0.052 -0.073 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Tyr -0.020800 5.364 0.127 0.127 -0.390 0.318 5.76770 0.4129 1.0912 31.2598 5.085 7.060 0.044 0.385 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Ala -0.000040 7.830 0.030 -0.008 -0.997 -0.042 13.2100 -0.1400 0.7500 31.3000 4.560 6.330 0.180 -0.040 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Gly -0.017800 5.780 0.196 0.036 0.185 -0.813 0.3300 12.4200 11.5200 4.5000 6.550 3.480 0.100 0.130 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Thr -0.019200 5.462 0.192 0.089 0.115 -0.581 0.3500 12.4300 11.1400 4.5000 6.330 3.370 0.110 0.120 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Ser -0.004400 6.180 0.172 0.101 0.214 -0.998 0.2300 12.1000 12.4300 4.5000 3.610 6.800 0.100 0.030 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Gln -0.008869 5.727 0.102 0.153 -0.607 0.025 0.2550 12.9010 11.5140 4.4149 3.660 6.890 0.120 0.050 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Asn -0.002180 6.839 0.154 -0.157 0.202 -0.998 2.6700 1.5700 2.2200 13.6000 7.106 3.942 0.084 -0.120 1 0.00 0.00 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.60 0.0000 0.000000 2.93 2.03 0.00 0.00 0.00 0.00 1.09 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Glu -0.001150 7.132 0.143 -0.171 0.134 -0.998 2.7500 1.7000 2.2300 13.6000 6.812 3.778 0.105 -0.006 1 0.00 0.00 0.00 0.00 0.00 0.00 0.50 0.00 0.00 0.50 0.0000 0.000000 2.29 0.79 0.00 0.00 0.00 0.00 0.98 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Asp -0.000270 7.490 0.113 0.046 0.012 -0.998 0.2150 10.2300 10.6900 4.4000 7.250 3.860 -0.005 0.088 1 0.00 0.00 0.00 0.00 0.00 0.00 0.60 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro His -0.000150 7.600 0.137 0.141 0.314 -0.998 2.5500 0.5100 1.3300 13.6000 8.000 4.440 -0.080 0.060 1 0.00 0.00 0.00 0.00 0.00 0.00 0.80 0.00 0.00 0.30 0.0000 0.000000 2.18 0.52 0.00 0.00 0.00 0.00 0.06 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Arg -0.000816 7.265 0.251 0.124 -0.143 -0.998 2.6400 0.7700 1.6200 13.5822 7.608 4.220 -0.002 -0.143 1 0.00 0.00 0.00 0.00 0.00 0.00 1.00 0.00 0.00 0.70 0.0000 0.000000 2.12 0.26 0.00 0.00 0.00 0.00 0.95 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Lys -0.010200 4.710 0.349 0.349 0.535 0.535 49.9300 -0.5300 0.4670 5.7100 7.810 7.810 0.170 0.170 1 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.000000 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.0000 0.0000 0.0000 0.0000 0.000 0.000 1.00 Pro Pro diff --git a/source/cluster/wham/src-M/CMakeLists.txt b/source/cluster/wham/src-M/CMakeLists.txt index ddd438c..30193dd 100644 --- a/source/cluster/wham/src-M/CMakeLists.txt +++ b/source/cluster/wham/src-M/CMakeLists.txt @@ -37,6 +37,7 @@ set(UNRES_CLUSTER_WHAM_M_SRC0 rescode.f setup_var.f srtclust.f + ssMD.F timing.F track.F wrtclust.f @@ -52,6 +53,7 @@ set(UNRES_CLUSTER_WHAM_M_PP_SRC probabl.F read_coords.F readrtns.F + ssMD.F timing.F track.F work_partition.F @@ -62,23 +64,48 @@ set(UNRES_CLUSTER_WHAM_M_PP_SRC # Set comipiler flags for different sourcefiles #================================================ if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) + set(FFLAGS0 "-mcmodel=medium -shared-intel -ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") set(FFLAGS0 "-std=legacy -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) +else () + set(FFLAGS0 "-I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") +#========================================= # Add MPI compiler flags +#========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_CLUSTER_WHAM_M_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) -set(CPPFLAGS "PROCOR -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) +#========================================= +# Settings for GAB force field +#========================================= +if(UNRES_MD_FF STREQUAL "GAB" ) + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) + +#========================================= +# Settings for E0LL2Y force field +#========================================= +elseif(UNRES_MD_FF STREQUAL "E0LL2Y") + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DSCCORPDB" ) +endif(UNRES_MD_FF STREQUAL "GAB") + +#========================================= +# Additional flags +#========================================= +set(CPPFLAGS "${CPPFLAGS} -DUNRES -DISNAN") +#========================================= +# Compiler specific flags +#========================================= if (Fortran_COMPILER_NAME STREQUAL "ifort") # Add ifort preprocessor flags - set(CPPFLAGS "${CPPFLAGS} -DPGI") + set(CPPFLAGS "${CPPFLAGS} -DPGI" ) elseif (Fortran_COMPILER_NAME STREQUAL "f95") # Add new gfortran flags set(CPPFLAGS "${CPPFLAGS} -DG77") @@ -113,23 +140,8 @@ set_property(SOURCE proc_proc.c PROPERTY COMPILE_DEFINITIONS "LINUX -DPGI" ) #======================================== # Setting binary name #======================================== -set(UNRES_CLUSTER_WHAM_M_BIN "unres_clustMD.exe") - -#========================================= -# cinfo.f stupid workaround for cmake -# - shame on me ]:) -#========================================= -#set_property(SOURCE compinfo.c PROPERTY CMAKE_C_FLAGS "-c" ) -#add_executable(compinfo-wham-m compinfo.c) -#set_target_properties(compinfo-wham-m PROPERTIES OUTPUT_NAME compinfo) - -#set(UNRES_CINFO_DIR "${CMAKE_CURRENT_BINARY_DIR}" ) -#add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/cinfo.f ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/COMMON.IOUNITS ${CMAKE_CURRENT_BINARY_DIR}/COMMON.IOUNITS -# COMMAND ${CMAKE_CURRENT_BINARY_DIR}/compinfo | true -# DEPENDS compinfo-wham-m ) -#set_property(SOURCE ${UNRES_CINFO_DIR}/cinfo.f PROPERTY COMPILE_FLAGS ${FFLAGS0} ) +set(UNRES_CLUSTER_WHAM_M_BIN +"cluster_wham-M_${Fortran_COMPILER_NAME}_${UNRES_MD_FF}.exe") #========================================= # Set full unres CLUSTER sources @@ -141,98 +153,21 @@ set(UNRES_CLUSTER_WHAM_M_SRCS ${UNRES_CLUSTER_WHAM_M_SRC0} proc_proc.c) #========================================= add_executable(UNRES_CLUSTER_WHAM_M_BIN ${UNRES_CLUSTER_WHAM_M_SRCS} ) set_target_properties(UNRES_CLUSTER_WHAM_M_BIN PROPERTIES OUTPUT_NAME ${UNRES_CLUSTER_WHAM_M_BIN}) +set_property(TARGET UNRES_CLUSTER_WHAM_M_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #========================================= # Link libraries #========================================= -# link MPI library (libmpich.a) +# link MPI libraries if(UNRES_WITH_MPI) - target_link_libraries( UNRES_CLUSTER_WHAM_M_BIN ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_CLUSTER_WHAM_M_BIN ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a target_link_libraries( UNRES_CLUSTER_WHAM_M_BIN xdrf ) + #========================================= -# TESTS -#========================================= - -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) - -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) - -#========================================= -# Generate data test files -#========================================= -# test_single_ala.sh -#========================================= - -#FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh -#"#!/bin/sh -#export POT=GB -#export PREFIX=ala10 -#----------------------------------------------------------------------------- -#UNRES_BIN=./${UNRES_BIN} -#----------------------------------------------------------------------------- -#DD=${CMAKE_SOURCE_DIR}/PARAM -#export BONDPAR=$DD/bond.parm -#export THETPAR=$DD/thetaml.5parm -#export ROTPAR=$DD/scgauss.parm -#export TORPAR=$DD/torsion_631Gdp.parm -#export TORDPAR=$DD/torsion_double_631Gdp.parm -#export ELEPAR=$DD/electr_631Gdp.parm -#export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k -#export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 -#export SCPPAR=$DD/scp.parm -#export SCCORPAR=$DD/rotcorr_AM1.parm -#export PATTERN=$DD/patterns.cart -#----------------------------------------------------------------------------- -#$UNRES_BIN -#") - -#========================================= -# ala10.inp -#========================================= - -#file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp -#"ala10 unblocked -#SEED=-1111333 MD ONE_LETTER rescale_mode=2 PDBOUT -#nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & -#reset_moment=1000 reset_vel=1000 MDPDB -#WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & -#WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & -#WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & -#WVDWPP=0.11371 WHPB=1.00000 & -#CUTOFF=7.00000 WCORR4=0.00000 -#12 -#XAAAAAAAAAAX -# 0 -# 0 -# 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 -# 90.0000 90.0000 -# 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 -# 180.0000 -# 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 -# 110.0000 110.0000 -# -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 -# -120.0000 -120.0000 -#") - - -# Add tests - -#if(NOT UNRES_WITH_MPI) - -# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -#endif(NOT UNRES_WITH_MPI) +# Install Path +#========================================= +install(TARGETS UNRES_CLUSTER_WHAM_M_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}/cluster) + diff --git a/source/cluster/wham/src-M/COMMON.CHAIN b/source/cluster/wham/src-M/COMMON.CHAIN index 5158330..75dcd91 100644 --- a/source/cluster/wham/src-M/COMMON.CHAIN +++ b/source/cluster/wham/src-M/COMMON.CHAIN @@ -1,9 +1,19 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq, - &tabperm - double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt + &tabperm,chain_length,nperm,ishift_pdb + double precision c,cref,cref_pdb,dc,xloc,xrot,dc_norm,t,r,prod,rt, + & chain_rep common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), & xrot(3,maxres),dc_norm(3,maxres2),nres,nres0 common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),nsup,nstart_sup,nstart_seq, - & nend_sup,tabperm(maxperm,maxsym) + common /refstruct/ cref(3,maxres2+2,maxperm), + & cref_pdb(3,maxres2+2,maxperm), + & chain_rep(3,maxres2+2,maxsym), nsup,nstart_sup, + & nstart_seq, + & nend_sup, chain_length,tabperm(maxperm,maxsym),nperm,ishift_pdb + double precision boxxsize,boxysize,boxzsize,enecut,sscut,sss, + & sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick + common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick + diff --git a/source/cluster/wham/src-M/COMMON.CLUSTER b/source/cluster/wham/src-M/COMMON.CLUSTER index 4477d19..9f881c4 100644 --- a/source/cluster/wham/src-M/COMMON.CLUSTER +++ b/source/cluster/wham/src-M/COMMON.CLUSTER @@ -2,16 +2,23 @@ real*8 rcutoff,ecut double precision totfree_gr real*4 diss,allcart - double precision enetb,entfac,totfree,energy,rmstb + double precision enetb,entfac,totfree,energy,rmstb,gdt_ts_tb, + & gdt_ha_tb,tmscore_tb integer ncut,ngr,licz,nconf,iass,icc,mult,list_conf, - & nss_all,ihpb_all,jhpb_all,iass_tot,iscore,nprop + & nss_all,ihpb_all,jhpb_all,iass_tot,iscore,nprop,nclust + real*8 rmsave,rms_closest,gdt_ts_ave,gdt_ts_closest, + & gdt_ha_ave,gdt_ha_closest,tmscore_ave,tmscore_closest common /clu/ diss(maxdist),energy(0:maxconf), - & enetb(max_ene,maxstr_proc),ecut, + & enetb(max_ene,maxconf),ecut, & entfac(maxconf),totfree(0:maxconf),totfree_gr(maxgr), - & rcutoff(max_cut+1),ncut,min_var,tree,plot_tree,lgrp + & rcutoff(max_cut+1),ncut,nclust,min_var,tree,plot_tree,lgrp common /clu1/ ngr,licz(maxgr),nconf(maxgr,maxingr),iass(maxgr), & iass_tot(maxgr,max_cut),list_conf(maxconf) - common /alles/ allcart(3,maxres2,maxstr_proc),rmstb(maxconf), + common /alles/ allcart(3,maxres2,maxconf),rmstb(maxconf), + & gdt_ts_tb(maxconf),gdt_ha_tb(maxconf),tmscore_tb(maxconf), + & rmsave(maxgr),rms_closest(maxgr),gdt_ts_ave(maxgr), + & gdt_ts_closest(maxgr),gdt_ha_ave(maxgr),gdt_ha_closest(maxgr), + & tmscore_ave(maxgr),tmscore_closest(maxgr), & icc(maxconf), - & mult(maxres),nss_all(maxstr_proc),ihpb_all(maxss,maxstr_proc), - & jhpb_all(maxss,maxstr_proc),iscore(maxconf),nprop + & mult(maxres),nss_all(maxconf),ihpb_all(maxss,maxconf), + & jhpb_all(maxss,maxconf),iscore(maxconf),nprop diff --git a/source/cluster/wham/src-M/COMMON.CONTACTS b/source/cluster/wham/src-M/COMMON.CONTACTS deleted file mode 100644 index 1487839..0000000 --- a/source/cluster/wham/src-M/COMMON.CONTACTS +++ /dev/null @@ -1,73 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - double precision gacontp_hb1,gacontp_hb2,gacontp_hb3,gacontm_hb1, - & gacontm_hb2,gacontm_hb3,gacont_hbr,facont_hb,ees0p,ees0m,d_cont, - & grij_hb_cont - integer num_cont_hb,jcont_hb - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -C Interactions of pseudo-dipoles generated by loc-el interactions. - double precision dip,dipderg,dipderx - common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), - & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder,Ug2DtEUg,Ug2DtEUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres), - & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres),muder(2,maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx,EAEA,EAEAderg,EAEAderx, - & ADtEA1,ADtEA1derg,ADtEA1derx,g_contij,ekont - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont diff --git a/source/cluster/wham/src-M/COMMON.CONTROL b/source/cluster/wham/src-M/COMMON.CONTROL index 9a2bd18..0265664 100644 --- a/source/cluster/wham/src-M/COMMON.CONTROL +++ b/source/cluster/wham/src-M/COMMON.CONTROL @@ -1,7 +1,12 @@ double precision betaT - integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,symetr + integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,symetr, + & constr_dist,shield_mode,tor_mode logical refstr,pdbref,punch_dist,print_dist,caonly,lside, - & lprint_cart,lprint_int,from_cart,efree,from_bx,from_cx + & lprint_cart,lprint_int,from_cart,lefree,from_bx,from_cx, + & with_dihed_constr,with_theta_constr,energy_dec common /cntrl/ betaT,iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_dist,caonly,lside,lprint_cart,lprint_int, - & from_cart,from_bx,from_cx,efree,iopt,nstart,nend,symetr + & from_cart,from_bx,from_cx, with_dihed_constr,with_theta_constr, + & lefree,iopt,nstart,nend,symetr, + & tor_mode,shield_mode, + & constr_dist,energy_dec diff --git a/source/cluster/wham/src-M/COMMON.DERIV b/source/cluster/wham/src-M/COMMON.DERIV deleted file mode 100644 index 79f8630..0000000 --- a/source/cluster/wham/src-M/COMMON.DERIV +++ /dev/null @@ -1,30 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gvdwpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gvdwx,gradcorr,gradxorr, - & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, - & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, - & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx - integer nfl,icg - logical calc_grad - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gvdwpp(3,maxres), - & gradx_scp(3,maxres), - & gvdwc_scp(3,maxres),ghpbx(3,maxres),ghpbc(3,maxres), - & gloc(maxvar,2),gradcorr(3,maxres),gradxorr(3,maxres), - & gradcorr5(3,maxres),gradcorr6(3,maxres), - & gel_loc(3,maxres),gcorr3_turn(3,maxres),gcorr4_turn(3,maxres), - & gcorr6_turn(3,maxres),gradb(3,maxres),gradbx(3,maxres), - & gel_loc_loc(maxvar),gel_loc_turn3(maxvar),gel_loc_turn4(maxvar), - & gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab diff --git a/source/cluster/wham/src-M/COMMON.FFIELD b/source/cluster/wham/src-M/COMMON.FFIELD index ccafd30..fa85436 100644 --- a/source/cluster/wham/src-M/COMMON.FFIELD +++ b/source/cluster/wham/src-M/COMMON.FFIELD @@ -6,11 +6,11 @@ C----------------------------------------------------------------------- double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6, & wvdwpp,wbond,weights,scal14,scalscp,cutoff_corr,delt_corr, - & r0_corr + & r0_corr,wliptran integer ipot,n_ene_comp,rescale_mode common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4,wturn6, - & wvdwpp,wbond,weights(max_ene),scalscp, + & wvdwpp,wbond,wliptran,weights(max_ene),scalscp, & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, & rescale_mode common /potentials/ potname(5) diff --git a/source/cluster/wham/src-M/COMMON.IOUNITS b/source/cluster/wham/src-M/COMMON.IOUNITS index c97090d..d171ae0 100644 --- a/source/cluster/wham/src-M/COMMON.IOUNITS +++ b/source/cluster/wham/src-M/COMMON.IOUNITS @@ -10,10 +10,12 @@ C----------------------------------------------------------------------- C General I/O units & files integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, - & ientin,ientout,isidep1,ibond,isccor,jrms,jplot + & ientin,ientout,isidep1,ibond,isccor,jrms,jplot, + & iliptranpar common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, - & istat,ientin,ientout,isidep1,ibond,isccor,jrms,jplot + & istat,ientin,ientout,isidep1,ibond,isccor,jrms,jplot, + & iliptranpar character*256 outname,intname,pdbname,mol2name,statname,intinname, & entname,restartname,prefix,scratchdir,sidepname,pdbfile, & sccorname,rmsname,prefintin,prefout @@ -35,9 +37,9 @@ C CSA I/O units & files & icsa_bank_reminimized,icsa_native_int,icsa_in C Parameter files character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,patname + & fouriername,elename,sidename,scpname,patname,liptranname common /parfiles/ thetname,rotname,torname,tordname,bondname, - & fouriername,elename,sidename,scpname,patname + & fouriername,elename,sidename,scpname,patname,liptranname character*3 pot C----------------------------------------------------------------------- C INP - main input file diff --git a/source/cluster/wham/src-M/COMMON.LOCAL b/source/cluster/wham/src-M/COMMON.LOCAL deleted file mode 100644 index 1d0f3aa..0000000 --- a/source/cluster/wham/src-M/COMMON.LOCAL +++ /dev/null @@ -1,36 +0,0 @@ - double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0, - & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0,vbl,vblinv,vblinv2, - & vbl_cis,vbl0,vbld_inv - integer nlob,loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end -C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) -C Parameters of ab initio-derived potential of virtual-bond-angle bending - integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) - common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, - & ffthet, - & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, - & ndouble,nntheterm -C Parameters of the side-chain probability distribution - common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), - & nlob(ntyp1) -C Virtual-bond lenghts - common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 - common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end -C Inverses of the actual virtual bond lengths - common /invlen/ vbld_inv(maxres2) diff --git a/source/cluster/wham/src-M/COMMON.NAMES b/source/cluster/wham/src-M/COMMON.NAMES index d42c725..7c5b6ee 100644 --- a/source/cluster/wham/src-M/COMMON.NAMES +++ b/source/cluster/wham/src-M/COMMON.NAMES @@ -1,4 +1,4 @@ - common /names/ restyp(ntyp+1),onelet(ntyp+1) + common /names/ restyp(-ntyp1:ntyp1),onelet(-ntyp1:ntyp1) character*3 restyp character*1 onelet character*10 ename,wname diff --git a/source/cluster/wham/src-M/COMMON.SBRIDGE b/source/cluster/wham/src-M/COMMON.SBRIDGE index 92150c5..028f9ae 100644 --- a/source/cluster/wham/src-M/COMMON.SBRIDGE +++ b/source/cluster/wham/src-M/COMMON.SBRIDGE @@ -1,7 +1,20 @@ - integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end - double precision ebr,dbr,fbr,dhpb,forcon,weidis - common /sbridge/ ebr,dbr,fbr,ns,nss,nfree,iss(maxss) - common /links/ dhpb(maxss),forcon(maxss),ihpb(maxss), - & jhpb(maxss),nhpb + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + integer ns,nss,nfree,iss + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + & ns,nss,nfree,iss(maxss) + double precision dhpb,dhpb1,forcon,fordepth + integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb + common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), + & fordepth(maxdim), + & ihpb(maxdim),jhpb(maxdim),nhpb + double precision weidis common /restraints/ weidis + integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, + & dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim),ibecarb(maxdim) + common /dyn_ss_logic/ + & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/cluster/wham/src-M/COMMON.SCCOR b/source/cluster/wham/src-M/COMMON.SCCOR index 5217de7..c38cccb 100644 --- a/source/cluster/wham/src-M/COMMON.SCCOR +++ b/source/cluster/wham/src-M/COMMON.SCCOR @@ -1,6 +1,19 @@ -C Parameters of the SCCOR term - double precision v1sccor,v2sccor - integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), - & nterm_sccor +cc Parameters of the SCCOR term + double precision v1sccor,v2sccor,vlor1sccor, + & vlor2sccor,vlor3sccor,gloc_sc, + & dcostau,dsintau,dtauangle,dcosomicron, + & domicron,v0sccor + integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor + common /sccor/ v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor1sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor2sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor3sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & gloc_sc(3,0:maxres2,10), + & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), + & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), + & domicron(3,3,3,maxres2), + & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), + & nsccortyp, + & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp) diff --git a/source/cluster/wham/src-M/COMMON.SCROT b/source/cluster/wham/src-M/COMMON.SCROT index 2da7b8f..a352775 100644 --- a/source/cluster/wham/src-M/COMMON.SCROT +++ b/source/cluster/wham/src-M/COMMON.SCROT @@ -1,3 +1,3 @@ C Parameters of the SC rotamers (local) term double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) + common/scrot/sc_parmin(maxsccoef,ntyp) diff --git a/source/cluster/wham/src-M/COMMON.TORSION b/source/cluster/wham/src-M/COMMON.TORSION deleted file mode 100644 index 8a12451..0000000 --- a/source/cluster/wham/src-M/COMMON.TORSION +++ /dev/null @@ -1,25 +0,0 @@ -C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), - & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor) - & ,nterm_old -C 6/23/01 - constants for double torsionals - double precision v1c,v1s,v2c,v2s - integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) -C 9/18/99 - added Fourier coeffficients of the expansion of local energy -C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b1tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp - double precision b - common /fourier1/ b(13,maxtor) diff --git a/source/cluster/wham/src-M/COMMON.VAR b/source/cluster/wham/src-M/COMMON.VAR index ad412d0..326d6ec 100644 --- a/source/cluster/wham/src-M/COMMON.VAR +++ b/source/cluster/wham/src-M/COMMON.VAR @@ -2,14 +2,15 @@ C Store the geometric variables in the following COMMON block. integer ntheta,nphi,nside,nvar,ialph,ivar double precision theta,phi,alph,omeg,vbld,vbld_ref, & theta_ref,phi_ref,alph_ref,omeg_ref, - & costtab,sinttab,cost2tab,sint2tab, + & costtab,sinttab,cost2tab,sint2tab,tauangle,omicron, & xxtab,yytab,zztab common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), & vbld(2*maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), & zztab(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar + & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar, + & omicron(2,maxres),tauangle(3,maxres) C Angles from experimental structure common /varref/ vbld_ref(maxres), & theta_ref(maxres),phi_ref(maxres), diff --git a/source/cluster/wham/src-M/DIMENSIONS b/source/cluster/wham/src-M/DIMENSIONS index e7a002b..ec15031 100644 --- a/source/cluster/wham/src-M/DIMENSIONS +++ b/source/cluster/wham/src-M/DIMENSIONS @@ -9,7 +9,7 @@ C Max. number of processors. parameter (maxprocs=16) C Max. number of AA residues integer maxres,maxres2 - parameter (maxres=650) + parameter (maxres=1600) C Appr. max. number of interaction sites parameter (maxres2=2*maxres) C Max. number of variables @@ -30,13 +30,18 @@ C Max. number of contacts per residue parameter (maxconts=maxres) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) + parameter (ntyp=24,ntyp1=ntyp+1) C Max. number of types of dihedral angles & multiplicity of torsional barriers - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 + integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2,maxtor_kcc, + & maxval_kcc parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) + parameter (maxtor_kcc=6,maxval_kcc=6) +c Max number of new valence-angle (only) terms + integer maxang_kcc + parameter (maxang_kcc=36) c Max number of torsional terms in SCCOR integer maxterm_sccor - parameter (maxterm_sccor=3) + parameter (maxterm_sccor=6) C Max. number of residue types and parameters in expressions for C virtual-bond angle bending potentials integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, @@ -60,7 +65,7 @@ C Max number of symetric chains parameter (maxperm=120) C Max. number of energy components integer max_ene - parameter (max_ene=21) + parameter (max_ene=25) C Max. number of temperatures integer maxt parameter (maxT=5) diff --git a/source/cluster/wham/src-M/Makefile b/source/cluster/wham/src-M/Makefile index 693492e..8aee570 120000 --- a/source/cluster/wham/src-M/Makefile +++ b/source/cluster/wham/src-M/Makefile @@ -1 +1 @@ -Makefile-MPICH-ifort \ No newline at end of file +Makefile-MPICH-ifort-okeanos \ No newline at end of file diff --git a/source/cluster/wham/src-M/Makefile-MPI b/source/cluster/wham/src-M/Makefile-MPI deleted file mode 100644 index 36a0387..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI +++ /dev/null @@ -1,34 +0,0 @@ -BIN = /users/adam/ZSCOREZ/bin -CC = cc -FC = mpif90 -PGI=/opt/pgi -OPT = -fast -pc 64 -tp p6 -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 -#FFLAGS = ${OPT} -c -I. -I../src_MD_T/include_unres -I../src_MD -FFLAGS = ${OPT} -c -I. -I../src_MD_T/include_unres -I../src_MD -LIBS = -L../../MEY_MD/src_Tc/xdrf -lxdrf -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -m -Bstatic -o ${BIN}/unres_clustMD_MPI-nopteron - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPI-INTEL b/source/cluster/wham/src-M/Makefile-MPI-INTEL deleted file mode 100644 index ff2c438..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI-INTEL +++ /dev/null @@ -1,33 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN=/users/adam/ZSCOREZ/bin -FC = ifort -OPT = -O3 -ip -w -#OPT = -CB -g -FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-oldparm - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPI-INTEL-old b/source/cluster/wham/src-M/Makefile-MPI-INTEL-old deleted file mode 100644 index 456d413..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI-INTEL-old +++ /dev/null @@ -1,35 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN=/users/adam/ZSCOREZ/bin -OUT=../bin -FC = ifort -#OPT = -O3 -ip -w -OPT = -CB -g -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#CPPFLAGS = -DLINUX -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMPI -DUNRES -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich /users/adam/ZSCOREZ/srcWHAM-Tsccor/xdrf/libxdrf.a - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -o ${OUT}/unres_clustMD_MPI-D-oldparm - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPI-opteron b/source/cluster/wham/src-M/Makefile-MPI-opteron deleted file mode 100644 index 657211b..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI-opteron +++ /dev/null @@ -1,39 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN=/users/adam/ZSCOREZ/bin -FC= pgf90 -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 -OPT = -C -g -FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include -FFLAGS1 = ${FFLAGS} -FFLAGS2 = ${FFLAGS} -#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich -L../srcWHAM-Tsccor/xdrf -lxdrf - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-new - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPI-opteron-old b/source/cluster/wham/src-M/Makefile-MPI-opteron-old deleted file mode 100644 index 31da78e..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI-opteron-old +++ /dev/null @@ -1,39 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN=/users/adam/ZSCOREZ/bin -FC= pgf90 -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 -OPT = -C -g -FFLAGS = ${OPT} -c -I. -I../src_MD_T-sccor/include_unres -I../src_MD_T-sccor -I/users/adam/MEY_MD/src_Tc-czarek -I$(INSTALL_DIR)/include -FFLAGS1 = ${FFLAGS} -FFLAGS2 = ${FFLAGS} -#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich -L../srcWHAM-Tsccor/xdrf -lxdrf - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPI-oldparm - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPI-w-opteron b/source/cluster/wham/src-M/Makefile-MPI-w-opteron deleted file mode 100644 index 0aa2066..0000000 --- a/source/cluster/wham/src-M/Makefile-MPI-w-opteron +++ /dev/null @@ -1,39 +0,0 @@ -INSTALL_DIR = /usr/local/mpich-1.2.5.2_pgi64-6.0-4_ssh -BIN=/users/adam/ZSCOREZ/bin -FC= pgf90 -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -C -g -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -pc 64 -tp amd64 -#OPT = -C -g -FFLAGS = ${OPT} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -FFLAGS1 = ${FFLAGS} -FFLAGS2 = ${FFLAGS} -#FFLAGS1 = ${OPT} -g -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -#FFLAGS2 = ${OPT1} -c -I. -I../src_MD_T -I../src_MD -I/users/adam/MEY_MD/src -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich - -.c.o: - cc -c -DLINUX -DPGI $*.c - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F - -objects = main_clust_w.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ - geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hcw.o \ - track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ - int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o - -unres_clust: $(objects) - $(FC) ${OPT} ${objects} ${LIBS} -m -o ${BIN}/unres_clustMD_w_MPI - -clean: - /bin/rm *.o - -move: - mv *.o ${OBJ} diff --git a/source/cluster/wham/src-M/Makefile-MPICH-ifort b/source/cluster/wham/src-M/Makefile-MPICH-ifort index ea08f41..79b8d0f 100644 --- a/source/cluster/wham/src-M/Makefile-MPICH-ifort +++ b/source/cluster/wham/src-M/Makefile-MPICH-ifort @@ -1,11 +1,10 @@ INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh BIN=../../../../bin/cluster FC = ifort -OPT = -O3 -ip -w -#OPT = -CB -g +OPT = -O3 -ip -w -mcmodel=medium +OPT = -CB -g -mcmodel=medium FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a .c.o: cc -c -DLINUX -DPGI $*.c @@ -16,22 +15,53 @@ LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB .F.o: ${FC} ${FFLAGS} ${CPPFLAGS} ${FFLAGS} $*.F -objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ +object = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ matmult.o readrtns.o pinorm.o rescode.o intcor.o timing.o misc.o \ geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o permut.o + setup_var.o read_ref_str.o gnmr1.o permut.o ssMD.o -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: $(objects) xdrf/libxdrf.a - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-GAB.exe +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: $(objects) xdrf/libxdrf.a - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD-mult_MPICH-E0LL2Y.exe +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_GAB.exe +GAB: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_4P.exe +4P: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DLANG0 +E0LL2Y: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_E0LL2Y.exe +E0LL2Y: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +NEWCORR: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DLANG0 -DNEWCORR +NEWCORR: BIN = ../../../../bin/cluster/unres_clustMD-mult_ifort_MPICH_NEWCORR.exe +NEWCORR: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} xdrf/libxdrf.a: cd xdrf && make diff --git a/source/cluster/wham/src-M/arcos.f b/source/cluster/wham/src-M/arcos.f index 052a1e4..698f704 100644 --- a/source/cluster/wham/src-M/arcos.f +++ b/source/cluster/wham/src-M/arcos.f @@ -2,7 +2,7 @@ implicit real*8 (a-h,o-z) include 'COMMON.GEO' IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=0.5D0*(PI+DSIGN(X,1.0D0)*PI) + ARCOS=0.5D0*(PI-DSIGN(X,1.0D0)*PI) RETURN 1 ARCOS=DACOS(X) RETURN diff --git a/source/cluster/wham/src-M/chainbuild.f b/source/cluster/wham/src-M/chainbuild.f index 5774ba6..1e72ff8 100644 --- a/source/cluster/wham/src-M/chainbuild.f +++ b/source/cluster/wham/src-M/chainbuild.f @@ -208,8 +208,8 @@ C include 'COMMON.INTERACT' dimension xx(3) - dsci=dsc(itype(i)) - dsci_inv=dsc_inv(itype(i)) + dsci=dsc(iabs(itype(i))) + dsci_inv=dsc_inv(iabs(itype(i))) alphi=alph(i) omegi=omeg(i) cosalphi=dcos(alphi) diff --git a/source/cluster/wham/src-M/contact.f b/source/cluster/wham/src-M/contact.f index b17f153..6f01564 100644 --- a/source/cluster/wham/src-M/contact.f +++ b/source/cluster/wham/src-M/contact.f @@ -12,9 +12,9 @@ kkk=3 c print *,'nnt=',nnt,' nct=',nct do i=nnt+kkk,nct - iti=itype(i) + iti=iabs(itype(i)) do j=nnt,i-kkk - itj=itype(j) + itj=iabs(itype(j)) if (ipot.ne.4) then c rcomp=sigmaii(iti,itj)+1.0D0 rcomp=facont*sigmaii(iti,itj) diff --git a/source/cluster/wham/src-M/energy_p_new.F b/source/cluster/wham/src-M/energy_p_new.F index c02d085..66d6a26 100644 --- a/source/cluster/wham/src-M/energy_p_new.F +++ b/source/cluster/wham/src-M/energy_p_new.F @@ -1,7 +1,6 @@ subroutine etotal(energia,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' #ifndef ISNAN external proc_proc @@ -12,18 +11,17 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.IOUNITS' double precision energia(0:max_ene),energia1(0:max_ene+1) -#ifdef MPL - include 'COMMON.INFO' - external d_vadd - integer ready -#endif include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' double precision fact(6) -cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot +c write(iout, '(a,i2)')'Calling etotal ipot=',ipot +c call flush(iout) cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy @@ -47,8 +45,19 @@ C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). C C Calculate electrostatic (H-bonding) energy of the main chain. C - 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C + 106 continue +c write (iout,*) "Sidechain" + call flush(iout) + call vec_and_deriv + if (shield_mode.eq.1) then + call set_shield_fac + else if (shield_mode.eq.2) then + call set_shield_fac2 + endif + call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) +c write(iout,*) 'po eelec' +c call flush(iout) + C Calculate excluded-volume interaction energy between peptide groups C and side chains. C @@ -56,8 +65,9 @@ C c c Calculate the bond-stretching energy c + call ebond(estr) -c write (iout,*) "estr",estr +C write (iout,*) "estr",estr C C Calculate the disulfide-bridge and other energy and the contributions C from other distance constraints. @@ -67,26 +77,60 @@ cd print *,'EHPB exitted succesfully.' C C Calculate the virtual-bond-angle energy. C - call ebend(ebe) +C print *,'Bend energy finished.' + if (wang.gt.0d0) then + if (tor_mode.eq.0) then + call ebend(ebe) + else +C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call ebend_kcc(ebe) + endif + else + ebe=0.0d0 + endif + ethetacnstr=0.0d0 + if (with_theta_constr) call etheta_constr(ethetacnstr) +c call ebend(ebe,ethetacnstr) cd print *,'Bend energy finished.' C C Calculate the SC local energy. C call esc(escloc) -cd print *,'SCLOC energy finished.' +C print *,'SCLOC energy finished.' C C Calculate the virtual-bond torsional energy. C -cd print *,'nterm=',nterm - call etor(etors,edihcnstr,fact(1)) + if (wtor.gt.0.0d0) then + if (tor_mode.eq.0) then + call etor(etors,fact(1)) + else +C etor kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call etor_kcc(etors,fact(1)) + endif + else + etors=0.0d0 + endif + edihcnstr=0.0d0 + if (ndih_constr.gt.0) call etor_constr(edihcnstr) +c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C - call etor_d(etors_d,fact(2)) -C -C 21/5/07 Calculate local sicdechain correlation energy + if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then + call etor_d(etors_d,fact(2)) + else + etors_d=0 + endif +c print *,"Processor",myrank," computed Utord" C call eback_sc_corr(esccor) + + if (wliptran.gt.0) then + call Eliptransfer(eliptran) + endif + C C 12/1/95 Multi-body terms C @@ -94,37 +138,69 @@ C n_corr1=0 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 & .or. wturn6.gt.0.0d0) then -c print *,"calling multibody_eello" +c write(iout,*)"calling multibody_eello" call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1 -c print *,ecorr,ecorr5,ecorr6,eturn6 +c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1 +c write (iout,*) ecorr,ecorr5,ecorr6,eturn6 + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then +c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t #ifdef SPLITELE + if (shield_mode.gt.0) then + etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2 + & +welec*fact(1)*ees + & +fact(1)*wvdwpp*evdw1 + & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 + & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 + & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + else etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees & +wvdwpp*evdw1 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + endif #else + if (shield_mode.gt.0) then + etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2 + & +welec*fact(1)*(ees+evdw1) + & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 + & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 + & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + else etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2 & +welec*fact(1)*(ees+evdw1) & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + endif #endif energia(0)=etot energia(1)=evdw -c call enerprint(energia(0),frac) #ifdef SCP14 energia(2)=evdw2-evdw2_14 energia(17)=evdw2_14 @@ -155,6 +231,8 @@ c call enerprint(energia(0),frac) energia(19)=esccor energia(20)=edihcnstr energia(21)=evdw_t + energia(24)=ethetacnstr + energia(22)=eliptran c detecting NaNQ #ifdef ISNAN #ifdef AIX @@ -174,6 +252,9 @@ c detecting NaNQ #ifdef MPL c endif #endif +#ifdef DEBUG + call enerprint(energia,fact) +#endif if (calc_grad) then C C Sum up the components of the Cartesian gradient. @@ -181,6 +262,7 @@ C #ifdef SPLITELE do i=1,nct do j=1,3 + if (shield_mode.eq.0) then gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ & wbond*gradb(j,i)+ @@ -193,14 +275,57 @@ C & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ & wsccor*fact(2)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + else + gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i) + & +fact(1)*wscp*gvdwc_scp(j,i)+ + & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+ + & wbond*gradb(j,i)+ + & wstrain*ghpbc(j,i)+ + & wcorr*fact(3)*gradcorr(j,i)+ + & wel_loc*fact(2)*gel_loc(j,i)+ + & wturn3*fact(2)*gcorr3_turn(j,i)+ + & wturn4*fact(3)*gcorr4_turn(j,i)+ + & wcorr5*fact(4)*gradcorr5(j,i)+ + & wcorr6*fact(5)*gradcorr6(j,i)+ + & wturn6*fact(5)*gcorr6_turn(j,i)+ + & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + + gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i) + & +fact(1)*wscp*gradx_scp(j,i)+ + & wbond*gradbx(j,i)+ + & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ + & wsccor*fact(2)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + & +welec*gshieldx(j,i) + & +wcorr*gshieldx_ec(j,i) + & +wturn3*gshieldx_t3(j,i) + & +wturn4*gshieldx_t4(j,i) + & +wel_loc*gshieldx_ll(j,i) + + + endif enddo #else do i=1,nct do j=1,3 + if (shield_mode.eq.0) then gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+ & wbond*gradb(j,i)+ @@ -212,10 +337,50 @@ C & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ & wsccor*fact(1)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + else + gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+ + & fact(1)*wscp*gvdwc_scp(j,i)+ + & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+ + & wbond*gradb(j,i)+ + & wcorr*fact(3)*gradcorr(j,i)+ + & wel_loc*fact(2)*gel_loc(j,i)+ + & wturn3*fact(2)*gcorr3_turn(j,i)+ + & wturn4*fact(3)*gcorr4_turn(j,i)+ + & wcorr5*fact(4)*gradcorr5(j,i)+ + & wcorr6*fact(5)*gradcorr6(j,i)+ + & wturn6*fact(5)*gcorr6_turn(j,i)+ + & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + + gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+ + & fact(1)*wscp*gradx_scp(j,i)+ + & wbond*gradbx(j,i)+ + & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ + & wsccor*fact(1)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + & +welec*gshieldx(j,i) + & +wcorr*gshieldx_ec(j,i) + & +wturn3*gshieldx_t3(j,i) + & +wturn4*gshieldx_t4(j,i) + & +wel_loc*gshieldx_ll(j,i) + + endif enddo #endif enddo @@ -229,16 +394,17 @@ C & +wturn3*fact(2)*gel_loc_turn3(i) & +wturn6*fact(5)*gel_loc_turn6(i) & +wel_loc*fact(2)*gel_loc_loc(i) - & +wsccor*fact(1)*gsccor_loc(i) +c & +wsccor*fact(1)*gsccor_loc(i) +c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA enddo endif + if (dyn_ss) call dyn_set_nss return end C------------------------------------------------------------------------ subroutine enerprint(energia,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' @@ -269,6 +435,8 @@ C------------------------------------------------------------------------ esccor=energia(19) edihcnstr=energia(20) estr=energia(18) + ethetacnstr=energia(24) + eliptran=energia(22) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1, & wvdwpp, @@ -277,7 +445,8 @@ C------------------------------------------------------------------------ & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), - & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot + & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss, + & eliptran,wliptran,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -299,7 +468,9 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ & 'ETOT= ',1pE16.6,' (total)') #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond, @@ -308,7 +479,7 @@ C------------------------------------------------------------------------ & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, - & edihcnstr,ebr*nss,etot + & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -329,7 +500,9 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -342,7 +515,6 @@ C assuming the LJ potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include "DIMENSIONS.COMPAR" parameter (accur=1.0d-10) include 'COMMON.GEO' @@ -360,12 +532,20 @@ C integer icant external icant cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon +c ROZNICA z cluster +c do i=1,210 +c do j=1,2 +c eneps_temp(j,i)=0.0d0 +c enddo +c enddo +cROZNICA + evdw=0.0D0 evdw_t=0.0d0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -378,8 +558,8 @@ C cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -389,17 +569,22 @@ C Change 12/1/95 to calculate four-body interactions c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e1+e2 ij=icant(itypi,itypj) +c ROZNICA z cluster +c eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij) +c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij +c + cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - if (bb(itypi,itypj).gt.0.0d0) then + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij @@ -510,7 +695,6 @@ C assuming the LJK potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include "DIMENSIONS.COMPAR" include 'COMMON.GEO' include 'COMMON.VAR' @@ -525,12 +709,17 @@ C integer icant external icant c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon +c do i=1,210 +c do j=1,2 +c eneps_temp(j,i)=0.0d0 +c enddo +c enddo evdw=0.0D0 evdw_t=0.0d0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -539,8 +728,8 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -551,10 +740,13 @@ C rij=1.0D0/r_inv_ij r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e_augm+e1+e2 ij=icant(itypi,itypj) +c eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm) +c & /dabs(eps(itypi,itypj)) +c eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps(itypi,itypj) cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') @@ -562,7 +754,7 @@ cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - if (bb(itypi,itypj).gt.0.0d0) then + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij @@ -606,7 +798,6 @@ C assuming the Berne-Pechukas potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include "DIMENSIONS.COMPAR" include 'COMMON.GEO' include 'COMMON.VAR' @@ -622,6 +813,11 @@ c double precision rrsave(maxdim) logical lprn integer icant external icant +c do i=1,210 +c do j=1,2 +c eneps_temp(j,i)=0.0d0 +c enddo +c enddo evdw=0.0D0 evdw_t=0.0d0 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon @@ -632,9 +828,9 @@ c else c endif ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -648,8 +844,8 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -688,29 +884,32 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt ij=icant(itypi,itypj) aux=eps1*eps2rt**2*eps3rt**2 - if (bb(itypi,itypj).gt.0.0d0) then +c eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux +c & /dabs(eps(itypi,itypj)) +c eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj) + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij endif if (calc_grad) then if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa + write (iout,'(2(a3,i3,2x),15(0pf7.3))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), + & om1,om2,om12,1.0D0/dsqrt(rrij), + & evdwij endif C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 @@ -739,7 +938,6 @@ C assuming the Gay-Berne potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include "DIMENSIONS.COMPAR" include 'COMMON.GEO' include 'COMMON.VAR' @@ -750,10 +948,16 @@ C include 'COMMON.INTERACT' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' logical lprn common /srutu/icall - integer icant + integer icant,xshift,yshift,zshift external icant +c do i=1,210 +c do j=1,2 +c eneps_temp(j,i)=0.0d0 +c enddo +c enddo c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 evdw_t=0.0d0 @@ -761,12 +965,42 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +C returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) + &.and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -776,9 +1010,29 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij +C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') +C & 'evdw',i,j,evdwij,' ss',evdw,evdw_t +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + call triple_ssbond_ene(i,j,k,evdwij) +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij +C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') +C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) @@ -800,17 +1054,96 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +C returning jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + &.and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) then + +C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, +C & bb_aq(itypi,itypj)-bb, +C & sslipi,sslipj +C endif + +C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) +C checking the distance + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C finding the closest + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) c write (iout,*) i,j,xj,yj,zj rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + if (sss.le.0.0) cycle C Calculate angle-dependent terms of energy and contributions to their C derivatives. + call sc_angular sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) @@ -824,32 +1157,39 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt - if (bb(itypi,itypj).gt.0) then - evdw=evdw+evdwij + if (bb.gt.0) then + evdw=evdw+evdwij*sss else - evdw_t=evdw_t+evdwij + evdw_t=evdw_t+evdwij*sss endif ij=icant(itypi,itypj) aux=eps1*eps2rt**2*eps3rt**2 +c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1 +c & /dabs(eps(itypi,itypj)) +c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj) c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), c & aux*e2/eps(itypi,itypj) c if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c & restyp(itypi),i,restyp(itypj),j, -c & epsi,sigm,chi1,chi2,chip1,chip2, -c & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c & evdwij -c write (iout,*) "pratial sum", evdw,evdw_t + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa +C#define DEBUG +#ifdef DEBUG + write (iout,'(2(a3,i3,2x),17(0pf7.3))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, + & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, + & evdwij + write (iout,*) "partial sum", evdw, evdw_t +#endif +C#undef DEBUG c endif if (calc_grad) then C Calculate gradient components. @@ -857,6 +1197,7 @@ C Calculate gradient components. fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac @@ -864,6 +1205,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif +C write(iout,*) "partial sum", evdw, evdw_t + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -877,8 +1220,8 @@ C assuming the Gay-Berne-Vorobjev potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include "DIMENSIONS.COMPAR" + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -888,10 +1231,16 @@ C include 'COMMON.INTERACT' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' common /srutu/ icall logical lprn integer icant external icant +c do i=1,210 +c do j=1,2 +c eneps_temp(j,i)=0.0d0 +c enddo +c enddo evdw=0.0D0 evdw_t=0.0d0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -900,12 +1249,45 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +C returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) + & .and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -915,9 +1297,29 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') + & 'evdw',i,j,evdwij,' ss',evdw,evdw_t +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + call triple_ssbond_ene(i,j,k,evdwij) +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') + & 'evdw',i,j,evdwij,'tss',evdw,evdw_t + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) r0ij=r0(itypi,itypj) @@ -940,16 +1342,96 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +C returning jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + & .and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) then + +C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, +C & bb_aq(itypi,itypj)-bb, +C & sslipi,sslipj +C endif + +C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) +C checking the distance + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C finding the closest + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if (dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) +c write (iout,*) i,j,xj,yj,zj rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + if (sss.le.0.0) cycle C Calculate angle-dependent terms of energy and contributions to their C derivatives. + call sc_angular sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) @@ -963,38 +1445,53 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm evdwij=evdwij*eps2rt*eps3rt - if (bb(itypi,itypj).gt.0.0d0) then - evdw=evdw+evdwij+e_augm + if (bb.gt.0) then + evdw=evdw+evdwij*sss+e_augm else - evdw_t=evdw_t+evdwij+e_augm + evdw_t=evdw_t+evdwij*sss+e_augm endif +c evdw=evdw+evdwij+e_augm ij=icant(itypi,itypj) aux=eps1*eps2rt**2*eps3rt**2 +c eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1 +c & /dabs(eps(itypi,itypj)) +c eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj) +c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, +c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), +c & aux*e2/eps(itypi,itypj) c if (lprn) then -c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c & restyp(itypi),i,restyp(itypj),j, -c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), -c & chi1,chi2,chip1,chip2, -c & eps1,eps2rt**2,eps3rt**2, -c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c & evdwij+e_augm +c#define DEBUG +#ifdef DEBUG + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa + write (iout,'(2(a3,i3,2x),17(0pf7.3))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), + & chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2, + & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, + & evdwij+e_augm + write (iout,*) "partial sum", evdw, evdw_t +#endif +c#undef DEBUG c endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'evdw',i,j,evdwij if (calc_grad) then C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm + fac=rij*fac + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac @@ -1002,6 +1499,7 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif + ENDIF enddo ! j enddo ! iint enddo ! i @@ -1060,7 +1558,6 @@ C---------------------------------------------------------------------------- subroutine sc_grad implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.CALC' @@ -1098,7 +1595,6 @@ c------------------------------------------------------------------------------ subroutine vec_and_deriv implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.GEO' include 'COMMON.VAR' @@ -1119,6 +1615,8 @@ C Compute the Z-axis call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) costh=dcos(pi-theta(nres)) fac=1.0d0/dsqrt(1.0d0-costh*costh) +c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1), +c & " uz",uz(:,i) do k=1,3 uz(k,i)=fac*uz(k,i) enddo @@ -1142,7 +1640,7 @@ C Compute the derivatives of uz uzder(1,3,2)= dc_norm(2,i) uzder(2,3,2)=-dc_norm(1,i) uzder(3,3,2)= 0.0d0 - endif + endif ! calc_grad C Compute the Y-axis facy=fac do k=1,3 @@ -1253,288 +1751,24 @@ C Compute the derivatives of uy endif return end -C----------------------------------------------------------------------------- - subroutine vec_and_deriv_test +C-------------------------------------------------------------------------- + subroutine set_matrices implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' +#ifdef MPI + include "mpif.h" + integer IERR + integer status(MPI_STATUS_SIZE) +#endif include 'COMMON.IOUNITS' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uyder(3,3,2),uzder(3,3,2) -C Compute the local reference systems. For reference system (i), the -C X-axis points from CA(i) to CA(i+1), the Y axis is in the -C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. - do i=1,nres-1 - if (i.eq.nres-1) then -C Case of the last full residue -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) - costh=dcos(pi-theta(nres)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) -c write (iout,*) 'fac',fac, -c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i-1) - uzder(3,1,1)= dc_norm(2,i-1) - uzder(1,2,1)= dc_norm(3,i-1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i-1) - uzder(1,3,1)=-dc_norm(2,i-1) - uzder(2,3,1)= dc_norm(1,i-1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - do k=1,3 - uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) - enddo - facy=fac - facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* - & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2- - & scalar(dc_norm(1,i),dc_norm(1,i-1))**2)) - do k=1,3 -c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - uy(k,i)= -c & facy*( - & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i)) - & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i) -c & ) - enddo -c write (iout,*) 'facy',facy, -c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - do k=1,3 - uy(k,i)=facy*uy(k,i) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i-1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo -c uyder(j,j,1)=uyder(j,j,1)-costh -c uyder(j,j,2)=1.0d0+uyder(j,j,2) - uyder(j,j,1)=uyder(j,j,1) - & -scalar(dc_norm(1,i),dc_norm(1,i-1)) - uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) - & +uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - else -C Other residues -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) - costh=dcos(pi-theta(i+2)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i+1) - uzder(3,1,1)= dc_norm(2,i+1) - uzder(1,2,1)= dc_norm(3,i+1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i+1) - uzder(1,3,1)=-dc_norm(2,i+1) - uzder(2,3,1)= dc_norm(1,i+1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* - & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2- - & scalar(dc_norm(1,i),dc_norm(1,i+1))**2)) - do k=1,3 -c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - uy(k,i)= -c & facy*( - & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i)) - & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i) -c & ) - enddo -c write (iout,*) 'facy',facy, -c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - do k=1,3 - uy(k,i)=facy*uy(k,i) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i+1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo -c uyder(j,j,1)=uyder(j,j,1)-costh -c uyder(j,j,2)=1.0d0+uyder(j,j,2) - uyder(j,j,1)=uyder(j,j,1) - & -scalar(dc_norm(1,i),dc_norm(1,i+1)) - uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) - & +uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - endif - enddo - do i=1,nres-1 - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i) - uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine check_vecgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizesclu.dat' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres) - dimension uyt(3,maxres),uzt(3,maxres) - dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3) - double precision delta /1.0d-7/ - call vec_and_deriv -cd do i=1,nres -crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i) -crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i) -crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i) -cd write(iout,'(2i5,2(3f10.5,5x))') i,1, -cd & (dc_norm(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3) -cd write(iout,'(a)') -cd enddo - do i=1,nres - do j=1,2 - do k=1,3 - do l=1,3 - uygradt(l,k,j,i)=uygrad(l,k,j,i) - uzgradt(l,k,j,i)=uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - call vec_and_deriv - do i=1,nres - do j=1,3 - uyt(j,i)=uy(j,i) - uzt(j,i)=uz(j,i) - enddo - enddo - do i=1,nres -cd write (iout,*) 'i=',i - do k=1,3 - erij(k)=dc_norm(k,i) - enddo - do j=1,3 - do k=1,3 - dc_norm(k,i)=erij(k) - enddo - dc_norm(j,i)=dc_norm(j,i)+delta -c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) -c do k=1,3 -c dc_norm(k,i)=dc_norm(k,i)/fac -c enddo -c write (iout,*) (dc_norm(k,i),k=1,3) -c write (iout,*) (erij(k),k=1,3) - call vec_and_deriv - do k=1,3 - uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta - uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta - uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta - uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta - enddo -c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3), -c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3) - enddo - do k=1,3 - dc_norm(k,i)=erij(k) - enddo -cd do k=1,3 -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3), -cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3) -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3), -cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3) -cd write (iout,'(a)') -cd enddo - enddo - return - end -C-------------------------------------------------------------------------- - subroutine set_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizesclu.dat' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' double precision auxvec(2),auxmat(2,2) @@ -1542,6 +1776,130 @@ C C Compute the virtual-bond-torsional-angle dependent quantities needed C to calculate the el-loc multibody terms of various order. C +c write(iout,*) 'SET_MATRICES nphi=',nphi,nres + do i=3,nres+1 + if (i.gt. nnt+2 .and. i.lt.nct+2) then + iti = itype2loc(itype(i-2)) + else + iti=nloctyp + endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then + if (i.gt. nnt+1 .and. i.lt.nct+1) then + iti1 = itype2loc(itype(i-1)) + else + iti1=nloctyp + endif +#ifdef NEWCORR + cost1=dcos(theta(i-1)) + sint1=dsin(theta(i-1)) + sint1sq=sint1*sint1 + sint1cub=sint1sq*sint1 + sint1cost1=2*sint1*cost1 +#ifdef DEBUG + write (iout,*) "bnew1",i,iti + write (iout,*) (bnew1(k,1,iti),k=1,3) + write (iout,*) (bnew1(k,2,iti),k=1,3) + write (iout,*) "bnew2",i,iti + write (iout,*) (bnew2(k,1,iti),k=1,3) + write (iout,*) (bnew2(k,2,iti),k=1,3) +#endif + do k=1,2 + b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1 + b1(k,i-2)=sint1*b1k + gtb1(k,i-2)=cost1*b1k-sint1sq* + & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1) + b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1 + b2(k,i-2)=sint1*b2k + if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq* + & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1) + enddo + do k=1,2 + aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1 + cc(1,k,i-2)=sint1sq*aux + if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1) + aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1 + dd(1,k,i-2)=sint1sq*aux + if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1) + enddo + cc(2,1,i-2)=cc(1,2,i-2) + cc(2,2,i-2)=-cc(1,1,i-2) + gtcc(2,1,i-2)=gtcc(1,2,i-2) + gtcc(2,2,i-2)=-gtcc(1,1,i-2) + dd(2,1,i-2)=dd(1,2,i-2) + dd(2,2,i-2)=-dd(1,1,i-2) + gtdd(2,1,i-2)=gtdd(1,2,i-2) + gtdd(2,2,i-2)=-gtdd(1,1,i-2) + do k=1,2 + do l=1,2 + aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1 + EE(l,k,i-2)=sint1sq*aux + if (calc_grad) + & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti) + enddo + enddo + EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1 + EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1 + EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti) + EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti) + if (calc_grad) then + gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1 + gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1 + gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1 + endif +c b1tilde(1,i-2)=b1(1,i-2) +c b1tilde(2,i-2)=-b1(2,i-2) +c b2tilde(1,i-2)=b2(1,i-2) +c b2tilde(2,i-2)=-b2(2,i-2) +#ifdef DEBUG + write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2) + write(iout,*) 'b1=',(b1(k,i-2),k=1,2) + write(iout,*) 'b2=',(b2(k,i-2),k=1,2) + write (iout,*) 'theta=', theta(i-1) +#endif +#else +c if (i.gt. nnt+2 .and. i.lt.nct+2) then +c iti = itype2loc(itype(i-2)) +c else +c iti=nloctyp +c endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then +c if (i.gt. nnt+1 .and. i.lt.nct+1) then +c iti1 = itype2loc(itype(i-1)) +c else +c iti1=nloctyp +c endif + b1(1,i-2)=b(3,iti) + b1(2,i-2)=b(5,iti) + b2(1,i-2)=b(2,iti) + b2(2,i-2)=b(4,iti) + do k=1,2 + do l=1,2 + CC(k,l,i-2)=ccold(k,l,iti) + DD(k,l,i-2)=ddold(k,l,iti) + EE(k,l,i-2)=eeold(k,l,iti) + enddo + enddo +#endif + b1tilde(1,i-2)= b1(1,i-2) + b1tilde(2,i-2)=-b1(2,i-2) + b2tilde(1,i-2)= b2(1,i-2) + b2tilde(2,i-2)=-b2(2,i-2) +c + Ctilde(1,1,i-2)= CC(1,1,i-2) + Ctilde(1,2,i-2)= CC(1,2,i-2) + Ctilde(2,1,i-2)=-CC(2,1,i-2) + Ctilde(2,2,i-2)=-CC(2,2,i-2) +c + Dtilde(1,1,i-2)= DD(1,1,i-2) + Dtilde(1,2,i-2)= DD(1,2,i-2) + Dtilde(2,1,i-2)=-DD(2,1,i-2) + Dtilde(2,2,i-2)=-DD(2,2,i-2) +c write(iout,*) "i",i," iti",iti +c write(iout,*) 'b1=',(b1(k,i-2),k=1,2) +c write(iout,*) 'b2=',(b2(k,i-2),k=1,2) + enddo do i=3,nres+1 if (i .lt. nres+1) then sin1=dsin(phi(i)) @@ -1609,37 +1967,44 @@ C Ug2der(2,1,i-2)=0.0d0 Ug2der(2,2,i-2)=0.0d0 endif +c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then if (i.gt. nnt+2 .and. i.lt.nct+2) then - if (itype(i-2).le.ntyp) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif + iti = itype2loc(itype(i-2)) else - iti=ntortyp+1 + iti=nloctyp endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then - if (itype(i-1).le.ntyp) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif + iti1 = itype2loc(itype(i-1)) else - iti1=ntortyp+1 + iti1=nloctyp endif cd write (iout,*) '*******i',i,' iti1',iti cd write (iout,*) 'b1',b1(:,iti) cd write (iout,*) 'b2',b2(:,iti) cd write (iout,*) 'Ug',Ug(:,:,i-2) -c print *,"itilde1 i iti iti1",i,iti,iti1 - if (i .gt. iatel_s+2) then - call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) - call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) - call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) - call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) +c if (i .gt. iatel_s+2) then + if (i .gt. nnt+2) then + call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2)) +#ifdef NEWCORR + call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2)) +c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj" +#endif +c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i), +c & EE(1,2,iti),EE(2,2,i) + call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2)) + call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2)) +c write(iout,*) "Macierz EUG", +c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2), +c & eug(2,2,i-2) + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) + & then + call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2)) + endif else do k=1,2 Ub2(k,i-2)=0.0d0 @@ -1653,63 +2018,76 @@ c print *,"itilde1 i iti iti1",i,iti,iti1 enddo enddo endif -c print *,"itilde2 i iti iti1",i,iti,iti1 - call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) - call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) - call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) - call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -c print *,"itilde3 i iti iti1",i,iti,iti1 + call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2)) + call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2)) do k=1,2 muder(k,i-2)=Ub2der(k,i-2) enddo +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then if (itype(i-1).le.ntyp) then - iti1 = itortyp(itype(i-1)) + iti1 = itype2loc(itype(i-1)) else - iti1=ntortyp+1 + iti1=nloctyp endif else - iti1=ntortyp+1 + iti1=nloctyp endif do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) + mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) enddo +#ifdef MUOUT + write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1), + & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2), + & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2), + & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2) + & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2), + & ((ee(l,k,i-2),l=1,2),k=1,2) +#endif +cd write (iout,*) 'mu1',mu1(:,i-2) +cd write (iout,*) 'mu2',mu2(:,i-2) + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) + & then + if (calc_grad) then + call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2)) + endif C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) + call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1)) call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) + call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2)) + call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2)) + call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2)) + if (calc_grad) then call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) - call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) - call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) -cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2), -cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2) + call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2)) + call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2)) + call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2)) + endif + endif enddo C Matrices dependent on two consecutive virtual-bond dihedrals. C The order of matrices is from left to right. + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) + &then do i=2,nres-1 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i)) + if (calc_grad) then call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i)) call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i)) + endif call transpose2(DtUg2(1,1,i-1),auxmat(1,1)) call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i)) + if (calc_grad) then call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i)) call transpose2(DtUg2der(1,1,i-1),auxmat(1,1)) call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i)) + endif enddo -cd do i=1,nres -cd iti = itortyp(itype(i)) -cd write (iout,*) i -cd do j=1,2 -cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') -cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) -cd enddo -cd enddo + endif return end C-------------------------------------------------------------------------- @@ -1722,8 +2100,10 @@ C The potential depends both on the distance of peptide-group centers and on C the orientation of the CA-CA virtual bonds. C implicit real*8 (a-h,o-z) +#ifdef MPI + include 'mpif.h' +#endif include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.CONTROL' include 'COMMON.IOUNITS' include 'COMMON.GEO' @@ -1736,13 +2116,21 @@ C include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' + include 'COMMON.TIME1' + include 'COMMON.SPLITELE' dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1 + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions +#ifdef MOMENT + double precision scal_el /1.0d0/ +#else double precision scal_el /0.5d0/ +#endif C 12/13/98 C 13-go grudnia roku pamietnego... double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, @@ -1771,25 +2159,26 @@ c write (iout,*) 'i',i,' fac',fac if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -cd if (wel_loc.gt.0.0d0) then - if (icheckgrad.eq.1) then - call vec_and_deriv_test - else - call vec_and_deriv - endif +c call vec_and_deriv +#ifdef TIMING + time01=MPI_Wtime() +#endif call set_matrices +#ifdef TIMING + time_mat=time_mat+MPI_Wtime()-time01 +#endif endif cd do i=1,nres-1 cd write (iout,*) 'i=',i cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) +cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) cd enddo cd do k=1,3 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) cd enddo cd enddo - num_conti_hb=0 + t_eelecij=0.0d0 ees=0.0D0 evdw1=0.0D0 eel_loc=0.0d0 @@ -1800,14 +2189,38 @@ cd enddo num_cont_hb(i)=0 enddo cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e +c write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e +c call flush(iout) do i=1,nres gel_loc_loc(i)=0.0d0 gcorr_loc(i)=0.0d0 enddo - do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle - if (itel(i).eq.0) goto 1215 +c +c +c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms +C +C Loop over i,i+2 and i,i+3 pairs of the peptide groups +C +C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition + do i=iturn3_start,iturn3_end +c if (i.le.1) cycle +C write(iout,*) "tu jest i",i + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +C Adam: Unnecessary: handled by iturn3_end and iturn3_start +c & .or.((i+4).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana +C dobra zmiana wycofana + & .or. itype(i+2).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1) cycle +C Adam: Instructions below will switch off existing interactions +c if(i.gt.1)then +c if(itype(i-1).eq.ntyp1)cycle +c end if +c if(i.LT.nres-3)then +c if (itype(i+4).eq.ntyp1) cycle +c end if dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1817,23 +2230,225 @@ cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 + call eelecij(i,i+2,ees,evdw1,eel_loc) + if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) + num_cont_hb(i)=num_conti + enddo + do i=iturn4_start,iturn4_end + if (i.lt.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+5).gt.nres) +c & .or.((i-1).le.0) +C end of changes suggested by Ana + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1 +c & .or. itype(i+5).eq.ntyp1 +c & .or. itype(i).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle + dxi=dc(1,i) + dyi=dc(2,i) + dzi=dc(3,i) + dx_normi=dc_norm(1,i) + dy_normi=dc_norm(2,i) + dz_normi=dc_norm(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi +C Return atom into box, boxxsize is size of box in x dimension +c 194 continue +c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((0.5d0)*boxxsize)).or. +c & (xmedi.lt.((-0.5d0)*boxxsize))) then +c go to 194 +c endif +c 195 continue +c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((0.5d0)*boxysize)).or. +c & (ymedi.lt.((-0.5d0)*boxysize))) then +c go to 195 +c endif +c 196 continue +c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +C Condition for being inside the proper box +c if ((zmedi.gt.((0.5d0)*boxzsize)).or. +c & (zmedi.lt.((-0.5d0)*boxzsize))) then +c go to 196 +c endif + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + + num_conti=num_cont_hb(i) +c write(iout,*) "JESTEM W PETLI" + call eelecij(i,i+3,ees,evdw1,eel_loc) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) + & call eturn4(i,eello_turn4) + num_cont_hb(i)=num_conti + enddo ! i +C Loop over all neighbouring boxes +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 +c +c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 +c +CTU KURWA + do i=iatel_s,iatel_e +C do i=75,75 +c if (i.le.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+2).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana +c & .or. itype(i+2).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle + dxi=dc(1,i) + dyi=dc(2,i) + dzi=dc(3,i) + dx_normi=dc_norm(1,i) + dy_normi=dc_norm(2,i) + dz_normi=dc_norm(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize +C xmedi=xmedi+xshift*boxxsize +C ymedi=ymedi+yshift*boxysize +C zmedi=zmedi+zshift*boxzsize + +C Return tom into box, boxxsize is size of box in x dimension +c 164 continue +c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 164 +c endif +c 165 continue +c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. +c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then +c go to 165 +c endif +c 166 continue +c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +cC Condition for being inside the proper box +c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 166 +c endif + c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + num_conti=num_cont_hb(i) +C I TU KURWA do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle - if (itel(j).eq.0) goto 1216 - ind=ind+1 +C do j=16,17 +C write (iout,*) i,j +C if (j.le.1) cycle + if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((j+2).gt.nres) +c & .or.((j-1).le.0) +C end of changes by Ana +c & .or.itype(j+2).eq.ntyp1 +c & .or.itype(j-1).eq.ntyp1 + &) cycle + call eelecij(i,j,ees,evdw1,eel_loc) + enddo ! j + num_cont_hb(i)=num_conti + enddo ! i +C enddo ! zshift +C enddo ! yshift +C enddo ! xshift + +c write (iout,*) "Number of loop steps in EELEC:",ind +cd do i=1,nres +cd write (iout,'(i3,3f10.5,5x,3f10.5)') +cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) +cd enddo +c 12/7/99 Adam eello_turn3 will be considered as a separate energy term +ccc eel_loc=eel_loc+eello_turn3 +cd print *,"Processor",fg_rank," t_eelecij",t_eelecij + return + end +C------------------------------------------------------------------------------- + subroutine eelecij(i,j,ees,evdw1,eel_loc) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.CONTROL' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' + include 'COMMON.VECTORS' + include 'COMMON.FFIELD' + include 'COMMON.TIME1' + include 'COMMON.SPLITELE' + include 'COMMON.SHIELD' + dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), + & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) + double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4), + & gmuij2(4),gmuji2(4) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 +c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions +#ifdef MOMENT + double precision scal_el /1.0d0/ +#else + double precision scal_el /0.5d0/ +#endif +C 12/13/98 +C 13-go grudnia roku pamietnego... + double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, + & 0.0d0,1.0d0,0.0d0, + & 0.0d0,0.0d0,1.0d0/ + integer xshift,yshift,zshift +c time00=MPI_Wtime() +cd write (iout,*) "eelecij",i,j +c ind=ind+1 iteli=itel(i) itelj=itel(j) if (j.eq.i+2 .and. itelj.eq.2) iteli=2 aaa=app(iteli,itelj) bbb=bpp(iteli,itelj) -C Diagnostics only!!! -c aaa=0.0D0 -c bbb=0.0D0 -c ael6i=0.0D0 -c ael3i=0.0D0 -C End diagnostics ael6i=ael6(iteli,itelj) ael3i=ael3(iteli,itelj) dxj=dc(1,j) @@ -1842,10 +2457,86 @@ C End diagnostics dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi +C xj=c(1,j)+0.5D0*dxj-xmedi +C yj=c(2,j)+0.5D0*dyj-ymedi +C zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif +C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC +c 174 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 174 +c endif +c 175 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +C Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 175 +c endif +c 176 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 176 +c endif +C endif !endPBC condintion +C xj=xj-xmedi +C yj=yj-ymedi +C zj=zj-zmedi rij=xj*xj+yj*yj+zj*zj + + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) +c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut, +c & " rlamb",rlamb," sss",sss +c if (sss.gt.0.0d0) then rrmij=1.0D0/rij rij=dsqrt(rij) rmij=1.0D0/rij @@ -1861,97 +2552,233 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions ev2=bbb*r6ij fac3=ael6i*r6ij fac4=ael3i*r3ij - evdwij=ev1+ev2 + evdwij=(ev1+ev2) el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) el2=fac4*fac - eesij=el1+el2 -c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij +C MARYSIA +C eesij=(el1+el2) C 12/26/95 - for the evaluation of multi-body H-bonding interactions ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) + if (shield_mode.gt.0) then +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + el1=el1*fac_shield(i)**2*fac_shield(j)**2 + el2=el2*fac_shield(i)**2*fac_shield(j)**2 + eesij=(el1+el2) ees=ees+eesij - evdw1=evdw1+evdwij + else + fac_shield(i)=1.0 + fac_shield(j)=1.0 + eesij=(el1+el2) + ees=ees+eesij + endif + evdw1=evdw1+evdwij*sss cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj + + if (energy_dec) then + write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') + &'evdw1',i,j,evdwij + &,iteli,itelj,aaa,evdw1,sss + write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, + &fac_shield(i),fac_shield(j) + endif + C C Calculate contributions to the Cartesian gradient. C #ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) + facvdw=-6*rrmij*(ev1+evdwij)*sss facel=-3*rrmij*(el1+eesij) fac1=fac erij(1)=xj*rmij erij(2)=yj*rmij erij(3)=zj*rmij - if (calc_grad) then + * * Radial derivatives. First process both termini of the fragment (i,j) -* +* + if (calc_grad) then ggg(1)=facel*xj ggg(2)=facel*yj ggg(3)=facel*zj + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C if (iresshield.gt.i) then +C do ishi=i+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C else +C do ishi=iresshield,i +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C endif + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C if (iresshield.gt.j) then +C do ishi=j+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C +C enddo +C else +C do ishi=iresshield,j +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C enddo +C endif + enddo + enddo + do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - gelc(k,j)=gelc(k,j)+ghalf + gshieldc(k,i)=gshieldc(k,i)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j)=gshieldc(k,j)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,i-1)=gshieldc(k,i-1)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j-1)=gshieldc(k,j-1)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + + enddo + endif +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c gelc(k,j)=gelc(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end +C print *,"before", gelc_long(1,i), gelc_long(1,j) + do k=1,3 + gelc_long(k,j)=gelc_long(k,j)+ggg(k) +C & +grad_shield(k,j)*eesij/fac_shield(j) + gelc_long(k,i)=gelc_long(k,i)-ggg(k) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,i-1)=gelc_long(k,i-1) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,j-1)=gelc_long(k,j-1) +C & +grad_shield(k,j)*eesij/fac_shield(j) enddo +C print *,"bafter", gelc_long(1,i), gelc_long(1,j) + * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo - enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo + if (sss.gt.0.0) then + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj + else + ggg(1)=0.0 + ggg(2)=0.0 + ggg(3)=0.0 + endif +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gvdwpp(k,i)=gvdwpp(k,i)+ghalf +c gvdwpp(k,j)=gvdwpp(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end do k=1,3 - ghalf=0.5D0*ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)+ghalf - gvdwpp(k,j)=gvdwpp(k,j)+ghalf + gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) + gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) - enddo - enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) +cgrad enddo +cgrad enddo + endif ! calc_grad #else - facvdw=ev1+evdwij - facel=el1+eesij +C MARYSIA + facvdw=(ev1+evdwij)*sss + facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel) erij(1)=xj*rmij erij(2)=yj*rmij erij(3)=zj*rmij - if (calc_grad) then * * Radial derivatives. First process both termini of the fragment (i,j) * + if (calc_grad) then ggg(1)=fac*xj +C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j) ggg(2)=fac*yj +C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j) ggg(3)=fac*zj +C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j) +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c gelc(k,j)=gelc(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - gelc(k,j)=gelc(k,j)+ghalf + gelc_long(k,j)=gelc(k,j)+ggg(k) + gelc_long(k,i)=gelc(k,i)-ggg(k) enddo * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo +c 9/28/08 AL Gradient compotents will be summed only at the end + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj + do k=1,3 + gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) + gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + endif ! calc_grad #endif * * Angular part * + if (calc_grad) then ecosa=2.0D0*fac3*fac1+fac4 fac4=-3.0D0*fac4 fac3=-6.0D0*fac3 @@ -1964,24 +2791,41 @@ C cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* + & fac_shield(i)**2*fac_shield(j)**2 enddo +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) +c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) +c gelc(k,j)=gelc(k,j)+ghalf +c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) +c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) +c enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo +C print *,"before22", gelc_long(1,i), gelc_long(1,j) do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j)+ghalf - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + gelc(k,i)=gelc(k,i) + & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) + & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) + & *fac_shield(i)**2*fac_shield(j)**2 + gelc(k,j)=gelc(k,j) + & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) + & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) + & *fac_shield(i)**2*fac_shield(j)**2 + gelc_long(k,j)=gelc_long(k,j)+ggg(k) + gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo - enddo - endif +C print *,"before33", gelc_long(1,i), gelc_long(1,j) +C MARYSIA +c endif !sscale + endif ! calc_grad IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN @@ -1992,6 +2836,7 @@ C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms C are computed for EVERY pair of non-contiguous peptide groups. C + if (j.lt.nres-1) then j1=j+1 j2=j-1 @@ -2000,15 +2845,32 @@ C j2=j-2 endif kkk=0 + lll=0 do k=1,2 do l=1,2 kkk=kkk+1 muij(kkk)=mu(k,i)*mu(l,j) +c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l +#ifdef NEWCORR + if (calc_grad) then + gmuij1(kkk)=gtb1(k,i+1)*mu(l,j) +c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j) + gmuij2(kkk)=gUb2(k,i)*mu(l,j) + gmuji1(kkk)=mu(k,i)*gtb1(l,j+1) +c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i) + gmuji2(kkk)=mu(k,i)*gUb2(l,j) + endif +#endif enddo enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij +#ifdef DEBUG + write (iout,*) 'EELEC: i',i,' j',j + write (iout,*) 'j',j,' j1',j1,' j2',j2 + write(iout,*) 'muij',muij + write (iout,*) "uy",uy(:,i) + write (iout,*) "uz",uz(:,j) + write (iout,*) "erij",erij +#endif ury=scalar(uy(1,i),erij) urz=scalar(uz(1,i),erij) vry=scalar(uy(1,j),erij) @@ -2017,15 +2879,7 @@ cd write(iout,*) 'muij',muij a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz a32=scalar(uz(1,i),uy(1,j))-3*urz*vry a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz -C For diagnostics only -cd a22=1.0d0 -cd a23=1.0d0 -cd a32=1.0d0 -cd a33=1.0d0 fac=dsqrt(-ael6i)*r3ij -cd write (2,*) 'fac=',fac -C For diagnostics only -cd fac=1.0d0 a22=a22*fac a23=a23*fac a32=a32*fac @@ -2033,22 +2887,17 @@ cd fac=1.0d0 cd write (iout,'(4i5,4f10.5)') cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3), -cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3) +cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), +cd & uy(:,j),uz(:,j) cd write (iout,'(4f10.5)') cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(2i3,9f10.5/)') i,j, +cd write (iout,'(9f10.5/)') cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij - if (calc_grad) then C Derivatives of the elements of A in virtual-bond vectors + if (calc_grad) then call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) -cd do k=1,3 -cd do l=1,3 -cd erder(k,l)=0.0d0 -cd enddo -cd enddo do k=1,3 uryg(k,1)=scalar(erder(1,k),uy(1,i)) uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) @@ -2063,24 +2912,12 @@ cd enddo vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) enddo -cd do k=1,3 -cd do l=1,3 -cd uryg(k,l)=0.0d0 -cd urzg(k,l)=0.0d0 -cd vryg(k,l)=0.0d0 -cd vrzg(k,l)=0.0d0 -cd enddo -cd enddo C Compute radial contributions to the gradient facr=-3.0d0*rrmij a22der=a22*facr a23der=a23*facr a32der=a32*facr a33der=a33*facr -cd a22der=0.0d0 -cd a23der=0.0d0 -cd a32der=0.0d0 -cd a33der=0.0d0 agg(1,1)=a22der*xj agg(2,1)=a22der*yj agg(3,1)=a22der*zj @@ -2103,36 +2940,36 @@ C Add the contributions coming from er enddo do k=1,3 C Derivatives in DC(i) - ghalf1=0.5d0*agg(k,1) - ghalf2=0.5d0*agg(k,2) - ghalf3=0.5d0*agg(k,3) - ghalf4=0.5d0*agg(k,4) +cgrad ghalf1=0.5d0*agg(k,1) +cgrad ghalf2=0.5d0*agg(k,2) +cgrad ghalf3=0.5d0*agg(k,3) +cgrad ghalf4=0.5d0*agg(k,4) aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)+ghalf1 + & -3.0d0*uryg(k,2)*vry)!+ghalf1 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)+ghalf2 + & -3.0d0*uryg(k,2)*vrz)!+ghalf2 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)+ghalf3 + & -3.0d0*urzg(k,2)*vry)!+ghalf3 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)+ghalf4 + & -3.0d0*urzg(k,2)*vrz)!+ghalf4 C Derivatives in DC(i+1) aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)+agg(k,1) + & -3.0d0*uryg(k,3)*vry)!+agg(k,1) aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)+agg(k,2) + & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)+agg(k,3) + & -3.0d0*urzg(k,3)*vry)!+agg(k,3) aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)+agg(k,4) + & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) C Derivatives in DC(j) aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)+ghalf1 + & -3.0d0*vryg(k,2)*ury)!+ghalf1 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)+ghalf2 + & -3.0d0*vrzg(k,2)*ury)!+ghalf2 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)+ghalf3 + & -3.0d0*vryg(k,2)*urz)!+ghalf3 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)+ghalf4 + & -3.0d0*vrzg(k,2)*urz)!+ghalf4 C Derivatives in DC(j+1) or DC(nres-1) aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) & -3.0d0*vryg(k,3)*ury) @@ -2142,41 +2979,20 @@ C Derivatives in DC(j+1) or DC(nres-1) & -3.0d0*vryg(k,3)*urz) aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) & -3.0d0*vrzg(k,3)*urz) -cd aggi(k,1)=ghalf1 -cd aggi(k,2)=ghalf2 -cd aggi(k,3)=ghalf3 -cd aggi(k,4)=ghalf4 -C Derivatives in DC(i+1) -cd aggi1(k,1)=agg(k,1) -cd aggi1(k,2)=agg(k,2) -cd aggi1(k,3)=agg(k,3) -cd aggi1(k,4)=agg(k,4) -C Derivatives in DC(j) -cd aggj(k,1)=ghalf1 -cd aggj(k,2)=ghalf2 -cd aggj(k,3)=ghalf3 -cd aggj(k,4)=ghalf4 -C Derivatives in DC(j+1) -cd aggj1(k,1)=0.0d0 -cd aggj1(k,2)=0.0d0 -cd aggj1(k,3)=0.0d0 -cd aggj1(k,4)=0.0d0 - if (j.eq.nres-1 .and. i.lt.j-2) then - do l=1,4 - aggj1(k,l)=aggj1(k,l)+agg(k,l) -cd aggj1(k,l)=agg(k,l) - enddo - endif +cgrad if (j.eq.nres-1 .and. i.lt.j-2) then +cgrad do l=1,4 +cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) +cgrad enddo +cgrad endif enddo - endif -c goto 11111 -C Check the loc-el terms by numerical integration + endif ! calc_grad acipa(1,1)=a22 acipa(1,2)=a23 acipa(2,1)=a32 acipa(2,2)=a33 a22=-a22 a23=-a23 + if (calc_grad) then do l=1,2 do k=1,3 agg(k,l)=-agg(k,l) @@ -2186,6 +3002,7 @@ C Check the loc-el terms by numerical integration aggj1(k,l)=-aggj1(k,l) enddo enddo + endif ! calc_grad if (j.lt.nres-1) then a22=-a22 a32=-a32 @@ -2214,63 +3031,188 @@ C Check the loc-el terms by numerical integration enddo endif ENDIF ! WCORR -11111 continue IF (wel_loc.gt.0.0d0) THEN C Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij -cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) +#ifdef DEBUG + write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32, + & " a33",a33 + write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij, + & " wel_loc",wel_loc +#endif + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif + eel_loc_ij=eel_loc_ij + & *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'eelloc',i,j,eel_loc_ij +c if (eel_loc_ij.ne.0) +c & write (iout,'(a4,2i4,8f9.5)')'chuj', +c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4) + eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma +C Now derivative over eel_loc if (calc_grad) then + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij + & /fac_shield(i) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij + & /fac_shield(j) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_ll(k,i)=gshieldc_ll(k,i)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j)=gshieldc_ll(k,j)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + enddo + endif + + +c write (iout,*) 'i',i,' j',j,itype(i),itype(j), +c & ' eel_loc_ij',eel_loc_ij +C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4) +C Calculate patrial derivative for theta angle +#ifdef NEWCORR + geel_loc_ij=(a22*gmuij1(1) + & +a23*gmuij1(2) + & +a32*gmuij1(3) + & +a33*gmuij1(4)) + & *fac_shield(i)*fac_shield(j) +c write(iout,*) "derivative over thatai" +c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), +c & a33*gmuij1(4) + gloc(nphi+i,icg)=gloc(nphi+i,icg)+ + & geel_loc_ij*wel_loc +c write(iout,*) "derivative over thatai-1" +c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3), +c & a33*gmuij2(4) + geel_loc_ij= + & a22*gmuij2(1) + & +a23*gmuij2(2) + & +a32*gmuij2(3) + & +a33*gmuij2(4) + gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ + & geel_loc_ij*wel_loc + & *fac_shield(i)*fac_shield(j) + +c Derivative over j residue + geel_loc_ji=a22*gmuji1(1) + & +a23*gmuji1(2) + & +a32*gmuji1(3) + & +a33*gmuji1(4) +c write(iout,*) "derivative over thataj" +c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3), +c & a33*gmuji1(4) + + gloc(nphi+j,icg)=gloc(nphi+j,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) + + geel_loc_ji= + & +a22*gmuji2(1) + & +a23*gmuji2(2) + & +a32*gmuji2(3) + & +a33*gmuji2(4) +c write(iout,*) "derivative over thataj-1" +c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), +c & a33*gmuji2(4) + gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) +#endif +cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij + +C Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij) -cd write(iout,*) 'agg ',agg -cd write(iout,*) 'aggi ',aggi -cd write(iout,*) 'aggi1',aggi1 -cd write(iout,*) 'aggj ',aggj -cd write(iout,*) 'aggj1',aggj1 + & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) + & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) + & *fac_shield(i)*fac_shield(j) + gel_loc_loc(j-1)=gel_loc_loc(j-1)+ + & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) + & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) + & *fac_shield(i)*fac_shield(j) C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - enddo - do k=i+2,j2 - do l=1,3 - gel_loc(l,k)=gel_loc(l,k)+ggg(l) - enddo + ggg(l)=(agg(l,1)*muij(1)+ + & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) + gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) +cgrad ghalf=0.5d0*ggg(l) +cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf +cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo +cgrad do k=i+1,j2 +cgrad do l=1,3 +cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) +cgrad enddo +cgrad enddo C Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ + & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ + & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ + & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ + & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + enddo - endif + endif ! calc_grad ENDIF - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then -C Contributions from turns - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 - call eturn34(i,j,eello_turn3,eello_turn4) - endif + + C Change 12/26/95 to calculate four-body contributions to H-bonding energy - if (j.gt.i+1 .and. num_conti.le.maxconts) then +c if (j.gt.i+1 .and. num_conti.le.maxconts) then + if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 + & .and. num_conti.le.maxconts) then +c write (iout,*) i,j," entered corr" C C Calculate the contact function. The ith column of the array JCONT will C contain the numbers of atoms that make contacts with the atom I (of numbers @@ -2288,6 +3230,8 @@ c r0ij=1.55D0*rpp(iteli,itelj) & ' will skip next contacts for this conf.' else jcont_hb(num_conti,i)=j +cd write (iout,*) "i",i," j",j," num_conti",num_conti, +cd & " jcont_hb",jcont_hb(num_conti,i) IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el @@ -2300,42 +3244,10 @@ C --- Electrostatic-interaction matrix --- a_chuj(2,1,num_conti,i)=a32 a_chuj(2,2,num_conti,i)=a33 C --- Gradient of rij + if (calc_grad) then do kkk=1,3 grij_hb_cont(kkk,num_conti,i)=erij(kkk) enddo -c if (i.eq.1) then -c a_chuj(1,1,num_conti,i)=-0.61d0 -c a_chuj(1,2,num_conti,i)= 0.4d0 -c a_chuj(2,1,num_conti,i)= 0.65d0 -c a_chuj(2,2,num_conti,i)= 0.50d0 -c else if (i.eq.2) then -c a_chuj(1,1,num_conti,i)= 0.0d0 -c a_chuj(1,2,num_conti,i)= 0.0d0 -c a_chuj(2,1,num_conti,i)= 0.0d0 -c a_chuj(2,2,num_conti,i)= 0.0d0 -c endif -C --- and its gradients -cd write (iout,*) 'i',i,' j',j -cd do kkk=1,3 -cd write (iout,*) 'iii 1 kkk',kkk -cd write (iout,*) agg(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 2 kkk',kkk -cd write (iout,*) aggi(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 3 kkk',kkk -cd write (iout,*) aggi1(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 4 kkk',kkk -cd write (iout,*) aggj(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 5 kkk',kkk -cd write (iout,*) aggj1(kkk,:) -cd enddo kkll=0 do k=1,2 do l=1,2 @@ -2346,12 +3258,10 @@ cd enddo a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) -c do mm=1,5 -c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0 -c enddo enddo enddo enddo + endif ! calc_grad ENDIF IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN C Calculate contact energies @@ -2361,21 +3271,42 @@ C Calculate contact energies cosbg2=cosb-cosg c fac3=dsqrt(-ael6i)/r0ij**3 fac3=dsqrt(-ael6i)*r3ij - ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) +c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) + ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 + if (ees0tmp.gt.0) then + ees0pij=dsqrt(ees0tmp) + else + ees0pij=0 + endif +c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) + ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 + if (ees0tmp.gt.0) then + ees0mij=dsqrt(ees0tmp) + else + ees0mij=0 + endif c ees0mij=0.0D0 + if (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + else + ees0plist(num_conti,i)=j +C fac_shield(i)=0.4d0 +C fac_shield(j)=0.6d0 + endif ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) + & *fac_shield(i)*fac_shield(j) ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + & *fac_shield(i)*fac_shield(j) C Diagnostics. Comment out or remove after debugging! c ees0p(num_conti,i)=0.5D0*fac3*ees0pij c ees0m(num_conti,i)=0.5D0*fac3*ees0mij c ees0m(num_conti,i)=0.0D0 C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont - facont_hb(num_conti,i)=fcont - if (calc_grad) then +c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, +c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont C Angular derivatives of the contact function + ees0pij1=fac3/ees0pij ees0mij1=fac3/ees0mij fac3p=-3.0D0*fac3*rrmij @@ -2402,6 +3333,9 @@ c ecosam=0.0D0 c ecosbm=0.0D0 c ecosgm=0.0D0 C End diagnostics + facont_hb(num_conti,i)=fcont + + if (calc_grad) then fprimcont=fprimcont/rij cd facont_hb(num_conti,i)=1.0D0 C Following line is for diagnostics. @@ -2425,24 +3359,39 @@ C Derivatives due to the contact function gacont_hbr(2,num_conti,i)=fprimcont*yj gacont_hbr(3,num_conti,i)=fprimcont*zj do k=1,3 - ghalfp=0.5D0*gggp(k) - ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=ghalfp +c +c 10/24/08 cgrad and ! comments indicate the parts of the code removed +c following the change of gradient-summation algorithm. +c +cgrad ghalfp=0.5D0*gggp(k) +cgrad ghalfm=0.5D0*gggm(k) + gacontp_hb1(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=ghalfp + & *fac_shield(i)*fac_shield(j) + + gacontp_hb2(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=ghalfm + & *fac_shield(i)*fac_shield(j) + + gacontm_hb1(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=ghalfm + & *fac_shield(i)*fac_shield(j) + + gacontm_hb2(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb3(k,num_conti,i)=gggm(k) + & *fac_shield(i)*fac_shield(j) + enddo - endif C Diagnostics. Comment out or remove after debugging! cdiag do k=1,3 cdiag gacontp_hb1(k,num_conti,i)=0.0D0 @@ -2452,29 +3401,40 @@ cdiag gacontm_hb1(k,num_conti,i)=0.0D0 cdiag gacontm_hb2(k,num_conti,i)=0.0D0 cdiag gacontm_hb3(k,num_conti,i)=0.0D0 cdiag enddo + + endif ! calc_grad + ENDIF ! wcorr endif ! num_conti.le.maxconts endif ! fcont.gt.0 endif ! j.gt.i+1 - 1216 continue - enddo ! j - num_cont_hb(i)=num_conti - 1215 continue - enddo ! i -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 + if (calc_grad) then + if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then + do k=1,4 + do l=1,3 + ghalf=0.5d0*agg(l,k) + aggi(l,k)=aggi(l,k)+ghalf + aggi1(l,k)=aggi1(l,k)+agg(l,k) + aggj(l,k)=aggj(l,k)+ghalf + enddo + enddo + if (j.eq.nres-1 .and. i.lt.j-2) then + do k=1,4 + do l=1,3 + aggj1(l,k)=aggj1(l,k)+agg(l,k) + enddo + enddo + endif + endif + endif ! calc_grad +c t_eelecij=t_eelecij+MPI_Wtime()-time00 return end C----------------------------------------------------------------------------- - subroutine eturn34(i,j,eello_turn3,eello_turn4) + subroutine eturn3(i,eello_turn3) C Third- and fourth-order contributions from turns implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.GEO' include 'COMMON.VAR' @@ -2486,14 +3446,25 @@ C Third- and fourth-order contributions from turns include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' dimension ggg(3) double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2), + & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2), + & auxgmat2(2,2),auxgmatt2(2,2) double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 - if (j.eq.i+2) then + & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 + j=i+2 +c write (iout,*) "eturn3",i,j,j1,j2 + a_temp(1,1)=a22 + a_temp(1,2)=a23 + a_temp(2,1)=a32 + a_temp(2,2)=a33 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Third-order contributions @@ -2506,47 +3477,132 @@ C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn3(i,a_temp,eello_turn3_num) call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) +c auxalary matices for theta gradient +c auxalary matrix for i+1 and constant i+2 + call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1)) +c auxalary matrix for i+2 and constant i+1 + call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1)) call transpose2(auxmat(1,1),auxmat1(1,1)) + call transpose2(auxgmat1(1,1),auxgmatt1(1,1)) + call transpose2(auxgmat2(1,1),auxgmatt2(1,1)) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) + call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1)) + call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, + & eello_t3 + if (calc_grad) then +C#ifdef NEWCORR +C Derivatives in theta + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) + & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) +C#endif + +C Derivatives in shield mode + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t3(k,i)=gshieldc_t3(k,i)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j)=gshieldc_t3(k,j)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + enddo + endif + +C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') cd write (2,*) 'i,',i,' j',j,'eello_turn3', cd & 0.5d0*(pizda(1,1)+pizda(2,2)), cd & ' eello_turn3_num',4*eello_turn3_num - if (calc_grad) then C Derivatives in gamma(i) call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),pizda(1,1)) - call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) + call transpose2(auxmat2(1,1),auxmat3(1,1)) + call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),pizda(1,1)) - call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) + call transpose2(auxmat2(1,1),auxmat3(1,1)) + call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Cartesian derivatives do l=1,3 - a_temp(1,1)=aggi(l,1) - a_temp(1,2)=aggi(l,2) - a_temp(2,1)=aggi(l,3) - a_temp(2,2)=aggi(l,4) +c ghalf1=0.5d0*agg(l,1) +c ghalf2=0.5d0*agg(l,2) +c ghalf3=0.5d0*agg(l,3) +c ghalf4=0.5d0*agg(l,4) + a_temp(1,1)=aggi(l,1)!+ghalf1 + a_temp(1,2)=aggi(l,2)!+ghalf2 + a_temp(2,1)=aggi(l,3)!+ghalf3 + a_temp(2,2)=aggi(l,4)!+ghalf4 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i)=gcorr3_turn(l,i) & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggi1(l,1) - a_temp(1,2)=aggi1(l,2) - a_temp(2,1)=aggi1(l,3) - a_temp(2,2)=aggi1(l,4) + & *fac_shield(i)*fac_shield(j) + + a_temp(1,1)=aggi1(l,1)!+agg(l,1) + a_temp(1,2)=aggi1(l,2)!+agg(l,2) + a_temp(2,1)=aggi1(l,3)!+agg(l,3) + a_temp(2,2)=aggi1(l,4)!+agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj(l,1) - a_temp(1,2)=aggj(l,2) - a_temp(2,1)=aggj(l,3) - a_temp(2,2)=aggj(l,4) + & *fac_shield(i)*fac_shield(j) + a_temp(1,1)=aggj(l,1)!+ghalf1 + a_temp(1,2)=aggj(l,2)!+ghalf2 + a_temp(2,1)=aggj(l,3)!+ghalf3 + a_temp(2,2)=aggj(l,4)!+ghalf4 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j)=gcorr3_turn(l,j) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -2554,9 +3610,45 @@ C Cartesian derivatives call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) enddo - endif - else if (j.eq.i+3 .and. itype(i+2).ne.21) then + + endif ! calc_grad + + return + end +C------------------------------------------------------------------------------- + subroutine eturn4(i,eello_turn4) +C Third- and fourth-order contributions from turns + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' + include 'COMMON.VECTORS' + include 'COMMON.FFIELD' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' + dimension ggg(3) + double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), + & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2), + & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2), + & gte1t(2,2),gte2t(2,2),gte3t(2,2), + & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2), + & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2) + double precision agg(3,4),aggi(3,4),aggi1(3,4), + & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 + j=i+3 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Fourth-order contributions @@ -2569,52 +3661,188 @@ C (i+1)o----i C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn4(i,a_temp,eello_turn4_num) - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) +c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 +c write(iout,*)"WCHODZE W PROGRAM" + a_temp(1,1)=a22 + a_temp(1,2)=a23 + a_temp(2,1)=a32 + a_temp(2,2)=a33 + iti1=itype2loc(itype(i+1)) + iti2=itype2loc(itype(i+2)) + iti3=itype2loc(itype(i+3)) +c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 call transpose2(EUg(1,1,i+1),e1t(1,1)) call transpose2(Eug(1,1,i+2),e2t(1,1)) call transpose2(Eug(1,1,i+3),e3t(1,1)) +C Ematrix derivative in theta + call transpose2(gtEUg(1,1,i+1),gte1t(1,1)) + call transpose2(gtEug(1,1,i+2),gte2t(1,1)) + call transpose2(gtEug(1,1,i+3),gte3t(1,1)) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) +c eta1 in derivative theta + call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) +c auxgvec is derivative of Ub2 so i+3 theta + call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1)) +c auxalary matrix of E i+1 + call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1)) +c s1=0.0 +c gs1=0.0 + s1=scalar2(b1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+3 + gs23=scalar2(gtb1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+2 + gs32=scalar2(b1(1,i+2),auxgvec(1)) +c derivative of E matix in theta of i+1 + gsE13=scalar2(b1(1,i+2),auxgEvec1(1)) + call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) +c ea31 in derivative theta + call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) +c auxilary matrix auxgvec of Ub2 with constant E matirx + call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1)) +c auxilary matrix auxgEvec1 of E matix with Ub2 constant + call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1)) + +c s2=0.0 +c gs2=0.0 + s2=scalar2(b1(1,i+1),auxvec(1)) +c derivative of theta i+1 with constant i+3 + gs13=scalar2(gtb1(1,i+1),auxvec(1)) +c derivative of theta i+2 with constant i+1 + gs21=scalar2(b1(1,i+1),auxgvec(1)) +c derivative of theta i+3 with constant i+1 + gsE31=scalar2(b1(1,i+1),auxgEvec3(1)) +c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2), +c & gtb1(1,i+1) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) +c two derivatives over diffetent matrices +c gtae3e2 is derivative over i+3 + call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1)) +c ae3gte2 is derivative over i+2 + call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) +c three possible derivative over theta E matices +c i+1 + call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1)) +c i+2 + call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1)) +c i+3 + call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) + + gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2)) + gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2)) + gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.6 +C fac_shield(j)=0.4 + endif eello_turn4=eello_turn4-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) + eello_t4=-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) +c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)') + & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3 +C Now derivative over shield: + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t4(k,i)=gshieldc_t4(k,i)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j)=gshieldc_t4(k,j)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + enddo + endif cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), cd & ' eello_turn4_num',8*eello_turn4_num +#ifdef NEWCORR + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & -(gs13+gsE13+gsEE1)*wturn4 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg) + & -(gs23+gs21+gsEE2)*wturn4 + & *fac_shield(i)*fac_shield(j) + + gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg) + & -(gs32+gsE31+gsEE3)*wturn4 + & *fac_shield(i)*fac_shield(j) + +c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)- +c & gs2 +#endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'eturn4',i,j,-(s1+s2+s3) +c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), +c & ' eello_turn4_num',8*eello_turn4_num C Derivatives in gamma(i) - if (calc_grad) then call transpose2(EUgder(1,1,i+1),e1tder(1,1)) call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call transpose2(EUgder(1,1,i+2),e2tder(1,1)) call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+2) call transpose2(EUgder(1,1,i+3),e3tder(1,1)) call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1)) - call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) + s2=scalar2(b1(1,i+1),auxvec(1)) + call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) + call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) + if (calc_grad) then C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) if (j.lt.nres-1) then @@ -2625,15 +3853,16 @@ C Derivatives of this turn contributions in DC(i+2) a_temp(2,2)=agg(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) ggg(l)=-(s1+s2+s3) gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo endif C Remaining derivatives of this turn contribution @@ -2644,59 +3873,65 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggi(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) a_temp(2,2)=aggi1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) a_temp(2,2)=aggj(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) a_temp(2,2)=aggj1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) +c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo - endif - endif + + endif ! calc_grad + return end C----------------------------------------------------------------------------- @@ -2741,7 +3976,6 @@ C side-chain vectors. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -2757,7 +3991,7 @@ cd print '(a)','Enter ESCP' c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e, c & ' scal14',scal14 do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i), c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) @@ -2765,37 +3999,90 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) - +C Returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) +C returning the jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C Finding the closest jth atom + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif rrij=1.0D0/(xj*xj+yj*yj+zj*zj) +C sss is scaling function for smoothing the cutoff gradient otherwise +C the gradient would not be continuouse + sss=sscale(1.0d0/(dsqrt(rrij))) + if (sss.le.0.0d0) cycle + sssgrad=sscagrad(1.0d0/(dsqrt(rrij))) fac=rrij**expon2 e1=fac*fac*aad(itypj,iteli) e2=fac*bad(itypj,iteli) if (iabs(j-i) .le. 2) then e1=scal14*e1 e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 + evdw2_14=evdw2_14+(e1+e2)*sss endif evdwij=e1+e2 -c write (iout,*) i,j,evdwij - evdw2=evdw2+evdwij +c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') +c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli), +c & bad(itypj,iteli) + evdw2=evdw2+evdwij*sss if (calc_grad) then C C Calculate contributions to the gradient in the virtual-bond and SC vectors. C - fac=-(evdwij+e1)*rrij + fac=-(evdwij+e1)*rrij*sss + fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -2825,7 +4112,7 @@ cd write (iout,*) ggg(1),ggg(2),ggg(3) gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) enddo enddo - endif + endif ! calc_grad enddo enddo ! iint 1225 continue @@ -2854,16 +4141,18 @@ C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.VAR' include 'COMMON.INTERACT' + include 'COMMON.CONTROL' + include 'COMMON.IOUNITS' dimension ggg(3) ehpb=0.0D0 -cd print *,'edis: nhpb=',nhpb,' fbr=',fbr -cd print *,'link_start=',link_start,' link_end=',link_end +c write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr +c write(iout,*)'link_start=',link_start,' link_end=',link_end +C write(iout,*) link_end, "link_end" if (link_end.eq.0) return do i=link_start,link_end C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a @@ -2880,24 +4169,98 @@ C iii and jjj point to the residues for which the distance is assigned. endif C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. +C & iabs(itype(jjj)).eq.1) then +C write(iout,*) constr_dist,"const" + if (.not.dyn_ss .and. i.le.nss) then + if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. + & iabs(itype(jjj)).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) + endif !ii.gt.neres + else if (ii.gt.nres .and. jj.gt.nres) then +c Restraints from contact prediction + dd=dist(ii,jj) + if (constr_dist.eq.11) then +C ehpb=ehpb+fordepth(i)**4.0d0 +C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd +C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, +C & ehpb,fordepth(i),dd +C write(iout,*) ehpb,"atu?" +C ehpb,"tu?" +C fac=fordepth(i)**4.0d0 +C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "beta nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + dd=dist(ii,jj) + rdis=dd-dhpb(i) +C Get the force constant corresponding to this distance. + waga=forcon(i) +C Calculate the contribution to energy. + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "beta reg",dd,waga*rdis*rdis +C +C Evaluate gradient. +C + fac=waga*rdis/dd + endif !end dhpb1(i).gt.0 + endif !end const_dist=11 + do j=1,3 + ggg(j)=fac*(c(j,jj)-c(j,ii)) + enddo + do j=1,3 + ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) + ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) + enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo + else !ii.gt.nres +C write(iout,*) "before" + dd=dist(ii,jj) +C write(iout,*) "after",dd + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd +C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i)) +C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd +C print *,ehpb,"tu?" +C write(iout,*) ehpb,"btu?", +C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i) +C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, +C & ehpb,fordepth(i),dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "alph nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + rdis=dd-dhpb(i) C Get the force constant corresponding to this distance. - waga=forcon(i) + waga=forcon(i) C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "alpha reg",dd,waga*rdis*rdis C C Evaluate gradient. C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac + fac=waga*rdis/dd + endif + endif + do j=1,3 ggg(j)=fac*(c(j,jj)-c(j,ii)) enddo @@ -2917,7 +4280,7 @@ C Cartesian gradient in the SC vectors (ghpbx). enddo endif enddo - ehpb=0.5D0*ehpb + if (constr_dist.ne.11) ehpb=0.5D0*ehpb return end C-------------------------------------------------------------------------- @@ -2931,7 +4294,6 @@ C A. Liwo and U. Kozlowska, 11/24/03 C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -2940,7 +4302,7 @@ C include 'COMMON.VAR' include 'COMMON.IOUNITS' double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) + itypi=iabs(itype(i)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -2948,7 +4310,7 @@ C dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=dsc_inv(itypi) - itypj=itype(j) + itypj=iabs(itype(j)) dscj_inv=dsc_inv(itypj) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -3012,7 +4374,6 @@ c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds c implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.LOCAL' include 'COMMON.GEO' include 'COMMON.INTERACT' @@ -3023,40 +4384,48 @@ c include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' - logical energy_dec /.false./ double precision u(3),ud(3) estr=0.0d0 + estr1=0.0d0 +c write (iout,*) "distchainmax",distchainmax do i=nnt+1,nct - if (itype(i-1).eq.21 .or. itype(i).eq.21) then - estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) - do j=1,3 - gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) - & *dc(j,i-1)/vbld(i) - enddo - if (energy_dec) write(iout,*) - & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) - else + if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle +C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) +C do j=1,3 +C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) +C & *dc(j,i-1)/vbld(i) +C enddo +C if (energy_dec) write(iout,*) +C & "estr1",i,vbld(i),distchainmax, +C & gnmr1(vbld(i),-1.0d0,distchainmax) +C else + if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then + diff = vbld(i)-vbldpDUM +C write(iout,*) i,diff + else diff = vbld(i)-vbldp0 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff + endif estr=estr+diff*diff do j=1,3 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) enddo - endif - +C endif +C write (iout,'(a7,i5,4f7.3)') +C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff enddo - estr=0.5d0*AKP*estr + estr=0.5d0*AKP*estr+estr1 c c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included c do i=nnt,nct - iti=itype(i) - if (iti.ne.10 .and. iti.ne.21) then + iti=iabs(itype(i)) + if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff +C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, +C & AKSC(1,iti),AKSC(1,iti)*diff*diff estr=estr+0.5d0*AKSC(1,iti)*diff*diff do j=1,3 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) @@ -3098,14 +4467,13 @@ c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi) end #ifdef CRYST_THETA C-------------------------------------------------------------------------- - subroutine ebend(etheta) + subroutine ebend(etheta,ethetacnstr) C C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral C angles gamma and its derivatives in consecutive thetas and gammas. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.LOCAL' include 'COMMON.GEO' include 'COMMON.INTERACT' @@ -3115,27 +4483,48 @@ C include 'COMMON.IOUNITS' include 'COMMON.NAMES' include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' common /calcthet/ term1,term2,termm,diffak,ratak, & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, & delthe0,sig0inv,sigtc,sigsqtc,delthec,it double precision y(2),z(2) delta=0.02d0*pi - time11=dexp(-2*time) - time12=1.0d0 +c time11=dexp(-2*time) +c time12=1.0d0 etheta=0.0D0 c write (iout,*) "nres",nres c write (*,'(a,i2)') 'EBEND ICG=',icg c write (iout,*) ithet_start,ithet_end do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle +C if (itype(i-1).eq.ntyp1) cycle + if (i.le.2) cycle + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle C Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) it=itype(i-1) - if (i.gt.3 .and. itype(i-2).ne.21) then + ichir1=isign(1,itype(i-2)) + ichir2=isign(1,itype(i)) + if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) + if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) + if (itype(i-1).eq.10) then + itype1=isign(10,itype(i-2)) + ichir11=isign(1,itype(i-2)) + ichir12=isign(1,itype(i-2)) + itype2=isign(10,itype(i)) + ichir21=isign(1,itype(i)) + ichir22=isign(1,itype(i)) + endif + if (i.eq.3) then + y(1)=0.0D0 + y(2)=0.0D0 + else + + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) - icrc=0 - call proc_proc(phii,icrc) +c icrc=0 +c call proc_proc(phii,icrc) if (icrc.eq.1) phii=150.0 #else phii=phi(i) @@ -3146,11 +4535,12 @@ C Zero the energy function and its derivative at 0 or pi. y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.21) then + endif + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) - icrc=0 - call proc_proc(phii1,icrc) +c icrc=0 +c call proc_proc(phii1,icrc) if (icrc.eq.1) phii1=150.0 phii1=pinorm(phii1) z(1)=cos(phii1) @@ -3168,8 +4558,12 @@ C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). C In following comments this theta will be referred to as t_c. thet_pred_mean=0.0d0 do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) + athetk=athet(k,it,ichir1,ichir2) + bthetk=bthet(k,it,ichir1,ichir2) + if (it.eq.10) then + athetk=athet(k,itype1,ichir11,ichir12) + bthetk=bthet(k,itype2,ichir21,ichir22) + endif thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) enddo c write (iout,*) "thet_pred_mean",thet_pred_mean @@ -3177,8 +4571,16 @@ c write (iout,*) "thet_pred_mean",thet_pred_mean thet_pred_mean=thet_pred_mean*ss+a0thet(it) c write (iout,*) "thet_pred_mean",thet_pred_mean C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss + dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) + &+athet(2,it,ichir1,ichir2)*y(1))*ss + dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) + & +bthet(2,it,ichir1,ichir2)*z(1))*ss + if (it.eq.10) then + dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) + &+athet(2,itype1,ichir11,ichir12)*y(1))*ss + dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) + & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss + endif if (theta(i).gt.pi-delta) then call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, & E_tc0) @@ -3201,12 +4603,41 @@ C Derivatives of the "mean" values in gamma1 and gamma2. & E_theta,E_tc) endif etheta=etheta+ethetai +c write (iout,'(a6,i5,0pf7.3,f7.3,i5)') +c & 'ebend',i,ethetai,theta(i),itype(i) c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i), c & rad2deg*phii,rad2deg*phii1,ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - 1215 continue +c 1215 continue + enddo + ethetacnstr=0.0d0 +C print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=1,ntheta_constr + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif +C if (energy_dec) then +C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", +C & i,itheta,rad2deg*thetiii, +C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), +C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, +C & gloc(itheta+nphi-2,icg) +C endif enddo C Ufff.... We've done all this!!! return @@ -3330,7 +4761,6 @@ c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.LOCAL' include 'COMMON.GEO' include 'COMMON.INTERACT' @@ -3341,6 +4771,7 @@ C include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), @@ -3349,37 +4780,53 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle +C if (i.eq.2) cycle +C if (itype(i-1).eq.ntyp1) cycle + if (i.le.2) cycle + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle + if (iabs(itype(i+1)).eq.20) iblock=2 + if (iabs(itype(i+1)).ne.20) iblock=1 dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) + ityp2=ithetyp((itype(i-1))) do k=1,nntheterm coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.eq.3) then + phii=0.0d0 + ityp1=nthetyp+1 + do k=1,nsingle + cosph1(k)=0.0d0 + sinph1(k)=0.0d0 + enddo + else + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) #endif - ityp1=ithetyp(itype(i-2)) + ityp1=ithetyp((itype(i-2))) do k=1,nsingle cosph1(k)=dcos(k*phii) sinph1(k)=dsin(k*phii) enddo else phii=0.0d0 - ityp1=nthetyp+1 +c ityp1=nthetyp+1 do k=1,nsingle + ityp1=ithetyp((itype(i-2))) cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.21) then + endif + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3387,14 +4834,15 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) #else phii1=phi(i+1) #endif - ityp3=ithetyp(itype(i)) + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=dcos(k*phii1) sinph2(k)=dsin(k*phii1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 +c ityp3=nthetyp+1 + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -3403,7 +4851,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) c write (iout,*) "i",i," ityp1",itype(i-2),ityp1, c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3 c call flush(iout) - ethetai=aa0thet(ityp1,ityp2,ityp3) + ethetai=aa0thet(ityp1,ityp2,ityp3,iblock) do k=1,ndouble do l=1,k-1 ccl=cosph1(l)*cosph2(k-l) @@ -3425,11 +4873,12 @@ c call flush(iout) enddo endif do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) + ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k) + dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) & *coskt(k) if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), + & write (iout,*) "k",k," + & aathet",aathet(k,ityp1,ityp2,ityp3,iblock), & " ethetai",ethetai enddo if (lprn) then @@ -3448,24 +4897,24 @@ c call flush(iout) endif do m=1,ntheterm2 do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) + aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) + & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) + & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) + & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*aux*coskt(m) dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)) dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) + & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)) if (lprn) & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", + & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai enddo enddo if (lprn) @@ -3473,28 +4922,29 @@ c call flush(iout) do m=1,ntheterm3 do k=2,ndouble do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) + aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*coskt(m)*aux dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) if (lprn) then write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet", + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock), + & " ethetai",ethetai write (iout,*) cosph1ph2(l,k)*sinkt(m), & cosph1ph2(k,l)*sinkt(m), & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) @@ -3509,7 +4959,8 @@ c call flush(iout) etheta=etheta+ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai +c gloc(nphi+i-2,icg)=wang*dethetai + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai enddo return end @@ -3522,7 +4973,6 @@ C corresponding virtual-bond valence angles THETA and the spherical angles C ALPHA and OMEGA. implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.GEO' include 'COMMON.LOCAL' include 'COMMON.VAR' @@ -3537,14 +4987,14 @@ C ALPHA and OMEGA. common /sccalc/ time11,time12,time112,theti,it,nlobit delta=0.02d0*pi escloc=0.0D0 -c write (iout,'(a)') 'ESC' +C write (iout,*) 'ESC' do i=loc_start,loc_end it=itype(i) - if (it.eq.21) cycle + if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 - nlobit=nlob(it) + nlobit=nlob(iabs(it)) c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad +C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad theti=theta(i+1)-pipol x(1)=dtan(theti) x(2)=alph(i) @@ -3580,8 +5030,8 @@ c write (iout,*) "i",i," x",x(1),x(2),x(3) dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) enddo dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd + write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, + & esclocbi,ss,ssd escloci=ss*escloci+(1.0d0-ss)*esclocbi c escloci=esclocbi c write (iout,*) escloci @@ -3615,15 +5065,17 @@ c write (iout,*) escloci enddo dersc(2)=dersc(2)+ssd*(escloci-esclocbi) c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd +c & esclocbi,ss,ssd escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci +C write (iout,*) 'i=',i, escloci else call enesc(x,escloci,dersc,ddummy,.false.) endif escloc=escloc+escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc +C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc + write (iout,'(a6,i5,0pf7.3)') + & 'escloc',i,escloci gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & wscloc*dersc(1) @@ -3697,7 +5149,7 @@ C Compute the contribution to SC energy and derivatives do iii=-1,1 do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin) cd print *,'j=',j,' expfac=',expfac escloc_i=escloc_i+expfac do k=1,3 @@ -3778,7 +5230,7 @@ C Compute the contribution to SC energy and derivatives dersc12=0.0d0 do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin) escloc_i=escloc_i+expfac do k=1,2 dersc(k)=dersc(k)+Ax(k,j)*expfac @@ -3807,7 +5259,6 @@ C added by Urszula Kozlowska. 07/11/2007 C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.GEO' include 'COMMON.LOCAL' include 'COMMON.VAR' @@ -3833,7 +5284,7 @@ C delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.21) cycle + if (itype(i).eq.ntyp1) cycle costtab(i+1) =dcos(theta(i+1)) sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) @@ -3842,7 +5293,7 @@ C cosfac=dsqrt(cosfac2) sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) - it=itype(i) + it=iabs(itype(i)) if (it.eq.10) goto 1 c C Compute the axes of tghe local cartesian coordinates system; store in @@ -3860,7 +5311,7 @@ C & dc_norm(3,i+nres) y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac enddo do j = 1,3 - z_prime(j) = -uz(j,i-1) + z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i))) enddo c write (2,*) "i",i c write (2,*) "x_prime",(x_prime(j),j=1,3) @@ -3892,7 +5343,7 @@ C C Compute the energy of the ith side cbain C c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) + it=iabs(itype(i)) do j = 1,65 x(j) = sc_parmin(j,it) enddo @@ -3900,7 +5351,7 @@ c write (2,*) "xx",xx," yy",yy," zz",zz Cc diagnostics - remove later xx1 = dcos(alph(2)) yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) + zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2)) write(2,'(3f8.1,3f9.3,1x,3f9.3)') & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, & xx1,yy1,zz1 @@ -3943,6 +5394,8 @@ c & dscp1,dscp2,sumene c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) escloc = escloc + sumene c write (2,*) "escloc",escloc +c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i), +c & zz,xx,yy if (.not. calc_grad) goto 1 #ifdef DEBUG C @@ -4071,8 +5524,10 @@ c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) dZZ_Ci1(k)=0.0d0 dZZ_Ci(k)=0.0d0 do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) + dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) + dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) enddo dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) @@ -4158,7 +5613,6 @@ c------------------------------------------------------------------------------ subroutine splinthet(theti,delta,ss,ssder) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.VAR' include 'COMMON.GEO' thetup=pi-delta @@ -4203,10 +5657,9 @@ c------------------------------------------------------------------------------ C----------------------------------------------------------------------------- #ifdef CRYST_TOR C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr,fact) + subroutine etor(etors,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.LOCAL' @@ -4224,8 +5677,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) @@ -4265,33 +5718,13 @@ C Proline-Proline pair is a special case... gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr return end c------------------------------------------------------------------------------ #else - subroutine etor(etors,edihcnstr,fact) + subroutine etor(etors,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.LOCAL' @@ -4309,17 +5742,25 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (i.le.2) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle +C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 +C & .or. itype(i).eq.ntyp1) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215 + if (iabs(itype(i)).eq.20) then + iblock=2 + else + iblock=1 + endif itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) gloci=0.0D0 C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) + do j=1,nterm(itori,itori1,iblock) + v1ij=v1(j,itori,itori1,iblock) + v2ij=v2(j,itori,itori1,iblock) cosphi=dcos(j*phii) sinphi=dsin(j*phii) etors=etors+v1ij*cosphi+v2ij*sinphi @@ -4332,52 +5773,28 @@ C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 C cosphi=dcos(0.5d0*phii) sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) + do j=1,nlor(itori,itori1,iblock) vl1ij=vlor1(j,itori,itori1) vl2ij=vlor2(j,itori,itori1) vl3ij=vlor3(j,itori,itori1) pom=vl2ij*cosphi+vl3ij*sinphi pom1=1.0d0/(pom*pom+1.0d0) etors=etors+vl1ij*pom1 +c if (energy_dec) etors_ii=etors_ii+ +c & vl1ij*pom1 pom=-pom*pom1*pom1 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom enddo C Subtract the constant term - etors=etors-v0(itori,itori1) + etors=etors-v0(itori,itori1,iblock) if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) + & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6) gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) 1215 continue enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - edihi=0.0d0 - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - edihi=0.25d0*ftors*difi**4 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - edihi=0.25d0*ftors*difi**4 - else - difi=0.0d0 - endif -c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi, -c & drange(i),edihi -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr return end c---------------------------------------------------------------------------- @@ -4385,7 +5802,6 @@ c---------------------------------------------------------------------------- C 6/23/01 Compute double torsional energy implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.LOCAL' @@ -4403,8 +5819,12 @@ C Set lprn=.true. for debugging c lprn=.true. etors_d=0.0D0 do i=iphi_start,iphi_end-1 - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (i.le.3) cycle +C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 +C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or. + & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or. + & (itype(i+1).eq.ntyp1)) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0) & goto 1215 itori=itortyp(itype(i-2)) @@ -4414,12 +5834,14 @@ c lprn=.true. phii1=phi(i+1) gloci1=0.0D0 gloci2=0.0D0 + iblock=1 + if (iabs(itype(i+1)).eq.20) iblock=2 C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) + do j=1,ntermd_1(itori,itori1,itori2,iblock) + v1cij=v1c(1,j,itori,itori1,itori2,iblock) + v1sij=v1s(1,j,itori,itori1,itori2,iblock) + v2cij=v1c(2,j,itori,itori1,itori2,iblock) + v2sij=v1s(2,j,itori,itori1,itori2,iblock) cosphi1=dcos(j*phii) sinphi1=dsin(j*phii) cosphi2=dcos(j*phii1) @@ -4429,12 +5851,12 @@ C Regular cosine and sine terms gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) enddo - do k=2,ntermd_2(itori,itori1,itori2) + do k=2,ntermd_2(itori,itori1,itori2,iblock) do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) + v1cdij = v2c(k,l,itori,itori1,itori2,iblock) + v2cdij = v2c(l,k,itori,itori1,itori2,iblock) + v1sdij = v2s(k,l,itori,itori1,itori2,iblock) + v2sdij = v2s(l,k,itori,itori1,itori2,iblock) cosphi1p2=dcos(l*phii+(k-l)*phii1) cosphi1m2=dcos(l*phii-(k-l)*phii1) sinphi1p2=dsin(l*phii+(k-l)*phii1) @@ -4444,7 +5866,7 @@ C Regular cosine and sine terms gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) + & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) enddo enddo gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1 @@ -4454,6 +5876,286 @@ C Regular cosine and sine terms return end #endif +c--------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine etor_kcc(etors,fact) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + double precision c1(0:maxval_kcc),c2(0:maxval_kcc) + logical lprn +c double precision thybt1(maxtermkcc),thybt2(maxtermkcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode + etors=0.0D0 + do i=iphi_start,iphi_end +C ANY TWO ARE DUMMY ATOMS in row CYCLE +c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. +c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. +c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle + itori=itortyp(itype(i-2)) + itori1=itortyp(itype(i-1)) + phii=phi(i) + glocig=0.0D0 + glocit1=0.0d0 + glocit2=0.0d0 +C to avoid multiple devision by 2 +c theti22=0.5d0*theta(i) +C theta 12 is the theta_1 /2 +C theta 22 is theta_2 /2 +c theti12=0.5d0*theta(i-1) +C and appropriate sinus function + sinthet1=dsin(theta(i-1)) + sinthet2=dsin(theta(i)) + costhet1=dcos(theta(i-1)) + costhet2=dcos(theta(i)) +C to speed up lets store its mutliplication + sint1t2=sinthet2*sinthet1 + sint1t2n=1.0d0 +C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma) +C +d_n*sin(n*gamma)) * +C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2))) +C we have two sum 1) Non-Chebyshev which is with n and gamma + nval=nterm_kcc_Tb(itori,itori1) + c1(0)=0.0d0 + c2(0)=0.0d0 + c1(1)=1.0d0 + c2(1)=1.0d0 + do j=2,nval + c1(j)=c1(j-1)*costhet1 + c2(j)=c2(j-1)*costhet2 + enddo + etori=0.0d0 + do j=1,nterm_kcc(itori,itori1) + cosphi=dcos(j*phii) + sinphi=dsin(j*phii) + sint1t2n1=sint1t2n + sint1t2n=sint1t2n*sint1t2 + sumvalc=0.0d0 + gradvalct1=0.0d0 + gradvalct2=0.0d0 + do k=1,nval + do l=1,nval + sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalct1=gradvalct1+ + & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalct2=gradvalct2+ + & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalct1=-gradvalct1*sinthet1 + gradvalct2=-gradvalct2*sinthet2 + sumvals=0.0d0 + gradvalst1=0.0d0 + gradvalst2=0.0d0 + do k=1,nval + do l=1,nval + sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalst1=gradvalst1+ + & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalst2=gradvalst2+ + & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalst1=-gradvalst1*sinthet1 + gradvalst2=-gradvalst2*sinthet2 + etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi) +C glocig is the gradient local i site in gamma + glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi) +C now gradient over theta_1 + glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi) + & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi) + glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi) + & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi) + enddo ! j + etors=etors+etori +C derivative over gamma + gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig +C derivative over theta1 + gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1 +C now derivative over theta2 + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2 + if (lprn) + & write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1, + & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori + enddo + return + end +c--------------------------------------------------------------------------------------------- + subroutine etor_constr(edihcnstr) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' +! 6/20/98 - dihedral angle constraints + edihcnstr=0.0d0 +c do i=1,ndih_constr +c write (iout,*) "idihconstr_start",idihconstr_start, +c & " idihconstr_end",idihconstr_end + if (raw_psipred) then + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + gaudih_i=vpsipred(1,i) + gauder_i=0.0d0 + do j=1,2 + s = sdihed(j,i) + cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2 + dexpcos_i=dexp(-cos_i*cos_i) + gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i + gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) + & *cos_i*dexpcos_i/s**2 + enddo + edihcnstr=edihcnstr-wdihc*dlog(gaudih_i) + gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i + if (energy_dec) + & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') + & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i), + & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i), + & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, + & -wdihc*dlog(gaudih_i) + enddo + else + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + difi=pinorm(phii-phi0(i)) + if (difi.gt.drange(i)) then + difi=difi-drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else + difi=0.0 + endif + enddo + endif + return + end +c---------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine ebend_kcc(etheta) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + logical lprn + double precision thybt1(maxang_kcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode + etheta=0.0D0 + do i=ithet_start,ithet_end +c print *,i,itype(i-1),itype(i),itype(i-2) + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle + iti=iabs(itortyp(itype(i-1))) + sinthet=dsin(theta(i)) + costhet=dcos(theta(i)) + do j=1,nbend_kcc_Tb(iti) + thybt1(j)=v1bend_chyb(j,iti) + enddo + sumth1thyb=v1bend_chyb(0,iti)+ + & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) + if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg, + & sumth1thyb + ihelp=nbend_kcc_Tb(iti)-1 + gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) + etheta=etheta+sumth1thyb +C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet + enddo + return + end +c------------------------------------------------------------------------------------- + subroutine etheta_constr(ethetacnstr) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + ethetacnstr=0.0d0 +C print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=ithetaconstr_start,ithetaconstr_end + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif + if (energy_dec) then + write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", + & i,itheta,rad2deg*thetiii, + & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), + & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, + & gloc(itheta+nphi-2,icg) + endif + enddo + return + end +c------------------------------------------------------------------------------ c------------------------------------------------------------------------------ subroutine eback_sc_corr(esccor) c 7/21/2007 Correlations between the backbone-local and side-chain-local @@ -4464,7 +6166,6 @@ c of residues computed from AM1 energy surfaces of terminally-blocked c amino-acid residues. implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.LOCAL' @@ -4483,26 +6184,50 @@ C Set lprn=.true. for debugging c lprn=.true. c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor esccor=0.0D0 - do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle + do i=itau_start,itau_end + if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) + isccori=isccortyp(itype(i-2)) + isccori1=isccortyp(itype(i-1)) phii=phi(i) + do intertyp=1,3 !intertyp +cc Added 09 May 2012 (Adasko) +cc Intertyp means interaction type of backbone mainchain correlation: +c 1 = SC...Ca...Ca...Ca +c 2 = Ca...Ca...Ca...SC +c 3 = SC...Ca...Ca...SCi gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo + if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. + & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-1).eq.ntyp1))) + & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) + & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) + & .or.(itype(i).eq.ntyp1))) + & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. + & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-3).eq.ntyp1)))) cycle + if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle + if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) + & cycle + do j=1,nterm_sccor(isccori,isccori1) + v1ij=v1sccor(j,intertyp,isccori,isccori1) + v2ij=v2sccor(j,intertyp,isccori,isccori1) + cosphi=dcos(j*tauangle(intertyp,i)) + sinphi=dsin(j*tauangle(intertyp,i)) + esccor=esccor+v1ij*cosphi+v2ij*sinphi + gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) + enddo +C write (iout,*)"EBACK_SC_COR",esccor,i +c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp, +c & nterm_sccor(isccori,isccori1),isccori,isccori1 +c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gloci + & (v1sccor(j,1,itori,itori1),j=1,6) + & ,(v2sccor(j,1,itori,itori1),j=1,6) +c gsccor_loc(i-3)=gloci + enddo !intertyp enddo return end @@ -4604,192 +6329,20 @@ cd & k,l,(gacont(m,kk,k),m=1,3) return end c------------------------------------------------------------------------------ -#ifdef MPL - subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,20,maxres,7), - & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), - & num_cont_hb(maxres),jcont_hb(20,maxres) - num_kont=num_cont_hb(atom) - do i=1,num_kont - do k=1,7 - do j=1,3 - buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k) - enddo ! j - enddo ! k - buffer(i,indx+22)=facont_hb(i,atom) - buffer(i,indx+23)=ees0p(i,atom) - buffer(i,indx+24)=ees0m(i,atom) - buffer(i,indx+25)=dfloat(jcont_hb(i,atom)) - enddo ! i - buffer(1,indx+26)=dfloat(num_kont) - return - end -c------------------------------------------------------------------------------ - subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,20,maxres,7), - & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), - & num_cont_hb(maxres),jcont_hb(20,maxres) - num_kont=buffer(1,indx+26) - num_kont_old=num_cont_hb(atom) - num_cont_hb(atom)=num_kont+num_kont_old - do i=1,num_kont - ii=i+num_kont_old - do k=1,7 - do j=1,3 - zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j) - enddo ! j - enddo ! k - facont_hb(ii,atom)=buffer(i,indx+22) - ees0p(ii,atom)=buffer(i,indx+23) - ees0m(ii,atom)=buffer(i,indx+24) - jcont_hb(ii,atom)=buffer(i,indx+25) - enddo ! i - return - end -c------------------------------------------------------------------------------ -#endif subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) C This subroutine calculates multi-body contributions to hydrogen-bonding implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' -#ifdef MPL - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+2)) - parameter (msglen1=max_cont*max_dim*4) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) -#endif double precision gx(3),gx1(3) logical lprn,ldone C Set lprn=.true. for debugging lprn=.false. -#ifdef MPL - n_corr=0 - n_corr1=0 - if (fgProcs.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=MyID+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(MyRank,2) -cd write (iout,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -cd write (iout,*) 'The BUFFER array:' -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -cd enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -cd enddo - num_cont_hb(iatel_s)=0 - endif -cd write (iout,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen -cd write (*,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -cd write (iout,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -cd write (*,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID - msglen=msglen1 - endif ! (MyRank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.lt.fgProcs-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -cd write (*,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - nbytes=-1 - do while (nbytes.le.0) - call mp_probe(MyID+1,CorrelType,nbytes) - enddo -cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes - call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -cd write (iout,*) 'Processor',MyID, -cd & ' has received correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' nbytes=',nbytes -cd write (iout,*) 'The received BUFFER array:' -cd do i=1,max_cont -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -cd enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call mp_stopall(Error) - endif ! msglen.eq.msglen1 - endif ! MyRank.lt.fgProcs-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif if (lprn) then write (iout,'(a)') 'Contact function values:' do i=nnt,nct-2 @@ -4848,141 +6401,32 @@ c------------------------------------------------------------------------------ C This subroutine calculates multi-body contributions to hydrogen-bonding implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' +#ifdef MPI + include "mpif.h" #endif include 'COMMON.FFIELD' include 'COMMON.DERIV' + include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' -#ifdef MPL - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+2)) - parameter (msglen1=max_cont*max_dim*4) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) -#endif + include 'COMMON.CHAIN' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' double precision gx(3),gx1(3) + integer num_cont_hb_old(maxres) logical lprn,ldone - + double precision eello4,eello5,eelo6,eello_turn6 + external eello4,eello5,eello6,eello_turn6 C Set lprn=.true. for debugging lprn=.false. eturn6=0.0d0 -#ifdef MPL - n_corr=0 - n_corr1=0 - if (fgProcs.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=MyID+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(MyRank,2) -cd write (iout,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -cd write (iout,*) 'The BUFFER array:' -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -cd enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -cd enddo - num_cont_hb(iatel_s)=0 - endif -cd write (iout,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen -cd write (*,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -cd write (iout,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -cd write (*,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID - msglen=msglen1 - endif ! (MyRank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.lt.fgProcs-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -cd write (*,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - nbytes=-1 - do while (nbytes.le.0) - call mp_probe(MyID+1,CorrelType,nbytes) - enddo -cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes - call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -cd write (iout,*) 'Processor',MyID, -cd & ' has received correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' nbytes=',nbytes -cd write (iout,*) 'The received BUFFER array:' -cd do i=1,max_cont -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -cd enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call mp_stopall(Error) - endif ! msglen.eq.msglen1 - endif ! MyRank.lt.fgProcs-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif if (lprn) then write (iout,'(a)') 'Contact function values:' do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) + write (iout,'(2i3,50(1x,i2,5f6.3))') + & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), + & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) enddo endif ecorr=0.0D0 @@ -5001,22 +6445,35 @@ C Calculate the dipole-dipole interaction energies num_conti=num_cont_hb(i) do jj=1,num_conti j=jcont_hb(jj,i) +#ifdef MOMENT call dipole(i,j,jj) +#endif enddo enddo endif C Calculate the local-electrostatic correlation terms - do i=iatel_s,iatel_e+1 +c write (iout,*) "gradcorr5 in eello5 before loop" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo + do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) +c write (iout,*) "corr loop i",i i1=i+1 num_conti=num_cont_hb(i) num_conti1=num_cont_hb(i+1) do jj=1,num_conti j=jcont_hb(jj,i) + jp=iabs(j) do kk=1,num_conti1 j1=jcont_hb(kk,i1) -c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, + jp1=iabs(j1) +c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1 .or. j1.eq.j-1) then +c if (j1.eq.j+1 .or. j1.eq.j-1) then + if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 + & .or. j.lt.0 .and. j1.gt.0) .and. + & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. C The system gains extra energy. n_corr=n_corr+1 @@ -5026,8 +6483,8 @@ C The system gains extra energy. IF (sred_geom.lt.cutoff_corr) THEN call gcont(sred_geom,r0_corr,1.0D0,delt_corr, & ekont,fprimcont) -c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk +cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, +cd & ' jj=',jj,' kk=',kk fac_prim1=0.5d0*sqd2/sqd1*fprimcont fac_prim2=0.5d0*sqd1/sqd2*fprimcont do l=1,3 @@ -5036,51 +6493,69 @@ c & ' jj=',jj,' kk=',kk enddo n_corr1=n_corr1+1 cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont - call calc_eello(i,j,i+1,j1,jj,kk) +cd & ' ekont=',ekont,' fprim=',fprimcont, +cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 +cd write (iout,*) "g_contij",g_contij +cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) +cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) + call calc_eello(i,jp,i+1,jp1,jj,kk) if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk) + & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) +CC & *fac_shield(i)**2*fac_shield(j)**2 + if (energy_dec.and.wcorr4.gt.0.0d0) + 1 write (iout,'(a6,4i5,0pf7.3)') + 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) +c write (iout,*) "gradcorr5 before eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk) -c print *,"wcorr5",ecorr5 + & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) +c write (iout,*) "gradcorr5 after eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo + if (energy_dec.and.wcorr5.gt.0.0d0) + 1 write (iout,'(a6,4i5,0pf7.3)') + 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,j,i+1,j1 - if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 +cd write(2,*)'ijkl',i,jp,i+1,jp1 + if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 & .or. wturn6.eq.0.0d0))then cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) + ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) + if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') + 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, cd & 'ecorr6=',ecorr6 cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,j,i+1,j1,jj,kk)), -cd & dabs(eello5(i,j,i+1,j1,jj,kk)), -cd & dabs(eello6(i,j,i+1,j1,jj,kk)) +cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), +cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), +cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) else if (wturn6.gt.0.0d0 - & .and. (j.eq.i+4 .and. j1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1 + & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then +cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 eturn6=eturn6+eello_turn6(i,jj,kk) + if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') + 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) cd write (2,*) 'multibody_eello:eturn6',eturn6 endif ENDIF -1111 continue - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) +1111 continue endif enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk enddo ! jj enddo ! i + do i=1,nres + num_cont_hb(i)=num_cont_hb_old(i) + enddo +c write (iout,*) "gradcorr5 in eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo return end c------------------------------------------------------------------------------ @@ -5091,9 +6566,12 @@ c------------------------------------------------------------------------------ include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' double precision gx(3),gx1(3) logical lprn lprn=.false. +C print *,"wchodze",fac_shield(i),shield_mode eij=facont_hb(jj,i) ekl=facont_hb(kk,k) ees0pij=ees0p(jj,i) @@ -5102,62 +6580,161 @@ c------------------------------------------------------------------------------ ees0mkl=ees0m(kk,k) ekont=eij*ekl ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) +C* +C & fac_shield(i)**2*fac_shield(j)**2 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) C Following 4 lines for diagnostics. cd ees0pkl=0.0D0 cd ees0pij=1.0D0 cd ees0mkl=0.0D0 cd ees0mij=1.0D0 -c write (iout,*)'Contacts have occurred for peptide groups',i,j, -c & ' and',k,l -c write (iout,*)'Contacts have occurred for peptide groups', -c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees +c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') +c & 'Contacts ',i,j, +c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l +c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, +c & 'gradcorr_long' C Calculate the multi-body contribution to energy. - ecorr=ecorr+ekont*ees - if (calc_grad) then +C ecorr=ecorr+ekont*ees C Calculate multi-body contributions to the gradient. + coeffpees0pij=coeffp*ees0pij + coeffmees0mij=coeffm*ees0mij + coeffpees0pkl=coeffp*ees0pkl + coeffmees0mkl=coeffm*ees0mkl do ll=1,3 - ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb2(ll,jj,i)) - ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb2(ll,kk,k)) - enddo - do m=i+1,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) - enddo +cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) + gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi + & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb1(ll,jj,i)) + gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi + & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb2(ll,jj,i)) +cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) + gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk + & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ + & coeffmees0mij*gacontm_hb1(ll,kk,k)) + gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk + & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ + & coeffmees0mij*gacontm_hb2(ll,kk,k)) + gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- + & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb3(ll,jj,i)) + gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij + gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij + gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- + & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ + & coeffmees0mij*gacontm_hb3(ll,kk,k)) + gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl + gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl +c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl enddo - do m=k+1,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) - enddo - enddo - endif +c write (iout,*) +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ +cgrad & ees*ekl*gacont_hbr(ll,jj,i)- +cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ +cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ +cgrad & ees*eij*gacont_hbr(ll,kk,k)- +cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ +cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) +cgrad enddo +cgrad enddo +c write (iout,*) "ehbcorr",ekont*ees +C print *,ekont,ees,i,k ehbcorr=ekont*ees +C now gradient over shielding +C return + if (shield_mode.gt.0) then + j=ees0plist(jj,i) + l=ees0plist(kk,k) +C print *,i,j,fac_shield(i),fac_shield(j), +C &fac_shield(k),fac_shield(l) + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + &+rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + + do ilist=1,ishield_list(k) + iresshield=shield_list(ilist,k) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(l) + iresshield=shield_list(ilist,l) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo +C print *,gshieldx(m,iresshield) + do m=1,3 + gshieldc_ec(m,i)=gshieldc_ec(m,i)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j)=gshieldc_ec(m,j)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + + gshieldc_ec(m,k)=gshieldc_ec(m,k)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l)=gshieldc_ec(m,l)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + + enddo + endif + endif return end +#ifdef MOMENT C--------------------------------------------------------------------------- subroutine dipole(i,j,jj) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.FFIELD' @@ -5171,17 +6748,17 @@ C--------------------------------------------------------------------------- & auxmat(2,2) iti1 = itortyp(itype(i+1)) if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) + itj1 = itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif do iii=1,2 dipi(iii,1)=Ub2(iii,i) dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) + dipi(iii,2)=b1(iii,i+1) dipj(iii,1)=Ub2(iii,j) dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) + dipj(iii,2)=b1(iii,j+1) enddo kkk=0 do iii=1,2 @@ -5191,7 +6768,6 @@ C--------------------------------------------------------------------------- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) enddo enddo - if (.not.calc_grad) return do kkk=1,5 do lll=1,3 mmm=0 @@ -5216,6 +6792,7 @@ C--------------------------------------------------------------------------- enddo return end +#endif C--------------------------------------------------------------------------- subroutine calc_eello(i,j,k,l,jj,kk) C @@ -5224,7 +6801,6 @@ C the fourth-, fifth-, and sixth-order local-electrostatic terms. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -5241,6 +6817,8 @@ C cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, cd & ' jj=',jj,' kk=',kk cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return +cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) +cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) do iii=1,2 do jjj=1,2 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) @@ -5260,16 +6838,16 @@ cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return if (l.eq.j+1) then C parallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) + itk1=itype2loc(itype(k+1)) + itj=itype2loc(itype(j)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif C A1 kernel(j+1) A2T cd do iii=1,2 @@ -5360,26 +6938,26 @@ C They are needed only when the fifth- or the sixth-order cumulants are C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) @@ -5388,20 +6966,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), + call matvec2(auxmat(1,1),b1(1,j), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -5413,17 +6991,17 @@ C End vectors else C Antiparallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif C A2 kernel(j-1)T A1T call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), @@ -5498,26 +7076,26 @@ C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) @@ -5526,20 +7104,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), + call matvec2(auxmat(1,1),b1(1,l), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,l), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -5601,7 +7179,6 @@ C--------------------------------------------------------------------------- double precision function eello4(i,j,k,l,jj,kk) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -5664,51 +7241,49 @@ cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num l2=l-2 endif do ll=1,3 -cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i) - ggg1(ll)=eel4*g_contij(ll,1) - ggg2(ll)=eel4*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1) +cgrad ggg1(ll)=eel4*g_contij(ll,1) +cgrad ggg2(ll)=eel4*g_contij(ll,2) + glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) + glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) +cgrad ghalf=0.5d0*ggg1(ll) + gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) -cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij + gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij +cgrad ghalf=0.5d0*ggg2(ll) + gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) + gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl + gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,gcorr_loc(iii) cd enddo - endif + endif ! calc_grad eello4=ekont*eel4 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello4',ekont*eel4 @@ -5718,7 +7293,6 @@ C--------------------------------------------------------------------------- double precision function eello5(i,j,k,l,jj,kk) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -5767,9 +7341,9 @@ cd endif cd write (iout,*) cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk=itype2loc(itype(k)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) eello5_1=0.0d0 eello5_2=0.0d0 eello5_3=0.0d0 @@ -5798,7 +7372,7 @@ cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) vv(2)=pizda(1,2)+pizda(2,1) eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - if (calc_grad) then + if (calc_grad) then C Explicit gradient in virtual-dihedral angles. if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) @@ -5836,15 +7410,15 @@ C Cartesian gradient enddo enddo enddo + endif ! calc_grad c goto 1112 - endif c1111 continue C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) + eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -5855,11 +7429,11 @@ C Explicit gradient in virtual-dihedral angles. vv(2)=pizda(2,1)-pizda(1,2) if (l.eq.j+1) then g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) else g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) endif C Cartesian gradient @@ -5871,13 +7445,13 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) enddo enddo enddo + endif ! calc_grad cd goto 1112 - endif cd1111 continue if (l.eq.j+1) then cd goto 1110 @@ -5922,16 +7496,14 @@ C Cartesian gradient enddo enddo cd goto 1112 - endif C Contribution from graph IV cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) + call transpose2(EE(1,1,l),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - if (calc_grad) then C Explicit gradient in virtual-dihedral angles. g_corr5_loc(l-1)=g_corr5_loc(l-1) & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) @@ -5939,7 +7511,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l))) C Cartesian gradient do iii=1,2 @@ -5950,12 +7522,12 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) enddo enddo enddo - endif + endif ! calc_grad else C Antiparallel orientation C Contribution from graph III @@ -5998,15 +7570,15 @@ C Cartesian gradient enddo enddo enddo + endif ! calc_grad cd goto 1112 - endif C Contribution from graph IV 1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) + call transpose2(EE(1,1,j),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -6016,7 +7588,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j))) C Cartesian gradient do iii=1,2 @@ -6027,12 +7599,12 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) enddo enddo enddo - endif + endif ! calc_grad endif 1112 continue eel5=eello5_1+eello5_2+eello5_3+eello5_4 @@ -6064,52 +7636,70 @@ cd eij=1.0d0 cd ekl=1.0d0 cd ekont=1.0d0 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont +C 2/11/08 AL Gradients over DC's connecting interacting sites will be +C summed up outside the subrouine as for the other subroutines +C handling long-range interactions. The old code is commented out +C with "cgrad" to keep track of changes. do ll=1,3 - ggg1(ll)=eel5*g_contij(ll,1) - ggg2(ll)=eel5*g_contij(ll,2) +cgrad ggg1(ll)=eel5*g_contij(ll,1) +cgrad ggg2(ll)=eel5*g_contij(ll,2) + gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) + gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) +c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') +c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), +c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), +c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont +c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') +c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), +c & gradcorr5ij, +c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1) + gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) + gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij + gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) +cgrad ghalf=0.5d0*ggg2(ll) cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2) gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2) gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) + gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl + gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl enddo + endif ! calc_grad cd goto 1112 - do m=i+1,j-1 - do ll=1,3 +cgrad do m=i+1,j-1 +cgrad do ll=1,3 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) - enddo - enddo +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo c1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr5_loc(iii) cd enddo - endif eello5=ekont*eel5 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello5',ekont*eel5 @@ -6119,7 +7709,6 @@ c-------------------------------------------------------------------------- double precision function eello6(i,j,k,l,jj,kk) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6179,12 +7768,12 @@ cd ekont=1.0d0 endif C If turn contributions are considered, they will be handled separately. eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num +cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num +cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num +cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num +cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num +cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num +cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num cd goto 1112 if (calc_grad) then if (j.lt.nres-1) then @@ -6202,51 +7791,57 @@ cd goto 1112 l2=l-2 endif do ll=1,3 - ggg1(ll)=eel6*g_contij(ll,1) - ggg2(ll)=eel6*g_contij(ll,2) +cgrad ggg1(ll)=eel6*g_contij(ll,1) +cgrad ggg2(ll)=eel6*g_contij(ll,2) cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1) + gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) + gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) + gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - ghalf=0.5d0*ggg2(ll) + gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij + gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij +cgrad ghalf=0.5d0*ggg2(ll) cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) + gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl + gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl enddo + endif ! calc_grad cd goto 1112 - do m=i+1,j-1 - do ll=1,3 +cgrad do m=i+1,j-1 +cgrad do ll=1,3 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad1112 continue +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr6_loc(iii) cd enddo - endif eello6=ekont*eel6 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello6',ekont*eel6 @@ -6256,7 +7851,6 @@ c-------------------------------------------------------------------------- double precision function eello6_graph1(i,j,k,l,imat,swap) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6270,7 +7864,7 @@ c-------------------------------------------------------------------------- logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C @@ -6283,7 +7877,7 @@ C o o o o C C i i C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) + itk=itype2loc(itype(k)) s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) @@ -6292,12 +7886,12 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) + vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) + vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (.not. calc_grad) return + if (calc_grad) then if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) @@ -6307,8 +7901,8 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) + vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) + vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) if (l.eq.j+1) then g_corr6_loc(l-1)=g_corr6_loc(l-1) & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) @@ -6347,22 +7941,22 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) + vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) + & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) + vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) + & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- double precision function eello6_graph2(i,j,k,l,jj,kk,swap) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6373,22 +7967,22 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C C \ /l\ /j\ / C C \ / \ / \ / C -C o| o | | o |o C +C o| o | | o |o C C \ j|/k\| \ |/k\|l C C \ / \ \ / \ C C o o C -C i i C -C C +C i i C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l C AL 7/4/01 s1 would occur in the sixth-order moment, @@ -6412,8 +8006,8 @@ cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 eello6_graph2=-(s2+s3+s4) #endif c eello6_graph2=-s3 - if (.not. calc_grad) return C Derivatives in gamma(i-1) + if (calc_grad) then if (i.gt.1) then #ifdef MOMENT s1=dipderg(1,jj,i)*dip(1,kk,k) @@ -6543,13 +8137,13 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- double precision function eello6_graph3(i,j,k,l,jj,kk,swap) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6561,11 +8155,11 @@ c---------------------------------------------------------------------------- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) logical swap CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C -C o o C -C /l\ / \ /j\ C +C o o C +C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C C j|/k\| / |/k\|l / C @@ -6579,45 +8173,46 @@ C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. iti=itortyp(itype(i)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif #ifdef MOMENT s1=dip(4,jj,i)*dip(4,kk,k) #endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) + call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 +cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, +cd & "sum",-(s2+s3+s4) #ifdef MOMENT eello6_graph3=-(s1+s2+s3+s4) #else eello6_graph3=-(s2+s3+s4) #endif c eello6_graph3=-s4 - if (.not. calc_grad) return C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + if (calc_grad) then + call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) + call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) @@ -6634,12 +8229,12 @@ C Cartesian derivatives. s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) endif #endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), & pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) @@ -6659,13 +8254,13 @@ c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6679,7 +8274,7 @@ c---------------------------------------------------------------------------- & auxvec1(2),auxmat1(2,2) logical swap CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C @@ -6687,33 +8282,33 @@ C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C +C \ / \ \ / \ C C o \ o \ C C i i C -C C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) + iti=itype2loc(itype(i)) + itj=itype2loc(itype(j)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) + itk=itype2loc(itype(k)) if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) + itk1=itype2loc(itype(k+1)) else - itk1=ntortyp+1 + itk1=nloctyp endif - itl=itortyp(itype(l)) + itl=itype2loc(itype(l)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, @@ -6728,11 +8323,11 @@ cd & ' itl',itl,' itl1',itl1 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUg(1,1,k),auxmat(1,1)) call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) @@ -6745,8 +8340,8 @@ cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 #else eello6_graph4=-(s2+s3+s4) #endif - if (.not. calc_grad) return C Derivatives in gamma(i-1) + if (calc_grad) then if (i.gt.1) then #ifdef MOMENT if (imat.eq.1) then @@ -6757,11 +8352,11 @@ C Derivatives in gamma(i-1) #endif s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then @@ -6790,11 +8385,11 @@ C Derivatives in gamma(k-1) call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUgder(1,1,k),auxmat1(1,1)) call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) @@ -6860,12 +8455,12 @@ C Cartesian derivatives. s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) + & b1(1,j+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) else call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) + & b1(1,l+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) endif call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), & pizda(1,1)) @@ -6905,13 +8500,13 @@ C Cartesian derivatives. enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- double precision function eello_turn6(i,jj,kk) implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.DERIV' @@ -6927,15 +8522,19 @@ c---------------------------------------------------------------------------- & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to C the respective energy moment and not to the cluster cumulant. + s1=0.0d0 + s8=0.0d0 + s13=0.0d0 +c eello_turn6=0.0d0 j=i+4 k=i+1 l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + iti=itype2loc(itype(i)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj cd write (2,*) 'i',i,' k',k,' j',j,' l',l cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then @@ -6962,21 +8561,17 @@ cd write (2,*) 'eello6_5',eello6_5 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmat(1,1)) call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) + ss1=scalar2(Ub2(1,i+2),b1(1,l)) s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#else - s1 = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) + s2 = scalar2(b1(1,k),vtemp1(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atemp(1,1)) call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8=0.0d0 + call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1)) + s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) @@ -6986,10 +8581,8 @@ cd write (2,*) 'eello6_5',eello6_5 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) + ss13 = scalar2(b1(1,k),vtemp4(1)) s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#else - s13=0.0d0 #endif c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 c s1=0.0d0 @@ -6998,17 +8591,17 @@ c s8=0.0d0 c s12=0.0d0 c s13=0.0d0 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) - if (calc_grad) then C Derivatives in gamma(i+2) + if (calc_grad) then + s1d =0.0d0 + s8d =0.0d0 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 call transpose2(AEAderg(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d=0.0d0 + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) @@ -7023,25 +8616,21 @@ C Derivatives in gamma(i+3) #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) + ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#else - s1d=0.0d0 #endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) + call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1)) + s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1)) #endif s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) #ifdef MOMENT call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#else - s13d=0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7063,8 +8652,6 @@ C Derivatives in gamma(i+4) call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#else - s13d = 0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7081,27 +8668,21 @@ C Derivatives in gamma(i+5) call transpose2(AEAderg(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#else - s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d = 0.0d0 + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) #ifdef MOMENT call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#else - s13d = 0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7123,20 +8704,16 @@ C Cartesian derivatives call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#else - s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d = 0.0d0 + & scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), & auxmatd(1,1)) @@ -7175,7 +8752,7 @@ c s13d=0.0d0 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d enddo @@ -7199,57 +8776,183 @@ cd goto 1112 l2=l-2 endif do ll=1,3 - ggg1(ll)=eel_turn6*g_contij(ll,1) - ggg2(ll)=eel_turn6*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) +cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) +cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf + gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) + gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) + gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf & +ekont*derx_turn(ll,2,1) gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf + gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf & +ekont*derx_turn(ll,4,1) gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - ghalf=0.5d0*ggg2(ll) + gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij + gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij +cgrad ghalf=0.5d0*ggg2(ll) cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf + gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf & +ekont*derx_turn(ll,2,2) gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf + gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf & +ekont*derx_turn(ll,4,2) gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) + gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl + gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl enddo cd goto 1112 - do m=i+1,j-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) - enddo - enddo +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad1112 continue +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr6_loc(iii) cd enddo - endif + endif ! calc_grad eello_turn6=ekont*eel_turn6 cd write (2,*) 'ekont',ekont cd write (2,*) 'eel_turn6',ekont*eel_turn6 return end + crc------------------------------------------------- +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + subroutine Eliptransfer(eliptran) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' +C this is done by Adasko +C print *,"wchodze" +C structure of box: +C water +C--bordliptop-- buffore starts +C--bufliptop--- here true lipid starts +C lipid +C--buflipbot--- lipid ends buffore starts +C--bordlipbot--buffore ends + eliptran=0.0 + do i=1,nres +C do i=1,1 + if (itype(i).eq.ntyp1) cycle + + positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + if ((positi.gt.bordlipbot) + &.and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran +C print *, "doing sscalefor top part" +C print *,i,sslip,fracinbuf,ssgradlip + else + eliptran=eliptran+pepliptran +C print *,"I am in true lipid" + endif +C else +C eliptran=elpitran+0.0 ! I am in water + endif + enddo +C print *, "nic nie bylo w lipidzie?" +C now multiply all by the peptide group transfer factor +C eliptran=eliptran*pepliptran +C now the same for side chains +CV do i=1,1 + do i=1,nres + if (itype(i).eq.ntyp1) cycle + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +c for each residue check if it is in lipid or lipid water border area +C respos=mod(c(3,i+nres),boxzsize) +C print *,positi,bordlipbot,buflipbot + if ((positi.gt.bordlipbot) + & .and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *,"doing sccale for lower part" + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0- + &((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *, "doing sscalefor top part",sslip,fracinbuf + else + eliptran=eliptran+liptranene(itype(i)) +C print *,"I am in true lipid" + endif + endif ! if in lipid or buffor +C else +C eliptran=elpitran+0.0 ! I am in water + enddo + return + end + + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + SUBROUTINE MATVEC2(A1,V1,V2) implicit real*8 (a-h,o-z) include 'DIMENSIONS' @@ -7383,4 +9086,443 @@ C----------------------------------------------------------------------------- scalar=sc return end +C----------------------------------------------------------------------- + double precision function sscale(r) + double precision r,gamm + include "COMMON.SPLITELE" + if(r.lt.r_cut-rlamb) then + sscale=1.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale=0d0 + endif + return + end +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscagrad(r) + double precision r,gamm + include "COMMON.SPLITELE" + if(r.lt.r_cut-rlamb) then + sscagrad=0.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscagrad=gamm*(6*gamm-6.0d0)/rlamb + else + sscagrad=0.0d0 + endif + return + end +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscalelip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscale=1.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscalelip=1.0d0+r*r*(2*r-3.0d0) +C else +C sscale=0d0 +C endif + return + end +C----------------------------------------------------------------------- + double precision function sscagradlip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscagrad=0.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscagradlip=r*(6*r-6.0d0) +C else +C sscagrad=0.0d0 +C endif + return + end + +C----------------------------------------------------------------------- + subroutine set_shield_fac + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0*sh_frac_dist-3.0d0) + fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C if ((i.eq.3).and.(k.eq.2)) then +C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist +C & ,"TU" +C endif + +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2) +C now costhet_grad +C costhet=0.0d0 + costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4 +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2) + cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4 + + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) + + cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) + enddo + + VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi) + & /VSolvSphere_div + & *wshield +C now the gradient... +C grad_shield is gradient of Calfa for peptide groups +C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist, +C & costhet,cosphi +C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group, +C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k) + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j) +C gradient po costhet + &-scale_fac_dist*costhet_grad(j)/(1.0-costhet) + &-scale_fac_dist*(cosphi_grad_long(j)) + &/(1.0-cosphi) )*div77_81 + &*VofOverlap +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet) + & +scale_fac_dist*(cosphi_grad_long(j)) + & *2.0d0/(1.0-cosphi)) + & *div77_81*VofOverlap + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*cosphi_grad_loc(j) + & *2.0d0/(1.0-cosphi) + & *div77_81*VofOverlap + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*div77_81+div4_81 +C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i) + enddo + return + end +C-------------------------------------------------------------------------- +C first for shielding is setting of function of side-chains + subroutine set_shield_fac2 + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0d0*sh_frac_dist-3.0d0) + fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5d0 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C sh_frac_dist_grad(j)=0.0d0 +C scale_fac_dist=1.0d0 +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2) + sinthet=short/dist_pep_side*costhet +C now costhet_grad +C costhet=0.6d0 +C sinthet=0.8 + costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4 +C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet +C & -short/dist_pep_side**2/costhet) +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0d0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0d0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C rkprim=short + +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2) +C cosphi=0.6 + cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4 + sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ + & dist_pep_side**2) +C sinphi=0.8 + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) +C cosphi_grad_long(j)=0.0d0 + cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) +C cosphi_grad_loc(j)=0.0d0 + enddo +C print *,sinphi,sinthet + VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) + & /VSolvSphere_div +C & *wshield +C now the gradient... + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j)*VofOverlap +C gradient po costhet + & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & *VofOverlap + & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*( + & sinthet/sinphi*cosphi*cosphi_grad_loc(j) + & )) + & *wshield + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield) +C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i) +C write(2,*) "TU",rpp(1,1),short,long,buff_shield + enddo + return + end +C-------------------------------------------------------------------------- + double precision function tschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=y + do i=2,n + yy(i)=2*yy(1)*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i)*yy(i) + enddo + tschebyshev=aux + return + end +C-------------------------------------------------------------------------- + double precision function gradtschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n+1),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=2.0d0*y + do i=2,n + yy(i)=2*y*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i+1)*yy(i)*(i+1) +C print *, x(i+1),yy(i),i + enddo + gradtschebyshev=aux + return + end diff --git a/source/cluster/wham/src-M/geomout.F b/source/cluster/wham/src-M/geomout.F index 5a61305..4ef656f 100644 --- a/source/cluster/wham/src-M/geomout.F +++ b/source/cluster/wham/src-M/geomout.F @@ -19,7 +19,7 @@ ires=0 do i=nnt,nct iti=itype(i) - if (iti.eq.21) then + if (iti.eq.ntyp1) then ichain=ichain+1 ires=0 write (ipdb,'(a)') 'TER' @@ -38,12 +38,12 @@ enddo write (ipdb,'(a)') 'TER' do i=nnt,nct-1 - if (itype(i).eq.21) cycle - if (itype(i).eq.10 .and. itype(i+1).ne.21) then + if (itype(i).eq.ntyp1) cycle + if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1) - else if (itype(i).ne.10 .and. itype(i+1).ne.21) then + else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1),ica(i)+1 - else if (itype(i).ne.10 .and. itype(i+1).eq.21) then + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (ipdb,30) ica(i),ica(i)+1 endif enddo diff --git a/source/cluster/wham/src-M/gnmr1.f b/source/cluster/wham/src-M/gnmr1.f index 905e746..2357e6d 100644 --- a/source/cluster/wham/src-M/gnmr1.f +++ b/source/cluster/wham/src-M/gnmr1.f @@ -41,3 +41,34 @@ c------------------------------------------------------------------------------- return end c--------------------------------------------------------------------------------- +c--------------------------------------------------------------------------------- + double precision function rlornmr1(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl) + else if (y.gt.ymax) then + rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl) + else + rlornmr1=0.0d0 + endif + return + end +c------------------------------------------------------------------------------ + double precision function rlornmr1prim(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ + & ((ymin-y)**wykl+sigma**wykl)**2 + else if (y.gt.ymax) then + rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ + & ((y-ymax)**wykl+sigma**wykl)**2 + else + rlornmr1prim=0.0d0 + endif + return + end + diff --git a/source/cluster/wham/src-M/hc.f b/source/cluster/wham/src-M/hc.f index a1a089e..3d514a7 100644 --- a/source/cluster/wham/src-M/hc.f +++ b/source/cluster/wham/src-M/hc.f @@ -334,12 +334,12 @@ C 110 CONTINUE 120 CONTINUE C - WRITE (iout,450) (j,j=2,LEV) +c WRITE (iout,450) (j,j=2,LEV) 450 FORMAT(4X,' SEQ NOS',8(i2,'CL'),10000(i3,'CL')) - WRITE (iout,470) (' ---',j=2,LEV) +c WRITE (iout,470) (' ---',j=2,LEV) 470 FORMAT(4X,' -------',10000a4) DO 500 I=1,N - WRITE (iout,600) I,(ICLASS(I,J),J=1,LEV-1) +c WRITE (iout,600) I,(ICLASS(I,J),J=1,LEV-1) 600 FORMAT(I11,8I4,10000i5) 500 CONTINUE C @@ -455,22 +455,22 @@ C IF (HEIGHT(L).EQ.IDUM) GOTO 190 ENDDO 190 IDUM=L - WRITE(iout,200) CRITVAL(IDUM),(OUT(I,J),J=1,3*LEV) +c WRITE(iout,200) CRITVAL(IDUM),(OUT(I,J),J=1,3*LEV) IC=IC+3 ELSE LINE = ' ' - WRITE(iout,210) (OUT(I,J),J=1,3*LEV) +c WRITE(iout,210) (OUT(I,J),J=1,3*LEV) ENDIF 200 FORMAT(1H ,8X,F12.2,4X,27000A1) 210 FORMAT(1H ,24X,27000A1) ENDDO WRITE(iout,250) - WRITE(iout,220)(IORDER(J),J=1,LEV) - WRITE(iout,250) +c WRITE(iout,220)(IORDER(J),J=1,LEV) +c WRITE(iout,250) 220 FORMAT(1H ,24X,9000I3) - WRITE(iout,230) LEV +c WRITE(iout,230) LEV 230 FORMAT(1H ,13X,'CRITERION CLUSTERS 1 TO ',i3) - WRITE(iout,240) LEV-1 +c WRITE(iout,240) LEV-1 240 FORMAT(1H ,13X,'VALUES. (TOP ',i3,' LEVELS OF HIERARCHY).') 250 FORMAT(/) C diff --git a/source/cluster/wham/src-M/include_unres/COMMON.CALC b/source/cluster/wham/src-M/include_unres/COMMON.CALC index 67b4bb9..bf255c9 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.CALC +++ b/source/cluster/wham/src-M/include_unres/COMMON.CALC @@ -5,11 +5,11 @@ & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg + & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j + & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j diff --git a/source/cluster/wham/src-M/include_unres/COMMON.CONTACTS b/source/cluster/wham/src-M/include_unres/COMMON.CONTACTS index d07a0f0..ecfc97d 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.CONTACTS +++ b/source/cluster/wham/src-M/include_unres/COMMON.CONTACTS @@ -1,6 +1,10 @@ C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont + integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont, + & num_cont_hb,jcont_hb + double precision facont,gacont,g_contij,ekont, + & gacontp_hb1,gacontp_hb2,gacontp_hb3,gacontm_hb1,gacontm_hb2, + & gacontm_hb3,gacont_hbr,grij_hb_cont,facont_hb,ees0p, + & ees0m,d_cont common /contacts/ ncont,ncont_ref,icont(2,maxcont), & icont_ref(2,maxcont) common /contacts1/ facont(maxconts,maxres), @@ -26,22 +30,26 @@ C Interactions of pseudo-dipoles generated by loc-el interactions. C 10/30/99 Added other pre-computed vectors and matrices needed C to calculate three - six-order el-loc correlation terms double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der + & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2, + & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der, + & gtEUg common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), & obrot_der(2,maxres),obrot2_der(2,maxres) C This common block contains vectors and matrices dependent on a single C amino-acid residue. common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), + & gmu(2,maxres),gUb2(2,maxres), & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) + & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres), + & gtEUg(2,2,maxres) C This common block contains vectors and matrices dependent on two C consecutive amino-acid residues. double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder + & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder, + & Ug2DtEUg,Ug2DtEUgder common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), @@ -57,7 +65,8 @@ C Cartesian derivatives. & a_chuj_der(2,2,3,5,maxconts,maxres) double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx + & AEAb2,AEAb2derg,AEAb2derx,ADtEA1,ADtEA1derg,ADtEA1derx, + & EAEA, EAEAderg, EAEAderx common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), diff --git a/source/cluster/wham/src-M/include_unres/COMMON.DERIV b/source/cluster/wham/src-M/include_unres/COMMON.DERIV index 79f8630..c2c0e42 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.DERIV +++ b/source/cluster/wham/src-M/include_unres/COMMON.DERIV @@ -1,25 +1,54 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gvdwpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gvdwx,gradcorr,gradxorr, - & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, - & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, - & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx + double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long + & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,gliptranc,gliptranx, + & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, + & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, + & gradcorr6_long,gcorr6_turn_long,gvdwx,gshieldx,gradafm, + & gg_tube,gg_tube_SC, + & gshieldc, gshieldc_loc, gshieldx_ec, gshieldc_ec, + & gshieldc_loc_ec, gshieldx_t3,gshieldc_t3,gshieldc_loc_t3, + & gshieldx_t4, gshieldc_t4,gshieldc_loc_t4,gshieldx_ll, + & gshieldc_ll, gshieldc_loc_ll integer nfl,icg logical calc_grad common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gvdwpp(3,maxres), - & gradx_scp(3,maxres), - & gvdwc_scp(3,maxres),ghpbx(3,maxres),ghpbc(3,maxres), - & gloc(maxvar,2),gradcorr(3,maxres),gradxorr(3,maxres), - & gradcorr5(3,maxres),gradcorr6(3,maxres), - & gel_loc(3,maxres),gcorr3_turn(3,maxres),gcorr4_turn(3,maxres), - & gcorr6_turn(3,maxres),gradb(3,maxres),gradbx(3,maxres), - & gel_loc_loc(maxvar),gel_loc_turn3(maxvar),gel_loc_turn4(maxvar), - & gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad + & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), + & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), + & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), + & gliptranc(3,-1:maxres), + & gliptranx(3,-1:maxres), + & gshieldx(3,-1:maxres), gshieldc(3,-1:maxres), + & gshieldc_loc(3,-1:maxres), + & gshieldx_ec(3,-1:maxres), gshieldc_ec(3,-1:maxres), + & gshieldc_loc_ec(3,-1:maxres), + & gshieldx_t3(3,-1:maxres), gshieldc_t3(3,-1:maxres), + & gshieldc_loc_t3(3,-1:maxres), + & gshieldx_t4(3,-1:maxres), gshieldc_t4(3,-1:maxres), + & gshieldc_loc_t4(3,-1:maxres), + & gshieldx_ll(3,-1:maxres), gshieldc_ll(3,-1:maxres), + & gshieldc_loc_ll(3,-1:maxres), + & gradafm(3,-1:maxres),gg_tube(3,-1:maxres), + & gg_tube_sc(3,-1:maxres), + & gradx_scp(3,-1:maxres),gvdwc_scp(3,-1:maxres), + & ghpbx(3,-1:maxres), + & ghpbc(3,-1:maxres),gloc(maxvar,2),gradcorr(3,-1:maxres), + & gradcorr_long(3,-1:maxres),gradcorr5_long(3,-1:maxres), + & gradcorr6_long(3,-1:maxres),gcorr6_turn_long(3,-1:maxres), + & gradxorr(3,-1:maxres),gradcorr5(3,-1:maxres), + & gradcorr6(3,-1:maxres), + & gloc_x(maxvar,2),gel_loc(3,-1:maxres),gel_loc_long(3,-1:maxres), + & gcorr3_turn(3,-1:maxres), + & gcorr4_turn(3,-1:maxres),gcorr6_turn(3,-1:maxres), + & gradb(3,-1:maxres), + & gradbx(3,-1:maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), + & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar), + & gcorr_loc(maxvar), + & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,-1:maxres), + & gsccorx(3,-1:maxres),gsccor_loc(-1:maxres), + & dtheta(3,2,-1:maxres), + & gscloc(3,-1:maxres),gsclocx(3,-1:maxres), + & dphi(3,3,-1:maxres),dalpha(3,3,-1:maxres),domega(3,3,-1:maxres), + & nfl, + & icg,cacl_grad double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), @@ -28,3 +57,6 @@ & dZZ_XYZtab(3,maxres) common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab + integer igrad_start,igrad_end,jgrad_start(maxres), + & jgrad_end(maxres) + common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/cluster/wham/src-M/include_unres/COMMON.INTERACT b/source/cluster/wham/src-M/include_unres/COMMON.INTERACT index d4a58b5..1c0b8db 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.INTERACT +++ b/source/cluster/wham/src-M/include_unres/COMMON.INTERACT @@ -1,8 +1,10 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ael6,ael3 + double precision aa_aq,bb_aq,augm,aad,bad,app,bpp,ael6,ael3, + & aa_lip,bb_lip integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro,ielstart, & ielend,nscp_gr,iscpstart,iscpend,iatsc_s,iatsc_e,iatel_s, & iatel_e,iatscp_s,iatscp_e,ispp,iscp,expon,expon2 - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), + common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp), + & augm(ntyp,ntyp),aa_lip(ntyp,ntyp),bb_lip(ntyp,ntyp), & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, @@ -10,17 +12,25 @@ & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr), & iatsc_s,iatsc_e,iatel_s,iatel_e,iatscp_s,iatscp_e,ispp,iscp C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,chip0,alp,signa0, + double precision eps,epslip,sigma,sigmaii,rs0,chi,chip,chip0, + & alp,signa0, & sigii,sigma0,rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp, & eps_orig - common /body/eps(ntyp,ntyp),sigma(ntyp,ntyp),sigmaii(ntyp,ntyp), + common /body/eps(ntyp,ntyp),epslip(ntyp,ntyp), + & sigma(ntyp,ntyp),sigmaii(ntyp,ntyp), & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),chip0(ntyp),alp(ntyp), & sigma0(ntyp),sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp), & r0d(ntyp,2),rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2), - & eps_scp(20,2),rscp(20,2),eps_orig(ntyp,ntyp) + & eps_scp(ntyp,2),rscp(ntyp,2),eps_orig(ntyp,ntyp) c 12/5/03 modified 09/18/03 Bond stretching parameters. double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax + &,vbldpDUM integer nbondterm common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp), & distchainmax,nbondterm(ntyp) + &,vbldpDUM +C 01/29/15 Lipidic parameters + double precision pepliptran,liptranene + common /lipid/ pepliptran,liptranene(ntyp) + diff --git a/source/cluster/wham/src-M/include_unres/COMMON.LOCAL b/source/cluster/wham/src-M/include_unres/COMMON.LOCAL index 1d0f3aa..11a1240 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.LOCAL +++ b/source/cluster/wham/src-M/include_unres/COMMON.LOCAL @@ -2,35 +2,50 @@ & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0,vbl,vblinv,vblinv2, & vbl_cis,vbl0,vbld_inv integer nlob,loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end + & iphi_start,iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, + & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, + & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, + & iint_end,iphi1_start,iphi1_end,itau_start,itau_end + C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) + common /thetas/ a0thet(-ntyp:ntyp),athet(2,-ntyp:ntyp,-1:1,-1:1) + & ,bthet(2,-ntyp:ntyp,-1:1,-1:1), + & polthet(0:3,-ntyp:ntyp),gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp), + &sig0(-ntyp:ntyp), sigc0(-ntyp:ntyp) C Parameters of ab initio-derived potential of virtual-bond-angle bending integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) + & ithetyp(-ntyp1:ntyp1),nntheterm + double precision aa0thet(-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & aathet(maxtheterm,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & bbthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ccthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ddthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & eethet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ffthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2), + & ggthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2) common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, & ffthet, & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, & ndouble,nntheterm C Parameters of the side-chain probability distribution common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), + & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp), + & dsc0(ntyp1), & nlob(ntyp1) C Virtual-bond lenghts common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end + & iphi_start,iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, + & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, + & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, + & iint_end,iphi1_start,iphi1_end,itau_start,itau_end C Inverses of the actual virtual bond lengths common /invlen/ vbld_inv(maxres2) diff --git a/source/cluster/wham/src-M/include_unres/COMMON.NAMES b/source/cluster/wham/src-M/include_unres/COMMON.NAMES deleted file mode 100644 index a266339..0000000 --- a/source/cluster/wham/src-M/include_unres/COMMON.NAMES +++ /dev/null @@ -1,7 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(max_ene),wname(max_ene),nprint_ene, - & print_order(max_ene) diff --git a/source/cluster/wham/src-M/include_unres/COMMON.SCCOR b/source/cluster/wham/src-M/include_unres/COMMON.SCCOR index 5217de7..fffe09b 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.SCCOR +++ b/source/cluster/wham/src-M/include_unres/COMMON.SCCOR @@ -1,6 +1,6 @@ C Parameters of the SCCOR term double precision v1sccor,v2sccor integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), + common/torsion/v1sccor(maxterm_sccor,ntyp,ntyp), + & v2sccor(maxterm_sccor,ntyp,ntyp), & nterm_sccor diff --git a/source/cluster/wham/src-M/include_unres/COMMON.SCROT b/source/cluster/wham/src-M/include_unres/COMMON.SCROT index 2da7b8f..a352775 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.SCROT +++ b/source/cluster/wham/src-M/include_unres/COMMON.SCROT @@ -1,3 +1,3 @@ C Parameters of the SC rotamers (local) term double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) + common/scrot/sc_parmin(maxsccoef,ntyp) diff --git a/source/cluster/wham/src-M/include_unres/COMMON.TORCNSTR b/source/cluster/wham/src-M/include_unres/COMMON.TORCNSTR index f8fc3a1..8958b81 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.TORCNSTR +++ b/source/cluster/wham/src-M/include_unres/COMMON.TORCNSTR @@ -1,5 +1,17 @@ - integer ndih_constr,idih_constr(maxdih_constr) + integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr, + & itheta_constr(maxdih_constr) integer ndih_nconstr,idih_nconstr(maxdih_constr) - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr + integer idihconstr_start,idihconstr_end,ithetaconstr_start, + & ithetaconstr_end + logical raw_psipred + double precision phi0(maxdih_constr),drange(maxdih_constr), + & ftors(maxdih_constr),theta_constr0(maxdih_constr), + & theta_drange(maxdih_constr),for_thet_constr(maxdih_constr), + & vpsipred(3,maxdih_constr),sdihed(2,maxdih_constr), + & phibound(2,maxres),wdihc + common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange, + & for_thet_constr,vpsipred,sdihed,phibound,wdihc, + & ndih_constr,idih_constr, + & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end, + & ntheta_constr,itheta_constr,ithetaconstr_start, + & ithetaconstr_end,raw_psipred diff --git a/source/cluster/wham/src-M/include_unres/COMMON.TORSION b/source/cluster/wham/src-M/include_unres/COMMON.TORSION index 55cc7f4..cd576c8 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.TORSION +++ b/source/cluster/wham/src-M/include_unres/COMMON.TORSION @@ -1,25 +1,60 @@ C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), + double precision v1,v2,vlor1,vlor2,vlor3,v0,v1_kcc,v2_kcc, + & v11_chyb,v21_chyb,v12_chyb,v22_chyb,v1bend_chyb + integer itortyp,ntortyp,nterm,nlor,nterm_old,nterm_kcc_Tb, + & nterm_kcc,itortyp_kcc,nbend_kcc_Tb + common/torsion/v0(-maxtor:maxtor,-maxtor:maxtor,2), + & v1(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & v2(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & vlor1(maxlor,-maxtor:maxtor,-maxtor:maxtor), & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor), - & nlor(maxtor,maxtor),nterm_old + & v1_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v2_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v1bend_chyb(0:maxang_kcc,-maxtor:maxtor), + & itortyp(-ntyp1:ntyp1),ntortyp, + & itortyp_kcc(-ntyp1:ntyp1), + & nterm(-maxtor:maxtor,-maxtor:maxtor,2), + & nlor(-maxtor:maxtor,-maxtor:maxtor,2), + & nterm_kcc_Tb(-maxtor:maxtor,-maxtor:maxtor), + & nterm_kcc(-maxtor:maxtor,-maxtor:maxtor), + & nbend_kcc_Tb(-maxtor:maxtor), + & nterm_old C 6/23/01 - constants for double torsionals double precision v1c,v1s,v2c,v2s integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) + common /torsiond/ + &v1c(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v1s(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v2c(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + &v2s(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + & ntermd_1(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + & ntermd_2(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) C 9/18/99 - added Fourier coeffficients of the expansion of local energy C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b1tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp - double precision b - common /fourier1/ b(13,maxtor) + double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde,b1tilde, + & b,bnew1,bnew2,ccold,ddold,ccnew,ddnew,eenew,e0new,gtb1,gtb2, + & eeold,gtcc,gtdd,gtee, + & bnew1tor,bnew2tor,ccnewtor,ddnewtor,eenewtor,e0newtor + integer nloctyp,iloctyp(-ntyp1:ntyp1),itype2loc(-ntyp1:ntyp1) + logical SPLIT_FOURIERTOR + common/fourier/ b1(2,maxres),b2(2,maxres),b(13,-ntyp:ntyp), + & bnew1(3,2,-ntyp:ntyp),bnew2(3,2,-ntyp:ntyp), + & ccnew(3,2,-ntyp:ntyp),ddnew(3,2,-ntyp:ntyp), + & bnew1tor(3,2,-ntyp:ntyp),bnew2tor(3,2,-ntyp:ntyp), + & ccnewtor(3,2,-ntyp:ntyp),ddnewtor(3,2,-ntyp:ntyp), + & ccold(2,2,-ntyp:ntyp),ddold(2,2,-ntyp:ntyp), + & cc(2,2,maxres), + & dd(2,2,maxres),eeold(2,2,-ntyp:ntyp), + & e0new(3,-ntyp:ntyp),eenew(2,2,2,-ntyp:ntyp), + & e0newtor(3,-ntyp:ntyp),eenewtor(2,2,2,-ntyp:ntyp), + & ee(2,2,maxres), + & ctilde(2,2,maxres), + & dtilde(2,2,maxres),b1tilde(2,maxres), + & b2tilde(2,maxres), + & gtb1(2,maxres),gtb2(2,maxres),gtCC(2,2,maxres), + & gtDD(2,2,maxres),gtEE(2,2,maxres), + & nloctyp,iloctyp,itype2loc,SPLIT_FOURIERTOR diff --git a/source/cluster/wham/src-M/include_unres/COMMON.WEIGHTS b/source/cluster/wham/src-M/include_unres/COMMON.WEIGHTS index d7e6e23..86f8d7a 100644 --- a/source/cluster/wham/src-M/include_unres/COMMON.WEIGHTS +++ b/source/cluster/wham/src-M/include_unres/COMMON.WEIGHTS @@ -10,13 +10,13 @@ & epp_low(2,2),epp_up(2,2),rpp_low(2,2),rpp_up(2,2), & elpp6_low(2,2),elpp6_up(2,2),elpp3_low(2,2),elpp3_up(2,2), & b_low(13,3),b_up(13,3),x_up(max_paropt),x_low(max_paropt), - & epscp_low(0:20,2),epscp_up(0:20,2),rscp_low(0:20,2), - & rscp_up(0:20,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp), + & epscp_low(0:ntyp,2),epscp_up(0:ntyp,2),rscp_low(0:ntyp,2), + & rscp_up(0:ntyp,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp), & epsp_up(nntyp), & xm(max_paropt,0:maxprot),xm1(max_paropt,0:maxprot), & xm2(max_paropt,0:maxprot), & imask(max_ene),nsingle_sc,npair_sc,ityp_ssc(ntyp), & ityp_psc(2,nntyp),mask_elec(2,2,4), & mask_fourier(13,3), - & mask_scp(0:20,2,2),mod_other_params,mod_fourier(0:3), + & mask_scp(0:ntyp,2,2),mod_other_params,mod_fourier(0:3), & mod_elec,mod_scp,mod_side,indz(maxbatch+1,maxprot),iw(max_ene) diff --git a/source/cluster/wham/src-M/initialize.f b/source/cluster/wham/src-M/initialize.f index 751c20e..12ea156 100644 --- a/source/cluster/wham/src-M/initialize.f +++ b/source/cluster/wham/src-M/initialize.f @@ -83,10 +83,17 @@ c------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.FFIELD' data restyp / + &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL', + & 'DSG','DGN','DSN','DTH', + &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER', &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ + &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ', + &'AIB','ABU','D'/ data onelet / + &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g', + &'a','y','w','v','l','i','f','m','c','x', &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ + &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/ + data potname /'LJ','LJK','BP','GB','GBV'/ data potname /'LJ','LJK','BP','GB','GBV'/ end diff --git a/source/cluster/wham/src-M/initialize_p.F b/source/cluster/wham/src-M/initialize_p.F index e1905f8..d43d1b6 100644 --- a/source/cluster/wham/src-M/initialize_p.F +++ b/source/cluster/wham/src-M/initialize_p.F @@ -5,9 +5,6 @@ C implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'sizesclu.dat' -#ifdef MPI - include 'mpif.h' -#endif include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' @@ -58,6 +55,7 @@ C ibond=28 isccor=29 jrms=30 + iliptran=60 C C Set default weights of the energy terms. C @@ -84,8 +82,10 @@ C enddo do i=1,ntyp do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 + aa_aq(i,j)=0.0D0 + bb_aq(i,j)=0.0D0 + aa_lip(i,j)=0.0D0 + bb_lip(i,j)=0.0D0 augm(i,j)=0.0D0 sigma(i,j)=0.0D0 r0(i,j)=0.0D0 @@ -101,8 +101,12 @@ C rr0(i)=0.0D0 a0thet(i)=0.0D0 do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 + do ichir1=-1,1 + do ichir2=-1,1 + athet(j,i,ichir1,ichir2)=0.0D0 + bthet(j,i,ichir1,ichir2)=0.0D0 + enddo + enddo enddo do j=0,3 polthet(j,i)=0.0D0 @@ -128,15 +132,37 @@ C enddo nlob(ntyp1)=0 dsc(ntyp1)=0.0D0 - do i=1,maxtor + do i=-maxtor,maxtor itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 - enddo - enddo + do iblock=1,2 + do j=-maxtor,maxtor + do k=1,maxterm + v1(k,j,i,iblock)=0.0D0 + v2(k,j,i,iblock)=0.0D0 + enddo + enddo + enddo enddo + do iblock=1,2 + do i=-maxtor,maxtor + do j=-maxtor,maxtor + do k=-maxtor,maxtor + do l=1,maxtermd_1 + v1c(1,l,i,j,k,iblock)=0.0D0 + v1s(1,l,i,j,k,iblock)=0.0D0 + v1c(2,l,i,j,k,iblock)=0.0D0 + v1s(2,l,i,j,k,iblock)=0.0D0 + enddo !l + do l=1,maxtermd_2 + do m=1,maxtermd_2 + v2c(m,l,i,j,k,iblock)=0.0D0 + v2s(m,l,i,j,k,iblock)=0.0D0 + enddo !m + enddo !l + enddo !k + enddo !j + enddo !i + enddo !iblock do i=1,maxres itype(i)=0 itel(i)=0 @@ -214,61 +240,44 @@ c------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.FFIELD' data restyp / + &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL', + & 'DSG','DGN','DSN','DTH', + &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER', &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ + &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ', + &'AIB','ABU','D'/ data onelet / + &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g', + &'a','y','w','v','l','i','f','m','c','x', &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ + &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/ data potname /'LJ','LJK','BP','GB','GBV'/ data ename / & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP", - & "ESTR","ESCCOR","EVDW2_14","","EVDW_T"/ + & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN", + & "EAFM","ETHETC","EMPTY"/ data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WHPB","WVDWPP","WBOND","WSCCOR","WSCP14","","WSC"/ - data nprint_ene /21/ + & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC", + & "WLIPTRAN","WAFM","WTHETC","WSHIELD"/ + data nprint_ene /22/ data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19, - & 16,15,17,20,21/ + & 16,15,17,20,21,24,22,23,1/ end c--------------------------------------------------------------------------- subroutine init_int_table implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'sizesclu.dat' -#ifdef MPI - include 'mpif.h' -#endif -#ifdef MPL - include 'COMMON.INFO' -#endif include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.LOCAL' include 'COMMON.SBRIDGE' include 'COMMON.IOUNITS' + include "COMMON.TORCNSTR" logical scheck,lprint -#ifdef MPL - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - lprint=.false. - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - MyRank=MyID-(MyGroup-1)*fgProcs - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif lprint=.false. do i=1,maxres nint_gr(i)=0 @@ -288,6 +297,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) goto 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. @@ -299,66 +309,30 @@ cd & (ihpb(i),jhpb(i),i=1,nss) cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj if (scheck) then if (jj.eq.i+1) then -#ifdef MPL - write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+2 iend(i,1)=nct -#endif else if (jj.eq.nct) then -#ifdef MPL - write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+1 iend(i,1)=nct-1 -#endif else -#ifdef MPL - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else nint_gr(i)=2 istart(i,1)=i+1 iend(i,1)=jj-1 istart(i,2)=jj+1 iend(i,2)=nct -#endif endif else -#ifdef MPL - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+1 iend(i,1)=nct ind_scint=int_scint+nct-i -#endif endif -#ifdef MPL - ind_scint_old=ind_scint -#endif enddo 12 continue -#ifndef MPL iatsc_s=nnt iatsc_e=nct-1 -#endif -#ifdef MPL - if (lprint) then - write (iout,*) 'Processor',MyID,' Group',MyGroup - write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e - endif -#endif if (lprint) then write (iout,'(a)') 'Interaction array:' do i=iatsc_s,iatsc_e @@ -367,33 +341,12 @@ cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj enddo endif ispp=2 -#ifdef MPL -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue -#else iatel_s=nnt iatel_e=nct-3 do i=iatel_s,iatel_e - ielstart(i)=i+2 + ielstart(i)=i+4 ielend(i)=nct-1 enddo -#endif if (lprint) then write (iout,'(a)') 'Electrostatic interaction array:' do i=iatel_s,iatel_e @@ -403,40 +356,6 @@ C Now partition the electrostatic-interaction array c iscp=3 iscp=2 C Partition the SC-p interaction array -#ifdef MPL - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else iatscp_s=nnt iatscp_e=nct-1 do i=nnt,nct-1 @@ -456,7 +375,6 @@ cd write (iout,*) 'i.gt.nct-iscp' iscpend(i,2)=nct endif enddo ! i -#endif if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e @@ -465,40 +383,22 @@ cd write (iout,*) 'i.gt.nct-iscp' enddo endif ! lprint C Partition local interactions -#ifdef MPL - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iphi_start,iphi_end) - iphi_start=iphi_start+nnt+2 - iphi_end=iphi_end+nnt+2 - if (lprint) then - write (iout,*) 'Processor:',MyID, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end - write (*,*) 'Processor:',MyID, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end - endif - if (fgprocs.gt.1 .and. MyID.eq.BossID) then - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',fgprocs, - & ' fine-grain processors.' - endif -#else loc_start=2 loc_end=nres-1 - ithet_start=3 + ithet_start=3 ithet_end=nres + iturn3_start=nnt + iturn3_end=nct-3 + iturn4_start=nnt + iturn4_end=nct-4 iphi_start=nnt+3 iphi_end=nct -#endif + idihconstr_start=1 + idihconstr_end=ndih_constr + ithetaconstr_start=1 + ithetaconstr_end=ntheta_constr + itau_start=4 + itau_end=nres return end c--------------------------------------------------------------------------- @@ -547,13 +447,8 @@ c------------------------------------------------------------------------------ include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' - call int_bounds(nhpb,link_start,link_end) -#else link_start=1 link_end=nhpb -#endif cd write (iout,*) 'Processor',MyID,' MyRank',MyRank, cd & ' nhpb',nhpb,' link_start=',link_start, cd & ' link_end',link_end diff --git a/source/cluster/wham/src-M/int_from_cart1.f b/source/cluster/wham/src-M/int_from_cart1.f index 4f768e1..7d266de 100644 --- a/source/cluster/wham/src-M/int_from_cart1.f +++ b/source/cluster/wham/src-M/int_from_cart1.f @@ -24,6 +24,9 @@ enddo be=0.0D0 if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + if (i.gt.2) tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) + if (i.gt.2) tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) + if (i.gt.2) tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) omeg(i)=beta(nres+i,i,maxres2,i+1) theta(i+1)=alpha(i-1,i,i+1) alph(i)=alpha(nres+i,i,maxres2) diff --git a/source/cluster/wham/src-M/main_clust.F b/source/cluster/wham/src-M/main_clust.F index f01f859..0164249 100644 --- a/source/cluster/wham/src-M/main_clust.F +++ b/source/cluster/wham/src-M/main_clust.F @@ -29,12 +29,12 @@ C INTEGER IA(maxconf),IB(maxconf) INTEGER ICLASS(maxconf,maxconf-1),HVALS(maxconf-1) INTEGER IORDER(maxconf-1),HEIGHT(maxconf-1) - integer nn,ndis - real*4 DISNN + integer nn,ndis,scount_buf + real*4 DISNN, diss_buf(maxdist) DIMENSION NN(maxconf),DISNN(maxconf) LOGICAL FLAG(maxconf) integer i,j,k,l,m,n,len,lev,idum,ii,ind,ioffset,jj,icut,ncon, - & it,ncon_work,ind1 + & it,ncon_work,ind1,kkk, ijk, is,ie double precision t1,t2,tcpu,difconf double precision varia(maxvar) @@ -61,10 +61,12 @@ C call initialize call openunits - call parmread + call cinfo call read_control + call parmread call molread -c if (refstr) call read_ref_structure(*30) +c write (iout,*) "Main: refstr ",refstr + if (refstr) call read_ref_structure(*30) do i=1,nres phi(i)=0.0D0 theta(i)=0.0D0 @@ -77,8 +79,13 @@ c call flush(iout) call permut(symetr) c write (iout,*) "after permut" c call flush(iout) - print *,'MAIN: nnt=',nnt,' nct=',nct - +c print *,'MAIN: nnt=',nnt,' nct=',nct + if (nclust.gt.0) then + PRINTANG(1)=.TRUE. + PRINTPDB(1)=outpdb + printmol2(1)=outmol2 + ncut=0 + else DO I=1,NCUT PRINTANG(I)=.FALSE. PRINTPDB(I)=0 @@ -90,12 +97,21 @@ c call flush(iout) printmol2(i)=outmol2 ENDIF ENDDO + endif + if (ncut.gt.0) then write (iout,*) 'Number of cutoffs:',NCUT write (iout,*) 'Cutoff values:' DO ICUT=1,NCUT WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT), & printpdb(icut),printmol2(icut) ENDDO + else if (nclust.gt.0) then + write (iout,'("Number of clusters requested",i5)') nclust + else + if (me.eq.Master) + & write (iout,*) "ERROR: Either nclust or ncut must be >0" + stop + endif DO I=1,NRES-3 MULT(I)=1 ENDDO @@ -107,11 +123,10 @@ c call flush(iout) write (iout,*) "nT",nT do iT=1,nT - write (iout,*) "iT",iT + write (iout,*) "Temperature",1.0d0/(beta_h(iT)*1.987D-3) #ifdef MPI call work_partition(.true.,ncon) #endif - call probabl(iT,ncon_work,ncon,*20) if (ncon_work.lt.2) then @@ -122,7 +137,6 @@ c call flush(iout) ndis=ncon_work*(ncon_work-1)/2 call work_partition(.true.,ndis) #endif - DO I=1,NCON_work ICC(I)=I ENDDO @@ -134,15 +148,16 @@ C call daread_ccoords(1,ncon_work) ind1=0 DO I=1,NCON_work-1 - if (mod(i,100).eq.0) print *,'Calculating RMS i=',i +c if (mod(i,100).eq.0) print *,'Calculating RMS i=',i do k=1,2*nres do l=1,3 c(l,k)=allcart(l,k,i) enddo enddo + kkk=1 do k=1,nres do l=1,3 - cref(l,k)=c(l,k) + cref(l,k,kkk)=c(l,k) enddo enddo DO J=I+1,NCON_work @@ -162,10 +177,18 @@ c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) WRITE (iout,'(/a,1pe14.5,a/)') & 'Time for distance calculation:',T2-T1,' sec.' t1=tcpu() - PRINT '(a)','End of distance computation' +c PRINT '(a)','End of distance computation' + + scount_buf=scount(me) + + do ijk=1, ndis + diss_buf(ijk)=diss(ijk) + enddo + #ifdef MPI - call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1), + WRITE (iout,*) "Wchodze do call MPI_Gatherv" + call MPI_Gatherv(diss_buf(1),scount_buf,MPI_REAL,diss(1), & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR) if (me.eq.master) then #endif @@ -241,21 +264,29 @@ C endif CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) - +c 3/3/16 AL: added explicit number of cluters + if (nclust.gt.0) then + is=nclust-1 + ie=nclust-1 + icut=1 + else + is=1 + ie=lev-1 + endif do i=1,maxgr licz(i)=0 enddo icut=1 - i=1 - NGR=i+1 + i=is + NGR=is+1 do j=1,n licz(iclass(j,i))=licz(iclass(j,i))+1 nconf(iclass(j,i),licz(iclass(j,i)))=j c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)), c & nconf(iclass(j,i),licz(iclass(j,i))) enddo - do i=1,lev-1 - +c do i=1,lev-1 + do i=is,ie idum=lev-i DO L=1,LEV IF (HEIGHT(L).EQ.IDUM) GOTO 190 @@ -263,8 +294,9 @@ c & nconf(iclass(j,i),licz(iclass(j,i))) 190 IDUM=L write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM), & " icut",icut," cutoff",rcutoff(icut) - IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN - WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) + IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN + if (nclust.le.0) + & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) write (iout,'(a,f8.2)') 'Maximum distance found:', & CRITVAL(IDUM) CALL SRTCLUST(ICUT,ncon_work,iT) @@ -305,17 +337,17 @@ C C close(icbase,status="delete") #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop '********** Program terminated normally.' 20 write (iout,*) "Error reading coordinates" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop 30 write (iout,*) "Error reading reference structure" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop end @@ -333,7 +365,7 @@ c--------------------------------------------------------------------------- logical non_conv double precision przes(3),obrot(3,3) double precision xx(3,maxres2),yy(3,maxres2) - integer i,ii,j,icon,jcon,kkk,nperm,chalen,zzz + integer i,ii,j,icon,jcon,kkk,chalen,zzz integer iaperm,ibezperm,run double precision rms,rmsmina c write (iout,*) "tu dochodze" @@ -358,7 +390,7 @@ c write (iout,*) "tutaj",zzz ibezperm=(run-1)*chalen+i do j=1,3 xx(j,ii)=allcart(j,iaperm,jcon) - yy(j,ii)=cref(j,ibezperm) + yy(j,ii)=cref(j,ibezperm,kkk) enddo enddo enddo @@ -372,7 +404,7 @@ c if (itype(i).ne.10) then ii=ii+1 do j=1,3 xx(j,ii)=allcart(j,iaperm+nres,jcon) - yy(j,ii)=cref(j,ibezperm+nres) + yy(j,ii)=cref(j,ibezperm+nres,kkk) enddo enddo c endif @@ -392,7 +424,8 @@ c do i=nnt,nct enddo enddo enddo - call fitsq(rms,c(1,nstart),cref(1,nstart),nend-nstart+1,przes, + call fitsq(rms,c(1,nstart),cref(1,nstart,kkk),nend-nstart+1, + & przes, & obrot,non_conv) endif if (rms.lt.0.0) then diff --git a/source/cluster/wham/src-M/obackup/arcos.o b/source/cluster/wham/src-M/obackup/arcos.o deleted file mode 100644 index 21307c76cfed8065d6317497bb39d83ea8fc7129..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 3624 zcmb7{U1(cX9Kg@HH%-!|Hfig|J_J+PN6Xfmn)acavSyZaDQj2BI$Q@DZkwC*V!pih zHl`2TP(c`q417`F6gGYGVTkxTeQ-{Yy*UtMFOI?#YC+tCQ2+mP&qTmGh_U%I~?U%m&S z3r`^P19W&i2&U}tU*DRZSzK6HJa3%MF8bs)^v<7! zC{4MmYnEe{&D6SUIc~}qUWy{T571OhumVZ#SXeggOGe0sl zN_3i_gkHf;v5bE2q+c4M`7VW%_-JPr1s?M02kd{yn5 zYVv2q#t{?tZJ|4%J%oY)qW;{$YLJ_6{&`P-K;`9T=soc3ZEt(3_31j*j^fV&{VLs> zoID|!AupyLpogMEF+F-Dnt%_7c9_Isr=bc5(V)-APR35flCgAbZs=H_9vz^AbQ+Fx zsE7EbxuJ7_HCXVTNsiJGJU4_We2^!2f%`;MAIwFbhCkfb(3@7GFA}|hg9SO^7wunh zh(q{2>T+D+wWH_Jl9iH4J z&u)BNbd1OS{{r84?a!bTp5gi>Zp5DAOo-8mnZzlTE0U*4jKa9sAsqy#@ e?-u_{mw1d-*_sm4N5hBT-@}cAg}`B?@tZ1Bv4oNuUYXu@$7nuiDNgJW@rLWLscMsw4-8 zmSPB@n2^VEU}>Q}O}pJ5vIn-D9$*u;TTFQbXt(7QwoA9|*+A26a<-*`rMuZSG<)yN z9cljiOChkGbEN;D@6O!0cjnIgPwDnR`zDuVxdkOlTqP`>F}CYE3z=rQ+bm{@vI1m# zsKX=PJeb+*j?ypHjwh&K_}dX5rb&&vOlcr)YwNxY4? z*7E`Jc2>RuLInG{oAD*Y`ZeIT*vKP;@=>? zi2PbYe3E!A@zumn5w9S=fw+M7G2uFb>008I#48mR*Ae%#@`J?di0c*XCE#wMql}cm z<|mR*DFE7gTXH?i3*vVq*WMTS8Of&=0PRhKCCM$OJNO*nmTF zWZX^8Jj%GBA^kRS?Q@-KR(yw-r;ynkocLAnj^8vx?*=EfoeCb^J^81z@~9i!D|h$c zkyQkbh_iR?^26RgV)ncE6`VL4oEUv`;wQn0SA!Ej4Kz*$_XOSyO+42)c>?8os;6!+PO4@DEZD{*sbFSww({q^Xfp~JmNMZF!n6VZ67lXMc zp9Ot33D-Nx^iF=L-iJ}|mGE^=y)QGpFMp`sX)t;xzx82yUt@Y-<9g2q&VXTiHlP0F z_bT??`iHY;PhJd)i!5IymaVP%;kHE+;v&N>qp4zF2#zM_Xo5|l?fE9aTUdqh8)hhC zdlM(${ebJ;({aWv&tHPkS4tg3hVuGtE+Dq+w~ZjV^276MlDU-5H)(STvAxNY$@9~X z2R`GtIF{FMa|y9se=(PO&#y_lOPj~lB5L{*7`Hce@_)~KjPcogk8^nr++){V%#Gvc z*BEo-KoK_%*c&@}FKRv-_#*T<1md<+uRMR?z=45OCU>R3W?5{-mHyt*{%kapNay@Z zm&N?40e@~N?vG?Lk)8f!S^rQZ>)#O>9*z5#4afYq3?-sN{zTS49M5KbSb=?7D+Y{&oB81+qn}T5= z#57B7TVWqRb$|9eS|h{?_|(AXdiY!ipRH`)uac0PXgrzAq!KZIG?mK45=n463*}W2 z{T&%j4@Fi*BbokG(kw`FDBs%E(b3ge8|vEJ8S3lJ=Q~?E0+7q+L!Etro|e`=UA{Hg z5|Vel+Cm+H&fZX0rz|bR8mJS5tFtQjpfA<%LGN$^BSRmT2;s#`13ax?3m>d=4ao3Q zB~}S-z1n`b4^?8Js#Bs*l-{XYufQulvTGlrh`TNN7}8QHlik<2Dy zaWNAHGndXJlDXOe5lZIb!!q4iLrRr-xEm=#ol}!vLBX!~fK<*urw|U$ZZYw$z zNhHGp58x_!T?>E;-yE1Rd1!fEi``Z%D&}*1vD+FOPDMpE7hD2@Oe!ZDxL_qJ3MW&U z5z)+K78sPwzzjgE&DO2CN>Ilo!sCTH(9TFCXZNDXZRJEKYrwSz3X3qO>)cj4lZuHn z7i@syIdO*_3(r(+Gd_^bWk#c{*+tNKAQJc6>v$~?B(tMw?ts^Vj!kBB5D(#^;>LnF z{uyWOOFdm8j(c=$1roXF4v{ zb4fi);=|$^E?A?gWKvG6H()cv%7z|R&+U^!v|<|be;=@rxLoXKNZ_)TX|-{+={2OVn6GN8C7xx9*KxAa|yHzYx77Xkr0Qt z>{6GN$<~RdIj?oW+MN*3a}Hq+JS|@1g0)IeC;p8~AYkC|ERHiib0(QpC*I*A7y+;t z>^;pT^T6Irop8ZT9&-hs30)7koMY&eOkG?o_XvL0D%HWi+CGIDW+`=h~R3lh|%jo0%uhb zr*Y-zXD*d-Rw|#TB(Wl*Di95%Ml%WMX}-ReF9RXOLy>Bifdo&Oi-;Of6oo18P`3^w z(f&x*Ip*b8W2IcgIT$n0E4UUb(n~YuD^Y5+NHrWOX<)s>jv32AhV#ZLS&6lx(Uh|< zW;A-On=&KLW91C+>ZbHCoKQ1=g=a3^poG8hgB zFB1-vHcLc;Fm%>VcHcM%}c%6$cDX7kgUvp`_l0u+~KQP%M!>Dj3K9Wc#MiRGz>tze< zBe)3W23i33V&HN+jJj6vA~1om2&@(@c9HNbQKR8JKwJcZL}57CH1=M!h{SR{98z5P zv9cZzM*(nM7LX&trHjG&ywtf=EyiOMYFA_8sEw;!UR9*u`9W5 zziF9mTpT5}6~@3g%GBnY;w=f!B`^T#NX9u&mVstC465bjQ}zM%E`x}JBcYtMQ7&5z z6;l~0%W>ISDT_(rZZ3qGiH8O$e258`&xG|{9V?~$5SK%wz~NHLzRP77tHntQf5e5b ziohXL%HHBKTqy=5_1DwQ z+yl1Uy2qdWX0bxX<%7G#+RG2kU^tQkdRNsio&&{N z@KJV)sZ_&oP7lwkBl5l)rO%h0tFJ#oCn{HLeGPsU6!1*JQizpvXH;)vnOER4!e`Bc zhXS>5T~4BkXi{`4WdHI2zC#I{m zx;FR8GQuJNQ_Bvz+cw%kM^}4;o%Hs#uu7mM)M+mi;EK`BmL68IyC<+Iv=#29Q(ts< z^$9nb*4x_C($^Yn3-y3J&*0X!y`kPvTcF#Hz=uttc6ctMtMzpBvJ%)X8eJ%Zra<=; zKx=PHxMyQa=e2g!8wkMLR9Z6@3Wj?7x_aPtzX_cck<{A@wX}B!TZ$l73~MsOz<7H- zEEDbtbc8xX9ii*FiJdKdp}!1-9kt93=nDqe==5|k0B+j*5kQ-rZ0zb}1bVe66kru0 zvhDS77#V5h!06~Lf@P+w{MxR5*|yrYOPO}T~T&rnZK-| z?2>Y~Zx%eYxf-6AxtoL%G(g$V92Y#(@hqaU>!BP1FE4`?r&Nowva6tyfOW;1Ru+Q$ z;=U!~;u)*qy@F}81?nqw%j|zmMpF_ajC5 zl*+qZ9(;_p%j5CGn~KxiZV!&_v?=(!4HN3cR7`J`63Oq6s@E1QxH{(|{h~Izb3|@) z@v)r1GZ?tkf%8dvv_Vg?^7m!(&&9%`79Q+GauHE0zv01j_?8UZQV(b2p9v3)$Tzf zwGMKHgRF6ob(}QRIY_;OG&o43gETqFJ#hs})+n;RWAH#ux>a@gGDu({4QTOok+svrHT<9mL##2r8U?YFm8s?n3Evs)e!37~*O2Hmo?iMbuYLls4 zy!M*T&8y&+Q1oV)e)0a%LAYWbNa_9I1l*P-9_jDT#CPc2Kn8F1*2agzv{$GM^L7yC zG&~Hil}mxzEyzixfNDV&R)Ew=lGnbJ7ArhxY%~`x+Q%pExR9Qp{91$KV%S9aEwn{F z__8;=m?IOu;Ef46oN0*1=tc3n5JJ-WRZfTr+R^+slz)}Bs0Uwo(fWT$T$dlGytY^K z_ld8-bsQ4ca|Ll+^_$_-cLRJux`w#cqo@$=jO!ozY%QVZLE^mKzb#SzNv40C8a~3f zJT8Ik#S(g4*dQd{?h4}E-+F^z4fWs+G@05BJsYJ)^>qVr-9LC%glW*=`k;w?zoEyB zldl=&<$;^@JY|&M1oic}A7$lHH>MvjUPXFl(CZv1HsfbGac%!NDuHwv<9^aJTtd$s z#IZkH;B$id?S7`Gn)H0r&|~@~-|dF_+8)@I>7SUMm89oSh91+e3-Ck+lGZaWbMV3s z<8`EG8*$!08RFWnQ{>k!rl*PYJY?uG{d$J!IZb-L&-ApBo_{Z)=Y+vqz$d+)xG-oS zq5USGOW`$dDB z?S8ui{~mGOuI}g8iR*TA)b6hhJ!ZT5Ojnmzy(2`~6t$=MdeYNQoX1asl^-WXNyeK= z&$mkGd5)FW_PoTnUYCDl=rQ}Pf_~G*?W{7mS-y$5_E+0~1>@ah|Hcw}?lgD+jMwYf z15A(h>r0H^Ncz8S=rQel+u)}D-x=I2KNYT`Fmb=i8Q)Ir&Lhs}SC_%fb|XxWYE6g% z#)nCN%FtuldC1_V{-+IYmj5BsKTZw5&Ul*I{doyJ^Wm}&6OR)LE7@;rR1x`o8|`C% zUT*OFX&;-TrAv~B8P^wzuNxfw(&+^4pdOR!Utnuqd8;b800AV;PyLt5*E4>M4gejD zzlOgghBUzV6LkJI&iIqWzhv-hRFm@i?@RC(7=P_)Rp}RuA0&I;XFOevBLqJpR2%7U zP^pmLH6?fppYdf9i&czIE>}FjxO}r2MB5nm*QoM47;h%NpYiR)4>3MY`~}AEBK~v6?;-v^ z1+lSr!+Sbo|Zx+oE_4;|Gaf&3N-hRelTOlknsKQ;P9sisvsdK7OMr z|5e5h5xk^ z_z5%s(l;4DMf^F&U!!&BZN{IVI2Lq1fYs5?!^9UDoI(Mc&Hun1%bUD|mDjRCgI_B( zsIT!7{9(p_Om&Vh{tfc?r;I;J{1oHzr{JJ#I-bZt!eSJHGQXq*zmjoU?nEEs)V(6f zI34c97Z}$+l>Zvz`Ud=W7>B3#GW~?{D&p@l?kA294lrqdt5sGkXS{}ZE8{DPZ)05l zz<-Q!ec$YU#@CUa#~EKw{3zqi#NTGTjrgA!4-#KQ9j^UtC*H(3{FY3nF2?(a4>1nU zQf0c6aauOSBL;7$vbcG=1phJT6u0ki?o!Iiq^e4UxJ*I-T}@je<$bk-yvTy zcn2Cl>6sGzUpc4o`XA0|yyj9nSWN1t@oM0l#;coi8m|=RG+ui-r|~+(IgQtkIj3>? zJ?DB{Xo1SxPvdf#!8>)Q!8TNa4>C^fihCF*GsQOoN>K=dS)r((0;U2 zub)d9*Xw69<9=0L+{Ab_@qLWf5dS;IR}z2G;9bOU^HvG|0p}EN3umj!n3Z}c-qvtV z@z%>Z4M3K2insloQ@lOKImO${oYO!a=bYm0VP(FY?>ZI`xyV1Sr{t zEByEcNtai-(!5S3UF_p-;e8=_>x9>DCNNIjg0lrrfwYS{{5}B;O{QLjJ(VV@UK4eb z=DNPlVqo^%v5yO#6xLX$JVoInP<=%$d2D=1e^`Argr?{E9dyI}!O}yf?lZr`aygcKSL!4GsGvX(u`#?zO4o z9H2ln;J5)UkEbEW9p>@``RcvbxZHEw<2R{K5tYK0ZW;|?$zAF_syxEiV+xS|2G&nz zg*`5h>lZLTM7c=%@+#&J!SqF^W%W;W}Xhbiz-5j+bG}znP)KBdb>>$9Z(&a5OfT_2 zL4BZjt_I$p`C8ydGG7Ngi}?oNr!&79__@p*m?vqsoC@ZfK);?j)jN8rukP#n%r^ty z$oxLw4=~>Xd>ivefWOMT5%_z|p920R^KHOWRE4KFZwEevc@uMK7wODjWZsqYJCXTL z;Cam7WG?;BeCF=~uVcQOxy1i!=6itO%sf%mBYKJcz07+8Z)Dyd`18yU0sbcQp};?7 zejM^WDH7V&2M}-<<8t z_W*x`xm0Aa{}J;<2Evn6M?`T;W+3(lGVcleSmxAU(o5`&W4;O6`)uZ^tXQlMb4r;v zFkis@V&=)JJ<&_K?Y^#Io&x+w%m*^(H|IX)slc}~Ph&3meU>KKNt8Pm=^$l zlX)@le=;ux-o3l_ryTg9%&UN>Gp_|ciFqCHGnp>|UdFs0_!8z<0Kb;`3gEXhUk&_z z=4*j(W4;dfpO|j|{yy`Yfk%4ixHSOp&wL~BqnK|3eggBmflp(;8F&Hn`+(Ol-@;t_ zhbx&s0{lkijll0_{uJ=Xm~R9AJoD|q-(ubbyp{QjzW3f054zz=7>fw{y#lljfSbC@>(pTm43@bj5(VlLz3 zCCu*zejW48z&A3#5BP)3w=fs~pJo0C@Yk3(0&ijd6!2(o9k*@F#s2}!w*x<#c@yyQ z%wGgPhxul%IBI&}zRp)X>Tu&?MsHQFew+_v+0|^Pne7)dzlC`LPkdxvw3+!f<}xpO zl6e#GmznQiE*`wYyczf&=DWa7?-U)+7T`mew=$P@G@5xL2S#{|c?xsRwsQ`1ns3re zcm?xR;FmE^1HO)VI&*f*xr=!g@Q0aaGnab!TjrC2H#3hh7e7B{o(sH7A04+jzy~oe z0Dc^EnirdKIE8r?@R`i(fR`|@2VTc~1#@W^tC+6_ek=2}VCNUiHvoT%c>~z_BlC^G z|IU09*!hC_X5cA(bv(C#oo_LJ1o#-{jbLXA^KHP-W!?mKDw)3s{Bq_ym`nXx&wMBF zP0X8_Oa1v3^IgDy$GipjpP9D;-_2YWfW>~-emZW++z^EiW}X84c;*9vXERR)K8tx8 z@cGQsnM-^wWIhV`YUWwMZ(}|l_%E4f1OE;4$-s9ok1^*r=UwJ`z`tZ(0K89s9nW&$ zLz&kxm-aQ5`4Zr#Gp`3em-!XItC+65;MX%>3;ZX{*8zWo`A+7%4Cg$qx9l8XV5`3-;>@{%joaX zE|=LyoR4-nciM66OmI0j7K6`lITx0}&vm(Y5f{u?JmRgE#ra}aUrH&?FLSw?M8oU* zE|=)Wg?G4IN-56ocext0;Wbo!@8f*5HqzhAIJL?@dY!5M6PNFMI4kp*SEZ4b<2+3cs@KKpzdyH*b8QH}CxkyA!gqx5 zH$wQQAv{@iq!efIm9ydWWuB^zqgVEybW8>V-@H)A?Qq4#hCV|7{ZiWRDCq_o2%V-x&wF0wV@Q?$=v14j;(wv zcG-K4>hRdgxy@U1c9FjOXO$`%$61;4-qxHJns%+qd2d;3;*vqJH90M@m0Mk%y*Vwb z)W6y9o%qBhf7_blUS-tB?QM(|HO7`VUV3(H*;6fB$kfC1XO-KB?0q~|^h|7J&!Mrc zlZPf#)p;!Hq@=`FJ{?=RzU9lkdmpC6AEMdMge{b{*sA4(r>uN@WTTt1vYKM1bW(qH z#3k)WjPxE$@DgkF5~F0i#0cAo#foxvQ+{UI`H2-x+Z~n>XRnA?cJ6L9Eo^h+p2;0WnUuIFamBw^i`>tI# zbz6(NEv}9BmhO3Fl^tQ*D_wT+6m|KvGf`-FSze-684|V=?L--7d$z4IBphJ7gJl@= zj9X<$*ft(7!+6BP+g@BpwZC?T6#C6v&oiqW3EQ6S%W|CKC2Ex;VLQ=Ilw*Ns+bT!G z0k%6>j-{S)s~id2#@kztoycI7=Yy3&!nO~t?G9$J&NFUhkg#ps?2=XG%M0p6+8VHD z*ZW87oci!IP8vW%bvu$Fz4(YXdxcKMtY|~@2rrCLDW00P`)^uL?_Bm?OgB@q@6S1P_V{7`)j6MDrH84+819M8^Z%9HT^t1FKR-`+6 zRY19zIo-hr&!%QKnE9jF#a87spd;G0E|{+{4~4SH%qN@Qgy!|ksjcYQUD@o-rqdj~ z%>hTqhbw zlbHz)SW|%24wl0X(^)pV1I_9>X^fZ{_%%JJ#2){%YA}`a~-6EOMW_ZRPSN#nl-W71=8H%d*yl-m9NhOF42rmD93!TTD;zz5`WpTFc&N z+L+l@DcfcV>Uy!9aNHGTGDV%l=`?f|{HkQ^y0^a0ONJ8g&Y=j~$w&=s>okX|gK;ug z@7cD7NWuZOsUEgv-0q~;ukeg($8}X)PS`e1@sShSfZ()sHoMkKLuY`?fN)3}p=Dqt z17)zmOU5b#!gey9D1!#iwp9j%18jG&3^sYjtui1SU|e;_ZIv%np3RYUuZ%xh$3pQc){Tda0xw%R=_R|l?hJF|~^&w2Kv-e)Pr96D#$Qv;)i zd*$=Jduf`gWXoGrx1>^{%+%0(;}uFXWRVPQ%*qZeuh^<+p z;apnciAhJsT_%~|q_iYM>V1v=e%9kg()v_p9i^zB)g7IM0J{%%yqM?viPQwQ^G2XyWC8XWnx zHK5a1J+zZb+%Z-2RxVGbqjVzfvZrcTE|SX56_0D_POYuql<%&VQ8!~st{TH~{oZGJ zir>16z&ag5RhQc4K>r~w3OJ-i<(>{n^&jFQI7H<^T70uULcay%BiD5%Wx0Ouvpmh8 zf{VgacvByt-=re}b@F|VPRZ?eshiT@b!$%dr|Ke~nUv+!(~!9={~<1dLwGrSeUnl@ z@rmBoobait1zVTzQeWLVxN2_mGf%GNHTMG59mH1NLJLRI(Ybdkxy##>XoET|Sh7h= zTn*I`KJ!uUbGNA@-19&xbdn?I4pSl$s6)rzLfstlH${SDKB9;#+%EZ{uFGQ?B*C=J)DraJ%t)9d?z= zUO>}P-scNwY}UVk=C&2Tv!Nwtt%h-keXC(=qSwKavsS^_EUbc2-{rOuC_O5pre)9_<=E<7C!b$s!zJJa920)bVYeZTl1|*mehpX_|5ROUzwQv>lgelN)&`Jlz!; zGM{m18jG&T+%(`mg9s2jCaiO zEYG&(IN<=>9dta~Gj2IfIKa5wxKnz%ja#ilhps_i@Y&wIeDzH44O9ysn^hBbJB3y5 zGDm#vBU|N9?Kj*JTe);sOkJCc6*;uFdL}GPu9~JK-NKev8`arMKvzf@GQ=t971pmv z1QuDhd5Kt2BOI8BYJuLB`{gum=ydj)yp*lVKsYevSZA`g!%M`<9^t@5tnAT@MgcdQ z_RbC50B@W$J+U(_32bBJ* znkl&}c~(}}B+^wK-Kkpw)m+-+6igpl zJg2M}5VoDN(&}^!TD|0~7!bCTqZm-t_;QH#1}zrh7V*mi2)#30#A&WZtHJ2{#u zTS@A&=Y^iHU;k4)N360ZY&&8((dn`u=p|?6o3NeSzq9O9J*TV~5VoD#H!(=_lCxq! zxQ*o8a@T!=YWw@F{L?*Wth^I$!Uhg?$<(;tY%)ZI{3NJY;?}Y8- zzUlhD)^o(lH(}e6eUtAEUUF8x3ERni)A?@j9I^6E*mh*!fzzBhZ0 zSotPwJF;)`y~Rt;$~R#6*>l9oH(}e6eN*PUyyUEW6K*59Z>Y>$ zJZG%D6K=zqPM3MBmzTEu$`Qgy?S4x+q~MLZZ1>p<8zyA&oL_wgl)$xCpz5^#JuFJ zI1sjzlYYRA!@pw=l!0N$EQ5zoRZxc@A3fAZ$ChZ|Xvwmz)(3!gg|I+mLuzF6`qzqTX}NiUVQW zG0TZg*NYWia#kD&w~^d8G*4RVIb-FWa2w8aI`132zQUAAiQ(z3EfxQ(~>3p>#F}NbR#Y@b}7U7`8_+qQ7 zt=?|qRkL@k>bvX-b(NKFSEv7a(~ptSH9ep4HX_6A5xmt{H@&YBv{o-4R?r9s<%92R zrC{I#f`Up2g66=s2})93H6{#+b^Hdgj%*<6@LtAtZy@^G<$)W8sCKCk1#A>@XNO!K z^gx*Qlm|RGCKbwq6C?b!%cCP3hdNvy?cX?LM2Q-oeppkBSy$tCi_%Vixb^*OmnUvR z;wm4o4axAdvz<~llqV-f_-mJE%(JaK3f?S9IKX!BeyaF>Ub11_8I$W7*S#qlCk)1o zD5>GE9sM?J+L+^|q_e?Qo^W_dfe+U*>yX^(3GJ)EOH5~r6C(_Xb-ceT^=w<^K{&v6 z2g{?%Gj5d!VcWQBF~)T`-5VM0Oo`?8YdN149eHq?YIOYIw6ERP>O8NlvL$SLZKkB3 z5CBim2`XFrApvsVl3B2U_bsVf+JQR|R+x)(x)lUGm#4$`)bN9O%)<2DS7f)Wb_B$3 zS+n^mJ!a^0@FpW84c(^Nk&NA@R8Va8GP2_Azsab>apq_1 zSaHU?jEuTR_iD6zCXljPo*Ut=$Wd7t$9uh(ajVCI-Ll70JvJeyIkraq=ZAc%jl3;t zYOO{;HLIJuBfg7wv-16G?cmMzE;E?HT~65F`B5hHB%@E zKI&p=L-JQVETO82mu0<|qLnSeZKv4zvRvUMX=Rddn@O5wnbXkef?Vq* zZ{?V9aPplg$PHd1RvrllCSvBzeYiuXv)ACIY-NvdV9K59b2fR2SlJ^Sn243V0@Vx^ zaIB3nH0eH4-}zd6I)wzTHQ&0QBG^{^N?CYZ`e^*{O1bp?IU(5 z)wH!WCMpJ2uPQ<|Sg48{yzY)O_5`ve$KVYVy_OrEX=BaB%9K zs+wLRRu*>zCZf9CZG5X%a0lPkb1R#@lyr9JuWD(8{n?R}+Unq~#Gr%UY)a!&B;P=_GrJS*1hRpBR;n z*{*n|;Z{U_(KS9COLwC6%^U1wwU37H{=ZRG&rw(Lt>ILTRpI-JUIJz=DPC@@nm{-> zH=U^o1HDA7nn2i}$k(a~sa{G}O&}beQfF&InwOYW6A1eg>r^{U_foJ*hj4HTohh9x zFA=MB2>TQHTBVcirDT;3;qa6?TRJf>F{^Y4`xEC9BM z)ibVR#l{H-$Ew5qj1zoSfpBmNovF#mULsaaCJc#me5#t_*|y?OIKXxXr>X-z<5v6$ z2N>_fRF&%;Z46asO*t)FbN1*m&QbTUd-I}pTt~2nkJ;9WKLth&M7ZK_EE(%UZAUWp zj7XloZ#Lu{yaG^^vxm<9{FjOLgq;1gYwe$`Qen1bmhv4x?~~{3n^iE!zvl0rs`{bHg!r&i8Stt~A{Ev&9CyfAfGO=@XjP3q#p@4 zX?iX!s;UZbVe%x$vH#~!pD}Zq>(b;&?fLxmj#tS$o%x@YNHwzk$I?_`O5RzyIqDdB zpP4gD5yz4DtS(gX9H(1Ezo)nRUHjr5%zwUi`TdvFANmPl^Z!is#r&T;bH-!}N!Yu2 zEPW2s>nsne!)Q<1fYe3&u4@G4M8E!L$~TsiH$i1NkKc1+Q``W^JC z0ki&f_A}NGv4i}pzK7MnF#gr{?EY5jtGr9Sm3QItu4}L3{IAqs>Fecv@+^vkiXp!X zmv_bUr%XRnbiB_Krsl>7%KMCIIj7Ngd6)Jf?{nrjj{AS=3^&0!oqU%zfyZ~6i(fNm zP*Zj0guH)MJw& zp=Ll8h2^P5m6g@SWfcn6r~{8y|I_IIh(h}4wC5PnoitDTfPnn*VGjqbEJcqwe zpD-wtiQkuKoxEf+^qyGJ7DIgvwD{ub9p2di&o{H-e5 zyLTi~UR7P;^mfIi(Owf0A~j_TDhkutK;uP;(caOB>s7wfjY99fk`e|g>Kv+$i^E7# z!r{?KaglQ@;vvyUU3q1ZGY$nuDM58*t#cX*jw3_)6_wQso!KCZD2FPlRnw?}vYNlLxex!%T3VpmGD zWPVL;^`at3cCZSb5;=F-$0S9RprU3`6=onQq5@k{Q(IVFn;$4185fs)&wunWN?cM= z9CR%CnHW*0z_o=nR%{{z6C;J`ByjFWHxE}LSMnH2h9ySkxsvTDIW{p;Rax%JUP0N& z#K;0y@-|Awv2W?l$0*89q`I2!d;x-lWLHp>?sQdMhEYMB#DgTO`Gxb!D#~ihDy=N{ zqAYWs``E`O9iXfh>P#O2qTWh0Pv?3Rh*FfOsL0LQ=^*N(M8(Cfr~pKLm8hh|6)gr) zKP8$!-xaL}(Sb^|K!@>85cO1|GCJtOD(6v<^-wXXU>UZk9tW|kM72YoFf}gB^h=M4 zOGo;pqm;C!tYSfViC;Ee$%-o%%?ptAB!^sY13YpP4^erkDN;R6VYyYX2?wZH*AzM1 zAnyr%U7lZ7vDkSYWrJ0zs$+H{KTH*ANrjTUgOZ`D016k?DAB)Aq-wu%Al>PCm{lc{ z5-IxSmGhhdw!leDRg$Wbs@i##s^J>dI4L1LF|v4Gx!XecV3G zVJ9R-6wg$0zieVsM9oMRmQ|pL28S+@#f8;&Tn2X01BP>~9h9W#VO=7s5S%f{hjdXB zm#R`{0t$}m5~*CMe42`a<5ary%8Q-vfFP+`mq<}%O>J%AJZB!t`gBo4LWL_^h_XTY zxJ){*4u#4;I?xp^17R0swXTj1y9Ol(b%|VfAxUmT$)Q~$7hOb>jUY)lvP-1Qjm6JV zqOx43V(t7I1*#0(KCjT%Xc7h}5k(w3=Y)fmz@3`=cYGPs+cZM#C ze44Rr1K$!=anRsV=t^HeX+O6c;g59)cKmJ|nw4pE}{m5Zv&N_=IX)N_~;mXrs$ z(eqd(p^6k>F_T0^RRNMLB`KO$SmPhvd!9lE)fV~-qZj3>BrxW^253>`qJYDwq+ACx zd_~ghNF}2I)Gs-Xjw&ju^v9yt$gYv|su%jtFM6q5omW+^PFJ8#IEnq0@AE4P7s6=R zM-_+inFP*WyA~()IaGO2p=BwD+v9Z~RUE2{xyK!Wvg5l(sFu0HOcbi>M8S21lTk>a zr}(^9(ik5Qf$ zRTtJ4l@^y(J3j+)Kjn>EJZ^fAfwb>vC8av)N}orm%BPCne09d{yalp;gH%oy*0{%g zin1d(7j7NwnrfFxKh+Q@k5mT-+cGEdVC8O6O(7*|cS!?P4N!vo>Uo6~=R3#R$0ZFs zTuW<8N{XG6QJAKMrK-79R$u7kqI{H=yOv8pI4C(T%y2G1XR8*hZL#^-_(=D2ux-$O&ahMX6#ft-)anfOfS?rdFPf8s>9V`XnQ&3rV72Fa* z>ESB#p48t}9Zq8uS=VLaJDPeqPaJT#YEGVYUk8MO zbcTCLVM2!CNkfAxECk_^2dMsBkCm>x2IZ=zsNvF;tw7lj-8s3!8&Rlw5jAAGvY(-h zx=QZ5AF*XlVx)I+gpRVim&kx*w_{f4^}n@`NQw+gj#O4CCu^OzZIP4MMH^Gg=?kr? zUSj`bH3qn&m3>H3;^5@S1+L_vAy#WkN+MfT)v98t(>ninpQH}dQnhBUW*#H(@FSBW zWfwT(Y)mV52{c%#g;-cTiwsOq3o*_l`v7&0m7o@3oLt0*DeXlI7CLiL@GUY^?3{=E zC}l_S3y>eH^wm`73gjb{zT(#*AF1?9%Evgjq9Dr^jC6hmg2dwzA|-WImHsJbVkS%c zQ_BPuCbb}fEiEabpW;OU{2;}ttQJ%|Tfl*Y!&S)jiTjf%I#P+~-1!eEP+=)k%St8A z8z{*jNlCf$cNC1#hg4Vky*`PODc3%H0>?#@T_Jhle9NwbQHp|UR+OtAC{sD6S*kWV z0HsH0DOnwgvZIx(u(n36X81gfQtn)tzsg6)xw4Y-fa4M=6Y9cMdA|R+#1yt!6?EVr zPZ)6I5GAY$n20B;+Dw^8|DD7X6|#Ai#TQ!bzn5xTB~>*}CPbpwA?|g7g@w*3C{Zb^ zRoI1vWo6D(lpT{0sjf+P&O$ysL0wTObLJyg)m-r^rv?RMwIJPDiV{^})PU(+1^j>m z*sXNuIuxlAP#!CPe~6L;mA}>L&Yj3r=oS7sVilC?^b+S05X+a6~2TC&1`2r=Xb5RADPetBcT^uu}MM(!_tMo~55D0p!h|ocm z)nyBup|;RT9H=Uax`t7rChAsQ8KCM4tyzFW%f5) zQyH?wodAX>{k?P(k|V)i9F;;`Vtt9@piha(5&Gw)pe6{2x+F)`zkN^HqTh6YfF_~I zkpn$9gFdOl;yF|y!0(922HG{s(I~;M{MgCE+OVq~yE-XZZE6%Zo6@}ew{fJd%eF$d z$Z*xfhtHUuM>`+XWp)OtN!TEF@AyRQ;l5C zoHh$IC|zSu_?3iX3RXxhW-PIWY|iyIcY)w z0yR1k98=EQ$B|C{%$#XcrcaqRhGXXdEQQE-$Q0NM#L9dNzj9l_DAkrrDpW4cNy&xv%6 zbW@W};|QHt_pXs6Z2leB3B}_bL;RC&S*nMOcQb8%p_c0%6aS(*@eX{Ej=<{$>^=d% z8EPH*Xm&GV(sR9?*$q>RN1@}N+KP1tf~d1%1zwe0+yH)wXT=&ygTCnU>F*>=bockr z94mi*HJxJPD-xa8)7-05XzkURuIe0JqH^ar(Z!pVMyDx4SHhSyENyeE&RHYu*&uJ# zS%6r!>MTNmY}HwY0%NPrbs*d4TXk-O1oT#&%}8ad&f_T1TXmkdal5wa{MA0@KXt3l zhv=raRp)b*cw2Rn)9tDeF}CU)h%#@h&JdKux9W^Qk!;l&2ZH!kok_N&LtAyG*~gk& zb>@P|*s7z>TddO~W2?@UATqY<+zcXPtIjV$WNg*h1|nmt&YwYKZq@k=WdBQBbrRJq z$2@yAx9S{#GTy2)5V^NiXBbN2TXjaGNVe+4K;UiFnQ065Z`GkO&Md3M|J$uP=VJNn z->OsSEU<&(ZPlqpE?ae$qCmFltU!Tm)%gJk%&j`NqRiN;^AnVrTXpV3p}AG(F%ZVL z>O6}QZ>!ErDDk%HG=n6*Rp(ul$X1EM13=sBYfX%O`o_E!0;qKli$B~#wVlu*Ur3JYgEh7j|rE% zCw8>yxV9v}qNJ`?T|%e(lI&Nc$K^xZRReYZMRaj#m*|7WjTu$Z8}#WNZRMkr(dgn` zOQYB86TCQUUK(9*p9bz&8eM0f1~x5?{y-6RkXYKbH2Qr-=<2$l#-#zbdR*A%`Qx9} zP2}bn&*zUHAeQsTFHj)ok3H0?nq|m1e;fp|eSZFU6eOU}AG46k`6DfWS-$G?$FptR zuJgz9?PLB^&mS*DH@)-6Whn8^AJ?M9IDfnaW#0MYPf-#-e|!){a{l-@2;%3D&)Jd= zoj<;0A8VdJz6B!V{IL~8#`)s`Gwf<(oIef)k#YWb0*H+B$6OE@=Z|F|GS43`2igD9 z`QvKHyLtY2J<9m}u>rYv{&){c;^&XQMv_30}4?BN+6U%4+`D3B; zfgKd@{P8p7a{icz=Z_gEGtVE#qtHBmJPm~L^T(Me z@y;LTqQpCYECosY{ILcla{hQ33jTx6A6J8K_N^W_pwu{jyd7oc`Qtq(G|wNm*uwp{ zdhEZ|BP!=nk)&S#CAWG!Y1d-wR*x4^X58xW7Rt<9Jw8RDd8sRuBIU@Bgk_J>IYj)VkH6j}s!^~Sf`k~Og)ngb4@m7zqC^v5Pn2IvNDwdYokC+$OwTRr{+k`CVL@i88*Z}s@X#$SD_M_08i%`9ua)uTURxz*zc z6!5Jc!;$l?9w#E_TRmdPN9bEUXd9sAkKF1p4+V0oMUV5cc4UW^|%)W?Y!0FAvn&s)#E7?(Uxwti=A%u_&v(3TRmPysd1~vE|mSx-smxCuGm>Twrx?^cidP~zR{@iv_1I+#zxJ&jpV;=k`c{tw^uS2Wb9lWcWYBww2 zLgAtP_i%(>-<3Vu#x{hn)NP-FY~40DSMR@vWB)xI)x+uL65rhz|6})X{7{`H7hs)Z@@2rh3-mo;fQ+-zthS2+o)-H|yNqw)A z?<s z>|_2@w=YdZH@)pkQ&Hk=UpfmV#`dN8DD$>2)u1H4eW@NrvVG}l5X84Ht+OQ^+P-wF zeXO~C>0S^S+m{{(k+FU0k03I(FZ}~V#`dLXtz8R^?Ms6|WNcr`1d+LY=?swlFKu6% z4S6@WFXf|*w=b0;_qH!BMoE18(v>KZ?MpX;z}vobhb`E@ed#}J`_esFKKr*X6*^n& zpm^Jto2OPF9Wr5hB$THBW%MwzjF={b~{+n08t(A>WCJ_vF9 zl2d0lpd*d#O9!IN+`e=q3XSbcStv8MFHNy!?byC_wta-TeW}J4wP*X%YWoml`_e{` zba4C9BY3#pzVx(>zk2&plYM|ZsrEI*vVH0ADB$f&|3uE)ml7|uOFY8cm--;*?MsIt zm+ec(qCmDUWr5(|zI`bN95A*o<)TQoFMSsU-u9((l*sm_3sBI`?Ms)#amMzgH7GK+ zFKs}XwSDOhlp5QYeu1+8+3ib@K_ueam$swC*uL}%%6R+I+sJwQ(#ObU`;w!6H_+U{ z(#zYv)EyC8HeU3!-CU#eUBN6&Cd_-AAQTZaZw`r04E6c`DQmdb~ zc5eUSvki$q8Yw@FEBILM5^qRQQ*rfQ zzaj~}qbZSuuF<4OLQ+)y>gf1{Ug|9^;l5}z65+qw+|T;&>xslSccH(%mFBp#giF-t zo6{0DB&+w>_=Jl|RI2`rPbi^}H(~bO@5|&^EIVs-LO;sU8xcCz z{aagGn=n|pns9|{PycOo<@)m;_p>JEU(Lg${$ovje_AWt)YrOywWj{8xh8K?Uegkq z-SEEW{(ZC?Wu&(XTd9g$?`ZEx!ge>q&$xf>eAX_xJ0V^1gjJMGZSBrI2`TDpTEbr_ zI#Uw<>gIG)S2F4TWl1b8JuTr@H}DDC?(?qoKe#B%s4%MjQxoVDIXJmrk7)9+R(^aqW`px@WdyxK^n5f=+c1gK1AyHX$mUT&-rzG8?s`jX_-MXl} zx-UF_Pm1Qo@dqffY*6Cgl;o?AfBIP8@oxHE6YoepA+=J)`Q4(y)%muTv>H^xH3%$3rJhJ!7a+URYS0PnL$K z56>_?$Qb1#V|-+^kBs$^EFT$%Bs1MdGJGV{M@IUH&*w~^hnc=yWcqy0^!c3W^LeDt z=aD|2NBVpo>GOG{&*zaopGW$99_jOWq|fJ(KA%VVd>-ZVd6duRQ9hqX`FtMb^Ldod z=TSbNNBMjn<@0&8&*#xTpGW(A9_{maw9n_!KA%TxpQRD{Q}*Rxv@ZvveK{E8vopq* zgE77wjPd1Qj4uacd^s57i~1O!&ttUDRV7um^m|YFj{3bw>IEG4$II1zc1P`W_xCdy z(yzrg^XHo###nMM(<0=IO~_%Jkb5>E_iRETwMZ6))Fu>Cn@~t?LLs$@&*vpyiLfJM@8;Klbk6 z2U@<^XS$=GrIqQ9et>+j&vZvW(DKDT(;fXl%NP4hck}}-U+gp8(a+X$M?XNm*k`(< zA87evpXr_rf|ibbO%a{$mgoB?jH8|5^VF?hd^T*%8i&rAqgv!BbA-&yr0@WuSOB6l z0a4)sqVNEs!nKh*90H>70HVSLMBxGC_ud^2LCc>ZcQ^zszxVENXluE{At1l^?r;cN ze(&Ak5VZV(c85dI^2gpC4nfNwdv`drwcOzlkU#eBa0pud*t^3aX!&FB4u_!SkG*?7 zXKT5`As~P3-BUWy^2gpisRJ#4?A_Bk(DKLLJ+T8Vf9&1i(AIK?LqPu6yTc)9`C~uU z@4Y)5!hwG8-Qf_l{NB66p{?Z(hk*RvyTc)9`Mr0CL(uZq9CtVbEq~2%heKP-9S#Bc zYmPe{f|jr5q?_HRwQ^^5)0Uah<}qW;FJsLwS>~5<=9dgRRV&#H>&!aC@?wl-Wvpdo ztYu}aWo4{oB_qSiO-6>5pNtGEM;RGbo-#75TxDcf9%W=&E@fm|K4sdLGi}S6w&hIQ za;9xL6D((1+0D!x=~S1@S4+~1iquIZ{R~NA4Zr6X&MT`Zt1YX{cgiY?%Zf^rpsZqX zc}a!4aH9@WYrnj1T~t#zzpR`z)Tc%2DD|nTu$q}tqTl$=cl2-Cdp}q{yrQzUWcX>* zXCGfvs}_XS3UtZ5MGMq32j*AG=kl_O68T&>Z(eoDV)>?jr*n8oDgR=paj;stUZ9r1 zOUes}yNm1kqiNigX`oXu02_9RXPqzAsEe|W6H}LE_Rs|$^*WTV0}ww|@w@+~FZP^h z@F|A=Y=fKnrOef(DMwvl@?H!1lki>qUES*KzA)YU4Su?j?qdcw(|w7#*stgBuL6IM zzc=$craMGu+l`NzZWeQ~&xboF0dHZ!B_Vd!gMK~h-voR&^FM{ydB@;p9HNvV^`Z-4 z#9P#+QhLcnYs~K0WNPs#5qz|+{zH$v>Z6~c$nwO#eX_>3^PnXl0ydHM}4Q}T5ixA$2Hw%cLQcnf|pUiPSggM38v_B+- z&oj8`XC2s=_$&pU%jrHEV&^5$7yn-celFWNxT{VH>&ejuH}f?jgrCM->WTCxXEB#} zO1{1eyp;X9&9HCA=K;`{eEkY|IosJ2VyBDRn?f%vuR+Yw&%=OMvHhVTb_xt``hT9m z&3M*>{d(6s$5{@%meXAoVrQ$t&2(P_J8a(h3-CI&e`q(Yf%Rb&bBT}mIS%*|wo@Bo z=W>Iaak!be)Sp&8J=}XI@Mh+BhuC?Tx%esheGGU#`}uT;oi7Y-#xt1=tCz3-Fqd@e zT`k8s4EPnC?ywL$=NjBhw;JrQdFKM)E7<-oL+m^Q`r_yBfUjmd-Kap+3+qEagPY|z zD1;xwoRZu%#m{=zOUJnt_&WA;V~Cxf zhVVBHZu`8IR(|4iUFvz_Zg?A&Z{Gj8{W@cTmecIK1~ zvLo&Hr4at9Vdo5`FXxGU)DA*=QNDO6bH5K`PI1WLJdt3Op-=U#fo0hSry)Z9?u`4Y zHSA0^(!I#wW*qJ}?3nfWVc?rM-Mxk#v)m7%9f#_L<#hz`yV=fs=2-4aKwn#RoXdc3 zW;;)W*m(u?>)Fuj!0%%_hxgVB=+8Ljk}vV+WZ+xa&ax0Y4WKXn+zI>*v{S%I|KUYBPCzr&%waAvz>F9 zW4=laPE!MEcQ-P}_IrB>e-L;huLB(2SNlonPE)>!{c#4TIrVW`%{kNHX1lw9x#YKr z^L3q}Z`%Kn!A<)KYHKpR$e-zkKYa~u>Sr;Rblrp1pOb*U$o^bn*fHDt4WM7ohHeJF zlkL0~V&@;ssaz&0-Mn+Oq0hk%n|Itz)#{7*|0dh-$(xMP&J^ZYPtFR_FJ&(F>p9_t zz~AF^FATBs0CPHQ1MRy&oC+rawP5xM{x;>`1$AGW5-M+H7#MojSbGEcqSE`8|j^ z#%CnxAIJKqhv;8z@L8%HdAj1PGkBg+z8ej0>fdYd*@ph_3_jD~Zv*FQ?|cMY`p@nI z+<-lKLezn2PbiZ$KO7}h1zZH1mgW8{;0^iB{4*=iI{859O={{|6 zO1CH5f1A0~=j;TX?z_O#c>VOaL0V2~=D0J7x!7rBJ2BwLv7MD6c5VZG@n<9Obhh(W zh@Cy4FaAUZYyZX1QEX=-bIjKq&=-H^0?%SQw}#lcAN0kahk=i0JD-Qx>7#B6rA@Ei(VrpAC12vtQNRn>&b$yi7crN3Ht=%orr z`9t8PZ2#pD`~Lua@$)0#Rc}UU_?Z3oX+V3&UDPJ@%75y>5WgayV zxXg=AH~6;=J2MSV_GSL|UEtiUIp+bF`Bk;SP5T!aob30!NayoP;PiwhdVL@GA|n2rMZ71?q#4a{!{=@PSolBJjBk^pfB-x4tP(t(=#nN&POn( z@}+X*nwphr`;Ua!-vRpK=WD=I+0GHi1p7If zx%e650dj_+Z?3D98QfeyS!Qrk{}zLr`j0X1uG}IQB@RykPh@1c^R^R+F!p7|u$5kI#9PiOmmcp(VeX(n^@b1d*tY^OfN&OOY<&nEVB zE7%b~w*${&`v)E$9M3V#(a#fsk7qkqgxI;0x%jz@{d^4Uh@VdZ&u06*h6npOoH_bA z68L1cvn0gMPne6JjZ*GlNBrCdJjV9>j0pBKlR5f17Wh=QQy*gIPUhn04v8n&5kH>- zo-6T85B5_%9K(H~pCf_iNjyXB+`?S^Y+*ki1UusABf#gd{iKXwKaXUNejW?_T((mi zVrM;b@pBvd`E#%%e%=SXfbD+~V*jwr;COxucrn{4XO8{G8s_4sT*to)?1-Ot121L! zpM=;SFf!QBgMpW`onq$bXO+Rrl}QWgNT%?2G@KfLC$49~$<}@wzWBm}7l7 z2zV{qDPWHNmmA#le>rpUe+926-v;)@|Bb-wINg63_D%l}7#$q{e!!QoopYI^|4W&R zpAGEi4PZz7ycu{s+kY#>ewQ)9e)a%<1>4DEj(#p;E`Dx#K-;|*?1-Q1fUjWtuQ5ma zUxI!E&)=eBZU0xZovF;x&O+wm=h_GK@mGNz@pCoswQT>T5c{8kzWDh$@O5lwa+XdX z{rnzt@pBXVxr({83-NO;@C|JLl@R-%fxh^;7x>L=CpIqF&xOpz&qj$SbM$jH@CJ!z zi2YAdpUeGo;2R~LCj|Rh!d(2^zqLetrP_KDLuJKG@H>%*D@b?B@l{(a$Box3K-+gxG%@ z^u^D2fj`1_Mx7MwXCZU(GmWpyT+AH(tOwpG@eHy5chDCF-+A@<(}eev^M z;4iYBQQ5(MmM|AT(_ zslk5s1D@PP>z&IS{k#bD#h*)o(}P;+wJpTXJD@M+`#$jgY-j9g+8+9o#~kb1S-=Of zoganRc^ve`pQnMRvYi8B!Tub>T*`3{Uk8~8T*k+aVgEZ3<9v`g=Jy)lY3%3A zh8?pX_!RUdzn=q7XFHRo1n2iG=IGCNfoHLu+d}L-0Q%z3uYhN>ojoCT2A!_`M1Kwg z9%DQ6nPa`W67ke`s+&j!AUC)2ub)4>)slooA$z1G+|K|X&XFGR<*m(%_ z#h*ukuV6cSL+lKgru{^J4hFuK?VQUT>&bgS~pfB-x7x>L=XXNzY zIMWX@&`a_q{!9nnz;><;vGZfp=X(1y;2YV_dm(mO4Q^h?95_S!iS=;2!Kog~eY>-n zW4_J?zKQ+0ojI1*6QD0~-U|F~w$m+F`-yfAXO8|11-_Z>(mL+;;%q!gdCKJ2+n_FqeFZKc@hHgza1wV&?|X7k_RB-pF?T7-Hvr&=-F`2L2S= z89p;OU#Bsbe2G6(fp23wSBKd7G3bjwKLfs%u(eo*B6E`$2c4Xd>8w3K66a>D$tjFtp?u0cA7%$ z{FOPD*N0$7>eZ*fTiJfncjEaq%Y7nq^nZ4Uelc^2kL0Ticw(|nuP(&S{me1lZ6W%9 zFgTT0gEsHH%Ut}CIJ5vyVSh%=(FbC>xy;3mhkt&0PH4#p|9wHuTN?7>x!u_hY@ zXX|{4{}P95fTy$nFEhvT`V{n~ygmn>#dap06CBSO27gYe$o0n}<`N(2A1V!fx{pcp z*BIQ4!(9e9Wal zWVZ8eh@Hf_+A;K}8}Jz0nZ_K;w+!^fp9+LjSt~uV*{cm}9*<5A?;K zO5iKl&VwO#{s{U~A9ey?&31+sI_?YoIf=RCOZ=G#d@b9#GQ`g9pfCR11$+bBc{jvP z@;vP)`qK+|1KXL+9P_mZ^u?cxfNx|wPlVWcmATZnX0C4^8JyO0wW{FwoK8{7Foh@H)# zFaF#Qyov365n|`i`F5PepCQ0sWIN|E$9!GRTvjcH8-wxx`cA&E^0C&oIY0yaW2;|NFp`*-rX-+8)|Dl{xxz2JjTNb7hE~ zTR>m@xgGdGw)0wuosU6Z;?oK|mF%X1Zz2C0&Wb@xaG(y5mCZTxf7}e7qLyNWRtq&u05Ch1huy^u^B) zflp>TnH9ltm}qb_4*ATf9Er>NSkFh^%LhSt3;AY%jGq~yJhhSgg z@G0;-PB)=49tYFTM1z~@&S8%EnhU&u?cW+==YG`hs{MEvcsbkoJjBkRs$l;!m`i!d zb;eVfqyJ|Buj6#DHSC*l_!;O+oHqks!gh9t*y;W~?LYd{8+bk2$z_h?!UE72f69Sh z!FKKmvGZ$#oAu#$U`Oin3&2;f{Wn7F462Toml@Ba4Q{4;5_5@<dhd`6DlR?mBW>qobGbl#BFt-WK5TmX9^R z67-vSK6X3sCN}UZ;G6k5`7Z&#kNNusr*TeUPAt?<{u(IT{|kzKNmmqm>c#b4 z^anCO5_l@}Y=fU`_%kP1LlF^$n(09PvibZxRhfVa4E+tflE2w0bI)Q*9JGA=lNm?{|9jC2fA_tCqKy! zS8wMC;L;DsbGAia+E*UvOFvKvT-x1A;D_ky;A{k*%KTB_Lz%wT^6zk^zmv&tMoSU6<5%6rbvmW?l=Dz?QWByy+_?G5ByUq46Ak7pKI^} zjy*+YVF^dg`XE&X*fOD}sb-+1{&JDn&|9lX*^q(&S zm;Uo(;Hlbe=g@w(|3jHi0G`HtE^z5T>kK~6h}*glz8N_mvmH6tw|9_pee1#jp~KyD zxd4tt&h>2~a;|Ur$hp2AHeLwIWobK;{%X6y#2E3W|zchF; zWsYA5a=j*G@)5wLU7P`2+C>p?X%`m*cetLc173f!cIaN#4ZM;0pMe)-YdfC< zcP41wZ?Jxs{5CK@26*;FttZc^7X8NQnxBpOT%W6f*Ym{mYTymbHv(^D{wVNf=C1;G zc%S0Oz_WS(U&_IDe(Uq~_hSrRLYd>&@3kEmW|96G(y})H1Tb_qW>5?5;|IgrYK)9^`PXjLN z|MP*%`oFXru_NpMHyZlpI{&>P{3+nl&%6d))){sKm-YV?9>>TZbNxRpgiio2aVr2W z>;IPmm-YXffy?^;{RTJJ|9>CC-vQpB@QG>B{>5@xW#Me+qC}|6c%H*8eXv zxVg^1A%x!te3N$1*$!OR|KA2K{b7X5jq*k5%KHCc;IjTd61c4YPdB)^{$CQp>wzb; z|2G4d^S&*>d79z;0eC9gdDr0P`hW7VT7mLw@}a;J+0JC(;^#cza^89waPj|E;Cwpc zJZNxp{r`m!{*J+E{ajvqL--&*AthDP7ym~B7eCJcE^(d@Je3o^9C#Y@TY;xDe+YOM z^WPiXT>sw{!ky#wfs`-Omv!Soz#G`1OyII^dvW|9=Qv*8h79xAQCO|HFXG`v1wmW&Qsw;4&^(1DEyx)xc%_|4!ht{{N`K&Gr9R zLwGB2DaZaJ;`t>zQjQtGr5vXNmvWrR=K)kts7=c}?QGy<@^pIrM#j@M=Wl5t{1o6a z519j8=5OBvF7vlFz-9jSW8gA>YXmOyw^s~q&fne-;fbT-`6Yd+pN9gMdNK;Q%-?bi zZqDCIL-=LDC2kGCW&ZXUaGAgD1TOQpPYiC(-+GUZ=hx&%18>l3&LrS6f6E6h^S29u z%lvH}aGAf|16<~BTY<~`ZI{8#`CD{MJYOb13^~u=#v$kNG7mY=-zt&w{OxMwJb$|r zInUo3k@Ng*Cvx5w(F$DVZwHRG^DFbWk-%mC_HE!Yf0O5AQvX14llj|9(3kn!UBG4j z_PD{#`P+^Vz8m-^u5UegKqPm^%-^;Hm-*XUz-9jSrNPbl z+u)Pp`89bKa4E+;;8Kp?11{xw4R9&PO$ImjZ#)*lcL0}u;3MGDj(YNXFx6YKFa5wU z;L^TM0WST(*}$dU)dD|6htatfcq;Rs03XWyDd5sh{|uZ@mz>XmOZy$b>)DcDo+dfz zz@=TE0i3IcQvy7j{j3K*nfcAYW6ZYzpUV7s;JM8I0X&a+mu&q(@->HfD)4iek2AQr zehC8a z=ZZcHc{i)(sKhvv^B=Z5q)@?Kg$aiV^Ys5gpR^Z@-m6?t#XPc(P| z9mKCWA$$>XK4v}g1a0V-$ho|lkaKyxkDSY^*CcI^l5_p!@;Vkdm)B{?xxA{7b9wy$ zxs(fXE|+HvZtmasTL@2@9QWVczi}jRcGH;*T>8%<;L?9y4qW=r+ks2}`8aUtKVJu) zs@-;yb8P>IGCvM@8uJ)%=|77MKF_Fcmxk~kBIjcsM9%f?MdVTK(1*wqHScq(ekZf8 zKS}!g@yNNposOLA+kE6)ke4Ip`gW7SCmM0MFNFUdICs~MJa3jvnENymPK)QuBZNN;T&`2U09>w9zYAQhw?$*|{8GBIf8$`_ z4p-2Tz*Ct|1)j~k1b6}SOM%xjzX`bP-}ohP*}w5DaM{1{HgMU$5t(A=SN3lV1}^(I zMgf=o8`FTx{*6-LvVUVaaM{1n09^KOJOW(yZ@daz_HTR&T=sADJ>AZ)?B5s;T=s9A z4qWzc$a8V2x>7xn^NwYpFZ(wdfXn`khk(oejpu>O{tbCvE~Q&cf8=$B{(yWiaA_A~ zfJ?iW4qV#BeBiQw<5J+Vf8$2rvVY?jz-9l&cHjlsIzMj%cP425CGZC32l50};voAs zjt4ILH*$bypQG*11upwH76F(28`lDt{Tn|4F8eor16=lRybfIUZ+s41_HP_GP5Vpv zHTQ3f2;pY{Pu7P!MZjhM#uDJNf8z$=vfi}?xa{9}8My4yHpf1fwFd0pUdA^c0=vc7!~pO{cQ&3zr|z~#EYRN!)5pai&F7q}F-To>42 zaPzu=JSUL+G5M3AFa6I>;IjVkF>tvq(EBVMM6z#Q7dR?}X9JhGjFOn zF4qO_Gq}0_|GN;r3wVRhj+1b9JYVL%j>CYFKSt-XANN~Sj;?*aE-)PV!&-j|@&r0kjVZ|ay1=E#`MSUlk@Izd z2Z76Vffs?xb%Bq7%XNViUJ#Ic$#sF_fXj6OdCsBe%XNYIpfA@2q+cg}^SZzdhQ7)F zAMj0X)EwtI;IgmdE#T5mN`Eiu%5{N3bG1R?a$O)3xLg;I=OU86d0n8`&^P&|z@`8H zA#gb#d=U6R&TkX&ROWv-xViq{^}AYu{51Kufb;2;GYPo(SqQu*r&|wP{J#aboX&f$h%XNXvfy;G)+kne;fk%ML`1mq# zxh~KGT&@drFLd0OjtdNKUKh9|gx>&M`hi~nmv;0VaOnr$1TO9C zOW@KE3@VD}m;97=Hxl?ETFsdbJe7GV@S)6?0he~#0Q@-Ce;By5-HCu#l|@-CXcfxN5cpCRXp-gmy1d->|7 zzh?lK>jE>7ch~w0k@wJiC30>^cOvhl^`At}*9G1{&esJ#Gq`zO;GhNC9_7pAqmXlX z~3VbN@cY&ud z?|Pp8K-Gi%m;Q5z!RK+^A*SF2cxd57wbA5XcIoG#t=g0Hq z`p@-k7;-Mi3CO$YjHzzb$Hfs~>mA_{_A21LC9QPD<05V27)pb+7T2K@tC2;xQj140lY7Pt1RFxWfip7SQN zPqK}-$liJ8yfbHZXE&31$!h=eBe;Blui!;Y&_Cd1@S%&V%NH2FR3EQ=f&Jj}1*XB}3+O$TcFFC$$rreZ zc=-ZP!Q~6Q0hcfE8C<@=FL3z+n=aSKC0}41Tz_}yy_75Yzjgh2#LE}B4lZBdA-H@2 zoj+?o_XR#=@i|`t*M0F9T=&K1_Ud@89o-k>;PM3~!Q~5_0hce(2A3~zAG~UL9t+^b zl=JuCo#2b$@&$f^%NN)%TOY4{fe~=+A5DOFV!?V0yc>K5ychfqxb}&jfy)X=Wh-1J;clJD8ZvxRN%^| z1Fn91;A%hce;;-vWh{YeZM35FVAQ`1r-Q9Gbj`FL+>^LngIMNxaQdnJ&6nZts6u*` zt=ja=;mVvxbcYn_$Fg25UZt|>WBRPrPCWOo)e7-1CCV4J`aMDY? zo<#m9y>~0wJfZ$kgTDRU^#@(vKkufc{zZen6Z&qZw`Uyn_Fj$k#$WyL{;N!Hw<7ib E0K#y-M*si- diff --git a/source/cluster/wham/src-M/obackup/contact.o b/source/cluster/wham/src-M/obackup/contact.o deleted file mode 100644 index 154457a28998a1c316215697c1877bbb6e5bb421..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 33256 zcmeI5dw5gVmFV}8WFatM^9Uit1(EVFiDQgy9tkwD0f98J!SN$Q(l)Xz%UHpd6-fp| zCc&MA6jwlLhosCmnbvpO^fJA@Dbs0Enwd_VM+?c9q;5-F($Kk{gtX9RdOc(&C3DGe z*V=n+>6~?RNa_65@5}i>=bYbKd+oLM^PIDf0I+F;ujcS zOI#O`)^8>5gFSAVcM&gTe1Q0D#y>;c&-i1+%ZX1^*@!2I*D^jrypHi75pQ7p4Dl_* zwg2xDZ)e;GO##cZoAEislZ;mo$GCATQaf=A@j<5FM0_vf9mEeZo*{mi@rQ{IGk%!( z5yrnp{3zr9NcPx;b2o7Te&MG5-%Z?4T=%cf5g#VLRV5Q&ChmhhZo2(ENxYQtOwf*;ruVTCeh7v5#I^x>?eBxLhxM^NPyqow{N-XM#4>I0J{4jAimD^p!A0w{E zx2?p#&h#_Hk23vF5g#EwmFyoNK1#fl_+JqpV|I=ZA17Wy`cDyu$w6+q99|$knYh;f z5%DsnzY-dZJJ)K+IP5k`?#%-_YLQ&mUS1rQT=$YZ@0DDSc6q)_@=19>M-KrvggxIw zQh%~d|4WkVTFQ%$O0G*i&!3fCmr9=hSaMw(c|IQwr-}2I{DfL*U(R?t@nwu3`<3dj zs~8tOD#0y`XQ+Q~VEoKeO1}wq({*Qu;|>Zj0>^gmg}BdwA8_Eq4m=6%5A)UeJxA?v z4BC^qeB9*3S;hrb-Ff2L*DA;lw~Jh#nuZtZ#caRsbv1BJWqj;s%FZ>6`=}{hM_lKt zTRgDtm%J?#|j zmYh45Xc61oIURJ0HgBFq+nzITi59Wld@kBC72<;zJS7i34%Gv3jTMe-%qgzqe_3l0 zvxizlY|D5o_~3<^1?n(wd?ute)!{(SxQdF5BeoeoS=jNDPL2=eY+EV>aRJ+f9nTwQ zj_=JGw^RpWtMT(CrLtSelHczc3_d$n6pXf=1io(+o8H9U7gXM4qgjpXvQ1ctb9o_|PSCvurs0z+Il6B*cP2<+me z0L&Vvvu&qff;{lbdoTaKKR9|c#;6FU|jWQo|6 zWo}}ZE$(s?J8N#Ia^@|yg1CTrtdjN5T^I`NgR$*OBN@wOWoc!I3uL95*cC)_HfP=v z3E~3gRU{XO0tX?IeT8SceNF?xcrGi;K#JIw)jr3|kGy$y`EemXU0IK7(&_9^(t%1SN5O!4*n(~eY4ndKXeD)rQ{M>Z-IEFO}gG3b+He5O!3hqDD ztOkNdRv{YNQ-?b>e5kAP{rjb|oQPm>pt&d;*f+FiRo-*0D-qL$nma7rz^8xb)|=c2 zDmMm;2^kccS9nkt4GznII74Ddd|G&j!9WngJfh^-l%TVBZSVJFA^IlGqrjM!>d zR+M!7;d}yufqC&5irzjRkWUJ;fwxgqg`y~2K^45oJnK|W z$y^w!oG=*ZQ;4l$NZU>$c-}mliw1J$RVk5q#5VKe=z62A>5MzL-Zp4%n948?3GB{z zJSd$mIdBLgbjg^7WLr*Q6IJ$zS4>s zF5vEP0jpF|UoF%R9V_Zc0hfGbdDjz_!w@wC4umQI6WBq6nX z`gX)p{*J!>gfsw}_Q#``dv5!0=f5=-i)0|roD2QQWC0gKt#>vBAXle-OK4+bJ;*P+ z4~3-PQs)DXL+dtg!so0``&Az73eNIex)1PsqJceIh~_{GXy*5;yo!IYT=^l56!`dW z*UukI`zTaj;pV^wC=*#1=3~wD-Ylczb$y9UB%1N}Mv^yUv6jbcDyj!6A{Fskypt*istCp_|)`vEk^h2B5HicTj z!un8SU{gzI^CmbZTLop9w$Qc$U=UV2R>B^S7r=jPQ8)?XV|_f9QyLs;89XMxtPE{^ z>%{hd`qG^DZcSgW(hK1;mZqcKu~cMhWNCjomP#*;Y)e-!U%qt5&U+%eI{S9)47Y89 zZeTmVt7YBh=D^Z)DjM#NhC2ps?CkID-Fag?k&bu9#MG#&smd-9N@QX^<;_d{8(>gO z!HBl5uQwU*fzf0`d?1$gH%Ag%W9jBtPb3rH9#aFG%YZ9$Ly!@0+`1WVV~%n6)ld#S z$y7X%5uWYCyS;8>zR`m)f$4x9LAKb~g)C0&=x(p4yx1_}nQDQ`?(K(ndlpNujKHDY zo<#_>!ol61g?O&z`*wR~PBDyB6ygwj!G>#lr)QcpagQ|N+TQLdoopET>=T}niI`)Y zq^+K*li-}rnmm&y7{<13+vq&#@l7?1u84H_FTngntaZ70rqsKPbbM!~0AcE5W+%ap!B88H{09?4e#`;-9{<~hEqy@4VQlu{7uEW;sc_RiLQdu zOhS>}!ua&-!P96el8JVA##7=?n0N+wBdbUHb2pPtUk*}ilTvywmqMISdR;K$iienN z#x)R0Z(62%gv;hr6tWF|l}n)`V2s!Xzhjk&qHDq3XgY#fT3f(uXaOJyr#d2uZQ>j%zuv`hdp}X{@c8dSY<+VyKEqku9*4Q<^yl|PA#ii4gG}4poj))~( z3L^#jETzlD8ZKU(H=PkpT)Iq2agK^I*&LHo;Z&?Qo{0CxcR}bGt_XbtJxIt2GK{u9 z&sCrUqY8|vU$crt(R@`K_6cGx2;%wbz}e6|T+E$AVp$(HDGvOYSXYQm0YaAwvPQUc z9t5A0+J~xnI7gv%RVTL8ILhV31(HK|%2~G!P~LgaVWb#~lH2y1J+st{O;dYesu-J2 zWiBh8lPFpY6_AXi?EPdRScYj(4KGhyE7ZFXS{%%TveUlIWlJGpUrNe;!DTC@tWyeq z%Z1Q0acYo4F~`~x7EOimT+NkIKAp>+;VLeKQ3R$;Df<&H!=aMK z?vGn#qR3O?F{0g(c*1hU?s*=gGb(m*e4WP_=;@1!y@@Q7))J zL*YbUs#ko4$qaBP0h0o+WUnz(397h66nP;Hv zs;^U=ngKj&ANX8X1BY@AZ%v6$GY4Gr zpvYxai_de>A`n46ieWB*Vu@#VCS&3WE?I_>SdaJ)7pzc8Qhm1O;`$h7)1!QNfu(c% zq!7LM0T*E@z!-y3{hZ4nV!UKmM&IJn`AUjb-{G<)Ad6(u(XhS8yD>T`vtRGKZ<4ZD zPl0qE3<4gy^@Q!|Jf&naSt#K(Ibng6*MTry;I702tr>&oB`u0dp~yP=I(J$|r76(2 zV#%~H$}GLnJEctCk@iN!R4##>;a;^j5|4{(x$JtEkxEyIa?UGVFs{eNa?YWd15b*z zT(D9Jszd{qK!bs+2XP1EQ>T(!Rid4Xpa#HW@b?}rxeEMERf!DeQ1pNw;1~)eRTUFi z&i%+c#bM4D0Eaqyobz%l^rZME=QtkpB$F$|GhBk>0Z3}Z%UlA33shhjtNb-CtAqSe z@Jl8rffB()eX00X@s3p}ie^JYfte%*cP*B-G7H+u_Ku#;q$Y@MOyLQtK!8^*RbmboLA&UL5ldbq^hO43Mz6+k0n@@f z(km8QlZ&F_k|Lw43kIA{OJv^JMaB;B#QIpq@OsN6xBKp$4+6M0Dv)F`CV>ZHaLsNr zw-jV>9cLHRDnYo@E?NyDc$8)r)L}+Zywu_OOqc{Bxa+rPG@+Cvwf00;lW4hJG?zpx z?4pGrQjZvHUQ~bxhP{Fw%7FV*i5j~_3^)U#0xqs4k=+kpF^INz?tos!{qRi(k$gU4 zlVG*S;#<2jX|c@ORJ=Z@$8@NDCilhCRzOJrt!3yv}be*xDOkwFn zh$2;0ST+foZX6#n@OzO-GmDHwIF^V(I(Twv6VC&iF$^UZ?(KtTxJ&^jh9Z1=fls9% zUQ5R)y;h3kmHcXJ35g=3#A~3$n#7ppm5)(&CPkYyh1Xc9p)L6Y8H@9+XO4^s|gy)3c=E)a%jrb1n ztQEsIWIV2h%^O4O>Kn>ym%v#Ot{ZF&G~=01KB9*8qlw0aH6Zge2T0AQ4p%J^lZ;9j z7%Dfnwc>&VJiI0VW~`uT{aPz%+}u!YB`vM>ED=}DAmn4)ZMY+)LhFFKt! zjjllPDH62zXBkOpz=9-<)ki(+ko@hKe3EF?|?2zT`Geu^Z^~|aXhOFX007y^d z0B2kf6OHOz-ZLi}Gk?Dmmsu@;0v-DbPLvBW9DS(L7e0e5wctt)3z<~a@cW1BR4VyW zxbmaRmGu=Aq6)=Q@DNwt06)ox0xjqAC#tmbI#)rE0UYm*B9R{kWnXanjIfkkr6u(C z00;)Gg3X(tOSKBaXMD~oP`zrB&-hy_|5KR*aODqrp^qk4&4;B@ECRh;8t%d;BeZ0g z-x=8J%%$Z}O}$t$`*zt4(X3-Ja#J=9z#;U(s$k?ZT4jhYOkbJpRLlOl+}+cgi2h zLgwSpBg{9e=7r3sxXiSWd7R743z?_5(7cfOYc8}bWL{)a^Fn3`d^OeVD__X;b9sIt zb2$^~h0FlsY$5Y@CblkQ#+cN)kU7AmriIKblbIJXALBC1LgxSGQqw}_h*kD`FJ%7E zn$EhAd4>zi)l!{aH+z@M%?p{u@HUgV#;gmOAK_BVLS_}0S{E|caj|6~^G~_dw2*lZ zlQ}MA-p3W~3z>h(Rq_j&e`ghaxR7bTqyOVt$b8mXp_YZrA9I;$A@dBEnHMtugA2_I znG@hOH*@#l3z^q&xoIJ@lFQ5snYVJGX(97=E;B7;c35Tj`klItQ;!3zXCFQWusr>c zj~_mK3;@ps@(&aKh#mvrWgULG$R+*y*Jd@zlz&BZq%BAr{w5Pu_7Veje==x3u z-X0Zaj(+|<&p%JoZ_(;EaE&*SKRj7;{pPL2|2l{8I`x9?;P+m7&-1#Qpnj`Ys(xBq zz&k8>TUWv_z`L~*)tlbvp6gn8%vHPOsOv>|@zfYryO8T~x7%&FhTU$D;R=9Yz3VlU zq5l*G~D_4=FmL&?{W zj+g78tqBW6aq%sX2!}XhVsU5&l<0hM-IS&9gDjJ#3$#}Z-`p>zL->)J$!5PoGt8ce znNSVzeT+*G&Oqtp3BH5aY+zfXcDYae8zdfl8G5p}^kJ6=fBxpdNuJx`wdsjiRd71d z3&kL}3fk+P{_PS|`tQQqx48u92X2M@fYq_w_J{cKiCk(SKFAMK2f;_h@T!EUOz-TK z`%G*A9-FJj?YZ}Y>17$Utg9Ec@-I>7`*%?ZFOx(v5dmLN2*WFBnQ&)3vNh3{&cvgl zQc7@DEi77En;Sx{P4(+;3s+0!9VuAR52s`IhP!$*b`l-{W7_NRg0&5|Er2ZW)t6)> zx~;ORa#>!up&q|AAekwfWz{xPYa=x_vfM^i*vLvws%?2y+bmbxa<8`MwTfF_b`vMn zRW`EBMr=M;+kLj>Rc*_w#+Fx&Ew36|>@~L7YizOC*kZ4-`CMc3xyI&mjm_s;o6og2 zpKEPC*V=rpwfS6Y^SRdMbFK1O_Ye7G&C>dpqkGln{;(XKu@ZFHO3*zkLHDc#-Ln#O z&q~leE5RbQ5-d^+sWQ8}%zRQ~KB+aIEH|I5FrTb6pR6*U++;pkX3f=-ZLK9)?M*_z zJr3`9(%X@6L~pR>-#x`)NZ%2+o(<;0_WVi@hlqz9c$7HI+?L;R>t_5co&PQEF<)5g z6Zkbq+@2$@?F`cSamL5#T>e@W9CJHY)69+2GWy^8ah2c(;yPX(*GdO|J8|ugvH~_4 zzd(X7nCzJ2I?D71N&iX4)%5>|75Q)wuDvR+zZCJU0{9<#`GZV2hdb;kHP8 zoqnzGUI#v8;;_1&8#i7cuFDf`abBJ=rawsj+{5@`^5=g!*coN|WJdgi@nNzv3mu1z`?Hj|j%!eA2~o@V5wg?o zVCNy?e17>$W{1p+FEXy@x&Px}{{qw3e!kE6G4k^k8Yg(Xjl{X1_nP$0?Rk(mW`pf{ zgzWD#acs}{b6&VTZL(u-&u56^?soVOKL#eZ|1#M@`=`kMRb&wT$4e01FRmx9{TUw_+CZ!>;^^1YFM2$$DakhqR_P+Ae9 zk?~QobHKsQFw-Y9;&H~$lAT{V*fH?y?XYowyo`^NosGnKTql^m9~EGGg>fHUA55j6 zedTr*6W9I>lbs62OUX{JgPjMNzV>G?;^uMPPh7{P z{rPjot0=DTI@tLs)7SpI&ba;+?^)9d`%^)j`?HMkI`XH-!OjrV*Zv$}yn*bz=wL_B zq3BOgxhy{)qhsV7P5c{ljLniR%_R9YmyM4)ek}6}Q(-+&oU6ci_d;9#M?? zI`4&y)3hsYWt@f!v4wG}K9OQvKLOp(I9-N||H-(1D*7Dbe()8y(~K`rSp1Iha^f?o z-gLYb#48!EA|7JAmUxu$Rm2})d<}8^Yw$YXI^uuN^w$&r0pq$2;ji7}rtLJSQ}{}w zI?%j{xSw%-A9NGry8W~;uAeIRnD{5jHtzI&3g&C(U*`I#0NXR1Q$3yLoZ@_sb2`78 zuK#oS(s>Q%)Dc@ar|aDW=hV<2=A5qE9%tN5{CUo?gTwYOoYVEh`YQza#Oita+xpH*L=zP`*k)ywxe*Y(0V)yqW_51Yzu4&{S!nfWTlDO_+$p78Q0_IG%646zn@}T&G-W1VaCge-^aKfKOZ&mcGAV&Hy!w^oKt)IHRsgc zCQ!YhT00u1_O^g?s(|&JQ+sRYoZ8#{oKri{_eZ&WseGU0`sDX3CXUZN^!A1We~QOMkMt@2J;uLIe2npvJC*)L#xFjo_#B#tb-W7>D87R6%-<;9%=in`j}nZZApRM~ zUnc%l#&v(x_k-G>lccZj2Q@!M{5@vpH1X*)F=_oV;!8|iUt?lqbq@S4#&y5g&bXj{ zae#5%FTTpSpmy>MH zPc!_d%Rn)o@lw)X%{VoCaR=kGNk7SW8SyORe&UZazJT}$ylO$Tl)R7&VS>U-3wxQ=mhQ`9l8$Ime1di;EVaXo&1k#RkKewT4Qe*TuV5q=1Jv+P>DW(i5Lnyy87xuv4X3($>-0K`JTiaCoJrdyHZ1^!ofxIKcGWhkr-Iu+^~yeo6Bm{cwosse$DLwSINjo+IkO z&(87h1ykd(NDgsDl44%w4gan%XDHX{cU*7Qw(H^wQK9t3x2bg7nUI|d{5!>*VaiX@ zrN;Bt>}|UE_lygrU*D(_?)`xDyC^-czn2}-v+9&@p7OfGEL-V`#2aAWym4Rg?)DE(6rv?4?mwL?sgZJejaJNiQDfB9#a8q%wsEMshE iJpHo{>1W-q61JPtV^`$qf9#NcJEb@0kE0Mz|NjBDoBg!_ diff --git a/source/cluster/wham/src-M/obackup/convert.o b/source/cluster/wham/src-M/obackup/convert.o deleted file mode 100644 index 601e80d7eaa2ba891647bd19d7fa205719b537a7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 23008 zcmd^{4|G)JmB7C@GYRKq0OD2;cnQs0$Gr?dL z;$mFV2t`XgXzR*RwoBEmv2`ulV+|^TxW_|vx9Zwm@l?B5+lq?2*;dWo``*28zIWeD znn2Il?df+;=Dqj3_q*TyzVCj2-pkC}6j*t=$1uE#lA#tWgDu7>1AwRu{t3RG?q ziZis~Qy+~9Z07K$$TuAny(vnbX>yM=qZXRncH5R;YI2`_%_rBwi2)^WVvThs=PRXJ zNZ}^peRSPQ$1TK<(sc$M?E->$)DxK%LKoUIOfB|_B)AJ3*JXONSyt@oA^q> zcN4E8&i*_}{A$4u5^o~T{`?#9Ho<>Qyqh@t^9AvQ;Bz4~F|Ig*_*iaopThcK;<#E$ zTv153T4L2eyp1@Q+e*A$@D0SfiE|td67LoKe&T(^+5Th1Zx?(Y@h!x;-CiTUUGVpa z?Q^HrT>u0x%Nr%6DB_;3FvIU$@5(Nb(812_#7Yw>f>YpY0Ja4C%{)SDRF+V#(jKd@B>&f3uaL zAvo|}@U~y$@)8`l{%COE)`P);p2NYxz`;Q^V8%%>Y#jyyZvcKHI1o58Xp(`zu>*nQ zU|0DRC}&sAz`pq-<}wV1@=dFkd;==8aXiDQ@T|u+yvH((O<)_| z<1{=NIKFx0^I&)ceXe)vTbFshpkDu~vl`IrgJ)tpY+acPDrq~v z&t0ED-ybL~83Wf%pwQHzuq8z(Y;l%Lp)hEM($=*FP>t~-Vgw`N91#&-j*I-@f&M0F zNNke#=fPBMg~r&yfxvbM4s7tj!1m3fp1eChhjGl~f4tsvj{l)LyZ7`dpdYcjUXu@w zt8Md+;6Us)Kj`bniuRA>ZJT{!wK)b2=?;y4#O~rIUz<_eyrVXVQ<#TIZ4w=!?3QwL z1mYC7Cp}8DZ1WD+5vMR8wt52R@CH1TtK|P zgDu5@{x&dZMfCMYUwWSQm$1kGW9%o)P-sB62JjEUw66rFk`_NE?*h*OM2m`2Cz zCei;B*p!}F|4(4o>1r$pYlsPm>vTb3Zaj-bP^8{?9)ryo-;?0B6YCAzPTZ#*vPE7v zgXbG?18UvRg+w2j`(dy33AdwZ_x3}|?jpyOjo8^mmP?LulOfVFq2f~qNtW$_W4cD{ z^nfRcNo?~bw>O&fT3eXfb;K!LKe=t5-!9A1QHaMW%c{~uc9qUqaH!ZW&e1D~oyDby z3ppBsRC9Z(bmS3{+&WGuO(32pyt_*4Lo%wrHVIc!$97ffRzy5bE9xzhdcoXr0%M`t z_QerEh@HM@)8=?XO$1EPHtz@+#3{_5+*qiy%W_l&@i=9j@L0IoF3wRk#LnVyU$BFg z09VlS{=nQqUYKeNxqV$%EV0mEJh$cCh5j`?&GB$7+MV!!d2WlpYn?yQ7V(E-vCszp z+_=9j6!)(Wwf98)bK6_|H?>8>ZT@K7-yVs_K{3>6YPWaY6p8tpyLviJ1EA@CERD;E zold&^)>tHzfHG|tdb+z)xKJ0YG0WuR)o_J>YlDHcOSB{Nnk6gig24Gmmx_xgXyH}|0mM^TyJiFJ~BVie&GDvzI^2N=i}1VwY95Pl`IV|sab{X zPS;liR@>)SEvZ*(Sxs$V)tZ{stJc_D=5gtvy>uxX{%wLoSg9A4X-iVI3FH88lB3!KA7n>{Ki7O?1js^Oy8+Fh7nb$;8~x@n3Cr)z)GXS ze?nR*(_82m7-Kigx3+Pm9Sn-rYmF}gY;ttu`B=R>*8 z?Ja7f5M*R~jBr;xkq9-b0Vyl+81ZPQDcd1sU$XL5V8#ce5d6c8rto1Q%mk~wy_oHv zq~vsuv0(#BMx^9Sk8$(OD0x{(Jo7w8)NG5NNeNUriaqwO6hI$zS`CifqBpqbG!S8n zy96^qU`CWnG6y7Bj1Z`dQ>?y@MbaP31Lu?0Am@kDzR$Q3EnNFd~@Z@<72yus(Mxoc}j;bq!2gXdV(Q;ELm1GWP=KC5R}!el2-YQ?pRlg+9m~;fOQ?qdWIsf;iII zk}5BJ-^Z6xvubVNia>pF<+-q4n6Ybk*EeOVDOtYyz><~4Rm^jYZ)A|l1WtG4Ok8(j zc5$-6f^!THn6|DC7oTh?-W=neq^oeHISyBvYpyG&rb~PR06g)`GnY?X@L=`CRg@P! z`)GLQIhW6Qexo10Tfxg`$t0G~`yrn`CGzsQM{-_1e<%gKeEviVc=>!u2=wLiU!+W1 zKHruyefj*A6za?8r$U%qJ{8($M)m(N@&v6s)&ge19q&XE#cK1-$G|IzZfQ26Ft zJ_Ay!EuVE#rZ1n@N};}du5${#_ZDIMIkp0mYmLG`% ztcB&Eq`a`aDFxQT@+&8v(8BV2XP*C?g(b_l8wVjRB|d8@v6mRfysAyHsZX_eHnqZ} z>7U0^f(yoL@aIw2!>3`4`EuaXz(?(dO5WtDzrXF%L*B=x(fz4;uetvhx9#%{W$L%A zrq-Q?^RD*D9fSLPPr!Xywspserac#W3yfPl_jnx5;;nwymm+X7FC zu_*VV+=aRR+=|?Drh2mq;3o7^2tas}ZwYFquK?_UTU1{qp$f=eGaXUJ8I=8E(#e!M zXlqK5%FSI2nefKi$j+^SFTrQeQD;vp1rs^u35+~71ODKd*%-Lln?H3*)^==fNEcfN z`;)&i=)-T^P0h@|!{ftmjc(5Htp$Lon^-GJy64)=}4Qok!Lx*`xM0yj-y!WTO5bdc#qbg~R$5jbz%R}%S0G?_! zMmnO2#+GQPwG-~nqhZWhR9;?ER#L9ktgT;Jv$k%@(iM%B5?m<30tx;~f+`6vlAyfI zMO>bgSGaWMyNJu(a+iDMt{RlPJT7;+T<-F@!sT;?%jXK0&lN78D_lNTxO}c~`CMW7 ztnGXoRd*C`0~@WLT!2O@^sbzb?l}oM<0R;?lc0M};LUGWei`<<`6S4E(89Oy+HG}7XICOpa>c5K3*h!R{MV|aCDPo}+8FIz*Tv`U(as2; zhnkyXk@bAFE*9zlQKYSr&XSoMMe(f9QMprhUDAzAo(ak)1xlKO??Fv#;BE zUgNs|?-0kOcRBn8X_@rVeg+T7caeiLHLmvy{!j=L*VnoNdy-Rm1DYM(p9h709~t@w z!Oid7gN%Qmf@0myr<#4;{~UUTF8$0C9DhN8sgO9D)9qZPalKsp!44*=f1}3re%VBv z{pmAvD|Nfz9A{fKJGws)Xk54dipF(6-`2Qp=M&-_52MyF9XkzoX^^;H-=TPzB{;{) zg&No6q=`7!*RrZqMDRjt|Lfgt+u` zzTm}VKas}%R-xaAPC&X_@G`RVS{gg=3w_IqQoj|Pf5=!$+h$qcAaSl&9~r6@yqf&k zmd4KC5tr@usIbF+J}!8W>_3yn4*nYhlk`6ao*HA4sur^|8TP` zjr~Pw?00KikE`3$*ttvaoyAxirM^d;{j{i3-xs`&+U-N)vVF4P?hF&#=`*jCnkG2^ z@N^Y%X{SZ#lNl8iyovmIIE|g>g+BXpQ1CXglTE+1lm48p@#WymZkm5)6PNK&N}St) z{jU_fo623B#(p4;{eDef@Aq$MT=(<7Gq36kYxLxsd3$Y5pik1Qt+d6`@TuDLsOSo-W_T9PK~bsP2LCYCyoc4DtJG1 zNbokS2&5cz5R$CdY>n&woKKwXn;9X0x#0Xm=Rg`e361M7I`s%~w$JS_Ecg~`hY!-&@zHOF*$(@UUy8xRd^_1$MqIYrl^WOU6(i2^!282* z3Vq%m4hhb2@|fT}pC1yO?Hm@I?Yv8z>&5N%zTi8lz8?xZZ2wci*?txM)>^jDWg5r! zVLL&=*-nGT^>_#qXaBjs+63np5_D>I^l}q|bGiK**UNoc<9Zw(CeHqFd;Y87yQn=+ zqhEQ;_9-RKcDP=Zg6|`j)W6e(n@}nC$OPW9J>>(*KXr=z9vx z;_Y$7^_n91UMhDwap`{@aary)8rS=`NpSApO=;|J5uEp#+k_pC+Z}?l{rd#xar%AY z+`ruZKNNg~+Tkf-hs%9da4vVh;9PFjsaE^Tb~{z$db<@0&h}>u&i2pKxISJkBF^>Y zeqSs&zo=uGW=HpDx!~+io#5T9m-}78x!gwu=W_RJd^I#VuTwuK z&h5bc{*K@Wso&4WHzh%m{k4cV+u`=C7W^>Txh;*IyNJv2^?;aR{=`9xg7~MyFMeyn? zE&aIQM>bgen}U~Zv-qQe_dRIwmjpljq{V+Bxc_B~e=d0U+ZI2a`WeO8J|mx49ACJE ziFrOfcUmrZ(=5wyL~tIz8wKa_%ljR+zlZLZ9~b(M5CYW$_%6Ze@q&6`gWA(a6D9hO_6v#65quW$pVIR;)W;^|`S4A_chmfK1_dPQ>+|ING<=2NJihq3 z9NXdXb*s?l@pX^jJidM)IM0)>2+s552ZHlFnMKc$*dOlSvjyjQ@?ybxp1ewMo+rBn z=Xr8KaGodmc^dn}arKPQ=XvsV!FirMCOFTN*|hGVeSMysn}#nHocpm+aPG%j1m}Ld zS8(pf$2G3cCoiVq|1LO>i~kaw=aal#s3;_?FWTq%&nGts&hyDl8rSEO zJJaw71?PDCvEbbAuL{od$!|5T&nKDmde!=NdH3`o8WmaOf6Fp9c zjI`r$n5d?!BQ(8Y?=6QvZYo~BX9B~j^R^dG&E%))i<^%*=jZE%aDu9|3t+5Xp!Oy+ zHkbJ?1qqff>%jS&gkisJ$vVOJ8B!G;k|L={QY=eP_})XwP|o?M(PJ*oBX#lph?1dh zd5M+db~ng6K;Rx!QiTgZ|=ay)VT;`<;|+%OBmxa zKfX6IRsJ{ETKRcFJbVcUJ_fV$FAEo?y`8XBH{QnEw C@O`)d diff --git a/source/cluster/wham/src-M/obackup/energy_p_new.o b/source/cluster/wham/src-M/obackup/energy_p_new.o deleted file mode 100644 index ed59fa4121be967ff46f8d96a8cf9738a9c550f6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2890680 zcmZtP513n1`^Nj-cG{-@2&#f2C=CWd5j6;kpeiVWB5G(*1VvB;MNkAqP(&3$5fniY z6u}@Uf+84%w+M=$IJ0Mc*YD_k&U&xw9sP9o$y)b%_RgM6X6F3e#_!&@PoI7cqmQ$r z)5redKOb8o+W+rQ;okoWJF7TD|IhS4+!}4pPyecWd!XO{&%g8a`v3Ql{k`6|=l_=< zhxGihU(f$^eA@$kdOW|Sspa7SZ_gk5^~^}esy*K4KVIU1jeGt7t>1}nkEi+b6h7{Q zyN~0Jf#!pA1nv`0;(qZ9@qqX&JctjW{@r+ocnOb)zlKi~UyR4`0o4BiPl!7`TjJ*I zuEQPn_?7XL_$WM$+kM#v&xl9xtoWgLPJAk!$8G-S;RW$5UKF2$yZO1p)|ro&#b3rN z;x)V~{vBQuUxwH5!RFze6?$6G&3TEqA8(0oiMRFCbBC=n4)@}N%wIbP;UmQpctHGY ze2n-^Jd6*c{%v?vyokreU%->%i}1Ag*SNc%?y!&B!t>&TdoBTPo<;GIcp10n*JgN^ zco=v0*&X)y{qb(`PP{382JY_vf9qs$PtQ93>o?=W#pmH}U%12O@GKq_ui|0xFYu`N zQap~^{u$8U0{x939Id%lYg$6MkX;%zbUKM{7uZh2m*YTcMddG)&LwpI|6#o}* ziLcz#U~ZmHPhY#k_TdKjQ1KA%UMJjPuUC8H0r4a7koYNhM0^Gw!&fv9V43+`T5++p|kK)fZM!0mzd z_;YX%V0})H_p_U89-{aE-|ju0;ytpkr$5}$q>h&Y_K1ExC$hUuBD zUkz`GZ;aa~F56c-;2!$kdK7n`Xa3uVN8>*6GjPB7Wq3e*HXamz2oH(BfQQAu#!K?~ z@`^ndC^w&i_Y6PTVX0IPMdF759rT z#sfIFU(SzsyLjK87uww1g5s;oy+#_f7P!54}*@ru;xx3bBtDn0_QiEo70#XInZ_`Y~kd@|k= zKOMI(jM;t9;GUlQEO*%T-hvMme-QWLw$AgoPka&X7ykwii2sQP#fPn8@(hXl@v!(- zctm`6Jc`@v)ggFHd@3FnKOawsUyCPko6lW%O1y-p#b3uW;-BJKoXfZK6P^=q8*XyT zi?4_*b8!0tnDxhSPtWHW?yz3Lz2YC^KHT1K|A70& z`}BN*=H4F$#E0WS@zHn)xBEL54~y@EyPyBL!|qocA1{6y9u>a?pD2D49uuF3PZEC) zkK;C9j+xv&L@fqS<;2H68_)PJG@hoohKOWDCpNr?kvv@)L zPP~ZQ`9F@&7k?Emi7&<%i2sO}#rv*da$6|ADqax};9cU|<5lqq_#*M6@S6BEe6jeY zcpbO--;6iJAHbX9WxOT+F7EVv9_$XA|JQh%_#e0jxAPggrpePQz7Fma-xBwW?}i7& zV|Y;f1Uw{u9v&9I29Mx&y>s#L;!ogFsq-2h6aNHvUl(zQ&8LYc#QTjjxh2I%;3@Hq z@U(abo)O;{&*FBylkr*Nr{g)Plfm=ix8Mcw2l1l#^LR;o5ndMm2Csk1Rk-^)kUQ-8at9t1pO1&cU%|uT zAK?+)-Vc0_j~92=F*!uVSHUNWZ-~dlx5FoikH_PTP_!csK68?&S_U|KIU0@xgxj3b*%@YvFbAAl?w)6>o|kgtu^ee{~%0 z^t?Xg4(rqXW(qKA$`_0^NffO$D`t- zargB+ci1{(@woUtctSjmC&f?0Q{tE4Y24;~6P^*DhiAo~!*k;A;CbAx>npq<-olIG zL)J5Smc-Y_%ecKhY=JKnABR`O55~L1kH@Rx=i-aRvv>`+=hvNhxA^0DQ~XtYnfPMd z)AKr?J8b3(d;N!&0ctreNe7yMAcvSoke4_Z!Q6|rr_&WF`@h$PV_-=TocnnX7pMXylKMzle zUxQB*pNpr&pTMV!zlNv9Kfz~+H}Q;kzYR=oGsV}!>vA8m1>O?h4R44af@g7_PMj0* zrW}7kulINC*O4chwsUUg_&oFM#2>)j*UQ~u?|;g82Di^I@8VhUukoDtA9!AT=!Pb@ z0^ZL&yt58IPkc+fD83s$Up$7pucN!e);|GXAbuWR#_jdz8oWzubo@)xcGy3Li~9=DZU6#;RC7v4W1VN6VKo_&tU0s;&J^b*lg7b{O6!eiH5xzW^U9J`4Ba z9`i8HJ-GYzLw8tz3ispodh!My5U=Awsq+gS5+AUs$t^5(R>vda?RZptCp;#;KOPr9 z22Y5m@TB+^cuM>>JT3k(o)KS&XT?9jbK>9OdGWvTg1C1xlV?$UeY_;T4PF-C6R(I* z!mHvZA^-Ooz`}$*nHF7T&<^^IZ^MBEBo$6h8=GDt;W^5}%GQ6Tcd_UtqV-cXRNeJzrOJhxNyB zpLhiyCH^rU6#oJ55bqN-xkd27=HZ>;_(bv1xcl{6ci4H3#ixqzgQswNU5evr@zd~( z_$7E&{3bky+xxM3cwYQDydeG#UKIZdFX6U7TX81zwjrNG{A^rfK#BDxhJSF}vo)-Ta&xrqlXK{Od z8@iRrbC&ozcussve75**cwRh)&lNubFW~n2a2`Hi{2IJ0J{Rv2e*&+GzlL{0DUmbXx_`bMDd@?>%{B+!l+y2bpKJi;{zxac= z`@RWx*gDVSLEPrE2p=Q<4IUEz6YmfowzbLAFZT)S;y&@Md%b5C<~GFPa^~!X`^Ar> zPMF8-G|O{N#ohN=xWnFWT#N^LzW(nH+n+gnjQIVwzWB5Fc=5M!_x%y>usL_*aq-{r zgwz?ljmd4A_*!^cJc!Q}-xbe^AB4N_vv7ya;W)gA+xbt&OX64KWvMd`e zD)?gYkMX+H`2k-d-e+6RU-991ThIFx{=44MxEHtc8H*1W-v{^M_I@Ca`^8Vg1LBw9 zLGhdL5N_u)4|m^J;tuQ2;bGkF<2(3x@vrchcnj|o9}+ToCdJprr;BfayYEkNhn>$j ze3tmZcpkU?c067XKNl}boh-gU{7$?g{y6Tw&*i`Kd=;U zai`~fAMUXA1GqbSjQ9h1SiFpn7k?Lz ziGPiEivNKp#fOeHc}^E!2hZTPf40Q4;=AEFsT0HJil2ZN#m~bRh+l(OaJ#>A@v8U} zcuo8@ye|F;-Vkr%P4Rx)(}&_CaHr>eH}0_W+z9vJwtqVCq2l}EUa2z~_lcj5`^7VO zK)iwn4${)dU#Um zY>Q75ACITRkHV*mpMj^vufS)B=kbjAWB5$**YGTE^ZyK=Exr^lh!5J)*m{=2`Y;!W{O@nzz(agTrbIuGN+#b3t#;veJf;!Qjx-hU^P&p7cl z@TmCa_$2XhctZRTe46-4cv}1-e5QB~&xt>P&lP_GFN%MFFA!gXSH$~-O+JgnN8okw zP4Fe+VZ0@NAl|mF(>n&456Y4?@pJH*;#oW=eiuGh{3*OB{uaJKyc@5G z|A8+OUtt%MPaU_{^Y!tDcnEKb?}N9*C*#g~PVcb$dnP_qd?xM_zXKm7{x}{Ke;w}- zuj3K%U-60JgLgIg#BrO?I(R~S44xF<6HkdBfv3e!!!zO;+TCG_;kD|ehpp{zZ)-$ zKaE$!t9VuXE4(KDCtk1g%30j@7#u`#UH`l_shG(9{)0)75@m&iT{A-#ry7S@+pXqz>DIW;3e@eUKT$P zuZSOySH;iAYvQx;y7;|#L;P91DgG|r5^vy6VELT?#y#RIM@?>C@zJcJRp879uz+Z4~b{-u=rhg1o!Z`PvKGVxA2&FHy#)N15b#ru%F2%DZW0Q5)a{N z@qO?NZgZQAXT{INbK*1cy!ah>LHu#NDE>NL!ad|!$IIfs;uZ11`Qj!D1J8{5`P*G<95HQcvSo= zJT7(q#1rBx9%S-KijTrm;@jbA@dA2b+AV;(oj)egGbpufLy+hr}=H^)|=;-j*!q;~d=I&w%yksZ-~1J30P+Jidv6 zDfs{J3O)#TVrE^7#8<`Z;v3^j#CO75xV`>Q#NF>Ja);#cEg-0tsO ze7yLRcuf3Fyi@#3JSpD7r;86e)Z~*9Uk`V`Ps<&4p4;Mi@$vXP@uTpP_!;;@@hkAE zcphIY{utg6e+^$M{u%CUy8OD9;zPv;9cJ?JiLZ^165k3BibwDc@x$?m_^J3r@k{Zz z_-uTt_`|sS{bcU2`}i_GL;PbrE8fIsi}#;o@+pX~fzKD;950KH!@I-}!E53t;oagF z;Z5-zzD)c9+_Ty8`MiJ+7ykhFi!Z_3#rqs?@(GELz{iPif=9)}xchx??y&oKAf6CE z9-k(DKAskzh0hef7te`5i_aB*7cb)W`rp9ki~o(6#8*DTm~e3AHFcuo8%e6jdjcwM|3cfViI9X7W=@P_ybN1A+=h_8<~aoZ;$e3|$@ zxMy?oxc2zT_;B$valiOXyj}bbJS6@&K2H2~JStwtCyD=xC&UNGO+M4a*TK``WAK^c zd*V6qBk;N6r{P81-Y;eFlK8E7S^N>){r*UI*gCJo&AO_%-LJ*?V)38whWLP^Or53T zYvN9@=RtdhtslgPitmQ|#1F+siJy!Ial5V=cu4#vJS_eo9ua>LkBZmunE3a&`+c15 zu=D9V+2oTDUky*MX>^iGPSkq|Og`RJ`95lTS?Q`0z>Mo8ob)vkRUOKNwHq_WC&$pDum@o)NzR zpCx`jp2uzeWqhvqdw2mKXtvGy4lj!TiEdtMCr-JMoBk37;tb1|Apx0-q}WJDw6Bdc4VJhWNU8R(url=LD0_aPhTpzxbATyZ9b> zNPH4LPW%)+Dt-w*N&FT(f!pg(5uYml5}p+Q2%jeYBc8$snV6imsq~Nd>UdUsGkmuA zu6RK_hR+v25ig5hh_)8g;oGsVBb-Jf&d4%LwHntA3P>L8IOyfi6_Ko;z{v4@D%Pb zu{w|AY4O+bjCdW-ivNn|#0Q^l^2v*@gBQfd;6?F0@e*$P;Rw7eei~j8&)`+@Tk)Fs zBY0i>6}*AlJQw3l@t^RP_<%D^KF)S#Lu{QjagTTq_loa^`@|2${o*I%?$3#FhrMr^ zfwzm_ga@V0gLp{%MLaBZYWO(u@9~J#>3gQhCn~-g9+Nul_$2Y2@wn7E2v3NgfG4F+ z8h3yG&3|*d9#2V~`|z~*b9hF45uO$Q7SD+c5g&zn#ka$K;uCPc_|bSk zJcS3vuf#**bMUbE6L>_t3y+F_j=MjX$Q?F^-|)Ejkh4ub32{H36yF+8iSLD{#ZT(> zHmBUr%qM?hpWgqt9FL!3{%rkj-1)3;?{Uoz^Y5OuKGGDj{=W4?jAzZ^&d+#We1&t| z^|m>|L(TC%jvw9Y{hbhj+1z&S^?pu%tU0ig;}639+Z&jIpMbkRm&hHqP8!dOUytX+ z@5A%r&*25}MR-yCTf8Lx4_+2uWxDAH_va_M!`|-&@I~S~;C1o+@g?F@@Rs;=yscyT z$Grykir$Nd~HivNZ$5Fc_L{e#>44L{x`zBOJI-wR(Pek5MQ z`oqk zz->O>3r#*##W%o{;$!h?;``z$+~(7Xr^V00GvZg_S@ApZ9B%U|;d8~`z>DHv;0wfm z$1AwaXXr&HpDyur@v8VX_#*MW@fvRPiQ{$g)A5G*<#<#4cD#k#eCFeAJDKys`m4BC z{8N0S_%C<>xA}Nxn0(sB*TRG1TjFEH_rOEA&1VuG7C!}#h+l$7#c#o5xXq!6cZ$D+ zC&fR)r;GoHXK;J{Z@bv!lNDbbcYm&)JM4Tm!{>_ciWkLW_yX}K@Q8fh(Cc_q{O?|G zbE4e;d(E_*)h==8-{!<|KfXn;_jBqzZYRDw9uFI^_y33C72Mu`Ch@BH#duBpX1p%` z5Z=J;>thS?ruc_=OZ*4i+1cqGwoboG%|3c?JAWVU72g#1iSL5@#Sg{g?@qh6M-rtmShG$G}QSpuNnD~x(T>Jn$ zA)dgK;^*Qi@oVw4_&s<=d;y*ne;dzeWHod#*6~Och@X zPl|7ePZQq*PvLf7CgExEQ}B%VC3sf+7Ca|j#Pi}W;RW%J@S^yScnKe3w%KW$Y4TYp zzB*nN-wapTjxgHBR&uJia(G0#NWsL;{U?~_)zk3 zt~B|$Kflu*)>p;D;v3`R#dpGExIMon;&Jig@PznzcvAd2JSASh)8fzI?#~T%hn>$m zcvk!yJcrxuHT$KW;bv+=t4)p$dEF5VP>5^ssW zi96#=Zg!qu;vU@gNedq?KJ03fk6(N}yj^@-JcQf*8jpv?kHRD3XW&usEAW_j9*>JZ zh9|^d!;|8l;VInawiHi`59)bAzE96@lg@~*jc3KT!gIKNevIIA#Sh1eQs-2>Bz`Gg z7N3n*#2?11xSh|-_+s&o@dj?6Uz&JRy#F;OpO*LY7@@$>PF_$)jtelMOAe-_V+zl#^d8+cLtZ@eVF@^vP+viNAcBHn>l#rMN&xb3%N z@w)gqctbpkH^uM5TjEdQ&hE=!pWnhgcpLrGjSm(71NVxrFw5jKTzq}phxey`2=|Nc zgS$Vs*d2C0lks-(Gx4DKOni*^9e4=0^LZQ(i@%OXq)r_lFa9eY6(4-P$!DVYI(Q7X z^BIH3#rMP$Qs)SKs`zPmQapoC6TcNt;dVZc;A!z!@CI}HSC-Ud!xz6 z*~6R{w$5s}N4y>Pitmj3@PVeBa}e$qKLHQm_Iym^?c&$tLEO&sK0GA;93GZBi|}#c z-{KK`AoKqRkBYC7Gr7fZJD&g^7vBL-;C8+H<5R__;7NQS^O=sjKmXeu)~~_SxSh}4 zct-qbJd4};RPkBjU*S1?pm})bPdqQa;!P%>0&eFs3NMOphnK`B;AQcn@rrl~uZmxZ z*YLs2e-7R){si8XI$d~6{Bzuin8Nn+wcqfe;zMpW`S@@Ia4KN8Q0Z-M8< zcgG9jhv7x>BwiA~7%z+8j90`T!mGIbd}JZMSo}l0f!pWDAMmDlzu6|Ambedh_B4Un zI-BAi+@9~d;6ud^#=YWG@!{eZ;6Cvi@R8#8<9_inK1%#OJRtrZ-Y)(x9>fRHKf`Y| zxpjzdghz0j+m3it`~W;AbrN`|__=rz_b{Jp@s#*IcpA6o?*e?L_}h36xBL4wK3n`R zJdfM;dT%rN6vQ{ci?}@>$KoaNeep7G=hKNV6h8~E;5MJD@T&Nocn!DL&l27({s!K} z?Rvk!TjIat&R%At?EHt`Zt`gpUl;e_1K8hfaIg5@xDU7MjpKgt)A0aq=W{vUE`B>6 z#0N2-`FMx;t9S&r`Fx5;#eczLxSfwDZ}OQWz7`(GZ9ZG#3GqGfByRJWgr~$$!PB^% z&n5T_@muf=Zu2SPv&3J*^SJH*kMM%{k9ZNcdA8kQ@+pb0j+gPljv1TbUE;gqHSrkU zEq)^2#O-`8#9QJw;?CY?9>bW=Jlre(JnqMBKJViJ@&DmL-0rV4$K(?dUlkAIc0L>9 zQSqJdIBw@N5l@I8hbM8H&v|%C{5m|14$8&g0{9QaQ{tccG{|irw z`{tS)QsV7+T0D#gx9-!sfYI#ZWITok@XPRw)VUSUia*@zJwF%s(0;uYBGh>iuZu6j z!-p+@{8xBh{5Ra0wEXb{?{ahKdH)RV<8gg>QapfX#mC}B@$q;S_f!9HyeWP%?mgVh z)6OT22gR@H_5Mzn6UF9sC!WFi;5^am{Tx4i*vWjl@H{>R{~Y)1W5CvF;$FOsuBs?H~5#BDI!-KeeUV8xV5Pt!Wh<|`j6kmeJ@nPiC z=N^+!QhWrS7T*NViihz$K7{%Q;`79h$4mG?jz1qSi_gL<;`icJ@n`WGK7jh~;&t%` z-oS1D{EaUWU%6m%Yl@G?mx_1bE%E*EW#Y%;&IB`Y+Yjg9L&dYWPy8-?l=xG4Q2Z^t zL%bW0;O1)JIDg>d#aFo3*9~#4e?j-rubsKCH@oc>}wv-KJI|~O+Fs+HF2+a5clCW&)smp_@Q_}{A4^RJ_8Sl z--NrrkH{VNaUaAZ;xFP+@fse(?e*t-e3E$Ic_yE@_-c5kcsrgD-x;4Oeh{9-2btwL zC*ae?(|AVwdffeeO75_A?!)uq&*AgL7vUw`UVpyD7l{9Zm&I3kz~r`2Jb+ikcfh;E z_s6Ta?b|7MO?*0D$8DcngEz$Q#+%|#<1O(j?nF(_w*FVRNBmFRE571`CLf>pDBLf; z9Uc&$fCt5o#zW#MJS=`C9uc2|N5!AOW8z(ST>Nu9A^sbl6d&@C$tNZ5$J4m&hpq99 z_+EHc>KuvZ#HZnT@yqan_-%L*xAS=vFNs(1GH#zAKfx>FKjT&Lfkl%~O?)I?7vBPJ zi0_U!#Sg<<;z``u&-A~Y|HZgR{AS!M{t)gHUx@p~Kg0v#Kj1;}eh-^`+}}Uu4m(dD z9v0sekBIMrN5v1uW8zcsIBxsl0z4sp1D?d~JnzR-;$=K7{vMtY{|?XM_Icr7e75-T zM@()7@s05L;ydDH++Gh4z$@Yjyo%fVy>s!J__cT)xAVUTUn0H$Z;8K+x9xBG!Pfa2 z_u_W`f8joH@1rIkKW^v00Ui(^iwDK`#Y5tqcv$=_JR*J-9>s0H-HFGZ^ygD=i@c;SMhG~ zPw^&h^Z5mDiF+P1`8WqG--m1AL&dkmed2rIqr@lS?(fZW$6)ipIR)j*Unhm!(Y>a!wcfv=CPs9Vb?VscDG2-Xp zVcgFDIy@p?z@y^N;4$%c@VNLlctU&`o)llHL|=(-h`Yb%&>i;rxjmi{kK$RWa}1sn zKO4`BUyT>U=i)`&et!BSK41Jzyd?f5zCgT%m&J!YY4TYpz8+o?-xlu@ACFgY+Yd+K zHSsg>y41M>?-tMF4e`hDCE~B)P4Un0rQ%ERmiVBjOg_uR*T$U#P5;>a+6r$IkKi8h z!||cwr{Z4mOY!02vvHsJ!}v(?mvO)N$M`7mChq=TO?TM!_J7*s(=NUS9u(gkA0s{v z4~ZXwcZi>ahjDv9b`c&C&*4$2^8h|k`~^IQ+kXB4kBcwC6S%#f@3X+UdF}c-n z+i#=s#o`@!9k=t@4{wMci#Kt*U+3U0@ht8fWcuG8e;4i%e+u{Fc0O<6KJjkcFLnOF z1L7+@Yw`(-uaAesLwFds^VtWFh)>3&xZSTa@tF8bJdWG_x&!YNe;iNXc0RA;N%1{7o^Te;iuiQA zire{LgV)6G#_Qrw;|=jD-o)+vzrtJMf8y@%VRnZ-e#I9}J|6K=xEHtc-wyYQPr&`+ zN8#$Iq4-F=g4_Mw0jLfnJf^?ryC75@SE;LUN-so#C^D5 zd{aCiz6&12?K}_0L*i5Mu=oXdMEnLkire+xk53dY<1u^y{qP==}?_YRD z+*>jERK+*IYvN<^I&RmyFWxQQi8pY&-m~zg_*Hld?@vG6i93fHuwKGF_&|<-1NVx5 zf%|X|$N!G|#fQFX@(GBqiwDKG!9%#sXK%biJdTHPo6qTZMEr6*irXA+$7AC2@i=bt zc@B`63^l`pFQwd;*;&x>Dz7jT=;EqGD9 zh?j7i&r5h&{3E=A+kAe+tKx01n|x~GtK)U?&F}_p^Vt<&A|At=xXtH8yd{1i?i{xK zd2}Q05ub;9ahuQcxKI3j+>hIQ{)Y#|oi3A4P<&N9B)%~o#%(@3;p4<7;t|~Da~vKO zKM#+IUx&xV3wQ#z>wN}Kiob)W#J|DQ;>++1Zr8ig8z#4z;v3>w+^%pcp0CYkfd`Wd)K{0iJFp2vN-UGHP~Nb%QjKW^9i86FT{iU-99y=C$ViLZ@^al5Xq z@Q8Q>kBT3T$HY&?I|jHkt$cm}uY?O!$dWX0FO zbK;xhdGT?00k`Wt1fM5<5?;jZdN0CD;yJvG+x0$xSHxeytGHe72Y5|<30@cP^R~&S zAwB|c;7i5Bcni1dJrH*eH|Ll2<8cpe*Lyzh6`zIsaJ$}naliPpctHGJJSg74 zL%3b<-*|`k%I}!m!nj@6Xgng`fk$z>-u>{H__26g{2V+Xp2d^mci}1Vr|>jx@2}p% zGveKNR{ReI(7e5UTh-dJi_^o(I{1H5i+x>k7 zkBBeEqvAi|G4TQKnSA2nYvKvFAZ;D@!x5V$moguY ztKy&IHSyo@y7-U}O+F2AKi(AI8gGg3g*$Q6|2F?4agX>k+$(+=?i0Ta_lrM@2gECQ zQ2Y}-B>poV#_jX(z>iEm5%H0DRD26OCcZl!7e5S7h$r!+_{Dfi{AN6j+x~e7&xkL? zv*I7(Iq@Ixym-HlO+E#2A6^vS6fcSIf|qgIKL_I#@u_%K`~titegj??zaMXim+_|f zdw5IyJKQLLQA@2Ren z7cb!@sq+S27XJdTNS)vDF7ctCntZBKXI;D|z71ZNI(y^Y;&Hqobxy~d;+NwssdGEN zOng4>Og0;3_v=;MEB-0&7ykthihDjY`Gj%1Uu)sx#J9vFxb6Qv@TmACJSKHc!6%7d zg2$!KEqFq_h$p4aOZYVLkMNY#`4LZxx7AHP8L6{6K2v-%JS%l}#dG2@JdfM`JrOU8 zUx=4+`}}(&UJ;*%SH+*lYvS+Yb@Bh<4RPmllTTB8RlFs>G434g^bR}!op6u%MBIxH zGXKmu4j(Cg9v%?C4j&_4z{9wm&og*L{2e?hb-uwTi7&$w;wyb&a+@Z;A)XfB9-k>5 z#dG4v;B&>##*4Up{=FJ6iOV6{qwwM4XW)MEEAV#lJRTB%3?C={8Xm>%_46}4CcYGpix28H`6R^G#*^Y( z;VJP5o)$kG&xoIjXK|b7rTA>|*?2+xVSK*$%XnG*W4ueeiPyyYe`WIN7GDEz;Y7z-1h(Zcuss4o)^CtFNi;j7scPjOX3Z@EdDoM5nuTmlUo(H z`H#jIi+A7+@%`|n;>Y67v8Lbp^L%#>?h()8Uh%tdpZHU_A0JHpxA1oHZagIZ2R=@G zg@(x|ircT(tdGaULwH<#A3PyG8BdCziKoP8;%V_a@QnE5cvk#%JSSeq^Wwka1@Xb( zntY1l>)<8vF?d;gPrM?21YQ+C4X=r3@VfY|ctiXVyonE>e_p{`;)`)-iaBrvj{gbw ziVyhCtsA3J_ApR--M^cAH>u6P}ch*K2yAg=fuCq z=Zg3JAN?b~8oofh9j}P*j4u*D2(OEufG-hG<1O6w!}Yk6FacP<5BG>ahkL~r;Xd5v z`7J(5{2x3hzRD7lTZec6kBIMpPZZxDkBd*ir;1O@vZ}M3nJ_@ghZ-*}upMclJkH(jXr|_2em3Z56W`cH}b8xTt6ZlB+ zEWn-zYL!tejA<@e-xiB zUcn3EpWySwf5ywW?azTfntUqaBk`*E7I;m3cf5|UA!p14PL_SeD=o6;&Hr! z+w0Zo_#*Mk@w)i!_!9B?cuV|Mylv|8*SAk`ulO(cNO8|nlTSc=EqsjlmUviv4}84% zBs_-OJWs*n;+NnF@muhuco9$G_WXJYpCSGco)!NQpDo_@EBzzBIzC@~GrTOmE8Zm@ z!)v(B=R~|Nej(nFIyd4=#pmJ9iKb6%KF{Mr#oxz$_+YNL|HDU#JHMHHg7`3wUlk9F zZ;VI9cf#Z16Y-?@ad=w%JUolr^IfEx*6V;6ugF#(m;fd8u}9f8&eAS6*gvYv8sYM&m8<4%~Cf^83CY?h`*24~U&As2jX$@Qn@F2^sxogdO=z313dO<}(5>imtT z@hLp+%KviS;r8>^(Rfq518<4%hdZa4!nV$_xCgh_)pPLS;#u4;b?(9g;!oj0sq+@z zA>NHgq|P6BRD6Y=uIl6Tb7E3weY{gVgeUR;JMZw6_+&gSekPs~pNVJ1@4$27kK=jq z*YSdQ9WUZ-^vSRIeDT43Og<&4vkqPsAA?t<&YpOe_z`#&x7V4|@S1oAuj4lVTk(eY zBX|?H>wN`ZD!v$R;VY8QPq=5A0qX<$ntXiXYvKX%ARfZ)dUwOa;)mi9@sshW_zXOT z+x6arPZEC+kK=Y-FXBn@8lD#a9?y#R?Pv1I<95BP;RW$_yePgiUJ^eDFXMK-C*TXk z(|859{c}BD6~7O!NuB5L#o~+bI&Sm)7H^9GgFB}$-&d=&ncTeM0o;$<`R{-S#P`R8 z;#2UD_;frhehnTGzZ;K=KaI!4t9V@eD?B0oC!WOZ{;t^H>P33x{8 z9F5NuPvKdqb0wY=pM&Rdd*Ay6UKH=b%i^EoRq@~Oy7-U*CZDFbA9v0${buL0HSQJP z3-{ypKKV#IAU+KbieH9@#BamH;*a7H@d_Rl{{)YT|BT0Rd%g@DX!1#jkHnL>?YAxP zY2v%%DXDW9o)%By8L4wIK2!W=Jd4}?dI-;pFT{)DAL3>4AMmPpKaa_$F7Csd;+x{m znalUpF1Q!B_l*bRKJlrzU;F|*AbtZL6u%!2iI?%P_az6H?~@JSm>QQ&Q(#e7g9xcpA6;a}S;sUx4Su-^PpLU*l!*zwoNKcQAb= zz5(78AB#IF(^vNTvoG!u@5H_0XW>5at8l;gop?aJga^gnz(e9+;9=bM&+m9deCQC9 zPZYQPvo1bSd>cF_b@s;N;&D77bxy~pieHW=aoaz)<7x5vcvk#XJTLw!UKIZYFN=GI zntZC_YvFbAE%7F9uRnX>E%8aXbC&5hd;BT5NBk1pD}D>^6EEU^@t5#`_(ymUxBc@Y z9ujXGX7UN+wtrT~$BA!-N2JcKcvL)w$E41Q_$2WQ@i=b#=SDm!J`YceKaXd{-^cUf z|HF&o&I%@I!BgUA<7wQ^|7tudJ{Ql6 zKZzH`-^9zfeSY~8uZXwss`xOk$)_g19$pvU7H^1;$D86u;VtnqaOa%m@4K$Rz2bS? zFa8)F6n_m5i+_ek#h2o7@j)w@e3Ig8<7wPpZ@0oT;t@P6emI^JKNZi5Uy2vRXX8cj zhw+m5%Xk^L*SC-Hs(2Hxi}zpIv z@w@P(_)~aV{4G2y-i_zQ|GsX~Uhxd>6TcNNY_ZRPui@@?)xgMncTeM0o*6P1MU~!9}nR6`aA^>iciNwxZTHV@DB02@v!*Q z_&D(@9ufZvA20qV9u;5FXY!dSJ_?VCZ--A3pMb~3kH$O2Q+NWmU$49ppC&#BPvb)z zGoHX_ig)2T@z3$O;=kcV+|Fmn>L#BB;(oj$zBRr`d@sC?+x|QfZ-`IBo4Det!eU^Cho)2;+x_##dpDTxXu4yJTE>KFG!sW z@cH65;AQdq@hIC z!n?$;!fWDp;@#pUyea+$zD(S+wpnjU?jJ_>dYhA!`-e?9-hYwlpHB0^3FCR(-aj0O zduEse?eqKbxL5pq+$TN@_lw_)2XK4+e-;mlzl(>&8+cg!Z#;tA`LDc=$t@~A8js=j zKClCii|>agaQl35EIw8I96TwW#ixnig{Q=y!l#SBg{Q^4@fqTO;2GRrPgd}A9*M7y z=Wx4UAv`a>4_*+Tj2Fev#7nrH&rG~5eg|HWI*;R3@z?R1cpa~c|B5%n2d``LX^O9d zx5UTb&c)_DvbpVvdvLqnBXF3zB5ptLSQlR)z71Xx-y2^f9>?qAr{hb+FUMQrx8rS>n*8lN z=i^@7=Km`06aN(VOPycvc5%-JCZ7;)_iHV@Lwrj-EWQUmPJ9v`5kCbVFMbIg#cd9^ z;FH9QctZRoe46-2cv}2Ne5QEYh9;k!`0Dsv@y+m}_^$W@@fcpg2XH=~h*!lg#A{OL zM!Z{m9^Mpx9$zN@KJLjZ--rLhhl@L-O+J3y&VN-rAigmklsY@%9pV%5h}1a_kBXm% z$E416c&B&)Pl`W-PZxg&&){wB*Eje~@nv`xAIR}51?VgB4e`AA_IN=&iWhM^pJVX( z;%DO}+@4=o;|s;-;#Kh{@x|hA;tkyP!ZgV~y&xoIjXT>kYbKFA|6Fh1my{e zpeTx92!^1n7=ofGf+8q_q9}r*D1xFWf*~k^A}GRB6h$xu!;jtX>vzsR`^P!2^L6FA zKlk;$ze(C5{_Fy;^7!KJiR@=i3V2BTW4sBs9Db(0=Mq<-g*wygTs}#BHoiJOfqU@{ z@iK06vIAZbkKvw6T>-oPINU3K9`3^}x9f1f_y8WjZN1Opwc_vMLGf?!I&seiE}sx? z{Vb1%#n;0lxUF|vyh(f}9u+?tkBOg+$8qcDYP?mvA5Vxsg|~~pg(q>#^Gm!_d_JBM zUuHv>TbKCScpA6pyr|{J(ewUxGfH@v1Hd=7-@v-1!0#g$v&DY{0$Zd*MFuqj10YnRq}vjR(c=z(e9s;9>DM@Ca_tqj9`Z{5QNw ze5wDse454A#G|;)VHl5z?~ccD%kyx&Rs1wOA>M_zi{FYT#UI5};;-Uq@eK3?%va35~{hj736j(9-o9EbY4?@g&|Oehr=xzX$IZe+JKrkK#k(U*S3N zzwo^Ha$C9F3gSV$D84mb65ku25TA{g#XInd_?5WlN;m(O|DCv3{7Kv=Ucmk0pIiNZ zp8x;;vHRsWyIy?B2JSoYHE^H!7I=Wywf7-=;2C_jTb}0#tACXPd%xO_SBqa}^~G<) z>%}>pwL2aZKLZbmUxA0k`xf{=zrV!$ zXZs#Ci>Jk(#k1mX;sxNo2!%XviL=K1-H5C#Xa5bbt9I8Qk{$5WHXfWIQXL!iU6f!gJye;d$|w@PhalUKIZU zFX6Voi*4`nnGjzEFH4;eUJ>6B_gu5^eQ_Y}6+Z#@;nq(l?iarv4@jN+@u2wgcu2g6 zhsD3eBXWK&x`R8fGMqmF_cp?_44ymOoo{isY|ol_;E09Ky^R<6Ki@C$x^`aegy-&s@A&{Czx%TR-37G4UylZm#0ue!NwD z13V$VJ>D+9Kc2*`|2cT4__=rrw|uU})8hByJ>oe$BmNHFFa9;275^I_60hFT<(3m) z7tiCi-fi#^@qO?DZs&h1J}Q0|UKGCy9}~X|FNqK1AH<@qY15@T~aG_z-UQ*DQQk{6st_ejz?r{6;)4p2bJRU%(5vR$CKjA?B;SyNu9OvwD?wdkJO3c8Sx|WCVBsM#saVMM0h_IcjM)`0?)|%wA=9< z9^m>Xsh{I@TkrxNx!%ES{Byh?xBP#{v*JrPyL^Uldmh!|!{S@uIjOS;o)jD#1F-T z;%#_H{9-(e+j?)t8^j;RBeSsCW%NQ+#7QCcYCsOZ*@_ zj@x<@c#HT2cq?x6e*>Nne*kY6pNl8O-^Wwp-{EQTDSNtndT@Jx;>R=M8{qxo+v8dB z{qZ5();kB!iJyz-#jnK+;`ic3+~y~TkBPs7m&Cuu$Ho7~CvfY(I_h#Oi?54Uq|P?@ zeDQs7&yDWBw*Fi3D)F;$FK*|+Rk%<5F5E9Zj0eQu#Dlo4_X|8E{s$fw_wD8KiHNU- zN9B36C7u%B6OW0v;BoQO@mBH6@r3y8c)R!zo)mu#Z(?1R{}`T@>wmy|#24G!<&zO# z1@9N%5+4%Z6VHjy!L#D$F7T&s+Qv7&4C4N4h7Vp7(a9i(vct-p=ydSrpXT66H zicjJ>sk6vTmrq`N1-u}2*2l-hBlrYv=ls5SS^OBhg4=q}!96!Eyzkw(SNv|=C;l|< z$L-vE8?OW zwd-HPtHj4}FK+Yj1MU-FEavj@x2$*&9~9pjAHuEwz407w{m;hd z;&!ff;3MK!;-lhs;$z}Z;^X24d{X>#e4hC4_-$!}uU>dFJt9@sIGiQs+l}M10!8E}v2H8hlKA zV|-kECwx-;Abg&90-rB_1s=$_L2hB5`|u1t8-E=4-s-@f3$Noo@&Dm|@d_RgU-A%_ zPf+|ncu4%ecv!p{kBA?JH{mv)r{YoZOYxX^29JwBg13slf+xg3!P{}ma~_@)U;I#) zPYSosHLKy>;+x_bsndk_iyw?2Rnjd+dt0eDdSc)VWxd^{rFgEx!chsSX1|2aG^{vO^c zK8Yv97dg!3(=NUOo)ljnPl-qHwD`VwkN7coM*JMSU%VU7ir=QUVIn4Abtp56h9d+iKp-h@tg3n_(OO_{3YDexA5GK;a>3{ zaG&^MN4k9c;;Y~R@em#q-w_XqABcy=PrxJMop_V@^>|eLemo}rJRTP>;;rJ};tBCZ zk8=66i?4_$#q02t_;z?&d_TNL{8&6Ap2Yjbufen8_uxa~&)_-nQ9LjH6p=d z7GJv6*p;dfkJR!aj-Y(vVC&drIQ}|TYdpw>NKOgVG?R|a^-Y0$^ zo)v!%9~OTP&x=puqvDGk!+j*a0zN6eK3)-z;8l0I0Bl|R;y&?X@EY-R@E|^oJiGCb z_}zFIx6k!Y;}P+<@h05%YXXmo|B1)&Y4o$~u`ai`_&RtiZv8ai3Guz~cHH_o3Qvlk ziKoQVcv}1pya%5`|4-n(xb4>)c)$2KJ}CYho)cecj>~66d`-M49>&LU%VBqX61V;j z$IDXZGbyFj9dRd;}P8YpMIRnrxBmQzO0T%#ka*% zn=P{7%9Xf2w!r`S|JTd!mCeCDE$$WlTz}32pX$l5;m!Ch)Q|JJc5V;iC44s5zl=BC z?ZDRiF&-8F36J5HgZFrs!z|oB7p#i6if@9q;nV16XS_pv7Tzg-BHkr_A>NJKx^BdK zaWAi%#rwoxzz4)Xzz4;@$A@uy-KrB@K67!)Z6!R9TW%ZTqvAW@CGi+ODSjMY5kC*F zy2k}zuX`Qt6Cc29#Gl23;_u@1;@{vAaZkeK(=5I`9>Z-;*2ClC+v2U_Gx3D@(RjP~ z*?3a?YCI+0kEg|-THsZlfZV^Y;}P)^bu!ek`}b!&aIf1hyML#j=yFTpHqWc$Y4Liz zM|>ANBYp_pFMcwf6;I(q;y2+r@rUrd_)B;}d<-v&|A3do7dy%2GaOMDN!Rs0CNO}rgXieH9ziQk6zh(Ct+iI3n}+}8UkJ|zANo|8ID zoXY%&2k@f!X85@Hu6SAeP<+048}7Y-;W@b&uNJ=<58yV>5977sc|0g}KEmt8f5ao= z(@t~wG>g~ZG4YM@7V(|%g!n;thj;={;kLgQ;A!z2@E)o20Ny7)7te~nj}MD~XLUAP z`18WF_J8xK^2Fu+!)ka^ynccIvln^nV-qYRu_;7o_y((UfTm4P&TJfFndfd*{ zS$IVJM7&x2LOdpZBi@2r|5UqnpNYrCkH+VSpN+SRUyXN)_v2~tr|@3!xA1=PFY!U~`FKuznGToRi1>zh zPR_BN@O-^H-|Rf;THsZljGSY4;yLkW7Wh<8T+X-8sb8WWJKuiC;}5xcu=8!{vt0jq z-1=D!FW`2+Y>F4foA45D^L8*^7C#C1JiPEZb`kEy?SAaVXW&-?-xv1`E_{w1gZsqK!2`Ihw;Qh$zZ(yW zKaDqvzl}$6o5Kk_F8(K;5MMUwa!ZP@gQs!pzX9(R-wW>-KMEfdKNHW1r|}W-JMg0T z6Zp9J8+aMF^JE;ai2sIr9&!6?*DrOh%f~CeChijt<9_ko@qqZ@cu@Q_JcKXh+VXVa z5%F8`sQ9CJT>Mo$Azs3h;y>eQ+~#5Wc`lz`@zwEusZ);+iSL5v#Sg)Y;wR%1;wii$ zeiQC})CFn%KZI9{zk~6_)PJ;tiJd#K1cjbyj}bYyi@!SJT30)WUj>5 z!u#=Q+!tHoS@AvbA@LSGCw@Af7rz`Yh~JJE#fR{c_-put_-A-o{8zjpKH~zHk7vjQ zU^%RTd&M`$ed4>}e(^XS5I+SE;xowq61-mg7Ca(8h&PMBjK{=3##_XH!V|dN*WL?V zJ{{t#;wkY>@NV&)@eFRy*;#m2{6st_ej#2EzY#BqXYsQ53%KWT7rgcJ0qzt39uJ6D zUF7l!iLZo5#5csF;yd7R-13j%bHtCs+r`hrJH@ZV)8YeoulTcgzxccOp!hd<4!1l# zDVI+{e0jViz8+o{-xl{gvG9J)#C_sN;{oxr@sRk{ctpG(kBUEq$Hm{m6XIXuN!<2# zKHeq1%*8IZ9`UvDKJl&aENgDfscw`ftSSl@JaE<@d|G1eI2iQ((R-9 z|8Spp1+Nib@)DO%5Vv{z4;~i(FWw~HjK{IykGnkd`SEg zJTE>EFN!aIsmo^qx13kQ=ZSBMdxjU@mnM9M_`$ee{3N_q{31Lg-itSgKZrNsw!bgp zG4T)aR`D|4EK3@f!ld9j(3RvhNr}ry29ntExsn65f9@7;=AKR;)mmN#ZSWvxXoJ^J|=!EJ|X@n zK2Q8r-1CgvN2_1LXNdod`*EAM>1mfwP<(YfEMAW{iSL5P#1Fw+#ZSiD#Z!1n{3g6d z{2{zw{3U!yd<@Tv|9}^9o43WTboq>nuY#AwL->60-4}S3C&2dr0k>_QL-7di!`twv zTz?^+kn3;6lj0BHX{q!40-xdud_??nyntIi zzvD&mrMq1|CEWI_7M~E`0xyg2fmg(jz&+2og<3!DxL5o#+=ttK-G=+cAHxIUBY05! zQ#^#*e*J}8hKHlfu{9AoLUM;=>9uVIiuM^)N59799bMT1xxp=%FNlxeMe$GZlK3z91U{AZ zF461eq%0o5E8?5so)=vKtFtTa#Vwyhai4e_?iarp4~XB42gM)8L*jWnEdCK55&scy z!fjpCZgTlV#cS}G_{Ml#d?&mWx98wNc$;_vPl{iFcZuJC_lQ4$_leKNv*PdL!{XoJ zdECyKDL1=(M#cSjNqhr*Qha;7f?GcO<5e%Yc{87b`^3-1Ys9a`gW~t%_2M}^BK{8E zEdDhf!!4h`@fPvwTU>4l@pbVI@on%FK8^c#A3QDIiuXvJv+zFgtMIJUxeFf>AI5W1 z=S_S>{0qD&b^gFh;=YW_XF}?%h0hb;68Gd?Fw@9qPuwfsg8OjWuha1w@yqd`)VUoG zi4Wmnsq-4%DE=89#cj@i#b=4nxYgy;D!vBZCcZhI#O-|B4Nr;3@iguw&r|Ro@k{Uw z{?8M4!JixOKJk0-e%#jk3_d76is!_?!bima!i)G~^t0S;F1M0+5TC$p9=68kiSLbj zUUr48|JnEq@ebTCekEQjekUHn?R&x}@doh%-h|utuAk#E@!#=Q-1ckw?Jl1=xUFk- zyj{E=?-bt!Pm3Rd_u{s$lktA>6h4UCx^BYfia&&p;$HUsC45YL3?IkszW4#36kn{* zv^0hwvHVJK}!v1Myn%6Y!9DC*FWhr=RQbCh`06nc~mmaq%KPNBmp7 zU3}3yTt1z+&CiN>TD%VL72gi;7vB#b#BINh#fQa{_*~rP;Tn8I{2qK1xBj2OOX8#W zr1)2OMf@+k>Q%Q<|9>vs>2jMP9>lA0o2#wyfcV~c9d7;4#>3(rc%%50cvSpOd=@^P zd3zFX6))gzxZS^>dMIVCEzE4BY1VQ@mRI7rX|yd03*~oAD0uhw+qn9`6?a2+xTBh!5cQT$^^c%O@*dgAd}C|Hk;R_)hp--1hMx zd_+8fkK)$P1$a^X27C;+ejdQb#pmLaQs;fVEdCunPkhQfE}x3HAD@p~KO5jxueo_P z-yWYKzCT_qJ_oPCEzfiDTJdY~I^6QS7Y~W&@Os?(dt|g&CcX_m3%7pu!CS;z@i|iGEIc8872YO(7v3&DjCbJH&zpFs_!oGW_#b$;xNpGa z(~Dc4YvFz3TjB$_oo{>ML*gy?T=CQKg81e5nE37Zg!m9X54Zh&4X=oQhR?^B;Q9C~ z?tR^X`HcHqKGouD-~sW?@jCI{@UVCsZ^UhXPr;kTFTrO@om=p@_#i$<{AIjd{A0XR z{3kpu?!BM+!EGK^#rwrK!3V{6#&hDc@DcG7@uK*J_&9F!a3ek;p2a6|+xHjniueb3 z)f)@X$@jQVyy^j$PmTCWcu;&pydJkacfcd!F}zv)I6NkP9^N8;9i9*$z&mi8&u8&Y z@pthq-17Ve?-BQ8T|Rx{%i~$`_3&ZwZSlPLOnel#Jdegp;%DQN;#cDp@qWCj;O4>V zKZX0m-@o{5Z?-K5|83D#gD|};%DG+}<51-%x@p*Wi_~H+{e8S?Z;f>;(;!*J?d=_qb9*nn&pM97x6ya=JP{*K)j3(;+E&sL6=WXd}Vw@d?UOl-iVKjAApy|kH_cZ z_C5Lec-32Oe$0FD8Mx(tAMO`_4zHCu@8NaglX$(zFyPegnLyjkk3kIxj3;IpL8 zzIdznF?gHQIS20$@5Vc&&fR!g{As)wpW)*6yp8vZPvC>%f8sguWgm69jo>z)>)@l} z4fq&t@6Y$b$HkArCviJZPQ}Z(t?N>JzIX=rzU>0A>mR|Z#b3b#xP5Q-2_6)mhlg;R z+r=Mq`80^HhBx8X&!+fH@g_VjelR{q{3N^`x9>?V!aK!#@ie|9bMhdb5q}ZS;@1C% z_^@~x&x=nTa`}vkuZ)*)>whDBQoIqb;MV^ExOdbo$ozQRkJ}ucj|aqi@E~q;ejgqZ ze-01hHV^ONjpCDdRD6-gT|TqKSHN4v*T>t$BX|L$Zt=tM3~uvw z8a^Q2g%9C&pWce+#UI6sxb^=kJ}zFu%i=%d^TnqRyL`Owx;e4_SI4Wx>+t|?{qKT@ z#1FwExXs(ic$0VvkK#7BH{mhyhwwOV^Y9WrM|=!#7ykk86kqHqmrq)J6}(qGg!ki? z=Z^TG_UuGNjxNVuEFcY@4>_3&)^N>qj&_je!jw+#Q(yh;>$hb za*K%v@i=aIZjHB!?~NyL%X2o~Cfz^ApRI$6d%D$xaIjNJ|X@K zUdHWwTjE)l&wTL!?k&3e)UMwQuNL1G4~QR%*NL~`VchojV!T28W;}x1=k$m1X7M~8 z6aNTr5&scSh);XY<cWJ_irsHV^0G4dU10P2%_B zGsSawT>Kq;j`-JjJ8pUYjdzMy&vm(_#n;7q#kaxx#rMGn#arWXb z$Khk*=iw8$&F6J^S$qJm;FjmJc-7d#=ghmfPy8FaM%?qV%O@zlJYFwezrd?J0sbD7 z&BG2{AL05I*On)S=kVG1ad_|}2ll@1JUk?R9UjJQ9|!P8@n`X<_`CQl@o(@}anCC* zpEmL3@uc{Ac$fILc#rr@yifdSJd4}s;SMQ$R;T7wms_#k{lz=m-;Eb|l_$jf_?d?t@TmB{ctZZ(Tr2ehyspjLS$GDwdAkbt ze&Sxx?xVZ#YVl#KFa9Q8C;kN<7XJfp6!(p|e4^rO;j_fI#9PJp#M{JM@TBcnq&d zo#XJTPdy9%SfA(NKJn}D8u0-`JSRuu)#7L10r4yFI`KX{jN5u2$0Ope<4scMfA~!C3LY0<@-3Io9P$6)?YQ;x zUpy(^jHjf|VR*Orsdz^GQhY!>gAd`>&m(wF{1rSebw0sI#pmHA@x|YE`AmwhhF8Ql z#jF0e@SHT^KJkO`8u63xAa3iu2oH((;$f-tAl@kcA|4h05T7Mp##_awj=Fr>#8<|X z;v3;z;*EF@ZtFb&&xjw7_e-7g@j>w(JSTo1J|g}cUKD>19~Ym*%i@c?koY-xgLpUIBz`wOQ~YT>F8($?M|=Wr$8EiT;z{vk z-*vgAq|Q2cw|E1d5#I|R5I+hZ5^wodB-d|^dybv5;7a>`U{5?Ce%Jz^;t71= z3b#=IR6K**_W+mT-Y?yS)3`o^`@|o?{kVO<@d{om{s|tEI`i&n{Y3AM)0WkzIaUP9D}!tpM$qcoo+lSem9;He;QAVzm50cw%!T6 zU;IyeNPO9kTyA;sb?_o?`_+J##P`A{a4&ftg_p(8#4EVJe*KjQ`Q>7TfKisGx|CGmQELVOpzjNAQw2tHr@WZe6;3(~Gn;nm_d z;Q{f7@H+9A@Gx%kGloaRf54k?o1eu>%#Zjgcnr7vLwH<#N4!=1Ks+IS0^Tm(i6_Oc z$5VI}^LansCH_2~7BAx6;@{#u_%!M-`l-t&BfcWukK6rKhYyKwhv)I>)ZY&u6+ad) zNu4BK7QY7feB%mRKlk81@n`S=Zh4O4wc=mlLEQ5B3lE7e_nFHrj9WiJyh(g(JSM(3 z-YPyDZ^y0w4!lGBN<4{M|99dk@h9;#Zv7YVjQHnx7GIqG{T&|`U;2M8pS*Z2J}SNi zUJ~B}pAr~7f;{?@eA-GZqJt+@RIlg_ylhE*Ic|J{yy&g)(wvJ{~hiV zpYnyv$B)~*`SDuu4e$`YB=fmF9ueOkkBZO17H=277f<4rXAVz^zk{do zCF%cbJR|-$o|QV)U%K3e#Mi}hQfC{yAifV?k~*#Ug!ox_S^O%zB7PU{`OYnLN!B}z z`^4YG1Gt^fU*L7(f8b$p--OGjQG6{tD!wH?OMFkf6}R)D1y6{dj<<_njwi)$$5Y}% zcv}25ya%`Y6aN_Zi~ocN#Jyj;e1hVu;vw9gN1NdF;ydGE@mY9-_=$J~x98V| zc$4^zcoet$D~rd)U%(T%y}$hc?-2hUPf4AsZ(Ke-;w$0(;v3>a;yd7Z-13a!BjU&5 z1>EvE4=;*ehnH~6X8kwL*nb<4dUD4O}Nef zOgt)nG#(Q_8;^@$jkk*T;|cMn@OIqJpSSQ%@h|bT_t)Ct|E`A@L!0mi~4(||u4^N3t z;@#ql{NVD*h_8STh_8pz-Q{rK~OMG`cjob69>6W1L-3&Z$#@92 z*G=IO@tg1{Zs*TK_$=|4@K*6LyiNQEJSo1|&n}-X@m261+~z-oXT*2J`^68$v*IV< zL*kuyPW*a2kK1{2KRzn{JYEtn;*;Xv;uY~le{uO#{k-rwwj%DsZGP(TYVqxGKW_80 zA07}t77yZ-`0fi!bq;%coW91n@TT z&G4l7u6URDp?HsY8{Q{=F`gB_86OsZ7|-Lj-aK9q{|GNiogeXW@oB%ie9GcA_VctrdGyh-ZJ#b=7YkH^Ko!{>-k`NQSYj$1!| zJSn~bo{~D-;~DWe_<;Di_z-UWT#M(#@5S>{Cx?%Uzk`>=zs4uU|Hdog)$?6$ zRh5P3WL?}Rz71X@z7HP6ZN05{Nc=23EOoBJ8^!O!qvFH(Eb%w-R`D)jI1i0_H_OPv;cQ2cZ}Cw@6TB7Qqw6d%IJ#b3kA;-BI3#ec=UzqvWF z_0IUq<>M1y1NY?d}n+}d=@@e{6xGUejz?4ej`4C+j_HjS^NdOB6U8%tA1bj zJoz5?iC1|R^(^9<;;9i|2@i^Ih}VnnfJek*c(eF%cnr7oo`=W9uftoV&H&yf{w$sp ze;4l({|4_7_blS_=@VZb&x)^y4~uV$=W$!_OuQg|G+vZCXXE4ISL0>zetf?8Z}>$0 z!oSD9)S~~cx5^Wd-zN{?aq&$S_!Ljz4>xZu?jN3=@eDp2pM`tpJFpy1#C_ry;(qZP z@ql<14~oBlhr~a?!?=B}{2Ff%{~eErPoLuEq)~ijya~6@aU0V;N9X+;2H5Z@B#60dnUv9d~ZBjgl zS8!YJ*0|@NcVGYhG2a{a;`Th6jaQ3z-~sU~@jCH4@v!)lc%yg$kBWbe&l3L~Z^dn0 zOE2N_Nr>0t?NVn8yi|nQ@tD;42yYSp z5l@IuThiszAzp*0#5cyf#dpFp;s@aa;t6~RxAk6t=frQo^HS#ld{lfcUJ`#FpA`QN zFU#k+DNFsEPn9Rh=e59sQ^n(14bO;gf#+}^*YAZF#9Q%_)H!c~|MPd07j^S#p9inQ zlem2z9Ka`V`#IgScv<{iyn@@$ZNI^*rnuKN_blz^#D`n`<#E6GdU!y5TRbQ}6Ay_W zjfch0#v{1(c{ScF-jBzm&Qo|?{4Kmy{7XC`J|Az#ZJw9$x!jWCYvU>0eh*|TJS`r@ zdvNFBlNDbXACfv7;d8|s@q+jP_?YxO7d}_-!>h%g!vnbG z{~lf^K8c5Mo6kk6T|N!sE8r2Svp(J|9>HT$XJ34l_%V1~>YRhm5%0#^rOw@WhxpTY zQtG^ocZpBnJyPdSyjOhLt7qwpeb^L!>=5>Mk3Qs)kQ zp7;~EXR(Fn?G1c}_&Dyzt^eQfTJfb;aQTFA>wir=EFQ)qxSfZ)<4xj+<5BU`@R)cP z9>;CJZp9PgkK#%3SMjuX3D4k`&(HXP`1BQBK0~yevctm`; zm0fPl;z2wnzBS$=zBir_pN)5jci<`9_V-FWEq*87BXyp{`@{=)R{V2(Sp0W9FTV6D zE}v2HTD&B_1wJXh2VTML{yGA$T72Q>PCM?yZGSJrYs7EEgW`|j_2MIVMEp~{S^O6~ zCcZ?C%cn&=fG2R<-_7uL@m=vGZl4Da#Z%&KcpA4nFUEVtZ^rw@AI1m8^LS4DBYZ^s zN4zLLZB>`gxOfd-#_b%~7_W%$gnOnh{Mw^Oi2LzYsj~szCcZtM6yG235}$+jh@Xr1iC>Fn#qY(3#dCNbxAne* zkBEPb7o^VL_?US0>Mpkl@pbWe;@jY!B^I8aeefCLt+-$OEWB3yDm;YSdhf#P#fR~* z)Oizc6#oK`ivNMn688mMKCR+w;cenu;z{v6@h_){j=M1+ZPw@oEvjtytO*ao2d^Wx! z?p@O5Y5COQKJo2vzxaN5K>S!dD4xVa;@99|@q6%y_%nEu_$VF~{|b-cmh)eDTzt7& z&KdC_o)F&}Z^tdqz44^@Y&<32fv3f<#Cvdi-*_k9C;lX!#qD!P0ndqlju*s#$4lZ% zujTS75{_bj#WyzPN|#gD*!;_bL!{4zWsej6SXe+&=d*8d0|7XK8Fi2s5& zi7&CX%O{Fk{sBBLz8Rhn-xW`aABv}Oo3}Q+NBm+uBYrd9Fa9u|#VwyaJ|zATo)iBO z&x=o6$K_MNEuR{^B)&0T7T*c?EbZpX>KugoaLXrw`^7K71L8N}LGcIh5N`R*#lzz7 z;}NOz9o{59CCL0p9X}ou-vE!}mc#aVLVSNbDLw~Ji=T^UaLe;rykGoYJS(2Vhs58( zbK+m)dE7mnJ)Xbu5%KDEnJe7BFIpEL6W<1(5Z?!%C*F#Cd~V*X{#p18@vCsZ_+5Cd z_%I$4e-m#I{{nBqZD0PtqqybfThHY)Q|hdR$HlkA=ZNo#w~M#no#LnCY4OYPUflY> z9q$t#!Ux1(!w1Db!-sKuZvKkr#b>PV@);Fh122hhj!%m3hF8Snc-1lsKL=02XNX^d zSBu|**N6||wc;=1b>bi6^|;ORPk2P!Tj%m=7GD*QiEo0pi0_Oi#Ao3hxSgvf;+^6b z;$66XzPJ(Z7SH0n;xFKR;ve7x;@{(g;#C{Ce1^qW!sm)_h>wWxfRBpD@G;xoj*!K=kR8@haI#Fxiw#n;2@#J9!k#b@FT;z#3+ z;%DQ{;#cD{#ryGD;!oi%;&0(|#J|Mb#OLE3;>&F0a_bad8}Aa|3hx$=;=STW;(g+0 z;9mLMeFg3l?_1zio{W6XeFo3U=h+YNg7`eVEOnL$xg2uzX`gcgcw{*@pY}O-GrS+S z@2hvkv*L&1L%4na+=kB;zZfq_otyEZ_``Tf>g4fB@sIF|)cFzjRJ--sx~6UH^6}!< ze+^zOzA+wP(@q_S?)JfnC;uqjeQs)LdD*gZ-lR9(p7V-D-1a9BgeTTP+Puaxf z(=P7EJH$7@lj7Uso#OlBDe*aYm-xAOTKrnPTl`+U2e*CC;TiFF@P4WDH9jEzH=Y%* z-qhtbD84Q}gxk+gx54L%?}Ha``<&8>m&DJ)%i>qzp5@*ATb;XbA8zw7j8}`liTlOB zz-z?+zyrAD@2hwD1jX0FL%8+1B_0vq6OW3w;BoQO@dR%9UygT(-;SrmhwyIk*YJ$^ zXZV2lulNvd`OnzQWb0{1m(-ehEG)ehXd^AH=IxaPwxb z`!epsZM`4k)#5+lesS;SE}t6lRq+6Bue%9eC%!Wt7N3PTil2x_#V^EXiQkB~;x_+T zJR$x9-j3V*#t-nM`1g29yz0L$pS1W&c#rsoct(5&yk9(qXT^`hhs4jrbK=+GdGP_f zApR^~6n_^liGPDnh3U3vU;tBC1@pkbu@TB+^cuKqvPm4c} z`!{p@XrGr~#{=U3Tj2kkQpYX)bFRN|pZLmK{+mygCx8d|`O#*0M0`&?E_IH=6LS4| z3w(+v!@63ie;pq1yLHXR2k;bb=g+fvTKrwS2elN|cuwkU zi;sxU#EVkrXuKqTHa;PBuEyty_v4A&K40QB;`8yK)LEv%iiGy7O&tL+|Jb{w|4pT zi~k4D;`aULfAJylW;`c;7@ikD6))g+K3s|y#WQ#bxA!xT;N#-2;1lAX;FIF>@G@@w zEWVA)ry{-@?pfK*v-PtnUM1dyd&LjNXNaGK`*6$uBHS#21OUe0s%Kz%#gg|Gz#yARfVoaQnQrFP;}a1}}=AgHMQe;}v{qo@;mG z-c{V3n?H^F#oxw*;uClnxB2`NkBBe39dm`-e6E8>#T)P#ZuiSxcwGD_ycM^3I1_IZ zPvc44=JO7`Q~U`$CH@B9B|eU)aqH(dyjOgw?Oi_oQfEzkKs=0R#dpUC#Sh1aaLfNR zJSX0T=W*NLTk(SUqj*v3yo#5^OZWtC^Zzqm5ud(;%g0;e=GLxX9rugZ<3Zf!d>1?{ zehA(qeli{tPvNb&eO|r^ZxeqAPvSPuFX1WiF+45)1KuOPSfk4)gIhnV-~-|zdXu*eA+H9pGNT-ya~7aWn+A%_)d6S{2+Xecmi)1zX0zPzX4B+KY;g&&&B(3JFniy zv*O?3L%6-)n6j(OCnxU5^Wq!e1@Z0iqWJ!JNqi1IA$~4i7QYs+h~JBQ0&Wg%T{+w< z{toUF{~Gs;|BVO4t9Ns`1;y9JL*m=uVex(NhA3MJ`>_=;AQd6@rw9vxMz)p=Rb~n#ZSR~;+Nol@muhK_#hq>e;E&ne~gF4 zf5Ic;-aTACP2#KKQSnXinE1|kTznSZDt;oK5Wf&_7rzltif8eZ_zQSi`~$oPx9>N; z$NR*q_H_AV#aF_I#W%$B;yd7@;xW7=ejGk2ejZ*CzYeeZkDE_h*8uJle-^J1e-{sm ze}mVHd!jC%i1_k&v-o;=Onh6sMSLcn5I-945I-AFiC>L(i}&Lh@u%O!rm^2oYW8D1@T?+lK5eGS?ZsT`%Z8+;EnuZRzb*Wp9BeU59u zhsB%m9B$tm9ERt`PsIyT=TdxBJcAd-AHm1OU%^Yb_45fnAwCZ;i!Z*P%dH~58tz%k z&8^kn6!(fZ;Xd($aliOUctHFjJSg6ahr}Pm!{RUE5!}89{t%Cfm+`px)csvP3GtQj zByOK`H^Nimjd&Wjc{>2_7C#>E5kDXA74N|_xb<@%-Y@yKZ~Nk2@ndkG_&K;=yc-YTw%)t(koePhMEq?$Dn5b7al2ps z#9PIeJ%G8wZ64Oa+r%62cJaON4)LS#ByRbiiKoQVcpA6<@4$P+pTIM?<@pAl6(7fQ z;=kbq@ud!Au5jyTO?*N;jF)lCb9a26_~Cd3x99I^c-1;?4$Zr8pZKkKjrgN@Q2bTA zUc7`yaO?kPyit7mK`x&r-11o+kBZmhG2GU*3*I7r2%Zo>8SfBJ;VJQ(@NV&k@C3HW^RPTU)Gb7lQpk5`M| zj|aq`$Lqw4cv$>fyit77gIzvR@fGn|;&phd_;z@k_jSmC4|1Fn)p;Km(}}Y1#^!8nvV#ATqZl0g;J=LR}E! z)KyF92qtmWk`}dzj8sLbD3KA+fPmo9o5_HHG$SCTavN-=4TD-zqd@hpFw;+@Pln1}nluV7yL7GL+kZ(`oYJm|lU`HqO+#k?cZ`FZA@5kJDbE8>5|ygTB{ z%zK!J=Z1gHyf5Pa$b2B;+kVXFXDH%VF&|+b+W*U#-y88CU_KM+>}Ng~@nPl*5uaqf z6!G6+z7p~O$$Ty1PcYwz_@|k-UG3`|@^+SaJM$3lzZ>xRxhmov%)26;moo2(_^X)r zMf}H@4@CS9=0g!5XFd|~Uu8ZO@!w}Y8}TLP^UOoMpJ4uI#Ghfl6zM$o$9;ZQB7P8t=ChH`e`P)&@kg02M*Jhpmm_|X`D(=fiTQfO>$my*)Ly9b|9s~4h`*e92lEi` z4>G?d;3kjYp@@GQ^O1;uAM>e*?_)k2@tA7ehn{Q2z9)65s5?LW_ak@?s2_Luzxx7%p@?abGhe+_Tn z!Fr!NarogZ;o`vnGZxdGt37g zo&U=Gu1Mz*=3|l0pD>?d{(o>>Pcom2bUw@c;YjBh=8rND?dmzV`?@?4>C~C8L^|KV zd^OT}5%cv(=M~J)MLIVy-_q^t8~k}S^Bv4X-QU2xgL$a?o0)eq|2odk81qJ?^NY-H zj&zPN-^V<(pZ78!igX@hepjUP=gjY69?ln^VSaz4^AF5tBc0k$`nt?95A#>IF@HGH z`FiGykiJD&oU3^ms^?7GY@qcWWE?}|0d?k%tQM;#C(-`sLM3- z)6B#9>p|w{BK_ZIe#Oi6`SAnHuVfzl{|NJIBEHJ}I_AOd-!s1<(*GCc`y&4D|Ff^l z?Ge9{`CZIIyf0ur7V(!ezn}S6azFD*=5vvLKl6o1=XJ~#E&w+ih0PxGV`v8e~S5a%tIdjj(K0C|If?^BAqLSxGv1Y z@%w)=A7&o%a5eKW<{=L+V?M(?wC4u%xrqNT^M!~XV7?UbJDIOA5Ba%=`O^{q1?KC_ zLwhkX9u%x_~J@_CN=9n3>M|J_gd zy4=G&6@$X~)81oSCEzFlA{#xcAXCCr-2lMqv|8C~BSNJ>! z{dY6Jf_cc#uQP9F9`ZBKypwsz&-|wshJmhCD^Cu#H8}pS&|GzL_i}*X3Z$$j(nYVqX zuGcK{9n3@ie~0;1%tQYFnEAELLmmH=`SsEEA7_4Z#6QRUHs&G!|HynO;?MgpzAkq$ z4|dy`-y7+FGxPUEI=h+AMLK(!FGM=GFkg!J0p=@_{z2wXNBj`;b>_kU!^~^nrTeQR z%F;8GPo%S( z`4saoj@rX~HqyU^`Fz9=FkfUI+U-H+%Mm}se3f}<&xe_>NBju$T92;FBh2f}LtTzB zzcS({n0GP{c{|CxJJLVPybFaX6BtdF51cbF6Q6Nd>8WvnTI^@X8thq;LjfB zk45|z=1(#Yc|O4W>4+a>eujC-^C9M2zFX(>F!LP|Kf?Sf<{{6IFz<@^G3M7X4{@Df zenZ4hGT+BM_<5H3?UDZ0gFgSm%tJnRG9QcdcQK!d_-^KN%tJo+FkguHEzFmg2R{!m zUy1lZ=4%l@#C(H!$me0^TfRr17mhHmGY|QEgn0+^;LkDUU6IZS=GR3!Cz;>CJmm8% z^L@-iezv~J=l^!*!R}7xcSU>`^Lrz{oB4Z~hdk_IJ{R#@m_Hop9AN%fwEaQm%glrS zhnTNM+aG3rI?_MF{9MEzVSdH;`g(=B9AkbZ^N^nt%&%b{;yuZ{JJLDJyb*1`b(s4f z<{_?~%x_~J?CxTIN5pqCzbE2*nBUJl#B~ev2czu|Fn^eNi0dHpMdsnT(jn$ck^W)k zE6hVXJi>g9d5G%~<{OdDG3IU8>;CNo^LFOJ&y&orinc$?{95KA&s*Q@^M8G$vy*vW zq_d0pK*V=5ABuGLFu#j=$ipqn?~Qa0Fnbjg{zJq!2=PdIM<{_@FZ}Iu>igb1|?}>DFF~1?w+0A@k zq_c*hKEpite~9^9wEbb`3lTrUe2KZ_pZN;&khf#ZpN@1+ zFh3J*f0B7^kFLvE=5^*lf9ucq{9nmD#I=+8HIdFP=GR3!yO}p4zK8kEk^U{rZ;SK~ zFuxDcb%K=1(#Yeja1~H1m+R6U@&r5B{HIzNHbhf95+PzV)p>|5rtP zC-ZBW2Y+@kzn*!pyPNsVkGK)3Kf%16d1#*}nRiC~Ec5P&Z+)B3e}j3*^G@dd(e}HT z4>Aw_>}Eb3ZNG>47<0)#^ZO%yfcb2sbCCIbwEZFGk23#i?jH^_e=_1nn4e}I<{>=7 ze4Tl?UwVxB6|eI758Iz$US}Tic9MBV#LqJCVjk+X^=EzldzgoO?quG_JmhT`^L>&2 zZsxZ~d=K-xmzA7Q=` zZGVjUIp!hHCzxOH{koq&$^1&@A>OmhuVEgJudO3K|JN}OdDzMPhDc`@^L@-ies(h- zWFGRfhxtgvZ(%;eJmlv9^Y<_h`8mjZA=>^B^GBJ7{2XTfM8uCU|2XrIpGTOVW*+i$ zjQKg{AwMUWUvY!(=T9=fl6lC_S>~P0gP&X9?(^Rr@tw>Yk^U~`{mg?uyO|F%4|ex3 zza!$eFdvEd0p|Bc`Ujc6hk5Y-5c7v3ewg{A%tM}!Fn@x1$nzu2KOSv=jQMHiA>I?r z&qdpxWPZhszAhmTXPLJ%4|cb{!{@&<+I}bVYa_mkc@Oj8&u->@%tLVl;Ry3bBmM~UrHCJ6{v`8Y_XP8&nTL2!GCvdX zv&^^rfIeQf-tF_hBjP)mU&TDw-NpRcX#3sFuV)_O-NU>u;{7c^I7J>?lI=`%tO2OmhS0lc4)aQSld9b^ad96<$ zFT0r6nTL3HGry8~(AmTMnuy=R{5s}g-RJ@4*GK#y^Bb6l@9#due1LiI=P>izBYuSW zF!SK&Bh1H`hddu+J`?d1%;%VgJfCE~5b?9jmzW2;TMzmCuSDDLWWL5c#I=k0nTYRZ zUi%?^9PMF#1@mC{7Uown5Ahygeoe#=GQW;_i1!fl8zO#~`99{s?h)p`{CeiW?h)oUGY|1T!u+;~A7g$8^Wf(R z=J!PWB=h^32fJsPKNxMlb_zKi)25&sL~m)F8wdAH@=;|Fyc=?;y3vAi0}I~KOv+i z;&=GXYp;yCm#_U0@vp31##_~DJ74Di`Qyy**y=a@iWhi}^#R!a>W})rUv;hjeLM5T zBmVC<@b*8&eC^GiuUzAQzlr(5@AZHG^ltzAF6RI8TEF68<>TJ|-OO+Pus=iH&JV)J znZNwyzRk_C-6`ga&-m>R?<7F~9j5=o|IfVEZ~x0zJ6wB!`DMTEd4nfF{|57a{Bqxh z9(uXoevbK(Ue7;so#*q+$KK)j4Q%)Q%y)m%^EZ5x-+r0-t3K@cX>J;yB%ZdaTJ2m3 zzmE=;V*44O?eO0(5=XqDt^<7N%n`Tr|FDFAj3zP_^}9RPoc?OWYiJ1c-xr8m`j^uo zXYnsD;V&f)|6lcGK0jmJZvTPmQ}kz+Cro@H;_JNqH`4+N=)B`wJ@`u==)9V^<@pM!k9`$^`%x90iGm42@-8qXE`)!HjO z$9UAzAAL=n^R| z&Eu2rBo6%@Kj63j=rw-(S2I8P7SHE#!leIR$NY}B`v$V~D$oBj^Xs1Q{L0gwzlnMO zfC9ED-TBL&hum%Po7e6l4*w6o$=m%T zx7({9_xz^Mdi{O8!}bqr{Z(!!?|aT=PUl7c!94>v85GKcSs0N89&v-u5=e|GM$^)62A7WBfI%jq&%@&!0cv z7=Ld&{hDy+it*l!^GkPcY}xj6zeYPv;IGESmOp{O`PIhcXa{zfobGh{9dC@ESi?uB zFhVZ$A+I9YPD5&*y>fSw(1I7UDax<^?&geX`3$ZbGQ37+2eja&~U%r z+lOD{6v&+`6ij3MLyhsL8WX)MuN+@=ks(Ua~meyEfi?`k8HYSF{7${{Ha; z+g^P1O}i6vRYJZpCI`R2G1)suF3mS4Z(L|hzGks8dFNVV@~x+-foxD3ofq$|IcFtB zqxhS$)R-8>Hm@8%>fF@gFFJbXtKQPk?8Qe9?v4zSu{+5aRpGr2DsG_=qxd`2BIuAw zB#8cObkYyk7@yg8>xb~~4);O-N9gYl(BG~*1@Ctp+w>m|ys1+UyQ8W2e>XS7?%gGP z*x;$`-Z4XS?}!1X(TD=~N8~fxu3jP++%wVeNg6?42x0GBi;dd-XZ5}FEjH>18!fch zD43hZ0n}o($zyW8GVr(+byir;tp$QU}z@Mqn1QP{P;z05 zR`S^3{g;V+yU0UWJ?18nJVBzkK%ieYY6L7fDg8IdTkAzJC$0o9m z+5yq_?!yAP4{T^>x1d3h_pY-%a3Y`Ef`&xfyUqs|u%VrK)DDZdcbvt6wYYS-=rJd^ z^fX*YNm-Z!e==KgP?B zr@6ly4*e_c?*@&Vu-}f6*e3Sx_*dRPEB~PfeEs73b#!t`J3qnlbpfHh#bzUn*-K|v(wJ*=Eg)`b#uUpd~P>4 zCEBW+12(iXySW(=SKSHiioS611I9SIbRiRm2+T2 zJ3HrVBCm1|oXF?qd|k9v&Vdc>%$#qCxXL+jBA%P`+CQ5Yo4|&4cFx;GUgaD(k^0XXkuQjg^0yLSFuO!;}%?YvtIsJsJf1E+q6JP0=`vmXZah#4OTe$vwvU~MK? z$bT5r5EDKUHUS))$bJ~qC)(b9SirL^TRXc2^^3e}LBNUYxh-fww7u*6yaw3N&OB-d zMO?KWU@iVdc^Gu5pU&j!S9}^14uQO<0q1+qO!S^{JwX4b&YwT^lzVoY-O`7oqN=3> z>xx!8KMjk#YU#j&&~O~Xset98`{}9Ul4hfbKpciH|L9@t#S@*XlLep zNyJsoffMoEoG**E$~my1ot^U)kykkfPULfQzAD-(=fH-x>xGxk8rKD-*BfhMK;<1+ z8#pygy61b>X=dBRG-j)P#|O6E_hV0mN!@oZ{`2_g6~#$x_yd#Jo}roZ;nb2ne(R&T zxyEG+uy!w4$REG;iwRXe;Mhd=S#3bHRr!Do?N@YCs*IUz&5Js0P?(1_DDtX!z=nL@ z?7<l$u&T!`@>>Fxeu&OoEn2})d^uEV#Y@TV>E~c)@Fi*{5CWu zCR7^&j!k5@p()W;g#b3Rv)j;&$g3g%$MSwc-s=~8euxs-oGfxV%?;^Ymyxz#b3lK- z5_55mx*4i}L@9UwVd~X~H+bsRy&qWkZA_2uUuy0grrq~pA`Z>gqI8KR+Un*HU}u_k zZ|;N1H@W-3$=rP~$tHK7D!x^)bHQ*zBQGuEc3+mz)uS6nSO2nqq{02JYJ>Y(X=ADh z1IKNQ>Yd$$=R{sLVPHc(uN#~fZRI+!p`Gpeg2*e^feraQ*B3=wxejb-XS=>6^2&8! zLq5;-Wzkly0~^}euCIu^avj)^&vSiMw3X|?hIY2=Ya*{)2R7vMTwfP$KaQkFib2s8WbRO6~TGxzDsoO`}6>}?pfIAfKp|jQY(N4`e!MZf- z0_)bS8>~mO9jxXqYyfOfvq7*S&4$2+H5&#SQOqs<0UpzM)@6G8 z=#<7-JcO-hfRB&PQ;moas*ko2!bh|CXwrQ&;nvkP{-AdLp1V6}GdCD&OuiSJ;Pori zB;LB}RuA2|R#+dp=2kxTt~MJN>AN8q^yixTZhX|3oOB2)9I=3sm-oP>I=eKV?&46o zi&$AmcX24)#kDIqwwUhXP`ZmBPSV;=-^AN|liohMlqxusD!5h)qs!?o4yC(DXe;S1 z4yC)eGQ-Mhx{E{UE@EXZ-Nm7F7uUjJWj)=+p>!9qvXSoMP`ZmdW?%(NYq@=f_Tx~x zi&()$f3%B3=`QXlgcU4BjCOG--NjjO?Wux8se(JqVYDON#i4YU$S68f^s3bJ zr4kOM60Re`E?wy^4yC(DLb3WX%8o z6YV@>?Ceh8urwQOJZo$mTMCuK%K}tPbH>i@Yz<5FRspr~ys>d)DHN-h-bSGIT`=}_ z=YJSlj5c00Hg<-J>+0PBfHlI(&XTdK8~ee|a8O z-@5Tu^6btfzaZSLudeaGmqc;>te$Pcp)=UkX>R%1qp1Mkw70L z!+WdGgu7#^~R)gY$x?upUeW=!14T-!DF)W2P<>eTD=y>luww&mF z2v5$w(CI>(xBFo_$=Utzu-I1B1WrPmZ{T4^`qqc0IQ%ahvm+v|Y6qN%=bk{uL|fGa z*wD^CflP_KstIr+Ki_!$A|AHUs@KyK_uzV;&LxjhTgWZOj2KnL05*(f7GqY#RWX1Q z@!Vp}iMA>Ru%Vq@jCqk)#Q;v^&0;(}(fjB)9!EbsvG-AoTK@3)?r6!K9Izmcs5pTW zN9frE&ez8AvMvW>bV6Sgc@-ycDlZ+u!bI=F-5WG&dHgE$2J6j}Esb1~Gwu2XPwbs? z?^3lwVC{vnRnoy5=AsjOmzY!S61asq-NDx<*CkC;<=0B&I}&ck{k4=WcZ4-IilbW0mvJC+1WhfLoZ0^RQ9K1J(-Q-X_`w z{hsu{aivwCM2_h9wEr#dW1HlCrv2~0X#nZBcVlPl@BjW$*Y4KoGwSsh>{BpZE83^v zehFCR7gz`EwC~>7VRR`?@g4dUJRssKo4|>9?tG&`(e{q>xCPkIwjFQIHHsV`5^?W% z7!+CJbXmS-q;Yih%lL&Y_qeAi81M5PLifysuV0TZKxz$VX>3uWhEkzu!{VMQ8gLT( z0*#xpiZ&wRs%XH8cy7_gL|YXN*wD5eFD=@Xh^wLjYjHYs`2IzG5*5HbI9CN-$a}ev z{s+J+NmnX*Q|)EQUNF8xuu#DZB;5@Lp!rn^CGTF1+2wGsV-Qax~pS& zs#Tx#f8)KC{2+0%_YA%Jj_;ZAGpF&!@93NMPdsxWXO zo?GE1(N+}(HncMF(81wMzo%J`-kEjlQCOs59QNdXp?TU4{RDj$PQRmk`j$SV z_!*zVlh2Niew-}3^GW`F%N0qgYHGkqQY+lITorlM*nnes7X^kI$?NDQ5ntJ8V@)im zCI@U=z})N$n1E8@vVUDnsD=k@o5&7gLoBEufNcx;LDZ;~`g^!42;kU6_Ra4$(N>KJ z*w8M!j4ZwRT^D)Ph=61HijAmUEU5eg+ZOWk-ytSc{()l?lz$rjH>ZC3SNBc3qhP-~ z7^s_}cahQ0EB@4v`}Se9QN9~>Bh7c0<-Dn^Q@mD{1x~!KaD$*rYneh__PLInXFo5-HT-7ngz5dj<8W!*#RU8Vt% zSB(fbmao`|2E~HPKd@~fKmS8wLggPgHbME%?H*`wQ?icI^(wx5IPbDE;eJv8+wS`x zG?kC;JDpz|A6+6p=vm7+Z{q&kdm48h57Nr#<8F44AAwX%@vy|N+6ZtQzqjC<$pud2 z(f!B~F``-uaAIT?V-E93b)S^n`xp}os-*zi7VMUyOhBnH8krIks-*ziCbEN=5eq5^ zVB11|5VK-J1p%CxaOXWUh*smmIkBJ`6tHcfN`smgBdS3GCq}9@s0Fd0Y5{Cp$gjns zm{7F&K!RFma z^l^o^%+JcKZq>+uytE`MBCbjT zoQRi~WQ{hbqbA&~nDl@9o0;p;XZ~;h*#><^le%yi(svu-lRv;^OJni@|H*r6bT~F9 z-`9p;_Y#1$zsr1f5r^u^v04MUf<>(S^RSsZ7yUg{{a&(Kl zDhIHZ$7v2n2mPMhpd*kUO`t@5bjG1aOmo!ThDS{P6pC$eF#4&)`l%qe%qmR{W- z>iBnsI`>F4K3VulhaIqv#%Y%&tF+Dyk@v}BdEi7ox6XZ{?Olfjavj*vE_1!K&ix{< znkcZAN1c7mnooqo?Pr%YezgtN8?Uven)|0w6{wSW`(+-ePp zwyGAep`Bf=VUbtW0@m`yYOU~5d5NkuB0i~V0c)SCRclP-RkeT<`P^zviMFa1u%Vq@ ztr?M5)dJS?#cHkQRO`4~rA0kLjh4!_(bWw8$*arvK8!1uJ%35GcYcEYxA!4{=l(^d z9(0K=or(h&cQfA)CqX&9O4oyBy}pP`TVE5a&tSRLd;F*%5V`e@+P`_g%CrKgup zkyq^qIFZktqSqzb{t)2A0~^}7`cJQ4o3~D(QMi}XE#j)Gz=?S79LgTiR>v-|p4ws*`67gOCkmI%8%r>e~kByxAE=&tXYdZ!FkWVn?qs?_Y4 z_RbWYW!V`mdvT8re@Z4Vx83)^7pRVWj+(_eYLtNaMuQH#^mY8LOSIZ-nZ|C5e%i?P zu-a^yhS+jCD_L#!>F1L~{#}Z8X@RPF1M4hRJ2E>&UNvywR9@z7`&VJoyzS4sdE1p& zoAt<0Lj?z{tt0uuV&Cw}`PB6{YX6vMK5n>+@XH@LKEu5(w`=FRpu>-d-7stLq zn_q<3hr}5bJ8%nUD#t!7=2Yy!EzHHS*XY2n&`XVoadjXAYva{=sWFlFvHA0aTNjlZ+b?=RndSG z@!T=ptZ1v602|ubqw+bCS2Y1nU5q7>SH%EMnwV4V61asq z-Luyx*C|I~nHip~E8pl@c!lM5>*AQo18@t+D(7KC%&9y8w=fsyVWW_T<%^RCJP9dY z9l<>s;Q_aBta2W3>%Vx_#O8oon2Ym(Gks_e{(N_HymL@)n~FzokqV@PGSeP@`>KA@YjcCE=*<1=tA3o+eRR zJx31abQE+cDyv>{UWY14xEVR zW_&=jRmOo0ZQJqEj1P*q$~dqVr|!|Uf7jOaa=@@8=zd-n*pDw?kB`Cd;XdkE{gKng zM;U(G9caDUu{9(ysY(Oun5uN3!y>LK4V;MQR(eFVRi%Lq?aWG#iMXmXuokCE^ZO>l zVnMeEG%l!K1lnG$R8!)VDiyGHs!FM5L|l~$I1$e+)vRc%QUM#w`Bv{ki%4eiWoFNwISHgF;yAB29sQ#LjF9ay?g`fv&*g^R>gv9uE4ehJl9IspePeiD%{*#6BDY@ z0^25Nczgj1s8;h4;`F*$P(c9O7V?AG5ECj0;Mhd=V$vENDaKVCu%VrOQ>;zoRU-n9 z!*82evKb=f7P{sQd%RCQ4R?x+c1R62GYXc-D(a{q_|XlXi&LJ~8kevv4f0 zE8GU`6nRxy;5aE2E88U&RAqr}3;C7p789znz_y9(?x9C4s33rC3;97b#Doe0I5v^J zn6yu{RU-m6w9C4O=7a`4O=7xV@(*lV$j|?vm{9o#j!l#-CT-O{ zv{+2q>>kd$?D+SfPylK%=_2_-k5a>{Qrw@##iVQ0Dftmd#S{-o{Hl!r$MJg$zL{L$ zG#j;)VKJgw3UFcs5!s^=_esfujuEk-S_-gj!EPza1e6M+kufo$S_-gj!t8F8g=jP~ zB^Fc=z_x|_AZEmb3IaGW;TpCXg!`nV60>4KH7H=)LX`$JCq`6*0#1xnYf$rILDd4- zwvby&0i2j{8K)-@$(t@*bo==oh|%E0EhcTbCr!Je@yvPuZe;hi2(MtxnE z$g8FaoXF=s9PSov)hK}tZM4XY3C=wtu9_ooBA)y7z9HJGQvf!!vvb}j@+#-RiF|I( z`$b#j9N5s#%=v(btDFOC@ryf!lWu+GR&Y=}RTTu*o;vO93J!_9svvM8pIgCU(N+}% zHndT}jOn*L3AtE4a}qM0M^n{iC!$9JVFq$B)y53u&^xsf*1gkSo`hUXvN;LabhmjW z5V^~9kc;W6}6-T7G<)6q`Pim~F6?Y^z8)R@G*;5}$g z4yIcEs1SnpowCLx?JWHd|1n7A&TI?o9fm<8ZGi2z?iY{6n z7Q`i$2jJE&Z6*(kVpQb;xV6zZ4`UZC4@=^b$^&p~mo}4!WihJq0NmPWoQJ84mWLH_ zN#y~!wM(zqLA~qSp5<|YZ3{O5R>i2w18{4jQ67B1?|wE9*vef5E&z+&B7CDe#lWq- z+Dt0e#i&XJaBHKNG!+}-m1-5ht-abzDrz#iRH*=NZS<0+qD{Q=sqo_gx2(FgSDQ&i zU5xrvuuf6(+E0 zM8*Y=9`9X5PG~kYZeu*tfzcj)R~&_zUZ>L+vzg<(=}s}PS~+lRp0w>L{7rF$Q0U{j zL|nCI;8@&OD!WA8VnLM%*tSrmL_K0el?XUCLOBXw;p4{P@-043RH#iu?5f%T8+J2m z(A^x=zU_`1v%0C*u>r^=mPEDcYhsj zLY@gnc6P%Y6u(sPz_DLGy;XuA5+f>jVAF{79ZNL9#$8L@izOJ&fr~JBsLL&A6*I7Q zC$_km(?q)%RXG4|Y1BAP(6?opohPj`wmZ)bv8@hJU~QWY{-u)X<4y5s-g~Ers{<4` z5kF@;ey+^%F40z%0yebm*)3Md{nX7>j}Vo*f`oEXgR4~9itMFX6Q zC(&Hwx{Zi4DpKIYne4-COvF{Bz^Ql=sq1U=`td0-sGz1h}=) zI44t=Bqz(_p2`VuYxg!Y0A3NJDks3Ljq05EQ+Rw(SMEku#VeHx;MQJkCKYR9RHXvA zwb4tOigocyr2@FMSDQ)2h8R_;0B&v6N=5le$Sp?Z6H=Wnnej4sS&Ur5{aU&Kx{pe_ zqxh}YvQF_Q{O~#(S!H!4kmZzuhvt_!>{I^BSTZDwL{2oKgoBuy(3S zsX9eml?pf!&n;D#Xsc2I8`_zr>K1WTDqt-hO69VnFTr(rhG|#Y*tq5^UjNl6QAXNs z+Ha3{5j4l9_Wu6B&i|}vm#;e~={CXSUb^~K%m418+h7x;_&Gj0Og~doVJLkoy-oX8 znrU$>eP!USAE8+m(<2m4g;v=^yBQq_u+D##R@o47)hdA#@!VF~C)%o20vpdmU-Ux1b7 z7hcm?k`A`fn)|(dbe*hLIF{xm231*LBL+J`rIlR}aaCF1L_D{$i=wS63v6iHj+a(; zNyJrUffI4NvUD07ZKKjuD9N%IS0w>9jN6fwmSjc5RY`yo@!XQEinb~Vu%T@`URshh z5mzMv*5WuQka-$R;H`RbdBOn8Uk7c_?zDqC&gk!H9#9posnSsjw(+O6XSQ8UV;C8R zsau3tYadpx57HiRkAL$i)Oiv-a93o|^4s_~5ApV4o8o7Ih2L49xz2>veT7wOG-6MG*8_=-tvu)2bC)xI%m){yFglRGpQI5 zqdpaE6u6~P8YsroCS(kBfr+qs3^Y9`9;mQ^wFhC8^+laA_t^2?B{)no1Tow8__tuR zmpwsb)*cf8$1%DIW0x6AZkrcYs8nIL?VO0K)(jkrS1i%ISWqPbwk=dC(SjIJEfF|2 zLOHT$+s;?0&7#;MoMc# zU*a(zX4^jG7xdrzx?PxUyAh6TI-%zE9aG|$3LZH2%cr+W@H1jW1rKZ*k!y;%iQYMP zE%l?%57$x`WAH$C7>sMGZo=A~_=;vTr->dhs&W9_(x`Eopl=DLI;Tq&=E^3mHpI3% zK!LSwI{4>Grgk>Pqe-iMBCZZl;6yxk$#}nLtJVo@Xxn$CnyaNF#|K1QRRlN@pDRr5 zT&I%A)J}KL$E7W=B!gmHl?2!@Zbw#Hk|7aSB>_&vb4xNT+NvbLhPLf^X-P&zT$Kbk z5ic!?@29ZN-7HDdcr=U}6XU8Rz=`qolB1+49yPWp5mzMvPQ-H$?-|inB>^_H?UIzX zrCAYIB>_&v*9%9I5C)A zw^b2W(Ez97Ni=EQ!mJHF$s``-P_J2S0`!`=>vI98u>?ACH@3K$`*iDK)aQte0_z;b zM)jSDOEm#{L)=q20dDQyW^z)C#@n0|;MPXtoLrg-&~4(L$_a35_coK0x)@dM1h}=) zI44t=WCC=%xTkUg+}gd(T$6N&QI!+m)<$(s{3$#>zAASko#K^B1#oMxHj|1jF{)Al z+}h|RO+~kOrBVUh+N;f^qDPFXQ~%VPbnDy`*^9l}Zd-2jwcZBrN zd;8r~J9?nsN7EYU#92G_XLJdHFxi@nnG3TLn8~<$(p&NKBZ?ON!5L5X?k7_f#yoxU z{bj0E0_z4+<#s~9h^y8IoQUUM;SGqkcRbvxx3x1b83sk%JI><3+HuqrnWx{A{onIzK@pIgLS9aQR!d0L#E3R56GcWm2tpwP}hn?)w`%eoZu38Cj zBA(ky7DZdN5@18ycD(c!(vpa)Rsx)e=N^~KqOCFxY-rn#mu7rL#8t+D6Y<=PuZp(H zIIy8@J6@XcH4#@C2TsK8y?u1J+Of1QF{sJ{8!^}kDy{5> zh^xv1C*rx4tx>$jLp5MS+jhLPvTY)+Dhr&5+m*$f?k*~ktFZZ8pqaJkxjRc-~D_1eGNKOx>M+T`*6-Y(HQ?wWBe()ZHYf$ zIlf5$!Y0j__)=raf&8{(CtH@gh&WIK7>Xy zgdpuUj--PpQ>iBoMVq4#$S)3snRFM2j9rF#m)Ud|htgem6uW(NF5ShU7Q4)+yExQh zmxXi}hg$5inC{|Gi(Qt|T^uUi1;eZDqs!@T4qafkm2@|U(%ty>!1mGAbQgz=UHpBC z?W1eyE)J!;NJ-bzT^wq$%SO73LoIfxp{LfzmP4hxgsUCji?pS?J5;{Ax^YrZcXz0C z_wA$Y=`IdMyZ9rPmQRkpiB2-7-b!7kejjyX|BcNaH#!e>Q67ymEO4`TBDuQjKrwCR zz7JBb*}?#pU=*gob&CPjr2}gNr+&iHZJy&I$9qIqori$6t~)t9$5&b#h#YT-0p&Qb zHgIZ$bd4*b=>gi5c*`|I*v1zytQq3H)S4ku;l@<_=FIJUr$_Gm$lbi~1iavt+!aCx z((gUv1F(6==mPtN?ZfY)rek6KPzSYKclx4pES=}@PrVfAAuI*@rKe~zY3~xf{E*ia zz3c?FtmAHVxZk^XA>H*HcKr`eV9Q?jebJ4H*R07(qFHJU7g|MBTwR3s_n)R$`15H` zUgYn>nV>&qMbWR(d+rM};x4e{N4M60gDZ;GCVJQ0EVwzEJL{wW(u$&*8yWfUE4bkM z`!}d%7rRb$6Ev^`)*Xb;ZgY;|W}Z0KWLmcGmDnh7YopO~lrOC)qH0lh*ZZXvMLrK- zT2bWk;QM{|vw6T)e(Lcg_kOo~GEV2qf14|cey#(f zy)UgOazmQ=WJnVR!c`V-EXcS?U04C@A&kramsS*U2f8e2Qy09zaoXJJi@)9S0xNg) zs|lu8#E7a5aBL)NMbS6A_xG=dW{s>RXT*pK9@sRJt|z>~+|nrBX^0n|X0Is14gF%k@PGma z*0%YU&JJTaX7heg^h~5%#C>2a4xEUu*^4~Z%9cX)h_-5-z=pQ{Or$9uIo=R)RT1Ds zy!aesjY`s7QPfY3*rhG+F;$-!_mOedfDPkzWThqP7jab*;6yyPBm<(YN&;+X+m4r( zWKhIaNq`ga@{-_&d4-Y;iE&jDV8gf_S!qdzMO>8xI1$e+$%tsHk^mdpw&SHG8540; z65vFq7ZXj+vWskf|uQvuoT(v&nL_BxsIV9TtaN>J$z=pQ%cu!wud zSsYl4Q)_b5>(HuD0h;}K)McuUbe%jRwLM8qTbwNHrW_ouVoYXHLXb!vRjja~saQXsd<;Y-ndToCOhA4F@<8 zFS|cgpF~M;&|?l?oBQ{L8cyX^dW+()DkHGru$_(4u6jwtRT+U3@!T>li?%8wu%T@` zUfNZ!h`1^va3XG(k(X&7J$QA)Ezj2L@aRaM^o4cbqvDotf3B0ZOjhhgTZYwpbR#WU zy>~MWL?%Y@bKEUJNV|)0d7rM{t5YlU-2=X#xDrFbpvv9VOrbMa5OA5+(tFu$tK4tuirB!C97_)0mp*e)#oZkz)9-?=H(uE&o zcFZPs5o*`UURlm#juFYT&BL?Z4)F#%`)~+zK5wOeZ|ArJ3)@xMC-_tBz{0=l&&RP! zC*6-zSMlfc8{efyUCOOXm_}ZFZBNs`qA#s-TjjIht8`tVjfLN(ZLOKhVvdS>*715N z>RPlJ{=JXB=>m}o1CbiBXm`{F`WaxcV&!9PMq=@aLPYdb5Lm|&TindCHY-Mb0@*0A zHd^6Wn-gtSd0<03v-0yIt||{~i03ug1<_WH0~^|zjxUP1avazY&vSf9w3Xw)hIXdo z%Ob8E2iD@3?pQldD-?Urkl)+x`^;`sKQj_t?Q7;9{eH$;0h_>%!6W2XwzljwU~B zq%7r4TE`3lW2^`qC(2u>vYMhpjQE7%CuWHoMzY6-ouaKO4IBqR+L@JZKCD-jP9N60 z9w)Df;^BKS^ZY~&*miu|eb1v1leZc)2cJklVPM-M29)!_+Q6ybr41@CduWImUjQyH zur?DcRB1tdV#LS7Mu1}@*)6DFv{efNHncNa(13`0$GOVDvA93JFt&9oywNq#jMERG zSM?fWc=JxRS;bPJ9i zA?$AvI1Sh-=&%XiCiKs=^{L;WA92uh^i{iD9+VQP1`MoA6kFWP5PnFEss;_LjaKMc zhDBR7XkbG-vq6uDxN6YAT0G8H<@$_?MO7c*))qHYpD8h_>I1BeR;bU6Xsh}F8`_!m znH6zWA7Dc~@02ws+RAZYLp#&)c@bBR18eb%*02`DqH0*ctu1b*VJ(VL)v$oI(FzS~ zNwigcfDLV`&$j!%Y=a)j-Tm0Qdx?#I=Nk3maw85pg(1bV7*I6=)&@@fkN=(Ox|^UP z9o;Hh5ouKnU@aX^233X;t71eYA2>FWJ&afrZIygrLp$@}SQl}Xcwj?3@2K7oZRI$y zq3v2t8*TaQTTT2v7#;(q?}Itzo*3|WfP%=olxdUK&Zrgy9LM2D993FSU5uy}1RNX5 zZb9v$tqK8bXlJ&d4iQ%^2sjpRF&;AqqRl5Nao7C+w}EKk;`^QJ=g*&-x|rk8PN|S; zzreaeah5l8I_eUmsyzd1qZLj^-J-49Gq9nZ*`9kuT(xIlEgom9@;J017FB(KTU*>r zefq?xst>R>TA@DuqOIx!Y-nfJXF$YNeSi(|yffCIXe-Bo4edhG(x3=gTR=++I$5;B}S6tONe*IN#c;P~GD7SZ{c45 zd&kl{TD@b2D%E7$eP6keju8veNJhcosiMPv2+=#GrB5x=sMD9_{E~WMBE3A(-L0Tm zX!m}Cgpc=bI0=3hoe|+oF+$GUjCRB2%?~bG3G3II?42#f$HKFT@CF{8r>Yxe1(_?l z%UPQo}n9=>1|E=^6nckolxJ_#2rBzI-5KA z+ky18-xIwXt_%4NdIaJJWfObXF~#(o2+(BIK6*lhyO8R=tMgw@VElmvy0DQ>ViXtN z$9vb{`h@#~ZZh6?Xqf)$UGsg$`45rs=nJo-o%7d&uTzgy%)GDXC~%UcwTAD|(=WI# z%=K2i`1FRzL-@NFSRPo*Q#9x4L6VzQ^uxM8pSW@D{Ns)NkC${I(>3a*jSzrKZ1^xP zWJaHmrrX4f3I$l3sZfQwXsa_Uu%Ydb*j820UH5dm$Sc=@4SBTeNuGwXckTR#8vFen z^vN9`b4_;tjWj`?ZqHBp8~y%kZs@)GewudGtK$yw(Wk&4tE0fNkN*0v%GGhF81ac< zBfzE+I{2M2`W>Ey?mMc#j&9XYst=n@^54_`x1WKi_ZXo`1_j|s|F?fZI;O?bG)3oE z{=qy&%EplZ9EV3Qj>v9CGa|2=5pW`(`;{28qOHmgY-r;okhcHk3)=N)V0uo(RoQ_P z@!X{{^P;T|U0_2yJLd}`uW}BY$miyKQM6Ugfer1pO_i~-5k#q05JJ)`gjvasA#4?*zI+^;}<$m_>CQdMY|BrcC0qao2Mx_%> zznD>_1}-r}38C!yt~#FSExynY_d;hnbT@@rp#$QGYSO?Zj#P?wP|T=!flJI3vJ~|=a4v{;sh>npi-Q}Vn)RYTw=zG^CGq75phPv3|!(&rI^RWjEWh!#7r^fi`bT@ z#1R!QaET+8;++vQDqi3cGnXjdS#dta;J1Z)`1 zj%h>WRZPH!{6&hXcGeu@0UJiMV`>w56%()_UyLa}){5;h44tW#qgV*eSB{$)5-rQ9 zU6mGC`zbbjDlRm_jP9kZh#8d*U~Pt4XYN(as%ZNV_!=MB(9XQ7Src*ZIEw=(;<;Cn z>!Pi44{T^>H^B{&S2+hx$g&VjXf=z^p_puUUOzTpbq-43JM=>CqOpU?|_ zf0)o~u7iv21EiPwUrXP^*}T-h?Z@%J>@*tP=6k>{iCnb^U>&(cT&V}_7Bi}40BbW9 zdcYphRxJbA(9Ucb4G~u@12_@SJsSH&Tjd_u(9Z4w`$b;m95|6bZ7%^nUG@-SK(tlP zfemfS`L_GsLSE=69dw{H4M3;)czJqI45+*VYXhgg5xV<(b0ZiM11kBz+JMuxTTQ9= z!y>Ly51feSc7!9Mtx^wcXxomL-Z~x=ag}ypEl!=9z8|GK!sh$rD1F8L?KJIJ`eE}X zsPr~XS?n2>5c}s0t}@twAK&16m}zY2Rw%ePMQ?l8t(2ov&!HdA4Rcyc^CB2MYT>@% zl;lFS5MZ4Pr=5Lx&WOBfBfyD#ZX1~uZPiAA4eiV}GAH7yjR0$LDPsOT*?F;{at~Z$ zqta<1#%qN(6${f zZRG041HtH$KL?r8`8y-t6> znm&Ju-)rIqG~2I#iryfS-O&z;&#DOm8$M??!66a%3E}n)oQUT(!C}!>O%T}7wkuiM z1V=<%H9_D+JhussiMDEjz=pQ%cxe-y5^>c8ffMoEj&?@0z2n>y0vp=d9qp{hd)HYW zIFZloXy-)RyN;i9*aI8dnXPs{ zcy23S5^e7|_l3ZQw(WRnD_<6I?>LJCC*qf+qb;nE{|1^+RJgbDJol#`6JNINzR#a= zw_0)!wYp67QDp~C0<5qEqg~`x;eic#^RlM&Hg|_;d)N6e1~#;_dx=hw_pY-%upwW# zu<>twnRMUYL+4F8ztTDN=x4VyCVz#FDOxdiyfJ=))*m&-pW-D*?pc@dom!=#cZqMR zYQTnX*`arfys8?oA)i;Z9?@1+12(j?U2llIsv58%|HZ9ZpZKP#25k729eTgWtEvGT z@_AJo5N%a8U_(3G^+AzWRRcEUjjCZC+9f*HhQv2jHDJTH?9hirUR4d)kk6~yh-j;- z0UO%cu8)blsv58%zlo}y`nGC|h3Dnolqwyt;b8Vdxdo9|r32RTc#ghUzF3%U43{nz zUKATD1mF@IrO(lonP`IRl9*AU0BbXJ;g>taSQc#+06=I#(qI)}hGhtkS7wM$D*E1DBYgKAW;vzHGQ+ytCqniWj)VkxKE- zi5V3yaEX~>ykXgsa=Yp6~aRQf^vEnQ)7urP3 zi{gxm8MwrmN--~q85J{diJ4-|VJZ#P*uBbi6Y(yKBPw3t5=SbXOz z;)seDxWti4@vey(6)$j!nPR-**e$l{;=e15rPswF6*sVU$Paxm$~T@@H}5M&mjN3h zui^zZo*i4e$g9|Z z4f$5FZL(cKjoC{Q*oh@SJa&j ziy4&;U~Pt4XYN(ah-mu|_$nXR(9XQ78542uIEw=(;<;CnQ=+YM4{T^>H^CW^S2+hx z&&~O~Xset98`{}d?+YTYat@rx=jMD-v{lZ54eiXF zFNwIyIj|N-7v#RoKHSNrzUzy;ac0a@8V$b>y4t0awI~Y8k-VOobkB zRkT&h05-HUTgIA*tCj(ri02-S>!Pi44{T^>_kbHBuW}BY$mdRPsYSD8`NRNhXj9H} zmkqax0hM=PZJ_G1;kp=5$p_X3s6}S4Eom2Vm3rVrJhvn45N*}mfer1<=H4mdD(%2p zoH{~THtf0{-4T|q49-|K9LavsmkoDGE>sHv*12%k6xoMox5%qD0-VU_wvisuR&4~> z(9Ucl4G~vu1Xzp9DI@=0WuMqkxd$$>QE6b_FJ@E?fVCOd378Mvn{)o7+pPnlt!e;l zXuB>lZ`tsm7*KTp)&??{4G)Q~$~~~wt=8^`MPB6`IFZjiEscn_$~my1ZMXYoL7`Dt zQZOdsD&N3~clfemdt=cSJ_=R{oP95@lr zZ7lPmt#S@*XxomLHkJhuR~ZLR#B(#gDB3FHz=pQ%cxlF$L|kPYI1&Fhx@>q|CO)Xb z0w*D45A8NYToo4B5YIbh)Z|rXs<6O@wq4lL7TG4^s<6O@c%I{R(N-A;HncMxZx?Zu zabQC{&+!h?Rv8C2v@;#=6mgYtU_%@OXtf~tk}ezW65mwCfDPX=1Me1bRWV>gJg;Is zqOB?hY-ndX-VkwBFpB((8jtHng*EzSl+G zyUy~!iG1!*xm~oq>-b5H1=!HeY~>vy?j2`w;6yyPm3NA^cN`YTabQE+ZY-s(yi3Hr z<17xGi08KQZqfFRb1Mfnv~9;rTX~O&d&gNEI1#@jtJx~tPHBkGJ|WynfDNBBn_!=a z`-HGKa3Y@D1p7tXJI<{H*wD5sS=s~#MBF>h;=qY`ZWA07ZSOd@5@18ycD%F+4vDyT zoW+3?@!XDfShT(4+!F#D+SwiLh{$`_Sspl%&+TZ(MBBTLpVVIg8`_zzd`iT<<17xG zi08KQ8PWERb3+6+wC%=H+RA4|+&j+Vz=?QnE1wf>?>IL^U_;w>ytI|ii@0~3#eoy? zOVZI^>Se=yGSNqs9XJWF!m{ChkynKWHssCAn&uowB)>2ndO)wFjk8`{~u#GuG~ z*I6FekS|==d=Zun4~cK8YQTnX*`W`Mys8?oA)i;Z5z$sv12(j?T^|#9RW)Ek{)=0+ zDe+BJ4cPE4JMvJNnss?Px8&zAQyW5v&+3>vhrm6;P z_?8{|g2=0?0UPppRa+EoRW)EkJKOaokylj%Hsm)^we!7e^eB2_dXY}M_%7qO{9N%{ z7@n-tcM`kXNc7$2qs!D15nJ(*UvQ~wG{JU7 z45`q8OAIBkpIXLHJAYO4s+d+W0&CONo|dnPyowAsl~01YST9Fhl5wmG5;*Y!Pt>wr zj<_u1Dn#H!Joi#?MYO%+JPHFgw6nXgRgw3uvpjGjpL;2|CfeS0{KO4fTRSu7>mu$Q zXK~=f@!U(n4bk?F!vZ-DY-rn8RHc`KHG21ve@&-%oW+3?@!U(nHqrKua|a4+XxomL zUJBMl+&j+Vz=?QnD{mKV?>IL@U_(2*m3N4|cb(;d6Zza$-YMGNb^OE)T3b7_m3N7_ zcbvt66UTE~dADeL$GIT_8`^ebDQ)FFBJLe$ao|Kex0N?U+dIw;5!leS9WQO=eIo81 zXK~;}91}YIVs3Y8#M>#4uF~5l_tKq^9rQMi@DlpH^!CXeH_@|k_ohnP$-N@@R=h?V z6HuPzUKL-j-7f*DYyqbM<(~NlL|kPHI1$h769z@wJI)6!u%VsZCk%-b510#3L)CV+DH}OETXdFX zXA@c1j#FpLZqx0ZD?002S?`>o>RWItVf}iXz4JwPS$IAXc5OFRZ8oncw+lsgxp^%Z zs+p~JvFI$zE+(?Mt#+yCEH|$uL)C5w&4VFo2+KuhS#~**&26|&i(g4Lp@*b`b6(K#kTFfm%2aYg`eNx{`7Y^aKi$3IDYW&>3-Jn z(G~iWIuz=R9$28!_v0U&+S?fa>&DwpcYOuH@dr9+&P4OpM<@LizK3!Yf8f@~Pd$ix z0PBU@0;9ilGwqzeP<8nq!pI%X<+~Sr!x#ll(!Jg&o8sJTbnz_!k%zFzuO#vm&H1IW zm$0p$f4tSJyTpbHVYS>w$&H-IOcctRm{Fks8<{fi={3`&`={x3(N-Y<8`@>Vf~LIg zRHrvYUbzlz$QSPEP3&Di|Dp6HY&7({;+6FOKXuJGyfKwum+EfX;rlLciBJFTH7aFa zd0C?aChbc`fny)N1)qfr7>N?mCPsWBe9tlpY#O0qZJ5ed_Ubi!A6#LxN&b7<|MuUc zxBxpYJy;}Pr}uRf_waxFSFhn);3^!&b%{&0AK*AHTFRc?e%eJ|wI5(ZKCkI_h_-Sa z*wD^)y;J0s>%fM5q3Pq>F8vkGj*m5)xfHS87jYE7b$L6Y^7_A<<3iFob}g+>DbyJu9l|J`5M@T*5h>91u#F0wzHpGmI7r4YsG2Z6muF7%ti32K5;1UNa#n~@r zRGh#iW~?|bQd=GnXH?9_1HEVhNCxc-qV>L5=T_L zz$K1Uig#GdsCa=(%v_>)N5l~oFK~$?mEs)}Gb&!-5;Mhk!?9az)5U*R7}8FOLn>}y z?U2*dH8&&jDqdhi-iozCOtWHC#RO~^&5mhKl*#vtwHjc@-P5A>S&tO}5KLaYV%lY&en~=aR^)IDrlMVw~X^tWdjUF{)w$HjHM+ zv?B5C`V~UTpVteFk!%dtXS7ltT!%oKKV#9}? zOrDC)!cq6RCT4W_i5Y5*xz{c0qU}TA%Q@gAwHqbhFI{@AxFO=+aTW(o#B;9|YceZH zf)9v7_fFr zY*acuwTl@QJ#dMc{7^c?h6)9^#73o1I>n3%1-Qgap_u0L8~40MZe({+K`RUyyTmOO zJ+OAG+L6~S@+xXzEidgPzkoerLxlibVxv+48)8O<0<6tQzsX19vnXCS6%XAgib!4W zBK>>Pvs)jh?)WJF#t}=OEgjg_c~n2C=<$1pCtQ>MZ~vqM9WswbPyHPYk}5Qj9ytZ+ z{3fR$-$d}J&baH}yn>IOwX3vO1tWwJ-Rt}(HU3nt=Fg5{6=(Y-uG-y&F^~MRyVhx>eKiEiB44=xFottN7bO1 zQPl_5W~g!HR)0veRrP@l?aYDMu!yVb11I9SgW(a;R=Ec@w0+()?wO5=yvjMSA)hxK zni6g0IAEwJHEcC>RMuc8Ik^3ucPpFQWr zh6(|=#73p#d_l~pP=K`=SA|01p2gV{J!6I9Es9Gja$v)y?BXqnyowk&kuV-dx))zwmQUs4eiXq!-j~f!wWbO&mBC}=s-7S7XcgE z**R|$d6jeEL_Rm?b&RQbMp@bI^_EX z)S(2d-IuXIrSo*Bm{H{g)@GvGI1$fn?n9!jQV(osXEyg?5m#vk*5cHgxf?^$Ej-H}?F{YMs=MP4 z4O#3No+S8r)2=dlq(aXgc+DUV#%=Gqm2!0IIrO8#C}Tu&p;`#A&V|#?K0L=nUbPY6 zL_W8TOo_H?Bfy4sW*eCian(kEwYU^9|MGEGY^dA=m)NLuTAC9xss_N?jB9G!PhP4s2-K zj+bVR}r~Zge3N3V_Q$~;I zs*D3`T~|%JMV1~)4G~uv2R6j>GTtZJD&xS0cBbR~BCfIxY>4ZDEDopZmsjcMPW_BO0CUG9v*MtN zA2@L^`?NJD;wpMzL)LS;Q1AOF)+9j|K!g+?5yQH%nn&m|z3T?7m#C?WX95@lr9pLwfwrZEahPFK_DIMT9 zL|nB?;6(hKo$+&J>$v+wTeVAIL)&(|DGrT7#`{HFwMpPaJooy0K(xK%{AMg*Lp%HF z)}Y9H*I6DokIB+7K+sdaz+dIyuBVa?@cD%He&xp8poW+3?aa;~87G`E|6yCXaj%VdR-Z=Vc zdOzQ5Xxl6Qsxf)5o0yMT`tQB2HcJTtHf(m5;2z0iKvI1JZjpOS zaG%^#f`AQfJCmIyctCO~LBK6?ZwU^_EhPxp;I<9#EWtyPO9=vQk$W5M5xJw`sS^S= zxZRERnDo)~L=U({?`^av@v-kA^35z%BA8(r6#u{QTz4&j+g~?)=H$ z#b$9__x!Tz$2cc`YU0lCyje}Ly+du8cYI0O0k<41*!5|J^pbeM2E93R?_3I4C3iGE z4P(Ftx4TQMlRlcB=m8t_jirG4H81f#o)3og?{G}L_ghc*xBmMuro!%g5BeLw-rsnw zzwvt7?kp^Y`&{3qZIU&>hHY-wcStW;18mUyOy4E9WDT&v?KXXn^pZ8e2K`%`wSC$q zSp#g?=63yn^pZ8e2E8w919D5&02|zH(+^26Sp#g)8(E9HLp_nPc0}7GYk&>g+^!#! zUa|(*p!a3%gxr!fzy`P5^i$GH)&LvyBV_IDfBR2D-}GOtIH!S3g3?#1E@(o5<9 zD?P4O47xWa4Hs=*?OH4u3y1aQ@)VT9vgL9zA&-~5GUxpEy{9h8`5? zDsFcr&5~X!39v!$YsGWq7SjP6+-}qRq!-fx8}yAqaK&}2#q{6?zUzY>npw~X;~o7+AY?LLVnxs2-zi`;ucF~&EHNz4Ja zf>LlAI8J(rIp7w(H|9NZOUwZq+|HO!l3ZdASjj^ReR5lr7S0{!*%TzHfYo@;Pm1Oa z3zU)M0`8Cr{U^k$dyCRSe-~+p_zSqhkRpGVC?oy??vQEvTW_((n1|ztv2m76)^G%G zT#;U;0pcg%4g-q(T%nBk3AjVX^0T=$*$6(b(irg>aECEPKCe?od5%l| z6JUeB=~F&F3w%4GxcCOx5O@1_OnUJRut9&BZzI;_2@MfH0UL(6{X8YT_zBpcZ~9q} z!GheKQ&fBcY>2vjx*)yy1lXXzCZEQ_RUm79D8PoO+oy5Ti%)ayjjYK_kcTO{PXWQYKSXAgoGA!(RrFB-UC*%DsFfAE|6Zl2CVd~6Mq61sUa=^?$9Vo;1XrT6~HP}Maq}F z)wuk&h9uUz_C;*CYad3ey=&ik{OfwrcPswf+I6LL*S;yPnn-*B8;-kI@TN&GaRuC> z_pT<*kUN^57S912+|JdcS&~P?6FFcdXKkY>hA+Dr?%FpNo^1@N#p6EB=j)np#Od7~ zkH6&JwXbmbWscrS)&X~TS2U{nl#%QMR+$hRZ}#WOE!hWba67ZVKyt}G;1;=e{dSSu z5_`Y~x4S7XkzQgB*r4}KhnC4LrUN#(-KMXQUQ7pU&^Ma!6<0SeB=H=u zVUjy}d!!eS0k`PAoo%1o(e!la0c>!G&Ngw!w`<=41)}ju0I&*_?%KD^*^~qyunJU( zbx$f*NH4($Y|uLgJ-Nm7Rh!#w`a0>wbijt`kKf|9(;O4u_2TbNHh+vix8{!pLu|k@ zl28FQd~t{Bkn|ENz%6?35IZ8b3^Bk4w{!AvOmZ1sfLr9=$-@b`CFXz)ZgO}xZN{_KItXqfLrw5Cs^jmEingda91-0 z=dOJekhm|j1d4afLr15miscfCG>y|ZfCi#kX*tJSjj^- z(NDs&W-u78%gJf!<7kkn;|X!@~z#qkFk&nS#8B4&LzE9UDru3H3C>eUC{Di8){+F20x_ky~O8*xpm_#1+6QQ%#T>d3}ugEs*Rq*(}<%Z;`f12ml+lxhE1! zq!-r#8}#N_9Nw~-O_-O-Ev5rDxZS3&kX}p&Y|uBdcEvTm$!5kz*|l$#28#cHTL!uh zTk9kj?*SX+X5xl@E=$}txufCfst#a-yE<(7cJ14tKr}uH09FC#u6?`Ym52jY-fBcT zyZ;`^CE|b$a$m&v$t@8FY;ac*_wCwuKmmz3U=?_bUHdRV-j-eadfb;KMhRcTW6^-s ziIiT~u6>gvj}c1bfLr9=3H}thqv22ph66UZ?YitdrJ5$W)Ft2+xp$kL8FEL%(?A7m zaNCA=ZnHB>a;ZtcEpqSq_Z+#S;b|Wizy`Pb>Qdx> zotsH5kUScm$N{&=y;Z(Q?r1m^g5iJ-Zo61It9*&%(eOkLxJB-*@?~;I!&8+5Hn?rW zJF9$!2izj}mf$YAqv5Ga02|!4;hiP8NAhTRA_v?e_cq#na!12cCj@M8 zyBqBR>7(h19&n4^+h_;mj;7;l=vROZZfBJrk~|uo$N{&=y;Xih?r3-_M8F2OT`Zkd zeoXRccp?YfBKKDL3Av-;sSp7h+_vGJRennHXm}zA+#-J>jrK|J+PBR+z9j8{TMia% z*RVr+NjzYK-aNnQTngAFcQic>W55QtyG!hmKAN8B0UPvw)CRqb)*yeWq zfb^0zzy`f9YXfpi)&LvaZqpA*FIfX@(7&}=JECopHNb{#Zr6`VFIfX@(EGA>LTUgJtF z46woNHhrA*k~P2v{Rmlmbn`qc_;22w4%ZjoeShN4D}Nf@`3$+E;i*{wHn`nYK1+J3a=0&57f2orPvn4GH41l`48jAh;oTFr!im_kVK2`5Mw46eo{I1{;T1rQCte@(uNp7DGgiGi zPg0iYOAJ&RRe;r($_MwTS|NQ5RiX#nqOV5PbC}eB%V=Rx!`Pjsv59u4MO%%Y zHtVp!Gh=s~#>VQtxofc6#tvySWA~cICfdCgZFO8|8{1XExAvRH#`?OsZ?MMNy^L6Q zm%Vk+G&d0+w1~Y`J7}7l%4=Y-I;-}uX>6iBY|(nF_NZxWDz77h)h>kLV8{yLxM^&n zJ#Nu@tM;U6Y$~r4gVi>+vuaP9#wOZRrG2aWd}Gn=6JZPP#;Y=Zy84l?%J?6uALGdh zPD5~V@{xe`AFK_+8ENPxp$~m@Dtz+l$F^_vH$Kz8TKKHtZXZ|}R;HRSJ3lRO%p$N{&=zjzumXN3j#cDZgv>1Q!dLkMsy=3hLG zF@oZ*@}(@|smcMjBL3K?FC)BW&pVR7cB`SEPFHY-fzy>A515>X{DKEoQHhpm-2E- z<&p0?)Hol|i_`ZsQ3Y%q3EhieJ<`YNWTFS$qW3N>Pm(*Do(|%G4Q_iLJiI3!9K++u z-6@hs!|O@5MeaR%Pm^0>4!C7_!Hpd=q?ecjZqa*VK1*(iIbeg^8S^=kOUwbc$mP++ zG&Ax9GiDS|GP%39!NK z%+eysB};%?SeIm=HUlF;PCUye*%Y}i>g2RU*5M)$0Xr^4aeNi zjBS%%5)QaU?>)2LA-5zPu)%F7yla{G?k>qC;eZWt^N>H}Ms9`|kM8b~TMP$ma61j( zC%G67xJBNq)Qix=v3(5t_S2sTR*yB-cYnO9zUFNsVY=f@+FT%Mua&O>Zkcz{v352L zEaKOgGxSL=z5{NNdpqMixn-aLHn`mbWr6fEPyn~+y)j=Tx6~V8gWFkeOC*<=12)KC zycKFLya@8%r@}m;s<-%ls_>42mtHgKtzbfZzyTnM0^BmF;4$n0=_OHsTlC&T*de(k zQGg9@J5ikz>LZd%q5!wZy@TVJ+!AxZ2Df`~oRD5(4!A|{jrl3LCFXz)ZfDHTNiH!5 z+#+u_iguDm;*MrZNod;>jB9n;(%M^-iQy#EfEK7aNCA=R{0^xCE|cv`A*mt6V;X$D0yKur^;qEc)S#sF@?(SDFdE@gD?U$?q zR{NYLg_F zhy!ksd%M~cxh3L&4Q|`;&aO61a)~%#C1=&6FQu2jY(97XsOkmR)ZGfsVrFQ+WEHU5 zUvazV2eYJ?yaH~~d-FO+ZpkZPgWH+cKFKAofLr9=IoUk9CFXz)ZgGPxz@fDLZj@XqeFLUM^X;1;`+GX3s_|e<^#Lrmiz)XxSjdkBe~=ku#z)A z{yEt`H6#asJ2Z-Na6lQ!0brFW$iaZzk^{g7w=)NaB$pfjZjpPt+7Y=W_J9p;+wjh= zc1&`KIN%n!x2v6yTOtnF;I<9#>}sbZmxu#aa#sBloRc*!Y`ppgF1zt6+@Jhy+~iST zQ1eFcf=hl9LBQ%{H6EN19Lr9C(oGS7Tjbu^&p5fIW&s=A?ls&V>7{A`x9GhwpCq@$ z9I(OdjQJGFrD_2iSB_XA>`f(<}J*8=LQ{E~nfNq+8$pRpF0by!l4oyiWN>f8&{N z=s$SxH;iXz_4&pIsoKnq4c_Q?&4-8d*@{ZOu|c9YH#T@9EF;A$Mf!@YUbVM@+p~P% zf+TJ3TTtLxzHdRIH}@^*@@z7A7Seco@P)K2wxCZZZa(+M?R(*~SG%&8Z*Y)|Xm4;Z zREa6PQYgz~zSThzYHxKwp^(fqWG<}z#ia5RROprZ5NKRZ?{TXI8U28DfDTp49G#?) zbOOK~LU0s`ydFoVs4pEFaEE>xlvhSH%jh(Pq*nv(5(-ZjH=JEX?-_=>AgMDnL3{<= zWkOj}XDKAU0`3w@zNQMUd@bm%a}<`c1+2mqx4XOcNiW3;Sm{IB>IcQqi=O#7a))QY zwbM?Ob=rBFAzlJjGs?VNAia1ASm__r%jr?O?jj8me*vpO!_iSzw@VZf&jEJ`VSFNs z*VBxasV|NK?$9r6Mk^E&M*(*T!BHggdK_J)esmO8gncLgcjy;7x=x|!Xc7Y4C6qc* za<=M3!@4Tyy4y5CdLLu=JunIjHKUXOq{lr(C-nQgN^>dv< z(a$6VSpBrdC{BMyAEVneL3{YJE962U0qzn?XX?%CmBWY^ zoTT??g7^x!%Y-stCn+Sp0#+f^@{?UTpQ0(^Ghj7k7}+wPrzs>p16H9Y@AC{z5uX98 zDWm#4OCj+YunJw)vv`FBzZ6%cdRy`PLU;=8#@bP!!)NgdQg17MkDncf&xT$UjEOnA z5Mu>Lu+-6VVW?78AAJhNSS2CA?O4IBaJXw-O}d``K2KA`XTWO8s6H=HNPGs|C6xMm z%=tB(Ixf-#84G~BOeo9m5{06#kPC$bxJxMYcO?5-PLr2ug7^x!%Y-stS12UD0#+dm zTcpyeWsdt{l@*NNRhl9`16EUpDrG*eQ%HOUtU^!T=WUuIJ_A-$M)i4zLgF)E6@t&l z0lhTOXD44i;#G$Eu%}XU6B<|*#u#9=XH>@*C=?w}LV#5$KPS1KHR(ml#{?&Nz$!ng zpGy=HKLM-Ilkszz@>0lvRen@IS11(ygj^^bz$%pcc|GfTtCSZ%0jvC|ey&qU`~<8* zPsYz}%8Q?XRen@IcPJ!&0#>0XQ~CtwwNGJYOWUg{RG%8%;jF@>U^kPC$a zScP&wuczOhP+t55tn#D!c}gMi6R-+B89&b{FMa}6`BDA6ppf_pScRU9pJU+$rRKaZ zl@nlH5_`sIj~FG}xnULNzFZh`@%)a7cN7vo*Dn!zF*=F| zpBB5G@Otr?Ed-2UO76zZ)6Y&0 zA7niJ>{m2?V6i{KBaC-`E!KMTn#>?V-TOwp5jSz^c)D?)H7QX8+%i9E#F}Vrjg-k` z&r%&wMxq4RmT6Z0QLOw@7k8NH!y0}LfaS?EbOkIAV=>LmW(Z{S^QSp^1`zT+yuJ4=5^*0=`_71%KWw`15ALhZm(ucfa$#@X+o^U2p8dKH3GiWoBVm>XScSqfUZ?gm$fsSstw-*dXD9@2zy|m2i>HluZ4JrsCdEbvnF7vKA2 zz&5I1*?7?3`1StAYt??E1<9PDfiV)PPynle6}K~)vm}q+Cvw0_K2kF0s3I-^?ougB zW}iah4&W}Kf|=1gRm2^@T`FbnEKo??0jxq*>W5{ydFzea_rqiEzZz;YlxnLs19m;N zxkv*g5`YZ@owd0{a`7Ipl8;oI%Ty5;0C%aBC3A&B;tt?0p@Q06rHZ%%xJ#wXoplO{ zJAhT_?W)af8YqzfY#8XQ%^i}9_kfjrq}tr2insu{OQkHCdlV9P0Cx!$)aE`_#2vt0 zDrN2*P)OVXtU_;BZ4PLlL;|p3ptCj)NiN<4R`QW*^N1?q0^lx{vSc1pNZbM3B~(zG zCsYx40C%aBxpPV(aR;ypT~}>-x3oH^ff5P8Ed$TP%SNn|hvB>5vy+Dll8g6%m3*Yy z9OH^$e}mr9vClN1tn0IN`_&GYbZRDBxM zoNqqSbD=33D76W=W#DN?ZFZj6PLn)(4~bAUfR%it+MJ<^BolC#N?9^zDJ01R+$B^{ zn{!kVcK~;(l)2NVkhlX_g)Zrvk6)W-zy5FV{gk7nn-?`CJ~OS08bg(`_{>sB;sdx9 zAMehbbL5Urq$?4C4Q}sy#7Q0vPvrd;d4AdF>9G1Te4WcMeg#!LPa7mlfYrgFN?Dc` zC?r_|tU{rRy;)i$w`2*h!R^e_63Hb?fR+3SW@(u=NR|Mr4Wnjhg+h`gz$#RbrB!lE zmH->v&Md8yT(SgM$uG}R+Q@Yn#)2WW!hLI_pZFS%rhwIyp-S11TBT6*ISBz)p@L+s zlRG*Ah2R8WgWH*`ZIVls0dA3dH+S73cQiaTRlo+fZTN6YV%XQX0 z)$>I(?rPcmo%h2(H)sUQFw+;-ABtL>cR(eOkLxJB-*whMAc!&5;3 zHn?rWJF9Ih>}nqGc8Z24a==Rd)>Yd$O^W`eA^@x=jaqFz3Ps^WBN(jR{OGyiJDC-$~E!Hm&JB?4Ft9<>&CC=?@;gaE5hs73GX5xeA$PNZ@HY;fBv zoSmykdnAvBCvw0_K8#Sod}p63;sW374&W}Kg4#Txins%~OQp=6QwoVYfK{kU z{je;X%hj&iBixr#XrM&m+%nLADTUq}m+&gL*zBE&$dT4^_&NIZh#Q2XL2A zL2dS^BJKe0QYmw1l0xDRU=<3r*>x$!Rh!;};1ms%NC0jb=)aUga`Aq;MLw*Wf@IE6 zMO*-^E(}%5k~vEuaR+dhP=PyhR1tRocd3-Q)2EQQ16YNwt8aR1bDjoDBmf%*I*;iK zBp2@iEBUZ$3X-`<6>$M@mr7YOmnbCe0PYehaA%n+;tt?0l`?l$C?xIxR-x;vP46*% zl?F;A0JjWuAJf-KF5UxH@{wwDn<~)-XoYn~z+Eb3$=sn(bSDV`?h-1f&0VU9JAk`X z%G}wbkhlX_g)TX!KmH}?s=z}y{!@L{BfLO z!0L31e5BeOP(_jnSX~&ZlqK_!LXu3tT|x!5c|;X)2XL24nLEc65_bTr&?SBI@oV$J z%{Nhc!yFWZW|nJT5*om2@ld5KG;ItB@cj=e3*x@lNK&= z>H|S9elXmw(tGJBjGXYUup2MEj(;>(Xa7NXe`TO(Jg)f!p5Pqt(MpLF;FdEZJi&QL z8HpKSTjm;{;2iLYLv^wHiNjdX&L=nzDWfiS%Z&a6=Mgop7(k z)3#xs*J<0W_2%{pvB}?DH(1fOE~AA(!`n1&Z8wcgwA(G(>inn8I=q8BGj^wGYzo1S z!HTo;%V_n+@LRi0V-xLei?%vEw^=(QyVo=}g<#KMbw+l-X>6k1SK8sBARLmfEVC@e z2Tik6Fb=x-WAD0BBCF&<(}g54P>F&{K5QDE0&{4vI^%uRG&a#5DeW-c>ChVnTv%5P zkKyW3xA$^&)cxGV!oAj?;Fw$;oEyjFzZNFYArRgbtP@VhV@JZ*(2)SE-4(ZU1?!aL zNZhv_Byzwla_{oSIk}~k0yem9!-u^?2l?F#l1Ia1-K_y`k%#B1`Fuf`N`+kVG3%cR zUWa`>n$J}ab6GG0#(Tq?g`46DSj`%$l+A$0DI|#l+$B`tPLC>*Lcm=rW$sK;NYV+o zOK6zWpG6Xf2i&d)=7%9Kh{O~PjFCu*1>9v|StO<@B#8ywB~;+f3{@ntfV))6+?l12 zBo=U&kUO!V@p*gG9LssZf9@mlUz~=Sjk7K$a$(r3ITVil%;TiLXtwjT|xyF zxkwdp2XL24nLA4q5_bTrP?h>&F*YytKmPJoL2WM6K&ef@hJnu7Tp_vCCSWBWsWw-s zBFO~YrBas6bqYx`0e1-%)aEu-#2vt0DrN5MP)OVXtU}jPnB3vm#JkjIi`@r1h5Jf)aD7f#R&oS~@_6Tn@jmc?Y2LJ||eDpXLLbL18$02|!S+U%2D z3_Bh}_SRm26rT`FaHSfG%&1Gr0QgxY)*E=Y#|Zk=F5+1JB0&$Qj_;l|BRKe+h@ zOxV2n>9C+X@$z2{dnSb6E!}u^k$y=40k`}b;mYI^Wh8unRVI}28}`PVZ**BV%wO3wn4nth|O zlVMod4?lh~OiPVT4Eg85`>U?!W)aw?i4p<89VW&oTqTnwafdPz3BW2-P=CAR78d{; z-0mdqkzPy(Y|#7aZ=c-JbX+lrN1Oi*M97pqfwGBz-koRTT$=mQ%2GTxI^Yzd&fNG#Y?~{ zUsjY0q!;f18}z=STqL&?C18WwU6f0tm!br$^zNdp&p$tn^Uog-`xo>dtStxHst0X; z@c7k_ZQtr|e5U_{Z;X8t?h5(fQGeqHw)-0&+UalH+U;*VxA*>yoBNwLk8fYRV`A+; z{*rKt8vY;dyA3C>>kn=|#7V&B&Gogx#GP*pAB4<3v`_jTcAfMc()SozL?9ed0ITm6 z_j{fVD#rU3hV=M_;ca|(k4PUwo9F=>^k!8IxwBKAV{(h>fDLZ9=_jNY(*YawTTjpR zx1Rnuk`oRt5Bposejxn+pHx3rH~UnFe7uzUG!Wper}%yVm-xwf{3JvWw^;YK;?LiS zS6Sa2q+3l3QhX6;n|BDM8~`>PamQ(l_peHv0JrG9PbiF&JEj=n3e^eN;J$tFPNO!5 z_g8|WQJX!IN5d02;1;=eSWS{!Y7?-*?T+~r=_TfXTlC(TPm^0>4%py!#(ak45_7;U z@-T?Ppt^VR&M=^w&mQ!i8+>l!`Fqt!kl)B|fPCk~onH=@V;SA8)1Wi zFtn;67Ph5%^}8ni^u6!@FI&iWw2*!a`SUI08(PR$<;eGaZEWTr`eW6o|Lm7k->NU) zGT69zf~|7;o42;Zkbf%ud#Ca5-NwK78vowMzr&hlJUWE8Z1LD|ietm4Fl_wChFK;{ zDgm&OtggfEuzzQ3Npqx^S^#X&S7%SbkFf{u{h`m}d!5%);G2qwp&)|M0K9qa?FSv{S+WSnZ5q zK-FHF*{rOWNiSgltn{HPJsR|19AL)QT84f2C^WcNyJl@G)DRZ{cWA`X`Iq&%j?L#X z8FfXU7>S2RA7NTXv-{Nn*HDA}EC?vjqtfYs5mT%9zy^Kp(|nmvD-;!<02`uipH@jPJ^?o9bDtK< zd|Icd_ypJxb^EkUdhrRcL7)4ySmx6XMa3t;hN#=8UDAtBfDQWGr=>EV_9!Yo0X9V4 zKJAlUd;)CH=RPf$`E)>0@d>aY`kt=|Q}s)azW9a4ylOyt@d>a&AARBpH`*RfEkZAR z=HqDY;Yq8*&=0p(%6vVfG2$y=!x*=(N2C{D0UPw0uV{y+ud8Lg9@7}{6|iB9+t(A) zi?4tU`pj3fNz>Q$@WF$%z3>&;E;!FWoU*M71r zgBKJNUjVno(tCs3_h<~ycyuy(cPv=deiYKac2!R)H`e}s_^Zvzqm8xw>faS|7d}?! z0KbUYSM?F*(f_$laQiQA;g7ne(c|H>=E_(KFW}tcs1Or)g-GUik0O#oz$y~%7YGkUig`OM$6ltkKZT2jZ;X~RO;(-^(x?8iR#j4Kg!_uFRG0?s2JmJQrJ zr%!rGEZ{ahd(M7%47NCL^OTgr1)NKk=WT%^;um03gs%N$a4lBr=B9}{z+F}@l#mQQw5t1yxwh^|UmnCbR5|S*yEs3&ZZBs##1=v=wowzJnJCu-Q0d7fL zmaL^wlC?`CBw2uMBWyn}OV%DGBw2u45@pHSr-CF4u&rP_aapnsC?UxL+>*E~S<9m& zYd|9;S%7ULY(Fnc)*&S%S%6y-Wyw0Cf+P#DtzbKGS+b5PA;|*VlDI5cD=}Hs4B2k? zVKUd%?oVihBnxoMh)N+YPqdF()rWP%&u$+$rHG^puq~1=Qml^R;yKmDMZmUtiHjE$ z5f=g5BDss}qqsPBs&h%$fEx+}Y^#^JI8G695wI`bnKH8^#`kTA)dyU^%JB+{2a*RJ$x5%v>B^_Yd zjdj0QsjQt>-!Er5PArLSEB*{?Z>*i9&(im;_&t7hnm${sJnwDoR6j>Amm+p|H)8a1 zIpKSP-&i|OTrpC;t;neni=1_2h7pULL%eDKMaJ8-@gRQIvT=}bwXr908H@2{R-#U{ zH+~lX9sR0$1n%MLRVU&|cMM+qrQyGCtc?faZ0Y6e!tYZEpU3)(zYET#XmEq`##%2L zxVCJ3Hkm$KNuM>7I+Z?)I=!vPgA%>5Hl038e_uItD|m&__udueQMh{4_;>H4F)Y2m zo5J%j{NCS9q5B6ZOrHsV6Y%GMEexLUw}{A%wV9-ptckb3;e*-qLHdQQ_;WOGE`D|s zajyTO_m#;kjIs3Z-rZzYG7r+dk0!H{dCv!v76J~}UZ_m!2loEv&2XPuFSyy;ifRk@ zB6cIpA#aBJ*5YR|P}OI+mkqzq1RhmEkBLt~zMFo(azETE^lIHl=A%dE-=+xMO?I^Y zc3~Ke8*7X42R5W*8gZj0Upq+EV11T`L~{sKe;4mk+Iz>uOMmKHt2=ntl5C^p4HfFo zqEeMUlp zeUUYm`4Vc%f0yDa#pOT=xaC>Fa`-ywCVcC-QvqG16nIt1e{x2e%a-aB9cqMxrqA(21n$UTmm+@ zow+K1?Tr5g$tC`PbMhGf zjv>+>PM7{VMpV6pa(IH^Z(r0i(D2OF+WW(-pt`$t5j(+~Pag3eWOK}0t{SArg>Z!x0U9#)-l!zm_r5KW zUd9dJ7QJ^uyG(9L3SfiVnUochOHu&0$h{{KtK^oL12(wbF<&RW#2j#o-W&66a!bqs z8{E#A?~q(#4!A}B_Mb%T(pt$P;N05slZZWvNG<{ABJM-xKDi~AfDLYEE)Pg9xdfb( z7oJ26s37qNY%9cp)Sh?Ab@*)Zct{b6Kj2)%9seV8OZ)*F+|KwPlU(8tI48gKtl&CN zBIe~JqWbCDP9jd|uT%rz+~1I>uAVwPMrU2e{(y6d5dXLSBm!-vc@i-huX$|6@9`pQybcmCzD%XXMqE}p zh`(E3jo6BxJ%6uxF(zWe3ptTje;;*igrHfCvP8RKmpY`rW{`xZJ zjkQ6vsl{~>{EQc-YThAN{H)D&7`TR4QoPgF8D?Ha2jEub!}SL5jybcWm(c;ZMem)q z&XHTj1z>~Qd8qA^Tt)<7gFN)q%gzn6RhfBmi{XF`Zl~c3Bp1U08{|I27s)M#12(vw zhA)v^3_;f#6hI1ChCNl2Tj;JuFFvwG>Gz7$-I%pXZ_dVS$n!te@LCUC*-M!msN z;aqi@2FuU^tOnPYG)ivbTA_#xAi%kZ`^dOTZb>I#gWH+Tb&^Xu0UPALI@~6=7!KIr zb{f7zaxomRLGCkrm)v4FV1wIf_#Vl{aKK7F96-afgsw5vIJ#Xjh8mX`R(`*EIP&)N zefl5)0<1n@2zxK=ACO!E1lS<=Wp+SrF&wbL?ab^U$;EKM2D#7hBXW!3fDLY^;m0Hw z!vQNfN)nTz*qP;4iryAxIO&6DKOWbm<5Wuec%ueyhlhNJQzCB-p3rEC2w*k3qy|q( zE)fB&V9-Hz{MEwNF9=Y;cD%ow)Ox zL0_LbmN!2m1da3PaSBA^(^)QH6*yZ1um8@T9t9-$fK{L@_>-iM_Ty{FE#MZtH~3TJ zmJtEi;CA+iX_8Ce0k_B>dx1ENo-LgC)l)B=vJUs&yL(Ry!WZVP)$Dn=hsqy!tIdXkebyCzZDq% zG47wN_mT=9wmMm-Z+chE#4Gb(8Xma*-OwCr=R(78uNlb#Xm$cJ!;niU0?tDoX9y)T z*I9~4K?2T2+%wlXa!Wx1Hn^Py*(bRaB;Xdg_jG%n+!A@f2Dkfkdx7*4bHFWnZxdJ~ zx5ON0#VmM%f+iCa;$;EKMEpl(Mtdd)b1+c;GE|zuDOR)fM z(R+(!o7@s}zy`N7<~t;pm;+Ywy4@D+Nw`Z5aR6|KMiu|CJ1LGjw}0Wh+FiT4AF{PC zVfI+)9;L(`z$$h2krwwATf*#{{eaw(2EYb)sH2HH zZw4zg0hdkt4k;kP2dn~TKL*~?y?Kr(BZ&a4GPOcUB918{i2$67xD#1Ir{uB>sSN5qCeBBDeGdzy`N7{?jCv z_yab`eY3$Ca*N@B4Q{95vm_V80q5j}g)>J5DICDILP_EDDI$dfI2Umj&OEs#{(uc` zXZ#mPF7XGfFgbjT4db#?=tU}t8-Tl&(iHLkXiej+?eMa}yhK594X_HHeS4r! z{)LSp;k=pdQ;z z__F(R)+r%*18hr}#}ZMsSNi4gy{{{9@amB#%!)rAY(UsJu1WI4=m75UB<^8Oa` z7hA}53;CKHnfS=gz3>jH>ew3Jtnlcyci;bkudmzvMrFsaIrf9ypZyd3x$)`k!522x z@bQDS+3;WlR&~=ArQu^ykE)Lf=G}+kS%~INtw?HEs|ValXTf!tBhpLB18&iK=iSHT zmSP8NaAP;H%WjN;eT{1{CnT3L2b_}^PM=PxAk7A_tx$3veohgIKj4-~)!5xF|AGpV z1;Dm~y)By@RkB=+g_jLk8yp9?C4muQKVesWQg4Tr9k<4*AWi_b74WY4_Q6*q@CL?4 zLG>sh1qC>l2q(DJ{+f-KGu3M`ao&cl$7`l@vJ z@nhk~f@U#b@0XGVZ1~W1eC&Lf=aBSLtbh%A99q(g;i~nQ#tUF^ujNIUdWIOK?>E+V zFw^y4Dm|i2;xb^vCb!GSq!*U~8}wJWJQg0Qh0F2#jkVp%<-+!KLd(Q)z`12np`<;X zQbgPbY>QkGf$y|6N1J2DVxjkc?^x`$(oW8JpdsGky0NV;B$(y8zxB)m9NvpnmljU%s)_$4gWXxkV z4Gd#?3+*dhy2t)PTd3;#-|_e2?rXKYz{MNaSzZY}8T9)fMdLf|#YmhN9HZ;}Hpg}Ry_oCuvRp6H3kelq!wYw=mq;%`0-Vzq=6ab5 z;s9Vu0=D3c(7jwN`)kCk^P_KS0=({GS@9Dmavyr*pH*qWe z{5))KIWz9AnZU=2kkA0%KcSu~^qFx-*tdp|rjHoU>0zg2DC z_H*IfC%kq0L4V`d`x~$IH(sw^#9DqI>?)Hal>oSvB=^18>m-*70Nf(?-Z!&NZZRCN z!R;P{JERxW0k`PmVjL$Rm%d7SF4R}GQ0}{+wM%oNw>ZlVi%EbDbDS4c_DCLmP2_;v z8XJ&X$_}u>?M%cW$))H3 zx5#m?!=PTxi0^KXZws+b+52TxcSL)n>HxRwaW{u!l1tSAZj+0T# zf~q?uy;L3G7QMIX&dDuR2iV|tR^0{3rRo5;$X!)8UsiQv|Bs#_r*;ImWske+#z`(! z2e?g+s)G~Fs`I9i($h`;HDRPV9fDLZ<0d|`7Vmja!z2^YC zP*!v^G$(qSiVm=0j&p>~l3a=oaGM-O2Pc|E=gr+51*13V2ne_(SkUVFq>uh2dcZAu z?|7Lfx0D@VgWH*i1(HkA0dA4ITHRt<)h*Ha&Z)d4oRomIC^a;ZANEpk`YEtOT>HtmtB1KhI5U3EJo zm#PEYCP&r5iDuP#Q@2Y&Ngd#}p!Wc~M{-FW;GDd0DQ2GvVm@G7p=2rMfFj}s;9Ml# zTEes0tCrK3%W7~yi=+kt8x}bS+#$)O1_8IpQG;-zQG?zd;;9R!62*)WRMF=<-aTj5a+){*q4Q^*rCP^+u2skHq7vXAI z5l+!0DMG-xN&X_7Cb<+L;5Ipm5Kc6T(4D;*3QG0>w*|dJYL?`ZJ-|76%$|AA)nyM& z&rw0l2W%^pwD3Mf#0|i?NQi&qwuI(WNcP3;^|BhAr$thOfDMbBV{U=uQiFio5$@9@DMG-xN&X@{Ah{GF;5Ipm5KgcN>$^g!%V*Q+vvieOKATCOr7PF+*=+hOahrSp z*PmH?|JR@8d;i0SWRuBRe`aykpIMyA7n8I8%;Ky+vp7=>OwRfXci+2e~ zg2UYc`vDg)fM-8+WHNiKl_Y>@jh z+9S7Q6tKbV%;+S^#c;p|xzF$^a*N@B4Q{95(Zj)OK2W)UVGrB`^F&wZ#?lXLs++sLjgWGBN9?8XUzy`U`@O^TN;eZWp zr{M=A7sCO!$vekT=W*!q$57)``IDa;=`4vJNw@~4N8XWjNOB1mU=3FYRdpH|=c}@D z@{P5lYCh~<*g2xOcm`O-t9h}r5ROSMo&i?!OFcU-^X!D;;u&BSFY)Y@zAv1OpM8D!QVj;*QF4a%%0L6$ve$iMz%0pQFw&|4 zU?mR&?dBkS`AV#Ez>Dzj=8n?CWsmT|T{!=_iTLi5@beaq3+Y|#SmdbRgA(GqHkf$j z2BPyb;FWDmWfx5t)_BkG9PO5%09L!}?lW=c2eD^Fw*Yt=8#(kTAb|m_0%!lO#XH>n zATxZPywUJ9`T;9%S#wz+eKb4K18&iKo691(qv=ox%>}T*?QAYfB#(wCa=fvO@t03}6*-HkV!UM#IzS2dunh&1H}D(d|a-NIikHXjsUmp zbvKt|lFJwZtmIcWmwKTL%>~Xkn+wj4uC=+G&~6C|V70rnxtvl!0s~kDoXzE&ywUJ9 z`T;9%S#!A{eKb4K18&iKo6A^OcWIu{K_Sds02|!S<}yz5Xm}zAoRb$emmU?Qxd65m zN}9_gMZ^ujxyUHZ<>0!S%M|UEaRj(!ue-TSlRO3^&0GL0`PI#(Idg&Y&E|pyife5y zGqhWR0$A-XZ7#DEkiY;|0cUfWBd;_Uz{*?JT>7MsW~b%?xJB=6F7xD;(Fxe#b~cv< zlFO(BoRb$emqjXw`G9SOlIF5R5pe@>E;34U88n;Ae;Wqv*}omWRJHC~b6KXnGL8VZ z>~%Mn6_U#s0<7d$H<#wj1>qvP4Z3r?JUS30pz6T-dUKa_UHWyx2 zX}m-Ruo_=Q-C6DHB$vnlHpqP`-6ppf4%pxhhKKz#!&@CMi41reD@HpM5aR)>z}a87 zcso~&cF7wJPrVDU@`i{PEJyE=KAN5A0k`PAt#O~+(R3(aZxx%{Su6)6kA^35z`5at zt#LpFF(0t4P|_L?DI#tF&P7IPjfdCO8jomi3<~-~$SL5Kz3$d{O!63vL=ITVuWpUa zc^902@~!cN#!F-XtMMhR@s#8e8Ndd)uQi^NTMP$ma2K@33krzwfK|ZR8pnP|&+Ag} z0<64ct#O?6(d6#PEkS32W%^pw8m+Q zh#P=&kx^RX(RH=P8QLr32yn|@cWay_c??EsjewQ>>ekqtHNyEP-x}v=yhH}D8eh^H z`y`jh05-^dt#O{*VmM%fyP!2LP(X|atOCx~xJce;c*x+`y#ubuB!xK5+oV>6#u2MnF2W%^pw8nLch#P=&kx^RXakDjkIJBIz zZwz0mLFyYv+q7545#W}+?$)?N@)(TN8UZW$)vd8PYlQQU+ZyXynRw+Bh?4J|dYAS~ zZ~&|QCEan4sZ@|fh&@I(%{ zWw`hLx)XAX;eZY9820u%eTM5LKOBr})XXXA#dN?qeH^tNd%J|kx55Tk;T@~??gl5# z*7#pz(EnTEOF?Tqr@b*8sMC-~z`4Etr+hC+9)pp{0W0~{tuZ~l_FDMOyKug4jp666 z`@4o+@mU1OcZ=89n|gAWOb4u{*IjYq&WEjAu{xW}I0Ym&fK}k^8x7t|n@f+>(p&&5 z^(f6{k|NRm)La1PBJSogMQ$0RfDLYEbD1W&j8MQWa&L2)A-5O~*x+_Ims!$_>40B^`uN6Bv{wcZ;M`t+bJ-!e3?RTtesyz6&uUdO7dYQ+E*q_C{^qhz>S%i!_kfjpl;(0kk!XJs0i27to6CUQGDZO# z+|K55NOBpWfLr9==5j=CF&wbL?QSl|q!-fx=k%jAmy7FaE+@2C1`*)gUVn2rCAkbB zz)J3GE^xltTsrRW8mYOQ({zaoU^Tt8xm-{{VgpzO{LN+TclDGmjeEdKJxX&Kr%1Fv zi2%+;+|8v&ZW*J14Q^+1nIyT4P{1v6Z*!RkSKnWMQ9 z3&3jbu%Z00u^#eV=Q>ND0um3vDsc8^4c<%FS>{O{ZBJtzuu_lGP!=c>?N1_ra}jq# zStPfNOTY%Vv!N`JTt+3}7P+^fER$Od2W)V=8_Ejl#dN?q{U{A({JI*-D(#g)1UR?X z-%!>`E&~X#lKUD8oPQDxWt-+oEC8#yr440=0um3vD&TJ@yQGe`r?C!LsYhujdlZTG zClSE8h`XWelUv3mV1wJ)P!32gqY`k7+}ltFyuf6;J#7qA${Ojx=hMlP{d0-<1u6YN@42_nE09K=iZRI871f~1LXO;pI6~HQR z_Ra9-=EKeE1xL5Jxez5kf;S<;$+5`R>9@{bY)Tut{xXk4Aa|w6p zO_N(n53s@QEWH_$OX&g5$qS=DO9hEOU|Yc-{W(fV^a1A*?&$Z)Ezt*Ta66+vPjZPq z;G8^0zcKJR%Ig7T5Ac_d&;aVs++$~f7E1O2+ZOt>w@3-e9^hQUoxLS;OZEU8+|KMR zlU%X~I43V0J1bO>=mWMD{Lx>fghU^3F5!;;I=LnKfDLYE^tVYa(FdH9zfEIjhZaiq z0NWP&v$snL$sXWb!kxW6a!d9A8{E$9?UP)x2RJ7$96JY8kmv)p75vd3P(q>)IG1oo z|B&1geZU5{Gx|p)m*@k|$={~2b4&{*dw^{V{nmYXZB`DF4+T|lNXMiSt>~M0ow}x=+99?q7OKi za7VvSZizl%gWDPXd6G-?0q5kSjh)8Y#mB=N!*qS)sfj!PO8{F7*IWNxuX<}(^=icW ztSYRLY}LyYSl(#j`1$&lDQ3b7yK!{~upJzK;mlG(3I}j5;Vzsxa!cU=Hn^RI(*@_NB@M}5`Dl1w=?>uB$wy|&dJ}Vv2#ufC3}Ev z3;o%K>;cZn z3&+k86(stAZ3Tbyk0~M12b@c|qklqfi9TS1+Zp{+l1uaf=j3nG*g2<#l0Cq-h5qba zP(rc?IG1o|Z!Fw#*zPqd!e@i9X<*{B0ULGqg~$2iUgIpS@X1NcI5d67KBHkz29{*x+_%uTOHx z9^jn3aO})eL81@XR`5rEff5pZz`2Aw`itb2=mR#mozY(+xkMjuPX0EHon=}m*#m4_ z=+E8?B_w-*a|w6$R>>{d18i_Rv$sxi$sXXGym0JnQ$eB+*jDgIe}@theZaYdJNmoi zmgoaExSi48Be_H$a85qj*vXbL^lpprGzspu=s#Fn4(kl@X_Q{|1PRt4zH8!7-<$Zz z|MVXXZ@dUA6xEB(KR5CGz3}fXtZszw)$@e`3p>XxRCs*Wq>aaCPICOlTJN`m5t}!6 z16Oz+rniNktLI`W?8ew;Wz*g}CSH11uqHeKc>CfV6L;>7SO0!=*ne?=2mZcYpK08D z?%|_X`!BxAO|!G-8s|>TSsh?aLC}jD@0tGcv9XCevms?yNZ}V7PyY2OCD{h7QfCi? zk<|11G*2O^S->hpjmoDFUlqE{p9RW@KY%-Aeip@r|Aq8c_wa#U30kpGn8b(pP^!%f5y-@ ze7+GJIJ@zsc-SLY9`btGM%`JRE;88CMgeQED{l7#+DoL5xy0A7uQuSEJ_gu)PNfQc z$D_5&R1gOM+X~T#_QSOzl5J4Hn`mxI3&H84mhVT%)k*9!~wvzLgmB6o&O3ub!PAV)XmniPIOEmaRsmnoqctn zj(56p4)Yx8e0#9)YQgN_e@?;ZUlIhYf@c?)%v9+b z!M_X2iGP4quBjAfHIEU@%(t;m)^kGf4RE(u<2e8S`?*acn+>-yy%}DmES>0#Gx#z> z0c-HfCOSRR%eVxb(-*dwNh*i~fNh16CO<_HaRYEJ;%@TO`;dWt8FaUXl-=JyU-s%Y4`N`HiTp z3zH#%|0q0ocD4{ar~_fHJ4hUmvc{|HRu~5fHDEIieSfG|DIuW-Y)iPESf_$G0oYdX zJF!g(aRRU{;dWw&3gQG{TcH}lJK>RL*AU*Nj5q>VWzOCcs5jU8VTZYmwehgn9MZBrTL2?J!R`3_#fD)27z_x_D01v4kP5`zQ{7xKELYx4cOSp^ZnA}oC zfDLYU5uK1;iU@E{Usyz^RFL=swiW#GKc|GmA8;-a;*ZUmcmf-K3YQP=R>zXKWm`Dx zz4zz@2ft6m10(imyX4QplgQ!s+sCkQIWJy-+q{c56FSPBp9t9ST)8@x4dv{(9&kZN zr5FIW9DUf?Q99oXI`$b|0zouG!vdVs7Z$@f6{Hvd+Y0_-=utw70kAFM?kJN~5GMfJ z3c-nqJ3k%FaUIg8C?k#lR++OGK<&S}G))1iCcr9Cad)+r&T5(=eY786Lp1@;=?klA zmI{&xz_xO!3L-Iu#@rfNceTL2Xk)@&MSDa2M1L6~qa^wn9}< zzZ}eQ71STwMoL zki-DC75vpTpoAm^uu3pif4C2fSDG0Qjv*!0Z76GliC6yj;Q46B#zO{C@&s6eSXY8S zPe+uHJOQ>P++E<93gQG{Tfy(d2_?h{z_x_jiBl?w6M$`ns+HkhR#z)Kr;IoPSY^)s zoJB2nKxNJAg4EFi2!yTzSgGq0j=ihBwk#sqfpP4g+h>OXZi!Uq)9yr!Q$Z2|*jDgY zQ;!mo1i-e0+lfgkh!cQqg{qnkgE_8hnxc$20$63v{sySox{P;YNYb;)nx>3Y7GRaB z6-p{=h9c1ye8rifB~n&dvs93z0B*TaDflaEjuMg(z%7X?;(xf0iFH1^tgH`-)$Q5g zw$|%7B=#9X$r9jJ2n(|`PYKBqU|YgH{uihqP5`zQ{H3-?32_3jE#Y=zi3;KbU|XST zVn1pfx2i;STzFlkj5q>VWzODhP*=|*blu{=Lh9%N1aP+4qVB&KOSq$PsYrH6T%|~~ zKZyWV`@?7|Yh3G8kVF8s75vq-O$kW?U|YgnO*>Q&Cji?DRW*GgnBzJm?ovh^0jx4- z-vjEDcgq`1dUi`x_)}OmGO|+x)StkaCgL0MaEH5b!fz~G*w5GkW>NAQ&m`R$5ap} z0NV=wPIf{GaRRU{VU7Lx-lqD1m5u#VDu@$+ZH20n{cYpmr7~b^+>mrm8F2)#%AEcA zKplofRhadId*A<6Ir4pfEg;piSD{9$-^I`I5x(Ki@zK5E&+(DH_;Y^?*AA+e@AWsI z+v{(BaKFFtpuh3!{f*c98?T=R`_uj2o3|c5x{s@!U-$ih_QHc%RRf%OGo9k_~)u$+4?E`Nwn@HJY&!>4nGFtzGYAu z708dmZ+=twtD5|HNM7Ar(BIm^uW*c{zdZY6!TN$rwI_kAxeZAwO~9JfvP-q6q>n|D z=mF>SRpjmAi=o~%9Y3dnR6bx^p<~jtB_i2${DLCUja2)9bCJ-^zI%WtKpMA#yz?lG z1@Om5Z#G{3p?@4+4_p_1U4h^K7hA}53;CKHnfS=3r;9Q_MW3Ya0XBS!QM>Gpk}PD? zq?gPC&gly?KSKq{JYZX)B=fTrk<0_mMXJotKWk?`q^)XYp|ibofA6!Qp8dB~%+Z$U zaC+4=V8a%7#`>g>t|ofGIelTq=BW@Jz}L{00ow{C8C#%8bR&rX&PA$>&HZHzpS#uY zzxSyxL89XOA8xz^f|91XNE0McfDIGeiCQAPBnog&Uzn(6DoCOL+X^L#TA_#}3UDsc zm8dk)EKbxaO^`$ZHcW6QYMu0wD8M;=VWPIFAc+EOE0iQ^ha!?Fz`00QqS6^aaiVr< zf+PyCVS+nRd!&~{0nX_Q6SYqTNfcmPp(IfU6p=&$&PBQsl}^oKq8_ZxhDl2`*?F=0 zr#(HxFLh1N#_T6;0p}(~1^eV&BoM*I+0{5DqStA11~``pUWfC;%Vsh75ts#eGId^cs_x*bZrs}+yEiIzxUw%8by`;?H90Nj#*KeiLqCml;32UL)f0BkGRB_R@E zYB({Vgp>r}T*BR14#^$O5BvCFU;;L{-JRu#^wIQ04>+eU>@3Grhz?-&FE{|$Rw(H# zClrZpBoV+Zk+L#6r9yNAUxOQfZ3TZBol_z@kt6`OB+4%4T~Hx90iECkU|Ydn{*x=J z;Ao76u}{@KBRY{J0Ou0!N0G+K9nDXz7qGz%+uMim;nQrH;XRT^!xK5+oIJKuTr0YF z^3HHhSXC7E6#MR12lt;2XM!J%i$wpdfA60^-T(J~Cw%*o{?^NXCPWG!R=W*((-S@5 zoW8Jo_o)yaNR1V+tx(dv=P451NFsn+B4uT?K!xZAzJ|sJ*jDhD(IO?H6G;MaOQNiM zFHs>n0iECkU|Yf8y_YEwok$XZa|w6%ULkihKQ&mu2Dh_&uaZ0(p2z{`y8Y^I1p`?2cC=%UBB7j>WWo2|oh3E#phQA%H z1s#%P1GXLVcki)qQ$oBVFUbbnk|-N?<5ZB81GW|X!>&gONj%_O!ri?m$sNs4?G>=W z?e5-Fq>rX2dcZk-VfUVvuQzAN%Bmn0U?(V%n?r45$uz(G2XZKztc{Dtc z1J23+Xmsx-IwZ*kY&+!d-piDbWCLzVlnuKTDoDx!+Y0_+w@L{~Jm6fy-M!bz9nDYe z6|lkW?%vy^kESPjz&U+k_uipGbRacWz_vn3_ui#QbR&rXZi$qY(H<3|8~7R;A7ER- zUq<_sh)yI4z%7Zg?tMUo=md0v6M$_6fA=0xB07;I0Ou0!?tMt^Xntz2fDLYE_dX(d zG(3?5&dJ}>?)|8`ez{qF4K+1!=g$R;^x1}|ChqhAhOP5%z8Tz}xbu5qf*sb+F$~7y z{gVH|y@|E2eqVTX$`5~K_^O}b6*IrrAEM#Yt@Ch^vA*qi=bsJP@Yw}F>ursNZAI%> z(Zs)bA-p2w#@259o3;46_3z=;G&k1v%+Fq^KHE>9Ee8!){<(=44!>(+`rZNZk?usk zu{IuV(Fm5Tom7_ew&KsvSIU!>MbURy8?BEoE=gA1jo+WIcJm3pQ^hHKzZ)$B-u$;^ zK`&Vlzu#Cp$YK;#;Zv`UMXg%DqNjSe2};ptyt=3P?-w$kCzE3Qeq(JA6btT(ym-An zUy>dGIIr_?uyP+z#(txwm+=ocr!PF9j8j3n0AO38Ky4MtAKO*!mReGAXx=$E0kn)o+6S}z`4j3 z<1aqq!h6n#uRMGG+u~cZ(y?VLj_&WQj##^)bB20Zt3Qh)K7O_rKQlYTQ96p&M>!ld z_p{%RKX-Q&98C`%`)^{s;%^4Y=43mMMCrJQBT?G%E_N>b&0(e!|2End|E_m8%?7F? zSv;1;zi;|@^cXy8hH)v+aq=O>__2IA$+Y9&cKZ;I%xxb|AA_gqL*$9^Z^q(0`H*6} z743_&q{B25O7Yr?n(?!v^jV6*R^*AF9jDKfGtRC~OwRb(smU2XJ5QgThiPW0jV(N7 z_PL2z@j5 zUnjR14%py!8oo_(F&waxquC#a0Z>&t?|!=VW_X<3D`6rS zHafl;elzX5A8u@_wxKa^Y`SbqpdA_}+Tha;G;C7~SpX8EGzy`Um4iCsJh66UZorVucE`|d($bE(%l3NT1Y;ZdbKO(sp z4p_;D11MJhWn-u@qqt-Y)k_~?d1U4Hn};KBPd}y)5+K0p1BP(*vI<8}KOwmU2(Ur! z%j_w+#c;p|w==WnBp1U08{|I2FUT#112(vwhL8PIU5!YKdVrN2C5cH@?96=MN}L&D zMwLEz_T!<+hUK&Pp5?5MyBpv*%@f}Nt9d2W)+4zj4X{D(OWGv4#c;p|w=-!|Bp1U0 z8{|I2r^zjb12(vwhR={(3_s5VTu&1%D3`|4_Ibi8-{K|BFXCxTo1>BKUqq>~~n ze%`20km?i0t%Jw>y}=c~H;5-OSL)Wkca?7adza~k0C}HH8w+MOw{AcIgy|As%}&Mb zUicg*eN29$2b|LvE~fOT5Nj7Y!2!UwLdjyvBt@bdNd&NppoZ(y!MftA$bI*qdd6$` zW)E)XfNl9hA-;6~;(k@)-V9FBwitjEV!&!!Sq7&`FBt@!(-&rNh6<8Fz_vn324^WE z83e2%%?#FK@^Ldb_OYT2&e1l>AYiqvEQ5X0O9lbw^o1Fmr-Ebqcm`O-OFWw=xp)Rx$uIS6EL;h!&*`z@>w2*C?B5Sxs@$6sqTvEr zwurSri=w;u8V)Le)uM{qeNQHAo&n!__5=NUp9&1sYT1vymKc65{K40yv#S?=Bb;IV zQn+k-uYMyy_^>&;!#xPW*7z=->Y7e91Ate>x`pR8DNcL9lw&bwrz??l>yF0+*P(iZmBZB2Dh`yc1bQ(2DnA;o%HRI zTOtqG;C5di*eAWj9B_-?dyqUJx5ONr;7g2e3+={fqiKjX3~1XGP-_ zh`!)!m{b5(fwEaqkMz<0L=QNpFPs%kQXx73o!|gqTcKoDG)0li@1+h)8vj0 zq=^e)gWEYAW=I|lPvn4=JWM;%tSHPf%qh`Ue1(K(R@7Kdu5OsXZm(YmL%=sNsxF;W z?+Cn(xe>b6#49g^+rQ7A4qtRQRujLDZDnQ|N+~qJ8p=3Qyw~sNNG~M@xJB>nxP5X< zi2*jaoh3F;aw##uIeFpb-vug2<`KVXB~8UJOHOZ)*F zYL;GDd$aMr0Hg#*}DC@Gw6ib&xA&PCjXvqNr)KVXB~ z8UJ09OZ)*Vd3Xs#=-TyLTL0E}XwQsW7hn1w%{?lK8-Tl&(wu3!J!h(pL@Jm~oAxOv zt^roTvsW=~k|`NZ*Sq#dJ0Pz(0$6#&F~GeTI3T$g4Y)<_JzY2?cQhPd!z>A~!R=oB zIwE~EJ<$Ws=?kZM$5e<8Kqoi=*j6Z+=ABR^x{*Wx=OXT*d`j-`S7mCHtspN?)6w)lgQU&hnIl2UV18S^BMOIuU2TE4!iufR%d?*tFwQ~yE;3~ zs7lQN)~MFeESb^FP(*4Da4zDmxmj{c%>g#Joi#T{a;Z7MEpqP>v`=n{JYa)6hP{2q z+;ANxo3YH3USbZoMejZRTOhZ@9I(OdjQJwTCFXz)a^LC461l~2zy`O|@MV&V;ecD@ z-eOrHw-gItgWFv!tE87=0ov} zH~`pID48P-C=%UBB7k!d_wnkG+|hwFM*?hcJBPy&$)n+k9I%oP=SbJMI@`GY^2w~u zjyzK;UaLK3V5RH;YhcUPYEMWn1qZlA@9n>*v0DoEr3 z+X^KU)Uj~7VC{q!;9SH#;K#`=@ds>hJLBIYxx^o^LGGI@O_Ey-2W)UV4WA;p7!Eim zFD#sCDoEh~wiQYWXNDp&Z~^Bc?!uWRx5OW?!R?Iy9LXjAfR%jYwc0+F#0|jRN@)i5 zZ?Ag?$ASb0m|$6LYE;m?~7pd=Row_Ge(+MOZ2L=dn+&$YSD>diYF@Bg9C$2f#vM;!3& z!Og=^qhpV5J`5+Go43v@-@iHd{@`YO-RkBCk6!)Q_O1TLXZk<*#vE4dHh$o!zwx2t z{>H77{>F2s{mq-lo1w~Y9c_Nq?fXv!g0=tk-$B{mJlY)Vx^x!aYkai%WqOK6p_?HbdGRM|MA zBgp{V9i7rD>rqTn0oW27smdm)C5{2UM60;UrYI+_0k-7c;wlT5A;vIT^L-J*XzjoF zWnBYxnm)x4*3I1X2@3DQOO9JFLeE6-JB>|1W+)N^mqY-!16Sn6EEU8Jz_vn(8*>y9 zHvrorJUBf@19<=ai_`+DL^l5PM)+vtBTb*S%TNK_w!J>4mG*#nipf9$Y>AE30~V+y zjsd2LC9t!OY}_!5#Vm$;y`)~v8*R7Q%nXE;BK)Z zw^pbmZUOFADs^j>V&WFyZn4H-zjC6`=o59a8-I>o5vIFUgMIPlA&v*_%an&*2ZI9| zFOdSA84qsz%xFjsj>bV?Kyrx;;5K<^n7k{cel*hS%^?NF8^CQruQx{|7jFQ!$*;qk zV+x8lfZKvzZ%#-q-T-csUxzoR6clg%Kla`RxVG#n6BFHyk?r>A$~2&vn28`BM%a^# zQcNZy{6wbu!X?$J5)KM7_!(s$5Sf}vsVX+nOsb8{>q~TV`#!5EG$>VcqN+GkO5)5Y zRq;d&7f1 zd+ztGwf5RSXPMFK1sNfX z7)%H8pH>lZ!^fX+Ad(;doLQIbw)y&VE;v9#J| zn$h*xHq`J!sp)CthKflb_!oU9;W!YPL)}f~HYG?n!JXMwY$>@ZLBaufB}$FTV@H)t zc@VBwYFZw)0cxlkc5?^n zjR_Uuz#A4rW~dI8+=Pm7Odd5p4Z67_6*S%ujshzKQag=|Z)#`5FV!Y-n3nM@Ew%|4 z1c#la8Ij;DVGMWMrPenAjvdeJ*2b0Flo;UzcV^qrQgTybgadLPo#a`X2~98qIi(6F z{)E#Cb!TZtB#8gCiijJ&kO>DO`Q6xza+~-QPH<<&e^$v&{0Rr-KK?cRPDU5zlDvkd zVfQtsUYHOO4!mg4ea$Pm2@&C#JZe-LbYC46G~N)71#_FoMI|@h5RS=j!<%IlG~N)7 z1#`VwQF7xA;h6k3yjfL2;|<|hFxQ(kB{$v>j>#i$hIe0gWy(9zeBO2I2kPeU*VQI* zn3i#AR>CGxkmhqSSlATOqARdqf}tlXt2nOQ_pBY3?R*-mRMM>32hVnN=DVkih7@s?k0m zdkNOeIPX`D^|bpTt;D&eH@SAFn zc(n4p%V$24A^i;OC|j%TGnF<@6CNq;i@Vp|#3iLL+pn{v&NdX=7ix}?#LRh5(QcsasW&iP#|T!(*L zxc*fA!gcHz;`)fxIpx58Q?oJRni^#MCu|KW6z*L<6)ju2YbBnt!=81OFg_DbOFTG* zryC#{3tI$kn1Aq^e~yfMo$T)7^;%hSgZmve)CChI!hs9%8A45+HMds;?dYb;nTQd# zawbc_I66z*@G+Ss?wgt{*;0dy|AehU$P&ks&JrULWXX<77@rBJC5C6oq0bU|#lzf3 zWy#PK!UT^yyTxnG9Uhb2eJG&EI>Rw8C-FL+`y?1!C zzVJllOiB~Ba;6%;j*b1P8f2<5VQWzH#{NttjL(GA62q(UE=~|#g>tXgXzX$Db!%#~ zm7W*spu|vS!@7h62T{M=HN*yY)Lg2FMA3^7PKzX3^x&SIU|7fpR#vNmS0J2LXmUr* zxQZAz2&Y9{f6tD;+K5&fPPaPVHJvWBmBY)sXv#^z>-4-qSXyeal&){k2*(!dgyYcR z;INLK4`WZXpM;0V)iM15cJ(nBv+rt5`w``K0P+p{O;jnb;`t$aNtyf zg?%SVZX!lFCdYW?#&-{&s-W?Pa4eX+cj2^4sv{LIsUCgk!;6Z!VSGctbcQ zzYTB3(1NDsCIH8Rx!#N`x$%Z@OdfgTx;T zH69dBshkAE%MrG6rn`R~2ZhsWknx|eHK_TZa7HDJ&xF$w!@K)K{0?c-mDe|BP&lhD zm?#krTrfQ~&j>zpo$f3+b(m8*6EVV8&Sc5!I4GP~gN*-#twGHPg&mbJJ`+w$49}7y z{Ek^7uW#6(F#isRMfF=k>qljTL%;LyK3i6D392V2Y{?laUf0EI@*3KYO#Hzs?iv~# z#5FW|=JG9^ZLO$*Cb0-x1C7?u=6Bfi@2bj~BqJQi31P6GFlj>&Jsn`0F;-VlxjbG@d;($NjA)MgO9IVVKxft%r2?yj&<3FzoCjNxe3QgkQQ4te=!huMB{1=tm z#Gi12J2U>vN^as$I3V}&uNfZa47FK}YG@kXuD_yQm=F;Tyl60j>#i$Uhnbru39Iq(?*P^2?y4psn9D3Lq|#&{njq^*i$(PhLI(IKiD+9#cwg%7bt~UMY{7!E(-+yQpe4 zR1L@7)9Q^072&{}2IKA-B{!iW9Fs?*p$6mbSrs(i5RL_N$98i{ZoDBJli!9n^D1b( zAsh?ldec#I;|<}M{5HH->lc zW8e`Zs$t{qRh5%qcsasW&WxyD$8ql-uf z-cT1zln4hd_$;~ExO-FOOvDIVIg=%?sHJCbs!Sa}TOu6l0*OgQlV2HVc=sfY;(#9t6Hahv zj_VGTTnzW*gah)X+s+=Uf{8!jv_joHwkhObTz#Y>CjNv2k^J}{E4PV1;RJVP{7;nJ z#Gi0LK4RP1p)0n~_m@jXUWaXGPt^+(BEo?e4aU=FN^U|#I3|xqISt0s7b&u@JVCmajrdNZ!%#v8&h`E7X9QbAKTgk!;6Z>E&octbcQ zkGy%k$J5hlow!aLF`gzISa&Pq=^2%iV0bygR?du+UdQqDtQuteCu|LBKAxUa3F9;2 zw8Zd{(j|U}H0jFg8#A7sR~Jl_2nR0Q%6Ph?awcMgt(?h{*Ks_(s0JDT30s4jkEfSa z!uU)$EipVx#<0^MvqWCsu<>-$eXv*5dlO*7q4%;Uae6#AbRX>PRTVKICLD^$F3lMa z;#^a1alm(ogcIDERA!riz&O6AneP z-3f`aBBmfXg@!WH{8su)B3}S_dW1vr{&Q_>|yr4Ph$xoTzHOlJG$*-z~E&N$kbiM^&E-Su#^wA+cb$T!HDFE>5 z1YW_jC3v=QfkRzoxZA!=KX>J_ZqsN!@1Z(^WyxaTLpUr`aHkWdBxll9wuKHK1L4V& zkAb*!%YXVyr=7vGFP~w5NI3Yg)BCM6P-4@h$u1vIfD?{f2bTi}eWOA6<__jO83Ip9 zZ#gI6j4ZFeYG3x-mx$@a{qMkodVC>1Y`@m9EY|~9eYgqNxEk-jUssmbe0sub>8B^W zR+E0$e0subF7aYxOIn+F*L!+GJJ(qA+yu#^__+ySWi81t);ur4)5gzBaCslImgU7? zmR;G>^`4g?ReBh05ZP-zFF`8lFxJ3W^MnFP+jjVb0#^NWWXl)?#+v65c-ruJ1b4I3 z;HcVO`tmx8Dp+0gsp z^L^Z(vz(n`?}fJXeMhbxW$)ZauP6_}eGSc$dj!R6{q}3FP5PUdHmNjGKZK8+hh09A zh~%BV>xq0%`_V_ch<&H`DRvy4-Y40_qlY~7T?x3y{6~Jnk9{{p=(W#^Hy7w#Wlsm} z=<|8S4?m2NSeK8HWY(Xber+Q!%O|@_p-N-aO+MKj zUVb$y$47?cB@d_!w91FHOI~{V_#y2@!LeG6N*LQlZ;z!PF-X`ZjB1D*qhtbC##P3+ zLfFcnEpttX%Q>`VXv(f$=0?$jXWq*u@RwO$c=OC}%9~{juh||>c8|c-AX8gvnJGiU z)-uPPU4~OiZyYCV={3IjWjL)G#s$JP8jZ?uMrDjEgsn{TGCT%XgEE{|%S-?WTg#f2 z;hfSN#|c~d8FHc_W9!}if{~Goe?hCfL;pO$a1OB9LG_!*5 zs-qbi#8p0kLsLZI-sKaCM;I6ha#VVbRh1BLy#(P;T3kqso z>BV$kP=rHziOvTPxtm$%?$Sm7g)Mdpz3w==_{PPvp$3?mNH}dke(`Logee}vp+t7^ zY$>-X9>NLk?Bdx`dQ&`vL;Bj{8FS+>7E-VM80&`laho4`itsJZxS`nN^eMvQx=OXH zb{V$`hjz6e*PbGj^g&kcDZO!|HAog zPoJ9KhUuYy#})tfoB6k^6YQozAspvUe);Vwy`-l1k8pxM^zWqN-+^3KbK`Fm@_^-u z*KK*_M0RVNF~I9f^7_8tz?`_l{cm5A*8=~5%Zo$#O_#5JUf`jd3(;BNBYcAfo2O>! z{?vU_b85Y>0Wk3;90ouX(hateU=S<)>48d^7!!^pSl!c3xNmBlI8+7Gei2S9@R4uv zxWh=GC9OJfq!QwU?^y|336yV_C4$$1yyD7+FP*_t8y#*leRrEuIO4@)sBrqp74`8= z3i4PDGzCf68dw;UUyvs%VG5FPB+;xOPgTJbB;m9|enFn8gegeER-!1#B3>g3?}YWU zeetD}C)`RJGk@!3WAwZO&9JZLCtr441Sg_IOh3vRKgn zcVb;7j1z>D5=cB5@Dy3${0xMnkZ4Ap-5)Jp^4zm z9>rfOy+pv%6AtMc=HeKVzIu}DI~&4jh5TY1R|!*$gwqn)x!6(#lZ%AY3i(b;5dP`y$@rYLtBF zJE+&)!WV>(a5VQ&fBtPa{_3dL-PK?C57^BCP_O&b{Du45>+ZPs-PDia z5r_}F|MN||sd>;PD>#ah2T(efHqzz(wja6up>wh@$u0wZaEm3cm z9;1f4^+ucrN{?Z93@f(#9xZt6dTmLWHElkidr?4(vz%eXK}nfaZJu~PBF-%-v#QOf zYrLv0yQIvjHcuO`YRjz!W>uRHLA6u)|_8ZtC_X?d0`o zKapj1ZLI$*X0EVg>1|j%zQ^C3fB#pbPx5`#QSs(8{q|A0)b1;B2rA=eIIxW`#(bu3 z4ynA*WdcT*oU)8_$<0{CO1W+v zDtR@d+-kCzT-|t7Sqb@(KQD#Gsn)X|_Rw=>$xn}Z?N`6}G!7-|KEeCrbRizs6(TRn zCA=pb8F*YfdsNcfc6Iw$>5cz{Bl=gyX_bWCI*VM|{v ztRH0&_;S2=`DGveetdql^7-HE3{XUarB^$H!6}BRa*IQ!_i1;13pa{z8LykB#;ZGm zbJKW_dq$RzzIEq*9VsM_jRZW+%k~^hKaC4*(cYozr)Q*?8ruQ~&gL zcOLv>e7=Lb3iVog>!&}*VIJ1ixYf=0CGR;bZZG3l(hV)2!sQy?lJ4d$27mk&oSbme z75G8!kYOBcQngn3>>+G@aolzNZtakvrSuXiPfs|a&rQxL|~i&dNJM86OQO}lcl5FCgy|_ z+?g?7RB{t@!Vx(JjPb=J*DA0jh-Xzf!c6@@r(JSK+RJLJDMZ4Nv9H#iB-D zfnuWhfD_GM?f}dRf2O~5MBx8Ack>T!uF=m)6uXwViDpbM@AJF^H=dvB9pD>S^nn@a z9c)ap+v#m@fE2&oseM2ezNvjc)&?%+R!=hgsXO5ywY`FLB;m@B{(=z+8kJ2IF?Ex0 zQbZ?cH|bY@>`93aHdaQx{eZp8y94R|o1c7}i&Eu*CP5Y6QWK;K(-6$A5ROf#D#}U! zHARE-{~Z-IjVa;bqUe>7dF7PVrZ3{EVU0tvt5%s%5FT#TO+vA!q9zoChl_@x*t*S7 z?5kBK6oiLcb(2sWsHh1A;o+iTD0Xf$6o+b+2?gQdR(;zusGT3VW(DD~l}`IeMNKFO z4;KwXv3r}LI997nCL#H$QBe~L!ox+wQ0(1iC{EQX6AHq^t-47l&Q#Qdg79$B zFckX?#ohL1dRBO|Zk&3d`r@?j6A1_Ur3iRtW;{HxH@R8sy@$;CNOPBzR_G!FXjxMNP#c zJY3XPyw+e7zbI}&J;3{03(KrpXu?8xxP>w2$bB?`tg%PMNZLU_2S z4a;Qr7{9o+P^_p`CKQB+TXmCAtg5I91>xbMVJJ@Ui(3oDnp$N-L3p@THwneMikeUm z9xfV&;uOC?pX1Jm@j5t=&)f1UcZ44b_L967cYe3FS-J3=m*lm;<&N+(`L4@XdnY&- z?c-Nnd7W$@@Pn6Kzz27mabZu_YsX)B@%W2fQFdqW#Ttw~!Pqh5nk&7MdrL?Um|KnUI5egkjOwh%@ZZ3|(6PrCa8i)+8PHHpDH8>-_t zrV=JG2uDd|rcLTHH#u_>v}ff#5GHd|_dsAKEjh7TyB2_VIaD3;gJHsfL!6~c&j^>~ ztj?8@_Lh>1;hvmuf;`Xg9p#ob#B&o)aAz96tK`OT!U^&`!}pZi7*06BooV>Kk{iPb zTXIyg_5m7nlcZ?ru#bUTh=K1HusXwCg?Z-J%0{5|(|&7%_y0Ot1#CiBS%qu;aA%hJv67oIC!8S9GyFukjp2k7 z+?j@-D!DP7aDqI~@H6E$h7(S3XBvK?Eqmb|EC=8QC`W!RxMtCm%+asCCYnukQu z^Rr`@MUWgIxKYC3()F^kh;$70RS!p(EnkcWU!V(K#{bDdOTKV@@`69S=-oLSnCwpZ zBiQ{f;5X7$Ux=#Xn3f~DGx9nRE9AK9`&s#Z+Z*$eymE-tddb`I-^%Ozei!xuFS`2H zV9x*6^SRA;#Io|3d4J5bdoA%!gtxZCV-|-VV~@vhV8gjDn{yOy%d3o`yqR3>tfpIY zC)>yPvg`e-#B8#=EVgvL-2-_QVsE!2o_EKw95q3<#Sd=UuQmtorQBD%#;m*!saicc$U9N^T4%Y{^-#j%BQ+HwL&Cbm7FK&-`*ZMw1$J zn*2t*g4R^WV|yiGG`Rb@;D5w13Y`DD17^~Ra1=13Sl6v3MT4sl zEfqECMK}=6Pp>KEHt9t;!JV02(@JjAi*SNGuYsCTZeuv%1h;FT{+GD>88YymRRLo> zVJmR{gXDGNH{SEGg|{erciRKrFYWZ-&O0BzlDpM4-mGa(jWKyg*c!tsRC{++d6E%y zf%8glGK_FUpL^#+N4ZTw5l(QYGpz0gg6%~mH-$tvL7vR8k~^sD%gSvGC!FBUG<-$L zjp2kN^4x14tIBPXg>ZsfI=uK+mfB=lQ+ksugd_UgWLZ~k6LZ1|ZpQp|xZ5Pvx!l4X z5pn~BY`wGPZh&CB@vys!$xjRzis#9G^wF5R$KlQ~?sGWwJMUmpw%B>6*FKf~S+Lt? z8@sri$|gHkFSC{TM}Nlc4tIr18}5dI=($*ru3qWX-zhMi4nJWVe(VJ!8j?MuWP;{q zMrBO$6SgvF&2qPrm{o3*L4*_Bb;)0DB@viDr}V~j!j`^>kZ#QKRUdkW?v$S=y073K z`35fL3<vl7h?P8YkTMP$_?bQeJ znX{#n4lCwA^NV{$jWxwhIALsdEXtRxp`+G(R*t%Zadsr>d#M6dzOVe-jXi9T8 zkt3O<>33!{r5W$c=sJuz^~&ZhNIkzTqcJw#meIGP6ZgLtmuqZ{ar#@52l4g0Ga8eF z-5JlH0HgHid>q7U*wht+f?0sBHGSCa;8Y(?_}GE_+;h*M>kQlx()D+KZtUuXd(-&( z=iMQLPx2?O9scAvYG?1au=!V~_c>Hne*Es

LXzJ3Y63t*3K&%w5BZpYwaK&1`%U9GLLK-0xVA|+ z;TknGw6$@2OAEEy=q0A`RYTgnQ8Kn(Zttj!gob}nJqSmk$vyqrRqkq=(j}bWPMsaiclKE7K6JK>VQCK=A_)%r8=- zB<{WLcB6$K6Zd}!C&X7gr+w64I^`MizxmJ1x;b6l?%N}@J=g-;wN2&O@fV~ob?3%k zC^w+}=65t|qUT{zq7Nf%1Lm6l?9<7P(wp)i9MkJvgJ;+d^xoxLCSLgW{}rA%;Qd!k zyzpIk4G1!lWDF$bvI0Lr?9nTW$gv?6A9~{$hL6i7t1N zlQMl0{kY6){D2*T^<8E>iE&u{+{PM4REd%#Y;7@G(#l;&F6d#_RnE9h*vd61Gp=&1 zxM*i~{92*Q@! zlsUTR>r{+jgtwMmLeU&q=5w>zDliaTQK)FrZNjSls*;OAZxfsqcqLLG~ zM@nuYPS}#00`?t!=fUT3W1hQHNXIrWep*hB zZZx(zR;x@|5w=#jJjg7o6D2ogMK~hQEvr-IHf2RP!JS!FXG(6$ig1EFc}c&VJqgAh z7s_o6C!FBUH2hM@jp2kNa@WG9E;s1N5oL}wzW#QB1`WZOw)ZBv2q&z`Os;VyH_1gf zBF{~(mU5diBAnpPETbtUH)TXPL7taf)5>iOC!FBUG<-(Mjp2k73bw_MX}o?xoA1jCDB`U#INkt*XKf-Da?+UB@{Q%S%1rRr4Dq`R4| z7+d^x8C%f6ewQEc81ac0f1d;H{F8!tb=X9caO80Ief=FJH_;?)$q^XmqQpd}kr{AI)3@A5M_ehc2cS2Tu)qaziSO7LcD`sA3|lWC%VSvMzg<{>YHR4J;ZDZVe6YY186+MF$QO=r+8kD zu$60&1LMkVDh%NScV-T>l-%S1VM}h}gi3#%^Wb1KKBZd55yC^X8kfnm${E)PTRD_T z?yS>{a+~xboZ!x$b(&RrG2N#V;fOwWygjGfrW6P#xHHpfUdc_&30rd1{O%@Dwjdkw zx-GA~=Mh&Dt4+Y`Iq|erxd!J{$H@FNp556n(u#gF~#qk$P{*4$x6^n9F9Y?K)2&&?>SIw$MqwD5#=nksQqVK*4+jJ;oDywB*_@fy&9?z|s zCqc{aH3?fySM9T_=Bd(~3@2>qD;cuD`*ht%`~<1)bp6uN&S2X?eht>(r86E-EH}a$ zF82h+B03x~W)}3Bnrmu1VQa2xG%Dx|l`&BvoR%pr{<^$}_PxV@*^x`V%fY4Ig-7=u z;Ja7!hWQ|s!=B!kccQ0P6>)K-P_Pty3`LVjX2Ow=Xf`MA|En-XU8`pHoA5=0PG=WQ zRbntm*c#9*v-gzVlp*1m9@$+C2PfUqL;&tJ*~-;?^TjED)~T%@T0Zx_L3GBocub}f zj?J&VWvX1+8I=C@2TEAY;`VYxXEOLVd`VYJ|IbNUTpjv^Pt<5Uey29y_qCXepMBK=K$M)*u=AL+dVk|?S3Pq#XxuDu9X z_|QF^8KhSDhyv$IquBy05iElVSNV8}5zg674hL1b1f9tSh-G8p0uYebKm`L^z6w*UOhVf##{Q*HFf-8c!r{&MRqYcA09| zxmCkuaGtSSas0y@D70P-i$P$le`HfN^5Jb0r~)+`M;*!RNUL4!hK0`D7Ft*LbHNI0E7`BiILC8}}i61EcR-6_6uOFE^& z0A5U%x?9ECnBi~OlFX5B zU_3qHm>wBlob(i_-{Kxz@Bj3VO#I~s6F>QO-pkdr$y(Hl7RFJ+p(WCuubwpBbP1|tq z%6rrJ8TY24FnJ6NaC04vOv)`=tw~T}~A`c(AZn)-{RVrl z8@RhYpX)vKPP}cQwSBJl>^sL%1$Q)>yFoPhS)$2fG@AE*snwvR-cpxMLL&qm3#d z*Z6ocGf$7BhIPQxcuLsPM;X+?AvGD~ zz8btVs-rq311}+d^31&}vxc7~Yj_L{kwywxGE$Q8bv+NZb`;aN2^Iew{ez7ICQw^ z;GYl~}C%;~q> z!nr$5lq1^&U<*DL;TjdAa#U)plMTHYq|l?QnjIbX3Bm2w^MX0@rj!$fBy4 z6d_!vQlBDb=}Ay+msQB52w^K!q)2vCx}plEObDkH^2=mZB}|zRwh}iglQmT_WkR@4 zrCFJ*tB@%Z!d9p#le${Q?5nG`oXgIxwnFHuZK0l>5eJxJNOZ1*)BfdW#Gy)&gm<^xYX(Wlg>vUwGd5=1i4V6)B7;CXW8b0hE8w5wFl4j z+@6ik^%gc7XB}NlWF27}r$Qlrn0%=cChG{NB_5o9IZ9=NQNpQr`{H5ylD{l0K+RgT zxmaAWNZ&@ZgdN+dHE(u!lyAD=eYsb3|USe&=^YOZbOI^!EXUoCR zlHYEyT4mb7c7r(ay2LV|)W*prEeXnz+|prnXf5NO_Mt5VL>}v7uon^DjI${$!j4kG zil9rtdZQj!zP2x}7B2hkOWgf6_w7$EG)tiG;0%g+hKN@}#I50hd+9UWyNj z{Sk523@0TY{3M)Y;wE%xfjqDweg>~1fw5i>7#aIrn7 z64miVmvCBwH&jWM6d4wzO4CIw^JfdXlUWC2Upv1?S zTLs!XMa{MFE}9P%UTXp0b7fLto_oKrE7RHCHG~HZ<5rKDkBS@@__c#5p75giA&1?qzAC(_7etTMq4S6NMEFV%U|)5lbK+@^y-!y@j9f z4?C~PvXJ><*MC)n*xfWI_f#?&syW1UX|i~FAK&<7pKKqf@sVk6OKbiS;Yu;cGr-;V z3&$J>(Uy}c?I{hzANlDSKhcc^{HdlyHJx0U(<3f(m3u;qq+&@f;is+`mkx?IJk}K& zzAkF7`3X$Y18B_$a9=5_f@Jl``E?BnStq!7yozJ!q+`hC_X8!dydmJPl_M=i@L*z?JZH)IW5N7_G5c% zql<#uu=ihZ^Ire)Egyax;^)p3&tG*L`MNK7YsQGKpJzSg48Zod&YDR7BPT^&!s*Td zri{9-!vZL01GZZ#A^ne+Ae@x2{^I^p zKqDvFz=jg{dT-(?gnMYx&lC7x9qLwUbYP>d`$ZSV&$x2$uGfdEem&OqRvp=5K*rB8 zSxZgs?tn?BN@1q^JXkm`*O^l57ijKtgZ37en7+qZQLHdsc8XkbvJz4<}gL|bVyMZO{Gb}0N<*X>w-NMXO6<-U)`B}ty%t-OQK-_&EA-=BS8-X}Ki#U%N zC2rDWABM=YwFWO8;C&@gHUkxYj?30&-C>39$kJ^Ebo?CCRSM`Bzpti>`z)zKtFbtR zYCcuECwT7{B%ivs%@-t>wV-0n86~mYuBa03vneqwlVJq0l=s5h(r_tnpzp?rZabku z`;xW{7Isi+##~f`h5R6JHWY0FKQk!BXBo;#$vtfEx?c8fdpF%>?CKSPpwm2nbYdQh zaMT9wy6XaQe^ipQnXZfk4wc+Au!Ixj$-b`S4h%n1ZqqjqPH=PHIK%K`B{zl>PLSsr zexlsQaKZ`hOv6u=+!#*Sk|UeiI~WFFOs{A5)w7Y-(hmDFe}vwFijx5>{&GL_TaR9~ zcd-@>W=`CH-eqU2I|en-@?@vA%_>bMoDNjZh0UqFJE!B()g!zCB?V7Y+*ERV>-;}8 zohvH1EHnQG18bk#MqjHRT*Fy>F6!bYj7;{kvNp0@At&n~rJt=HcYss!c&1TKZ`JriG;&c*vCONed%<-%+E#Vmr91i3e^$bSGwhy zfQp|BDx|!P$5A344ja5gYp>Ub&N@X7x#j|GewG07m?%K-OcV1sVF|IaWRm^oylQs> zZGIMQ9usI^yZb}Le6@Ccz4Wywu&bz+d_SzOZQg$_!t6x-O!41n{J43f;+PtT2*pmIN=0&p5bfCZ44)z;LbFBUCE8%ge^HM>HlZ@&oBNv zzG5tGC40RMxLZBDCLszIpvcU?q zF-*ZHt{M}zvPCpe`!c5xRl$_kc&$Qyd9_r+low&^#4VQBlxmvtB0NI#M&&iFvf?UF zbCCUnt!z}JO~fblJvfgT+kFPs+=hw!d5PouS3!uLn(~}hVQZ<)`7{9L^+?$x>dOrvaI%* z8c*2T=eXGBn&H|`S-=^Li!sw$ZDB%D^rPtP@#FzHD+l)#lNcPZ}4XCz1O zezw#7?2q5Iy(iPO@2*lm`3}j|yT8-vz2lvohnVUM%4c1*P5BVMhW1DQnCbYDI~n>m ze~X>Ws-+h`biP66`e#u-?Sq7KtH~EW&0Bf6q#Jja_uBio)OX5ye8mf#kL8gE_rG5D z89w0`o&KG(^2+=!!qe%!G=q@^CMy{poaMQb=pHZ74`%TN7In|z#h<3S4V!dh#O#gh zcsiA6M+ip+!#xF4b8qEFZ!Fx(q#>tR5(5~*mYlwzW@1$_FWpZ*`|>6FO*+{h)+)c#aj7H%Uj>$~*2%-&U2pnp9oFmb~MjP!bNwo3^g1Aeq3wh}>$eLjF>%HI)!2yaeIUiR?5Dnyz#`2avQ@5C%7{W-&JyBIN=1jEX68rU>Q99-JJ*j824G+x#$eu@dKT~i=RVr zqIJCU7)=BkPW*lDb7(T&&$)eII=9dM2Zm1E{}b%F;9COUhqTXdpMtauTERx#O2DJb z@z;{se3J==sf4Z28R2Ht8bNN?xGtG3I6e7JNG_EsUeZ(MePHr#wLO#C+TKmDvN{c; zwbiM(l}Jj~(?+)v$>~?jS~ih^vHl(+Nk*xmiF=41yAFC7EeXmFx>zqI#(LV+O+=_X zF>84bQDCgUhe(X&cSwfd9wOvs_N__&UKlaf(?<8gxZ727jP*Cc7-Lg6!LW`Gi$M@s ze;14~Ho6N&D#YNaLp&akw@#r-Kl9nnK=xC{=f`}`HnxSpw#x3ds%MW+88}q&Vg;|e z%(ifb%V}Iyw{UjV=ABlqn$Kb+f}>B76Iaj27fes}GBQUQWmVqZ)7D91!oTQj2uHPp z5aL?)KOR$}NUVK6eQxxHEgnLnRl(Jvrfs zJhzuTQf@I^a=S}7!JXOJ94omP?#T&9v+rGB$7~0W?Yv2{Xfz( zk@jXezRb?L6E#y};1h#z!pzL9J5_RtfhQ*%k>_UJnR1KaJ~0RthxsBn36Wp1Gx0GBW?xR9DA|F*~};V9CadB{4c z8B1UMBOH;R7A+oIIF!w#w0XtD?05prJMe$u0&m)yNJ3}oW{GpzSsThAklMke&D(Jw<7{gy6SQD(v&^ngqN9(W=qLU+e0`a&n^2Y zd*c$q*Tj`dS+k~8Of;%(h zD@txcPBnwuDd{QH)#?bRSldX5v)xJtz*CTuFV7)}KkPB_7x*(Pi$xft%r2}k7FA>UDQ6LP{y@~n{WD!BAE|)xfUp&C+?fr`v636>2`9+=ZaG1!Nk#+wg1;&_vb}cK3d=2- z%FB$e6k|SIX8fJ-GUMkk-jhuZFkj*}IdE4V-Tg#p=qn2y?zJC3QCxU@_a9$fozKI! z#-~;%8X*b4Tnu#g8io;SdTMp55>g0Wf^aC2eQI^4++sfeqOByH;LfbL7fLRMdvd}N zd2YqMRBkcc*DJyaZdY;tYxeBLjZbd1wOiI$EN3K7rQ(iZ08pK1^a6yf!1;H%v;7P1 z7O}mCkqT!3zUKmO%Bi`p!$;HsmjUI?__zqU0dyP*i`6tA(CtxDM|Nl3q(Svy4`Dl% zzI&@#E=zX4gA;%5jHXoNgvGJUM!1O!95Im3+;~TJ?*QAOJ7f~8b1t0Q`3s%KHF~Ca z2;1nPRmxt()lzcPDiKbQCx^Fn*WkCOl-n3iIKiE6PD}D2r>2$M7*04r?nbA60mWb* z#~??zgrc%0t+HtA`)~k?t{k_13>wV~a0@ArIF}`yFf}s{J4$ZiKsZ63SAe_9Z3>WZ zf;-djJta4W6Hbul8NRRF#&E(3?o7iEl-w9jI6+=?mr?RbgVh-?v#|BOJfD)=X9YD~ z?FG8p3)nhwe;qAz=VA80GGJk=}LnX+bdWS!{@-eR38o55m@ z5U%bvZJ!oFlSpsEiFjlNds)d%unAl8av^51$h17*TzMb2FuBeeF z-3VJFQL5RKRjW#FB0xAKmr)U_%82=9c0`pmA#182=JPL_Kf-B+{PmOTDj`mI3BsX7 z_PA?9xy5`cz(~Ys$z`8FTF@xft%r z2`9*t&1=aWB+RaI8^Z}FxHApkQ*vWC;RN~ZuAh8D)=w6LMhx*>mAdWqlzz#h1g~z% zV|j{`x1Q3ke3amM^3=*l6nVVjtsHLIA}Ar@RkzB4T5fS2t6`?N2qz57 z94eeBxhXEf5qWNLohr8}F2V`!%pUhl$xU$)PLSsf6)u$97*06BooV=`k{iPbN919i z6-!@v7e%mwZ>w0rw^g~8b)V;4`I9&0tgrDuIqRF#&AW|ccN%W0MIV+c^9$O$L7GgEn7$xV?HPLLFAg06DcLT;Zsh8$0oFW}IV{8^oGB{yLr z9Fgaaa$3r5>J{MxcW(JAxfssBsI*fl^4y3|E4N8Z!ja+GgVGr#HxVbCAWzn)x)aXr zS>-l{6Hahvj&isFtJ;S7(KO)%xh&+tXvZz&!Km8ZIx1I;Q9X3`#-VF>Fc0#pm|RA= z&Z6GR+MT}v*BW&ATiODfWF#C}pFIHDQF4=vgcIb+GOcYTca_^1PB_7hS~PM0AF(ck zS4B$!JNL1@rvk=!!dBpme-j14?%3Z%_+FIbQ@_dfu>w5p05+KDzui87ox5(A4|mt$ zgU{m*#06#rzG}VjY5usl$d9(tUF0XgCtnmD|M`FJhIkD-_kHzF!Y4CPUBcG8V)&3h zseGUk5QwF`0Yf$9$_8 z(5;~b;05yk>|c}vy7KyT))jFnb8|)9rva|0qfaeqd2-M}E&_H#XuSIED$Hf?X?Ms? zE_=^wvnM6sn?1rdK(0|rx2a{_BS$&!SlM7nqVLH&Y4W^=V=-+w;hP)IwV{d5fN+Am zdfA&Rv+J&TqrG>}ZYAxDI)Y2hyB8*K42R@ug?Hg&ZqLkC04gh2)Vmz)tWU`RATJ=T6kh z=k;+P;UD`t9CM7{oyzYfpYYY>3`sh6{uBxoU)bMF`~=&{0+xs4;pp~0A^uswAGa?l zpE$z}iN*a3ym8GbUhnXb%0qmXEALxBe1I>17dtcntUj=1*=?*0N*If0td!J#s`AQ{H*UUkyYD+dr^0itEGo9vpDYpH&fT!`|M4)=o-mU$hRY zTG;V`TD+XfVJgnF#KWhCs{KyALvd0xJzK}HVR!ad9J;fikt$f6ktm`}@!dN>5(x5GC zfIfYC4X&Z7U@hK6B|t@3+VMM{`37c_MdIfP+g~W&ob~bEwU!v3ym<6(JRYficJHuw zlK8S6Blj21?mZax2=OWH^UO$quK}fTo0%MpCt^Z45^9>6Jk?J)L%2qxQD$=bF5wE{NJdJ=7g_i4Ltj}`3WYx0s*E?! z|H@yyVNr6>5wgCVdsq)%G>14D%WQHtRNi<^IFi3Xle?)h#!JFAGL;ey_b$g~Pp%gk zQJ`C@XbLX+irUD2R8cU06kN_emo zLFr|-_8x~r7z(-Rth^WgL;&W`q9a8JkWb)P}XJ?!!_6r&M)EYZ?o;^ zg_38miVzGs4_D*wh(nyWO?!-4EmM>Agwti3Uuox5!sI^TP$Ik1&MUXcdcq0r%u3r) za+B|bL-KSV{|=OMwU6g#_VGW1Z6_Kxvx{n#xXi!kWeBIO$}h2Hl@Q0h1mRF3yTn$M zTg;~d%qN`S&MdK2B{!)?I3#b_%&w_|nD5&_!f6Fw2#m+XrjI96}G97*_Q zcD~qDP`2UJJEmN5cQ6{F#%Z^qR*B>Mi*h5JwkkjEHdVr;9pO+SJMFfVTg>-q zM>xTqnRYu$Zqkl$NZv5*c2z;l_i0Bst&pE~dn#elj&LNAm3F5$NxOZu%A_6Pv{m_O zcc2m`?Ffew*=cvE+$QY^C%7}y?nuc^+7S-P8>Zc{Dwwn*oL0zByAzc#X-7Dc$V$62 zHv}sleQgGS1OHty@WXJQ7nTcc*J_iqu(>(}W!1uW$swq>nFHPt!%+@PI2`@pmu}EMoN76m zOedT!$NY+VrV=LK35OEd74<^7O{No0aA#K3OC>isPBn_KKJ198ZsJrjJ>9f8t%QL$3uV#$>sdwH?+ZfthqcIpbC@`ZsZ*cGOO%wM& zj-oNYtF`S{SUVfpHXhsNpi#DcFBPTINf}$)&NtpvZK^64o34EwkHg-|h5u=kW#Z~6 zVVkgJ(^aVQ+Wh^WWiEtOq~^*cmyc9V(q>fJ)D^;3`uyJpq;<29$F-R2UhE2do>gJf z9uT&|k*0I`JJIJvE~hW;1s>0-u<@9%6+Ztwpd$0KFFLi*&Q{BmUgA8Hu$3tk^2ZTV zDj}YD3BsX7_Bdi%xutlh0P_haxHHEQGfFOodvd}ddBXw!tSZ>-s#U-&^2Gf=VoPr7 zQRl9`QW9Lom{S>X#GlR*wvL?tSEOz_xjC;g;*Bq8!d9kG$j_yYN{A<3f^aC2olA?# zE#~{;CY<2T%%x=|7sEX{;gGyxF0H77nC}aja9Y9T(s$z#KUul7sxsn;mmzFr&VT=s zxg^UYQ|*#lKwNimZ%t)PVGy=5g+l%#bJtbE6bWG~;kvUw@$3CkOSkY{?c?P)RK*kv z;W`z0kn>0(`xM;mO%*Z)L)Z!x5z8)6T)>W z&B|m?g-n?cwn9ajq#hdI#@bnCA5Kf9GW8dB@E*&z-HeByZE)|e_vHAJ&_6PsPc(LS z_26ZZqtS=$19YT#uJIY-++X?vrz_@O)%%dP+zGKWrq_P-uzkixpx=JPi!FEl49CIQ zi%NOxO?4dNo0a4pIcI*+UHsg;+C`=1O*y6@k~ifPYecc?436a9eY>1?gm75o;I3Pw zbfN8Ha7MqP^u`gwF+H-RvPh{xsjRA+sVIaawFafKru4=c!ZAIZY2%8mZq^}d-}gHM z+;!1==uZ}rnC_+>{+Vna`gK`t?opq+%z0gnGrkj!jq?Q=Z&Fp4k=J}^Iqs{0Doe}V7PIjLZ-M0TOlb^T2q!ODrdKaiqyEgPF3BM7h$Vj zDCC#dnM#=QB5WmYR9+XVV#O-kUWBbs5wYY@#AhbT)Kvq#4p@$UD00o= zhm!c=hh&JY^}uRs{N%#X`R_Gr0msr!I^i$|=q~E|=DH?*dtB*FhzVPI=Wx)l|G{Um zpy}7qz#mWi8@Md^)ugkyT=BK{N&ylltvr`N!*s_~}5 zARHRsw1Hn!3DaN@wh}jLFxFMY6f)sDm1Ygbh6YCh#DL2Tsu3eZYxe;0Y6T(}GKW zGhq|$U^8Jx+p$Zwj1maU_xlQ)Xdgx9n>#Gs4YWV{&8{N2a`rcDIsCoAF>bi5V&CqM zrIl6u8w4*aQ*;(HyfRhxXQ>9L+lfX}VU-#wWTUjbm>#kbj$)-1E4u&ia#+RMzV?hz zP`yUU1g_-F47o}cpWByp!B(3a&OCl76Yi#xL7%3D4h3hrqCa6oe zPN;IZJG#bS)VL9Mlydz@!ac&HRFk&|*U1L=lybdF!db#2WPP#sy3;7)A{W?)jH*6C zxsK`ecGKh#jx4Blf}>=DQXN+rlj?+PWGaOktzqyD&xkT@sitv_@CeQ1UBWe@L5WVO zsBx6=a8WJLccMUDdxFBuXsfQhN~Kv_b?ucXj=oZOKVXMr*pKhBGos+Gz4*jvvCys~ z78KaE7o1eZw6JEH71q3FiAhbuHcOfnR!8Yg5)zK-aUQEzOWfmQ*qRi>yF@h~GQ8Vf zRAJ*6VJoZ}GRPYx6SOAFDr5X3oR%>@@?_edXLWhjTfFDFDVAusB2AsR58OA!lGC6a zT~U+7bNg?pFdi5nA*1a4EUHgiWRAx?M+ z!jXipTyMqQ48B&qxifg71wz!AZ5OHspZ^NkgTQH`+MzFa;fXbP&#Q5qCTv`{j@42L zhEIILX-m^3I;?J;sDuQ=OAwAEn$@jSRS+k9;uB6Qq@5U6x6V{TobVEaBZ+2p>p~U8 z3I0V|5>6|mofuZPE>%LD@DhY0372Zgj>{x|FoYP>`**|%pZJ8+3i)+wTqVQ_FF`nx zxN+U$1bXAT)ly3(7(Vd{r!7sF=&-sqr4kYhFF`nxXjZqTRY9EaiBCAKkal8N-I`Ge zal%UwjwG7ZtyxtNC-@h2i*Q;Y?ZmLUHK!8dgqI*3Ni?fl^Qs_D_{1liR>-eg9hDF# zyaeG$qH*2ggdY2?gPYW?MYU9d;S-;5+R}814y#+sDj~t}5`-g(W_4>t6~qaj_=M96 zX(xu&tyPr}C%gpVNTONYT2lpaf`3uB2&Wa&P7JGC>nb5mcnQLhM6Cmlb2aTPzkbQ9nSF{l%Tnx9#P^o1(Dn8>HnwkM^R^haoeCS@U%9dp&i*#fqIu2y(-$`w zeQasInR-b$op0%SIjn`;Q3+Eo2}csmTF6~hF!hpfS|RPkuoiMpB}}~}97!~5A@@~5 zobXdEgwqOXCx*3<2Pz>>cnQLhgl}BRo$iYBPQTF|b^2~L=da-1!|ojZlC|IEXDrs4 zc=5mgN`B-QSeMcLR=nWR5%?>UKK#r{pC83hjR((%>X8J^_r8SF9;JgeEPanuLW1Tc z2uBjl()U;u#0lT~5>6|mofwwBCn_OMcnQLhM6>igRRwW^f6>7cPAjCH7?!?gDj`mI z3Br*C^DI5-`fYdmu$lUeBEaFmPQgU`Q7CbMV;`p0LF z@q7mCzv~WZI78f0t0geLCKFCuolenVjm4BoNMO7K;YgxcV==7?;)JisgwqOXCx$f^ zGb$lYcnQLh#B^UV?BWG2N)K*iZ#=f`3uZ2&Wa&PB`(R76gsOrb>ttUV?BW;Zi-jo^7du zI6)maK{&0DU(a?_LY(jtgd>S&E#9swh!egh6HY6nop9nsNd%3>o=S)lUV?BWk=d7f;w=5a9Sb1 zo}HD-M-t6iybDzjCwxsNoK{FX;lyhii%XRdC%gpVNFuwja7Cw$1X z80k68PMiw*rIRP!yazU3KfCA57AYH)dK6m|BgQLYt<* zR7~LV)D5v1&|}2HY#hskJCiV0bK?y^xPPK&BI<4>IY1zt|zR?DSe@TzXg)&Ke> zuZAgC_bkqBZ{bT`%}>Q*J9|-k$*Y+u+Aa4Tr=ceYd>@s+n^wP`72NK=m0^WEaumNA zaB{eqcINvlmz!csfBRbjaH9BcJ>oaaYnhenZ*!`S-~0#ornqY?HMAMJlg}6gt1HTV zQ$jebh3vG(I{A0=rr9!6N zB5Z{km&vp$m>z_1S|PtoW>mtI31KU7qcWLQ6;mdJ>r|SR$(#zAG9he*iZV&wUFowA zby8Bj&nL8&JNayZ&9{Bmyp>)F{jKzcdUh?HSN}{#5KjA-pAj9EFd0GEO1O-ueOhR7 zM@iA?vsW)~W87X;6_XK!>s0D9!aSBVsHMv)WHN%V6>3~2E2?11gm79Rzf4wD!juVN zD{-STSyL5LCWPx$nw81A3Yjt?Y=w$4sjH>TzPehv1Gem1Duk8&w%Qw=9(JF`=2`6Y zu5e=|{w+Obcl)7VM0e{Sv|HZcyaku=G+yjJ@%(Y^9nQ7)H$TR{Ii?Ip-h6E9)zUTY zvn~0X-QRr8J8p|7?)vte*lX{&H3If#jHRY`+|J`h9E2{q<8}skaZAP` zM`hL9(?{M-Xp3(;QZ$QyoB)+it_g-_ys9KTSt#Sl%7A zjC3qgbA_qthBLkP-oy4M$byH>^VwT{o7%8!A=A78*z8xxOuzV zF!JCwH}(b967=MRZ3%*WH*NTCo#7kGZ8~hi3GTGvC3#@@rjnbkns7w^iL~LLs55*^ zxlIR6IKj=Qj>Hi!$;nZ<)V8DKrc)*yks~Kwc27%u_c30++?B!Lsd-!xei@`lrln6H z5uZIi<<;IbWL|^x+EshRS^h{q@p>m7izM&zU;Lc31BPAEZJvrfsJS)A{U7w45lPNs5c^vkc z3A*-1zdhoJ&0>a&>5AlC*zki#U7tuHe6h5NFWllpovSLji(~j>HxK05?(j!u%8Bi9 zG1Kg28ut7pJajobgw%Tht)w*Sa*Bf+4xuoMaO=;*PV-xbx?4uG1PrmKE^~wM(2Nk z2)It``W;<+%kT~swnFcvj=Lw8e2o0nc%{wwSyn*~%`(i`F}#C?ogrp?EBWiqIA3%R zCn@&Zs%(?cbmNjSlu#nw2}kMfHzq1n-IF?A!ToDd)?e@8B;zV=dLY79`uv9=qE)(( zN7Zh+v4;wqezg?|N1D#%{{)K)BbTrBaFQt%HXaiWJf5IN{wctz3W#U?%S)V*fa6XN zb!x|GXG$*Cdve0odXVRi(Jqu*45tDNC!F9;8(up`yHs*9+>;ZI$aBYNyaJZ0KY$b5 z7^6+x|F@zlgH26pPXl;4t$O0+`y;|u;QW8XAf-Xhv{b<43}GwKBxk0S+~f@5h&(rE zrj^^|4B-TKX3oqgxyc#A5qWOT%qq7S?u(Rgg4^ZHX5x7x^*J-A0%E)uAZ!KBXTj^n zR(w(dM@y;E?69kQ^D1S0A#9~emHG)XBNPmlIx1v*B3virMu;5D;w+)Nf&+2(`|Qh? z80D_w1HUMyi_JXp)BhCp=wbWB9nimXR?a0~Adr|#MhE`Lot@q4YM{q|>ivi^IxZTsLXY&*ewv5g%|#Wv|@4$*M) zkkU5qcj|F#XjDFfyqoyg4zaDW?CrkHGV=ear;zyAPZn`ycV?{Ac{3oev)J z3KOO{j{7fcG59^XyH)%t&Jqp^n=6m;Q|+%s?wb&#kl79=|4v`2d->OQO%178roPRrcrA!lZm$g2usem*iltCI1wgROO ziMh0rKCpjX>BW9ePdK7KPEP`2i`=K**?IWvJI9%fmGk)x&_Ti#|--%)xKb;1#SZq#>`+eDpkg4;*^ zYg5swjryKSn5YxB66e2+5gq6CJN@=9nhL*da#GXkh(5Q_#+BO?8sP+YdP1`-E^<`n%gb@BDXw@N>q?4E6lchFjDSxs zOPfE5dGZG3QVw-Zxg>|WpQ+vKwYCYH*4UZKL^u&UjO5}=4Q1$pCTvEzO}P+GaA%fF zIodVl5|4JTQ!diGx*_ocRA%3MF8va_&i@WTISOhYRVv?6S^54;jDH@sU!|jcykPj# zK50gc^L0^UzdmWxnWX9?Tv`oJ+&@oy{M@?OPleyyS(&fs}C`24;*rTg%KJQBXs`y56y*tnmA8a^1nt+&G9roAVloEFcj7xr+; z>_IW?xoThFB3XaQJ#*rZFv2Y!Lg5~S_#W3@zluf|H-}8z|8dM#70ve%oA3XK(^n7O zlpm4_RrJnIdFI_>-FG(9z@@`ZZ{g^W`K z;`a4#Pe&xEAf-7%#1`oG^>0we*<-C6_@>s4F$6qL$1dR@BfUbM8%88>V_Ze5so5nQ ziMUw#lj%NE?(W;G=hN*|q|ITir}(DU)0P@xnhL^^5l*4bQzH_1I;A4wsk9kg!jT9D z5H)#+Z))9`Rt3|#6HY7CxnV>CH)d4C6d2)1#KlSr46L@m&aiw^PHr1kw0X5f9Ohs2 z#DpVTT=LX8j4#Wm1`c;rL>%@agd-8;WKFr@n^GYdP%Nr~xZyK{a9W|x4I>h`v8*EE zh8H0mh~z(Obw#n?;j#doMnDc$X2M;gs2&9g*Z=Jz2@5P#{W7i$sUAn-L&vDJw`>^ME8=od+ zDPZG|^alq#|;RJVP9_}f*81BglC&=?E(7tjT!wDz2GYvmba$`7QOU??U zy}wo<_BYqBKUQ zcV+>eD7h&>!U^)c%sW+XV>saicc$TIN^T4%9FY4~JO3O(6-?q>)G9PdoJ$oki9~qVst`_aXU2bA$xZwT2jo8fshQUcT&ZA>=~gMXp8hpQA;RJW4;d4rE3@03rH%***RWOM|IIYkmaXKnu5{GaglAkz>%5CCL zIKiD6|79gN@h2RR`}im8cCtNivrVolCV!*tfjgH?HuGle8=PRQsNtqq2}g!Ig}P!j zB0+nwsv@RX2?rwi#k!{4rdSClxHF4&UCB+c5>AlkwFeu@Z44)z;LbFBQ^}3tgah)X zQ&L;1U=oLLTA@ke?5K!I9KwM}e&XyZw~0UD1b1fq_mtekpKw6#O6Eu2_vo&>kG9h$&XWfk=L_9xAsfR>BGH%wj!K za#O5?6XbdA!Lf21!wDz2GYvmca$`8*fV|&smN=)XU=oLLTA@keoT-RO9KwM}e&Spx zw~0UD1b1fqFO}THpKw6#z$t{TxU&SpaMT6#JT8QgV|8gcIb+=A+~e26EHNZ44)z;LbFB zM#+uggd=iyMR{0h28Pcnw-`a%0_ho0O^sDsZ}nLCK>Bd{6d#%jwBYkxCDt= z>sskzl}k0qiB&F-v9;Zk9~nkVg0f>-+L0(!!`t3T#5P&!Z{A9Lja%pGv!Pq8hlH>GfDxifG_)ZLWA zpAE25vrZLJkcv62k_ zP;9tuJfyH~i-)@#W_IwdVjDk-Z9Js34ekCT42LE@c7`tad<%aZq6>oi&;G<~z3wV$ z#fsuq5(fo$eV9Y+9UiJP3-8ZQ&Vd^>8b1i~uDH@epY{WX4-y z5Qo}^+(55MJjj2KmZS-AQ2ng@?&eRRozfd5UMY=Jr^K*s>BFE(MooY_9j>>)yrM(w zndjaHZ^{zsFxw=$b>-o7CUNr-B$YO@a}jpYhglQQdI%Zu0dUC&=N6cjKCyq!=+*v6 z4>+T*9kk9Hcej*>%^Do;aPXOVZUN1dHh=LfXTc<>`2n-U4Ic25@wUx^(CFN~vuM23 z>VTOy^k`{#)zT-ezGU>&>VPx)+E!mSZfbSF4tH$zS+8}9tv)abYIVRYadV21aN3(~ zvm~v)YP@7RVCHRGedf8Jzy+dZiKOM%OoB`Y%n~>Mx$x@UJ8|#n_6DA_<{kp6P-pEu z1ixLZZZ3waPxN$j3Hv0`-O*(%RyB#9jxQtq;~!sYk#)zH{(!9wGxU0Az(%9XNSjNd%oz1qQz+bo&BpZW%X6bwUn4!>jK21cste<$?gH#^mxdIjJ6Xcx zSo3^M@3?Qqy8cPSWpmPiiSCQtl~2mHx!Px+M4!D+nnT+4+@CEzFU9Fq;&^OSz?tLc z#fk2gK8eq3qo+OtoY7zTreBpzzcp^^Gr$gasn1&a#PmC(SJU+v_YiPKf8N|_W!a@C zdRNwG*Ly41d-rc&dr@xinT_v1Dn<6;Ukzy&>gOp&N`rl=q5Jpc-+QNWw~yTE^Io~@ z=lxgT5;moHdiRNUH1FiLc9~vS2onm}bYd~Q!(IvDMxZ$Vd?w`%zY&|m?LeY2D~H~P z^Z0f1yp3>U&^{o&H^>H6@(WB=$Xu!LJi^=EH@=2j{jT=ze-g)tT{$BNB}8ugi{Th< z{QF;}xq6h4DN*PiFJm|Y&KkWr!sj#f?a(3V(`lopa0Hyu*M{S)aZ@+~cDSpCEgY?Q;X>BMlG*SAYdzqWEI*M`eYXz10~WQ&=2im&(Se)XM1OJ@(3y=P8d z{;~Um-A@hv%qvqk?bo@kCHXUn#O3hMqe1v*e^vgGxvsVF&;Gjn^U}(XOVo!QpC!QX zy+ouOe15z$12!##5Bx|}59Dok2JBEi%cKc@QJMk6pER>f1MyC0nO5apXO;;cb(RS~ zXY*kGhmISvf^O7@(r_XLBtx{*5tj~wl42Fw&A1NhM%;yNlszL zmS@0TO=qSSL8~nkLSV4JAE0E?hkn8nJf_o~0n2p41CLkk!eJ;p?KqtQd$kaWcTHhz zwi`r)HKs1X`qb3M@9qp3*u%arNt|N`=XM5cId6;rB?@srA$t-`oB?YM;|9_troBgq z5Ts0b2COud{^$rkV|w*RsA2%_bhwTRUL86E)=DG=@7N@$Y5-=5W(KTwz39XQ)Q4EG z0kc2|s8ZD{+J9>FRImYO^mqRF;jT1(I5Tc)e!vcQFugDX)=DJJe{K@g{D4`)p8;!| z1sT?v0lP3>YIVTO+ppCxjhQ}~1tq$1Xj;%f`-)7TD#a6#I32Jq~EaA_9 z6j_t7_OXQtB zHgtY0l=4{nozwW%?j#^LMWkEGV7(mL0khq0(>SN`Eq&4~TSiX-2{@w<0h!PGw9&$* zH@ggUyVRK~fs~zFYkHrJZ&^21_g)!&HYTJLj z`LXKuAAf#qX#4A^K;}kgp40g;-Krt%et`Kg8EJ&Pl4N`NyJo)rh4=m16q)(Zr=%0w zd9>4ZJSms3*|Kj76hYKO;ThjQ-LeXIz%X8MsQIYkF)$ zzz%oG^p>8p^3k%Gr%9MB#yWWIU~@x6ot6abxLRt-Vz6%-J+&lYhdvK> z@oP|+EPi$9Wbu{>caK70>7Io{+d)Hp%O;BxnIuxSO@{mfT#!k8{A5VzD@*7rB=k4` znqCRLW5%e@G2;NUF(FQ>`|`l()z?T5IHRvk=tJYC?gH#^mrO4v^pVk1Hv!J*$4F>z zTduz`6Z-7JuVfdcN_K3PQJ(?MEW0R97Ps_Ce4ZFR^%>xdzII!#Q{$#S1MF~@`mDGu z*O}2%p8?M3FA8%avPYL*6@&?X*^=q5nJf(H&E1G$q@kmJaN&L4650 zv$)5=Vb$oVF9B!twfVPZ+|-wV9qv+J7V~f2=&3IOXY{2RC_L*_XQ0B8W3v%gn01%0 z;=fOZowKC#Y7=q8Or*{OoSE1o5jTyVIuCG0Uz>oSjNgb~F~0OvgiV>< zSM$CTj~U+wH7;g_iL+{AIDNr)`n&Kr^5{zbH*@kgvWt2c!q$)94n@5?enSLEIRl(^ zPLG;%Wc1qiksfeHUt4pIjhiwKu)|#n+hWZ*F?z~4z#09Sf7CuJ9kox5n=%ft!|h)g z-;#r)o#uFSX5^G_fE{x8lKz$(Vbz)CJU4DK9I(S(Y50Yali`4w99fK13CGyD^No#* zW#_0j&f*!i5AMq~L2aK5OLK;&CPeFq0!^aHt3|IV5M~>V}ay^O{`6xpF3!%EbnFqRL*l zYa$MRv6{U5Mx9a!56u|Z^u_+Qm?c+G$dwe~3JQs%ADsh)NsW)phj;BE6`%ExiroS(aU#TX5Y1)wtn`XoGBN?_0kyh%QME&u+vzA*D}Pkul1eGl7qo?>_OBe}B*(}Fu|;a%$v zKC3(UP1l_Pe!2HhS4Xs+0Y!J3MUzi&vVmX!!k_xit~0;C>&#Oz8stcDPoho242Ia) ze@YcsLl>$dps1+ulepetT7Dt!%ahWt!<9ne8jX9ma?XeO)K_eW?XY!oywIk0D(zgN zygL+&#S^f!(r-TtR^wWsaM&x==HgV^h0#-O2At8?9#$@mn@SvDhr48Y@vw4b^i<>k zXY{4%m(Hnt(}`h&Zu~($8!_BID_x}!ne;6KQ)IRJeTxfF;ue7<9oR=$Y zuB4J-3P8#j>Yv-;{skN}H|l&%JF46oipPdHA(%rtuxgI_h4y7j4LX8nbe# zy%Q;bllEwJw9!XPB@;k%CPh&LIFo{taet6pN53p?5i)N&6hVNCIwhA zoJlpkNYdKIv*pq}J=f|E$%#=u0VKLMvA)-!H@1}CXA4<=01RWpq` z6L4l)6KbW-)bHD-PFi8jq^L6iXHuFVQ#fg@PSkbNp)Lhn)G4{7b`)LOFe&O-z?oFj zdTz(MiF!C;qHdaX)VF{$>n2RpEt8_Y1)NItOw?^tpk4*+EA&a!9TTDc1e}W0ChF0I ziF#nBQD*|qOlv}|6xI5DF{%$uiaHZ;CZ!3|FHw(7hq@GSQK#gR+EH}r*rcdq0cTQ8 z>y4kNvImHTgIlrE!(1|Fbz;_0-vZ98n=nyNO^W&!a4OX^QO`_)dKIv*&?iyPO@#Ur za4KRw&lM2+&hSq-r=Nqu(u+&K!h`}dx!eP?7btrk#FYYn`!y~{;>cb z#T#M4o3-u^5cf{yn?NT2;zO7=zjr1-JD2nGduMw61FmQPzGd8a`bwNDX(G~%E&Z~M z{3Nz6tfjO&@G9X7IBTg!r<7!=RC0j7G%4+rC$9=z#VVuTKC^$qnbusU%?bq@z>n?GXVyZBo?RfD@_u-kvpX z>TSRdcbK_+O{_>xydT^v_V}C$P>%y3S zrz{#bbqZjIyD|lrjGQ_Ia6;bpg?CXe@=5nfzjuivihK+!!|{lOqtY`t5dGawTgQY= z($gMT0?PM<2bRbmg`*daV1En;txx7G`NCDgYia*S1Lr5j%D=0}KkV9S6G;WYgzwT2zmaPl4fAK1mfQwzwGfW32rM(@c0B2H@9Q;;IM_q!N zxCFSUQ*vpj zeKF$Dv}IBhUVt;HNy2N}bSS(47j;T5jR>zDlcMkfoJiG&*MV_UcmZ~}!_oGi-O1c= zdDj{6bjDYQCO{zum<4XWKj+;GH?$6!l{_+b>IJ~eE}0)@^JOZx)C>B3afEwpQq&88 z6RG-MI5BSO1;7q>k1@}w2~aNpW`SnR(=?WQFiBe~Ig>gwG3pe+EH-(koSPJN3gASl zzEduYn>q!s!(CZ7_A zB;c$I*5X-ssdni1#oBRgQrg>53UDU1HNgr0t?8&sP!pE`7j;T5sU1a^?o5g@4{#z? zpLtlg@1DuVF%MveyE5~pjhr$Ma6&%Wm}k~>D7*j{bxM6PBE05Iioy$UCN)WT&6^H| z7vQ2!$)yqDwO~>dUVsy+`tVvbZgnGu7hs3G$Cziy1SrG+vw%P588HdIZ0r25(#o}9cdi}E98CYwld2ZU)DB?H1ubAvh=FuTz)wr9j{ znG|(3;6$pvtGA7tx*D*<9qPs}i526YEA5y7bvIxZxcLj>*)0C zltYuEP63=q)pyE~aZ{%NcDO6^@7TzxLjWh_ZC?}yvLi?7hjC`INwj8WvXh&mrX{hc zhH1%!!kL!rkdBy>Y`6+;#ql|=jcev4--bEKzov7N&0qHk&=YHX?OD8vbAXGD-!ni@ zO-lPYN&!x#dLHM_OhKK2jyMC@SLkz`J2w%^Gr);ReV$zyw>l69O@JNl$~?O?a>_Hn z33(gbeM0KWbkvF1&wz_MJwxi+q$s2Sr&2vb>edt}qyYO0eM0KaL@1;HCnEJBg=@{d z(>#G4?r=Pv#ytvS&pqPWd=;Ru0?Yz8CwCd|Ubx_Q$lT+su~Yj4W_HQ*raqQ}Nxv_i zY|oh#^#b5Ts=gQIja%J_i4EA{4!!U>v10sQSTF(V1;8wD^Ml}R8_Uh`w55`v=AwyF zrvPTLj!w@`Su!c=6u^m8eWxrNH+2eNhr6=c4vd^S1aLy$_C?|F|F7$)rpd>GTNu^o z4xJ(1f9PlA`5TX6M6+rQuf2*_i9^6y!#5+RQgG_`#fq_JQrgE+3UDgb^YF873hE4W z#2LW8LZ8FWhKW#)0Zv5fb8OSN)qz;}06W~3Iksiwlw*Js^2tUt+oq#V#C`@`)ae;g zJ0?XT1vr)J8BzzPKp_R#SLhQ`hbBTH1vn9@52+*LrjP>caEIFR)~XTBu?bLE0cL@l zAI6Br?&dt-4I2RquqJ0}xV;lk^o&^8d3x_Fup!FKhyVPSw-;36!3lB@&UZ9xpPP^z zeoxFk>OsJ4pWOJ?({t?#>EzWpZYtgyp~8~|m5kq>`)*s@^n2X%$xYXC9HAbihL`?4IBys~>kJrEwFb0B2I#+5K+sn6i6f)g`Ej zOMr_yC70BW;;;}q6?D&tqZHsos{Y{D?q8s8#PL+Ve}P2JD`CUeVbvKNoy&-@Z$Q`Z zNFKKn=-yG?cDsB2nD%*c6qq+1bpo%_7l4xnYIRC|kxC`uwO~>dUVt;HNy2NXkdE4!M!fVxZD7*j{ zbxM6PBD~g2N?nSP3^wjboRdJKAtwv9Mo3 zGo1h96AkCL&1ULbz-)8B5#^52Q-1=^=xaxm2gXhP3E1Hd{kb5&9Dg`}XadxqfLY+? zLVge$sBSoaWCGOqfLWkl;~yJ6H9p{szP9mCjGG!Cu)|$ht51!b8Xj;)K5950FOk@9 zX4A^U`Df%3iC$y*!n&?AmiHEAoq_!0T;;7D#h+pn|3)3fH#3y(aj9Nv5Bb7>qS?4CD;S!|)r&2wqtu9PKoq>)x1K3wkPwK8= zx-=0=SHOu#{ju-LxYdC;`T^{4SElQ=kyE+?PRQG??h{hCrlU^8eg<6B=^0XYCPg6y zIF;%dQd4qt?=FqTkOJ&0^a-hH6QPg-oQTwi)U0t+NC9@ZD?@6|$SI@%C*+fb)V%3X zNC7VD^bDy5lcJCUoJ#c!sYO#zXJSYJ_7(bs)RKu%NC8en>O*STxGAInJKSMJ_o1p0 z`oIJztN^pX&2R0D&@t%72>rj45qdM1hnYf|E(|*X%R@t7TDg!z!jz!$Vegr%mw&9; zbL>Q18SK7aHW2*?j(vk&+2~ZBKN|L5)Q27X!DK|bckg2FR}X#OL3*iCtmf{eMy8~l zJ%(6%bWN@giDJ$rM;*5wJn<0ifwhG{Qg-jbTld4S3PXtTFGzBfpS^qg2P&lBE{1d_ zqbe>}YWp%ey{EqG6C2}@XKzX$;_(``q2K@25`FfCJ@n$4w4wG9Fe5@?)q00g1~5l- zqNmX?o@5dbYbHra1bC=qCno;bP*+EU#k%Q}%YetyM`Y9)kOaqu89)sHcpL*PKHejB z<H#q74v504E~#4^-YZZt7jY4)?QnZ*-o6c5YjF!?I3V?-;on9%~t3hul4xZ@H6} zKQL}G9I(S(Y51X$li`39aw&xfoENU1kbSge`Q{#$pY*a~Y@_{?(jXELJ)`T$%%JE3 z?3>Xix{ggmeZ{MUFyKU_KDthfn>q=w!(G`)r$$bl1lS?3i>@={Cc^)(9se$S}Hk4PMZ`(8sJ2#KGJ55n>q}z!(G{7b4E@b2G}95i?n&; zCc^R*jns2kdZH8op-aWH{i2eB5Ar5XS#FW6lq0I5V&@Z8Gj$H%lnY04J72 z1^=i?63J0>!z3uY0H+c%{ZZFTo5oGO1lZxO?4>Our(Oc=kk=W$ZQNuyV28WX@Es#3 z!vUw{8a6`<*=zEk>XmabVdlBN_%Cpd8TPfG^i=b}Y}5uo(8xF)aAIQ|HTF3fI5ZJ$ zh$sR$6S*v&G0Qi_Gv*^xP&e=@ZUFWbN^X!yG8#BG5p^Sq08T{e3-pO`s{>FF2LL7M!T$H-V|Z*E zKjb6s@+wb!2-lCf=~%qD_uLGnRsftBig{_j66dfYra+wq*jMP2bGIf!od!4& zc_0zzMqB%kljNX#XWZ&QoJa!faN~%ZUkTZgCx_c9Iodl{LIO_6Ip;Lyx~cc37bWYi zWdbNfokZVL7njWyyK*r2{?7|#du;fO+^Ep(yZqi+d63SDe2*}`nUWdM_}HA6R&L?! zODnJ9n@Nu$)8?wSrs36rv@+lqbCOM{HXkcZ!GZ$#CMj-THhAYx4fda!-LdMY52(Gx zl^$}NSNAq@8BqOtxp=ZOp!$?uL=vu5IS(JN<(Y)iK{L<&bzHgPen^I;%_h^=I@~X0W!3=Hx@biNWBm92;C4 zxwb|m2h8Nbx#YN>p3BNAPVW%DHAATH0ka{ELaFbEh47t;P~QX2MEZsBlr3;kX94yV zN^T4b;b{}0P6M2X)JNN_ajOGbR38F%xczh4b|lIN!bfvPu7*c)zzMk(?T~wgb6H%> z5H_G_&SlS=iOomSqfMYxSJMNF5^aK5=m7gxmilm5C?1-KHboQxoQd=c#UoRoi~{T{ zl-w8=ipM5G83i~K8Kas$*1|b&(MGulII*oq;ao6s%0a+PK1Si(kU#1jt&3&|bu(Z# zq){k!^RQ@LG7;)#z?n$DXk9i1>MX#%LdlI`(K;{@>NLPCf;w{c#(`dvyT&IFd-u+t zeL=o^xwHniYAWhVta5-$DyX9)Ws+jLW-{tblmW~#O~=Q9j8{ze?w>#VqWJXFsHh0X ztfKxmlF>2=cq;#3nDg?F#iuA=e1(kVcYkmV!`I#SpA2^2dn8vipAL5K9Y4Lha`yD@ zy>pu@jE`+wIVn!7$v5St87no~tg&Lc^(-iqB7{Ve(P3K8qKI41&WdixH$^v25;x$C zO!WZHx-BS_+#r#}4RllY)F_GoPDJXj%Re)2?FU4kH~`q;_Q#{ewUu)trwj$0k=IVs zUl_L<9uo$z!|fa1o{hu4_DuBArIAxM0?x>5Z?C*EZfbGB4!3W3vBj^AoLU@kMqb#jB8eMwCZcXc5x|K^ees$%Zgl_(;s9WW+mFa%DlHhf8Xn03 zXXLf1v}oLFcr0Fk9d6(7Vk#{exf&kH0cYg3#cSEPsl@?1+`i$(79SWnwK(96ytc(x zjhk8=u*2;eUTpC-Bc~PzoRG^rDN@ynmt;=Q;?-H}eP3ttQD!RtuzYN1uR7B@F4!*m zYMk^O&#hY%X#2*6Sio5m^d8S`n25G>6ak!xgwd8eTR=lCI6dSZo48W5SyU*ML=s6# z;#T5DvmBI*)GwND8@KjDJZb<=nh4zfYHvI5&#MWKc8pxxKavB^$Y1p@yC|*JJUTFL zH5{)}%KZ$Bh@%C?P z7EF)AIzwDay^;^@w^*$T>#l$9EutZ(S}zTDKOQb0lGD0S8Ssp(k4sSA{AqdVv+sy` zsm&O>=qU3ta98&Kv5`~%1Lh_a^4k7CF>WfFHAw*h;<3DuTXMh*m&^L zMAVHa0yq(=FMe0Xtq#QC2kdZH2LH8@Q}6@M$ZLcD*0|Mhyh`x{>~M$R|0I4gcJSYs z00lo_7P$FfkZy)4vG|2y$``Kqy|(h|-pZ@Ntv~&XvPVtN+K0S#7ES@PlYMI6w2@Qy z1J1~6yMNZWsrvyt+@YPmL%tio`{zu6x*sqL+`K^`-M%a=WPj>&BD1%0yeHv!|0wQD z_V73V*9gy*lf9{D@7^%;+)FrA#nWVFgg?2B}6X#dWnnfLAmr4e_sFPoxvX;cI}ToJdhk13hlyFM^UauV=R$>yf@mCH|m zx!tiY*D}h8Waw5Frz7?+Sp2NtvjS)Kn3DExzLiBLmiDlTk@HJK#X7y5?XJy(v1=wm zJ_7bdI-Q#5QBWGuq3fndZUG*y=%=nLnRMiaNs^O*he}!}UPvcOk?!t9@@XkKirO|L zd0HKh$l+D1DbyB#Gs8q*l}b6BiKSg_V$=$2L&ZAXo#(JAj_Pt#CO6l|QucGWD4lk_ zNt4qX<49Zgf2>=%KPJ5%rdX7#>pZ-6NqSV0TPNU5P?~S?C7m_(FZrnSzVsi0^(` z$Joz^(ANxh|KZ?;ee^&mH%dNzwq*R&3yd}GvE6I(t0<4`E6Qsiv4yxq~8v#Ikn&L zD$;$#FcGc_o=DHCU<&F+Qx%E|v0J{mx+<6uSA|UI z=4TP$uh*(@B4HFJC_i!<-nCT$pS3FBHxg=A71|h^dHyq~2Y()o7qhiGkq)dODUkqk zd^ZZc>Vb(+5*-#rs@*s;1#$!M5I1I?``PMxU_#`|aVB*0y&g3kw3C{4V$@Uv0B1h* zt^ubeqV~r^12_}uR|C#WfocF?Um@0j-&b1$&P_;NiNyvm3*Ef(MXUk8%Ek+0jttJM z2An4~0H3u6;5Xuv)qt16xInx@;)htkn#SbS;KG`e(g-j&=_J+Q(nKhQ0Q(}<)!@n$ z)Qx72x~LFC5EJB8ql0S`Qdgo7V0Pu^{T}tOYH(}RR1E+#brS)l!b~E`=;qEus2Tvy zMEX^OsejHBR53{b`wFoueoJjNm^LA*27p=U=BHoJ)!@Ra!DUhn@L8(?ej`3vHJEG! zFl!A*IS-f{ZjzjzGZD&pz`jUz&d-|y+4P==LfZ zn6$#J8A!ni*f+3GE8Lj~wE|#Yq-QG(Z6dqoyV)NCEg_3&wHIOGCd_W!#DWVraR%I# z7hx?Jxwcd!2b_`DJ{fb-xG8}FJKU8E%S%R1Neeh5uU%POHg1Yhzz%mZ~w7C6({ycZjt; z0(jND)#i*b2AI7K+?4^mX5?@Sq7?wM0CPKLb*cYiT1M8+hZUFWb zVi|aMZ5h}wA#w#U3*G$E7qJXfPw=i<8CXlo06uFOz;DDSw+#GVlz~r6TMw_H$(i$} zHJH^$Sx_H}EPs0@zn5xiKu&FHM9}9k4G_o$6Pnpl-wr z1neusRNt&k^=lKNR0qsLH(v?rz85-dN}6@gh-0?^W|>Bz)Gf!|^VQ@WY|BKbTLAka zJ!g^|8{J+d1Cvp~wi!sl3D`HVPb=)02(-CGNDeq@srnnW4vd=;7_h@#IURXu2z^6t|0Sq`JubodnGj0lCzz%n10G}H<1u)=@yf%O@jGF=& zu*2PBKK;@JD1ZU8z!>xC>Fo3Ser<}(eCQwiZ*f^E-M~{q=F-0h{j#*z*U2p(hv9(? zj{vjnf!p6Mu_ec-q;voIsgY~LL~_7P-Yk+`hFxrmkJOOkY`nV4nRufMYm(#anHi!X z5Dfv$hBOML<1C3Jqm6SDA#VY*hm?FdHO+JMn$83noV117@)%fKPGLx9lZ3 zqLVwONqx?5G_+e<3lE50G`pw~0JB|>qY;)&j2Zzji+zzBVcG1WMgYuqJ&r~gm>4wz zU>2)ugz#%;EOz17xQkMaTQ&2jEdaB5QUfmJS~2f2Of7j*idKH7bC;} zsJQwr-xMz*ST{q+OTcW1^mtGx4NXWS8H;V02zd*bMVg)#ve9F)V2(Q$BU_TO*rwS+ z4g+ReCUJPnM95*lEHb{sk1MRV%{1~KFq_sVtapr@{07YAU+AztFhj^oz--7Qy?kgQ z~3iy8qi+x0ja;nKvY5dgE;7r7Cx%r0sKz--s!XoPDMqecMC zVs(x1xYilg<*Lx``DR=S0L2Hro0nFV7csG zb`9NsVtEjj#Xg9?pQ7z9osoa-EbM`qr@li(diE*ppF#rKO+?8p0YUFBoBnO<4*QVu} zajW4masWHrVfEzy$nW7BayP=c38?W=05A*O{E?hD?kH0j+FTel*$$YgoA3<7nwjTb z%yTOdN`^I;CPY2}W}zm%vdRC+GfeMIn|c1jVnW~ax-vhs!D0pgW_Acg~WxO=46vX!d2Oi78@C!B!w|5;T^TA1 zMy`fOa=;mRZKy07w;CS95U|5tIY3%6ay2}X1J1~6*KU@LTMdsP2-x8cqnn@4EAWGR z#r2zk38?W=05A*OJOVE&W!(@@#(Ui*pVvpRUNx_^S!1jLX0Q8X;F^(ZlSXpD8F_66 zt{b-+9%Bu#!(Ewy8%C~%M{>X!d2I%68n+rA;|#FF9g6ky`Iu$MSZK=x)c7a>m<4Wr zr^nkqts^Pc+s3Pg$9f8wdHaOQj*+X;ksNSFUK=V0#;u0OFa+#ySBA==k*nd69B@Wn z8!AV}t%l=Oj_ZIO?#g0)Y~*TqBnO<3Pr62VVoK^p3`oFbr8tWI<-CT=GX>J!SCf(S zsR^oUQ4lZ--uyt%QoeWJS>JtqRP-}*URyf`Bw%*FPnw<^xwdR12b_`Drs;)otKl&q z0Xy84X?khoYIr0EoRQb2>6LM-;W69*JKUk7?|7BBIPr9C0&08|0L%h6iym*WqTd>? z8Xk)-VCL-;DtAV%Mn`hM8F_7}Ox^JbPYgrA4tHg!OdGix9?1b`X!d2L#*8n+rABL}d<9V&R;{N$PmsPRz%FbjASD0}yYT^X`&)MPtg zrk43h;fcFH7v?8PC>d34m=O5@n1!13k|&?=1u>In*yEU=+%!M5!D0pgW~Qx;uR{}{&;-l^ zUV06gpFA>NH9U@C05fl&P&qboH9C?5&d6&+<;1wv@EC@G9q!6dIW=-MJdy*>$ZJF8 z%(&HXyh@A%cDO4CNasebhDUP18TrTj(M@~FQ8K!@Fm5#*3Su~5hr2vK*$SXpJENOR z6Hw!$0ALoFV1BZD8Pw~eSYMgf+N?3w0JGP9GVt2SwMip6;EcRB18{(mU*ylLXzy-^o14opy8i-Lez@aBI2eUGK4z5C8J zj}uq)&TgRp{BnZbK+Sz^?--J+nfrYbbNaR0(Q776LrJL z)$m9TI3ur3)J@}7!(+e!cDO@L|ByG6Se&8UG66L{3IJw-o8KzDo!vnH$B)x)pu6(% z=6AmrL#M~{n9N(-i9|ies7;1tfY~s*dglXwAj@gGQ8qa-2K|h&@}w8qw27rc7=E9!TY!fv`l;(mCLMWhlH?@d zp_0~#SIyjE^?hp>CQaS~&ZOJfNvHk}o0+^c5%LePFEX?fgVKmjyfQ^{3-EA7zY|@_ zq!X`AlAHuQRMI*T&pJJFpLHtekY}A9rK|19%*U)97^p1(=Y};(nydM}KbcsPuX83w ztpK-6WE;f|ZoG}cLa z`_{rxn;~vY2spDvc*+l(B$1?-?@UA;jv|0Fk+b5#MZPKCKs+T6XzyM!8_(wf`wH=V zuliZ1(@L?OT|_gx9)^IK+M~H#kZm{) z1)sID;5XuvRhA|K(kCQJCiJK&tJaW|jDWczC#flGCPIk_*cWm0hf+PspLJ6pHvszz zG4R~yrIJvRLmMVUt^j7C`sbx?8a34bz)amlK%W}0Wg=7q0B0hS>4k`rZ;CZw+Z3n< z0QMF7)_@%oq8b30g}$gYpn6a3GphmTNe#eftpWIr`1A#;0SDHQlstgBAt$K;hbBUa z1K1a-t^r4;pl-z3Z@|7n-x_diLh4Es0?b17HQ>aksRjUM>Pc$Asfkbx0Gx^Rs{v=G zKs5lcuMoSU`YEaBCPXy=Fbh5Ir=(^_{O&lQx&~ZW4Y*8d06uFCz;DDSs{xapOI%pP zQO*PAhMOekFHMAU96@}i}c*jys^>kRWdLc%`KaO6r6y41N*eXz(lAO z0Q(|6TOn)*5iTMB0`BU5WjiQqi^UT!z=<k;jGU4da7JFctUM)aw@#)4cDTc`@~4o@e7(ewTN$TKfZ`J{3;Y|gtNW~ZO92d+ zz3p>d#GH{+00Yj*YXf-RxG8`EJKU84ykO)Mz<@LI+5lcOZZ#aQIMn#uA%N?ilDcF9 z6u^Ml_%U{McP5CN$0Es$SLZ3IGG6`0FZxqbmu-T0kW3Kcvku?z8*$r)Z`pL?_uiND zh@0Oe-O!Bf-Qy-r@FmC1RXe0O53Vm3`d-N36P7+_zaQC8u#dLCBfzO)y_>K5vsqa5-by%uzT4PbF1Lnq>B-OV}gi;-FCekm}w@rak z9k8!Z%8_BIzGEVk>VPwmeyM(73Y6-AeT9-6!&3dwL@3n(`y$n;eq;)i>VSQPnCjJ! zTRk=*N_D_2)I4tWs5lgsZ`#wvM_6aN4=~F}k_3fPw~$CO6h1T&?v|oR&nfA~ zMz>eVz@!z9%s>iGz>lvLj!lGG0kAL9vlYH56Z6Y92}V^3aN)zk)mTMgVu53H32;E_{ zNUC-#g8Ms4+l||mos2dFZO+=>L&$~o{z2DRG_;iH1BW$)>tC+9J@Niw*WgHf$kaFg z3E!CbwqKSGSh?O?xt5i}ndg4-U%mEPI^FiZKae3$rO3>O{^U0WPtq%BpHVoyg7)_c z+!kfs|6a$n_0O-owWnif*rLB=@)a=qE@2xU2;e*nq4+R>J0sUHh~$8o+TR|&`{Q(Y)@-3}1)@E!6(N>(Qp!MU4QM z?Rp%Iuw`P@2!L7ai`)p?W*0RAV7BXVG{TOFQ6m6mvARYGzjii1{W*Vou%9c8#2+1) zdDIqw**vKMKUa7xYfFxyd^;Y0bZF${J76YP-yhunxe<>$?0d`pkr_f>0%k*`$9vzh ze{3S;EnpUDdRml5KbAF^<4y*JJM0U2eqy$e!+_bANgO^k5pozXi;VAZDXg#ju)ZpV z^_iJQ{sU&yB&@FrVcn7^VSR4o)YGs{&w`KzQ2bfLhN$boewsXJu>&^)F*vQrJNDeq7e+-W+ZjJ!52FN|9aj{ykS;jT=}OCwjq zBRSxVyf!Vbj9U$lkptM_4r?cMk1n`20X04f0A>MiZ}sGfr^!+K)~LyLz)UR%v9LH0 zFOYZ<>Blz_B|^zi<<5l22f!@Uq*pe9Kk?qFA>eUI@+6N|osw0k?kZW#0Kn`=pY)nG za&4qY4mcyPO|Mzw)}D?T0NCNKOs_d3SHmMY;EcRBz2=RZLKLvW-6OpgOn^cYFbjC; zHRRC+i^i*l$1x0G=Is+IOGd6nM{>X!d2OgH8@C!B!w|5;T^T9^Bc~V#oRQat%Bpdz z;dqrn0$_)`a)7jEigv*4e4jMEHgav*m`Z>%^4c`LHExP_zz%n1n%)_?8Xi*# za7JF6rc-hiUiXA2h8tjqJ5=<#N2^YofEphK0JA{lqg7{(S6e(5UBJxSCsgK)T#b(8 zfHU&iP?+p$XXG4i&s^esaqM zC^P}HfH#36&uSWS!_&4=lkI?+n%4abk5(n2WPWnTgvbZLEYzfzJl}~IQzy?btdmVT zKY3t&XoJNJ0L*^$Nv}gAr}P4xk=Lfzk#Vcxc$IN9V28Uhy^f8X(hG1#UYlMg#!Vp# z*x~MxUZ*BNp$V7;y!09}KY3=nYIq#O0A}7kp>l5IYIGzAoRQat%7t;O;W5SmJKU9_ za%tog|J_^r=fo}X+ldP1Ld zR-f-oK#h+AfZ6y7<|n(CGQB>E_0;G2+$sh#VD`FC22LBfHfbaWoRQaN;H+^|AOm)| zD>HD;$kp(eC4e*X+6;1J1~6LuJ*t)o{E@%>(RkR~G9vBc~V#oRIgu z0CC+E)O_fO`G9?eI4Aiz{4QPDrwjj*k@JQLsVh+kFbm!M_n^igclX6`neaO=0pm#10H4)&fA+V{@uo__N|zunUhpJhiMz2Diy zA1(>}(!+0(S6n}|7e33G>T|zYnrHAJe1WUL(@Ufu?Bh>LcP?DmzQ`1WfVrs~g$G|5 z8bKa&^xP|G4X#ohu?KGpKiqx#9n+mL=B4RTTmojjo9Dp37uziIzVMIUEKN5z*nj%V zrTwH0AABS@_rgCB{QV1q{Xh9TW$x~!!R|*Eg3oQ6;&aocuZ6bS)7M96R(SIxV#3YO zKs2^x$J0M4zxnhZZN893{+Y7hFUbRck_)`jExBVd=38=q`q?tC-=67)+>tupko)FD z{CjET4yL`d@_GCt1@X?mZ{V&JF3Zvo-Gzu|AQ4*kh2I`y_Sqkw4cvasYRQpEo!A%{ zxyD8$2h6b{6_#2 zo|K&Zr`~uZ2i(th54hb@u{e0}{=32cH+|3Gg@5{HiSvI?e*J#=wSLf`f3FUh8zd2PpU8aH)3V23+&{C_H$ zGJeNznE-V>U>3OfGLN^-2BhTQe$&+K>|po*lEct=o0i#UzgLr3V{KaUEEsXDcyM2mMQ8YGHhBMrWXMaKd>F!wbnVI*TH=p(WllzPEn?1Dh)bSf;KKS+j0R+RiP9EiZK6r43 zI36R;-_t6KRPx^ z4Ui}ac&KDw7f(!&Tm(E+Zvq!jO_E#$JXA8=_*?W3QW`HmOl z^V2WhAv%(N=`cJgzmRVcY^`;lY zxt1&)$l>j&H*SB|%rCqg215v<+P^;JzkHLdLVVfaolsE0{SRJ517yJU6=+;_a5PU)-4rUhE~q9RIU!+^SrvPoM*JP;d{|FR!h&yg~RI42Nc8ivTJOl zz07E9!}qFdY^*s~4r?f9&q^1LU(T+(21n{^roQpZsm@EaKF-Uw-Eg%aN|cWJzSH&4Vn8Oy!EI2@uSiS=ednm(0X>l37DHv=DP!r zbW-+M(Fgk^0jBnl^XS4PP!LT5urDEly?ot*6u6i_x-?_ne zF(s+rtq^*UdkB~%z9_vmZPt*(fZ3YXsP6ihk27yx1$tbcDrfW>R??k z1?oG%zCwMlE}8`O9bjLg+KDAoASVF(3iVDbn*=!lIFV>Oy-#orOoxICa8ajcaIKmY z1sC8%s_#K~%@n9#0Q(B{{jzQn)GvS&iMC&`Bx!RBazT)c!5`r;EXCrfiz|8EN0pE{ zP|Sbo0>4$0w>JkpnIBzyp_Acd(kF#9{!pgT&x+INs1-7eE=SYiH2Q{lOVI(?^|sN| z2+60>J;|g5ZJH!S3E)JsZmR;t1%}Jfz3~ zoO#&jlnzpYcbU z3338(A~9KTU7HRC7vQ2!&)~W>DGDyYiB#XW9Fyu2WB$AYwSreg10Gx@085`G) zVRJcira+MZ*jK2Jgn5&o3fCMIy1C5&DA*5Wnu zh8hfT=1u65`UYD!32HFFEFpuqai*zehYiy7%iS1F6#6Qt|OD8-~yaT^$o6LQ=onU>?_pw%ZW))zW`1o+I}gQ!5)LO zCd135aheK096EClelUER>eRfY=m6|`+vsV8Ama3a|^O3qDzq6Dz7 zP#+~1CP7gG*q5j-L6@dLP5|~5>YcbU3338(B4L*nm*+&io=-~Awdql?0UoM1L9pGL zBn2DbM6z$N-I)UQ6JTGVzMrP#u0rp;QQ$;^`>9+(njy`IX{v68DU-!%s<~k!ApNp9 z0-81tDKY?O9yU6qgH$S&l%H9XqKE*TNcD|~Ia8pB0PHK&N5s5IQ04;mC92EMf+>&_ zfPIB}Cl*bDoB*6i=mjjrIncDnld`j9Iuu-hi#k1nYuThIxBw?oeS>RY3e+!veTDjd zSv3jj7r==`+b`wn&|?JDWO$i0PE&I=Y`MCglh2^eb#6BD@1 z60Y72*B|YLS8-|Pxo`OU$)%RqdZDvwxBKutIQ0tKFvx9GVKGl{qx$fll1oTWzcmF*;c(M&yzldI6|6gJHHt65eyjC~uPO1WdmfAq zLRl6#6X_RU)22Z21=v@pkFQyip!fppOH>!EIa44f0Q(B{PRyGGIRQA6=vS~7Oo0Ll zu&>Z3pcYL;-G~7NI1}j?P)nvjeF4~4sPBtqlc2r;oJoAC3l<8H6|9%Sb3Jf<)Lyum z#dfgLtD~Mhdt+0#?&QyGp!MvFZxo6T|Jlbg(i&LnQJewxTdz-?t(pkM8Q@H$U!1L( z0>v3%U!gwE)=h%q46rXzUAQ((ft&#BE7Uu&X%gfF;7p=l;o33<3Mjz7LZ5)zHW3Oa zz?n$DfZ8zy>I=ZWLVaHxm<06&;7np@;cA!Yht6k@9(CbX&UDoEL)ob7P7Fj5`+$72 z7jBi?efW97;_Cd~RHt$&9!Fe{w{jg?^HHDy_M5LypdFbA1sdQ?q+g&Nn*s$IU|*p= z&`wN(0u8V)QC+!CO@W*M>?_neab^j8L^;Ee~jhf2U6ixXzY$m1Gs6QFD@sw?>mgQU$Lo@k0KcCgxzO|YKc-QUDsSbHl6amgl~I^Vk|-xL=E zH(zZ|^QZ#>C#@S5{5VWRlF6?v6QM2y?29~j;vw1tb9vvH-iN5}Jb3GV_(fq(Z`%~f zEx^MSpS^qg2ga0qyBN^9?|H{0$w|ONCHK_VUD=j-?;(1&xb&u97Q6Dm3?QEYrv{jg z_GW&aQ!15o=%GoGuYikEoj(1;X`hCOMwE`|)+5s;7XgpdMbC~eoOJH736sNsM+sa1 zZcG1$Bre@xt6vuT_rz=<=K*InG&-gJO{J3lJvAwE7jRK(X#X~PBl`Eubjd})BX#}$ zEeR+6dv3zyFyK+b*1sQ=eNfJDGxe4fuo{1A9qO628p!Z4k@m&#chM)1}SPRxW(9f zgB0w$;%#l((&9SdjO1@RL?A?&Bq*%e2&>X$uE+g)*9m59Rx_R6b!E3b+jGtc4KVa<*w zvH{9p3LjtDTX`jHfbtxUFnvc07nUa4BzTpo1~^R<9gp-GEnJ$2Hc%7+?2Clw7Ho?t zQ(=NXYy$rAu!H)kfj@$G`psbXqv6ZWpe*ju_a3>k`N?nrdj1{mde-lHx89XGrmd%8 z`Vg@1SfAFrHW6*TC<2&8Lfgou^fEf6M?37w7V6r1sAXqTr^Ml%;^0!gDIT$I%@%SP zFx%27lpH3Jc#T(oIU^?cxw=-gM*o%Me4$T3xV_l`Nli|#B|E*M&(Spft zjh7~*I32KW*!Rt)$=06^b9)I5{rME^; z{s7K9jQnv*=_p_BOpJU1To&upKfQQN%A}Rjc{w&WrF1U5cS`9&V|RxNr8Hz?z??DN z%|vx}>a(0|@E2uA;M~(;WoKBjO`C`|XA}XbfLXzF%z3(j*Op1$9hf9J1$d}rr^e*v>Qw%^DOV@qeO|7p zXF6-n1u* z`F)<@2g7T~rny6@2AJIuBfEOTYKSMBq}!IsQn~?VS-*yO3P~_*n*uoom=!$7oEqXu zCQj{`Bsm3msAMPW^BQt4f8ErOv+&-jA>E$ou!S1(D=5N!Ysi7QL@5P0b*X<1IW!SU zDZnh!q}1>lf>vrWyt;-QnJwfnV78@E=u<kJ0B)^csO|CCWmbTS5j$rB zYJ3y`%mO!mMShU+7DHv;cqvo>GjCW}t1N5_My^IfLRtlIMqV2#i^i>n$KC|&a94)P zl98+7ksNSFUK=XQ#;u0Oo&@Z0R~EK`k*nd69B@V+3)}E@(s*ysJ$d9vyN9uqvinCm zGQ-V6O^F=Nl&rYE?@osKzYnAN`uetNUTPD@;|^fQ%gUf#GjeUhNDeq7uMOID<5t7* zDhUDD;jRqY4I@{>BRSxVyf$bzjav@AjXXy&bjYymHtK z%BzR{2WB?44dBG=xH4608=9X;7RnAygxUr$i;OkwUpb0JW9IokCQHgUZoG2KJ_^sImdJY%q9o!XYZbH2B0lDsz_(Z zKW*gN9+4cdL;l#7j@k<{hK)vhG}f&7LqP=C@u#w}=8T+z2QZUs@I1JGt$FkPA&vOj zj0*{s-ctheW(au+mK`TLi;sqqE{RZ;Ke(TyZc0m_6w##o4tVk{>6d*wHJ93nr*d z7X<;c;LYzDiynX9@n_NK$sfQ>pZU{c1#!v5$QQt6vCafoI-RCHz7SRp`DwguFL(ZY z^s3=o(1d*t$jjy(WfI`ryS}T20~4W40?Z=gWfI!1+q0Nx`U*LK-TVzX_3flsT(TXr z);8-?a{K6}@HC5PUyYG*^POD~mCti;;cte|bI;l}8x*#Hxfv3@Ve{OcY%(Q0XR;K) zfLYd`=k^qme4IB0attslc#b*q+@56O)PhNpQ-Fs`b}}nX%-Kf^a#cVx&pjXBzbCs& zYUo%Qe%dYm&=(UjY6M;_P|8Q zTfm;Tqpl!DL?l6rYV$iJ*>8TjyEHbWGK6X}yfUns)s#Sh*=n&R(8U$EVU@v?O_FHM zWGRUNv#ehkJcXn(teXNk2ACB*$DGRGNhVHhm?Sv`c&Oyi%COX_42z}8(CwKHTUY`6 zc^stcE5oKaLpcLDai&LQ*fMg;6~IhBMrA;wGitWU>)$lld z2iW1RoMJmQay2}X1J1~6r`XPnTMfsn^fX|HyK;){+{o4NNDi3Eo1Bx$;h!43@Q-AI z>Z9_{n`JUeZ=#V0SP%C9oZMlHx^hn@sN}o-cfaLotOc(zhs5<0!WZTqwH;t~uTQjI z8acHc;EcRBTCa>-4TpksI$(#pGFq>VTn&%pfHU&iXuUOVH5{c?3^+Jw{Z{4Eoqh5^hXV~z4xPGXIidHzqywEWGllb6o=*4Od+)@+!Uj1xr3G~&#^8^RVd zTk)o{(fd{;XGyCzi>mF1S7bsqiz;BFqfIzkDp@65GbwGwC*gT^BjBQkJsWewq$nf-vs4VpN7{KqZu4E#K*M}P(SQB2cz5%r8AbjBW}~Es8=aE> zsZB*`hjLnS*iZ23(7pfg{$9NyPmu^vJ(C^+ZSH(x83b}FA72}f7hq@hpD zYsx>snb#8*^HY1t260JI`b$p97r|oDLKSNJp+kiw11c~x&%aNM zy7?-3A-ulu+?tn^cz{zcCmluJnUpptUd4LAEY&35$ijn0jEUEG;4^jW&fWlKqdGc0 z3(vGkk^g{Ms_}nh;Xy!kLmgG;4Ool(A*@9v_xantbcO5cX3ac}1iXsVfZ03&Cp-kr znUuCflmc9o`qG?FG(}O$Z?9`S=FL-WR1`F6Kftc1jb0oX{x43I9Or)M1(VeVjm%1juI&-Y0cYg3Q_Z)=t=$@@u>m{Wl~c`k zMy`fOa=;mR?NsyBzv32$`O?LJ9q!7h=4m5W!y`H1jGSj|WzARaHr1OFWQ~_@N|4V_ z&0d8P<(#N?=1A%`39MfjnKk#c)1!NU9rr31M&^v1+756=UK_3R#;t}!K{_3X!d2O^V8n+rA5BY!{?y&It7Wri|O2nlDO#uQ==hlcN6Hw!$0ALol`Rnq7 zjJH_WmW@{p$E&nBVCL;p*ak+fMn`hM8F_7}tQxl(9(xn8!(ACFYeueyM{>X!d2Ohy z8@C!BdlIn2U0K*Rj9d+m$=dIuoq%B+4mcyP4c%?yR>ScsIS1I`t_rEx?Hjtxl=6Mw}L$niRDbV3r#D zv;YMv7M7Xk-zB5cn}00zrn6@JX<7E_+!Oit z>!NL%TOo@4!H@3u^moB}*lvNPY7&faMxZ0Zc2Y-z81 zSHDO0t{ygH7s9V}ihT36Xwfzo`W)W3%~Q%bz^>$4t-sks57S}SHN%LPq!_|*=PRtuh zFu;j7;I2G?pBg!(6ksMF;{c9^nXs6gnK|SuU^b_tQyTrIV};~g;oPLibHFS$b}>Pa zbi)^w)JGN(i$+^DYhy%mz!`b%+4qHUtKsp?9v2xGO_t$;j34 zNDeq7uML%D~L2WwtXAaDGY8k+Z@vTnJG5?`SQ9A)ak6Wk9|8-f>Sw+>5s{UKhPy*hGT1UL5cMW|v~?HG0EthYEHjcVQ*hhhCbjwq%qA%(DLNP@Y1P7FVV~ zjsa!`&#`{f=GP`kP5~Y&Idt;wpfh>56W%+wLvB=zUkyr%pEoO#{o zl=3evbxHo+nH1$8V3um~Z)E*Ji+1XQTYu5GLmoCe^)LK$Zh_gTj!wz{R4Va*+N8*T zz%14HuY5!5527nc08IRS>2HUcHCHKp0kf;!Im=j-dfg5+XM&WxfLXBL?NIYZPyPUA z`plmmO9%@lM!olT;1EDTHLuEDy;@dgiu?!6Ms;*b{*Nd;1Ct{E z0kc%&|H#6Ffa-=i0;7C8RN6gBB&?cw+7fsbrvbBhok%RTL@Jd;!kS5GOGGKaMX4{% z`9w2Pb4P~oGQEW-Y1DP|R2vmvOZx$KJ#F-25q58f@??{d;fBdl?E=iQ{_RknLgLt_ zDUf4;Ss_LXIp&NEJ;}tWEt4dt01uTMT9Z#YHTk$ulSAQa9O$q)w?n~=;-yRaWqX#L zH0iear%ehkrS$;2{tdf~B9%%KaL1&yDWeo%mTF3o@(n4)Xge`hOIFWWATx^mKgf*g z=#&c3h*ErLQsh5i-~W-N7;%(@I;!#GyB+GtCa$z~;`%ILHo4Cl$+3}Zdqi@;8F}qQ z^NDe*;c*fhu)|$B(R^y;YIr0EoRQZ~G@lu_8je@#V!#e}n($%^b<}9@&V0N~vgtd|}q|khw zYj-bAirN)0OG%p4M)H+$s~b>|fB@`pS4Q%+k*nd69B@Wn8_BoEt%k=@2w;ahEDZk^ z`DJn`=a5^a?o2?9j{<;M;O6hi514n1_?eQcXSyr$@Io3MFw;*SKhq|qoBH*PgNb}wLuyRs547`YlA$pJHYw{ydd8{^$Z zbtFTw^fs#Ffaz^im9)vz<9-|NruwhsuoIVnYSxYy&2w$mc<=(up7%MVFB!QuYa|Dp zk=GW&W#d-E@hbTU*x{}WST*_f!n`Up(RJ{>5S2?ja=I)k^|;;3gnM%;%Ch3_Ujw#*8HIm z1MK)y*;sc*PC*5j$u+1R-2Y(t{;G9dDAu$qoTR4}0f*zxr5aO0(H)AxC=A5}W^)8= zbV})zN+pvN(59mf7O-IlRto& zKJzD?W*Llrz~!}xkuQMDVx7E6GjI0Mxn^Cszv?W!?|*+)?P%xLyrBdGoOpx5LG1zD z$SI}nGV(DF;Aof$i^-Hwcn5HS6JIAkfSVL~KAlO8T}%)p-S9;vd3^U*ZQJ-=!ywLr z15TQz$Ng11My`z!$pL5Nwddmp#;u0ObA7-Lcjfu`p^>ZMksNSFUVA=%WZY^vUM0Q( zJKUA$hDUP1Ox`5km+<~7KFRAb#eQPWQcD76XS+)Mrr1wSirN)0OUdb5Z6u!= zx4HoZ2?)RrcV#4>8@U=D$pL5NwUK;b+-i6nVgq)#drYxknt&P~1pu=^zbW=Bqo?=* z%=DAT&$UUZClHiA2Fy}D;^)@5DSiMu+?DZjXXF$=fHU&i_?ePZfbL;Ab}wLuyRs5a z8#%=eU?%T&Zp9S)i4dhz?56?K`?4x&y(#u@lf#b0!z=zgmQ-$k6VX}oT;m}gya2Q3 zfxGhdtT`jsW{u>4GxFL(IB(pPkANNS%0ON)a>_u!8F_6WFB&&xAYg~PGLV;yoH7t_ zMqYaoux#99IADjn@+4qjp?`v>(0@WER6A4Xe@#Bh6#Ak3QVvg3GHdv7OWw=B``h8) za2M)6p0E=u-#&I_()Uk3Jd*eA4o!dmUEv6~2~(!_z7mA5ee_)~zW*JuV`Q4|Z1>^1 zeBA=)yAM}|AAo|U-XTPF9lAmmO+zNvGk1BTrg!|nMcMH*P0ylp2(!&k;+i*B~ z5ZNN)H^XS33383OCTB%VX?jB<6D0MK_w4{l!rowUi!?;lTQS!Y13+lSIru77%*GY zDAYT=W)kEuU|*uziFH#TCjk2j^-gS<1UUhiCB7)VwrSRo!+_bE{=K$k667#omJo+A z%OT^o7?PbZmH2#kiV)sg*@+j-rWwC?PrfN%Eo)Y&qp(Hl;C5z3qoAu$BSexVs2vkg zSEC4EcC~5E>Hs}31?n%rzCwL~9-0L87hqqa+KD4mASVF(3iVDLn*=!lIFaZZP$#B9 z0R`As=o3(I=ZWLVaJHn*{X*;6x(!1@`W@$$#0&|HZ+BM;I_j zfq3fTN?!L-3c6>IZOM3hb7a#!uSYWCPq%2>sY93N7T(}-K zN*WKzC99rTQe-YojA8r{#CII^i^)Yd65)>1FeTnKKb88CZ1YlpG-ibSt zASVDP5|akl)W75*G4$l<1-Pu#H^8P%i~>fm#gZ!B1y%( zG!Y7Lz==rT{<<;+>My{)LVbT-n*{Y2U|+&5Hp9yPttpTbfPIB}C+J8oh^eM|^N@-Q;M~JTN#h}(YRbftBC}v(6cd0GvA!{}XbKb)fPIDf zm{>9iiV48Jgp;4c7c7@eft&#BE7UtNFbQ%3a3Z145$PXbtENN&2Dq%$H^A0Ri~2C%PC-!~g3L45-_k?8bIxlA-8lc7Vkv6$ji6PE0YQ%(A1aV)cGzELy) zPJOf6E;ShP*??3kDK=XsMX>-lk?I=@+onLV0N7WkkA)qRpji0-*?a%k%8u+z?2V)u zb7seGwk-#AcD-P*GeB>QBpi=zFt!)NmioD0dqjz8i87^lERN}!(228V=7*Qwz!UCD z3`o=LAr@|c|0p3g6Mzd093rq2u7g=qa-60VWI@{tn}ZAz&PGPqm`0XZD=~ot+c{sI zs&nhqk9%L;_qx?`x1eU-`@MV5ch0F(=hm%Tw=Uo`MRBs(5(Z@i;50+I5!*tci~t-^ zRPVr&9nCc!^lNs6M+Fz)EKkee+7&7lTz~_rw!yV0460rLry0uYWnU;%y#Nj}#Q%}^c*$3meZ0dSfkSr>ITPA9^ki~yWwC^zC%D3lR^BZ_tbbtVidpa7>C z+62_Okf?wH9FepOs18j%OilJCIL%OA7b8NU>H=^?Vd^5E0{ZH|*an=Jg1*aLGY@FP z{3Vkv-1tX-iWxw%zTW!koShPc8=dvlU!soAhQ(&rHoo`nn?Ld9h2QuUnrE$MCE~F3 ztVHumCOM6Yhg2*9jyz=KX za+(kZWdz_fL%9)?LZOTR98t6js3~Dk0R=eC&?caILZSi+a75BBpk{1m-{~MDgGR$!PcHh^AG8iC?Wk8typ%~<{g~BaT6Jdvd)cP zr(Y;lRnw(^mQ$4({c)*^vDvL5r>c4Jmx?UFX@9ketVJPFkp(y+X%|^b!k{7xaGIe! zvX+HHMHb*RMRBTH5e8)h;50+I5oRF%9U}AZ z#o<28#3eZGxHcg+A|xur07oS4LTpqRREPmiGn9wem{6z?1DvKP&ROHapo{>VW+*q} zl29lk07n$H;=m~|Y3&0V@gOsz7 zid@ce>5|IL9m07A`Nh>;+NSr1_o(2B<)a3A>-T4S>wnh!dv~TjL}_OIGdsQYZ;aC| zXK(#?E}7!ygef*Bsd#36b;=Z*Jt{tb;a?o!t+^R*d(PXQ_qG?k?Imw}nYM3rPx091 zR`(7UXDDd-gHsHlO@}Y`PM>Dp>Yd&9vnFDMW?_C$+CjG0gf7yr1^+kEnRZ}YVy5=p@_duGQ^x@Q~RGt%S2 zjo+ow68HZ62QS?Cn%O1}M9 zX0Y)(PWUI_{5?aw{*6ic!h3K17PXftv-Kyv^|yQL-=y=ge{KB$Ec_MtQ=Ebpb7I=% zs4ck#(P5^+ZQNvD)8Kj=uY*?+_JnXIAjCcs;uvzI5T05>E-$X4nWACUS=rn89W?gd z#y8N|FPrrZo>_n5W0WA~M1}c41?;m5IL4_!RHLx_%&NiV#Z_d8wrV(qu6%5SG+Gpm zmI95i&l=&FP@{9J5tkQNk*BOi+1kiCMr*Vz8m$BxVV^a^F`-5s!YFsIa(QtT*|M#V z$T4e%9O1cTwyN;NKC6LaLN!JRgBo03Tt%Y3{d`Ho*fxA%-Z5JhGxnJo$2evL$SCcD zl}l+DXmr#@xe0D^#k`JYq8i4op#kBZ*{TS!&xAO}Cmf@F5OSGn7|iXOKXYdr#=aqj z3I}GZQUUv{0*-MixP~!K7}Vf$m<{95=mCw6%vPll_E{qw6KZscFlfXjHw@Z0bDAkB zzxDYG|MnYy_pvYipiNsQhoVMsH}nMcMPB<&%5^qwv(-l}sb{M88^|=S{XFq8x5aJy zklH9`*dw#$nLzv21hd5n&pGvgFqpt4x1{fU)b(28c2!i<$HtrR>xtQ_l)^qMg=0d$ zP7nsAxa4+){TXrqm78;>h9TI z-(Gq_t-Va&;U zE875T`Zkp^A;OhyfVFV4&Au2D#2m$2cbifNt|HmVr2J!cGU=pf!6rf%WTQw6kB3J) z;;DrpRWOlaN~qXiO9faPY`j?(g*}n2Y6@^dc3~9Gh;UU?fD^*Y6rU5>N^!sm*@cSF zi*Thl;6V6bL9{45Du@7Qd0Gb1l2EB20vu4`;#F1`%OYFV1>l72!n#-y;i@hG2g0km zNX(g-#bt+QN=$F-;1%Q(l zIzEns{wRZ#vL%!%8UP2B<Eq5*J1cv%?lifpAg;Dqc##rH(G zQXFs~oWs~va@(NV7d{nKfNS{%2&x02R6zwepezrnLy@iO25>@lVci^wa8);e1L3-E zGO5A!I;KreH@Ucq${QIm_Kg?ZSYysCXw>lH1pC8esKf`UVnW2LS_T}6FYSs>ifmQOfD^I{ zYk5k9t6Bz}5T5jTHU1N{vYyCRiUUr_E>wI*ge%1XN5V^kWlm(PU;&(vT^ua)B3=ax z;7ELFuq=vf<#WIZ*@Zq|65-0{fFt3%v@m3}Or*JEu>%uS+ZEYLali@Lg^KTqaHTllKzLQTq<%as7uIZ$ zvG;{X1rgvZPs<=W5GoZ!fCH-XAUYJ;sxAO0WEa-OkqB3H0XPs|)kP+o74?f;qs_>& zgEu&;_CDJjP`_O6u~?|00C3Vm$H$Qn58k9GgOqY2lqwnk2bAT}a4ND@GyqP>E{ujV z5w4;Ea6))lN;wzVN^!sm*@cRCXbMm285hBUa1LWv$z(!*H5{at5#duo1-O=PfS?)` zN)=Rq1IqHC8WY*7ZU84_7uL+JIulz}ottuaILUv*0Pl<3<`G6C`%Q8w&WGlr1 zCuA2YJ|n`F;(!C;JPD$05X}jX3L?N+o|Zv0FH|as00&g%L9{5cRb2p1$S$mlB@wRb z0&pO_s*6msFY2VYMw^jk2XDTf9=!Q_Zt!MVtWh-%IIw1c=Ff0l$AdSO_#joRhKryiUW>>mj=tO$X3Au zI3c?@SoTD`3KqbT_|jn67um|^fD^I{eSRRqmCpf3!oQvye`)SYpateyKi(nh?rn7U zNc9UhroUT%S1_qR7JW@dG}xA6ZO-foo{Z@-<+CBL1^C5Pe$ z6&`>iH~e-smsH||TyiAhRd@i7#FvK0vB*~80XQMMFg#8~xC#%z3E^eAFz6XN=)BpfS;!A^NL}V+U15U^;^!ca= zS3U5wHnZDvL^wG_nKr`I1#7C7s?$RU2yObm7|C>l1c!%p9!pMW@hHy@K zl5>i?y)ik3F*6~4I5}lZ+@Zn*aKatMVKOe_+1oZu07v3W!{n04R$&4-A-gb4CPcUj z6Tk`KWjSS1WGlr1CuA2YJ|)7H;(#OJr8%W1vQ@AEPRK3}mKhPRf(39SzBE|oM7Hud z;Dqc#pU;bM<#WK1@JxyrZcag(keqUB^_X6Wp#0p~FjM{4SI0QBn8|SF&31HG7_{9L z`)2#4f%+?p;uaMyfD>*h4woenufhdzB)&9UmPNJ-7r+VGh2gRy!d18cP6#i{Eo&lM zDGoRxyHN2h5v~*m90@PYE!!en1qMP7%c00t@d7v@yD(mkM7W9msNE5!jPWEU!a zBEps8fFt3h$>mgJt6%|~kX;-sXCht&3*bn6X|SA&Y~^#n3E71{?@(J!JxL=t5}wTu z{S2&RPp(NW$QdrVxD-a^^om{Cf)o|y);FhsZs09AGZiyj?0I9Fe#t%$s@@P(^^$l)&@ymT zHIM{DGS#bss!b$b6|^J^PprZr7+Ctb@Z|?KXW^rp=7`K%v>nRiiMJ{N2N4l4zIy)T zSNf!Uk`$;`gSa^&l*&lJwUird>w5QuDzV+CyGMnZD-nO`9vpB)Z5XhGNL+>L>)u8=~c(M=Zqy}dX7`4hd(e_%kYqVXrPX2lFOOKQ=pTwbJa-?XjX2~kv4FW|JI z<<&bW6smdwM-=T6&6F^xiUpizXp?AqLZYe^a71Dnf?uVSR~KsPbB^khU%sce+)ds7 zEPdM6yz|+z+0KZzs$K!7wJopLIiXPX3OJ%@SFiKJpz0NHnxRd-E((dNSHKZTX}!+d zcFN_&?oR7#>5^!v>JxCJrEzu}S1b#Os!_mck}AY`xqvE5wN6MYqJuINaHK=a>&==_ zC^G@4DFQS9ag~v2K_i=#xr;|h`MdG!zr0`?u$c@^m@DmXSi<5WPn4!bs?q<-O$!b$ zGr_d0EwMy35Wt}&!qf7Kwk=eunE=*QX7z}EE@F$^IGk@bc^}{OzKF#&S|+|7(No0_ zV6CTPC{KL5LZRXZa6qv@9k1m5<4NuT=AOt_H3~Q(`_=O&5=(Ye!f9;M?`Z9da8-wZ z1L1AGe;^FX`+(C7<=#IO3gvyk0Y$m@k3_ceKH!AxLhm1oaOHi#fpF`6N;{N0R*+9< zp@fs(8z)cD{u=gif9C?24>PcLn7!+J>1{t1xl<@68@lL0qB#-WRlNdE>t0^3r$V9X z6>vaNUaw~&Th%MzgzUn4Js07sUI7Qf+qS9>WlH~!6Gq@kGQnwva_^4_h4Mb&fTG;{ zqas^*A810M7EXyvbM-DmKYd0S>9yYt@}uKX)8E z6c(*(bW3z&H=u7#ZUCItt-MCJg@Vnu6o4a&b|We~!l3FBaGIgbFv6~os9FRZk=PNH z56R$X!$=uge(NgS6U9^&0!}MdUWNNYp{fvYMA5Da4}?KgA>cGan<_jM5>d;}!uE~_xz`fD^I{?tl7kYnLge&g@4ulW+UcMTvcd4Ox zglt80SM>@wt$TUBt_g*zSHJ;9dA)9lY*nv-6S52Ibz6k1dIcN^Z`-PNgh6>9aGIgq z`@2G+ybm~_DEI!J$X4D5oRD4U{e2Oxybm}KKIB%VM#v^HtV4(Hy;8G#@?LZ3P(8^Vx&yL^xuc^_M6m2lnaW1s%TuTdB)878oei%m{k09Z57MKCffF@DpBQ6oaBi~?Ls>5ZU-<2R!>@u>nDdwCrnDxlF98k-q? z9kcFfj0W33NLFLq=f6HN*h}BC`0J-~%u8?6IN=}BxqnDwhHuibW*lb@<2b(Io)%^t zXZj*K2rWBHqv8scSOABvXgiKGCKM{M01heSW~R+J&baWXBm+3h)AFX_l2ECX1308= zGme8$YF(ofq8q!x4zd7F>sEfLm=p>&-% z1Tdc~Y1=4gL@`x`fYXYVSK*vcs44^;QM9YVd0|jh2sq8qrV1B@L{%Z+h@`X%k-RDO zE)Ot&Wl7XiJ^&o5Cp;}v(y~w~PXN|beUD?{LN%cME25OLAFx)+<7sLCnoueG0c)zh z?Z<^Vxb&_bT=?pjsq1t5`{)n-X8L+E#*^sSnFH!Oc3Yx2`^ffx0BgkqzPgTGiZcVc7;+I1-O>d>r%xXyEBRdbmq=Y z$sM~6-CTqnyAgv`9lKFErlw9!bnFmHtvhx{q8q!x_PPM4bt~@`918`T zZz%vr6zzHiC&HlW5^$QKO|RfoNK`EXjz~&-1;_%etME(|Q&k8!typ;#o(qMlLckG4 zyDIFE2mIMuwv7NzGqkC~5g}1k2sk1stwJPk${))EbnHe&Jr%})L-mBGWl9#UfWV`$Sm=10x z47$aWLdd?fgn%{S?U(x!kMq3|+$j;S>;bIB`<^rQe5DWP1-A5rOxXfBPv-Tkb^o3R zTt{CYqp)&=w&P}7587TbnCsi;`}0*~c$B6y|6fvHs&#vt5u;Um0~{IMvc1g-g=%kr zBZ_wYhIwINBfvx15pbHJO?F%q5;nt<0FFp(zoB|DwP9`+f~0j7E{S5Q3IV4TD^Hor zLZPYdV_ZTwuMT0 z0Q7qsQ3`QYDeMuM(>SpKhgW4LsM+NM(=iz zTNY;T^fsTo&dWDk89gH4%J_S#c{Ia3s7m zeVmJIRvZkZIN*fr!t~LRrFL0yD;#hj+}`;oFPGFQ%PuxFA`D7>z-fjyU9V9gQDy*+ zNKDsjNGYSf5Yllo9&^_9K3x|w}iR?$)r~#)1nmd z+oG7p{;y{zIG`xcPsbvg)weAXa6)!remW81thf~pI1*l(pH4+KD~`Vugn$#W z3-i;N2xrBuaKMr9()@HTvRQE((ts1P3-eP)*5qZyt#H7R@X|H1Mntw!9B@K5y)AR$ z#=lELvB6`(h3V`%S))Rrln1N{ZhzZUcKhL>$KP~=LzE4!Ja*tM;1sR%RG-0VrO+sY zKhab2pLy)ili#pF)P=8pH?@-6|1G)L4KOF~$*HT8y(b?NKXOIcd;wVd(J_>FnZ|{J ztIARU4k*e~(j}42>f5XVI3c?*B~6HMR@@2)90@N?Ns}U*6~|vnNq`fw3scgR2xrBu zaKMr9(v;K_*{nDiNO8ak*@Y=-MufBCRyg2Dcxg(S6WK~}zzNwVCH(=d57vK5nim44 zJYY?5`#+B5ZcNv;(nS%?y4xlMSc`7oN|%I!wYL<21B&uix-7C;ecO-#CuA44(iIWT zid*4;BjKg3bWLQl;`mF!4mcsZu$69!a8}$32OJ46ZKc~Hn-vEGDGoRxyRen+h;UZi z3I`ksFKwl}B3mgAI3e4#(w{8qIP3|5QXa4-xc!dt+55fYpx*GU=8InV>L@jo!TJvS z;!3V7n=$}vSGLbe2SUNMWhnp$6y;gzP-L_EHgNz>$S%xEMEw@)7=NCMl@3@-r^;|CqU9hAz5~fr zsulois=fzdjxhpGe`w)Kx-~jY&$u|v&A1p7eYoaqI0M%D7}@DYUI~Xy-i!-;dd@f2 z3I`ksFKy)bDsQ6B04HP@HgbH8(^uRE1mH+`X(OK$+3aziVP(Dunvh-C$fra&hnE!& zI1*kODm{^{LIrR_c44T@h;UZih6>#oj;g~q|IIZ9PUA-T|fDca(+I;PZT6_lsK>kqh7VY%4 zXf7Q`pWLP={utHii-f-}8xA2mw-rQZ7M7(}JdNTFrYXQa?rdh0h4*YqVRMBp>)tGjd_ zeN1YP3c3iG-*O*3;2*OiO3)yYxBv%!uXu77n~*B_gwKpnsn`Upsocee<@sNENjxbb z`;Dh^_VbTf`{zU{-5MjMJf58WAyr`iyih6o0c-m`Dq5l5F63#R6nT$b=@Pp-LXqM{ z`X=w|)t~1OIJBA@iky%5$E=SQMRDaLz>(sPC+DM(D)7;gP$?e))>JM=SYC6Cm}Zo- zpMT8Szbr~A`vGgE$j^=^XMac)*uNrF%6`CEs`?li4Pu1%b&Sk&j0}=T)s`hp3hd+-=`kfgLN7OH>)99igia?Wf>N;^WO0uHdI zat)5<`3){eN@GF5@xBhYMG81v|K_;dL;%w224+ce{%uYzVZTr6s3q)22*5@3_P=-8 z#2K`*Z_ND{xQY&TQRvVmI&o11texWVwDkXoP$~Zd&QjGk_$j*O^e+m$ul*0dlkP5A zC#MR8nHoJZ?;Sk6)0*%R;7D=Dlk-tX6(mKx29>z~0j#N9jIumGM$;V!m#mZahnYIC zA20SK><6rsB0oExoc$qHU_aiWN!SlKOI05uy&y(-U&qKi#|XFg4sPV*h3@&s?1ghe z6jyl+aHP27$@wUx3VbvvRH_{T)>JM=Se_pvK^~h4e8l_ON61w+2Y4^&#-DfqS;ITJ zQ(^%7%H9A0)&>N8{90>&l;NALLdia}l)WZO3Wfgof+jN~e9A+Dbs_7FI^?kNA5ZB=U&n2F2- zII_v{dYiskvODxG<`^|i|?+oF`pDuA_8wxz(&Ir~|U%GH7W zJ3^)G2b`s<&%6`Vaq+Ltysxtg;*4~6SIuPR4KJBNQ`;5Am5%^NiaVa1k3y=zM|(o0 zd<0lixfo%2%`xJxno0Y^OJ-pIz9^;a2dtGMKRceB{UKFg|A9~``vGUE>SJUwh!Nh` zF*46F;@Wr8M`7a*d~_&^vybqX+yOXJ-0|dm6jB8~Iua`Ok);BhrFwtevK@M(A7B=1K3xHOA0)| z+5iHLIC~k*b#+pdL09KYDA{M05^ybLva6Hg3)zlw49;z# zQjQ0#sa)f1ya+A^j^};t_{AzXYcGO`nud$uju^ncvgsPIHb7FS_j%03VznvC;3Bvy zl_r&Yx!~)!4zd+;=WKS69Ly!dY7%1_xnbYKvFg1A_MeGT%6`CFDVtyGI*K7xVE?&LDfxl12{kVB#gAR3-whr5wBy z;Mb8S4R^xs@%4q*I=BnIwR%7|<}~nu%`;kGZX}`B=j_Cbv=k9B-j?<5P zFS+?T4yN&&e*)XCtsj5#;FLCKal8{#lS=LcS&XUdPVOY_XXWDHSnfvmWPNp%RJG?B zt9qN823o(>TmO^Z`rD!dFXyLp7^8E29mXqJv28dwrNcYxs~yaWW1l!33>4{L)(Z6f zn{?#=0H-;s?k5kft$$OjI5nR1xeUoC|45E73lVG+3AHGR075lB-2 zKSw#^_CKeFU|t)gCN*92!kTVKvul1*<@F%CYe78YLwT6$S|=89Q_YH=-SWqbtk|tc ztXZrumRhYR7%02#E6Z;#5!BJzrTXb}tfZX5q$Ct91hdW%qq$QJ19benM(G3@Wif7##S@TCvn9 z-moE0VLD1NYvww~%2um02Ff1#%HlUt_Antet!yPWQ1-}I)`~rf#M0a7-ui+cB=z6v zZ9XwYvxc!a2Sj43@F~qC=CwH7i{t!`_Z{j6Tsb<$n+(UQac@o^Q{GUC?{1f;08cZnFl;ayEa|h1yFBwIpvgp=Q3O?fg5motprXD z@uHyBTl?D0H^a3OtnlPo38kx0dSzK>zC9Chr!j=^X8NY zXHQt+fFt3h$)_i>S#g^m04HP@CZ8D*&Wc;%fFt3h$!AVvv*P$m?G|uCc46|F7vZe9 z6%IHMKG@upMd4v1z(z&@&hq4v4{o^pS1E&$nI)lOlPneBfT~sUVfNu98pD!bs8DZfyCP+kUqB#4=MlRq;amSO3 zsE{g%s4bylA6Y8ES*rX@mKI5OTNGehZC(T%D9|G5?uc-<&I$({2`^2$yCRzvw|Nn8 zLUv)&-4o%gxD^gK5?-2g_eC} z6Va@3jLODaiLSK2sU<16r<7@>{A0EobttB?A7L;xe87RJ19zj2go?dtsQ_!Leg}rT zE1qMfX-DU<#daO2V^LE@7GSNW$rHFqF6cm=h;S8IfFt3hZTVDWtEvQ?kX_i8&qTPY zJiw9g(zbjqvRQE+JXi&skX_i8I}`=+$iyn(Ncc&5WrS>BdqiZbPyw8fT^K5(B3y+E z;7E9BsEmnh6)J!evI|3HT!gDo0UQZ04V6nGTZIbXgzUmlnGoTuxQ#==k#L*#z1Q7o z9E-k&QN8X?qg2(qbc-azzDrlV&EA&`yv)CMAf6K0Du@9mWETc;PlT%=2CRkqmD?(e zW`v2&uweu^&(toA=7dUx5nxT#B8=umwhAM_3E72Vv?#(=7y*uimxj@j$W~zlI3c?* zjFv^X3M0T;xF1I03LvSJcm<1jjM|rrfA)>S(=XELw||#zBwF00t%yk~UIA;9+H~yJ zM7WAjz>)CMtM!)1RuKv~A-ga_w?(*$P{5J!(g@uV*(yQ-CuA2!=&lG?5ehgGUfQwS z6WJXgw#NR`D*#^@vaA$`gGgbO!z{txOFR*xiq-R#OE$uH3^O_{hv4=<@x z)j@Z1A5$?l%wj}u{r=W$Z~f1DfA7u;(&73yX2=>^nrO}xvpcjd(L8O^xn$GB6`2$XgkP&13y+gxgoufDj3q+7AjR`fU{H!PpraG=oEi8n8LBK z>G&2tx@itt|LDhhx2}9_BU1GobFnIpkfb&QdKPAT1u(WZ=n)t!mDf2!5w;UV|s^Pd8up9N1}qN zOu(@Uj)^O@53-U;W z(KH6MitBkYuk#NQ1aXoz2h_*Gj^r5SAi$xPR+0L=o}vt*VOJ=XV*uAudI1rqRiC#Z zCiaA1nGCou{&ZfiQy_?peNjL;0B}DFNN~L4=k<45+!~)rh_WZ34h0+-G6-gg+zv572)}JSijlzLg%R|5k3qvqLS%PwiF(z*+?( zn--r=*jEV;>>Cl`%09pe;q}kvSLh_~q1GnvyN_m-FVH?Jx~Yl<9O;G`eJR7M0ocIs zF%hl|2dss=ihZZCVvo}mOOrd(-Su%%LD>gbt3VZdoUyMG9@uwDge&_1Cxq8m>>8cq zS1j*y#bQzJ(ukfA-Pmyar4|b~((PLr!?O`RDZ<%sD;#h_czz~@srUXLcvla#Jx@gs z!&`S-r^G51D}V#5Y{$4wx3woEDrNv{68n&wZq(I8NuI@Q-X6hXvRibX=ZsC>SI@bp z&3Dvy>8R;F`-lmUUaN7LlCO<-ilXAG8&FzeJ0Pryic#`=z&P#y`$PY4(gA0|Ts;_L=y-x%B;# zA`9LNJQp(dkR=10CyO8E^RVx6jg}Y=o{O<9%sG#fv ztW_`_m2@)Cb|x-~aAhChgz)-gw?Zd*)xXL6wtH;+^T6~rCd6#zQ^0}Q17y%iAyK{s ztV#OIplfuV?_S=IGN`-%cS$rm-k?%jFwj0Fs;fK-SgS4rAN5PE%%g`Byx1LN)1FYO zv;(-7l9EL$6K8}^nFzR+FZY&pA12NTr7{t4Ev1(uWvb~k`jqM9sv^KU7x~q`H+QRR z-ub=NHLvAT;wXJ0I3LUk#0*%(LT*-IY940wP8ZzajY%wuaQ2fG4mj|WeZMlEmsGt7 z8ASGy$mVLtT_q_FI3YXz47L&u%{;}IMK~*Ng#(U+mwroTMP#$$_)CfdPRLF_gRS0W z#o316*cah!vK02xrBuaKMr9(it)*BAXQl11SzTAv>KbvLm9WBAgYs!U0FZTjYx2 zkDs22!pa+fBZZ5{PtQfT@&@39@cLYF=;sRBaRVIX{fg>^05;h+=j00k#km4g|M@nW zO}4@TM<$o%it2>`R@^q{0JD9NSX&d>HMsy6~yaVtFeMnGwBfvNw#$E|R{+T-r_ncCeS_TKn5U8CQof>xlgAF4AePWUP-)}Fv!hh;7Lm|nepUC{m^yy$n(TB z?S!|HI0mRUD$HxL^vyMs||1@ zytL)ci)>chjtT-!$S!QTiz1vAx55EO!b>}ZOCno^3gCq7!cbWj;VM)BN5V@N=UMRw zVYw>1D+#FxlDaj2aN()$zT7%htgjUtuTy2hBbHj_UVW$QmZ|b%qZ=<%#VNf`EChJU z+I6Z}S&oXtI#ss+cd(u(?)>M=(OEcQ8$mYuDkXi+tkX@M3 z_Cz=7TIiut!cms*@aRj z*{rw?6~GDEg`qMd!d0jMj)eEsBeO4FaSAi(qR-srR)eGu!Y}<9b=0d5!oO^GPbnW# zI9<4Lg?4Fv)FM4GqwbV>>uQ-2)my)B-?rNMFy+AYU)$@ge|f*RK6}txpFX6Qtk&ol z`uO`66?B(RGy2SHNbxHV^h@@=igB6kp{fFK;4RCLo1mshf=SnxghW*d;53Oh+d6*9 z!7w#Uvz`z}WftIi#`Jp?Ny=bi^`uZLBLUY^x*64G9GmKKKUI_E&Sp)(v0_bc%|v8DRUZqP@&e#InOEKMt1H6T zP~|7Wtg0MvGjsZ_nJjfs^`}Cuj0W6DE!F=u|HX)}QLP_j8#MirZP4=)hRO|qBV7zb zu0bo3pq3YfL>UY?P2$yXoR|$$L+vgJqcRI{J!85-Cn*0kw^hBl2g{1a^&aIBkS;+l>VNJJLYHohjnWXchM^JHF)$8A~|8*05H zA4XBN4!D^)-KMkDLG6zSwK5uTBeg`p3U#r*^F8t&>nipsB4{#NrpraYWLx%%#G`Ts z;7B9GkZakBB&h2(AyH-nPLp``9Jg%4)KJG;!l=vwT+f(p*-6TvZnuR}840+S($#Bs z7nP`+wY^jmTGOl#8=Cc~1fB8);8-!olxx-zSy0tuLZ-X`I8WwPcigOnv7ySxg;|*i zxS2WKth3ZX)n5{7Wi;SMYN`IO`T8#MirZO}UshU^CXrSWyZkuHV-V+iqW znxcSJ-nja%P_Vg{0&qlOdIL1V8#Ab`0J@LA_jqS?w7330_116h2?HAe9x?)Onjx2! z6iE=O`$EEISQ5YyiSbnRo>y;!?t9g1ONoc%RE2xlDx_bsRd^tZDeD18iW!ES^@=30 z{!mDi^?=hPwbN5pcjzMIJ@4M+eV(LpM4q5~5OUh##`oTRlh)%{{ojZbA->V^pC(0< zjHgF8KHT&`X+jzwd&@>6;K&f44{_fgAspm||D+JI=PV)MfN-Jvwe*V?U(3B{F(tB9 z)dNn*PEXFNgkuhir+80I~M^~UJlP20Si zvw20-QZ@q))LNh(VA|$NcwqCI2v;@(P6)4$?vWt6c|VSB3hZ_l^&`3Bs89wRC~FyV zm$kZ!`mvCx@CBSEsjA<+#^Jqwj24`|e$y}6>-UN1pbP~Z>0lVjyI`k6q09uFrU=YT zbXUC07QJ#F|5m-KPHv)pM&{O&e#yG&Ol(js18`)6VaUaUA_=-V=R%@d2w+X(UJxT; z{--m%c);uEyFoXH_qm&MOkOgR{>(+dy@^h!eiMD0M5s5>N1g}QV5qncDhC`053jNx>TRwd%xS*y z@cWP_qL#85aG+L;KIEwgS2hDq2(ORvacUcWjPrhcl^tdu@=Ww+=h$Ea9O$p>taTsq zTnJTk0}cqw`;eW#&`lK#)Kmc{WT&G$+lL$x;i{$q2g0?d-Z=51d-#3GQBg}pH{d|6 z7JbMu5w2_ooDg0g-Is#s=KVOj-9;xkFr+T$!NAarTyc~q00+trFhgKYNR&qaYm)x@ z4Ew=ljrXfQ17<3BK7Zj~y!H7D|IQm1{`1R3O8%ioIXqzU>YGns#N^*(m^udp?{9qX zt8YFA`1=Irx5MMfl=LunFMKaN@al@RSN1A?rZxpw8;p9R5n>t+Kj`JwzKFM=TtE@ZsChg5_o z1h1dp{+?lkL`T|y@*Uv3Ic1d9x?)Onjv>9 zR5$LhD^0f7*AC<3}FNo1?42b_?d?kZ<*1eZm) zs&c@A@S3jj@NWcHL@i}A;6SZ~Zt=r}H4(0C2AmLHAL9o>uaNiSuJSN%1h+(g72SXX z{dJwSz7gCOLKWSB1H$qf!5xvUY8r4tb~?JVH-ft&T-7w-K)CkQJ-!j#6Sb7hfCIH! z+z9TAaAh;#gz)<4J`AFp_v7fsjZU^_qOP~WEz5yiao7|1OBZ#(fwBWUOgI!0_J}0` zoF=I*>O*^&a3ne?LjgxRwCsW%3xzThaGD}8^Fer+a3VIan_vmW1K`Mp*4>;_AyF*^ zuqNqmU|=lh=J5V-2L>=B)ZDHoZ`8A%!N552eg~2s?Tt=4Jr}#@b8E|A~%S+cKpOjvh>jV#<2Jkz#voM-O^J zqO1p;CaLdxPEd!{A3fmxYV^Q3usE1!L`n99jWocKk}ZRIPAJ$9mI82^qKX33t{;Sc z*u2=F0tRqoL+gN96cQCMfHg^f{jkX(V0hp5!#Ek%^r0|Gysi(mB+9Z!Y_|rmR@P_A zU0EWspbxbyWb7GB1~^ZaykJI5L2_RaCS?}jJX2e<)`U!%1vpRUUF-A(GxIbmtZ?B0*qL{KCaHLr46n88n%6hs3j+AT}%%?)Zez5HYaGIiuf(PcBcqTTefB_uY&^lnwg+v7mU`^8BHE}Hn z7~ap0P5da4Qi`Pe3~GDymWQ3R@Yfj*CoOyz!}Lx_&2<&;N!MLh=jFbdy=pIYfVIJ# zy6eX#BC_DRx+rAqT}uWyPnNu{MohtVbxD|%S%C9Qx$9~~7MQgxWXdeSc{1z>)CtwBqME#m7Z9D~`Vyq)N+9FaJ~t$Jw6Zmqa)#ZiNF56mR<+ zY(f}Veehs-D$CHOD?TYCY=$KP9GPJnm06R@egxt}v`Q6)<31_EZR1c}oCT6Wm@i)T&VoCr|bJLd%7({_E7ZZodgV z%4c((iJ|OCm`k1ntPM4?X}-&a8{b2DCh}xd>9xN%s&slSU7KJ=3}sKk zT=FDfZ75}_uj4)aOnS{uDV!4m_M{~MtO?TTwORupNU!rES1Ary%O%B&7Z_L+;Yw-1 z3E}nW^^{KX(<|>M=LDLY2^U#8S$&(}04HP@X3s?t&Wc;%fFt3h*>g!`v*I?v0Zzy+%%004oE5ji0Y}13 z_Kd%?QS}{l)0tJ@8iDR~&lG=a#k^ANk%q z{GSQBdGsz}e!`Fb915z7{26`@MZK5VAYRXsnN^=fvEsLN5cKtMqkHP5p=sKw9`%oH zbap>*;kAGIebraCt2Z`WYaQKkp4+!4qp84xr1*>FkOrJF^Zgp_3@4h*j zRsn0neI}%aKB(ZqDr#>Y3KcgrO9fa{(RHLWLmY{0NWHwzmA48wA-ga`9E)&P+zJOA z2`}wmorr8!90>%suW8wZql2d+oE5ji0c*wm%8j2U^btm9!o+6Sx&@qPY8OW5Ld8Z| zD!`hmMHqEt-Xxo0YZ`Duc3~Keh;UZi3I`ksFAbwnk8L^><_l8geW7u&i5+I62(Y$^q6nYY zDtZobNrbb*tZ=}Q@X|~-A+lL<8%2NTbqCrvI|3HPK2}KRyg2DcxkB2i)>ch)+XSD?7~o46ydD6 z6%IHOUK%P(BAXSrwFx*OyD(IiMK~*Ng#(U+(_^JK>2ZE*FubmHh!D*huB8$<^LYm@xk+V1LmC{*k{O9fa{wYd5oiEI_GfD^I{vg!VZ5G-a22nBwQ#?3+jZiEiOsNedsfTTE{x8FN`(<%ZB&ae z>d0dT6-Iy)vJ1m#M1-p_0vri14Wm(!t-=U!LUv&ojfrp-Mu4?&KaBdwV()1uPHa*E zJ0988suL%|Rft|n2`{}ePl#+4qJVW}nD8$Q(Mb`mLKJW$yfj3oM79c1zzNxfA=(q+ zDntQC!izg`B3p&ZOj>qnCr*T`P?<{!FAbG>k*z`naO9MC=|&~>P5SJ-r$rI2LIrRn zyfjpnM79bQzzNxfp|UK(Rj2@tgx~v4+|BR7Ep72!yd`<|p<)tn!id6{To&OfCILsn zOJj0HWUH72oRD1@lWQVe#U$WJcxg;-iEI^c0UQbM zFMTD4(o9b3qYr1l!cOm}(UeG9`jOw%{ylmU)*`EQq-(E26>!3~!cZL%;VM)CN5V@( zbyQ@lPz9WjT^OokB3y+k;7E9BsE&(l6{>&}vI|4?k_cC!3OEv8n$;#mwh9%%3E73A zGAY7Ur~r#_(}@d`K+UK+0}B3s2P;DqeLcwH0WDqaC=;eO?|3ZpGyQegx*&(toA zwuMTC5nxT#B8+xKwhAM_3E72Vv@60@7y*uimxj@v$W~zlI3c?*jP^yi3M0T;xF1G+ z^vdj)*yXuG;puq1aJPHD(LE=7F5LJlZ_$LN?zhIBm!Btbn+3W+iiaGIp19xYQtJx&RuG7E4$W2zoAltDfA zgi;v^xR%n@WA}8!)M4%`up6cx@6xl)w{q_}&WH-iYQS0rpNT6p>?|e7f=ZneGG#B| zJegOq!B=2?^BO95UYM1cfSZ{UUxBTo4k~$3sFl%x8>wAIuby&)JwcIdu;!OcgIy90 zl<|PI29y$voLqxdBthLS3yCrlaGJ!c*D&!eY#OG9I$aS)WftIi#&m;CQU-OoCX~uZ zz_paF9=mtQ#pVi|tVHumrV_V=T3HJ?qBe4Jm8eL9O57F_Wgp-)No^$>riMz~5k_Se z;CjY%B_=6@O57DnWhCHQN>_=icc>MnmnX1K6XLn%bmRQdkM(X{`PhiQ$D7@cXMl9~ zLpAJNwmPverJA)nd%$AZKzNq=R0ok*Gk_9H&E1gB9{S2cHc359NX0!womjkO;3<3L zD{I9bMPkj}LoBtLZXbB|*jJXP3w4hZQgPo9>mrC{okd~ z^7{KNKC>j$)jW5}vgG9GW;j(T4?v|l^CxH?bA zxVwl&NV0bkkKsE&l;HmT=q-VjjSs*22K}7vj_gU>xVALcl$!; zx0F@D0o?+nZZatzy}6TV**6bFHk-nMotUFfp>l^F0jIuSTnWefEmagov+}L*!&q^@ zPO3$)Xe#fW`fu7+uURKvAt9Ad)9yIUx#KA94#1JCPc!bQga__87U5iv)*XNo!t38h z+oMRvoivvhSC_mfU-qK>@%kvIpR-YZBI>Fr2OOwtYtL}iM!BL3qWo0o*gLjS0j{B| zf+hDNk!yob)O&({&U)fZR8x%va9TCPRqF{w7kJ`a=v15l)^zTLp%t@cS#RNw>Klvm z!~mJEBNJSeCje{J6j!Y$RH6+$F(P!z6M$>z>RZmfZ8=6&Km!QD?i4mHgUb6 z@+MlB{h--R9PhT#(%d$mE8jZX#C7LiUijHVx+ZOI(e{RsiWjtgZqa-)593?IB|*N@?v)jO{LYC?v`lB&fpI5 zD&SZD{RTT;O&y)yra!Z5HcifM@rL<{KKO_X>FU*!ge4Yjr@g!F zQse;Ftv#`dU5CGP{{T3)3eOk}SL^1mFLdlgO9wchYtdsD*=!0Ja4VFSUD{(8;jFk7 zei#dXV0!GLv2w>ztTFBe((cIj*hRQ<$8lPCeLBOczes0XUhM7+A*@eCKV>}NAkO^i zY8}?6LZ{pTxQ4FYEm%kxZsC%$yt`LFq952rxd#XIabUVtuYGWECK|JYY*GfC(wLcY zE0IQILFzmgGIoz81Dq$Lt3dFGq7Sn=;mqBFb5W;VbzI&&WFXTUQ^q&=Zy7g;*M zHFWJvn-MN$8sHkP)~3w~oiYt@4V{+=)7g{~Y1pHdUaWWWu)EdsVhuYFe<_IouCbF)nUaz|8Co&c;>8_q>?SLl={0N2pfN6Lte6fQFtNz>oU2aD?L1;Mf> zIrMN-iP7s-90V;5OEz%_L3Ogj)RWg6fbuG))aooRAC|rZR=noQzJshuC;W41G@4{ z=%~nMQ@}u`08Yp*yo8R4a8}$32OJ1*dkHm@A*g-CPtSAnVs4I$Qfx6E@sP!U1Et!m z^d!RBVk`VoN_go@MiU~N6}Jmh0*(|fe)D@$gtOvSIN(Tl>1_Kcku{GMq^YGomK@0A%C?z>%88 zL!NUYoPA)015OC9z2bIvsbhvesa~16__ezl&5MdE1^@>t+El<7T8z!~b)gLgaTbM+ zJz}E*a6mWsYx=g0FQsJ{zNNSvC~k!VjubCVAS)u9>%g{gzzNxfuj{OdaQ3(r4mc8C znn1QhwhA7=3E71SWLt!*PyrkW_ajr?=TTnyL;l*#+vaOC>MJw9d6Dx9eNp0#Z-212 z`NBs|QYpp18Ob-Xx*MMzF@(JYb120CP8%}VjnA&ovEM8mU`==bZ+!MdHRTDwTD9Ta z`0NXv@&w=-y81M{hcrxo@Cdy;MIDGns=)vbG-}buITYb+E+{C@07t@0Q`C{jRy7AW zA-ga|9gA>PPkdL zdtv&LP^p*&tf|cHL-O7;_nO1a36afa*q8;JkX;zFlOkNjEZ|6ZY0OTEY!$PB6S50q zwkN_>%mUWJ{mN|>Ml-^s!U%Alsa+V&36%;Xz?!N>7|n}p6-Iy)vJ1m#QG}~70vri1 z4WlKIt-=U!LUv&oEsJm!Mu4?&KaBcFU@|Z{El=z?0~X3bBJ^Is|Bt>yid8S*&zfC% zA?H)HyJ24F+xUJY;Ja`C#GAkN*BQa<^JkcyY<|CcxV}0;d*AuNYQOsR)q{V zw6GI84Z_|v!pt5C`w=V5?N`4VVfdL=2B5#D8?s=*H@kCO7?cr!(+uTCToMXp1Yk{p2WptJ zZv92OAN>PF4zAjQU3|h|&Zor&Plz_kV8B`%$53wYq);e>0jDX7jhGS!Wdz_fL%9(> zp-@Hu))e=p)@DQ-WiVi^P5WA#6AEQ8U`;^=n;xZvq!*@iySuuB5T?P9R+Gl(MGH0* zy3joVV6BB?;AstEqYq|VhhvLE!lqi1#h9dRZd?)uRbPMuGpgKp;l?s461*2#pC6Zn zh7GZ|m4G$P?H`2bww1CXG^$bnYZ}MUrc%~~gl)lJs(HWxN!v=<5(ZT%fYS`+Sz}u$ zRD}QzC~RHe;e|Z>q(>QV_7-m9ib##jE|rGnM6>rXsozZHteV}E?&|P1es{jlOT_v? zILb}*Ts^q()qjgZ=Jr2@tJ`{YM@&{;1ss^{hx!tdMDWGl+OEK^&?wIW)-<=jKNj6Q zWqD7;s}KjQ#rqEAFc0p9Qxl1U{If4)D%1f7WNjS$;5<{?06P^j6<~k^vbF(sCJd@> z0H+zs>*ic2RNVj$D7?DKXFu0zF1*i%uj}C6iVG6Vh>)oI2ON=@`>*1*IVudQ{sE^MsQxe9_!6m8 zl=a7iM#TVNO>_GPAiC`WI^#m48Yf^);~3gh$|WIDl>#^-X;&!|!k{VzaGIgKQBDel zst~{t#W60#`DRqy!LhZQmuNaT3ua`6hBGdF^=}T`xtS7kl}75>kLR*mp`DRW?RA>W^NZN(=yfCPW0Gwth z5A8*vP?Z2UO;MaQmxMtX0XWT2Zp5-sC?fzz6sAU#MyR?DIx;K5paKeTnxRcVtqF+= zD8La(yMWpf22~e;(+uTxu`Lv;E&xXq#^d?S)>r4nHsHJz+i_{p&P( zeF080m`hjj5Y(a2s5%3zX?O^#ZKWIujj9yDnr4tnITjLCDS#uAc9n7>460H9ry0t# z&Z$tS3IQBZ@Dg#u8-lX6Ta$rk2+ChAb~r;&XJWGQD&WXumzplzSW0!J%+Kzw3evo% zQRhOVJPTOUB!-~;MPZ%z;KJJZf75q{1Z(lW13C8uLr^KQApeXAnF@8lnvB|0yHFn$ z230A5(+uUIJ|+~ZLI9^JlARq@%Y)TkZ-2hHAl-Es9C{*15))ao-p zWss@v~#m9G|H=hHBEX5${3ukeG66Bj*AyJ_XI3j5m+IzyFDgtntp**zrg+f&V;50>Xhvq;Slo5c_ z4CO`~3WYKPa71C-Nn+BLs_UR5b0iEZpa7>C+62_Gkf?wH9FepOs1spObpbfdP+k|O zLZRvca71A|p3iLkbY5Ho&Py>C+62@kAyEMZ zI3j5mP!qzS>H=_@p}a08g+kQ@;E2N1MJ}iG_|X~-33F%8J=dohQ41z})I5STUsMaT z(Qi@1yle9gm^W@B`~1Y47jFDI{lc@bF=hKFO=kKQ{lyGyb0lNt%L_xzQ&ZwB6;^=L z&T11@Jt0wH1vnyU7gjUEpu!4pnxQ$~~ClL_>V^!}{tJLdA5fXjwv+u^2?p>eV+Nqa^nme}6b#t1a=HiZH-wzqN_5 zZ6Q$+1~?*V7hyZXpdt)#nxQ`WL`hyhMBl!w^4P^b_CoTezwSski)f1WIcfUr0K!D)taBSwTm838z=XqU4_g+T=r z;50**A77sJZ|gQ9MXF3#rKEESD~+G~XWL)fVhm zv~QWuZ=*X#Kidy$o3C%%FLJ+nXM(=Nebih3@^No{7VqgC(Sa25-D4_8%sZfr^+qi? z1Ju0xgH>iu?I}|usdL7X=bRBrOF@iwPe}r}%+49@OpS51c>2*kY9nmodR*bpBf{QGmyxa-w$Y~xBeMY`qx%S@inT} zEjo=}3tP97>bO`p-+?_6a(uphJQvT)IbAZuj(7_YN{R zxq+tq-1tY7N8C?mx4Q50PiOe)*YFdT^`k3Bye4FJU5;>h3uFs*iprQd`MSGKShym(~`BfHK5UJyHNLAa=e zWl1h-QEEZSq89YA2+26!pE#g=;K4od$Bw^Uhq;tRZopNk(GBMEVUALMaOXDr!EnQxLM4>T=%AQhP?cL|T%XD<`AvOb}X17B5q?|T=<}HHsi?k9Ton-PY^$Krw&0?WI_NYR)KL5*K_|lJ$U;6kj{LLR9fBwrq z|HXwb{NmD=#{b60e_{NWKR^DZ#m|j@_6uM5?5~c0{EOp@pZ((auYC5GzWllIkN?sy zjQ^d*UtCxm|HUtk|I+8a_(eMKvwzzh{Y$_6cRu%p@t^LfR3bf{OkT3nEyZc z!skBwCE^qnzPz+lrh-!M>Wf!?=4nD|%U7O%dd3~owB3CM;yPDzCGpLWFz_YI>zA)Q zh4XV|Z{{hZZ?2^Co__B7b)!Q++udhgdFDBzGIVa`C`m>*H*x+>Qr=+-q?vX@mJ{u0;LXC^xa|wqL;yKU&3qa{tGI-@Scq zJ0@^`1p3zOe=_(z+&A&*o$v1lZMD+J_>ytj^8vZ?s{Q?5mCw#jQ>Hg6cKq$E-*Wy;;O4qT zc$?BVHSyYtxW{OxQ$ad{?}PaNK7Ub#GbbsE){E3Z>?@&D!8mBalU zgzdTM!{6Wgaf1(d*`w2Wls_KjkJ|gy3ElsG*z-y5KE>hT{l>%6zDoPC-RswW8i~l2 z^bqFx=cYela+BUJ>mNILu4Gw1?8)VAcORv>LLKtw$$edJyu#k^mHMUhcxR_8OV4k# zBWIt({}S1WzDoAK+Pit>*74X zZQh!V_~>}^o7ST=eq7#j`OuXP&y}S-kB)zo7tu}0#X(d4$(=VWyovw)_j`~>O7mmi z`OxK0ormIl)$sd0&Wrvtf?;gG@$o5|K6<4_WRv0P5pvKB>& zWqX}2uK$+fXpgQ_>Fa)}|A%#an5%~+_mLd#H-!Ez-G9IPu_-U#Yx|n`n|?3V?|#c` z;w%6C(RIzc!|2-`C@58BoyjkI%O$>RvVVtGE_^~<}Swr5I@jUlj z!`YuHt-T4#qPBi{O$Vpi}kV9d9zR1c*~Sezd+t3u3UKqzmteu*+sz9fBlwE+vEE!uh`@J zE??l5a;4AGwO67{P`bH{~tK24Jb@z4Dp+I5BI%;2B`;!Iu z+Z0!~HK7KF(}Qyaf4*;=~|Qx^@@%)BMh^?D*Tcc1t*>{UU$4(wrT} zFMhXT&9UA#PM7@W{Dt!^E+y=Da{c2xSy$Y4*zV~(&4bvspgGpxwnF^)&z-OM=peOE zj7|^tlPevkI^O;0o#&me^hf=_K*t00x19)Ay5Ag6xbNHOZ(Gq)FX4INzERHm^RV1M zu*qki!s1Ky|H_`LxHTkR>Cw#y{TJ@Lb%C<$_+-{6YR-e*XTW#u1upY8mD!WKFGbQw z{kztE#;&MIwA<}B#9hwLVd1fTW&UyV8_86ei;3;*`i>3uy7Pu*Urx@0YIhVb z4gT``ya=RWQ@ zR~8=c_+2UUU#`Dw^{{2rbDRN>cl@q&{&>;a6bgt;j=;gI$l@0<8ozuei?sGZVqp%cNbrw zUr3%=n8%fka$Gxi?a!9(d{;Krf2EIZckX;wHp&rw8suc!Ph~INS0Z=CcHy$sA$?qV z4R5DIKa|z^nRyzbpU!ihytLe={NwU$5T^sn6@4RrIz3%k<_D{|zv=ht9&9-JRQ9mECVt8j zZQHFmFLD1_t)bq}_Yd5-hAaCyXMkgnS8e>YDy=`+_5t+B$$@@@YJ;VVc~K84(U0M@$(Eh7p>0udU*T8vOg#1-us0n)hWLWX+Ml7 zsR#4;-NroXVL1Ca{|yVjxAia`#OLt#hh=|G&b{}GACK_MkoH|3cBP3=$oJ!Mc>9x2 zJZ9S2`aQ$NYrAtmPjm3$9#$j6iYt;U($dCoppIy>FID;;jW!T28ATYLZ6 zFuvvNaiz1%?Yq+94}iV(_q7erW1Ky%bauIYS33Mbu($Spxncax+2cxQm)m!x!{2Lr zDQ}v5Qd63|?ec4QoSzTTlPTQ~<#{}Yw^Uwuyvs9fOH)6Ce!qBt^P%@3`Q`!8f1v#F zAm~3xK6tP7e^~nOvpfxn-jOlOZ+Bkon%9)1ba=L;+(oZ+$?@*|*=OzircC*;_&2`K zarZ^8)bC%U-u0-%o_+r58Tr1iw|$Ma-3uc9Zre|A(l>#ho@v|;-Yd!Jco~cF(0{q| zDf@e_l>U0ye|P)zKEl)PJM8^zyYpPx&pCq}<9J*-h^%{YF248f{C5wwP30&4JT&dU zH-pzYI@fIZ(?QvkAFkNrUHMbbU8m0|cRH@jwL6DL?T6%<@3ZDg7pJbw9oH}JoKJ7 z;-e)fA|`wsWUe>*%M`_Df;Vcgfx_T^7Mk1*`y%31O*{#^z? ziOrSnINY=K_0P)f%b(QnO?@TGe(lfM=kP)GFb=0b4_EuddIj!&lS}t~C|8ERhx=|l zGgmhKei?!hubJ{Gi|0yuy`_VH^g4+7cX@(OkTN6J@#W+?9H;x=5A187+Lbx3-;#7! za>MhQeh-fi_rvqO{i}B2iwCuQSlZvrbI%|IsAg!bzz1NPzV~jfI$lXph4mb-n)0gE zw%-!xrv7_a>Nm`T&pz{gCzzabnxj$+=8Ql>Bq&(O}gJ*P-`4DxWf5p*7<&WfO1c|D28Cajt$`nL97UOY6bO zmok+X$iJeW-N+sv{7$DP|9e>5-}|M#wQXOycH;1`y+~ZyxC`UC>G!6156=(xIXKTg z6$a_U5}#rJqIq9GPmI@b)Axb?TAq5lzvJBfpevtsV;`CFMH;$H{-dGG7Zd-eABD?D zCs)2mzhgACq$C=1e7_~;=Rkg6CH1vl^!|nQb-nvM-HCTPuAKZ3&o_4COr^)W^IQpO zN&k|QCO*Ji=9q-9;eU4wMz@;!XidLgyK=3E7XY6(JpdYm2=-mfcqMtxtf_9wE7vbS zdlhRJ_gOaS)AW1D({y~(@31BJ-=q8$=9k=lQ$7oS59JItuRLszI!9Kry%;uC9`2jG zc;yxI;AW8R7e8T!fvJtREuS~~z4(c?Wm{f%URz#1&-xCjyEDl4i$84jd0(RR)&>+He1`Cue}|Fu%Hfkt^>_|H#vQ0Dri?68EP( znFIL4$u#{hBa)X*x$14B@*bA>ckki({ag1A9{k{Mn{_k@%au+BzxPgasLZ>BajEKn zoWB@G~5#lL=! zcgM|{t|6UkOU%VAh$F)Z-qQ0*k9YQ!o>zLj^Mfl(&o4dR@wl?|d^*0L+#ttzeiW=! zMnA_pdtBMiIo>gxE#kiqOaAyzpZu+>-~PM*>{B24)BkGeZ++zd{8V^7aygq`NHG-Zm<`V_-7n=UJwCTCUBCFS*N2PbnU(1H+XYws?R&gVo#OI%Oa1Hejw>IQ z{L|0%Y>;E>)={I!G_~ujx!+UktmW2U3-O_?DdzRr`npdw_Z`DqUyJPshD4vlmS6qBuZ!?+ptz85#9UWd3}YH#WB4_h3z z^3M?BR{Z=)bBV3;*)aDJcfPzK?w9(l^myZ+M}F?>+Uoh%_1D7kVd=kx&v$aq&-*>j ztpk)RuUwlk>uR}@j-x4M^sZB;q~qv!b4thGcIyne(#dmWj^E*QoLRrcl{tQg({ZGS zImPP1+m7FrPM#~9*86tHd8P6X;U+ZuE${VO+Mb@yf1$qQCmKAZ|LEBJw%x+dq??)A zZ}n`q-3M>NKkc~KpM37alAoIV+xYuseqM7qSDJOgY3_X6@-p8aT+WsEdL8o1pLl@+ z*|ayZv3dKR>+{2&4$a&BURNIU<2Zi$|As-+`fzy12y+Zt$TbtENWPRVK7hIHQn~JX z=?Jvcwv+3AbNhI%Qp)ANEf22Lwv+9CbNk^Md!dgncQ4bSd~F(JyX&1i$abk;LVH4c zTga0bfv-uP#D~9KD%ZsTWTv)VeYxMH4l-X-sl`)ZB3nccpi}u{W{bmt4o|%A9Y?}tsRRF9$4}T( zpCATgf*$o9kLw};K%L1M!{_g?w!Ve3mGxt3mA zas9`6eo2W4km@It%5~R#$VqKG4)>eeFXeI9eDI{Uom}^u+b4U?rdLA51KT$!^$Xdh z?D6b0cDIoCC{CzZgnsq&*dW_}KX8z3*B1zLD(#zkcV+H4hr2Q%$HbL~_a)cyx-uu< z;jZ*}LSDD8_y?&2|6IpU*rPrqdAfxks9pxY2M_BXdJNFt_Rk%Pevjg$Rc!ceYAE$^ zuj1rk8Grxur>PpK%izk(pT>BI9VhX(FS|Qxs`q}j&AB!Y^s{~0j3t{BXsjJ$%=O#- z$n=ge7Y*;v!&1NII}Y~C-w(p}Abp&BajuKAe#_i^Qd;NRJcyFgn`^4hxq8(+P@>~p zsn7G~F7z|kA=JB{a|Su)5nsc*h*iCE{XVKs_1@-R_V|(Z@A5%m{TH{*0pqQd@BLPP z-X&jcJ}lS&_i8LOjFYDQaC{}~*I#+zxu>pEMs+2wsn@UnsO{O%oataceLiVHQNS{I zJ3KGk5692K-@|?4HG*B~^mS!;eCdALE@xBhhx;wxA4?fzyD476--k6m(B$8cw`spi z>u2Gg8!vboaZEAj%BK1;#}NsVm%rU~UeoVw^|@Da2ZXqxck2>`0Ak_NrO=$d$m+fpR70=Rfrc{%)eb?S6NqJKvQw?xN<4({ZLgT5nl>Y%4!o4EhfH_dfI%PM_cT$(6n@{cYd({vv(%&ag^mBpV_NvGD+|IN=q;3m4hD8Lg^9OU@v-r;1M^QO|osWyX$F7{t$$Wr{gv%-DxiN>^;drjIsdVEUoYyFuN>9i>aVOn z)mu2X9*@uZT+lxsk8|l|s`jbBdA{kZmv_ZlVz{qXFXQ`u{tmIEgsAB&}@+3DWa_}^D~x<$Lg9^ ze~(rBaIQGj7kebjFa6?Q-Vbu(!~dNs-%o|Uzc|s;spqtw{wn_}<@c%nVtU=jQ~%uG z?;A{?_dGP`R6Q_#e~*{dtx&fq`d#z#KVvMuUC z(D`ZVdcSMza>+zLhxE^?eDzmn`e((}U;BLW6vy;;(5kvM;@x(`<}Dl7$u*&V9;^OP zf3Y9(kIS*^7aAYgDeAAPhx&`-)ZgzZU;2Lb5B9I9m)&}MF00SjPk7u@zGC}?A7

QGraF)Mdp!D7FB9iGT|dR&i1fYq-`o%K z%gJeD@v}YFsvpENk@#19K0djgkHz(>#_(u9E5AeaoT~n+`?30~?CLLmFX6FDr~V?x zV|>o(?=hW+xMxy7+ST9wmXGQ2eApg5#{B&~R{f~{s&=Wrs$JS&d0ne| z^!I$2UY%F{Rp-^$M33gPDo>TK{vJ)4dS2BJJ^ekJYv@$SD}KiuR~?T17%qNB%6The zM=elyIPz8QgZDHBedRmeyjU;!^Qz!+J#PJleyn}Wr@rRJajR#sUgGC?!SkiBaq5eo zsN?AK^FGRX(N{n8$&c~%)93m6Xzz(SZpW)$r^@d$@sghXM=s&ZwEyJ8L7x9RRr+TO zwO#yok@KJG3h_IR{_W}Mc0i z@4UNf!e>UT?2Geq2cO4}jeZ^HJmgIil+QReoMoj{2+Gt&UZ_ z)OnB}Ub<`er&m3@^LDbul^o(>iHVzXltv?ZcC&qlku*cmxeC*%3NzAD=f`(jd(Vf5xR~Qb{Un;9m!ZOkxEu}M%y~# z*|Wtwc)6@TSs9PFwWSs`v}B^`)*4Y(B9S;p{N1)~oBX?C{o1wb*UeqAdRe{v0plER zTE4M<e47>%8G<_E9+OUI7g&w zjK;P#rjqeF89HfuJVPln8Ch24#dYei7-W@lF}$hB6cGEH$x z%F@Y&LoMBzy`(!+OIMp|>ao09kuKgAkL5C{Y%ZEh#OAc6VzP(Wx$D-fSufkv-qDsz z%xO$D$xdNu6J7{xw(}w(baSPeYkr024^f&9gQ?5 zxl|@gb6PZn)sfcqH?5R?<0YUm^QDn(-L#_8=?um<(df!~&=^lPC6X;v8^)K{Ih?8* z&&68pBs|Tg%^U6drst$9FIssqmO-Ws8$>+?7vlr%s8e%s(~3E1V3fDUssEf!EBt*$ zT%7x&L?+h}ZJQHorKxLA^n|$ld$=B7*7c^Yb$TH}m+~f6wtKBQeBH9Ob#!&Q*EZe@ z#Hi5)?DD?u4R~*%W%p%kwDK=nw$UwXRo#019x<1yv_arr?;}0b8{2iF)RS7jqNl#c zI^tO1efPNc?aZ2)(c0OG+SxT-r_ZilII}92eh13b=zy6GY z_c1)b`@B=gdDOj2-Ji5)8EiM+506Pb+~1GR?>II0dbnorc>>1{`=Ymg!}iH%H|M-= zTMOtzoG&M09kHL>_UXT8owoNU?a{U!=MavGK7MYUoqEdgDqwtiY>!?}fBK=1eEK|+ z_3y2Y_A_WrmwH64p-0sP&5P#N&Z}9_<$MwktA(a>>PFwME7sA^LiKEe6|`sznh)o<2|nOZIbp|_n40J%tX!XnyQ)AH2G_0 zH&<89o$vfE>&YHHz1Me%GX?j)NBZ+T>0S?c?gRaOHqBesOmSh)cN;r@ZjJg4+JpW0 zwYA4N)BAm@hkEwZt`n^O$6;Rh?(@z$@EYmw{K4_Td$BvedK<4E?hnVS&PP+nVx9U} zXDE)PZ+)krYhY&W%o_V^W%m3odWgbfwT7hDl=7`NIelN8qs2LjzfJI&_+{M#_2&)! zvv}qb|D?9hFpcrXs27zTBm_vMxoRv@O`$4}ts z>OYeDC%;dE+fTw5f_xW_?mS{%IX)Mfj|4l%QIEBD4$WVKo#Uv-Lpz7&JK~^L zz8Xz^mEWJmJ&)t}((`#HP#H~$-h5}=vK(KVp39ml%j(N-$1TtC_361h`i^ycgBH?v zZg2m@_xmD>d^Lgoitp$k{Wn$nT;Y5U(BHG@zeUCncb?LrF`2T6d;{n|!PWUzf98P? zz3{}&bIC;ilz*9hmUg|3p8lGREd%s*Qx? z^AYx+$}7r#CCMQCb`a+#goO_Wm+--*#Bb`xu!@?%!kUnm7$o`2kv3%8Mi;SAy z$`6S0!}Q-PRlYqJf?_PgqK>Lr!wScm#kcoYELKH$e-@~L{~gpxslxP;@OSy zHgaFX@6dEMoapgGyRO<0@Bw~|aZ zULFbEYnkR&<1VrWI&-0q4=~MybCeEkqa$$!;|7UWhZ<{zfxP$@IHvPLjkC!l{QhiH zu=Bn>p~h*BZN5wv?A%YbNsi4i?b{Q2BNd-)5P7SeQ?`ZP;MyEhYv_`(lrtNnbWYY= z_k^|#Bb#^}YiM$eH|_~tIEsvP|CK&;j`=z=4{_2urmOaZUNcx0NzQMMZSS7Y`9sOp z7p~WHzJsdlhLzjmZic@wrZLevlKGU%tB&*0Ntd8l)%R@C) zWD=gE4Wj#0+5-fp>Y&!i@fd;e5;S;~e2|PI?UJjVboY@-R4Sfz4Erw+O&(#VX|TsF z*tw5vqQO)nC)KT&hsu`)%xt118Ld(|J3|$-D3x#sO+>4WFVUC}6!$^-FI+JwXeLq} z$wV&OpxGm3!k$da(ejd;k+NYjea;U?6KIL2+WlmrC@Pmo`pHxx>83_MIGsRys;$OP z=Gj^Dm9~ITt~H*g(o2X)XI5W%mS`uv z5pk=?gK7kdrSp(QL}HE6Y}|jQr6Ln~zxqhIXjMFKpO=rcQK}G#oU=WWHY`n-es}ER*o>2x&Tr&XsUrC2!ae(e7n=eIv8r3%wZ%%X>n*oiW-b_=MHGzHT8C26)CQ3fLO^J+=20V;v zBZo)U=Pf{o&L=A7q@*_>rFK&9HPhFY@kwCA#!ySzvohcP$R<0jkaO@mNa;clZ4`6x z8P1IGII3xBtVc?B3Q=cCtBpp)GrXd6Mkms0o62PM4Eg zy6*-RnM4`J|6Y+QUPRV}oE@uivTo(j)oglEtIq@x-Cbux`grmsQ!_HvL9 zXk;4AIQk}(7wrqk=26B}MzY`(eg#ciC|Q$)!x7SzDZUycoDOh$1>Mi>?@GxRA*Y!_ zUzd`tMK;C0IZ60Ngmf37uT06($i%JExp!Z|nGr4<6f&Ee={vfKJ@Q0Ghs^C+`_WOq zc|^ubds;qFF)*2cc;VwGGej0CuJN;Z#HgG7;7l7h&%W$TiwV)s1%ICN#ED|+VN%aC zpp=k!3io9iFxVmX^D4_U%0c!cK0^~7Wd9;yXc{5!QJ$gMgyL=P<1S;e!Svj0KOQqA z8tgq%Gql`6{(6*@5u(RodW;f3ZS-6vLkY>p7atMB9#6Ei=Ca21e5yoBXdJU7E23%U zFR{{Q&MyRZG8*DoM=sUeEPn?1vr_At;%&M7bRe}NQ&P@-wF4rc=mi#p2d zf4<~($VD9`Um*Dgo0TnB6b zv1D@_-fNq7q4ad0iU}!hlkpK=nh_qY?l+>2?2a=^+;QTWF5@nqCo)Rh zaR}Jc=mAcR@C3I+**I3_7*S?dS3|5i7i~1Y!?Q-l%qF^HheLk~bnHN)J9j$t5K?&? zq>@F!e?v$!NER$$Xd0iQ<5al<4n;^8q^NM$j-3KmBCfUzcJN%lEmq+jE^B$Btfn5IRK&A0W;o}PWfM6g=!q)e@PXfZc66)br2Xv zc6vn%U%rvRD6&(((v&y83Ka-UqAr)O3yg0enofwcyvCCVs9O@b9qG97Yb4cz#M_ML z5iGE?WK#axog+@uX4m0gkS|ywp{T`x>3p6BMK92|qG;7nWYl8uzRNCj0@BGg6{XHX zb~>?WE*op`zf}r~)=B1jz=;IUl8kQ4{(K?Ph$wYSgFjzruv2C_U&b*m%#(8p!7R-} z9PSX!X3=;A;vtOYEos!*J*a#%O|*2@I175Be7tZ{yuyuc&aURb||Wh(>^FO!d7D z$q1@%rpmYr?bP*Tz6Z_JDVeIc@pZIU3VV}r0PR!BPGj^m+GmPRPaD5OySN{;rPB+H zzatU%10uCXXa>I!D(L1y11O&XhafwT&M)S|L;!=RM?|JnCedQd;!u1GQh(VpeKuD{ z(p>3mY->u}umANYn~`)Q5hxq0G8XajA|q)=Mz{HYAwe5p$~m??G?|RaXGG=@{V%)k?g0wj+MK4$ugP1`VJaOEi&WRSAwJt8o*wDmZBX z{g^a9f#xX#%r5a`=w1Xf2+(UT;}Hb2ML`Y86wSQHftggHB=rzhHDV680o{c7TLsan z1H|jJcKGodJad4VGoFPL1Q$?Z;{~)X8bB|@Q}oh$CckY2&!OZwV>mY(;SzDqcr%S; z2RwxZ$5Q7JGN$o75tBeN+u{4hiI~)}6qro%8nW&Wdbv#iW7EEpdo0n~bj2kxAonKEu z=FKv@ejCQ-{g>iSLOQF#eB`ZEd(g<(=n5ydZCvtjkJ zJSIpcaze$Z@;skN)3C8_ZT-6Xwe^=`71u4>Tz^qrgD;of0h?FX!RTyU4+d%`??*DM zR(IMt7lAo~X8yHoO@miwUYUkrMNl zzq7nc#CLd2*oDCo^O|sp8R)~n@o_!cH{4g9<9a^X0|lL7-*7kC(SPjiv^YNQY3)n{ zLxDBxSJhKQ677y>62pPS<37q&^QX6}yh)f)2i{a<6Ct3_iarm-m#>)F)N|^i zoj?DPmaIP?^A#z-tIS?oSWri}W3Htx)Ye;Hd)?b-C)!P6$=HzKfmc(SCA}Zm!ywXl zpPZg!jr6GZ$xcV7_&}+fmX6-Xj(VHwJf&|&zYK${iCx1ZH1BGRz@Kd2Jo2PUQ(^ zL>gU3xr5!-0BLcZ+ms{VligN?6W8sn+X{2y`n`2qA&1CU%XXz7?6!i^Dqr$D^}Daz z3b;ns(XgA`8AXqYlup8Z-JzF+i57X3+uW_)p??dL>o#{|cj%u^ni?nDb={%AJ0{0+ zRd?ub!lFDPsW-ceesRLRgC>*zCqvOMjx89SNPcnK=q{tb^3na`x{+yqaqmK=`^9|( zq3##AA0hLL`x;Q)FYbSlfnVIOk$Zk|{{*D`;>yVVTyH-3#f<{Y{o-Z;<$iJJBGvrj zE(E6g#Wf;hesNi(nqS=8I4jsM?gpNZ`^9|{;Y{1}OSxe^fL!;B`vE}i7xx@e<`?%j zq}(rVAVu%hM{W%Bi<^K{^NXtj)}vqCGEC_Ai)+9no?qN{j*5P9{za^l%P;Qjd_b9B z+y{|qesP~fru)U+k5KoE`z}EAi+cvS<`?%DWV&Bmn1X2Q7teIfFK!ev%`a{yXGOob zqF4XxU=|FDf-2UpM4SCFKz|zp_6bK>kZg~K9;dsczS&q>oP#@GS)5xY8mUT z2u_w|EcLd6Rx;G9wn%ZAg1-Wn%Ok~Q3R<`D7CTPTWs0?Qo#tPrz;}7xyF&g(P^By1 z=ty1Lw(9TD}Qf)v+eD&?l%XSW`_K-o%cS6w_Ep0Q&nQCV>-0mx<{CVD~hrm+-}`YRW)r7#$e~c z-PSE8=`Od)<vA{4+@hdGe+z8&r4kV?Me zPN(eKV`YVXXToXAk=<5C7JP$xDeT_Pa9~ggx#p&r%Yiw%#7x_@(4T+IaV2Kc_Gmsb zS!773+GN{Uo*9Dps1vhETkvMmW2Q*P^Vrvr9~}*AVx!`Mfl?I|H6CHzWJZD$2byW}{5pX4DFcNYSF7XA^BN&Ap7E=E9OkQ6eksLyR8Fp`kyad9uy z$2%~NfQ%*JBa?}U(*Q8&MYSAj^7`PzU2P8qY0#RDMyOkehC^0O(src7#hCTB+G6$$liWN=e4j zCfS#f)s~tql6(uvSx()mj3*GCS1P^^s*Gm=1WF_zZ@S-eVuVMjrZz+yNtj8yRI#xs z7fp8B{8yegQbDCg?M8>we0B^X)M&SQG@!wRVlmmYxqyZcYHE^bC7_{%;&F*C1vHFM zbF)O`1j#1p2tqA(H(m|MA|w>}bO$$X16D?TBCiKxFo`2&qZ}rDg?zBmgML@*vNJqd z>(6^8QMyOac2|D3gqR(k%f~EHAz9lzH8R5EsV!0~5N%@v8>pbZCU42RpzVR7(oO@8qzrVPaEGwGL;4(+L0ynG$NY)(!ujEfRO0@wp63>4-SlQC6RPI zof8h3yfIa!;%1KDE|CEBDcMC^@cSyTSRwlL%qhM3>UFcKUrna^icyk?~t zMY~nSKnorkUTO;cM}Eh{5cQp)dHfC|q3O;X?I~}K;`wri#SEugcMqAv!yKF^uMwUq z8`DWzSJu(N5wi77a(aX=V^>@6Zjys|;)vrWIRVYeO>!0juu#P1lGgt{j3yi7O`|@WhpK0C92UVx&x5S&vjG6UjlM%eWYc5bzO+ z85F&ReYFK<5)obzSp>Sc@(P4Pr$~?KQe1g0KrXJl87UK2-icH+!PXHPUqlAt%5NYC zapnIa7nRn;mCph9#Fft@@x+xc0YY(Qd6xHY$S1BGjVZ*~Xwu0ujngoNPh2?{Q!sJm zSwK--xe_^uE7v2}#FdvK)5Mjn$hf$&6R;+(yaEyF6P38~T41ldxbkMG0T)+(iqrmx zE5FRMg1GYAK)JZ`CrEX1y1QWa7#o`FQEiFyrWg)WnrT5OZyK5gA!M+Mza!EZb9IPD;v@7h$~4h!CGrN;>vEc&$GpqSEF5tD?flhi7WpHz$-4U z+z%Dd#Fh6WQsT;QB5=i(Pasj^%3mNTP+a*($ft=bk025vDo0!y?BD|zWa7#Sq?)*L zJhD?(TzLlcgeR_Ch-8WeBzsNF7_gns(^AnrHCbZ<*vsg|vR+LM)kZBsI=KUDj1?Rj z;Sn^@PSh7L#}ihIepOR4|Y6S%u#qc{+Jgakd*F# z@arxT7~v4pa4lTR&lL$wbBN6MI!?s{qE{3CGbA{=T=@8jG7~%(t>2c@ z%DzNhfCBTVnvRp5aSg&n<>pqI?fsmHr$DbB4XusrVYQTMVxKNesM@%lXO5Ik)p?C^ z5ArIV*BXx@U!r)sEdQs#%LeMa#`ptr8XCKPB7d#%ALNr2C!8?`ck?M`iQ>silA!cW zG^Rj;ve{}RD2Z_<(go#0NnDjSRv@8v3DRzCM6$fxY_d-l1yn9(pfiBtbZO+{oG}z| z7l*>*gbGfi$=i*M;5ZsVG8@oMx#o3WTebbb7q83qw|Q3GWcmK z=``%K(IS46Jb{EprlY0CID~e(Xvi+IyoiVfBh@HkHkIz?<5*eakQ!q& zqO%;-Ac~w0bTUlKAQ@wRUVZX7enO#Z*5V$s55kj*akgyF}qKrmcWR&J`ub zqsHrb`pCI-cO^SjjxKCuba%B`m(dOEJi2(|qQLhf5O)bXSBvp6gfu4|*k#-Y@Lal& zMB}lj@dE^uO8{BPXA#m&c3_wBJiw(io1-*)qDJXnK3+?ynew~5C>aI18q<(WZOW2S|| z>GPu&8mG^+g(VPA$zF^x`{=;TmsL6Kgq~uE!V~2`Fer|XN7#X9&i5%)Vv7H{RirRS zXrc&f^uJ?obxQOXod?)m=}8ImeWGk$3#kk67)_!KELWQnl>7vax#Vgpeev!f8lEG(Re^K9mUq+~INIB^~pWg-3w%BC@f7YAo(rp9ktT z>t4WWS}VX~)oIE4^N|-~ABk@uy3Oc!nwNFp&NJ_hRq&_YPVRMYpPgtog(YJ{f(Ksx zXfF1CU=M?rM%>Wd7MI#L{2q^~be6v7WA8NfCnp;_a9deo7pvEV+MdTsrUI>3N3_h}fd%#={rRVUc0i0OOD27_X)&gNkKItuW* z*`UaCbsX3+UP}jl3$Y>ttdMEEXOdA@Hbksd0WBU1#qC%g(Bh%|a$eUPeJhn~lw?{ElSvPq>RW_l0iW5}jjR;gwl>`D6R3!&M52~^UnHEf1D< zmG>j0`nf?>ZUyKCRk;(18&u^UByLcZhk$rNRlb8n1y%Vef)gmH%CDeqJgCZHq*_pw zecSUqMy6cwRlI%2j~0pei>3(t@gd7LXQHc0K~-);;00CL4~Pd<`3h1NROLHJMMM%AROP2gs4MKCDuOoby0J5MeZ$n5Iq!v`=eTaEbmD>PAP?h~0_Z?K_D?Eb=s`70#tDq`R zB5;DL{0i+(P?ZTmA4^dK~>&^R12zd3$jx-sLH3HC%m94UqYe< zRrv-oC#cGg(C!3Pc^2&|sLG!ZxItBpAaR1K1n%TlpB7ZbLgWTj8HvORs#1w|JE+PT zXm*0CEJV8#RAnXFouDcgqTLCq@ZZm@&W{%XKnX@4_NuC(8eR8!i2 z9hk1P{}D2#wEq=SO=*9Gvx1fO13$%wYxE?0JHTu_-einN2ul08$aSUt3V>W`zXd5% z+P5O*O8Z@inbQ7Rq?*$HHefv}?LUtR{Yv{EU=mMh|67iVO8b*tY5yW0P^Ppm`!v6V zrfEw1@yK+g{Tzh4(tasGRN7yNTvOUNBh!`k+YxF?`>T;@O8XCSX7n9R=}w*_qD51B zn4?0XDLu`zXwj7Z3Z$RWl*&KD$1iM0QyRt1MG2PcR9%!{Nq0=QKTLA0BKJ&oj3(U= zTq&B05-iOZkvi-+AMIm0kK=#7!q1=ysE+<)Z>KH1hf#8c$Ay=4%u^OFL-O1t+0gsk zPIb3SFOQQ<`E64o_0jgW%zvaM>(9r0McQufg*Vr`0r5O;^Rxto+VtBRFBM!)ef?(F zzURJXLxKlhO=&v!eqay7@Zye}#T_>i}{dWZETVTw}BQriQ2?{4dh(n(tRj32q&`hqM-xrZO=wmvTn%02vWxAi$;@Z7@> zbz64`i?%c7!EWmv!sIz$2Rc_na4w<9aaw z-Q)UvWSYnIg~)V|>(?Ws`new0EdV`_>kJat<9as|*W>ysAfCtddyy!Q>yIKhfjqA7 zg1T{!>wA%E9@k$(rh8m}7oqNP{UnElcw9fnvuGaIe?;PXT>k@!=5amXCw!utuE+Io zB%a6hWJJp2dKLiB<9a?P{qne8%Jb?T*Xsdk9@mY4G>_{pK$^$(y8&q)*S7=GJg&b4 zNb|UU9FXpD{Rd#DlE?MmpzXTHweeFvDFcqjbt&3ikLyuLJdf)ch?K|m*#KOR>y;c7 zJ+8$Mp%cjCdL52WZywi|@WjgFx&_V3Ydf#z}j9$?4Zm@)u zkL$HSJdf+wAyFRJ2?U#qqgnaA~ekqUQZ>2dv0B(BHxXOJk5>n|hFJ+8lv zP&h9ukL#ZRTxV{*<&*QogQ}{ft+cAaD$&}hm3n% zKL}X!xc)XG&Extfz+QQe>)${PxX1P1Iqi?f^?;}O3?DO_+?#joXoyvd@Tenza*ylN zkm?@S)d+Qu>!kph$Msr-bU|t!*RMm&J+2dg!Q*;6#|5kmzm@0ESB5{rQ6VeC_wp>- z%JBDr^mAqSH<;aC8GfFd`}Q#ZC(ocf%u9aG=ZUF2%ts(_Jj|z{-SIG=hjz!qddGH{gU?cnIVLq5= zFM604JUxG~cFkg#M_b_ij$UMw11FCzNzXch1n7<#n z=VAUyK+41XOJD~N^G5-55A&Y_YW;>ja{2^FS_)2FY41SVIgSbWSp zwL-=0W9AtZDz+appHV?COl*%9W}i!T$4i9SYsl`nlQ8=NQO;J};3E<^Ta=T>ey%9T zZx5DG*R&>VR~Y>S!Ey;~rx^x@+BxzN>QO2you{ygHp!ERdQaxbgJxBj(YEG1rBz9g zC&zp{M;@}c!c4X2DQc;(=SjapruTyo^%oVCFHcC!verbt(}YGkC{KYj+w5F<*fhIy z@)kKqu{`;xA4I28zC4g-0y$Or`yxzDBNwRrY_QARSeg2y2#>c5ZOD7d@N}7*{I-1a zHB8MQd-gIvsdb1b(@)RwsK1R7YKkm1e|;k47DX*h`$~<_3>F}78zXf63+S&*gsye! zwwjD@!<|Tku4^0RZARoQ4g1?MfZE~Z&claGUYqB{1I7``*K-3ZCCF14%{GxE51}hj z3%RNf`~bQ?i5k)tM!w!0K=&eIwRzccIYRkR2{pPY8%yLJgpwf=Zp{zJR+ud<#tU#m zH|fGm_%=f~sU+J+P-~Ads7*#N&2;2C^bNcQw~@~xZQmJfYr}#(L67F4-seY6v(abT z!V=_jBQNfxBsOBovlkP|Y}o%?H+E*FM6U0BzWtLt8_IU@n7q%KsVL)-@)F(mzc;w0u#r0{ln={rSiX(JxMHRL{-riBLUkC6AV%P@68@!J2s8 zo3G#OQ}#^Qkl=w=Q<{IhAK1fC6c24GiiiHI#6$M=<82liG|HcGq&+Q-2L3ZEo&jmk zYa?VrY0sM?*4iLRY3R3slJ@M~VXYA+P1#$jUY%FWC^3E3<`Gc+hYw3>iaMVv5*-AX^6=sfFRuFWx}t$%Q3P?z;QD1&lL8Fa9NDTC7=qZEViNsX~-GIbZ z2Hgh4QwDtsiBbmLkKhDS20aRObCp4~vpTy3OivlK7?Dy2)dBF7LF+l`mon%Qo>x}}B>-v4pl(2# zGU$3hnlfk~AWa$c6+oIY=tqDwWzZi1>B^u;1@GchNf|^hmf7^ul|l46k26OZL~91z z?ka<-k$B3WWr&nAXfps;8T3XDipn7ID@S`-8hMrXVra$j=}j4w<%yLt=n6C|Wze+< zlrrdM1e!AFPGHAe8T3UsfvpVs7Fv}u=w}FQWzZkExgcfGzj>ZlT^Uq1h}{DUPzH_R zIXq?1OaxP$y%-iEaFs!INL*#mML;}dPzw-G8PtJ9DTA&=;3FWv1BA+;%aHq&LEV@_j1Ak1;q92hrwqCtQ!r)F z%|KBZv=2EbgFcU3QwDtnnWhZ-4l=F``YB*d8T2benlk9mz+QP}kU4};VXh1s!fAh$ zL6dn_*o$EvP_7I*2dS3>v{RC}q$TG%ID$JOqw1XbIXK zWl%lZ9c9o(Xm^xBF|;dXP#S?!2JHs$iYtSzfeL8Kp!XwE%Ao&2;3|VYi$p1d9zal_ zGUywSPg4f{5Rs+~dKwv11|34GDTDro?37gog@*Bq)KdlxL82*xCL(i`L9@{AD1#QE zT`7a=5V*>q^++6L&?R8kltD2>t}>_{iK7hKj&@rabOo9nWzf6P?kIz9Lc603+J|;W z8FV+=U1iYMkhsdA?<3KaK~Eu5%Anr@V9KDsad_0qpx|&ml}6J2HM-63h&EE(U$Yp;`44%EH3@R#vPC{kSnS2&AWl$Y5O&N3%GF=(ef>2im?Lf$sLGJ*n zD}z3Q43t5iLGCGo9tNb8K|caJD1#0H=E|VI0OiV{0VDXWYN)0R8VgKU2F*goltD|7 zYRaJXoE5ALdK1sbl|fmApbUB|a$OnpA%I*NbQe;l4Eickt_=DiVx|oGHBwC(^dhhx zl|iK=`3R2nD}!cY5>FX)9!EuG(8;b0+Q0{tDT5l3Y0981GF=(;7KFMo=mP*z8MF_% zrVRQrGF=(;J%pMv=pZsp8T347eJO(iqxc0>R0dH@xM5@6`Sq`*pLJ#C+-xp0cf2LXSv;5(pjMVLj|*bc8^Mc3AfdOCEvH zmxP@OguWnCGJ(*Cq>0IcKIr80jHF!pfG~n)=)FG8&^u5wbPZ~Tt`-JeGjx?OXxj;i zU5Vc2+8oVLtM!&3+f68K?F#bUgxa`fi0>wJFwbs62aCH2#Yr>thV%GaL!}vNMZ3}r zWf3UN(B%k}X6R}Fx@PEo$TZE+Ey#4u&?gb4V`jKtLptwy40 zhPEJcHA9U^Jk3xFkX&nxS{`yt-!SWySB`q1U3_)eOavc$%ROL`pMs6#!Q= zbUg<}&Cm&^8Tv4ePj8x`J9uKH8M+(IN;C9z1WGgX0|c68=ow(gTr>1XIDxGh`VU%_ zW@yj~em@G@nxRT=E=V&}&GWqKnxUnBlQJSF{0J&ypK2oL`T7gtF!O;v|hzvAC4ah+=)Q((KTGI^e0`6&su14Z%hHe0a znxT&&_i2XqV+x;U=zdJ$(+oX|DVS#H2S8CX^b~T?4E+YVrWtwxnWh;s>i852bIni% zU`;bL29c&2ngQ&U*9^^v8gR`}9jE=#3~k|AK{FHs$~8lmA=NcQdl2fHp?3jfnxUHz z(gmq$hCYFqYliLx44R=wI4(dl^f=F={w3M6s)(qA23`#R}5t@}|D2Bk%45iWTXohy9-O&tPgLX$VbOYLzX6SYVN;C9X z0I#@a=qpeGO*8aOL`pOC1Oitx^eZGvGjte1ftsOzLOxA16j{Y*XHe4&4M8?4U?#G$ zbT${IK(phKYMP-lke#xcp+(RWo@S^HiKZFah|JLpHK5(m47H(MX@+(nAZ>_<2wi1d ziNw(iy$kG`X6Ob)u4d??NF2@3ooKf;LwBRu(F}bJ?T%*X`)GGGLr`$uG(&$z$~8lg3;4*5VVa?_ zNHxvS9AG_ahR(%=e$CM9F^Q)c%5hZG44v$np||h>WtyQ6Ak#EMcOcU>L-!%nHACM5 zh?=3NkZYQu=aK1}p}=eS#WP*g3=K!7X@;h8)|X~z0Z(4sO^959ikhL~ZbB@|O>sA& zNO3nICxEs-F;2wYgwBH-dcQP7JB3eO*0-C`&R}sjAx|b`7BxfmMkZ>D4AcnWaZxjb zDukkDsK*_6_Ia|3qyNZ-Qv9gL8t`Ovgu4gfap5H$!<0|c5?@};(BC-lG(&@Ec}2_N zYKCTTdr>olS8Jilpq|w|h3bRyrR%v=eaEAo_YCTp;08jT0*SSlt^n_v%y&@SO-M+Q zikhKioB!)ILoe8xp)AREk}Vx=(Tra?q{&bMooQ|78anD@Yv+3}(!g%b4va$;+6B;D+9xmoe_MAluIFw2&07(if2MG4_A^SZ9PzGtH)0Dl7JU zzxYl17Yeb_id7p?#@M%(uAK~Y=EA*+4z{sk=+*h80d#s}2bz`W;Oz*M=-~YbG||ET z06XTQgU`YVY|+8j(5gfSk0Y=}2fyUzf?@>I(QnP@ZVRWgWm(>qJtNaGSR_+MmGGBplE_4Iv9ZrLrk7-LhoKca&%JS&I}W&q`)gZW5x z(ZLFYy6E6SfJ}7IfRHXoO?1$Xn2Qc}0S3{*)g1TbEN}x)UUU{HItxUKzfbulgW=-u z)8g;bljZm6N8yHk)W1*Fk}xe3e4y0(1zTdij~(^44#rbbK|JxxFvyzNixfv_1+2!c zSER)JK`JvrH64osr*l0*rqj6{sIJqw z7a8bu9z*Wwbe;yJbUJ?oJLq&?1k80h$GN#knf>hJ# zv~pIkPG<+t$8|dILWLa|uU9osR#DZqj`EGKpoQ^wsQ#l_d^rj3&1=Wa90KWTHK>Gv4I; zBC8bNilUfgG?(a%=Pzxpdn(LtglEtdGNeR;4=B^=>_SH0 zt+`Z2=6feHU8i$1LS3ix8GxwMc?h|t)A=znU8nOKgqlw0MP!;zr}Qdz=@{X_pb~o1 zo?_2C=I9bLosiE(`s0o{uEcEG9?eH4iwx;hn?KJCL2CW>Sx#AbPz|AYOO04)6rt@| z70xa($zDU;&z6^%_nOqX){V5jDo~PKl^kq|?!^Vv$xOP_amt zAW*SLR{_vtk#0n$#UgzJGCdY)D?&XMX%?Uti}Z3NZYIGja<#H@QA6! zA{~azjYV3C#EV5b2a$?Jx)6XDi*y+${fb5U8lG2=Mfy5GS}f8eAT1W@TL5XXNIwKf zi$%I0kQR&dQ9xQO(q{nau}F^qJC$OQ2Cm_gQjbMyA#-Apjzqf~i}W-kUM$jDL@E~P z`2gHlq#HOW#v(nzVv$~o4SjK zC+QC4KA)t|VG5s5(w8xX&nM|IOu>AT9tVm(Nk2ypK1shtuK6VW1)1iP6nGb(LJ$ab zFksCmX&fTWC+T!xue?vvLZ|`vNm|8ee|(ZI=2^ifDGrqTBxRB6K1o*~)P0h!1;~7o zZbnEKq~?=!Ct~iC^hLnnlk^Ra`wk5HzdVBq4EhT+tH7ZDhrkI8`Y*IQfk6kpo6lI& z2@EfkDp!@QMcpy#Okp1qR)MNCgIsA#ekOUWP;k2JJ>rU|`U< zLq07q==F%Sz@RrHV}U{UA=Ltd-h=Fv4Gj7)^n@1}^an_^z@R@z<^%@)J=&eXphwWI z0)vLH<=0-h8yIvD5+^X|7_e)BK~F0W+RX8y#qO1B1R9i5nR7S|nOv&<`V1fk8h3fCUD)UV@->agJA#)!+-y{6jRtZ~JrWev;LY*@W4j|q}3r<|L4GU{<|5NR4V)~&5y zSHHIY(z=zLuKVv4IcqLXeSXv&^!iL&SOVKOPr29GM+auQ7iD3E*qbkFX}zEY6apdt zL2<`#{|?`$MD(6MJTS$bKab-nw-vodP}y;Z5e`cM(*EsDp5 zmvqcivQRC(9(d0(Ebt3WYLE1Jpl;Q4b5djwC>k506k!upyG2_ASgrMcMqfjtbvjq*cz9Er(iH=E0&8DA3CyotN5IbqG4 zIA@Iwb8q4&J1j$_P~OB{*1xzn@qrHOpXg2eScmmD-J3XVz2Nx@|L%7ER~`}9SNI={ z6#asQ|1&MQ_??L@a&{7=DGwrVzeIDYBaupg`%YFqotW4M z!cWMpkm^pa`2C37v$kg1vwlFW+L~@l`RZVVhg02~g>M>P1sg)cL3Nf+Yo#C4XE*l? z9*0cx3!aTk_X|D;q3##F9wGA!jsn&Ff^*2gFZivXah`vrds zDEA9~8mZEMS7i@lAf{ywlC{ell-Lcd?|e=v#X7d-L~HjYKVVBZZYa&q|v zPv-;5{DK!D)BJ+#k?DTHmm<{tg4+P1U-0F~HNW8ZBGdhXZ%3&41>b{A^9%k4XGOo@ zcrI!@$vegM3w{pm$}jj&2$Wy&iwKloaA+U9mqc{G;6cbVzu>XRbid$f2z9^UDuA9} z@M0vcU-0=zT)*H8fp~twuScT%g0~_#f&79ypl;kRcrQ}TFZdnEbid#aAk_VWKgwYt ze!+L~ESg{NJxE-?;IAXm{DKc4bNzy!M&kJe{|=Gz3;qiL&oB5tob<~txa1T3N~tI* zHKS3X?J!0I()@yF0n+?}mjTlJf-eT7`31KF()@z21f=-|e;APN7koFcQ^_y*tI&4c zFZi3t9KYbl(eC;MA4KB$1s_JF{DOm@Y)M zk#0>i*!!Vk=I}5F=gDh?rw$^T>}-oCxngHTsVf9GM&bDM<`+DLCsuyJRcKaz!RI1S ze!*)HXnw($0z2k@!L4ut+b?(rT9se$H3)3K;G4L)AiviR~pCeBTp>TqRzb^WHz>o;D)lle0W3#`f)7w-+znVFmFSK9kBc$O6#xIf4S*Jnfp z+tJpP`utd2yq7E9w8$Ou7Jd9CTHB@niBx*RqqjOG`iss3#5c9ruR{%UzE6~mtq0*T z-T0VEl!4`HQ-YG81Yw(~mfAe`9g%@A)RV!rmERJU0hD8{@z}No60k^t39gBm*8O6I zO9j~Jw!Rdu&=O48)6Uf~21 zF1)F0#Eg`mBnxjpU~`x+y!`^1w($06WctEe=pp^Wr9$EWGUo%opC?1C%ek-HudSc)J&vzVP-KGPdyc6QtV0+aEY9c;W5e zJRe_p8~imsmZM?eZ3=RI;cX#6zVKF$lr6ly9w}dVOCe?pZ&xDK7T!JptjC47J20Vt z;q4Jj;w`*A%~5gT?POng`y(Gvw(#~6GHu~)@YnejG)-T4n~YFjc&i173vYGEwS~7! zk?9L>+Yo9CZ@ZCc3vch{thn$d7T#{*o#HOMeG=_z;q7h&YT@lc1Zv^!+W_>1w;vc$t| zRw30E-ZmoB7vA20P+xd!<*<;2w=B=1ExheU;x4>hgG5_+y8)TI@OC>AZ{h8;h}6Q{ z{Q$g$w?{bX*TUQPd0ssr&oh9ug|`;~X$x;9kMQZPExb(xq%FLi2}oOby8w{3@D>B4 zFT8aFJCzpR-Ue;g7v8Qz<}AE@2<`5|+Z{-}g|~YVsfD+10dN=Ie#Aj>;SJZ$Ugd?i zpX2!Sw(#~_o>(os{TZ#RQkTX?$@k+<;nRgScUH}`F|^U}4qXMyPpd0#`u7V;iPsx9RGnzMoz^8U{A@rAt7fAZnNg}m{|^@Y4@fP5iu z1yZ(r@)fV!u1J>h0-bXQ^eN zTgcmv#9hdH3leQ1?>)%eg}jd-@fPy#M5Gq-?grp3U}WE#y6qX0?#_5(2f5SN;;e zX#}-}ym7#e`9j|5Z~}WF?`*WHg}m1wuov=P&&>rb(FA96 zi+3S|%`I+14x3wi0=cNPwzs^Ta*Rabs8zxHn$j!%-P&x8rq%B zEo#uNHn&)cz}?)U9*MKL#U`+8n_IjAk-ND?3le8@i_6e%Z*H**&Ccc)SE1e6+~WOc zcQ&`U4eie67N0@8ySc>!NZidWzKKNJ+~UW`)aDk?0brY39Om$-H@EmVFR$;-ElNXt zhK=+#w-|+}f16uO<=KsJXiz!%B_wmvSdK?24G>5Q;){417~v4wExg%JCzVr_SCMZn zKUX9$%^@=15>Ab9M5{?Pk0>*`+-#1@GB4n{=m&1O*jTY2V4=~SJQ{|E9ao!1(lK)yurc3J-Yz{>{e zyvF!0avB=DejmY&8;;#2A5eLAe=^XRFf2 zR3y|cLE4R4B+JXqCi`T|0hNmx=nSAZ-G#`p3*S<0*GjB28P~vk@FeBS>ar z8&4k@H(uJC;+Ym>H!>Pk%0sNnxRx^`d>Wl6lcLbY>@<~hnvNFZ4xTzvNmcG>p@NM2 zkkH6OA74^rCns%3up>8w28932kqt3F0$N)h?>}x6JzvwBx4;SvOSFOG^#|7 zI@S1JB&Rz>WP1)F4PleWR%1Mmh=$NcBI8S(8sTbhjB41NoG0gGO;cla&L|(i2Yz0q zJ+l8C;pFp|i#8gM z^IVYyH2KN*PoSS8nyzxy7{5g}S7oa){sL_B6mdO?D!#;t5ne)7q#GD{2(tPurus!2 zVyzupjq(yc9~M*nY$R_4Q#dxl%k2{B6$C5sTv1{?YMjHo1dx^d8bX@M4(u|1 z2yiLQ<|xgcsPTIw)J>AeLjQ?$j7PhSih+CxmZ?&!jTwjrI~l8GxeF1~w~Rciz+J`# zfR|FIQrFSrOAHC!ktC7DW|7imqG*?KCD8Lkb*a=E+4$n8iQ%aM&LGn3Q~!EjwF zI7zU0rrlVBxuy}J`WcrXpi0Or4Rou*0*$amHE}wP-^fa3_r#25D6e!pHL5ymbfdkJ z>@_jtdbEq~smU7qz+Oftmi20Cs5ZWWkWTKv8smE$8sQN%(9Zr9Y@mlxE}G##=jkKE zXhdm>{vORVqOq891kIDn%%&!zq>PXMFlt6TZj46r3@Rj-XlsfaGZD?Df^4)1(R@)+ zo2>>mT=WawWAhBZ5gtR(X*quu8!eh{Y~f|~sR3)`>6Hd74Q5RPb~z$X19m+}M!0NH z$ZT$=%|!Ubii{4K+p{seej}0b(w_E%$pmOik~~>vh%C8GG?Db@nn#RgwjZ2ngN7zQ zT1+UKZ1IEh#ED|!oju%kA_GbZ$t58l8SIcV{h3BNXucm!bkG7nnnuXps>FA$*@T=` zA|I0t?#Lu-{UwS9=LqGg;&KQ1>rqlhsIzH1?e~J`Dj7;h?z7?}V%Xz}meyR>_&A>` zkrEomY%JPFTgdoJth8CRzltR^#IcTCs=1lIEoe>7cS>rV2)mY_4y0COs`9f^n!1U! ze}9)q>F|)5q_Dbi%Gd6{KbKCTGUK8t@rL#k-4x&kPWvQL$yBh|-GL z{zPXyvcz|!zIoZVue?+oOP=xTF)h2H;rxDua*27Tow~rozFJ9NYfzHkLcK=k_S?l! zvpT&zgVrctamR-FihY#~$EG!fmvX$CSx~t=kyhzGKk}S(Bn^3HnmsXL{@UsJt;)XH zdN(K;XI*^5`GGH^KZ$+XLh`ydUAt0+XFQsd9!*}o!d`9tCHB=z`SX(1%SiVVZ)by2 z`)S=hJswj|mcHj>{C04%*=AM-jY)}JtX`A+R!W#BEn2;k*d^kzI|03h)9Kj3u|D<+ zFW1jR{ij`qz9TYFMR*FIP5d_c61@(hZwI5yoJ+4e=WcL97X`~dACbEk#O3Qz705yT zH7h<(!9YZB2uBPf)Op>W2${w^CVGQcO~xCgaf(XUCOwlwowrK!8Lqi4)gWFJ)>4jr z5-mVR=iaaEv39vu`yF4X^T?O?Sg#vMdkm0oLAFJu zJxtb1m950Ui}WsNH9L9)J9SzA=OPm=XwWo=Z}17y8OS)g{Z>!k^KT?r$UtdR{9rJx;UL?#kQjKmm?I-I(*Q!e1N7ekc zV@~C!tg~FB-R@xLfs{2-oGe;fON*Ye&x0rqK}b6l6Qp0zEiepjWegVIu?nz1)!J!4x`nj=Z;=fcvN z+3A$CKV>~_TXr~>eJSfHVd-$w+?uj}W?NL68&lQ~gk{^dZO%B}*KK`g0Cn!x8prTh zoAq&#L|*4k(T}C9k11QDV|y@V-KK2zRw>khDJwa^4cZj!e4yKE7KO`^bMhTZT9=A^ z)JtkG4koQj98ZPqs_27L; zYqf1rXWgH)R!Iw$?`GVWw9Xess-2o?w&PE@>^ZEvopdlGajT z5w}aH`g@bsxsFNo;*oai9LJAfM3^!Q+*%!Kw-!rNt!p~iZk;Vn>UKaAz1>9p%5Y!1b*3^s}zO{yMO?Y71U+YZgPcegcK*t#^^k#1|0usL0- zvLEiYMoP2YrOJG$+ZrLwc9$yi!ES4~U5K(g*=-H8^DE1NZfmHWRaqYEw!#AjP&YW+ zO$Iuftd}BWP_CQ_;jSqj(*m7uvVO^S}xCZCi_k>~AcO$du8>fTj?qZ(lJ2Gxs zERl{Hb)0-Va<;rpwip``R0*)7#b`hUj)-}!1gUv>YIg*nj?2UyP2~he(HkN0hG!hs|DA|;5vgeJSD@eJ>3!NT> zjgL$d24@n^ z2#4eRxRyF3no73q@aH^xu-TSP&>At;G+aW&E;JU+_|F+0?s7V@Kl`M?W^*P*PVjj% z&vR&Fmp|u1l`{`JeXtpC&X5ZXRyQ!4MkG8i{dW{(v$~L0J4PRGURKN zMX~Y7KPOK$EQ+m^5VJE+i8TVn$oT`W6>AZZSYtHn^LvO`B3>TN1^-}_i&hDD2!EfK zkF*h8w!U+nEPIZ9pWQZjsKSHDv`~f5Bhy0_2G;1`cd+N!aD*&W;dG#SsKT?5L8!tD zkb9vD8vvoHW}$1tHk zRN>b#i5IHyXB-tn75Zvk8 zC-YUT<5v(1RX7Qu9;&b!AciVjfm{n!_*!IosKNw7EmYwyWLl`gcXCz?RVYFg-po72 z4OO@g?J88^=Ml^pXr|iZEyh<6s8EI91fYj1{1GxORN*to^iYMrL#T%;{3}2&RH3n+ zPiJq>u`(oXsKSvzyikRck*H9G^AMasp$gB2y75qjbx5^Pg&UCRp$cDzP!Cnu%wZv+ z3NPbXv`~e+khq}=uR@}QDtte(|7Y(!z^kazH$Ia~E+vzYfFdYT6tDvch%AVTfPw`P zu&x+WZs08TuqwO~iLolY5s|hkyc2-2DtuUyc3BlZCHr!#!q)*Y ztHL#am{nnPioD&KRbg*H%&M>e5VI(iQ5;fJ!ZwkrGv!`iAaa;SVa z1U1L<5HPF4zQESIRpD;%0g(|M?HX$@jB2aGLlAgYg~!QoN>+u(%RU?3s&IiEPYPCr zXUQJMs_+s7+bNf=(pu{}1c6oIok#+!!pDIatHM`-7^}jMk!Y*JZxI-)!py1i{*+dQ z-H{5b!v08=&!1~mI0Olu3Pnn+F-Wvk;eiOaRpC(xmFu6jDx3*WS{2qK6;_2OBUOjs zi_p$R23CcaBL}O(8<49(GpoY8fg7vB$B-DS!j}M{RpI-{Lso@ru!Xudes+PUqx%6{ zgscjq)8t(vtqSviqE%sUq&FK&4gTO-Q*_;r$4?RpCH?3j1MLTNUnxz_%(Kg>m1iaDR;ZR)y0s?pqZWVO(1kRwB?=h4TSy zaI3;aFaTy%xEPVPD!c+gU{!b{5^Ys@7lIV63jYTEm{s9wM9ix2Rb;}d@B^gGs_<)M zo2^x0#$n=Vj2f%Lu1J_wVQ*x@bB2vJ~F zI0uPuRalR4&#G_%hJCBTGcoR46<&mK->UFW827CTZ^3wARrmmsz^d>mB+RPt6=d3~ z@IwH?s_<(G*V(GjK3v{PJ?Q;fG{;LU<%{Dz)cbV~IXC2B2V+&Z4Wjm0749gz|EyMp z1@g1Ns&F4kQ?x3aEPHXQ!Wn>sRbdsvk=m+oo+RzFDm-0w4p|jmj2x^AZ$M7ISjK8F z-?|?-S`|Kv9IOi8MJ}xhzX2SwD(rZKymO^hVK1bCRpE|E=(s$q!aa}}tHS*Np;h5w z$hlSFaT2y^Rahn43#-Btkuj^n#gesQRd}6j&8!OVLE>8#K80~(Rrm&?z^d>IB*v=n zzlelYVb+oI`hrzqFNssID%?T#;8umZBl4^Y$6d+B?of;ytHNSLzExo@#*J0s zDS)(9;S!7+tHM7a3akq6K*FsGS0N0n3jcwGjKN$JLzR^HAwpwS_zfaqRTw!+T*4Hs z3iD*IC|DKtMI2Za?uLX6-pD4>bE6!MP+JvF0>G^bk4Bc~-T8h*=eWhKyMit_5bS3L{6uEz!1BVV>*~ z1*^hA61QnpI99e7R)vQmV^)Plzyhnnc?i^7f*kH#_q#I?(mfei6#V# ztHRTO8mq!(NQ7143Z%lS@L{0Bs_-?0KiR7AW7v~#RrqfVdsc~`GZ3t!RpD&dpSCJoh;iSl@B)mh(?eE;*F#)b z6+VQJTNOShVVhQk@5uJrs_+X8dsc=2!LVml=**DU-?u94jo}>vtHNCo8LPrQ5izU6 zgMh7zRpC)`Uu{|ymdWM{0*TUAg&osYg^@rt9qq)d3a^#7O4_PW zou(+aD!f&mA*<`t(XO^la$8y!V^W&jr=p}iDk`jtk#FMDvQO@l(d~(m%IMV)Ah{NS zxb;zpjPOXl^$nn>lwyoJ&9*X*6|Y7b!&_OQ$+KnM|cd1uS0Ea=+|uUOz7KM1OEPX4_yP+qs<@XPWWSz z`r#U{MA;{Js#t?mW88sJ?v;xVpMxXFn~#-X5XdtsfTJ?M4c$pQA~AFF)5|rnFz# zhz+{UA7xM4asx^3H1EcQ``2r4eiJ0$_PQz-ycm-=OwuIvzOe7qJBG)#Vfyj`n@63oN|d&Hd)u>V`$)Cj2c02@5jjqgke%dkBD11SuP$U-1Ti)n&cLUl9ZCRs}tpf47_%L_IE|NHBzT@~I?K^kod?(8fdGmUa#G?7mo1MvC z$}bxh#hq*Nv&pqzR)O_CG8!12Gh$R+4H>yidCdAzqLs?|QTa?c=krT|K2yqD zE^P#qHUiS`BRjgO7yVA~!}re*&b9fNqC47y&&5SQ-Jn2viyYeTVuRS z0p&}UvJud}vY#{pIt<~C5nGwA%p%{cs+vY?CUR~BbOJzW1avl1VFYvqQfUNqD`H^; zvu1w40xFOfR2Tt`N5+hR4nwww zYZ6rIz75L|awDJyfM^7C26AQubU89^1hfJnGXi=D88ZUu{B%+OgashB7ply&bBcMUZxDil3LT&`KCqQEav_F!qI@^tns(koV zB!Lmo3?Rk`XciJ}1e8GV3o-&a5ymEsfX+n9jDVIR<3>PNBIHIuH%OR@5ztE6g&6@o zgd{KmdIkwI0(uQuUXsO0(ubG=41r)1ROgz0(t?NZv^xv#seduetCcjexpdByZNh2&k6?X(J#tuQfi?pA7lObD$oivvXV`%eP#zFt1hgFxV+1r5i8cb-3xP2LItY+70y-M0Fanx| zRJrK5MnDN9ff3LtNVE~qc?h@>&@zO|Q%4&C{S}}z0=fsOFamlUsX7GT2?SU;qMnL;wi;xk}!Pr9GQ0ma! z5?n_DMI)dRWSFc<+HByrnD zKu60C+6ZVShP4q;9RlA7=tPYBMnGp{+&2Qc7~{SX&~l7xBcR(5Xd|G90Bmq0pl4tJ z%n0ZeMA``GBLsmF(7%yrBOv=ydBXawXyKV}596(VK?v>h^G1hgB{{uyrJ2~{^_ zG_uXs2xt0x^jesu1xG@6y3nJeL=q`*KBcLY$X(OQ5Fm8;1K0_230sRjNHv;N< zg}kua1x7&qkZ>cQ!3d2J(4L5d5zqmWrf39or0j)8KxK#nBcM7Y+z99-gxUz`901%1 z=n7=o2WXuR?Ik3P8=s^VB2m15m1+_<#`uIK-(ky$woj!VNbph&=?GRMnDH+ zm~3N|-A}$X14&>6RDmQg0%`)njeyQVmXZQ`?$%vQ{&|+ZgVg$5I?yF5Bpc`a+Z3J{Tgqac0V~C6q(CZSVjeycdKzvD^8v%VO zZ`;YpE09?ky&e0B%kYFk>ld~WvC=j| zX&a%mjZoS~NUDFyJVGgXxtx@oYUsc9ANBVb-gOe-$$hsB-o43wqHe<70=GS3vuUFC zf%`pQ+4Xo@VruT1_XJy#F{wSZlv}c82>*mY+C~V^u{`7JeQUY7PuBg%&;@71Wk0so zj2PMm;dbhKTJJ5<&BmNOB<8D-=zZ@>z7;&@qDPz2WV`fU26#{{ zA8tz|c+0Q`smAzg4o6~6Z~M+@a9m~w;`)fsp?lE`JK2VJ8B`nZCmKuIMhLuAf=zwT z24^cE-bJBbV{Jyfw?nw4x(URK^QQ&a`y#Zv^}|BD-AIA;b2O>%<>xxgl=dqdu|c=_ zqwGmrZXn5>=G~ZZ|9b7snqF+8pf)0Yp}d}4Ssp|b`} zlJ}*k=}7MrV=9BTLAXslMf;Yw@wbED%?pct(3MTw2pPlA;L_8%RToM;Z^>fnFPu!8 z?%Du0LT7hzZG^~Gr@BU)bp-#nbI$J4)4qj9V%K}tKxcQ^+P+t9CtO1y;=S!h)%IN4 zu8x``P5M*zQt#91E30ZMsOCyM5qy;X!OmIQWm~)P&;Cb}PtnpYeeILoZKZ+mhOxBE zK+n6#-IF(zrCoNh&vDyT`VFh2&gEUmu4cAtJ(Q6+fi`KTGwyFTIG57V*>vdErPR+% zC?^{`Hx*ZxjJ3(W(L1VGZArC0jNt!v&W&BR@_m*PrE?3c4vAIGQ3`I$f`$3RDZaWn z>U7M?)uu<0#H~$EB#UN7=cr6t^_WEx=g)UC+z`2k)Oh{@uBFmPjl1l&-QOA$$&((F9fh5ViLrKxjPtIc@4 zQXkZRnw+PVDb&2UKbV)BoTpTvQ3qBxIZvuUgAS}}a#ndhQn7OHB1aO-nw>|wbTJpb z+Ic|T63W5o;V1b;4?7sW)sUIdwG#D;1Zq`&G= zT~!|Lvx6d@otD_wF8;ofpaMd%nFZ=mP#0Eo8`a6CcmeS++qaWlR5`OEUWrHvr#st; zq8f3Ok)ECHx>-ui|CBgQcA(~e8RJ^b|1JWp=KmalR`Y)cfUEgCJjJh)9nEBF{;tTl zntyAAT+Kfapi%P=MG~m_MRLws`=}YGBy7~WL(Yv zdxTuge}ROlsQIsuU6`8xIwXObe3zz5otC5S^$BXKjRs3Q>E4X>T4MPox73M{0?59*3|r4$;MjE zKM=!O%|8r*R`ZWVz|{PQ09)^B{u%HAo|?ZBqgu_s0D-6GKSzdBQuALS`)qVI|BZ4y zDX97Hl|77_|49T|&HpNbK+XR#l0eP>JrJYj&sr^BCsCv3?}bFG`FB8I)cm^xl4|~O zNQIjJP^3x<@2dF=kpyb~3M5+1KOX^C^Pi4T3FEbze0_k*h&7HUFo;jhg>EBu35O@mYEGQO&<4@{pRpAGQdo`FFt#s5Q}dsTC{XiXjKo*-UxRT^&3_|? zeKr3*828ouk73+b^S_93U(Nq6#sf9~8YF?5|G!9>n!n5Q@*&C5YW}SN2sQrz3D;T8 zpD*{|oUV2O?^pn*T`IJuS0H%Pja@2bWnC%UdNavrsF3LS|7e&yX^Lh}iL} z`pS4+typTwQt`@ackzy&?yT-^`>;!RR!;)7EL9Qi(nsy8juv@vo+@hqk?PXoFxZJe zMOAr7FcHln%Wl;r+1{vrL7bL{k_>uJBINj36ds(Tj*~3%!<`)R_*SGe2_lpGcv)3_ zO*~c;8oNXF7vizwH^loS`$#=@VZYBH#b4Iz@Pjw+V) zoM-p&P*r`BZt6<80}Pe2j%E)cR$S#T`tn;Mo80ti?DU6tcpT(PKD(x(HVo*fW>=S! z2`AhWR^}Eo_A=$VE^o*@x*RlS*N**n@-B|%k>x+#VJ=&WjFrP!j*OSXxDz2Shw%hL zQ4ZsEpu8N$8e~uo!+t^jzVBwrVe|l`%V7+HIF!RE04&R4><3hq!#D~lD~C}IjF-b` zLMF;#oQ;%~!?;4Sl*?hyy z7UeKTB4y<;4g}U>IgDelVYnQ|JZxghVVoyXx*SI61r^=2%3)k7FQ_PoaVs+V-Acdk z+}G&eknwUDFCygSFg^l^>D37PE;q=jCX)hf^6df!@ibr;(MUGo+P z*dhpZLSYwfr@p84-csm*THP>dmrOM)9_q;zMtzTsUT(?%tnC+M%IWC`bK zzk#&hz^}(|AbYzkuWoW_yf#SE*FV@f+hyrweaZ!)tob9OPEl5lPOZ;K)H&0$SlW8E zb7&T2pzDnJjKn_9fhsV!Xl9X{XB|nbZE_~5P>uRPFBN}HlQU6;O1%{BNaCX=XI$3y zl&~M9*;BUuXqD$bd$!JypYDuOfp}cY7p6FSsGS52%AFBvJK(dNVOcEk{UB#>mY?{( z->3Ymf0D%a`I(WfQMM>Bdy?b2lNeo?zDN!+IWSBB@R z>~1QYB;JGKWi@1yrQTe8M$D!Uj#G~*;+Sk@L>#rtw^}*Cum&fbGC9#Kitk6h8Sl_5U%Ewwn!k{`!9qp1?G#IhVNKcAdC&5ug`gXKS zORRG+tkVTAL!i?IuSdYr1@8j3-qQtF!3TKhg8#s%P8a+HftN1$gAAvXF6jJ|KW3y5 z*}5a$-1XskXPZuJrF-=Xlj30p$BxH)Dr)acm@aP8z8M`m+Ej_KI#yF*Z7s)>Lb~9N zvWH0*+yjA57u*j)kS;hKNsulW17gwz6F^M5;3-ISy5M;TOuFDQKr&tMuSi9@;5|rH zt{pw$4c6mGf^@-`k?3^64-oKl!LJdj%sZVfnDLpsrDVEbE>e*$*axXP1V3GHS7eYb zI0`wW3r<9?2F=n14+n121xt~bbio=xm@c>wc_>}*_t+woE_ea92&D^Nfh|P3;PpT; zUGNU%kS_QTa+WUm6f%}B_$o4)F8DEEmM-`;B9<uQYa9M;zn=p5Eh0BrCa)^A||EQd8?jeI^bbPj7S zf*^;r4-%cjx)XvFb6AH%KbFI~HzJn9dH^z!!+ID}mcv?tY_rW_Js!@4$zg3q!g5%D zkIc_uy%6Jm4(l}-*Ey^=BM5R>??K|{us#BDmczOlQINy>3KBnu^*xMxIjo;!*w118 z0porSYo{;eGnC`!ux^QQKZkWYj0ZWaLy!bHta~D1IjobA=^WO>0f-#d5((EihqYSn zuk9SxChTBxSkFMzz8u!2vb$V@#(8fu1Fn8D)coYl$kT*++Ea49FG|S;wB=$wL$Zy# z#TE+J{m0f0CG|6mON+Rj`kvN%OSZ!{f81meJothdF6ptC2zTKUw{y!&ddZ0Q`f<;m z{xR8Fr)I&cOY~?nnrxTp|$Q5fCEvk6SRjcPws0W1#g3u}zqQ#{|eh_+Ko^yo?70oHB^EpqMSUDwK`-dG#TsY6U)P(h6oioq5 z#6UT9R3PZGve7xs-AQf9?810uLZABu&hJ#1`*5APz&X`#8fQ(H zFK|wA!-4zOibm&THxk%yEpK#AawCEN*0M(DL=_1-UD)U>RDqz+IgQQ&6$rX4YIK@a zK#fUTb}d@qG-ZuY9$i*>j|f}sqwp?t`shYcw{!v-Rjcq=zO@h;`Mi2r$gv(cA6kCo#|Vd=A6 z_ApDI^AYH!&odANOP?1a36?(p0>mtR-UY-geXc^Hmp)%aV3t1L10B93;WgXKy5W>2qfUeCcx}LbZyhmp=CcD3?B`BNa=Z#Yoj5_)DMF$YANS z896L{o{3xynk{|)5x80UT#m#neclcTmp=awd1&eL8Eg?+`g{djgqA+v#};Dga}7{j z`uqVoEPY0M$@?mkEq&%8V@scXk;$dc-2k(t&yk4O(&v7_HvH1(bQpnL`Ye^SJxiZ; zvMVfoo&;1beV&7qFMVEykS~2+4^S+9-i44JNVfF33b9=Jd=W4#eZD7gDpr#Jl3kdU zmURl8*smR+8@k;#QJB0Nb3bBr~^>Hzl`{?262{ zlI(@?z)Eru5@RJf0ukN)rL`qPtw{g^E6HgRq^%^?ED}q`jBaEr$r*TkGHJb)vQ%R= zMJ14N+B3s0DzawD4tjCE9>aQZ{v-tc;`|>l?k~bYihW*9)w=wQ7&VP<^e{uc?jQfl8owk(^P)@Koza^4jaeg}_ zY;k@FGQBvzCjhZHKS{!MUYtK%?yv2|`4a447U!!GwQq60Np^25EAcehJjhBs592y3 z@lpgjD{(mjot1bC0G^e2A2ODe_!u&tmH0eDo|X6}K$DgD36dZy@f##TR-)BM-m)eu zF$;;#O6-N;7nGGa0LCV>5{DpVS&5^N@vOuN2zgfG6baKtO=+X1h+e<7quHB?QPXeb zT`Y{6%8@anrY2Y7LA(nv0>P#=@4vUjGAUjls0PG)Qy_v z$_pxtnodW?jGF$4j2kswhmadJ-3t(nnw~+iaV@ z^Gs2CXz~q<#$<@tFyUlBsYOX}4`lW96YR-(hg_ZZi8@h-Qp0t@tyG1nw@{T zwoP@~*J+mXhH6q8FDvtVUD)irq)e!^6;!qJqH3XRg!H&pH#^U(BzC=%a_2dc9oY4y z)~=KIUjY=RROotZgp59$MMqEag_@a-g{4#v`?3LiX*x-obOTuub@2)WOBW-%XBWF@ zsG9_{kN6Dozv)ZJB?ll0l4_1X!jfuAkp)RL$0IRGHO+{0Qq3X&CaLB;N!pcEbBXNB zlWML9#FA?62gH(UUI4_BYCZ+Tl4|S&_(iv)EU9KIKrE?dC?K9xGYQz{lvFbfj-4mf z%s}QR)y%|rkW^EL#3a?6f=DOTECmoG)m$M#I;lo|P3p|1?>BN%&2@NvHjj$(ZKV#~ zE>DY29eNnUI(29@0zY-=b&UI|L!V&WPaXOe<9_N;hXdvN($=X%c?fjsP#*vrJauRn z7ywHh8i7cs4vj|;qz+9*qEm-vAV@KFXcqKisYA7hSn5zSGLbrTI#QN8v=rH9n>ut2 zoC%XUbTbl`I&?oWKXvFyjQgoW|G>CT9r^%4kUF#miJv<3J;Yh+P=|x$gP9Yg4&@;6 zQ-^wD+)EwW4#R%x&=8FKsY82W+)o{vgmFK0=x~e&sY4}5g4CgEBrJ8P37JkEIs<@6 z9a<{kI;Rd@E%(=U>d;Nt!K4n|hp2t2Lr=)=DM+|pkUflq>pcWo!u1t`K*D7oEbl`* zkZ^SaVkBJK12Gb=d?Z@JwKoDI;W`+QlyLnPsgQ8Rkt+R@E8&`pB#>~OibPAe79-#i zt}75KHI$Zc-3U-hxb8(NBwSA*Rfph9xc-3*BwQaN2MO0V$km{kgex*xUVJ0r%0pr# zTzvtdgljkCAqm$=Y!Q-hjl&ip3D;z7AtYQ!0YwQ{DRPi-RUu~*u6f9qgliEpDdD;R zFq3dyfrv@CZUnaBC0zHy2&9DTDM{NS;d)(m1qs)uK&6E1JEUB~)$tH{Yj4dZTw4MZ z60YqL(gVpPT=|HlglliWAmKV#;RhPdZ6Bog~a=88?+A;TPmxERuvjK*o}U zzeUEAggYH7-?n)?NqB37B1w2xpgc)0m~%eB|v48 z@N%RqN%(GHJW2RTWFkrUb)+mwc#UK!CkfkA<>l(xH)5C678TaUVx`s=2q8&$5OSU* zJQ|=(5B}ob@u3b|IFyP&Maiuf zWS3}%tsQ%=OFjdVsrFS}Luz%`gb^13GpVCTsm46zY-CQC*DrIBW5?%OU1iwH%<9^~ zE-Rx7^QB^h(ViXbxwR#3b_QQ-jP`cp)nU+|0G)*-U3O4i+;ULiUPFjck>D^G?twxt ztwaoAG@+u(nc+VBs1GVBuL_T$V;4edx+~PFW3EqzhtXC(+C7Z=_-I5J4J72%uU9#U zeB>Q>CFD=&g_wK5^);2l!h2K)Tt_I$5cl;_cpROw2qjAAR)?=ur*4GYJR%%LCw19l z@tL#gYOP-KR*80^>sVV-R9;(>WRLwkmLDEsC%VKX^>tNcWrayEKqopnWr3NTcBZ4K z8Je7Rp<6dzT@`){ciEzYU8$ZD>Q@o2Mb)J*?K7qhC01BbRT?U|W@YBmo@vLi%DOlm zuXr$Ww{emCh;A>>kb2&8?UKs6nsU*_?wM;B$H?O|bY(NBeZ00L$rz#;JqT5nR+ok< ztVJW#t0q>a^1Ngc6WQNUFX}=xgfh0xwX5pulI<{KfQu@s$_qlJw<6T7y1uexRv}ew zs|)QlvLj*lrIZ{GqZ3k8RaxE`?l~&gF0YN#>Bob}>_o)dX-QE{_%k!N2sphB!`=Jl z+GRCW6@|$=5AiA0wF-Uk9=c}|wo|ShbIbE#uZ&&kN>x>dZ^MlIT)*a7=&WXpB$T9D zU9( z(Y}GEB0AYyT3PmB`lDm;)Ctq3A2r2_bhICl;E>4^4w^9CvOC&uN-$xvx*@uBw7-?{ zBXrzTekIc`s@QJycUC7mQ-A)HL#Dg^BH6u3;bPfVtXO@O#(#EBZ%1ollq93bD@Ebd zE5%E!u+Ez$pn?m{POTquTdD6lkpziWYMe3D(Cw;gHY{p(j(7IfkvlIGTbw zuxP$h?x+&$YJ@Yjq-SBXGsi^rr&ERYnL*V1JCtfZG&v;>iEN714(7PyQ57|cRm>H! z=-3pe$e~&trh3G2YG0~XVRcQcw6G#pROxr0=p3fHQFW6Bo z`soX7a}xdR1jo)rKf{puqMtDs4@5r)ATgq!qY-J*PX&NL^fOn2wCD%t`!}-a=R~|d zY0;1J3qDhx7A^X@2*X(a$T00@2TVNPN-H z=NR`yKWj1Ui+(Z}%Eu_j7yWd@xG(zYi*aA{vn$2}(a&#?1frk)kTB8DG-O)za~uF6 z`l*m`okc(M_k6#e8Q6{4TLkt)TEEBZMYNg(?9EfOvIi6h{m zpScK?enyLaP6a4MKZ}tH(a#k~)gkyf0yiQ9(a*ieLG<$kay4is`uPWNBl`Iei4pyL z0|-Swk(1;-&>*Q-FA#Fk&-W6xF8awlMc)6u=%+h|wdkim0xkL(f`EyB#sFLI zqMrld13b~sF&NdNp9%z?=%-nRQxg6BLH60`qMu9Uc+#SuwCHCO6#ZN$?_wePxd#~& z{XB(?i+9;p!h zj6f|<_=vWc6CurS-d-wCIP+lDO#S z3wf)gML#O5EXqYc-^nv%b=^%RkCB+D#7&4|g0I}&oL-c%MB+a$6^fm6LVZ2t~0ybr5A zJ~WUa>Y!C_*sPeBF~>h}h&n!ZER~5QJ?Z!eCOI!doIWn9Jw7QMq(3oy^h2D%WL+Kl zeqdBRtRO&;)}L1Oglbu&Yh>v99&R$fmpGfkk7-qpdB8+14w4d>$1K@~cZyA$u#5*p zK1^lds&u?l?@6eV2Z9IQ#Xsv-TGf+Q^?0`;yG`5uqkir1x5`hi)RI>9)C`_9dHSTu zuB^ebef`jc$)3(32q@vj*r^blGIhd!la913+gE3hI>L(hdzdzE>e%VyCXSypm3R;v zcgR%vLDMFUpD;y+ri|Zrzexv8Fx{peJPlf?&sBpqZPZW>Ic&NKjGH#LaO%EeCm$$7 z(>5~rsHK}?|raxqos(LPwz^Hm|lORy_JSF2Ps(K=eT2S?z?WuaypHnfi`M`g6 z&e_h^UacF|q$p0hp0}E#6zy-KOqdc$%u;ZufkpHuNQcBnZl94}Sj&7mB-Xg$ef)5t z`w`T7ErtI;Dj4wrmDD+U|z!CAZwmh(lh&0>CmaVKGpdm+&W~EHB|sU_3A3abzMd;Z>w8FX3~^ zQqD{GQTCI03EeJ{*Rm(%B@95$^AdgoQ065Zh*aby9E()uB^-}f-|yeUySFCqMkZqv$3_(EP#k(Xd!DxVT=M%oP-&r8@IAdkb0o96p5Nlq;`uEvEuP=<(&G7Q2~Mrtg_jo3cUoRr zJYOxrC0|-x(!$c>k`|X1m$bIDxTLkE#U)NlON&cdURqqDj;n>G#U-sQEiP$gY4L*A zmKHB)ZE5iWb$rQ}7B6URY4HN5m8HcC+FDvPYZqyAKz9O1O?&A{XY*4BSP8;yTAUFf z)zg~@H~Sz1t+e}7+WqO*Gf$lTx;GnJ5pPho()iELd7XX}xs#&7WUQJ&eVyLbL6l9# zdK0OyJ3|chW@BkCl{)R=g_S!~VI9r7E}|LMuawD8-Ec37BO@`(`Ij3Q=B0yVB#v{w zbOQx@_*1M$I%~XuXNsJWnBsil1w3!%jKoCeb1&efn`9*RaXxbc`CgYuV&wwopI*ds zG>#<5Zs=1lqOF$5Z0Hj=@*DSqBZ*}ToR8gr-phpxoR8dq_rc^UwIGG*-(zl+-*(LO zZyAzc`nMJdoBmyhESUa13yGQj{Uahh{d+Y4GyVHlN!m62yHfV$)4!_#vFYDe0kP@d zF9EUX-;OKf`DN3;+X7ED9@@#)_fu+3@uw+fD(PyaR|^QV7L#&|IOdkzva z{ksg2p8mZBKrsD#uLSAo-(T4D@1uBq($l|c&bX>3JZJ3C-?WO9CP6f*6ECZ(uZh#I zZoI+{%{Nlrha|Jm4*k6vSJv!F_E?}$2^AFx?QSHIlH#J;ke`0kQFD;B$^aibWvj`1 zWwRfia?kGJA@ZybcT*Gf?f~<{Y!ETGxIyT{X!eN4P6i0!PV`s!?3#+&FrcHFU0oh7 zGGJwHL1Qmdk_x#Vkw=$<#_Vb>o|AX6nErhi8Jqt78X2Gd&Adte`V!N>TOkzFzdHft z)4zKngX!Ock(=q?VnBNOw+7-c{o4#!PXC?6r1b9q6<^sjY`d`kHAZyqu}{kt7PKK(l!AWr}8 zhn!9S{uUXZ{w+tyrhl7}vFYDGNM?0?r^V^tcUqqQeW&H=-*;M`{(YyF>ECx+p8kEe zh3VgSTb%xVx3%ftcUznOeYeHw-*;P{{(ZNV>ECx-nf`sZmFeI2TATiTueIsl_gbF* zeXq6Y-}hRZ{(Ub!{j26>I|MVjYJ>lmWSZ7Y*qWcj+%C@b(l& z`?5WY{n`?o`nBww`?7oZ6SiL2y+~qW)cHO;M|;J)Q=}`~CuBNtRs5c`^=JfNOud>}mFBR2Ou5YO*xwcdFHY)R1tZn&Up6`5_J&aVC zv+8Hp`;)P&RBSubRPUJV`oB-H zAgXsw7X9zDu-*q5^*^7@tnBNYXS0QGy_%tZCVOYKG)v{`zJ7&&+ab{3wi{gXKO|ex zVU*TaR5V(hUWHDSgIwyJQLCF|PiK$RM{o5;M3>6%H3$)1j0QEnp$O=DxP7cqNNBOM z!5S~3VJH3-jhUN=d349FU0fT6A~|7T_v~U94OOcr)?{(2cx8bjkpwgUF(ho}zXn+_ z^S=OznfX5xk)HX#0DzhKUnWVrX8y00efiA)U4Yok|5Je2%>TQ9*v$WTfY{7`*Vp(1 zWJlS||3E-&=6^3heCGcMV4Ks-e-RuzpZTAI%%AzM$9ORFe-aWi^M4*9J@bDJfMDkT zMhVh0|2R#$krTh~#Ou?M>>0_nQIu4T^z7`tO0EBs%>#?fXE3fUGG9TUEi&Inpe-`j z0N@sxKOkcknbFtfD2*HAN+L;?A^tW~f3C7s?L05X3bY z)`cK$M&K8MxF6$wA&4h2?iYgi2gdzE5FcP%7lQZ-fi47Ly&>=34PFQ$8wS7%LG(nV z3qcG*5EOzKjzkxN*c(BLg&+=qeykA0VTf2Eh~tonLJ)J1vO*Az$Tr(T5U0VJFoht_ zN5Tq0T!G9l1o2ml`-LFx#<(s7u?j&@2;w;;ej$k0AkGRwe1Iq@1hEE*UkKuRjC+M3 zI=m^L*BrkPL>|WdLJ)m0?iYgC1>=4ph>;i%3PDUj5)^`%ii8z{C`6_UL6id!g&-Ow zT<1a%zmxlGyAZ@;>|hE(EJM`3LJ&8|?kN<4xI^|Zg&-b5pbJ5~fFLLY@h+0xyaER$ z*4IExA&AVkQgsM^A&9$?K_Q68kV7GemyoMLvqBK>12=^r zzCvOOLD+B0tB-{sx*`u1g4h~cgbG0n#1^4K5JRzrCDa)4>=TqI25^hD%=#3 z66+XbtPsR(WU>%M17KDN;$%du5X8B_Hhdw7%V7kv5X6m=wx#rM0dop5JZ2#PzYj(#I1YokCBa|zUTgd7}lQq zMqA&;9c;sy+9wLEw4r-!8)`dG0?d`)qX2 z{TJkT(w_TiZTlvuZGTtZ#Ui=!Yh*0BG4oydUd`jljXe-@&;1<{isZ&oKzVZG!N?%F z@mS<0xv>_IPHsFI;*i|<2f#A9@hYG)x$$aS}k8-1u9hBDt{=sZ4G>5wS>aT!NG(H!cU( zVshi1*f5;j_!2fT$&Ft~lumBk)RP;3lowPaH|D)BA0eLHxE(T{+&By&Pi~w55R)5^ zK+cjI%aQTq#wLU;x$zIkSaRbs$x`s#ze)Dsp8JnWl#1v6yRr-O-2VYcJ3aTie;}`4 zrsui8tqi9<_tT#H%z!+~J@N3K%E6b~j!^}9o zM}myi_5D-Y@F8T(VDfy;PwOe;S360x$3>ZZB7RD@Rz5-B5NEUeO7-4OQb zW`i6@+OeSzB1qYm$Aep}S$lrur%3P8^TclT2+dQ~O0(dyvev1_xc>-#L_1ERcPQe- z)85PuaKnt0QruhL@UD+(llH=Qbphc3dLn~Qdd+o|vA z=V*C>d7skQ*xR+WgAcU~HU0?!cO>3(vX)-R1!+H^v~T>c$~XRQ`g=L4Z~XHT7~lBM zBnW)tGwEwR+f$0Z@uS^dnU<+{;ND=7?BO|{RHc%{8cD<|!*hDtr+pi-NRr^W5Dm}q zZREAMqeJ3>#%Rv)obBv$RXb1A;M%-Xa7X)MH>jg4PEbvU*q03;LwIsWq6yCqiIpcr zow6JmIw13hjx(ALoJL^XjA0UZ%(EU6(X?d4mux&KP79Z8yoe-_Y`lwvNjBCX3nUx= zMPeiyUDomoNrTXmjV%Be$wnVZ+9lc8QTFAMjgf$uWaB_UOtMh~h)Fi)0%DSlvj8#4 z##MlrWaAz{T(a>3u+2%b@g^KQmu!5D%$IC@h4DbLVSOj>$P6Rd$VH?j8`}d2BpbU) zkd|zyub1YBga-o+xHVHz@)&rpht=QGqJ z&cOVY=44(s*`3xD~%h$ckXV?-c%V*dT z7|&<;4Kk6>Z~#)4&oD!>l=B%XWj|@wbRt5?XIPA!=QAt^DDxTaLMrkZoiG=E$_py;8LE*{9US^q==$NE zh>YhmoQII-Gh7W2^BHbO&hi@V%<4Ky{r#R~Npe(9%S)1@ za#~)J9F^0`lH{nI7MCPPN44N91+W|3i*J-9VA%Qfay@X{wmYHhVFf#4RkQdT*skrg9h4dow?~gPF=*oa5Wgo2lGo zG(WqTW^G5Sc6!oQxy&!l8SI%Bxj}LO>X2COwjCkoa%qCsxhsc^de~g<$`hOw?zAeO z%Oy9U>vG8R$js$lo0BEya<5TSvt}-LSq|9&nVH(l+)t4+wNyy-Vlz`afeym_!SDRh zpQ$|r!|qJ&F(R6tsr6@S%fxBnGqu%7f|=STBy6Vk3}nGf?NTIWruJ$?dZzZT0L)D7 zN=e!^Q~QwY%V%nz1H@)(-v`8IYJUL4W@__t_&sVz*-Y&YfY?m!7(i^M_HaOarnU;$ z<}_2=2*=K6YEMSy&(xlU@nEL*k4Vf+?X`&XOzph@f|=S!B}mWI{=#NzpT+Bwo~cdG z)cRkrHl3N;*W_I+W@%c2l3JT`MoBn5pfOCm$iMJlh5tpQ+syA)l$;3n0$aPC?FQYGcUwOl<-oo2gxd zjLp!#O|Z&YPnk~!JlxjnsU)tdNhE0WkJn$tVCw;vhmh9;^| ze=iiPuJwXbRB%TB4X;y4u>?zJncu8CLp@mW!4=UkfhY|wQ& zsdDGexm!~}Tf0-?&Yfv&l=iE%3mJ)OD|?K0D7Dq)(TvI6#cM>C_f&OF9gQyKiVGfoHVtNqw-Kg4-0Sv1WX$XKNo3sX_9cYe>-HUh z#_RSoB!SoMS|owjZDcEXij3E74ifEk+Z(|z$m@0o7@PFEEkMe=ZpR?wUbhnwaK%X5;OGOhC$kq_jMg6EpPe(AUX|*# z=!zoFq1Ca;`n}gMlorM=bR&KFTdxC^IabXEdciW)Y`Gip-{NKY6j|X${5PTdzElUonk$s&Y`)x()yXM);xu_ccN|Yg|4bMADTtBD&9U6rtY%6!G7+M_So4_{k}NQ$wdDX9k{}8KILiBR9#(nPE~nUTA@A8v3@kaL_k8MA1cpN!*Zo1cs$XVONx>X zRN-2I9sENecWjE$UF3A4Ulz7%s4u`or=tp$#>;eMALpxFS~sn(s?Y^h*3NhS<%itM z=9Y!|QbiKw!{|GO`t(TRqxsGnFIEu5s8GxoUMxR|t)B0^t75hBO7&aQ>rCZf-ciAl zs#+7IYA|oRz0D4(#LQc6$n1|Q%)FT!NNysD3r}!f&!t0}Nu_D@?x}vvYbr+j)*&hz z{;CS81mU<>zmy7tpWwU_1bvB5wew;wD;qP*c{Z0)jLNHPDlH{CqRQvtVk+mQqPC~d8 zfJs95vn1_GLbyrxi`Gm40gdTuc62h*4SQ5enKs*WI zSYVq|62dGvcAkV#gUnAtI055962j?7OcKIHh;$Od^#Fn-gxe)ZCn5a8k`Nxi>(hbK z<<$4ecvU5LbBbmR&9W0ittVvrXhu&8=UXphcpC~ASRY}y4~5ICYVxhMNCtSM!0NQ0 zd~0Ov?2%zsPau)5S?(9Ny2fg2M`T-N*_Cu0is31b^i?cIKFbBzYakICpS3pv8id=W zu&TTicW7lgG!p-$m5Q_0#XUVG)L5bCXadmnMYOS*&o<$$* zj;pjV-?|zheYg(`tXn0tGPk4)T~<|J6OYMqPTi?jalZ9`vVF8WUD4tK>sbub6)h>T z-oSAGEGl_ueU4!|j9AS2ABK0Joz%t4OJi2f{_^T~A51&)P#;9QtAToKFt9Dud7-cV zNiM&Y*^8imkEAk z{aAgW%!%@bjdabhD{D)t3uo3?xyVF)p>2@%r!rR5Gget@?SyQztuM3(oC#B3Xgm^D zU+7R|etn^1G49tFnuBp&U#I~=P+#aIBz}FNGa=6E3tfOHs4uh(iCJ>L zUtj1!jQjP4p2oOeU+7hg`}KuB!gx?$=o=(KeW8p=@kEyL`)j+t&^YX1>I+Rl)V}&cGi3J^>I==3JxqO}1Oi=O=u`wjeWArjg8D*N12Of5 zZUbWK3q6cP*B5#gfvGR_CLmc~=rg3EzR(XyRdF7-zEI}_kAc1+MfDCRkAD87it13>kIuJDX%Yd5kg*H z=+6K}eWBYB(gVrr3q6cj))#sfFw_@%Q{vX^3w-s`JU|81|>U@yAYa_b8&{hao zeW8KC)_Z-SVekQ7eWCFf)%ArAL*UgHDwE-q>I==4eKvZ1p;P5}Qt;YeEPHUT{p%%4 z#cTg>vJ3Ote;r6Wz4pJs?w;5Fk20LDrU^+#tL9PWKCO(p#u-~9W2%;2 zka1PZo(Q@B&}4){)p8tAu4<`82C9}*kQ-IYMS!%b&ma7mlRm*M2n5yLw$n{vpnl1(2|NjZ^)BxX?QlelVZZcD@7;x$3ublQl_P00OOjmUI8BdV%ow1-`kOI$14u8SPwEpL0b zh*B_mKl!^A8{X|n7rT@9vHX*hN2y_wwiq=Z;_VT)gU>YwP9G;W*7vsAc{cwfEE{AL zpGaD$2SnpEq|FWQM7R&O{xMl`CC!41CwjCQO}0z#l;c6Qe7G%<;1$6dq#EPZl5iyL zIElgCWBSnETHY`trKhF!4e!L8HtBjz>3U7-H!a;b?6>ho*!l(6YwBoUO7qFAF3r>l z)21Ia#fo&aZQ~FDZ%Eg81HR(3& zMbzTgg6zI|UTr7(GpaC|BWT~eUQD1yO?8B27Lz9d%dgNH z@e7-sBUrpz$IoeY4p(tc9cJ1uYIY7|@u2;}W@oyJQ{HT8pgUXJ9Ar(=tnoIQ2Sm+~!aaz?9=E37MU z|Co*>mNz@2f}mF0UES>bCJ6csmo+=X^O)SO!5NY#<#yF!x!qfB$?ew6gSh}-vi}3d zwcIW`A3A8cT^<50x9bgn%k6eRMn|pXb_K||+-?j)F1MQq(8%qkAqnJm$07;jc5xs^ zZdZpy%k54=@C%aLodsi)a=QzWGP&JV$hh3@uL!x^?oJ8Qay#4i{QW<9Vwl|SX(WN% z?o}jAZub$gKyLR95+k?EI6*$rL3K6A405Q4UQGl4- zt_l#7+noxC$?Yx%#N>9j0^)MJr+{rva=Vw{*ty*9ZDhXO?o*5ha=W!ijNGnMle}3o zwA^kR0D;_Ypaf~Totkvvv-}&mI@=JuK5fYDM#=VCZnr;%J-OWx7!KriGm!*xySYdL zx!q|%xZG|jvXta@S70wKxBDxCb(GuP4g1q_yJs=(%k4hIxG%T+FT{o1u6wh5Ims+iR_?29 zx!oPIgO=Ooe=0f>k<^*!Pu1I{j zT`!D#a=Yy@?91(jV%(S8jlsAtw>tpizTEBzj0bYNQY3-g?sz0jZr6-V%k6#-K*;Sb zlyIHpcGt-LwJo>189Nxc-TjE#C%1c2c27ZW_oD1!n#t`toFp&4k=u1cV&r!H z0HNG&F!GSx?l;&XB)1!nEkbg;L$HOA+Z_!Q<#sXTAh)YV&g6FUkuka5>BywqZYf|U zx4RM%liRHTw&CS=_rVCH-0o>f+atGoLv{tZ-9Ld!x!w0jx!kVP$@13Tn#=8a02Fe& z0SM`VWOBO##8Pgz4`7hnO_sQIx!p0cv6kD-#;}&#H6YM(yWb&Ta=Y_^t#`TImGA+c z-0l{PYPsG2A@JmOFUW98a=Q;?pN%fJ`&y1C1-V_uDe^A12Re3DWvrZ>sJD?Q6}jDT z*@emN4g%6nxm_uC_vCh!GMtv%rR8>;pxmxO-o>Jb)al5W-0qLaxZLhKgj{ZSFG3-= zdj=?%+r5JfnH*&j9r^;82mfQ7&ILPe=0G4vQkwB%~?m(nWZg(s&F1M>fCggSt zkutg6V#!jL+g&aDNx9t}2tjW57;-MRdjp`9+pR$=DH5gScAL7~?tFPch1~8>$e7&j4rE+zw+bPb+r0u1<#zu> z&g6FXY4Y(I#N~F~5Hh*l0Ax&Vx4UF%xm{Xr$Cr3J_3U8Jjm2lqs;jm3lebD*ZWof< zO_66P6}jDP*@esP>JhCsx!pq8bNl6Xzn6PR%k5fLtQe6>vY(XN3v^BxB5e!(xBjF4 z9>cp%0zAEq%6j%hJ;{EeZsrK-eBd^Q)IM;(tniE)MeuoPxt&tCDA^i6E9+s~oZ__H z&cC-&@n&x7R!DHCvev1__;Z6FVbpSMY8KOSJEpj3P5QN5s1RFgxuMx|bN8(KkF5

E~$qiS#B5i<#xqIC36aEOUR$3CRtgycwRqWbyr(L zOzi5hE*7C3)UK~ZCE;R5GuS0ZL=tgUT!&hk`afw*iSpIusRmonwi;~B zyf%ujJ$|#Cn$pGBUck6kgS~}7tHC}+pw(di2Ef%|_AT<`GwH~+8q7h))nHp8lX9zqtV!Ja{4)L^e6(#6+40ASQ$Yb0rx8ti-7m#e|L z+$vuOObxazAf^Tz28gM_CIMnG00`7zKT2R__M@7J)v@Zj;;Kqnrz&G;7dug09x_GC81Ba7 zm5DGKt&yh}=Tq>JPA)4fiHCjGB2-6}K58iLP%TY%A(P$GcuA~Q_`G%4qKi$noC<5} zifY2kcOB^5DXPlmgw$SxXpgF*V@rJtG*8w$la3-zUu0V7oY~#SN%~ru1Kfj2l*cN? zu|&3XkG`}}ozl*?iHDx%-diuewuNl3)nNTG?5V->F&wDD#v%#SV22_J)L=zGxEkzu zWGSh^=3_6d23v%nH8mKWgl?*on){u13G~e9N36hO*8q!j?dF$s^Eli)DHL_P4fd#2 zW=~+;SDC$yabIQjEyRV&EcdJQ;;&1*?Gt|Tb0=|I1@%?b^{WoGP?_zuQGcS#>7Tncaz~eJZm@WcL(Q zW~*fnqcVFFfmWG)jv!E({Rc^)GRwYG-iJnI)(41DneB>1tIS3rFe04U#}*wh)O{nVpS*tIRGzs03SDWp*t}+JgUW0+a;7q?N5)iUCnJ+8vvUD6mDweTn9A&0U>ja#wh~4lRc5OsZI8Wq2$;(3Y+&nMWp)XCfTuFM0i#-Fb{_&yW%i5=r=&7_ zOZM65Dzne!cv4WA{YUoTMcuZ%N8I44sLTe-E=*;%ACPvc%#OwGp2}>N45w9QX_eU~ zs4}aOcd<~Jos5jB%+5!~Rc6;9@{SdGW!gyd*<53vAUuGTvSn2?s?ktJ0e2es_QFDW)+skYwJRLjqFIchTi@y;9+z^ zimEEh8^b+E<=W-7aXNH7h|Eqzyq%V)+=vk0BH-%RP6+qSwaaR%DhiW#9^%vDhH%e4 zbk8Jgr(8Q$Ruc;kH)B`2QdQOA-+vkTxi%HuOP1b|F_KV{42x(7I`-PeidgvCrj>o9 zc`&LBv0=i=e)3gxMg$ZV+NG6!o$QUF>{C|}uPWarsa2BVdC8+#QqNOiVN@l=@avD; zfp*L2@#y2k#`@kiJ5MYB(#k)-c$#^U`ENS!Mm6Ddp}n7{$lSWi{n#Gp+O;UQYY~Jx zrImlGoM7m*gaWPx(R)tT(o4R8e&a`JMlq@Kudf6~`8QI6K>0UC#?#8bwDND#vC}6V{_9l!O}{_6@-O>RPt8|RUtSk4t}1O*e=3WAcFv`Fy?rI0 zEA{J;ShgVQJfdpR&GzJT8HqaQZ>kL4oH_2FycvmV=V4cw=hbt|NX&8`QcAkYdivY0 zsymnT+%=>FCBQf2%Ij^U#7?+Wl;;e9+ z_<&+6{B5C4Uk)sw)?SXD*1i<(iTQ&bry1BfJ>1<2ZoK+-vYESd{dU6SpM z7KW4-A<3ZkBvMmVR}>yxdYy3-TxWb(+}E~PXM7$RTW5S98DD4oH$uM7*y(NlfYB$4 zb;hlM@^!}Dkik0RUdYWl<1|2eov{Ssu+CToSgtdk3{rZY#3f=yaStx^&83o6zbzeL8?88hCMPtZWV&e$Cx zUuPT$5Z4*^K+e_~4?@P*8D}75>x@;%*gE4v$x_G~KUelJS>wwP=&bP@5d>M|_aX_h z#-9davc}&8VzS0RL!z_Be?VZe#yh_!FQv>H-wLV78Xt&MrChsNt1o=&bQW z5b&(=83~=)4I zsI;-Mu%xc2*m@SA$QpkWAw7^RYy30BGHd(?z>qcG`2%s=wk<>5N_NmP)BzaQGSqwo zz6^CQjQcXw12OK)P>;m8FGG!CT+2{v5NH|d0stFahI%FpfXPsoBGNL{YY+r7)LW2f z8R~rqQk0=S2K|@}^?5{0hWaKlAw&HHDU+eDMYh?>P@^A;r!i_|sNIn;8EQXdz6^CY zjQcXwQ5e@U)cp|zGSown_%hVrLY&D^V~7G7Y84V+hT4d6PlkFjhJ6|8IT-h4sFz~g zm!V#ZabJdd2gU;#>i;1LWT?*~VKUS=kZBp}rvQWub*+T!EJMxwNZv|4=>1wWr#h6! z)I+^r=hT*1-LQj^q4q`8J{jt+vb$0yWs}`oWnEDT%%Wxxs8l30^_j7yPbe9+EKK`m zQ!cCOH$r|^G-IGo+5uqE7CLDE-P~PIaT%|u~fD_(?dmoGKSDF{W)%{ z7U9Tjd$zmBW=WKM#f+nHRn7xTYF^>) z|6$-+ojEVCUO-Nl#v7mNKg{|Nd4J6b*I3^HcGT``;9jO>Z||8mpOUor;XED)k}OU@eu*%G{nlN6pX6kLgDrQ$N$X zQMQiuqaoMNq#aogAfYQ$KeNDk7UT5LP+WC+2N7M2s$%+V>nkJ$J}I#5PvjNs_ZuG- zs$F&k+MjL!cb5e&-d18Ob4NPZ>Y7+dRYkRYMEh?+!z?bac9A`z{ndFWc8C8PMD*xZ z)LZ*wct^Tb=+qsCaXMOxt5KIB8b(hnb(xFtJ>0nJvIx+2bfBfwYs z(@z((M0GkA87*e23vE>)=-~m?X(6&c{v}Yi&bbJ8Fi>^A5;@&J>KUt3oo`1-uPzN$ z=SL;CGWQ5x09EDEIBf)-aI#WWe^tIJdqqdk&959i34MTQknUAreTi(a?p9#^2U!2@ z)bpf<*zuomOYBKQq!(BPyrf3c_=*ZkX4TKOwv=6>qiK8|a$f{HOKfHC>+Ml_tMRw% zUTTlAB5Q(dAKi=It`w)i(SwbQ-mV^NuwuaWp@%1?cG!$Sy(PR}Gp(}`(mm?@!1>oLvHy6>}Q)GRGgie!7+?_@~6W1lWcP~R5 ztR6te>b>S$LlEWq9rNA&?v0p!%ebGaaDz1!@ZNM%>D1BJmpMr2jpPz{xAT$GW1?w; z^?RWEsNvFH3#_Y=sFR?GyVqNhs*~W;2J2CvW9ea->7^;mw%$TGgs$@(^;J`)o3f>T zljI!<(v>5Y@2P#rVbi6j_N2)WARBJk;^0FLDv*(B)5k(5+RLQLve5+G@ze>_Zz^=0 zGIhd!la8e1mn=UO=#c4F#2@RlaZ|@mA2)IQq^Tx3X4<%MhfI|pG;PxO2~%V!Z6!Wo z^GGO4C$J{TX-qvSw8fSz{dC=b4CPp|k7Yl$){NLMIDu8j4_e(Y1z<$g5>f*g(&mPj zo$8)B{iD}E`4;^W(4aj(CflVaY-sfeO>%iF&4S-ctaYj}F73dNXvawmG#aLlxFon? zMoRZ$>l@zLR&BhW=z^}@GqmLm;0(I0@fq+VNiJH8ZM~hjPtZnd1Ba60W?M%|!YkNQ zIO4q>!g2K^iPQ1Z0_^&PcDH_5Xtx_Fuzrpv^}YODhndoTWg|A|Hh+{oY0C{HxzoHG z6YgKHy?N~<-}bsH7Q7gfH%!tb^}ew0)H{a9wPE`50h><@k0x~1ph@z+6wR=*hj;5{ zTecM>qN^EJ{AcG3@77o5qCe0arQkpo+}-MsSmj1{Wzi87UF}APxxXOnO8OIz3fFW< zyzE9t@n}AU-)fFJtGn?e_gT&}-FTAwan4iSC@X!oPI5oed9quwB=;%K6C&=eUt}Z> zavoRVAjy5Ab5FNHCZWCBxl8Rm?zb*?4(PUpZI_o;ReD0^NMgl&igl$}bxozKh>j%g zS>R0S=4ZJ-^++cB1C`=lmitR09L{oIF+ZK-s%pZi@eZZ#DN>pQQSNHItg5~y zPSauP_bZzmh&q&39gmeKNw#+=EibOb^hx$upioJ55;BrVNpVqa*nPlJsn#_A7hXfl zR!0>}sw~Lv;URJv2n{`3=@HxkdZG<}SlNS!sp1XcUX&zDW2Z+fj40V~c1=ZX7|>D8 zt}ds=1vq_H<`y*eGUWs#WfysLIcUtTMaZtjm1i>eh4AUy#P7Sa^D}I%yK^psmO9KM=G=2 z7a$f{?u(JKEcZVFYcb3H4s00Ca(@Avm@N0tBuZzwhh9+8O)Ja&zw&~LEcdRD$wz1) z%X06BjAyy$Bjj1`;{alo`(emgmiugEJj;DPLYC!z7BZIQewk!xH?6dr7XM6uN>WD)D3GIBcWp)ztI>!C7o4eM4Jxs|{w zBliQWb!FrU?0`^4ULdl{$lC;wGV&RTRYttW^&MA~r!rE8c|sZKLnM@uVPr}f8AU3T zk!{F+u*%5pI1^48Ifz6kBU8viWu$@iP#HOfb*qe=Ob{s}XOo1=$R(%?W#k&7NEx}A zBveN3W<5|w{={;qj6BJDsEoYAdZ>)N&w8kge93yGj3l4X@1U-cGSZVoC?iA3tTM7G zfKo=b(QuWOkss;x<$iM6Bu;S3NEK20l#zNpeT^z3bM>~MjQm8?Je84i^em~2TnVI< zk=qEjvdYMPnzT982Pqk<);vj9f%6m62a+m{S?KO^;W~$irkp8F@jo9LmT) z^=P4t6fMEyr;O}Eq?D2UL7|LPYMh5MGE2{p%E)}8Kp8oi zfObYE zF;Qx7Q$nYVY)hn+k%^k-sf-+=XHgkR6GzHOGl^72jw7_n$e93A8M&OyDkC=&2xa5} zGO3I_MF?f&4RWcBd_f3hq|=k?`sS&OtgB~9Wn@Dlp^S_n6UxXAU``pCsEJpSTNyb- zPoXkWr*TeYN?db=QGU1G( z)}2z<^z5GS9qCH*z=v5C86T#&^@0VdU&?xUSYNUrb!E@~X1qT*BSHJ&+2YnE^HP`h zG#RGmrgTkZrXOZdU$h`~S*Cteja~H@$EGd~OLnavADcSAr;KPdrq1grBU;l_XZOq& z$vQlBmS2yuSNo+-?x~|(i`BgFpeLo~^b`@TxvAOyEE~~kNp;AaAraA9G}qK*M60NE z*Hm%OFrhVC-6^IXB(%0x<#%ddV*9Zv|c4v39Zja zMMA6eS$)~sOlbAzz<5GyOAc`ft$j5rB(%Qo39U+fK~+NQC^C`II-X1>w9Y1!39YLE znb5kOTqLyqLM9VhFA<7_)<RI*=erXjPF!39Tj&m(V%^#3i)OBC!dr%LrUT>qa1*(7KycCA1zT_2W&M zgw}H;Q9|oY5}VNalt3o563?rTykwCdcCrbrZh$(WwJxbjXl+93A3~VW+L{artsjvi zp>+_sztbY2RSoVET1Sz%gw{eJCbUi`k0rD&;D}g4>q?G@CA5Cc5h|f|CnytI50WFH z^;dF{(E1yhNNBx7rW0D91B--K;st$wB}GE38`#=UXswGq&s3>XQm8#T_I(7IbsunDb4ShfkR zX9&WC)@!VX39XM<4-;BnvmPe2I{i)GrwNO)`?TI&I<^@P^u*a4By+Lp*Bv?dZn z39Um&Y(i@aL7oY%S(qmhT62j+LhA%FmC!naR3x-6Ci}rAw64dQa0#v3Nkl^HL9#HR zwT$&Jq4hHBHlg(%L6p$?j3i8GeT%wCXm$F#eq(lx5?Vb;!i3hktOp6L4Ok8nT4Pxc z6I$b04-;DZupTC~4r4t^XiX=H5?ZrKL_+I$GMmsk6F?=jF4l0B6I$2l_2o`z{f-k{ zLhFx2?MrAa)zjB#LhEmOTS#cVqiLQAtbg z(AtF@39W<3knozS|UG)ibKC5aMRuaLNe)`vh$ zXnjL26I!J&sjHteq19K9R|&0+$V5VGTg`GLv<}pxMMA5FBur?{X5A&UenJ!_w9Y4S z39YM%R6^^wph#%luW=p;t-tCSGNJVnQIODjkL56-^(E^rq1E|ib*+=b!i3g9)?Gqt z6p&45ZO^((XzfE3CA2C@WJ0TvFiL10MfWH)<5)kmC*WMxsdWuLVv|cCH z39Zk8T|%qdtNL{Bs1jO3NL4~>G^k5x?M|W+T9ZjtLTe_dN@$%(xPpY%h+dhtRHl`6 zLtWZtE~5VvT}SllA7rI!O`2)Hq*)#qEYI-cSjYN>b;H68Gh%WwwO6mQL}J#g;NiOd zqm%dSWkN)Cbv9YmnA+7Z%!v9*)uqPw>gYdQ**;x)dTQ%lolWkj)+Ud3Pi@i5k2AG| z4`eQGeQ`l*j6bQ?K5MzyB)d`-{-~i; z!}~YcNXu%yM0c!mV1~``$_Pwy%$(6$ub%?(sMFFy)T!{uXVI?W(dQKw@-Wz^|RGDMv&CwEb&+kkA;=})L5>a+}4N1fgT)lsJ}NJZ4C ztcU#kNhD>|X%Lx;I&DfSqE0($mUq-?e?3n}ooWaXb!sJ-QKwS@b=2t+QWbT&iBw0O z{z$B%PS25wsMEV(ZAP8`!-4UrQ~#d&LJn|Ir*e%7QK#>F)M>oFpepKgAeo3d)sV@k z(`-T+b^0kFqfS337g48QlgX&ly@Vp_w2VwdonF(-|7B{&MD_Hl+Isb*lj44+>V2vQ zo8Me^Ow?3+iC+3GQ#`z5Vy<~sir0-`0|WdgIIT-C%3o1seM8eMZxgVD*`fNTbi8L{ z!hDnIgU#bT8^*$$roQ#`g~qQ%=98z>%U277z3x>ZN>?5Bnr?=XVx&F~hlPM5us zQh%H2sm(1-v#a&fv5E(nljlD??pQr1nJ}Qfd3LsiiV29^-KOC?0+? zv9ZDF`kJhBi#nQfP&K77ZBF&6dVdNzw?fXXt(@D>^{rCKxy5pBSL!pAN6zgYJ;UYP z{z71LZht3;a&G@1iE?gVfw-JoS#SNh?Q(AYNo>w-0|J+G+X6`E+;$;VIk){u{g7BD z=T=D)<=keG*qqyZ0-19=nb41n*__+?fI8=PHL1$E{g%`}gfQoJKN)gve8k3=@-wu~UkxxGSSb8hbv ztW7q zD(g1q)=UuP+>Rv)b8bIHUF6)(B8qZu7myIk&z5D(5yr!&T0?mFxB8&bjTt2`=ZhCsF%y zZj<%&HJWpqqPK;dTcf6V=G+$OSu*E#I*`h_T}Bw?+^*N8eL1%~_2gL2?J;uX++HF_ z&g~;`=G+nk^!;6ioLf(FopT!r9Lu?Fi2*w2Hjy;SxlJaCa&FT|T+Xc(h&i{D$YsuL ziH13IZkOrtD(7}HnaH{QQL`L5x4-MrBIou#Ntko{hIN;7>pD^ zIl9qnCF@(3s5i&qGdx7jeCz8o|4(j= z{iU{Z=JZs17h-*#2bqH^Z}x6teWc1-z2p=0b;0DO9`M)6AMu?)A{)lReE9ol@ZqVcA^K>S}Kk%freNH8tLLEStkf zr@g&c-oUJ+rM9jn?Hx|EnORYQ>WH@RcQjzffc5gvi}|B>mdo#z^fxd(@^W?P{rp4s zPS)%4N;-DylxVGLQbUXTbxO2MPq$Qg=jq|e;=!E~jniwrD_9@iDN$9|INiH}V1rJH zhFR%p-t7dV%yy@k`|SaMl1`lx)eX%p<}b(I<7C}CC7NsNGwgY?{=vKof8y(eX8-(& z8TcV!(yVpvTz}e^Bz-$2jy~Ea9fqkpESX%lQ)1pcpL7E$TEA1GHghfpkeEZRHRsyf zkicAn`rw4~?OfEyApeZVz(5212Uf<(Fhl&!V2b}UZ01^^n(Lqux}mA z<;d(>hVDRW`Ujf5%dm-LW)J=Ikb#p3M+Emp23Bh5l@xU=HGk1+PUePE|HC%%5Na&G9)K_+(7HzDc;QEU3bu^t1}|_q+JCZAufSUSW8g?Od9u zs-HHiww}oIx>N_L>*}hy>dLlSVpiK=b*)KS-?T8)0@yGSj5BcTc89_cm$mC|F(8T9X>pI}^3GaqS~h=lX%}+LpTD z`KU#$lTv4gY3$66R@Ay*>SsY=rX6y4>WpBLO>j?6ov2gbEvXayjJFGYH>QqZEPTFB zflp7(?zKsj@1CJ<9fJlKR8`U9w{f0B=EuUT$}{W~&02bm4d!{55NsSw@~$TsmYLz* z&bn!DX}01$sOs_1_f0=8^tUYZx3rGM_ou(*GId|;(D!R(BJ}+!nGAh*7_Ps(c9)^= zK7=aty&CF7#amWJBLap^nh^vA{a?eHN$=eP2Z?Lf^N8$_>JRSO8XFYu_`yuo_oLq*!w*=Io?}?-;^nEy~4t+NetI+oeq$2cv z9$1^9?`t?P9{TWf_*gueUfa$ceDjr5%FJoLS#-k&^jsuT1Kms6cYU~{U~1W``) zD3U0rdOV2Bsh$nua;jI5*qrKb2wYC}9w41leT-D)R9_(VL!OzO>f0nyPW3Yqn^P@b zU*BUzGN;;|(2soDoazujom1VEROM8+CG`&>%&AT!Lr(P&a^zIgMiClWc;Az*7ir@ATjK<8Aq*R(x3)xGsp)j8E#QkheoLnw2qCjqLQ z>e+TiINQ@uyy+&R_9^aPtzeV%2TQ+<;l%&C6DdYDuFmh~{Fn%Yp` zs);bC+MjisQ(d3H=2XW3to5AgPS^pFQ{9uu=2Qamz7a;l4o zL{9Z=GL=)klyq28qPDrZ(O78S4P-yqoa$XT6E3IvFp0>iK1~+pR9|I1%&C6Jy3MKn zhak$SmTaWoeOR3G95ms5R;sC_xr<$C%W z&8fbtw}qVQ7n-7dwIn@maqnv7mChg0qj@Of8In@KnkyA~R zBd0nCoH^B#$&pjNh+OAXZv>9zRPV(Aol{*#8s$`%lSDbyk4Rij^}j&Osdm{!U;8dH zr`k`$oH^AE^mvt1-I`3~RQJ>@M^3d`j}|%A7LqWhdJ^j{r+OYylvBNi#N||PBT_ll zKY}8sx=iCda;mTB88WB(0a1`s{SV7wPPNl0eYJn^9d9gxkb?#;T( zsUATT zI)p^!R7aDloa&CCE~h$~MCDYcld7ERd{C8BJ%@0mbE;QhO<_*;*DMD))jzNtI*B7|h=2UwVtYS`eIM!!#s#~!h=2Z7#Ja8pXIn@VQ4sxnbv+Q!JZxFeh>c5CYPPIe1zL2Yu zQ|+$Tl`E$@SPzeKsvEIxbE;zrY)*AY0-ICa13>0f4|JIn{?qMNV}YnaruaNGNlvZ)^Ai$*Go< zb?cCrI<+=kr{n+0ejO5XnyZ;>O(q9r>Wy(Q%z$*AX}!x3Z*l{FN=uXJ1s7+d4Kw~h z9E=S>Wjv9a+}0oyyN%D;$=^`5-!YE+(6O^Y{$CK|WSx+VjibIH+9HkyhiF_JjWnpa z+H5S2Mi~_TjWo80nFBV@wU5V>JNgIgKk`1yF76zn_yz}gqs%DvPU#HbC*EKfPdzX$- z0e2GM521cX*6J2lV-9OQ%BI#vf$HlEC-+fE(brb6am5P>3!rPRF zCpHfUnQ-*nppW-0y*EzmVh4uh$^QH?K|Z|R)TWsf`NyWk_bt7*PWU^QFz?g)=0>xE zBa>Z!YhvOD`ztVQyNg@b@e8R$bx_F6EpF}S7keh=WHvLi$_yLoSNbMS3@hQd4gKnn z#09SE@8ssm)ZJ!w)JnX#b?LFDV$POr9iFM&W!5LUiyxD^%b(@0Z)S6q5#JE`{m#XgY{jMAyK+NOYYvXh7oNKBeYbl$)J5ozf=_S~pSc z7mP^eH%2#wp@~_ULWL0Xzq(WcGTvu%2+ z+4P)f)8;OiYBqghrr>XBcfT++aaN`_W^rYA2T&%^O-st~C z*K-FA3hz*JcP=uH!?}Y7Cw2?g+M#uErZ6;dSh(5_txFarQ|Avdx5SLlR%kJcra!wi z6Y9J!R|H%2J8_ybJSN(heUa#T#h`(S`phcBi+hFH==@ByOHG{VZ;6Os1|Hw4u2Y=FR#GQ+Iw#>Pmkn?LO~k7X6#p3Kw4Y z=eiF|cnSX_+Dm7?pfuUNjs8z`eXjdP!MU;u$#dN|2?~Dqe%}~*uKT7z!G9B*JLkFX zql4u-vutjh=en1N6a4P}=B|FO``B=TKf|>9_je>=cfsGE;?|qyrT*DH)AK(%k1lu@1@FSXJ-$EQ#g*#5*51XfWWu}n6Pffbo+Xst#XE$` zyZ8!JdKX>pl5fpKvIo42!Q{@n7z1Rzi(OEMcd;+9_AaVHwRh1Fb z)~0uHGzZ4Li}N|ec^ALYsNh|E-@S`_^#xVl#WFJCUA#sny^Bu?rFT*Cd;RvIchQ$z zco(C{q<67Bq3|yDB@^Dok(%WZy+2CNaMAlk1U7nqCP5Uvzl0=;-v1iJMepwganbw7 zNo@4~?*uM-{|_J?z5h3NE7QKI( zBVy6}S2!XTy?>V@RP_EcP)6^)Kj{0W1kw94auL1nLnfm4Bgl00z5-Z8@3$us(fd8Y z)_(NwJkKWf|2SoIK4v~%CpF|Kv@6RT&(fdmY@{HbJhj}7;e=CuQ-rq~6qW6C$718_W z$$qfW`?qi=T=f1^5)r-k?$htRE@AY(3+rL@egNw>dcOfd6umDe38VMhqAsHM6NsYd z{k|k&^!`xRgXn!V%VG4sk@cZPiKfkKykl7pqxYw<9!BraXFZDEUquo{?{6j%(fdD; z?PT`LSSH?M04jR_yoReBy?;}$FL(6*6Hai^`)`Tb7rjs2ukOz^8olqMw}t5a2u<^h z-dE^ZvPJZGAQinokT8ngAE8P6qW81(36uyo%nZ$wc&i zj%GQc_h;(SB6@#0Nf^DqnROSve}E{8-akd+qW7;7sp$Pjpordoqj4V5`?5dk3qP!1 zm&EKTrl(qy*Pkee-fzHi7`@+ubr-$gjVO%XAHuqe-cJXz(fgxWchUP(h@$BIMI3HR zGJ1bKp^V<&1?ZypPm!qT{p+MEdjC17h~9U5NS*%VcpbeTLad|r6~HcfzbA=`-XBJ) zqW3dFUG)A$5*58ahg3!HuK`uj`}+vnjNW@4Gii#_M6r0)IkA}uCvLXyL6i0wzxM=_ zfC>u}_d#L5U3bp;y`cjq?mA&VT{6e8+r+)ZQ68}Off(U$ z*WYQkYJXSE>2ZZ!4jf;3z|Q0M*;AJeoG@WmUDo_(>BFo=_Q^B~QSl-6!Dc9I!76<}men zG=*JtW#@hOLB*Wa113(u#0h&%(DVGuh{`U!tkG>}@9<=4;*EDx(QO`IJf$Rp#ifZ; zN=g$&ISLxD(WPs9#dc?nZZC5N^4h|+y`o{O{&Gc|<@Jd+8=J&S$L0LjwAx3S%jnM6 z3K!hXr!IYwybp3N_&u@xd)b^T`!blHeMt;!&&zD9^h0sxSo1#Iw$4g)mBoO3Yb)Bg zJH0tiVsI#Gn7SlfaC>U*%oQ&Lm%$$syfPd4V!PN)-m`5TWe5Lw)G@^?=D5v}c-_CcYU;`r#Px}-ZuPL(YQLkx>N%SH*RrM# zGq3gPL1L$KzSJ|#Ql^mQP77{K+`qwi{ZSQs*t*Xo^SyiKp7zI@cZLM9<@k{N=VIOY zPh6FauF71w!)|ZmYs__)vd=YDH?i>3ll>X7@YB=(pFchIHt(iCK3ZbFr7Q8=&)=CJ z!iw#OPW(qI{Jlp{#}IJ)9Z8MwbddVa2|?Z2Nrk(s7wry6rWs_L2Gj z$l-22^&Ncd3u(0T*+|xJO8qrk5ZvT;Nr3je)GLwioBR*g{UoC2M29B^=-1jNbw$w0nNx0zl)O;?icp*6P{+QsE*+}6hEPR_8EoQk()wingpPS+pb43b2 zVVS#3e6aa9cKZu@1#5n3C3Z2dDJwBZ9Bj^)*;k+CbO$$Pbg#P)AbwQEmxHNhOYTdC zzmR1)Udn&2`XF3eKh~|T9d?HqUt{d7VMzA5rs^gZe!?pJgk}CF>HnSW|I@!u`9EQe ze6H{lmj7o1^VS!i`)ht_)&FoM*07@8&Ht$Q6BU>9U(;$I$#3-CH{c}h^ILrfAN#_o zzVdM)>o=wTnk@*vPS_;@+VfJcM1JYvLA8CjZIS4R#DIKj^5+}wi95aRJEOt3KI)Qi z!R@KJomadNoOpjs@XG8<;U_G7n;9);xl7e&UHs>%c*R_i!cSP{E)ySY{{7$nf?mOz zUs{P>%xlU@3=#*M^JVtcXF1)$jTznRg`co8KO)MnCFWF`f5Cb3Uq@dB0$v3kPw1XDy{c|%*kWmN>f4@XM4f%kcU|i1o_rSbU zGNp8LW=^r`7?t`UtZY6j?A~PBJuOVVA63H^PQ~W&9y+cuS}yErpg)g_cm! zdpp@>aItx$RBcVVF?f=_>&Ir=MXhgGrZJ}for@x-ql|eFmEYAfhD>LU8BMdA<6tWT z8tWQj9ap@PUgnBSt*@GuR*fQ)-A&t(hS@DX@P4Q6Yuys+VKUJY>UlER66zm>vL)1i z2vtj{E*<3C&$N9qhmfuh_H`&3T0)hRyOvP90oj&N2cwRbP*Z?)OQ=>*-4g0#QqdCX zVldef>P9lv66z16q9xQa&GK#u^_rfiTS9$Ch?YBe@s?26bBJpR^?*i&mQb+|sN|3>%*S1Ib5&(+eH;!g z4dIlk`k9qY=~=b)wX_Q(x6m+nUb4w#}kValTiwf%%YWtZJHC zTZd1|k!H;;)6>Dn&y)Iss+Lf1kc~DI8=5j7v7eF2mQcy0e*27+Eus1WvL)2UE3~OQ_TIRJ4S;5LCB>x|US7g!&z!Yzg%splS*AB%ygj zik48ziFHe;4}sAV>T8X2w}k54N#DtdfklZaQ@p+`+m=ux2*Q?7<*bJ-p>|+BYzeg| z>tRc%$*kL!P-z0&5~>Mct+#|)h#e3up-v&PEuk(Th+0DZlEk)zx|tx)mQcUPJkb*B zVIt8I>Pa%y66z&V(Gu!CvL9?qs4sCQTuZ2AXZ^P8B3eTABnw+Y4P`xS3AHKfwk6ay z1W`+tRc%C9H=np)O%PYzcKe z>rqRn+exC9P!E!bmQc&cY)hz@0aQz<_cUDPmQY{l_2q5}RZ^z!us*IOR1c!|wS*d? zr?1hLP#fuOp(WIon&#OOYJ#36TS83&QZ1pT5=Jedj?$!kEuj|a$+4DDKO;v=sH@1) z66$y0Yzg%UIa)&fja;{cdLKB}66(Jgpj$$%lhU_oS=1702uaiuYBLho5^8%OwuIV? zT(*QdM8ljdp{DBbswLE1GSL$16wPw9g!+XZEm}hTmLzNm^&so6CDb!SQA?<|NL)*( ze-WvcP(@wz6+}y@bu`YSCDdR&Lq3gp6j9I;Y8#frmQcI1?pi_}N))z)n!&nj2{j+c zwuCy3b=MN=5~8Rj)UQcoOQ?GZqn1!hNn}f?mkC`RfW!66!iaw1m1#^E_KZJ)vjGmQXJciIz}rkcpO1AAz}+P+w`1PfMuM zZu)-M*1S2ZDyyf@o>A%F59?~2vnAA4dc0~0wL6(;2{jokY6*1|foutN9HF@<(^csz zv*&ZYa{!~3P&X2oSykz3f7Ueb9zxj?>Ty8V66!4y)e`D+Qq>Zw(>nSRh?Y>piF8Y- z3S!+7Y67rp33UXCY6(?Os#-!V0Cg>)&L>eVp{^lSEuroLRV|^OA}q9o3c5%YT0&() z^@WyDrHQz|ETVBHE9D2CJZD zT$(l7mKvrm2^ZX+nrpw}h2X^dV}e&^BZW9UGR4timb+BtlH=j|c*R_iLY&^*W#S{y zzp>k2&?{K;ODnO9c}-b~LE>O@zRbS*ET=oTF{69keE`XiQ?oYzpZZK{Pr`gv=6)v| zU0pjIoZalFkEfGoIQv{v)f3(MS@Embyg~?un*6bi+iUBqe(dYI?Ubj!pWx4m zZf$Bi=H7F=ooykw422&Y)z=Pu_Z%(Sdsf_F%O?u$3$56|9LR zvtN3(-%&yD#F}4PQ-_(?di5Z2usL7qnPw?d$Z`#X8#B7s3qLq!enjS{aeIDBj=oBm zQy!e%;PkuC>Nb|K(d=_g)vd^Uo^*&d*E!RxyzON(Q;lzXnO_~kX+c@7!yHLzuv)n% z*{fz?ma(k5jRb4ta&&{b12vmd3#)tCt-OoeQqK3F7$ANo5!F?B8JrjYee2&2!P3$V zqnlwRS8Yz6ySw~_;1-Tn+eS(86)Y5fS5f#~#s7a#3o;+1--F*(#Q$Pl=(sJvr8QSk zd}!vsB)Yk+`pXq?_m?zTDWaiH-Q+=ks7GznDm-3&Bb>}~ERW`aRbL9@Zy^XIicGfT?`&?6X6V>ko3crW&+Y$%2 zs{7T!YFKtF`~Uv;5dI%llNBre!)ojeFK>7Q{rfgoN%0;D(^qgoQq|OgKVS(4M8D(n zx-akTnj@y`>Kew{wrSD-iLT3gZ0mGXZ$(XO!Ud_ZeWH$s#jP(cNR8~H zS{@d+KC&P+%pVi>JS=W~enD!GKd7!E(_N^z_5EX012cu7{abPC(+g6){lW}8;+&Awi z6>nOQdcXH3rbFYjX%$|d|C0`f0qbQzxi^%+bUAFSomW%kZLCPV(c$t!qr;SG7gcMz zJ2kSCR5E3{H~FL{3o`A?YNs~LZmKo@lK&m5?E9B8o%L$db?GeAOlPK`k6?UKg^#Km zvrIBA0c)$LR5hpLll*Rb%`H{&ep_AqqcW}bYU^W@y7UQhC>>vDM)f$ehn zC_&Wa@;Q>I%jG*DuFK_@Ag;@0$0~hqCTy3>-UP18<$6H6%VjyK>T`JAK1S~E zwCHmA0=VmP`8J8`a`_n$yIdAe(f2@ySeMJL91-hs*`Fg~T`os(gz9oR8kAiww;@ND z%L(M7%jJG#qRZtGWV*{`9kA$fIfqDexjYGM?RU968+)L;TwbYZd%9fyR!>Ej%lkof zm&?DB$}X2L5y~!??*XbVmtPW^H>But*|A#R-UD@)%ih4~a=D(yxw~AJ>j}xQ%jFI% z+b)-T5`~i@!=7}zs9}T=mb!&UBb zIYh57cbCgioZz}#ZcWs_E|1(vh<$iiw=yG|4rg?U`tkbh(m&^G;s>|i+gi)8v z3p8n8m&JIT@I@-cFBxqJznT`oT&N0-aQRDGM5=`NQ&fn!}RM`D2Pa=9gG z)a7zFlBmn&K_srrWepI!TsD)-E|&{5%-QAgbUj{mxx9=_bh*4)vm9M6AJwBpm&?DA zgk3J*W8HPR{F*50a@l2?zRW{im&<`fs>|g@py+bBrN()5xtyS9$S#)$5(Ql@t5^=Z zTsE-ox?CnXWJ4 zaM$IsCz0xMIZV?$yIhXevy$j?xjk{z<#JCF+2!(3LfhqX8i4F_IhV|KxjdObbh*5c zOm?~a6(PD@{+?WRxm-$!E|;%ro@bZK&-5(W<cBtb-C;^Lto1sRhP?kNmZB2%|S(%%ZWs~%jKcOy31u9uvH)A64mAM2~ySN@>NjP&%740x9lRmPu-~9Np;Eko7G~)SKh* z8UMOcJj7@IUkU0tYosA&|GfDGW+yUJDjVuz4=?jdQf5!WlUAetEYmr2daAv}SYPKs z=Ag=(y-QgiYU&l$-mR?rr>COX`!nigX2Y5Ns;MmZmJ^zdhp@u?SVOO*x4F<^mPPGy zPcv&ux#!jC3*FOP(J2*P7naQxt*-V4usp0RQB&h>%(6L*blTg7fy=a!JQI~(`&smSs&ghQB~JC-Mf%rgHDNtS?Ous)dZu=cBh#8?IwVd zPMyqifSX&)AG^G}$+~w+G@EDf`RpOG{=vKoA1)&_`{z&0z!w3NX03DQ`qSPf>DwuB z^wB=~gk;@LiFxyU@(oDQ`kfNBnR8J(OW$Qh=8$X6x%T=Hm}^k)KgO>r_I55Z3A}p$ zjPre7G|&M5`K@s>%n*MwnBxBoo4MBJPn!C2mj{=^Ji~CRHw^pM!Ca2au4U*b(w>?7 zA;Y#LGkfTthYZ}Aa71ulWZ>Q!dL>2OO3h!i8q{7U`jwglU?xN;lWB>8rHPt3RoTce ze?ntJU3|_4J{c3QZxXI63#u?EJ*~q0{VqOjo6>}-R~Q~=JC`P^>Zh4!LlSvWBDFZn zt4t=gVA&Qd+k$0l`{$S#xUlcdlKCgJm6a>B*%7Q@*=9Mx`gE_<(yFVqVhyo7KQg{%cz8BUdQaIwMnwwQ6C-ZbkHkCmiN~#}K}$?90Fo%D!Z#ThN}D*;ZMw zYzvlcBDe`M?^gBE4w*2|#Vog`T5H^$jaPzChj`t8zo?b1TtR$Z#8$U@SZuZ5QDOBQ zP5x_HQ-_(?di5Z&(>Y)2nPw?d$a1FzHzwW*!FXqLW?v4!;su|=!CNl-K)UA!=93c^(Vc%EO7rfOz{Fjc?EjF6`4J5Bx^X{vtQluY^i5}2x6 zWPaCC+Q8-zsrvrB)bGr1)J)#Gs%~mH=8opnE&iCuRDEY&>NXY)<%;n57B#0%6Xo)-{6$mhRKHx?G9&YQy5iOo z7p6`LDuG>F+`4FC>g1qe_1fvFDSd{9>g;6~$lop+U<_H~)RueKX;9T?yF{Y3)%z{W zqZ5g$*>jC+QSRMCW;EP@d4DE~MBL{TiHo>59d3T%XuQmZ+4Z$8&FXh~Wq!Rr{>O{5 zo|*A+KdG#r0p>S?v-nHRWSOsbW|czAMi|mqGbKJ{BLikNgg2P{Wn!6;h5RX56w@+e zPS%=Vgl5_4?F=#2N>zO43LJV|40BaHVDo`!r-cBk++&_a!5%=$8O2mDi zREW6WYL>T%yUvCBTJ{@KoTzTDs%%cDYrORcA>wX9E=Alu0JVsFIH?kG8%VW?dpxlc zanBl?iHG?Sj4?W4>mdFjEH+5%T~mF zg20NnFA@k5_g%2nF5-TH4Fn=?r;GKyP;5oq0R(}FyNNF6CE{+U=X~cP?jCx7@(^(+ z>lseOokn0q+*X1}#66KD5^>K3aU$+7L7a$tD~T0xA0Tid?ouEv;=W9(MBMjDeTy|C z;(kREiMXYg=zFZlinx6Uq=-9$(05v`h+6@uMckc8m593!secHeh{ z`#UW}+@F9u5%(MtC*uABh$8MyCF1^)(7Yjqhgs zC735f+>3~Wi2F-2CF0&pDn#6S$$qdR?&CNUPQ?8ii4bw$CJRN}f3Y5lxQWa4Td#{1 zak~;kB5psDP{bXMx)5ar)xoQT^Uh$8M#aw+0&qG3)EcN;xk ziMV@_2@&@Q&2osit$MT&aeqn@intfB?nK<{h$0d9E)pl=K0>5K+-E@{;=ZAA9wP21 zdWIBny({&V9~OwXU0DuA+(E265qDFfP{iGVbtmHP3uHyyBUyJM?omXMhkat-ky{g^1f1Y*j?u5qe#@MBH*c zJQ8uYW8I3lKO(Rq?g0c=#Qi@2DdJ8i6C!RinG|ss5K0mEWI!k4oQ%;X;=_(Wony2ZxKqr zz9%A5u7t^)Z>=;TCSd_zne96=#}{xrOuZYq;5KUR%oQ&L{;5AEcx5*K#dfi!K){2@ zm$~c1PmEj|s~p>wK)W`_;85~h%ypD;1vg$XM`=C{;&uPJtB>E6D~QjF*y>gfi>>xM zDy*KP$$u?t>M-+KuO1|JI_FD0(=25QS?;vp#>6`z7_UF7_~S-Aq;E$fc6 zZd~+#qU&3Ig{)w z8mWsHruOM4WZhdArgk)a0F|tJ!NSzG{+LMCy=h@;oIfa%bx&K6+9Ff1D((#nQ=|Pt zBOXoQ|9lD-4|oNmh@9knr%#V=%=1ETbC;K_ryJEc6!PS*HYIo zuF|gQiv_7~Llf99TO0V}1*!jvvQ>NES&;fhl&#vkd_n4KQMPKYd8Y1vMA@pn<}taS z_O+Jo#?Q%LCmUcb-LVS9?b-X93-+vU37gKNapkt~7+dj>zeKXj`sPGUX{e7iZ%uYF z@|}4Euki+A7IYUQG0kY26@NZo7xQr58I5)3aew|Np3tMcl3wPDO!e(9t#fxbhL(Bs zZbtjsLEYEdp52#B*t18HNqhDvLTS&QK&b55b3vs&do3C4**nRdJ^KWZwP#;O9royFV{KO7vrFM}SFtb_+6P&+bMl?Ab##%iErvq37wx*d9v=d-hCnY0q8- zsO{O`kt%!kQBrNszDTU>*^fzuJzM;OzA$atv%NSlZqHV5h_h$+(5PU~#y+5u-!FUi z$NGY*$Jo}9348WfGHK7AK`8Cn%K>T6-a;-}BdfzF=oN@DHVK?Kg8-55yQvs;lW zdv-TcUp>v(vy(_7dv*$mwPza%q&>TU&=*myJ$o9Uwr4LSRrc()r2Zj<_U!M-V9!2C z4tw@Va(}0VJ-Zy-*|Q&#ID7VMAlkE?U(|O;{4ut@IU;7y4&{iLJ-Z1{;(6eg6(LZ%AR!b|u#K>>yy+vm0xi+n(J@Pq6mv1eUEmdjLUb z&sMS?+Ou`6hxY8ztcUjOPguA1?AZj?p1mAkt=qFVVh4mhdk2xVXCESn?AfPDtUdb* zL7w*PyO<~J+0TfCJ?p)!Z_{FB&z6x2d$vE>57wUD0B6G4vtvnwJv*K(v}gBWJ+x;J zW8K=b(+MJbwuvOPXOBT$*t0(&itO1XB%wWfA?txXdlk!}J$p0jp*{Nt)d$w86lJ@NJK+2vyhcL2dFVm!b_Uy0qY%daL&kiS2_Uz`MuxEGB zI1hVvFFixrvp*&Z?AhrohxTkM>&~A2DN$(8UckDuXRiaY_Uv7(JA3vqqR5_okwn_F z9}q_N?0-q5J)3$>UtIAR+W|z%p50K>Jnh+WdKT^3U5O)m_5c!T&mKu=?b&(&Y0oYs zv-a!~0%6ZyK_>0lTL@v#{*heTv(FL2o_$C2Jnh-9^(<-6c6?o5dHERI9%RCvT^G#R zvm0uXk3Bn1PoX`#r^Y$$*{OQGdW>x=nXqSn0v6e`mk~&N_BVvmo_zo?vS>!k&GcOxm;06H0sbbwFp&en=A8vtN=#_H2i@^}Xcm*={7( zo?VyVf5@KQ5c{U>*)gQTp51{=+Orc0r9C@I!ykw}TT<4oLt^UG+H{?MI(V{Qhs2!b z>P)&+gvgS~L794E91JrcU6;->WdnaoOH)<+DZ0tzXv0iMFuuC60jP{Wus6A_LFTEv z@i{yB8>%+X){dc$oelE;f*2?3gd|9j%46-=H$*}1RH4Bk3X-Y{jWj3-?fF8FLZb`{ z|3(^PnFF5PR3CqOaYz4vTMWvwi#vxXz8|G!2DR4AX^da1(jEq75{KN2Qvb52Yo|?b zY4$4h8zNb1u48j`Rb6v+mNgCySb2OGOU)&&p54+gb!uhS3s7o~t|ndAlAU%kN71x- zcGlV4y5UL6wkmFfDlnKvt*KkYoktTXK&O1g4ZL;M-sUdcLU&1S`E^JE%x zyz1dM>kQ1GOj@#5pP}r}gf5un1+%Xl&Eom!p$v5Ps;;jKhX zdfnW((*m=dw?Myco2W~|1-GZ>ep>NDaN_+j!7H=Hf>{o|Hd@Sbm#R<9xGx^Bm@85+ z%gtRTKG^)by!{2ef;GRi61$k!l$97H4mRh@?5odmx`P`ty4T$Yko-6`YxDm_pNYY8 zFf|L{z$`=ZpZlF`bX5*k?yx(|_!@JarR;M})lDpz(Kgz@y8qb zl?R0xrf}0-zhH%OQ&?o47~Rlsi(o{ZDcq46v1Pap^Mqkj^B+9j&~LlMr6W8q(LATB z(bVpnn@st;6^iI~hx|{m;?_szrv69=`~f=Pe=vVOF^~TZ#Mh$M>8amqDZD0ifiHzO zTkqTW>gQ$(*7!E^`I1b*y55&BOr4o2Sj*cu?`LER*6&`jFm<|LsBN*2Wj-=B-yB(@ zv36cfRk^o!kB;JZb_Q)8Jxuw>L?gpl-ZYZI{zIF~y%yGuKW-l8yg-%X_W08Jf<0ca z$D?=j_vYEli`9Lt?eU+J348o{GHH+BO(^a0#|f1^{tBqH$3G#1Jzm^XehwI4+u7s& zfUG^fA?mQl#{z46e0NZ7j~_-Vp1oWTChhTsWXc|2LMrU>D>cj89=}!3)Asnogs{h7 zAeZ*|hk)81_j>8;)nD1;JxR4azCN+C$G0IB_W0glZQA2UaA4dXKZZk`J${Zx1$#XH zN1yMPJ${wGpvoTq9htDlA10Ib`16F)9)A~*_W0N2!XEG5Tfe#1m-hH@LSc`OB@_1e z1kF}#j~}cD+h;G=ux#z|CIV}ZFCq~3_!(fU-5$Rf8wl+28(H0|W1_LCp~m|IL12&n zRhRR!$Cv9l-?=^hq28Z7?D4Pl3}=s*_0czH!rJ2l2qJrYLz2iI-x|c(<9mQOdwep9 zwa2FtID5PWNZaGblPY_B38}AMXYBDyNg{jv1`=zJ-$fwp@ka=K5!>41&jM>}(LFE2U3wwNHaA%KiMdIx7-GFG1Pa=;!d%2P$V)pn9 zj)>XgvpGW9jA3m@u8&B9^Z^m+T+^+DtmknLi2_c_V{FC zZI4d{hCSY*ac+D3cs;?|t`?50LSd{ zRt(Vg_+rw?9zUNXvd4c(;_UI;fM}0DNG|R1ziOD%9)DSnSN8bFWWpXV8lWyX^&q;6xidpupHXs z_p$Em@nuAzJ^mW&&L001$lBu_)>W4?Io#Rfy@?`we0>sWk8epB+2gyDNPGNXLig^>j|wreg}ZG#~&rL_W0ijggyQqnY72hCWJlS zWw5^Jn@f9q7$NNO3eEGh$9L1Sq&>brk$Cp<;bg)dp9bda@g`03vBwwbDYVDW)i|d; zev=-r?D6}^ggw3#EV9S{K_Kn%FA1eRo*JSrc4Uu_B#`#_7KG9sp8)9W@gqolak{1@ zeCl*Psj|n90~Pl8g+$sOzn)mzI+vAh5rqCWwvmDstvssSp@smg*d;DCI$R58MMB3xGk>zEN-^*Fn9{&r$ zD%#^OV13pe|A_U_9xoZD?}W~wJw6b1WsjE=N_%{~hB@u={q=bJ?Byd^4(#!nEC=@Z ze3k=y{8W~mJ$@09v&Vl$B<%6K!B)i{e?+e{w?ty*?3OAe$*yy(U#@Fxs`vcBs8FDtA{)!4 z%jmXCS<6=ileS>e7ED?j7dJ9O!K4)~jyWG~E)`7Lw$DxMywRNHa+_y4wx-oSl0v61 zQ3lo&iTk>tOwD}1>I9-sR{79hvjuGq6Jv6|)GLvS5f7^E!)=SW^V9xU(qrYGxYOId zGa6kiw*qy2)OO7MdKY+C}SMIReVtj96rx!!A&oxyyv0%~`Oxo3A(sq9#yCqv;Rl4Z^MAsLjCF?(T z`2}go`j1_HL0YorsmrDyEZL=*LTJg(@Xgw5kM@Ub6L_;TXPU}QnacLUnk{Z!CzrNd8tyv*yvrZ}&3_Yt`(z zM*l7MF5X-Ie$%j?8P=MvuJEoSE48fL`>kegne*qb)6DbkA==1p&U={1>`6w>^`0gP zblO){Ij+-wTzD9Bs-V-__r7`H@?ih5%C$A=#^535;`fvPQx9W)PuNcLtR@?LlPFX{VAqopwHu)oD*f9Xjp#z*?vM6{yx}|3E5q z+GSu;r+tk~>9n7c3Y|8&uev6A>$H9KJgw7iObDHJJ94Sh?hmMS+GdK{U=(^iu~r#*@sI_*Mof2V~`dpfw&X)hvi zI_-5p)M;-gkLk1za70X}eVij=I_>iup>*2UL8;SzNDiI$OLC#pb~sSqStUZJ?Lnq> z+M&Qgr`?1|=(Jmdt$m&LN7w_c(;lK}dvw}qdMX~qJR4N&v?q{Co%Sq3sncEtsC3#J z3C$Z)=(KkeYn}E{VCb~ZX`EZ9eN#`cI_)PcTb=e>f>5VTP11L5BGhU7vmWZS>$4u} zv}0JeI_*vbR;S$?V6E%4KgJFSoia@KH zBAs>!NvP9qgu2ja#}Gw2?e-+0PWvO)1D$q%mP4KP2-ZWLb|&kgPCJ+NP^UeK^+>1v z8A+tmUPdBx+8fBMPJ1VS(rF*kaFuo1r}X-A>$J-`!RfRg5VcRI{YpW2E3%BJ*GuZO02>a;`kEUD9u22wihc*01h-Aj}9>9mLG$uXUF7CCg>D>a-Oa z=G1A&>+wpbJ&;W3v}w(9=(NY`(L$#^gCx{xFJs;5v^Nn&I_>==PN)4Vk z1duxIC^Da-^kLZ>}f^E`Fh>+~$C)80xXblQ8#giiZs zFsIW#qe(tG?dy69b=og9&Z*P({IR|fb{J%|(oia0k4)&aW56Pvb}s^{(;iMJb=n5N zNT*#)Aa&Xc2&GPYEuhnB?G9t!Go+9ndE(;iQ%blP)4l}`I>!j;x(@5Y)!o%Ruy1D*DHmLr|^9g;|={emRY zX-f~+S4--&{mAmtX@_%`)oDi)tfEf49oA=c+5=b*b=v8yhdS*7)Rj(q4x!X(uhKB5 zPJ62!Z*|)HSq^mCCs+=2+Lu`lblMMDb~^2UiJVT`_5bwc?yn#aH_L-L=CoydP;`~cR@T)D$;i}AgQ zon8#dKG#&;#DZd5P;6I^VtY>itPi3cWA(b||3uew`ilqAE}fS&1@R!-=Q9QIAll2# zGiJ}}FBIG5nGsU4eJ4|qitWdlN=&i!_fjdg)^+`2Ug{0smvxG5W9oI^mvsVdUFx;| zouxoKJ@uFpXzy5b}+%?MGz7qV-Oe?=4ug-3g^dyB?vkXtw~B z7VYk2uxJk@cNT3ukhN$Rpbm@n6ku)9UJ9x$+M7v*Mf)I_v}m6pQx@%8q{5>8QnS1* z+RmrwYuRr|aiY4psW^;&`4p?u1h8@+RX^1MY|IqE!qRf zg+)7!Oj@*a357*_3YoBIFVbwq7VQmsu(fFKV%b`>j}Tak_E`d9(Y^t;+AZ2ouz|p$ zEj~?O@5rL&P!{d8ptNXTC5J`(KDn@H|4k+=+LAN$y;Y(u+Md9|q8&^m zEZR|EYu}>X2790_+C4OFk45`qJrx%1bWm;4wvtMV_C!Ky(f$ljS+tiEnm44dXn#$t zE!y7$!=nAO#taXcaZ|s1uXeSd{i*_nOWYM;eSc`TcL7o=vDVQfL+H;A7MSD4!vS@!rDlFPN z$$qdF?ZY?|&Z2#qL|C-1l7$xShpdMd?SELe7H#Pg{od;mS+qS!LW_0~>cXO3pD40u zHzx@#+HF`5EZSXJ4lUaKSr0ARBUleD+L^3}7VTWtBa8MVlE|X{8HuoHFC()S?F|6R zqPTD1Sx+rmR>OU_a^c%Bw*Pd!Uow8Mdv zMLU)-vS@eIqdbi7eW$Nt{Jn_A_-yBx%tOAeR>HNDXsZv}5&nWzp_NCM?>?n&q%)8}(>m(H=(< zTC_i7-C49(5=9p6tt8H(eSk<=v`ax@(Y~y49v1EUdWN)Uzak1O+S0T2RUZ~ww0&52 z7VQQ^p+&nD>&~K`2xKkVAG7W(+L=U=MSBd1v}jK!j4awqNu))41EI5M?;=tb?IW7z zY0*BbXVId4gE+EiKOvD8t#^*TmXSr<6+l|FL&&T}yE%cdXvdRDi}nCQShUsT(xRP1 z2#a>H=6PDQ7wcKlqP>PlShTm035)g~FlW&|qDej$?X!9cE!y`q&S}vm&($}Av}pT~ z35#}pu*jm_kw99s`w~ivb_!r*(atB37VW8o(xSZx&{?#%k|>MzK~iPWJ_jl++K-8} zMeCiX&o(UDp1{tc9Yvxn+U-b{MY|WMvuM*K%A%c3sw~>Ypvt1Xf^elR+FxT$p+$Q) z%YjAv7|W4G`*)JaqJ57fvS|MUA}!jo^YxW1&dZ|h%~{r>9Zs-{7VT)P&sww-SPw1Q z!&nb3+M`fc7VS?7rA2$bhB+z&BUuD@@wErY>7H#4J zeTk(-+Z}9GEZV_(UAZjUP4w`{q8-P&wP?o^Sc`Tq0&CG80w68gDP+Q;okb=s+PQ?% zqCEl7S+r-6L>BGONg|8(DiCMU{)WU_wD%DF4_UO2VBfSw`xL3LXkR9i7VSR>rA7NM z4SygOt&3H=S27E&L*@nLb)SOrT2NjK%Bwg7LYgraMVm_n<+bf|6FYBIT)EulS&pq~ zwU4BEDMU^Pnog)ObKHXdijs?DwFLc@SrDwiE(y?{mwF{~pYlK4woXL!byW<=w}vw+ z)*$z>eP^_wyv9GJ+FgO!m*--ZyHssCF1W@k<{e&8UddKY+C}SMIReVtj96 zrx!!A&oxyyv7o#bl-Jdxyp|5gs=SW1E?o3~qHE~@p}gK?gx1mlLV3L-Q;3w;;?|w~ z0g>@q+`7BJEQQy_^ZkkxUYBGl+XqjXtu>El_55ebnn63O$ISLiru^Mj4y=6u>;>~v zcMebv?A+8H1C#^XlDd6>a$p-%lLokl$QHFuPVG6s2(FO=`~0z~-7^CM1-7Vlztq>(j@kHVp=aT5NIaRSQ#_ z1cQR7;1;)DzA&|MP_d@$(qmJ71_aNk%{;@l@?rUlV8g_7YU?!XZ7zv5Y+H$(VY`SZ zGHg#L2@Kl{RXJ|hF0U&Xwgto1ewuuL4BM;JeXR}K+sK4r`w*FYPVIAq(y;vpp)zd$ z11b&Mu8+u%fkd(g4BH{(&afQ|WDVP0QHNo>AFwuTYe2POJBL&lwx@te!}cOFW!T<8 zDh%6uHOt$uU8?8l=hVJV2*dU>a%tFhepFvEZP*SXRfg?oQf=7oOsovsgGq&9TMO2v zVLOilQd_C9?iJK^k8e)E@Iglwr3Dn!}ekVVc1>|w%QHbJFtPkuzi$O z`<&Xp5d?|TS%;7dpvg%Z)!}czc$gq8c#2U8G5=g`L4MJa5wTA5{ zfZDM2{-Q2$vRE0mT}k~z2o2joWH4+uCWm3W6}i9D!m!;9+!?l$NSt9i1&D@iBYDiQ zozD?5!}cc}5i@Mh;s|BfUJOdZ_8M{+wzrTA!}cCBVc0%KrVZN{fQ4cE29YpqKLK0& zhOPIwzJ;}6yN;&qF>HtGsW5Ce1J#D@cBIm<-GfjXwvz#sVLO%3ydi~Q+d`}j+v9;@ z*e=mHw_$s!o?s2zU$JZr+dBwC!}d?ChlcHwtcQl}E3Aix?fa}-!}d!8YuF~A(D%+- zH*9-i2ZUien8+HoqX;6yb{i6F*iInG)3DtS^Mql07?Ch+r;;hd_9#+e*e)dd!5X%w z<4ici_CgY2*j_^x8n(Bx9vZgyvu+LBCkP_L_IZ-fuzd}6Vc5P;6dAUklZ1w?_gDSK z>>3!hommbI+rF%ahV2N}L&LV5_0X{0f%V9+-IF9TY$uZl!!}K34cjIFW!Ns%aFq?) z)Aags8@4~^1ZUX(lBj)#?Qiw;HEP)2qqhaa_AyQKG;Ckcv!r4B4v;czzaoqb+mfZ~ zPH&%K+e=T58Mf<_!?4|o9ER;4;52LxCx>BMPp%EyMZht`_GcKN4cn_oBg6K$B#~kJ z0EshfmjThRT~00y+xIlgY1n?H$1B4&wM^X-$$`SK9jsXn!*-k=EezWqk%WfrWY(Qw zTT2ufw)04wVY`?}8Mfzv!mzzc<2(%8Tl5TR*xpAJ7`9Ka92&MSvhEDq4~Rm;_P?w< z!?xR#`jT41b|~x4uq`Kw4BMSaq+xp?VPx3WkVwO}iO?Cgi-?qAdxoZY8nzefSu|{~ zCyor;J4mEq`w*e=64SG%ReMhZNW=C`GHcj=P9O~1j!)_9xw$lK`w_yh-H2Qow%ZfJ zu-!-VJPq3^dX_Y7XAud*b}pGPY)=4lhV2=eKE zqz&7Li1l-7UjTN7?I$G4uq}ENW*p+SzdhV8ll(y-l-Oc=If z$fRMr1EDl*CjvUdb`nWs*jAE6hV2XxXV}grv4-sl1ph;Z?HSlNZP@;tR2a5bkx9e$ zH-yr#y-UL%h+$h&)~!Qg>eSkFT}`Fesn{mglF5D@5_6iXJ>SQ1(W`KY~W96X{xHNkIx!ySW81w9E=S>WlbDyYfx4Fv^dzw-%xd3Lwp}Pb~ecW3u0_i z$8|yyL~7-+cI+FXE#k8VhiF_JjWnpa+H5S2Mi~_Tjg%+0W9EQoH`NDEqEY+dA8?C7 zS$1*f5XJYSw9KH^nmLW}YgO9ApeYUY@pD`1U-oqEwCOF)-k&?U2}Do zH4Y6}d3+a3%_Xj$-O@01YGu|7P->2@CSBK(opv%u(X@GX*4f;;wT%t&AW`RD9TN4G z>H4&pH>)v|P?qPj^ANMnw0|h+%2^FHX%6s8)-h`~D^Az9)SBZ}Z;W*YW>9_AthD!6 zeTF=#L^yjP>no`@Xm6xou@@}%g9{eBaJUN(ZWbP#5u@5%Dp>4opPSfuqqWZEHqUZw zO{;xm{#v*D+ETFCeMe3>=+PJB95pow3-0vluhDIP^_E0k5-zyCGWXMp7XmTc9}~PX z`|`zhv8BMAhvAyJSHn+?Tz94dT+DTpac4bVF~?o7*v(xgKG^*Gzx@Th zf;GRi61$k!l$97H4mRh@?5odmx`P`N?*ud3{}+AUWnT`a<}onKko@OjC-R>dKY+C} zSMIReVtj96rx!!A&oxyyv0$+mEcVr6vD+VwdYhZ~1@kKi^VP~LOKfI-#kSdg`%cRI z^jzHizcAe^{a+xBv%lYq{!euM?|@B11KsP;y2xnl|Fz=#j2Wi#hQn&boD8YCxtCJUh9#^Ff}!p77bdmFf}Dp+R6@EyfAf$UrC$a+yy5w zIM^lgQ~L&!?ZcxN&rj_Zt}Z-S-oPpKh?uuwwrx^eyZ!h9nEdf zny#+#4k{@Xzfv}2j3F)QS&cPbCDCwW?^jQsJ)<(zJ>cE9NgP~#mN0TaM55J4V{5##$uc#IpGf6*^et%HH6j}^r8bZiD_q$HDNoLv^n55G* zt!ZD%G#}Gu$|RX4lTtKkD<7prcvR?v3I+S5`icfc9*8J@@lZsIpnwz!f{I9ag}0SaM#muS#FV z;xjv4Rr)(D>hx5pv^X)%iQ#Usjw+pmMJqe~RC)#$iPf}LUOFF(y1i6-K~nT|3WcpU zX%++3OP@}m&~a4%@1#(uC*wLzp>Qdd6;det5SA5FDD1?-VhV*H#=<0p!t0^5m_p$v zu?$iuycf%RDHMJiiaIG2J_~Y4q3~x=oTgCt2PjQbC>(!Wadwh~4}}y8&w{dI3Wb$e zmZVU)7)uK&6eiNL1*cHhn$}BGD9m9Yq)@mM%Zn)#-VTLn3WfJzX_7+WH?cHLq3~%e zPEsiR6_yrKDEt$Y&6`4D$?>TLm-!S57b2vWLSao>^mGaZ|K#&I^}h1-_I+C?r+53p z^Nx>&+qUk0+2r1-UDLa#cTNBB)DC@w2V!UJC1%7Cm1)*X-84 zH%!k=rH@aaCug49IW?!xPp?P~nxs(Jj%9@u3UgRiOrh`^EG(u_cqPc7Iac5ybuct zDHOgR%AWER3S)2qOQCQrN;@eOUWNshLg7FvUQh~!H>7p`-BT#MJ#EhdQYgGTteDD0mYC);rz7t=qVIllve1ZP#8jSCxyZo7Q_?^SED?pP}q+0 zm_lI|?7wUZg=a%g^in9i z080uf6k1poQz(p}Jf=|Ci1JPfg-I;vrcjv1l9)naAIJ+S6b@ohH-*A$u_UHY_;Hk5 z3Wc|$IHpi|2<0(_!Us?uQz(1{P;Wx+xSM#gak_g>PY5Cxt@a$>}|i zq)<3DEqu}`6wXc0ck~nrE3iT@g+ddHo>&Tn;k5d9HHE^4^jeTYVM|)Nz!VBMrL~GF z6kY*ENeYD@!@_O~g}0<7Pb`JPPp6e#3WX11IiyhdIF>^Sg)cxkrcn3>mO~1Kf5Y-L zg~Dm4q<4W!q40eGNK+`(v9y~)VHiugDHN{6l3oghZBT?M6mG`yVhV)=Y2i^*DEwH8 zPf{qn1Ir326n-HsJ4ybbFp1)rLSYxmdnpud!=ji%;f*NorBHYPiaIG2 zei7xp6bc`~qHYR>Ph&|jg~C^`u$w~RAF!mDLZR=p)P&FNrBFBxi;@%y&q+%cm_p%& zX)R2l@cmfaO`$M`CB+m9KZJ#y6be&NP)wn43zl_KD7+R63Mmxs!?I!ug?D2iq)_-3 zEH9=|_ya726bfHT%NLkJ;qTH~#S{wvibaJK3MZVNj*3Phg~FLo)=Q!AoU~*iDHL9q zR>2esYt!PRrck&p#V08gc41i|g~CB7>!wh63lsE2nxF?6#fVciYXNS z91Dvn6#fJm42#kf3O|I!X$pm#ptzSp;Z<0Y zq)>P>mL@3_-UX$-6bc{4k|c$~!&sW6Q1}v*CMguYjfKaYLSfOFshwg9h0{@NDHNWI z;%*9s980<>6xL!%H-*ARC@H2;*oI{bN}(`=wK^#jUV#NqGKIpOaK26oh5Jz+Qz*O- z84QlYb@!eQ21vk>7`Iue0DmVvQ7$x zGqK=5Pzr_TK-+E$w~ky=1V^izN;0p0RMAg6u@wTYmXfwzs@gj)JibAeb0lo4&if{_^oWm0Y=L z4OEh|jBQ9kBY5JCBT{c8RGip2a_QLSQmNeA`(EmcO}ld4#xXz8?Q-)zG9G6QqY?5iP1Gg1h7yO8YYcT>jli@#*y`78^+d;U5icJux8WP(=ViV z?+1CO=jj*H3$L_Ef6V*s=@-)H?;F=|_yRh9pSPFYnVxdw(=Vi#?TzS#c0_l!=)Kv! z;7`TZ!SQ+p2c3BEg?+(y(0gY~t|Q~A*I4%D=@-(&n~d-p?tEXLejz<@(!@#p`w0p& zqifQ4qs(38DH1H`G%2W{-cdiMHRYQMhz(_S5H|%w-|)T3g@3oIp{zSuav*^$ye^!3 z;T3(mzBhG?4enjhx5o7vKzLn|_9{O8Li*D$q(7xEq^EakZzT6V6^CDn4kf4EG0^>a z_K==$>)yQc{$KZR`Q$qWE-at(jN?n?{qn~7^^4{E3(C(8-*1ucI~OkvC(%TOp?aWg z*)6k6Up;V&ya*j%Xuf{ws|Msn)R^8fyXE>`1KFo}8hv`XUw*87arh%Y4<9R@UJgG6 zAC40pkyM}O3`Z?F?GxA`-G1nND4+a^fx+_NIlcb)#K4Mj9=^x^2Eryllyl| zYQ@s3Qc2P;?!EC9le3e%r(VA5(o*SnKl1hO^uO}8r>?tv{rbx{tdbza$i_A6HkHbM z@!mImr~l5S9r@)~Z5Z2hWhqnfH1j}jH#SXadxG1}NWL-FQ z6z}RF*ASSXWfz55+C>(#Jd~>!W6#ih}qH^}kzW#D{O5fsekgs}J8or(z3YLY# zQaPM=&dO!O;eYk)CGz#btPx6X?~@b(*%flkek2^$cMm@lJ`MK0qMV)3cY1j|J5x@% zB|D?9Pma%!3r$Q+Y}vA9VoUhDb4!q&P|l8%b8gL^720vK9PSy+{$`QH`$T?AS?YE^ zt?7O`v-?S9{au`X>dDRyIFRZ2K&IzY*`cy1uyV*1piK2Svxwh?}+23$5znFp|#{gC409pLj1F z*(hs5|4HAR9WLEhzCZhD7%9>?88c^eKdtG0I6TwA{wse>--VYbeMLJf*hC9gV~z}S-v;> zx$r0Z$#6W7JwIIge}vDkIVgjwzx?ol0|#o^Ps+=;f(gg#AE;%&rXOSmJ*oWQ`|Uj8 z*e@q|xzx?h?mMk~PWDDU@lS>0A(^d3`JY!w_b8okcHi4?FK4IqeYI4+!rCiCH>m+@0Ncuzu zQn63683E1TFZ)HSD}qw1%M;Sn;qdX|f-d)|E?2C4rW8Iy?739B=KOOW%pNxLKBk84 znoF8!pMOlvSUkQq3*+tUivMId={eaWb`B|#dTL-h9?1ScVR}ryh$oY2`ChG1JQgox zpEt{>{eTSHzVb(lgC@H~d*jeU4|h6gxRpH|niFhyLizE}95{I3KsF%t&KHe;QH=YH zzE72;Z%*xdK)?KXsl4(m5lUwaeYZQ}De4ZniNe6iR)|*T9r(%@H;u1<$AM(rbh@R} zDGz0K{ugBRAz@diF* zo&ACLgw9@C9*KRE4a>BB;A^%X1zt$J-!i$#4tSpxgu3h+|%F0g2;F&4Vwco~W3UY|WLoL0%dp6vK8=!9_5Q-pB_e{h=|hxPc(?&ow# zWJ@2L6omdr-K5jLt9ObtQ&hWK4&~ldhxg%)p;T_cjoEL7&K=1f4ET+O$uX%hvrPP= zc-818Wx`W;*|~MqZHoI`HuT(~aMlIipF*{4s_NaJX-_@1!|Ul`l^yd0{Qu0blDRG` zZ@DkbYad=JgEsrx5;@Aewk6JMLbsPlut>_^tL29~<>yHR>22y|^fFB=sa)d`Ae;3$ii%$*=H~Jl5VZ6d{<@{FpwSH<%QlI8TB1) zUiY-YR@%s8IA*dQwrZab_LmrDU%CBY_7{4-Pjy8S$vjR%iuWr&I`Z*o(VY!7B{2qSAOdzW5aRFVtYv3mlM(9bgYpCp}?xuPP7SksS`G!R%e3iDOq->}y1P<89(B^cbSM z`O5mr3(uDuYH9hrq44jVTeCmZi-acJntfV7>v7_~?2umA#{Xxu|;=3)aTLk&m{(FCIfo=fL~BE12%0<5TbXum}%i zH%a-dE@iTp2B>_LwfWLvJj92{mw5RzW@H- zB5E-EfSyZ-kPf^!E@kqu9@a=|my7R+T%h3L4@i?`^|My~WS5Iw2bL9AKZ92fs*@kw zW`DapU7Y`iLN9lmzkI)2N19&nNb9Y5!I5ymtHK4l%dN2Z>0V$PunW1sZ^H%k-t2av zhD7HXp%TkHzPxF8{qR_Au(mwA+oEj20@>f`5VYefHCAKC$8-$AQQ~SpD3xYsXC?kA z%V3FMEtcEkA9O1CR^jL+uh!mqP2uPz!BgBXBSA)xE}7+{{yQix$xQ5yqZcL)rRZFK zG+e7l<}Q`*D+b;Kv zCjZ{GP2aN$`ce%s6gRhDNp zGwB#Qv%IC2{m}{HxVOrj*k2x(e={>RVS+kY&T|~Se#Zhpub7d4M?IB9j{3^2DV?Y< z(np~Ohc$E}-Ly!Cz?2>}dZwRlw(r}d=YD3#*Tjv4=W1a!I@_6FWjd5#b^3Vd^Mpx2tDf0b|nHZ@%gI`z6{vgal=&p(<*Of~+`?5_JJWp5Q zM>)UTB!3uA`s^LgmY$Hmv-Y=m(l>@78&0|+oHX2{M?a~yw0n{mSL}Y5Zusw=lV0#$ zJLv+tx4-<3F#NOSVYXc!f~MlOWfZ<#G~Tg%BKu$VR4X_;eO8~Z6wV^h_i5nV;xBN_ z%C+pXdMBOL_uO)DsI~0Z!|I72`^(o~Kla%JhYuVyl5tBw?hS4D<8ak*lvc_0%H@#* z2Od8B#lyXjZ{edlLZw!6=ohD3U_Qcj3T%AzQ26(r>?3;m!m-1N)JYC@XV^%Jy0#-R z;t6S7kt7W*8@yo1g2V&*gm~=}qDk5OL!4YZ?2nL(kA%(&gsE`x#DB^Zk;G#-W0I5T zbGs+0|Lg@T|NZpuUi?YuFVo#A<<)Y6SIPtAWqto9R8UtatEJ#?;j_$oJRP8ZyK7$(Yr- z(jV{0?g-~T(g+MIi`UhJDnHLxH_08@J>ew9i--BHJDJL(j^JOUF-JVfQ__-e2G1nw zd|Mv4d|O)Z?eL%_ESyY*>oVckCzUf}*Z&Zjo!RkULjQ%*&hd`yb^1j^gXxz$4yh@I zGp&@C9m+nVcCj-RPa(A)pQk9fl;GYJV!%6&V720Tv9hhH?+?#qWJDd&_(wX;*L9+u zcibGQ>YMc1$5i!6T-B-ujpZp_h_62;OQv%9Yx3>6!ZHT4Ul3V&Ok!#O7*=7UW37s; zrB0VE2!X2IXO18&=OrO{_R)at9mQwJqYF8HL3>3&+PShS6Vf9ei^nk9?#(`~Cy+-6 z-)V@S$0q8UW4q;(2%fu;>2<*>^hJ^y;RPyQ{pG$L_emjl4DlBWO)5@d8jC}%)3Hk z?#Ny!pMNu~-9#O+ksQOkBF`SeQ29n2HvQ${!R&AKiyp@$lJJ@Eb@Ymf1M=v3S>G9D z+nJF0T?Jn9``RAe$&lISx9ZJRJo;LpCm#w+-ZA-LhY%7O%)Y8t(BtS10o;49?%%jy z?sValx;^k>0Ul6Bn1#n~`uyOM!R%MH+ZOO}_U_Q)6$8H)f&|9Qj`TeCRjSQVpTDLj z4Nqx~a#DT7`k40nMC&Xu^BLu#hvJ@_*Mw^hX8$)dbQ^HY&dj$?mAF&r<+A5pyY@VJ zf^~cOyxsO!827gZ#8pcKLdL*Psf8q_B_pjBhLAjam7wNe_MR|4bt0LN$Kv5e`FMcN zWWN{wjAp;1d`+jj!R)Q!q3Ct@WUti)!50Jl&Hi`j@-5@{TDV}#(9k{O%HfZY8#{CCvJI?CC?Co-@ay;G_K99|2|DV#(uW5-LElQ_nzu@!PJ$jX&)}t&M z%H@k5&0Zb;HvT1S6O;2jSU~6)7KFu}?@(Me6g1E{?%J#xK8JlX+57b7`k)@~2^|&u z|1ao${%PIa@uF}~>&7s-=e2#xk2MlGXb&idWdf5^sc6SR*&xwZ{=fmN^ZL8)eO#_A z`GUtEylVVGp#gG_e?uEAQF&?ho5Kp|;32hX_TQxD!#_LrxUz?3LmFY#`9yX!oiEeX zy?5U=e94ZxE;%rK$>vLjvpsTxy_-IqRl@BSrk#~pU*GS@Ny7l0z4$)c1T#95eO`N4 zAMMWt^9V$aedYVcXUDT}i`r2))~pbgE@nO0In3(xJ+4Ou-061&n|KVLx_qT;>hm&gfYrQ-#3c6IHE@Ss}nm=A>zY@OD)q~kz zm=R3vGiA7q-(y34i?)6Ap6tg$Z*A`E0I^W&ih;d%6&B;k;vohGFS+jh59>B4nN+la zx(sPa5a@Tr5a-Em#0NHyPwd>hS;nr6s!h^CLl?_v9gsesy<~@=1$Ltp?GkTwo^=#EO@h_ogGCe-fZZM)G|GQGhv zlz(1E$Kvu8ayOnKyzauG2eLcObl(aa&HpL*wl5#D0Xd%iNx^XTsK(|ebsFMA?$dky zurdvI4C{Oi7Rd7AVzX;t8FSfBgjx?qr)jRUczkit0S==g)6-lkA6~ah&-S`qb914K ztfOqUnFt+K(WzGErZf7^3Hz`6$}&LzcTi<0`*ZCk+e)muNS}U52bdo3z4!0+9-3%n z|E!yy!+Qef+EjmY7-NO+AxLwS5jEe)S(rSGsB>jxh9ldwzfgJSJkn8rt?Hj4FCm&|J<5pOaa1w-DC^4jd$j;+74 z;oEBmHppbCuCDhuM@WE>8KFw*^#{}^pyVTFF(FMdrct4E0+yjC#+7$-xBD- z3+1J#Fz61eIXc0BHv+ui}4=0bh-SNmA7Wk5zD{O z#=_ba19|5OZ@6va-1Ie_p>(2tO3(PNC(zQ@bz2%9N}TIjs=IKq!%v{4M>u0}nzo%M zoG~juHfVD~xBtkq@+s-gJ6En9SbKM|M??3@hC$sX7~U3=xx7zq@IVdX!*nrwc(z@1 z1DSNVY*1SGRU5slYVQ=Uy5xvgwQlQnURJ(t$I6Q(bRaMDX#j3EyF0W+hSi^H*V@s# z`5P*+qe{XisMiIX4xW>#KOP;OlTB2E*@MT+IYju$uw_N|S&e4D5ytWzGP1)AI+}ef ze3fVA`b}2RE5vn5y*g*PT)VQM+kxJbu5IvmPQE`9)GkyBp{bKaukO<^UPnR+c9}wlSjDyJW0K-|bXA{p z6`m&a)Dt>^m`oxmA=qYro|--sU$>}y==vCJv{k$wQ_+{zU)oV)L|NgOLZ4V|+pKNR zyEOC>2SgZ;^NxNxAY|a_*8X^cWFJ0O!0&N=XiMZLa{_(6>dBnoFLjFgPu3I1ba%^~ zu&B(YH(T!aCOMhC3UgUulIttq+ZbvU3y(I@$vh{H&ChdgR-9*^`|jMMPkf$J&By=i z&2=I6{4JR_z7^hjyF{E>cn-6u{P1H>W{Q%>q)%jeEX<*qe13X@6GGp44N>Ok|1=Yv zKJ|%H{jp7O;Sr%kM(5;l{8t{z{x!JRWgk*5KDaTEi7TYv2IUb|U-`np?56{dyY{>l z5;~V{N~iZp0)>Ch!UKs{Yr)D`aAqj@i%c-1a_YJ~?!SK|)29!O9Sx1dH)aDDESGPp ztzCa$-XfU^WwM;FqHO>W4);)SSMkA6=h1lQuSDI2;#$YH>wc2Ogv3!on4r~`_iSrrb2ypojgaxHN7)swk0=6-{b1+!X%ge2WwzHY>x>G!r#Y?WrdZdt8yeS``4_VNl{!S~Ma%`hH(9qoE~_$+k2JJVQY z-J2aA!N_x@f~ECRYm-Yg3oVAD7xS0$xv~$ z@?FyO)zY>Q*y-)czt}FeI1I>eqh%ipYozRN%i(j_l5Uf{JvqKZTG*wj+V{|pA*!)r z<%?^L^>51LT@8KO(ie8MhgdG}IXj;kDfZk#q5si(&XOdgJtqSpY(dMu9n=rqr%xEe zoBrB;^Qc-FhK85p?K1Adz>;%7r*{Ut)zUysp%#w(`7bHWTpAc!p>nun=;rKuG(LxP z3?6ZOeqP6?JkUMj_?)MMx5V+eR>r41`R$I+BXnt}S8SZBAwrk_2kVs&xn2q3*Z(xb zPU1{5Eru|e%)Rl`bm4oL&yI0g3?cT;unW;Lds)d%i#F_JpR+U}+=gLV6oP^C;`esk z{rh)|jk~m4#I?%?r4!4;U7jI~YO%z*Qh50l@rWUI`-Iw@v+gC-lx`= z2Q#fZx~2O`*Y&a$O*VL3EcEKx9eSm2lZPOksP-v6YMd)ICkC00rgxm8+9&LxC|i%vb%iC zknBG{Sbp(5Cl0UL2hSv@bl&U<)lU0B_l6cZp*+?a%7Q-?LUVlvy4|LnQg)YLvgUc> zAb&#*`pbHJuO98>vin_$ozlVVCqjul6c}1D_{xhlEZmK2##bH|9F~(Po9$tHLvqg0 z+$Vodr7PKAg*AYL=Y^>c^*ygc3~cw5S=T;y$&Gv!avwG|?U!3#Jg3KsMC9-54;%T5 z=O}(Ip3lH?)bkZldhS4}swAabelN_DRVd8{Hu z4}_wQRx;a56YT}a;^&S&GEayN9x{Disrr2IgwQXdPd&R(UIEE|H|UcD8QUh?k$p4F zk|Rl(XeYbr?atHv%R4OKnBA?jlSU@P=00gvdM^ujQTYS=#Yu}Xj#AS$Mh}O6d~-;x znEm(uW522>r_XM?XOay|MFqN(pk4K~y1qREU^sM_phQEll1w*YfSp>--mPnLQ9V3A z{zhPb%fdZZi0gO4?s5l6i4-_%@B?EDa+e>`#_e?TO_|f{;zk!9Dc} zq|!N&?7S5Htz@ZO*Y=KfyCS}?v0~*mePct~QM_cQnglK07^b@7Sr>ON-a*O9^=bWSIM4_u#(z+nivkb~PS?5J6rPdFd2H|T6FN`w+Fs{8nosdRW~;Uer?qsCbG=WkF3}A_ zi?bCd?-fD?my{p*;w8i3-HMaTj~qVyXO|2Q56iw^;hCq(;C>`*)s}&KstCq6ZQ3NS zUF?(Zx87>$(IzHjL)Jie${lj$>dwxu4=g)ZcjL;3^Yz0w!-ufXPd-SxOacFZd^rj( z0!C{q3mJwbDRjsSeOmch$DgsJ@A&5(f9hgM8ojFg{Y%i%M27cE(FYoSj%I_1B^(m+E6@1ks{pvHDQNEJjQ?*Ky_Y z2}{P#kgV?Km!5mli%ycf$IDAgmi&O6rc^rd^inwAl0~J`lK62+skBtivnaHycde78 zsVc&zo-9q(f?iWkk#?!5)2>tTe4$;Z70) zLSk+CH)Mah$Ftk^vApw|Kj$Z$(?{M{1|Ks{UBPB<#|HxsxF$&k$ z`p5VGj+FTNXsf+Hp?~FHIp?%svXZ62MN{-&XndiIq z-5{cQulJU-9bWrmasO+ib4j08)NGG0)AXXT|BmL^jvp-)o)RMLrQ%6u>MZ3pW6T8{wt|| zSpU8OcYUpYcK@rT#9trvy~}QoV*k8SMDyyq!sEqTmR{A@KM<-pe}dP0(AR%w@p_2A z*5j`#;;}ytUF7;h?QvZH+oa^^?fdh1!h-z|i)h~d7@y~UTGW3Ly`QkXKYR*r?x?3#8oe0dw=)EuKq_v)NL=~ z2Oe|yXNaha$M*g4T8CGAp4|UYDLH!kF1g9ozeq&$Uhk(y9bWtM(*8F{$P}&?2mg7I{X_&)Wu_eyy-_AUfVa?f18vXy?yst_2T$?vxvIa!}dMf&rjzR=O@I= zFAVFy!uVZ(r1M{I@M3%ZTM>`?UmAG6{41Pa$HU_Onv@(}|1G}$)uCc%fq?pa%Ip98 zMg7A%CH!OSlmRQ!|Z6WKFp#uI`)+q-H z^%t^EIaI(eWSt@ey8G`~)+qy7w|ePV)+t*G^^awpa(|)zv8+=L7wR9&I%U9qB}+Tu zSk@_93iTJVPI-L+|8VU3!aU*DDIYH2k7b?mc%lA6)+sCF+!LC1EbEk+Lj8rTQ|>R| zk7b>5xKRIC)+qxq77+AZ$U0@bfM3Wu~{bO0D40VE1(mxAX zr_2=a$Ffd2RH(m@b;{uaej)3WrN;$J+rML3r;HcsFJzr^pnyM?b;^ee^^awp@_3>C zLe?oO!%8y#JC=3IOridL1HG<*`Ejg{)Hs;@Tppd@SpfErt5WvQD|bP=6uo zl!puWg{)H^FW`@5oicP{XEc;b3t6Yk6!6EgPB~PlzmRpx;R1dk>y)K|iN}A(vQ8N< z)L+Ot8gEmd*`-pE3Ml1ie375ZtB*#()OKOr*}`5rgzUx?cKV4ZnCsvYVY(dTjj&PZF{G8 z+&DE^y5WZDshJ&sPJ-b8o9n<^5mnr?SFBH%1*&C0ceB0LTFPjwk_C0$=ylel=-1N3RJ6#ogp*XFuwbKSMM?%LdNZEmg^Jq7C4V^g1pFLDmuVH6#5!Op|3#{`Wi%`uR#?08bqP5 zK@|Er5#>70K@`S0h{8Ark!yXf;~Y?~^|_97K)KfEI?e&*Td(6hMd>&Pk#D_@b3nPi z&vl#w%JqG&;~Y?~?{gjJDN4sVhRVx zzNt#k0Oeb+6fH$5M+1>>y|Oew`PM5>1C(#QGBrS%aS98(T)7&ceBUcuOHoSKK;-*g z2^*k%-z#MUl<#{bZGiH9ue2>iDQ^Rj?|Wr#fbxB>+zn8^@0Gm)%J;qUH$eHmR|c1& zl){0?_q~!hK>5B`8V4xf_e$gd<@;W#T!N~qivyAC`>IkoK)JrJs*3}Z>-(y@I6%3+ zud0g!lBQqBP_IBH#BK^Z=CadkuR4%J;nnJ^;3H3kAG-}m0vRy7QgR@68Mhj&70FXoBMzxZ9aSn)cb1AY z=m4T{7l0^O0z^R<5CuzsDCh#BUdIRQR=%u zz6(&k@6~suDD_<+@_nyCd_eiW*DyYyeBbLj5m3JGb)A@^)OUf%_r3ZqK>5Dcbt0gA z-|IRNP`>YVod_u3_qt9@QMyh9k?(t5Cj!d%y{;1h<@;XOi4yJDeap<0Jj>m_bw(bp zde>YhvSvvhxNhBjxC6pRU?&>bKO#spCqiXaNcOhk2ce;{&At*iS3lxuxm-5;P_>+9iz)b`o6C24^Xb}>+1dh<@&y^?k`2D`vZ~hdv$++@_n!F4^Y1E z)%^j=_r1D5K>5B`_m`s7{ej5$y}Ca@`My{82Poh7>iz)b`(E8&icMXCD(k?(tTe}M9RukH^}zVFrj0m}Eiy1x{q?hi!1 z@74VQ%J;pxKS24uSN8`f-}mbN0Ok8$-Cv4Q_Xi^1_v-!t<@;XUAE12StNR0#?|WTW z)=Rs$?wXRPaL&`^6(Xwg7P>`(C{qpnTt}mjjgVd-ZaF@_nyf4p6@D)yt(Q z^>QHceXm{)P`>Zg%K^&wy?Qx7`My^#m!j0mfynp0dO1M(zE>{?DBt($a7cl<#}>a)9!EuU;-iX^a&_zVG#6AfSBT>%%}m`M%eO zfq?RTuMYzO<@;V&lqpId27<`60I4+E5Mz4|afd2^@_1C;N3^VM;l<#}>VSw^|uRaV=zVFqC zr6~1bAo6{$J`7O4@70F^%J;qcFhKdfS04r_-}manQk42I5c$4W9|kDj_v*s{<@;WJ z7@&OLs}D<2>cc?f`(Aw*pnTt}4+E6%d-Y*}@_ny93{bxB)rX}h^Zg zhXKm>z4|af`My^lmY`bd!$9QvzNJx7K)JqeX;c(YuJ2pAUIdiu`r9O;o z^{bL~e6`YzYA+vNclniB2D!QsV_|{>Ut1FzQ1%m2q@orT@M1vw_bfIpnU7qm!>H7 zr6BTsuf7yezVFqS0?PNj`cgpozE@ugDBt($OH-8kQV{vRS6>P!-}mZE0pWZ8QR+)Uz7$Zt@70&4DD|Zv@_nzq6i~kJ)t3Uw z_r3a3K>5B`Uz(!Smx9Rmz4}r>`My_Q3Mk+A>PrFT`(Ax1pnTt}FHKSEOF`uOUVSN` zeBY}t1(ff5^`(IFeXqVWLABMFwoA8!hpjhG$xE%bOl_B!U?m_eALKdgj!Av}R=>^) zX8WFfe!)~FVd-kMw12m}5Ynq&INS28t{ooPD3g3;HC$);RoBc{a`oEr;mNTLS5Iyl zSwCTQ3qGl>3qd(wA`1f~mC36|!O~6`ddmrewNa=ug%gJH>V(1OPRN?1GloNkaqEP^ z_D;w&(wV~{nMOK$AX4WKCuADw9O95+Bs(F~$X*Rh>?SXMF^%j6K}0f*bVk9e+na(= zU1t@CWH!>7#UYtSI=eU|(@19+hh!S*EQ3g$XPl7PNaq@dWH!?I#v$3L(>cc>*?pw* z4j|(jhN(H?JBBDE8pZbv5lJ+P?;0YKXcXT!L?qEDzH^TM5d8G4|3I+ zM*2+1A(=+H4sb}Okvkj!=QZA9o0dmj;nOe1?I5s^$Idv_m^Oe1@PACS62 zK#g>b;DpRZx=wINrjf1{9Fl3I>jj5o8tIw=k-BPdLS`dfIXEPl>ngf>a7Z%ORdfa6 zkYui_=qkb?$y`^_l>{PnE#ZXBM!KGGNM<8lQ#d5E5#tOMOAG)5OxG58PR1E3mLUMD z>k7kFXEtJ-p<>wr@SIE|%Nc-3HtH;M03aD>s4&h@u@nMWooQr=1Q5wa9pelY#u+M% zGgNd9f}PAbLxpjM3gZkF%P|0rXPlv8nFbKaY-ITc5Xo$0SqA{gI75YT275ajJA`qD ziX|by3o#p6Dgs2ZnZXhgAd<`s_O^D~&NlI-ZF^@wIb)kR&9=R@4>;e%w!OCxIN!iF z@t19Tbw91E@iWkaILo%~s6d?W?6&TyKpfFScU2&c=s~<>n>fj~rMpRWBQCOSDQ^Hr z^suxyfFpWX>KnijJ&12?TLPT4F7b?QOM(M9??u{{2nTTfZf;vL9KiW|xort?QXKJ! zZQ>BymKF!<`l+^Usc`^D>|yC~07vXWJYkzS!Zz`PZQ=&o#0$19Sx(v(;se{n1-3QT z2IHPMz&2Skw~6~}6Ytk1&aX{;Uz;qK+r;y=HRuLyCVsC?++Le_y*6=rZQ}FV#O1Y# z$7>UZ*Czh1P263ZtdQHp*|o{~xJ_JLn|Qi5add4#WEv6oE=Z;kaqxm<8W9&SNTv~S@{$ONX++$-AelzQ(F>AkL|nZfnMTCf z3zBI>+`YtCm`23m3zBI>T)rTgM#Sk0l4(TTz95-K#PLfSDy9)}{eol~u|@G};{ByM zyN`(f7bLrn2m_EH7Q2rK2M{D#6t8BB;?;x(NOfi-LIf%~o0oDnFXe2uu|!BPgXNY! zES)Yav64fQ5n^eR9FmNXoXtx)o0oDnFXe1r%GtbRNtCcjY+kZNN)Aazh$T}(B%7CV zHZSFDUdq|Ll(Ts$XY*3d=B1p?OF5gDayBpJY+lOQyp*$fDQELi&gP|@%}Y6(mvS~Q zcce|NH4hlg!?j^4Al z3NP+FkW13iN)|btO;M;5XDY1O+=D`8B`DOn2ZcJDqEPRC6zaW#LcRMzXbTY(5{+uM z6hS0Y(-tF$WE$CW1d&W5TaX}3zf=Ff~TdW|G z*~peFh$J?$7nCb0vTnQpg~Ud6^Y(}&HmVzgKqRqI-PS9JBsQwsdIgZi3s6XGR5xCL zNMfV9@d88=8`X^$Ad=XqZtE39G8-8$0HpB(6fzqbFF+)-k?{gVG8-8$KqRw~@d7{^ zFF+x)k?{gVG8-8$KqRw~@d89L8yPP^B(st60zeusKq0e{tyd7qY-H;dL^2!MdIgcp zMz&r7q^(y_$ZTZm6+|){*?I+$%tp3eK_s)0g)R}vY{WQ2-J+LJopFY`#V--bY-ABk zL^2y$3=@&eMi#{cB;yQq#u@4s$i(W*MvODmEtZMZnMM}PL?qM5;+cSCoT1J*L)}7} zSet2#S)-Nj59PWmViiN zqlU#e5lL)hFN9;`8E3GU!V$?hLxXXKhQ$(~NsKczES7*sW+RIwAd=b0VhM<3He#Hi zVX*|L&NxHEVhM<3HnLa(BAJaWmViidA2lqN07%9ea^_5P<~MVT^QGs^ncvK9^9v$L zJ9B&H2T0~ObLKa5<~MWZH*>bu&Y9oL*;+eie$(bu&Y9oL*;+eielur&GiQD?XMQthYweu*&77^ZbLKa5w${#>-^|%sJ7<0~ zXMQthelur&GiPhbu&Y9n|JkBsatITg&E@y`%e$(fpfS!HYOs>R^biMqmO&adVw}OUNIN8(85n1%GR{zCoT19%^Hs(fs*E#K z8E2?6&QN8Xp~^Tzm2rkD;|x{C87wC@b{*pkRmK^rj5AajXQ(pHP-UE<$~Z%nafT}6 z3{}P%s*E#K8E2?6&QN8Xp~^Tzm2rkD;|x{C8LEskR2gTeGR|Q6v%#7*#u+S!wnGxm zV0pA1lFW6MOWPsITxa>T9g@s-mQx#%j5E|2XRyrLt~!|+EW5Tt63$>5wjGji2FtRI zNX8jzj5E|2XQ(mGP-C2-#yCTbafTY>3^m3XYK$|~7-y(4&QN2Vp~g5vjd6w=;|w*% z8ET9()EH-|G0sq9oT0`zLyd8U8siK##u;iXK3`*;p~m9#HO3igEIwajoT0{^>DL%% zXfWLyO!o%Uy}@*EFx?wW_Xg9w!E|ph-5X5z2GhMkb!U93!T3^x@uddiOAW@C8jLSB z7+-2IzSLkbmImWX4Hjc*uoz2&@uddiOAW@C8jLSB7+-2IzSLlRsnOv}+jmaM&o#>~ z8Os8mewFviFWb0gcvE;QS$?!Ffyxe;Ba~e;U!8g6dYuhNxDGEH**NxMT4{J>eA5~$ zDZJWVX&BQ=ex^=@>abC$j|@?$J`aWJ#Zjm}4~6Q*QK&u-h3dsYXiN)*`g9P5tntRQ z5Xm$$riDnRkufbqGL4LBrASMxCqt`fBTKF4ghV4tuji0NBTKR8kVGR(v*(aRBTKc1 zNPDUQ8X40NM<8r8-O&nfkI{@i_RdD*~p?Zh-5ah=nNv6jVw9? zNQ=&(klDzhGl*n1vgiyVnT;$ugGgp0i_RdD*@$t5rbTC-#}%hz1B`Rb8%fz?)h$@(>$tfa`LTDEy1`O!al6JOto0ijJ# zDAb{kLcN($sNIS}y_r#{0|kY8Gow%k3JUdRMxhQA5Zd&FLZ*=|h7id#vfwcynMM{o zMkLe79ylYCX=KwAAZ$&$2=a0Bt74@ zB_bkO&$IhICi8&m?0#?C5)qNiMz%yuku9TlC?xG{8NCCf(K{5fyVycPh$QW7Sx5+x zWGuBTB!oyZmRc4PN|BaZQwUCx#LNYJ4**xF2&;V3t^L*Pv1At`nd`#zpNY)G(9bsV>N?ZNf}2U#36g0;x*y3R^t~iPKaxerG$NcqkW3@O86of99+0aRS^&Wd0N+(}=|D1j#fa@j5{=jYzys zkW3>oe@e0)W+Qu?0BVwWom6Kt1DQVs$z}!;uM;Gj8EmsBG>NeEd^K5bijd6=WW6a! zrV&|h3X*9=)|-N48ZnkG3D{iNT+$p78%Y{4h9sj-GE^}n8FdxL(ql&TwC5{~rN@lw zfMhIPvZs?KF_vCoEWN^5dWEs{iX~&fCXxH7!dQBRv2;nAMH{h6~-AVj5AaiXQ(jF zP+^>*!Z<_Bs1DX-oFQgZMNWNBv4_Nkfh%Ram3wr-!>H@R~g$tzYTzfM;pKl@W7zdT zmZs+R@7-Okk&D&H54F~k-z}0{c};n+y?65Ed#C57CihLU4+7O?(ck5iaZq4}Q$he^j z;cH1esC=N7_Oy|iT4{W2)5Mx}FPT&ajTrSuDAZ{Ug?h`NP$z*@D4{*yLJ65Mp%Naf zu7n4LL_t}%uyg7pfYpgc!b(|nrjZdIIHwUF6f%vB@F0?DWP}HiOd|_RB9dujga?pD zcu>e}WMN4}G8-A;K_s)01xXOeY-EH7k<3O$cmQdH2ZhW=MtBg(Y-EH7k<3O$co4~K zWP}HhMtD%jY-EH7k<3OGBtayzkp)Q*$!uhV2a(K179;_r5grsW8yVq2B(sqb9z-%5 z8R0=BvylZ!0BM8=h0I1qco4~KWP}Hi%tjU@K_s)05gtS`8yVpNqyB(YJWnkQEEg+zUAPFLwjqJe+BAJaCXNXxe zpgQ9WF^dKwnT_nh3L=?}EJ%V#W+Mxd0FrTrm_-AT%tnke#4H+Eo!Q79tRRxv$R4a9 zlG%uHhL}YIsx!_IvuGfa*~lKOAd=b09;_ge*~lKO0FrTrm_-AT%tnke#4H+Eo!O`p zizr4dVipao&NO12A!gA?tH&%FC?p!yZ2J=;iH&M3&JeR`V0AL;VipZVl2I44XaJIN zhL}YIk%TkU7-xuCG_X1ubuo(uB8iP+77ai$&JeR`Ad=b09;_ge*~lKOAd+ch4^|M# zG_nUPfMlE@X3;<-(}=|xVipaoPVS?aMFWv+)G^KwvuHqd#u;K34MZ}H?7<2mnT;4{ zh*>nSI@5^78DbUu!2ZtBgPqOEY474oT0|z3^m3XYK$|~Se&6|4_2V@j5E~i!3rXojTmRBu{cAG zafTX;Gt?MosM%%=XcFTLHQS7VNM<9(8EP!fP-C2-#^MY$#u;jiGt^j|p=O&gpz(|| z)Yzkn8jCa37-y)lI77`gW8l?^hmF6Cks{+SW1x`C4DpvS5J_wle;EUj#2>|9#y}+T zNAZ_20Lh+B)EQ@pzl?#^31^7EjDbjUAH`qBKqQ&H<1b?%lG%uHhPrLWfa)yHP-mQ> z&Yn%w8E2@oXA^bC8S3oWM4fSlI^zs=_H3eVn=wF5#u@6i83U2bMz$FPk<3PnGt}9$ zi8|v9b=!;q7h-XSI^zs=_H3fgI76L1o2aumL!EJkI*T*Z8E2@oXA^bXi~(vg&QNEZ zq0XL7)EQ@}GtN+FoT1J*L!EJk_{$j3c*YsxFJmB*&2@}3)EQ@}GtN+FoT1J*L!EJk z_{$j3PR1GPj5E|3XNbRyf#+niH{%R-#u@62Gt?Pph`)>hS7)4|&NxGzJ)5XA&QNEZ zq0Tr%opFXb;|z7i8R9QvfJTfn#9zihBpY>%Gt?Pps58z`XPlwV;tcVZG14Z*U&cTo z;S3EHXNbRyfz`?E9e)`Ek!1Fczl?!M;$h=2V*rwIhK6n6L?q!14HjpJzl?#^$$b=m z83U1o1;t;+03_oK@s}|W$!x?pL;Ph7tj=u2I75SRh6dvd4aON7j5EYv#(*X<&JceY z1CiuDYOrS$4aON7Y(GPTafbNI7;tsQ8DhptL^2yO&JZ(JVs&OC#u;M9O03RC9pel! zVWnkQjFpIFqmFTg2ICA3wx6NF;tUPO85)c;G#F=SFwPM3PJ%{^GsI++ zh-5ZmoT0%uLxXXK2ICA3#u*xnGc;J7p}{yqgT)ydEY8qioT0%uLxXXK2ICA3#u;MX z$+VMW-boaaQ5W-0B9hoB=AA?&nHgf}HlZYg9UCcX)NHTlJypw=r zafT-23{4hiXtFp%lW~S7;|xv48JdhUG+CUX$v8uk#Tl9`&d_9>p~>P5O%`WpGS1Ls zafT*~Gc*}zXtFp%lW~S7i!(G?oT14$LzBfBnk>%HWSpVN;tWj|XJ|6c&}7dhnv63v z*|Uiz+XLBToT16$3{4hiXfn>wWO0Tj;|xvqY@*5H3{A!vnv63v8E0rR&d_9>p~*Ny zlW~S7;|xvqY@*3HLzBfBnk>%HWSpVNI75?hh9=_-O~x5oY<<*Xb6tzgbuBj6wb)$O zVsl-K&2=p{*R|MO*J5*Bi_LW{HrKV-T-RcAU5m|iEjHJ+*j(3Qb6tzgbuBj6wb)$O zVsl-K&2=p{*R|MO*J5*Bi_LW{HrKV-T-RcAU5m|iEjHJ+*j(3Qb6tzgbuBj6wb)$O zVsl-K&2=q0*D>xL^S1(#VBEXOxObCr?OjC(g3_ii%o9rL%QjgR?TQAoIV zi^c0={#L9`cwNh0xJD%5buIS(QOnXIL3PHxTa0_R824^5?%iVCyT!P7i*fH3@wHgIuEpYYEf%k9v3OmJafTM-3@yePT8uNa z7-wiP&d_30b-G0xCpoT0@yLyK{S7UK*tnIViN${E;P z*J5#o7Mtr@Y_4muxh^I%geI}ME+#WXBw3ZmWQHj+CNo4Kd2ga^$t4g;B9LuME`dlg z*R|PP7n2!cb)r#BW(Y_&*R|PP7n7G_b*2%U>tga!tWF{)F?lH>nMN$m5R;cebvD<< zeg>1@P-hwuCLl?%tnL>2$E?;q6dOx8jWMy z5y>=SoFS&BgzAhl#MG3CBpx=VrbHz1uocD`VrojP&NO12p~5&rOic;rWSk+UrbHyO z5#tOoH6>OjoFS&B1SE+bRAXvNM6yxGI73WLiPf1#j5Ea4lvtf<#5hAtO$pT*XNajO z5lLo-n3@uiOe4k_DvUE!7-xv7Dd9qlGgQcvyJ}2LiPf1#j5Ea4lvthJM~pMX)Rb7A z-A9Zw#MG2fopFYkni7$0W?-D5!Z<^PafX^Wb{{d$P+^>*!Z?Hc#2~p4;|vwX87ho3R2XNdFwRh6oT0)vLxpjM3VGsC ztuW3|VVr>_dz9*IW?-D5!Z?Hclmh8b#u-?4$12P2C_-W*`H=vBAxWvvghV4r?9Py6 z)UoW2(j;;pNiuG7P8Mg#8E42@oFQj%hMdJ2au#QhEUBzX#72_(lOP#q$QftIS)3tf zoFQj%hMdJ2a>f~Q7H7y=oFQj%hMaMRoW&V(7H7yAXUJKcA!l)hoN0R@IxO zecQLrY~3rr)!WI;ynLjxDctn+f+Tm6s*_YS1972N@8^Dt!V#UJQ^|-<bU&y_hgrglex; z7}IT`P#qQu)nTDf9Tp17)vFdPLL_UF5kElMRudG)9x3WxwO|nAI73Xgg-B*2#u;L|Ev(KovS1M+nMRB=#B^IwopFYkZVQo2BgPqO z7A(T*Od|^xA(Cli!6HPm`-pLdm~IQITd)X)Y}DBUCPXrgELem{rjadn5J@zO>9$g2 zOt*zXVxyRD3z1}Ii0QTvNoIzaZVQoQW{Byw0BOM@6q1=CrrSa!u~AI7g-Bwfm~IP^ z#6~gQ79yFA7-xv-wxBxW3^CmnBAJaWScFJsBMTNGlG(_DMSx_SA*S0xBpY>%GsJXT zSe@C(f<=gAHnLz5BAJaCXNc*xpgQ9WG2Ip-nT;%1gh*neoK4g@o0D_4j>|28pI#_u zb8^n+WzRx9X2S` zPDY_lzbMpBMj>rHQ`0&bs@qc%6f%wM*#{z{M(%+~qv?Mqve7C{?b|*(xja5CXr%_T zC^iaJXB2Ahpinykh1wAyH1>l+H7yFYBT%TOMWJ>C3e~hIWQ{lWgGi>4u^&Jh`#~Yo z$k-1enMTHb5Xm$$_Jc@fIAcGEBsPl498+XW=7>UKqnOMQk;Fy~drbn7#6}H!O#+d` zMh)A(07zp$C?qzD$s7?$Y!s6@B9hpsVeAKy#6}HcKZs;DGWG*V+rEH8W+U6afJkN| zV?T&wHnJ5dBAJbh{Q%O~4+@!$jQt>z*~r)rBAJbh{UDOr$k-1enT?G70MfQEppe;Hg*sMH$TYGz z2O^n97Uw`D)5ttMBAG_!=>ch;9)(OJ^Yn;hHZo6-NMTO;DljhIbpDa6NZuHguxCdRB!Htu}_kA zYAnMcnVR}c+98=n8q07ZGy>p| z%tpG8%^{hMbh98Ll@~Z6vyndka7bn&eg5H)%treB!y%cC^!bNFG8-u`K%_qZa6)Dy zeg5H)%treB!y%cC^!bNFG8^gh4?tRaI42}FYU%S2ha@(#^l%PIY-H)-9Fo|`(!)6< zu~AET0V4JJhZ7PTS$a5!BsQ}2a1KdqWa;4?lGv!FFEAidd4Ur$8|m{8hh#R=eQXZN zY^2XW9Fo~c_pv!7vynys1i5c+@6_D(os*>-ckkL;iGODIPVbsb=!9f4B@40^k+n-x zx{_Od)o^g^mG0N%+sKBIjh9_BIjj+F0Tq3^)wfa_AKNssX5C9Bb>v`0H9ZQ| z$|%%60ipS55Smj!p_(3rtV!k+5UGP1g=%^fGL6hBAd;zRP63eS6i~=CGJXO`jW(cl zjGrKqscHNKkxWhFCx~Qf8b1M~@e>p>HI1JjQtw$5GL7^FOY9KiCs;j>;bgQMKS3lL zpXQ?hscUz>OYWRZBi-@rkW3?eQtpsUBYjeiNLyV(<26?7kW3?u6$8@JgE}F*-;L|0 zS8r(y467U01*CCZ6q0sYdQf*x(({%c)FDaFTY6B3Bt38GK>=y$L7kA@9maK2HQV~K zu2i4fIW@OcBFNLbcT8`ek`EG=*&c)>Hq#OYa_g)oDy=G!<)sjg-fgD}$En>nPL_5} z-zrbwB}N^}ri3KfhwuvAwkZi(FTW;mo4oVwTKiU<ze$>@gn_ExLDMGK22>qy&H^{;!#k8GrA>T_PWarce zrm7k~GPWWD$D1i;(q_zUS|*?t7_fIUiG`2r1I*E=aGt2w8vXrqA?3(sfLC za|F;!<_J*8bl2cLUdR^dP~E5(3h6o7sIx^nR`Xm!f+g?p%#6`DB9HO0a>6p=yLe zwI&MHa41y6p-|NXp+yowfZR9ozv|IA5E>J>32PMZ`X>RN8l58~CC*}5M+n)VG@u|TEdbz>b-$#zl^>fk}48U=;g|0vWEg+lFr6zYgVq241PG?IYAsBfZ?kpx7> z#&_a@vDuxkL|;oUC+|mm=A?ZU)FX)i;LaYyU_W@M5)QV2XdfT2dq>W!~4i|-_ zw=KCLT&Q9MCarGC4IPr5(+CVyw>UovS$`UVK_u%>BQS_0y=2J^vGGRpusYMoXdWPq zLZFaoWE29COe2fl)YC7TE0dnm`3O8y303g+8Ab#u0$7_jdVC0Wk8`e7KM7N zp-}HC6siU&)G>}iwFwG!o2lG(`E0V0`=j2!^d*Z~Tejf@>2lG(`E0V0`=j2$47 z*~r2Sh-5ahFasbh%z#2>BMUPilG(`i0w9vv$ifVWWHz!e10XHTfI?;?V-SdBHZod) zNM<7oGa!=L$l{}jWHvGe0Z5CFqLA6h!VHLHHnP0{h-5Z0FO5iMBU=`yNK0lY6MT`O zSTaK=BpO*VLx&_93lWWS;|Pc(8d)+!yt;7&sBRnqg-j#k2#91F8Am`Q)5tXH=s~;LZQwLAT-v1LbVbKb=;v)XFC+Cl~BkUZ>#~4 zOe13rh-4ZWYXGFN1{5-lj5Q#VX=JPck<4($8W72BWUK*@#u`w_Y-Fqfk<3QM8W72B zWUK*^%tpo<5Xo$0tO1b58c@h=WUK*^%tpo<5Xo$0tO1eCM#dTdX{-T-%tpo<5Xo$0 ztO1eCM#dTt$!uh-0g=o`#u@-=tO140M#dTt$!uh-0g=o`#u^aGY-Fr~ymKlk_{m~2 zCp)wxFF!+)SgYjaXGpec6))$)aFUn5`)E_OZWBz6HM_=ISSJx;NdaG)+p~B3ZrR4h z;&*k{EXiRyI~`uDrZqwm&pmr5m#-av$?_Wnv~_MWn?iVKvqss}y{o;h7pPew=FHRUnmlHCLG@^h=eF))%Oe1{=;gC!teF))@Oe5X@ z;gC!t-T#3|@jD^2k-o(5kjzH9d(R=6jdbIJLoyrb3xM*8yz4#{k!KdI!9%tpF#!6BKAG?9`+G8-v3K%{0@azbV!-MQ$H%trdwp+hno z>05^m$!w$>7Z9o3zzLa+^qGW1G8<{!-yxZe^g+8rG8<{!-yw;OXL?qM5oFyR5S)!2H$ebl2nT^a@ zB9ht2oFyW4prep!qzh@Vk)?-qLZVS!ccnQb(WtJe2py7WRM&lr4oNhs>mEagB==F> zoMqY}b#s;|B%`iw&JvMi)YZ*dB9e@{x`yAe@%o6~37JObEa5`tEK$fb((pT8$ebls zXEritiAZK6bC!r?8kxfYq&W-}GL3A3jYwuATVNxS*~k{yh$Qz>-4@t@H204}b|0Dh zM5&h*~r{KBAJcM{Uegu$lO05&Hba0*+_%$IO=SHjn$b(w!lUt)5sRsh-4bs z0vnLFz(yg{$QIa$WTTF8hPnpdu|pV^@?gp>7LoygJi}afUkM40R2@W0M$XsB7@uA=#+Y;JZVzQK!Lohh!Qt&QRCjJ630$ zp{~Jqhh#R=;JZUc8%=GKi0-89+uXiqFAw!5KSNn-m>)!;b{Yz`F(}mQqELGhg*wNg zPLRL^6%^F|sQrXOwLA#T7om`~(|i#kSvzh0ib&RYTfZWbX=K4(L=ufG#hlo% z*vXb+&IxraBa&#;wDl_@iAGIZzao-o)U@?0BAG_Eeg&khUs1?3GQW*Ty*p9JG}2_U z*mbsk#p-d?$;%+dDK6U_ZYSBQ-4p1@N;hdWZRLqVy@61u4Md^#E(*0RDAe8sp?O>s zvUXai5|KJyP^i6&Le_W-RU(pUWT8q#GL6jR0@4D{DAe(SLZ*>IBMIqD3JT4&3$3-N&kIdr&(pH`*WcQJ+JQ2x8ojuw`BpY@1Xcv)e)Y-}tk<3Q6@&u%5vha?(V;y8yS8d>5vhh!R6gs$$~hIDo3Hc9zxjI~){tR@a# z7Nvx@rhDsJwx&g)HomuKO@~(RYb-5JdM%44<9T$Pqfm!53gacxb8623(mXW^b@ZZ8 z??)7>tx?F@X=`Idvc}um7?DgPTN?w?JT(fLMz%IaB-6+|H6nHNqL681o3IecG_p-t zfHY5yLZ*>z!a^j|$YR8ZWE$Dp7?Etynx{r28+GQX0coBZg>2NBr$!_jb>^uN$!uhv zx+yv0XC)hRy4-C^hIo16R_Q;#x;ZH68t;fHO_;+${|K8p5 zrMIrOTAg{Q#Y)0dL<-1klqAcqwaitN`?x0osAVvol3e^-S)LuuSb}$Nc$e>Vf z0u-_)nVSWq1$a@&+Gzn^M6$+PfESTWBi&ssmPuw=bF(NU8d=UNsNOa=n^tezLtzx^ zZH+>rk!9U;7a|&2);)(LHnOaHh_ppDG|3j#C?qzrtb6X9Oe1?JjOSz;*`gYeOe5QM z4M+=yqmbMkmURysZ*Cl`GmVTmAd+ch!Ei(}jVu@rNOSloWE$Dh9Fc6)*)AeP#(AcA zceHJ3jz}^yv~6jQNOm8Y!v~}-%~8lko$b0tB(st2x<(|kkvV)sG8>u02c$WC6fzr` z!$%~ukvV)sMjLsj){<-ikui6ClO*8nNrF#Ge$JrQHvf%6Z3_z34k*+vN1-+lh1%sP z)Io$o?Q#_AAOfMSv{9&CjzZRWd&Y}Mrjb44MI_V6p7A1*X=MAt0BI|26f%u0T8>C& zI19@olG(_f@gkDh$e!^clG(^803eM5ppeNdK-z*Ya~K%BN2LyMCffKKY7kHG711{YVNso4w33iBh5YM zkW3?stK)^3Mz${ukxV0_0D!c8VJKuaG75l5W+S5jh-5Z03V=vvBclL-Gzx%1HtLK5 zAd=b0C;%dvjf?^ylG(^803w-*O`FbHC=D~h9IVjp#&+> z=1-_0cfOx72!f~}2n|UjAt91938GRyHKhbmQ>rN`QK4EQx|dD$F{hVrtx z0wgVxm(3NFq(x;`Gsx@S3X78*$?M(__35dA2xfk=#p;o-9XlFF7h%j;v+~ z)1cus=Gjka=F_1)`|dwr{}5O0+X>Q)gjY}&;Q>qraL>aB$#0Q6zrYUKbD%8j<`U}V zeEL2JW0>_)0cQPKfLYfSV79{+VAgd7nC-9ym~|b(d?+u#Y-1?EY=>o%!l#Bsr3|vY|2`$_tR>sFDxm1trN*B_GNQN|K{WK9m=fBuABeC@&~k zj`E=#mHAL!fGkJ(>3>1Va+II`7nCeV`RRW_$#RsR{-ZJ<$_tR?C_nu#C|Qp3)Bl2! zFDO}#^3(rgn3^h%(otdd0!*Uw;qJ~{(vywdH~AUk5GF$YP*d6sAMgY zu^*MJMKboIlC?<2epIp+$=DA{8T%2k9Ld;^N|qxT`%%eqBx64+S&n4v2c?Yt2w9F~ z>_;Wbk&OMQWI2+tAC)XeGWMgAui6Q$2oCvw!hc& zX}f}w^n5*^wks$}&)4&5yMmJSd_HZ5O18ht`fJ)XvIX6Hh*-9I7Zh%VGA~`oeC2NtK8-P;I4G^-PmvaMDlC7{I=LV=GTVX@a z4Nyt8!iJn1fKtv45R!4WA?F6DWI2*^15~mc$+-b4S&rn~0F^99a&7=hIX6JaawO*l zsAM^ka|2Ye9Lc!>Dp`*5OM|#~$b2F!o=&*i2Sq$Wy)rB|9>(8l%C^DH>K|_!GAV zt05Y!hG^uM1~DX7Lp1VBg9Rnqk5~=SVCNJKRzoz{IYooj5b~HVgd~sY79cq?G}$?Y zJf>S%oa9Iz(=8~;(OVwVEhx#+yUA*XCaW2mtY&Chf$2AfCaW2m`K3V&iPa3v{Ep&+ zk{lVD`K3WrvYMgEYKCThX|S+38DZsN--43mD8DpVP_i85mj(+;mLpa(H1pSM;Nq-i zXy&iiC@9H()XX0tDk#a(yO}>iR8X=U<&O}dlGO}NRx>o^8f1L%Z?c-9nLk2QSP{!n z{;+RB$#RrG>|0Q>9I=|A$!dmXemfC*vYMeO*C3(otY&D+HAqyl7Rfb8RI(PanxV;R zh9;{SnyhAMvYMgEYKCV1nknohRx>p7*Gv_ZtVOJ5XtJ82$!dlss~MWCW@xgSp~-57 zCaW2mtY&DknxV;Rh9;{Sn)&TS*h{QtXy&&Q6_jj0Vl_jP)eKEmGc;Mv&}213lhq7O zRx>nN&Cq1?kWE%IG+E8iWHm#R)eKEmGswff(4X?KZvm2;p~Y$jdDyqGILVPb>|0Qh zBZEBbTTqhysKsiA7ONRrtY&DjnxVyNh8C+CTC8TM=C?{i@KqLPmBm?QaaLKJRTgKJ z#aX3svf8G~=0oH+DzHVYwyCn(rpjuYDw_|f=C?f+Rz$X?Dywa(Y(AvQYMUyX52>=+ zrpjuYs?|2%&b5(AlParqs%(Cw%4(e|n;)sNTBpk9N2;vWsj^z9%4(e|t97cZ)~T{u zr^@C>s;t(jviXrJt97buex%B3ohqw!s;t(jvRbFgYMm;pb*ik^sj~TzDywy>Y<{H5 zYMm;pb*ik^sj^z9%4(e|t97cZ)~T{ur^;%bDw`jvvRbFgYMm;pb*ik^sj^z9%4(e| zt97cZ)~T{ur^;%bDywy>tk$WrTBpitohqw!s_dF;mDM^`R_jz*ty5*SPL&S0bz*r)`Sy6zb){)<=C@9I9s{Cd}K}pV3 zYwVh<{ANXAaZ>BlSPfBQHAIco5H(gq)L0EsV>LvL)e!QV6&O6LA>=nJP|0ct`OS)g zlI4ii5H(gq)Yvr@`OS*Liby?LV>LvL)etpSL&)zo;EJq<@Y7W_Rx{LC%}`@CLygr8 zHC8j!Sj|vlHA9Wn4Du@+*dkUl)L6|>V>LsK)eJROGt^kkP-8Vijnxb_Rx`-2aA1pA z%}`@CLygr8HC8j!Sj|vlHA9Wn3^i6W)L6|B-ZxylPpigih8n9GYOH3EpYFh3Vl{*O zo<~7RX60(EW~i~6p~h;48mk#TG^Qe!2s8ggUzqLw>rWpd{l_c>IlpL}~{4=??T{HA9`% z4D!<*g~dq~BtP9zP?8+UPj?iQtVQgaN}bgVbvEx%XY&qqRx{LD%@A&hC7sOX9qMe} zq0VZCI;$D#tY)aQd51cy8S1QNsI!`(&T57_s~PI7W~j58L4LXev&m|PI-6&xvznpK zYKA(i8S1QNsI!`(&T57_s~PI7W~j58q0Z(R>a1p{vznpKYKA(i8S1QNsI!`(&T57_ zs~PH6GmM`wZbbNf+Uk(fslz7ptTfuB{n5|VhWiWi!w|y!h=VZSlL5+3i!eX1BFqo0 z2=fb}2=l`b!hEMim>-4^vKGlsi%Ql^*=a#3J1s)iBH3wC$yy{kEh<@yWT!=?renm& z38POPlE3Y)@B*MpIs9I+yveTTe*5j0r={vi-hvJ?VE?20?wK7Nqn{rMcai2D1yFVp zg!w>=P*>y6h+4Aepfc|$glz4ym4i|$V}x|=`Q`*l*&7k&n-jvk^8re=jgYlSX6R6v zrye0&yUfs`lJ$~Q+n|(c8zJi@skTwcS|rsrDp`x9+D0YoPpP&+Db+SY-Lj(%OsZ{E z<_8>vtVL37qms2qs%=!V7D=@YN~yLHvKC3TjY`%cskTwcwt1y25wZ6t*%X~ZBWXZFN#@qmpfPQf-4$s%?a9tCMOQl`Kb6ZKIOqNUCjA zvK+CRp-rl7Sez9SZBlKclI2LMZB()xvGKi4s%>1HwMeRMP_jBiUZRM*jLgvC;;cn7 zLx)P%BAKB>CEMy)&Cn(@bg($98QNIQ&?Yl(GjynA`w^=d z+GK_f7H2g>o6OLmlI=&VW@wWcI$WH!NM`6z$y&r}hBld@gT-0R&?YlH;jbD8OQl0xY&Dz+#TV zQ(vq_q-F?8ZBg<3trC9nAUl7n59!(Q2A$fs?A!CT4s^s3+4)SCjgD!GR&irwMd3}RI+Bu zFpo;sA{pjU$yy}CJSb(DN62y{!#pZkI%JqfCCiZv^QdGwl3^Z{GRz}nIg()>l`Kax z%%hU!NQQY-vK+~z8Y)?iWS9q~OgA88Ig+UXRI(h&)Bq}3j^vaZlrnrGWNnw>6P2v( zGJJwkhEIgF?QHE*j=j&q#Qvd+m@sp0i_J{2w9F~m`5eckxUJslI=$_ zH2_K(<`J^C%P@~h)^?d1KqcFcWNHAFESoYlfJ(A0$$JmO@Z=BF^4`M&B-@g__pqQO zIgSS|n2gsAMgYsR2;R z)Br-(BDoL;N|`H1$g(MO<)~zBm$`COvbM`yIVxG(S#2ZlXT%)I6b5+81w({n?U58Om}Y4wdA{P?igEsAO%I3vsAqZD%z@S*8YH zaaJ>w<#GZl*|sDX;!w%9C7BvPCEJ!{Y58*0RAibS7bk76$TU4DS|WLmLoakj+OfIB822PUzJmCRFWK3<&+zh zBu7;_ z>___W4Jg@ItPkIylC_APzw5&{xHxMO8;kYf8(f^Vh@HRd!#A)v8;kYf8&t9*13Q1$ zhi`CkwjZ&vSRcN@#o2zu#$tW=1{P;yu|9l*O12-d^LKst1{Y`h5j!u|hi_nUc3!Lx z-=LChb#iGRm8?aqX3&RkaBQWtsJ7nawklS$~%0 zvIlswd4@9U&oY~5D6{@7vl^_-YOpfv&oZmQ%B(-jtOhHy8m!FbL&~fME3^5KGONML zY(AvSYOpe!4=J-6tjub#GONMLtOhHy`H(WJ!OCntq|9otGMf)6vl>ia9vyFB`toRm zWSiHQN28ML#rpDSRFWgDzC0S0WbDwFM}v~hhg4V%rZ11i#mU&AFONng84dO2(WoTH zC4G4`D#_SUVKrDqZcK*7Sq)ZU^9&WaF&P(UEn@Qw6}eRc7iT$=TO~lrYOo5Mx2dpe zC>2(NRoFF@3Y)j7uo|qw=4~qM8cK!Dhg4V%R$=oY6}d4PI)v3=6*eDIVb@S9tOl#F zYbX^qA5vj8ScT1pR9FpGVe=ssHXl-9HCTnshg8@#lnSfCD(o7HzH}NonblzWCTdi& zV;#GOQepEU6;^{)=zIvP87i!12)9qmbyYucU12pth1CodRx?ys%}`-AgFaXs_mVzX zjF22d^uc0OlB1$NSd2>2c73oIlx!^42a8cjj`R9pF)CS$*jTI&7USaNsHhJX$4Y&$ z7$KPtsj>MGeXtl8Cu6ZbSd2s3a|_v1=3hU@vBSPYA^u~;80MkP7U>x0FpWG!N2u|8Ogi?bH7u~;80 zhQ--ftPd8WlC_A9#rj||F3z?(HWurH#ke>-GO%kC`d~3E&aO@9gT<(1M+P<)>x0F( zI6Ky{vAD*@Vtud}JlR;R4;G`6<%o^N`d~3G&T_=g-}S*_T%6^IoxkgY#jrR#f7b_# zQOR<|&foRHVqBc%h@HRdgT=TwJJzxDcYUxJ7H8-0`d~3C*^z;rzw3j=xHvm9u=96) zusB{^A1p>lYKA(i8T7$oT%5E>A1p>C$x-;F&|;;k4;JI%BuDySF(_Hhpbr+Kl5BP1 zSN_~hiH#vAOc*wPRC$Qp#;6}F@yA;HF+9XbZjKDUWuM&~*%2ztN|qz308q(tBs2J^WI2)<{8$-o{?EoXgd|7$ zlP{yA%B%rGmLr)pKqbqO%;2Mv<%rcB`V%j>IBSv2;DeIY91WSlMjZ3T%5H?X7EwTwmMcbG-L)J7H2g>gVhWTnZd`!S&n1|AC;^{GJ}sw)*_iTKqcFc zSk2Io8GKlr)eH@pH9#fXk66vnkXZv*Xl2IR&a@`&w%aL3wKqbqO+&hU%mLs`V zfJ&Al8TCOaqdr2GBe_<9N|qxT^-;-kB%?kmS&n4XMhwoiP)W8r{gD<_lC4hPXNXF&)wN`%0F8esjpH*NNR>QRx{|U6mfB~)wQvC27Q$x zE>3c!uTn&%Zgs^=_u&b90^^y%wldh2<68~d%KCDoZ|@+;rUH-HXYXtRuNln}R`S;; zg|G6CW8WRL=RmsHxAT65g^oCaE+8S~)lOj%_b#TwcYF0eu;=mPCWIF@4;epf_(|gJ zC;QrD$ZtmTk8Lu#1C+S~fHLGG)Ig&Z$&ioAe4{~_@7M_QLlwe&qd}PO1_<+w2A~Z2 z2sN8g@G|71G9OM5vKGlS0V-LGWSRh#tVJ?S07@D15waG^kdI2%BAF&YCCibVf})b; zNKQdf$#Nt^J}70#N65B1IR!-}%aNRdqLSrEPC-%0awMmqpp+pWA}oXNyg2fWO0&lGbmZllW{XBSZPD$M@3RE1*IMpizjULDmja*>q}+ztgLFMUfCH^Ha zuk_5T@YT0xUWISu%&X;3gu*55yyFn&TN1+j_=Pa%aIKE zsAM^kAs>}2M{;EVl`KbcWdM{i zK0=lw8S+udawJ1ODp`(X*h3}DkqmpFlwl7c%aIIwsAM^kVGoroM>6c8lI2K-JyfzB zNx1_`DR&UE97(x@N|qxjcTmZ4B;^h&S&pRK0i~2X2w9Hg$^a@^j^xS!C}nmWA&XOH z$77|wJqIC)v%I8z$@VyzB59FIvBAp6MqEDDeEIn8^M3iQzu$h9=bL?}rDfr(Z%fO< zH&R*_u$#DVi^@)YHxR;nH%F*py4mWcz8eUY`4)&U?^}fV7Kkw4S`g-2Ai{iW0Vq`g zLKeJC1fVkCS`e}pNmYPK)*`72P{~>(RRJiaDnQ6uBvk<_S&O79KqbqOR0XJHIg+XX zl`Kb66@XHz0)%W+l&S!gEJsomfKtX~gshijTt+49B^j4d$$CkqAwVfL2|~7oNKFDt zsYwvBEkvpURI(gNRRBt<3J|g!NmYPKmLsVOKq=!gLY5;Lmr==bBvZ)?_0F-hrkC3#eDnDd|O46dLyb%DEWUJFRN`q1^T_7Yms>-DcRFbW( zDwi%mDbFP!B-^~c(;1a4M>3NDO1Z}nA#0I5Lx4)wBAMt%CCj@!>wrpfw5iIo4xnVC zVO1`rqms2qE~TTAwMZ_dgOZJgRW=&x+lp~ zHX^Vwt}6H0;o_|4*;rhaGfG^XZFO?d2$ZZ|()U@Tl6taUViil3RV?~GYgiGh*7Ti^ zsARn)GYOz%HG{tQFjne&4-t}V>U$4SNsga2x%z-gGQQX3>H{iC&)3*dQQw0Gi?gG5 zjaB~o9yC~7F2W%sdt6N}!l9DnNZ*5oN^%UTv15q73k(*Q8+Q=0IOWD2RI)hPwp3%4 ze~leO^j%=MB66Isv15q73k()#=Un;@I8d_Vr@jLYm8_T8@l)Rchl{fpLG|MQqg8cRr$$^*kH3YpklQv8qzv z`G_lG#}GEhqVIf!#aUIU?|eihYZ04c(RV)L;w(pUr4^Ly3`O7Z3QD=sijc)AS6WfY zjtp|86_xA=CRbWf$+mg9(h5p;ex&bsMI~zyJD1USyyD`l=jBQ(D%rLqS6WfYj&-a` z*LS?Ov59fLodJ z_Kp6IFs>xvEHMQfZosE5S@YNzd+y!u@B@Y7b0JH780JA-|0JH5IVLn4t zfV#y-A>}hf1tkkUpCKwJS&Q;Hnu3zGD1UcELCIQ_AA?Yt&(Rd1Zt77p^J7p!$r6{( zrxcVdNBO)@LCJEI&-(=Bw{M8l7JmDgEtDUl&_2H#qySlq^O=N#lC?OWNhl~;i}RYK zprpaG9Og9%E}q{2T7axYc}-GKvKHkvNkPe4l+Sb(l&nShOcyHinxp{PewN<=T2Qk6 zEWZJ?pk(`5e*RTZvi&SS|0*b1j`G#Xp`MGBSvK-~-o&_b# zQGV`OP_i85=bi;6%TYdmh06TgvjAC+^7*TRlI1ABmQ+x(9Od&@1trT-K8I6Kk{rof zC_&lCulp1r$x$P}?o&{b95wPQF9jvZQ6s*5qWG%|)F$zl7B33iVTPShy{OUsivKHm@ z7zHJ3QGTyTLCIQ_&tnvntVOJ5khf6c;;d$nw@?<8Y(L7cWEGTbKgzFU6_jj0%I9oR z$!Z393uQscjts13XykXQ6c%SW%I{PuC|Qp3dCP*5<%rb`jr?8_T%6SmjeOp+pkz79 zuYDAhEJyj>8U-cGQ9f^pN>(#8Sk2JLuYD92XZulpr%FM|a+J?k7nCeV`Mn|qCCd@3 z85;Rrl(;yn85;RDuY!{0D8J@aP_i85_n#D$EJyj>v!DzQYZg!CtfFtY&Dkd4?vd8JcXKp~-57CYxtyvYMgE z<{6r-W@zSj)L`3L&CtxReH4`J$iQlbCYxtyvYMgE<{6r-W@xgSp~>bMn)$sV7(A;P znyhAMvU!Fks~MU$&oF7iu(1=zkDEAhNa@sJ6MBXpUzdF`dK*r&DK!GZe5Xg4pU5K2 zk8KF^oFL4PZ3y$DHNyO8jW9o2Bg~I&_0sqW<3@y6++;e}YKx<4i=qlYqwRAP zen30^7zG)AG&}w_3NrjqcKmG=WcYFH_}eJR@PpXVxA86+egr%IHjXOZC9CmZ|bf#aJBmRa-ggt8xVf;P5;5e(CUiwCeCVT6g#ytvq~=)*e1bt1pLNvXA`3bQOG# z*WZZu`*Qe=70}1)Z^XNP(8ud<#JgF!6?bj;9Q(K8&JEwk?Q8Xp{lihR;!a)d~!0 z6&TYhFsN1H?K>aIso>pAgh415dT5)Mt4X-|r;tg*-htCjSe7vu= z6+XxDw#CQ)ppWBii;w@|`#9dV`1oIKi%-PD=Q!TB_*5)>ALTbZS`f82e2$h6pQHAM z2MnV8hR;!aweY$!-(TS~_{aN4_#XV@{UdxI^W>y$NdqWd5M>gkLTfL`Z!^BEN8(3Ve>&A8t;8@8k7{TTDms!0`g=-SGSm#1F>{sCR=N;)mk}oI2Iu+$nsH{8e)VnpPcf)7Y$N7T# zHt6H_LVX*)kMk9NxFzb}R(viP&gSFxgkNfj^)Mc^U_1yv>JaPU_#b}C0ltU!!STNZ z`D{Tx!!I^~AG8nh*#`T6TRi<(YlHp24fg-Gc>k}L9oAom z_19tjbzFaZ{A+{_&hM|`a~vO>&xDV0|1{#`PxwCWpGG{MgvI0jX~f5)@O_*=7+=Eo zaeOcz6z*Y({o7!BXoLQ5gZ^%V{%(W*ZiD`AgZ^%V{%(W*ZiD`AgZ^%ductNI;`6&E z)XU*>w0(uoQU8U{QGUbcsQ<#}X!{SJqx^=?(e@ucNBIqRu0-2^7>?ubD{=i1hUX|h z;d2~+CC*p)K90W<=P!I8#~&t){PrBakK+#$Fwyt5cs?fFK@j&}tu0=E7?5E3c>T4w zehhx``fG9h7;a98`>!6?kIiPhe}&I&rQ^pAJ9*^9A*JCHhaEq9jQ;DCv7;viHh$Oy zW#h+98aZ~-=wV|59Wipk=u?MG96n~;@FArMBPWKd^rOdS@(JT6Wk1pq*zp0LGCce< zT(%FNhLk3a8aZj$kYUG-4#uO$4JjQz?vx3mM@}dYDTUQf8ad(Q5Wu*xlZFk?d?rpf zWzs1DjGZ)L%#hNKW5c?4-0w$+?=UfZe^P135hIT~<%A)l#~we<{yk>&*pc?{VaFXe zVdSay>G%nub)_9gjvAu>>R5Ql#E~bIcAPMB%&;9NjhsA5{~4~r51TYhKXiyAAgjxl z6oq={|yl%IAi>)|*ao|&XiSO~s z*9spsg#3$>fOpmH{#NI6gNx@O(6@_y=`rBl)MxE3BFNh1eYR4L@oWvehx(k5@HrFo z7SB1rd#TTYgwMY~ugxm`8+dQ^>9HnnSDSKcm&LO?@LkpCtc1^%ptpFg0dB|T7ZX08 zf!^Zz68J!kXV)z7@Q3;8?|8Po4bbiFXyw*kS-Mmj0(`pex5p=ZZgAXhCx3L@ulGLi zZ`T$74fqUQ@1qHy)w6*&{9${$E6*15`^#3qXQ}^j37<1S-=3{3{Ivt0qdpHNd|m*( zxRgpS0iUZr-&;o%*shv#YgfA(wE>@}K0i(PobR|FkFHRjZBALfy3VcVTh^aIuZPXj ze9$kxp^@uf1HFDMeFOT^d*Z*s+UgjvJ`|Z!Pc7Rl7=@wqIy-OI?5u&DEvS{>pLxIu7*hYIFkdQR*`% z;d4LeEuOyvAFn>0*B1rGv$=9>m&MZq_+<4Nmhd?Z^cK$);O**jU&7~k)T_~pz^AHD z_YHWvD$1>07EcrSboH5>@VON9?P_!d@EPj!kA%-VptpEd0H38keEj-wrdFJEuIm;YwB}j!si~)TmQ@l z-bZ~pZ7K?kXEWv2E{kVN-~-fWXu{`I&|5rb03WJ8_a=Ov1--?y1o(LM*>p4BuAP)y zyDXj>@OJe%CE;@k>ec9S;M3LTxrEQ#ptpEF06t57dT-9#wV!fpSGyYZ2R>JQE>8H| z0D6mO4)FQv^H#!VmF}`6#3br;cs5aP?Xq~f17D#&$0U4C1-->{2Jo-c=iY?RGoZJ4UI5-j&*Qpn!P~Wya%-2x zQv<${`ka#Rxd`+Y&vf8D)aU7h&)cB4cs>B$TYY+mbD!)F^R=&XYnP}>r2~QYQJ-lE zpKP1V{>-O6|5Pf?0X{%|-b(m<1A4V7b?zbmGXJ6KvyXCY*Rh~)m&HrNfsaw2*~-!9 zub@|((gVOJt50bwQJ~M}$}RqOHR=KUT=f~2@Ra#rIvuaOS665ItymM#K?XP^5@X?PKM>+1#_fG&Hi*pR{ zxt-;ki3y*%j{EiAN`mpks~Cx5HFQ&@eL zuO1U+{_p|Nt9|JS&@Vk+<_|vrz0Dtf4f^R@?VPQuwBi?MYl7qu^S1Kw3T z?kMG$-wB{^SEJK_cT=Bv37;oHZ}B_}yodU1w5=#Go*yc=c3C{Vf%j6MpCo)P0KLUC z4R~+$c_QKS2IwuGcYwFlXZ!7VyY^CU?Xr0G1Kvk{rY3x@1HHvF8+bqUc|GCtCFm`l z(hucdYlZ);7XCLtefCt2`8pc(?Xq}j2=Kw`Gb`b9H|W)-bPw=R>ho2?XT$AfNsHg& z=>~j~`W&Sk+cggK7SAN$?do$^!skiUtI@N-?K<~HJBR?|*-p8&%i`Gy_zaC_e8T4< z(6_76bl|hq=jnvcCyr;e`mJx~hrQCKJ9fnHk7L^?$N0AgzEsy+P56v=+>iTbIPTYb zA^2N+F9p6_*LzjM=UK=7dfx&c?atEsz*ngMPCIqVBGaK|4 z&&|lQojd%!o$y(sw|tNBtOI-<^*Km6Znwuc?(=dI_{iEyrSZU5sQ+mRpF17*{rQ07 ze!WkEf4i>uS>P*mz5h!1Y*Lm5vAsJew|=vBg?mTyzi;{K@_AyyXBz0+MP9lLco+3~ zCgJn4R&I69tfS?+=hsf3)oE7eY*LW`Oy7RPF8L0>v+}GTGJSuIb0FyFe{GSK?7}c);{ruac4qU4$0*il&>U%1;_Vzhc{C5Za z2-Ob)efzQEKLPYs2VMmF9_!2fLbILT=j(RRTfSB(|8~35cs>Q*O}FRpOl$s!+wH;1 z&8J;`1_JM;K367ueh+%JDa{4mQlAeKK5NxwNsMPb;QiERfO2ft@u0VOP69qieQr(o zJOui7HF^yADD_#pAp(qNE9KTMi)U-#lhx;hgikx@EuQm$PgS3X6Fx72-r{)`_zd;= zev`Lr7vD9pIqGwE!slwxTRby?&r_e56F#4T-s1TZ_(JvBwZ+?YsB&wU#d9R^ zCF(OH;d2-0EuOyuU#31^CValTOGliu!|~SsdMdX#yXv^m+wrqZ9R54V`TQ>U*nNyc z9rx$ylblZ$VmI}_$mwr#J~x5BhwAT7=pS}GTd$TmrGJ4>FZKD*>HT`w)d9=;p||RL zD$n*uuixJBY`yDf9~}%nE%iCx>Ala-LElI9ze?zT>v*=_b9KFUfloj6S>*J7y~{yA zK=t1w^lR)UE6VyITkkYo@8-&_-v+5q#p(Tee+2rWsvnuqpX_+H-tBe0XM@iu^_k)H ze!X{se!S`*Pw1a@JX^00H>EehXR`YI&*}YoH``qTw*F~XeOWnfS8a}G>+P=X9SlBG z)n}s9`}JN5`su3wT|)my$FueJ)b&0CJ~PzkEvNVEU2TuJy|Yx`T{*V5r{mdrH`4XC zz-Ny79PIRdy(fWwuIhiD&|m0ywqD)rOMe8PdFu0!)BE+l3i|n~UzyOC`bYz9KkBdT z?Wx?hlZEQDi_`n{9trxzsvn!spXzwl-hn0gyGFUKcZvGk?(}}WPk?@@>X#+-?>e5X z*XrJ`dzSJ)Tkmr9*+w~TCw)M_LiGa^`oWH8>m4JjEBy?7R;tfsPVd`$3+PL0h|&EC z{lkuD>z$HT`&1buJSf0@v)y0@%omGGbJITWiy)&$;7(7?@H=N$bb1>-psD5}tf0N_c^BN28mKDzhK41C03I4oti*u;1_eJ0Xx`==GzVhF! zAN)KJ8oV{zVzT>bx>@ZWeJ@xwSb2R=%D zhAPMQPE?L@p5^p@zHvJETl`l7AFu1ZHsSM%8}PThblx}ahe^8Lb(LrB z^*#qV?$>*?<6eKF@~nR{zFeO}JR_l>rrh#k{c{=c$r|T137>yC?&EyZaUbWG;BWm? z+Ar>(DZ1V@m1F#@5sv%y9(juS)nl@3@ciKaTr2 zKL>y7pRa(QtLt5@pY$8{&pwX(^&aZDU+;0st$$W(|D2;7`(Y~Zsa+(FN0sCL`x@x2 zU2g)vLVbGe-_b4~e^a>~2d4EB-Lc9s&f&mkssHSR|2?3$IOhYOqduJu;BjuE9OLN@ ze6IQ&lkhne^cK$Qg?5_kSPd7N?ElgPh*)@1vDl|5*HEfv?c@o|f?Wv*Uh0UEsK1 z?-KC0?c`3ZK!`0RKv@1I>9_v<}Sx%H2YkE0U$)0JcYoC&veu3rQ1rR{pj`S|VaW6)c>Rs!E%ecBG= z?K)UF#xoFjZ}qt{;d3kKEuPzf*VN~ugwGFjA}H(UtUs-v_f(E??hCx7{ue06@$p*F zTbwrl-&K8>uIp8>j!h z+YWzlgnV!7wfK7h@2Be>tsMKa9rPCedBFRt&%+6ymq2gvyb64P`h5RLi67%>Q*Q0D zcyy}{rQH|XVWC*hRNX5dOGf}-pnL-GManNxZt+_`Tn>DY z#{Zo2@yCbvKyUr<5%8hvQ$0!o!2ay79OF3z_$c+cGU0O@=q;W*fsa?8l?k8qkCr$w zo{fP|R-dDlW4k7S-r_kO_!RZIFX8hn=q+DMfVZp9raE7R@l=#syDXk2@TuxEIpK2| z=q;YBfKOMSe0ua@;R&Oz1ZpR?7dZ zf2>{IfG@Xrlw&-TL2v#1GvF)K=fQ-}zd&#C{2Ta6_4&bZ5cev9)s4U#~oC@2$bd&c7BZ$M!xAytl@=!STG`wpDIE*4`a~x724`!sk5DTmN4O zypQ@kp741M^cK&X!279BuM>E?_EDbob9SC<=Mh7cTYD|e5x@ti|BVU%dqHn;J_vk} z`m8dF$JtFe#`8Vo>T_(u=M>OeJU<0KN`3B0_$*QWZNK%DxR*Qq%>mhV*m-nEyKZs( zhsv#8{kn*5qSODuZO_+&-tuw-@bMb|GUwxuOJ9TD`eBt5W&IYm^ zEbw;qxh~-|5A+t#eZZ%x&;JrWo1Y}{XL-quKkzx~b8*7wKILnN)nxrP z=N*~wddKOr`I#xbB#!T%EdRCjTKt;~=&oU*X@u$KqTFe6jkkIgZEqedQSEHo%vt z&!~jYnV`3L&H=tueHJ8qUPk>I68CGsm#fbY#`AU!QEvU#L;LL~%B{T?=c&L~sQ;f6 z{)<6x`TYm*mFlzcPk5Z$E5~@sz)M*}!rz31&qbiOc%}pIqCQV2eAb;H>#=_8rTuoK za*T5@@UH6r8|Ap4-VJ(-^B&;#zRRx?KHr%b$7#psmhx=9ex7Y#$Ft*)y@z&^a%|V> zzT^oMXBy}&p38vuQJ-fLKFdKr zRQJdCfcI0M9Z%uy+E2N)%i`$|e1Q5~obb5;^cK$?;DglXt%OhMREZPgSq=D5_1RZB z=4*iCeq1|FIi6pfpWwGBw|J~ww*eoe@vKme@vM0oZ`XH#k5`|Am7~u{&|5qw0-vlt zzfbu54fK}xM}W7hPnXGj``JP{_RkN1PgS2|6F#Sb-r|`8e7gGlIpOmJ=&gUA0X{>0 z);*oKtEX~nm&LO!@LB3JBH=UEalak5E4S^?=22%S_;-KW5ohLO_kV5y-0uI}F2VaM zw|33f`1c1sXB}DJh0ezxS8o7)AJxwRK3Dl$37?h9voNxD*?lA5J44owaeg28JoP_8 zIqom#g5Ki%1#o-6@RJFjSCwO&?>W7{UjIMz*M44gO5Co68vi=Vv-rJFf5(0QALY2$ zpA7!i-U+}L>3Yvd_}t^TU++T4{d$)u&zhNWyT9eFg#HWVnBQ-JFV;A_{7m`{`=_7d zKF-4(_i>I^ZtJ!F84LV5UGHfLpFcb9*So-RzuxDRTmRVoEw3l^pDDLEZ9n}I_!5n? z^O?MV`a168Jj8Jy=SbzYUhAI|fxo2dotW^s!*Rdf`HuVbE>>>+WB0ebt=!_Ve)s_R zQjMqgSsnf0*So)R^RagQ2>83|b7{ioTIE@s+40Km|9l91EY8P(uT=lF+j*SdSB`OR z1H81ZEI&#)9{0`!y~T45@Gk1JAmQ^e=&j#g1Kw4AesFdv|HF88Q;z+1sB&ws#d##~ zZt6cH;eQ+GEzUcE_fVft6FzJIT;j)gx&rT|K8GmB_MQlOi)S40-s&?q;q#bs>o>dq z^JDO_ep?B=rT%T_@Vp$V+}dk#9*JCiW+Z%WQf_hDIR1dsNBcYYTm1h3-cQ&2O2TK0 zb9uXd=(u0+9?G%3eS!Da^&XV)x!7@koVmtvzusGvXZ@3L8y_D@=$9zBIIVwP20lRJ zd?Vqr^?AI1s*d|O_fu}`we6ul@PWGC!xKJNI_~@DddK~G|D@dd$HvE}68fdeEl%s7 z*MSexINwkB?07!!pIsdHaUQJP)@%JU5cptS?=cCV-#G63=N8BPdjG22`p3q{=be6= zP94`HY8Q00D;uY5Ubm0q{yxT|m0P>4KZgJxs_mNPe0=-4vVezxmDoBpDs|9xKe zP>${D3%p(9InVj{cFhF6wd=RQ&sCq-5xQz{!Vc|{`hdV#s?R>k zF`mJow|IsDU!*?QCwv}JZvAH4XV>W+dH44@*OXhF7JnP?#k$^~Iv>9sUIu!L|0>|m zsm}`upZ7p-@q7e)iTYG8>u8sc=K$r_E{o@2;4i7q^n}kJlw*H>?)3ip%LTveh-Z!P z&zIz5=?37-ls^FcUF9z-xA?6emI7a@@o#mxEQs6H&dSZl`e6^?%hjhn;qxodTRhhS zU!gv)C49aDy~We%3W?w1T&X_$D93gk3wn!ZIPlVU#P_Cz&x4@1cpe7cS$)>JlJ|2D zQ?cyIN& zF5xo|^cK&3z+39mX$FsHbLALM59I1IBH{Bh&|5q|2i{M89!~fy1-%jY~&$hqf z?b<`Rwaen^3w(h3oR{#q7W5X+4ZsJf&$5Ki*Pyp}R=Gyvw>XEY&%VlW`xy#)i)SS8 zQR;JZ!sj04xL+()j{C(&3H{Jt$MIXcMgkvi@hHc3Jp_7d*JHpZtIv04^1N@O-1^hv z*&cYi`ixKbTnKuL=ThKP)#urS&%2L^U481m;q5wDxwXsU83_Ce^_h|IxgGQt z&)vXhsLvM(pN+4L^KS8M4t$pS3{j4GpA347=V!p@sLz85pBF)I@hk;CSABY3$NRZW zx$PHrpYyTGale?D&~G}c!{66w+c=(`U)X&zhby=IT0a~Oe4fVtYv<$Z&pSbH{qPsy z^VR2zgiqJsmhwN0=exics?QP1F~28+-r|`6e6jl6k??sG^wvL50$-v&>s>GLV?4c- zTe~ct9e^)YpRoy_b3t$M`~vuL^?5Ae^D5{qo;QH6P@ipX;O#0q?&ksaR^BNr=I`4- zA;B+FZvA8Jnht!W#`CoDRf50Y4&Mg7wd(`mrS+sey=U`w?W-K)IS_ak^_iCNxdHSR z&m7=g)#pD6pZ|j1`saVZyQxpxjl5llDz|o7JVyfWp+3J%_{;&l#q$T?z0_xU!si>% zTRfeAC-GaHz13$A<(T*V9rxSekCoeYX!psSmEfO(kKHHpKj3zsOy`?A`uVnSTwRu} zDEzJKcovW8yF2dn+bOs9_R;q41iV*Q@oyx2PIlby7n2?L>-`1z&)4-{0=&1b_sWFN zBFFuDUvS*7_Z8(f&tTX4K2GRYpCj$Y{#hG%OXFN$dA6PS^&aN9kMkJEy?!G2TmMW3 z-bdGaX2NH_<9@x5Iqui{ymIWHe<$>>JMORhe5M@x?MvYOH2zLEOFv`3t>L)$-_LR1 zu0tI6?K;wN?{kuJi_`jfJn;S+=c&%e`%iJ)``_!hkMm*2z0V@Yz0XU^v%F;7uEW0R z^xo$^$Gy-0lv{gke_!>Mcsn1U?Ojtj=4Cy{z5l_E`}Q8?xQ}y)4uJb|DMXNA1q(n z0-vt^u#@xg@z)*q{--$Z`{69dz0Y}$d!Jt^w>T|d*8-oZan5!=-v1WIz5m;e`#3*w z-1~gtxc6D>Hc5o#YoX?A1Ld|K_0@cJbKLuE;kaM#PRgwxEMGO?bF?3Jc0S&}kK^9I z-ErR!7dq~JraSI^W-GTiEnhbSzf^#@*Xa4T(vL1`a`e8HROS+2g$I7$)!moD%=&fC+0bi;< z^AbLPcihMSH27GY&jVks{x2tdHv5yb1LOZc$NhR6%B_E_UAq8Zq3hi%;d7SbzTd8N z+^=`0a?IE5$}Jx2hr5BV)ObF3{(imRxg*ZIwQED*rS(NOP&xM75XXJ|Cxeg0IRSVV z^*=q~bGPF@{s$fR>wO0Ntz9nw@2cy4CE>IAoqRhfJMP!pQf~RO`?vdoez_i(1}FH5 z$}zv=fOpgQPfhsT;kfU&`yJ2Xw|Jfcf9tpBfcMb#zL@aob{FrrA2{yUyPb0DH=AGD z!|DCFu#e;3=LqH4Z$Ad!OXDBre7ye&j(h)`9QXZsyW`&H&yIVa$CX>0*3XN9*EG)O zosai_$#L)B{chg>TRZN3ws+k7w3KIg@#AbC&@a&K`B3H7F5BOaM6T_c;e335-UfQ> zpF4r~Q=d;0K5PG3`T^tV3VeY29HJbLZ=*nO@th2Nkox>F;q$oitUvSj(3T~>XPrLl z{}F;quYUw`TPZq@Z_fl^CVDawe-3<-`dp#h; zZ|5I^-umG);8WG7`B$Fbe#)&MChsn~0ZyOw!xWAGIOQ1s3Baf8dgnMFAO8cOxA+$T zpP@dh-NWPGSUJYOh0|y8pR4h24cywbBXHC241AjU^jD7ka0u{O8vieykMD<@L2v!= zN8oeR=Yxcgy?EC8Vcs4RXqS6C`Yr2+D>VMilw#{az2XYtR}_+N4S;xLBT^AvA5?%Vr5aP#>e@Y(9$`M$W{tj<}>aX$`jt{nTb z2k`mY4_iB*EKc*^-f{0g#&O^Or#kL^ra10>rYpBNEnimxU!ZaR+WC0@-#YI7Uv=Ea z`Hth>=R?Q6PpA8(|Fi8O<97XJ1LfKAJoD);vQjtT)}LEA?)`UCZvD__Ju#{QU#R`C zv-9!s_i^0&w>$3p;X=o~&veJV&urxur{(Kr;EOcQ+nkU0zsqs&|Ec3X&Tky|KC3+- z{gm~;_xY}J%a>i3+1lwdpPrhp?SWgqDvo>qy_H)(SibrJU#$J`Bj@AeALzLEzru0f z57#>GeP%oEedZ~*I4xiI0e?>8{JZn<{*OBD{nwn|(f>Zq4ITGBn>y}&wpDKVvg$vwnQn~em{K;|eGtY7Fvq-tc zY595@_%e<21?S`aUv}L4fA7Ik{)hGFHjaCr9US*QyD7JP*>#+KoIdmEFRLpZ2;A~@ zh~wV>IOWz4mah|luh4!t+4=bRCpzx^?{M7b>psW5&)*&QJ})S@I4xf<0sl(le9ifI z|K*N*|6YIN`KmbXeOiutpMJ_MUv?d5fYWC_12tbq0JnS%cHH})tlav+@-+c?mkneE zlbw%`|4hfd|NV~pd@Xd``#kBm_jygZ#cBC^6Zl3N=X=h_`+w}X_pkn)=W92|z0cl` zd!NIUTfXc%&X1iw^BJu98t(WdojU5zlN`_VR-a5v@Uwv1_;^8rUk%)j&(|gRLyq4X z;;}mUWyiBPH_~>!=J;Hv|H$!7-!rs1`}@lA?7D#c4o;T^^8G5|KmPg9?<=?M!M59N zfcMbtVU+Xn+u>QDx9#d&;62snp@h$iptpFI0`H|hTRqg#E+0=zxwXsU*$w#i>T_no z=Qicpc9`|2JshxfAf3`ixKboDX`7=OW-O^;wkg`48x= z-KHF};lEq6W0w1i~^Qpk6D8B~yOy$=n_$|QA=WgJ$ z)#rZT=KnD8!K!}-_^rzS1>AgI18zR=1D~QkUjR3s^%i#Yzkl9#TgS70Hvckk^KS!g zc^R(UwoluxMj_Yj;b!OK_s995x9#d7;C3y z)#v?$Pv^%a{re5m@Y zx=7;3cs5gR?Xq~b1U^E2h9-PY1-->{2Jlhpb8o`uSkKdm2T0w1sOzwCVccJc}6tsnji ze3JU?{3P#(0m?C+!+}p$pQ{o+e*nG3^C#d_)aT=bPuHg;PRon+|8~kT&Ygg_tN(cA zxIJG0dW&-!@N?DYiG@adiQbMueZN)+h6Q{jA04=B<0vYrvsm{p~QDq!skK9eVmUw?&Ew_ zxvkgw=MCVqHk9?goABB3xsHDG>uovi*V|V)_Rm2H{b7##`HB(BEq>dsMgyOt@sD#p zKAuw?_x^V|?%VZ%Uf4 zfbuLa8Mo_AhdaIZ`LW~PXN+=dujS<@z~^dvPjf!r|7VVS|N9*Gd3nTf@AHJ?-se^2 z7N_Oq4d8cbobNgx@BfkG-oNrZ&&#fkd!M}=_dbUzx4hVOrDL4l`wVy7`%F@9?X|p| z4t$=r_blh*{m*mU`#p?)`Uuf#;>K zjwX_x?{f?(_13ez1H^1HMH2;g`xrXxWyvF;l>$vwn$Z;R%k&b(xV;uKBCo8vn*>$2*oIdl}Rr7TQaLd=(j(h)K zD!2ApzODwoLi^!2&d0}pgX7-+KaTr;c+YX~^ReUJXN`Zwd9i%01NHcigvYh2uW{PA~C(ULE-My54n_<9=~~ z<9@w|JMPyzSb5fO*?F!#?{kiF?1!nqTN=-!&fl+hDd=r~e;s%q_1XGm>4&Uc-ly!i zkADy47-wJL{nY=!gwIsR{dzBV+^=^w_*=Vf20lR7J2&C;p5uPKtG?3F4}QICDaU+m zsT}*EC-6ZU&q(L**EUG4^^MPC48Q6+{gbS_}DnL6!<9he>36J^WPo)w5Q3_?+*!@3+ew_v@XZ-1^Ptm;T`Neq6Z2 zaqqK0xy5h&_9*bF8vj$y$NT@oaqs`#S4;UH9UQ_2fkQ+4pqKNSj=y4qd{-+j0L_#eQrzm zEK+X$HmEG|J?HeUy_-T^7Xn_f~E`7JonB%hl%>37_jgZ~2`K ze1-bFp78k!^cGL2HzaUwW>K0f~WpttxR0^Uu1R$tEJ-$XgazopY>@t>>lZv))gwG(jD?*e?9`W&Pj`{7XF zJv9EyosaK_TTrj_0Jj0}r9LYXKAql@z^otaIjJ?3XL-;1;R=m^bLAL+58%CZy~CW3 zkAE`gEss9~-cq0Y6FyHV$M|1x`YisL8vnl?e!hz_aCm@`oZ!w3ix>Khq2Db$3Mw&?|-M`K414c?tKT|dF9V;VasJ2oc>lK?_x{^{!1Gmg-21dS?tS)GZuzq7Uxzq-<}*<9btG`h z*D;QJ|FO!gA1q%Jflt+bINka9_|J0O`#<2g&)1`ld!MHq_dfqoZgE<^mIJ>+<9y%w zc>hlv_x`mNJYTyz?tS_??tKO-w|v?4ufa~A`3%;4jd1*3SAULiJkwi!GAY5^f!p{v zHNj^9x8w7y1b^7^TSGinC%@u&7N?#rm;U3pe@^Nh$9;Q0c0BXx8Tumo`zFEH_)xyL zy2AA9JMQD$&2hipeH{1kpX2y@E-$}#+{gI$a&lAAssLyvk?#P#q=l_&jyDXmV zfZwVAHeTbpN&7|?b=1T^_$J39_;klcK($tUOE!^VBJrL1GoFSF91GM^_M32 z)xgc?2H>;R=l8(P{|?}TRsR6+Ta`Zo+I^S>({ zy~k%fUq>i6AItlXfiF;>nF*gif!^ZzGw_A#vohhc-sci0#$Q- zG^fwDL+j6568v$;{quLPJD&Mi9^V6QdHfW(ZU0-YjN5Dd))V+*ZSP3s*xo6iw>+K= z{5kdcTf%1v=q;X?fiF>?E&j{5tGaT`CmpF{k& z^O+sE{k^Z;`m=|w_Y23*3gV?}$Pzn#Bmd3f`Cag_{i5c0cAQ_Pye(?@;gC4BC8Jd4N9#}|W7KlORj>3uw_mZTvT{{Yo*rabEhuWx{U zkm?Ug=nr>1i*tl@Z)r663{{_Yr}yif>UiceMtx?2&nWe|!|A=xJ&tESQ`F}v@ENZ@ zZ#cd8dEfEO=Unw!rBmFWlhtQa<=CHFIiC6GVWCt9pLX@>@AN*NfsSWBR)>rMpQ-9| zj?;UeiyY7UN4N7Ez-PMp{MG5b&-0+4q5Ag{`ZZUH`)!u$dnm_#>*aVB=dIfRyMoUg z^*PMxeVjjbJoC9zea3;$T=hBM>AlY-j%Pmis?YV{Gf#c~;`H91KiF#)?2NkU76mFGiAs9e9=CR`~02`+~%XsOYn<<+je_1@b0=j z-v@k=gk5?FxXnZU6SzGe{VH&qhx`=yOX~lHRjaQHR&Bod834RFhW$J%qg5TwM z*8lc=^!>o?dFKU=XL&LICmhdwO#hPOUjMdo+n$%|_Vxkrg_}rXK1=xQutrD!`2D5j zxL@!7%5A+v)&EDp7b`zJ;WN!~zuv1I_v^h@xz&?)|LPqH{lm&FPV1k?fiKZGpHBE} z*oF7c_Z;_eR+Za&t$$j;m+E?VPx!Pu?)&FL$NhS*QjYy|T|$4O$iJ= zFW2}VbUr?wM;!P5YplupbA89X&nAw0pC2l>IIW+11AkZJY&ak9zpLZke~RP2|Ic^a z`%H7(`^;3H=G z>A3f)Dz`W-FD>Ao*!J&yynkQEz5lt6`@CG@xc9ljaqlx*x#h*~C%Mh(z0X~ad!L7u zTYD`pj{{$+?S0z$c>fn1_x_u#&GWLAb@w|ACHs|0^8#dAZhc?=#zR?{lYe%ZuF~a<9{8 zJ~gca{|4OZoP~~i|9>jCez1JK0=%2{!!qaNT|d zhXL=YaUSJ-y#El#z5jKN`+VK(xc9luaqshha?6+9AM%LPXFj`XzMcSX`FhrI@4rmB z^@HW>E#SSiA3ktCKK@S~_x|*v$NQh?xc9%s zai6a{9rr$eb=>=^qEgz&DRpgz0WI-`}KaH-1@=t^$GBP+7DkiAMamU zuOlzszmMa-9}aNb`wVd0`;1U-aaz7c10Seyj&nZV{}ji)|6PvzI3IA_`#j{h_jy`* zmM{O@);~diuXI;wDRA4r-dAqzwY+=`e5mCm;nVEekr&^ty&U)PAEw;aYyCV3_!wR9 zkc7`n$NhS5a@?=?kIJ)t%g%G{`RIQrw|J}{{snxp#9~)72jv)N1^68GZ%g=` z>bPI;*^c}5{u2DHT~`C2tLwcs;q#*7e!U+$?$^6gx#i2AkM6utN55tIo=QU`o`(~ zxUkxHd4F!K9Q$o^;0rbWt(=ed-^Ott=LwGccKyV0?{k{t-sd9a7N_;|bl}fvoL4y? z??2OV@BfnHKF&8B_df4B?tNA&&+_8O+0w>w|1Z$(c?0FvE;}x5f?V4*$ocp<$ARAZ zXAT_4Z=W)1daareFdc z-v3)Dw|<+kXWk8^mU3&a#km{suIhhg!v9LpTb$Pb@1{O4CVV~wy~Xnx@E+>Z+>E#P zN6M{T7SCb8d#TSA37^}QTff zV-r5-g5Ki!1@J!V^H{>?RnS|1z5%?S`fSskx2vym?9cvApY^BRUojB4_48ohrXK}- zl5FOspDMThw0<}X_yCQ6zVq?>^$Vc4es~G^Aocm)_jo_-sNDL&o-1!Sebx_CH2!|d zG5&*q57qTv;(UDkH=jeA_rs;2w>(|}e6srdBjNLga_a|suKazc&-&pCjlZ;|^bf|r8t`^q z@4m`$d^ra67XNX;r>f5l37Tltosajwz;W;Yh~qxarych`FF5Xf-c+7#4;i=XeJhezzwQ6conM5l|Dolk%m`V-BWD>$6S${ATLox}AXp%(9R5VO2!YCR_qcBQ_P;>ElBd7taPKc91+^E}(LuwHwGbDj;3tGy0b|KZ@A1FyqJ3D3tI5{$>@ zZ)3Rik22iOAswet@=t+8H*3Fmsn8*csWz&Qu5S4ZImm_rxivH80jZvD3zZs#!BaO;_7xb@5d zXHKryv%=>g=X~R_{)L8H|F4GIoPQZ^J^vYQJ%^kSt_#=XHrcFVsdj*DJ|z z>pugWbKrXQ7G8)s^fMlt|9r!({{h489P$mfo;ikF&mwT<r}(7zaKc~!1X#$croTM*m!LI zp@v)kkH{5!TG2D7Of^)t2 zeZy|1KJW~|di4;__3CZ7^$!N;9JpTT!pkv-D~!kHA8EMt&okVv*DHow&tk)^rv#ii zxn3U&--4W<8jtmVX}I+t*(Q3uPB7eh+8J&=r-5_5_0rs3C`b;&c_=A0*dad^1c0>kZb*BWkrPWUUs?dQsO zfph=!JpD^}750Dk#M*xCd3PZ=Jv@&t7QPFf#~jbgQqMe#gjd6})A2NJ7v|JFhX~&T zPa1e|Ut#;21Rk7s!94l-rl-Zjob!aojtV#KR>!|b>N&Ul+SkqB0G{69nloMMndfrh zaq!G>Jg-YV^SmXz2|WKeo`eoze$I`br|SY9Rx(50CW|J`sG3@Y&$m z4xcETo?PMc;K>tCf4=ZxsGlc%0r(=r?fJOEaC<(MgLB_<9lsXd6!SkODLjzwhpyoC za2>k~kB8@W$McZXGtZ;K6X5y6@%$q7%(GK?B0ODAitg(|aPF&gd>>@2sSoxQ*Xw5C zT(3#OCt|(s7f#R9;G8GtFi&_g@^3XBdp+4B^_;_g9m4?hcY&ujxUO%y)HBcJ!c*Xx z<9J?|dgggccn^5~aXj&z!u(tpp6{K(dA@U=!yG=bePyx(hda_t;~<8DHI6T|K2cM=T`>MK#-(cvS6Z$bSv4u3#6 z=kTa-&U3DC-j}{8oby>EoSqfJ8{qlwec_zjTH*A3CAh}s~ z&VxJGUB^DCZy}s{+6Z5O`i{Z}f_D?noV|q)L4AMW%z3HsVW=N2oH@q{UyS#;-2xtBk!j~iG`@*xq*9vF-SHd@;{yW3pt+_~Z{y!NWoR9SU zE}Wivr_|ji4RAg-Hr)CTGd%FK{utp+;A!LVWW(+2vfhRV{ypfozi|2o31?qd2*-~J z#YPF|KEGc0|Mr#e)yQ+V@R8utgwy}1@KV&z5k3a|dEv~nNcaZSza^ZN@A+z*|Fw}!vFaOUYPoO3u| zIOle$a2|J*@FX1fdf`0oc;Q^HyM=T94+!URpAe4!jm;I#`WJ;~WB)7?&h>puIM4U@ zg)fI^t#Gc_@4|avK7R|J2v5DPVFB+yIiG`tZ$W(v;gi9S5zh5(FMJ2;I}4uy-d#BR z?JIm2>d!aa?&pgQx7X(@gwu1q@IIK^c*Cv#PQwE~>!%4H2+za9Ip-&YbI#8T=R98# z&Uvm7&VBX1!#@$uIeaI42=f1AxShlAh6i(C{olelhsNFN?zds^A7=PU^E`W$;enqy zj~CAQbQI2co++Gp1_>XDJeL}7^9(oK=DAil*LS>duGbXd%=3isF~~DlIO|_D+~!GFX?SW_!0XRUNK7xb9t$^9bQHz>gI^8@#RX=HRCYXTPTl&qn3vzZa9-H%I!>#{D!)?y{#LxN6 zP>$n%?0B|FJ@fx4d>}mSyVuUg=1B$T9GK^9;py;9aXe2+J@d>Jo&nGIj^{6_XP&*n zGvVoZdURhGgR?K@xlDLAJhL57q2a;0H^+7R72(`(iw(E?;UmKX51&WM!Grf>1J0kH z*=l&;DHzQD<^~?ZgPOjra!e=1oW5#3sPZ@6gUmI?7?i4@gQ!P9n$35+g=zW+5uK6z# zJ`bKp9nS)(XP#Gu7s2zp<2m5WFsJ4@Sol(SE&vbqm7UMkQqMfs3NMD|CC9T;>v0`k zBfJ!zxSr8-ZfmT1T+h=B4G%m#Pe&OZoTu?&?AQa~ zoImIGi12dsy8&G1zg_B!F}Et=o8UP)HF|F6fNP$C!Ykmp-|@_odghrgdpjCJQeb({3DfP^=LU>bn{&PGnde`lXd0Gl@4$m-f z?Q4wT!Ty|#eRV5%us`kd!W6@U`V!PXEFRw9K5gplzFlm%^{f{Up9eRC>%Q6|JRbdS zcRYz_g@JVrrx+gO;c@$b^SGSzxxy20+%(5?zv1?}_pErh9}0yh!vCY=;TtuYbN@bd z_enB5eZh4O!=#>ht`eRC&s@jzw$yWOD~0!fr~cW|>(b0{yDrCpvtQHQ@DdJ~e(}h>!xDPv?b%xvHZWRyv`bl^d{2ls6&#gB&=fj-m2(N}G*YP}J zxShjO;K9*@@24l+6uvRG9GuT2|||Jj=t&ZR|JUTf(u# z{xsZr4ml?*2y)uz*;Wou0uRoY;JB0FPZ7@h@H2%oPanf=o?+mc=NiL<JSem4wNUCg|5XnEz;K)YD{$^N?%U1EvEQ~DPmrI--EO$`cjy;3sMo8m zhFj0+hFi}C;LOSMVu)B|y_52F1^VubQ zB69w1Jk}rUU%TI|Kh#+c|$Ke&#P1UWDU*V?5Ts#c=CyJ+O9t?K*Ze z+@?i&hrNc|;~tV0y`P&4FT-(Lf(QHAdeRNI$Gu)W?CU1s;3R^4u9Qvg5%Bz#}#{5INyI;Bb<3YHr(df3a)v6H#|5l@6Q_! zs$H*uuSTB3h4Z+_g6nz>kb2JlLc?v&;ov;4xj#n>PsF|&Ydk?t`foDa`d>5Lo)>Q$ zZau3Ex1KM+nUni}lkhIc`JM4tf2HBppE$U7{x;{C;5;tpbCz-(ce3MoQtFw%K=?p- zzI8m?4G;R_e)!FB+gH6IVPBfRk??dJ_aJb+zBM!4`Ue|s=XSZ_Hs=V#t>+eS=Hz@P z3LlA_cN>rO=NfMPC5GFa--w^<`@Qfi9JlpF(fj0daLu18d?GxP9M5A?&pfk*=fd-~ z%;nuU< zaO)`pXHL%NGvV`)bEENC|F?!)f6Ggv=Xo+XkIVUV6JCVl-spH{NImmEBz!qMrH*H# z;kK_Ig!4N8yThBMM_*^+g;yfaU~qk1Fh=Ux*Nwuf;91~!R!TkRyheC6JoSb~uh)^_ zTrcK1MtJO)@Wy4Rf0#CzBqx)(F&c2xEIN?p<8RmFy zmU`y7O?W&!uRETPq@H=ogeSmr;APQ$9S_dFn5V7qM0kcfo^0^oD8c=3)1t2X4)_ST z-VZfczUA&!JaF&!?5) z_P8g3^SGQ_XW=L^YH_zXTNKOFNUYt$msbef%7`a-%HcO)Cc+dApan6&3}pTVjOq2@!0%tYCWC@ zR|qeKr~cK^`CEZAKYtHWYf~TO$J^$y?%$L&F^Be?c;itsArnP5D&uUS&hzMc@i2cFH2ry87n@%cAy zbnQ9@ePOv{$AD}86NJZ|So5HouT0~y`R|o_=AS0KIXvqePbE0>b6-`P`XK)poEHaY zhX0}Yn+Z?Aanr%|dFN)SXa3uSC&BZM<0%Jce$Kzb)Cc*qk$;EqiQv`3CxbV>Cc584 zgr^{98o2g*jnuQ>>xK7$XQAU+4bFaf9+jH87&!alc{I}0 z2YoF-{_)^EF7w|mJRiqhZag;sXHw7nUkRTFPs_2<>zfSD{M=V5ras8O82S5yYyJy_ z7vZ>h#$)r(mwM)ZMfh@fesw$zt`CDTKj+^ZJXo(F|8nF{5WX7xJaFx6knj@ZdCYih zUyG%leZ47s13Y^jPxBkXV4CMh;T7;)3a@xph&^M>R3Sn5-8J^Vy?H9XC- z!u*;i37mZ~&&k3Yw5eINny+z=Cs*p3=YHW$;aTf=wn{zo{3N^;JRNR~?yDC#`(mEH z!V}@S&+!yUJ@Y&#JPDp39M2x9XP*7W)!kRg@bm`P^%^Sm%yWhCF7Q0bV~_2+xG)@SCIec}H;e#XP47&xR-4@l2C? z=6O(f4m@R!XS>uhPnGZ)@SHq8y03xY?2CCW6kZL_!;WXZ)HBa3!eecNt6MDgtK-@K zmb&LD^E4J72hRX--9N*no_R(KZwgPL<5_I@QRe-(_27D5|KjiiC)A$T!TW@~4kS7} z)$rhXydr#f?0RrrubYJDW4#uG>wG?zdd}w);q%~Wc5C$hX$P)(Itnj>=LW|!Me3Pn zy71-jlscXtq@Md{yYLctl5dOd>pXDw#XN(AZ-D19$Mdq(GtVO774YnIJO|$%=F~jR zgztc72)M5MD5+x9SSyjb9P-jjOH=R@JG;W-d5oHfsJ;OvWe+6YgEXSCzFQ|g)L z9^pOUS?zefl6vOZEW95)33o*ApVPqE7xSDcdH2Co|%s4C8=kgBH=mk{N{KX-BtIzV4fzzbKyA;T=(Hfsb`*R zgy+HYqT^WuuFne<4&P&Vqnhh{Vi2t6t8GqnUrECAk!LKp_BC1R+1FIz1@L_6cq*ix zbKWYv5S})ZqW8}k;M_mV(_45EJoh-B$EBWm<_KR3&t}K7Tk4tTALa1$xI4P9LE!9* zc`gxN0#Cljyw zng3@-tvzaKr= zsec5V^I>24!sC(WOXIh%XRD;1ef=Rk0iJI6MfWujT=QHgJQ1FU9nXBJXP#GtC&Tlr z;4}q^~`^T@H}{)c08|3J@dRJJRhEa9M56**Uis7M+h%~Cmme-x?bv; z=O*EW@GN#bA4xs)lnF0_=gX~P{a(GG|&v#PKJllkq zz?1l3bYDHe*%$Nl5ncw*y^iNesb`)7;pOmr>v*cAo_YQiUIEXUdC`3h0cT&#GgNpb zJWn{DSEZhLmI$wc=TFCT;6q_fULW}TyG}JcxIPsA5Y{~muK6DmUXA0HgX?+po76M^ zZsB|2IrZV_d7cNZc?JoOwF|Frk2szMQqMfE3Xg;5cgNH4k=l6%bK~Fdc_4U@vr)}I ze7$g@)TiM(+zmXK+gmjr{`_Y@{sU>Cp;dWbHQ~#43~Q587({koT?s(QpJ?H*NB!cVwPXg!l2QMFD=SY3Zws0=##&73;gYnq; zXA4iPxn>1luN#k@|5~a4U%$e;z|;KkFqih*5nQi7rznSKg5#Mb_002x@PY7bc07Mb zJ@>=k!qee7{fX$lhJdp#<{2t{7(7ono>#zw{SbU#j6cV+(&3*N9$Y_p{#F>j{XD{- z;LOQ>_Xy8G&fZT(_nQGu5Bt4ZcqTkAIi6y}?dJkM01xJ1KNs+YskfgC*k-tWU*&+= zwfXJm0**A?*7pTxU!2bX;aTWwhVj_*o;id2#KQ}u6 z>EO)I`JZL#gZx8~{{rE|z^?|^zOEHsjywyE$M#h!^<0ZV9d|?9|0a*2ZH?B$bW+HiQt`tPX_M= zuKo5Eo`9V98ISF^K|@Dv>PGUKuN zv!$N-Zx!ALp0^y&I&kLae%oy7gZ0A8;n;8DPsR0Tx9~I^_tY0^=V0@vfpZSbf06KE z@I2~xUIJ%+&VQMy5Ax$SDYiy9wsGuBaOPoO-w4k{o?{E6`$_?)hkczPJR6=n9nT}+ z?2G5olcqlCYe5(z_Okeyf06JU9CxSj*mY?#KNM>ILxs-0Lh3pHt-|NQ)8@r6faX6PocTHb0j564za0555xyFHGC1eS zzNQKq9Ysb`*9!dt=fx#KxvVVINW zDSsZgwZqRgJb2%Op9{DYJlI$E_0$w_?RUEH1mr9;9((@&EcNX7ci~C!oLUt2rThFm zaLqGFcnUm^IGz`!o_Q7u?*mVj<7xP6m{ao{C_D|Gf#BNL)l$zq*9sp7&r6QyU8zsS z{mJ{nGvR5pD9o>Ujt6I7%+pqQHawY*=N_qNo?PJ-@OcojT%JD$g-o_Xd7uZCx{nVxHrL7r`^y@l2L_=9wydIXr6}&lag?o*#vmz|;PX=)TSdXJ5?IU-$-iraPXe zq@H=^3XdHhKJS0;c=kv=^X#`Y%+H)n;OPyn>y<9`%yYT$czEVGp4X+GdEOG<8lHa~ z&!KPD&Cfh7geSvu3Apx^CH2g6v+y49EO9)gQqMf=h4+K!u(zW3Pdjj~3-fdoJ_Mc{ z9M8Q{&pgwFXTbB3-n>;9SW0(e@ii0|bCctlD)r3sfbb%C z);XRZq@H=U3ttLP(mT<8rGf|h&E7wZa`@fgoCEXUC%hQPEdj45`)#w<b|X3&GhJ^IR;v5}wB# z&&yKJJd1=^!L!rxG+r6z)I5g>uZAZLyq>K4NO0~qUdOUbz5RalG^hSUaOPoO>x9Qn zs0mQ>)pS+#oZEua!#O7jkAr8dv~-y^~`g<@HBW9I-d8Xp7Z%gcse{y)rEOP7zVKXl9&|jwtC_E3I?T)A3hha|5 z(@1zeJpI6R&R0l1^NbK)0M9(f^S0D;J}ZS6!c+gF=s6z=&c2xE7~w_mT$ z>G*MUU%kP3ecy-!mTjy7e2WXTRSI-vdwUvgm%hgL54@|DM8Q_I@VyeV?tZajAWGo_yWJ}$gDJYPAUDyirE z{}3JzPq$B^*YN^y_QgCygeSl=%kj(y=REmy#jhAoF#psrMyy2Y`MH2Ejo;3HyYbll zUnM*dIZysHy5Iib+V2IzliKr_}Rv0S_9#o&S8p?e|IFFg*BK*9F_c1N;QezBr#>g{R~54qZNrUat$m z>EZsoSolbIo^(7#;K6)esmaOT8^6@l2lE*d47TR$UBhi(-+?m^``RWv7kN(lJi4y| z;PkMsG~qMhdDQVN0N1`2oBE)yZ1nY!_?f>v?B|IOV!@rB}s{=UuVxDB-1@K(wcqU6d^Gp?92+wNA z^Oe*y&t~C8@ErAhbYCZfvoGf9CVVM8H#(mCq@Hv5m(z3>uvj@c63 zR~K;h#XP48FM}uB@l2O`&L>ZJIXoXZo=xC-U9C3UzCYG+YuHy%Z}}qd;QD4?N0d8! z7dYooft-H{&+1$wtoiExL-afcgVU4IA*@dqJ`tYB9nWi0&pbnL?syV^bmnQe zJ?`m-+s}RX0T1SHKleSz)Z5Q}4>$bU2DQI;WwPN5YSx9nk7cIew*D<}o&P(+mtqdF zpQ8Ic5}Y2+^BCdF;knZB+${Cn54Q;~hG&`M*&y}I^QG|B@Eo;0y04DlydH9&pXu;( zjpuDM{}G1Ub-BrKyDkOboG0h-obVFl|G{|d{{K(vIfn*2!hY#5h39N=yEeV|K!aOGn-vZA#$MYCC_boqgH8B`e&DU0N=3!qy39m$+PQOO? zH4vO0_I07~UGO~Wcou^5d5WKxe8mls&-{-H&%kjv z8jsCit@Ryh4pQ^=ukbPO^xhS{KQ9Ake$Ib{sSolmM*bUwF9*L}_-gR`!MRV^@590; zAm^vXWBc79_1tg237-s4=RczRJqMiq@;ti0)Cc{RBL7w3ntzn=JRJ80Y4u;;fvw<&hh*S&itHz zqd#l=4f1b7{$|3rfS(AieYF=}j6ByFkL_!+)U&Ut!b{=#(D7^rXJ0&zwwd~%uN}z$ zm-u;J>=j;)!u-sc22U^WU>npqkEEV?E*Cxwo;i+ZvD7oqo5C~U`P=a{ z`?qd>=7|?R2A-kd+Sd(I&pg?}v*3B%@svtE^Q;%14bNeFqxa8XaGt09++u zITj>|?fbXg&uzdtXI>AxIlPzg*!NGa1lKu_6kdot^Nq*md0*<;*GIw^!_#!X=)T&6 zYo1QRi{Z(3JP%1d^E@iN6rPQaXD7JMxlz3^zw*PtgFm%%P6F4yP8ME{JmZYV&Uw1j zv#&hiTi{vmc(zMD_j8r-DtNlqk6y1q;OvWeE)l*5p4pD42wdm6+TrVr$Ikhn2DLfu z`+-LrZr=~Q0G#4dwsYTobzE{Hwe!} zo+9J1=hp{P&%V|Q&xYra#?gJX1J^tqh3CL?ljF&gdghrWdxJLk6G+EExJa*1gq@I0E7d{W3QpfY1)N|dp2`_>tu}SoLodwRmn5Uoc zY3*S;k)3ebUb^dp7W{SwC+BvhNlm>?zhXOo_U4~ z-viIHj^|COXPyte9hN?j;F<;b@MY%OW_UR83wL>O#R=KoxH z9FE)aurQ|{HwB#gg!#`9-W;C09Z$a0GtX1P6X5yA@%$n6%=5SKBzR757Two{;OvWe zE*72w&ts0KNa~sAb>V&B+3k3mG!JuXoSp+L=I40^ zgY$lduWPa#e!s(CboffcgZHHq@cwfZIOojy{2@FOeRVq`x~~hs>EV2a2+xLRmg9Lz z>Y1lVcn&gn>^_{_|!}Gc0sg!!=`B``+JROgU?&}ht`Z&(&s@i|OzJtGV&Sdf*{@af zoR0wKoSCPU@ML%{cRblr&pfvZ?*Y$Sj;BoOnddX%{orYFbaY=QfwM2>=`1`Ao|_!c zRHlNXd$nz_> z?&pTbhB@hBUk3`$f@dJOdWK6q^Nbcg0iHs~vr6ijr$l%TJO?C1&$%Ty`(mC1;Y;DU z%JEE)dgi%9criRH9M1-+XPz&Gm%ww>anXI949>oor3H@(A{H_WgwCz?p}Ay(qjKdA1vm&C{TDbYBMu-vUp6aP2EY>Y3+i;Z^WF z?|9ykdhXlR!uPbDK!gS^Yy&(*g3x~_3Ue< z@ML)Ew{iLc*F47vPl4x3$8($1GtXVZQ{gFgJfBEC*Zm9Oaqz^qjqa-xIQwFrF2b9_ zbF<@_F7?clCp;dW^^RwU)HBa-!V}=>oEY8L0B~ME`Mi9i!(RpG9GHKJ@P0V%pWwRx z4{jIcp@;dK2~UG(2)KH#m3rp6L3lbmMUH2U)H6@1a(E7EA3e_#z}Xk`Bnr=j=NiY8 zBlXO4ukb8*-gi8kq@H=c6+Qu;<2yw6bviivVxCmtIq*z!Jda5|^UM~W3(wb%XP4A7 z&tJmx;OU+e-B%ho`(mDpgy+NasN;EA>X~Pe@B(;tI-Ubg3Ug|ngM}Bua{+kpD0@90 zCH2g6o$w-f7C4?_a9$tE!+5bBh6mrj=I=i|s$+EiV}&opaWlX*|1DC_{1b&2!}GS| z`Bdt;zU9J8;5o8Wm|ycGgL7S&r>pQXc*Z-P8B)(Y4+$@a=M%^Cqtr9cFTyL}>69GZ z*V*9gi+TDBuY_m1~=V$nfC$z~6sZ1g`7*y6{9CcQ?2m_mD2(f#_lW=E9TUxd>c6*GWC+ znI$|Ko>v{uhf>cx>x8Gk)3j@tU-PsE59S%njo;602OjimU+11B_5A&ZLyX`4{;^TU z6a4-b_IsW1RODP>JofqJJ*j8E9}4dS&w<^d`#lbv>&QH9g!hAIwByN^DdFFnHc|JYPsX z=f6pK20TaO1lN7r4V-;3&*{Q5;hE@o^1wNNe%^VO@dWeF3C9~-DE0jPhsDNk=l_ZE z*!};7@GRtvKdp8h?fg#$*M7SR&xYp~$8*2bbN&wtp8(INj%SC|bN;^x&w;0N_vpU* zg6sSTfCv2s^Dn{tuapfT#26 z(ftkt=Q?u!7b=J6QOEO|)HBag;XB~@*YPy#5$4o9@xrU&844ae%Fbt;)HBa5!uPHIK>e=r- z!sFoi!0~)zxc&VY+rWc4*x!%whpD%}A7lSB!@h!l+n<|iYqyF7=$xyTY5pQ?F-je(Q+`*E~lHkB8?9$8(F+GtWfft>Agv@vH|A*2V6( zZymnFcNtaJw#Nf$JRl2~R-&sm5dHIalgAhZlsmhNsf;?3H?6$LjYA z`(n;Sc=~_`e`@nwCiTpdAv_75XB^KPQqMfgg(t)Fuj6UayKa8wX(_x5Jj1}XuW?e( zJhuo>foG}XSts?(vq5+dcn&`+%&&R6gLB{V_hVe*@NvcyJpWD%wXs}qt}pw#UwA6= zd}2Iy-G7yO_O(m+KzL5;6W!M!a6Vt~bIrp|eUN`L@=pNQ{C5aX$8lF0kIlbX>Y0Cw z@R9JeJ3BgmZ*b=4=YRW~`XK)dI@RybL+V8;|Yx zL8)iIGlg%0=QGFi6FB?jdGx!f57w&``5W{P|3mX1AiNUC?GGM2%H|&-^~|3sd>1_P z9nT7I=I4G}YwCmi8<4+3{CpnSDm->l&4X&b+6)LEsQG(>a}LbkM|cx>?sYs*fHObm z|Dvf6@^3=^CBnCWmw+=5`}$aTJn|eoFuJd{;PkMsB;l>$8S8lN24`P9kEWUWpsyXs zKO3CKW&US`C*!!^8IRpp|42Ra$Ic56M1K!>dVvRjYCRW&Ge7s$6{bGOzYF=Z#LxUU z3-5>HE-@Z^+;vjV{2PQ1f#>k^!vLDUJvj4o{@qP|kbe*I_Z80HkC6$^xv{UY!ZVQP z72~metlN^o8GiBiwLCJCPn&-;$2Lh8BhTZI?G)BeKf^*RTfeKF5K z;fvvU$nnev*EzrK@Dk&(bN&vTdDz!B;l;?4I4HWWUf}ewufD=d;knQ8JR|kY^StnK zc(yy9xWRSz5Az%(d<#5-z;*wO0@pd;=J0!s$If|`;r4xoPYt*4GweU4Zhp?8vGAgf z;dNsGxaJ=z^_;^s!WYByqT?x+dgggg_)>TpUKHlnJV%4;J~>|aa(G5Kp2^@`7k)lv zzQaE;Jb1r|pF8^#oO#&S9^qBkC%rC??&}J0dN}71!uP;a=y+C0J@c#*9*6lfxFkAH zOK{DTAiOy|S2>e<(1;ltp0&+%-Q zdd_)^@Jx8xU0U0h&C?g0eKF4f;o0!yIi7joI_IShUu8UY&R>Hw5BvH~cnc)oEwe@Q*_>=ix_o}R;^`??gIeKF6K!i(W4a6E5H zJ@c#(z8aqY9M9pGhdDLRQNl~$xePpbl--BfQqMfM3NMA{EyuGKJlKc!=QO@?_>ab8 z_hJ1jYUgk72bvjf?*~%Bbq;3>FGKz*#$)I3wA6DB^Mr4JXRG7+N9wsxVprB(uX1>L zf$O@YOFi>kE_@R_a~#iNsb`)ymBaJ5<7t*rH$U^l3*Q3IP;l+*2B~MBY~hvgyzY2P zrJi}#3*Q0HVONFuHP5Nw+_${{8RGE!z;(aP5MG7jt_RoS{v!3vzf<@gcv6N(=RY4@ z^9&Xq*D1Uop6PgAl6vMT65br1-yBb)5n)cv(?oazJm-Pyd`3w<^IRu937!RxXQkA0 zzpW9T0#Dq?=sBMN&c2u@QFtGCu5mn*rJi}F3NM1^L&x*2)HBZy!k5C+_Uh=q&H!g$ z%+p(VF+BG;o+qT9d7c(t0#AkG*_<4nND`84jOdc<_D~KX?B; zxX$M#;c4h=2e|I%{YQuS>EV1D3m*p00C4qOCG}jdQNlCfdBO3lkb34>B|ICR2AN@g z&2tPm`(mCGgy+DM>3HsydghrXd~TDY zT~{|h^Bf^OmK;8RrGslY1lfcnUo2#zyzm6P$f9Paol_@Z9ToW=lQuJR`gxJl{E< z|G@QmA^!R>zw$1I2iJLizVAwK?Q5j)G~{^>T-SZM)U&U5g{Q+)?}q3($AfF0qlIU{ zbA{u%RqH#1=h2Z}$FSw8LkCa}Lb^gzzjJcO$s&w_Q@t{C^3b2v7HM z(fNmfYo4LPbK#lec$P^$^Aro83D5pFMdvvZoaZm!KRn6dDaK>pPq++R`^perj6Ba6 zk9~jOEvaW;?+7o2hkr4;u2+lfuwTv7Qg}H$!@$*Zv(z)sZNj&}v&`|V1J^lkcKA=m zW9QuBW~VRVO-~N5Kf}PaubZTveN7M^56_#9XPwmZ{MsNq0iMIhhxs*6GC0?ZdAbTu zglD|t$(4HMxnFn{)@!Zf*(&wS^ONvucskq?-B&Mg_QgDXg~!m>eU4|Y)HBZu!sFnn zbUgb_2y^oK$>-&^4j&D!`Ns%P#&KT;*Y#a3_00c)@Dz9&-x@v71aQrBqVQCBMme54 zq@H>17Tyn@RgULNsptBBBRmbBV{eP@s~b4`VxH55r^7SR@jNW`%=4J=40y^N&u?1a zA-taK7M=;uskcY>bsjkTVxB?5v*3Be@w_PYoX$McTVb3Utu=fSi89no`c1$*?)H4r1*vOn^@bt=w?(0%;)-%tQ!pq?) za6C(-o_Urjhi8xDX*Ma$sd?gsSHd$CJb08nuWyig=E)Xb1<&h_r&Q`WpY_74;W_N? z=s72XvoGd3Nq7u@f9Um&=U%C2o@v74;Q7e$YzF7`Atj6*JMfSsZant9xLxYmZ;tRJc;0n9Ur0Uo^CscR z@Ekp*wlABf8#w!7p3{Y=z%$YD256bNP`x-u@=6PYk zw(#$Jn`ZoWT^$=MAZ6p5?-q!t<}=X?}m* z{LFKt@M3r_1=qf^q@HX~PQ@G^J~e;~}Sc{+gW{z(>I4$qB_Cs*p3 z=YHW8@T_$_TeQA?&Bmzt`cZf#JnbKh?yDC#`(mEH!mHr9&+$AZ^<1yH!mHu=-tqh` z_0031@L2b--_*S5z6Kh;tme8@^H&e-`^p68^^LD{=Q#X*aL$K)eIz^%d73;Fo##Yw zde~Qc;Z5PW&hbo=dghrTJRY8R9Z$K`Gtbw;6X1z|IJ&Qn;OvWeP7$66&-ISyUa4oE zX~L7?dC&1|lzQf=5S{{0%SWR7>I}}lnCDdCsql<*Jh@WOJogLl2TzIP`Bv(g=Lg|w z@EkWYy025g*%$Nl5S|XtEso~_sb`)?l*6;u@obTL=J`>0COoZYMfY_&IQwFrRN-0h z-0pZDl6vNORQLpV);pd`sb`*_h3CMN_-J%rT@1I^u{3aA$M|}Dio*|htk(ZV&Gm54 zf8p05hTHqM3&A8f7CN5yv>x;MPdqf1BrcaQ4MKZG{)Xlj(TwlzOh$J;Im5 zv)b`&lzQf=5MB(=aZg0|bt*XfVxAttOW?V~@jNQ^%=4u14e)GoJikjl^ZY5i0-ls7 zqx-r5oP9CR5aB!EndNw1l6vMT5?&3@Z;mH!c9>K193;F!kMKM_A3S)J-G?Kko_Vej z-V~k}9nZT`&-uJBycIl+o{FAxTX0_Ac%L@d@Zf!e%JAW_N#L9V^G^|;h~usS*Ev*3 zJ@aoBo(xZ$InnuhfNP#!!c*Xx=y)EHdgjR&o(j*Wj^{_I=X`z<-VdI3Pe=Ea3eLWm z=WO9=@Z>n2N2Q*5o)n%A&*zTkXQ^kN--Tzub5cQcUuS`{FXrhdJQJRK9M5d2XP#$- zXT!6}@%%3J%=4%49C$iE6W!Oj;OvWe&KEudo~e%KX{l$PdBXGI+3a|BOFi@aBYYk_ z-R4I3H4vPAG0%mqTPyJ`ZoV;G~eyo$>!SyOPD|~hsZkT>{R&m}i*q zDtMl9JRgE{fAaHLpBf(Q&x&ut99zZD{67h=#&J8m5S_mdxaL1s_#SwsIi3QkXP)PT z$Ihr}qUP%d$Mdh$bDs4I!~D$I0G_kJgFm(ROGBled9Dy12hY=vXQ|XP&)dSA!n4=$ zG@oBLKl2JD--|oHO$z2+x4$D#vp-c(CrlI`Z>n(+v;SJ@L|T-QN;F^S>iJ z6UU9c9G(9NaLwOJcosaDJD!`Qo_Qt+p8(IBj^`7p=RCg?2 z@MJrl=~B-;dBSJIv)=Li4j!zpUB`b6x9i?&Vc3`EKTdcdjyoJYc$D3rw@W?q=Lla6 z&%2K23#sQkHwiC>=jfv7b?E}mzL@7U;id50=6Ld?o_S^oFNf!I$MdVyGtVyJTj1&X zYII)%z}Xk`qzSKr=OM>aDD}+qvhY3d{Ni{HTomTi>q#^4;7{+W`KL=<&A)2ClAZdl zrrzFfpAWA64i+AFX6T=3Ja&J+EcNVnk?~uT_ycYJWc@7rd6rKyfgGbpsqokgB zt`puIo&}C)rPOmjtPvg$Pu$`#zvej(oP9A*8|Cnfc06}TJ@ecxJQ1E%j^`_>XP(W% zli^8tJ-V-M;OvWeP8Xg6&qT-bh}1JrzVJTqeCc?8m3rpcB|HtDu1li(8VJt5nCC*_ z!{B+?@w@}h`#`?#C^6i=?$}^F_Pnl?`q;Ab$>Y3+y;q%~G z=y=|fdd}xV;YIKqxGZ|k$Afdu%+pr*a(FTw&r{%f{yuNGJ%1M&k3E0im->D7~ zPWHP^cnNYQE|2cF7dSoax3BP0ceXV|AcRVC-v>gy8X}B_a{t4hZpA&_rz;mtRxlihuXNK@pc-A|f zZBozq>=51$o|9HZ_tgiSeKF6u!qecH=6DLEo_U@Vo(|6sj^|&gXP$bi>+Y+O@SFv% z`)8=sGtU*mv*3B!@hp*g=2<3uB0PH>&<F`StwmZn!;v`+^6Lx~t|NzAnC0>ML>n zJ_*isWWNQ%bCL5~&)q;}4A-dA_{ zC~)>$fjrj<&+S!n@S3j$#$)%xds3f~y01L;q3}F-4*Z}tr}eY~5Bd%MezbngLr)u1 z|9%bU&$Fe1YyPu^=i|6jjK?1LX{l%adBO|e+3I+9gKPfShqe9Mzu)axaLwOZcp;8^ zt?}6Wxl+&k_X{tA=Tpb?8+ed^wV8k1M`3==d64j>@DBzL9%XahDD})aUU)G)%N@^G z;LKT#pKtt4JlxN_g_pqJqcrSGb6yJ0ewp)1;brhV=Xl-+4|1-mnP*j>{q}9>uf@Zh z-w7{=Kk?(}oPEJH=K$dq@I2&r7J)NoHFB<2PtSevV;=~wgun6H=$t2jYtBUBRq$Nn zcy2a4zhUil;BN3BzrAkcnRYU|rZRJ=`Y;3y<{<=XL>j z@F?rK%y8RRCb;%B-qhRc$t-Z@VP8)Ok3*gckzk+$kRByhnHf{2w^}ZBn0+T63V9uN}gZ;OV?RNEnL+|F${Pz?m~YabH<% zG&uWZ&N0GM;9unU%cMRdHS~WbJQbdnp9Bg2f6gA@LC#e*^UNE&-@dxR;F>dCct7~( zIR52Q&z$cHPlKn?r_nhR!I?83IeUU@&OXA^;h*OC3#FbpUlu+Lo}G@T)rK%XbMpP_ zQ@}N6itr5h?*tEQc3;ib`qX{P6?;bbNO-n6o~EDG%~^%#ySCt(Gf8+R{NuniXP(q& zAm=RMW8m57cp7{jm}4={lb?TY39dO4glEA&3Oumcc}|x4jMU(0vDj4M+3>7$JXPS# z$@_;!Uj#?2y}t2$Zz6mG{DZ)QN7edq30j*FlVeh zNK%_W7yiEB!JpckBc(ngHF$I^c8%~ncosUIa&YF%nj3n46%TXn5}pr#_b==1dtmTy zn=>7p`zIqc^j|K#0G?+ZPboNaX3h;g-;0MiD}@)r-|?$@`yLql+vXeyt~oChUIfo$ zj%O)2b558W=G-72=KNB4NorVs?8fMvXMk(Y-one^$#pz44S(F+k3A0_2VSeW1eb-Uon)6uUDezwn9@uQod!(K@bA|VS zXRYJe4$hps@2dBGm|t@?5}peGdElD!I;m&QEa83NS>kwB8gBQ)7vRj#=Zjy&&+EfZ z;r(#j)3${DYW_>WIS1w+COi$ExsK-@aOULw*yrM5&W*y;;XiI`bk3gOnzN5`c&0g? z7r>d5_hT!>!f@{ts;aTvEb36}%GbiuIo)-^uz9f7C{J%N=L$-za zHD`0-Iq+Nx9z4pPr?-GJ=Y+X61vOtYOuc=-{blhp|03b}XN8_>7@i+c4I_Dw6m&0=rxaJ%W&YUU8dB1p=^I_p7 z@RvLO-BO>C8qWV8;brjj`YG&7a}Eb*&V&m?&#mCxZ_Ih8@N)Q9JO1yao;kM(uYl*I z?a?_e24~J>obVL*mpcB>rJgxA3QvXS zxT@%!y}_BYU}v~bhJtI(D}?uhf1cxCDfP^`MtB-L2mKbEvl}>b79r<(;F@!g@O1d| z9sd%kXU=8H;o0x^=$!4rnX?c%dx2}tzQQx%pW*mllzQe|C_D?EKOE07JH!0UxfD6O zgKN&7!k6|A_sPBBfz3X@KP&ajStxupJij=e19t`H+V@@g{C+&R=4>mx4F0j;fz9Te zF7+9y!O?2I{~&x5JfAzBo#31&pWhq*5gf7heM>%X9wNLF{)@naN7&YXOH|6M%H`KRz|_|MoKB>ey1$GHrg>%yEF!ee+|d*1P^0%uM>zkekj z=G-hi4*nDWjLvx$xaRC9yeT{nIG&flnUl}&E5*Z{YlO$ce^7OF&JN(3Gg){7JmVeD zBjC)*=l2)I!<-9+C&K@S<8Ss?m|t_o3-1EY72v_6>^{F8oH_aY{;+tM^D*J6@PF<2 z|B?EP)L<9aeEnTF|3G;9f@{tZ;LOSA_uIt7oOcONhyOjt|Gm^RXQgs@I{p*p*PH{u znUl}&!@;>;%sE;aZ;F|MP;koeN0Up@w{(n;HnX^E69y~udp89+1=H&Bx6Y$_q z@2~m(#bo?EK!WgG@ZR9s*Ezx`;C|zNQ!&z$+f^Wgc$@$3W-_KD58U#xx*_kTZU!t<`7@O=1>09Vft zaLs>>Q$Ioc?CTEU^Kje;9M4DKdfW=9ew*PdYu0Pe!TZ{e{cbz~A9zT}|8w|3`-O80 zj$3En3g^B}1=sy>w(uhKJI#3Pet1FZIkyGEm%{U#<7rSY%&+Ts0=VW(6kZJfSa6;H zG^uCK2Zfiwv%&FHf@{v*;^DsiM|c_h2iA}7w;#CXALi6w2hRDhuPou4aNHcn^ES91 zcfC_zZn)jI-y4tJw^a_`Yk074OO}NDJfT7Kb>Kwdaec%3>%cYtRH^5D9uVFHo(+!Y zC#mQ9{wlmFJjwglo{#o?IR{+VYoPGv@Z9fs3ZcL~o#&aO?O`yB{Q5Bt4P_!xK|c04ajJ@YIQo&`^}<7shF-F?M8Ern;pa}{_! z*;f;#o_Qt-p8(Gq$Fo)Hndc|rIq)PO96jf=z_}kPupcfl-0p|#3=j50F}`1LtMS|Y zFddxh$bR#L=OX8N#Oc>Z-f z@lEUQE6(R=;f3&w0M~srN$Qzritr+MN*&K;aPEhU;6OEBI}H!^L&n^YH##)TAJhl? zA@!>80f&PJ|7Z6@TX3C!lJKR-Io5dWewZxv8L45Osltol`Oxufm3q$qC*dXVBp(*N zug(W&U(7RDco{s8JD$Z-&pdAmFNfzp$8&VEy8DWGju&15PbPSW35&B813I(nJ$*nRt@)U)4jgjd1S`iSU$ zyMt?V+D^_D+p*djj6uQ^)^kAwdz@OpB--zD|T zIazp9cs_JI6;jWAyH$8RJZ+AQp8px(?2CDN3r~RO9>?<>IOkS^>(X-ZFz36%6X9=k zRCLZ0!8K=l;mPo1Ii4v}&pgwGr@&L{c)pi<&aF~-Dm?A*`$%*@3;^fc;&A?61I~V# z^LpX^;9uRp8qM}nkPkgIy|>Jo;;~%o>|J_`P}jBkb2JNH{qG^ zbUr$|uXDlK7xSDiJPV!&9nVYPTt~jH|3W;>xk>m0_>Vs(I%g`l<~&#&Tm56h{LGmLPap7lay`6M>Y3+C;rZ|sIG#78o_UrFFM#J?$8%&t zn4jy&*W+h{voGfCFT4=`JaFyz6{%;=*Mt|r^Oxf}ZT>pYu6gcr`o| z9nT|D&pi3UW4O=%(((KO&UNJL-<~Jdoj-H-5gw2G?P=gT|3ax}&X3ok&i%kVU4^H>bGzet1Uy*B z;PnfC-fXVn_WLGF41YIxy@Q`aSZ)0Fb<>)drx&we)u z9|OX~Pb@Cop2aXkM?J?GOPsqVhYfu}#X?yF3xXP&Xb zbK!Z-@w^ZIzx@y{Z|p0>?SA;h@L)gW;P-FrF@C!r4nC=FU+lM;@I2%k0oO5Hp3xzL5&MM=v*M~;Q z(fu|NUJTE9;M#Ad)HBam;U)0A=6KdiJ?HogBTdP6gNb^blSS&)trvK<9i_Ya7FZ{gAUL+z(yAga5Ppp)a`hJ3x39a?UUw zyC0sFdiGl=yc(V#9Z!Q(>h3G>Ax~PjGtJZy(_)@Z9To3Z$NSo)ex5&vwUiK)1U4ig^weJ`kQE;Pqr* z-5~YMlPx?Qp0^xNxzsby*TP4_bHb_7bM6Mt{lM!(f5U_Qz|Rp}VR*0~itY%#V~pSK zhiTwkNA~-m@GRu~%y{hixKrxcZ?*6V@SK?v-R}@^%`;SZ4m?jdo>!%wd6o#zh38Ml zbJ%Hh_Z8=Jgz!9gE(h0rb-UCvPmb{X|D)?{;Io|HHh!yU^kS4ug-L1%Lo_NDVNtA9 zrq@xJ^s-Q4imDiH2w;T11O52}@xTMlVLHXIJ-eJUe&%uXCTz^LhTy z_kTX$>p0Kf?{{7Iz1?l_eCT*KOFi>!5uOiEs|&;Dd;vJ;%sdwfFMwyF<9QW4*q_0E zKFdq9k=OqsR0-X6dw@tz;kU##S@cCQ>P7n9t zrNS%WdBE{JEA`AXM|c%HUpt;ksb`+u!Xw?PH+=P1;>F>8T@KE^nCB|tG4M=wJhP>q zdFBdl2+y~UXQ$LNPnGakc+O1@@9Ro%_QgEc2yY6{BaUZ*)HBaZ!sFoC?s#IlM00AM zM#5Xd(*wLt_1f9z^$@9No($pf@XT{OZ%aMrvqE@lc>Z-ftuKl8#peh=pKylZ!S~b1 zuQGh4dA=X}`LXyFOSvjkk{vsUWa*QdhU!E@xL;rr(laLsd?@I-iSb3FG;J@Y&y zyc0Ynj^`WjV9voj%d7u)@U>kyetkjY596<2U6QqO+x7oN&~9nV&&XPye-Y4DtRS@=432j@C6Pfy`P;d#dKyapc3KX~2F&qFRX z9y{j}Q@^6Rp8w9`OXIim|IK&~t-c2P{Y!Wzawc6K-fv%U?YF=1EO?%GJj=l` z9{aq0Tk6^G3gN5aiCh)lZwqkE6ED03o|_%dB&lbfhlQ8Iv)=J+mwN7pKZKXTb6)rG zzODslU(Ayxd>cG-9M58K-47oa9_$C+2fj8u*bk-ncTYbXzugb}!I_i&*6k7Pi@Xv! zyMfoK-jjAe+#>btcewB>c$PSx5~*jNPlQLVJa{Z3jjs-$|0&?i&pf9IuLsX<2#IA25FV z{rMT-oE!UnPIw%0{%AaQKh#aFy?@wmjPQ7Pt_H6o`)a7vGtaHU6X1Et@vM}3=J`-~ zJ9z5%44;21@FS{o+UIFo;fe5!a6D6_o_TVGcY^0j$MZWl_XB@kzt3>HACBr3?JKAc z_5)vUoCqGw-|mO=!L{Fx!c&m*KI5_b;W?>izw?Es!n57+M6Rv9uecu$6`lsq<={bI zHqSt*XPz5{4}fQ$<9Sc&ndg1s>F^xhJA7ZY1wR7&ih0@z&w%H4$MXm{_XF<_&l+yu zXT4&0upi3t_j=wje!Cw&17}Y5`<3ua0!Ug!n5F+?09BLJ@Y&-JR6=L z9M3;e&pi8uPlD&-zTtiK17}~%Ggx>IJPRDp`%=$5CBmPCr}1^+dD?(;Kk)u=p5b;s zbTd5I5ApcDsn;35-47!Tx4*Y`7P!vgdExoU|C909b6Pho+7~^XLyYhOczS@>k@G%8 z>bWi%!VBS9=y+C1J@c#)UIb6f_2KJs0yz6(o|AcAvBa*M3hDUWS}E8;{)&4@f=x%@Mv0o=+Ul zR;lOwD}-0Vb87$ab-Vt*NM51jjfpX<0)IQK)A;lX~$P6~{X$YkTU`(YM1=f-}Y7aotCKN*kBS$AOV zzSwV!@C0~zfNQ@)q@H;)geStY(DAI2dgfUpJPDqdLE-!A1aO_t$-nAN;0>zRbY=DW{{Q_!IG-<7h6np0AN%33!8QHb{m>Fz`#ni`I&$7@Ja#`k zp!LbYF0B4Ju<#6cK5;zT!2hRT;|abmmyY|zF5_8S-7kO7%wg%Z_b2yN1L2v-(;Zy* z=S@=2bsQ!<3!ax9&q}Fho)3j*!&Co;n)R}CjtA#@G0!Q&r^0iy;~8b@?L6-VZ%{qs zV88J`^QhqmU!QyvOezwYY5aCyy<+_K{n`@YdC0lbcx=B7Z>+tJ?Dr_)`SA1t57Jpr zhSYQZBZL>g^Qz-nBlXO)PIwVKjfRA;V>9qz9qs&20dG*vgZcAZw>SLYbH82Gdx`Pe z`KKAbo&P}LCCE9~cMAGO2)qW%J}WRI_u_|^|kLi(!hCNibu|Y!ee_x^UpCJyDrP5J|CXt z!kfag&+#<5rS|-pCr)@AJlBKky4)`H%yXCUmhcogo^{~C{DZkw;rqjz9saZNyjxw* z=h`6|HS=F&_)&(}iK(gY2(IgrtQ`68GakDxGo+q#cush0c*-5m9;xTL>=m8>Pp4aJ z`n7qk1!rH(lP0_!JkL6w*QB0#mI_aVXSd^NJgoM9W1c3$JHgW%T=&~Bsb`*1!c*WW zbUbUMo_W>@?+s6*+rsC38aVfDCH8H1;f473DR&xAZuR~g8a?ij$-?pLE+Totaoi&> z3GWTha^b_lKNWr_c)9Qi;C~yw+?=ERhA%U`?(mxVd|-GF!|na>PH^r|uH)Up(=q?I zjmPfu&!wL0SSCCZp5sQ;Y@vK6ZZa_>5d>>TUkf;F^D|@N8Unneo`` zmP$SIe<3^2VHpZ8y{W4HD@>B`S3sD_~&UoHe!MBMezLMc=m$- zf6jRw59Vw+s-~~t^P=nU`%zC3&flAQw!^Oi*M3ul7a`~4#$(szC8_7Sye7ODo=V4a zL}s)v&2yyi5_o!p>wRyu)HBam;id4r;doYq2lp%cx!lbT|6Ba=Soi;gm*KjdN7t;Q zoo8Qg&Vl*+3onOfmg9LDocSl*6r9pXWP^B^^Go3s@E?17c+Ny{&3T^i9q^2GJX65= zT;S`O1>#}OmxNcs|EuG#cSr4g#d#hsd>1@dg6qB-49=X9anX6+Egt5)S9lftD;$5B z)HCO|!vBNkgge96&)j6u#G;9M`}>?J&Mb+oVPj(?HVGv{LA4dMCA@zfs^&Ci@g zcKf2i;Q@LUeA`TH4e^N#{&e*WFnXT;C^vxKMPy5AbV&A&(L^YMJ#D||RSoyLXl z!>ho9oWXOsU{v&eH3XdN%bXd)v*2Io_*Y3ibFLAd4NuJY@SMkjGbcaC)eBs6UMD;U z{+W({nbb4qa^bn~L?(piJRV&0v=W{N&oIaHh}1LBW6I(A%JKXH&bjgLmDIZ@nqPS< zaLwOVcmb|^8@Qf}hoqkQrwT8Gr_}NM0M49z-PPdUXnxHZE4&E)p5U5unA9`pDB;EM z6gr+2;F@!jc;azRzZYHt|H%`>_tnMV?3X#a3NM8x$MMVn|DT-V`Tv~4%a}7eJZEQc z&3TFNa(E^?p68^VdFBhRfTzOo)VZ(rKH=Qz3$KLdD)9f=C*Yi0Mce3o@*(js=TzZU z@RvIN?NZO2e+Z9U6TR-a_lM8FJ2>ahJUxZS!1I*jc}?n>XQ}X5c&Z%Fu@6LZa&9pR z(fsYfHRlDwxE~)Kil!YCH2htp77!D)Ok2O zXLE4oHEaPoOPzu&Yute<=~q0My<#F_7>rb;Cb2cybsQte4kz} z9_IW}coF=kP7U8zmw|KtaGqBRUk=YS$Fsn2`#$k)aOUUx^qwod6Ez-NpJlkM-(~n=#-BL7#$)RrH9Yv-LiYjDx`o1fgMT1=0Qkp-2R|q3{aojR zKY#hd@W4MD^$nh^$rJE9!P^R-0GUrMh3NM3atK<2@ zaJ%3B0}u9F&{qcXH-9SHujW5dcsZ_{4zBmryQQA_?-gDF&kD!$h17GNn}k=w)8grx z^|JFk2b_H|PY2;u@MJljX;RNT(}hP;tA|?swbAkXCiTqom+%;P&V44luWsP%i+QdV z9t+Q7j^_obXP%dZ$HBA1@$3iZ&o?8#opL?=I^T<*PQ{b`|VAsXa0AD zC%|*S@f`DP`2KG$JQ1G$;F{-lsb`+MgeSpMq+;7OVp-d7KB-B%MF{sTDY!2CZ8Pseo=W`$q3 z3phQ@f4T4scph>*`BKk33xsFF^NZuDJG=J2Wu6$}S@3iR*L{1F)HBa8;o0!K>Uc_| zo_RhIo&(QObHeA`7Mycto_4}>;Thq0CQCi@Oc9<3&pOBRqtr9ccH#N(ocUaMUn$`1 zi+OqoFM#K9$1@LH_kRhvKHoPv_3iU(a@yBFslxgCXSi^_{&^6beQ`dI2room9~+N- zUjHEVoX^j~i{MFkz9zr*v^U(o{^vS5MBn)yN>5`sptBZ2``7|xOw4yodeFkn5TpA3V5;{&orrL zp6S9X;o0bTewBLWsT5uX&)M_C`??gI=dtqC^Mn5w8RhV&!8r%!pD8@jGq6M=--GLY zd#}_pe`G;4C;c(-bOl#WKdEP)!NOzV$#*=mJAR1i0?El@4!P5I)a# z!jo~`5#Tz{$x_e!Q-r6$v(EASDD|A@cHyb;oVhT3o+;ou&mO|l;CbBfyd?F^^P2E< zcy>CTMlaQ#Gv{-(@C-XPy^@FNLSV@$8p+&Zq8c zwdYn0PgiiAPk*Uro^;_Q@I3E$mPtMHEEir1&pyY~w6J!5<~dGy89e>KwXX-jxj$0| zM7?>22S1PFzngf)@Zj}%4(eBd>$`0oQ%F*>JlL|1><)JaKP?&-pBH_QgEyg{QzX#_>#%dgjR$o(j(f$5SEo z%=4S@GEvfpwn^&iSyfxx&+tXDhg_`@d4pz77b_fG2rb zcwgNOx9|6_2WP*`e;2sspCCLF*L~Oc?fd;NrJnh}5uOE4%cAi7=YVUT4#KnH$#Oi? zrJi~6gy+EXwd2_(^<3Y7gr{74@HQN|@U8H^t_5db%#$WO6`p4u&udc8JWGYA!L!@( zG<-XnQ}Y}pJRP21;JR;zg7ftxf8OyPc(C8>{qtjoN8X9%(fUS)2lv|)oV(Kuf3^B` z0)Jkd46b=5fU{rD?LOhT*bg6oYrk8hp6mFN@LBMjwmf`4B!g?7%Y+xeGuiRXmU`xy zD|{(DTOH3oQqTG97hVj{#qWmql?Kkfm}j8yb@0q_JWHjXdEOFU2G75a=cxC>_jxnn z+u*qlT-SYs)HBcR!Yko<-SK=R^_7sqohDOmaMPq@H=^2~UKl!torwGJO9u7TyV- zYr%E@+$8nPGfa2}Jg+*QkEEXSSuZ>jo+hip=X@$S=gd533eSRPl;e3s>Y3*;;o0z% zI-cL9o_Tf(PsTrV@9=(jU)O@OFXl-To&wJ-$FoH0nP-{sRCuZ!&ylOc_fJ#dY4G#` z*ZngLT%T*J!S%Vh!QqF05Y40Y%?!8C+4Bvz&)I9hHP1ufoImF_Rd^2e!zbX{?@v+w0s`N9{$^P}V0FZG;H-8HrMNfA6(fa`pQ zNImD1A$&DFiyY4?sb`)w!b{b4o^0V2@T_z^Wm3;P z-wLmU=Y+N4eRTk5U(C})}4|qvP2t^~@9bsP_Jeg{KR+?w>TN zXP$w=Tf#HP@w_AT%u_5p0iKwT!{^)%oO5QLvxT>Z=WfTdM(UYoo$z#c8m$Y@(*|7g zoGv^Ap5cz?L8)h+M}%j>^Qq&hkb2JNH{n_Eoc&37Usr;&FXp*Mcs4xK9nULL&pbvo+j(V=X?e@=gd6k z2rqzVtmDZ6*XQgj;K6e|cwY1SIV+s{LrZIN+TS~LtZ@F`p;Lw9aTn<*9PuMPgb%OI z6nqU9erFU%MhoZf9hzcz@O^_t`2D@l8UArK|1TIw_1C)&KLF18a~un6J7?-tBz+4cyQi>-+P&WpCA3;@I8hH_lJ@J(SF)}5#HC?!po88c5v-$ ziqx~OT;bc`+2DA71P}Upv$`+-yPNIC6XZ`t{@uo7fA8OkUxxS9T6hKW+yt(D-7EF% z>jB|A;92c>%D~xIS*PkIs=vN99@|%i@z}nO`6|4x=E5tHXArpdHBRc;*F@pF;CbKi zYyxLrT(9qq$M&_|cx+$CmWB7#Qg{{eq=Rc;6QrJf-6#A%cs_7Eo59%^*K3RM*uHic zkL|13*WrD&5FY6h-46r6wXZQ!&%VY9uLsXNj%TCP$Kyf%weT2tj^7l`uX!#2=lz*^ zE)w1lp8Flo)8L#l_s>FyFEt)J=hcSW&#Tn=CVc+&g~uXi3b^)rgVeL%n}s)p=S9a; zEcKlK2g2jvIec^Y{7(Vb`JX1dB|IY?&;8&!|EGj=|K}TzoqwU>cK*MEGbj7qsT?`m ze;eL!4{&-o|6amd!!zCSERuTWSu8vOp52b;sPAg;E9Pk?yd6CKz;$1Z1n2xY=lg{7 zTue0{JO5dR+xc$-=iJ!u_repAGyePV`CkA|5Bt4HczbvzI-WeKXP()@li=Cnc=ky> z^VBJ?y)K>Lxg1>Q-w#~pKf>Wz#$)H7W4N9FXNE5d-lrUhehu7GGiUqnE{A~!bGFZy zQHD>f{_m3U?^4Gb9@J;|i+ZOT|J&xe3rv0R3r#uymxL!{Zoe9jecw^%huU-I{Ob!( zfhPrA=RZj5nP-UbRCwk)o_D35c~%MU4Nu*zHS@Q99Sa`phhUx=m}gtV?d#HWjK}VW z?%+Hx?5n5nG~{{0cx;}9QqR6#6`l^yAC4zxTeM&HRffKrgKN$cg=fH@4zBBXx70J| zy}~o$S>brTkb2H-lkhBfTKpKkj^}{0FXrhWJR6=Y$CC%n`$H0bpYv?vvFEhFcy zW$Nv@TO&LNd18JF@9RWx?W?u$TzGDBJokcgKU88r--xCFM+>1xZWRz zNIi3A2rq?aq2pO0_1q7ug_pr|==Sh^bpkm1VxE(QZ-!^6?;ZTVZ3;lGh28i{3{** zCaGu6?}b;v6Tc&T9nS~XxpfpC>05mOtG^~Vp6OE0JbA)n;Q89|`~x1$?cloq6#d5Z ze&ezChr@rX>C5hilfkvG1mUsBbF1;#{g5s7?CU|{aqxWTc)kbcen`cB_)|RG4||lu z-{JR~er?WFaQ4fbeS{~#^R(kxB=yX*Sa>2le>tAR{|G-vjfE${a}Btjqfy}85Apc< z#hu1u_rpZvvHRg!Q*WOabA%@&&-cb-=e$SiIp@8?Q{d@T8NOb9z_}kXupe##=Q?u! z!-c29|BB;ZE%nT~R(KjbNBkL{^JH+%lOQ}Dp5cxsN9vj9QQ<@3+2DA71poiJ;dNJ) z;r9JS-M?!3visq9aP6y=@C@V`Vmx*~jFWoyHBopbJjIUZYjF0JhyC!oc(@;S3eSSS z!_Jz1ZO&`K*)MaZ3D1USmg89>^~|$Ocn&;Oj_1f-(VUv6sqkEQ`he^GAq$-M2fn|! z$9U}hA;);^ewb_O?fv0J;d#hYVLW!u2c({JuD4tIh37JG?Q0M?_d_A}!yV$`{Ii4? zz`xw_mq|Tyek;5Xo|E>3@2d{rTu0{VB)kZodmPV`QqMfk3NMCdljGS3&i%mm7j^!w znZMl+jlhHX+x^hi)Z6{gPIw9Oj4&R%A0|mX`+8V-DLfxJo~_{A4<*(~pN>&Tqf2``5y&+#mldgggkcm+KFI-X|#)T~!9f97c+dZUJXsRoD*`#KWBT z36ES?J=E&24;=p%sptHE5*`E3X?w%>RWi8F?K0u9@Jx0*v!$MS<_eF4XRG5m?7wJE z-XF^F{-ObRkkj5Dnt|*6A<@*^`@?z4k!P&&*!}RR)U&TAgeSoBx#QUZ&ixQOAlm04 z`)cnu?uWyKC&GUvxbC-`rJgx&6P^UmYmVmwsb`*#geSw(V1M|&Y6Z@H#XN0=r@)ip zc&31JKk)rUuJPFYFw=PK{oxH$Z}-F7!c&oFukqOZaP)!N>&3o~6`lr98n~|4XmIX_ z1nh?#Q*VFHk{GFX@O}_@g3p7sJotZA|6WYtt-&*dw*#LfyghinaD03tvRpVnFIOg< zpO@Pu93Ml7#2!*R{{URKo$#UHDZ=^rx}n1FME!8X?cC;ob02a)&l8@G_1b1UcHQ?% zJ=Z-_C)yYN8Sr!g*LA;6>X~PN@Jx7SJD#Od&pdAl&w}S)#}iw(c7EnLMtC+neZjS_ z5mL`Qw+qjK=XJ-kR_dAOQ{lPr99gesU)l9)1I~3}p3{Zr!86?PJPgir%AYIE70&mA zD+~|LX&m-vsl$H&XHNF}v+#W6OgJ>W-;2TNVZU947r^tN7hVj{49Bxr>Y3+F;U)0=?RXm14?izQ3onJ|T5vrt!=#>h zMhP#2r_k|y0C*gekSvMw{Kd2A(XCn4zQ-`+!*ZH3=yc{`)gKNJJNIm<_5nch$ zTF3Lf)N?;<6J80=DTjyet4`qTi+Q>TuY%`($CD@Z%rjefBrQ7V?;Ou=sb`*lg~!0t z@rdxgdV;er=IJXu7M^Du&#O|;Jg*CngJ+lHIjTX;ehXfwCH0TKemYG!@1Iu~9_-H) z?9ViZ4+GbJM=3|nLU7%mYown2t`nXBPosw6^FJ9}^CSpQgy&YrlP&ek^Pun~cs_JI zo28!nVT|I@9P3^_QgCG2~UA%qT_i=>X~PT@KkudaXf!XJ@fo6JPn?t#^HVS z0q6ab`*Wml-an@p9_-I_?9W*aUk%Q=vEQ}A(~#M*WG6P_Vw6asb~I3Y_wnYl?6{1a6P9z47d6Ffipj!YgyuF z{(FRH)J)HDAk;W_ZMI4XP{+Zt~3w+Cl_-uHTeb3V*}o$y>-H_!NO{@0|Q z`IidMgJ-wnIppY?zHI)+;LOi+(GFbmpDjEe*S+2NZT=}*k2jpT!VBQp;COzPdd_o) z@IrXbXj0R!&C?Z}eQ}=Mgcrf{h~t?j^~_TsycnJxjwhyR?Q_IDjfAg;rzg0cuhHPa zItJf&<{`pmSB0TL{grAGcz}Xk`Tq!&Wo+*y!d8ucf7lbFn^RwgGFZIk*w`J{pl>$#! zaGmo&sb`)Wg{Q*vg5y~w^~|$IcyD+b93MXC)4_SZ`17NSg!B2;&3Nqj8UxPtVqfEg zXCTiz#$#V6d?xkm>nq`z@Wh=E-q)#y+w*lkIL{Y9w>HY~;CvO}d_4lLeLW^T4S7nz zb=`lJdiGT*JRP31PYmztQgF?aB0LM8haJycsb`)Sg=fQ4;du5-J=eW%eC>0Q15a0Q zolk$MXP$K7x$r#ic;1$J=2;;;51zUwh0pm!aL$=|S__{APln^k0oU_2Q#pQs^n&r& z^Ys}x^RTb4gcl-DT&wWD&H|^0eYF=}1kV`9Gud!^zNUlg`C4aqaK4IhzJ3O09`?0E zcs}x+adLQHDd6<5uO7k+;F;!l@}-`676>nf=O@Q=Kkob7r0sg~!8_?s&#(J-(kaUU&jL z%N@_>QqMeP!V}>+?zHf}&H-m%oKFYgN$`w!JkLly^UM<737&Gt6FI$R{|DcP;eDWq zaK2AG0X*10_C9bWxb}68@O0$KH6FX}FG@Z8S|mIJp5GkLe#7m3ph3HueuMAB@IH`a zcyJ%!_jS7ouf%;|D7f}}tMFvxd}cFG8M|jmO>xR!KekS|hv|o|v=4=X{*u_CC-CoUaG??{2O&Jh%_==OaUf z$Kdy*O$66|Ckf9(&JV!#KCoHp+3yzR@U%K7yx$~n&C^+U0X+9Qo@b?=dFBW&gy(z5 z^QY9u<36xQcnLfm&JFJ?6`XxBPaol>@I38!7D+wxEEZk{&tHz`@b=N1ny0bwa(J!* z*LBa3dgd7+yaJxZj^`7p=X^dBz5||S=Y`Mtd~m)m;C-N*aK0YsZ9Mk%KsGq%!@eFA z9@{_qK>g5o?0w){sb^n52#i=2+?t<_+CxUa%%yXXbBzVR;o~csLJdX=c zhUYWK^Q+V|Po?m#@SJ^NcwfE2c^}}w!_mWA6hq!8srHl`lLEdA1mjy$@7L zJ^R`xJRP2kI)?Xkjp6n_FaVtQ0scF?rwkA714%gVuY+q}MZ!~%=O1w0&rLhkJ{Rok zIN_=A^aEGVaH;2 zo(dl9AA7#~fNNj18$f?R?sRYo61ESHUyN@l26==E)Tv!9NV! z=y<0eKAjW;j!>M>Uic!J@XU@kAvqI$5ZEuXim*jUwBJ+ zQowcHZv*G~;`3{~@=nn=PLqwtp06d~%)`Ex2~R|xD&w*H=g5@szM2Y8f~OC-_I0!2 z_I%v|&hy3R*CNA%^OcSB^%1!CwO%>$#C8kcKc|D!!~K&eJOQ53j^_cX=bUqdC&RPO z@l;4X^ZX_}1)j674Dag-aQ4MK-G!&Z^QhyQFZIl`Pj;92i=Zim=DHG1uhg*%up06XjhxgS~coy>X0oT5UOFjDi{IxwRXERAd+=cY*z=VRu6^Akycl_2FdqB- zdROY%*DB#9@YL-YKIf)}+w*l2IL{Y<55U!i2j{C0=W95)_BC2~A@VE%*Yov>)U&V8 zgcrfnq*r)fr+{mo(}b78Gt%)qBK6GknD8=qK6gC7NPRqBAO0@99Go-aPX#tG;9uLq6Cp0CB= z%)`Fk6dp4$`a1J(}D&a}+T#y#tS1)k(#XQ#u?*vbt<9P?1=Znv; zkA?GmeQ7-QeAT(W_PJnR^@XP*PYSr6i@{RQzJ>}e=r&;VJOE<9Pm-dd~kp;py-s_YdD!{lIl! z4HljO&pgNTmee!Pd%`o}IpBDj4X8b5&ZmX&EO-Wh|IeJIo_WRz&xYqc$5STt%=4}A z9C%I|7(V9?;G8q_bP}Em&pnRkNvUU^XNBj%v&r%7lzQf=5}prFr$OO;^#x~N%+p_Z z0X)w+o;RePdEORY2+v-}bM)Zw{d27FB6!lkb^lBO5AGYm{ej<~c~W@v)k7q*R5#!R-_o(+HaPqz@iYIg z!jo~`vu+8`-wj;zUoAWZo+lhnfz&h4E5cLZ`Q7mxni0PLj}V>)&sE^M|A$IF^V}*t z9iCSl&l;)c`mPh60Z;6$;d5>S&N(yB>B2MN8SZ!t zLyjk3>X~PO@O*fFaXfX0hwuLw;RWz?2iG~@DD}*9i||5t3LMW0spouF3onA_&=KKt zJ_VfnDjx4EyE%LiIM;>whX^mmbzcP6Ijod==KoN52|P!P49_1Au6a%oUJB36j^`e! zXP*0om%;PCm|TzE1b*n_||PnOiPuX}{2z_Zfv zd?oeFvsrj5JjdT2zV7Y8b=@xzo(9i2$1`2(nI}(pIy{>l&mO7geD(^@fal^n!u#q2 z&c2wZpYTk0W;&iFQqMfgglEB1<#^)mjOOG%jNq%2!+U~j{=UMqaori3G&lJ=b@m@O*gU#)j{cbHF)g=IJ23 z0G{!V=W(fLo~MNu!t<5m`CaOnXQ%KYc-r3;-dAsM?l+W2vK;;>IOo9pPY5rD=u2>2 z-%6=x{@ub$;JF|xJpVP|ny0t$Qh1(nJd32Bc@_&VgXb^D)8Ov#{U0m59G>3bI-ikJ z&pdYsuYhNnW_Z#0wR66|7 zd&Bb|Av_t^y&7EeXGlHsj}V>$&tk{3M(Vk~>x8Gm(`aJ&K4}fkeZoAa3QvP)nB#ds z>X|1;cse}m9M4Zu&pf{h&w%Hw?C`!W17}~%bEWW1c&0d>xl+$OFAC3sr^4~X+!xKs z{l@nZ?Hs-tT=Q=c9vK|HznyY__#7?w@EkTNe9kSwnV)%15}pXpjgIGTsb`*h zg(tzY!ts0$&i#hRX{7Fhwf7-;9JuB`UU)LDdjq(x%Xq10{%qkX@T_(`o1~ue{9bq} zJn@sm*QEnE`(mC>!qecn$MHNZ^~^I;n*Vy?*|_d(aNTdqq@MYg3(tWk@^JV( zn}KVd7Q%Dk8Q^&Ckb36H5}pUoTaM>5sptBBB|IOV7LSDYbsjkTVx9|y7r=9`<9Sl* znde#Ih45^0Jby|(^Xw5`1W$)4;eA~P&ih+2_S<-e=Yn$%%>R_|VqEuYaNTb^rJnh# zgqOh6X=-@>Uf`PNI^m`87j_@jY?r=QQ!MWe~eqouz*NLC`Hwcg5MtRI* z;rY)3*Zl2;$H0^2c&14`^Gp{W3(rQ!^Q+Wzo|VGm;5j=tyss<4*%$L%qa2>;j^`Dr zXPza(6X4n7cp5$)zWT8^P}sz8QR~@NMAl89uH0y1k$4d`NKR3UFQD--Ku5ebYJ9 zYx3LAJ6#J-59gUCJQtqXj%T^lbHA+=9=S0(x5J(c&vP=k=1CA93(pA0GZ8!(Rxr2h zK^GpJ+f49a-B(xh#GcVSOAKFWc$wk0{tv^0`XqRcd@9-({p4*7xBklw5B#hjXt?#? z0j_;L3C_83{?7`}$2x8T*YmYg>+$b9s)QH7bHUT$>(~oi^IRvq5T2QiXPMMYYn~Rui{KgHc*aOQ^NbT-49`1`XQR|}y}lM+0?+Yz;eA~I&c2xEBH`=c zx!>{RNj>w-7G4U^caG<8sb`-5gqOk7`PuNk`hv4B=IJlI9G>SK&pT4jJjKGd!BcNW zc%J6qn&(8}74W1xp1Y-;5lh#cwb$>*%$L%F8n`u9&tR2 zq@H;eE608NAIEe2tY}Wn(@Jd9P+z=od43drCp>NDhWB+bIQwFruEMk6$#FdMrJi{f3eSe; zH^)z_0033@LYI~m>)jp)4(}r<~d7v z9z1tAp2wx0d7c(t49_OVQziAxvrl*lJY5!q_ca)teKF5a;gKQL3sn78;CNO^J@c#) z9s^H<7sB(L2p-)3gMS~y-~Zp%)Z6#79i^VXC;U>W=lk6LQqSKfJVfgG{&&38rw2o* z{(3;_`M!9jsSk2y;QjJP;5z5^!b`DUOx9Q*Kj%4~ z#Zu2aZwhY-&)<$G_N8b}&2x{_E;rZ6_?2&rr*(-biJe?MW_tgiSeKAiz;TiDE zaXdv*&phu6zZ0HAUJ1|B1e~vj%PXV5IW-A9xZm3Q)s;^Dd~oe+q3~?v*$%GzuwgeTMSOp|)% znJ&Btp06CwUsBKc{4Kl^o}|L?zIuYQFXrhh{6Bb}aXf`m&pdAkj~QCMA*;XsaXd{H zhwq;_;Z5Ng0IvIIB)Fc7N5T0zBr6&x@|5w|*CDSycp{^16=2}RO-1O-V$B{&pyY~?Dg8~$UH5C zm%=j`T=U#5^~`gx@G^K-Ii7E%o_WfJm&4O~X*9p)xdfbZW}YjASHLsH@ywQb=9#M; z`}}9eQ}2!1b7r2yg|~y}YH;oA7O7{R;lh*PDRev^Nj>wd7v2?~CT~XbYo2!CoHO&B zEj$&TF^*@t)H6?>@HBWfJD$B#&peT3(frJr3(sZX+SiRz&pfvXp9Rk%$Mb>IGtWoD z3*c#76wRr562O_CdCm~N6rRzJ=OJ*tFTDWH`z`;z+pET7@3-ruo__~wqtx?$yF=>v z_hNQQJ@2;---^zGdH8exrr^PRf;_z6o(ZmfjR5D|IRD#)r(w-5S|6kcaG<8spowD6P^uE@;l*u4FYFh%riuI z4m>Y9p0}i)dEOIV3{Rcq;dxE~*E}Z+UkA@Ejwf5{ndd>_W$>(ZJX@un^QjQN4W4%I zhWB+DIQwFrD}`6WGtKcVl6vM@EW8Sy-HxZpd(oVlCr)_cP0<%j1HkoMWJx{q+#|db zJS!c~CaLFqz89VX&&eyo=iC{beKF4^!h6Fr+40N-*Zb1j;Jm-_?`W(t9(%tnmwNtP zfC{PS{Wek@?Tdc?p7R)R-amQ2jhA|U?j=F$dB5!fu6+$O^}+WK{|gGLzp}wOPp->@ z!XudHTH~?z;jL27b*T^@15dk^;p=-DxaPT1cq}~A98ZDNGtVo+2OV&-0FFh14_8YT+qJjGJa{quqFB6tp88@>-)fipkzv=v?q&uxz9 zVX0@HX~Ik3`ONWbH9Yuy?C|Kzfyi#*cY+`JQB7Y5_rrnc*NMU#qW&!5(f{vAjyDUBh36&5 zvs&tzXRYu!cp9y%nZNDpIK%75)Xc3tcyNDMSUt}S{C?&XQy*jMM}c$BF+HO5TxRND zG3#=`)E{2$;a8JSYI4r6uIE=PaQcfzNB^7drv6joA7JW_F#b`7A6l&_hG(+ztT&$7 zQqT38s~mIQYCLw%|4BX9>yS@t@1J(?Tmr89r@z!QPrC3Vc;-8vVyS1I4}^Dx=kWD4 z>tg#l0X(>$udAM0!AbLju|~R>`r!W1HGtJ$*9zzD`6l7Lqvesigiio}2AunWbC@MO z75Tq49-DuU)N>Adg{Q&OsWf~JeZVzOKjG={%yB$#OFi?f5S{@~-3{S+;=s8s>60=K zu1hy?&3U!(O!yyj`~_0aoUaJag6DU~Q~$GQe$CTRcs4w#;Ce2GOFi?97M=so8;++O zJh<?=GEo@X3Sq0}?a8^ZJ9`N#1b zv$6L4nWwq%0(b_2>---E=iCZ0x0&K$&V1p8@NaSa|4Kb`9uQsxPx2Sx^S>UP^Jktx z!i(XV>v-OidgggwcnLi9zYNcF4mjslfVp)A*PPvim%{&u%vm7344z*cPo1x7 z?-S0gzVLE*t^(J6a*Nb6&v4-t@Dw_pZ@@XXBFyby@i6BB;g#@TS{A-81Hn0e=DbmO z6+ACEp5;={JS&AqZiznF>UR10y3O;}M z7`WztQg}M9TL!M@;xDOZ{=bE1z|(Pa_&j@qYo6i=2Y zYn~Ruv*8)wc*aOQ^NbTd6`pq-&qk?_$8-E^;d$^J|6O=r7l5-b=DA4te0c76JTs-9 zdGdu9!n4is?3a4xsr!92KXWdJ=L&G$hv`z!JU0n1foGxPd0*<8r$qQhcp8?6&$$&i z^D|Fd;pOmTIG%}8&peZa?||n6$5VexG$)@szF|oB*zQP8OaH&n=GUKB;G($-;-j^O55zmwL|UN8wrUwD~E# zug>7?i+L^)J_()&9M1>fygwx8MDGukh6neDble~s{2a~0>oR|=@LXKCH@Ke1ky6k6 zcL>jeXPM(Em3rp+LU=wr$5n*S^IUND#XL#E3*edHc%G1Y=6ObVAv|S{=TE6;o;|{s z!_(oH@V-*P*%$Nl5nck%vySHtsb`+Ig>QsszvDS}d-(ooDZCt>ba352CJNsH z&-;#Nv($4wTZC7^bIPybbG{gyb7r2d!t31{JxDo@XO7e}&phF=@N9EDd!?RvB0Fl& zza>0fz;(_Kfb;&4kNd-`h6neDV%#6ril6yE6`p|W9{pSRJllcmJkJ)M2+tVDGfnE5 zXS(ntc)oHxe@Z>)xkq?1JQw~R-d8F(`(mCx!c*XR+VQ+5^~|$WcyD-iJD$dW)ZP!w z(?obWJlBEiKDk5cnI}v5aCnwGo-d@Hc{T~pg6D+F@Hr=ebI#1uS@!kX>Y1m`pS9;d3!cltbklwnm^#d z{ehqJ91R}qXZv&5M}>EaZj;D7!w-$A`8>c1!|mUz?eb5}+!j?|m!G>BVYu}?Yq<5i zZ@BerHQaiR{I}-1)^ncW)-xDf*Kw%uG|Yd2@z|dizbExv$M=P&!&7f>O-}1M9$fRZ z5}pCi&5q}Osb`*tglEF@vE%v5@VaK*8~zu~&+muF4?6td&ymjq*Zda>&%$-bgX?|u zNvUW4XN70Ov&r%7l=^slU$;tl4m_Rqg|AB*IQwFrfx>g)dEW87Vz`~>58#|<@}Hd! z&a=V(XdYgd`D2CW;krG+b)Lhdp7}=!pAS!=<5?^9%=4-6LU@io5I)Z{!Pyt{oGW}e zJa;*ssoxG{@Mj(Vis5z4dHKNb28K5} zq~^Mo4>a878Etq&<9XO{>)GJ&-|IxL%lUI1cM31T{M*;9$!YIbJ;3SVI`$I25uWLe zXQ9+H&#S`A;rYYy99FM(U(C}$_zrlwgX?*@QRlad3o4i=UU&>VH#nXwsb`*hgvY}3p5yr$Ja}DEzxsdpbI<<_pIZIgFB}n^ z%t+*@!=in$J_kQ1Z3C`-oi02Mc}9WjdQFjf_LVEVH9Q*~&vvQjoc|D>2v1`D@b$U^ zoP9A*cj2AjdDQXDlX~VU5S{|hFODY?6V0i44i%mX&*k7c=K)gBJU0kWgJ-Vec}wa! zpZA2P!*js#oF0AI5ou7p$Lu~#Hr(#RK86SN1=xr8fO9_V>we)G$n!q9&S#UX|1`cs4v=JDxwJp7YryJO`fh8ie=N9h`kJPfy{w z@I2voUIuS~b?5zLwQ#QQ*TQ4)cjtcvXCC%dDLfB(&TbgqR|+^i?5l@zc&0g?`BKk3 z3xyZJv)%C=(kT4AA11sIo-4q0KM$08=DAUL5j^u8&)ZVZ`K%CL3{RwS_?(XeZy@V_ zj&QE~6~Ys+?zbC%a35$0ey_u42ycq|7aYDycuUlO>hSHt+o67s!;e0)W z;TH<;g!;=Jo(9hS%yl0qyaekt$9U}P!(~#>bzd%gBRu;YPqWzC`2cxFgF^E@X!8J?|<=YZ66ZuOeh-Y4DRNdedWFdAIvwm>}0`I7K7_ zhdJvDPiIbW&Dq;<`@Z!C@CMa;HMn2#`8!ek%s)wZ2Cn;o@!S2mS?Za8i||Z%S~Uyb zKW7?l^LGSiem+M=f^)wy{~f{;M+B!d5?N~eHvcD5&-|YWPll(-vEljKfoq<#g{Q(Z z#_>EZ_003M@N{@KIi5_J|GCbJNDR>`ovEi>)zyGbmzc(CV__}Hy`+oGlcmkY#aX!xo&%(a_23*hG-%`){ z{3m=8Jju<&=iC=u^Yj;<3(qXa^SabCPm%Ch@ciR=j%*Rlsd<_TFMy{HxXx#!)HBZ= z!k5Cc)bV^I^<1y@!i(XFZ5cl2w&3iGdD;nI2hRw{^MKSdPmb_1c-A_ea;ayYABC60 z)8_c_zB+-kFXrhYyaJy49nVauXP$iFyWrX4c>b1p=J`)}1ow^3CxrLa8=QSH&-KC^ z!ZXA1ER}lZc}sX4Jo_Ebi6_=R7tGUIcx!lW1=n*iN$Q#BVc{twgQr*UZ{Nb_vsLPu zr$TrdJg3HodoBUzoSEke;TiBuaXc?dJ@YIQo&`^(<2mf4+H+=}2EudT=?<=Q9wPP3 zlOa40o`sI*7jS(Z?Q!^-t)lt0zN6vx`PJWW`}}&?@ZkBCIbp`Z{qQQduGj0rbFmM1 zf$Mx4om_j)oX^q1XTftVxO#4tdal<<;RW!#=6F7odgl39_)>TpwhrIVr-18xP7_`X z&q&Afh}1LBW5UUic#J@dRMyb_)Y z$8$jHnWtWx+WV>sp3A^>{|u6P<{2V9f^+(!<9T1|nWsc}LwFjt4WDx>aL$=|+6s?@ zC&TeflzQfwB)l~|A2^;Lq@Hm?uqmCwTH5&l0I;o@K%d;Hh#v zN1j@HpD<5T;f3(@0oVO=o76K;rtl(o7CWAgq@H=!3on5u_O$Rhp9;=7GtZgA%iy`) z@l2C?=9w!CJbwwVg6G`R!~41toP9CRHNs;?9ehkhavje?aDHE<`1bRH z{}|Z-9y~Yg_bc{`pZV*ytG$0paow)qx=#j5J@elvyd0i+j%T^lGtWxlmGB&TM)*8W z0@r!A5gy5m&U2XK$(DNNc~E#PJRdrqZ>65|`9XL*JSU$S-q#Rtef^W^@C6QEVz_<1 zwBB(0dZ`ke`zpR&>A`)KcvkIw!ugyhJPzx1H@NPfr=*_qnIXJ2Jl{EUj$E5`|!ScfwM2>xlVWy zJhL3nyHd~jtP;K&p8Ds7=V=A5dD;rEz3n-Gtu!p zCH2fRLwFWE-#DJXq@H>H7Cs4{q>kZzT@B8@nCDvIx$r#ccwUxz<|!1O2hX35=ZH?> z`{zjE`S4r|uKQ<{*5i3`r|?Da6gi$xrJnQoTzC;YO*@Cr`E+p3ne#~$z8ap?cn(NC^VGYj_WU=)(;ZyrJV@%9XNd3=+*jv2o_D04d5VRn!gI*Q;d4F~ zoO5QLmcrBE8R&S%Nw(9)HBZ};aTvUkR0CEh2ZRqc`g>71J47F=UJ&| zo;kwv;Q8M1?2&rr*(PeC2p{OFi@aE4&h(OS^{8Z74YVVxC)tSHZKy@vH+6);IWj*2Spb>hKEV4_+^& z4?4I_B72O#q}s!O*S6QGk6c!>E`g^Uo(AB-{MQ;!tf>$Fy&k`gG2D8Z3y+6C!T4>? z_J&{8uqJ;e!vlXyc)AL24}PQJ)2eg!ey;Pu?{7Q+&h_HD=O`Z+?X1*z?B`)BrJn1) zTX+mSoi7jHKmEZqPrC3}cosUIkEEV?)(ek=C+>>yJm-LOA4Wco&Y_!d?$4{igZ#m| zLwAM!f3tAzlhMXw_u*JmZ};JN!-G8ZWIKGC@!Op9O#Q)0;XYF!JRbAh zVLW!9#H7@mui!s%T^b2bgr_IC-uH${J@@S>;mPp4?s(QqJ@af7p2~gFEqtGx3LYG) z;CvOocHzPEb)KoW=eM)r_WWKZoac9_<9`TT&&yQd>Bzs)`0cvvl6ubJAK@ABbh$Eo z4uiop&rso+@Vw%9K9zdr`CNDwJT0#Z&vQOF&o9qu58*u5y}(^(-6wwLpDer- z*Ii>gHve~0&vo1?ybPY!*MzU*dEm^STir+S)!Ebs`Kw<_9sIfmT<70gcsZ{7l=0a7 zi=>|U7Yna|=P$=oH#OQ9^A{jz1MpzIg8b2cr5%YJ53c!J39rO;hZv8|KThhIf1>az zc#0j*25{ytM*go&eUP7j@8dh;4>-TJ8Xlala=ebM5YGGR9^<$7y#_sNp9}8KSmooR zSMCk2=OR<;IiE4YW8rzr@vN76=GiDb9-d=*h41rr;9Pg+Ia_!lJhwZZDN@foxx$m- z+30vGrJi|q3r~gTf@{P3x(1wmF;8#d>F_+|cos=L^DGvg3C~}Sr+)8fPCge(&$!^= z>$(=;!9KCig_8}p&xO;4^SN-f5s*GU2(n?quV!`DaT#*Kw}!Jb1P`o?YO~Ux^#df2Kaj&*wtp zzR@{o{wBinaoyhFdf&KB>X|=NcmX_%9nUIo=I7t%{m9e@`T1PfEPkG&Ey4?N-B#Cy zulohyoCEV;B)kZoiH;{1ocZ~C&+<%tke|;T>aOB>l_9NPe%UdjNjf@-;{dJ;T_>A@cid^8V!i{ z#dFQSlY0z!u&;vi%jZH{aLwONcq*9}skfi>%H^Y;Sh9GL$);TiDcIi7{!%+J3gyx7zS`T1OUU;NBpB0Lk< zJ$z7j{&;ZBe~R!dcy4w)cY!lMf8X6iQy=8#b77M42b^CI8*ZNq(}eT6Fw6Mub78Tm zKiD~*3vUX~MqmFLk6qtpgQIiP`Lqz83(sJ1y$_F(dalv$=+u49VuICvg*JTt(VpMQsUuBi|5 z^SQ88{LKHB@OWJJU*oa&jiZLvUPsQqneYU7t^?O~%m8P8{$1cqQy=8#bK!pRGyg-v z6LH-Vh{IL{IH!@0uK;UDRE9+Z0Kd_;IAJRdloQp4>Wz7r2~ZWW#l|8~c7(k3DvVdglB~cp*GzWQ5Nl$#6S|OThJc z*VokB=iMN~?ep$t;e6grG~8bIVQ{_fT5zrl=k}@a3Y^oUZVm7E9B_I#w+_N9;Th+6 z3c!Q=*rV0=jo$sEcczcT!<_4dSHXYmu<)E6z%^$l;gLI{*PY~eW`b+Zh3Y|`SB1yG zztZvS2iND+F}Fqg((ASc*S<~_-W1pEuGf9gsh?`NU9Uyp%)>b>7M_AU|AOmvTa1kMOAps8UU(`zw}PwZK5$*H$Hc>& zPYO?izrgYQ2(H)N=hQbG72elT!iVCzr+{nz8^QIuEAe}=o|pPk^!u9euL+);s9$aB zZNF=U7qZ_w!~1OuuKl(Xz7(EJ$1@o`=&QIoC;OUWJi#2;*VD#RYWjNJ)Z6_~WVqdL z?+P!++&(sbyH9>J^>%LCg%_dUbH{|wtv9&N?Rw$G@XU2QFPr+HFXmqbuKQ$-)N`I+ z7{A>o+fBXg_YdJE?00N^}Kg>N&UXglA$u zY!x2C=U)Cae!EZhIQ4slr@|k(D>}DeK0$td-=i^jaG$aMW`^7MaVHoac=-AAHp2Nn zF4J)P`SZuYxn6wkKP|iz>-C-S*yqT8sptK$ZdOgd!G9`)=PGc$uigaC{mjpW4l|yh z-(;-I7~`?ek#SD_M8oZUW0K*4KOO!jjNh)yB2#~`L%gn7EW8~3{%bsTZY}PvJs-|3 zUU&sOw}R{3Za4Kd|HI&%C-1k@q@MSOS;lYg4~tE`?e|ULmF(AeY`;y%h4*`$@Lli> z1lNA=0N49Nmhl90U|$aykG((SOFhr~0^!_mFA0ywJ}EMOyHAP@x97LS@E|A8Z>eye z-`(JPPX85Ng}GfcK00TeTR(7mxZef~kGZotRQ1<9$Fp4OdEZzmJPw{iCxquY30(8E z5uO0gFvl|SiU zUN)X!pJZddy=gr5zE^7M4<^Qa=?md0$aBKI;eA~U{(p3x3w+n}+s1z-S_fK$MYIwv zB||bgjiPnHN;0V|lBuu=Md_?bv<{dQL$oL+m8AZLFiM7Kl3FB1YE)Fhvv0ra_PcgH z-+Qmu^Su7g`+q<0&voCQ&-bun+E*vx>F_-2c%Gp8Aiq6-7lB*9xk$0@wU6NxjYU72yRoPsdYdLNuq{2kgFA4?M^joRfT<=Z4@x9=`8g zO!Y^Mm}h(8g~&6RJbX?Hq~7{kBz!qMe>k3hsXoYGi1+`KCRXm(?t7<#TfcVSYX%FX#5BlQ!-Z@my@8{Qg7$vYVz|r8A$cq?`^_MtzYtRzaL4x^}AO1CV1i}hxdCHxIQ17gWDXeuh!(@ zb8?N;+uSmQXXCo-C*10Xke|;By%Mk>9{AkM;G3@I>UfXiE5;uL3uZ&G{PPN$|{a zJTHO=*HLhvOgJ*lNMsS!2i(36{Eql7|7zjMSoi2h!t*x(*Zhryr`WzYp1Z*`}wX%#c%m%2v5bjUy_IKV?Rs1&3}*ZGD{9UL%$ZtR2bpyD~ z&GKgoPsh5?k%#jymwL;;N_Yl5|2UpHk4F2l{F%sqGI($u1^MfNHvkXv2lpkr?=>PG z)Z52d#QFWF75Vvodll6mNrwBzHNrE|*BtWjd{#-l&F4MgS@6_)EPQ|Kfm^?YxX(8S z59StpU(%k-$x>f}`u61K=khgF&;4cy&$fQa!~HIkdh7RX;ltti*YTVb+YaUM zoR=GZPA&nr`B?rQ;CfDaOTEo=Ao=;6jHG(*_d($~)-QRu-%V0){caUL6`nJvhxgkC zJm`zhNh-L_!TRb(9)5qzl6srl?ZUHhPVN#O!TZ%%^7A>FI?B) zTS0z)KCY+wBb{SD-w4k{UyWyn&!;1}&L>TH7Ch4(&upsa{I7!tbL02zWl~>)epi#9 z-=n^vdhU0#@NDb%>F|Erf@{B*3Lg&7B**hKc+eNWN9B_zn1l883VHZFs+j8eJbX$# z@Z@4XUkJDNt}^oTIXOi2Jhy*^k3hd^bHe9#8@SHx4(0H?>3E8$KIqHxZvfYGvPtS~ zog~R9tMIAtyyAG?1=n-(A$j^JjXp7n;UzYfNP#+!VBRU?0CjWz2$jG zco94wIi519xB2`iyab+R`Qd$C4sLx}p02{n;CamP%#(V{vp{$`JU=_0D$iBEel5>2 z!Xx(uhc^=G46fI8UvPb2eZk=$sUOeTwZh}E?y=8@&$9`*&a;{D1b7BJo(I5#`$_P; zu)iZTf$9Tp@3D`I-{wDCcp}#QmOOmUf0ufj|DVE>;7NHQd=6c}Ex-L8p&nEpr^4s4LYDo1#etVBS4_x!N7M_ZA z?;{WAe@yBv|4iX&@T_+{KZ09+`#VCvQhku$-eZ3!e{g@c`~RQBgL?ZoOgyMB#Pg!& zi?Mm~bEgTo&Zn91bo6x>d3ZiErQYU~Cp-h5t&Znss^|PwUW(=q=Em=_$AAae>tAI3!-z- zb8-^6&B6L=1Rl(d&q;f!x4Cr`o{e*oCfwdjdy}8f$qi0@rtoz5ZxL?qv3EQE2Z-}~ z>;&S$Ik)%NM}*sZ>=N)`ZoI#52_K7nsq%98Icx-O9^2ougy+I@hvS(j^%2~c9u}St z&nJ#&tJGVb?ZOM;Y5GcdU!B0MFU!+Kco96)9nb4hZ+VspFM;PD$5U@%G^ggNFT4z% zKHz%a7$)_W=U(CE@Vx1GO2G9!_S8kuoXR_ZYyM8k@rBVz;F^Dq)LZ`NgvY`2z2n&n z9^6lY=Y{>o$5V{JKa1w|%ty?Sv=6^PuCI25$N7@18wL^+A4nk6j>s%m1qI zWURY~Jp4R5rm*rpTK-zXQ{d?iuKU;z-16JsJ-dbKgZ%a$JDB{z{n_sScM=ck?PECc zpuP~#i}B>==gu6eKhh!g_c`II=<8?l@O)~$9zLIV;c4((53cjMiRwB3Nbq28{2u$D z)R&;&spRMPljo?O`+Z4xy7fyQ?zh_F@P2Cu?*-45;M(ua;6Y#f9-Bp;U=G&T-Q?l- zlU%Cj^YA$Fz>|yl%oc9%GX>=5bMhY5^V~iXo`HVj--ymf`#ld_?*pxcXTmea@#Ii_ z(3j?pJ>g~BOLpeNOJDy!qZ+U(bo(s?U%VK?To-W|l zm*u%ics@MS98ZDNTb@P23*q_A@f`bRG^ge{UU(5ay}|XqF;wa;&oJR7@GN#bA4|Q> zXPxjece4eURVYV-Jeo&d)!>6R~cGx5MYw z8{Fn#`EL-O1kW7Dvk2Vs+uvziO7%g0dyic~{@^}r_y2c@2le)`ns`uOi08!@HIVcqe$~I-WPcgTDAZb~$;1IapuslZW3=%BY^t!;i!RPcG*3 zvv7N#IY53sC&&LUItT05uA`HMr=j0WaJ>(YlX|<39ul4o&u5OOlBw|&%}OBbUg18=ku_ZIIsJi`0bp0FFYIT?sPn7y&F5vylz`??dwwE zW8oj~c%IUFJTIORo(s-&M*d~E(V z2`|LDw>h4di1WHD#bbTFE4&E)s_)18Vo!Z=&3U@;5_oQOJcEhz9EOAI`}ylm{o79c zud8GCnczPa;qT@CF1+BuivP0WIda(IsUIJ~dZz^yOK(^&Wcc=|b>yQSXpj1V3f6I_jv$QzF56REd6 zp9znHr{*W&eI)9}99fCuyEzx#cS!|wpMIavO?g(qR%CE$7=`&8;J{};lO;W=Slc>c!V zmVeYO6^&GU^a9tM*9%V>d!#%v+ws34^_FwF@V4+AbUY_~7R|4D5`?G1(+^zdcE8kH zo-x8Z!L!=&ln@_%Z0x!GD|j%^;P?7>;CcOr!xKuv`#Mc{8uIi9*S_wPdh2VH@b2)e zay%QPJ`vaHCgJJuH2OUJT(t+c{jxkAh4+Fd$MMV}&U1bp+~#b*AHBlio4_rP^|e)a z2J$riBD}9Q;O4QuQib=0XPo1CTIwxNzVJ+VesnxlzpQ+IEKhae1L5fouIDF%IM4YW zaGUc1oaYA}o)2#GvA$juo`pQy!8OmnQg3}#TVJ`~;qY7zuAW}tc7HoCA#&tnvUn`# zRN-UcFLC@oOTFdXBYY}67km|duDXEh+^!Oy2hTLeQy}%0XOZxE@a%RxwZ4w#)VZAn zt~r|vFNFV2aNU=OrQUKrCVVA4UpSr}Qg8eCtMFoYT5brRe`j#(%kp#=z8;=O9nZ_) zHn+6A$dQjN;<23DgqOj8W@&iN_TZYcqwpQ@OmsXm!7Zo#dnGHxV>#auUJifcoA8|V z!8PaU!uP>*qvIJ49^~Zb>1^>>&S!-mfWOS~AC!9A_kV;RhNr{E@P2!NTTXi(-4AYa zu$*IrN5)k&Sn*Nh_`i{Q%eh&2HFz3+8=kWjxaG9_c{kM-L@csx849M2r7xA{LOJOQ2`9nZf~Z+WVH7tL=u z6X8h%*ZbZWaJ%kGn?&cCuO7U2y(l~h{+*8hsLhr0Sk5@%$?$Xs*PORVz0GZ~@DzAn zbv(sVZ+Siyo(fOhE#c>(Ex64s;jHM~CQ*HE#X0O$CCZ<3c+;|&pZ`Aj1H^-`Uv!>5Rd2DWJ!qefI>Udt1dfUgBg=fIC z+wsJGAAYWm6`l!C5AgqYuE2wR4Cb7Mxs7)CtKzr(ZwSxAy8FO&-D7_U&wsq|;qY7o zuAZS%Z+V6Z9}CY?$Mc!g+y1T>J{6vXZQcRL`G(Jpr!Q%VNhf`KQV`t>3A_OOdk#TyyS{dYk`m!neV5 z;g0Zqyb9d*(ehj)yd0h<9nb4hZ+VspKMciqvI);`ouB8RS}8o7d`@> zQX!)Jrre5|i$g%=>tM)0Z?d+`EYFMFll`Z^$d2|O2+hxgS5T=QHdya=9$9Z$a0 zTb>t%uZ5?~@%$n6HlM$Qm%`KfxA4BM2DiQ}PcPxy;F;!lUX*&v^Rn=Acz$#|ho#=~ zRQWxc-*O&?r!9C@+4n1m^Eu1_w{uuFDEhuJ%Hdnd^F_tEvX27}ud+8b=b+xc4sfi) zn}SJOTEn@OL#gw3mngT;C2q}>xX6Hv7A2& z&w&4|1L5bV9k`yK%YZ$L3kGYy})&zw@bav^Df~-;d#UH zd@S`gw{^m^;i+>dd~Rof>)e_P9}dq@$1`5)Eze}(Bj71^JX@vS=CfV+D0rIw72a1n zaO=zRTqb-hJQEzxY^k?A&kCOiPnqNSL+UNhU&3?XX?r-luWP`qFUyl5JQtp)9M2l? z;G75dr80bfcD=)Q5)Z!qmW8jsHT*mLx@aOi4|#3@*X!azskgo+D2HdYwE z3*broCw$Hqf$N;x3NM6bwBwm6^_C}3_;Pr@aXjTxZ}ZtNya=Aw|AzO~9o+h|JUxUL z!!yJ2ydw3Mr%-qaJij@f>XBnAPE#bJd1?zUh386eJwF4b-tycgybPX~9nVT|d+#kO zi@x`M3m#lAeExrR>g!es@9QMtJCNr(aP2Ew>aDMPgqOp!%<-(1dfWHUg&%W6~s ze1<7U&e4u%6>*-=r^GquR`J_>whNz!b$@p}=hqIO&t=4U-Jak!ANzTyK~DXB;5wgC z!V8cy$MF;s=lPTp=bXF1ZC#tsZ^9R1-M<}AyJN%Wb0u+Jw;#C8$G%Q7%&8v_ZaMRD zf0!)15IJW$o-c{>e10I#IsX*D&F8T2l~_0KxY!)nlSZ7^%^=S8S>QIG<+mTX-9|<^ z^^bz5Pkr8Hj|&%-7odF?}vm}n;d;!x2YSQgT9}12M=<7Rq-6jkCsOUfosko z!sFq8&GE01ddpcNJOQ41$A{-U3p~il?*nbXHD{{uMEJ)!{yeS6{O1a90ncW~vj<$~ z895==7oU^5;F|v=;VD?RvE#XkIG>Zdi1WG+iQo3+5#epI?vsvZ194vWC*r*BpWt>~ z*n7*#^}^?q1g`TrM|di7UhH^A66c%`6X%?B#c%U@UU(<0`>NyFO`O;Lhd8f$+=fA*d|D9ab=!j5 zeC)j?-Kie{uJairJPSGRay*NP^L*YT&N;spzs=`c;lr`+PmZT)Lil_xBF^h}2Dkax zd&><@{ZMe7&oJR*k#n@;Sw)=Z^C@x8xmEl&pY6h@V%^^z&-wMk=W`ixUbiQ>&Bxwb zZle0*j*I;q#cJXU>HEUJ6R%$J%$|zx zPU1m*0qP%c{8Pbgo;HW+!po6=uH*TRIPcf5#JR634J)5do7*wM4`bcq!Sy|=Cvjdk zOFY)s?ZV@7Duz_?@v7tbKBDD^g1Q@d&S zoEw8%UzVq-@Emxu9M2f3w>%StPle|L$MY??p8wy3+kL)PQnW9txAUJUddT=NW-ddo9RcmX_%9Z#{;Tb@sa z7s7Mg+2QA^8Mw{a^0XAb1fDw`&!bXrd1eSd0MFNs=Xa^MJbwz0JRE(#v}qpRR}XOO z%kuOV9tY2pj^|aWw>)nMkB4WU=`d)D@)${XZ2=UQ{dU|c&eNietwP--WHzD;Cg;;k$THBSom0YUUfX5NWIPHGvPV#oN#{loST8$ zoGnjF;koeK>3ANJddu^O@H}|dI-afIdf$s&5Y4am+Y`a{etQnp^Zm9XalYT)2CnNq z?f4gh>)c)!o{D}~IiA0X^L_8wRqtsi@pM?*Er}>4kemT#j;MT9@xk7k0Jd+*I^HOhl<_jMI&ko0PZtG}H&C^Ob zJokX>ec&;vw>&e27r?XL@%$|HHlIDh3*kw=D16SH!L2XL(_Q#-cph~;FG#)RDG*)+ z&rZh^NvS+%%X75w)$m*au5<1y^_FLV@M3tLcRX)Pz2zwqUII^*i^J!9GPupz@-z@$ z3Qs@BGhFH|&q(2A@GNmWAA;L`&wifpM{vF0{^``;a7nD+;QR9Sd+P&*PfUuw|KH{C z8Q?ab$dqXPlfuivH<5?$8waI+Eb9LeegM2BZs#I*Zh|X&&0ap!SybBhKe=FSy+g z^S50b{KrV+)bPHV3LlF+gTS?~30jZ&mnJb0R37T#BD;=y}#GRszC`uw=z4rx>WfkT1=W8>_1mQ0=C)IK2|Q~o4^DIN2-Bi!>Il5E$byrh( zJUrdN^|~7<^>(gq6P^Ii%Z}%5aGlTlR3FU2o=5dA56@p;cp}#A53czikb28MR(KP5 zK5#tWO1+)8GT}+^G`b@EyrqEad21)U1w0Qro>@|Fd7cuU49`Z#vsdbEJ_m%Sz;kiu z@V>4Ax4tY-hVWE)<~p7gQg35kqJ0IN?id8MZ$MrKD)`o&(rE%qy3u4=3HBNIXqW_>-F9jJeV85=RYhSJD-mUKLGz{ zj(@wAb5d zUypX)S_@CZy7z%={>P-=^3N2W4$peWvza*W%kSc`oPP?>fd6mDlX`Xd`Rq!Z*BtI>%v#Icb@MJljyNL4~9ukk`d_;H_ z{L>xJdg45X&BS@#{o=Rz9}=F8bt64u^I=a%;=Jzl;5IkwtH1CO@IUK#mP@_mT%{bI ze;iM}p5fPHec?Iq^a0oFahTLwo_mGo!t(3Anxgoe@C2;;uj9F_ zS8P7KZU(sa)lYaL{LeU^rBZJ>R|szb&tHzG?zQ3P^CaOZ@LUJ3=kpG!w>)$%!aJa~@V?^RXn9o|;C>v>Mj5K%HgSYeR%#;z%@@p;W_YRI-dKa z-tvqRo(s<^$MdDs+k8re=fP9IPk3L+;MSMrxls5VcEVWOc$OH&liqor_@`X z-NNU=bM6h{eRU(w@6{RL!8zpfHjH?1pDB!fc{MVgcu=2&^Z5+<1Kt9BBe>1e=CDP0 z0rDsI4bOiOxOr?2ZG|s{XSCya0^Itw{C`sY1N3!?>iuGQm|qWWd91Jg!V8h-dGhe{ zai!E-U+)TE0?*O?V|m!q2weNR3|w<|7QP(*M;!l)Qg1n57QPam-HxaFjnVv?r?&7S zc+$c3J~mkDEzh08SHts$2=Q;Eu z&hM|VtDQ3+L)uaLwOGcoEjkClBZUpVV9a_k|b3Q)6&={$}8s zzZ1CT>>|7b{wa?C1*x~31;R_=+39!=f!jGrs}~(;y&+tRd^ZtEg%o?@4HfObNf*E4tS~$jm?2Q^@#KRzbUxx z`xW4tznk!KteZ=IUU!kyTmHqu55V)M>m9%L6sZRuoFA@l z46c1O6`qJZEgjDg;=Et?66bX%sUO$H6yZr&ce>+QN1WH)CLVil*(p33{ysq z*UzJGm3qrFRCpRZ^BvFsq~7NFzVPnw{Ns4)-4#3M!F?kDy-fTzhaZJ!VBKAgr`g@%=k{{qyzW)tcHaJb|8(kyg6n*S z3C~2%5sqgmah^{RanAXf_-#Jxg=b;iZyis<@bLMZL7dk;4_y0gEj%0RwsSo96X$*> z5$APhiQoEtO85w@o9}qOBhKsYAkORV1Gn>#TX8J~ABU-)-w*5D6PqV{P6aoQ{rfv- zP<`OB_sJ`Wv!@rh&i{JhV=;$J$1|5W&!K=guluI>ZT>5T=V0CU9Z%%m*nD{1TEuzX z`rz8{>B4id?wO9~CgQyA?ZkQAQR26L#|h8Fx;c*L1LC}H32|O`6S$od`+nRus^|C8 zKZ&#FsQaRGHjn+BQZ4Y{J|B4OJ@#U7opXET=ywcxxUW2^x4F#~UI5Q#$Fm1K$j@H~ z_>=1S>qT`(#LgAZp&_{T)kJtQF6`!xCyO}udpB`jcf9y*4wHqaVBN_hciXr2Rzv*%85o#$}j>FDbL$FrO` z_w_z;UiS;}+dMZ2&%nBy9nYx`gwL}Hc+gicPy0BR>N(Fv;5yGSRL|#gI{AYi1-AFn zCxmAr{|55#e9EQX=CEIQ7Cfy-h4*_IaXvpcgX?|lQ>rhcbMgbYo`)U6vyrFSXeST2 zd91I_!biZ9<9KEf=f0MLYhNck7|XMj`f3Sod2GKf5MGGq!f^8NemyGn*4GT-%i;Ob z@oWRv{D-KX&u842XkVKDSm9+@w;s5DKGlOb_tlp;uRBEi)^E1(9a#51$Fqbuulo^k zUiUL_y&g{<8{1#L9#1FEo)+LbxATOTBY%qHxraFCA4{CqohE*p+brP+uiWz;&K&$A!=HDsY|KHNqpferJ(~b1ss4o5Nz^aq#SQJPpQ2bL#c- z5O{FT`93zCIM3l(aP4cJ@Ob2T#qsPQ&i(Es&g)j4Q2F|`IaC*(fOU@p*Xy?%abCAS zab9;2xbFLdRL}1Tx!^jV$Au>%=hx)nJbSbr=X0O%BzP{I7(0jT=?|{^zLM(sKEDB6 z^KTMfgzN6KN#X0Z1~-rGR~zBQ@QiXilZo@bJT4x49?ceB0{?T4XESl0+fL%V?g8;z zUw;cP#k$oVip_^TmlEf7dw}bH^`(0D45a$t>#O!2yO8SnKL0K8$13X6pKW*KE3!Mm zZNF@uyM>R%dE4)J&Yv9Xm-}i*oY(CRZtL1SdkD|Lx*3k=apJsgp?IvXrNVRJ|I6{z z&x!V>IZqd!2hTw8;QqsT?j+807%d*lIbJ#Z4?CU@iSxRj6X$iy#BcNeQFsB?-Q{?i zJsiI8oxp8w)>jwdh44>vJd32>axNCW9G(M?=cp;MoIHnkaQnHJ{65itFE5Geb1SZw z7WhP{7jgCsa6A*Jp1*H9gE)Kg!F6sg3NJ#x3mwl+;(Q+V5$AP}dL;au#|baSx^=*V zbIzXb#ChFY#bf7TsPGc_7dxI3skig+mGDw{PMsRtcg}Mban9cgT<3qW@G|&Q9nWau zylxJ0UiV4yTVHd8@4&h*IG!@%yzXD(vH3?Ht-SB$@LvJ0_pyOeZ#i!hegK}=9M1~k zJcp0K^?KYw^?W_ndMviT>`4GuPl{821-R~eH{p@#(HlWe$1{yM&wn;?&bdJRHqTdu z$6?*2j^}scyzXJ*!PjH+@pt>{O{=``b{^^rkH@+V!GrU_oLx z?kk=+uiFsZ*3HMdO@!COy3HL=7I9wpZsNS|7;yXiC;`9UF~h0P2e+IypBI%Q=R(Kx z198r|n>gqETl_YksxvB|{}x!c26%AJ*^^3~*X=DH>+1&LDeynxcos>$i!G5JU^;dxFesvR`jyydb&otsZx7oxw=K}HD99|XP7wax{Jiim? zb^jsWp-$}QQIDP#KDWByHa9!xr%C;&=w%&gF5G@z^kQ(GXM5pU=<9OFGm1F(HJLci z^9k|WJf9Xm9P2*sc)lUd>+TVco&SBp$HIT^&{5^nW&>K59%%F zJmKb9DBSWa5pJH9!ma)j;++2r;+$tAanAoeaqf4gaJ!%U39k2(!@`&2x;|=l<#TAB zRN{PHcOxF;vHCvXwyxbzZWLaGbq6_~7l`w^uM+2V-vPJ#NiP0g*=JH;59jb};g)|J zxaGI|@J`{y$Y1Vw&UrdEPtKo0obz`Ew{>l9-G!H6-D@0AE^%J>Y2v(Y0l3XA4|6M& zdYfC3@CKOYN5XBMUx8a+HqVX1OVQU>$8-9e@Od^P&V8kT+qyQ-cEZcBZYRexjyTVA zDsf&nk2v4A^N9!bHqV8^ZJuv|+rH#rU)E4P-%q|I9{8JJU%qwt55jHTJ;GbS^QUn0 z|0~??pS9-3_AAI^_sNrmw}rol+=oc)Oh`OT9> zoa@IE59;my|Ge<2$n&!Bf#A!8+uYt0Zu9v>_)vJh7Cs#Od*Ri`ow z=W)+gp65{H=_uUtTr1q>FhscZHHr8Q^uD^1cyK-~|0dy<|LFY6In7^JxaDc?@ZQ30 zp8bW}`FujS)qf(q3Fh{NaP!oEE|$M9&7l!-{`tDL#Dm{Yw~xz(+rIR0_z-Y=?nGur zP1(YCfWJZ>e!i@h`mw10Sa>;jwdZ5~vgZWw;5ov-pI)Epf2ioU0UB=T@Rknm?C@*B zbq;-mA3**Aj^`QT+}8r)oPW9aZEmZC+Y9Sz$5Z8n@OjoI&g-549?bcxig^xi935zV zsZYe5&jr`{v=SaSEBgO1k~}cmn!*fIK{(SyFHFc}jR9JR2R) zFW@$xyrgKud#OIiKOFgwela>9&0kY^64vbo9(-Me^AD7I%YU2jWO!b7Ja2+x10@yZ$f<&@L>Ld zrvyA%c>I9qH&iYZUXJ=phzGCWZ87J*;K6?VNauMVaqep7W}^W@=kwOZ=!T&)*w^Z7=&h+L zOK^QIZ=rgAKJJ%#doI^p675$#?ZJb63C^cIm%BPVlQ^$C3Ea+MHtwH~3Ag*|OyRkx z&m+$FffeBT9Nb8pe;#{>cx)ek6`qgz?{hroEe$^>ZHe=`-N5bq*uJL=FTlFjIi6X> z`FuV@oPVBqnfR^Ww}lsC-FF>N+_La~k0;LSo&&D^o-cek)=hCdV~BIVQ;74N^Tcoc z&J|vSb>}&rt;BiVUBr3azr=6*8+kK2H=9E-)~ya6oLlyEBF^hxMV#k6Nc`6C5aA_Q zcbMZ@PMp_$k2tUUo%pTa?}e9Q-5rkS+~wit>Js8SpU&X=^ZdQ2o^uW&9{j#QtBQFC zA9oNB?r#fmpLvKluR9Z5*UhJTUiSlV+jrZSPlT6YKDFKopF))cgJ(?itxF00JpDW*NzKzE)uyC z+~#Th_Ei4(k@84?$MZC}zPG&M)UOo3_4}^yIIR1ro`iL$JDzpKdEHIKgZs}s{QlPu;JRP?z;zA>g(oA=QLAEeW`9j^ z^>?Lu&Y3}+JvTa@;oz3j<~CAz3UW?x{8JqNYO3d)CB*qUDkUCVM=SBX_<=a@dpWpX zM^*k8KF>ICo#$L|n?ox4eO`Fd6VdzC59H^*4oQ6xJpT$$h9~u%SWfng1lK$d3QvLO z9mn&v)LWi!g{Q*PpeQ`g9mIpLtJ}}3$=UJ(@ob!Zd!Skcz`Ah08Pvre*e#@B+&!yn{{K}Ae%hONz2zZ`x zJWHhB^1LN{EIfxCPua{tFJ1~Z8m=2@Fn8GeKO(Z z=zsC0+4DJSYLC5 z=fS_h@$8m*%ehy0K0GZy44*?MaO>CdbP-+v&qT-bwA5RkeBp)geCv3AlX}bZhw$a_ zocB?9Uuodhm*u%qIXpRz=NYNDJTC|@hG(dK%B3;*T8K)*4Gl@CCIZMT<-(5KaS=!kM&ho_>MhUh!b{55V)C{a_gyUHx^_FL`@M`evbv!4m zi{{jGb+&MOUiSyr{5K1a!@Bdp^}M|;^_IU#csx8+J`11c$>5r&f$#))`Z=EAQg3-i z3QvS*h2tp&w|SQ0Iz720mjB4-iQp}W2lw;D=(b1tfNNhj3Qt0weDd)7#+y=aeXSIp z4A0+==Y-Fr`87|1@DzBi2iJYimU_!`kMLA@mN}jc;5z4h>cQu;2Zg7>f5{iIec`$F z0JnZEXK&%@@I2{w7D;_7@+=mf0nc8?Q}fHp^S3;8glEE&4zBaR4P56ohw7i8pW9hQ zoX_VL;r99Iui!Q}>-TrzS;%?N@w8qazAu*&5AxW$>EO1m&F5O-*;u!)<9UiWpNH4P zV|^_VJ_7#zj;Hol;rm!u_*i&)g8#pLlzPi^hwvPDUUNJjO1;f(jqqG}YJVNRFO9)% z{+6ey@H}|39M2f3w>%St=fm@X<0&D|=cJ4{pY#3TdR+N-FM=ojoAC426x`-)d0Gfx4bSb4XM)sQo*d!D@O$xhH zddvB#@E!0Rw<&yXXM$^zj?&5mck)LWiI!mGj4W^;I7J;1Fm%hOwU96V1to>!&b z^1LCuHazQ^V@F2<8^}O9G^_Fv}@ML%v zIiB~W-sW5^JO!Q_Kg9Nn`)UGi`(=5W2~UM*u;Y1#c(5<^qQ@jsK%D>G*ka;b{{?Zb zKV@4iKmQ$uo4_r<&EZzz8OUEi9-hNHQg3ruEj$yRqkoL$Vb7`HnkP|s7CZwS&j_iv zJfnqY!}CAKbH?`YbDJc51U$Ea>$x2(^_FLn@UifG=y*0sz3tal;W_X${waLU7lYfJ zEl+#lx$ul}JdaDg<(Vx!51wxw&+k%idHxih4^PUD@V=_nllkG1fiT@eC!-_nGnHvA!k?FM+?<@obTL z%ehT>DLiNH3ZFw8aO>CdqzW&CXPo27lX}ZDSNINiHanhuQg3+<3NMG}l3&C7>H%(j zS)Sg)_rdd|<5@(U&&dbi_Vo(;{`+>~!RK*#`2PFf=^=A<0bI?4< zPakmYYZSPBewv8;)gtj&&c(vh;os}{YwiorSx0y;c+$Z&=OC%KJVS(Mz_ZZtyf5{3 zK8uC-g{Q{;@N?b}+|G~XX(Bumo?9HxD51zh)WmvDQ2HTwo^RF#D2mUL;b^ZgT-g4e1JQtpq9nag~nsW=) z|3ly3j5`=U|FebL`+o|!?n^u2dC1wx@r)y0X}^f`^Wtgo+kEnc=VRUZj%OQjUiXlA z>^k~acme#WhhlSM&voE7AIsTScp*G<9nTw5Z+VsrUk=Yf#}ofo<@0HIP841QPj7HN zp96^Vz6>MI=juUlJ%^7F=kF&jAP;{(aU;0R)8?>6cro%P9uD7^i@?oeb7(8P1fJ23 zXQtF!o;=~D@O=(WXp4NYd_thQT`m#JdgqOiH!|^PTddu^w@NMwyaXd%= zQ~A7Eo|?jUz|##}&)ZE>Z+UJNUJg%z-IUeoc51_6`5)bBJ-(OfkoWEbNkvP|H zBhK}8kBa5z?=M^rZuxBv{e>qX|Fh)bIV_WUo5S0}li@k+c#f|Y&8c}#7M=o62Dn~# zcS^nG8Lk|jrH&`>=-Avk#mD~6=UU>I6R&$rto{n(jfrm+XX_(s}s$WE&XPx>locbPdv30McoY};$ zB7Rei@cN{hF@81Grx8ylKFQ%{*NS<9zn@(3|8nHx0^v5F4i4`RZgb1T+-?@0HYe&| zKpwunK9c$}c-9I}hv)d(vHa|50j_z@6P^Ljy^d$5)LWiB;hFG!=XmyNJ^DHzJPV$S zj}7muC%E-xd9D+l4NsoqSqL6HXZi0-uXcE;!w-O49^3c7g^xgm=fH2~Z^*4H56 zW8qoocs`VR%d_@O*eiJDwTfmcQ2x(fs-1v79doFMxlUnWrwsRpTEdIrNe5TY zKyaPgUE;Bv_X#h7f3o9Q4X*2!I`uz^-}>4md=u6^?07CdA^eO!c+C+@I3XwHP7k7o4|9U;~63KmS?o^ zBzWF+Jl{&a&8JLw3wW9&g!k1R{J(wtH~MiOxb5k_WaNEbRxUX(j z58h9H5S|5p)6>IqUJ9-`uMnOM&lJa#FZDLJ7ln_2XS?J1Tk36YRU1b0Th6iYbOhJu zT3@NRJOhO1!1JQxc}MCk&uZbh@WdsC&$&6c?PFrlNX5ss;MSMr>?1r6{%0Kja;dkR ztAyvnQ>9UO&Xd74PXplv@bq&$!=>Kxj1*o7&kD!$rPSMeN`)_nr$OWJzFLD@UzVqh z@FIA|IG*RhZ6EW4|4{LyTbK%ACpLj-i&U3*vXDi_)@QiRgk4e4dnJK&!p7oCB z7pb?ol`Dtmye8p&bp^M+EYH=#cfd2#@hp;h%d=Q`IXr(jp897-bJ{*89vj`q!QjFD zq$fS^9&-3SXGJ~Q*Zsl|AkY86^?p?<_14#S!VkmKsA>3|F9O#*ZG}gkiS|3%@ywEX z%kz}*YVd4yJpX{(oJ;Xu(IP2)Zs!S)ga1Boo!e7VZ#kb49uLnp$8%z{*m>Zuznw<> zjf(f8zmY!$JjgSzg4;)DaGQS;*1d-Kn2O?j{5#!~$@3DucRfq>!QXREhG!Yo&!_se zQlE+UfzO4fz;n{s&iMhi{5H?F!c*ZH=XhQM5B8ns`6_XqXR-J*;NL=i?)ML=&qV#P z&0~FWePeLzD+~1(JM}%JJ{$E}PW^DHAA$M_PJIEmT^Ff1SEb^a1om;Cf&B(5YW9e(U!e;b~ZRr{g)RWq7}rfNQ^3f@{A$ zg{NcPn;g%x;M(sh@mOE)2_FUjG3SQoPXyPTX9^z+&uxxpjMQ76iNYts^MT{pB=vSq zwhGUIr*U$4Uv0pxFUylEd@4K>9nbSpZ+Yem&xPj~$5Z3HXim*@obY^jdV=e|50!e$ zGfenAc$PYzHBxW$DG^=(Pu=sw=bQv?eOaD!gfE2W4#zWD>MhSy;f3&&IG){7Z+Z3# zUjolX7lilKnK=I)-D|w0*>MiFK;hW$oaXjA==Q->YkIjF#@NMw#cRc4`7(Rz~#ChHB;5HxY ztB3GiSU1D*JWibVy-+;X*HYp8;Q!0<)NdW_OLLws{4hKN!Sz0KCvl#`DDdFV(F8od z&qYW6GR-Wi5B^SdgNpw?_$VUIo=+W5ql;qu@>7Lp9{#=BG;r(7=5wX+YR^X3eT+Oj z=lN1^`?yeeJ$Qa~Jcq%9=YEj006FWXRGz=(JV|&H_^$)k`DaVL<-A9D3wV|}o{zwT zoc#T@&Em0~KL~FHf0K)2`@-{V2X6afIWH657M=-?=P7WTr~Nz5g;c+zVeISV8^v$= zw+QcqbrUZM&wnwv=5H^&J3J#D&opq$Z{Np!MLd?XQ1}w~e{=jb+f+VRHs?CRSHhDH zuIFkHxaOQd^)EM!&3PK}Yv}7UPZAH#{~VnEWyJY-WE1D}|A=_3uUz5l;s4t4?2~%Sc~JN!csjHTpTl*;c^?N6 z=lKi=xA|E9k;1oO-LZ~m6>*+VF>zjZgZQoAO~Q9!-5(rJV*Btpv;o(?Qibn>{~^aS zPwFk_0^x_@+2eQ)5$8En?-0$e&(ntB!S&16R|n$k>F#(&QazuCam4w$ewa9~y9iw8 zxmb8F%waEi_&n53jrMCEn`d3&ec|Z|uJ^GlaJ`RB6_1_g>B0xX|ApiKMd~eQx$vRz zoOfyXIqVFsIR{cb?@Kmu-j@-?d0(C+&gbDpaGSHu;bq~&k^gnavzs{Y<3ZxQZro+z z`+KbLQCPPgc(A|h=|P;=9V#B{Ynbqf@W1JJzLI*|-;Khj!jsrBe1B7j^FDSa&V5}A zuKUtQ_$;hD!0|jooaeKEIIp{0{MPR(;d8L=YR6NhQ}`SjfNNikgwKQjR>w0*>MiFK z;S1p@aXjA==Q->E*ZXbc@>pMdeI*iS&pF`g=|lB=9&RGe*Y#lHyzV;U{B!Bw2)Cb0 z|Iy*quBd!HCgxXMXcZqdgvUJ>)a)GF z7e41r!R@?Ro)*Fr;Tht1#%VqJdPsN@JnuT5jZ$xUwg^v#=ajVYzFL7>UpAkMg{QzX z!tp#V^_FM0@KkudaXi0*2hT75zS7ZMqWP8Acldb@?*Xp;_7-Qbu z>F^xgHGKXJ!8K14;TiDU=6D{Gddu^O@Jx709M5*CxAX9e@GN**bPMn6a&YU*@^lrR z4bLNv=UH&ucl&w%#SVYh;k&>skM;GN@Da#!QTOn^t_3%b_0>oCSa|Xs&r)#f%YM%P zeeqb%V&OUPf8%&gx-vX}b8ubv5^(LSgYa2cH{J0(3a;17^G^K&;{0>tAAnmPo5Lr< z^O2{{RpI@%05^~A*LlJV;JMfFOaa%q<%!2~&J|t=|02ipGq}#}AE*A4JT`|Xg%=}FDY<o7CHW{UN*ro{Q4M_q{W?_IoY3 z=IkT96#hYu=LK-h|Atflp7^b=kA!c-x?eh;_#WZ?CW33fO^NeMiHJ!W+P|!ts15^)|Os;Ysi`=oNmhT7%m;u{>>rw}NMk zO{$DIu;zHii_%8>)~l6WlV zE5bA2-{bge^sb!8avmo<6P}*nnsbQMTb^v;S@0}zJnN+1@_Z>g8=jM|3qKFZ;C3D? z&xOKAz%$bE%#?b|lP7#EJewTPeyO)ShlJ^1-uMBYO%kuOSo(s=&j^}-FJ6DlE zqCfam_4>-^!E#m?o(F$7@TzidZ;^V-IaoP7uR5NOq~7wZ6Oe4p^Soei#YJ6Cui zJa;>usZwuwrVC#V&sUCTkJQ_I_6aY7C*_9lzIuRLUzVr0@M3soJDw#{Z+YGlUINeG zj;CSYXwLu6)k#NgSCRhUn)7DirSQ)OuPW#2U8%R69||vnr)IzKxt#&7d6I$a*&K2%gE5u_t-w~bw|52IYb2|-Ob2b*92+ttLGe+z4 zqjR1pJPDp+$Me0^+dlpzJQ<$m1H$|21a5uVe7Xovf#*@jGhga0&qCp;@RU2A8aGuw z50>XR;c4*n1lRL0RO&6yFyZO&EOk5^!2df}xL-B8IW|xJy}~ZU`S%lt5$F1+h;#j> zf#Gx5Dm(-E&%7m;hu;r7fZP7s96AXf2v3gVc~0tWUtSWP4bRVxr`n*(eOaCw!bib# zCAjYIAgQ-JLxktR^P1!NSn4g$I^nb6IsVr0IVXYJIVnnwzK1^zZu7UC`NH$z-{$!L z(R$oBj>@V$&jNTlgX`QfrQY(~BD@fu1&-%^skgZm3ttXT?c2iVb|$#a=WO9c@Z8~e za-`n!JSw~xp3fc6&r)ym*(1CJo(l$t_jM(>^<{Z_3NMA{3CHuA)LWh|faeBqJwKzt?VLvvqR+2l@mS7Jg_px$cWC(BnuF`yl7%0DXSm~eRO&6y z4B?S^(fnUKo^q+Tx$PGo2hYW~hxgSJ-1@RS*9nh@=V`~YRO&6y3gHRx{Ns2|zN7Ma zusjWv!;=ZF=iz>-w>)EnC&BZ+ z_lw7J9ul4kfBWq4oEhMnv!C!Zc%E}SE2Q4?ydyjvo}-3^=Q#~r^E4Ko0nZ@EGe+ty z&qU#w@Dw|q@1@@M@h9O~@HD?Gysu8+)|ch!B0L+OM;*_6skb}}g^z%z-0{@7JDOAT z94CA%JUzknx*IC>mS>po9C(&Go(wdv*oELd^tQB z;5z4FQg3MhSV!i(WK?Y{6iw+6R4Tb?$;OW+yfc%G7a%kzxzQh2_1 zJk>@-bLu%C1s=?kKQH^x;qfD5{qpB)eH>o*fml8N98^Paolg_tW$3H9N)5nc}ed81o2iSr!Z z5Rc_tEvdOce5^0N?vjbKryaO@3aOrd{`M{5 z_Vc$NID8wp%`+4I?i8N(QuGGVY(gwQpNG!i<|%`xyYO^)raGRNq~7wpB0K}0pB+#2 ziP4;zr?&7+c)Ee>``(SDMTn(0b%X6pjmGBfgo)4wo@~jbF3{UNc!}sM3aGSH`NfN#up4%MH zH1J@5gMB=JzXSG$cr52~;brh2bo}vCD$n0?o+x}5JiWnn{zIkS@(dGx0G`E;=VPh2 zJnMv4n;$*Tbshv`#9o)X#Uft#`5#$ zp&f|x=bL|kYhQl}PePtcAC39>`n?(4Jl0p1@ML&ibv#?Z^*;F%asE46RUeDx;lE2( z7u@osVcpY+kEs}0VvXqBdXVR(itEDu9_(#Ye{@A@Iy_^kem>PdA@z1no)(?~PZ@c5 zo>itr`?CBt&trsV!qW|0ucK^mo#zPRJkJ^89|8XY@^imMQa={;8=U%GQlEqRqjIYs z*@z%N`xC%z4!Nj5*QswK^?9i8>eP<_x9iC6hcm^q4W9Xq=RK+4h5FB(`hUS~UAuly znO^S=Y4QpcY{;^v-qvwJ;JlG?!S(w z?ab&LblvN~wXeRy=fFSL@hp*g%lVe@0(cHNp7>eOoSNrE;Y;A@4X%CNF7=k@F5yM+ zyy190mU`Rwb;8%eQ|Iw$e$8_>xbMhSp!t25FljHeY>Mc*zC!_f-XCgcu!F9j-OTFc} zS$GS0<~g3#Qg3-a7TyV-I(gx9J_p?LTb}cUr^7SC@jL= z!;6S>&dQ4#62c-B(V{ZFXuZfJL}3U+81k4zVOUCyq9LiI zR-)-ei_)Sp6-|~VQ55EpEGkQ36#aMaKF?>@&i{RN9RL6E9G~ZWKELz2?(cp7_FFIO zkDgl%4|>i=&qhi0exFtj_Nc=rh<_sduRH!? z@#Ovz{yF*W;#m&Q0mpOv%T?DsxQ=T$7kF^p?OgpNpNjK#h44Y}Ja0Vq>(zylFM(&V z@HBXScRX>^s`qD~qlFKH=W1}h-|v+?`wSDF0nZZ0^NHlyr&#!Cc#e9d>b%+goDI(N z#y;l?9}mwk$1_Iq>@!aIG}&ySL4pPz-#hUd)b(R1|x=UnX5NBDer#yXzal4qYc zgfE8YXU9`#MpaMy{AnnBG@d`lIlK$F&Xpv*5Pe1(kG<|wCC|BL2;T%xiR1Z0^4#+Q z;U(~N&8gah?K1$JbFoi~@LljsaXbsb|M$N0Px$W;el8yN+#x^96l#{ z|MB3Qi+xTNo()f`<9Qfd_qN64f2sI7li!DYD!2MRbKrkgc-Fk|dAJc=_qj*%@yPEJ zo(+E98_|2{56(TX&sD-F!!yP4ERj6>yem8ho_`%r{M@i-{fhB}uh04Qb7yev**N_PJg1>~pv90(cfWp3lJR%iewy53lc^ z!VBT=GC%s9Tm#Piv*#e;#qi`fo@J6}pOwP5z*BQUbe|K!wa+QSOW?V~@jNPd_IW~h zDLktk&)1UYe!df422cE((Q|bI=UnX5MR++p8II=#$+OR7;RoUQ%JI}%81}4>bCqy) z_#0Fw8XhE?53W`5|6{Rp!L@&)@Ywvycq{{4?~BQjXa84(*M;YM$Md)3xz9twv{W1^6dYu@P6=|{C0Hz zL~!lXO?V1Ck2#(fCC@%ng%5^jtK-=#dG6;A;py<4w>WyP%fLAo`wS3144#ROXMyC| z=PltQ;Q7PxG+q++)IP@u9}Um-;CkKflRW!8C_EdUrH~p{HWOx=kp7oOF_1Y-BKRnG=MDO_=aPFCX&J#Weo<|(d zbCPGDNy5|M+3a}sNS=N62_FVehn3NDT@0@GMH)Eo3x2)ysFR-!&i!z%H-u-R&u(zN z?)BcUettMtL*e7$xe{DGX_9B3dxTGh=S|1+q2$?To$%T4)GvtMb4zgD&uPN*;JL%` zJSKVe86`X)o;8l=8_9D&{}o;U&uJe-&(#y0bFt4w!i(S;=XhpHo_$^yz6GA29M8X! zXP;WDs-LUv@bm`P^K&h@-WMal^}cw<$?pQ^emK`&;brJ^&g$qrUjj}K=jt!~AUw}G zo;i|dpZUV;z8Sus?sh!2*Hqsp`_vQO6rR4|y605Mv(Ih9L-J@r;l>_w%Um4)CmWJewrXK3@q>g6Fu8qUUN4&bip9lkk4< z40k+Ff%CqI$M5&$g7d!M=Zklp{26PjpC8WEPIwCXq=W1Ec}nt}>sjH0;o0DLev~}> z{46{jo-+%h_uLa)_k5A?40y5}&vePN&#S_-;MwkY4oIH+iG5ss|Jm^L0M|WVBYE~2 zBz!VFFFBq($+OQA;j`f>b3BKwtKOe|>I=_Yzwdm4@X`2v=e7>N%5d9rFgWjv67)!er&!qxW4Yq!gE`OeVzp8yo2GN=J?+i zPwbN~Y6ty)63;Yv{&hSjep+>Yf<4Se{w(m|{MflJmwXA%`9R^NxLz+BkNxu`Z%IBC z`K7|k!OI;_lMU7Tvrlv39Wd9m;Cf#Vl|1_l7oG%9zT^2+^6c}u@P6<#Ev`C0c0cXG zc^=rOlkgOHhC808B+ow23LgT`2FFt>dG^^Yd;~mae-=GgZ*b1VJ{Jog4bRh#XO86A zXTI=kcy>FULy~8o+8e8%tETW=2(IVn7Rj^E9l~3|lk0dsGTc5_Hwfo*b*sY4dCrw8d@(#T9nVt9bI;3#7r^tU<7v35dVlt5BD@Hm%fNN6!QlG- znd_zNBX_mXGN9m2Q6)AEbx`{g`vy^dXlm%%gK@jNSe_IW}0L3loOJlny! zH~u-a7GGBN56*4TJHfkAEOxr^Lhy4PeigXRd!6vQi$ed)#$%tKizUx_mkDnU&)<%x z?&feVeIIWFu078d-WvY)QpK`)8jd;X~jV>3AlAb8q~5>PL(LFnWYtQqAkA~-A$CE92_IXiwHauTCo?j);z3mr14W5o$qvz@iu6uh8obwjr z>$io%3&DRf{#_N%4gR^c!P}zG?VZAN(Q_`ip4-)u=e&i&7sFHUo9KB@0_R-Ze=Fey z@Z9Ej9+N!#j1pc1&l<<`6}awy&bL*2yVQIhd=EU>kNupr&g6ry|BK%WpQ~RQ9(>M9 z4F<3Hb;Ng7`>~(1;taQ6x11!LU$>m?@M{dWJ#Po+{uFs8Ol4qZXgeSuDuHz||Jo|hhyf-|}eyF-Gc0cEW^SZE4qVWFkJmh%B zNuGVOg%5`3Gsp9@%F+4>;#ypG$;iz%$!d=BMcMb2d275Br=ed<{JRaXh2JgXeSb?~MKL_bJ4~o(qH* z!(Zz7Ym`>sKYJb~d>cGHz;*xENS=KL2``1`CCBroO-%exwg=c^dHr#%GyjM6sKR)8{7r}WRxSy%QV~fKV-fBGddAnco+|OUa zSG)m+xo5uAJA*Q-~9YtQS2r^BD)_*Y1tJy!|Ogy--*(LIj^*PfSwYtI3~ zv*DlU_!mf?J>L>O4W50Dr{1q&f9=yycrHAbgX?oRP4et>kMPCtyyZ-f zN0(Rc&pyWq&xGfCaGmQu$+ORc!n5I7>UchtJo|hud>TAW{|ftSpZ4IqUviG>Qu*f= z27?EG?j<<4<%z+mjl~`W*Yoy>@Las^a&Ud!FC@?YUklHN=lH*!{@~iDlkh@#hC7~Y z$+ORk!neTlrQ_Kpd0yYW!b{;f=Rova7lU&y_PI=WIXn{_&ufxrpSi;8;`af6aXd8- zMxXz~g*SyK8CNcs%ypBv!Yw zneMqQI6XW+?S;36XQ<=Jl05r7BRmnFPaV%sl4qY?!h6GWR*mSndV=%(@ayxv;QyN! zoqFAXnbx0=!ZLE!Y1z;mkF6cuGZ9>Sb`w4tp3#oy70I*DEaBPk>~K6a>x4bE&*8$S!E*_? z-bc5C>)xh{hdpNq&t*@?U+1vso<|7JgXaox?Rk&n*=MNme0Y{Qo-L9u!MXiLcmX`E z4v#($-NCuH_#5k0ey({CoY#dt9}!*%|0>7-z2w<*hwx%}&Z-;Tvk$oTxkUIDcqTZW zd6H+JJmv80cRY>ig*|m|y}-3+vhY&&1lM!&rsUc4ZQ*6`{Ox#}9Z~(<@;V+byd0ie zz_rgv$+OQG;j#SixxL=;l!9|_Nqf6ip0|_gNB3+cye|BAgKN*HCC{D{gvY`2rQ`Wk z^4!~g;mzSmY!H2J2ZHlFu+O!^<=kN5I*W^JWTfjh<_b$9}(JhvYf$FTy*(b56smp4M|2xb_(!JPDquj%S(V*=MEj ze(=<36y4`|aP1Q>JO!Sc9nT2Kv(KZ#2g9?{@vJj^y7~UYKJfpYla!pwfAFPiTsW8Z z?;$)LubTy~_tzZBv;TbI8Sw0LJoS!>?$c0s7Ce`OYoEI$&p!7Gp9oK$RyfljV4(OP+mR6+QxJkZdG4W9cpg0Mj*h;*mw;=Z{=y63dCBp-BYF0DPk1prHJe5EX%4P^P7q!K&y9}f z0nOw5KPQ1kVb`vqkdU&o{#R!*k-X(R)q+=UnX5QFt~y8II>= z$+J(6@M-Y;~pK|#qi8_JReG)ebx!jd^dQC#bQSt z@9Y_zduE@G!pFmt;dq{xJo~&Pd@?*+9M7+kXP^DTXT#I6Mf6;kg6nfT-Q?~2LM}Mp z7t%APR_^Uv;|bmuGJm`)xTLW&P6%ID{X@XHPwwG9;RU$9`QUm^HcOs+*e1Lfo>NYY z-a~hA?bBO$2|VK*&s@#pIlNGK89aYDo(3m{J+;qK!eh9;SAy$)?vy`H@GNvZ zpGcn9t5|qEJjcXG@3|8==VG5O!V}dfTu6G?(=TRvroG4Qh1g+o-ZX|g6H{G;rrn^`Sj>LCxUa&?9)wnYuP^s- zlR}L+K>HyR}XMrU-s!EJO!So9Z!zr z+2=LkY4GfDJpV|ZeQKUreg7li=>@KPzDe@zGgx>QJo6mSI?1!o2H}(8Y1TG+&+Wju zXZGnJJQto3j%T9e*=LIIe0aWbJo_ZiKIOs-;W_`T=(z@hb1wF|R`?cpraGSal4qYq z!kgpyQ0{n+IlKBfVV@SlTfuWHxSpSfB+ovN2~U9MeaG{)9M62ov(F;oP2nkbJPi}7@0op?2#<$nAh_=NZppJxy70E}EOI;_gX{ak zE|a(K3oYA+{rSGY&x6;1^L>Gz2XhR!?+f38>vj1-crvc<8RtY_-;2TN;T|p%o&wK{ zj^|Cu^SZn(JPn>d9Z!>Ut6yLCX)b&OJcGdX`VN&m`wSPJ1y8=?*&uoL*(7{2JV$qk z-gA3!?wNf$3D1S+QO7e)^6WEHcs@L(j;BV)>U(CN!-N;Y(-&O#e7oe?=WgL!;92N+ zK9oHBtP@@ePyJ5Odp-@EduE?Ag_pxK#PNJ2dG`54cp{z;4bF@1b1Jy@IYW4Fcs{Po{5vkxjhwO8k@bU1>cRZ^k&pvB~Pll&%x9C16foq>u!e_&Co8uWNdG;A2 zJP)4rj%SzTxu3nl3*bq-AbPHW;GBznt`%MkPmbexU-Im;Mmaq7yGQqF39fxk6J7?- z9ggQQ$+OQW;W6CrYaCCB@!t(4m?{O z&wk0X&tJml!_&D}bf5m<+UF|a`S46~Jc}gHKJN%$1J9q1r*ZG<*PZ)0M);QZ!}s?T zaJ}yLNuGTk6uupvrH*I4`~JSi zcbIa&CAcy4z*8Iot8k-}rR?yDTnSCZ#`z7^g8o|7()o~sKu=VG5E z;mzS0>v&$5Jp0TO-Ws0Y98dkeVNdN7Cp;0Jf#7<-r%RrF9uS@k&oaleLGs+sCgCaY z9DPajp4)dy)Hx~%#+ zk1q({zmkR5{UGGo;CjyUB%cG%65(<1{Ns3*QY%Kj)eyycJ$|iR1YVTwk|d|LA$+3}02Thl35nJ)8<2c*a-o`9IaD z{4Xv6*ZuSto`9Y&8;||`xKi?*ceU_Dcp6?2eg0d6>vik|u06X5PlEpn$MY<>?lafP zFBL!MS}wdFUU#G8X>?`uyludB-UP$#b-ciM0^YAtcztgH*ZtffJOw@H8IQe=YbDQl zi-f1b6E`4wuG7G^&zZv0;2Gk0MoFH1vV^C@^ReUkPV(^u;oi0j9|6y)1Ec5a3eLIM zr-$%Nc%E=Pv%rJv{z1icEDisd^Pzc$2Y<7)`EB9PT`dql`+q1r3$I)6s_6cwf@}XX zglEI^AICFV^6c}J@X7G3b3ETmp8MRP9G=s!j-IOwZ!t&px*auM5xXj^|@=-oJc4Z!|o(zR9@0KZ~E& z_gCR@c->BeqOZ$U;M@cIUnjgdJTo27QpvN=a^>*+<9M3hQ2n~F&#}T=!*d;Y&5GUF zuPf3e&proe=NAp)yjB^&0IZ9-pOg4ewcyr%5)LCLfK zBf_`C^S3Q+rm@scpBaneSVqu91@GTw{a} zhG&iA`9|{b1(laE_Fv)Y@WkI!HJ9zv6`XUiPY>Z4@I3B#UX(ohOckC5&liqom*m-J zukeZRwEa)?Ts^@#7yDc!JO`d99M2TZW6#rt&xhwL$MdV?*=N7-e0bX38$DMaaL&d3 zTq1l8JYyWsbnqG#$0m3mj7^yq{Kr_|^ze1*XV1%p7sLMoxIV8IN}fFz3*Q1yx#KzN zzUV&9gqOf`9k}*+Q1a~ai11Q)-gi9P!TJ2;*U3ALCwQJ@;WJF$K8M>0FT=d)#$%rkVcCN<4V{3xb9E)8IuIFK>9nbHQXP>`?cZH|R1JQF01P`un@SI6Hu)cCZ zlfgOf|9T2fhW~rV|BvL^v*v@<&q;rH`he^HZ<0Lw3>KaOPp;!xBYF1uSa>QtM-GqP z+d1I+oH-9X*jsQPrQc=W1|0pF<_jKEs7igXcZR^QGk3XRGjBcv?OjeZ9JY^ZsR@p28QyljV43g6s34 z-6PfaRsc^2;kh4HK2BmIz;$mEC7*=+6ybT`-#DH>B+otvgy+N4JtKN=*MoC!?2{_I z0G`>7=UvTXKko}KgeUfBbf06uwNDG-#qiwVcC9o?^*!KVJwhfv4GH z(Q~y0=UnX5UU(@yLmkgkl4qZ1g_psz!SVbkdG`5PcsV?0J{~<+PjJq~J{Jj(eH7jo zS&nA`xW2z^HavKLNxQRFrD&J<*?+I_x_I4=nbG~P0N4Ik3y*_ms^fWE^6Zl@yg57v z9Z&O-VNdOIg7A2FZU)!q%y7xGPloW;@T_n=nyjef9`XhNs=A=(+lUb1wF|M0kIA#yg%_l4qYe!c*WWbv%b8 z&px$BS3g&&@LUM4=jSePy&oqU9^8*vxF44qf92;X@a4h_z}JEYuWLVt7D+w_`Ok!x zfNyg=hfKas#cOb%wV$lMhcxUV8C>@;Sn}NGox+E~v%v9uBzgAvM0h4VjmAWuw===@ zyd?-956>{i^R(pIXM*s_@Dw|qpCr%y>=Hg3p0mbA&(#Z@bFojd@H}{)ay+vo&pvMm zUk=aDj_1UzuqV$yzb~C)cyP}7{efG-^*lcfu5(QgUdTNgkNx`pC&_cJUBWkU&rdmf z2G>5x!b`Yk$1_{~p*D+G{H=TE(xq zj%T&x*{4u=96SxiMen&aIQz5DS;AYubD!fGD|z-AFT6E8>mAQ_$+OQ+;T_;PV|?^n zN#LA|eJ&K91kV`9GgI^UI`ehm{owh@@f`n5*i-M*s|-K9;(Ev55q{m63aV0hX*8@=c5;M%9R@N{^dbUZndXP?)EXTY<=@gzW=e~+NybJ6>0BD@uPUJtH)9+5of%@p1i zosHn`K^ZA z>$ne`eYl5m;r-C3>kHu?^mS9f>ET>A2p$huuh&B3v40P1BRG34DI{vF}5PeT5I@dSS#mcNRGC*i-?EIbpu(UhwF{88cIpF2I? z@aziCpG(*aoacepFcm{y$eRsd) z*=L0C?eHvjJYP$m`}t0I89b-FT(y6@pYGtCi+y?vKL}5jJa+$94$M1m7z>c5Ik$ zGqdWt+xzQW!+)>nQ;xsyd^0%D1Fz%l!bf2LbB)K|FCR&s=js#Tqv2^ZtE#8@S=RU{toaEVOlJFdOzIHsjB+vcq6`luA$5*50x&oYYvCq}Qm%}sF@w_d0_Q@As z2+u*s(_(h?eb-X>CU|ZG*ZXd`$=mxbLpbldIpBKV&6hmyyG4fE`|cg#yzdH)zw&(z z|IWs@!ZQ=Y`*El71ovHLe0U%27hV8ecy>vi``IhJIXoTb zM9*~vIOk%YtA)qIGu83rfd}U^_&mbT9ZQTSIOnmu!sm8@@z~!d{m{v;Gu(cD*&sYA z95eQf@fTL~;pdd!Og^|TxVJxrx5m6(a-;Wl4Y=-YknjX}avaY);M^NO$GvAfc5fdU zkKNlRPQKW1ySFctV{bngzujA@$=g1=4X=Fv4X$y;uiu2H!XJC1YM<7BIym>q>(W+u zBKCQY@!0!xwB&i7pAz01o^_6=MDpzOqwxOloHn;=F59OYIOk%Yp27#gGs^Kykv#iM z7oG;scaG<8$+OQP;ltobnioCSW#GYF_B;#&56*MtdH6T{f@zNM%)^3H5{s=eetRBD zjo;p=h^e4dtL~x`|m4!JUrtZ&rHd4|E~+549`!F=U>Tl|Fsr`{n>LiJiWp7 z>xb(k&ptN^&x0q&@w_K__9+m)9G)6)M(?>3IL|`?zCYGQcn)}y@B;k#>bt@9>zs6x z56;8v!ph?ldq6n9o*8RA_WNV62cIIlaeV>{u6*#G^;W1lkl4qYkgqOh6Ij?Fi+vjR< z&c#003*QCL49Al%dG=W$yd0hyi=z9S0Iq#b79RT|ypFd!p2sE6KBI-#g{RQ*luDla z*)2Q{p7w7=&(#ZD@4IB-yzed*&iifzxZZbLk25_WZE%*z-I|^1NOz3vUI_caEoA z^6c}E@C0~zEUuc%_PGI^bFt4Y!n?xry5o6Y^6axlcrrY7mqhnz1+IPC2=5QiJ&tFL zv3?szebyUaDVapV^0a^ z{q?f(*zb=m63*|BEjOOZ`wQO(TPwT(e53Lf;r(^Q(yIN~`>QQDuRE_-d*SKW^8?0X z&+~JV=k=N-JOiGu9nU_=vroD3EO@%+SIuSnq=0iS_PIg$M0jR8o_8hBKJN?9fv488 z=sqWbYoAua=fjicct%Q|eZ~mShi9GR`C0PZ&#%G@;W_u+=(#Qg*ZZrlaNb{+3+Mgy zFu2}dkDI)`zeWq^{WZyW?DxUu3+MO2mKslRf91r7_sc5bF?_#kz4BATe4Y2I_G9m_ zW59XcdA(W)--11-8jn5C8ItGq8Yz4`JRdrqZzaz@KL{^_=k(=ObJ;$R_S8O&gg1p}0JwfG8zOo3xledJJWCwU7n0|Gz80PU z&xtFe_uLhnbFohk;Ysj3>3C*p{=;yeuM1Cx=V!+gdq3Ygmu7!p7#3*ap1w8 z?f1KmcJjv=Za>GJBs?>$5j)HH?e`ygntbrw;NC70-XHUhGah@+=SZH{alY^rc*-2l zVFlIq#_to>2iLtd1J}JB@8shRw|hHPIret0@!P#6n!LS^-3+h%I;3K!!LOdebKvg} z9`v{V;U;gdONQ`N>~n?j*z2-M^1Loz2_FK_aUX=m^nOnO*ZZrZ@DcDl=y;xyJo`K^ zd^9|tJD#1A=egY@JR6>NtD@)X3(mRN=W^lG;K_D8(@oxz8IdZj%Tmr+2;@C@SL}%YA)O7 zGH}ktJ_Cdo!86hE%#}R*EEK*4o-)T%|HH7S_K6d|9iA(|^?u1TJor9Xzwq+Lo)jBO?!sILGO$hyCjNi`tvdP%3Q* zyq$M2IOomAb-dH$gL&iHhw~0Memif5-oD^GC%i8%H~GqWaZYY9emn2ICU55*COiQ>ml%(o zw@C7w_cP%g;A#9x^t{J|2lH0;$GJTNT(56C$rs~(>1O~9^9G;$c%GYrbKYV+=T8RLdApdroi|B%fAq{U9y@QY zOT-l3A`yu*d(!tyvR!WY9c-SNyZ`O52sbNddsUf=g5UxxeTW8=5;ZZ&y3 zZ;9}H^lbS>)%|6!Zz6bbe+3@S+fDd#cph^+V@*DoHx=_v0@rz8mV5%v^Bcx*=Urv; zcHXth(X-K)(et(g*Lgb#FN7z<@jPkr_WHgIuID*N@@06=ziIq--nAxg=PeRmjGj$5 zN6*^0hv zm%=l~@k}szdwpL6=e&Ghn=AQr%$slgcHZwy-p;#Sco}-0`c?G2UBPwU9>Nd8^MvD> zEO~yv^cCTCw}dzLw~ps`$@6*gxA3O$bon}Zt}DPf7yDc-JRY8x9M7AQXP>u)w}ofF z<2i9_*fY59!Ffo+pYKfo4|>}7wJzYn`-}ZL$+OSv!n5G{+3_6lUD#9mG!mW-&j4`!dhAA%x92k*oX=r?-8jkc%J(U}&n_~4 z`yBql`0f4pweZR4d3;Iq{?7r|dCwC*8=eu4=UK^f|1Sv7gJ+ZD`9<~o9oUGTi> zc$P_?eO3xDhv$&vY4$_)x!C7;;kCaCpL>JAb*`b3XP@E1KAVKMfamD# z(dXw(a6LZ>!dt_0pW_)XdG>iucw2ZjI-VLohCTIt`~<`8`&}=?gXc-?jBx)qg6sR; z6W}`USm6oiS!g`={q8%-bKdR3yTWtoj_Cb&0oOiB!js_{>3Akfo_$^sJ`kR79nXHr z^L+j#JQbeKKSj@V6*%W&pX-DVf#+q%vq19f^Oo=t@a%IuN0f#=wNE4Aqv7cfuJ`Zl zl4qa0g=fPv-|?)LJoi&5d>TCUc1G{{Byi5fKCOi3!gHJB$&ftzj1;~Yo>h+LJIS-p zcIEK2{W*HB{@|R8eXbH-2+u2yrwCl1C%+nQf8XcmU&22B%bycIPZGfOc`^{3Jvr~S z!i&*!s`1$8$s);f-gks=gXd4jbL6h-=bU{S3onId0Jxs>yCly(_X^(+PoCrXNb>CS ziSXFh;hr1pjy?~kgLBX9(^hx`c{g7bdl zpT{dU9{agttMS;+^}9{pevbG}cq;mwTjtCK{{Q9@KA3Yko*5=@`@abu%xk~S*<^U| zbxz5d;r;Tf@!QW$&Gv@<*^}4tc;RX2IS5>z1NTdw*KvgKVel+-JR2m>KAVJR!gKU* z(fe-;&bip9z3}ny40SwNl4qZ1ginU&Q^&JY^6axm_-uIE?TenP2RP?qpFYC#;Cb5d z%#}R*EEJv(&pyZVugTl<8Mi;|ADmD7zS+s}%I`aM2+!vg;QGG#0JzTkuyXW#&v@+n z=0?eL-p#^`;A#GQ^#0EV*FNV8-vZAt$1_gy?2|2gJ3OB`o}VPo^RP>J89ZnG5j|Hj zIOk%YONAeV=UK;-BYF0DO?cg{;dS5Pc>a+*`_%k1?9ZM};pqjg&!uZ6&ptN_kB4W5 z<9SE&?DL-Rw(uNuJdMk%_h+ADgeSt20aXbY z(-xf9g?-u!9|+G-$1@XL-^W)NZr|^IFg$pk6r2^FtACB(zTchvcl7>G7oLKiY2dp5 z$0g5sM++Ye&xej@tK_-=65;9av^)^K|3q-ze>dS7@I2;tCQ6=trU=i1=WECFyX3i_ zzlBePr^~_Uxh@6gT=Gn?FTzk%!P)~OxtLFa8?xc&Fuj{y%n_TPK& z2(J6-EIbcApD-T#xnP#$Iqw|d`SASecn+%*Jy%n3?Rl(n_}e<3JHd6InNEI!_&L`^ z;YE1eIgV#LxW4WICtvfhsy*22cpSLy;UwW((C1cgeci_;&$&hmFM+4f@oWXxbGTDH zd_L?EUJCy|j;HhC(f9kM;QG3Qz_}mJb+hpOc-?fzvjAN8R^a5<8g8%Gci`;9J!}^q zD-54kt?Ne5+Z&u7&ULZyy6`;XcyhpXZ*Pi+J>M1{2mdO^a|m4b*0^5PdA85zmf$+q zX~J9Jbvrtqq2T(uPdfSWhTH4)vhmoTZ?Y1cJ-MIN!ds(f{Uf5UYH_r~icIG%gJ^>s%(`EiEZ>p01H z0^YAtcz@-AvnThnM0kJn{L6Uk``ytE!adN#>v){-LGauNu5%5SJo{t_PlKnx@svoO zeSQ=^44yVeMxW0v;K5vnSNvZl|D8tRCE$012j|fKe3Nv^^WUR>!0_Pr1!kkq!@_gG z#~Xj}`GWu6#Vq0c_Zt@&Pvz&1iq{B!Vj{`-yX zz=s@EPx~g(*S#+| zuRG7r<-$whdBO3#EqV6I7rq~!gN~tk@ezdn^b@2}4d z5B8siK3jzI{`%SY?Z4|7YZmSyc-?^W-*v1H9_*p={%T(FA1Zz|6V9J|(o#5o?#Z>_ zdVh^Id3%1w3s1mY#l~aruU(So_1Y`ED?A;K3Fp=8ei=BgJI~Jm;mPp4f^#nRxkz|6 zJmVbCD<*H>zh(*N{k0xk@2`!L=l!+WaC?7k6VCf_ zGrscniXA7s0Q^+p{P`v~fb0GBh{@agD^vJ1?0Jpx*!!zQ^1NO@3eSb7&GF&9dVlo< z=XK}#xk&h8c*Z%Nd6H+JJmG8L+3$E7w+MS`pJRk?g6Dd0ool${*(XEzHh2mg&zIoA zISD?G@N>sj;|b0=f4<2MK7+pX1M+Q^1JY)y1|RYVzo{P_Y=%(|2?$k;JUXH zgm1^ZHye*VSC2}bdwW9oE_gn2JlnvzH-3)$-gxZZb{UV|+g>OChv9Z_2b5!P^-hf5 zTSM?*Z?;bp!zo|{#$_`QL&%koU>0G;i>T4<#;kB&puBI9|F%uj^}&Hv(FCU zBj7pxl<2tzfd_L1=Ye0h+$=m3-ygeOIKOUr4m>zN_WNd&Og`8fzd!b}aDF|rz{ALijXzQo;4U%aA<#j1-;=&xelZTgmgB{~&xZ zJg1*lwST*xUf@Sy&+L;dd^tSh9nWi$XP>#k*TA#K@iaWW`kvXRiSQzLt^wCQrx|X) zfB2U1*!yv*aNdv0h4X&=30&{TT_$hu$GyUNKh|m;&Kr2__s5PE&hL-40uQcNa6hKv z`(5pX=YV$>&YycS6g=3Qy&rQ--rjew3EzbM?=&8JuIjXjzK%x-FM;PWaJ`OqNS^0v zi11zT2=z|*09^mV@!oY$S_ z=St!8;hE%k-jY1~EES#)&jH8N^qjD#_BmGg8hCC1*XPDVl4qaCgcrlJ%JFQKJoi%~ zd>cHi&W+x4Z*b1VJ{Jq$103t{!=B- z{of`$1D+hmvsCizvs`!AxIV9Ll|1K76J7?-8;<8KldtTLbNd0fUf+)-UyS=@ zlkwYmcbL4L_ZQ*&(X(xjs&itmZ!d736V96~yd0jV9MAJ6AI!`9bSAjY`?}=gaGn<% zznyoz$=i813O|UR$MuY!w==lT+g*6=_2C5@>v*zF-d^9=!Sy`PlRSSO$};1(^KLYG zJMU)U4bbzXUeWV*2iJLf3vUX~c*pai$=mBY4_xQXlRSSO%1Yz6^KLeIJMT8(Ezq-7 z@924ZgX_E(3vUI_bB<@K$=mCj2hMrop&ra=jDAd-sFRM`SVbw8o!-)hU8OmU(7b#zV1Tf zvG>IXCU5ulk??`sTXOW?P6XGzogzF1p23di9+S8IGr;w}7-{nMzL;SAc5kyy-p>1m z@ImOg+j#8P1NANr_n`AO6h0W9E5Y^asOwGM&U+6y&k65~p(Y>9n}o0TGL7HP`@G59 zd0!Gf1UDV{=oLm4N>@DaYk8^t|xL)5YC0~Z;UaIlid54<3 zop-qKVd$A}Ja*m?!l$8U zrt#Q$r%9gk&J;cyo*y009+S8CZ|t(_^YVSI4mjuK&qHYfuJd*_c{^`+;qy7K@z{A^ zl04^~COjXWZye7)$@BXI<-*s%bN=Pg_eFp3U=P7u>~odyVt6Jwp81kzpGCsA!SkEr zsnFNNoFaDD%J2s}9FmG4LR^T6Yb$G)#kG9LSNNUq7->%Ktve)QR6JodWR zyTX}Ecsb_+*SW4UdE5U^aD8r1Fud}aE=X{s&czDhl5It8faL&a($->*h^OWP6EqV5N zLwF)QKRcd-l4qY91FN66-tb%quIK7D$+OR0!u!GVrsG*=^7edw0-=5C|aNU1L;RDh0LF2La<1>=yyw3|yh39j}vs3ci{~qB(;AwYt)m*kuA8^ja zK9>j|0nd2HGfVR9Ge`JncuE~lt!t{EANHv$JR6>i!S!5SFM0M!6+R7~nT{u4^6axh zcrHBuI-aH})#qZLV}&n<=Q?nm>psb|&x67X;92T;)@y!E_&nSwya=8q*G8Y8Gr;xy zv=hDso^;1EM)KUxIN{sjDRMkNNuK-JCA<`#v#yJtYY@1;kB>0i{{G{1!-MAue;&#* z!W*i2B(Mfb{Ad_Pp0FUBzg9ES$ORY;W^pnc=k!2eaeN$ z!E^qg=(#Qj=UnVFP1~*qf=bZN_;gjLH5?s%Dn&i3vdxX!1=S|1+q2$?T zo$x$(>faK59$JFyeohm<9G*KI&l8eopRvLV;VE=HUrV0*`A+yIc;au3p6fht&c!}m zg_pqdsN;D-^6WEN_%3+9ay(^{XP@7Nm&4O(aP(aLz&RKDTp_%6arl1pyyJO8^6c}b z@HlvWbv(!37WU-*8w(D6#ji8LgP!(tM_o4oy;d#Ugi=<}@c*!%Pi$^UOI z;qjcy@%(M_wtv0btLC*|=d?3CcrNkhq4WjU=hA)PdL17W-U>aJ8jqd#Q^|AQ&xI$z z)AWw$b9Dx|_Gu@)D?I6rXRPGeXT0!ac-A|fA0*FnUMhSbJZ;jV=jsj4x!C7o;i>RE z?Rch1o_%Ht9|F&hj;GF@VNdOIgz#bTTn4W1BiEX|J)d`j>*xCC3=hs{JboU^eB-z8 zo5jX&@5e8MXP{@ZyQ24h7P!uPj_@pa?sq&-NuK+ER`^7CHaMOglIMB&MR*Q8ZSRhr zt0y?;VxNnI&xa?=@w_T|_Q@5V56@1=b3pR!6B|~d#d+mpJu{K;kgD}=ekGo>@!sOet6z?JnJOSJ{yF`J`3IjW3jmZ zM4zA2!1er`DZBwZLmbao$+ORR;c@V+cRUBd^?khgy-~GP z!_G(32o#PIV_j(MP}r~Ue*8#sG% z-k!o2qvt5&vCosKlIOfLgcrb5;&}ehJic#yKzI>6T_3EP%k~)n&binpMfetYrZ}F3 zlIMOF3*QdU?~W&Kc-T|>94)*Io~yz2{{7VO;Oo^Ech#!+|FPH?4&UqWt|O}U_GiU8 zId~}iH3Iy9J@NBd9u?mDo647sePBFx|DPLfd;Tb%0{DLxo&f(r$J73ys{ZzMvkkX% ztuWm7`379){jcyu^f~R}=-2HCP7mkmEW9^7{fx)<8ELqkYp!^bu(yT6`@>)6cn*K0 z`Z;9J2Eqryb1ArB+owg311G+e8;m&^4!l_;f3(jd^~!t6Tmqa`IqCYh?BQ>{C~G?Qg^9e=l&IYk}dx z*C7Xkhg`+46~dd=4fzJcpRLFboYAdD@ZanM=XH$7>y`_z`(5bi^+fb}xE-9H9C+>) z-V~m99M6}MXP>Rg;W=$obf1gCwa;b3+rl%&@hk!lmKE$R^VKeuds|`h!T#HxAMWQv z;a#!+^}+{&?{oYeM^`^5+(T#KY3TnXxSo?-$@97_5Izi^a>vvB$>=^O2+xEk4P5(- zlRW!m3m*^9R>!jsT(8R^legF9@G({AB;bRv|3<=xfp-K~e=0c76|c)}!V}Ry&-m^8 z-RF|$9<~VY4bLfKtNL3{FL3RXEWAHFFF2leB+owY2_FQ{VOi0AP6XGzoni9!x|}1N z*QK*?UYAtI{~WmPVUqC4=)c+c?LPNNo_p9Qd^S8Co{HW>UvTYnx$r!AvK`MH$+ORV z;mhIK?RaWE9rn~db%htg(+gbh-y0>*KDP?r1kZHGvrO{wc)wUFymd+VT>Z=O#Eq*y z7yBG7JOQ5m;5ygsl4qa0g(t%Ey5m_PdG=W)JPDqE98Z(+)#qZL=E9TV833+x-6eVU zxmS39c;-5uwcz|dNeTWv@|18L|>PS!8sTET&5hJ=N-?R;M`{%z7Ahyc(Bi8>~pjD z*?*hxT)b}l#OVH=!L@&P;d$_kay%0Zuivcd`-C&V^*pQ=Kl>L7&&TUFdNI2H+2Gp$ zT;XfrdD!v1AbIwgEW8+=ZI0&;$@4rM5WWqb?vtYDN&)9w>~n+gQg~)Mp7$irJ_W+d z;Hmvmbf0)|?Q^Q|a(IR~o^g_ApKRf^zmHY^+U$7BB+vc)E<6sN^Cw5oH2|D*u}_Nd z7Vu1SJd45kc_IFv^Md~v`^Mz$=Y`$i!F>^YT@hC~Z7f!AO4w69ox$0Y^L7{B8afz94|Zxo}0k6&qI=DpT~svgJ+fF*(!PNr$l%PJgr`i zJ`Wdwb1wGjB|H_Lv5sesFSnSyyYaP49{UX(S1$^*FL8U-vZBn9M3b7XP@VVZ-?hA$Mc)yxt~9Um%-CzX7pTF zfpaeQxlZ^&c&0m^cff1N{qmj3+xz8LaNaLTxL@ke3VW)jBRG3<-p<17{x=jo2CmPU zsgmcsGlVyV=Lg4gQ1a|kro(``?&vhv{=VG5Lg{Q(Z$?@b# zo_&@G9|F%`j;G=4(dYbB@R}9J*xoN4!Fj)=;C>nCcpd}Sc}EE!fu3u@gV(j+r~O{? zoOg%tOnA2cA)m=M~N4`?0fx&xdD+<2fXGp6A+cg#FnwAD(3JnsR+_kv#WvhwuV;<~g3V zl4qYH;f3%tnH#<5bHLf3ea;iU37*Fs&r6bLpJ~EN;3;uDe@mWy4hi1{Pp^5=b6pRv z?`xw?-rnyM!Fj)D;eO9^Jl}(JZ=83B@N)EQKR>$XKyZ3E@3q2f{}2|M?RZv5o_$sc zkAvs11<`%t!L`q+!dt*|r{j4-^6WEKcx!k*aXddtp8NS(cmh0UzZpH(W#F8PeFg|m zglD?r`9SjQ^O5l0@Eo-;y3ZNl+NYiH{_x!Ic%G3w`#djv5IkQxp5MUreyNvN)!*JP z$Aa^I$-({79b7#_z;)jHgr}irK6uRvuYG^nEP2kmP53Z)PFYmd-+H=&Yo8v%GvRsC z@yw7s`^*+T9-dOiQ{%0$r}jBa_+)tcg6n<;OP+o1R1VJq$Mdn|;BUu&p!7Eue&{5^diUeiR9U*Sa=*fO_xUR`7ChmnSIU?-W;9>9nbTU zXP=jZw}NM@0g1;6P zJK%U8UsnBGao*9wlhLyfT+h{Z$#dSF!Uw{0*1OSr>jTccvCk#KQ{kE5c;1ja`@AW9 z2t2wf+tdG@(qcqTkc9Z#|3xt}kDXTfvq^5{Kx1m~XFr?c>h z@I2;tUXncfOcS01Pl@CCTl09|JS2QRJiS&#&y@nM_sgT;!F^$WKmBvexo^4#-O;cMXe*75u)dG7h3@M3t9-jCkTb>Mp4ZxX%@o>v{ua>=vL2f|C? zsZ$W$=Ol3L(@J<5JZX++q~zIWjPP=J);XRXlIQjMMR@HW!}rH_A4JcU49>aO=ThNu z@I2>u=1HD?@`Sg5XTRgAw<_$Z_r=-Zyf66YB6>Obo!~mx9^tLg=bY8i`?(C99?msD zcn5f1ay)sG=bo1cPlD$!$J1m@*i-v77v2w^LEw77KOlMbd02P~JS!c~7Rhrz-w02I zr{#yyd+rR*x!9+>@HBWvIi4AkXP?=^hrv_ocxrr9eb4N3nD9(^`hx482TPuP?i4;A zo&}C)6}a9PUzxo9`f4XQzrHHRpJS}MHk?a6uY&9TbA?Yv&t2d;Z{5P`d*i%E3ZD(n z72xW*OY+?Ry~6Y0dE4=lGQinCen%)8DZK7aA^*^L?Dwy}mwXO9JA}u< zbH@6rKGxF>Jecd5ia&QT@cQs|F9Fw{{e?G&|0c&X4P5Wvg-(8@_&L{V;jQqx8y!!h zPow8O8C>UWWB96yJsfNp?x8oh?%`tL3Fwmz{{QBcJm*?0JQ1D)j_0Ti;auAPByjE7 zN_Z0dogB~o;M)HwCqG&Ioa+_g{qVXA9nUUsechVH(eu_b++MF%;JSx4!c)*E9b8{` zg5){ZMB%CMY;`<)!S#9_5>Gtt-`byr^Rj;${LR4CGXPxs-|6H>h@W#kDts7TcY@<7 z0@v65uanJzHdddPdq@_Zi9Vyi^>wF8o^#C*o(0d>j;BoW?DMUh&^$jH3{tC#RC@Qigl*(QH@MW15qe-=3Bio2>-<-iM!$Ii9F@VCw1 zv-rXA;Lp?Y@5MLSQvLqo9-0d;LH|^6y}w3Fp4ay&;briA=6HUPJo}UiZ(SN*_k^#a zuS7>XzqAr*>ZC5#hBVX4C;45=X$ zAqtZ}{dRk<>+IU)x%Ybg&d=-J$NPJIKF@vM&-49m)5YLE|C_9y^S{k_COmIPJe5)( z`r_YT{53e&A@|o$;?Z@u%g5<`?QT2^dCmd%zD8O-`xpAaL*N2CHXZHyO`|=go+x3Y_^fmM8n-3-N@0t8kud5|7^3 zev*2&NY z>;3(9ncwR6Rz=g&3b(Y~%X zUW`0T#G`rET0Q$(XM7So?LJNK>rn8}SGZn$Zs`urzWCg7ig>iIk;3(SxZXI=hue(v ze3)#U=fnNRc|JU5oae(z;rjdF)!@EQ|1h4tp=KC0U%fs{pW9{N^l<(ojJJd5<%s7U ztIxsvxc80sgJ+-5)ARHI_dF*U9|F&mh-V(S@Ap!v*K?yxxSktZBc6Y(OY$=(``yoY zXXG3V?)TrZR?qnt8_$DhMa1)-)c5KHfnj7zhJpI7E zuMt+yzOFW&56_Dc&+AgJ`??aGeQ{rZE*|Zx#g|E6A*b%6uHb$hyBROV`7=R0dX7D9 z_3XFQcsV@vzpBlnp54Gb&z{Ds;TaV16k9#>Of;T}`Bz3fo4|b^{Vw&oj~cA6?MwI3 zG2reQ0Pg(`HeQK-pAf&!?G3AEzblMa!IQP2Hm7>_01tU|9~}tJ^~Qa4xOjBEogp5* zKlU@e9(ksVNAr|gJ^Omm_$GL^`#Qa^M&O|@-AAp!*%$ZG{^HTTt`Lv*HPZMftgBM- zXkTwzJ^NZ^d>lNxeUskTf#AM=a*a=d=kkcB*y@>QqVehQycO}Rv-%v|2R9g>15f*n z>3wwrXJ5?I)A%BIZjN{sfQRcF)^i^Ie$^%73G0E+x8=t9eEYum_4#&vBAySe zo_W?7uYhOo?`r$iJcom`FXriDyb_+#5zk##&ph`UuY#vC;@NEV%u{WAJv>K#pWfF= z;OvWe@{RZVy5{27eBBxG%&~grnQy!Rp6?=_2Ah(co~NPlA@H0C?$1BxTRrn!XuJ@f z$0D8=t)BCF)%YlQ>i>{F=RLvM7xV0Gya=9xi03BoaGvP*Sss>pz3*2<>N9>!pY!&{ zH*NUqvS;)J_c@LeRvGUA&u&|i{GR7v@J2P4L+|??jdzA;WW+Ps>X~P%@jQ4|M?5?H zl;q@ntpMMDX(L?!9)Vo&(3d{XoCxlHooc)n@=O+wp3hHNJ^NZ@JRhFwh-bT>YuArH zr|k;v&uRYv_r3;+N3Yk##*2~X3GrxOuUb9(dc*hxcrt%UUq3CuL;mph#T0}$0ySSb z;EihjS)W4=6pwyBoExb>O!!~V?SI)bGL8}+{CuA2C4POL$rm2#`T1}^<9wbOXq?Y8 zLyhyfWrT4)=M)*|^UPh~VLo~t?=?ON^RE<-UdQjPp4V}U@hR{eR-Jwwj{y&P!kjDG z)%-)v*U8|#zI=bwPdvKst`v{o_(!#4$pqSruWqWJoKge?ig_H zyNdeB_hn8HkM?!8aJ>&+FI>OxIRiYruFl~R<8zSzTk+@|cHUZhZUhhK(872rJm-P? zIbUe?Ie7narSU3wUW|A?v3lnD%=jjF+W(e*U5*9!&katJdY$tb!o&LHe<%F9h-V^r zBV2dB54ubEU+h=0AHC~Q6Wd5E$ht}XBr(WL!jIV-c zSj2Oc)ayDg2Io32?2xSU$>PykGkuh z>-GTS{k{oTF(YFHxUc{Ft)A<4hVdcrd=v5fVfD;Y@6Wn9C&6kW-Cu3DCHdWRJUG`U`|WLf6mm`k_kL$vJ^P(&d^9{?M?9OQKJ=A! zKyuydWrTzo8I5cHPygP!rr;ruuJiWb-q#_0nS=M$-FOD_+z#&7>lv$OUoRNXf@k}B$?LjjcW}?s%6MmZ z21h)%T0QgJVZ0YSA4NPrg8MrEQ|fiU>`=e9FWoPB;O;pe-21)IIdVQGeqC2DSv~t* zV!Smx4I0$uR8Ldz@Ta<8T7fsV{j$G!bY1ljkKXT2Fy0P%CW=S%%(Z&<^`!A!cz%p{ zev^9LFHN^k<`DYQ{gMst=fDNve!YemFF~HU;?cg!te$ztp5KX3JXpZJFO^||hC;rjgZfpI?nd~Tf2Ki?SV^Ur4EeE!*HoXJU2!>)2yC(9yC4)p0yFr zPgc)7Ta8bJr%U7XzD@^cU(D0jIXqJ%o+quId7d^t2c9hvPva&@PS2BNyab-pzX z&!&iH$7V@R&(p+sZ+K1y_r5N$dgd8oydOMsBc3v==X_o>J`kQAc1oXfD{%J3Jo^|g zgl9m+bG6ko&vnK}!1Hp%vjLp2unj;?cea@0`rR`x} z>jUFi@cd(!cjJSP7*)kG~wzw%Q&BB28v&w zXNC&b=a~`4`8-o(oX<1G#`)Yb$vB^LrW@z;%p!2Vj?Wv<#{4sOO`reX;Pmi1wl%g0#G~tTk$Cj|(euXJv9IQlzQF(1m+@To74eLadfj)o zfU__DT+kHpXkW91>wWM|;rhAvci_yQgZB%Yjdw==V|GiQ!ys^aczrK6-V2^*BAz#_ zo_SUnFM?maR1!kNvYS*AD$Ji^WPNlYy%HDgQo!JNrT;! zzQX_NdD750&y(H3!?~yDNhhh-b$+Drewag%c=Z1Akk#}0&Nf~E&o>dz7O4;Y<{z3g z+%P-om+PGSw>h}qH#>ocf2&Sk#)q&k@zm+d>i^f5@e%AR;@Kkgx_=w)QMWJtK2dXU z?<-HZp8vg!^Zf5)oacXk<2?Td8t3_6Xq@N&E#N-q+l|k_eBKw2&UvfXK7J_KNgnypnx^|E({n*Zq4VIQ!!LccOT-ujj<0eJwVg@nbT#`u|Asd!Bv4{d(Uq>S?^BD!ulK3N!u8x+ zYMkd@g>jyHmBxAQRT<~Gx6wGyz0AGquB#lJS51v)VgCKV{W@N6_1t&kjOW1fcEt0k z*CWrD#`EDhG$(ys^#S*Fb++*WcxFdDi^2WeE0=mb_bP*orqXP%M9r@&Jh@w{dAIoQAN8lM4A^EOF-&vPI+`(mD4eu}&-{pIiPdvGlp8OHr{VtT>mdi+*FziQ z74Tdb@r<^5=DERmB|NW2JfB!S=kuBIDtPv5m)_T5;OvWejxwIV`LAW0ac#tNm(?@R zy~g{&QyKAmXZ6gp*?0jwoeoIv>m+dY#XR}Ohrn}Z#PgWdGtWHZh46eE@ib_ka(H@NpT!0MT2u<>ko=0rR%TRrEq)Oc%nwm&F+ z&ijC~FXm}$JQto}5zhpxXP!HacZR1j;;DCVl9TtfoKDI4&|0|uKEfg3Vb1!Tb}G2{ z)yH@q^4u>TeV%#2>e<)J#(TlD!y)N&-U&SXsXnK*2Iuo9pVJNzkM?!7c=Y}0b;gU3 z=VkF|U+-Hz`})}UICxs+ruTISc*w86kI)I6{qi~FSn=rl(;kuf6NKyg)>DLsdGdLt zzxefeW}t9=o*8PK&oiTp^LeJoIGqu22XvMv5w68mjPePtb@n~PaSUvmt z-S|{^y8knogZI@NJp8HdyYs=h@Az|`L&c+gjTWx=!I{GK`!cVC^Sb2V{laqNGmyVU z$MpP1gVVz~{L6R=JQE|Hhpe7?W*e`B=lh6fmrhAe&$GMn_3#V;_v>;ExPNYNlho^+ zZxe%Z+DlscE|AYu6)c=b)Z8;GU*R`4`BvNpeZb_EZA8v4q`?<4FB?)RyK#G~u{Wbx>I>U8JGGfh02r_}1%*Nev6 z!PDTV^uC&chdBUhr&-cv^I; z+ZXe+G@cJne{k>XM(}WM=;wGdq+aj)D*``XcXIo3}vaL@B^t7l&Wjjw{| zk%;F%R?j?T#;f4ju6vT-^JIf_{V>m7#y7%qUc@uP>Y3+imYFU#XSEso(0eFi04+TXP!HZH;1Pp;@Jw$`&ZdPe;p4QEsjg_2d+O~y$^V} zUiv)K4cz@0d56>+* zHS-8x1;X_?XOM9|&kPs8KF?e$T%Tvg8t3!O9me@QbFXnew>)H=&pA&R=kv@G@Gu{} zj^)P7G5?)JazgqUdg^r zi1Y>ix4w*5v9E|{tkmnin+ndp`1$!P@n~O93)lPLhr;!9yg$I1KL_s@>YbSMOTHfY zPX_n>HNxt7eXllN4bReu=Y6YZo{x>^e*4$9%V>L2lGF2?0M7i(bBggic&0@>3&8zz zgBPVftV4cY_nL5>|F(#yS?}682TwuLR>rQv^*qTo&hw-#c$kBpC*7r9*Lg4FnV7>J z;?Z;XNvr2PpEjNa&(?^i{>gRw<%8#8am)tN&kL z##^(mh^PK3wSDRS%?4**{Q2trz`d_ih3om>*ErAr3ykypzr;At|KY}Y{$FpL=l@i2 z?j!EU2aM-qK3|AO=iKnr+WCa*#W^=KUI5Qo;J&YiSUvL$Gd>BPXCj{Wte$y3at_bF z`AL4ya|F1b58b6+&xezQ>-lhF#IqRO=l_cFLgdUmEj{P{;PkNH4#r2pGd$uME%l)< z{(SYF;9Te2zthE|`**Q;bpO6$yoi0B9_b7GZ+#grW?vD{XsOrzdnY*i;{A8Jc(kwA z#iM;KH(r7~yPT2U*P-Cv*Wt!X;TaS0+yl=1{Q2tp#S{AF&sRSx9)0e8Lh8eH&#C!$ z!dHoK^*m#o_o*e~*Zb6R;d<`9Yn;Gt<}A1>o$9d4?Fzg6HXoXF0f^ zdml)>o_lMB>$$hbSxHX!91qT%?6V(evSW@#y)`+xRB-B_6$>F0}gp^<})8eMLMw_N(nn&%IXQ?2G5# z{@~u%CF0S(3Y}wJEfA0PRc`g{>%Yc3z|-vPB)?zx*5Kh!HO~RYJHvBv#B+nyGtW)N zd%*KX#Pf;O=iq(TXU6m4+3)|-`#K7oeKF6m#{0ul6!AO`9Rbm{}xz1^9(Yc@qNujuKAiD@hrD`&Zok7COp~arO)|baQ4MK z9gSzfGa}--&FYzFlJRVK-idg=vU=v(=p3Gd{+-@e4{-LyJSP}$2hXh$&vW46JkjsV zyeIW~-)~lst`Ieub=y^o_)h(G83h>Zx=!?&3W5lCgNjA_pMI~4}Lz+EEc~$&ny)l>gVC-23Hv8^Gv02 zKF?Gc=X1+?<9yE9Vw}%2J6u?IU2%OjHr^TY?+xzj>H@3hbsS>6D?D=}o`q5$=FFe3 zeg&M@m!Au*5Rb0UjpEVu`GfI17~h=RolAr+WV63J;!w znm-R;hY8p7q&s++gPtb^Qm^ZLknuvyVV-#O`YyM6&a=Y!Xn1zNB~ws^Tng< zYN7E8eBzr&H- z85zwB)34Wo;NDlR@h0$G9`W34^;|y_jAz61--u_O)pPx9Fy0!T_Lrykl?TqgnCCd- zx$xW+@jPJl%rnz?S9m^;cs5GC-lulCBFP`FdsyfEe6KZl_*1=4{S(~pQ%4Ec^ZZ}N zd7htQoagyj#(AEfXPoEx#m0G_j|KPn7aQ+|xmAcq_uY3^&-rgQo)1r#;mJIG-<<~T zdCoH451xA?o+quId7d_20MC|)r_qQcr{~$p_z-yV!M(3bte$xajTgeRAmUkK^*Q+5 zyWDssJXu$!&-q|*_QgCMjaR{QZNzh@)icjM#@EC1LB#W&)icj#W@lt(mxKK9^k&7|Ig|<=YJcY1ka3!=Q*oqp2fze!}CYPv+LD$^D|Gj z@j39E4eosvT0QezX?zhp&qh2ete$z^F+}^LE6u-s+j> zTjPcB9C}^t9Q52c37mZ~PrmU{@Jxw#O2D}et2@^mfHhxBg@@}{jrYqRnxFaC7%#%> z?t6WD{;uGjznk$1@Qjam9<+MqnPq$`JYPjT+Z81_JksZQKl4v9J_oN`3GT1^qt$ag{9?QWo-Q|}Uzg*B>wT~F!TtIUwtD6nYJ3wsB@xdutLOE4%Xl?ByNpYp^TFWki+MU4Z}4-n{zpbU zldPV3?lztU&xaAuW~*nOYU8co={i2WuhYQ!c~Qp5&fy<3u915Eyy#Z&urI>%WLDB{ z#;l0v9dOQ#{l0I!9diETru3Z0fYZZ%yBqHW&utOUY^!IUxyJM0`8ML&@#Z9_=V@ZR zH$3^^zRoYQdgi&*ct3a+Mm#I5p7VLfcmX`S6{pYnpWy6^d5$nX1fJ_7o`| zOmOe(Qmbd4;l?+?^IXL9j@2{I`^JBVXV2Ty=loA_U+3pYz3!Jwz`0-YaDTZu;#mOB z>&SkeHJb8B%&`utlOZw}AD!QC^;>X~PZb9i2fcs{mz&cDid2Y6afN}vDH z;69&!8Sf0wO%cxwt7o1^jOW3#A>yfbXWcn-K06xk1nCe&%0qycnmjkkj5KM~I=t7o1Mjkkkmulthxp63W~&Y5|-8qbBN zDB^j*>X~Pz@y_sk9q}}}zwVrwXD8!5;OPtQeHB_g^IT~>AD-tUo_DRDc`A+fho{x_ z^f?~}?(4j_)a!of56=BE1N-Irh-V%+uOs_iV0;L2R)hQ8c7Gs!{;iCUfad~m_l&lB z=DERm5j?L&JZr6<^IvCt0zB;=OrL)@aGy_4<5S_eHR73V^~^KZIXvG+JPjYJJ7>

9#*e*tlL>+7tb-5wI4M5Lj0wwT7~Bn~g;GVb=a9uw8Lsr{_*i0e+)a41#sfK z$BLGh56kaiDdDn(^Gf0E132K-{UHeQg5<~VqiZOAfFXYe_eg1>Q*`~t;V-M1od?_w-Q@_$3Ol{SPQSUZ(4)Cgmr@*?$`^GYwW;!LGp(=)(evF;0C=Q z`5taC79@X)**@?E$zNm3FGwB% zH?-zd2rWpSz_DJCd>%K@g5*5T&sPhQFXx;VBwx+>C2B$P^_=Sk$+g^|7bJg}8U9~i zkbFCHz*vyn%}shi@s|3z9#^IW0)OmvdT>{4nRVAo+`&dkd1k z$t~W3SdiSyZF)iSFPXtwko<;iJmCe&@7Q|pzaTjU=H$$VeL`|U@)&L!+=Aq@ z?9-2Dscx=)N@{YcZj@WRrMg#gi?LLRQDh=8B2AKGLx}XH+zX)d(5S}`ONlz z(^B2bSlZ2{y71O0>xv80Qr(4|drNh1=9c7A-9~QGOLgyH25+fuw{1ANR2Oea%@#1_ ze|M?w{k(ks>6TJ`ny27>mQwAo!<$Q~zQ#=6QmUu8K`*8H0XO{9ETua65)}BJIjn$n z9vi2gdm*0ly%H(zXW9qv)V5~`5dfxp5A+n=e5rWJdcXC<$)0UV?HH zx7sg3Y2s$aU?3c`eAr6Y}RkM9S)2cMJo=h00*O1|41wT#S}NWieiu4weL3W-Ch- zz9}}cx_sEEcSC6!(YMMXtCu1k<6-jr3Sa$aT)GwFGmyBKHlGWRpHJumYGX0_*KzQe7?yv&c8&77C{ z6}MUQGJoV&V_qg)Yo-6V=Viv(=h^czQ@D}M%M@|DIWIGx8SQx)cvFE@UZ+{}GOgTd z&&zaivo$aCZ`^9k%RJ6(f%7s?^MLNW%&R;|a$e@ow&~=&%s>0QOaxY&TJtN$%V|&H zHe+693b&c_GBdc*oR=wOMm{fd6So`lGVm@+%iAgDyv#?r(U_OHpWBRina6A!#BlPf zcjh+^Pu>=_PQz~v{0=X+_%w_B{n;C)|O@|+#seA517X7Zl2 z|C}52llK4NhLca)^__Mo_2kcu$h-)pp8UBHsuXbVctSrn@_TlCbM>nk1DwE^BqdV0;&%UF(kQ><@-7Ic5@93^& zM*EJghFh&Wy4Boj-_dn*vvo)J2)7z{bUT?X@Q&^o9?-p``!x@eyrX-^Hl4hq`)9wS z8{TGJUe=TL)40vJqq~sX%saZvxY4|$o6n5=jt*XVZ{M{UcXaTALEC2D(RFd7aYy$M zw;6YIJ8WC>Nqh1!o4uzWh$SDAoxBG;`DpC_Kd)aI{o+`7b<}NZ){0Oyyt(Vv9Qg6} zDm`BJKHvWhQ)hPASF7=csY2UyJa3pqGS%dIpY5y|9A%dw0n5V(~mu!(z`$hqhF4X$WU*d zPIykD1STLOo!@`quPLua2+oTy6e`@N5Fz!$@(~&J>!S(6TfY{SE`-x1erP1&tF9`I zm(3-GyE2ICpQ=}Ze;y_*UsOg4O~mHLD@w1^9*iQ0Z@XAT@F9Kn;?nu?e1e~WoF9R| ze=WCAI6ZP&sBE3w!da1&P*Kcx3y%a_8E!IEEIT*+iAW?AQhyWWxpXY|?v<8f{!QeD zr9BaTA%rr={F@uzC>7;jI8%QHDNu;q@XINnodDn7NX4B*cn?OFNW^C4s$DR>iebV} z%a92WH$1s^>ZC~&P#fS=YS7Mj2BCIrCGQq#fvUNunrm@hsXV(H0(t z866Hs&J2aeM$QYxtXOly|0&Nu=HEp5R8Wb8cI9@2U&i3M;TQ3vqDVi! zein*^L*emB{3D6~D-;>211j`+!Eb{fdsJablfG??dxZ-+>ChVRAm zX7^1Qn4LQ%+yId^&7K%8iQEyI*g7$M6@2Dimn)BRZ&aTXuS?n&qdm}i6{Hes-zlM4 ziEUx!f%NZM9rsUU0ghL}CWU6r-Cj>#t8##JghDM=e!L>{LnY12A*coF1R&v%C$EyW zXUd`36Q_i0e3IrRs67nL$SHBS&7Sw^23)vcIJj3MrZTZ7ljX{Vm5=Z z`||Lk2+L-5mdM?3XzI*x8oc*07S4#IhNeP2`s_zS#zhV7D>kuXLT99nOOK>YPRoMd zvJX!SU6wvG{nGTD^l19|8IiOxuwd)T4EO=|m{5i&ge@Hxh97cIIi14Jf^Y~@c^Eu# z*d&pjeg&L_-A`yldg(amfzA=ZL==KazISg-8dTRCFR4R|fbc5%+6U zDupc_cMZ8Q`YiG*k~S;j#- zmi6&)N)4b9!ytEXo25RyzfIDaVl zwAVQQc=G9p5&r%1iH{`kRj~L*;c0DaSIW=!x(@h#Q~l<5{SJD1W54&)1N3t(mBRaB zCH%1{{IM|g^ME*Cq@Kbya%6C!JMFlP@a#74h(*^wG0F1-njsCR_RV$jB;kCduqOA_zq6M!9ZiQ4j z9u>N1hL|Q31aCH0FGF6mxT36dae2v{Ybx`nPlKVJFv$#u6gs5HAu~CN<~bzaAyJ1E zI3(r}$LFZyVbn=Q)bTm$_*~%lT;TXz;P_nN_*~%lT;TXz;P_nN_*~%lT;TW|b9|0D zKF1uNV~)=;$LE;ibIkEM=J*_Qe2zIjPj`Ht?)W_2@p-!A^K{4O>5k9S9iOK=K2LXi zp6>Wu==fad_+04tThbCKh7k>hib<8zVYbCKh7k>hib<8zVYbCKh7k>m4B$LE=j&odpL zXF5L5bbOxa_&n3`d8Xs@OvmS$j?ejdj??*hj@S8lj@$Wpj^Futj^p`xj_3J#j_dh( zj_>(-j`R6>uJwVPqKI-PZ+ePNPePq7dN#?t~WWL)?=DYo5zS~jeyFF#T+g0YfePzDeS?0UFWxm^8 z=DYo6zT08uyFF$;b(!9;Na6@F`To*MbHoI$9*HLdWA;gxN5AFf=!vfU+>9Waiw z&MPXi52JEWY{W8YcG)$PUF6~z!%K!&iIGK6)~M)Hbc2`{$NrtdaGK5zYL$0gxiejN$@8uO`hmuzmL$3GoiejN$@8uQ6Lb=|{E6NTf zhdKt8a=61nxw$Iqw;f8>Z-(5QkYhp?%FPKmDrBMDoRH%}7Rs%da%5kXw?oShjk3Oe#wCy3+4C~lOsDTR7{TS7;^lI z$&nok<%TW%3Stz$0j*@q1?VUCP%LTIF*$l=pE962zA*AzooM;O9uiXp5c z4B<7!kn6qdmslv*dpTQThm!pgL$3F7!i0rV-m8gT`ZZJQiyf6huJfrB=I_?xueQN- zs8Lg_ieXh6t6=S#Z3;{`53H(URU@m4S=BG!cER!?-*O_~@&bNZ*hoiyj2W5Lax*_> zIhr4{T+NSJ&gRE#cc9$wXZLg-=UQM^XDzv>Sw7n{{ zy(+Z5Dzv>Sw7n{{y(+Z5Dzv>Sw7r^Pdo{!MYKHCA4BM+2wpTN3uV&a@&9J?iVS6>h z_NvJCs>t@L$o2|;gx;)XMYdN(wpT^AS4Fm0_Kj?Qk?qw?+pC$jS2Jy|X4+oCt+nao zOxvrOwpTN4uV&hLHPiAcnrC?x&9l6U=2>1v^DM8Td6rjE_)S~G$te7$sC8(070t7} zisso~*=IK zJFjAPUfFGX6n;S5I@k8fZrh`F+a9&s_Nd*qNA0#fYPaoCyKRr!ZF|&i+oN{d9<|%{ zsNJ?l?Y2E?x9w58ZI9Y*d(>{*qjuXKwcGZn-L^;VwmoXM?NPgJkJ@c})Nb3OcH17c z+xDp4wny!@J!-e@QM+xA+HHH(Zrh`F+a9&s_Nd*qNA1QuYB%OlyD^X2jd|2=%%gVe z9kpBUsNH%;?bbVLx86~^xsKY+b<}RIqjqy0wVUe#ySXl~o9hC*xh}Aq>jJyEF0h;H znB88*>;@`kw;M6L-H6%kM$B$EVs^U`v)hfB-EPF}h9YJ+6fwJ@h}o4tW>@|gRDM`^ z2|re~x>78sk#Pj*($+6-;Ks9^9!BYi(}FIcCvXw;a}CtitsY@LAVhQ(r0M zf{MzjYPm+D8P2L}X|HaE-`0ZJ>eY>PO%S5FwGCcG1!Q^is@8_OR&NJ>*toS0l&avy z5F(VzIn)npt6lm{S9KmH(u$^k~Be14O^Rol^ z`2oCuaa@Rn+hytl)(C?(=xaX5;KR|T+&Q|?;22)7UV>Md$_;g3Rhk#RQejVD>)gtC z1|7pUnB=DY(c%Bq;3HsP^Sca={!F6ddkqe&=)CX`8Qcv2ImV~b@s|ybOUQJ*UpKg^ z^F796biCW(m{zUx3xmIBly6@Ee}nNXIzG%emH}>mS06I}QD5hC8tmhS`HXzAJc9CM zT!){+I0YAZjO+SyDdTzt++4=9NoWD%x?U}1Jcq(pGp<*nH8QTtaW&&}NvD(XJmPmV zuFG*Nhv2N!|VJX zFt{0BRvhpR>ko$4`J9FTHvBNdXBiyB>-@|%xEVgj;22)lpR0&tSX$(X(TQsqKOm_P zn+%=5gO0xLKF`8;Qur@1eu((*19U-2U~_{$jAt3KBS=-kJ`YkwZ%9MXW> zz5ty+vhbZUv=E0GmkWl$Hk~RBPuF$Cb-wklRYDIE*XbpB@hQf2d%8bB|1T_jCkegF zcowDiGFmFj{k)bq_vbpsvq|Tn0G%gTcw<-b3bon zJeTx8MVzPiYb<=Hk{91%d@AV-1n7*W4w3saj&a?eEhf(Wxs`?2{hbl#?w_rT<6<9+<~o)xK6L4LUb^mAV0rNoa^_p@SP;|GUMf> zGlAmgI#Y?`X>^H8rF_Phl1^)YPB#m${n^a;GSc~JfKESg{E+pH23}zr7;ry_GhR>n z3F17xl`OpWvzGA|()oOV&UaaOnQ8E+hw%>53Bea$aO3`D6W8hLl%a$;lXKGfP=L-I z#4+FAfv~#1eS+zbym*lD4W$3`0R2C(@Y>HmGroy*V)#86*m!!cCa%+~LJ6^u@hzmY zB|zs3EPN*kJ@mCsQ^6x&mgYLx8n*G?qcHH&nV*uNWU#W z|85pu`*|e>vT_@qAcJT&Gw2c?09Jp@T?1 z8KCnO;@Z!p#mb{+xQ@c&2aN0c)#0b80Nl^Bh;u*BV_e_g)&}UTC9eG(AU`)U9dc7_ zVO-xQ|13cN01MwqLT@sjg9(If+648<(>sT__EWdpONi@yP-hEqBjdTG|EU1|ud(o* zB=jxD^GIhPKxY(9jG~`!LtPu7@$(eo+|P>`FCzU$;yfSjWZ|`+8yGJpogW71{F;TQ z0C>kr?;Mk*Z!92J85xrn$I_- zmNKrd(|;q*b-u#Glg^Wjr_uHPmjIoNbJU64pD~PQkxm71?oTsu%(uUUgvf<|xNRV= z^%WK39>%jt|0l$`{%=|MP7->9@f^~*=v)y!}Z{#?a)F6rDApz~=KUivU;K!e2Vc z-_L7_YaQ+9b&Qvj&L;wNzQDq3e;#LiDe1f(p!0VYUi%Z7tQ57M%Sh)6;$bkG2vOIdjB&%ba^I@G&j;u{NnHEcPS@dnBRsZmJ;V<& z{xD^9YOa5}Ml!yQ{JDlWPggYyuhX@Has51UM}W?^h-11Aga1cp-tbkXL+*<{#&?pR z=Ukvda6gNP>vGh7Ue5TFq;q?K&Q=y)`}1#%?;@RF1nB&Uh1dSP&G=KKGvh-4bj>HO z)202XV7!NP?hnxU5(}^W`3mFDlTLqtPWna416_{Abl+V_d?c7twUh998RL6Me;sjN zj`y?housvm@x7$;UjaG?S$OTz9~kc?oeQR_5Zs?);yPX0pE%<$kxplT&Vwwx_UBWK z?<1X80(9PF;k7?+F|MEMUwpBDx)Q|G!Hm~qaf%A}1>!oriVE>K<9+1kn*sX6rl~Wv zPA3VaGk$<{%82v)zlk{diF1mJZ&E@ZW;!GOs~uO zrNJ@0=D#)gXe0ca2FLK^zWB4j@mWXWGnd0(cy3yNf7SC-H~3|-cAx) z$assc4*@#ciE}@nU^?2*uQT3B`rixCIYONKpD|r2@_5f6&eN5{_D|BC_o&$95^&)tkaPC98t{(hcHT>Ck2rwRvObdnqQ6TUxU z@m-|f9-w~@3$OjWkMSPT`Eh{Ge&X8CC#gMpi|Occe~0lsqz~V2lN&FuYl!RgYCp>v z?H7BS?M-0 z9qnfuB6@eI=Wet^zP#I>I}n^nATFdgmZ9~sXk{R?OL=ffQ0I=$M@1mlxP=gt6~`-p2l zTOL*My%AX;9sa;}l<8~#Q?8I^xi%lGaxujlC(ix9nT6N> zS23O-oks(7b{gFD^V`IAy7YK5`%2qS?f;pKXAf85K17`RzlMd^{;y+v66ri0ptF~_ zu7|pR{0-C5e!k9l9_i;6D}TA4CB$`o(|%sXcoFH`6`=DlaqXw>cb;H6+Rv{uUQGIj z1N29g2)S`T$1UcdFkwg0+5S{o4le&X66oi4p@Me{zYpZ{&>nB(@h zn2yf>cNjlJIz_WpKJawSBd-0|_2gfOYk#z#)r=32{^y8?AsW-qr&xIH=QE58%Kz{j ze?KP>*M91Hl1rTXc`@T@q~8>ve-{g{{oKTO7U}#rK1+?s`3iCEr>+m*XFA%?7dR*V^tgXHP9m<;rTx5s z@g1adOMuSp#I>KgK5St++Rq0V-%0wf1nB>fh1Y%_W_%avOux!My=BC;pSs*XL|o^C z_OpiZo?%M&G2*=3pJw5;pU*PBhjb$I{QW$gxb|~DjWeba=YHlh-b?ze0s0$Rcbv}m^%C6H@PVvqm&hzb#rVyn^Jsw1 zSBYys_4T!z>1aRqGG0&mqe}hDaSCyrF74++Ruj=?;!ns z0s4Pp;kBP{Gu}x$Gp_beZ`|N!eJCTY{nyuBML_tw8Q0_REsXbkQ~B{A<9a;*X~v(Y z@VkkRgwwYu3HkR`BRqbuS#NI`;Zp&Y4_B7A4W6k3!{>$9r~|CG5%{C$A@dB5`J?@r z#kfw_H37Wc;HIB<6329*pG(Qldkv0$X23t(o-=ezKYwb3N1bJ)^D85Kijl7Oh^IqX zOqafnW|Uzp>ic~rFD0)1e3S-y!Pi8jISe|vlb}-xj#k3b^dFA zE@yl_>3lRm=OGqe`|~j4n@H!E0Xpxp@YllBEbe;~-*=umT9$%vN@D;{& zd%K_UJrw>ojO+IH_l)nQ@P7*6?=r6ShtYTe^8x+TJcl?h-^q;kQa&s`7_4gnGmE{1rzW~hjPR6HT#`w432*4 z`g1+wx;`uq;P)Eb^z+liwV(Qd;+G7Leo}WJer4#Ge)b#Tv47O%`xnO3(quA4;bQg4 zuj_@xwLiLi7c)MdbRG!Md5pL&M_muU$#il^=f{SQ+0Xu(h1cnNjqzO4nY_e5T~`q2 z>6*iM9_g$P(7B(uPM5BqpJzHnr1O-aW2WmBgJZqgN9|G{M<`B@fT*Ux`v zJcD#z572p=xGqQi+%4mJ6+icL4CC3PUqPH-N4K)@+RqloCy~xq19ZM?a4Z*{&p#xt z{nyVsUS;|^pZgfkqj=9*nk;uSpD!h@^FjN6CF8S5r!zojv%%4SUEdxcuKm}~K|aUA z>-2t^ajo-x;@VH0-WM3x-#bXZ!9Tr|h-)34-U}Fip04X#0(90A*Xh#r>RzU!{oKlU zFX_J=p#KLJUi>_-3e&NjGty_XW#{_A>m6LFnC+W%#YAE0N_mF z_Wyf~A0{1flfVBX4Q^f+rxVxy>w1+>ocmwMcrnGh#?UwY-@?Lc{~utyjC5WJ(D^NK z?We9M?=c;n&*Em458D5wq+dduw?8+s@Y>Hx#%oDudw|Xp1~==;H;8Nhbv@b5^tJzc z8Q1TZ8TBvzfI^ zu<+XdBaCk)oy$MupAYj4Zu-B3xb{D>O`X4jxXw52eUE$U*<)~+0=TgsQ z@jqE6S0)ch9$(K(;FhNXd4A^N{dMMYxNT=U&TI+z2bBLop6|$_aOfAK>P}dw{gCjd@Az%#pUti{7Z_raej!r3VDXj(Dq9GeV$2h zYp>O33i*8GSrf?fB*j~Oo+Zy9&%r>RwwGuJ zvz6j)`@BWI9(mf${Ne4~4{q(U`V1i7ggn)OJU3Fj)n^I$>&Wv)AkQ9(xBBcQuS1>z zvwpZ;!<;vZJHfu!eWr8&J(F{sOS~-;0)C-$pJ%#r$%DgrG{?Cd5AA(ijdO`_gB4%p z+#l!dcLP#IiO)y;KM*hdm>1`7TxRPtiTB6(_HgTW`@P#>7k^A#$mTW9q4)-D{~0d6 zrHg;U#kX?xdCkT9`uy3&w}|U{2>B1Vcwe7(bF^Jn|KtPwnEJt`y}mvtyZB>WeM+6n zdh;Y^i|6w23Z9!+ z4OQ5Ub&0oi>pc?izRk6q#oId0A@79s&2sL?!*u~)O>X(0AkRboKa$(|>tk{|PaP(= zdUnN%q+L?aZpeQUc~5v5c?v$8ya0Y9c_I8>@`3P8pWN^oewQIP( zjQWtL;UmaL!>5p!!WWR2!IzU`8ZLT_d=lbcBge;m(Jpd)><}Gr-p-BN4%lI&z1|10 zOF+DgVMngn>=-wT*|FW%vZH=4vE%hF_Lf>7`+j9({V~w<@%Kh=rSU%@Zw?>Fj^kA| zduz?}b9U@V53sk@_|5F?)OWGVo8Wk{`8uh8d)Hr`(LVNKb_s}=iR{RA1v~odzu3`V zzhy^%ZDU72+2^2*^+Y>!vAr7|!Ncp1(*-+)du_rTR1E^+mdpcggE6Q~#WNBQ9!kaa@rospr#hyC1T6 zN7s+VF5Y`7xqZGjoxB$HSx8<}petGB{5ZGX^#R{PZrg1Sc_(bo<~UwTyCi=%c#6Cy zd^mXuKH0gvPq*c=fZt4>L4Vvs9(C7D&yZ*OslP>@{WtZ$lSkN5kC3O}U2uMos!RRT z@Sl)Z!pD$j;4{hX^Ns7s?epqYLGtXm z>g|uyN2_NV3z=SKFPK`AMp3c zYf-@NBP}T;kKO0IRTm8~PvJVPFL^Dt|LNozTz5?-Pho@plspSx>AbTWZ;uCjD?7@3 z!ahLT^F8~|)Vp_WYHzaM7xeWI_8i^V1HzJz_OR`h=IN$^+5E8x4xr^3G@ zuY`BSfRtKDyJo@%lUKnfkk5lxJD2;^*<$yj7V>^C#jisFyYIBcmm^ml#oPY=1$jBH z`*U$Vu{?Dr=n8s~FYKdU;=BvSi2P-I!0kTOl3(I6JfkHPZ^wcA$x-d-Me>xaG+y3! z?&q!c2fW?!T2AUC@%H}oL~^TV896RjqiS-i|59=s2BWpkySnZ6QouiOF83d^WnaK^ zduW7&N_++dda&a-b22;L-;O7@3AszjGk9Nd3wea=&b8#_@E6G^!MBs!_3?i4?TBxS zH}cZnZf<)P1bjGqN;l9X_O$vu_N@9Z*wflM53`R_&pPk!>iL&|?;}TbqTF7(e#t6% zGWs&=L7sfj8vm`BJfqc##*rsq2#MpX$TO(x&EyfzU$x|E_>0buckQhU_+IDo|1oS_ zdh0VG@7>95KOIbN`{Q_WJDyaLr?BG1gP5$x9_5 zUM8lJhh%umc(C(b4S5CPmyuV(A0n@UzfL|6{&(^kc+Lq?vdGKUZk+cD_$kiiJ}S1H z8}QlWc_?r_c|LqKc{ljumHFdy}WXQ7<7+U3qenXCit2 zM)hj)XrKBL@`fJ|P4YZQUO!v?Rr0zA)OV6+>(vjCZ|rqSlD~bwWOF3P6KQYl1?mII zQ%BUtkmsLTlH{2~9$l?|3wgs+>TAjC8`L+G*9{t$?y}#u$@|u3?>&Po-sAtLTewcqHxBC_zAg{pv3_BJ! zwX0`*Jh5d!z)Q&+P++$6UM|n#fUhNQ7_Nz4A+NtieJ8nnUiuAr_DhZL@?(9JPLld; zEK0g7I+@(&J0_8@cueE3B+p>}PSTzel1c$R#mRxh&qkSA+%dA@Y%6zC&#HjieaNM_#OI+t+bG`7BcGDn^+2mXaqo{%7CksX0Xxny;FruV_V zR*vOJz&j1o011_Nn=czgZu5+1k=s1u404-iyq4VN8CR3rJmUuEem?QFfPYAC`{{mi z+wbf?lhR(vZ}W`(PHox_ex7kez|SYQ?Y4m2<{4L!+dSiw)-DK z-ubkqc1gU=r<_P`^NeSa+kDE!^^L~iqpo5^i|{D|D<8NVa9dB#qsAKfmSXBJn8$3;J^KoyJ*S63^d&zA+F6RvWd$agK>Y2iZ z>q(x4k8tki<0=AvC3}vp?{;=v=RL}f`MB5FU(h_e*)bpYEj#ApI-l9p-lYDRk2{GS z^IYS|Z9Z-;xy{EdCAaywhskX|?p1P|kNb$+=Hm{N+k9M?(M|30^KOFzK8Adq7LTTr zm&?G2mutywzqpg!=Hu*sm{MHoWAkxaDcA+lmb@Om%envj_F%v}m+E??xc~fiaKOvSZCuTD{vGNfnQsjE8gk3? zG zFM`|sHm&|c;QJ{aZ^NUuV>Q6yha@SmqXE)h@5SsA5HIJl=cre+H&e?xe$0;V4;*pse-Co}I9-pl z%lj$p=&#A_=&$+g=&zOR=&z0J=&yI!(O>)6(O<3beaXi9qrZyT(O>7WTfeZQUv6{m zfA{fdz~3N8bED75QO)R>@lD%b^0(2KQ9p7!evT%$@MqU8_ zCwU?KSR7bn`%C=?!uvT-eop}(74VDLG2X6W$9TJw9pmjOc67jd>=@LfVxJHHo_s~Mt}o{TeUx~AzV06IVsaaAW#l&AW|P}^ zyMa7ks}cR0+{W9}kCb#jnmpq01%`em^)?OQLy~%C7oknis?L6`#v{M<=y$Irv$cKqxyJxUhY{!;&*`Z6jZPr+x97r>X07sBr+ zx8vta&i(oN!+?Ly-b`1}VTL}+%OnrR+llNLZ|AV11FG3E-hR%G@%A7)##@#h9l4Vo zKVo|4}_CmBF)pOc*J+<#6oJ>WMu z_n(v86Yv+vG2Ei<&i!@Q7Xi2X?MS;M-tzRWYHF{z^=}Ee9XBSBTfbM6+i_zFxs8Wf zavKjXlBcwK(fi~!9va9C5#RRGquXW2jsE0Ch(CkeuDhm^mmvOX^5O71$kXuk7$9QHi*8`xW^-%D=SUB72PR^xZDw^l#EjvcAvJpH@1 z%dWeM*m2!e#*XW*InMoc*UbT6%Z~oq%#Qy0h#mcPm>vCf{AEq;O6r6D8pe+Pn#_*= zx{@9JbvHZu>lJqE7k2c^*UtTQ*KwCO)!+L`l zayx$RBe&z{u~!^j{}k3cguDP=L0$--Pd*U7+_}H*`fb49V8?j-gdO88s?ilmSdt&( ztrt5wU<5nH+Z1+;x2xDO-d3`sBR8;PyuEW}Q$3|Bc763h!1p=#-;-=PzbTLRKI9`c zEE?|Ie;@L^fL}pw-;=zZ+`cEdf!w|)xrN-mC;5@{Z_&3>)vp8IZb4IfCEoUzLh^jH zcQm<;|BJ{|h+jx<s9(hHjT8`&cDUvm54u= zyb69PIfi9)GxXn=v&btD zeFhu zx8q)l^5A6@s(+}Sq56c@TO^CE?Em}NEiP#1AD<(Q7o~&siCjB0#4Wc0AmwC9#s6f3 z;2aY_(`6~jWicqst-QTn6F-siT!+&8G$Py4BK0wK^vg)@RV3wcu5A2k-tY8jE&Ur$B6cb(!?D$Y@|T>bk#-ZoQ2DC^<^MWZ z%kQ;!Zrd213d_DplO#7F)DxQPE6UG27hAVWS8b(r+i0m$bO7p1lLU1;E3~utHcLw-$%Tj@kfa_F#ZDZCdU7rcpKwy67OXE zuf)3;9|DQRd|t=+c;ZRM&m?{e#x7{5j%7Xq^8K@s}9yBfg*MjD!F%&j%SlmG~Qs&m#U7 z;};Qsm+{MpA7%V1;-3)L$LaONvtV4{ruiMj^NH*HJV1OR<4+PVAg=TCGV$q*{|E6B z;@a;K;$@6~Oneb>9nWwW0GQ8e#wQWKg6TwwH!!|{cqeh_KDjL?-o^N8;@2_0j(C#s zjl^$Z{C?sa82=9OO^m-td<)}0C%%<9q)TpZ6W_-8hs3utJ`@s*`P{+yiNtp@eirdv zjGs^Z5ymejzMJtn;(Lhe@vw$?597BH-%orfwfAep4>A62;%_njed4{0|CIPA#PxXi zEpbSZ+%*3S@i5~Va3Eklvlu^tcn;&!i03hW4)J`(mk=Mvc%1k|;(9!E5|1!`8}S0h z?%(MUc&hAh?g?{H{$b%>+z5S3oXoNjPXgttBLFJP(*wsnrt=Z;>8$*47?7CH62>FM=P{jP;npfj#6Mv= zPZQ6f4$EI-fqUc9h_t%~uL z2x0pI{EQO%Xb|F>SrUs|;lpi}5ZiqCBR>3)5C4r1$LryAe*XkrZnif>g+5?h=&pu- z#PV9J5Oi@HMm!?-5U4NtjBiOOK9TXVU#nadFdn%^m7mGDXi|I@<5_fwoX7Y|8uAx1 z-u5}=_Y%hU(*#sQT(_5oiD+beoC-&@Go4Br0?T9FZ^v$WHxG{NSof8?V%^`5{cm4i zY~ye@0Ob* z@by`_yZI@s@`C){{rwf6K=JNZV%<-zgm2xyjCH>j>wX=4;%-HE4}8NS72Piu_q>C3 za4|1LUr(&AC$_%l#>-0s z!}oJXhF^vn)Z9?N%?-WUPjkDx2(0EJwj)s9m8X81Ydd4jO?u9(<|4M8rJ5@pvgZCB zy}QASz-lgHI|3uwv3{Cs4<**zEuJ&0xrl9NspiV2vF83Ay}Qkez-lgHJA!{i@9yxN zS z)~|#~=>6P0`W#t)7;E%&m-j%8UZ~OI)M%g@>T_iIJFk?>TQjjbr~q@vGJEcb)h!0E z=_ieCAZ1P(m;jhG5Zg_c+UJhN*`hyrEMQC%J3M)nS&~QW$RAA~`cc2ocX`^@5J8+q z`{rYzG=ZnYQNsv)wr^S*I$Z(n~i*j~?vY5*k%v5yax|Ic#6 z`k=>iWAy=I+YNN_K>J{yr)~8C;xyU=?1KZIxYY-U9r1yV`$L|#m3zc#vQ0=fY$q1boWHm7L)=hs$Cw9uCFomLCPa^?)jH*=ycmZWNI7 z>gJq^*o(h~3RjvH^0vROYF_bkkh${k`?+6)FDs;sT=EP`<{d5be(q(k5-bOgw3_NG zKf1B}sO;+x|JK)c1fQYG(}@4f)ZbDv%gdp4bRf2K==t!SnJhPKX3F#2SVswB+sz=x z*f>wy8e@plXb*6VMLcn9j3IW!2RbuN^|YSb0ZmJ28t^Id3&ZHD#J=KG}qujuGn&RD`#!b;IQ6kq|C<_v8e2Y6{_ zT)C})V9iAsnqd)!*lw2R5ZggZZIze)7N{&I zyFGa;Cx~5n%m+5Z%m=RR_fswoKrZ&nHU8$s2fQ>GIp~7QULOv8ob2_2wQ_;j4%YKA zsBzNcxv_GBIK3Op3pUNniykKjAt&&o$A>!8~(Ev(Cmnad6yq5K^S)oo+3GyAD)jvT^3h*Zd78(4PrYnFs}^s5^aU2 zZS^tYG};5aEMDn}TRn={5g+Jfaf7FAAtr)}jNaT@Ib z<~-?%TRBJUhz~U98$4|*=ZMp2tBGI$OPnp9yp?mrj{HD#zRlCNa*jBS_5gFf!xOi1 zj@TCW=7Iii_uWFb8S^&jyM}V{7BgzWoTo|+Vx6+f3)kvK#CEu9or24&G>=MBkC52< zYquwFbt7U&exTjB*VDGT5pf#r0d`}LCvJ5kVq4tnMmVny@RYI7^IdD_SNdzEbne*vUgo*8`UJ7< zZV<;o%+t2|1aTVe0rp9yCvNo#Vq4tm6JxSW^N=;oa>=i@w`{Ts46e&pculdo9C1HQ z8FZJg^xRopj@WiLh%RsNw5={joJMme-*f14RTC23n4RUB6R$zqSDo?b5BVFpXGJ8W5NKpArgtgmRnWh{WKMVEg~ck%V~ z2Qa$m&eL98eEkamybT05X4T8YN8xUhQtVz|3RJ%pD0k$Gfj@&1klKNs`L}tu%&g&# z*v^F19`GIK9iF^(b?6TCct zADjDqGaN#6}r-Vx|Vwf{^iAyYvGq^v9eI= zDoezaspE6+sD^QS1pmUc-+0ShRf+sm@ox%_;NR8vs~U4vC1R>Hd)|d}BTk_2!(Uw- zf%jqDcN9}Mo$Qm$UHiOI1=Ui2e}LE>RWUge=HC7m_;b!U8^aGZC$fB9_Zf%>kR>=-Nnm# z#I}ng75(e7(6c;UD|E!Rt{M8g{#~%p^E?+;))Ct-j=Tj4gTI=pgwB;`$BkF+di94} zwrp9|+TM9~Wa?@4)6R}8TT|On*WTFH89DW|`bg`lNM}PL5^ryhuZx`45ow5bMApWe z)+8dQHPuJ1ZfLA)h%|OYni3ryP%z#iOEdPw2VPAhD_sfe}&#&BPzOgy@U7#dKYx?l8XA#ptp^rz-}4CznJ zb$$J*xgJ0IQ*%A;^k-o}9aAzm`Rnlc^u0`d_MTsrsEaq%t!aW|v_8_<0!L~~yeU%G z+S*><*a8s$A6(PmXDa^8jN?~vJau&01xpt%UbZq&m8zc zy^BC220ysp0zzt3WCdn+)HNj9J7&h~wpgc7tm>!}(yXZ)t6BE|MjJYa7C&HHs2i86Gt( z5NM=2ZQXSsx6EwhEp4)H3I{T?N6Ye^ zu3;P)Rwr7UUCYTR)!EqMS_;6@R$uEHrh%ckwW-Lp%v4pD)D|tHDYFk_CUCVT=Rae*Q z=3;npDDb8B<_@nLafWMA6u`ZBMLf>=Mr~(-_ER8>H-2#z&n2k=C`xJL?+i8{5S%n0YirBfCe&bA(w(%>pZq zNooCrTcMqhy;U&HiCmbj%|SMLJhY^_L)MFM+hl5m9D`AAg#!WGh+}Y}Z4((MLb!Du zadc^qfN?Maz);g(8*jNvEVt`rj+>;c9f?G}XyC@F%GdyhOKbZ&aSgYZD7#d?gBizX zrHoPW0Jn}()_7A}LtO0PR+uR;W@(LzSGajfO1e}0np>mF3Ik32iPSX01RsRp%9I@#{X32*>o5tvhF*(Q-OS@ni{f;brrjj8V7GtkKs z$SnKAvEsy!m34sq8!*j(wiHs@G0d4Vi_c%EXl;Jd}rk8TNLo-i<5eH{N zdC*?UZ8M=_E389dif!PwInq`yjqA7(j!Zl?NaIFkJbeVr=jvQ3?e}v#j1)LsO4}3M zc8Z#ur16K`2(t*BGNtVo+=f#n&E3DVZ6aexZaAswPT|6^%ayZb| z&?thF?4u@hN;rT6Obq9SDd9kCb7Hj^#|_iLZ*5b(IF%VPhK2)mtsR}6@mev1+eU_A zer}Prx!g8h)hoh^3%L>E!-~?llo>NYwW|xOUCu2hgahl=p(VjBCxrvoT!WT2W(l4i z4m8SKT+1!cI|53)DE1iG49>%{N5VG0=Fs26|bhUq9&gVzxv6tTy5 z00L@(l?u;kW*}b~3b{pOWI!G8(;V-#TTzk`=oBNFgWzl^EKcFHGy~QKt@Waq8_tE| zuwJk+9?ifLt2#Q{*VHk$6Ciom!OQJBnE^1gbgXd~+W|;yi(H%4q%{|(%!x1a=4S@Z z0CS?HK3!dr5zNgD!1a-pn83KqKwG1{8Z%c`ffF+W^;gH!StetJw$>)M&J?s1yZlVj zN@FSlQ(|>dd%WJQc6Md}coEoL+Xa~cxYmU=2RGpe2;#yRuC`fc1jYpe@wlktU2$SC zPzy5($0tMSHLIJ&_1thO%G8U0;(Q9|0KbRxGod_OR_)|`CX@&MIOoMsKG8H=JkJfK z(oigZ%nae_!9b#`t<}A}4HuEcy^IY)np)DVAA+NS*SYJ8;0eGXuQjXN#UU0za1x|k z4qEXhH=Pb97?I*VZh*8jcCKqnh(2zKq9xHJhQVDHb5I6nt19iS&cF|zi*A}!3}aZm zP?j`e6cKL1EWjxoTXiP4L5uNstdVo8rb5U9d$MC+!eysNt=5)9hxg` ziKaC5!q^D7E7w%x)(hv6W?Q<7<2_@Vnx}xVBh5vB7)CQTo@ZKQs0u!9{3WA)mZ6$HGK{rjEKo zaj~tJITl7_{Hiv$4$iMvb<~M3@(P7uz>9)HaTPbgxTuF2OD=bs<6VyE2{R0-Q)}Y2aEag9Xs;iJW0R@P zzp?9PjsVrTYV@C&DHlw&s?~v0?a`YDrn)-Wv=f+VB$(>!rRgkY8U?0ALYfvZ(`YcQ zS|v@FG1C|@tyXDlXQmu5;k{fqMTw2fmJK;25^6Uc@G$1z4yM)#DQeMZV! z?A9#-D_l;kh8tmy?mV#7x2~y8W6QySWVC4_5*ZVrE%5ZD6`loIM`>^be|*H>Pk1&MVGg9)z3%$F|^84r{S-jy9?18>TG;V*{$y)HQZE^+I{l z=FDw)BMU}UOMPP(^9}>8PY)3O4s zEpTrJuHE2in$ZU$BU6dt1Z{;7&d-8d-*^Y<47*BZctTd-YH7KESu#+otsR%Qi5B

3eQI2fy?E*`srDL#;ZlWjfEHz4lY`HQ3X8joLVwX49N;tmBZIk_!`c@$DS9J zSD_&*Fayq$GnOu|#%HDQ42}R4u|eg+3v94>>7pW=EUTW+DuGJH61z}27skig^Q&0J z%Bu1UD^@@_Lsfj0ORGhQLR+?=YJT;C*un~U9;?G$wg4Vy+K!f0EG)0I5wzjLibX~% zs}?U~CD1Phosz~-AU!FtVA=edste{X`Miymm6tEHNvvX7_0p=#Z0J@*615BABlh`e z5G#f?Szr*nT@TCDRFyBTSW>aL;&LA1lKIsYmz2X>8?2U@0DN!2&QjG<2B4XC2>=Ui za>3Fij6hbaD#}^K@#*Z5dwjY$RbmX; z@B+rLfZ97S_3!l($`0I}3KjN@z+uk_&Dpa{I_5zDBa-~=K)%6QdU(K%5l3wV?*<8P3sVofqTYtG8Y(~9yr39@0vHBFoN~&Gyc2xhQ z%A~$QKd0Xj>2xTnep3|A4&Z;OGHTyMnc48xhAj1urR3U`PGe9h8RLbS?i*A~B?t1s z_c=lht}74oAS?v317qN=FnMC9m&HO*+BPg*0#j|Z2n-99*akJ*4jUF&Wb;eqEDSv5 zR(}()MT7Xp(NEx8AkY^c2EXNNV1XGk8(ZK7srp3C8hJmRy$u9!7K!IS{lkv%FNf=Q ztMofrf&YH{$H&6A=4h_pxq55!`WM6hGl8&tE$ihsZ+bC&S0*8PbL;S}8($3X2@#a9 zc0G90UtbGt3J{{V!8X4Rm482iAhr@--n#d_KkW$L18o`#KWYmE$A)qO!8_o6r9kk{ z>3?5$@Zi+o!`V>cjETRzIG7*0ArPsJ1Q&*G3`APg=fq1U2Is^6#LFiJpAUtCfqB6n z1yOQ~{Jl;7zDfT6t8}tGgw_Wn`KcuDVYT4V0Q{~@P7S^=6bpPb1b)XVyQT&|mis;M zFc$VJw+8oT!nX_N%{T-vCGLt(H2J)_o1Pyl~VkiV-Pa$zVOC^eD^;{%7t$iRtNqq9Re2F zYe<2}&OQ$+36V8QVD0P-=w|u~{}u(jH8wQ6Vl*5^lf@~+XW}0i=ED#C`B)#s+?AIz zBuoDjh4W}==nwr*mdJmaC?_-T)?gR}#m&RR4YTkP0+Il`Lo?}L+>p9hH=QmlBD`&& zy6!=SlL0=woYAqaS$=jVx;lk?B12b2spl4ONh+_ck2t=CbOlMHSVR^A~)+rbyuHkZ}Poao1ek4!6^5Iuc*5S=HPr3B0Y*SySH_U)=)F zd>iWo-V3V{HARh0g{zucSV-L&k}BmP?!#%yL>V%W1(Zrvn(ee}w$rXTPRw(hnCCb#&v9dR;+f;bGslT% zjuTI*)AmxQ?WIo4rB2MHPRylF%%x7urB2MHPRylF%yXTX=Q=UZbz+|D#5~uDd9D-l zTqowaPRw(inCCh%M+=>xqlHe?(LyKeXrU8#w9pAWTIfU`Ep$SU7CNy<3!UJjg>Ljw zH~Od>ebkLU>P8=RqmR1Lr#W#(-RPrk^iel@_f#1za-%PDqc3u!FLI+Va-(-om{IqP z8Ff#YQTLn~bx)d6_pBLpPn%Kqycu;*oKg488Ff#cQTN;#bx)pA_v~3{Er!gUVsod& z+?i$W%r8`$} z>||3wd60z_AUR1q_4DZZ0{>V?Uy&e^|Dy!>#4F#25zrQ=Pb?3YOyV8dZ#FpovzqWX zYI1vkK2hfp_<=t^mD{%r{t(*eABL3whXmNy`czE3KwmWPrTv%b6ZK7l;?9S0@$?Qq}&tYM8@SmZ3wo>#JNtL!A-wkHn^Fe8;SG$ ztoJFe|6y|-Cxt2Qr}CQTQTxB)qw}`G%{c#Ta5K(~kn*JUljL|9;}gkm9&wa2b*c<* z`dw*ovwRD2%nu$@$LRR#^eKNEaUCaxDK;@amE!!WkIq4Zn{oce;AWghnSPQS|Bdky z^4sU5Ge4{-Ed&jf>G)AjstiosD*^K*#f z{PPg}9H#lX$%n7;;ZOST=Y05Y81GpJ&SA^KKwv{N9r|*AIOA=UhbrPc53Q_xQmP2i z$#^H}JmaJDQ&yg2#6iZpNM{V(y~mBmGo83@S5lUOM^cPmM>_33IvZGdk`bF3Pm<2R z`RM$fmnWfj8NY>e&Kj-?@OCXAuG^*Ki7~!`bh>?XcCzwG5_*X7O{DV&ADzqS-=fDj zzXLydoL^0x$9Wy&+erUKL+4RL=Qpf;5^T7=$@mV^nTr261lV}q%8BDJ+66x`e0&4j z5~DmGkNUb}6>%N^F4Di=DE}QOuiJYME05Z^ZD;%u()mwA$87Hhtb9_c2=OuFdq`(q zo+`lGyPUXg?>qEZ>L#Q7Zm6o`|2lEqUUDmTGX5O-J!0sX@n?=yHMLHXgt8fbiF7K7 z^Z1*I>-hCLcCAs~?5|syzV5HPjq+xDceC=ky-zW|pW^($&@tPaJ1Tv9^BF%#I?IXk z_O=k$?cFw2>25U2KL$wm*Mm%7$NwAdZu^C>H@;|b9#Qaa8Jq_dDX zZ`b9lypE@a@lB+&!$;@4th|orImWk;&j0%8jE4VN4Q@JqwI{?l#A+FAJ| z30=*&zCXU#N9W&Ic^%Ks8Q)Iv%L8g(Lop@tqV;1pYq}xbb%3|9}KHt&@~{LY&9=F4DQtN9Qh9 zo@B(mj6Xs;zxL62pOx3~e8~82(kYE7PrO}K#C5w=DIqRpd=KetC(d=AVdaxTZO=2_ zLpq_!%FcDh6X)@q%=muN!9VZDjq7x=@<~}ri0c_YL^{v==p1C_Nk+WR_*wrxH-zc#q( z_dTvd`X4YJ4k^Q&0`-Z_GUAe zo)L`e=aEZ^^L8azc^%J}7|*A8zU`y)16DpsLa#7Bj&!n4R|R-HqYQ42lhcXo_Ubs# zWPBp&M}2fU4Q}@D4F)&;-o^BFyY6K?LVkDn=)7rg)9>Gyj&9edj2Dpp`BT#8?GoZT zKRV7YFg}%Zw)^OO)8J+v{++m)ixyB;$9P9)CTHJR}k z`JLjUQ*Ut7Z;QcAzh7bcy1lnCUQK>C`{=x8aMSNWgPVT;$n=xsxR-JLzQ_kYI>l$I ziq1G8J`Btmq>Ud-7;mC>b^GY-VC9pf^&sP2q;uFu=MM%q^N=xJ31-6way>s}6X)~8 z1f%@7puE11THsUue4{+->-ExFpYl72^SnL8_$}1lKNvb@zlY8OXRv9Vq}+q&wv2Bg zoeJW-A1@=0`S~XN==+DOnGVT|CdRjtewUBVQ^dL7mwn0~Wco>R{5s>?$?w}fI;YG~ z6}jIE;=H{V8~j123jfH3+?ouXhbb2PxR$ui|4xeMHiHi_%0Fx9JOW(buRCCr$K&V` z()qnn{&A!H-&lF=;#0==kk0utRSBMl6~uM?NfNq}@#jeAUwm}FLmczD3x4$TogXrt zmq_PVhK|{;qXypzIyCG>pil*-_4V;Mp16+x4bm?pj_oz|KWA`L|5B!}pZ~Tp{iCFR ztD$4+-(hfb{&~oUKSf-(OXuxX;<{ZqVb%V_hK}j?BZHgm8WOehrk@*5BChodNPjkQ zp0`SaoBCHWef=DH4bz`T`kM@$$00O5{vTuIRn$T}$@qTC|4~EdQA1~Bk*cZNl_a6D zj2|SOONsO2qLGy+8PUS{Tcqg0U5D*si^M=1Un=edf% zYVao&lD~iF!$XuOj8m4!FR-1;IrUc==hRG#0BIH|ur z<>jegCR07HyzUpysb4NN_#Tx4`Fo8IzmsuluGqskg(-ffkoU zcT81c-Hi9r3FcoJFS}Tkf1dHf`gthhg}1BnA2Oc&SH<(`_`vpJyAC|9_zcD)KUO@( zc-wy|UdwpTUlhNN@w_ZGAnsy(?FQdz#Pfs?-_JNrKjL?c>+{8@ zjO+8lcv=@=d(m%%e9vN>rWtWD<9a>Z#CR#`+-C4^62p)CefS>6lQdp`!nmOKuHI%m zd75(azl`^suJ{;A2)0+oLk&BN@d)t?880JV!}v<#>ljZG-^%zc#2;Z?KR0@b@l90z zFymW@f6Vw^y6=!bQng#RH|rv`KZEfVUr_ua#*+!fYZ>3ws`!nJKSKOo#t+i@PvCFy6C7@$(rkqw#zx<4L-3ZDo81 z@ovU@h<}6e!^B@;TwJN*ImCF`7Zv|2eU0hv(a69b0rFys2~7C&TM|2^8TR5f|uTjw6p6q;{P z7P-FvKM{?v;br`G`Az+b(05&4oBVj8+H|qOeq!%Zq?SY(?Tw>l5FTB4S)!Y$hcO;S z7&6_Zfp2PCLG`YirHT5~^)VG!$DdeucXt6E+5ff=rakQSf9?8M1?3>tiG=F zi24#?``1Fl=!|4pwo-iy!VdZ}w~bJrGqmga?FD9Ox9mMW^)u=8Gm9mL`}&4Y{c}2% zUvGM)FnImPed@nS^;g*8J8gZQ>a#G#Icro!UZ3|r4inyYSo2P*f4ZKZl$_)L5cubs zSoE2jRE4&g>J!_IG3sehk6*m)l&=1?$5p*TDv0%QjPv?Oed=HKD%DpXGHx7aynY6> cFP;DHH1&t3segh`{b#7YZYRc%Qx5n4fAf@)(iROA^%YtgN=cJ6NkaimX4XXziDwQ}FRzq8N&Iv?-8^OBo^*yfGFKp^B$2{>_&LGCB&Z*yo~q+@g`-)*+6_J^cxnQ zk2{Eu5~mlZh4?AK_Yofx{2t=Z2>uVm#|0lI{+!^C5uXtJ8R9Pp{&V6uPO;F7bB_2K z!7s>B`J5E|QsOTQUQE0Q`UlH}>czR1cop$^#N)&_2wq3LR_JLYzEjBGPP|R<0pd8W zv9Ldfi60R1pCW!l@JE1$c=1=N+~X;iL-Ir!cR3tHdBNp#1a+LVF6VcfO!aw}&&>cj zn+qxej%oK|;30>zn`ySx(&I~*Bv}Z~S39&S#@-~g$9P~}0nM~D5&o?a%h^24dl3+`NTopvmp7Ts; zX+Uh4noZ9-u!v<@eGpsi*g~3Os^)s8w2%-Rre-izkIi_h=6jB5-HKQ`HuI@k=o!(X zM=XuZYN|#(J6bS^t#)SEp+%l4EhNO!)U>DS&@88FiRYV^2E@|0*-q6e&ypM!dXGaSOvDMBDdp7Qw(n3OPnCb$EAx&c)K0f2ATI)Hc_k60R+)l}W-+0lYQY_&7P4sG#FX(1t&rlvhrhvBX%b^s1FaJU6-oAPUp!J!Tg zw>*6|uihock-$Nb5&Rh8-q_+z)&$hyp&&MbXM=F4frC;tgbm@4QHA#E;E+w#X;c7* zg4hW>I{=4_D%UGb6*%Nmg~I4T9kfN|?{RMdN8^WMqw#}J(VaNzo&+I06vW2jPsPUR z&M`K2^6^3Xq!5KP!zYDY$S-_S$ai0k7P>Eoqxf=YzguU!!B&;lrQq}*v%YI1mfh*u zv5g#QO5BJ{dZx6IgV-?T#%T*lRa!$j=h@LF17fQkTS(HB2+7HQZ-v+}#l56fH>LR1 zKQrtvQvK`pwk;W|(wdB1&qFO4hz$?fjx8C|lt@OtXG-f|#D=Na^lzbOM+*tD)s8Ks zDf&0+nbJZ+Y?$KgO{0HHRR6lu*w(+Q(%Qd8o`+g85E~w{9a}P_Dbc?ro+&LEhz(Pm zjI5uH(w2%-RrZ{`5f0g1X=5N*P*XOwBp_UB9 zhKIbu*pe~D`dsUo(vpGLFg2U`TkqM?LPBh{V+(1D`Mc9IrG2Rsk8WFR&?hPR2~u=VP87EhNNNJGPLf7_vj2DJ>+# zhAGb8G}hl~Dc0v<&yUKx~+rP5+L2cC?TXTkY6F znxcOvJX2aohz(Pmy=nCC&e^Zer#%m~WFR&?hPR2~u=X0JN zEhNNNJGPLf7_ts@fZFrdLPBhq;_OXheQp6gutBmvu3itT>suae&U^9X*}Pjvv94Ct z9o^}^-tri169F%9zbnQ1644geVI`Y?v`V#s4I1}5I(G}s-$v=y?U66smhIJ~v0)b( zQ?Kr})8RhF+;0has|jS?26fQt)i89`2Wj4QX_bi47_ZJPC z^Hx2Y_o45@r$WS-0U!Q4VT_YHIkQt}B-u5e_B(`D>Of~^TMjqsVk6CY+wrS&H0fFE zT@F`FaYIj8LRnXaH};eUEx7#?u-yc$>9rs>{Ob!d%HR?%Vvs3!9Ax$`ROnh~*4(Bc`<7COX+kx^?HP-6`PdnZd6h_hR;g`pV{ zVc=SnWxYmh7;$^UU99Us<*V;>!0vUX`)ZBfZqPET@AlNC&7foH?9Ql&r% zH+H~K&s}Ef*0L#FAI#$VV0PU$*ERLR^|)t&J8fYr1l6^yWRgdK$Z1yHe51mo-H@o1>|g zWHiy;o!A>)))Q?>^hA3TZF`c@Wo=E-J6c*BTcWK!(Y9ny4+thYTL${}U1P!kM-G-QCGV3T%2V?CI*t;=+2c_5b-b*J?~MA5yW;iyXCL>R zA9$z7GQijG@7>h$*s|-c|E!B&e7oY4Z(qN)re^Dw;`Q-$o3lP z+6HUI#@4=MPjp+NV|TJ=Te2;YYVA#`Wh-tC?T=#j`wK>7OU|@H$v%#5*ALQLKCr}s+bhWxFGBhwJus9fKx+9UTW(hXv>TEOH zEXSJFCclbwWvMEIs^spn?nIN>Y;7ZgYXibNr|?umIRMw?==t(FZZTWxOcKYCmdek&82YfIRsY| zSnY&+(*rpXP#RF`)O4ziEQ0CN)0k*Wbi0Er*c*>51aybn$x5g?vH(c0M?$?L1Cati z`^wZ{5A_ZYMDh{PJPh?7ABf}u*y~9Q4Mg66z>_#O5V;UQpC>Um5Sfp_lQ=N&`eb&# zET$7p=0_yv$^5je;K@8LD}0mr=c4Y-aTI z<|@6-UuH4~!;wu}w#ROaZ7V9j65gY6Ud;`J<_7-$0{_(!?dro3f1Q4%OM)W3dIkVI z2`%=PoL$LOwiRdb6}}bc04y+zuk@`rg9ujoR-9u9RuL$NC1|KWCjv$Su6nh&)JHbJ zq)+Xm)u%SH9xwNLi_r~u*+-Yvk!#@+-V@uBE^!y0DnPy!%w3%-f%z9KSdJW8u zy>E3nxq7-kvI2p(;7#;Lu0-H1c;o$%A^>~6CS(1Pq7e1>KEQSu7T~?ptA|i0)g}43*Z>Q z4cdU?eFSuVeBZB!!iN_5KfFG8_ivvL-4oD1-%fn!(4*mp;8WII_1P2DghGMfn?t#Q z;7{Q!5d6M-w4L9CBJN=moTXO=b3@@ka5*-ga2rnR7!JJh++^@wplNJ!%vJkDa4TH( z9S>fCdM^Z(Uph4stOhn%zA`um;X*X_9oN|Bd`EO@r7tYV5+$ z)!&kvURM zs0jv-$;^>5s4F)Rm<#G5;Y*y$F2vQv!9T#oO$hL>FMs}=+(GP2C@a;A zcjUj=4dY*6&(F#KP%yj{m%tnd1dEjCzwGtN|2x>S%I|Z(@PlwO`u70xXh2({np~{7iH=cJ?$lH*epzdDHgVb?a|xSY2FFTlrg>zGSL+jfqN2Om>Zls+

~~~bb>x;qzdz< z6U>`VFmF0Be6BJ)tTLjgGJG!ahpjE}+5{=P#xJ*8YqeTywnnR4qt}%=yl?8;%Pj8b zOeKqN+){Tn>`6Ah&na$7?%K1vp|zvAlh4~)JCb~!*tM%W*~?eW-HCRnO13o6S*CGA z4{S~scf+24vHKpVPBZmXr+~8H3M)YBT;gdjrMG1K0)g%vT!IfU!NUBsx^(WMSG>{e zgr8U3FJ8`{zmGV}r|J3u!Oze&>yvu;fpM&d#9@<0oiTU66b6J(BEcf{;Dg<;uzcFR za-5XlFBAWkMb8Vw@sTs_@N=5t#Rsxsk$fKAfwNsD1rKEroFA~aow)SBOUS25(H_D1 zfqdVv=y_Jivp@L2G%TK<6wea+t_G|9{aa0(<zk4it@Iho)WZu4I;ru`- zwyRn@&hx@9KTwb#%q0E4ksf%&deWq5v*7#y!jBV|dcGp$*`J35hi~89^1l{6m(XOB z{=8Lie!yWfap}*!#5tdnG(L}6_`^a!`~NM$3(5cU#HHQE^l?S{9~GP*xY$Ho>PZWE z_GiD~QSt{LNQFh}`L&QwyHbubDfm*-vj+CTu}D3)5tsRFw(!3r&UsK;9p@gw`GJu? zBrffq74m6P^n1bi0h4co54%{To_79tw6y`zn&`M(jVN2#lpOn^nB2w=hH%- z{W&f;zfZqt(NhRtRb%0P;roOo79JzcesVtFA$UFc|54&H55q#9{r{Ta{GiiUEP4v_ zl>gG7H%m_bG!d8nd_c&vKL-To2dVzRqURiOna=<{-A?jl#HIf$1aBe#ZznGO9~AQJ z|53r)NY8T?J?Dfx_wOGC=li@31uFm2pGM*w7yHv9c#8b_ibc;jahbR0Ej)rxxQ4=Z z+5Za!?<2eKBrg5$67uZ-9>MuRwvSl!j0<`8=cj_F$)BaLIg3U5vz|D|#s0(v=LhB9 zYtb`8ob$=|U5{G$&xC&V|5t(^Apc8gpH})`OI-S2C-^<2=RS*`5h2h1d|U8A(i6TY zdp<8GF8wJI{0QmkwCFiTT;}ru3x87RXaAoT{219Scw=_|ONdMVD+K2U72j#mb4BYgD>y$0c`I>L+X+AXe%(i0=JRd~e^BUW|Gyykaq|Bq;?iz@ zVRrv768uY~=T_oUPoI!yf9?`|nDjhh(eqzIeuC~dP7D4J=~;EL@?ZK>Pn`3~_pu2J z-%p(Tk^TR$;O^F7vt0!jr_M|L+xil>GlHahZoPAP1Qmib&_;ct0MreC_?l-G^$TeI`1k4Js-Yb^YJ zA7A2=f6&J-^YMT7@ymVuq>uacJn!QvpS%-=3n-YbZusH2R$yZ&++P!v&sBo+gU@@2 zqnLkPy;sQZqCpbS?eJv&niu7j(agK}q`5VFcLG1r%(eoH_ z9zXo~<$D(XOQE0r|8K$hLGLTEQ?vLVCocW35uEn{4_WklM#!^2pO-wO{P=}MPiU#C zm;U4m&JUj7NIVG5{NtpRIOmh^54$aVQ0Qm>j|$EYw*Mhh_qdPFG2TWW{{)=};57_C`~dX_1W%K_H=!UDe8KgH%heWsqu{i?<|G8CkB!b= z!Ra=}IU;zJ3=a!lMEsQCCB*5u_MZP$#PJ`^V8NGm_e>oYVS=GZewE<)l;915PyUZ; zf1BVFv_ZL7@UeE~2>wGEENpj}9OwH=<_{5n(kI`mnz~2+9t7q6d{W4dJ**n>uPU-%eo@F566g0ZmcNuZuUp7*Jaggo zfI0vA&kH1k+&`ZGVBw1*N+ZkjcrF&4$MZ(Pc|0cskCLNz3C`pB6N2-2en@a0&!>Fc zKc1hraQp`%STHV>=YA=m1%)|}=M{qUc-|;DkLL!#c|7kGoX7LWeB3{7KWE|J7M#cP zj|AuO{2Re}JmWv+z=HAm$MX^kUn@B0?H0j#JogFCya30V51?Ta6zu-KcM+A?e6HuNJoX7K|;5?q^;Ts?n_MgY| zZX;#!|2#>CvftaFT3jnC#ifJ)4@xp@nX^%~ zKcZf|qm;$}8zmVEf0EiC_gbnGDU1JK3YpCR4L2%z*e zuS)7fMep3I)J@VrV;}kLg~uQMU#o2G*R`njL(~A<;~k1@kN^KFTl?p`RC|6~!S;|U mqy0up`-0n5`$6^M<``{D`}qH~ve|!t+Q)tE@tb+s{{H}zP@T{K diff --git a/source/cluster/wham/src-M/obackup/main_clust.o b/source/cluster/wham/src-M/obackup/main_clust.o deleted file mode 100644 index 6f4ebbceea4f3eb692224a21ced2d1018538750e..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 143320 zcmeF44SZGAmFUm8`5-_rK@lUOTs3IW2+6$x0%9eQt2Y`ThG4OS4f(i`NJ!G;g2DQc z7Gg<56kBPrV`rF3JIqu&%#60wL7Q6ph}P*~%goT0PH7))p=D~?(i&%I^VZsX?Q{2D z``mnK-+TVX^Ml-b{%h~G*8bjSpMB1KC{lh)z;#m`I$Y;{j;l_z&$ZVFytAd^+fwI3 zC(~p63+hO9em%tb1prcf;!PLawtR))3EN8F!-9KmE9|@i-(0Y;bBaW>Nis|15C_6AnkZ{BXVjJOy%yAN>@*mGop& zfFBUgAUzim{{``x#IuOMCG@9p_0D|AN=$G3LMgh0LX;BECp{`>R}(K_{KLeHh+ju~ z_7PuCT>05YJWhNTh5t73$BC=_IYInM;;LNUBz}lEeK=|0Fs7@YfU22c;>U>Rlid>H z4rLhDGdxxiKSx~oc{lNs#8tXB5$`8{u~g%1BfgLLwZuP0d>3&l24@fPIPn|`{}l0h z;;KIUJ@FuMm2Y1oo=05y^UuVWvhY739%bRr5MNIms*^YdiBBU(RDPyIRmS{ZN?eu8 zG~yM+Rk>V6d>wIBe+r22BtDhwzK{5m#IGV=PP~t}D#s5HKS?}D;TwoMq&S!OR^qwD zRk|J}UO^nHpEy2Cyo$JL?_VUop15j(UnSl^T>1ZP;=72$sW?s$-%VVV?=Oh&B|eeD z4-((c!l#1+ST0W!&!F(rh(AkQ`F|DhKH{n#evtTa;+K)0O~lU;SAKR7KTmuDg@2TI zDpmYE;!hIKCq9Gt-w=-ySM~4^@p9rSKfg)5m4!bhxXN9}34Ti&c!Rh)SD%w1AujaK zOFtzoDxOPxeT}RMiZ3PJnGX#F4#oeB_`Wwy9w*-SlJrT1?TK~MP2`6XYCW_z+;!96fiu0v+2s6%N;+=)71s{;u zxs!NnNb+gKw-DdW_~XP6GX5;_qr|DXI+ug9lOQ=*&pXAL z<7}kQ%ZZ<+b2t^p^~6w;*c%kc%66=v0#3dGk!VoD#iZ z1;;Sojxs)t_zA|ZC4QRm#l+7szJjMm);+cZgRJSM}ki#Md!CNW7l$$zTZcvx)I5h{uVmd?+N|$#^O8T};pWi9b#p z+z`h-#Bn~0hvE+qf12spP5fEna4L?ch~xYh55>Ps{57WM72?N;t9E*VIL?dlQ2Y(z zr0T=IygQrD{Zjl?qH({21dA;wKniOZ*gZ)qXb-A7K1J;^&FOuqcklh^JD;QG7q~OybJ_ zuMo%U9y}C(mH15Js(t;CcrN1u#Pb8S!TspG*8O<0ZsjCa%(3Mf^3!HxfU__{G7@7Y~s0$7ZcBC{C46+jDL{$ z62?D7yp%XKV`m5PC=35-;uVblE%CLCzd(FF<41`%F#f-Zw=({F;&^?m=i5ZMUd4Rt zWPB#^os7>TzMJu7#P%^BZeu{W0)AJ_ra>ggYg*@hG72}r^ zU&nX>@p{IW6K`VtPU5)!p{KWz`2CFEPkaY)`fwg4zKikC5r3Sxx-Nc>_>+wH6W`DH z4~Rd__^*gROI($g3k$87Z-*J5M*L;sRK1*QiND79V&cabUqSo?kHG z`Y`c9#-AXbN*Sj7e42PB<6k2_jq&dgpUL=7iPJKbqx=~pUO?d$pA0vIFh7?tJy#Gf zW#J2nS1?{md>!NOC*HvLJ;dY0RX#jG{C*aGH}Rc}KSdnZz3@w@5i03n&2@BwupG8d1EaFQT4-qeA zJVG4T5%Hi8XD#t6#y1gP$M}Q9>luHHcoXCMiN}en^nQi-{fxg#d#T?>KGrolQvy87IeweuGH)@IZv+!GpA7y+e@#BpDIq^=o ze$~tCIpVuuK7t2KgT?VO@h6GXvYm5W@Kom{t#3yu{4a?w4a@cOliQ@=zljH*G5KV; zA%g4n&b3u}7!tBw99IaQ;+!P^>xmZHG~?B^n_@5JB$M~0sH!%Kn;&H~05$|OD=frn0{$IrR5?A>- z1#a|XJ$#b!An|>Shl%fJ{1)N|h^z9wi}*ptn}{D`{2}6fjDLc7KXK*%=ZU|@_#xs) z8UGgXV~qa?@#DnRc=~JNCmBzL4K0{&ry0M5_yFVA5g%myCgN%u z_&ypR;WA1bZNzb%01q0*oR0{e>I7-L6N4VecMG281ZjZn7qJ}Y8PXFZyYn= z#=-9r&!F*L`S~;A*~Ha&@fPuEEPQ5A=I2Zneirc{<00a?OizS(J`2B=cmd;^h!-*b zAn{`2sy;tPd@1AmiAR~9uMjV1{8i!=#8tlikoZ~_et`Ho##648`L>?%>BQ@q{yD^( zSokHx4^#b7`h`&Z0PQ_6{e1N#BZyzK+NL=~f zL_C!`m;mXyk9Y?0eBwKa7ZJ}T{wd;Xi3f@AC*DCEx><4j1M$7Y;Zz)b#19jPBHGU+=2BEJgE4c zPY|C*9J*_9>?2-8T$R_Ch*uF;`F5CiCvoa-oL7nCdJi6oA1A(#xT?=TBfg)w%Aa$@ zpCzvHKL8aE+t*>@%KvQQxDJGe(sKpzvrJDu@pFvdNc=o;Ro`wSj_W{pq{t8FF5>x& zHxMr%P9M&_#G?dMK0i#nf$=@WcM^x&bK=-fd@pfTzW+%4Y2rZ&{}S=nh{N<-9Iq2U zO?)=-lf<*BVygD_2JxB1l|O$Zp3nFcP>AKVgt+Q|W)hDQSM}t2;<(;}htj{8cmr|O zuFHsbF#T(Z?_l~j5`UbyswZ2C<2n!?%AYRc&ocdw6YnFg)_1M%Zb&)12c zBCgVVl=wLo{zt?eSpUF7`Tr~8*~FFqe;^(tuJmVKBg>_L@ym!WWqPh7UO`-y<09hg zh^uieO1y!1K)UO^pLi2-)z5Dr-bq}Ir(1~Q`V$^1{0`zz5>J(4=aa2F39Q#vxn8kq-T>-VZp~VZf2ec!uc39Oq)jt7LFz zCgT-Q5Ac}H_)O9~wdqUvvI2G=$ZHeCP_od9+uA=n0Y2uG5LAl&QS}v3xz! zH2?u|W(-lzsh|9Xau8M#A%h^KrO*oo7IGlP6@HH4ENPUN=9*fXZkJwbdA?uAk zH1V6Psj1(DpyNqPr)SJa3u4pQ_|me|Q*WdNv8n!@NXu@|n2{F5rm^v*Wv{2+NDE?9 z{X3DCeV#EREr?BH<4el{PrZ>A#HM;HEkluWJ@9YMi5p+adgN=+k(#Z45E?X&7OM3- zppm+eL=#qB6$ZxEKLm%}RaF3Gy^lbws{;EOU1TEe>I8 zY@K1BXUeFkh;38RF{Y#6Q*NXKv90{=rQ@h)%18%d+tgUoaokgGqyw?7{OzUVq-V-V z2V&b4q$7RUdW92OtzMn>lpE(6@lkKo!ks#*hd z7d}k}v5)mJCau*|ZX^w{kMgm#kq%F{Q6`9ebdS;TPEWbvIAR~=R+&^`*C9(olTC&4 z8b=B3^n5WAirB}OF?I&KJ>^D15!=eC5#h)(j&$txOd07wY?~TuXRyyxZlnXTtz2G& zbWamq^f*#-z%yo~1hH*wtSLF@DK}Dr*j8?&M9m^j;w<9DK`12isth_5yve2p^dOv% zbXA5yaKzrSJ8?-C*`2r^Q=|QQd$bpbjrOKPd7vHFTa`lvBRhmqq(gf(hxS?yMNS=w zoW?7Rp2#VjPuv3qr5W#uobK*wNcf!WsuY8K4Ya_8^aJ~(-2k#6If1R&u2Dqvx?8RKI%`tKAh4iPEeRy22{RWUC-+ z4%*c(a?r*& z1JLf&f=qX0C-i_jw-35mJ65fN!Zn7RC=6P-y+HNw6>v_CI9ZpAQAE3bt^lkhI@>Nh z)%y9!KzCOZ>#$r`RGpJRyjwARS_=j+8>PxZ0o`?HWY;l@bp0p<*0K{%HP?mx?ykOsMwO!i zG1q0@^{&C1087WJGV}^9(cV2vAqlXuOyb1KaFv9l1zyq7j z`cwR0Lql`4vRVq~Bh(*^A`^V*zl{XrX(GXA&fl)=4)tgKop7K>_&xM$*58RQU;o9d zl$Tx~?Cv@Wc}OYVgWrurOW(V@j)6e+b>akz@D%v2dV%2h zzgdEK3MB}&2ZJPBrRs;%m3<(93uF46+SLi?s^~`0?gjUEkUAfSLN%L35hj0q2x@d$A4!Lt0;iJcI;! z_Z1@NV9u1tHPsXaVog!@A}M{{T_@4?u0zniWIuxE=zT5RaXZp=nD{uV<8er-ULA1^ zhC)D`CIu_vmmDr zXa^F2*x$lU)1WJVa0DY5MoY$kXGA80j3Bm*U}5+tLr9X`A{q277_%V6{uZ_mruZbn zFoBx1L^x1q?3qFrV#|cc@iCW0hG)Sj3&j2wZkj%dvcND}GO|4*Mp+=XjEt`=ay$!0 zSs?beF!r(tdM0EduvJ5?Ma)gW-L}TQfh8dC?SxP;=IoK};q~a(f1DESo%UEX>KGDTMvwRl&SyRH64bLH5v51|-E$IL z!6D!;K%!JI6Cb^aQ@@9pXO^_EeK6Y|=1dc~!A2V&`aKgy zc_8*TG3G=Z^(+{b3bDV1u_xlVXTnGXV$(zqm511R(=%-k<~Nq?)sVAEWRK!5$00F4 zj`qUn(z_>7=wd$+PPPxcg{3S5`OX85i;CjE-y`Qu-%>_wdao?p^l!HDVZ*+H!oV+LG098D4oI)Mnu5s^o+gq%?k?#h81d=1RNLWuKMb0BY*+eKB=_ z_2S-P<_$%tq6`1hydjZX(A?d%FR^}-Y|R*hs6MeD@=sRdqwr1Z6Y*5mVhobV;vUhx zcXu5~*ik*1K)esElcTBcfG6fXNv_`Wys^lb5g<-DBUe$Rg=7PsVT4tx0?&w1sSx`b zF)GtZI|l@^b3jZ6pf2?O3$(&t-U~ytAR^y@Kx>1Io}w?pGZ<}BUxGiG-%{gEF&2_J z-U!4jnIkV&Ev&GA3v=Hy4`G{T_uXh>O7ji0tj#Kmy__+!AF-7)A~AAV)tb7RM%c>g zQqPEy{fM~{u|f8M;ra`ffT*Y2NC09V-E_yM7H>tcY|{4NGWRPy6NdYUO%rD(fnL>- zV84LnavC}m)se)rpm=G)Rm>OFwMG*L>cYQb*#irr8~UQ_XGQw1cO~>|}u6D>XaWBiq3!(oUXf2TzmP$$?1vG$1&# z9gHIF6qt7KG?|?|h%`$}Pr=A`Fp9KOY}&!oWOkN9q^mVM(UI+76lrIvX$Mb}*{Og? zdOKY^vK@>f?LL3Vl^cv@imzE zng>fO6{sCM+~?McZ;4qboG`qN1r318HRgF%FCZNyVo1p9150@;Q-K?}?& zy+rS{4Pg-55au6T;M;}-VuoPR5Q5`oqz*IBPs4m$?{)@8o}yzEndc|LF)h#WG?C|M z2LL3^Idd~S-V0Z3C#i0V984_j!IQG+-KZA#5_J%l_fD&vd2T>_OVmL;mvs=s7YK2e-VsLXF)O zwm)j8=ZcXfh<#jv#1B_%SS#J_={71QVjtaOu9SN{^+u&c%+-&xQttCC80Cc6-@WT-D%2e$_rzav|xTwkqw z9G@X^x>Lo?>T&e8eV%_t#YXJo-ZHhq{&w&lMv}5RclGI(dr}rve`u^;DoPvv;^DLAK|YQK1o!*)N$@ z<9Cfs5pq1&jK+X?)ULe~v!u)=C6oD+}ON4(Qbv_Javm)LID!v6nC~GvI+Y+mJxE zp*+x%p{2RNHiSXAA*f1d$^Y2|AyK8wE+iU2nNL+hY?ZRmldLKkMp#v9^^6!*39+vc zV|PP^op%D+c~=bj^g>z+=d5@!2+uq5Q2AQhia@rND5!w9+<3LJ!nT4zxD}WS;}hmt zkNyp|hbnO@st%meJ3(+q-+J2*fw&)Dd1pO34T|&(E;U&LX3__yJHSDoQb)`SL_Bw# zp7qG>u;wz10rvcQr)R(@am1#9Gr#rO>CkIbCRSs2da8}F3bCnLwTbc6*xjBH!+*rw z$e3Rou-DUVBml9GZvPjcBubWL{60^);W%QhT=W=TQxgxCKw9)VS&r|i!FSYr1w1wT z=DpCf>x;+x5;q-_-7~@{VgVFZH4lJ4qJ=zn5WZ>sG@i;uO$?&BESrzdg-jwVSVidr zdp?yMv8H#NFKFoZlpFbs*hjgZsq}(|wU`6)UWgh&1mX?dxP5Q{)a$zf4#GJpNtWvv zMdkV-w220u>w|AvuH&i9bqt~k1C>}DkNY7XvaT#uT~)Cj~=(+f3BJ!agC zk4{_NB!);lrtUqza5}M;E_V(0z96H&(2u4?qK=Ahi3M^zm#M-qiB!?+Cd7g<%t9W0 z1rl}Um`?{fY(I1qGS;VhAx@Zr9upSI<=8Cxp{z&z-Vk9LVx#AA&yZ2o5Sxb1h+Sjw z5En=wHO`qfxEn5~Iyfwvk8zD}=2-y4lTV@%o4!Dzg#~$4Fv84}T@@93MvMd__BEp4 zCJB@lz#Qp_SXRKkqNfYb-^Q(hY;TGzdvbIaR@M=7M_~~_jzhyO z^0I=@@zl$FAoYm3`f)Cm1U(DJP=wgu!g!WS@;oC(aU$kM{-jGK1)d*9ViAwpk9X)I zx7c&V$P&apu8i&0z*0}QQ7IAo=pJ*WjC$&gN{N`OA7`bk@GKbRgxKH0cq-*u&xlb1 zh`EtJX{B86`C%j$@u>ZHhbm=*=ZcXfh)3(npY+y1tLL9lu@U?DH|C1n;i)$&He#-R zoE5v%vtX1pVt)(csn|O`BStAA=0>1mkF9Ij?ddj30I`qmF_*wzPrXqBh`IW4mcTyG zf>8p9{Vj~A1P*vcj1oZ1jr>WwmV=%jMq&|<+K+drYdPe(Vq^*8QM;lRb>GQb1AU%f zMukQ^X1`=sy<@iq`aRc-#(;R#uDuht29A1u7_|uTsQq|{YSD4e6{8j*9Pt z7l>cu!z;+aLwzAOJK?cf>%bt^wLfGW*u{(+5^p5yk$?B#o7FIPzwi(EoHo3S>^Q!M zr(66m1>|-HoZ&K<%AjnN4!6y;_c@FrGvy?F(=r85AycTFq{iMg^ivxK)pyRn2%G;L z{TD3E#j;{pt1+|?LMfDVi5z{OymG<{yQ!gy}H+&=#HEe zKV$LWCGg`WS$`Kf*&R7PgzThvIsb!a0C)43%Wi}Rw^R$w+VLvLuq({UXQ{~zMp5xlWs) z4Sn1pwL=Zxl>ve2PQh4~I)mVkzAS_NBP>K9PPA*e76r>|+Xq8FI}{V^sIWm%-=Uc2 zDK|zU#9X<2VJr+g_JU6bB;9*+2tv;YY}%o2bbbLH#XhFc-y?{4$dOV>&LfS>yF{uevvljZ%Or`xEM zh%ML8Lz_zRX;TU1s6*TJ>p(ZE=Q%bA$QQ(x^0WSqpH1d?hNs)ebHqNnljV6rJ5p5 zLF}V@jCsD^Q*PurVoUj;-T>fL63`&ji_h+c24TJREONdlavuE2dgKR#Fm%#%Z3oWu z@d9Q@4!iR29-L00;c27$*h*;>j5 z2Fw`fyAfMiGUmxv)KhL$6vSM)$QbNe_;6p>Ys`e$WUIonU{n{x{uahQ*;?zFFe(jV zZsHxBY{9hb?asFvyxK1F2LD3QB4&=ijrmrqXGG=>89{6sk+n7jCPsCASk8ZD?!W25 zXPuoCcr8fXE6IkE4$qcM5Y<)0!`PDD+i1+Oxk0CA&ZxbJO>@xf#@fy8^mNOl(9nX| zNB0=Jx!s;}qsAh(l#g|2+3V>x$^fyC?lBK7`#kkVo+Gx@k2TK^c)E=|N9?0}jCp?0 zQ*PurVy4`0J|?^I6quCNeP=xLGS#@?mz{=dTp&)`xDI&5nbAokHc=Eil>Q*Y!s zVoUv48`o)1w~^WcQ>eKzs#LwL900KWMUb_ouGw{n%%f!Uw@tz-FWLp+yj*BHi3(U~v6 z25Olsza_j3hzd)1_`#R(?gyq#DZB7oY!8CfWvNh~Rqm8XEIsZ_%qo8c%ar4oRj&8u zOh!dUY$i|W9^(>TgQwi6#)!G{an34RJqt!5pxso;H>iPPAPHw znSMo#*#lEb#LVlrF{RA$jL57ZBZ!%iu|NMF^mH2)6S0r(WIb%+my_6(G0#(PR87Q| z`my$~1)grBQX=-zJ;olk*i&v)N5q!$lm06}CzDOvmwLL5JV)%KJJ||QLOq*FL_PIJ zo+Gx@k2TLLJl#f~Blgif#ynr^DL3*QF;nh0WfTvB4ZDN~Z|_h)s-P|54J8&Teh2p_ z)k4Ki9MLX>Tc_qi1r8c0`4-+T_1>j!U!;qxw`3Kd)9dSu3V@g;lq@89MZal;RfC!`&$@KGWL2#jAS4-jaYL6w>z?1O-G{MTbV22cQ^hO zFRi0>GI6+y)tmXx0`=a#+jpw69!gzKRT{*%#4dC^ms1rCV|oOOVv)YYPXXhtZ@5Ey z6yDY>j2-F9hD7ME=(*mVDRBZFavhfj}i$RxYJ-?BCfg%FA%?f-xJx} z<8*f&w1W#|2j7Rm`|RKXvEcHKx_;a9aMRk`Rv@O!y&{C1 zjz+)g4DHw+gdpPOSnv`ejPf-Rz59Vqc^`kLb{~JIsHl-nt(MXr45vGC=t$%+w(p+E zA)FMifrsFFB8Rv4O^o*JLFaldyz!+6FMzp?IDrUfe>qVGfUiA~v)z$C-Tz@6l}~tJ zZYO@f7G5q0#RETKtL{klMEbfTFN1;ZNPiD}S#$Wtm+oKG6M@HcaXg4h{i?VHV&yl4 z5&L`AybOLHF~W<0;qTCXkFk60{m8BK8h+>2@cK37^=s1WTfu?@KI@MaX4q-KAfn8) zw{fX7yas9b>TqdD6w6Uz{a8=rsIZ>3s~N6XdLqYq*7Sjr43Vz`zf1?x9T~uu7dZ~Q zCwkT#gHf$(GSmQw4;NNzj>ETVkoP1r5YRlqx zz+b{KDACT0m)*bkW$plc zhg9|ZU)ezY_W$`9y!P^`b%?DT>xW$xlYDknB$Tt_DE5>a#evvXuIIm8^w4vnm+qm# z806F2iXW=}BNW4MJ?;^)I|v8cA?RGOe?5xV1)qQ`1}NC|;1tTXM-ESdjP6-;2!&r9 z6hgdOLLtlr4!-h@-Mcrmw8a+(^Jdr2SsYxwrMA7Ut+6#8yn1$huw_Fq-Vh7cw6)c2 z3(js2Hq^8Sx7IXmi3Mjj)d%lwXsl}pHnsXYkFoRj{_vXxaOD@B|N{=K4f8R`;T|Gr{XIqsqpoW55sUsJW} zmRm5m^LD;lKIp#bKIq?l{Nd?T`K|IfnU4ij4py4Uo{F!hUH?AOmHE12O?egOh59Tn zTU}MXeAPTvcSqf=cSt>qD%T}+(w5d;(9#t+Xt?G02@>OeALh{t-43P&@ zARn@zP0es*X(aS1y)&qsRC%gTC0Cy_s6IqiMk;T;%W;x@7LY#WSK?EZqx>A1OOF%b zMt3gDesp0+t6S>i{wF&(ZI_oV{{WVw`Yc;sUV{EqPpUJ{0uEMEL#mD=p^r+93 z)K-&yMk8gnMxoxRPgPG8b|-G>RGaQ$@?pr@47Did$M@SPBM9- zKFjjfb?V<$J5u?kK1V7C6;6G=)8WUeFIhP&uJX(7hcdlB#%@h@^9zn$?&kDGK{Vq?*0eA2_{Hr~$nwQC(m|DSA(RQxU&XY~KNPow$%c6`<2 z>OSLl zIg0vJT*bwBimCAhEmqgExwWw=CRD5_DOOt@F znx?ufO%McV<%-q8Mle>@xH%Stn8EtS_IOQmT`X9qLbWu5onU*c4ig)Z7m!R z_5MiZwX5fNeEA(~%BrgFx^}f9aBT_IqU6>{u)J*L?ZG^#8@E=jT2m1u>_v5!uUb)2 z9;u>$WC(1phQyRJ`u>v2QnXRFvTVhg6~Q}8D#4xQ5zlBt-P{eq+HJvG<_1@6X^Yov zY{(BrR+r3+tX?$_@@M%i`N3Oj+UgoGhi-}0wr#0t+ZHTbRJ;J}RmL{N+G0?qP+hA-l6N*4$hZTpX-u*w)@y zS98Oiv9_j~jrnM9KGu;C+1Ogs)(GnW!TOqb4OID>CJ64QS2Tx`=K8i+FdD1dgf?z( z+JcJ~C3Q9RvCWNj!HO-lO^xjhv9@+$X5pCXQ#1PA3@xMj-j=pa@VzOv71QF|W}pSD z48gQCUSH@08|$}hMjfya6Nlv%j2mo(HYu2BkWNWeP+svvTY+ZYxOvOwL{r*;YcGqz zUL0~eu3B26ZEEeSKGqbALzi%!cLbr!*w|LHISB1|b7M1PXnn95n|M>xwz-b%cc6Qz z$JSie($WTBAPnX+9;Uoa)r4SsylqQed`p|`eH>>)TgztXl4|O!g^qUUiy*@sCx-o6 zez0wG`v*h8n}R}T6)ZuiW)7WQysfcAm4`D28Ya!5^G0jm^wCU1-n^Rp!q!+}(cJm@ zHS^|p{m^iE$>ZeJc_qaK*f7EvEwLS{u&Z$D14}M+9*vZgMj*I4zcsST`@XVd zMFgyP=dd^qbD!l^Dr{BRib$a*hbgh+z^rz|+y=*Khe>ifjB;~f0)SykA@Iu8Wvf;u z{O0M<{pPl;bjX>Z=Nqh0$#e~8SG5E5=LYznSKOdbeqjMrY~=FrmE}PYzwr;b%3tP} zm&W1zLc8j~IonJp!y89);apw!%!I2S9AmEpge(L8qa3eo@IOv~G5+Q7ALaN1?26qA zBntoW_7BSN|18Hz!_N!gKguwS3XkXNyRreB2hesJ+Cn`_u5_ae_31Ly103%m3V(T= z(f9*Vy#v#y@&x@s-%)o8{4WN}$`@?y0%2zUAI+)oWH(Mpj$rAAt4$%E-L-wz}$uy6W1F8(>DVdD{(*Fy*h0ITviM zX>6_*^Ut}rz~yN?)|6K{CwL3ocWi^3hRfx3X&cNII%4g?%9`elvG&RsUNLTsVPTz$MvCcvVF`xG)%n%jtr6XD{Ht*!Odxy#CLM}cv;sn=z>Zmea4^YN>p$hIEc zm^$ZL*M-YVoESTMJvhsCVYOxYBT*g18e?l(p1rE_2;@h&1lJH}x6_ z7%!yr&U;g5U+lV#&Gm)OmxRsZ+frvwcHP8vg2a6frq0fQfN=`e|6pqF%`%uEfvv5n zxr-qHUJqcDz}AM;+=Z@t&pi|aQkZ+aFhyWsTWW3|fJQCA)o_lpMrriPcxo=BAFop+ z7~Gng3(0AUH7gweE(JH}^emiS0vSf9=in4l*F>j>Kb)F-k?U@v(?f7N6&zG?!5t_P z=}lm3JoRcg+W=Q|&S5h{ue`u@Vcy@|?DU(0;Dz7`NJ!z)ZK**}0pWgRhMRRI6kn`y zV?*5eC6k~7aP1OnbKW#1SImJpaM9K7q(Ga~iuVePQrA?|-tJ_XlFK2d8f%>(qZq!% z$v5fDOxIPHb;YLWGFZ#s9NS#m=9Dr4#c?W3J_ED7u{qY@tTP3dg6URRgo$r%X$m>_ zn8F+-Y^|?#;->5pC4(mDJZQ?Mlmy)N#*NK21&KxzxGu$Q4CxhX;uX-gV0~swyR*}b zKXE!V!?w1%7U&RUC4-7O5i<#BOPgSUt!vZ1o0aOqhz|a5t=95C{T|7yYg^*+7FqEU zrQ@b=BC#}H4UV?J#pWjrAKdgNBUG$ig?rKr=cJ`(rJxtpxRzkJ;m%2Mn{lyC);`?@ zHwWU>;QE(Hj3Ejtk!=2k3{A;AG4SFP7gp>x`$V`1Blz$_<(e%EWI#zZ*F)~K#hovh zsZ9@DD1@=*dgmY)T?Ha&YOPJq^IS9|#ci*HrG~ikG83ghl9aXT%{8sgw|Rh>%Ayb- z=i+OXRU!Tf7l)K(AwFx0owSq-(p>Dc3(bhz7Qo+ZLJHEtGF+YsfXxwSA5 z(NJNC^3$M|#kPXbj#dP=YBt2;+qej-7I@blZ)t^ihJS&qG#3^_TUvSTanjPV0+63j zv1;n#MjSUM;MUYQzc+Ir-MuW}*48>Hv-KX#O?R(=&|5ZccCxwPYE)D2T+aEmpa=MM zoL>*&TU(uloX>;sz)Lv~L-<(J0_P4cC>DaS^Fby^%@4S-j#gL_!oEV!_S6tbLY621 z*#t}4HopjXoe#eRIOJ>f#x`dYb09DavRpQotz2{sh_JEj-~z~&#`v~Y=y$lJ5GAoD z=d)a}Kt^e6vAwANMZDA#`oz2ngzZoZ zt(pV1857S1PFgl(S#3-GHluA#fwmQEZFhdka$?F%F%WL9ael)kU>Sx;n3y&?LtJ)U zz-?QIh&e5s2a(r1_j8^L9LlJh^E}M-R_9ZkV}H=p z+Pc7bic7FR07=+6$R*IZKmk@`k-xxYOTj)0US)zT$PtVLwd1?u#_E( z*EJY*WjfTAt+h?{t#Wdt_gB-QBSBGnU4e7T)R#UTYGlo(Rz60gPsjdsQ+u8BYaXEh z1hp;A^##r!xd`e7u9DX^)HF74uIaFpUV{As#>ItwXY#d1J%p?1taP`zW;4u*wC*2lEA!~xWG1g+Z=jKdsTN|yMb1$3V z*56y>C%FT=4?&1k9@DRvt*|G^POxWS- zm5VTy8E^>%ceUEggigzV84?aiJv?91vnINA&GEJ-GeXWpw>Ab7du}2<0O6rmRnvOi z>A-XlHP_>X2JeegAQs#mg0>{C%k@|(5DTJ!)Di_QpXj!1iTf!GbNd!+ zzLV}k#>zsi_7#T{;@F3H^3&bxKn&&X8#gck@}Q;`w%>1d3Qd2UvW+D3smt893g)rhSE(HHDq7Z(X3DZGqM+Zjx9G6@&+1<7cCC_ll z<&)j}?nB8TCJ9_K879z}7vJC#NOB|Oweva`Kp8a44Cn1OFdamgBiTWU9zu_|Q5c5F@|G4KGtK$i%r+yK|8lIz8=%OqjpK+BR-;f?Sj%MDbcDpGgAKL4wP* zd{9rj0;9w?)YLhPS)8=lnQpu#E;{R5m@EY>kqoc#Dw#L{&bNU%*umx8&1C72*k-kI ztYt&Gdvzu*e^+B!^0CT=NHFKMM-6vcrrX-o60i1`Lh70}wzYD7PFkkSa&vhm9h5ag za#&4DPlwbtHP+qdY~*RV9Mb~(&zv?cfy6Z8LhVPGU;+uMA^V(NOqgDXhT7w>BL#GR z#*|`(&V(ukTY=4*a*?27nErwpB|WVO3Sx6R)QCe&lAZ?+*3~&LbDj^S0NbUUqf9Vi zBBZswy&4>Fe!yi@L0Lmf8_G0ejD^L||7_@4`8vU(v;~^1T$|t8kUrB z&|Y(%at+Avg42$bkFn~Y=Gmg~6!#uzHMRg!br1G7T;iln1K&5;*RE5cIKXFdQF#HY z-%~FK51OTH7MDSBKot}53b^csDK6GBAuQoSs7{!G3zmZg*3*b7eW#s_l2y3 z%PyHBuEF6tLdd(h{A%zQ##7i9_ZLibG2~_|W*OrbUI(7mwbj6CL49MJ^E?w@1m1|^ z5%#{#q!-QyDb`6L{V|t9IwAKq;7;RnOm@+wkdn>qB3|0{W{-2xm6Qrm2d8r>Gz3f| z*1+OH11} zr<%))q+Do@GvTEf31Ol0Fqd8^r8r@!ah~8(=qb==AuV*C=HhD;s^d-{mljGXR5a(i zOg2Mv3Z_CZ+Ba^79W(XLDIO5o26_PdI^hOc zSAd`~Q5?Jnx?%>2MR{0K?D#RVDiA9GBwYj$CBmh%An~5m?y6?t7=_wpnOL#0m-ECv z(V;nc+N};MeHJtrA;zrax`VoBM!8ral^0sUSYhURrnn_1?OG^+)|xiEoy-Q!IPn$@ z^E$IY(`Q4CgOO0kmT=iTh}hC5WGlFAp^()J;Rm@8S|$z+LfFcL*IWSoxg0Bn{G(hB zH3f!CA^S9!T_rmwAw0l^(2Ky3DP+%c8FrP_cYn*2!5zh{3t&Aa7Bl94ft(A(npky% zbHa>}9+-UrUf$PM!#zdV%E2f8E~vAs0_^2T4V16C6`w=ME1Kg3GEyre@U?i3Gr>g_ z8Sa5;5GD@@H-@lB>6!BRb`&o?JqN#FK2nWeB2It^5g z;v}F4OPmBUU`vuxFye_!_Qw;c{dk&;uLS0qN~~+d7?GMvbO%SD++?}prBw?sS~gr> zk0BFfVHtT1=}IWzCkanebPxPaWHDfbS+Hc6;a&`nf{7{&+uo|~s&G;!xW%Sm)yfDw zb>p}b+&fG`1b4GKlP0*0CV#);($>XZX?nJ*%BmvePKBye;OD0%d07l+j~i#AYRD`B znR#Z0w8Y~8!V~HFAmmTT^Gh>4;#bYB5yOryfM4@Dnl~=zghAPz{o9^yFRLBd|H+KL zIKw@aNV+C5LTN$Ly;2rXx_c@_YSgI~D8o(k5mLW&Nff`2b*VyzRGFcv^S(mc&^$2D zF!m%_-B+!t64lgk3BaIZ0(c{b3Gg)_CV^K@ut=b#Y^50po{TdAwlsKEg$XO*Vd64) z2-cx(FRv`AS{^MegI(py-POxsN2;k}by;bo!bFgUTgu8KiD>YAA`5|b z(dk4ObOo{}0hX^WsjggBvhsElt&T)WO%jE-kgTe_%Y=4BB(Td}B?Z;v`(;Xe5DSJe znPcF*84tr$S4PC6e`O!wF0L%8D!VgMZN<_v0AGG%=2GP<1|XSc2mqxfS+;5=Bao|= z@GPbo3_4d6U@Q zCL#*77Kpb^Hn24cr`|T%z}6}_#odu2aLU%h552eWhS!hpExcjHbv;qB8*rZ2o5;4)+3?WExf&E%0|8L_CqtCx$ri? zg?VymNv-n)K4=zLj=u1A2@{$NZ*#cRSa@5)rRKuhDlRq_-s-qiTX@^bWJwp^KE?yu z3vZw2K@tmZFPNhD7T)Z&wRhLT+drEHYAn3{h|9Evw*fBG7v9`zv-!-{7v3&nLcZ`e zo6EI@x5ZqhFTCB(h1$Z~-CU+Eyur4hG2ESh$PBIDo!`Yp-rf1VOfs6g^Iu?b^tMM>|@I~UySUI~{uxJm(+ zIvd1Z2KZ_mZsyJI9C@kJh;Q9U-MaUobYOEOyGOEp52a5*Wv~-QszIG8TMs@oWu-gQ z#rt@03#mq|ZKrHKfD|5h#5=bb4ljXLxbRG2+ZOfA;NXKm;32Ta+Sq+!f0(>f>Hvz@ zIW-!KPbqf`UD)(=A6@-C{t%Gs;L*8;8ts|H2La~7b(a=%Eg-lQ+q6kOe2CX(Z-;?w-YPc7;4_`}<8|9$pW%C3arNOKJ>|WvxbNIn++jDq zMT|P@>O*TK7kNYL2bp9vLu(U@qYteeOvZ-R9Zakbt&cLo1r@4XwZDTn(*(JN0hYP1lFkDO{!xtvOt%53Sd5 zVPa@4;-aKO>#%#*mohc9cYP(tYVZ0wE>L^d@8JS%?|KK5z2ke=A7%#R-t|v&s`joQ z-~zdK{i`M()!y}2%{c$h_pTo|{TcZY+@F~d)FZgR%8Br=q^2iJB4$41a}7K z_=p&6{=1g*dGZn5BF@z#xFuYm9>HD71pn6`!TmGlfc6OP1};*M;KsQCvPC|E`%x}Y zkKp!l!6+ZW-OJ)>kKjJVMfj*4Y&5~`*I-rE+4_I&B_!ENH49>LwlIX!~=Fz4PQxS!+_?-AU6T%tXK`wW+(x^|AC=9ydOqqh zE>O=$UBds-aeSyUzD=v2oYA zhfB4)&VRvVN$)!U9S>;Vb^d1_ByrdIr>5w=yUy?SyUxEe3)HylJb`VcnXTP*&fzls zuJar&)bBdq$b|f^^9nB4?mE|UnSR%~oeQSbZ)^h7zuuUCyJSQFp81^K|^906Y2P2+XTe07J-UA=2fQ(OM?}(WwTcZ)oP{2~C_!C(^i7=yk+CVz=|NB!6?``GB2XMT7^x_eM_qOuG-u^_MysNhI%Mo_cdylA? zk3YOuuiNJ0Gcxb;di_7}SupAHbj-#C%scBydmGbobIr*P^wMFKB=^VPRfzm%e| z_(_#O_gnw+R_YHF#NRHFvG=5_aP(6kfm4{0V+yNZ1d*Zta|VSLKky=1BP^BRPi%-I zCEq=~V@FYOpdrO|OM9b%XWW#48@L0{0>PA2HxG_E9f8+eAokxo0%tIMN1$KG^}jz5 z)yev<+omZO|=n9}u(?AjUlIkuwB=TAOK_6Xr zN8H$!?psFl(!82a;=^uX^?ai9ysFMI3p(!ibYB?rpm z!>-DZw!FYCkQFP6ivr)nU=2?u%wbk9D#{B?09_)>)7|1H0`*`nwl`3VAG_#dQQ(r4 zY>3LsZ5qzu-{0Kem4LmLKp<+k=B1qC?H_!%j$7_KvBgXoe;_li} zigm_y=g*E8{qr{i-%Lrl&kan4hsXmjpu)i9lvX^Sir*StcoF}lZn4%Bp*O@1ajJV+ z#zm7;GG=FFr$cX<>r9^fJ~)N#xO3ebCoh`3c=CeD!O5Y?WfxtWnUXOT9(24p({WOZ z94QPz*s_ZPli;^EMg5Dq~)4}%dWxb8&I1=nd;I#*4ZHw8L}3msH4c``g7Okbhf zo($I0&^p@IEoY`VQc!l$?PO>Q7!qL<&Rn2JH(ht8K~ID~k_yT1$j+RQu^Yz(IF`r{ z?{9WYeoak<&&>4fhXbkLqq99Db*LVff1!cF>BMx%HgWLy>9ZuaeborYH;{y7^>TbKN1F0ghqIEDt^Ns)~E)-ChZh|F00yE zT~%3LR#j25{Pya?P@&LtFZ|SE4D@{n-saLSqHlnW@A#9vX7KPLX&8RO0Sv%P^>kf@ zQfTO^?!cGB7@-y#r$t3h;`e{6otD;EGrd*`UgNV_{Cp+wTwtEgcjnf@8xyNTjZFm`np$e&tu=L`@Ri1Oc918+-egWspo zY!@#w&Wc42V2PPop`JfC;}#il4U@%22`ntuLoPH5aiO7Qp`m4=p=E)gWr2~`3k)p_ z3Uzx63@sru;(SBte8aW*hSK?lYx51IMTV9lLklzqEyIfpEky;+2Ke!5cr8Et0GS>v zY^VquX$>0+!y$+ZuMIV#hm7bUBYMb)9y01p$ndVvNL68x)7}<`9u8hM>OlWg2i?%U z9>8`a8NTgMymU%SwOPybgf0{nt*)sB-utLUF#I0! z@auZHFsk5N&v9%JDzti5STx^83k6aGYJqW9Xax@!Tc}9JG3?k8i)4a~P+?ow0vq{Q zTx5lsZ#yyHc4EHm#C+R{`9-#RJLBftuFjWvsi$$i?frb)`vtc53vBNf*xoO&yf$jYQ+xrE!_X}+A7uw!0w7p+wd%w{3exdFCLfiX=w)YEd?-$zMFSNZcw!JU5 zy)U-CFSflew!JU5y)U-CFSflew!JU5yY*+2kKU8FUUu1hxS-iGY)He`>tA$z_Fx#chs>}&u!il?J#3HeVS98B+oOBf9^J$C=pMGO zZNv6h8@9*Vuszm>?Xfm&kF{ZYtPR^^ZP*@b!}h>hNJD_Nq#t%Rz;E|_$XMnKFErNQ zi(tXF{X_6OboB0@>fBY!;2p0pWeFwF+O_8SU3Z!16_p=|tQJUbdSbvd*BZs>XrLm| z*crlMf*~B_7{ZR0A#Cgn;XITfoQE=m^H39s#?BDVq8Y*~0)}kwMPp~7Z0|*5XQ6EG zMPp~7Ebqf&W@3a2i)o07#59B4Pl|IG=@bTWTC7yhQ&05g|gBZ7Sj+G%1UFA zn1&dkio`U8A-jacG=zn+>z9~@uuyjW64MYC%C28x8e)bL(-4NNye|^d5EjbH`yw$7 zVWF(NFA~!b7Rt)|A~6kNq3paD(-1S1n1(Q9=e?MQuuyj1i)jc8W#_$^hOkg}-iv97 z8A?n;7_#$T447spF<>%er%?=;ER>rjQ{lGKMgP3}KO(NL<`8gxSoH?U%TcW1(!n#K6Qt z*?x(!iiN_4U?S0lGK5u$AAbcPL`u;oItUSwz~GPD#KsVy>e78zRR z8(QWYTIL&C<{Mh(8(J0^IlsWrvcSme1%{RdhL(kfFAEJV3k_e)`P)K6OR=G)*w9jJ zXel;4D>gh^WN2Ar+)7?#Xjx=vS!8N4JS!|PszG6ak!ytohLOSoLvLY$Q56acOwGJm zn3~}hyjF1v+5LI5iWjnb`R0xOLUR{Dp}9q%(A+;z7&0=W&}<=vW)mqi+eo3=ND5)Q zf}RAk(G;3n8w$;R4~6EYh(gxH%uOa?voeLv4Jl!>a)pZxufk?!3l|&N9yTjqk-3AU z$ZSwW=2ny!m^x#kA= zNy@rSuu&^kyJaKnf!olczBe^C$JFWTOu-Sgxd%k?P5(e zbH%Pc`86RYnFP{;2rL1q6U5V=O&bqkKdJ-UN}bbmK7&4SXZl?Da~^ku!jY%(c^bcg zxY9E~=OK;fLwMNYDvn#|6ZIEpdf<0l#KHAcXdLyZ19qB<15u%-=N^q?c;)}JQ6 zn2P8Cany4?{-NV5^r`$gN9RALPYfE;^uM9;u*Ow9)C0Ryy(5b@*P@;xE&RnA*Zp5a z9QDvXQK9Qjjbk~U7u0cDG(EbXTQsig{}|IF_V9wPztF$oLY{-;qTBV=R29@WOFE#ds;{`S&Dx&JtIC?xha(k4z7#cT%u1!=d~y zC;g?wc|P3D!gq?;j#JBc73p~@iJn8mm7k}VNJXbKJt$L$OP#6ma~Pb(T7GCdv?$W}mu?2l<(m1-@M0&O-(bKJQ^k*me^XE)Yob>#I7GC$~ zkjAeCJu~a@Av?$U5z~VVk5i1_Px@!mAc6U&x5p*KRX%s35;#g2-${BtnncfI#IX$F zArq%5v|6P2ubCdyjmOiBKTi7pGl~Ax3>lC6Ig#;wq~|u`JiT`jSAOmyKUEp`;gz3H zFn*Nud_Rev)5I|t*3W@jSwAmC2jSp;Uc&eZ(!Z8C&xaNkzEfz0a$)>5>3J@Ro^P@6 zq{cbQ_&L%ul{zEtPabiMh7GZk6y3nM7*IggoJ7z4#Cg6wqJ_Tz;;Zp@Z<6rO5?B6^ zJI+@b&%}hl@n4#Ly&srLot@ItDMCBWbjEW?&-;n<{MkSp&FKBW{Y($3cRs>+F6n}g@XF8sU>vUj@R)^8z`^~zLF3nekftF{5pm_e>K|?)uJT7}b)4H7UqW_wY5Mhi zeu{k)3~mG1#wmGO{D)WjZZ}f>G+7I2kU}rzn|2?ivgU%?`1qr`oE{?(d*9u3*Sk4 ze#bfKSwNYHr@Ed};=KQlV#eHve?@gHh>D2XCLzt+O*>2fZS=~d~?B2#7%wJ0w-ZPIbv<_xSN(%?EK~FkpVahRg^}p^YfX=y zZ(r8JV|`vqc3;vscGXKs&+j!o`uP3_jhBF3)!t`ZDkG}&MoIr%;^^WsE&O9zcq(e4 z;7b}uKg&ta5lxR?z9(3CweI#?ExcZD-_p1~F3hKed*#1OjpHn4d>#4oVd9uBy}TZ0 z;X6su6O1>Ip6@5o^IH~P`7_9Pob)WYOorh8tR=3}rTn>@bJFuyN%TC=!YhBi#`rGM zlQPrapUa7Jf39MDFX`EkM9)Jkyz*xU`d`;?UsvaOp3igddwsuat-bckv)X%kxUk!exb^={xZZmkxb+|2E|!36 zUdx5gLp;@Ra}w=`4Z+v*5^(hyCHj1@ zO>Ppt5k89}K0kn4Kji-QU*ZkY!o45fd~7Jl;^~?L(aPL%_XU6q{Tnd{3qD z&B%z)OT@X{*NJnv?|^%`c@(@#cy?2v^t%rtK8F;A6|Ek)+=j%t+!MjA{}{)xoOFoj zJBhw56qgJmeM#!${b~ZZ=LLB(NqDWw;hWXu!|`tweI7>tE4&VT+8h@IS`Qb3TfTPP z#^anwdOq%23~uq`P&6}MLwY_A+(h~+sj?99Y$a~TfxR=A^nA2Ycw=$$abPL9*IN;M z`jeiopIl3N971Nsw-dK`n!@J~5uX{vxgOpp9~|Ok{@aP0e{1;fA#VAO&(!I4)Z@b& z&9@P8?w_r}y&hnboF=>-$}Nugj3v(f>Mr73?!)4rN5RvDm!RCIB0iglbGh5d$NHf! zJ4w&+>;d=f^ee1Tp>cTQ_0tXUR3*;-HHn+Q`xFSD3ID^0Tl>0yj=1@t*rW+@({G2* zHQ<)&Iq4tY?nV>me8&lgP4Y+b$Dw-m)dJ!;WX|{|;ucR&1iG92J5fAMPY5M>eTGlz z93J6=;WHB4^5XWrTl9GtO%XmEK5HUA+rV|as(E5C^f*VsrwH8QIhXQkPu#Ba`#AqH zaXudSg1C)uK3?qvuaWv&eU3r7Nt5z;Y3Mt`Eqd4| zV}(zG&zt1K?eekc^Dz2M_yh21gbPg;Kl_{xUNhyqAL#+^^)nqlSC9|qH6FYIeEKvw zz^Ws;FTxjy|6A~XFXI2B=*`=fJ;G|UKa05KTN1)f{z5)D^~}Eci1b|U7Sda} z?Xq5*{{GoK7+U|~a*rX-<#qtK`oXDTX3&fDT<$>9Tam3%?j+K4xepWPa$hB%TvlTE z^DgPR+z&}_MK(pbm0N`MG~e39x!jY%Enl3XWd?th7MxyQ5&g;~BhWywG~Q$1U(-niVeNpD5gLAk?8 z&*k1ooXdTfe2PL*+27|$&*i>OdMh%$U2V2}PI@l4a;xyY<#k+moBgc^u6Z3#db8e$ z?eu)ov;W1!Ij<|l=X3bvNzd0~r;r|pp8XGM6TbKQDMeoCf0xJ>t><2($DvK8 z`wi*Y{|3^Vbx-)uAU(&wkn}i|$o$_UJ^Oz`db92W|LUh?tNp5mFc z^GyREB)n{ZMV!t*6khz0ov|dzO~P~UW;huyJkTV$mpEUScn91{>q7bdKza;~nN^L` zgQMxW{*M6n?Pxmcza#0n9WNFAOz20Fp7%SqlO97_7RZCd&0-FG=0tqn68${rKZ@wT zAw7nctlVFSo5dpd)IB5nI@|6z{$}7_KW{-_644JMJvQ;ocpT}u{wI^(tXIPSRnl|) zuOmJ8+l|7#-)`MK180k?3neny4*W$~$yD|~Y8gFxdy4P4`CFMKC_ZjbmpE_#pW zDdBtI^JT=RN{0}q)u;87cIa1!f@_@hgjcQ_)^8c{xfWdOVRA(OxcKLTee#s>FuNs5 z7Ds%32G?>6ii4r%RabZ&- zfqPzg7_}AN6h31jK97KFf0!*kuuonP-WvXYiTG4Ld;jqt3$Eq10{>NB!rP(T3nD)E zf>%t7=k5B1h<+Y%9%oh)=j~-3an^qg?(uuQeJi{K@t@pr|MgP}?ml@Kbr;?ZKKDd? zW{KY8nIpV6e6~k?YL$dFHJ*co_k+)c;1$!=xc;vay~i^`_+a?_DdO{2(dS|Gp77!D zDL5wxG@cW{Jui>vB;ljrGcw|HkLW#~`-P8z&$@`uE^ys0Ds>8xX`I!CkB9%U;Of&K zTM!=^Y&FA+~Wyrr`PC&KY)17Bp=>> z&mqqKw}We(Gf2-qvx&3MYv3NI*V_`|(-G%-@?rl?#M%F7oIq)uXMk&cb_Vx&yxw{U zpNV*eMtq(I*K(If^lQc6>tTcNIVg8W#HV@Z5V4lq16=dHh&b2Vjl{X0#}j9L%`Tx_ zt+xW<^ALY;aE)_>=)E4U7rqESuSI;`1^0Y6;&{Gc*YY@Vil2c~!7Uy>-|0m9D(QD` zq1+Lq=kuKjqF)L9FwHHZ`Q{gP0H;G%hYvHp#;;bQkYVA6V|9{&fdt`QduV1x;PYZCXPp*gaL?6~p=L-nO>2>lT`EdKr z6@4B?uLy6Bcz%fZR6j4Q=fGy;Q^pNno;Il5`^98upPo)cjp~v|E ze2xUSym-Dx8`9&_LT1pJ^jx2PNN@Ey9sYxfADr@)nM;yPBOk8M#o*fRYskm^7s3B4 z^5OVv^a=%8Uft3^e!Zw3@$SSMgIoO^nEo4q`wuh|J_Wp`@VVgEkbe*IznQp=V}4(Y zDdb~$`SPIfnaFno`EdW)E&4o+ei1$wK4!bT|G++(DEuw> zuOc6gbBpNnF#1mTO8B(8FbFixbHJ^i@bTM2;2P(n!q>uoW5j=#=snJ#g>Qt<85iw8 z&fee}Pha7m!{@Px&ugOhc$Ns?3ZIG>??0X#xNl#6J@6!OjkA^To$&7-@tFv&?KL~1 ze@*=N<|TX&%3UAvsoQ7&`8EO9yqXL5`>p&o;xke79_PKn{o%8#BR*e?K17`)-wLl& zJ$%!$@BZ`Z0q%KuJiUY$!sp?L&nw{CAC`-c$GJjy5&S=k_#AV|{^LIrT+8hN{;Rx% zH$}NuM|_?G*M7JnqJNJ#k0;*{xBY@|FW(bqedS9-z8=5V+X2E`BmOSn8s{L<=V3Hd zcsuw!8}V5tdXMKX!b{*&vtLkXJja83ULH?V;oaafBI5Hq(R)013-1k|l@XsWMDOuz z5#A3zO)lGiUM1k3m&emt_+a=puav za_zXiG44nAHSzOO?#Id7iT5P_BXR!!N+%8s`C9#S2ye5$?ZH!veXiqmC%v67%tXEQ zC2r?gpJy&fGMRk%JnI$Go6j8htRy|3Pi-W9F}&^NJL2Xu4?a}~1yRNHg?+k$TfS!n zN%prt>FvC-Exx;k^ya?^{?kZr_aOE9e@yh-;qxNt`F^MWL;AC!wU;%d=XsS|N#Bw5 z$>8w8^5yg5+Th;*S0MgYr046dZAI_#cP2f@--Gle6wj5U=lI8y{v6UzBR$7Ii}Y6i zs}cXZr04ioi{9hkOnQ$0U!?Cu@l?1Xe6afD_?r;#T%o+(+Y`6>W$ur@w5l`ygZ(c!Y9FJLd55JaNA!rNDFBHxw-JNO!Qji(UY>)GRJAiN%Y z21a~t61~SWPIw`F-iY{Y1vi?*|8iYn)dK?+O1Gz_owABYKZ>mGFM>Ib`Ji>#dMD-(RRXxW?H= z_)z$t5%C#EoZIUz;#}?%;_rFQ6g~>&J{R%XMx4v7bX}+i&8xcbJp4O@YyFpr-s8MN z_$2r|6Y*IjdLL)r6z=z5t~hG{?RXTp=jHL_gil9210p^*ir(WHBYXyY7Ds&6ir(Yd zAbci#j=X;Vd9?yJ8SiILBR%(@>qu|oq3?fhis&bUd%bzS_X(ekIHyH?J|fQj?F-@@ z=N|F*`l)b3s0WW{F3PP2ZvBvbx)A4b%f!d?N}tPcPRc zh0l! z8QkjOg7lAH=jlV7pMOy%+@C`+j5r^k+!^7|5@-KK5xyeAKLhvn@^=4H_=*EUy)?c# zylT650Cyj6_Y&c2;d5ui=W)?{JWnZy&zBLO3b%wfHJ+-%x5B3jxaM^Yxc4_de}7ec zJkCYJe}aE9X8-k82(EE95MJ2?>2gKH=N8d>JbB>-@Od-h^P%Xy9X}Ob2%p^85SP~5 zDd3)$$8(18#_$;v@ws309?vx4t>LpF;`5#8J)WJyi{aB|-2U_G0q%KuJiUaMz~_O8 z&vT;pcwQ1-3ZLx}pK7;;I5nPH!n?tzJGi#j5OC|~d|dH3aT|yIJnK{P;q#+y;2w|X z^}X<(h-Y`i=al^Z>;Ej`T%a5Zvjt}cuoDWl87lWtLeSXgx zLV9b*>RD$=ug4NUIOYC4rboz!e}7EwOhxIU{PpZ9^!L!{?^{*LIqK356v2cOz^hrF~t8-dqIzqWF{ zKAQ+HgU|4Y&sgx9sfS6u-%b^u!SI<)KAhLvq8|?Z+K9etT9z#qzdyUoK0jf9(#81U zmNb^X;nkX>vcvTC1K|Z%1kfJsW-k^>@umwJ+c)>Z)44HQW()WGuB;aB_i5Q8-0xpe zxl-_Rf4>jL(Zc<{8K(;O`)qU}|iSA#!Byf^CBYI0$OZx)V^Nx0i*l2|nZS1<)@M?s0x7ydLyF3NHjd1RIjaUk2Vx z_)PFp;a`DYDZHr}rpsNzM}W@~J`eoQ!hZt)g!qM2|360fA=N_pwz}!Po|_5x`s^&+ z>us>`T(C{X5xIU+a}AVJI5{PV{J-dOn3Mu8U# zPZ|f_M|ckWx5A6TCkihE_xXBz;{ks|^!_~Gb;A96=6Av;!KdZ{Azt^N0^UgYf|fzo zLAd|_{Jz5bTpIKvh5P)f$--yj_tfWv&jEj1_*z^K-7I|19iiO+3NN}R@S|*pmM)&} zs3*hcQ-!}ZKk#0{SAhF-SKVhN_}!vk4L)1=TJX1puLu7`_(t#_g>M2ssAh=Q;<=c% zi{m1^gK*z2E*0+E#dX4cySQ7p-}KIZH}iP%?L&M^M4#&r_&z_$obE(`vZ za2)6P7GEBCPI$h5;HMMsL;az5gpUx8;Uc+9xIahukHWWGVCk|*_-Y)ld@Ot}_M`t6 z?$1F#^q}BpwtXr7W)WU09Ni}wNc8Y;XT0z z2=5Jk6LGsP?aMt8{&vkX55uXO1xuRdXBk;cpFQ{&7CdogAmlX#7 zi*WBhhaVRFyxf`SS1p9k2Ja$#4)`GAmr*<38sU!#_jY_uxVPg!gnK*g5bo`Gz~SY2 z*>y-?8bo+I;r?8bi-ga3vqpA=a;@;5A;O!3k0s9kukC>de?hokpZSaM2d)S$ zvq|{c28U*6H2!>8%gf3gJR$I-a9-}*pC8?dxcxrvOOFU2DtzggHM1)odEx$?+&>8S z=WD+ry!6@d-0i;$Uw_a+ng4gf>-|zU<28;95nEmsf1hnfXS_)G=mqsN-kvyLKff@- zuMzI;a+h#Fj(SqKA4e?|j>Deh1K}8ElkLLM+)0h2%Ja4O{W$74;kh77ItcgUs7r+V zany~%{Wxl>a6gWkBfK@r{j>14;G2c}an!$s7ejv-614WUeEm48rEouv>LJ{ZqlOCi z&$fyrnXeqz_0}jyNB>$mt`qrlZ#}O{;En2s{PuEOe<@Lp>l9_mu_297j`Q9} zl;gZ{zH*#jts&l@+Uwg0uX#*){Fxr@)kHbGN|mF%hA2mSjaQELdP+Ik>rLfouaA|Z zy{hIUezeO8%Dr8bqh0zFFQa-J8{v-%N4m)(;RrMNP`HnuyM_DsS+7BoE!G?skB^^i zh5PtK+?btdPDiZ=u`->C#;} zyoM=9f198j4KPbN`rC5l=x>{pqrdG@j)tt)FvPnzFZ8#Qi8rhmH1@Z1gbx+&^?a*v z-yi*e3b%4C)x*Y{dy@Pj{Mbo>pU^D4n%;(zoX@`^&c_L>BK%9?sOH3g!^$qT_or}eV{*C zct7w`;(VMiD8g@5ZUv>wqsp-@El^%5=s!@74!T1*#sPmmofVhGiE+T6Pq&w29O%*_ zl(UzkqYqS$ao{%Lew^@xa_o;5E64t5gK}(0yOi6;oi2yA46hz%rGvufla<#FybEzY zPWVlPk5_I5rOQm^Xsmuc7uUnO)y`EI= z?V=p*vYt2}C;SlMbub`U{H8~`NgLq^GwCJV$Ip?%3qrLdQ-#+7|C4YZKmECE9*>Wo z+eDv(&*5#t8`l?spCP<4_{G9~{2WP~j|c9F@aL3U0O|5)<>+t!RF3|ZoD$Zv)w6QZ z06FF8Z|#($zx7p){&u}`G~`s}=x?)#^Yy4VBK$+)em!cZaK9dP;Hl;Ln!jIrsP*`}L?>h5PlWX~O+_)I8ySJ?d}5{d&|l!u@(wW$Zw$9W5`v9(5FPz8=*w z!n+Fh?ePlXem!cOaK9e)sBpg?^_pWl5eyOT{~z!f;{1E!8xj7Ya37y{3HR~200(kb&*tyra}(h{K6escFQlIg z6kZ5^oA4a?4BkHbF*_i?yRae2O0u8+e_iSsyoZiEjI?&I)H!hIaRPq>f6FADc@_+8;X z4u2)w$Kgt6CD~&2WAXbqe6(;MhuaY6-_5&3_yFPl`|r)d{de>Gh5PU3FA4YG%~uHb z-_1W0?!TM=n>hb&UT}7KJuq)1+<$NFAl!fVyhynJZa$KDgNmUn`#UkhpAzo%woJJH zZoXN#|8D+^aR1%>$d2XtT0H){c^l$9-?eLm4;1e6`fd^K^ZM==?(_Pd7w+?2mkUp@ z-eO9>7cU>mj z=euqc?(7YpHOb?>bnx&v(6DxX*WeT)5A7eOA@cFK%ir(kDo-f?zyIw8a=ezz+xX*WeO1RH= zT}+(kyRM6He~y^NZ~E#X&7@}M@_dc^eAgo3KHs&2aG&p5Cfw({juYc!u@>t zE#ZE?{Hbt1U*0Xe5dL+#hc}k5<&^_JNq7->XW`f^5`V6l`!t0Pjva?&r%Rh5PyP-NO68|7qdSnNQl5ww$EAQs7;cqk~?lyh_mDsl007Pb;q$_)_KQ=F!0|iKPd30mDdh@DRKTi=;H|gSvlJ4 z$n%4reaw8&UZ*NYdtIm;?RA}UwAX#g(Oz?vqrFxtM| zF9QFQ@W$YO6Yk^ZSH!d5WuUK&0mtHJo>OjubZMs?ZO~Ua`r8f4(EtxAM}K=+Ir`gs z%F*AxQI3YJc43HjZ(itc6Oo6#cwaDOU6k+K=XH4dShqZa`diLcN*C9MPwD+|@J97z z;I8-U^V1{x8KU>=_BrABn3M^3{~5yFr+M?{_~!roa#*@1)yQ6-V!RuTpB`)zvP&pl z-M%T*Pq|eGS{Q33$pWlbG-)r&-uU`Xf0w?o^)-f#Z$p8puddJe8@w)0SGL}Qp1Swj zjh}|MWthU_U*!A^UU#SKTlul|H85TOzT=Ywy?7tzjhpxRxc7sV#mkfF`pWEkUw>Q~ ztADM1F|z(8X9w4Y*d*LV%X&Ss{@8Paa)+;oS6zQaWc?APLAn0_v;GHIU)#Ubo-2_q zy1w=w+e2&H*?KwL_v%a^Qw^qz#{XSfzIvMOvXMbKWwdsgE#nG)~+KS$Qzwk51z zMwi;F?PvX(X?*)DzdNow`vz`qR<@R37+HTT)}NBDV~eeC!@6`#F5+vlDepOXsGmXA%E2&W-upOcW!wl?vmdn9&JJ4SBR;;zqU-z8_C zb$52`RwRbhD8{0=peQW@HAtume?Wu8M`-_OQYa1}q)14p>OTZpgexrJDlQZyVBVX1 zv$ywluP9-3cRTZ&_kR1EHy^h(V`?LaWTSiUtubfh>m{ zLGj)SgQbV=Uiump(Ji_qJgs)}z1B4q4KSX#V!)?Nw8J;J6C&Q-+Z)Nyd!Y#s8yS`8OL59Cd z_+f_sj_@N4|0ChOgsTz02xVQUXi?DMa#P~fC4h1v7_z#k@!)q!JmkUGOT5;DH%a^s z555a(nooE&?E4!5=Hpv24xMZLsFsH^|}rnl2&{YvxzL`1~u_bw9^>-gXgHTC?W! z@tMn8FUg4vL=nk)>I416htVRzYXOJ$T#*(D9olmq+68~H3zfv4cZ-z`o;A<=u=Em!b0D+|u>> zM=wLJ12Vl=U>bBRt(eQR<}zrkfA+nbFmccurbD-9I+UV|qDs@@Oe4%UcPNSho<`Us zd(pyZd>DCoG|n_T>oxx#LvapS8047{^oTM9N6#jZ8A12Sa;AT4%DylR2Y5J2oN-z|#AOh66PE&m| z&%rFlfh*w6qbZ+AC3E(W-87a@=JHMUv3$$+?M=rgkJ?WSWRFkw^>lWb-JbGe-TMx8 znN9gzqA!)`>z~*%Fg83qxg|Z4PY)!;s$sh@JeDa$2St3Okjyl8Z8G*lr{|!@_GO1h z(;0}?{`5pLZ*)~JWvyfrwN*_-J`Wb8#Fs6^zq(mUHiE9 zxGc9o`AH}nT3VL3is1O^lhwgcMAMFmacuW^Ay^aEG<$3MsCYyIqrvJ`ns$_`Gr_7l zO-oZL6%00jaeAwG25f6_N)}Uu5YY<79< zkn$<`2E=;!)wGr19q_Bc4N75vSc~Y0%3g;b0MuU+7UR5Hc#wy5x|Y`UJcs4p*3MWv@sNc7nwj*+Y{au z-W@i=E#Xhq>7fSbl84|;Mz0dZiujrX00*GMg4+mc0r&VCgsL>HHXL6A@mVL<-`NCj zIyD=!A=|#(ScR3%e=lq)&+<& zJYboN${|zCmg=dl2o&!ijf()$NyK6Q91Uq)Gu?Y3hZrtjssZ~d;ka~s8ou!NEYo)h zS3FZxeu?2~H|3k;XrH&FQ^;YjBmKR;#mQ$+MC!_{u)%?doLY5S1t`6$EH?q@II zTu+wSD?J5<8x-fCRN#4waNKpoznCSOFAvaU<2paf@J8Z4ML5^_EoQHDzQ}O3OM9&X z&p((wNR{aZ!_}_tUi!b}db$Z$?V2KTg3Bz1)e(Eu;qFh z7_N4iy9np)N-=w-XPDt?SNew)c-~<4Dn7qqxZ1_8!e<>wT+d#@`M9Dm$aQIb(N+F_ zoAMZkbuRp6%3~O5s7mB#3|Egkdnn#`QTIaACT34XG0JeoqaLMD&wa`mt_J0~o=SLg zGdbM$1s*WfB3#DNN~N8y8N3-V6{WRQkLOuD8dx@2GLm%aThE=kn zz;hLjq5r?>r~=RD+=<)b`3uL;{%LAx#_bGwZj0wM97C7Cl7H|2@W=BU^oL7XdZ?jT zC}W(#yzj8?Ecu^h#9S+$4{=WPkJ6jWRa(K7Ml~GO_{DQ1KmY&SjVv&Zix=5O zoblWr&zt=G$LV}ojX%6Ujx+9$=Td(DFZuZ6X&U#(^D969Kajs_C*B`d8}9#K);66l diff --git a/source/cluster/wham/src-M/obackup/misc.o b/source/cluster/wham/src-M/obackup/misc.o deleted file mode 100644 index 49c7279c96502d90ab5dd593663ca3168c73c670..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 37448 zcmeHw4Rl;rk>-2dt+xD=NOArQ2}uVlL?K3z9NChSOpviVX(yH=Y%ACSBFnODDVAiR zAIApUQI0Ke(^1eeBgPDDP!f`eff;-zKRDSy6omS@Q`NXl^Q&)cKZHGgGbWWa&kLPd}t&^ zB;CWf+!4IX;2HjHTya0+eSE!^kAK1V1Yh6F$Hy68&5WarKg;-fg&$-5T?!v(e2c@2aWx1QTc`H{*2#`oAu=xob>VLlVAzxe$z#%s8v zh~J-K{4XBk}Mi#!D4m#rPtHCzyX9>mzo)n{kgj zoY=XI@lA}2o%b>R6~=LC${^!kQ~0Bde@EdIf7ISr75*j0Pbr+@iRe!&{Kt%+Rrp!P zBXg~OxHRQ_IGXs(Q+SN=ixj??@yivylJOFS-^KVMg|{$XsqptQezU?KWPGKjK53qX<>Ye!uK%VruYmp-lOnOGQLOgIl}k>g@1+duc-d`ZN`r){Kt%c zP2oRhd|cs$=!ay_?8E3pu;p-Tmr|?F`ixs|u@rx9` zm+=LRb2s)^fS%<>K>UrhoM!OHb<`Du?pW ze=ZOHnHXd5Fp)&{5fljzjoI*u~Y{k+$KOOV2A|SEBzayYdolR~_(N^#6hm zOZ4TJT6st8!8;%I2%lv9Vb<$mgfijpzseGhaA?;jl0Qs5aB2c*BDwcSBH25dNY)=r zBx}bKsrXo8|CzeIw9&xR;z)^5T52xHysgQX)CjIXyl7JVnNH^9?~i z0jrXu%b%;m^$nww`0Ig7F?b$HG(lASc;<9GF+I9(PU2X6f{b@^F76Nnq6wVhQ-3^h z)A7AGWmI^vAT4?qi6-MdM=30k>L&oAQSKVJ0g%FuMtv!g}NUJP=t=-Gd~ z>1gj2sCFdf!MyihXiw4LRQ-`;=){3vO-}J(zX|8Y3l|`u`9>mXU;uPCks319(JyYv*)K{#6zCTO7~2@Rj(Jj65$+u%z6GSl zH6-4M!Of(B0nlBDH)_F6YhKe$<)n(q4(uiZtSZFBQ6=pu)3{vDI#^!RR{N-1 zp$|d8^vPN9uIWt2;)8Td#izdf@*wBFK3F=DeD@&o-y!6`KIFf{$bUyD6cGIfVURv> zHuVS0DfNZa{KRwK^nv{`;ECk1Z{DB)^AVWS!&WztMn#o4sPEx*!{ArS7 zGX82R{%SHll^EzBg*2OKr8@DjIn?SjnrH%L62VCy&Ys6j#8CDm2zMyO9!CcE_uZIL z$w{4^Fijvt2rwZ_oHDwOCi+MB%mFiEI)1Vc`Ewiul$yrTjImsuHB}2@j1lRSIkbzU zxlurXiGui8RtStiO~ucQ_(caEq!u`?J!U!@(Hkbx-GUwuvB&?LQET8Cir*K_d2;Wt5!pLp zLLrg-7R)nZ+vg;sWc*YrehT9ahMWCori%`2gRM`@qLu}8DF$Pjs)#NNaGgl&(&t8> z=t5Okm(M4NoGkE69nLZuao@*K!?{uh$Rp(P{?Xptkx~vOfk+`hM~bk}(}k?jbEulw zxuHOSVYdcaNZ?U2IMz>Tlu$7Qr7<>y?IQyNL}J~Y>4TU|041Z=;DGwx$@#$O1Q?|- zIyJM4cMnP~*ng@9N#Hn=0OA_4jTl_1vRkTlJUI8MAGIy9SwB9it%CZ+V1`)$M*dMd z(U>9Uu>fau63nOEo(aw-ie~rB=KN+79ktuwa|l08?Iip(;TcWb*$B~{5xO(B{+U$$ z=~V61+*js~C2LR7jlnATa5J)QEv?iSfDdawcolA94dRj@bp(IqYN*nnKWc zg*3>gsrr$`O-C{Dqj?PSqLIi%Hc4XUMOjQw{8F``ce7aiup75=bZnA-#F1{@J(dU~ zevrPYft=uxe~@^3E}5=93v&)ybCRh(^mWty?GOd)v4tNvbr>`-@-U1HJ?yBo8b(@e zXXnEyFKO28i6(oHl#eW(fhM4!xaTlx#HSDoq!tE2^3zjDGa#XPPVo$;`qXvYxHNsq zgk~{#x_x)RP94a!Fa+Iwj{e9vR-8v*aj<`#V{M@Yl6SGT=pWsCS5~jZo!P`VacpHt zA++#b49jHRj!b01=V%?V{0QY;B*0mA%bZ6AZgfSi>CN#NP4S@B@xDSpsD_Jg5ZJm7fb~r!Wx1@2P5=_7^pE^BTsLF z3(y+xWNbQq8fdD1>ZYSb57qv1dYUs9deR}HK;M!q{=lgksE8RII^gFwfCENBVuW=n z1#cob&`F1sS)^i^CqLtgNX&}U;ATEHk*a?c@&*t0z%A zdYaT|HT>ClB5c(`pwp708l>dMlMA4RX+(x3Y3>3iBB*C>hmA9zqdImPjj`X1j?0fw zH^@ZOb*R{hioAC*&_YZwgDf>QgEPpYXH6mvEY^SaPvN6xaFcZxF-xQdHkiYIwe0?f z*$2TsMe?7}^>A>erDk4#ig!0KfKt+34;@)A3`m0*7b!&_;^Y6rrMO*lo8@<^eo#iq zK`3*?jFP-C$8rUWp*#!oR4wS;QS#SVnA>R`4fxifb{_XU^&NI$W)dLdDZ7~_kTTw2 zP|Qn5F3r%i-K?n*(hDsM9--WU;SePAj+qe*)xDE*>^XcsZI{GE+iPfTTqOIC z(FZ274GXb@OHgvo@pvm+dYBY;U8APH#(DEzHV& z%1SV-0i=eEuACLjd9wcuXiQcRDhoj|x`R4KVN8;;vx4Oih=4KF31kHVte(Wj(GyvL zyInXwc@WFmRKHO-Y&Sjz>Zh_}0$Kkcxn(*&fxMimKSiU$XU;;+WAQ$^0VcM8zI!}9 zo1z<-O<^`-_Bh9m#SarHrq1LO@;PQCb$hdC{78^!TY9$>qpexH@Qfeh?0@b)XYOh5 zpgR`CG5C%`&#S!bIeqn1v; zdIEr{Ae1mRmV{pL~Z{eRG;TFyjzBjvYy?gA~%N=)sFA>YPXnOTSwEKn~6GHf?a5ki9$UMDu< zagl}T(pHfT;Tdad#x5synvKpp+0zDwnM;y16EQN8He2Ki5O9=R)C`+oB!7D_b5q($ z$h}2w#wd3z&5TinVB@5ZlvM;nCq1yC`6^A}>qIuGr%pT0qSRUw>1f1LCrKEJ)26ECSH(Hvx4Z)~x4?{++n~oPfG){3Ed~TV&5jmMQ zkL}H74ra|xj2v}f_7nX!^f3=MftBm=MA3o&O&Qkoeq)MUM7^&&@nuV8J6_R4PvY{# zGntwR2+vvbA5MJ8QqAcNp=MZoE9N$0y5DX94gPHs1 z?{hSl3zAz5x<~;Zb`SGS%~T z=@!riJW7ByAysrtn6io(r;S(%hPBhj4+BoSSZ*f!35GuQFl6+cQCjUpy?}cOu(}Zw zM>msJ`;As+cz}q0J8rgc(0z)rv?m*;O@a8l5XY+oRta4k`9kyvWt$`gjuW^J)BF*-V)>0I8Vno z-#`t5p|w4{#;`>lAz%*zY#fz>jT1+iVJpc)lHJWRF+Rsk9Vl~=%goG$s@ti9Nobt( zQZkO^nmSNj=ea6HTfkZbSly_xj&3%_Ye=GrabpXP@j9U3YhzrIBzYsB4?`v}_a6-* z)D7i8l4{bP8kt!?mCZ!x1R``|MiIIJ+MGK=4{MJQU}A(qPPTh^P{O7x1t@Wa<2T`8 z0+ddS#{88E1agi5wY3798%MOs3CI#24A2$`a{{!Jbm1hti}f%8!8f2M!O+?s?ACSO zBs{9kL4XYc66^#4e}99LaJ&!f>9!qY=a_Fs9WEd>WDs7}s@X!j;a8`8Tg^x(||6z1{vbpII}O=BjS z=sPJ)flU&u7wrSyT;K3gaWtu0Pk>dxedKF{Xw(D|TFeo2oGg8^2olqGrLn8Asi(OswzILTwQ+M>bL^U{yRV70G?dK zapnJ^$M3rJYgetg&GY1_+xNS+FUixzweLFQgQl+5&Ysx9tGC3^@u)vGc6BxGj&a7= z+1S?GoG(2Pb=!{nkg7KC=nd{$LepUkM?d;5<0{X-|Rzj>fu8W(W1^9K( zGg@cPT>byp;#1;Oj;mKJUl(sEH;s4CGuFsHbM5p0JHG$W{gZ9oV1E3g?!Ri>N{?fA z*2dSMH{ZcWZKFTMA5FY|zvf@R>HJOmmabj@{-O8pHTAW%)FwG5>Tjn@PmY4iQE)j5 zE=R%TXqc%#e@yn1aVp=j-Wk8#^B8P$3;xiNK8^U$9GO0M^YwdijPW_)jrb7uXZXbM zDP7!nEe?i{oRrP%Gh9aTWciy&Y#q!mqmDhUV-Sd4Y-@bc$^KK{^EPiD7 z0{^G@=L^5BwWHaK>^yRRG_v~*erPrzRJd;outS6`^p|1(%5Ux5(d~tI)&ME>>4%*B z&25bx+qw2IQ7*Q4b63~aw#IF!KXQMx0Afu2vYz(NGD<>aSUxx0RnoN83++r4KxF2& znH%!`Efu(59R27l-)}`G^@u9G^VGiRpA%x%hKx<_iypYn_nUUKw>NqhLI2qxwIzDs zO5bmO4_5Eq8`X^qaihJnXSY`#xZ#B#HCF5BZO1ZQ_@s}1FjB!tPxNs{+8ODLK6a7s zxAflY-5FGQR&)UzZGK#9Yiq}rhQ_XKX@%v)k3_Fx#mSM@-_bYu<|osP6OC`9*J&Rf zgbzWNX^rE+n+ILsM zciXYy)9BH!tz``2&9*Hi#^87G{z7h_oov<3sz|r5b#q(C_H>iv#E(>5;eUyArcJIU z@TiLx0LtiWmiDalk|wxkLljJX%g(CX7QLa!_d8hI7BRow6!2$NlMcktLk8*)$?2mX zseXfhGrlbA+pR6=upwFiETe-R9$1N`OQ6K2D7gBDACZN2?h#Y)P!ihNQaCG~k=)T> z@=`;0b5B~bocNLW)mB;uh~PL%NbxsYsMSKqMv?gSOhtXfxHl57^yB!Qj&#zaL>Rx( zUzf&69(9faP-YtB=BlctP(M+CTIxR5yxiofYLFC1(H!)9ry;iKyP}CXxFKC%%x`3P z#dG|vP-d=AR-Fq~TA~30T38oLf05C4*7kJRv>`K!ozh1?vYp*y61&X@+u!Jq(vV=| z)U+9p(?&$Hp3f4~C&+5r&NE;Xp zO^w~nY5nBHkMu0`e?&?(wOB9UI-}8w1gq0jWz+#r-)x6iZk&z0S?jJq0N)2IdTqJI z%mc*(BnGV^Jt8~D_eBc;W@MSwH;Y?V1!X4oMb?%0LsX07KC%;oQ31eAtw7)}TZU>= z`=akaGH7bSi0F+3j1s*I*|EucHVCf27_qUXb?a8?p3(L5VO74`5?zn3E3valI+5%Z zkeY>@W4L35cb?fNS!P9IeQljr%Hgvjon1Nm%<;#e%Xxk%9dUP>rJv6nS0rHeI$>tk z7+VuORGaeM6)1N7~boL=7IpvoIV5BMOfTweKSq35Fj?!NrPm*2f8^c{0EzPhqD^h*+1eNm_k$D7}^ zx+HXl7}CkOoP3y0su#>e&7UhZ9V^2XI5#$T@!V_Xg$pn6=lgHP&*Mc3JbPo+g?9iBA;JnWP$fgrN~T&2ZmTXNs#z|_ zRTsKE3+H=8Hy6K_HQS!PZVp`_vCp2n>Ou@fS9xzd?|Lwq=ZX^f=b5|bA$Bgp2jADg z_qzOD#q(wr4pOwC(3;6D^7~{F%woKG(c<@qBL7a4q$nk9l$-4#{a1d+%%O*R-u~jq zFU*`0(S^%&^(=YvyI@ZJYfvLyLF*^KcjnN)`&{(ZG*d!x=ogb>`Pw7DFXqsj_RNYD zzyhXbu2leoG(J#u;8uNzk~4${)Ir*X4a*1fyk z9DAB~^?0(zZScyvc5G?HN)G#Y4bAPXJq=r08@F}r=1w_Ymhj3pcX!hh*mPUV&E2NX-LSM-Q#RNsoUOHWS$PAhHSfY~eMh@+YTSaQ z-+LOiw)eQKF!drg+}G9G)11Dag*5Dfo2&<{b|q$li*_vzpl@4!M+qvoH}*7iHa2ZH z_g%fo5{q5&i>ci~glrQ;$dill4GQaMvTyJ{IW~xpBZCNeGKi2Xg9!O@v1iux4X%^+FBBWsexq+G=Kq|@9L4;ZwM5tXsgjx|qsHIEn(lKDzB^9pPO9E!DT;{bmwYYE}@TMg$R3Ie=7A5W(c>-G+cK zs{-L(wb*W)H}D~y$Kh4lP)A~?-AFJ@17>+^0LN`rq}MXnPF18=0I4Ru0!S5EC4f|u zRe}iFJBW~-f(Usah>+!i2>B$4Wa(U;txr}fmSt(UEUR71vUFaSrSq~ZotIgiv0aXw z(ctm11bYI|ydu!)mXYcTB25)U%?Uyk<)psGr~w+ICTNTrp)qQP#;740BlBx4yA>7X zxpdBMT7@0H14gN+2xK$bt#Bf=q9PFZv>xWvU$)dM>)6rLTz1=<`nTXwSJQS(E1Ng>Zo{l->kc_LPi+`)+`PG~d8gdj+SS+w{6 zm4{D)c8O4g&xE=1yjq3J$~4Ki*5^qFcl}$32U%2z{!x5H|9ZwruKCSD9I4#x;Fnm) z{C$tZ=P@9{=YWHM(!oFK@NxNn+M$2kp`Uc<>2#Rw_7jEETf?Zlft{-Du!eE5Cx3mx zqbFcg1edpzJ(!2jn1erodeYwGijTb2?CTEhw)ck)pC=tY7h?;Finf2XgHzMxEok&M z8!ALkEU}GhN*m*3hY@^4&qo}3{=t4j|3wEU{(WrE;|@;zWmk&cDno_HK826)pU=41 zQ~Y(Q!sTskw>f-<9X=Zsz4+@Mh0ELBK9YyeUpw@!{Xg&ECa$=>Uvv2UwWH6Q=m89h zv}=^)<60|A$FI6w$MW^?6L;vI|IW z1)-w#l(#7fpJC?nI@+^D5nSFvx0-Ryr`f?jje25-mmHk@B0H30dGK%N!7rXi+GO;R zx7@v6;qunHwTx>$yB+*-@Dn}XulNZ6l)?uoh)`a3_zdG(_0Q};*5)5Vyw^Y3YWL;y(TP7-}mzHk+=L%yIlQ$ zrTB>c;qyU=BJCRGcFkv8^I7iT!>A|vuXAu$?tp{;jYI!_evysHonW~sh09y|USwSR zYhf{%q6nWF&ikbbm$&+DV_fqYb?E6Eds4pb(7XDdbm*zQ>$$=le&G)BcgO1s9Gt!h zD0aKd!K)p-!NFZVUtnC?D|UNX;qtb^(+;0uhyRWATZbsZN9^`ih0EIwcQLN*_JBiA zcGzRMdfvkh{bzwmdmqa~KjPr-7b}lCd|dnggG2AiJ?`K)vMzM^aUMP&$CF4ZVh6G3 zBMO(dIewjSZHHw%a0?%?=Pe4Cw?FP>T=O~T;MA^NMmx{@I|p~|xqygJM6SGO>J18) zw>jR)xRyJl==*qH@>dF%w?F=U9zMTR^b^b{#FJXlQ{EQ2gmJCU9g2Pv&l~DA&f|0{ z51&UB{RH!QQsMG8%J1jl^!*1aZ)cp^Rc8?Ur;TxHmm9Zx9s0LB^oR1$ zFIr%U#BMUbsZhAQb+VOlZO_jtdJ`~U{j|d6EtTKR!{^f11@+lPilJPtaCxicos4UJ z?sagoXN;JjJgWFed!JOeydCqq4xeGvmpt z&z~q<-pYB^Wmc}{vz>9#N9@_DaCwX8XY%lQS<#E##uOgmd7j6QxV1j-WL)%-c5PC) zye0H6^6>e-qL+64NZ~RMUigOG_PN!;-8k8_$td^^XYYPcm5N4qotSj%3ED$ zDO}#(TE%!4e?>2Efqk#SV|n<*uFLrMK6`5Z-o!Y` zb?19`IP^3%?laV$cdtY5w)Z^_z6-R{Pv7U@yB+*R2Y2~gvB(ON_KMvWDqP-Pyq2;y@wUf zX~Cnn@=_6c9#*`sIylJ{{@+lzye;@%YAA~Ek@4;W4o-Zed`RK)?aoWXmO}VQopOZ> zpZ7aB(F&i36fSQOE@g(qpZq1I(ZT6d=vx&oZ%uwR4}MDF@|NPQ6s#yDmq-NfP`JFM z_%At7gkIjV{0W82TZ&_|h~d4Z*_2zEA+Q1T;l2pg^NCat8me0Nud=a_FT_$ zZ&&yp#`nz5(33tAKL-?^;Qm8zN2enE`^**cjKU?4NxX~QnB1ecRZ|gM`13Nz^gHQm zL>Hq!C_-11r13YT@YK#a_ z=HWx587EGUH@wV|oGK$GPE9G~opkBJf=hk5rV)B=zI8uEc zNYZx)*VxmW(}+FM@;9O~B|%;PD_nn6)sLy`6hfAhZs3m84}iEJUET6A)Yll@m--*4 zF5whS`(&Q_EgNm6VO2q0dQau4U-(X2|F|QYPIdj4^3)&a`WuvEb$xo`OPC__%I~p) zb$#u>T)v~42RGUJOXu37{MGU&Az$+(+AnOkH8$~%py){Qs7U<(Tb}w?e8AFea%MOb zC%QiEFy@lK?}N6!ba0YSb#?uV^VI)au3yZCrTS1ctNt~4>VJWU#6mV09YC5@|NjEF CaQ#F8 diff --git a/source/cluster/wham/src-M/obackup/noyes.o b/source/cluster/wham/src-M/obackup/noyes.o deleted file mode 100644 index 9e7e13b0df76bad78a8e1ee42160a51be2cb171f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4120 zcmbW4U2GIp6vyxEZp*e?=@%kIjUytKkWNea7J{vHVON?$wh+Li*-Uq*?MipI%uMO7 zF@iw|n}$eyQWJdei8ntU2%1PxW2%G)^ohg=O^gXd9?&OH<9hyg?%kQ*T^{r#Gxwg~ zJ?Gr-J9kdTNA`p?EzE>yY&X-S5=h^T`N|;A4ze!R=0hci7!me+Rl%%dO_!NXoHt3emcC3mjau3vh^*{R)POK+7SvBx za=y$5BDaQfS*u@caE@7CD!VvuT?$D{avoS*!eWfL#_H?MaQjE<;uJVvUdK;z-d@Kq za4u)vFaD5otj4AC6scWIt`5c$WCz(nPkj`|79PS6B`Uur-n@H(iW8Ob+lj^aIm$9h zZzAFqu2kZ;66fRR5}&i`Tc>qGpK*MC{N`1!d@)g(yLa{PYPFiI+)6CO?(i&rT@w?uy^)F}kL^Zh^7>O%Z}VqyIDcVA!F9`PnX zre!iYN>72FQF@YvOwqQjjH@5B%JW4#Yv}QUYuWlyy=d#Bdauq{&(Oy8WLitNQvOML z5E;)ldRi&t&3aVpb28JGZBChebB<*@edaM|V9S=i`SPpgYuVy_Ielm}6(6h9Ul|+T zpNjW6b|yWYNl%n|vvc`;xi?pEa#@QlFBHp`V@y(uU2CQ%wO-#-v|ZaQ=)=YQY;J~{ zyeC((96eWPP>X*gHED+9+Q!i6*x`7J4+tOO5Yx#{)2fkHdTZWb$xg6e zK7Qvxc{pu}*f;P}LP zqWGnbwq;Rld&n*?slDZPj^KoCYwkE3iopGJQ)DZ7w1mTaxwSOQ15zH#jpE8r0D}M5 zxZcFkYQWID<^-kXJWpM#d6$18*L$j52u&)%SD+7yc)Q%2ShkdYSDGfG70vh{Pse}*#QBUiw622 zUL@ebuiH4M-dUql9%nlQ_YDYk6XHvba}EMdJEX>62P9GL&w7}1e4S;SO938?|7n1u zt>Gv44f;obqhC^bMMjOYU*R&2-279>#_F|4wj&!5FGC zC_ukB=P@U^+sHAJ_uAFO&{jF_l;tuj{A7P6m;O>;M;Xki|2gqWt_VZbUez~{IqFyY zApH+|;c9QyANPIutM#{u$(0AV450esJ{;Vi(oPR94hbnmT|vRUS!F1f{>zm@MP;~O zs|@~zm=JkhfI(DS+{0A{y9ME|j-P6a`?|{D|C8`P0wo}-E$;PT>ilgJgR1(ga&clT?5F$29UkCH!SS$&3N1{{I5GS@&uH diff --git a/source/cluster/wham/src-M/obackup/parmread.o b/source/cluster/wham/src-M/obackup/parmread.o deleted file mode 100644 index 1d7dfa05f82ff81da27a568c1b020e47ba7d8695..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 393688 zcmd4a4_sw+oj?AogCi=*)yT-mNXgJ9Bb|)3(a0FPxnyLc%NiN0WMq@E#v1FAk%BP} zGqQ%px|2)ptV`~!k;}MbliiGU$jHbgLnC923|ulYGBR|2pZEE^KA(F&uk$%Go@>8- zeDA{t%zbjs>%7nBe9q_mxqtlZ#=3J3KIot|DLf8Jos~MsJPG|Sef|*ptS0zZP3q;T zB5V8)$tXzuW*@uEvBooBN#M~Xmj!+>$E5xva9g(h`#03T4pK{)Jw;O?{_@}OdGaUW z?QeFcf2%4*aysF!MNX~qHEPZH(TM2>F}-Q6kHd%HW=;Mcz6)*=2jRms{a4{5aI;?b z!S}$|qOkA7$0+AX_&6NDQon<*0FFgYfht(qp`=PfG5qE53i9LO>&f2&uO+X6Zz6vm ze2KQ#CGZvUzkxR+=PjtS3qC;kUw{vh-wq!o{~COpJPV&D{{eg+egf)w9A1P1O?&iV)>Hjp0+uOmMRUWn~$`p>1x*Q88uMUm=P3#M;GP9^^IX?PdqUk~qx zAA{*{hVO!#{<#xALjE7{J#e-9!Q*~-7H;Z)4xXa*dYRgxqxP+A0*Gh zhv0`H{|E39^2gy>xb2_tNw`_xRrnm-jFU&Gf~EZnPSXoC^&bl_f}8qJf|t=Mv>%-gFC~8uyqvrd-h=!Tu-uQscfrkm zaW#Azt`0-N;|BN){7Cpez!%}B9}dA&>-B`?nEpTEW;{|op8yd2YC2494m zdj1BUdaIt$)YAnog`0Z5056A|dTxiWBmWw_nmh}yCI11u9&Xz6r|>qossDfBJ@8jx zeg6O-gq!*gRsWFwKLj`RzXCo&egZs8{ucNI`8(j#{tpg(@4KLrXi)(e$r|FOr`WxH)>HQso$+&w`uh z;MDuz6#(N+@JjN(4%{5gQmHmow>)lyo9AYVe+k^21*B5Vdh*mLyc5qqir?RZr?FhK zCXd5Q$$tYk>t*)G0`(7Rw{@7__$%SnaFm}q87|k0@-TiTyq=a@4{v~*{%|S0iTo;f z3*~Hqx5CYGcfdQyzY6c6ocrN@oJx9o22hWnPhfk2d z8$Jy;+xH^)Ecqwk^W>fICGs!8SIF;xr*MH{miu*hA^8M6P5v`@Dfu(-a`Ho7rrWKO zycAwV{ziB;Tn)d$<1Dybf6K%8`{5bNX@=Ls)n*MIpN2P*-vDo+oG-y!;if+f!#l{o z1Mi`nN8o*Mv%f6B2gq09gOpROPAsJ#4#7=391kBRe=B^Hax(BN+_cXJ;S=Onz^CD+ z9X(8xLL2$;c_2E9{81d4}6Gn8sWp_pM;N+UklHY-wYpz zn|g-elW_b>eFHv4{t$c`Zu;&2z~{)9;Y;L)stZ7Aw^j0E;e|MHFm=8Oo`z$#R1Lg@ z`~&b(xY@p!!OO}27G6o-3$G&oCwMj7)Ok0&25##7FL*87^xJ889r^#lH&Olz@J6^9 z2aY;gw`VhX1$;B*ybaz4H|=vSyo3BhaJla#53|0l@Lrn!I(R?%E$|)WUxDu=-vi$T zH_QD2e1!Z7_#X1#!N7nkfzOb?6Fx`23BCw7+x?^PW%8@xtCX`1 zUVsKLIfL*b^8bLBz)ib7051cW{`n}p9B%rgv32&$AC*hssKZo~_ zKMU_8KkOB{-3G|Z;Dh9Eh7Z9_e>fX1_b=sP`~vtW<+Q-FaI?OD2Ooo*aeg~|lKji? z8S)YMJo#SuG915BkHJ>~rvLm3UVs75cE}&wxo<5GfA zcfqU4zXh*_qukWP@H+Bez&F87|6hSOk{|IZ-JZ?l$H6y~zXje#UJLIa{|mU>FAuld zr@OikYvkkrkH+6m}0=T`VC`M<*pP`Js@!i&iN z8(u>GB)p9L5AX`|qF3woTn9JxzZPBvN4cp};nn0D;Wgw9@C^CK;q~O#z#GW_9^M2u z?Xwf!0yp*lCww#cgYZ^3ex-g2Zzo@ZcapDBZvc{h*h78{ypQ}OxV-Km5By4PfDZ!9 zdc6-m1UKt-349ma^sB#t%j+caFx~^-1IMq_Kf=ez?}AT|e;YnUJ_Vm4|0R5m{5kj{ z`ODM`6Vjf`H^3&i282It$)H(1X^1pUk$)CmL4Ff_9r?e&*OQOJH;{i1 zUQ7NsypH@g@J-|e$LV%!B!4BmnfzqGeo8%3laPLRJ2K1Dg};WOm#hR=~- z1Yaco1bmsi6TV9R1$cpaT}U3L-R^)Fk$)Xt0ypEy1iX}{{~5fT{26#9`61=H-Kxk- z;nn1CgxA1LJ!ipdY5MoW>uCCBcs=>2;hW&*_;mxkk^D>WX7XY9X7caA+sGe*caSf@ zyWnPft-^cZrX7l3r`xlS{CIdj`CH)waMPbN@Imqq!iUJOfDe;@4lb`}%ERRM!?Wc7 z3LhuG7d}b;efTuow9hPj7H-<-x9~Zde(mwP-4@AT1z)C|b?_B9cC*ww;PU#aJdB?Y zPs2@}AAy&`O`YxVGMauXyn_5T_&T`hw_k&=Cm(}vApbGEmi#Gr9o*FaJbV+}jH~Gr zbbB_Ep8#(rKOMfA{5|kCxLIx^yaR65_ml80@@wI}ANbJ#bTJ4SbBI{{VcP{4)3i`QO4P$$Q~bvelBlUKl3$lnHEg`56-F1$d! zjx7)4AA%Q=x57)vuY;Gt57BX{Ti_LN)1SWrUq`+NF7G3dhnfBd@D1coz-!5W2d^V9 zJW;pXCio$GF{xL>8)^De;LYUkgl{I_1aBk%D7=IGYIqmw$!iS9ptH#bh~wt zzZ~96ej>adZrb_J-~;4!@EznIh7Xco3ExTH4Id&OfbW8v_W3vX2u*(CO# z4KE=-_)WUq%E(^zLUJ@6y2V~)8w1sv*e$J&y(K-Un2h( z_zJmvURU~0O1-a59;W{9!3*JLyF3mrBL59M4L94R;4M18jQo}GO7fH8>&efA%li%G zVe;$Yb>x@A8{lTWu7Wp_Z-KXv?|`?Ge-++Nem}gE{73K}a{1h>w0|G@AK?S!N1m#u zAB3Cj@;dlV^7Zf`xM{a{!$-(3f@jG;0iPi6gv!X`2xHLZt7o!_rgv47q8dt*-w5vdMtUH2fT#*e0Ul8N8lCY?eKNvTjA@;Z-Z|j{~ElOd<>OfH}Ql=j(7egeFW{B(E+`Fr49whZTDRMJxEZ%A;5Fpc@H+B3cmsJ8yqUZW z-b&sB?|_^AXa`*0e=QH=!|-0p8G{dyPs4YTFT#h(Q-7x0XAgM^e4M-zJ_R>*Zh+6g zO~0y#&(ieG@OjE_hcA=&!c(u%?PIp%AiRit1YSx$4zD1efmgxJdM&}L$qUZV?N&ox z3eS+QgV&SSz#GUn!JEii;PO6nd6+so;H~6+@OJW@@J{kkcn|pmypMbqK0v+J@6&+N%#u+99-UyAKs2D z@IvyU4Z7XZE^7Zg?@(jF^yb)eS-U_cK?}FEm55P0zyWsWYS$G57j2lz%Mw)&e z-b~Z4!du{Gd`O?E+pUef0^Uhp4euqdgUja+LsrO3;03SL>uc(-gcre0{TtwExM`nyco}&!ypp^f zzMi}nUPC?zuOlCUH^5E()g;KJrcQ0rD33 zAbAITh`bLz3^&_rCwzo_6h2Bm0p9~R+jkZ|PQDDEA}_4b?KVqZ245tvg0GO*!V5}M z!NY9d26z$NtnX%c8gADrQ5-5uQqrgc@Mk@ZrW`Jyo9D7hL_UxWAJjg zc^z#UzK(nmUQM2Qmu?^V+>bm=P6@o8yb|6>z5(6>H|tdoZ>8y*;T`1d@E-DBct80d ze2{zuzKeVuJ_f?C~fljNoFY4UaOS@IhAJozU065MQ;7WgW82fXlD zcRTjMOUQS^%gIOK>&PeI)o{~pv+x?4ei>dzUbs=WTLXC+yqUZT-b!8z?;vl0_rMR) z&5_y+?<4Po55U)8`hNHh@*(&j`5yRA@=5p*`5b%~`3ig(ehBI*I!CwLC{14u-$T={ zhmVnG;1iV72%n_sTjA5>UGQ1*0r))S?}9IqXW>iaQ}AW-dH4$4w9hI$^=jQ?e zt=p}DyaHZGUJaMevB{%A|4P-t)8tL?63S_Vmy-9u%P40DyqtU(UO_oy@JjM&_&T^5 zHx}X5cTrBkdvv??ke9-HDQ6wLkGuxnPdS_51LQ669hB1nA0+RC@1&fa z@FDV1_%6zsfDe<;!bd1)89qv0c&=`@J(N=h&yrWc$0(;3K2F{MpMV$Y?wHyPpCa#s z&rnW3e3pC&K1Vrw;EUvw@MX%GgRhXUz*i}!=+7~ZmFX2S>s1aff}3$~Jv>dGftOHD zBfN~f6<$F(UGPfs0r)z&*?)JztH`tP^^`LOuO^>|%jaC>Ve(huHRS0!jBk`v0nd6J^V^#11xT&WWUP#^mFQS~y@HBZRyo9_TUP?X$FN2$U_Q2)y zg^VK={I`S3xdh()r-EJEwzZ_mez8+pnIT?5zP2UKwCvSysqMR;xBl!Tl znR0f)TgbC;`P{rbO#4j1+i3cEcsuzjyn}Mm@7L|tMP32#rJQPbA9)?TpS%e^K;8!5 z0XOT_1K&y0?|=`H55sqnkHLq@r{N=Tv)o1a9`e-rx_!ndrvyGuUJ0Kd-vFN^uZK^; zO+C%<8JfNwK1<#UpCccH&y$b97vW~PHcZ<>w*vHc9ZW*kcaV7 zcp>>ZcoE#xQv)xd={Lbk$y?xM#2Hd_DODd;|F`yq0_!UPoTI zNw?c3@-lcMc@?}FZjKAJ@D}n0_-4x43~wXvgm;kl!@J0b;JxH~;Qeq@=Olc9d=9>Y zd<8y8`9&A#b{iruhYyplhmVqH;92rU_&D6u-wK}~?}AT~55TA3hw9xUwF^E&o`uhm zPr(<-=i$q6)1O!2t8i0)`a<1qsn_a4j90)5$gAOna8rLBJWbvNFC}k-my`FvE8(X8 z9q=l+sdE@E-wPrSGyNER1Nk((mV6OjN1pl%?2qIn@J8}Vcr*D1_-68YcpG^$yo0QwobdheiUh;By zKlyt24)P3qCwU`$7kMjuguDyB2X5Mb06s>(3qC=fg-?-B!Drxyr1WDRK1b89!WYTY zAJpx(OkM$BC9j4Tye<_y%yR4CMdVHJ67n{98F>%9f_w*j9r-YPJ^V0TR%#4hLp}|! zqnt(fCh}CHZl6Z-5_mItC44j79H%zGTgmI;ZRE}HcJg+32i&xOFT9I<5Z+5Z0`Dgu zhwmVtf$xNy^;&`t!Oi`&f)D9-8zwJ>k5c|Rc$V^O;A1rXCinz-3w#Q0t~;)RPt)`_ zz~y_7{k%W%^UkHJ^TpN1D4?=JV?i*>sd!A;IF@DlQq;boL_ z7Q6y(>O3D_Nq!kzzMn}RrX8+^uP5IQ-#~slyq5ePcpdqJ@J(=2=i~4OxM_!H;7#Of zKdjrWh4PPuw^IHo@HU$MY5)-emuOA{B(E~`ML0F@{8d$ z@HJAbdRz&wg`4elJ-m+mR`@2kssApxd>@!R*63fU`{7M+b6)xgyoLNJcq`oGzW{HC zuR;FNm*{rupqvxoUF2uLd*LSkJa|8R4e~F6576{i!3W82fXnxm$;0H|1|Np6(SJ_e z4IhD<_IUulhx{@482Qui3G#z4)$KC{H|LGVz-P!$hR?xG{b#`!$3t4A-@M+M*bkY0=@?A{5ZT4Zux5MYiZ-+0E-veKUAByer zAbgelad^Rrdcs36{WI_)_*(edkLh+RAwL#gMmeXzE6C4=uOq(@zMlMY_y)Myj@Q6z zX!@Jr8S*>e_2l=$8^|AmH<3R9Zy|pc-b#M><+|P4$&Z6~lAj9iffu6v&w=-mUj!c@ zzXCo;el2_mZu-eB@L}>h;iKgD!L#HK!^g>=gin$`2cITC^5eSQX339-&y$}HUm`yj zzCwO6JoN_Mz@{Cpgcp)u4^NZd3NIzU3tmosKfDrd_Pa;mRpd{><$E{fVWxipUPFHL zX5DTX@)P0ppo%}X50W4J z3Ee(J&b6|SCiiX-#~sZ zyoUTCcrE!8@C@ASkI%yE$q)aeZnp;VUUkz^{-wtmgza8EJKTJ1Y>K=F-`GfFI^2g!5K zx7$wgW8uT(r@;4+pA8>}oAK>J_yqao@JaG(;8Wx`!KdMC(LQ&;XUXq{&yzm{Um|}3 zzC!*iJaw{OpjqzWZMxkG$&Z7l$xnrs!cG4_2VPEo5xkQ83b=gVvph`BweV{4Ti`Y1 zcfvE|_rdGQABH!;O*=dZZz6vV-a>xl-{^L0B|jeCPJTMPll)wG5BbILKJqK!1LW7k z2gz@R50T#mA11#aJ_i%h#dpEp*`~i3&`D5@R@~7cxxLNMOpVsYD3OD`p z7lXBtIM8Lw+H=kNk4@0QoiWLGqj6L*#eBhsp1SkCHzG z&yqg@A18knJ_$ceck9&Qf2-SVhWt4AJo%~cW%6_2sdYNo^xKQzh2&Sj)8yB}OUZA6 zm&46{wmab!aI;?b!K=t0hHoH$5}qM{4!#L)`p=P9>vn5|oAo^&-b{Wvd^7pE@HX;` z;T>?Z+$-T-aMKRg!+YSS9d3p9livj&gq!;BhYyiI0w0E(dY*!hlD`1Y!c9F#|DA5P z3Gx%+({NMI8Sq*1^WgJvQ_m&vCGxA_D{xcK4e)|D>3(bcHh3Ct>bVizCxd(UX_Sryw3_Jrj^_&c^CqE0`05{7$AKpZM8N7x3YIrN$)VUqr zL4G^DhjQ+L_rXp555fn?ABPW8&NJ{KxT$CDXLP%bkRJ=rQqC#xak#1HZ1^Pkh45+0 zxg0)Aehqw{{3iGk`5o{T@_XT_Q{4XZ5WJB533!_PS$HY=;n(PPDRY9C4Uf}fxj%JAJgy#xHFw1@`Du73`El?*%3lW`p!_r7gOrnj50hUA&r*Ife4O&HgilgVCwvxuxNf%8 zcK9N^1ik~Fs@7npzY|^rH^=2scnSP9$aw(1o~ECIZ-5tL`X}IZH+Q}82@b2@w$ZrY(1z6dwR@$=y;n4-sfJI%P5ZwaJ_9$~>q7W4P5%-2DtQ~c z;O%;S&GxzuUJ5tMy$N0pH{0vW@Je{Oj!O;0Gc^6T;Pr5`y&i%$k^dCl3ODVu2=9QK z?e#}^5BcHUdb`N?Tg$_=|Eu6TD8CXu1UK#QHux~ywEsEqahm=D_#}BVd>U@r|5NZq zn*Lh>gNP-@{koW`7xk%lBl#%@_pO#I7I(SmBQQMrk&pa@1yBYhs*bH%fsYsgb%_^J8y!I(DawW z_rTZcxYU*KF?c!rbMQHuz7M_#H~sdX;4AQ>kaHKj=u8b}yL=N~1~)kq@JhH@-=Dy% z;3pyfDR?9N1o$7|os?7fdA(iad%NXf>UyX8@#f2H0EpQ8L)_zd|6 z;B)W-e9yN$*63fUPWTe}jqqi-sq;2?=~+6!wCBIW%i*s_{vLRSrvDyX zzW-YuW`B7M-blUxZ-JZoSKymz`a^s4c9HK359c2P@1mU7!+U7@_3(c3cfsZR#pPk@ zIUl~0{IB3cuB^CkE=`7Zbb<$MD!-)k-pv)l*ab8vHg z^eB9pd>$^}cP@{$`d8}r@FKX$U%N$bmlB%(74S0nYmrj{-$2u!2Cs#i{(m++L;ikv z9o(!}6TFf9lkm-ObKJZJ-cG&^-bFb(;Qi$P2H#0J_rizCzYE_3H{;ASd=h>P+U=L{ zdGcrBsTw_@=~su`ptnmJei(8};AP||z$@WqyPpcLB7Y~m8gBYSJ-h~9p3;vG!<*nI z!LNY#!p(9&1MesAh3|ly?f#GOUF3Jd_rOg%e;qza(~rYv$$t!Af*+mIk0;>;@6^vt z{lA0D_qfZ$v`@iS>@PI^%i(2kbKE~3F5mAi50n2E_y%~P{&T7ZUJHK>{C)6d@{8eJ z@RKq9C*Z^IgW(e(*NET_z~!DEKVg)L9Of?{Sxh@i)U$wXUB9Pm{kF zUQXT!uY$it$E7|FZ-$%oy&B#QH`{j$T)wYe9>xdYLzMHc@I7#|UiZM|``YDU{J-Ec z-Y%7Jv%YEg26%y4gAgUQ{b&M{h9DK_{%VT z9lVSDgK+sCcX^oo`f~VA^1p?TkoUmH;0Not)ED97H2od$Y50+tem8s`ZpN!I_!8WV z+y4!h?}L|zS?&|?Rk&%--@sGnxYMU@)Z3*1eu(~asu(WcD=&{D^{>=%@G|&X_?zGr z@YljOz-wvxKZn=BP5l?a>&ZU`-$dRHZy^6XT)wwn9;QFs0^dyjFYpd{v7Rk80`H~i zzXRU^H|_H7^X4}1^hEWsz>M_{@8;L~u^KacFw+e^OZULIz>UISl&7wbQ#*1-$k zt-(zHc6ce=EO%D<8hg}5i2Ah@_@Oz#zg7b`y)yUb!oQasa~7HNV*)=s2l&?sftxCF ze}0qlgY3H_bADzpy;+-_X971{Bj*kXfmcY%~T<*`utA8Gq zdS+ias13j02scYG70Ama&h!WA8RT?5?5WM#Wp@tyAf|sGdF>iKeFJ&wY(2vz3PZjC*Z-isAR24SPWjsBGgjVv=U#f;wk57}= z{6uf}&ytr*$5f9S$ZG;krEVl|Jy+-a6FiOS%=y(2O>aJ@GE82tV^UuypVQ^1vhXzW z&4@V>k_7D5^JyV-@>-v}nzwmX<)%iheE-Ra-#+qdPB%$5f;TOQ49?UtwS*^)gi8&q!+ zM{|ky>V$0pNrKFa$@gxQT`iTlbmL5>JNwxWWUd=q3L^AOm%euYTt&z5f^Ud5$@?CVxauGwF>wC}eLw&CSA zTsnpg7mkMSE$CJgspDK;>rrVJrPo6isMbR`x~NRT^{BGpdOZ*>OyRjcp}I#_Z9M7X zLDOw3sL5utER_QIapE&31NG zVNdpTE3eq^t}5eGXjg5r;kxi(H{9AS>qx+D~A_% z|3JEV^3iDgC*ILW*i%KqRh+cp&MFGK;g=QvIxEG?S_M1o!hmXyJXUAgF45Uy!tN4- z?1ZZ`Yr~z@5%z>9>uU2h+bLYwlbx{eB^&M(F6@SzBeUKX>7rm;$l=-9IQurv1ih}L zc>C(gzI|IaP7fVa-1UBSjS)IRtA7qm?Av#o>XzovI;fr>;9xDYd`r4@X3IBMRC#(h zPR%&Ou{>47u{zkuB%w8Mjs-(1N^V1#r4Ju?=`xF1dZAi~UV7SHx;)iOmr0zZkE;1) zH#UpR<`!v&RGB0)r0(q=S1cRe%sCmIQzr4uIjuOn%-QIiGKpu-dBt*NZI-zdol_?9 z%(~cSaXs3eWAIqte;cSy|sBs%_PAEwiovd?ku*9uV5nJt)8S ze`YT;o9@t}4x7P7+}*1F6*|k8r@A}HB%y+mA1kZviaKMoa40v=Gxr)B?zEzCG<>T* zbKlav^efv+X3qW4Qi^>n1R zfa20h)rv1<9{>E@0t9`_EO46uzWvu(?j*!ftM`or1#8-Twlp@Fu$er*L6+0SnJO zzuyL-!dq;vQ@F63n=AZh`(FSR-f9=%6fW#8VBz!o&!xiKZLTvE2)nta@cmvHP|=+> zTo*0NR{c;o8g7SzadlH>@5Wh~Wox%Qxo+j);@(~AIK7Zj3E@*S?E9H-&#qB}@2naF zx+c|Z>PF2`-RazZ7IzqyNzAz0ZpYnDcifeydfb&sLUrqLxA?}-sY(}4Qa{Y#;Vq{$ zSB@Fr0*c%1zofRu!bbIDzo|9R)PN{;-^SUk>c5+%HQ#=J@r@r==aWHhvUB?$yFHy= zE*xr?JdYcFHe7cW`KdaKa3p-zf2(RX?pD=+&31aZuqXSvl{LlNZ}#m*xdlj0=o)y? zE&+a*F!<`lvj)W&|@ll)Yw79S*J81E5u6jn? z*cQ*)1vo7(>@Hy8Bfi|&79Y2{PKyh>x%ssCqz!jkTsRV*w8f`ww$tLmp6sB-zx>A} zEk0`(;Iz1~yMTrFsNB%Cb;+^}==t7e?op$z=agUAU2HxZq|b&s>m*F!xl?|10Gd_j zm!aFU!QBOQsz0AQ?TkC*$ejB0KC2ojbb2pO)nUfmHV1%vr%58E5|v%%<+{Iq{u zEh5~KvdU_N6{eMy?1VROCvCXfwSD12nUX{j1cU=>l8k;A?VyG?ufP?WfDx>;E6ydfu*;GmHt- zTII2=mu$GRt%W1uNw@Wi&33l6uqQj=woa{@J;2%4!W6D{_x*3{n&`HcIr87u;q%)4 z-7eU&*Nhq)Pcy@XI$c(sI-gUzLfaxvKM|%D$)lg7ZMf4G zeYDw5KPmNRtHa%X#{|g;jS1y8-03I6RQTTRjN4BRp)sL8+D~MTxPGF}JP$A?yu^Nz z=dq*GwusYDgsDaH=qFV+-03I6k?^GBNwv*(`iZb7J7GVmvEfcX5vK6H-3{S>5`IZH zIEK_tuBZb@Q?#?lZ2RdfZ`uC=B#(={0eed1G?*~0QyyD-(1tq=CQRYZ`Bu5Q%(che z+)Lq=xvSr}^DUV(XujPUwNcE-DL2D{ZDa<}Jlbi1ZzHSi*wdo zn2O6|%_nWRv*yClaOZY+yE-|_V>?dU1v+aZ99>}2>w#Gt?yQZl8?M%*TUOwi;=jzw zO4ygqLsyXhrRI7m$348VJD@(T5{}v1UHbif`%Y2Ee)G~{xq5zp7i(k|bJK8s2Hk4+ zlKNL@bdjg}rlCv{T485ct5i|13N5|rz)P1|%+gov(o;WmmM%~A(q$5N>1uv?cduFD zn%pAIC{Zm$HxN~;WoXX&=$tZ%XU+zivne{KOyZfdh30IH&MA|4=4_`qJEL>TBs^#S zw2C9~ z6H33>y`=sX?(D%nomB@_nIu$@41(R+;u~M48e?I%>UDbm&b{-eyFEHo2gKd)fS1S% z#cCM`zLH+JS2f^%CJT)@E6?xSx9}mkQ6B%Ym~7SPNyNv>}HB=6~5Q5!Jai)Arty9&Dt2(lC2B2sVfN4TyY;lh#dq^J3X zHrr`>VNZ6#+XiVH?lilw8?KIJ@^%t^A&&b)%6jplRPYYq?w06Den8acLwAWzQyX*P zwa@3ZMN4h%x?#}h!fx&PY|(NX?rc%vNO;mMT4}SLEh_BEPPj#@Y`C*Uh28KMwMAQ_ zTQr~pY|%D3ZOaYV>YwxKkW{7mk2yLo<&Ii$7dSGD8KEoHIG{)9D)q0>2rW43OKl$s~NBRK=FkoaNCuWfISv8Je>`I;TwHnX`fBY>Lh)lX&KA zr#U;LbIK$l1>>1D_Dc z%%;0ltGy*?uiZ83U!m?MPjz>bNkRqf_b@I4=faNM=o#EeQ~O`;CH;Zueil&7ezxYC z_b=>~(}LitB6QYK{cBZtxR!0(0*d71-X8kA8iCJLZJoz4HKW=f+!17p$qfj%X>uJQ z(dQ)UZMg0T2p0~uyADr!i?zXKJ0q~LCp&mW@twZYncO{G$qC(NZL$l{#bXx{b{DX) zpxQs5rnkF^vj&;yZemZ!ejrPVKjWi!xYXMPIBOtGYw&5w&Fzfpp94SGx9@n>AZD;1 zRL{{X;|6<~#q50zY8iU(Yf}FT?S1l8?|m{!s0{V)Ts43A>Tfc)NOScklkgy@ik+r8 zXQOkYXcLCAi0^?Khjg4yS zFBIUwL+?#B9~9J=0`1Y{fZ~$njg|{d>PN6Fe%EVHG%cXGv=dY-FMQ9R=GNI4O%8~X zLs!qEtLlJRsTQ!Gu~c@F(A9H~-9XOP7mjYAq_-pcY`C-ah28M*3BUTc`Q(V+Uaiq~ z2#DGtk0aH9txvDKRH;r9gx&gr?BJcRw>_`A<%>R24cZ0h2EYP@-32V1v;SP$YC|^H zDO}ji%@zKR{V#wHvBP!&PT|7t0v3L$`rLjRgbE+ExlZB2Zf>sdsr@g23eVaFIE4$l z3s~q-x%nS^+SRb@Ira#<%fX5yI`(whaJ>@Jh^k)-Q+V#!qfQqZp4OjP3KqFdzsX-- z-&A~nQyiJo9CPZWy=C9p-Jt#zI_Ahzeaw+bLWLwh=JePVbVr@&3hGnDM6K6n!=2U> z4izm2w7uOeYQ;UTakl1~%$%ahlzi&)Qa?Ru`>N9lu&X( zcX_Ppimk?3RpFPus;S4#nCPska5UV0@?b)L@<7J8t=;lOy?C+xW|gpaWAHr`dpFJp zDkio>_HnQ?TE6E6JxpLzmGlHe9bP!i6K@bN+YE&&9oS zzSU;ytt3lOg$sMK{coSig-b@L@OB%n3rDzcBz)dq_x+F6&Cd4=mINk!=0@u?1r0RUVTpH z5Vi81s#7>G%j-*g|2+`@yB~wSGmrKdu*YZJ9`aMpx}(Qu+#mAnmbp(7(D~n>4cF~~ zaACJSRN+Z?%ORVs3r7bO_GJ5eckFICY{Q-2EllC+CYF2FQX|_`b!yeY?Yp7}qh~NO z7oWj|di<#`s6U5q^aR&ep?ARR?Hxab+I6;U9KdkBb>o1H<3Chwq*^-ZI5KJ*L$|av ziRvQ4)EJWOZ|T@^Bx}Q+T}C((p0taM+ia(c2z#>qg~xW0NgM8T5n&47+dZ1=BJ*-L z#2p9q8y~aLJ|eS4`-lvZTQ3-pG4Rc*mxMaauVhG!?-F^84yATLb6QZCRx*!EgK``0 zw4iV_+@7J#=`$3WWox%Qkxvoy{!V@SK_2T@X-jarws5qBq&HluY`D|4g(Klf&!(zv zwzFY`J=qD*rfO`svtfiO+_~aSKN`Ax(}SQo>f1rERQ(yf(|=&wwp$YP)$X*~jY3zu z@>E^znvVvB7W;p9q@1-oyl!&&sfIyeYLz^Wl=C)RH#x$EBjHK=%9732h079D;liHm zgnebjhC7{HI1-+8{7(JWy=1^4Uf7eJaQrT`;Z7$PrtrPpX?4>xbYsFC;#KdKb6E87 z;E=D!^3v!{Qi+I;<@OAB^Zti!Tz&0la1W06L-u$-)SbQN6AS+)TUxzuF;~7S**OhY zha*{q+R1r+%A)J9kJc|4(fakVXz1?R&9~`ePpqo#0-POF*j>QF>+-t<%-F-5vj)QM0)i8Y zgm;+gZMajta5UVW)GVr9L4ATv+Hz~RJdxA&M)h6B*ztqCdxzb-cgUZQRe#2}4s9IW zyKy<#5XtwTK6@drTSI=Tql0jy;KX~-fDL!{AmK>(vj6tRa@_5WL7S}$mnEpeg+1B+ zJt!A08KL_!LpEF&j&R{fc+x#+*kZ?; zwYab+JK>Gn-vvi+_v|7(mAc87uA5X}P$RD+r{6pJ zOmV}wy7l$m(R~}2w{BckwHI$cGrv#q)Yv12ZY8-ntoo&JWJMBxsy}1Hbt@rUI1-+8 zhpM;Px^Vfa3K#ZdC)}YLY`88Q;lh#dr2VqVX6wSy=Y>7l3HxP>4cCPuTsRV*bnI=l z*}8D_d0|hszwp?xx7~*8!VxYU372nd%i>m{Tt_?{x{km}d2nxBcCL+TXOSD^dEDUW zv?b~FMeh~%l$7w(3_UhnuP?%dBjHJRjXs;L3zwg2*AVt(C)_m#Y`88Q;lh#dq&;lV zX6wSydxbsO347R(4cCPuTsRV*be|r!*}8D_USUtRzwp>&&8Q96g(F-z628A(gI+eW zyM})4XzK+#I&s0+*QJ-E02qOZ*GtJ zY{DB<*ER2O?K|+t8Dtjo_Kya2*`RNTHK~7vZivZKyu;PGvdI5EG%YG8{Q4}mkg#V9 zCA=zXwc*a@7mkM8tD;G@v9@;0Pr2T?Tm26P!rMr_@}gQQ{2tfA12?YBVj8zyEnPQm zr}|f@apkFQT$v|T^l+}x&AW4C624cYx8s)Xq3HMH1{7V; zs7eWcGjTS$Aen?0go9-9jqg)Ec;WYQ*if5I9Yu5RW*v^!5Ky#+(03e9Q#rG_a^h}h z%Pgj|_1MnV=XN%EsymxZ654Lzt>M1N`Ib&@0n$N2SJP>`0H>o0y9-#Tmt5J+@cMz;Zn+P? z6h5l{7;YBz!7L%#Zsz`?w1|xLk4Ya0&*rwKJEl}V&MAs;sIc7jPV^p# zavQFDQl>sR@ntO9aY#}z`|ch zZv3{xeY=G(%G%2ol2?80Yhv!J2C9#%lY4cF-<^uycMmAi!STAmHE%b4UAl$z^^fiU z*1IVSciWR5&4yIh4Ij;9E2wQN>^4uZ$_cL~hHbcRdxQ%|!jpEKQJd}bcwtX=!mEj_ z4R?CHa3nnG)x@~Xc6z+9CtIDA7jNI@>+!MItdn*DPLCIM7qIYF$$fF>$oHv!ksP9k^BA$m?d6m12Ds7|&NZbv9_RHx znwqrXx(gs&I1-+8$D6jHuYr}Qn2p5ioC%qb;x7oUIS%NBD*pr>` zYIw

%tK(90^Z4VyxI~UAUaa0{>@1i>_UGM&szQ^hT11|zGqPy-egl1l z<$uwgwr%NbEMd1T^EsfF+Hhw>2~+sq?jF^U!G5oY(Qegg)BxVymup{haVJwo&$#WK zl;5jSZa+hI_yD3V;MIj#_U?s&spnJk9m2U}Jc10_CnM==yrau9CB%g=v-Y*wCq;xx=xv zni}1NBjHKU_X};dv!R7O*$Fpv+J-wDTA0H3c9%c8->qAz{_G4o+qTIZJWS!;65W$( zP*4|L!4M&rUDGm1B!A~bsa*kQvkKD+jyh?Tt}gTBGa&j6l|5=68lWVG2dF#-p%z=YZWi#k-+7X9rw$l-XJ=qC6 z;;;>OI-+nSJZVQ9wb@Qb6!v5%?1)(#?sP<9H(Z@aaxjC*v9QT zIa^xTU8f-1zolaj+LJci+0w$1@T6UI+GaajTG*5AFFf|3J!`|AEiD`gkDjots!d`~ z*yM?vuzj~k9sWX>XZnP#>cA&#!6d;6TeW+_CQo0|3ER9~OWlO>Q=Rt+d)Ct5gt6Ox z$%gADM7VGyJn6PyvDvzCS%NBD*puxqJa*fsX8jkBiX-7kho?fDtqaEqo3JO_e+M;p z!X_D^6SlMscRH;wh41aoKI$ANYw$Xp3{Boo?~JSI=@=;ye}ZFVsjXT!iTqUCQkbgF z;}}_P!<|kj90^a_2`g>3E*zau*pr>G6IR)9T{yypBjHIqVYSWHg`*P+d$JRD!WtW{ z3rDyxg{!ZMbx+m~*a^#{Cu$P$C+LJ3TeZ^(g{kU1I$^yH*G+;RE*uF@+6fzMw$llP zJ=qC6VUrDaI-zhRJZUFvvDr>16!v5%?1Zg0-06hE6s``)2|Hm;v=d6ipP&=A+p3*T zC`?u7(Fr?kxYG%RBjHIqVUNvrI-#&9J7Fj6v*AuB6pn-^?Sun1+v$YDp6rC3aL|T3 zolrOup7dpsA)D=V6=6@dzr|zE+=gwq(^Z5c;Yqv7sLgh|im)f!UwG`9Th@jQ(bRE;Og@Iyzfk*t3rQEg#!uXKlE%<%J{R zNxSU4&33lDuqWGJcx;zlvf<8_7mkF>g{FLqj=XUfTj?nMMo{wx9C`6oHqmuY?8BQ3 zw%#nS*ovK}%(?#Tu2wJZ`CldQy`Yb`^VhxHy^K}g9{v4&`{X;0%=-@})pJ}b_|v!T zmRZcZLs!(Q1_#gGssC|ayq2fx@>Z_voYpWeJGZE}_u*XzTf60nTxI|J(Ye>9TZ0Mk zy0koz3EI^J;bu@L01xTc(MiGfcmsxbpg>KFAG7=vi*g}jt})V z+!-H)BjGYW1h4ViR}Q;^Jpiv9$`jcG8dV?5WBWANO7v>VPql9fdn)m-X6*K9vf+9) z5iT4FPr7|tY_=|3mY@n3_GJ4DkKI14Hr(l0!jbT#ryT7zTNjQ?X<<)x!h6}BHr(l0 z!W165XDQbmFXnc3t=!H&s=Gn%5bgh+Xfla85|pYTM2{`y?${zv^^rg(36&@HBzxOQ zk6mrurs!zGpa*caFBXo3C+)=pHrwgN!k+Aey?D@uJH1#q5}vdd57}&| z7Ylo`6ZYa^8}9UC;YfI*t~-?Ly5`s$5FJm=xv`9`a+0<4In{+jJB<22WT*qCy!36( zE@lsWjFnmReo*P|2lDhK9b-prb2*(z*wbA8P82(aXKlFCiG(BJNqhge&2~DGuqWGJ zcS}e~a!mJI~T?^sD zk?^GZ#JtVch079D;liHmg!{yj4cCPuTsRV*^oX!xvvuJ(uMzfSt6M3>+jl2>H~z!s zQbHGx1*8cL58J%AuWeb6b7&13Io$rCw^IO=V=yIHfr1h|_ePh^6b({mHd2NU38 zU!KSW|EeYkpM&h}o>cdLq;zvaI-R?76nC;AvzU{O8ug|VeX@~p-;E+q^~r`z5^9mX z-LtgF`P?GS$+b)p#6FVQ@?h@cM=LaE>QOaW_`{Few#g)sIg<~OHR=p0{4ri^UE$EW zim7y{rfM~qzm^;Wy!zyzR8y8w1Kc& zVvrrQ!TZ(j7-@stzE5q?Vi(}Ffv~%Pg+IKoZ=bW8bIxjZeN#1qyF;%0c;CKCwccij zOy%~DxE)ev(K}&{8bU%J_>!l&E5zXbbEP8MWdfqJ>EJGMRdm{bBGb-o>8_4W8xT#a z*0qp!;&g5W&F(LgM0R5J1`(RGJUXXL;+eCO=B$d&DUcVdCG2L^&Z_}r)*>1yi*F?B*Bs}TZ(rL4G;j#o( zxUeVNe=?9eMWVucY`88Q;lh#dq-QaGHd_~t(OlS*?JqobG#{|xx^RRGQ@C>{s8t=i zqzQtJtUn*2?j|^&jZkmDtL7ZRd-FWCx z!nA&}EBG5Pb|f9L;kxk%tK(90^a_d6#UqE*$+! z*puxqJht<$*l=Aq!i6K@bHS(1?8hwh;2M0yVrFY?-{O|;l)8jB-xnS{kt?JRtE%(p zXDRh|itzP%wITs&HXX_H`?T zp3}eFmx#*$b0hSo|7shq3rDyxg{%MPg}SjWv*Qfp2z8MrJIP_8PiLwxnS0_;brzED zRDYb;rzf>(`Dk%{^sc<*@o;L%ZP-9!m=|jTQ zT6r8DGB(`lL&A~pq&35{buqWH!`D6Fm1{?15A>l}P(!I9HX6wQ+fD3!F{e{Qw zwJkPW7mje@NcaJd4h5>m+M|O!c?m~{R$G`}YYgDRp2GZV9eZ?Wx8ZuN5iT4FPukBq zZMH5P1Gum!+h2HWKkKpKx^RRGN5Yf#vp$=x3zwg2kQMf1`wNflX9G4|7mje@NO;nt z!=TO9h079D;liHmghz)V8?FmSxG;sQw;!s}Jny4JtD4yv=C^H=ytt!->|X!x9UX>k zYdL*Lm|823qr<2TclwZUBs}R}o3+_a9}@Ot`#XQ^UOR5XojxQS2~WD$PTFi;I0kTG zPqx4C*u8ezhU>x+E*uFz;L)K_^;mm!kS8zU=rC&w(`$_ZT-Z~Xf30JW4)Zo#uQkGj zBjHK=*^=9UWHWEA!OMbaarsxTAyY zUjOeM9m;KM=}m#nEKIGH$I+qEhC6*oI1-+8udTA#P9GBXWcxdR>|R@K!<{}P90^al z*Vfo?ikaCE4*h3U1%050q)%)i#L zM~4O*uGbpj!jbT#{jAAm>%uXB3wyHtg~#@@78|Y$N4Rh#JZV2`wb{CG`Kbn3VNbTd z@YsIVZo_rq2p5ioCp|iJ+H768EI}16?8#1ebm+0+x^RRGQ@HvcV5reN@1w)8nwgFc zk{5S$klpM5=IBs-GGo8er_+PRbh4zkS8(-Y?GPe?|-SU(B3z` zrMo1UHTd6EZVjHutY?|!df(8R+r?$%3cX9Q&u%x}DX@zR({{__I5l9yb*DhMa3nnG z_%Ud+b>Y~>g+1B+-7t3i7_#BIaD)p-!jq04!!}zNE%wvH7WQQO3y-~} zK5fHw;RqL|aP@Aw$DD!hWw@n&1l>~Cx7gKNgVf)b)m?Qpj?|{J!7X-t8{)JIa>j{m z+a#L@!8~56nzgH=+X}m^Fs)7=%y_i3VX8syH)IXuwuh? z;RqLwgeM&jQgi;RO~syUf8nv?L7@%Tg-hG0!A3X|o^-cL+icz9vILba?8#2JTb0^y zT{yypBjHI0vT~cP3&$=i?8){Q9y^d#+HhSs!i6b(Z})ui@jzZ>v*UsKzr*TpM_r1J z2a+8#9u(jBW3}Q7pH)BP4R=5J6Aemf6-0xQWXBfqYxNPFg)hqIaQ1drCNIL@5>?S6 zB%6!S|I6I1H_NG%oF3l)ti0iRUY%fVy;)Ai#6G3WSs(YsNb`vzdGoYP{vGw!?uC!Y zSs1@rHumJJ%JvoA5#^`agM_KCwtviu9c(i; zTo;aT;YfJW!M5IJ>%y^j3VX6u;lPqlLjd$Rq7$99t*8?FmSxNsyq>EW%fIr0Sj|0p4{C2BQu6B zqK9p+E*$%hu$!CD&N*tsbEhFDOI}cm}XT554DpiIy zQ%E*fhN89=(WL|wUCN4zko#L^T~a@Y zw1P~+OTq1$;v1J#-(MI|KLRQQBc%j%1kC6mOK)us0Qg>~x3iz#a| zT2?^OvZ~cbt5jo|8{htquz26_@9dP7>i-BH{(qTQspsf={>W{+WtL!Vcc0D+)Sj|%q52US)nZQ#TI}b5^{^>F)p#%Lj%vX|{0FLBxa_H+^Y&I7u7^y73rE6} zo*J~aFcEcXQ`e!>6OSzYww#P6psQ-_`0;Zoh_ROe=L zhj@P{!rOMsB<8yuO4Tt@A1uq=gQYxG2TOHSlSx7a%S}sl)_LOzYONN&r&cQHjo+S) z|0qfD`K#cAB1Li6<=YkDFd@f-Yc#9mT&ywS`NFEF9j4m*sxCI_2 z-{AE%{gqOQ7TAt89E>h7ptuEgsQb(d73L-X1Z!v(n2jzlAX=cgCocU+E~!S<|H6Es z?+DehJO;*&RV%i0>pcheFN8yVMSoXD;tvR?{@c8GruQ6#3rE6}j#Y&=TNf@TU#gP} zd$RqzeC!!e+J@`G5iT4FPdZkW+H768{FJ@ZpY1O^cC0G5;ks~y3r7l1dUK@GX6wRb z394{mPj+yR;VZu5aqJC}D!Tw(JQg7AE@0vPzTDV8UTt%A;pm3KZf-uu;~E>Ti$=I` zBs^&!&)95TIJ%**C)?juV*7Z#4cCPuTsRV*w2wE~Y+bngR9!{blkG1&wvRX2a9udU zg(Klf`*@4Z)`g=B3VX7HK7RTiJm-e7eZ18!Ko^e%2)hedcs$Wf?sl823r9B;c60OT zTNjQlDD24&`uKNz_ljft_^@4oE*=XIb{DYlabIriI6i7~ zb>ZlS!ftLpeLQQ!bH;YpR~3p= zU#g`#hDd1j^%dV|KM-lw*j;?ZHmlR&ghRRcUXDz;mm}zKDaDcSq`P>b&2~DRuqWHU zr^N2!X&dfzHsMHk(p|jNX6wRncSG2d?Jqob7caNrx^RRGN5T(y>!d$?>qMS(XRp~1 z+$(8{UM>d|bGa<@zWx4d#+;YFf@yQ#Ws$t=R@!xSx~{NiUHuK2+b?7k551O9Wy5tt zqU#Dr!jpF0YMbqJU13kQzwp?uTVunWt}7e~Pug`eHrwgC!k%n@;jvw}-iA9}S2z-W zz^*$G?z-|sUhZvDx1~Y{hM*_6=X!G7%VIK#x$9T0##=oW*M!DmH4w{Feb-MW2^AcE zwb$F_i*Gzv?WGIP$SAMx&+YevGK0aI;nObiMAqzcYUYKXsCGlbi+?MnLiE@L=rzD4hOoPUe6C;m zY`Cr-;lh#dqx+E*uF@`hKoao2?6%C8)xMJ=yB|#q&L5vG3)|+HhSs!i6K@NiV#{ZMH5PJCU#_ zJGk)raiSY&lXd~Rcq~BJUBJR;CHKW$)Tm>q`R3)&w*$Ypc|#XOnb1L4Ul56e%1S?x^Q$dVNbSy*NZ*QEZJ~fIKqV^;Yr7g z6`QRKM+X!3Wcv$`9WzotaxXyAJ$6Y=7agUAM}H>%!4>g(Kky?7BO{U00sOT@a1tdUD(akxXJPi0ajNt1pNe zLSwNya>`SEK_rue3XZ=@z!_e`3!>?bwe23x-Yy(!?K}@uH8$MY+l3?HN%!`Q&35*7VNbSyr-|L$>utERw+lzYlkV*e zHrv_Tg+1A-@T3<+O?Cm!9xv=JAm0n37P|nw2DoMsb{Fvfk@qg}bsXn?=$?azAW{;b zr(v0vjvUE?UgUW{Z0VX0K>}k+L`h1feHDWs2nw+HfB}$#Q^#hniiE06iD~SF&Z~6l zw9KQqY!cltkNY#^#3t-C3Eeg|-8c<$^DvRv4&x>`-z1rO^>$1zT6VDMOre;GyCXIK%=x?G4c>haD=88c1=773`EZM5i5isCWbp zu>endLv+Srhl)qE39*9R!VS?`S3#(JQ~|`if~&qEvfotWdlj(6;BUoW`rsoM$lhdR zU#6d{dFf;LG6u3g{dep}%zk%q_Uj~G`VB{u1=RNH?!RK+<=`@YbQOJzbH3kvakIjE zzWBcF$b91FZ{Vf=`PgsK2R;2?J>MUGtkeHh@cC&POjtGjw5@jk*`=*Ha@NdDj$E*{ zQB@aWBWR4nFx36ZMvCC#CA9DJv&a6sYn+)NdSg>20c9kFMf95#gAQa z;9*CKz#$gkX~*4wRw9#%qXrtjAXcz-#p7|;Q@qQ8hl)qw5DW0MKgHMMu-Whhv4U-W zim#v2#Hwq2BL|#>*Lz(Bq4Lr21u?H+@oN+afg4BDYbrU18!8?}6Jn0rN>k}`;GxnH zIK%=xZBxlR>`?J2nh-14DVs{&frpAm;1CP&v`uBB!wwaXA_=jAZJNqQmVS>DIEkh* z;3^1}k1BweSFl(n-0)W$$v@pM{~4_WhCkS7F8||IE(}Irt@iTgcQkgMq0a{IAe|k< z;WNUe84gA4&Fda_^E$?FUU3=Tydq0%YjfVCA8I6a#mv#_a*3{&(FH}qo997tY0Ofy zxQvO){1n}c9Po|EyALI&Tqab^y{#fwVnr-DA&XBH=F`!WvKAxqYOyT+NypNk1WUgg zEFE&3@(xPVkz)_dEs|q()VU#!UEeCnj5+YI4M*S*3-Gif$ArTUJ7CngAy%+cjvO-% zJXAaahgg889XXCU>`?KjV?(T9)5xLFdQ*Zq?!ZIEBXEd4@WgsQTFtW4E%TUq!91pp z+i9~^s(H#{JNj24r`Lm=UhTL)ACLP@`-tU%SLevC1OeePK|r9B z;KkX$qKe!$47k9cf48@Z!cz2m6;J)B`&#|tCx++yPn)=;|Hy@E9 z2B+^JlZr1maMtJ{_Q222=KjLnDSvt3xw$dAA3ja@#uo@Npl$2>DA~IuMhSn`@p}L1 zm-aGcDhNsikk;r#45+N2>l@tULSWhP!I67sS$yA;V`-ZX zI6djr6DN#Fs=wgXa!J;LEPgF!T|{leasTkz@G-J8IpKqCbaM`IY<@K1OWpa7J8;(d zAQs?hJKsr%%{m{%3UqMXX7nm3&TZhS- zd@DEgY{FT=2G-NM6)6|I&p2=vTZk1GrE8RD9X3-OVg);;;^!PVQygLiJRD8&bAs&@ z-(%D}0t)Z{fny83ZO+xr41-vyJEdXs4xAYVu>zhhA{QJsQygLiJEh_m9XL}QVg-D4 zBeLM?W`;qm)Sc3>OAeeF2C)L3E+Us5Hd7p81v{nUR~$G~9AX80bt4k|sme$YD|M$d ztjmEj!ys0`(?z7mVY7%ptYD{9yw`y<#UWO}DI#{X+TZ;bpZiAlGxKJ&dToJ5u^W%K zIC|xr4$MG^6&+F<*yq5Rfe|S!5tqz*o1g%(=Q*L?Bk`PHEV@17{I|SOHHLkqZu+MFe66JEh_m9XN{! z#0vQ8Mr6U&%_0J^Qg=$jE;(=(5r`G=bP>7iuvtVPRah(N4>uWm$wujuzD zBv$H9X;_y7XAyx|0Z$i^9*4~$01MDh-sMFe66JEh`v2hJh_u>wvJv2!i&j`3<3exuWYMFwI;hm-~mIB*sjh!ya3 zkr{N@EHV%)*eMm??Z8=NAXdOvx3BDRb+d>-tkj*-urUYDA_B1jo-QI24x2>;Vg);; z;xi7MMFe66e03vo%+<{z0L>64#EFusqb*D7!k^^TEfmi`g z7m>>jn?(d-1v{nUR~$Ht2*e8b>P95Eq~D*ASgAXuVO)EXHkM!0Z$jDU{Sv}A+ds;Qt>Va&J>4O0Z*rR zkHcoo3t|O3rQ*E~oHZ|q74RjSmn6yX+s~IihHpgh{mPeVlY;2|{n}0Ok8&QT{R-Uo zB)Gu$B)3t9aFwVIhDOlHpSczrIhBD{CSqq2Q15bRFfe&)b zdw=fj<=Mg5&CNbXGFjmESM%IMxV$P4%{wEQhamQhfaWPZbisi$4?(Pedu|zv-C{p4 zF`^|~-x;sfE=uyei*bbmlYPLadmd(zgo^ocR`F4}9s?cRF@+v({&_ znAW$EdkB|T<)KT?2<9P(JtJCZeU}|L^AN-exYznF#%{5#&xn?6eZBPi2B^!9eYxd- z5&=cR);GX?i_6%zc0-x;-}4O;PV$o?IGTogh!roSY=pZVcmY`r|-a29ol z1$f%1A9L6&>JTf~DWiVefwQPXEWkn2GStW7P}^a_h`eFJev+K+et9eQib*u0^Rolq zC^5MFD1jnjlQ~JcCYlT`S7Veo0g^Y}Q^NR_XX2*QY?MG2J4$rXU=W79hmR7t3`YrMN$8P&lnDMzok2pJz-@7q=yKpJ>JSU? zv{CPI*evQ0E7&Qc-s`|w)FBq&`Y3TW4z(R6jA-dm!mc1;RR}9ce@4e>1?djbgikdt z{r2mx-<`N2xlGr~%v4dtwyqo*6Sl5CI!g>FxC~ntvLx(HwD9w@y}#q#4$<{8wWElw zJ@0C-^V)G4){ZQ!_CBx5d|ajVF|rt=lKW56tc=8HCidQKP?kg%rQ~j}7hIQJ3vxWt+2Y!C` z;?fOkK{hOu_+P$ZopCN?4GUt=g)KC!vksg!EQkeo+J<$`VY7w>v4WklVa+*k*03P< zz|YTKTDoCfmJJIf{+Dl9^Uj5=VL|M0R3|5Kf~Ex_apTj68Fss1@L%~D@lh-V8Zk=UQG z%PGM^1F@onZea`#LlRTP9tX}s1F-;48=78+%|ZjQf~_mwbSjc_;4Cx{3-Gje6@3ny zc^qN|TUWfP$MX)Hc^qN^p4Q`ahs`_=v4X8D-qhn89XRti!~$G)2I>`0%zdN#-LJWm zcr zN_Sa26+s1$f$?amisbk3+0r>xwt^_+ls3PH(i2x=AFCLV_voqxYU`z^mCBOBa^Ch!x#*!<$BIqXTCVgIIv4jo5(0 zW)Xu}!PXUT8nHnK&LRe}0M{dylMyo_J!0Lj`~^|z;t$au&ZTZhxpB5nA{tRM#BNf3 z@t0^BqbXuuA{vp0xcJ9}wDKQJ+wFYES`@^J@ASYlZBct1IBQW53-GipYRqA?76q|_ zO^SEFyq)Mqc&2Hqns61cRs}JyVDX!@a3*kLr+8~qGY*$|9Ab`ZT0%;XA9LW$;}8q* zv>re1u$jjpRhY7V0_Jguc?FAKq!&FC&rjb$uO=j(pWa88iHD^2ErWA^ zLE@zzn4WmmWI=~|^%PZ_U}#(tLzm{vvZO_vixDj~8LCc=p1Tj_#K) zV)S6IaMZu}`s;5YsYTyN*URXOB6fDsOE0H{vx^*^C3MGSIJ-cWgeU1m3@YE3sB$o_ z(i(&;{(60=;jaX*|I-(8FyqDZrN1eCF8)QF(9G8^-PvYt+P`q+#qj2xnS13wzy3Pz zNvyfS?=5RCidb_`Q$#{@&+t&;GBg)i66TJCO3+H#(|&I?_eSphb+5y2q~?^ICLx(# zn1DEeZeExOYoPdkXqhUIF|njP;HqFPA7Wm`IdnbxVVleUiL4*Fl`evT6Cd4Sj`Ulm zkiIw@$S9ipUbCdu*GoR{p~5x>xi|(k{>b9TKlD|We@B0bT@})>H@KXC{VDak<$quws&tBpko5i1aEBP?dGF!#@WqKuK z6>!+&GUFHbLnyfC=wG0}_&v*4e%nqK(k=a-`YLbDXmHe;A?8gjqMuYhrhD3fhwV55 zhgg88rJpkno6!%%3UU$izIn#QgP5;Mb3oIpvvKZ?btU!*AY&$n|Tzm{L^d3T1*vkbe5!Bx{T=7oV^xJ8hGu41V!H%yV`dzUptD} z+WTDXd0sm%!`hLBdHu4n)Qs!DOf?6;ia+M3z(UmX?RSUl@_*MI`bKkxw>Jk~{1Qmd z!6OfY@8JgSA#L%C)z-aZ%NvLy*1!R$!XTX`+>6W5Kx9d1kQl?WwaDX_5r@0e;XdQ#Yt;%PB@$4S6lf)cn#(}fJ0b&kr=Qx+(E%R!no8VkF4xGIr zU28IX(})&^$74=OMluj{B_j`L>==8%`^EO-4xD)aVhK)9yuv||p7YM0l%t{%c?Ks4 zZ=V#|*jgkz0L27}VQVYl6KLNbv4KNzd79YWcmp0-c?!iE6*L zbhY8cVfIC;b@5lQ_}{{0ixg1C({m*D;u}r2x?ld}(rZ*+%b#-GSmQB5*je~2A}0KxGuV0 zCb%eKYd`C1KgVmwWmr41u-bd5{F+32>W!}&EQu^i$(4K}l$iU? zC5#E@evrggv_AKnCmdz0f;fh6b?$e;f%9H2!0p^`4&LH(zj@=p*$dLOCbKscYGJIq z=#*q*9mJ{!v^h#ss$X#6%mWZha5ncFq@mCwHY2)vgD*Lqn86TBotjL_ni_oBfir_4 zmf+0bF=?<7c?KsYyVox}+3h1t>e<2K75YRo$s$YKa#3%!qgK4MZ97==>B_3C($)VR z?~U*w&6gn--b+1S-sr%?&_v)63-Gk_Z3Mz+2wh&xF+m)E1PxgDw&?kP|16bBSt?EM0B*OaqT5 z{^|A9(icC1^~Ln_>)oV;!nzQ9E!y27{QT0-RJ}WdJ+1<>C)i{@t)PJfVqU@Gdw`qX zf-zSC>+lfs3gSD2XH!`);VNJjK+G#x>~7718CL2-w#2hNOuSOHg`s>KeXu`v0;(Itn?A^@?1os#x0J8-5r#0q#i#jiMQrZ~h3 zc1p#A&)aY^#UYm9_7#6RUT2;L+28I?B-|1u?7r}g?)QEkjeu51!`zAK;0x3{qsKn4 z5*H+=d*^2_)BVGp6g<0Va3#K1%l z>2Gq;po^{}UTRi*Kv`_GSmQB5*je~<_IeJ*r#v#+EK*TKHzE}TwDVcJiVt2xU z;X(x@vFBRnh&_a(a0J9Le5(r;V-B2+SP*k?yHIf!OWS;*;+$FSo}H8H;3l(o8`}ci zPdFvnm<=&kvK5w`ap24Y5KC}&-`-2J0dJ0NL|1R{F{cwV7-FeY+J%ba4xAYbu>@xZ z=cK_#q#NA*%C$6USp2uRlQ+bbc)r&sk&LJr(hQJtxF7S8@)F62Jfs9$V#db8X0p1M zjut0T4Wkh@Q>4`7MChdRCJPnB(whiX_sd^T^}yhitAK?IVqU@G4=#=CDSq1FGQ}b0 zxVBSuzx?5)EAXbDXIuqLafo>Zi}!|4I(jIS3(bd)G^>G_ zYe(j%UT`|+z(dm`aEJwX+6AXMht1*!v4Wj)0z2=(Sqf= zVHmQY*N753q+Rub)4NDpnqXXtHA*fxU6#azoId9#hKOr`xBL>!PlVO>l9kF5Oimh) zoJ&-@V`bHTEvz=LS6i3WBIgp-{@BW@ty6o$EKaX>Kvs*KOH_MlW!1hAR=ZoTc8{zU zIhUxm1ia?4jh=%44&_?>HF{0jjDG2EF)z4IL?H1J6vSR9!h(UJgm#$#L2SW$Q(4gEDqt2s%qv*zY|VlmR{@Iw#Jqyof}2xW z(CaE-7C_7^Sp3!hMq>iIbI#KmM~-@rT^6Y?zbt|x_Rjf=y=i1eIJC8Cbq{6tT5;S^9dlhu4nFuy$lg)XwI!%PfoZI`o`5i~Tu6kr`sHq#c>lJa!m!;LHOMOK`TnFd-*%Ms)QCPdJ^J!4ONG z(k`gXIB;e##1fntJR=P@BHiHbS9a1p{NjHj)&%z> ze-=NPcrV##>_|8Eo~4g;lk9^Eu<*pc-HpFFN%hvOhtbnT?kFmX0dBI_aibqa?Siw%I_(ccKJPxq{PrKB&;INs; zAy%+;#p5UVURS#0z?sJ(R>0#AFcxU!S{OKS-HQXS{UQB^)pvo1!hIRBLF1PwZb7)7 z_tH~8i{Fs=5{>DJA^t2~MpHMwj{9@hwbY$1J2RM%AXdys>7y$SocRc13C{T#H=ODB zsSN&x4-Qc`fLK(RdR4m1fir6$mf#6%dQKc8YiK96&(S~HpL6&8{_eil*rv6!$6K?v z$En1+Cd5*uCiAkm-+L{**MYOH39$fA+ck3zn>9O#73`GFuFrw9KtU|PsVla-Z=)z^ zCK6Y(RchW<&O!pQQn_wf(~#61I135H0z7R2@~^Muoe#Ry_Wo0O)`IB*sthy{4sUUAG}vlv0FVC#yY+doD9zWy2na3gK;GlvWetH0tkVNkw zdAy0ROl*C3)U!@A7B7goW~Nfz?56QL=fGLKAQs?h<2C27S-c=tuyw_o#%tbzvv@(Q zfT!b)3l5uk9AX7KrQ#PIIP*Bf0z7TkUU1mV;}9#@y5dcn$|VQRJPxq}p6D6N^G4!5 zg&qHu-PIK6GI|5|7OIv%Y8s=T&b*&)i|nJO3H+31xXPt3MbJ+=Qx^L)V(`x>JJ!rz z-A!kSXCb%@pGF`{!Z_Nphsr0PMjVT)v`-_DMOmdk?v*?#OCpO>@|0Kdv@D4%O35=M z#tRhIL1$%2WKl|<^GeRilE|WzoG0`qWbsR?H@%;HySeF2 z+kq~-HqLrJ#EE7Q|D>I^hSanJU2)*7=R+*O(~h;lH}(5l5-Zqx&u==`b~$j?^C1@C zJ}0^rjM+Nf$=Z*dGSj!))3#~1nPGeP>?xYUw=jzwp#2DywLgdz4R!OI#%<7nv$#Pl zz|+QUx5H*5HpB|Hu6Wb9?Q!5NZV(Ib=5gCdaa)YylGePOdy#;d2eHr~^(J9`4xE_> zu>emy5ab;;QygLiTaQcA232?9OmT<>_?PJsChoNC7Ct@K{VolzwEg~W`Z1RqXAzth z`b&@N(QKT9SZI)XIjq-#v;G3H08ibZ95#zfPRG{c(zL(yIdB#ih=t;Qe=(6rE)S)( zEbl63A%R#_p1P~l9XJaK!~#5RSJ~*WSx6vOu=S8M?J5HfoP`8p0ghKw?TQ_`3=fGF zguL_OdA`irVm}&m>an0fEYwTgk9Iq77Bq+jc-q#s$6>ReL9AfwL2KHN#vC{c8pHzJ z??-&TfS_UCfZyWT-@Re}`I|_Bz42%Oq|MAI<1SaR<)A4KW9|(WK)Ebhzjj$=tb# zNZg0MGcrlC6Hz*(pu z=HLib)Ok*zv-qK6KaRyi*76Tzops8wkU`9qYb9jo95@RZ!~#5R$mSe23mL=;cFK^= zJ8%{saG60ixI>EJZ-NCuJC(u`^cTd3bw9z(}AqZfwLGvtbnKM z6+I4{c^qN|JEh{i4xD)$Vga7ESL7Tv>lF|y*t+6PdqtlEXC8-G0Z-K{>{1Z@vdZJF z?T@*K)@hULKT%tQSSXkJ=4s4)G<2lz?nr5OYnq6^!rMeTZ+#~S0S?oVo_o0 z_?&X!%o>O#IJ2fs){tNpF{0xMv_9J5BwQ;B)1sRonu43_Fm0eUFPwIYhF*ZW^mZY{ zQqi=p8J%(9p%)@>hy{4s#(36Yv+zNzVCzF=Q*t`zz*+bp=HL_|7Y(#SY*d5jh37pV z3nR4q(-gsZGlnFFRT^8unKu2l-%C$@8E*tezxtKd7gv6l51x^qA?E6m3aLA0@SiL= z3nIh562 zeb)RE@d*nO_UCth9_zk*<*Ms1O;4W7jr z;4CB%3-Gid+32uYNFY|Qb;X;8WWa&5kU%WJ{g9X*l3ZF!YuTWyoP`8pQF-d|a<>C# zA%R$cryVc%IBXUYh!t!-Bu(4Wm;+}afmnchV_=U6Nm|P$T;(hz5R1xF&&FmPI135H z0z7S7I_9uhNFY|Q^^i2}CC42&3kk#=+}(i1&*D3}XSZO>JNcHIU7_zefgz1nwkz0;1{4DQQ5)fV*h47~W+ffqlv`-^sRz`_PGSFjbn+2g=j*dP|*X~Q<=uvyq3 zR@Sb(RE^%;lFVhyo^tt;L%)@L0!i#5a?98n1$ zee|3_1Q0zr9Jc<1>YP)Ag$H7;NGpTioC9a!fmnd24bQy8X5oQY!A=>T3l5xx2Vwd+C z9gBC6zAcPg^Iuix1rRGLrL^~g180GPSb(SP8W$Zl3lzi(wyt>Gd_8(yaNsOZ5OZ*P zI6Jr0NR`&AORi$pZy@FsQ>CeIcrH6|77mC7c-nq*#bL8>K&)Wv;b_`#0^)@5nF9+4 z#2h>dhj-Hx5l6Hw+BQ;fap4B)E%AOkb|aH6>WSV)COr_*&l=;f^b7AOY+rakNfUqb z_VlZ#=q&NVJ1)Z)-jOAtefZp>`;|{az4y@{t5Yu2i6%qtCl&ibo$|3x_KkRx+1s2V z8Wp-<$+Z*oJVDDA8-M;hdjady$qg({oG_whs1MV+>f#?0^pdC-C8`lML*3m;r~&<1 z5_LhM8c{RUX?o_hxGsF~rOz($9O;roHKJyyC+U`Kv2O3n62mslYwRuDjkA{}su49q z{aJdoe{mQ6S<(YnB&rcfR18JkugueH|BDm!hfuw4lF&7vl}@h>7?Fp%`0=$7P`cT{ zf?MXJ#u#t@2XUfD#QR6w+WqqOrFT{Hez)|JtAGs{5c3KazlpU%e^--uAo8X)mmMxs z9Ab`ZVn#o^?2P?z&s8yuVC?~|2B=sH#%JAafmr?D;^(k z;LPI?3-GiaA9UEv;}9#@#^ZmA`GwyWn|ge=tAKeNVqU@G%NlMxT6x3a9*4_34l&1V z#p7cRoOv8#0iM?56Aqhs9AX9Ac>MFlGB+~1_}_$gNb^Ekx3g2ksb+@>Bs?QogLA?CQPc>Ih5 zXC8-GfT#8NS%=L$4zYr5JpRvVQ=pZPD(74U%;OOA3KrkCG_E(Q%sE`!qiKU$rk~k5=|)~=E_7JBdct{8H1zrr?T#GRnCF4FhMN9 z({_wLht0wSv4TxuQWS4WwRs25LIg1fr+Y*5LXzdWaS5l%bz+;4JhId*J712k5qu)^Nmf z%fN}~x#NqogSfNgOJgYIZ`4#y{Os=KgSAHn3#I&E zCHnL%mTHpWHOpP@SCtYwK=vlOJ0>A2b2jtb$4+12%o$oa3$bTt3lp3(4xBZ4h!ya3 zil24Ztgk|>V5jV>=Nvdw9AXJhLv{G>|EFln&49nAc?wZZAC);*KQj(uS$~rktmBaL zR{gPg2hNOxSb{s__IKOwXnRh;s_3~mzSaz_Z^6t9P7`J(#8Q*AW?ppQ%uI+C@N|uD z!C^DSAy%+cHoi*^oGA{m1b6XK8sF*G8sBACKQj(uS%2E7TyfycIEW>EHz1MW|sqJWObdr&>x1+$%NAX%I_r=BcsR zQ})FWBk~^Kw=iyYIh~ln5KEoX_Rt;&&J2cFf-{3>q`^jX^#=DkotVK8OP$ghoO9sJ zV2C9+Gx(%5*ody);6A4lGZ@xZpOyw2(bXGVcRDeHA(lF&HF%=~ zX9hzo!I{D5q`^jX^#%_(otVK8OP$ghJm|og!4OMuX7HRe*ody);N4CqW-!E3r?dv| zap25gh$T2PcwQQ8M4rKkNyR;M$3_s*hs-xdM|VAYIs6perq5pSt^=wuQGT||yYBI> zd%f!%UGtet{r6sfeI4#YF!`X@BsbFaGBX(zu^c_&IC_S2G%iDqMwWyl6Y~RFvL&dS z6SWU6UptD}+K;)~kMr7b8P<+0aqUUp<>8CuV&RDsM&w10yK6Vqj_6o-?O9%76tN1Q zbPAv13ga?V7+ILYQKPtVcDGd6h@`?}RHeDOjDk85Yw4yF5P2oZJ5h_fadwZa%!s@q z+&eP_n)J@GxZY-)OrwbP&S~eJGu%74484Oa+&f{Hpl`XQ!bT(&K2B98y>l|w(s~D3 zH1CA{?Z(+-vN9u*mAN0BJU@GiK$G4%9oO5;J1AnkbJlt19QO_`L+>C9_f8KfimCT; zsjv}Ah0joxN$;GEwY1(r7R@{1XmjK2DOs5j$;!@omCeb@kVUI37g=^jR%S%9va^)a zbcmOJY>piDxnDoI|M2AW+j4#P?7Q!6xt&M$PK`{CPfX{&yuC0Jjn$5p*c{C<$+rAmTdons+8;!~S*lOFIFQ@Be$Jb;YTaP_%-nRW+{X3{Vtn?U- z{hOmBV!EaONpscgX!{cK;@@(0+5GU3)zcnrz0Ho+Pb<;O*Vop&Qayb;YYA1s5KkFE_=6DRS@v=wTPwkjsk9KUZ>6Ux#wcpr;C)X{ImU5D+}4OdfNKQ9?Bj(y~3l@i}I6Nrrb)7 z$#SKr+)9ql&K2sHv|}as$ZzryYdxL#XWNxOAMyK}Z9g`jjc>DKvv}Dyt;HI$xF3g_ zEf?RUA661ySAW{LM*QylX#Kg&F}4RiHXdiJAGbf*zpZ~4O|I#`t2wvhmyMf$wCV9N z@-O=DqeF0AU}D+gxf?e^JaiR{*V4HiU*NT?(JNW@=|Xsa+Un8vZFp{V_1Xz{(fHWf z@!O}@|F8VjQag>>mnn-j@pLir*(x1vY`=ZDQJX8S&N0?^b?}~!^s>0y&64}Wv$Mwj)S(GwjqBk!&Q7Oa1yb1X*84HjDJ+l{1ex^wr+d0-{5X8B+gy_giK4P(Qh;U+5F!1 z78=6w&!(roj;h}h9Uaap$sc_*2=LG1roN8!c+}I+UfZL?PnqAA>!%RmpS`xnR^@S< z3fr0OYo@JG8?k*MzV`A(ad!FKHP2_`ZI3p;y|zc&SF9d34)$ov*=u|B%UOTeqb+Bz z?a?o1{jvNp?w46=^ZkQ^rtdU6Ci^z>`OtYg_rhnVuU={T>IW{X(ipprmWSP*a z<#lUjr;plvj^-USW^T?6h** z{+iii^NYL_-@ah`!)c}J}0n8tGC6rN9#Y-fpX3Cv~sJ{ zQu>1569StD4o2vzHD|3^CQ)^6?W3rsp*&b~g zbZ_1FHYTmdz}je!)~Bl(n^3#u`-_cJv!m@hOCHIeCjEcHamUVR%=$JR<8j)?eWk}R z0?qtt<+cqpJ1*x}4Ao2hv-LDPZrViigv7tin`wTY_?Jx6&Xaky^X2qkvR#pFl+OCT ze@*?KTAdjOS~{BgO$|{SUgdK?Hk+P$9Iq?}tsafORKC??tM#t5oaG^Vw0vZ*?a|8p zHf6^`zb#q$a(dW&%lXIV^W$UX%eAYO=X2x0(9SJ}VljtV_IyW_x!Dn;&`NNUc`W}m z!?bdn51J>-C(mtOd)%~%79i+9dram{p4$S=C{YqQGNE9%$q#7`R&o> zw?{hm&JFqhsI3 zfj|82TYm2Gzx>quO~yMmhI%{@rC)x>V}~b4Msp*F4^2%EADX5&?8hgkj|?B6SLhGz zn|d3)Q~QC5(SZJYlK#D>e^dkI}eQ`fR zdI(5(aewp>RWy9)S$bigaJL*D-M@c)WPB8r(yRWXGZVvyrp6B+BCH(#qj&$Ohx2q2 zUJn=UFXZ1_wAaH$dl{zhHOU1O4D;_b86ePfquM6vy8)^$M;`#>rpBK=INWDy92&Wg zv?Gk+0~2GWev1i#sUWNamr%$2XY!9tloHpu5H&vnnWn?kD0zKf?%ClZq{#3gsuek% z*;K|tgrGZAz~K=J@w20c zDPof!2zHE88huwWO|gC(>irHx#41L)_nMFexqVY3aL$3l&*sMHI79yqP16S)AD9Ss z9iD_c3D&hGAcSU_}Z(k7H_ek6a&H65_-C`XUYpP~_^uXxI^yFdcz0>0( z6`#z9!O#vfH5Kxy!I}S{DZi4;JBsk@11)sW{ zsltvmlNhFQnk}0Llhs{qT~ivuAz$!u zaOakXCX($sY&(yRPaQe1pN7cX-pTQO&yFUPHEnC>LpyECDAC`uAE1G9Uw-5u5_7}P znUmq?rpN5{G@TqROd0Up(V{uY9W9yTLsaIi_Fpb>Ze=)92JK!|;Yee&)g2 z@P=BkuQ2uyl}WZe(+uM_nP{u54JX<*m5$rI>kDc65cx;w1S_jE4_44bD)5!Key~i* zCIF;?nf};5XvZ19uiJ5tvb*unj=>aHhiBu}Y}~f#eZw0}{Izk?rolF3;<243mXPC| z%^TTT_H0jFL)UT|+nd-MVpw~=z4mf$@oX)6wkED&Yth-ddWr=A9Y3-?H;^8r#N;WV&s9n4@E^?#o?% zA_k(C3JtuGU-`AYH?sEuw!JKO-(d6gQPVd6#w!mN^HwX;$G&b50TQ>Rhk!3x#plxZgS@1Jssdn&;5ai_b{%1;g`4L z1fM@NUmLOc(O+nUG_yhz1OJ-lQ}7zapwef3NLFI*p~`6<)4+slL#;vfW7-(dJc_N~ z(6#w5vA#ps$@L$@bou1^5Y2?bWwV?%N0Mt!XiL5xOlP#_qHRtT`=mX7nu0|Nhe}54 zU^KDh>ty~qnwfce>uia2I3735`<7qJTh_+bP+eH5!r+-_vKk>x&C)e-XvST~VIuh5>3)MD#^Ny{L zK2Gz4=o;@&G73+P@9h(KUU!yL0PyQarlewtdT{Z3+Cx`?tHat$5FW)0SN} z@0Nj0TVb-j-n#v%C%5jR+NQ?8dvt2#z>)R)hNqGK=+-Cb3w)|3d_@Z)^*>Co9uG3X z0R6+UM%R$Nnf_(yAGW`-=WWqB_7;L%%X>G;Q4V?U3WAQS$$LYDb$x^d%w)aL+3JwA z!Irz0@(%Jy=KivF_2Jf3{rGHl$-+#g@mDnmUyyJKA7V7yYw&k{I94x?wNs z#=kowJ+R&W-?tvi`M~-NG4k4g^PTm%^%uWxbLHT7#5P%{&1>yOdYxL?x*%)TxsrLU zEEywNE{ruVmrlm)V~Qr9HC6;w8sp>kn`Ud<;J&V_|WVb)~O6wsWbvVfX6S z-R^w6RNe5=>et<|qPo%Vo7HXOgY<#mnuuoy%-H7hEc&5lBm9c-PZ_%mZvZ!neyn=j?n}3toP_BtcBq>Wyl2<#mJI>GHq{ZyC##tlc(S_caw9Ep5D`Tml4rJ zsYrBcPg~B2=z&!vI=QFqPKfY0C=wmt({@KFnjVWp$M&?nIm&e~5?vW;TL%#y2t}gH zLv5eSUZ2TK4&gC}MSD-%uNmRgk%L1Ahi7cwqiw&O?WDZJ({$fhjHL5>+RmBGMp}rZ zb9>r;33(~w__)n_Zcp3)<%BlpnLTZ zl({vNdG0wQ$R3?&`(S1*YKvemeplN+hTv%4pt71)6?y}Z=%X3%ys+G3om`Ry|MR zCj?)ol`iJUuLxyAF2JYc#UZb+?8o z`;?@0l(av5XGdsw-93~@AykSzKq(mCl%yh(MkbV$I;D*49iAGMHN69c=p7f4ay_iV zTPf1#*WVT<9X_HIL!^v?1qu09O2b=gGUY*(8W}k}DU(WVnfFZ|oRSG-)%zw692PnR z9k-C~`w!7;bG$*`NZ}xzkr32a!_IWx_-4}JP?$F0r%^bliJ5Zm_R}6}%b=B+#P|7$ z)STd4llVbD5w3@SP3p^D>P=(mr#+N4QcLn{Tz?tT;5 zN!~N>l)c$YyZMb|$-ya8ZoQv&S7e20gYWQDsUyHfw80%bE$Da?sXH|9ba78jAzYLN(x$g|#6<<}H++)DwV39jrX_Yg83c$kj4lLxf(9%^yKgeGm&PuoBR z4^Nu3qkdY=r0p|_-{&V%&jdA?#E*N4Z@q!W^N=e|`p@|3)KZ8pP1>BF_LgvPGKpXC z6KND7$~0+zSb2OIo^2LUv6=Dnc$s;3PwYQV= zC@FY_m+8z||AxfCalzTY>$Gjl&Bj~?2mm4$DzU}y8vFY`{O zH=7wA4t~s6@=e*y-o3$3`{Fw&H}1`T$xrwW!0Zct!u zpX7h;%S)7h^guPZ;wRKiLMiB=CqT(&+WufRV_qW`o@y^fDRM5IB{v;X2C?kTB&Qo( ze>lp%f#l@Zp=T$9n>+=wcaqCZID` zi%cGt+C7454um>v_sX?(nM7#u9zO|Qpm79NjrwV1F{b4q=!BnoSC|Ua5BX{LQ5xNs zj||CP-3IGSnw-j3}CPrE;xnViZ8zu?Q) zXKCyn59WM1HFLa?8T^)?Pzw|C!594$YA`fI2>#HM-*7{uRzCQ1KZzn>)>VSP_ET;p zeJAt5>%N>^PvUFu=l%5ta>`_WG`P)|=OEt~e1|W;o8%Ouyf5#A(kj0cob3f|?X(BMJ=974$V`Dq)eek8o#OXwz#pwQvT@n?e%@x-8`ml_JO#VFmG zu(om=wUwiL5A2%=mm-oQ*=;nCAZcnOAH2lzI&Y&EIsDv&S-xOpFup!FH4>ci3*;#Q zGn0JqlYSDli+wa=nTdd1X-k5>0pkM75|11Vex4VnM@iis8CvdOW@UOiG85sFRT3%l zrVgwdX(@N1z{KHjd5V>}7bzuSYUY6mOGzqH(&)3rNn#)@YBIRDb@_L>!B2UhlWuGe zn6w2yt<;%$)}(yRPiaKD<%7TTlQwpupXP)12e==yT_%Cr)(t!*=y-!Qb!d1m-A&Qg zLM*n|!{o^3US78I20|SUjqdZ3x+!UIX!YB@q#jBd88N2)BQNPjO4_&2Bt7dT-9$;F zqbBKlyri2cY5#tc^aEbft(5d^=*FM*lCGm9ESnJ#2cPlM){;*SMQQ$QVC@^CG;|M< zn2QtT#AEIKacW7HEmLarU75grn9`!}%>12dW1vYyF`I^R# z-|=kE-elx-S9~=1lAm@vMU~3@kuSf4LOM#biQuxIayJD4A2p89Th3maq}FeSyPLg) zc6gsww}UtHgrFlwDHEd;(-@w(G5Jo6o_cW{3a3?gYCZf4iX`6 z{;&9HZ@7lKfA}e@ACk5^k%pf3alh0(ltTIi|H@AwB}|c_!v|!Hv%Ov9gm4}C7rc_$ z9HkY*v|snq+Pb?URCNtH=(vt7jDo>C%NpbMk>Edgh-=o7vkFteqA$;pyf_lP?#to! z;#6=eJswW>khN5?v3DQsM*o1HNR>y4#o+BcG3dCJ8c?)o!Wz)cRBCS_cqh-_c{8`!PRhJpqMDKj|k`plF!( zs+V>P{6bwFP0njpLB|^@F|xeCOz(y1!KXP^(6P4rS|UBV@#C@W?7cSgJPo$~XxF*U z$mJZe^DauDbtt9Cy(mJDp5+9ovvUKbQR9;Jl*5D}IT!1EJ0;PCOP1M)ia=2!>6$f^ zL{C^`Mc4F1DP>vc4N+1>CfyMwh0ijRt@fIGC@JhpzVohmkdo;3Q`OKId}Q*FoS0q% zgQqD;QE_vWB=zW8OG!ufJx_Nxz8+mSQ4+XMrXcL25b>;*lfMhxhLvQUlOM*6kZTFs-LvOIA$g^|UqAbZPQ07h2Zba&6`i5#cD6 zqo>PWAL(3kCt=civ9x={(80shFTD)7LBAGHio);G`P9AVO(w~#ntq9Uh~7o&UXwuz zFOs=!jd^56-Sxln5}lcQ)k3>77mt;dQa0Khf?YFFNijyf!lxe%j1b%=WI$ zjP8}4ExT@QW}ha{t-K6K(#NJ?v=kLtkM~c$sCbXl-_jpMevSA!$zRyp%XKm(vNces~;eJvV37)nH z{aVvvFlKr$7G(2l(L?Fh+wX+9+qA|^O&l2KE6kY zo4MeL?c0i6vUArauMnYZeUfMD_kpoN*QOm_!NDEB)C;(a!$rVPa;oV#)3qnF4H74O{1Id9+ipa}`lAdCuJTHelLp%DP z*!twwC$_%FSMkYByS6^vPd{?#l}b7QzuL&XM4xeR0huWTk8%lqCY4Lbt2?&#dj;u- zoOmvT(UWZP!|Iw{qMQ8Snq;T>D7*S+9mzC)#dA_;89Ps8&16;){y(wu6L;b^s_g)4GI?1l7aOZhs56GKy&T4*JkMd)t5$y5?V~aQ#+$#v4!Lh z|JoM;!^cf@b7G)v=4!zK+4KPu7Ik{Soc}GW6Pd$p3by^|r3ee>W+&+LUOoPfEBAGpmeC z2!x;wH$?;?(#o^yh1&(kv_QaQ{vaj3_<+I;fX6L{8XQ$hLXiX#zf5RsGqrXRazhD8P?=-XD|5GIW zKC2Zxx--cB@LztN%4co)=#$UvCtmoEpJ@N06PqtZvkOq+0~ASo++hC8WN)I^t*84c z+dlX`*^gw}GMT>YJPz5PZpYt~ZS?oy?C)gSvYG6uHvH{wyCGB0eh8_jjbJWI=Y82< zLV?ZeZvSfZ@Ar3XUYFg}_TkLB_pQtB!m-KKV}SZHDjm2#d&Gd;|Ej!fMAk|k&i;XEOnuqkMcTl?GuhuV z&FT;7?Yc~M!JIF`zu8}duWx_&_UvJJ_>D`2+;^!pEUfE5zAyWW^b-@Af$Wc%_?f?h z1K&09t+2gP;85?Q*?(<3kgd0MX0o5k&}RuOh8+~6?6XjY(w1(3Xu9X_r|i$uHwoG6 z+NPHbzv&DK&pw7iKMs`$f*de~I+u*B?*RYWIE0!^ciT;w?89w$WU}8y=-IEJ>12Nh zHJv<}{p2-te0W>fyt7|7jsKhQ$bn}f*`L#UiJ9!@;mc>TuOLd#JQMkl%Kx1S-Wal& z9+I60#4}kV`AO4f;F9kqA@yQ9+vLt3No^r-a=yL(b?V&c7tfH-JIFC7v)?e5y#^B! zVH!lQ-Ie`e40a#So;CjZ@#`p0R{q^+OufB+dv^9loDSTM$Uc1gx7=Cw9}~btu$~~XOL1FLrrACCSw5x ziZ@f=!rz+{=V|4=rtGe(KxkHDh>SK8wSW_5SiWSU^a}c#X({tjA2DNYnx4T(&Uabb zYtx3H>Him$d;g{J!Jnm#tHV9hF4D#=4mExmb&u%;b`#{(;CBb z^Y@wh$w<{PX!?UDots2~{Qcp? z-&ZhYqOj7O`1b50=A61cagyJ}myV%n;Ly37=CI*heLpGim%l=e5Y`w2-Lnb@W z_FnuslF9x6Y>aF$^ZgOJ4rl&Uj!ypurJl(CKqm_K&=$9}N%LM=8^R?9U)?_7}|G5Yzk}$o_lN zX2QR}ZO+Z#4}LKFOD6MY%-@|bkHE>tt_m7T!YsdHwEK1A0-D`ZPBS~j-)v@E_WOal zIr{|ut~2+LxR3nr5p8x+16|3vnXe}1f82+OtJM8(>9UW(Z{ZweX@*}pV}JW{qA7(# z35{PaP~q^hj{4k}%=p-s{qJVf3;({@0SnDv>W#Qv=nIz_tg|DBeruJlzZSAl4?XbO zX8wC39Ebj`X@oy+ZjQpgFQFaP6YC?il7z*i8#8a}x_NC|*F9Z5owU-lKJ)gqjkRxE zn_F94d+&8^T{qHR1@E|y_8=$+Z|^`tk@9Z6IlG4Tc_5L=8;d$_kBUD`MUkh|&jYM$ z?he+j{oe=&8!%+9UAy&WTDQ3?c+2%0uBQzlZVG_6c5M)>jZQmgJqL?n_>m6Md8X&O zYr0Ni5sdzOI6Sz&a}S0KK<(`$x~{Y5d$a8~(Af*0&$RyxC0&bE4!XX!lZ?fG;UXKY zrzyDW!Yt-*THNGf93DkZ5AO}uPkrE^IZltxOb71Ce)3fa`>s&<{X+bvk$c-JepM_w z8w&6SEZ%^QUX5^Xk-87(-8=5_OPTTaM|RP0C|FM)TMbVS2Sdg21Nr?24i8UH439iF zI=wz0(8oJPDW_Nb{H%pWKo9Wg)52l;_-XY0LkH+Vx-S@-IXFITr1W9v^w7TX;b#xg zk0FeY1Uq-_*tT`o;HE9_94ghT0rpiJHW{Cvr0;DE;QoWtEL*L{FRLIsdx7gt+flI0Tq}B^Ni?B~@vmz^2smp&BnTtAelNXpk_6B5y7Elz zVuPt&Y%sNp4d$O>gO{bo2p!^PXxlZDglY+cIC7o2x>(~{)wotQW>K-m%T{@6HS`>P zLq35wx>)NhR$0J{6&9spg(Fp1l!_H@LB)e&jip%T$h@Hyc~dGDx%EX}Z;=Oqx4R;5 zXvG3ATi{9-xRQCUWS(U%G+1h(&SFxid#TKIg*sECP-m_y)Jwt8(8S^AC+p)%%U8O2 zP4*A24R0X@KC%_cHEvmrd9+Yv?k`XSN_3|}wGf!M*33t|$pqeb3KiBW3w+=!lsRab z1)@;m&g276fwz_dZ!Lu)w~aTC0&fom9`OPnDhhe7WS&QjHxJ%A8cc~gb7-A;oA-3y z(K(Cpm{Lfm-cR2Qzwmk~S8lszqsbQEFe5dKIN!MX6U&>Q$7UC`wNh zrS>JMeMxFxlG>MKjU`!QN!nPFHkPD~C23 zmfDx4_7$mpMQUG>+E=9Z6{&qiYG0AsSETk8seMIiUzOTdrS?^+eN}2-mD*RO_Eo8U zRcc?A+E=CaHK~0~YG0Gu*QE9}seMgqUz6I`r1mwbeNAd#m)h5*_I0U!U20#K+SjG_ zb*X(_YG0Sy*QNFiseMCg-;mljr1lM|eM4&BklHt-_6@0hLug;g3+*d;p?xJUw6Ela z_LaQQzLFQ(SMoypN?vGRkt|w~j9ih#T9G7Okz89TNbL(!d-}N>kEAOFseM6eFS)i- zkiM5(TajE_kz8Am{8*9vSdolek&IlCj9ih7T#;N`kz8AmTw9S`TajE_kz8AmTw9S` zTajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_ zkz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8Am zTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S`TajE_kz8AmTw9S` zTajE_kz8AmELxE)T9GVTkt|w~yj_vJU6EW{kz8AmTw9e~Ta{c}m0VkuTw9e~Ta{c} zm0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0Vku zTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~ zTa{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c} zm0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0Vku zTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0VkuTw9e~Ta{c}m0Vku{8*Lz zSe1-im5f}Kj9itBT$Nl~m0VkuTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{ zlU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!Sq zTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y| zTa#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{ zlU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!Sq zTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y|Ta#Q{lU!SqTw9Y| zTa#Q{lU!SqTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0 zmt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$y zTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1 zTbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0 zmt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$y zTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yTw9l1TbEp0mt0$yT-%Ub z+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_ zkX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4 zT-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub z+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_ zkX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4 zT-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4T-%Ub+mKw_kX+l4TwBOXvL%^#JBnoD^(c~w zH;hOoUNIt>c*lrj;w2-JiMNbMCSLI(nRw5rke9SeGQ|!_yp&I|LsBp0Q|yrBOZgN# zB>hr8#STfpg}h{7k}2_!98CF?ct{qed`dhd4^uuR9+HU*c}c}2Q{o}XnDQy{kaSG> zlz2!&rhG~~BqdWmB_5KL3wg=PBvaxcd71Jl@sP|+`ILA_Zl-)nJS02Q*Dm5ENRlb> zkOWQnlz2#rrhG~~BuP^~B_5KdDW4J#N!0XVk79?UYRaeBA<3HZDRxM@rhJMWlCUYC zVuz$``d&$~Ly|V-Q|yqmP5Bf%Bym$d#STf`luxlkl6N65*_&ia|B(Dm`IP=48JzMd z{X=p%3(v4u#JP3ZEAgJ})SIUQqbFpzt|;>Mr$D_?$kN zSMn)#D11&|<|}2Dcqn{cQ24x{@OeSu^Mb zqQd7zh0lu$pBEKAFDm!vMTO6c3ZEAhJ})YKUR3zJsPK7F;q#)x=d=%s^s{n*UR3zJ zsPK7F;q#)x=S79jX#*Fji^Au$4UCdcu|whWqQd7zh0lu$pBEKArwwbQE()I)6+SO2 z_vb~0&x;D57ZpA)Dtum4_?-6Vkvc1UUR3zJsPK7Fxj!!|d|p)eoHiDcx+r{JRQSB8 z@Oe?;^Pc}d~(lEUXDh0jY0pO+LqFDZOpQuw^2@Oeq$ z^OC~nC56vR3ZIu0J})VJUQ+nHr0{u3;q#Kh=Ou;DOA4Qt6h1F0d|p!cyrl4XN#XO7 z!sjK0&r1rQmlQrPDSTd1_`Ia>c}d~(lEUXD<^H^+@Oeq$^OC~nC56vR3ZIu0J})VJ zUQ+nHr0{u3;q#Kh=Ou;DOA4Qt6h1F0d|p!cyrl4XN#XO7!sjK0&r1rQmlQrPDSTd1 z_`Ia>c}d~(lEUXDh0kekPQh;_h0jY0pO+LqFDZOpQuw^2@Oeq$^OC~nCFTCSr0{u3 z;q#Kh=OyL-ysYqfS>f}t!slg$&&vv*mlZxQD|}v7_`Iy}xw7vUErH7URaxQlvcl(O zh0n_hpO+OrFDrarR`|TE@OfF`^RmL{Wrfen3ZIu1J})bLURL=VgV@ z%L<>D6+SO3d|p=gysYqfS>f}t!slg$&&vv*mlZxQD|}v7_`Iy}d0FA}vcl(Oh0n_h zpO+OrFDrarR`|TE@OfF`^RmL{Wrfen3ZIu1J})bLURL=VgV@%L<>D z6+SO3d|p=gysYqfS>f}t!slg$&&vv*mlZxQD|}v7xVx-ycUj@?vclbEg}ciNcb66J zRgDy!trH=jnVVrzorEDlh`Q!?hvZWa1lPeL*4q}u~t~w}t zh|z;V=__RyG0G=bvy^?rD4%Sh6@}fEt;DFTTwSav?5^x4M%xZ6b|~zwY$!%$72hlD zuIwpBW##Nw*;S14De+L)UD;TS9?B|hNMUznZ!s#X#6w|sWqUCytHeWLcV&k$dT6Y~ zLt%GilQAl*#6w|sWuGxBtHeWLcV(+FDl1pzl+DKI;kObGh253?#;B|k4~5;8Eyt*= z5)Xylm0ic^;k*(Lh252n$Ed6l4~5;8y~n7m5)XylmF>r+_9CNvvJEM_kx@SBdu2Z|$|w7R zvLhMglWj=ZlZ;-5QS4Ce%$04)sI2t8vN0LulYK$invC+vcqp5bQ9jwHmF>w2%Kl^| zQ{tg;x3WbUl~wFexLet!jLItUP`F#!sEl4jl6_j)s*Lg}@ld#1*{zJqD(y<)Ze_zV zDyzgp;cjKmGJ2s(iHE}7%C==xR*8qg-OA2oR91P`F#!#jK!gV@5K?4&}~V*~yH`Dt0J$=E`PfR93M=xieSxGb<TiMx+Ui?$WU4^@q&CRH+($5v{R`xfevPwT!xLeuc zjLItgT;XnImos{)QR(LjcPks6QCX#*EBD>XUT0KR>F3IQx3b+?LD}z&WYUiRLD$*9 zXEpwR{8a0C6h@_0D~n{(!(`FJXed^~kfg_zmCTt&@{8_`F^<9Woz&&;-m?vIGepPAgD$4A5k&`j>obro?5 zH1or)haTq<7eO<*LywP$%b=NDL?024=Mh&zGuuY&--yTah>M|_AIOd9BjUAq#P!h3 zwh`+f;*XI$}T{GK8^bzs;JmS)8=2uHbtgDFE=Mh(5 zGuuY&kBHaj5f@-H+eWObh}Y*4*I+Xr_KDaZ5wFi9F2iQFjW|9cUY|!?iOp;qv92Os zpGRDb&1@TSd_=sr9&tUkZV?w`Gc2Nyh}Y*4*JLx>M)VQ!d?@0wY-ZbtJ|f;*kGL|M z`JJZ`$4A8DdBnxp%(fB7N5tcK#P!+Cwh_li)Z=-?<7LD(+RO*WBKnAUyo|U^o7py^ zkBHaj5m#z6+eY*e@pu_=v9@jzS8FpYqK}Bj%ZLlMnQbHbhy8N5u8p%!dRIJzqs!!Oi3%`iOWu zkGP1N+4j)=5pfwelRNah8*w2wlRNY{kGPbZ`LN@mj~@{ib2GU^&sPzbb2GV!J|Z5^ zBd+LXwvE^y5wFi9F6w4Jpc&Ce#N&Cyb=}Oihpem6Z*mR&4%5(YZVmm~-_WlM4*e?O z(C>^5{jTHC@0|_(mfr9$&<+3Q>TaPT!oTF&{AyhFyHx4-ABPGF|LW}UFK`e48fE$w z+@TTZw{?d`=pO2|d#Ks)FL~|}>L~o{!s(aRhnzja&d>~|hIV3VXoS@8o(px98tNhZ zo6J)~ITgzpWj_~;F*==h}rn2z9Xp$59q zQA>wy_((OE6$up?{v@F3 zWDZYk_@Fk|W*p99RZnou}=7BG+F;d{e7C45>iS7iu?!!3l*4CayxI&7}C z5dJpQg1MeT_}D~u7nW2H#|`IMA1EbW-wPI2yGia6`1P~ zgzpWTyN7EIp9;+N1wz|~AK1;+0>bx(&EZplxfDP+99m}P0s!HA!*dlrGnh~Ohr;0# zh54L+_}*|;so`A~enQYae4;QP-4Ch4Ckpf7{P4Zu7ETRs8$R~UhvY-shEE0E!^gh) zWP3Oq9w_{LzKz=9ARnd&6afpF)_AFo(k7W8ZvmIec%ph48Zi^GW4!ICO-X&nJiP4R_Q% z+)?=GHlGO&Z5uwi%_o6F_lA#d^ZDQKz2T0+N4NRFZ#W$8D13yPPuhmU;YW7!`P%Tk z;n_Gf+)?;}-h7rev~Bq4HlLOa-y1F?e6X93$A-hIDG7zPrQcj4e!Cz z!rO+AZu2SA(6-@+a`V~J@V()^5Pnr)J~$c+`ID!NHUGS7+@z5~e$Kf3 z(IZEXnP9e?V7{MlZT5t*)-~bU8*;~)4b33=<0fA-GRU29?bU`)9%r^UN;`@}*XQL< zFuLoo0ftu<8nsgU$q;LynftOL6^znaz}T`A6Jl%e@>p1Jvx6hzNrm|fE%u6OP7GV zhWt0wF@d|)HD4N-Kh^)bTav?p<(nJU@>3Q6!0?hu4xFjD!T)&%D*nFmT&Q>>mA_nZ zogYU$4&Ptn;Zr<(Ch>TDe-FMkF<&>?25?(~uXY~ZGdvUDuf$iIuW$Y|uj9ZM;5NTS z_4^ID`1c_HyW-Z<68tcHwVscZ=Xh`#7n=ts5l_PRxytjg^86p=V-U?Io`UZ;dOX{~ zo0{$IysflNnA=a}aWn{iBc6uuQ*EQ>X20k<&j*)&V>V=NLx^XHH~;7Jg<5@TPTm|3APfKb=(5$(e|b5 z=>jf&Nj*J?&qqD^9?#w2GS9NE7AXF%IW7)hy~*(*<4XOn(75Fo_b<=5N7$3KxrrxM z^IZ@eLwplFmx1#<*0;@_O7aRo;%f6Z5lIaXW4T zMD5UwtzVCO3b@V6W3S!hEXA#V5B!%a&nK$>2`Yb>72sB=xb^IV=RS|;36(!wB)D0h(Iq0Rl$UyniI>9jsmHUI@>0(};^pvk!%3g}8UQYRNj-yzZ-Qs8$MZ0_tY>*%`!(@B zIRE^iJo^08;7Her)FZF2j#S*>Zu~$5}uQfb|Z0L{lTR#sb>K3 zBzW%dcotJ$>UoNICwPAFc&aHc_0+)|c2Z{=JZFJ(Uzbx}>KQ>i9iB%$o|h;u^{gR2 z0G_`+o?}|LEv0^`r#0~*@C*m%zV4>H)N?O!d7tHDkLL%0+J#OJ`X)#Le*@>0*Q#EanRajYBZko^TN`)f7|ngA~S zE`lefJbIoNQhqV=%RTuwDKGP|f%r0b8n=$FKM7pwj6u|qxIBK1_jn2^FZIkMz8dws z;qiP*d8y|M;^pwPOLQagemM(V_R9u5j$Z;U{ceCKS9$b)xt;Qxkze4+KdZPtPG2KW z1w0?Aygp9%QeNhBAMx$*bZZkm4+FrZUzyKA#CO3n*W+1Cd8y|q;``wF!Q-jZ)@{l4 zG$39L&$-~de7W~<(nh_x+lL?alL=PB~Jo8f2q9QzelwT z&x6coOXBjr`Q_j|4|$Z2K{SPU66#sy@ob{J)U$|B${i;OP&}^DvC^F?dE2&xEJM z<9Qog=Apnm_S@TMDzDe!_vFul|ELabJ6oq-haJJCFP92}&cuhqbG7p5*YCGbJ_gb4 z#Ixbq;PHF|F8#K|`@+AICl{W>j&lRmHDC08ZwJnOB@@qwXPolrz6vQXea$3Z2+tcH z&kk_uYc=}XN1j>mG)#`}s}(r+)t2}ict$FZ?&}81OJCE87r|5J@w^YteeEWX>m~@Q zh%btB_nh3ZwqIRm2DtPqbq*xH7@j*lo+rV%&JR>xA4faLzXJYWReq~E7Ug~BmdCsL zZJl^2UjtIW?fSHSxt*c%^$lDJ|GA1=*J^AqU3v8T6$?}zFTrcJSg!JV+*efIj$4Lt z-%{L;yB_2IsXThz#wWOd&Eh3;4M$<2$?Y zrC<5~{?_2Uf72-Mwhn?m#N#mT4CT@L_d&|XAbNy&JUm}|JbzJM>iL&=5%p($@LsfJPn>p!MU$7ircpe z$@9#qHSXb!s$0lT+MRyTA1L?O1S|#Y_B};K_nqJ#jR&P>RIjaY*2Z;l&tZ5uDDec!}F`hQ@3l) zW;KtSN$#IDe;=*5Rg}P!0&eG7&(GPE7u9*hm%($F^62y13+27%kYbUitgk3n<|@jdW7>+x))ywvjn@oIRQrMd*y(-~a)l6p=d z9*6yv=kXM&Jl>+H8E~1(>vjIJ%G(kX;D1wbTa%pU|4<&i&KsUuGfd5Sql5cr&ELl= zZvBbyn~(R`+<3j6sq%QqUX#mG+q&*@OONMgl|Np2>h^Ts$bRn)Pb+YqAM=66nw#WBbsF&ucnXw9um5?Jk3m#KJQJQz zJf3QBKCiYo%?WM&dc7SFF7;=@Z$6GybFF6`jHD{OIS6XMxK+Y=ZxCmDhFNKzTP> z5KJeY4^Nr$=>76B7^ehG(+Jb2sIso_mR}fahb6 z=Ud84JwFgHgXg5)(S4l*E`3Qo=M!HK&m52ES;|X2FA}eSXTQhOw2#}8>uFBB5}pge zd4JsqZr7pxTtI#Y=eAl6Vq4ZO(M}v*$#`8<~i#+n(SupR!KQC0^pR!8mZ4AK+jj@eI`S zG&tAu2IXTAy+b?`o#Xy5W*ji0~$lsvAAAozm#Ecn}ea9 zq4N6iOHR&L@mbm?_yS+W<@w`QOmp0Flh}*}0duuw-edT&O zfXn`hxma)l@tyGGcs#d*%keHhZ~p{&_Q117dGvn#j`I7E|DPw{@H|(r)Q|Fmc;frv z83fMrkWG1+hY7^1;aTqSyaF!kSsuT3lSk^TA|BVs-E;E!?km@s0p7&iUElnPxmYle zcsx9JdORhRhbCA;JOQ5XJf4G;mwM`EI-}H?2v2`-?&~`6re-tyJiimp!?&uuJ`Wd> zKNy=;zh-FLYZXa<@5htv!d%f7o6+NB)%SX z-tF-`L3ycX8Szc={paspo3qDe$cDc;2ME)U$zjDm;ycxskY@cHq*N)RRoS zH$3A!ovVAG zOX}%IT&@=r^LQShywtOZ_$<`3!{hml@>0(M;&b5XH6psNA>h)N)N={(B6t>fJgdNY zU8Rhy9aq0zI|E$CT?GFSmDfL4e}l@OD9xI$cdESg%k4pxx38}k!@opvJ9eHuftcH; z%2Q!H@;>~pDsMe<`-Auj_|rzY1fQ2K0GEDaE*4}FUkT6s;OtopF7qtU(>_+7&Oz;M zH@Nla`S~4O>M6sxbw|5xEw_JSn4g~D_FFwa15{qm&miLK;h(EK`gO+=%E!z&_O_h( zCV2LGJPpUV?d<&MpQCFJF8x-(lLl`4(*NH*K;=(z%9_8gP~7%g3D0DY=T6G+LjEyN z{&|&8QRA*x+>ToX&*vV`U*NJ%jZEc>*69c zf1jc9dVig#^7TzJ1O7`Dw@9uBa;Ng>{k1^lttS(nB`UA`+Cll6BF$f46K@I6apPTr z_t)v*HfG0-xmeJTcoIA@k7ohpp$Qfe?*vb!$MXl}rJicyUE%3-l^cosx(HnQ8iM?2 zmDlrm2e_;^x&FhGmJYdl%IqA0Z;yz99O^8Df8Bvcosav!MWe-DKGO@KwPdv z_ln2!A?2l>3gX$Q=jaJ8!S$qoOJ7n?H{!YQO!jzYQ(o%1n|MAvA9y_9Q(o%%iFhGA zr%a6QYl!0dJTMa6Zf=jG`Su^?maVu&8TD##a3{E(H+>#>S>>&#$ZlkAZ>zjsw?Bc) zx|P=>Ew6Ul+0CtIJ3Oa=+i|sL80B{&Kf#lqM|n4zsh4;$JfA3!e!Qrnd<>#rh?l_A zJ=XjZ3FTuDEhk7T>5Gb&jre(|DR^5iN`(I_mH*V%kDsgAt+?$gvzZ&@Px2(g)BHMjzn!1Y zl;;@5wdXVs&jy!ybJif3Ks*KGE>|ACf7eky2GQHZQ{ibi*#&t2wgKmQIuP#-&sdLV z8s(*)n~7(@Q||Hn1a4z?KGU&Z>Rw-4zdpW>0GIkR;Xgy=_3<@`^3H00{)BiIJohP& zp8w^PmwulkJ{+EX9#4aOSAoV^LQQrw=uo`KT&zT{&$go5&VbWSX-xF|4HCdr%Rdl zC5SJEXT0+0`M-(s((f(Am%;O<$MY%WrJgT{uYjjrL2X~Uo}S>+m(+6x@ltpSJ)V0h zFZDb?d?h^FJ)WN_FZJvvz8aoWr$+ac4Q^w0J?#6(J%Gi)rQb4m9#9^AJU&Hv>FZhI z>*4uXdGtItnC7;WabplQCB6ZkOmIG4#!z1Bxr+EEc$RrQYbh`FtS7!1p8C_>NL){A zaOq3xNg`eW&uEXQfbvq$O~kju^Sa0LBe;##?038#Y+UFnlR7KmNdmWh>HXfF@^0%O zIF0x&cnXw9@Ar9>k3m#Kd=EUIcszS4FZJvrUIkCLn_PnT*8p&t2dQTe@qO^j^>`Lj zUg~*@_dxVeS$0d8A~C&SZXrVDVLUBG2rY##I=o&rz4$8#s;QBE+Acq%-bJ)Yf^mwKv* z_lD=>TcZ2w4=#O4Jp+hmz;lPkQ$l&EX9@94c)s&^j`%-Ufvkr{wlH%$8C>ejf+qvK zuF2^0=cSadk(j@(AU+(PMarYkpD$8A2GMHb@_Qiu^mv-havMth&;$v@b5YMF;I=Pa zPcG$S5M4(+AD$OHo(+_jdfq2q2+!fSx&+tL5nTF`dO8!I1<%zU&jN7S@3V0}e1SZ3 z;Mu4=dcS{8dFg8>@gjKI-xl3h8aVgWhxj6RW_UbBl$UxQB)%A)&pe)AC@=H;JMk6p zoOXM3UxUDFW*R74X!%!;QqpMJsTrU+QT~yb_*~9?uPwmwKiX-vv*Z z$MX^8rJilXtKeyQXLMhufJu#?i}|osWTCt{@}b0hf!YY z8A&`Do)V9z9K5L+-afxgLjF7EwlH(6R-Q)odpsZRdw0#!z;$7kS%H#Qi@={MV@l<&F%ykK_CktHql6o#Do(9iD9?z@bGSAyFZ-1-2em>k} zo~uX3?G1lBa9gMT|CF;;zMI>$=I_f@-umU1qw@B+$bdgzaXa>$dTxtl%A^0^^I661 z`jPkTKlJeW^PSJSySsnZ{M`!N_ND9Wr1G}TOw@Ui%Ip6}xQg;w$j?xD{r?4XRlbL+ z=P||YxWnOD?eV-%`E2BOdGi0Ne5xAvsC(QuJP#efWj*A=pQ-YC9!5}Jh8RmcAD+d^ zqaQb4rF;yca^i*X)Va5|e(h-iF7-=2iNt5YbEU_VPkE_lD)Bk+tnqlZfXneH|F7{6 zd8E#I_ql&b{YCI+fb)6d3d&2Jqlg#7^O(o;GUcV7GUAKiIq2~u6ou=TdRh@LfoB*v z_mxL^sb>oD#qg~1c;2VH)bkPXW$+wzzZ;3`ITifB{fP7GSe4i3lgZ$+A6LLXLvedw z3C?>jD33nxtyg*dykaBqmGC!N5M6(JaH&V;;dtV!;knA=xry>_v>>>Jco{rzdOV*| zUh4UhcsV>t4@CFX6I}X|dd?ue9-cyv=RV3yJ;lT~!1Jlcvk&~gbrR<)YE$gKN}ZeF zNd>p-P5->jSd~B3ZCdm9jViC#+ifau*GUEZr7Ew_+iy@_hIof~B|MEDbO}B#+JQ@7 zF^H0h?}BHX$1|PsQcsL{6+G)ap6!&EdUg=s4^P{N+(_Klso=67<$c9M;z_n~b6co9 zdcQ0Om-&(3E4fN>d!PJ%oF9}&p9fkltQn@}_YvFYKP9#>bL$B%{_MjY9|X?pYC3u3 zdH93mSp-k1$Fr64Zqy+7oOm_nIdPFo@I3bbm-=H6r4f%qJySiNd6buWiipR<^NGh( zMR}>`7vc%`S>nm?{Os}6dBjz~^)w)!3eUOV z+}8-oOFd(W_l9S&$Fqj=GCymHXTTFY>JnT}3vlU6>PaM?3D1=t&-Ij-dJ2eV!Sjm8 zQ$cyD=TqXt;W@U%jl_MWfJIxbzi+=Un2m;F<05JVJSBf+vX2foGS;^DpJ4p18-IQR*y$=WKB9t59+M z`t)HBf8E3PgWGXCnLkN&Tpf*`a9``1FZS^z*?k+d0GB!!qt4?LxA)2K3%g8t^mY8M zQh7UWGRB>zxP4x+0{(lH$6h-}-k*6)<*i3Pm$6cD>sblUdmhgY%9~AUZeJ5GlYSSw z`|bSb*Mp~n%lyP#Ea*pk13WR0X94A*2^JEsfTz;q`GfLOPc`wK@bp>YM&iECQ{2vT zBKFr%aQpPY_I!O~xBW!Q%epG?fEXPdj9{Wd`v`3-9N;C0G>0! zx!(&F*Xwg6IQM(2^7oW6&DRH&M?X(nrtb~0q|6MJik(2>iL6s7CdQBxdgBO3&3UlNIhA^N5ONy$MZDhrJhpax$ykr@ibcQ zw&Z#aBVGW{U~uj$25yhvx6OVm?dMKp539U>yjwy3S@3UFdHwSndnhmc{z!ZdJYAl4 z39j>O@FwPNyRKp`7Mw@C7@oU4p2sK;O|X>sVt96YJpWK$>Z!NF8Kurrcrw7buVIvz zdPWj2gQvvfd71K3PZ{wI@Er7blAm!EG&Nsp)?%^#CO88S9$dLr0%nBOQ}BwQA6TY@C*Rw{WXH}QqNf82jE%k z@w`fTsi&NHTyr-*;E8|UCAgmBz@;y#rxWpXcqVu} zH&b5fnMHg6Ja2hCm6Vryz9K#Zo(?ZW_mu`NeMvoih!2HlhR1V1<)xm7h>wEjbC0L) zi>?A$SHbV@KLAbvmpXIcIS1VCFMVDbPx(CLr+D&rE3VIDi^!7?&+{s;&tq>=UgmQH z@d9`nuXG7sZ%N?NZw#W2#Am@X-s35xywo$3_D5MK$;c8_N-xU4rhkDav2RmOF8C0-8yb>Q6ZY|2ZWcN5q`cI#n)m^D{`7c~UU3!3x(beQ-wy)+ug)VJ&jz>q zOP|MPQN9uK_j&S9E3VIDYseE1&xb0n&tqRv-c=a{-w|&P&k1W>g4bJLaOpP&QGeoz z@XYdf9-_R|^C{-C_nQ%yV-o<6U-k+`pm!KE*$XDIP>cpmh4N+~b(yhJ<` zp5Hy5#$~PoS#NS48wk#I4kkVn{(0cs?^4Q3olg@V1y7a7Q};DjC)d-Ecn&-Rz`350 zl$Uz4iRZzy#N&CD@~%4b`vZv=z*FaSm*9F@f=gdgPaEd&jPQ8!DKGU*B|aOTH6G6v z%1b?4iO+|p#oFk;`hv^4lILSrgG;}~@Z6$2`aJeH>GI-7g=lwgJ@-er0Fq-&Ecpe95&uYp;6TC*e9G-tXo}<^fEv5dL z`!+b1_$GL+0OxwHqdYXh4aB#@^RmbD0p+EhkBRSsC*ch@64!GAxU4rhk6i^W{Yss= z#P`Af40v4=)b9_hr@Yj;k@x|4n!FiZXA(Hq(~65`45eC6>RpuE&`ka!9_eLslqYaDn}bGQBf z9XT!@0hfML;dx1U^l|Y6dy3t7$9?F&if0Zyr-R#h)}Be=|J4J}GV<(#XRXKc8|ABz zue;gR!{a7{OPwwi1Sb+t$NHbBJo>nvN%hU!C*j2#w97a47p26U}zs6Bs>X}G93!bMvo^_O$`FWf8aCjP4xCGbJ z7F_z0dX6KW4NtbmGmY|6&&|Yh;VJicwozW{sU)5cPn%Do`|1HMeMvoO#0%k>>hTm& zUg~*}_$+un^LVN#FZKLFya=A|Tci6L2rhj|J%foaf@hw`vxM?e&vN36;o0l))ZON` zF`l^#z% z<)xmf#5cjS#^c#cd8y|U;uY{5^J#Qn-N2+>V{(IQvuHaaGsx0itBYa zi9D6?%u;#14j)zdzN)VmRbKnwPQz_E%6%dby=M|6VL&{4% z6~tS@bM!8k;J#A8r7x+c8}Vd#CVM=$g8z5^$InkzsJuSkenbAQ@c*p1ttl?f)qUKz zwe{=Iw+;fAapnJWZvvOT3g9nN9{suL*V%K78}BFbl*3d1yV`oR=M-?RXC%1P(+K_> zJf0HvAitSBL%?@?JdJm|I%QnpY(Al$UyT5FZ6k+wY_MN(Gm`q@G^H zbKsfg@!U^&splc$dGLJh@%%`6spnVXF?f3X5Z%{#;L?}Wa{=+$@XYskmQr5od7Aiq zc&a>}dVAfLP0W}2=1#Fq@Fg!OW_&e@l2(>)H8$lYIxRqJX6rFdJx|XPrk=< zC*`G{dBnHFv)SX>O?j!Oiug`=PW~ynum0fDm((+W_#Sxf@OVlnFZC=Tz7L-7Jf3RG zOFeadcK?z(55RL4IIqJiDKGVmAud0+@Px$NTu(d+o|PWYdz6=YHWTjz&k?`4k+_}{z-7NkJt@Sy!gGzsGmG+4&mF|m z;Ca{M*-3e+=Ud|G@EreZbYEwJOJ7pYIm8FRbGyg0OmY4E^JVf3g=dq>>(~3cRlc7z zWxoEc^4j0zHy4unhr^!=Zug`1XDY5eSCA(go>7Y1F?!>9@@>kapC=cqynVcr+rz|j z;QvB-^y{GiQ9cIIU&Qm_Ib**I@VdPaT;@mWxs-Seo(DXhXE_hii^S)^v)|)s@;|pB z*VBx6F+4-Sxv#4zA45I4#23T!jK@X&+sAYK8_Mc}+&CQx4L zxt91&c%Jik-lDwJ^Dgl!c$yw?39hFDxb!9UoIv~lJUJfEbZ}lL@2b2$pL|OGxE8Ly zZxy#S4afPU)t|NX>+?xRaH&5Yo>Z0B>+lkAuCs)={9MPU`U*etMN&nj=cwJovF7qJu z3@4rn&%++ii6rF z1~P}|PLHRA@>0(d;0=1a)eL;(FREuFub1!KJU2@SLsk`g!A(ifd0Uc~--7o#J+kLY(IxP#%4re@f-` z^Tub1m%;zD^62wqgF0>=q%WDbro=bElL^lAHiq&wlWYFEig*P)%RHX7l$Uze6W<9> z{kqZnu{F5#CG{i`uYzZ^$5TLgsplr*2jF?#$M#Pi_!pU2a*k?Tw9mwK8LFNEhpa6Yf*P+sb}hWKoF zp7nUvQ(o%XNW2K1CXH+Ni=Lm3;L?}W)0ub)JXd=>w^3f|xr_J;cs6-F-%wua*+YCK zJSR4Z?yDcT^d9<)xm-h_8p|Ymesu<)xm3#5cjyw`p`=mw-!OQqM5r z74R(dc%G-c)U%3sB|Lw4Jcq}Jj|-{iDB`=|$pYu&Vj|_Go=L>3;3@TZ-lM$KvzhpQ zc#b$MdY-#0uFubBg3J6j!g=gcmDkT3A6I$%^Mu=nxz1Lpy!8)3!*8j)eI6JO|IaF~ zKi_xs;kET^PcpdFnE=m;irf3j@HjG1dGvKhFHqdpUxE5(DXz!8Px)>AEivv&mDlzE z25ujBtbgZW<{#$PtXX(n<-l`1xLrT`b0Xuw#WSi$jV72$p4IRadps{w-dW5%5l@2W zpz`SRYC`jH{V|AI5l?|<7&spnd6buWrVvkqXO+kEKINsJkBDc$bJP*F>q_@^BDkz8 zsizC^A@EG{ce)>^51vj(M)%bZT>6rFGKd$#bF0U*kn&Pb z3GvzReC6>RpuE&`ka!V1eUFOnD+^rul6o#DUINcU9?wgZmwMI^UjfhG9?$6swRP(A z#z1hXvmBlgDzAUf(JYlum!{0uVwJakxjm`!_Pn$K{udRuV{gFuaJTa4=he-RcJVxd>{N{!1=s4mGUu&W)QE2XRXKc3FW1p&xkiV*4@*( zMeX|3=e_RWvOcAr(}*X)Q{eH;rM%R0AMqr3DmM?<^eqZ z&Qy85p67$hJfy+DNO5~#C61%b%A=2?uT@^JlikGA;qTNcy8eFPQjg3-2JuXIZuNK; zQeO5;3Gt!ueC6>RpuE&`ka#vceUFXqD+^rul6o#Do(IoE9?$cXmwHwaFNEh0kEcy* zSEsC#0zAJu16=By4bMg3_PEyX1KgwXZ<+IRdOg?K5|y{>trHqvsq%K6%!mIAmDkTF zcPVcDz2R?x3$V-iS^UR?OZ~<0pP};Ff3f1a&N1X!1ka5suRZfAk9LFmiI>2$ReAJz z=|{@PAo`W~Vt9JAiC%95!DSw#p25VI!86a}SxR}S=V{_A;HmO>nzgN6Z|lu|oR8n< z)d5`UEQO~RxZS_{bwL*8S0g{xlfOgd`^zMluMexdJ|C`7dAmN#;NPn9`tf})<<}!$ zw_WXi(U0%PDz3*p5nSeB6FglMxA(>2j{}#!q@GU1_ro*60FxbQk`4$s-( zyxvBG%YIpg^V)z@ag22`eVcsFzz~V9(OzCrT!hnTf);eIeNdOg3Er9dU_F0 zglC$^a}VXEo(05{;MwN!{01)bxf=8Kx8im_4}c%mF}%N|{v(MeW890uc|IpnUh1Dj zyc0a79?#p9mwMhKo&rz&@zML`IB?l7Qcox1Y4A+&cy0xk`IPl}x8gPH(@u!FJxYE@ zgJ3c742=6NIL~J_3WqqEYc+L96eD(sD{V4VKC7z9OZwBXiSU`EHeI!D*v37qRcnRo#_ z*Lpm&C@=NgLA(&2cRil3C@=H*9dme2I4QcX{@^m7rI^q26}R)5hC;6dmwAx-#}J=| zai0L^^|^-fQvX`wv*8I+qU%2foa<>#d=5OrJ)Y|+FZC1GM^hTpF0${ z^EnC=_cQr{gZ;#dFz%@*N6$khxXgppeUVKVTLvSAVJIc#^?j^nqo|IFf_sdz}G7nPE zxx`n%Guz{Nl=4!~V&bLneCzSl>FVl~`P`26*;sKqpE)SBH8|IwM0_R29SzR&SwMNI z|0d$A;d$NTsi3^f=cmNW;5oKi^nU3EE`3QoJ&BjYbEC&|A2`qFLdETT=AqDM$S?K3 zKzu#M{SBPwvq|^pl;eG^;&wjwVLrEzU+UjVd_Tr*acXq^UBJ2i9>fp8lkf4| zNqMPf9`R~;HhVm~DKGO`MLaIijc{_$=)TSb=lQ%`aXX)TFrQb0%RET^dBo!}?(^Wh zJ~vQa>VKbjb9fFvExP_>aIWV>;tB9f^mt}cUh27xcp^OScs$>L%Y4f5zE^QOp9e6X z2gxtG16Jc>V?F`D}59tKagP^@&1H1n2s@5YNE4lfZdCZ=<}_e;4rq z@NDvUzNS3N40aRGgr`&Q=>5_UT>6rFGKdd>=T?vBF>smB%~+pLDPD8_M4_*eU+OO> zo`rGi^og#&B{`5n&k@goXP?K@pr7lD>uE|n7oJRTu4gRerJfw( z`S3jD@w^2t^C{=g_Z7GEIm#AbZeNn$(ID7Gyb$AdOpo4=y}@N3Vi29l9G+V|o?^;N zJr5I~1p6w^B6#vVp4%xe^~@o@7@qe%p0B`pKL1qQ&SwthvuXe6 zO>0$GG2s^L+kAd8z+j;v3*eKRbFJE(Mo)kb15lz6qX1 z9?y%EmwHwc-we;69#6A#qSspj@d|h@0q6P2rM%R09r5k(yx{SC051D?C!TL?CB6sz z2gPg7^RAts8l303&bi@!D^br`;M~{cl$X9n5Z?*UqaM#ol$ZU!hWIXc{`Po|91yNw z>S;lI4?IJ`xvy&}FZEncyb7L`9?yG}mwGl6-v`eT16}=GPe*Xx?|q2Ne!o!hn&Tb& zeJnWd_Z;H;QO{H0Tu(XWrLVV$AAqO9dC`3(f^$9XiC4oj#^aevd8uax@t}>{lWRSm zPdM-5!Dqzd;Awq+bYI=Ur7x-HG~$imDe!oTz-7P7&rvKQE_ek9rzqM)%bYTs+cOGV$i{jPrP=Q(o$c5l?_;oyW7C@>0(Z;w|B6J1DxZRB-7_ z>gh#15uRxt&pnivdKM5*f@hn@^BXwt_rHnDes4C|^=0#Rzvp4Ur-Iw#*K+we(uv@< z-*e0#xy?{{{d0PEtGxYrwq(@*vdZh958Oog6y(2AdHwT&|ET=AQjGa}wf!# zOTQWLU!(H6-O(vSo*5p` z!{9P+@^c_BsJ!lX9r<(N->dSv--DEwe(PTB`jYzd;pq>~&j*H4UiuwLya1jOk7p&g z^eaE7v4K2=@O-H}dY$~G@&lzQ^Y!qo+Wn>Htqr*JI}84ERbJ2AD9Xza9?wp2*^fg}(En6k z&wt#d;q|r%{^p9?-csyAY;GCgb{*=U1HV+|5v|EzL3}a%id1kbG=&mzi8J&zIJ4A0jdPlI8uPT7y!(N}A5p8w9^Qhx>fJr%e2rQ@KP zs66`kDpYxWe9a_Y3I7|)qxZ|Fl$UwBM)zGu`94m-152 z1H|{hv)$wQ1zh&a9u!o6c*MQ5;tBBYQ69Zt z{-wOkL)^&l{%Q%&+2FiiuAn@2OE8LfB0P_IJgX@$^}I$r37&sEo))8A{jy(j+_%9= z;4=To@SFwC$JbpdpD9h5uaBy{-oMYPyxlJ;@UKzaj-7*@_LK7H{o8nS?fef?adTcH9Dto2xu}+(MNftj3+ExK;Fqf2s25^U^Anzd(65DsDX)@a*(> z_Nn|3<*7HOc7CiU6P{zic|Uem`3se&kK)#o1y7d8ldbX>DbJ0HThDNK=6XC!6}S5_ z1+JIKlMT7Mc*xh39;5KHkSrJ_gZM#Pi`<=JC8v zd8y}3;)U?UWxM*hp4Q-UTuVJk#Am@X+T)o8ZqFNUn*B0+xU1*^^2~wfS>@65yq)qz z$nW;#|5aSChr`E(_g67I$AQ~<(CeWmVdOhr+d>rzBsJyPT`NZ(~N9O-%;*H?B z6rA_tHI$e6pG>?tJTH1Y8!0dKd_cSw8NQ(ortV&c8wDN-JNTs%#A zna@(<8Swn#@ie?9dcDOH&xB_XIIp*C%1b>Hh-bmG+~au@T=uV=|36asO7lFS8b3$z zJ^5umenJbv+(5ht zo|iqI&ET@$X5)PFhvFZY^|t2(S83zxqU%4L_#%vZ0XWw`p7K)v)x;OWv%=$fgYq(; z?+{-BPov4v>%Sd1um5D?E8!XE@l2<@)Dt6K2G2T=XFKI(es&OF4^P|cqx(t)m%gN) zUc@)SGtJ|a0;D_`@yi)oC z=XH1w<^Su8_%7+oM#STi+z11~d7ej7Uh2sv9uLnFkEe|CF^JX?Pk^WHjnVVm8eG^%N<;e*Ar!@-c`?i6_JJi^tQjAiTez3F3*T zz%vM(_g6OMV-QUso(j)$kEfjS&;)N0?+s6bsnPqZ4YM04AsJoeem}O^^yqb%Ks-08MiX2D&g(Fj z@-Y_=t|Oig&kG*U2FgPdyidFkp2G{H_g6=7na>zRor%wa=W35<7PvgF$@8mX^2~wf zIpxvwypHlHCwQB95j+iVitei|IQMlN@kQ`tdpy%9FZJ9^d@(%b9?v$)#~`XCz5<>$ zGot(I2`=+2&mYbMmws2mGg^7{JkKVNoc|Y*rxKnQJ)Y0VBggMgc zqrjzpmp0dfCtiknE>|A?xRXcu7(`QuuZL%q$Fqs@&;(nEZ-VE@SZ!aro|D0)uNXw# ziC4gLy~lGa<)I1gB)$ut_dK4jDIbGqH}NWXI?askt1r0p1x?VO_+vMs;_9^ZykQo72KYO?c<32TwgzxuW#;)Z*TrGw+Sk*-}k##-t@X1P5D@j zH3-HNp9Rm89?xr(hbDM~_#AlZ&35&3J;#E}ew2FJ5if#gl*e;BxLrT?|KEq=xO<2^ zi{N=)dGtJgPWi>i|KQ2jyTkP*^~*doBEAfsf#5t3qbM))FphXBJWD;Eb>RQaL%OS| zf;_9?*{eKy9va*k?yDU6qrq+cI)8@BU*U$V`TGKu*N;0RRNk)V_3%$r+|FrlJnlTA zJo@qa6_v+Z-ZkUCukw1_N|m?cZo;^G6u09J!MKTcxp}bt>Tx@Q%YLtbr?ZEj;^C=^ z+dA>%`Z-ts4T;ySnin$NB6OV3*eaPI2_;_>k0D39*zX39%nvxq0a z^Onc66`aq9KaeL8o;vfQ`$`0tzLJqY$&){q@|}>sROR*ga~kEb8-tsPr@&LLJbK=? zQC{Y)l6WdSZRXeZt35ryrC+Hhjd*W(rg}W{DKGWhPdo#jtsc)o@c;HB9^aea zGvPS_ysjx+&+~aSyvU z-0v)SlELdzzx^mb2l>ICd>-Z9s6jA=_)vIODUV)1TPPocXe;qi@U*xudL4ELm;EdC zoJKq!o&t~OKFUiy#l#EY`PAb%sPdzv81warqT2fP<3$p<)IT5o6vgd*tMPa-N_q6- z+H{p4t;U_F@_O7yRNg+m6l2`wiraBFVcaj2M~}N(<*i4a=Tv$4FCPB8;rX1L$33X>cHCtcxAB77e(ktb7`G3&?N^UGNaeH5eR3P6xb>I9f1~o~$Lrfw zew;|m*M}6hp4IR?@9}I@T=%=3Jmv80P~7(02+w8fJy3fb>3$QzZPwN!xAw%>!#_rO z^m%D2iYk*5ltgUX}(YW865de-|Zf%txSE&;D=hSPoJQeOJHj(9aZ zFL*p}f=gfWc)E=|amTrSe^MUZSL27meZ?c+65Q6W^XZD)<3iqtzkoc=;mKBc{eIDn zlutnZHkH@UbCy%ybrl595pN04KIPH#-*92LUzz`S;z{rf0_XiWmhw_h4)IR#Jmv9} zQ(o$Mi+ERf8Z4?k?sQ)#gUfo5_lwfO<#B!Ibo-B`N66Fh!pW(?r1}@{a?C1JjNuD|I zyyx+JNBJV;|L4iKe8kOzjJq1+o&+xaE`#SRaJz2xyj@B8Qsi?z`N@jw_qXpQkDG-c zcz}2Y{M(gBuiM`!AA{%s@l1GnJzBdSv?mK(=0WPYocJhs9`blzqP*0zhIkGp9Rlr9?y2l%lzyhUJOs$$D-%C7r68#_4FlP0?*AJ z&tsIAdX^Gj3D0hi=O4;TJ@pWOguQcp|b74TdR&VA)kUh0`byb_*O9?#o~H!{V@`>`K_%Xvx8hhKW~dp!Ar#0&bm zj=L|eorm!<3FhlL;I?1={QMG?x6jjdp|8=3+qIjD=jZn;kA8k$s`6Kvyxi8SydL*s zmAB(oVcahjx8n}LxJNCiJ-+m~iQsa4RkU{_xA*YlJ^UoaZJqM^w5#I!_35dK>({4~ z!R$bkNGKA-1a;a^Rr)h^!zkiTDu-5sBw=2=k?HC zN4I z(ewY7%G-M6_Ac>G@Hbsndwl8V2_3-gnAQ`6=mg?j;mPrMW`W!Do_@Xj2zk=rc}aQn z{J%qaloMNPGZ16Fr{k;Br2f*UR(BGX$Qc%A@;QO?m0-HR40z z`A2#5{yKVjcs<7;I+pk-c&-4q>s)(s!KE*Gy$~Z$4m=MikM3&~dE{~GUGl`>`O4!7 zo_2jnJ@R}$0bKTDF+3-M^YMEQ_1{Fi6rR^To(jrKJ)aU^4bQR9M(>wy;Idz&o}R?Z;knV{c?4Y6xx6p&Jb5<2 zvq5?EJpW4h&B)hzuC{)iPX_;Q+;le+r-4gfyWkn@@l2q674ik1{6cUUxA;sq?z7|x zIy(NA$Fr02jgbG@lRvW5&4Y|9=eLgF(r+R>y}|7|)bn;3<&%*g@5$c*F5}Aia1nXZ z;Ca#G`GE52$nWsvgXhEj%K7ssaOpP-p3dOh@7a_ej(nCUe*@*+UJQci#4E5)%9KZ+ zKetgn22myPN_g75P`l2xCk`N1b80vc*-a*^{gY_37)zuqw8q{&h>O4-W8s)9?uNQOFjQbJOiHf z9?zGQm-*R6JQJRdFGcq?5Zv~4trTOvUa9i>`FyU**EhLQ@E0gd>-8POPR{+`FT&}?fm3nezqxYd$x07Z%tp0o}c5vZT7mF zr2Ff1mDl4ARCzmY0mi*VaqHTJaqmzby!{s!eKQrvn< z;Cb5Pc~fz{A3q|`GI+KrZs#JfZ~mFvLFLi=@t9X?=grn5x7Ng0z&{+^&YON*yPonf zhzf|Wgy$8H=M!-I{6xP_|Cu~x@HALcdtB)K*b>~%f$pmf@%8YGP#)da6v|6q(}-_^ z=T(nq6SzF@lGo`w$x{K(AIhWqYW!;S{yLm^B|H~^^Zpu7dFktF;=ABk;qkl%E`1fB zX(rs|JL$dd?9p~th3Jo0?? zIr5~!^R~zH73F&)zt5BZhw`r5AgK3Rc)#z*d}e_2{vApA7)05`tKnJV@w`lVsi%y1 zJo-B5@w9wBT)))QhIj%zBfz<@JjzQwQ-~+Sv&!SyLV2lYEAbR~TC8>Tb3J_&x94a1 z`HD<%S-0u%j8=JlJ*y(hOJ5HX9{|s1%A?O$zffNK`knX?cup&i?rRXZ)Gzg1M0_Yb z_jx?aDKGUrM|>1K`#hco>%!|t>S;a#2o6+^BgLD076Q2*yZ6419 z;Q!U1?kakoJW}T>;>Ga);qf27KD>Tn5FJIl1fDE#UO(f&xz5{F{tI&+kpFLejQmpn zQsT=n?r!DL$Mrvym-_3y74EAPo(yoVe;DPZo{_{?!&Bn%yi9qir;K@d<>!m#5cpU&Exrz@>0*Q#J9uK^<)!20M8PSr;PGa z&pP7432ubC8>8p>6mVWwX&!zaxa=3H{{rHTFz$SCo`)wXFZHh=-W;AEJ)U~+hWCrq z(};LWcm{%VJ)0+3#7Dui!Q=UY@-jc)5YK@p`Ge@b&H$Ibq@Hx* zdGO5icpjj<)U$|q0X#cAp8b@Udj4b%&*>jV_jMKcf9nnFD$m1Lg4=nxQHnQTHz>b; ze`%Y_*EhM@sOKBStt$oZFSXcQTc>`1=>%|_EiixNcDmx$KOg=Jl}EonFk0oOio|@) zSKNAv;knD>S*Y^Ul;>H+t)~Q@w>+LtRDQbh>`~l$mcjF{$J1RZ@h04=GaqB6C zrx&$Q<8 zuYZ1fqK8lM@cG~}Z_@Am#N|3>Ta`!8|BsZHet#w2yptQDM@4kM1HrkT!Ngm_Gtc8$ zN_na0Y2r!nRCzp&KXG-+{LAZ(PT*YU$;9_y|6U8ukIT1GUh2G)_&#{v^LW0Zyqo19 z_>TAicuv?FJ^y{dr7x+cKk)$bHp}CA5M1U>-tT?f!^_!^2Hqkr*THMBExP_T;9P$P z;wh+qtj9Bz@-m+@h47#^^)TDy>Q_>6#xIu&ILNE>fGbU5G5#&KmY>*js|K#ECIm= zR>VQ5ghwH2C;_ab3K)5m=!$?|)S>bel%VL1h&CW#6u3qOj35|`JhY*u6eW70L=X&5 zBM3x|aL=Co|IC;FJ$v1??pX_F@|$n}&i~tI&zZ^0tjUv#UjUb!{!P)XhIkHg-nu`y z-%N1vMBo`gd?Gwc9G+sThsIk^JQtqx4o{;4b=Q^TX+}H`p1Z+$UFCzD`8VrX=6^YP zB$8@L!^O$r=0ay7}e%0DlY4IY&{w$uJ`7yeiR2tfd@lSigLA*{P`%9Cd&C#OQ|<6HuBbcDk|%+9K0KM=oM!^nOP*Zf zi{W|O;n_j;lBbM#0X&VqviUhrdvKX&$zNdaG3|mpG&+5`+Xan=W{33Oa5KN*TB>GaB%+i;GCx;@nU$! zJ3KR}Uh>Q)z7C!p4$lFqm-#tFyab-4uY>#Q1ulI_p4*6j08hl>d6DWR&&$M1;o0x- zoTYlnQ%(G1czPZQ?rR*ltT#E2O?L1{lt=&mm=7-VBYnLC1e+PCgHFA2{cHfOs|hMGpUmR4+L{Chm2#GjaJh!8u!kbI$JIoUoPS8iwwEZ9DN)ctGJ%Gwcs+(SzYZ8c99>u_4W`?$9@w|1n2Jr&iT6#&wwY_;h9bK zl4m~gEO^Qsp2JihfvA#rHas0q2KUuNaXp_8gY$eAse1js|2}Y;AL(m9@tru2wLKM_ zr#rZKq_3XDcf<3T!;??-lII2DK%e-YJTG7ws zk$H=$vVBSZ0{Hua^LcV4)yuq%CcXlmLWgGq)k~gD#Eapnad;BGtD9f)BohAso)O^O z*Aw78Z~5eroG%dH3IFE~|0$}MoM(ua!E^JO;Po~DT#lFI8A5zFJPRG3Ra7r|RukU~ z&q;^pyyE)#K=qR6KH@3xyyoz{PxX>#3-MHVE;&3c&(-Zq@?1ka49`8_ z+}FcYFL|aCPlu<(;rR#EOP;;NGvH})zII*dNlY zSNe^b_Zek-lXw<#o=_g0Gv-3@{MRR*4Np2a&;PwtFL~}Ko&(Pchi4PjM<6OCo(s=q z)sFcGH}fBT9TJZ_{lKsExt_NH#HYdkw8OuQ>LuqY=J0&u@cc~mXxEGRq3&^+3r}Bg zp8t_lFL_22&xfbb;n_g-l4ld~0(fd1o`fIk=9fH)#0%jW0nU9*rh3VfN4yB0^$t%N z)k~g#5-*0Q*-ydi>Nap*SLqHu8vIH>xL$8#h?nDWZ6!F*!v|C^`9C6F0Z&X#aQ;Ma z&eN87B|P^!JdaSlxJnuU^Uz0~3 zf2+w8f1~ZIiDzcmi~g_k^aAI39s(|XrNT4T;mKDX^ZKFWSwWs`cs4maN6Ayr$L9Z$ zJk#K5dRcH^Y2c=>=|wkyy3f_Mpzd+V6m zzV!2%9^jHc0#PsGrSSZR!}AQ)OP=S5?}q1J4$o<-mpo^Qm&4P&UT|M`fJ}cv@UuH^1a*O*|H!QQ+LyLsTz$rVx*V=RJpK57kSaeZ(8WlX!*A&v`n5%W;uB zU5F>blk4!zp?b-)fOrU=T@KG-s+T;K#FOFaSU{PZ{xCcp6<9JkQDC(wF49iFh77e{y&tR4;jE5s$#L z-QhXF^$;B*J{O*(tAhLL2`+s}p5Das;d#>GSwi(PKYt-!08fR(bB5|A&jsQ|@T4{j z?rSKx^d)&Ri5J83g2S_#>LpJx@e+8xb9fpyvN<_VQ{tuY+y!n%>BqsBs9y5CN_;mw z2OXaCR4?=M6Y>4kc<{KMfnLiNyi$BDW zzh3+|fJ?p1Lucac;hCg7dLCv{z0AWr;wkWa>hM%hz2rGUJPn>-HLLAQ=eZSJ`jR}i z6HkZdDTn7xaGC!stmn<-$%JRG^62l`J4*G^*9qeHz|%P)xUat8+*dmBG18aA^Agod zo>z%agy#!~r;6%jp3f1_gD0hVa9_j0Wu9f7j|Z22r^7QtdGtIlrTUquU+t*>7uCx= zloOu|PpcNe`BT6pr_4hS;)~&#;_xh>ddahhcp*G{9G+uTFL_QAFM_8_%izAk;Bs72 z@y9TSs(SrC$b;ZA50d{+#EY@tx0FZUf45V;Ef}2q~&p4`= zJQIjlz_Z5T*$gi8T#j{8rt0-NIZA#%R&+Z-yb}BE+$#9^_63)Dh`^Ihyb7Lq4$l&B z$uH-h<*HtX${e1IR&ei(TkbuGB`CFhxbiko#J-;45laPDgq@f74)3T{&AzTTyJ>8pfz z8azKZJWbl#emPHb;_2`V1Lr&wsb2CtL_7nYcO0Ir;4+_bKG~z{^*T98et(*x+jqpX zu-|U&f{*V2aG8e)JVS_Q!?V!gd0BD2PKv;#FFDWbQat)T%MEtNG1t}}mp>zmxo8P) zZq@G}bx`%@{mmTY9IEQS@YkWN+Z?JlZnI4yo(s=^DUV)<+o(PgwRqmA#HYh^RVaA= zZvdD1k^51as@MGv0+-`87yjXjo7>9pe%XBG(eIbNqU!bg!pn*0!+%(L^gR4X^)e5a zh!?;UzAktk?gW>4kn`kNaOt-Yp6SY?-!FTX>Ty`S=ZP1=vsZa^Uni(u`l=$n4xX;p z2lsV5xb!9K|M%e1S1CM`lt=gVB-Kk_Gl}nnXPffqzV=hS^z{|--SAwW6x`R%;L?|z zulj>aU*+)Jt30}|T&kD89wA-<&j#hueeI%p>1z-1N_Z052lv$;-1McN52u1lUsdo7 zRUX~fAE{pY8b`bup4XK}_qB!UrLV2Ty@l z^OQ&TRY>*H*Gl3k@Emn`E`Up4S$KTB>IU1d^py(F_2ArBPsN||o07-DK8lyB$HxJR z&s6mz6rZK|gNn~q{87c{C_Yc|xr)D}_&mkmQ2c4d%fQV%%=iDvR-x+kgO9Zd@nvxY;Gy&a?SnKW+{LH?<4=f3n@H>h*pnsd}^DbnN$0#f_^5`(3L%dcW%x z*T?G<D9rdj`*?BNMEmZrx3EbSO=O<0o zn>^FtPgmTyx?_H(E03O^0#$E35qREG^?H6jRQ36Oy=;3FH=eoh9CLUszp=JoQ=gCe zHsIz~z2D!c`bDx+|8kJ3*Yh({)f;~S{Nofi^OK4BS)x38em1Cj<0*t^m#Wt}52*U* z{Ce4{6gQqCcIO6ALS#SkBW_~vKk0Y|lcXJuOUU6Bg zX0-9kR)8zQOVMYWdiDmxlcm_d9H_Y2M;_Ksw&JEf*~avy5N{8@fOrV}eZ}>9-tFMW zh)ZwvaK&hi2d8q9&h_4g1@1D`@X48DkXKk&80)4@L>J{bHk@eJ^b z#52LK#vMTV%>wUA952Ir0~J50?iXVnd6!CiC%b1%xx4(VJ+&nS%xBq62JJJQ_jck1j&aM@(-RaXEkH5tsAl^Tg%+`7Uuef9@eJ z=g)76hy1)|YlXfge|w9)TZt!wk037R&pgEssd>wH@HNb_-gYv_dON}#>n#QoXog4k zivw^ybF8=C%(31^F-H$mnd3k{&m8Mxwc>}>Jd`^4KH~BCveGKzRcGx1Xn^y9>DTxx zQtZTaAijH&<-Lg)Ocm#YYarr*3b;ReQzKpnhFIFY-eAL&& ziB9@0>1OAr4e_}Cmfu1=Yn0_fiATm-KAw2dWXtCeUjx3J_+ESo@fPAWPg&1?;_aWc zyqb94a?6`HwU^TG$GE?w5Z?(tn0Og@4sp5P%_6=R^~;HugKr|fAAB$I3h)z(o6il( z7SpV@FU{K!m-|I3ak*b)5SRN!4soxW-QNu2k=~ZSOgwa(R<~W*u3&F1@9=_eybs=6l#Pa^c!&uLwiAV56d@Aum@I}N+!B-Qn0N+8}!{-$% zh==j{ke`W1M%(;X;|YnGhcdMux;psph{sutHfr%fOp!aU3&j?<*~8u1j=Zy_$fhwf8+ zr|RoF2fwPN6`FoceIfiEh~w)4y*|W4cs@3Ycp>I_3h@XsEhHYoguX$%6#P@gzfpZ1 zad7YI+P$z7UmCIekb#dmQQ3JV`k9v<}e><`Eur;TE2z(KpXT+;+fzV zh-ZPfzydQ?)9*dtHxthWA4+@-_ypoP;PZ%21bm0m{dB}RcW*)Y@hIy&wt=ig4vu>mN4V!EJ z>%+|ZSe~KyHkEUngFj9@9JPDiV&W0-)x@JO@cOs?m3YL)@eUC8@OV*8JObXlo!yZc z9?g%(!4%?Q@Ii{p-^4bCYzKc-ar6C4vgJGY8^q=QzLmJ#uMZNJ^HMeO5O$n!t-WIU zHF=W3I}?}ZC;f@1qW+J>!{F12r-T0|@eJ^Hh-ZQCBAyL?jCc-sY{*`bzH-5@B|Z(j z7x4)AFyeE;Clk*HpHI91{B`2E8+m^vo{n{Uh`2m%de>Q@^p%DBHpH{Rdl1h7&m=w( z{1M{0;Lj=kky^KF9ekVO=6f(?JLup)62A=tn&a{OGXLk}%5#&0_b0vwo^ixi7@@z- zCSC;o3UPehiua!4r7F+g9sDTqIJ;Z#BJp_e7D@JsiDCSS;5QM+>Dud0JcRnu#N~D1 zsfwRa`4>9)o5Ty@-%4E8^M2y_n9p;>E5Mr}nECOf%G24w2P%F_)#o_)EaI`q|BB+L zm1m=acST-vAr7OuQ@x&G_%H7ln;ZSjJY9KD`9lW!8+$@g`oDRKzu~6;_l0?G7ZWf# z43@LSUNKLh%$k$_WbK)?X7b{tbzAKJUxabev)mx#<>z<(D`q@r$T?w2xW81|%TV1P zy?*{+Grk`2qHdN%@LIjx9Fi-zyx%V~_d6b+oMuVb$ki57*Ui-m|KzR?;V-w!_+J37 zkj|^}$1^jfGJfr^>l(PW#xef0@izZxtUztE_^kh9 zd=kd<@$deG-9L}#^<&nht*pDF1sGr8`}M~8Z}o3yr>SorZ)xE!JHq^LGRiqx)_=NV z{Kp6EFDcWE%-_s-lat2}bBs^>w;ivaE1Gr2Y0(@Cwr)0io8&O}aBr_K z`m*U2mnAj&K_Y%B=!bp~3<#38qGv2zd{U~ERum$(aL_1G?nA)C^Z%d6Wi!`;IO*-o z{O13f|IF^r_NcbAry&ps5>W!=NfMA9UtPLwq0_~hU8IFHEkLD(HbUgjs)ETf0KuE+ ztz^93^F53=sAk9(#%p2M#=990)%vnwLn8nYwF%HD>XVEw*pZrVGcJ1=GcO+qE=QIK z{)ynrMPJHK3*IWYl>bTayA?jmcn~7xMb>{qYJx;+i$SPbAT>daIgn#mzkCaR z6gb+E`fJ73mc&yctEQKmocs7;^YBEzAwWE)+?Os;JicO zW3TX)->mTRWD8U1R`|B>xgDzTV?BJWpHnyy{6)cK{BqyL75Ptl0YFJ9{FuT0Itp(R zTj{XE8-=61!ijMFrrT9n2U1FMHyUdskzv8yy9vX zg{gDQz-aU$7@_WE>V7Ru$Pmg9!i7b`OtAe@O>UNXo3DAB&lgsl!oZ|QYDOU!-_S39 z3(<8~p;`iD*26eXc+9_VhDB{0Z;naEUG21R?cK$|Svm3ZtUH<;XL09dSm@NfNDQW%~hwUd5L<_lGpoIrE}`g zvT76;K3~XPhN@a{wX!gz&4Vg*VoVjHf$ltZA(eplaJfa&U;$fi^22` zoddIA6#C$!xv0%x8gJ~bf@z<5YQ|tU)}s2=A2oN)B4O*g*fo!ky9VpHD`7z(zAKQY zu`zrrGza**0eAnV5N|gJut$iK!#_gqWIa4f1opQsZ)_Ul!|Xh=MvP%4-&-Mk04!hH zda@yePri|sPzM-p4hBQ0*t}G}x$!)+8-B9L_nl9_3C2bmL-^*Z*C!dvPUf6&4+&=- z+cEl~K9FR!W9@fHBArVmoUBf4YXAgtrlSiLorL?dSrWF>al?%Ltf~8e&_byUENRZ&?6)TJ~BGlYuFEN+_*U$32*R^Z)mS09d+dKI`Tvv z*~kcb*%U!9j}d3catxSO)*Mco#<0$TZuBQ$x`{MSGUN28Q*oUnQt^aofovkRci2j? zXmyevjt^QOXIqdKotQ&L0*36glQbYj19m#8AIzF*+d@6ZvJK2!e>#2ud^)z}m_s0y zGLmT6%o+oUVbK!#&KR~}%#DzQ3T!1oCFR%po*J0g#Y2jvv}Rjv{o z9u0o>$@}N^ zhaxYJ_zgHADC)c(_VLv)F6Z0tCD3Z%ZPy`Df`u|rv-iUY> z8R-(emqdj4kiz82z~todI}QW$Zw%;?aiN!yA4~|LNPXTT?D>ke6*1Bz&i^>(FRFew z45EK^4pM)uUm4n}K7N1sH;WXH$nOscM2)`u1;5i&hU5QLAHU~r7QfUV_dA2O8bAN; zR)nBCE#mJ~5~Ie7-;JtGv=$V1;e=3-G0OFj>yO`;H`D)E{J(7%Q6vt=QpQ%IFNf3%!4z5Jiq$GAR0YX6~A97;1`9N+WwH2z_#2d%OAJN(| zTO_CoDpFJ=a^^!IAuhdfK^0smJ+z=62ol$-7o@JoV+JlqyM?BUl0cO{QJ zK7^Vx?|VNJ{<7EP4Al+6yW4R#5) z|JTG9(;L60-}^n5-gx^#`g-a?Q;#yZL`RzX#am5%=(~;74w|kn?lkq|-?y#j!5R%W z_1Eq;^`6;ncu3(*Xjk;atw#SI1dbr+Np1i3%pSg?|M@f6wm|YzB)^KWVO6jESXkp zs%V?FSk|Z%%v#ng8TDerbXJWP_GeS$GXtZ8%*T&##^1q?Iw7&Or*J1j0}p5 zEn_y=2;4c}^&fyc$GwPCX5nM8FR%Xnqwn*OdnyR@0XTNGraITUePM2Ya;{{XLoN;x zF=!7z9PW$w!bihV*d?^5SR`@^9$}Y>^OqtoMovazkz^#(cMPKR@Lv83tX+SAIi^hC z8NeD$gun=)B#1M8h=PYGz{}(lQhhKMdmOG^D9{@_+8qjS;xM5MIaTW}SF9g5zwTi4 zea-(Bw7P<{xnUeEo#H&{n8f|R;WBN-l!Yw z>_T=Xv+(NpK@5xcunbE{@}si-2=Jyd=G diff --git a/source/cluster/wham/src-M/obackup/printmat.o b/source/cluster/wham/src-M/obackup/printmat.o deleted file mode 100644 index bb6d25ea8d4d9855a14befa268190d1798e02eed..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8296 zcmb_heQXrR6`#F3pU<3w&n9gnk)jRQ0wg$p;1B~9!G(o&FbVYsN@=5GeO~)6+?}1f zvoR_$v~Vq(!x8<5|yZ$N>+kYH$siuhPv;~ z&g_k6@2IFcy4#ugz0aBVW_EY>sMfjDqbOd&ibA#$g?EH{c6qV0jW)NDI#OK(r55V& zk-sfSFqQC@kb4jqy(KI^OmUB_hODEwq^KxE|zbM0~HyR{JVnKHOp2Jh9azvy4QjcKb}&rIvqFPat>7If=E z8?DZ4qt%2CRi~BPORI^e5zOb1mM0bsJ#E$w8{kTx@=-NgLKYcsh*&5J*Vw8?8Xj~6QSJasf*x8>^iQbAz;{VJQm(&qEp zyrtdJr*gypUZC5pK0%uxi=)fe=@-euiQ_8hzXX5sOT6gTlx~fjxBj48Z|T+zZ9@Uv zI^SVk*-)58dS1I_Y43s!OPkF@qxa^Pt2L*_a5nQ=NIyRBef|mk__eu7WPTkldVWtx zx2o$e*O3r3ex+MyZh=Fu~08wA)kKoSm4rF){xMqr8v!&x6~G z;*UU?_|KJ&|6IBF6PVc&@kdw~iJe<>`n}?BnfQ-UP8ig z?PdT{DBnASl%e$x~8Fj?PhhyNHTd?jmC_$5zU%ub<{}5 zjlP7bu5QSzR%1p+O_-^{Y)oxP^s9$r@n}qqXVk&8X&`qtW~NjS95E6_$)bS!@dv#i zqW$iXzDzV7AI_?)8v50t0aU3P>9lcJZOBmjqef!HTx>pJW-`ENq$qb{=n%NlH#Cx> z3c%4acB%3IhyCL4nF}Ms!zEn6blRqbl&HDG&O;@UHCUCMIGw_ z=Vc=_J_&!+jSB~#60wckZ6rV*fmc85<5MfXcRdDwl-UJbZDcQb7;4mqG{i(Y*M%zq zb@4tvNsBhQUVvTYhhW_HJfJjYqA@dV3>u9i88e+}H2RHXBo>YI zjjiv;G+iH0W#auNSvs7Kr?N>S8y+AXsjQh;)3sLJ2}zxXaBLq+4#yJ^jh*o^GoyAH zsX;T-WhRVleAKiP!=uzGFf6Xc<)7kJmMeYWq>|{5Cy8(L{J7t%s5XTCN$jt*`zh!b zuwQTY<3l4^fUYC7RvAVu2hGEPOe3;hc>xgv`ZMExA8=4R;cRj^3?UE0+KKF|j}p&l zsA5UAqC88G?in4f@UKvmgRB>;sHjwwR05o{$p z;9CM$1!RQzgD8+6-F@$@?`24~Dm$>q;Q6lN^(rTRUB~ZLW9B18hub7PSQGSj%6K&2nqLPG9;WH>Nm0m3DYa=&yhpvc-D+$ z%;zEl$t>>J5i=RjM*8E%U}`9njYlcAh$}J%90YD4_028erf{>}+(esvtwriT-MPCS z)WPbF3>(pdl-k|X)!EUrw|)EWh%G4qtun_(8EBS)4Knbk3_Kf@$?XjtRGM7u;Bdz7cW2kTQ1;uK+*$$ zEL#|kdcyGMcDWqagS=SqR1OQr`6=Q#K~E#lxt>cB|1lJXQjlc}1x=(t2ZA+}q~ z<6XgU?houxw5*bFetOwbM$e#ti+0aRdQLF?ZwUNNV3CjahQ!ZLL1)YG*WqIi6z)IY zusM|F$hCGhi28%2^5&QDp-33|lwUXu8ap%N$s3FoJ>3f@4Vpg*FX zkbsN%zk=a>yiU9%{1rCOEoJl!3b<(ZO-T3aN%%Du_d{j$ye8nH|34RS(eCfd;D2X09~VER zU&4|@j_+!QbN*@O=f*PpOg&xK^(+^#!mmVFP|qsbvM=pFgCb-3G>kmCD+(o^p5-H_YVjzrsgJoL#wWW57#n`0%_;-|hHpJjCcY z67-hOFoVeqW8@>|IG5-BbqP~xcn_73Ply#*u?iu zWRdN+;tML2v-DcLsKq92;rAeM2jk>-m^|br) zuY?@7E9WZn;&&(+L*{=m`4=2XyCL)9_bM4f&K&zR^z?s`$M0Gw57nab$1?JA{4q`B z*rB3F@zVqp{sdt6+`i&>GFd0`E~Q@3$2lK(A}=i@~C_)aRz{|B+BE8747 diff --git a/source/cluster/wham/src-M/obackup/probabl.o b/source/cluster/wham/src-M/obackup/probabl.o deleted file mode 100644 index 51910eabce013f6e04bff2bee43e40677c306d7f..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 86936 zcmeI5dwf*Y)%VX_62e6i?h#Oe291i483F`F376nR14IZFEt-T}NHiod2^cEsREQ;w zv3Xjkw8fS_wJl!SVv8-cSmQnQ(Wh9crAlks(noBuQnWR;w!CZYz4n>C*FFcF_`H9- zpU--_dwYv0Z}b7r`suy}DW5C}Q61)R&BfZEYsGnXZ3f#3zsNN1R4VZKG{ zu=CfGCUu;l074$ejS@UjhdOS8;6b(PzTPgl>$b}uhIav|p=q#0L#X6s;+u%45r2nx zE#pCO1$9<2J_dLQBIDZx!BaSPvPq|$>D)tn3vqgJen`BV@u!LJB%Vq&9Uy)`apl2L z;twr_Ot#=zR4oqNBbpIo=3dkMG212m9Is_a|c63u;obX zTuZ#1@p|IjjK_)h5YHf;ZNv`{SCKqG{19>272AHn6YZti{YBzxU%md8xT;V2|4+da z{jG}h&j5t|Bu@Kl>2(tEqqL9x9=8bb_vEe^5BPQ=aS#)mifbkDG{)Bw&mgY)`9|Us z8Sf;X!*uQ=p3C_6i02bm`FWCf0pqU_k1?G;5-%aH{CuDIYQ_gcQ(-=9nf?UgO^jbm zyp8dB#N&)#O?)fkmBhOlUr&4oao82xXNd1){7b}lF`b8q?`HgQ;(M6R&x!A4{CC9n zF`ajb_b{FU9SQT91#J4hj2l2ZZ{}1BbjDLeT&aZmCj}qU(`18bfGX87g zyBPm7@%tJ77xCSUrw@{Oewgve#P={hgZN&?3yJSz{2Jo8KIrk*5$|FAR^rbv-bK8Z zxavP&BYu$aM~L?kSL5+%;>Q^OCGmd7-y|NUj;wS(Af7=S(kr%MFo9#g&18HM@hqkj zB|eq$LgM+1uOhyP@tcU35Lf=(PJ9*P|3SQ*I819|`x@~o;wsPIC*H*Pv&1(Mrx)iC z@i^muCccI7e-q!z_y}+S^LaPp*~GgUpG|xlahP7jb|vwh%>H`fyBNpwTCDee#y1n+ z&G;9IKg{?8#P=}1pZH$Je@=WKapnK-iT5!3zY%|i*{4BAMgL!9d;;-VT@=UBpKdhv6o+9}u6&_;bXw8UHo$sf-^Z zp2zq};&T}v2`84A&qa(+AzsXQKJikPXP`@}af zK4iGe=N95H%*A#V@ovU*iSHz?=B0(icQgJ8;(LiJ|LchFXM7X!XNXgGaXw4Dm+>9M zUt~HD5kJWIPl+F9IxiCMBd+rB2JvHzpCI1P^i$GhJ{>yIQ1NCGPhG^C{fwuMpngabs%oz@iKh{VdBd+rQC*pC&|3!Q&aaC`|Na}~g zRX;hG_)f-W5#P;piiq!Fd^PcX#MQiaBk}!=w-N7QI-SIO8UL!_Db8WKKdJN|B>O(H zucH3&IPr2y*jnNTls<7fZFT-Y{6)t9PW%AlgW-ldj_ZSrPb7}lNw_Kf>BJ8+zJPci z<12|DVZ4_3QO0j2evI*Zh#zPC>%`w3Vta>pK5;m$65GFs$C&-l zF|xf@5r^qoY-bX$B@U+(VmqIB8*w-d7TZkXTbTYr;@gO;`TT0)c)f@l4R5E6_-^9L z|8>OoF`aYA;uuuDKx*ON8Gw{SX=4&A9rg z{EJK{myX-T?P(}K$n4cf`ysclmqPm)PopX4S*D|AmY03_Z<$WP>#|S&5958mlJ))- zxXKNMBwj)=-o5xZAHFiy@yFPwkKt)ftmFCvv5vEv7;EA9spXthDI$e3h9`eFltgv&*;f~@vKRj7@xD)jx)K;#wne7wc&6hJ6y3ne6I9lNgGjj5@MXI0LD_?GrrpVrg-+j~;2+&vMga zWFIk4kE~&Hf5z>nsRDbS)&eTCmwAUsQt6~?3$Nqf#4oC^E=qhWw z?5v^5|60~^-H?o|A@&R@mVDOo-71W%A@;1o&03S4HGz262HIl^T*r*q5qml|fY@Vh z6-Mlcy{kyN+n2aC7(pQRt|9pbT;*0_1cBJQiZ0pjW0i6e=^DKqhk@*~YM6Jni^;jt z!AbU7Hqtx0WZ__Uu(PSQ+;z!_8ZmPzQP1Z7l-o~V5zYHf{e~w`q>pHC!<9!Iu(>~w-rf%CFo}Mgl&tFaTzwFmo@(_B zC?(}?MMg>xn-!^)z^k0O-2j1%rqp0c?DWJTJ&D6dv~Okm-LU_BVITGiFr(rT?K`BI zGVhWy*NTjjL^~b|#|V$0MMN1gSd{y`7yLfIUfASz4x<+$HZvi#G1>NVpAg61p!K{q zSKLT5VpALwUidRaYlsLjN#+<$u_qlGg($ekPtEIR1Zj03?%tJY4yPj&pwAuAWjFx zDIkvjeptlc`aQHboB1l2Bsv6}^J?93XY@A2EScDolk9CxuDFpv#HP5Gz^*jti#VbA z^{PKY*nhqOjt~Q~CjFhCok(BZTa%viq?rsy=wyhbfOVJLU&XAjHX5YqpUZ^P&9{0m zt&l@pTGYBS(362UsC#r(#AX6wR73LX=vKE1Bgcq6t57FGg-6`WlOuR}GIipArxdRLo-ce4A#|5yFXDE&&ddDZUzj8ibLT<(vZ^yra}kFI+N{3Ym6y38 zdBm3daqs2mxZiTL$JLguV-4UsVh`=hM#Dttu^=Vn(Li&3pDQn2Cwat{{CnQ6zvt(A zkE<PXpZ-~;?i*vM{J2FoAU#%wvlth9@>|UJzdVxKy&?& zD{tf+u_d2u&ih<#Bj<=cw3E#FQCHl^IbuuvaICHezdI1?ibKP}pj`=l@a5Q(zYE2> zM*l}F1ZOQP-+MPbV^R0<^y_+HOdpSRg$rU&_JyzjR?{s9gsd2m-6@!IASx^Q@p#oUDeHK=IG~Mv(JQbN#{^Ar!=?s7p=) zAEi1r8Kk+@866X`SsgT2vK=$S)iydNVh`;kJ7%UUZgfn4xbYduLu|$O9-MF` zwYtSzaU*$%O>vonlQ4mbIp#XAIp!ps%ll3-C2mbdcSh`AlkCkOp)%H)SGkoLof)xN z*#J6oxvOoo2VxKHB-^9b6*t-gu`MpU?@3tUegSLU^4OEVhc#^ptZ5nY5*-(}7v$mw zCk8O1!{Tt7d)9b%qumy7a@{c+4Ka5|)*u_~G?lQ%YI7?w8VfP6B2y$G9tRWCF2=eB#r;MR$JKAyOlIa7TNte$9+Kc+LDA zJc~Afn76u48J!uihf_(PKX<$GMz=+5$tQc^w!_snnhUXq_U8W49#@>&r7}*siH~Y` zx#C7+A@&gW{FFJN%_j8SuD0PgVh`;k9pB@M8;&Ek#1F$&SRAgx!ZEkE#X<+57s0vM zlH;9=?tHi-+=XLn03Bxa>?5PSHMbjRv(<&BPo*pg4SWA(b)M*AT4&`z>_4!Gh* z`yloZPp)Gfa3E+jZa9wE6932@OP!_TEQV+4m%y^X?j4F<`I)=;*x0>I zEavyy?9XEoPj_I~)lQ_2x)B)ZLF^Gh(oc6Bcjb))A@-1WM;xqVVs?jxEc_Ha+@c=o zIMrhuKNW)#)A8sY$e4PFqi{wK-YqniR<&s4iA6))Q|)ZW9b7d21v8WJM2F1qFDS?K z*$9mOWUrU@fe-qT%^|s!1NPC7cT1f>%SuZ2aWA;vtB_?21SdajCAD4;9mUxMpt`yW-<@@apa+O>rYniL-dK>&EP^E0BNJ9ieqy>?+uGU;o!ByRP4o zk(gZJLAs9i-ZOXJ7P;d*>i$?SKG)rVh`;k zb6((z8#zbpAzrx>ZbJWJHwO1(>>0SlLNCYC~Mu3PtJV-jgJ+8bF zAYu=Bj{p~C#IgB~4lKHTZuLfVh&`%LI=UWL-iQvdhrDNWTQR!h1BoC)f>?v_NYGT==xlFBRa$$@}AM{!05zjb@HqHQMY;{ zI>a8;Cmr2!SKf#Yv4^~8bh|LRG?-lmurBnw)f>?v_NYGT=o~n8l-FcNbcj9VJ)_%= z(Pa!Qx-_?XBRa$$)h8WYhAVGGhuA~jGrBz(UFN`|%XF(ZqC@OaebUiox$;JIh&|*z zquYnkWeqI49JhKSI>a8;Cmmg`D{n-H*hAhkI&nIkGqC9L-Rh0#5PMXgbaVx-yb&E@ z4|&h%da>Sahr0>W%0SdsLrvbmgwR z5glR=dC%yMVsv;FKY$gX)~()%4zWk|Nk`Y@${W!k_K^3C?l?v#FKyL_NEuyt4KKeI zrM@DSu^lga<(Jo1!Pli+F7CQZp0ORT7CmgX<8_u7$Cb!~8=5%ddDv{ndESfTC{tYC zPd<@;A&fu$`(^$S;02R9+Am7H<~W@Vp1GgS#?d_Ws|(K}Pp5-tE2p!;b8XG0OSZUw z9&jes?8WmlW)3s9*3lF74Cs4} zaknBlqNpOotfI=oW8U9yIOg|s_EuNh2m-N(w%>=x33>L@0Nt*<;W}bVKG}Q5J6vtU zb;KUpey%4zR%fp7a^(%z5i@zWd7(3^rz11Eu!liU#P6UTOFW1ICdE(npGaSY{O}3* z+Q7T;0eQQ)Q!6iBJnr`=d_+6#6OrAnk46d*Gapeq=@jg7<&6{|_K??ay^8S#vv~L^ z_45u#@B^+leul$MJ`k7m7s~g!-Wb6m=HAE}lK&!Hk6VQiFk)84=4blk10Cj9$;EAV z@skwdS%xRDz2*zU;*M~(dI!JIk$9U?+*NqAxMNXvCj2f4-a-(>x`PJxQBJ``sFh@DO{~ zko;h9;6y{ePeN-rVpatX20294@Fnr9Cr?B$j z0+`m@KZKv7f$6CPW5m>IpFVcbkLVl~-2Gvr_H3|KUmg}a_}tcaAS(m7py}^dxiy;) zu;Dihy@9NP4m?lc)pUS8?`8;pG2mVJ#Q*@}RO8+BRlUZK2S|gA-t_D6y0i=P1Lu5r$3?u?A3}S+Js&!% z{)|ll?9($geh={AA!4{bng;1rPp3f>;I8%nk36MJ=C{If+=LkUMrVmg9-~j$Auktzf^giPu z(&tRmXWUKrtPR@(w#x!Bm!EGx1cvzY0jxO?iyHM`O;c0;V|akLnUr39;N%M(+oxjK z^y_x*xPz0#x8WB82QW!&b$?~W=(LFKUX^^O?RMpjPK(%Aq)&_VL=h=z00nvZZ zNB-_siCvpOyf!(br+;n=Ob2hh1oepF;+`GCw_85!XkTTE3FIx7%<{0?O{&p)h*?tI zb1nGUN_5lz*DBfh{vNjqqumgjRlL<zVJz4l!30k<-v@erGpz4c%4=s8nA#c#SEa&?U$5SzM2zdLmm zY#{czRT!=#Hmi864RvwAyYrA7h;T7vUH8M!)Vgz(-I>crbZ_PyA=iB3uRqTI% z&VfOXXXKp@+&Amoj&D1H>Y@TqQ}LqW+P{f|`e6FPgXj>^`Pm)dSl4YwV;#5c7AwvA zJ^Hnz-@Ih42wDr@!@+b6|(bg>>Owoel?E+F=RtNKOHzQoMycLIrr$eMZ+ zXOD%w#;K#sR7d*(NDR9g5Qt6Wkmx?Jq@1n7gF3H2@Uy48=@+sy@CK0hh3wnlUhR6g zBeilDq^KLtPQ|&Dx*6S3xEnJU>nPllK>GkeY6>x_cm)6PZ2VUpMUV3Q_G#i44I75| ziKrX}MsG!|C0qS?Hhmm$=~MPEIMeTQ%e$_zj^gYzZJEH&OFhOKVvkxnSMGqN7fy9x z-NoO^Jls)uL`8iRc2D-ekJWV+9)%yUJNXoJ*t=iA#3ujgAbu9^5j$ebt7Gb(q-X5% z6GHFUGu>K@!HU?U7A^LSC4K4Bd(-cF9XeEJ;W11?@-ZHVUg!}cVvpKS)xM{S5kE8c zXkWx0wP-Oy`<}$MJl47LC{8`I;D`bA;w(4EMlVKe)qnVuEhz_zcT48DwHPgl*sA4- z_b1gy+|vOz4)GZZk9I=rp?#`$l2v#|knh%FM1a_;Sl}mAKUzK_RxPgP|)P zv59$3AE#=vRc4Nh>0G%>TqEO;L5Q!~Cv){%?p9?4gxIQT;G?M4t;Glku~kd5 zP159Q8xbJ(&>m=$w7Iny5g@i|!BMn}Mv-h9Z3Hd($QMK_{u!Ai*ZvD#^cftu~?D@i8dF~@ldb(>Gn_Dl*%9&Di!6jKM)~{)) zY_4l+%{q5VRaRq7R%>l_Rz-7j#m1~DEm^e{Em<2X>ep9iO{uTSx}~-5?_cKvIct1DWePS=I?O-&vy6c?>1EnB#3 z>0)p~e?K^Y-NSM6!}7Ig>7o^-^Ou(*)8Bj86)s&QY{cu}0In70G5YcF-mqU#SUSHf z<~V+@i@^i@pO-7XV&SrtOQBr7vbx+D<`)+)q;Q;%^L`=3rvLwOwDe53I) zpex!ye_s?US)d9&>U+_Sa2&o~sU81O->c*B6}Qr5rHhvr7FzGI$Kn4x?p*4V*rPs* z4ey(HOySbP4+=U%gHM<~J{>y49;XM!o8O=IPd(8>H?R8qKn$x5-zJO4M{Uw7x-@gY}~&wC(r*Mol? zbYh-tljHNU>KdwAS}U4c0pR=UhAJnkx}myxZCwT0)Kt~2!<6Iun`@e@tKqewvatd8 z8|v#?@HqFCxU$oa)irbSYa+SRW?q0AALYI4m*(rjWlNSUTRLrF@yZpYh09^hqW#$X zBK#*E)&7bF%ZnCW0ZSc~7cB+r`3pGx~ghtcvExZnu;~`(-u2L z4XxGnIm<7|S_~)S&2T2Yuo1$phqKtlb#2uxS<5RL)>gMHudc6Xt=mv7PpE@|kpY+h zNCbi~w?HT`KJW(!G*Gw332*4xlo|@0C4uZc;SIgW&LxIDDZJsprqpm&W+0&Y<6l8w za7ZbKCk+n-+&-3ij!`yoR3K2Mgb1A!Z9uPK~)Rv=K99+CtHa~wg4->Xs3{#faC>;%3}73oZi$vf@>Dptg~v@p z%T{IA19lj4Yh!auSrwV>1~?I5Rb6dmL&CNXFgR6RU0+rYp2~`jgX9?~u)eur7O}0j zhsQ>RVSQs67R;c6{@cQ1v9{`ZDo~Ea;fP6400A^Bm7`#cJqOuL5;z2GBr!t0fY5>3 zCe=QBZV!)<`AE3A1K2FE!Z_)`U4YQbHPr;V0Zat|Ig1eLxh*^<2T-*-Xdi%cq)n7; zb_0SI#lw^`5cIsYv6aZt+ry)wf3)U`eQf}Yo&f!%rb1>@=a6XX`!dh{o5G`^$*b4Y zDOaEakA^k6x~aKt9aRHp)Iup(PpJF0@Tkk6v#xJ!RcI?9$b~>E&>g^Fgdn2><3J$v znpUjwN^>xcf-zCkDk?5zB@lN_t8;@%N5U|#Y^iHlTVL(ennh>K4+dK5);3hg)QGM= z7>8VIMeF(&XM<@ycq|0m++5iR(;W^qX^ukyC=ICKhT3rO!cd?tO2Y+>QeH_92Ve>W zpEs0gGf?V{l9#P%Y;A2^Cqxs?5JR@E)a?z5(ylM+r3 zp%-PaL$78th}Tp`@v5ja_g76s&8kkJ=^E#d$bA z7fPBNTPy6bFbv~_3DiDl*ce$-l-C zD1G#uF%^#z>$FugBPDPnoT1pqKvXw2)x*Th4slXOgYPwXwqth45zrjqvp5YpV)o+H z5odu14YKTSybPKHx|ldF^<2~Q5f`Tfu$PI#al8<^6DC&_Ucd`6^_X8#dMPU%2_ZoC zMcGnbHZCR53@0maZ6nIdc=@^DZ*z4`U7OR&ipD@Tn;>Od7$12dcv{(9(OOwsRoCov zv*Jl{HtdgVXzUaP3#+JjM-SY@i1X;;N_&wGMF;7{F)(bLw%k$Vr(j zTf<%;&W3`zM02oVoO>|rmMy^W%V$|(iSmi(!mf#bFO#U5a_yf zc&fo?q#>gR1sclW#ups7&OTWkG6^){o=ru4b=f*~J*&Cwq-20H2;;da#A^(Uj0vJh zjOXXf3^^$&=|Mc2Pkr-ME4X`Igh`|A2x&ZWE{Ulh!6VyqxMH5jOFYl1tD zyb;1tDzPt*f{>;LdooH5jsjk3w`Xu1aL8-f+Gb}Zb09bgQZ7zZopN4u9u(mXW?e0w}9!ZK*7?uV+FSohY*}(?WAZ8O%=habXMs9?YmOvyTgB zkYnz|LQV+P8V@OJKZnbkQ=UK?BoEpxv zfkPX$aGrxnZ*ttbjS!E z)Yx3N)_Kw_bW$>*qrfRgHC${OePt~4l?`j^tD59JPi@jq9Sai)7PVC7I{$6zrH+Lj zS#guS?2X0w^(Ht?dYvDT3kA5s<~m1t5%deV{|27H3DLTWHft>%hw}m+3+u=_=WpiW zcwU$mXj#)-SGAU(8m7TLYWoByI590y<;Ano0yQ2y0QwE~91s|Z*n^J+E2<~D5^VUg81+Vay2cD<0+l;~7G(0PUR^yH3qzrO{fm^C|Y}KDG11*!&IIA)> za0wOTJkAR7hV@{WSil*h1BWt!IuRCCXwu+7Ri!hJ<8uZF+VFIE2`@Mw3g80E`6Mrx zib7>@t9_kQ$I1fWPy=L$yP6t+4@0mZmzQ8t2jhj@x(YKfp}fI?R_7L0L1-2jJ6k!; zAB@*ERnC`q!DV3H>O5#-_%s;ntgeBUT+hzJLgOKMP~`l?JSH^&1r06htraIV0Evaq z;ovq{nP>5gL~-@aJp9zag-{HQ>v?Q&5agg@4SdGB&iR??55_Pg03VPWO&=aU1SgIb z=U1k6YRbh!~(-z+Z!oXM;#6@qO*SJ)Ux4V*h90QZc_HdHh_7qNo^ za1c!J)po(?ApyK+TjpH~(bcbo8|h5XNf{MEf5RogR z6@~kF;rJn9b{2)t@j|E$&i?SjzJt7I22==hfi+GYXHYl=A5XcWaCuJN1@M@MxUhA` zID^u{%M0fh=j0Zyn(-xK%E`i60oD|wGE?Rh9#0k>gf>lfB zFDZ0NNH~z9s$lPA4WYq-Z9~99^qN5URPUS&Rr)dC4V7UmTUjbRbpiw+D<&vew7>*Q zmK8@$0uLOsgFvNdsc8fcyO{tUo56>zO<1zLaB&el%N3wRmMklELgdsjFSU+I|N2tqAv--kg|sJkkMc!#y*~u`0oUDv&2pipAc07r`?gm`?EL~sJHTX z?>)^dnYUh&A0a~j*tHTj)&a1Omfq7QQHEleLCYmtf$tYC*98Nm%r;dkL_$U3}+NAH6h zs>1KWqk`&j!}{>M`jdi?8I&0o2yfVPM=IrMSRk~aAXWIA9R>;Kq5!xNI2j%Sf5p@D zfoaq08sJi(s=92wxcZvr(37hzjWw;eR5VvlhsT;KYcGyWi%y%}6v59fu0UQJ^1); zsQdBz9}gc`s*a>5eWlgg;|Yr|$w*eGkbGWP!q2E0)KkX6BUtgTf@Hi)2i$iw=;1Q~DAefGSjta%!1VX8SSZQ}o@a;h; z`#3y+6^O0Q3I08dyM6EgF6h64w%x&B3nu=qj@1TV6$+igou7!mg5-jDVK@opa8Z4nIXUWTb<7Lx(!fPFv;H%xK3&6O|i-*fP*Pq2kyB6NnOX51AFgQT-LEt~-*gG11vV0Un;oG$I- z-vjS(vycA+l-S3kU$}Ysh2O|g+d%wUtqz9QWc|`6X}mIpdqmE(mW}JgYio5|tCRSI zQQRV;TdD3nVY(kc_YT!(`|?o&_aVx}qp+X>_dM{)0r&z#nKKP;wZS8@4%~5t^#g8b zR@GI&qqi-sb(MnM(hQ%Em9kJ?Jf}ub~lp5slcZXe7_}-d_JA_5v8OSHOt9BuDHuIbtu$5qnjR*vo0e zUQZ)4ZSU=ia*FR>AOjg8ogY{Xt=Bla>IvDev%z0gMNl{R88wGn%*jnHDNrg}M> zsXcqTvsdB>Eyd~>d-||f=7_yCN9?sZVlU1Sdv%W3%X7qDpCk4H9kEyFh`mHd>@_-S zuhCI^jgH!Dbkts>qxKpdwb$sVy+%iAjn)>|Xs$KBqxPyCwO8e+y(&lTRXJ*}%29h& zj@qko)LxaN_NpAUSLLX^Do5>AIcl%UQF~R6+N*NZUX`QvsvNaf<*2FsJ$vjX;oIEQ!d+T&sx``_KF>)6&s$#$<7x;IjW!0MaAlE zBC%96gr_46;atNIP96-Qj|^cD4B@#4LwN4N5RMOq@Z7^hV)bSSCqjm7@5SoPtZeVa z>dmZd@5SoPtZeVa>TOzy)!RVE3HS`X?Plsbv-O=h`c5R**faDZW>toK#JC?8F)E1U z8=6LaQKP=7QD4-kFKW~mHE+2Y(M1hkqJ}R~aeq(#Oo94pFMI)yzPbkQ=<9`vue0f2 z5s{Cj!~I(M%(4C?sk}i;kB6$KA+;wI@vdUS`uci!#;a*#Sq(h!=@R&2Of}qYRjg`# zlXyR^0lu6v?TV!CKi-r*+% z$dA(g*Xb2M*P9DB{NbNS5S#j!0F-^4?4F=k#owcS@q=3Mp6d*!Pap8*68Mw1c?=%v zTuL16=fHdVFu_@>@qBuZ_Se&URj;b=Gn)Nn@Lu_UuV$}4!9bk{HI8{mqx~o875%v! z-YcD6jq85CO5F7a#bJA$ar{Yi+VMY8Ns;fTbaaBPS;tfaXmlf8rSU`nSPuqZe_fH;=0vGXP?IPdY{&~UhfOU zRlAf^y@!dbJjAHpcQqZoUH+kQT|W&!9fVEk$UVn7gYgp5A5EO+^JCRi0J6 zGZ}B9dguD+Y}B}3?-q^g_1;Zf^&d5^zu;s46=q*f3EHjM&jTOT{MkcX#YN`Mvy8V< zT*GLx=6Sn-xYAMinZ`NktoPCRw8nAGQGRYCj(M038vV2m?$qoDYxdvQ_$;umr+Qx@ zuKa{U#CC}BU1UFrCP5zWT;fV6PCD}$-%UDOeRQ^IT#t9B#<32Shwl;RdH9KDujkw_yh3j0+_#TS)^O}y{&mUm+aT5A2<9kWx9Uq+#1_>Mb zi6$yPQ;B1K@c*2_QfRSeulI+w#CcrxjBh1>exT{-aUEdxai|-&UozfJIuo%%*m%Fn z(YPL0uEz1LigzJ#-XE4}_UMALU#oFl|9*|*8mR0aBaSaLCBQrQhm;uKL2-$sLphIY z96AV_(us>bI8R}GC+S>Ioa@wS9G=8+{k)SnzTp3=-5=5H^|*ee@%dW3eP;+Q_4oaZMf{xQcyKj|eu2NTEq>-8?yxbElG8rSX1 znSPx7tY-Wm)m!hQ^MJmpRX{UfeyfS*hlAGW*-;Ua6ZELMADf9|8_fWJg#NLRb0{veovqA9MakD zqw`&6A19$7Fg}%Z-t*BJGD056{Yhs$mvl;q^SIVBd*x3(<9Vd>9Uq;iiQ{<5gFce+ zv^?Sar^d1W_tAOa86&;@AIW$=)w_Z?_rIRmEB|k1d=cq<-$!S^#`SS}fayrD;XHxy z64HO&N9SyKW?Hdi#&ThtQN&hV$ z9r1W99L)Vpp~q7dZzY|@#CaY{G_L2Nis>jn>llxdexr}h_cgBPVZX-pdSBuCRPiCk zw@|&m_0gFu{uL*?-DeY5`B8DrWqd2?-{zyUjoHUZ=u3>>O**gn=o}}`$M4@Ydp$pA zjg=Lltj_a^qYiR4-dlFe$FGP93MH=I`)SNGS(jgtl_tLseGxbA-* zaqj0F#&?jP^L%tZt#Q5HPL1pJex2#7xW2{sPOA4|ADzEwT(38rDf7VN8qD}E(!Y{8 z&sznvSANzoen07a+ehb7jq7>%IdRp0)O~|PjH`b2hL6tM#Cg0Y7~f5Pe&C}s>r9z9 zo`?Aw*Zp5kT-B@ca}DDUQ@uC%=zK-vdOJSCbfkBV^Fzk>kpBBVI>YfFX@QOVIg0VU zq*F?q=ivs8>v^d1;p>^c^ulpI#rQs|H}0czmk)nV<9gl>Xk7R6RUiH*;ygd^FutGs z{F{%?KYjS6_z&X1#`AeKaaFIha-2^v-b3}?>!b5sW*;Y^A29w5>AdHob5i4a-bT;` z5gxAdaXx%HaW$^h_|5m>*AnM>xPkFr^8ahZaaV8meav3v;c>^&Iuo#w6kSg z+@CWT?mr<&O-e{N(vOrMK9vzOjE&U1`skj|h<(t`VQHgOe~^5OEc>3o|w*ZC>4k2`XEn(;-X6P_%~xz2dvDlU?7CNW+@I^{k(w=nxS z32kD073n(4(S|adg zYv3&5R=;MC@w$09S5_2+7ralawrt`mpPQ&&{4IFgkmLV!8^l?r=@e@DS*dY-J=&z{ zpo8%c{DG}gvtO*~;4io1ru>n6@O5*>w~)@CG#x$9p=^1i(utE$8sl3@r-(S_N7pH1 z_9Wv}F@87ceA7o~KeJc(_9nz%och-2Ggp4B=&gSd)!8|hrB>F9ah$n1BL z{Z=3QT^iT>&-a+lF4EbnarBA8bY9bR^#0SQ@mz=tf5r{BV~lSh{!bsCex5u|<>7wv z=WODbPdyJ8X<_qAN!bQudf&Q6NtE>4sx|#T&L+=q0M8rYFr;LpVf3yK<63qXRl_j zKlk;FW=|hwz)_C)5kGuYalJ@7f6;V|=V3G*toI<<5553ZPWs-2btR&n2B}h;yBK;@tl)FdgOR z4#pRe{;z%XPcZv93BAvFG3n$_lLp++CB(U(apEcu%FlMjOG*DZAN@C&z4G%2+R1^@Q`4VyN=i^L=}`u|||aS}So_=}`dFw;BUmBhK98;PqtC_is!{2=K+;iG?u*(*PP!}wv+ zIeV73pEHPaKd&Lq{anrX5z@cUNB@V+UitYG#*dNChdw$ZW=sFMpEHSbKQCeYJ<`9G zI3Gvbn7#7zON@U=I!UyHQh6lza|Gk+Is4_rdAqD7&i(9U zI?B&(#ut&FFZ<~KiP^_V=pDw3Nhf!%G~j*~66b!_5m$Loel{>(O8VdP(eGvU%FmY= zUrjp0FZ1^ET;kl%%QSm@zFOUCI)!=xKd7vo!qf0J># zoN*r4xUT=K#!-JF>HLmyTK=357#~gc>6gnl*pB+=bQ2g?dALa9=+9h=cZSB%A8HO~ zna0t65!qj(akMX%Za6I(NBd&3zg6RCUrP4(YFzi{YZ^!UR;L#<7i(+_A@lD+h3}2w9h8{Yc!7bs=t+K9PL+={jH4O zP5dF^d_3-9yo$!r`z&$w8#JVOEV{rIFD-%<2%WpPZ1Bo@p`*|f!W7Ne+T30`&z&D(Rq`& z@?U*kma$L@2H{12{`_p>-2ZbK-%I{q=%ce%<9b}p8rSRnG}Bk{-o^NSs<+EW=LL=H z_5MoJ!S?Eb|8e`RX0QA6Kg7`%`B7o*IDgi3(3M{D=eWjo{l95k*ZBwI_mjS}NWM|| zSNcOVjyhqoAER+}?7}%@z<$8_l@!rIANZx5;{6*5g#Ybna#`XL^p>e(5 z|7QAes`wSg4^q9a`RI%*lm}wGdc9MKtN!0jpBLw9_PRg$#Cf}4MqIVa;S^clLgHK> z|CJ5g&>rxzP zUy3a0_0dULEX#TRGc>N(JBhf;XPhd|X8ah{dy$V$t;Y3sZ_&73@27~X_MJ%eb`e+p z5OzM#ct82`B_I7=KKj4c>~%li*0}EHdpBB?9or9vw?9n&ur2- zc4ei1m&Q>?%`^X@akN+SOfPXh&-_B;dfpB(PT@MoG=0oz4;7psj`8ZhHxe$A23T(q z6smRY65=XvB;(9uJd^rET+`9}+n1PqoP@s0csA+0;iL06X0QDD2jjVG-KezB1W{=vq-OYF{>Aa-r=>712n0;KR!1*WRt)w$`i8SE(zl=EMM$gaH z#8vyoNvBrR(Vri@(z{;%}K|ulv)W*`q%@NPmZBulw@@X1|N9mShg)pD- zJ*0Cdao)aPVfJwn+Qs;O()pc_&I#hYp9D*!Al9q*pHUju$5)xgjr-qmZv!^sTZ!&&}bf#UMh)W-LR}oi!#!0Az@jlYI*GK2O#4%_3{e-8O z&Qa3&wWg!T^?}CIKufK6f#uRMY?r|rA5EOsn@e29+fw$CyR8p z`RII$*~?mC-e5e3bdG5{dbA&*r4$4O{7<9VdBj5r@JYl!o>Zq~TI4&KA`SCRfV zHGMsAKVtSO-u;Z1lg__19X;OhbOV;hJBjgn(kUm-<82|%_M4f$8!zW7ULT!9#Cg4cVmdNP$9aeGZqm=aR$6eKCB#*KP=4Y+=Zc%+>i4I< z;G=Vt+3%-%-)4Lt@e>-?uS4J0IG(?$>(K1$ggfH-FAD9P_5vd$(pkLb@jY?$Ye_^P=x*_Nd=Od3Z&$*UyXo!t8s=KIN0LGW18E zR|_?cbMztlJg(S>m-+A=#8uw9rZz*s`o|W z>8oWu7_Y9gNaK3F+lVV2<^Pu$KS27g`RKf*alPL6nU3=RL&gu1{?O~a{V&kC?tdF` z?*DC!A0qvq`slo*aozvdnU3=+bpLN4&i$|Cob>Pa(fNVKb^o7a zI?Dg&7(YV#zx2@=Qs(V{7IE(X6vmH|evOaLdX4M;Z)Q5m|E-K4BmH}QbY9fBp8tO{ z9o7FsSbAU%_;g|22%Of7NfjkIsV{*ZqHm=_vmXG2T!9pIPCE zjr*UYaozt}#8n=Y|Ccfz#)~c3uJqBlL*u&t_cI;k{{xI?kp7>1bUx6y?*E`Q(l74+ zFvcg6{siKfA6=(JSbV{_)TZiEyoU<#x8`tD`~aO-e3Ef>zOkP1zWUmz}PdD)s%wBze?F>BGf=$^MyeRiCWxR)Ux-?!) zvEUI8`S6z+CpVlA7#}UGbw*PIqcom>s!jbaF6TweUg=jeuJX2t@nKZK7a7kW{$0kE zpD!?;N%n6tK9P8k&J&gY<;2fo{C?v3j2|U_E#p%uN9y`a>8syWzL(kWCHo&T-cS61 z#`W{_H+{H6iN(XwUgdv0<0}7ojH~=FVO-^ZE#oTxcQUT>zmsv5{~s})MfrT0@oeJi z{6fW*LwqpJTZ&I5elFv=#4l$&kN7Ia^NF`GK9_hG;|0WbGroxUGmOWG_c2~f{2z>$ z5SRbDft(+(eM^Z?qe)8TfiA0^7~`wSzCz!%vr;~9t ze?G{#nm=D)T+N?vF|Ov%RO%PX|11m&wp_-uC3Z>~&mrE#_*CMZ8ZXiE_H7^jH0N~8 z8=O;r`;c?$Z)Z}X@NiKtHGujZT9;FQTgmOIzcq7C{p}vksUaWaoci078pr$jYJ1&> z|ATRr=Mi+%4JA+~mxM0VI6l9vw)sB%I>uE$Y-OC>aJm^+{ptb6v#8={7+3!PhH>S8 zKjUiMRKHt`Az@qvq<`^9`9|>=@fhPJ#48zB>)P#%my`XM8LuV&DC14U)$iFVf7*!u znc2sQr;d_ul>JuXS&VlRpUe0T;;R@hKtb4A7{_O1ar*+}YD_-D_$so0iScsc|HF7K zarOJOxQp#oPy9TZpcGfSHML1W}Ax+46cjy{R;EaLf$7ZAUi@p9rfF&-y=7vt*pbH2*B`n{bWGJZGd z{DSdr;%_s)FDm0q9c#v$c7@!}Vtf_d@1DbWyjt3qGQPV}@|zidnE2g{AKWPIcQgLs zX33vpJo_HWf6sX9e@gyu#-I72gC%CpR%3zg*VW&Un^5$?s#l zhxk6m%L}CaFBo^`Oa3RucM%WJ_{P*=yafxS{h5sSER{UMcmeh2BF5u%AymQmF5O6U;#-p15dwuxN8Q(?vM;TY^dw?86Y1HqgI>s~JM|`%%ONn6>SNrfr zjjz<~yL|YAjH~ONr!+oO)A^MT{|n<8pOT3fbe4QY3Di0MuH09@2dj7=ofOPv_6OF< z%2zVJ=S|5Q8Q)8MtHwVeO-04``S2ewuIB$28Q(?z{DJYN?4Zy;sqt&HddHnD<3^^4Y+6Ch<K=Olc2%2T$#~jPT-npKCq5&}!9v=y z=vCP(zM9@(a)==I#OjzhPbj1qOc0bvJy)wdaNJZD(0 zj{oL`y0vXP&*%929+SuAu!QrvuJSql*`LbeA2F-9e7)A^_zh3U19zO}_!>H%xBu`S z@8elG;&Wo&c6j8sdhoB~{5R<98;?H@2v%RIw4m7 z_5vP{{e&OC)93h7y78|DI3AD3^5ehbbNm)Mz8sFh4Ufm6#E*Z%=lCNY_2X@Je*FId Dj}I>Q diff --git a/source/cluster/wham/src-M/obackup/proc_proc.o b/source/cluster/wham/src-M/obackup/proc_proc.o deleted file mode 100644 index a38ab2d9e2f7016183d97a9280153412a6f6f31a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 2504 zcmb_e&1+Ow6hCjC^&>US7z9i0Vp?idFpo^?SDK>Jrmx;bO)>CrBaF|<#9*C_%)Ch2 zT2w}a$D`C;-E<%N2b9u9nbgHZ=pwjs(M1r1k+|?<76AvxbMC#zxpR}c>VbF9IluFH z&%JY#tNzztr5p#C95@DDjZuIFw=3tQn1g=kgFwU&Mf~HMi07V&#D9`NZLKr+5sGUf z0TI7Nz74r{kd#E&>X+o+AQ6;zS|rj>jQ%~>r;OCe8;y7G$OdYUhp~w!Hn9>1|B9c2 zHbyo7lDXr?AH5D9b^`x51pmA^zV2IV}3iDr_(T6 zZg*Q=QY~8@1vtty2c>YI^#riBUIb?;caHX;o(xie+Lj6kS~Q8aovV&1Oe3`zDK184*Sb9~#*YJ86VS&i9kx z%%`2*+qZ1Jh1cVK#ONcsPRr--q;ICi`!}bqpog-3MmW+aEo_gZS;n3r9BGgiwx8_U zuMm!OfvzLl-J&Bsyy|zQC_D#VHL55+!&0SqG4!J1d<5Q97=_@St5(6Ql$BB_mrBK1 zw9S^IqK8u$szzbqTXdkX;!J+J5|)ax@c*!6FbB22*~*pE`r%ZsVNa;f8t zi53)tw~V)w16Yj@kj)C*Oc4?e-=2Y7S`FD`S9&%wzkIstwdRmMq?ymc_ z1AK_4L1SOnbqL*G!daJZC1S+w-xh`B@FV{}NkNitC-Mm?JMa&INb=1j;Zmhs$kXB# zU?QA2<$aPpdPGVk5|4Hr@=7d}XD{dTP^}ii*=Yl+AUIXMTseOU1^9q+BhlTW>9^^> z45YmTA~CKs0D1?A80QoFM!~Of&U4Yi+5cCK_aQe=NS1jp!_W%F@ diff --git a/source/cluster/wham/src-M/obackup/read_coords.o b/source/cluster/wham/src-M/obackup/read_coords.o deleted file mode 100644 index c27b4879ae4f10d9036fb7024f68ab0f55faaee6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 251944 zcmeF44}4rjwfOH%Hfh?XO6zahc46D@k#*1IfQ9cb_E-*=K&xq|0fQ>|1j zh4~S61gzhlG^u5!0Z8;Y?@YnHIiDwZ0#{?*FSuJKmEePd2h^eSzFY7l=U9E{f)6&7 zw11i;DyQ!dKSn%RimhK0KTbS__zB`Ch%3uXfGVN>l<6|zI7&Z<_%`CI#FrCqB(C%< zBfg92c@Oa%;;Q_W#H~!3q0+yN_!3Hw{=nCN5YH!0r&-SvFC#uhCbxb6?ClbGj_z~i&obAN> zh+jbIpClf@1_`gT<(u_K;z8mQh>wFNi1nIF{Cwh<5icOF%5x3z+lf zloQ`aJV?Bj_%p;WCEiZFpSbel6N1AZ^&&%jS8+N{xmG6l74hJ^@<6%HXd+ufYY~qhGJ(m&R&-iu3A7}hM#Ghfjl=uP0Hxoa^ z_=kueX8cj&M~K6rcCl=0_?A7lJ`#E&!n8u1gvRr?$w9-xk>_(W)UXwOu}&n2G0 z_yXcHiK}*-M|>9Jw-BF8d_2|nPU1O?-%C7?@mAsmjDL>!?ZoNLdXjiC<1Z2~WBds5 z3dVm!yo$Ige*zc~?bg8fG~zoL&m!K+_%+1$5vMn6CGj@KONc+lcs+5v4&Y1a`4I8_ zj6X`egYhpBf1J3g?>C5dG5%fRhZsLfyqEDei612n-CVpTKt^cKW5nsrI*0fm_7iVo{5j(7Owad-cQF1M@lN7kM)4XVet_|baG^na_Aq`f@gs~cAl^@0 z`8|*LF~)BpKFIi;#E&z6FYzJbsvWixw+JZyIpQe<;847tB%ZxmaIJ^x0$hwU>wOT3ry9^wI7 z@Im#(>%WO-5U1s?^=smDiPJRE`ZMut;%fby3L6Dzw|wF=NdMWyD~MlC{1W1A#8r8& zBHlq>$2`_$(^tM~N2`SNcCod>e74 z|KEx4W%|2__c6cxO7KK0m)5^(y_^IKWZO!zim4oZv@XmNJYW@5dnhCMHN^XfZzR5w zc$hAjYFxdYcs_AD&8i_@$oK=qZ)bcD@iNBSiB~cHb>j7me~0)s#$P4AgYo0UcM(_p zdK_#(VLN<;@fpPTF@72G#~9BgzMt_m#2;sT1Mz2wD|>Dwet_{^#1An&pCNvjrT;4N zBaDBO_)(^(m-sQpUnhQ?@xKs1L0pZuQ>IFLS~LMvd=~Kl<5v<-Vf-fIsf^!2Je~0f z@eJb1zYh|h$lHn?;+kpT>1Cs#CsY41MxoMs=njldV}L(Khr;x_%X)k6CY&y zuO~jl_*&u?Etpik6~t4BtN!%?;;AhCZsHllm4E+*_)NwhCq9eugT&`D{uAPhi7R{l zFYzUeTQKoJyX6sA^*V!iKI0b=FJ$~G;OOy2o5^raG0^D!F`tE1^9O4~}XA^&%@nyt2 z8NZqMGsKl0Dv2Lp>9-Nb{S|zv@;^lU5aXXE-oyA4#1AvxO}v-!SBM{B{MW?$h^zA3 zFn<;Om!-$~I`U&I{T$-QS^BGq4-r@GVFhuE7C?#@6Hg(o%2P)?ow%~w2Z`f;l5WpO ziDxqX`-uk`e~x$-ah31)h-WkXuMuC&_z>|N;%YpZ2=j8ZTQ1}05)Tts`7R({!1U)4 zFJ$}{;_H~6JBj0d7`~MLdx=*t-by^e^nZ?cJ>yRjZy>Jx_#*K}#*Yx+NnDlZH^f_+ z{sdUypxqu}d>Zk+On(;fHpZ_Z-cDTQyOMYZ(_cdTahATG_%p;*Z1!8Bc|UB--;hEB8GcE&$RyqM|#3h@fYpC=w6uIzA_ zcmvb_OXAxY{}b^>;;O$)I!D@bC*wilt;AKni-_-K`fnhFak9Y^; zA0gh!^nafCGmLi!Qp3e9b;u(yeM?919dBkTjel77JTcq#Eh#%qbMWBh*NxG#<`m2WHYV#Ys1yo|W= z<5!7SG5$^B^-RxU;th=docK1T=MThpFh2f5Y3E(UmEUI)e}wV*#P<H! z{yn}_ySj*YJ8`;vT2~Q&obi0(UBscp;#EZa0OPg9yNRpoPL%jz#`hBMWBg0Rk1_rY z;zNvomv{j7q4A~iJxV;CxSChINj#Ids@H_s(w;LJKZkgb>CYxUm+@u9a~Qvwcpl@G z#0wbTM*MchA0l2sJV{pD`Ydt0Z-6glhbM?{W4xRAPNwG-;;qD$eSS^+5#s9lWnU!i z*2Z`S@%@a?A>PUO)x-}FPmRy zQvLlo;;D>(k9Y=grRO!`Gl{Ela)|gW#wX5^_MFS~Tqii(C(RYbamI~x#EXfmapP{{ z5yqQIe=g}Slj^Kb6YnCvk@&w8&w~ARe5rBc0P)3)|A=@lan*i)MLdu3KNAlVSM4@E zOWL83@e7F;Gkyi}D#n)+Z(#g(;&>keUn<`k;;qD$A0HsTm$<6e9^(5LZztZy^nacB ze#XB;yp!=)i63D6IB~pBqL+W%#nNs^7@tABpSY^mWyA+r`ds2C7+*s?1@0T*OX=A_ zJe|0*&sO3Y#K+6itX;%|jDLpsT;gh+`6}@o#=l8CkMUmO1&qH={C481{C^={#?nu@ zMA|dL_$=bv7{8MEPR4H{{s?iE?;XVV5l9Eg-FW7b#uRjpSeNcR<@+4j=?U~JZI`JIh za425q5HBMhBz`IJ9mHo7zl!*N;#58BM&bvEPo(r~iT4nPX}oxq5uM3y8N6&m}&Q_$P_y6Hg%iMdAg-mHod)JVIRA^P9vQh|{vr`abcU#9^2f zuUCn85U1&s^&8>`h$}z-nfMXnv|Orn^p_J)XM7p) znZ#AT?;$>y_(ZABDk7f4(r+RjX6ZjbypW}DB3?#ZT~9wwyq-8M@2$@h-@)|!2k}RU zt8zY1yp6c>;yQ}?!>CEm`` zA0qxZA5n;=RPFdsr#+q+gB`hvkWQok=_s_6zZ){Cg2`+#ki4^5f;i zZ)ZG@cm?BYh}Sc|o_HhUcN5>mcq8$>j6X#DF~&blyo2#C6Mu&BXNY$*{%zui8UG3K zKH|#11H@0T^h3l`XrNX095-M3C4=$l#Dk2_CO((A^6z5eVd83>Uq(EiID`#|*J|Qr z#3vCiAzn{hwTB4t{lr!I?<3yH_-^6{82=RU9>(_*Kf?IeiT5-967l1V|CqR1xTtdW z6Hg7wiYoplaooqnm*UCU(l4`u0y}&f@odIt5nn=FwTDH-*Rk~16E9=@J;Wo77Zcyc zcn$HL#8rFPPW&iY6D@gv03Ectqo_%W8gm-rBI zrT>@2Q)oh@^!$N%CUKQMX@T@h7V&h-H-mT%OMfBpFw?(~_&Uay60cx-3WzrlS9T~O zzJu{<;xipz<`OR>uI4kVh*vQ^?<2mA z>DfelCvjD;ZN&Go^v%Q{WBe1uJD8p?67M3e?9fTPhowJAypOoD!w-oM5?6M3jra-T z$_~eg2QHNDP3cKoMAsMMO3zf{LB`J~K9{(%Pd4!-Ed6!F!^Bm6R}x>x^xQ$bg7GTi z4a8OXKR|pZaaH~g6Muxbvcsdq_c1-~#P>5jUnAa0T-Enm#JgGg9}qvx(jO&$l%;=z z_#jK4uvq#9_t){I>^6mXI&o!(An_n^Wrz91=Mq|p+2(ES!TwW@;x{A8|Zo$=R%;nn!SG95ZPT;n)ns@nLkzQHF<)0ILvJ2?b zv#fuO!S~1DM`G|_#^9MyT)%wJkHL##@DIn}`(p5yV{m-lgkO2^`3ru$JO;lf z29L(zyJPT2fup~apDtPkhJ@FF80o(gga4TH{BWl{zdIn`e-k79v_zTjr(0yYZ&24? z4&2WU_r>53$KW4=F0J>MLl?+=S{cuk*xJK*$0l$TygmWkuRPy}p#kmo!|kMihNzC9 zieA^V%$oV=^rMp%9Aaz z^+}$d?EiVjTg&AMUuJsL73irL{98;1m@A z{>XSC>A?*ay*(GmY_0LYm2Ff~d_Ow|pC5y-4L7|OzW-Pw*d^R_M_0J%*>xvRo(vz1 z7Q-7V#0Sg3-)Z>wnin>w9*pLK1YfUDma>!GO@iquPrfA6=EAv1uF zy?;J=G7e@8)#2bbU^-$^{!O7{&7ouAQZR2cg0(-{wS5xQy8%AqaP#_)_N#@?r?Do_C0Xg|;ihkeoAz}5<>bky(P~d&y&ydTsPodNP$lK8^j?dl z*}gLT;DJF`S@>XJ7V_r;j?!*aibMEQ_y^8L07^;E@}}pN;s+0;E9KFy`zAtdux4-) zo`oMpd7+%e{|B{cidMjz@^1tYR3F~3to|k&Yz_?ylZ6`5UK7FxLpw3`>l4Abh{8>w zo$zsIIJS*?xQ!5aZ3OD1f!;l$fqJ=t5C{W>8o6~qEtn<+3f>6i2D^kBl~Ed{QFdxZ zX_ZFV3vYT~Xp^`d-h`i9qG(XkbMPC;p3<6{vL(6cU`RX|3yiIGw+>K%rzm%H$}GCz z4JYmjcT3y@Z#dspxL4vnc*7a3!u^O#L*3x&LHsDYtn63er&P!NI-FsJTb{roghij- zt99AEU`Q(XqOPXU;igcpS@Jmb(<1#)Vw~Hk_A@wg4e%6Mg9^BIsGMQA z!9%wO%~32IT$6y3O=NdzX%R@3np&Dn9_>nt9))YGS;!p75xxNC6f$?@LgFd1kSWl{ zwL;>dTS%(5d6|d~L7HaqSB!koAyjs^&2c@H16$Ns&BkS$ibh(sBS@%WNv;&gB}!i~g|a#n2+vy9c&H zV?k3xec_Y508(Y4H6w>5_I_!ec02SIad@9y~Q%7LeT;kE}O+)*~WLGp=d(X3ZI?!KmuqFh`|Bk zEp~fofQD$a2LwLtLFgTAduT+ZdV4@1+XL$HvWQ ziJpV5uw&5$mUS}J-yG_{wi~vY({?YX-VP-Z_Ba>~LJvO|J}YBnVUHjF`h};+dbEKa ztsZ#j)&uO74JolKN_mc}Tv-~Ea7!PI?gdR)VrBxwJTYXG3p#N1sj>-sv%w_%Oqsl8 zj~F*wRvht{#~wS~Yx9$^?Wi{o(|(DxR+3Y$ri032?kL<8?SaPJEdDk{4>_OlS~wkA znarsvx)bVuFuDu=qE(?W!zW0ydoH?Fzv_r)vgmu%ESjR3Q2l1{SE)yW>c0jvgM-l? z7~W9jz)NrlHR*sUidc7)irm6YFN9%%7H-+`03@=)rF-y%a7$k62^bVQaXzEx-qM2S zb8|LD55q~#;;$+N5-i06$o8Zt1sDO?gF}gFyWb@s*0x!cqInP2_nH^(%QbT2b*+cI zo1^$w<$|9fmmL`};0=5W>NV{7>x8ZFuR0$;V=0^AROO0ptP2#-vYKS!qJq%sJZ;zF zkz8_A6chidZ16K?gHKA-TyjXdBon0Q5}9eD^b0OzhjUF3PBJRn(t>)tuIU5X9L2w? zH24`y^D&rrdR&7Kr#ngY77p5jwI9(nLqnJg{#Ci)XLL;}y5>^IO7-D(ET-A01Y!eV zQ}mc9IsR2T@iUejpA2iL;4P(1oQi+dsrVUB{TDb@c{c(~?{s(!X?90pi8gRlIwuFJ zfzAn2e`yIsv1vf($OVZ}h?W*i?Dar8sBMnoUsV|VjJ8<`Bfvl!R_0)|>&;jhb%TUu zgo(Ww4MO(KQT(ei!p~UiFF~6%y^3|c=7qG~e}>8pJObr_B4j~o*rc+WLx*AM4=qp( z<)XSRffu04*^q#h1kdr7Btujg|EiMUXRPv{vC1>C3&B_fwTP8p-U~xG0C}s9CwVhG z4#jAW;$M{^e#Q)o(V1UDmmQ2Yj+o(2Z-#i1H^ZRF5dW$S@pH6m^D;0{7%B^;Z}ln@ z$kWo>Az^bA|0-p8rFd}YWZI6KW`IA$g##+{&=NQrSPwN)%@L+SH?s|u(iZHu;ilAC z;e&azQgHBpF45V2>Vl#@4Ncp63c94Vv=bU1PM#36i54~ZYo|l%?IUD@X`V}PGU;|Q zLG?~1h&`Ez>y2+Ugd|2adYl|&HL#XY4aELAi0jS?aFNGaMmDHTt4ObtjjRY|gV@Yw z;9sykpj|C@0Eb$=&&;k_+$Bwv9x8n?mXoraYz-$NHnZh9N@tBSQ|7d6CsV^|h|Nr) z?TyW8IZh6S(-8aTAe{D-c%7E(WMeoDv6;=leW;q+xo;C3t|x`zWW6U*+dyn)qjGp~ zC?jq67oikpn+UTGn_)J=0w)`zHi*q^23Df#vDT&s1|Of=AU3m6If&Zi#ao+RCmW+S zh|O#U2B3n@g(%u}?=7a)npYe?`FvRGLfG}Rac-SsHlwW}HZyYapoJ7(H%7<`*Du;2 zQS4-8)CsYf)xcgrPJYnfMyeAVyZapD8FfNzX5{2Sb!v^fPW?_+Mx79wSq&^cwL0x} zGBWCf*vyF6>9V-%)aGPm)CsYf)xdWF(a;Jv)6!v)a4^~m7gh8J%;e;vVfTiqIGe{I zLUjF7kpyo?crTWCa;(9=5$4x=&%?sOr3|rIEa-VcPpm7lkqH~zcRHEKx>F{IJ(-9> z&$k-G4Tr5x4u&HU`{w|I`$*FY)TDK^y-pT}0}*?&5XSJWgkdJu!`hr2WF^Q_3VrD!<^&JH`6tCGuw@CKoA+R+#P!Twa5QiT?s~v9 zJO#Ge)NWKaOsK;xpAt7oTApxjtvt~V>76?)(CzTp-RV*{E;gsb>Y)I#z|ssn=~eG2 z#En{GkJ#D5Gjuh8orJDCL6;nAnxYwEph4Tnfd-FZ*1vlpm{?tQeVg>K{Sq$G`tTyg zDzF-0kE4VhxUi4ZFWD4juakw*77(*6q)*7b;g*a&Xal&x;b%U>UOPdTu-DZvgC4Uj zik*TQ{Q@y7C{3f{w?&1Mg<%WCEQ>MQVjbubwwMQjJbKq?-h(X$d%<@^YZo0L+_L8o zG`7(gxlt+p0o)m-{sX7?10K!k1?u#V8K*al^7IsSI{yBHn|pYar&qvyKv*RcPIo2? z@lPBFomqm>Mi840bn+0BtnDMs<=CWg$jQcNCy32#V3>@e17VbOa&-1(V1x|3;9wXV zMk)on-dSKYpTPmKSqdkQF;zCj$;PNGVlx}8EH<}Tm4#g)rzG*$Hr*+P;abFIF`PWc zRNG7^8>6;}&1|r?*gJ-+t=Lj%isH_NJJ)O$$9QSj12u7Xl*c?UMw}u`%V5FbVu;u* zvdSUWyvMi_u{mgilZmtoWrEm~Ne>QLzSlY-iLoox=;UBH7_om2{_`Fq3)G~|L3cV? z7|uoP$wC;zw-Sb#Sf6Zlaxi>>*guD{_+qbl~pJiG>oV!Wq z8@Gg{rbN-{<;`XpMHz<8cxXs>vW*F`kC-U-6r0b%i{G2CwB(;<>)Rr%adkK*Ga46S z(`3VyL^ilF6ow55olaqlMu^xf42(KsYlK}+4n`wH?4LvYjj-Fv!f1qu%`9|_l0W%I zt>({ReAwgUX!sEE@HtAqjWSc_t6nEl!&ivSOvmi2J|_pmSBU*{h~HQJP8No*5Sv-( zzT*8*-If&#Sw4v9C!&)_JD4QGFk(*SahSltB*Ce;I48sj1edh0fr-2s2@Yi3*4BLSRpPV ziO6ga5^H(kp}Sy)WpWCvJd2=A`CHP8UhauL*zn+ zaKFwmMA%yTD#cslDvliiC?$uO9ZGo#Z(`nrWrj!~c!RU8fve@Qas({>MAH

W<;g>GHir9^c*#vKC}o z1BH(TU}5~SjB4fU;CNVbwLF2R$daZ*d9;3uhi-F~jSjv#fq9z283JKlwXH2EOED-8 zYGtW#%c8nDCgH8yt?ZO&gEupQSY`uFkd0=u4r!~Xe3v2OUN_@cXpBKJ6M<#`JO%>@ z_iNfaNqf3{Z;{8EN1CJS;LPT=hnsLyaLlb%KlflX6LQl7-GXpDf@kp*VcpH`ZmmM? zu1}%QiIPGbQ-v^wD6DdhK+MumrYz8k+k2{sWxEAYXJQiWR_s5NpGYQpkO+%&`wzsg z!wY+m>`4%u5N^7+L)M{Fb4{pI^q^3O*?sW)3VrhWbn>O9wMUym{mr4HFrw_52Qvn^ zlt~#}Gc3lkirfMx9J=MgsASlwq2pLGKv?@iSx_ zNNd53=GSx4ZOt-(t0|i0RUr^laWK>eo#*5Lw&>Bfqz0(1PfJ3~oQ)-fmXx-;2>Yn{ zp2u_aIGks1LtIGsK!yyq8|HIrf3#OSD$d z562@kM?6I~#~_qaYmRv6Hb*_5c*`go8BTNaLFYjkNZl+BaO}8S&aW&e2oxQMk*4T6 zchHM9AI2nNRsgesEYK?}k!@B255-Ux#Uz?v;vbqiptbrmD8!mx{KgXg*@DRN7sx0*-GEn&BidhraOA!8r2S8e1+@OTDVB9 z=*oxht%jRJ?adYhNj9%-Z%U9Y?9E=;R$B5B66B|*wLOnEujqO6kMQMGRuUTdLW9&g z;nH>-zKki)JNW|GX;(9t1e|#sH-5aAnd8ni3~QrZ!@^JzpN4|iwcE(NqxosE@DcI9u^4I$|H)aTgt3EY%xDN9ZGQJX z=b=OVM9-&v@FiHVG>48qIFyjK`y23i48H4vR_$W|#NHByul+F8V_4r|0?l{bj(WoY zh)wlSjg#GBx##G)qjdb_i^FYBIe8enI6blRkkuF|8&;KGCmW+Gh|Q{?7ih$S(S8U1 zW~Qp0h9?7t@t_0tT+rw65qHz@ISFcNg&SRPEyEPCE(v&w9Frc-+2A9eUWC}&HsT)va~${ai~4}#w63dE`lk8Oa-xHqjpEUno` zaf@_@)}&J4c!ai%r^vRA5ja{O#Y4Ak>-h}R>BZVss%zBL!PmcFMuEh&4qfm?w9>&) z8}|}eHBbNPlno>;oqKC zNQ(2}L^+MdD~lWmP3Ono6x*Q|s%6Wjh{UazYKo6Q0q8T7Cn^r{QUTAPN!v9W3}e*I zEEP3Ld3qwW9XVNeuepGwuRE*&am?>JbU3b%ex^2r*exWk;7{bR8zHS7{KuGR7UGwO`Yr_NL(jL z8^Y}-r;ES@3_FPcqLau)+Bk5-7{=uS?Ch|xQs2TNXCihB;f~8O7HRId%ob_u9Q8(9 zLF`p;Oi{AI42DNrS_Ja63ps|NIj|x8@vR=i`aBLo;ufA7Ihqi*xA!@2lA#mARRRiE zB|4+p7~NIu*wg6Ph}|NM-CY%qdc$3az3L5j<#^pCPz-mWN!}KB^?Tff#4Wt)Pi;^D znEjv?;ie@V;8k(g8Dr~25yxzXR}i~7yIzU0T6Q}TTVggi>J6_THr0biL_5TB06wRF z6C364(r$eo=Lor84+#{*LueE9(Eq;G9cs|yAtY`^l!qRZ9>V*&%~3pfa40Zl4>dX_ zG(3dZ&3Wt|+Uck_JcQU(KdgtsUJnTr!$WA3x5Yz49uFaLD@*nPCuQE&JNv8jGo9~F3gBv1?=p@H5OA6XELqoyHp-hjldi0h;M zx{vVSRD9It7}4+%VmI%x`>5SfZ}v>2MbnnPy6 zF-=!u?aJXPat=A{!@^*$x(+G;x~+j3m%{fda6kTd^V&fy$sF5OS1 zYmdUv;@odZ{Q-8v-=*CSGbrcg3*2Ej8_r{EN*I0hU3z@>(Fo%Keo;`42RX2MRf9RK zDe+KSQ;Iu$@SI#2rr3f=AU3Lnon88V?+F6&6O3K@AQTF%>x^q7*8@+H^~g2rfroBA z#4i1yw@dYot@6Ltdi_ZFRu`XbEiga|?bTl5i zj@CQI=(emeG*GpFIhjG?)}AhO(Oy`Kz@iQP)hrI))-CIGPzJpnpnITqB6f@B&UJ8m z&u7qbS9NUvuh>y9{Z8r;d(_9f|5xGYHbz^-KDy)F|BE=vjRuR@qdfMO^$=fIwzLSu z8f}a%YitQPA9~BTtQ(*fW>ZAs)=M?TBTxV}|7vTFibH2}=dZS9-RQVN`kC4gVzvl~Y z-PJMdsJcj>(?w{@S^&{WPHD@!5h|vS%Xm3}Y9ThA39S%rCC0mDz0*-|v=zi&^~QDB z0yFS-fymP?0~^9yzGdCvaS#%>@YKk~R$){0sN*JW%UVF;s#D&wZguQwc5GjJ z#_z7Zj(Wpgh}{~itF+;+6tBAkis3Fa$=l+tPLI2gxP@2!sUHdevmdl#a}*CwWy`wF zF`MBP#BR>YY%y2K?&OATS+_gt4X+?J)q_VwJH);UpUo}nbgzd5is2!&33}))-?HxV zcnFDG5#^y{(nE5~8V^oo%euocq2VFKZq8%(P^Y8b@DO5C{jeU&^m<637#>2Kye%H; z_IL=1TM_9Y+_D~&KEg`F6H0}T#=d3UWB4Fw%11j#qbf@ zBu*bez&R92-?FZN;}PbNc#51u_G-?9$rc_ObI2?J(50+_jS#@9wygWHjFAC%rPOy2 zHruf0h5E$B>sj1Ki+`^gzxU-c14L}vT#2Qf8-5vCv(C>GG zu{$^jh0-^ThDNRjo+9g!Yt{n~wR&jz470A$;vB=8I=Ku%;yOrOlq+Dh2Gb^7CBToz zzyWR=y$OfLR9)EVEr@e0fHLS!6I&4U7sPJS+|ef9O`~;=df7BdJz|ggcvs-Xj&5V1 zMC_wG&J}otqul6Ih&{?KzYeTz7hMOcRfHqD9mk^azzh|p+vDH4 zjDSMbH)SJ4;?_tt!YU{LeGb8PkvMd=i_Qa+3{$GNF2b<^%I4EJ5xYgk#wm-M7&^7> zqDCh>qp>13vx8we-p0Dq(QPzV#6G&?Y^<%0a-*>#HkBK8im_c3+H3f>WyRiM8ts{o zg=)0eNU+hq%17$hjaGh{P2VU=aqkVp+Sa!)3F>@eFXXOTGYndIcq$`wo2E{74kWGx zRp*E}or5-t1UU7Lq99aEZ|-;rfNCLj3*nB%@op4lIqHp8g4nCxnI>Q;)*$z2ON&6B z!Ax!xp*gT2yyY83?H&gqaSKn)n>LE-9XDwkMFPGx8%5cUJ&i7n*e%l7-Ie30H{6BT ztKM+ekk?%T#c&sz=^7qc#M(jL;{2Ym+tns28mk>*EKsF*X%eI*F+rK8LmO><~nxQG&t%F*C00459^vBH*-siKrvji zBTm=Aw_%_>`nFIe9Mf1DYsQGD$Qfgg<};XD;h`~O%me`a!5YAyG9SZEPb1{yGlfHJ z+Hh<;Jv$xshKmq;)q|Uyz%cPed;ntR0}=Kw!OjoFg&l#aj-i%=5Om{HOT^w{#Jm~f zJ}H6Sj2Uv&8?{7is#gsW-l>AO!Y`ZPa|Wi!nyZbyK5S*njzKG+{Umt&L`PEs9Cgvd zD7wT^2ksAA6A7*@gB8l=t1valJHyQ@Al)7CW74#iho5v;sl^x0F_Bb$5Ze+& zFNJoB_vSl#-KS&>qNM5GMtDL7MaCxLW10?z2604&9Y@^v>4%;Udyq(=VuLuAuYew| z|4w@8ioqB`jB8tUC!sB&3h>MG#?PdqRvBP1oMJN;XzgC9Sh|N4!|!7=#UiBFtJU?p zdFff(rWaRK8NTl6qZL=j!>Ps5(T%oT+pZUu)WXBQjKV@ha=6q&^A<4kHp4@&O2@~t zaED%G%oiJ&zi!crwvV75Tbfq%PQB=)9v<;!6g~cC(WMufyw~NURfZyXE$y~9Gaz?u zw_aRQ-0e{uZ?ovpi%b6N@zEM*v*^_eOKN*PY6rFNFyr$}u-w%%->})5%2kdTFsJV*gA;)GOLWewVo^|A7;< zoCqCt2045P-R@UmU7~GMqcrC}tM0$-fLCi9tVPrTHG5hB_x()jy z_R$@u{lkuOqq!mWQQo{3y5m&nbsvG>!%ch8GvTHd zv>gm*C=)}eXw>26Pa$_74GIqg9i&I=VwuI9bTiB;o#*O?8exG0dVFexPaYL_c(J#H zoA+Q=Bjs}MPMJlko(0S)A&byXX0b8pmvif$v&WimcPL7k6 z(TEYVtk7g`cFrXlezqKbHF%UQ0G{QC7VOe32-8QjAfKDMS;5SD{vm_v>gcl0~sSOmNV;}}fS?uB|`rPe~OEBfGRkNsGogO+Uh zq3&i2XM6SIA-!map>BO(yQ9w?)r2Oh`Kb^Y}ByZT|&1g-c$@_XZH&9VyO zC+%?O2u(5YFZ7w6Z>e(SDLkrrB*7~A&EHlJ3qs`F2S}8&|-U&`;x!|$P1=EZ+ zml3O#>0}sW8RD_b5Yvn{L;q@JIl17)LN^{B%Um!G%cVKgL)R+r$_^y4_AvIef**V? zREYg^kYnr!nXpULUMCad5`~y$BD=1r3co(Z(Xa5@C;L?{vmqW!8~R)y$7;hir+UU5 z6)~$G^Hbl%a8I=wF8(-KlTmds29!tYv8kXZ&4cFn+$uJyZ{~X3*xK1Y% z!*GaMCZjUkh{MD>$A-nshIlM(h-p~nW3^$IQ$53mi2ZXIiw(P-Obi<$W|@r2hW?GO z!ZBQg84i!7;V=!$5oQ_g3~8@EL)ts)3vq+WdbF!2Bh!6)ru$T;zLkt;1%)l5c`a0~ zd1^~uIxGj*_KF(|NPGR}Xw9Ksx}nh{63RK(L%aR}qaoac#2E|Rx)^ltLiEYm8_e3C z%@!7T0!KwyBj8&zOgMYtGfMFD5l|1S1aUYOZmH}l#ozN)a(ImQ+9U7`Z@US$+e$-6 z{BJxTiLsTwXY?Zh>XuE|yIbX|XBVK+j{&IOx$-pUJ#Yf<%D~;>AhdL0zZUV)|6XJ1 zW|(T@galiunr6vZGPB)kTcP6aj{H52-A_U13d;;c5rncIIyb2ghK9ss`qVd3aHIgw z$!_JjpCGq@yw-(De(J37L70xS-C^uK`u-28N6h*vMbCThD#W}k)TmERaPWau1#D`t zLaQgT52u*juGp!Um=yCpjMC7M|4p|c#}w!hcU#)L=|)Q**dSrW9fA#Mzq?qjS~Q_{ zE6BLzMr!$n$U*UoO&FykwmIqU1l)wsZ%ef7NQVS?w_*sE{jDd$@GEBECZpB0w1g3< z^&kDn&&d${hU}2If$@F_F;h2J#TM6%GUg0BiC@E&&0WResr#L{JA!Lk*xHoc$^G)? z5AdGAh#g_z6WCwi0Yp%m_^T~0&Uzj#a!)6AwJ(M2RJFyIMQ(+R2QJ34!uM66?oJ_` z0R(LP0NS_$q(+5WTJQvJVPH5GHhu<4W2T|;U?{&!{D%iZSV(b+ZJC|I7ww$p$49nGVU?F zVUIu2J8*xp$SwkjVWo`?TN|CBBCv1Oq<#-82#I9tYiYp~xOTcKr9HF^ZT7m<+&HY} zov6laBX|PWd=jsXN8qB2<^I(WG>S0(2nLPQ-Z9A?NZIIN+yj@RsLwrcxMhz6u+Lp^ zSFt%ln|HxUG2ifve{44Hf71{OyQyrj8^hRa-1#QOe0MSavDvuuO@kV%@KRl$7^#7uB$#x94MGmKBya zc!UdA_}M8D4uhW$!NMIDv6#MDEMkx2BDOSi$bY?hD8@X0PovZP4J#ows~~j8TCck5 znT2*b>J1Aa_EGOlH|2U2_6MlGxF|oQ7Uf_@I9-^rMSKK1prx9p@?VQB#rrt8j$H?0 za~+GsErFVp9(E?BhjCJh<2y{7FgtnWG^es-U&j_h?)t!hwuj0hb_)efJsqq*hU-X$ zqh4B_)Fbw&k9SOqIJ#wn!5pCIh<$X&dJd3w6@iJkyFlF2;HZ~HC-sOu>f>G08cT3_ zdGc9;$GxUC7T~1Ty8s^y(?Zq>voqGSBFt{+jkI(Kv4cQ6*sIaoUCRo&A)`HVQCr4- zKwHKh#;JQ)E@NZ0TXPxPYaYTfmVU_2UB-S9*JXNneEY#bH8@K&*tlxiZ)k48UuT6b z>tEAU$U!Zx#3E$_w2OfWSUl_~=J+8t{7mI7*^r*=H&;<6_TVCkwQ-6XuK9%wk~S@OrUq+Ulsy(Q6bPv8h*d6|p)> z+kNHmS+JtFJ6RY-M{H&>@ZY$wqb@nzvX|AN!^uF_LAFNm`|f52ZXJdVf@bCKbkxi8 zlX}D+_3_Szx*Xkx`4Ri*7Aw48_^pn#`4IXy!AegLH+>710NqXohVc=b84T?9)9bcJ zX7e6LuVHhjiPz=+5#HL=o z=+^LAur*_flZ8=q#AX%)?Qeql4~nldKrwJtjlbW#p{BO}>R{IFvWu?{-ds{!S+c&W zJUF{9SW!|JtlPZ4uD-UidSkGzzNEGuKSXLOtLuZatIC4+R8*E$1S{);RpoVc!TO4l z>R?TE`2NF2iH_zIw%)LR6sMm#ta8^2U6usb!7oGp5u3 zpW^vgJN!SYytTY$B;i@|+*3J!e4?vI*;Kucr#zHx)w|-Zjit@ADZR3_dRJW8T)itk zK2f%Xcx_<#0c*Rrk#H8Vkg&ks?T69s!sTMwCAaFR5^4T>7P|PEI++|!5dtY7{5`K;Ku57D(qI|}=I_CLhQ=8`cz4~NZ!9sr7 zYIJS+v>n~Pr|c?>7vs-A%lOX6NVr5VTe`YXSmjhcuUxZ6UG6RYvzk}w?t6`!e8p@PCFf9=xBn zUu^p+d#ZP3NA-^ORG-!RKdXK7m#---TDEHC4bZ0a&tM`kM>~}Ms$Hu0>?AplfFe4tf0q8Ow>kauTi*U? z4fA&C)!Ur@S=0@{bou}HPdRJ=|)gINmS}!<_(z0^p=L~$$ zop9fV-1+cfUc>szYIxsVeOGnOJ=O3It#?yNeSLYERaRMBURn?1ZEbB$?bX53nwnbJ zl7+3;piC32uBi{!MaoMnH&jA$s}}S$l+|viiIi7g9fXtp&#i>rWGh%!Q(h+&ls8n? z)z5=d#jB>O%(o1yKqqboZxCl&7VPvw;heJ7*VF_zl~iwqLQ(}PYpUylmX!rsF9uOV z<)+P>C>NFpc9YA38)|Dd1@o3V`u)<>)dV+`KqU)mYf52*y9VnUtgqZ8>|vY`M4j{N zU<(^7wKP~?Q(saAyUUQ?EFh*6rCPap(|Xv#g$-ykK}mfuqGbnmtK6`mytYmj7`E8! zgGQ2AdPF7HZ*`T`!5Y7$s&sQzNj;b<2>a=qgm1ApxifEArr8nea6Q;)+0x6FErpG4 z*yolT?ZAWZzYsRTm%+_|^14dc@!wcpv#Gqkb}QTmxLV5K_CR@UH5kAY!Fh12K(B7_ zmgV{R!Ii5DgX>`vzO1ag3@j&hjTn7y6n)g_(_WoH)%Sh!^Nbz(c!T2)jh`{cC^eSxF>bWuuHRVdbFOeUAD^?< zzkhD!qIrwJjn-&BFI%-@#j2I_mgTQqQy5weV~9MyF|^A0yyp7V%kyr8%`%eRywpv% zeAU{O%L~^yGT0^#tzNpUP^DcKUb=iG6va7SwX$&aD%c?Kj|%c`q< ze|cSL)#iCHI^a2Z%U6U}u35fnCFmdP*pijAVL|r1#b^#_*MIxZIJU+bKV|tY*UCEl z=i$cb(T!VU8?XN!?5LOFuVvF9v?01~dah0U8g{z9dfV=B?Nzg_XHLRx8|N5>cdlUs zamE}zX63J1wp84+A-(aAVb0h&-1s$yv6GLxp0QMo*>UFUlvmYvgfV=ia*TQmr~G*S z`n4vWYs*_*F1;LFw^1&3jpOZ!*N^+{t+dy$d+d`@oj6Cty&$LUsqdNR8d;A zzTvX6&6_rDy{xjjuClD$nvAREBC$}an|Fh?9M-Q@S*tG&-T;AdwXnopRs&PeDp;=H zP}u;x7^`8WS6;We9GB8tDBLZi2taD1&0;b(z`u5aKSX& zUJon&dfe!!vkriGJoXRq3Y?#5+tuX_^%kC%xaGk1!1-ym9jPtfQdzUPj%e5RKyb2c zm)5~*ud3YYHC3EB%s>;d$s1!Cn+r zEn!Q3AoF}h355fhXWMpVT`6q5$ohBJ1~N0CKvk91U@OU>LYY`d+#PbrnL#Mprn<87 zE!HnYwTEg0XPyPDd_!${IkEn_z?o+ttE{dhbZB$nOfV%FxRglO2LjV)Kq=}sMN}bx zfYZcwm&|b2w!m~KLM5)XDACSsfobW0s!L=A6SqJ)r=>zUs~5P%oCeVy)mnm#%i)yu zt~_Ht99L?`mw}1suxE21;}YAx>n=?Uc2$SFwgxi5pp~T%rl^`v_x3;r)aA}Qi*VNs z%bu{MAdoQ~(VcX>E|38>aSjUu8B^ep@@NI6SW!w_5ts^Tt13(1zrMse*K8bE#Y zF;2s*q>T)Gb)sEbvuTsh31{F5K74^Hnpc*P0-mcb6CuFXyUp4rCrlMW-27b2MHhgm ztgt7XH-amWzmfC!sC7X+a0bz5;)oRgh8eWk^9buOD`iWE=8<`$lFh7AM>F)~hUo#48}N^*c^;lA+Djlv#-| z)z__>cr7Haw=zr&vwO@_bePShEZZ4iJnSvA&2y4%5LDM~mRD{)4;u_Com%88UgV0) z@8;D{wl4uO_}%y1gmGYllJyXuzsXu;md8p;N=tz80EYMyRs}mV!7eGWmYOFd+h-@( z>(^T=IX)LsZ{E1cdM_7Th-%8L3eM+%9^jifzZB9(BGv<(&xiEDAL4uwq%W_!!rI3L zIYO|=`XUnq<|f$X4H1~{dOFEMl6Z%!1Ta%IOg!62ygfb$0s|IG>jQ<9el4 z#yK=|;1TO?F1S((vaJtr2{f3Js)!Y3eDY)}R<`vJ7l8+$#8BQxxnvrYw>I1Q9Oqzq zz+dJVj8dCjZavL;5P6w(kn>rkf5lpG~1eQ>PwyuEwbdUh-Ydz9mm(Z>PoF8{Df=};GOksYdIG|yTDnR zm?S_TgGcF^I4iws!c>*?ddeh6VDLoy`$>HOc3BL zeBRHJC!UL{;LCts$t;lg%}ys?3BRZ+6hCcOfT+Hr+^5h>Kms$65^v#Bv7Yrc zwce9br%6efk7y={Hq>mch2^EEQmL~+SYG8*jMPg(g416gjSEp!3SEE?U#U4DDaGgp zujo2F2^Sgsq)Aw-a$lQInl44KF7Td)o)QK0F6t&-1Tt(#-m~W7S*2>@MehZZ7LBv- zgsm0tIZ&%RBULc@WJR}&4lTz1(w8(WzWev}KLIiYcd@bg@Vrbqh<>DQQaDpUciFJv!q*_q>DVk)l0LjDSu zUkK%e>1kzyHONHMz?u;-nKj28)uvtoB`vKjfk6O*vaD1lJ_AZ4+#~V}GU?RIL5gis zNEdM_)Dx_S+l|%@Om@auP?Jq{;=Eh9?0l+)XoD483LOFKh;8r#rp!t@8;V<6S0Z*e zjTVpzEdT^Xwd+e@7jc()UUKGnQd(CI!DgS~!YnC-kRs^oTdjZR^2JgvG=GZ;&q{HH z3#?u)ohqep39cxyUguI6DX`2!y1@Di7te83*IQGwOuwGBKuV#ZS+kjJhE}Me+H#1_ zs@wzt4`tRBJR$TAECEF3!S*w3q1Ic4JPCAQOafzSl_|24&X?ZsULei|L8a>s){T?T zok3#Z504ZFemq$@#FGH3E)ocjaOrtac}MCUs?Nh}6l#|~@tlpLoFn!*9lDdF-7`QX zp9dXAh|!c>cTg{x;TKOzRSL~9o;35EtawgV(j0I=q@>o{PiBK=xD3kSXPfEJ(h6hq)YD3S2IQ zY=Fxykb{#D{)r1=6oE^okflPHi+Q`}oK?=^hE37;&n3G~dkmE*c6&K8fd|^&#-Npn-<5OV!wXPm^0<3Z_ zo00-aIm%oKa;R+Q}Hl5`-)3bCfICFdg!G48dWL8ZLiQ?`K?%_gLU@b|XUTRUgm0Qc zD=9H;yj{1xwz6zvxlz)D%<*>l`dZJtK4Io~8+LuYJUHIo;KOauU+tZU*;5hw@ae$C z?Js81WE(QBgfkK@F}fV?RgQ<-JJolY^R|RpP|k|TdMnjTpPXuJ70LY+mSwViHHmRUg$b>sgtQ4ZERzf$+nE#WNF^@>?B`9e%kC-hlbnwyL~5$M z=gdLLA}_y`boq!Df~b7s!dlq!!`r_4IBH)#!3Mq%!Vx(m8mQN_kETL#*v^1;|9LWgvkpqqq=&CmjIn#H>Ef{PlN#zVi}B52hI>w z+{`&>o|2rj7#y*w4qC*InIt(23Rqfdy~g=m@WSRQXemrEZambru1-WNoZzx4pbQ2S zAslz9*(=7)m?(xJA)LmAkR2?C@s99?T(k%>gxeUNRla473nXEr;EkcxSrA^FV$Xy9 zrg_&FtX@@k!}5F#IJC#x7@RP{PMlzWYyzYYtPU;B$He1Oc-^|i-<|ai%60QRvJ9DM`+GpzU;Q^ms*J=umdWI-zO_wNl*EcC>~XT3X4aNOi)F~ zqYo#=J~C5!5|06ZF_jgDz`P5cyfY@)8KXN$(380b2@~L}X{weZ9$*)xx~q@!eE%a* ztOW6V^iwIFGWzPqvWinzEx~BnaJG)ah_Wh%t)X770)F6@6k5*k2h!RZs&B4ZTPPo5 zWm9K`?rVaAyz5P{VpaY^ldLIR%1#0;>giZYF?^ZNJPShB3gJltCRC5sPI01gyGxd5E1D$`6_6p&J=l z#@*^PJ2gCMWA2C_wJ~_aw4+O)MlyYL>dA7(j?pQReP5(ieO1-Y?b-OrmAaqgwe^R4 znw%?<)%_Y=_2mWCo;JZg>RuT%iIGZ6lI-Lopv>qf%(RU|EztxUuX-|_)bCvGADQ5j zyPi^h)@rV00wZ3`Bg`kYQpTdf7b=UY%kL?IeSDax@s~ZR(hiE!iRiz;miGIS0nJhf z;!`^WnWKn^8Vqdd6m*`X6knLQB^OV=TtX4Cnz$vLJb9~qjvH%wF??mrU5S7UBSUe9 ziEd8Z(sTFZ1_+SF;279D67$=HEmgoo_@#^?Y0kEav~w1CPsOyI;qCTyvPLnjszOCRurJoel@{Hke@VGui6TQ%i!k+W*b zXOhvZnr>s~=&Pm;OvYACwM?w9n(k$?ck-&~L%c4|s_7$KqE=1+!UV>uX+IO1tEQ(- z>1b9>-!f0pR!zN3qE<~uIajNuK_<{wP5;Mb`l>0pK<~kJvaxE);6iuRbO9H|Ts55z zzGS-q$%&_fFY&>{p8bx5w>tQ89&4l&e7S^U6?}OU7pUONbzGnYUv6Nsw>NBgHD=sZz!rpGjC{s`D!I+~moiwM16B zh>6lbv|iS_mWk3qR9Y&kwv&mbfT*lYh(66kQ$bW-E<}$r(HS7xutA7kVxnmv+9=KV zb0$g!5eB8g_XDgGOg0g0B4QvwhFdtA!ICGQNivMu^$3HmaG_Uvi7Q>?l`aM;efig; zcL~VKYBs|!dU(!D#R7@a`jp5@nhAA*r|r~~mY83JOPCC{hLGlD*ksk~moQauh&kJ0 zrE}Q~@G6`$gY$F2rR8v)wdQciEO0={<~k5v$wkomMHKc;Ob|fpSJkYy3Qd8P6a-16 zJW`J#O-3tC$WFxo9?vc31h6S^tPAc=8TGtIi57ZfiO@FSw4zdP077zNx{!GS%P}Gk zS`_^H2|Q%ZC|n>T)du^=2ucWm?NI6ylaL&^h}vkZa~CSP-`Ppn!XaEI#>q)%kl5#3 zD`}Rf%of-)G+k6Hf;7aB3^T}-OStbd=&Sj_rSE_Y+r|HwotW_|oxb6jLG>(iLnj9I^! zNzIt`C0we-tgm7+J!ZX_%Z!-yySY@0S>IvGMjf-h$2`xBS#RgUEE$!pLZqMOay@4K zWhOLZ)?ejPBWC?Lmzpu_<8C%Rca{;eem0kCG3)b~EN0C5bv&UrX8jJH#En_sY>H0D ztb4aV-&ry1QPZJD%=*W=Q2HJ{V6WgW7faTggj>br(CYZtpAS7^qBR;Tg=XL zkruN)jmxx{^@~iIm1L()vN6)#ob%b!CyC%zSU_B9o{?s7(huD}#wOsr6b z-v~6OU4e{A5ITwB|CQz`$$=S@?0badekMsmUGm8d@R%UavLOjhlu~#+G<;j`QGWVG zlkCcStk0Qvq!|4#o5`IR{Z7tRjQ)Refr`=p4i~5x{U0-d9;1Jh%d{B%-*A~8qyHx^ z)MNCM;K%m#rGp!zpUx#tjQ-hN;>74*#3XKv{sJyhG5XhW!QWAg{!OfGW{mz?F4bc6 zi@8jX(Z7oe^%(svrtlpYqkliI!3Z(>&1QN%Mt=_z*+GiY{|pzX82vAD!RZ)%xn!~b zE@Jc{+DJr9L9nn2E&eAAe^LQn5dJ9wfn^XG9BDyro}gka9?g@|lXwi^bV#yv!|9M@ zH*gV}k>^0h{khov1QF2w2bP~6vbGu#v{PLrfeAMLbJNIU9VJh&;U7XbBkRr?5} zNpMJ$mGb)pr@8e4d+=k9PzTow!vjS`pAH0@E}4=4St!p~EGB4e=e;S}XE0=q~&&QLse!yAkJ6FW=BPQ#N|16vv)#QG=p zrII)y))mQzHIT0mvKJIeGvx zJZ;!mB(nhI?M$o(AU84DJ2?RPqr5Io0P?4~L+8Ydp_sYObvyI zhB;OtqBnDa3K1>i0xd+emdW1o5Ya}KfeaCSm{S!Z`dKcJA)^0b;!%Z&9x%`On}>*g z&n(Y7a671v*I5Dj zPdOCW+F~}P5ud|4iJ#zx0?**0_(Fl_n5W~68e+OmKZo`7b6DR=F>MRXR&2zyUC(7& zOxqeR(_`AoxKNL2+rouLOxsQ-)nnQ|$z?32Z9kX0F>TK?k&0>iF5@hw?Was^#n+vs=wx4pD z7Sr}?Q#MkJ*GV(E6XP{utJ$#JOEK`u}+UY9a~9^-WdmuWFxOSw#s@yh2y zJ;v)6CUj%G)^mvyiQwU9q9veSx~u3!512O?`H_|^o{#!HOQka2>S_kmLnAZ{B_gGx{bVR&2d;TX zG@{JaNXDPx=V~+Jg`lmu74SPy&Es?&2mGYD8?$gaj-z%SK6daO8^2hQ!g?KPsU`s#z?y~1$Z5`VK?DuIqwom?}2(Zw9aW?YS z{=)3xJ?7Lm)-TNd%uM$W{tL7HW^I$TUzq(J7rDPMdxDGHUzkn)m}zFuFU+R%1m-Wy z&fsG67iMR1vH1(L^GxyZzX6(KCQhapgBv(jF$RTPpkfTxbAc9P5Mi>nJjP%<%Rt5$ zJjAJrF=*og8DsG8CLUFc!3*X&fAbiF9_=3!G11LF$Q1bf>Fj8yui-WVhsL^i?kSnUM@3Y z41Ug~T8zPOx$K`d#^5Bggd1a!y4M^~CTTGSXK@+D7+l0T#TYE&T*VmVa)A?La1)nM zj6oseT8zQ_xX6hysNfQcF{tHS#u#klm|_f?IHwqck8w^h2A|`cVhlPscVY~l!^W2>IW-B&g405?li!pc)m+3JE>$y;mF{tN4BgWu^OsdBiJj!J(#^B$$ z+>J4Kj)_!^!OM)Z7=u@s*o-mw4U?KN1__@qM;<-KU>cL@F$NcLnGs`fC6{V31~-|q zQO6j(*F4XRF{tK37Gu!J<$8?49wszn48FjnMvTGJTx!M`{1+D+F$S-4sTN~!oXKLw z7$kkt^q^0S!G%1D8)I;dDLNfv@J^30c(>_LBgWtkF4JNRs<}*$F}RNl^%#SPnUKdA ze2&Yt7=unO(_;)?@VhoO%vJrlW@Xuyy{U@&MolJkwW=}a=3Z?w%~ z=jh*P%Vsk6jkYCBtbe2JMkaeFf1~X^ye`f++HU6(^^LZ>n85f(+ZHA?ztOhCl#b>b zZLQ`h+Be!h%OvU>ZC~MBeWUGZCeXjp_DwF+ztPsih59$ze#V9FH`J-^vzR~+%9+n)T2Ri_T&4%*gt$--$|+z%Hz?=5 zT;c@fY~T_nDCce_af5QUafu4b`7js!9R=m=VP!Lea@x353(ENtm+3({PjaCil=HkP zgr-Gb9ryW}%2WPHN^z@FXpuKgAynY+`bjV{!hc%daM?8>g6hc0viWz zRr~^8qymzt=5adu<#hDRKhn=x{?q=DqZ+M77oa1@g1`H~pK}tX+LmqAmY0@SZjqrs z5%>-An4v%CBwWm%gAz`jbWTFHgcSLcxTOH$l?uYoNv=b1wFHsc@-6UHygI;D%1mu8s6H#qH~P=?BrO1MRUw_|KNc|3(VT;fkoGFksDYP;vzS&XcZHA z0*h|t3CzHvQZ69$s=QubB)i+Q6|2EUM!I3M^{moC1qlIH$m(PjF6wMPJ}t z1r|Nd1uC%Uc_#R)2Nr#Y6+jCt`Y{)&z@lGrffHEtdoEFdMb@+CkdpBK**h0FtLF9p zuf1og=_IGP7sTG*KE|RCE~?Ld;CfR6{p4rAQ}Aa)glM76u)n5Q>n55IJl5{r)Hvj5n`qQ2A;sl=iaxdal6MsS%V7ENF-iA6J*YhuwQ zTu_}@bTyYqV$n^+A+hLAE~-u}x}QrVvFI`8HnHd##*$d{3Uf&;dY8E*7VTgziACQt zuTCtgy~dqEjj9uins5mu7G-joCKh$10w=NPNVo96oLJPy)%*3tqM^J&DzT`Pi~hC5 zqVewLzb6*`o>=r7Oe~t_j$$XV=n^i2#G)Ix3=@l%av>%bJm#G;HR++&_57PTNwiA7md>?Rf!P^p_(bUc^BmzSJDWtdnrfyFE1I(CaJ`tId0MKiABHl#G-|6hdPNxcW@ab7Cp>mm{_!)3o)_iEh^;1 zq8(fgiAAv|-RW~MCKm0(g^*a3#buCKl;@WH+LxCc>zY@8dC3XP^~+0!bAjebjOGH( zlbA#Wm?v>QmqDJyJTAjLiL1E~^CWJj!c?BbU0hO~C$WM{s`DhCppsOc#0y-ac@l4M z!T+K>i4Vv(H&5boE`>aa@3{=~B+{R92Xi{+N$lkodbQ$v)r*ZTcYj(t)}mf)Vnyi3 zhhr`4#mdept*NA~*}(tB@bEVOD}K1>pMOjJ{%)IKPTwJ1RGrh8OC@`f({~JQgE@Tz zsEl&@PN8DV=_{kM-*Qghc&7L~D-Q#WoIekx1 ziRSceV6HiRuTuf$^u5nznA5kD3o)nfM=ng|^woXZJu=jZ%;~GnqNyQ$D)>d8AQ$BK zL@FoENAqJe^(>WI<7Nr%S*DMZsPn72Q#Lp+W;J9;)s*#AgIRUI??FygO_J3KNB>UU zVH>AiMRZTuo;B~k)}qz*a&o7fH!1IbPo(NJq+hSzMZs_Qcri&AE9%wb*na)tTZ0A< z7(y07??~;G2{DpJVoa zse>M|h9l!`C4tIMMVeGuJaWSLQT}gCE%(0|X=J>k6a`*UhqEu?tV_cLph%2vD#^xTGfOLG_|TN7eH#&5mffyo?6w7c3@Mh1~S#us$wp%sZ|qQyho{3 z7r5K}e^0Ht!u97@K67}JYmMs@cXLto`ou$2vM1{k>u4KXpV&xcv_7$!igA5n8T=E?B)_(pQ!)7J4>DQiRM)3u1{pSrF*hIk?n2*>k~bwMAs(g&g zC(5}D*C!@&A+Ar% zN#iDmxAALr=ESiRLOyu4n)<$v@-J!2Cl|xdjn>}V?+)K*Q{Y`k<9lyEMp`l6mfgi= zkU#J!mtp?E1}?<>fh}C<KFU`2%NhDdZ2#q%zDOxPr@^{DCSih5UgB-LgH-A6VyZ=jIQ*&V`ge@Clb={=m;v z=;jYJ{?P5u{ha)PgSgbqAIRroCx75LE`|Jo)2S>ne_%WthVuvJvq>s{V6j{Dd;UP^ z09Ct9o`0|zIk~jhKjMUrYnd5RIHGj?S;dpe$5o847*}y_dHATAX^yoh+vEV`<$ugYnwS3# z7gXov$3J$5OkDHw8*;%O=H<7b?I17zATENu{7ziv(oy!`K(OJ08MZSDl}KQ|jIA3JekzSo3Hs`K(Qxdig^J93%k6nP)K+sDEI<*04vlIk3_ueqc;N9|`SN#&^3-R=(N zxaO$s%LV_7a?}na-`pIvj$8^kY6V<|Ichz*5OdT9x`n^N51yXFHTabeo{n_w@q?%1 zs3?{xA3QyW3-p7h7jVIE=7XpI5xIz7{aB~Tm6JO8xes2ZygsI9Pp`4OK6cRH0bXOx zA*vz&>OU^)>Oc1TS$_YbrQg43>HpFfEmddHrE=x|X=bF8Uzd9Guchv3LJ*`jVs6my z-zw+%&0$-__Rk)^aq?67O{#c;qiHKkoG@YAktjLYxV`LQ%VbIYb(T^AI{57kW>Ur||XLTTw!tNe7Vdo>;Fr&=)x zUNyQ$)3NH-Ca&pN&D?@zZaUW58I6{@=~zWRFzHyS^sA*oI+mtu_4mu2bgZSnl8&`D zl#aFbzd0StPpW}7iB8AzQ)$rd|9Co9zFS*N$13EaR65piT$D=38cIc>bgVPjz)i;* z!^Lho)+8==)3Ii_#s54VYp!do=~xRHYdY3#T%hS#%ees3vDQ%8e|tLCi?joqjkQI#%O4&P@6Lo{r@Qp4^%HYmpW|@Q52|q@@dEjkFxg1rli)!dxOP zCCnw#GLE@KTFzyzk(P_OKqD;+so;M+(sC;~0FjnuT%?hfN4cOn(z2dQG}7`a7wloA zPX8RE|Eyf<;-oQ0Kw%($FpZFGpJTclCZf(sBrIkczY< zx#(Yuv>fAZ{`)r|{r(L|X`VcOJ3p;|BEaV8gH2IB%QbTSxk zqf*RZT*+mW!T2nfr!pAdrXtN?{ERqdFn&wLZU$rhdhU_W&0su$OCf_XhsrR6u?Lqq z8H_`?6fzh`xn+Bt!FZ0lotwet0@npB?_YB5xlHzYGgK@Omp-u+lbS{Go#y@fy zW-#8!g_yy34;69-;}cvC8H}5_3^N!%;zGz^{FciggE6ClGj)C~yJSDtygIuii@9c( z9Ki*eU2-HBXm&|&D!}ZLA})jMlGC^hvr9&CA!e7HO@*oKk{Mi5on3M4(i?2?DbH#fWFNiK!#k{7uQvrAs*Ld-6C-!1$NW|!>b8vIIj$+xaO zW|zboIy1C(b#_U8F3{|fW?b-lc8R%)_rI?HH}FkYZK(5Vb*vvNA74Ic^mMNS7gc|f zw17(X(!o?lpCmnlit&@A6;$?H{v_#Su1obNNoR72evIdWN&0&_mcJrr1OI-g-v1xIP{n^2{H~!5PJibo3M8tH|7qd|M7c4uz{wKW!!!di z`#p<8dx;zV-_47uPR2{z>dXJ_KaiKo zHL5x-E1k*s>OVFE*Ie4am*IJFZ+y(Z$dCP!UeAAy`LDfLrz0xHj~qLtth{*2 z_(|oHy-wZ{Qzn;Bnta6M38N~{@xL|eh;b7uMvm#2(<#xZ^TZtUN!jwT9doif!D&PH__eJhce`wr!JubLU z??GZYUp?>H|HL7_?_#-01^N%_d5rH=u=%z|vbp&-K;8SbasR_I{y+PO#oMN3#rk*a zJ+xcAQCeCoK0Yly_F+6ftyV1lU_31ri(em0`$Mcl{8IBLo|*Q77wg+T{y@w(%iPbm z_AQ$Fujl3Ujz1nV0*(B4pY)Gk8}o~L#mD&1pY}Q+UX~V*^}8(IF73Qn{6ecZEG;7z zl=t&x{g?OnTgT!H&35sR0`$U;Ub0EVeiq-(1^oo|1T*w0&do-hQnr;|KZAeJdBmzcLM1 zDSs-f?0-|@JA=;oJoUUtMJiV(5a{H&%kHx#D-R=*UhH3A5vF!L&W&?i|td!n0 z4VxMTerq0WD%3KqPHf4d!@i7X_zm)i>3M%x_3d#@{BYl?Za>9eGGngfswXoi7R6r+ zT<`~|KM?90wWM!zq(Am%###qG);j31)_xDC$BGJe2jgt_b@44`NDmL*^*zSlvUaSu zU+2AJy%zOd5?}6X#Jbu)@%6zTHrFzHFoQULX)W{oSnwQxTa9`AzTo*bcwQX5w$EeC z=8cUH*TtU?6mJX!tokQ`<$q0mK+%l&-vVV{Q+>TC*vZOY_w~lW1N&@z9T0!YkRrb& z8^?ML^E)s-wxCyD2QwKO#AdaRKWX~7Z&Cbxv&(7m?dhfsg6Efd=6#yk3ZSWpnJ?f>!HzOk9KwPL;IpY-JX!~C*ZvC3&PznnJsOMH$8 zLvH4m_U~Z%n|eRvwl^1yc(QDo@Am2D2-ML(UXP`zm>FPe&2T?3UhY31 z+$ujl!8BJrGkB((SNr&{ehNlVzu>iB58uIhW+vyFSB=c8y{g#}X^qTmoD^$yQmcQo z8sY!Lzh}0J7y8GR*1<7EN96v&=rqR=mz(2{+L)=Kugx*1b$lq0e{LBZozjhm!BHo8 z6&#&{SNj|PgI7bVU)5B4tl!ZEhsLwgGGnVv!})A>IU?34IqawhQi*gdVGX{X8maywzYe=99lKUM(eR{wg&T+-|vYnjocep*Jm zjK;P7>zz)qqw065e`Nj4`ic67G)T+XJGM`(djro)tL52(eoc<|alD@Ar6&a?{LT9{ zF{sx5vUyjrsm(S?ts)&8k|UVfB) znV#nmm16@VByjTBTPyHu$O_|6Z%u8(T5{EdOhR zMvkwXG`86De{BvgobWCZ*_+rn$Jt{6Mtt>6Z zT^4(tMojka+$K#hMP8@i+5ej1V*BA6U!-`{xJu9esv=*(aQ};uDvQf1N=J{MFuAf~ zq&H;f;QsxF79G>`_~N{T^DZZ__dk0x(*K^jQDdh}9#ia;XXCqM7w26;u=h>}#%7NiJE634V(G}U$}2nNIHuXb9&N2B zm!DlcwqkOa6i@SOkDKLocHZR&ja)ing8wDZSWu7*v?fm7qPQteQ*s-Ha{cq5k{AL*VB-H5% zX98vQC>lIysQF_5A)Wk{4Y#c4kbVRE^zR)m7&vs$(BfnI_Yar!9@u+upMJ-L3x*6m zX6T7E?4y6bo~QPx!M;cT7xq3c?0sI?`@FFCd13GK!`|nI zz0VJOpC9%JG{T_(Ef6=!>yGaZmsN)TRGV^_!Vv~f4$ip zm*LQtlM`;OoUr#fVefOo-sgn9&k1{<6ZSqQ?0rty`$X9LMA-X8*!x7-`$X9LMA-X8 z*!x7-`$X9LMA-Y>u=lxP?{mZ6=Z3w{4SSy(_C7c4eQwzM+_3lgVXgeIR`_I>6F!mV zWCtf*%*TVs7^n?&E)Hq&?EMh%}%b2^7xuyeT9ox`;bpG0%QXVIL_ z;aZ2!qdDOdX-@b|niD>i<`jgzmyyb=pJ8*tr`VkEIW{MJlFbR9Wpl!( z*_`lsHm8OYZI`h3;lpuG4aei~m0BWvh)#qr-V$=up6p+>k1X|XD1%?ZoLcH%K?nDK zlO~KS9$7l6GN*}ng zxi^!Eq`RY}>s7)nrQ526yCe5bC6S#QZh|hJf15X{Ty9xLnFci9^vgF?S*h#%1l?<8 zg|FP*JFZ~h5He#t;pySP%xW?)Ba4tZ2of?=*g?6$Fd}4*HiXRKh>$s65i(PlP{`HX z;N(wMwt6tpbAyvVS%tk1PX4Y{aPlV<_C7fIlU3OJ;N(wMp@z;4PX1&SYWv*a{$v$y`{3kHR^he}PX4Y{aPlVj_Bsh1)*3!EvpE z8yrI6whwM_$SU0S!3_>sh1)*3!6B<~+Xpu|u2pb@Lnz$#!3_>sh1)*3!6B<~+Xt6= zWEF1v;8KsQ!fhX1>bX|Ir5>Sh+Xt6yWEF1v;F683!fhX1vXND|?So4;*DAPVBNT4? z;F683!fhX1vXND|?So4;vI@6-aLGni;kFMh*<7pOl8sQf?So4;vI@6-_{^IdT(Z%I zVef-WHnIwNpA4UClffmMvtcs0WFr)6`($vVO;(|{PlnI6$>2ttHVloNWOms5@VPb_ zKG!CL8*NuUe6CFfH`-(s_CC1LCaX}}CxaVpvI=`2KG!CL8*O*P@VPb_+-Q?kXyhb= z8*Q=*&DvyeqfJ)fwhwN!U90f9HW@zGCW9Mo+AutFf*WnJ3b%c5qfJ)fwhwN!$tv9T z;d5;=SWI*`44-S0!D1p=h1)(@OeCvt+Xst@WEF1vU@_6P3ZH9};d5;=SWKi1!)+fd zCX!XS?SsWcvI@6-u$V|z;kFN-Ym>oZqPt=ET$>CQ6Ui#v_QA3WS%up^SXLpcaN7sV zDy~)dT$>D^Ym>pU3T+r}`(Sy5tio*{ERT>?xb1`G5wZ%mefV6P43OK3E=ct-|NpWUvh3+%o3{Con>0RgjQ5BNH+`M99>Ukm(^p zrjCS64-qnTBxHKXMZr0ZkhvNn6!tzir;%0I`{4eOtis+0_m5;1_CC0ObghDO8lkZF z!8whr!fhYiKjwO6r8ZnDU(4wPTJwTiGA9z97u(vjb#n$+DDc)ytkm0JM8I3q+^M%gx5Hage|T$mgmn*Y z4apr-f7r-0I=r=|j)t{xkZClMwVpawrY}G`yisr>b9I6f8Eixvb}xQbjla6-{>Zn@ zbqVq($|@$M@+bT^HXVS>v;53`-@km8$@0I~zD91o<31?BItKTDPLfAnaI;6q^b8@> zs)S4f5i<29WLm^U!8wVLnQes3j3Z;v=AJsrtJ>>N5z$xN)F zK&GM-2FMTAK?#{IBxIV3kZBhe1@~rzOs^6$?Lx@(Dk0M@giNmzGGmfZ*wx^CNLFF* zgEO9M72KN<3VR>in~_!6`{3S;tis+0_hw`j?vCKz%(V*c%?O3tJ~+{mRk-bgdo!{M zw|#JLMpogr5AMy#D%|$LDb2MCPHBX~Z6Dm5kyW_ugL^Zw3b%c5Z$?((wh!*j94jX# z=fvEcYfbl(3)3_lwH#N@(aUi(a-3^`94F|Q<3<%76$!{>9DsEIV=^PE+0Hz!J%ya7QhDq}rl{}|Ld5$l6jxYI6Tjx9V%XjVp^PSq}JHF&Q zb)peNkfk#HwO!krNbcSXJa@9^xsyH5o$Pt; zWY2Rad!Bp3$#Z9Do;ySH+!>nZ&d@w}hUU@f%AK%zZgNhZo4S+dPUk##TIIRZD$ku( zdG55zbEj3FJFW8EX_e=u8|AsPEYF=~dG0LBcTW@f?r9?5O&Q8}uSfFTvqrvq*2s6y z8u{*7Bj3GX$#+j8`TnT$KWs5^QiWM}nowyz2H>whjq*QVG{t-BWAk(xmdr zk^TpB{NFQ|-y`>5$w!J(zftbzgZZ19?fnh>4-=UW9NEtyO`bT`|2&Xqezm;Rhr!?C z(h>fTr&m@?DE20nPplj=kCppx{XhQal*ZYQCyk#n zcC7yanTgYjN68140#a5!w!E^unw3qN7`*N@enMq=r#=Hu>^Qm7|A2%4;id8sQ%3vW zGBIj`zV@9g*Vm;ZMocQ7s_#Zk^7rp`Dj!oUuTmTPA5aT08o05aBliB+Oa~8R|Ed4fLhM=tNBx6QL&|2F`at_}9P3b?V?$BV+ve!udcwBP><_S=0fA5Qk( z2K%qU{wJ_U{id>^X$SL9ABO`sA9L1658(di%c~!y!i}HCp8_eF2==C(bv!Ku`)|Nc z^I2;1Fuq{Btpj^JzHJ42qu<<}J2=3*g3o{SThJyN&F##r|io{|@XAk&}(7um42})sLfuo6XUm(-V+h_uK+ju9VYwz1az=o--Eq=!rxS`feaW^U!zkZItK|iZ&9Z`*qe5c z>E`PX1={XCV~AAV1Fmr8-0B&BVH)`-3&T-JpYF5 zOGM~<;{8P@PY&YdE$UPXH|^P6G|ZoQV2|VHTCg|%w-Ws)!5+uYvtWdHw@`E{bxTex|PI+MX3{htfm=r0zXn?MKW(JHXl zbCmJtMX<+qejDtK{xZ?8B`0I^7TbA$;aaa1VxI%{=ubY_i$8w>d-Q(`*zd36{@-1|jm|pJsUs&*^A_vXTDZ2ui(;RQudz^PygFSxB%DrHZ$GsK6@p@wuaMS*B`0_pg{b2mab>Vkl z|D$iO$KeCy;=@#PhySGaO?`!HdoCB9lfiyB=-esX3}16e@{Rw`Jf0<;4@GB7gicZ} zdU(G*g&RL{zm;UaL-c1y*xv;l@9$O;*ZaihBKX_F)z4kB-%r6F{X9%Ap17TR2VS1&G_jc`%MVv_CJH{lVU$E!v1RD zcwf9xxM_!v{hf4``?3#6zpv>306N$XUF70Yb@ZEc`U}_gED@cN!nt0L2{&$hW6S*if{-90= z;p+cZotS8UeI3{p|c)1?)N>?*=ic!e|${5fsCueV1v9EA#AN6wp@fM;ip|ghU)t{${Zxny(wDy7r`_oo9`*Sey&7yN=gwAZTSAXUa z-!3{YM(AuOd+o=a#C82K=YX2)b)0amm-;h^_%8A1>Ij{C$X@+xYG#e*DRQ())-lV2{_6-+=wkVE;YX<9%pa zrghBd<9+Bs!122AB;nl7rxD+51pUV?nZch>T;mbps-x|^hPb)*GLLv$`Ro6|^J6RF zdi|-_vAJN6?Jz>P?suz|^+ppnePbR=K?nEy4B4yyFAz6t!RFEEK>OFcMVAkEJnw}>k+*9L8<+s{fWR)|03bsK7S-`?g7l>WzfNT?I3$?pD&50r&*o+ zEc@5UqRtTEF`wgo!6f1A=Q+e1i2mvb{Wr;8{d|YG#Uq5KE!*8&ZQALeLd3+8LuKU&Y8Ag1L>~~Rw&O>Cc{y#>1 zf$01ap|e+ql%H6yOyTTjJK~E(KPN)xY~a{m7XZioUPJm?uN#P0$$syM(D@iR?)Mkc z(e_X8Xxl;SyIA!53g>LcOxeRpg5|MYtJ8?Z;6 zy*k-?8GFO^I{94Tre2=!qh9~q2OQ%gYlLh2e3x!@w}U;#N4^7lxdjO}sDFgrPIc@> zy5}7z-1vj>kwd^9<5~G&kMX#15%#lyo8wZZX*~aNE$HBWR{_U%c#d@1i_Vu|kL?i4 zw)-*lm0O$uGzD(_$rhc%g>yUj$^F5@aEzynCmn0$d6S7}i2m)MgY)7svM&*#wZxl> z&h7{u|C{fEhw&5RJAH&}zZZzkaIlZTIGheV4!jC@8t}VFzrX0;OT4e}2Z{F*{si$t z;p>QNyv+Yu%;b$&~*%4m%1r_Hs)a7#;)m*k46pZ`x;?=vRV0_SY3;KTGWI0DJ70 zhrs?o>vHh?JaDt$d7`s5LT4A*>%90oah(@G05{T^N86qM0^ICZb<*=}xwfI&7X5X2glW1us7|zME1KJ>~UN@L-xzXelytPxY_~sa?2ig z^$T#b-&La1ymL?-tVf|vE8uwi@jsLsJajy)6`kH-k2)n}zh3OmiLk#?IJfidq_bUg z9*xj>ne4Y(x4lioH;PWP0&Bqi?tfG-cxZif{P-WWa`FQKYk5bj|~N)VTmS&i5yPqy9^z zAKY~Mb$JVT9sj*tu6T`(Ox3pz9A`3xYkjv`Gp`--3^NJ*$0*Rj`F=jxYrkJeys79s z9ij7za30Sel1`@R{0KT3P_M&|vi_QS9c*6)&qoXAejfn#M!LP|p9A*TUo*ho^o!gU zcyqxX*TX*mj`ua65!cU0{2jQt?k$o!)b46uXn*xJo$Nmv3pe#LYnFPxXb#-$SM}Qv z*Zi4|5xk#p-EWDs&p_h+#h)uc2gk`0vfnB?_YfZ{I-f`Aq<0Idoyr>&ow~$_i_USv zP5YofBgtO<8AH5Gbnc4Kc~rO=xApz@FF3*a_Y~Ma;v?;s*COnLjUrVk#xc%!9 zA1i(yFP!UJM)q3Y3gVh4eRqV;IqKW)gifr7tq0HRX2P|9 zUlg4V!ns~YlfBlfC-F_9GY53AUN@1w*6TLnn?>h?2%WEl^L$C~Y3r-?`cQOQ3XfBN zWt065vF{UMKLYI6*j)wBQ^6j`?L}a3#?LpRe;?T6xP1;d>ims#c8kv2zzr%1yzzf! zv6p>e>WkM)b%5h~V<+L-ZkpiR4easy1Ufh#R+7DrhewHLh|Z4@ zI(zrF^;Q4XpXS8%b15eaH|>M|j3;~bXEO1|;?If*oxch<;}h3!KO&u`qO%)xu$>P- z)~#17u|HC{@gMC61IO`GN;;XMGYYsFKb3ZO-h9x(@pBb$ydJxmxL%Ll6TzPpuKkrI z{%iz$tk)LcIBvfr9qspj5ZBKa?T*mt-p5v)$3s8hxZe`t>c5VYa^fANUS~z<+zTAX z;X2aMdOc4(TlDMot=a#!!r9M*i6=#8bcD{?z_A_X3+HiOC0zGgkYW9M7<90IKPLM^ zvHyF7edB&s&*(p4Uk1-v!c9No_|FCV+J0Ft(LWvR@i;sMIO@zHo&KV83Gh0;{=C2& z&$|zFa2~A$j`QeA;yRCBiQu0L*LK!%@-^`y@iTdxb&SXP0O6{m<9RUgVWM+&gwA5& ze7&)XbV@|$WzfO#@CDhA5&NGb?3*8-su%WGJK^>GV$<(qMdvW!roR^1&AlSf!Tvf4 zIQG|Y;5aYF05|s9kK=)({rSMrel~Elze%{(OZ)vc;uEF5AAk-XXLggl_Is?qZ4lL; zCOSQY^Y|GeyuQB~-an2eomrwY6LhfOZzlVBVt-GB{WHL^-#3xYe9?Imxas%h((k{3 z4)%Mk0oK6O7u!EqxVDeBe*y6Yvft^TgYAD6*=ze>OZ+;~c_TvSL*Vt&{Lj%yy}lH# z{qmjUTh<+D4b=ZC(a#ia>WlqSNcKy_eo%z{XyDi{Q%Pr;=$r@K^vgQ&|5nh!ez_Ak z_RDLaW9GZ|%Ui^k%YIu9vOD7OoD{C@qy5r__$tvkH$rDFaO{_>g=@d`ZEF2kO8RR> z|0&SHetDnl*Ngp^5%zUuAMIbQZ4ta$S2{;X%T+eYT4JDA2)vnM?ND z#r~QI`+I<6zpN&m9isCjaMLe4q+hmy4))7V;Mgy%2ipy`UOHb6B)&`bJ5o5e=M1vf zez}17ccSxDgw9LAv0vU6uKluI)>XeIeXp+6XNdi4{KS4aOt{uJL+ram*bfE!wN^5C z9s~B+U*~|m8Rrc||5mWa>&*4Q@w(!##P#}NO9cN`xYkSiaX0a%;!n4swldt0Cka;_ z?Z?xIw-TL25jsnSoBlHO8hV=D-&)d9Kc69o7U?z;=M$F zQH0KeWUqd%BHmwgzK_t!INAEo<79u~W_)734g-6<&ddc~*T4SJ>zwYOgYkO$puiroNXRt?qR)YQ0;Lm#CX1_CJzwbuqYzL10{ypjF zxc!;<9MP|Higkj=PaohoFNOlg{f-f?^F_z`IO6kVzf&W09s-X0eHu9K_hsRFzSDTz z2g22#g|gotKnMG!*{QZ2jJ;k{8*->{(>^#(3c%j<*CNp$0rogf&IOJ-myph4(YYMB zxo+`d=E;w%fDT@_JPI7!=RMFdel8LHU0{#r{kn4g(RS1E(}?&o(HSJ%v=8>z7_zS( z55$*?&b<*j>&RaHd7k(R(Wy7wv{Lx{@!AU4dZ|AL6JI4dqa$?Y2sh)+w6o?LUq?Et zMdv=y!FGO!?AM9?&ItQjrw7#v@{w@-G!?G(S}!{L0XO5Psf?fQpo8P5H*mbZI)S)e zUzJ4gO5y6yi{j60u*Y^-0365dV$#umzl-=rZRZG`uYlwD+zlM}+vE(}&g#F8lNQ7` z$$k$I&d1ME;JDv&NJr~6gZLYw|9FJXCbCyQ-z2_SboMV!jUV(U3plnzci}wFhX}83 zAJIP(bg+M~C;RPUza+x`X|R9Bx*R;e4)!?yKL&eqeA^-VjZ5streE+l+#WdUbQZ4l z`bKoR0yp!hz09K#po8;h3~-!BmBe)(T@=A@6|Vm1IJtxPcjD(Z(82!oO1Qe!0XAgNGHSW$bVc2IyfF~Bm2f;e}9Di^T4sc-XNW(qO%3K z=`a19Z`z2!t>E~H{Z$t@_Sas(abC0pZtS%m+X6@XY~X004;<}_glm6kzn@6Fh1B;? zpo9H&AK7cauOOZ&I)9JQsXfxR8~6ME!qw0AqLU*$?r((e-(7FU%n>$BC(H`r|O0F`vb>*IaIjTcc|!e0&e=H zO!{Rg=wQE`3LN`o9_V1dTt-~K_wXgq!G76B_S!Eyh?j`}9Y>|w0d=|n$9_3hxb};# zSDztV+h>gEPXQfl=WED*qS!BvuwM-v`(*>^REo|<;HF=uNx%F9bg*A`1IK>pFxs|{ z)=TG04)JNS-$}xGzFbQ7+Aj-;&k~)#M(At-j{WkfaP1deua1v#{hufL`w8dcSQoNi zAohJD>`Q=Szf2&Vg`!glypHdhe$T@Vpo9HV1swZjBk0ujb+lhzBYvIiw|Rwa2kw_6 zgc~!Xqy3U3UL`tHB6KbQj{S1EaP1deufBuymx%u3po8;e3)wFh`yCPXbZYLe>mnFpY`&B;y9X$TT&$9ck=l{We zsY867G4LOKg>(O&BD}tDW3KD;JaQrEJQpa~r$2!Xw$Goz-uUyP?Du7`$M)Gq_M621 zXRychnHFR1{0p6K>i8=f%-vuj8#J@oz+D4(Q-`yNT@e zIB*;B??mT=2%YcAUj6x*_-@hZKHk=s$L&eNjTw&r(};WZ?e>czbRH3I%uGA$dd>@^ zqu*cr4(MPzH=JPiqy99I{k9U${gMQZ(H}=-~LN1djJLvxw{c z%M}s)cHvsDrsB^7V2|za1aKU;uab`T`y0eti2gefI&CM~cINSLIB?u=58>*+j@v%O zTgiS0MCdF4j`QLU($RV?C7vnzJ0f(_&UVL-`k6sIOLY1P=XMwZ9NS^MaI-m%^FNS& zd(podbg+M)BKvHy|7(Q(4zPdTR?$9BvVV;KIR5t%uKkr1{VrgS$KexzqfQCwbQPU) z;AS4Jmw9w4=-@oM5;)GIn~3W?x;KKqAYALE3iY!fV86dX_S)}Th>sDS z1E$#aU-{)h*!yezXctf7mcR{yZ5wzwO^VMUm`ju3FrPD0UY~ff^f6B=@(tkxtR2qi~h}^ zgYCSA>{p5XUn1;30*?Li4e6{Fo$rC0erX~7(q_7CAM+Obr5$kWmqEg{J+)tk5??F( zy#{o!U+yJ)?Ux6MuNR$fB6PfSQ~qPWG!$+&H~pgPIqih2{~JZWE9hXqoI>_*i2axd z`&q!TU#=jX&7!jqxapS;(l3vK4))7h;Mgypf)37?FNklI{brw+YB%hce!{hVv|k1i z-!3{=MCjZI9Q$R7aI?AT7hTU;OZvM+|8>y8e))#%zZ3hk8L4`q{Q<&FyQ1d()n~MgJ_Y$Lq|?$X@5gRm9U9*qy%$I@ta@$X?t3OX3YgCvm>jTsX~dg~KaYS8*6S6r*LuB9yp`y*m|1hZvVf!i z9e|_%-Gp;HoDcR5{rYMBOZMu|ABY!-KaWS~yh--z z&pX8R_kmhn-~|tE=Y(*rm-^G0c#-%sDMIH`vR8i=5Fai&8zOYxBYXAdW8z~(r|pF` z*Q-Fd)=T~AM!ZsVrbXynBizgvGtPCr>u%uY`+gfgEe8(ax?lA_eYW*e`7GIQU*W!l z6AvvTd-cD9_dI=IkvuB zuaktUj@Iim;#H!vC_-l?*{eT~5?>-ZKS${7f05fS>Q5Wu`ukNQg>${8lfC*gllWTk z=ZOfNzp=d>_ueM{qUf}mTXQ>i5w89IMx#dNwCx=)+>B@ZeWFs~+Ar$=DB^F(e(w~{ z?XZUIwLPCEzEyP6FRt1D*23AJ1Bq`Joly}w7m~gDb20I6L}x>U&U<99?ej5luaT|K zA@gdk*U`eYUg}Rz;tfP+PK3^_!nJ=}{M@Xz+2e!4wSP4pTK5v`kM6hWUiN(>;*Evx zPrQNfHpDZ8pCsIj2mId4GU4i{9)BuHNB296cni_Lh`8?eA>q8=b;5POI{r72j_!9W z@m8|mkBIAjoBz?aAMZCyxb9c`B`I9nU-w%`JX7}Do4D?Gs&L-#Rb-zj0@zX(c`UyAwpiZf9Z3q3Guc@R{AUYQk*Wb^(n7FpXD&gD?o5)_< z;Z5RQWxtv8Q~ikkcNbpIFE$fP+o2cnUZQhpgwE~4O*@$1S$mo(J~k{;{j<_!6*hl$N@` zcpvNoe;V5jwh=E9zKeK&;eRLISNM;>Yx&ZMHLq(?#arLK& zxcYMw~`MZ$HzdfdK>bacNr5+5$@P(@t#dk1iAhwZ|7Jp4mA`;)f7wi~xY z1LEq>-o(|Pfx@{Rh6~sI>UpGsbhI5N5ie$5`qS>p)HuZJhogmSJD2Qb?RpX~Yi#+&po7Qr+sS^b=qw>VR&;hm=)|tF z`_XpL^I8+(>Zks`X)EHDqTiOdw!>ES$&5FJO=3B>fuO4qD$T z*>7Lr+`naHukBMoe2M7X6QT2zaBiPXq@(S#g}AoQ`^2?<+WaZizj!=3O1P;nUKjNO zZrW#s_&wbp;$9`ETocm=t*rPv>07rkGBCh^CM_m2+PB_n(HrJ;59k0_m z3ODw6owgqAjX!Ip9sWXm$=+7C(RKDOkDo(?>v$^^`wqlc2p<=rbDnTBej5ANZ^_xs zjHGun*qeG4SU0?TgzJ9SivH_hzYkmoZUK(#+dq@eI?-u(z1@+iZxhftSa|h*rQHrE zzFu_3f({;6FCu$ww?7i!Bsv=+blxL-?Z=OaZxx-kH>B!?{v0V>>!tp5C%!{;&W+Gn zK=$g-HN?LYosAJX+sI!1*+D#gA6uV8ZmhXp!-UuOi_LsYmv!Ar;acCuqH`(eV81_1 z_ASKz*$Dd=f#Z041vuvCybT=f-vf^MHamf%{nxOVj_dOiO->FgGr&m(m9yV?5B=gmCf>QB=q)~>&B?yt$9W5&5&$6i4?9Yp7j z2%VS6Ugz(t#51K{jc!S`KORpG5w8C0{Ov%zgXoNo&^e#%)t?KA7l_W|5juY(d-dmS z;=M$tc~#Bz>L6U}rT*j)FA|-x5jq!>z4|ks_;AsAE<)#hvR8k$5uYeJ?Qivhhd)Hz z>wMu_FZJg*;xk0&(g>Y9$X@+fN_?T{?1<2*b({5*{i#R1N_37F&h;uKd-Z1&@nxcO zXN1mEWUuY>9Pw46lW}{^?YzHmt(W@KhWLx3Qxc&wo$S@0nZ(}^ohKr6UL$+;=PlwN zicZVLHPCy&BT+U z)B4Vu+vjlMF~1nE+ouTEb}JN}TR_MBRr46t3US=FA<$DB6KqDvVO8Z4T+Bxoq@u+-^<8e z{iz^6O>`DV=sZUD+CFQE&k>y;BXst@+ty33Gd1txXyIDl1)?)pxTzQR`%JRGPV6s> zu)i8Oj<@T9ofztpy; z>TDOCuEM$9&Ju3sueom2>+_39C!?9wT@<0SgzOuO{lgLVuL|e=)>&rvqg=1g+Y8rv z4Hy0H!ns}}Nk^~G=a9}q(YY}~=P}U1b-y=BXPM~iiqL6rk6SOjK0i#j)@z;U93!0T zRYCSTf5#KAl77Dnbny896xr+ieUA7t(TU${{Wt!gP7C4czxvaf_$tvE7NK)C*{eTO ziLVo#`y+IoBYXAdMdBMpr_Oyf*XuyxS}*nI5aOFfXGDa~`DCyDTu6ME=sX>vvz6@C zpO1*|7M+8a*Icgx;aV^CryKF6G7e`(=-f#5>Q5E%OwoBSLT5MGt3R>(t^ew02hr&v zoX6p5WUu~|5HAp&TO)KHCVTZ~HSu1e^HYRQiw9i))t}bHi$v!P;asnYWUu~AAzmgr z4@Ky_O!n%}CgKxCr`dxwkDtSZYrm*J*~Djv&e;(<^T}TQxsv!i(Rn38XD8XKKVK1F zBs#e(YOYt2aIKg6b0YD@qVuN+oh4+i{@g=+h3I@9p;Lcl&Euyr@ztVpf^Z%`=32r$ zOugPVh4QG9zlOgB{9)nd{F^SX&7UXawesahS@0$BTJqZbNg6}{Vg3YM-j@*4U|#r-gNaWR-kZ37uD^`S zwsWkG-O#vU_N(pOinz9O0dZ~TlZj`FKU0Zk3BQtfd*MrocM!gTc((9Qi6@0;NP}p- z3WR47?<%~Ic%kr9iT4sdnRs8}mlN+V{7&LU!k;2ORQOxK&3%?WzKGzp>skv_Ut{0+ zT>HKa@m*hAUO;?nwjGE=iEkWd`8eXsw^@EM@fE_WfbR>(tCbOa1M!UySwBA{UM2qg zNPJ?JZKQq8f!}`^?^?iqkBH!XiEF!!Cf-!qb1v}~!fz+uO867RGljne+}tngL%;XM z_>a6!eQTk7mQ3tS;@*DNu7LQgc9s_rUwg3SV~Bh0EuTd^Q~3473xz*GyhQkm#AgZL zMqIyd;TPiiySMvFy|o?Yi%u@_1;PgsUzM=+8cjT-kL4E-A9kAMHxQpyZuv^$OD0(U z3h`yacM{(;-P+e}X#Z-xcF(r&4nDT zuD+PK*6UW{a(M9`B`($RH1EdvZ~W2gy)VdKulMTild7+=Z)M+lS;RAiA5C1Z_f8=$ zhi7jp@eZQ1fOxj>rNs4m?-}BHy|LQ)2N3Tsd^GVQ z;TICu>%AL^4-@;9#ASMUF9H9=?-zZ162WUpN1J*D_U48EXv zug%P*ziRDk{jK(2`lUT{?HA_KFJ}O61?@H?g5N+~s_Q*QT-@~DB(BHL?}+R1b6+_y zntB<3WEgv$iOXB>B;tDfoJ>5^HkWr3@hss_5^pbj3voSueh0iYv|CfTKQR6y&t@*; ztv_=aZxzgCA9I;Y2i(D2#@kcOWxT!1T*ljv%%vmu-QPAyb-iS~bp&p{w?rSuM({I; z7fA=7L%d2lU;*)6a)P;wc;N|l&(9FwI^FX3h-Y7J`Om~>-DY{qmiDiyuc?<_pXU+J z++ghn5uf<3tr{rjiHmk3Xj38M8{CcG8! z1E3!ZBKS$fwI3%D*M7W$xc1{R;@XeT0ylY>`q&b||4v+wKMh;kElqumjvi;Sh|6^L zx)K*z?Nz|Hs1=wodJe~Y;G<2S^$9~-o>il&-IU;FV8;+eAJ zp2X!a;}sLn7W;FF7YJVf+{E|wu_S^&O?=qlb%P`H7UES;)(iMQh!>vKGT?h>+C7>2 zVqQT<;`3sy1N;8OH(q-{z{e2ZHKI+xFCd;d((;>#X9<6ZczfZSh<6aalX$l9^tN8` zF!eI|VESko!IQ*wybUD2u-qz*Ccdd{liVSav zK0M{8X=9Dw4Iuuvnbz(vz|DXv>~8t9a^Ym^i}U532>v~Boi9x~T0Pa#`O<;7&X+#K z^>gA)msg4FeAz)<=S#g#ZoPEA97J5_%aOowzMK%j&m^w% zWe#zjFE)N2KbDyd80!FWrcHGG9(2uJdIQah)$$5ZC## zjJVF1=ZNckd5^fxm+ygNoN*sHp_p-tyd!Zv-}NQlz&4jRl6Yg`Gl}bc)Ahvl{J4_1 zUgvBgo+y0L!6#a{c>-qOq;$6l5apHx-Unky6 z_%7moh1XBm7h13W!n24M3GYsPsPL14W1Mkp1fNY@<7JD8Yn*WcxC9ZMC3yEu-v5L6H86N@O7Vb}9jo>?pSBd|1j!M)LBw^$hhU&yq1O?;^EH;E4u{w?w0!kcxo{%XBSgy#@16Fz|W7~y9T zA1nMK;B}#27Dez?#Ftq2yp6<*Z1Z@Z64!ZA>*!Ry%zibW=>Xyz+giKM#HSr-`C#A& zf&Uc|d=7D)?^VPbOTAVTZz23O;+ev~0GKo^j`}J^n{kY8N9J-K?8jWam{~tlXUTHFsj$q!<+7Dpf$npy2ds#jQIOadx8o}2vm;QQ(x%AhM%+u_C z_v>x{n$3g#rrY*T| zn%D6)an0*!c)VL*&FeUXxaM^f64$(r(}?T3XeDvY>$se_=5^djT=P2C0>`|L%@O;#HzQmAK}0TtQs(I+hUEb%SSsV_wI*5&S3M zy2fB!YB|t4X6lQ)fViIT1_H;tjDMt^Q>K;Q&RRA*Dj9W=MvYr_Cn$s*S?3i#A#uyy9iO#M zOV!utXk7aM;u_aJinzwLPa&>x?X!Vn{Ca)_zk|5Owbu~Wxc2MBHLm?NagA#?mK!%S ze~mvH*X~GMZe1o{gF~1?Mam(ETEpa_B zcL9#)BkhsR9 zHxk!)^ryfv9-TfaRbS+p#51g!S3q3j(I*hsc=TA}8h5*lxW=QG64!Y2Gr%#vvpItQ zop`$Vzt`wgeT|OR>rmni#J&e{J--hpuIrZP5ZCkmmBjVDzl?aM?DtvXS;F5VE{A{b zXW|{izQq{(BIf@w_0{{qT;dw{89=;1bjA?xD*Qs?g~D$l-b?r+#QO?=jkqjRcwZ1N z68m};_J!6<<30xwm)lsc8*#bJ_D%whai6mz_+`wE1ODSK=6+k7$Ft1SEdPMH4A9t_ zw%o`D{?xMXTQje1c{k>DEFZ=^!}5vD>so#VagF=j!@Qog-@v@S<=dFcL`pl$mTSGz z8rt`5nK!b$8*_>K3J|7S{dE{~>94-b zrN7FUOMhL)T>5J{bL|)A^{sy&1IM^e`nZ(;$PXkg)%AK37dO39;ti~+$m);(Gl2k$9%;x7~QRURlEX5pOTNoOlP}vw&mVXHf)S#azbQCgw8UzGN=r ztPR%Xpj3Tsra=<}%(^0>}8sOA-8I;<~Q>3-K!HfEE)| z^)>psuAW0&*VP9Q*Z4>UagC46C9d(2+llM-`QyYjKJq$ojgNduT;n74&vxsj@sTXz z8XxIST-RHM5!d+0B;pz$xsQy589f>a%-k11x;T6R7dkg0g zpD4$@JBjP}7CuW{zqjxm;JEJkbp)?>zIDv(&e-ev;X%Z8-L)%mU3VQuT-ROCCa&wQ zmlD@?*Tukb-Sv?O{xWer{%j|%$AMpn>$+>pnW=Wbb=TYo-k-R(+gZeQ-Sv;eb=~z& z;=1noG;v*b-2xofUB8Lo4gQd-m$BD*lto&ghek$9Epd_r8;UE{N?ff>(6U)Nn*64!Ot0^qprIyiz)1degf%Om(w;(C007C5fE zZjRtz6W8^n1{Zk2!_+s>+0VYuBChL8U5V?u>rmoed#f{+c&6}+h!+aKnRtotRm5ir zf0ekdyM9Jo*Im;tw0^~;zPj$(hPbY~9!Xr+U560Yb=Pskb=`F?ab0)4mAJ0Et|6}L zu5S|8b=SWW*LBw>v)%gYy6X|db=~!N;=1lSnz*jJ&L*zwuD1}^$>Zw#C6@Z z)$+=a;=1lSkhre9jv}t>t}}`2y6c~a>$>Z`#C6?uJ#k%keV@3l zyZ%gE*IoCW>$ZcgyC#Y2y6ZsTxV}0jg3lqIVRz>(BChMMD~ap6>qg?b?)oKhU3cB< z;#9qipStdPC~#bNEsWr&5KkBXCll9tT}Hh6dYHJL-`5h?>*2SF>v{k0#Pz)2cwVZ$ zre2xi=V8RNg!d-iUib*&x^6Ioc(&MIOFSw3e&PkfUnJgD_{YQxg~u+jFU^dN*CP0r%uNOTN5enbzvgYA(h9$-=F(pi zm`i_M&RqIy8FT5c^~|NezGN=_)l}9Ys{Pk~VP4+!P(aXo$(6VH_WUP3%e_&vni3xA$?2jL$A$8}fl z3Tt56A9*Y0GTsW9%XmAHxs10-%%uaaVlLzDUgk31HZYg*wvD-TWZD9%myEalfMdR8 zP6Y2yT=OkQ5!ZanKM>b^%NvMmzU4#2HQ(|z;+k*yC2`HStaoLqzNTK9Z+S3r&A04M zT=OkYC$9OHQ;BQ7Jz-*RyTf1J3^$JdE#zU40Bns3?gs#JZ=el_3naN?S8*%LVC zTb>cYrxDkD%LT+W-|{Zvns50Gam}}UpSb2*{z6>yE%(1VRbS)3=36F-Yrf@iz%jls zGJ>B+T-T)+60ed2%{|0*UHVz#x-R`bag8thOkCp&Ef=QhYy8*vLIH8T4;@Tg;|pVn zYkXlYag8rj5!d*_Bg8enu!*>?EAAw&@r63qxb@QbLMCyIFLVKp@r4s3_+;YRk5>@a zeq2Ue`|)|=+K->zl=9!qU5z7rO?>#Z*6xLyQ}*T%zpJ}_{}138cW8P`${zWV#Pzr_ zf_PKAxu?J1ZBAPlceobpkv~9O^VLOf3|*^-5L9I`_^j%9ODjo5xhTfU0*FHuIsDk6W8_CYlv&y;U40i zTyH!>JX82P#0!OgOT0w*-gl(h!PIw_@D9W^?$C?4#vO(e*SLfJPP%Dlqpxv?tI1yD z4$FvZ+~HZ`8h3b?xW*lRAg*zTeeZPZt8s?}ag93+B))sL-F_@_jXTUEuE(#%#5L}) zmbk_pHWSyl!*|5>xY}%qTQ7|}B#3L=;dtU2cPJySafkDOW8C4Y2)>NC&WrWLbzW>G zuJhtM;u?3@`>s@djXxT9IGnh~9eNVixWgI5OA4*-G~ya}SU_Ck4tEmQxWf~~HSX{_ zag95CL0sbwb?$cSt8s_6#5L}46mg9^oJ?Hf4ikxM+(Cc0-OS&hor|p>cY-~}9iEKf z`upid$Jl3B8Sn38uW^S)ORa(0Yuw>b;u?22j=07h#t_%I!-c>x?r?nse}K52FJ2_B z_4=52_4P1uJ-_d_ELC6Qk6sTaiR*cPAaOnKR}jyXcAiZ?32Rl-D6)UFA(02cvs=wi5Ch#m3S}VQ;GK#eiiZl!j};*60X0uu6_;` zzLo5U3IBokaN$kvwJ(eg#vM9E@Z*@94gJR`=6;)+$86^QTr!U;<}yInFt26p-(p_d z@*kMjvAo%R_HT8)WT1CsUf0_7C$4daGnv=3_Vbw6w|p`429~d7-q7-Qm^ZTg2j+WO z-fX%3YwCq@heQM)#9aDo0(0rF`OKxi?q)9iwVt{3*EZ(TU$yQh|E0g$GMD~3j=A*L zIOf_f%%xv$2aa)vCnNZ~#HG5P_dv>jqa$v52N0KT_qq{pY&Z9Y6W8PC4B~qHypgyb zKUWdY6#e&!X9=(UpnYM6f$_h+@B@i=5Z(rwZ4qEEao!a3Ykks4reaoZ4z)?kG(X4-%ecD@m3SBk`8!{xUS>r z@4TCOnf>ZIUcHs6`Wmk5u?G{^_1K=obv?F(xL%*1OI+7u7ZTU?*n5fVdhB}Qx*q!; zab1tyOV@B<(mH~7Ca%Yy6Nu|^rh>R0Pv#KMv~GA+#P#^Fns~O@zfN4Qmv#cjI9;t( zsrn+%B(8C~BZ+IAZU}LW(~T#tak@Ve*Ero>#5GR$3~`Oqy+d5%bUzT+I9-!R-1=&q zE{C|r>5e0=ak^6A7^j;S!LKB)=dY#2HBPsVxW?(;Bd&3}Ux;g*Zr?{!^~E?{B7*lP zu5r3D;u@zrpSZ^9t|zW>x`&8sobFZP8mIf5xW?%+9&_uZak>sqr?_cjjhiHi?=R~+ z7XS}VU4?f0>xpLye}H(l@DtYA?aXlo<17;*_%+0hujcVM@un7gZve+Q%U2P+;WKta zcC@v4xxUN4X74e}4%m`NOq?7_q0tKZK8Cs!)fo4)rajFHh z6j2L=T55+1I3WF@Fs4`-(`sO*pwLzaNPl4Xp@20ah!IePf(R%o2HIz{-w(IXyR-lJ z{E^(fvU_)Xdv|-g`+Wee`IiNOhwb3Xh;M|eeS8D1_VF}a?PJH6((=0fs(ri$uJ-ZU zaJ7%O!__{{hO2#i9Ip29&v3PmJK<^{kHXbH<~5|{3fsr75x*X;=hXi?E8@rCY9Cu|P0QP|9sB>Vu7In3{3cxO)XU;A%%o;c7?5!PSmThpQb~2v<8&3(wf`)WeI+ z_rr_LKZEx%@4VeFxc0@BSMS?>;U$*-W_W+|+u?)E=fKO%ABPV$e-1v}d>6dj{1|+c zd7B-6LFF24o`F}G4}ecFzcui1+;U39=hNK*WIwCu*>mka_4I7p;66=syFky=Tl@51 ze%b$ayK6bli~afldK>R!=ysw1h~Czxe*~^^%RkcF`Se@p?Y$qO7kE!z@xOKa`gbb2 z(>wZf1L&7{9}{>uZh3FS7tyW0R@1G%w$ZJ=j?%5Z@^_}?YB?UOudC@+U&H8DUq7H* zea)v^eLYK8z0j>*4h9~MTjuRbk3aM);a1$F3~q;+RKiv5v*3k(cgZrio}Yh%>-o7C zuIJ|`@QiK$E4y>cRb+l6yx4pqT+h#0frsOkzl-=fx?OKO>2|%nPq*u>{j2Hmx9ry{ zpf}yFx0~p8z1>E)>#dq@6}gOV*W2@fhw&lXBYp_3dGK>^&4YLTcUs<-c#NKY{aU!< zLx#aM0R4S<#wvIQyv%$Nyvn>5UTyw&xZ*?h!4)6!Azbkxg|Fq7SMede;ffC#3Riqc zC0y|#_rVn(vKX%TkkxR-hcv(yAM!3-@gc1mbIYapkPKY$A%ozG52=7FK4dyv@ga}G z)$e;2u5r}{xZ*<&!WAFV3|D+er`OZ+hVdcSM0_Y*_eB+4_r*-O;zJ&VD?X$auK198 zxZ*?h!WAEK23}R>%UQSwd>ziVxWUSA58B zxZ*=jz!e{o|3+?k6(7Iq_>co|#fKz& z({hF1OZ`&d;r!Hf5x)tpd5tP~jXgi_hiiUnFTbB^r{=*mKUD+Qc+>{C=BIYUH9vI>uKB6fZ>Hr9=cjr^ zycDi_91mAL&V;KTm%>$#s{;??g#Q`w{cznEXW)9D?65yAuiJiCznb)fcQY@AXUxaK z_1-u&@Gu_u;fSw**Vy*|3Rj%)t8m2$ABQVWxZPWRgYNY*j1w-3_>jQEIN_>@&w}gy ze@WosJY#Ld>*1=$H{q(skKn4u!ltymZoe77n)HF&VqvN~+u6iE;*Zn&NUS;K-2LFTkui#d# z$un@xzifqT{^clK^Dk|W<(5nHFFgVe=U@6o{1&+85$=F%{$&na^Dj@pHUF{}uKAZ8 zaLvCQ4m_NHX^!|8kEiFsrB^%K8?N?l2wd|om4S!zFEb*(2(I&12iN?|cDUwWj>0wn za`F3Vx!mz+{-sCYVZZnr5g!TH`~PIP-v8&o_5S}GxcbGb;YqPS?tj5E=1uT2^H1Sb z=ABNY=b@#aZvIuc`o%ZG)i17ut6%&8T>avuaP^Dp;OZA|fvaEqHeCJUX1Myrmwk|1 zUiFJh;OZBTf~#LV1+ISae7O3>tKjMvZ-%R1ydSQ9@maX;$1W#x%cXvC30(c+Tj1&! z-vL*@cvj$Hzxc6;*THpPG{ALV9DwV-I15+5xYMb$yy5pIu7#^#JPfXWaTQ$c`vY)& zZ(=cA{o-1<`o){z>KE^Ut6zK)UOmB=v+e2J^46GN1>b0X1H8$699;e4d*SLAFM_LI zTpM`UFRqXHTkw2eoaAG;`o)DGrsZ|pSHHM7T>av5xcbFEgzI|~KMy>de|#e1YvFp2 z+5uO&-h&rddGkI>%jNc4Xnr~TQuBUry+@6LceC_&!87Lb;6>&&aC`hGFTnd)`bKzP z^HcB=^MW&e!M)$Q^6LHkYWN^aKNwzSJ^?<|d?tLj`D5^M^E&t_^OxYG%@4pU%$wnM zdnKJe_6b~h!}-U)5ih5^jM>kf^z6BFpLz7`z2QD9=yri_q}%+$KDx~>G}CQZ^fn^>u`9_0{Gqj^FC*D!SEIIo;}ODqZzLw|ZF_csS2k zAMv;0R@~&G&(h;}+p)t;GH^XVOW}HcR>JlCoDJ{lcb6=O>-qT?c*fEnf)|un9)uD9)UtAOKlyWZNKOUu=AoOZqSqTBU0 zgl-jCNw@25df?%>^n!@5gljzWMR<)>KqFk^nIFJ4o>_1{EpPa}iDJ0MrH8>aEE-VuR^@x2ox{vce}+fumVd+Xqe@7)SleD4vs;(PO2r{xOcd%H!vA6)UhBjNh~ z%VfCXdmn-;zPARh_}&-bitl|LuK3?1=%R(l1HTgw$-R+-cQ2wf-+zgrA)ns9I-R0;0yY_OLoyWw6GcB6_82I%h zu~+yMvr84lK7S5oSEwVh`DreX@^|l;``6sHBpDmYKck;N@OSKaq2plwNs;{HOMU*s z%4olt|DH(xA$H=nAOlvD*_I!tIcYb<3-j~(al;U-J9ntNzUA}3o85l+;r@S{{X4hm z(yzbY=dby_&+YO#(dpFn|5PM@g$;%jKbPir*9r5ljpVQ1=}V>eA-8{*m-+t@$-l<( dhtCuDY-Rq&Nd9EE-~ZFuJnrN6?}jdz|9`9p`w{>E diff --git a/source/cluster/wham/src-M/obackup/read_ref_str.o b/source/cluster/wham/src-M/obackup/read_ref_str.o deleted file mode 100644 index 07f1195461509630d60fce53829f9f869322cf85..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 65136 zcmchg3w%`7wea_unS=mA!b>6|3j9s z=ls{&YpuQZS!ZSji7Z$X6;#A@31LM2zv(!O}+$|BqMRp3ZJ+u)KAMa;a zp3cU2tMs?4IGBye|%d9zyn^KsU!nP;UV}ALqvRg0RZZkkp2Wx7zm*t zuOY5W77?!{j&b95I`FW_PzT0m4e38f`Z1EV5bt2TgZLieQ%L_miLamv9Y_3E#77dJ zM0^MFxx|MO|2^@A#B~e4MSMANo!O5hPt_}LkTNt3n#6wc-a*H!>3g%*hq!QCs=mZM#8(o(nE0c_Um&h)@*Cp281E(i z8gU)jr^I_1&jbbRCvP);6!ATbPbL07acX998u7i1FD3p3<4NKXhzmDuXD#t;;<~=y zBtDYyJBW`ZK2Vtx4-n5|yoY!Zv-2YHxx|N%owtc&`{SnL`8)9n;?(U#7IYEJ=L*Kh z5U(LVSeX-3i8nKTD)B3c!=c<367OL87ZJaK@n+)K?{L#`ex3Lh#&0Ix&FuV`_=AjZ zBi_U8JV$&7B{a#CaBICCZ&nK??`F|2GX8aN2C5%5$JkI!^h?g_|5%J}Wdk_HT zb0y;=h}SYciFh;Pvxwt(#SISSRz|#o@e7D=V7!5N7vonG-^}>8iEm;2F5=ycKSX>h zaXmlmApR)huM*$E_=m)IG44T!k^Pgn?hklAL;gPFlZo$Rd=Bvlj04=XokhfRh|}px ztRy~`@mAt_j9*W@i1F_dFJb&X;yB;nru{xad^zJU60c$W9pX3-;RfAOZu^L@Wqfd! z%3BBHtol{vhKI6UX@y zHy!`8#CsTjjrb16KO(-9@ep)u>~FgnA4R;E@jT*t7(bbKALEOO?;}oMB0>BM#@mSN z2G{!EAReKPp!w~@vxr0YklX#la~SU-o=Y4K<@OTsiH!f5cs}Ew5ueL=HgtH*XPmf> zb3E~dj293uXS|en1>?(!FDI_!zl3-Vxt(wel_tZ<@P@DZsPj>@iXGvh)*K@Ot|33JoggUen%4DOI-KEV~OK=47cOdm&hkR7UpT( zwEn5Yqr|D0SV%mN_!L!4oKL)h>DLlp!R)UgzLL1UPrr`%%}oD0#5Xg(h4>xJ&I81E zGW|!1?_&Hp;=76Kb%x!<`w+cx4miNmxbw_g)~jqzQ?_Yl|heT(=$;yTVg;#qKhz)jnK9SVl^q@+ah z^FzsX)>DFiN=}_2g+(S*BrM3O!AD9?P7OXmaveoVa3XNezZ*{Rlcm0{O^Tl(IaH2q zUzJ>EB_*tt96s1~h2+B+726b7by+ZM?FkYds zTz@kCt|X4jUnbx77qx&>1$?;Bv$YT_=c)oXz?WNFA$}0Re-*(07{K2T;GYEW(GYIB zc%lLP%m7{-A=h=whx+3-oOo0o!3Pb6v5c3H zd;;TJ8z2zaj%Qrds{&IQ*Vhp<7+*<4^AyIL&r*G65#ui$tL&dkT-Pg4VX=~NeIBV} zcD7J~OBvVwd@bYU)P=8MyyR6S=w!T2rAK_5xQ-JJ<@SB9PyEM>>vh)qnH@dTJrclw z&Fqwu{ogQsowwgJuFr$##5>=KU-N!5T#m&%FWghu6YnhDxp5R)>y)4I&h^Eg@82Ka zzJB@s{rmB%Z5s*!uY}|HCMi_~;*W^^*IgS0DUN0l-}Dd`iFa;~ceeL-{vqD^T)gv@ z_{P%Svd*5uo;|3uQC@d;mhL7)zf=Vm?Utpmh^5%=4ZUviI553kx|Pb?*Ju4}|9+Uf z{lIeI_#lB{ktbyF&Z|09gd25ZjN$E%^0*4JWg_xB9F@l6Qi-QU7Te4~P$>+`{xj;%Nq z8)bJBig|+V3T}WVH&fcBy1-`m!YgfUdkbQ_3wW#xpe0q^Ek<>>q`E+7>5h%1J332y zHkS6R?-}~7W1zb4zJ=A!a!}(Li;RY;~K2k4h{;UGcG%(mRaMhiYLj)k5p>P}K`njCyS^ z-HCy{JGvM`sV?n{ukX2f8OvMsqP}=%_Qd%11rxJS`H8Tfz-{3Cm)IbWVAIUohGNJQ zV#5h04{e|FO{n#{1DQvKCqlmY9^X9hlzGHy%=a(!9lmWVbi`?F_dE2RzIiKj#A(b| zpVPN7vL5OvIwQB>*Z$JJjqv|lu=AY!-$QR)2_1|&#dd2Fg}!F?FFe5hRScCnjP~5^ zM{Okqahj<6os?eRypG$1-2*fqcL7VJ=+Bjs?@ z;|#|QjEhWbCV}tbhD*qr4s6R58p0 z|KGX@ZXQ*+f9zHon-+vTtsDOD&h-K&a5$Yvqw)ZT`we%%6)VgaVQC+)D4@SxU{B*4 z7xjgut9bRZLDPB3KXu2jnhCL;N6VLLu0wIhruVq-&T2Nqw!3(>su`)iIufYYQB$Gs|)i@BjvpR2(~M~n(JI2g>Jb~ ze&R**?Qr|3uPy}432I+=mz@2brF%J2Lg-;PJO`QBzJ4qilvgCBd&9D`26dXf;Z4|= z5722=`qfuC#w5Ts0AgN!!`CTCLX)m@I!zjPsAyah)cWpJw#gl0+g-d`))I$;)1I5K z{z0Rl+4o>|8pP>6T)Qv4?jSDEl2M7Zz6-0%Ahum>g!YkrKMdDTYFuArkARJf_Ns9m zhRd|zq21wov|0)Afjz2*Iz*?etv2{ht+qmJJ3Z{S>he8UZG||!hyJ(KX5WR?R)}pE z*jD~n+7u~?KiM0OSKoqNjW^P!?6UZiZ-VsuDE(w;&UHI+;D0i7*mbYq&VJc-H_A_l zc<7B4ptgU}UU0GT798?0k~hsn!?JU9u8;J08o*cIQqusO()Xsn^xqpaO1AiEu{soD zJ1x?->P7CQf66@TI^Di`tLq@<<_~k2Z}mM`T?cV`5B={t+k6*R*FkK%z%v81fEwV- z`2g<=F9KQMS-Z#gVzmU~ATO#p4(f=t$qwI<)h38-M~6L}clsWzHbI=;L;u@kx9`Gg z6U5vFv$9|1WQfy58+75E8fEO#WwUSIN(N%v{FmyWTYN88 zt0E5aqH1!`4$7+2?K`rngV=V2EwS;OzVJCPu3m)cH}VWkzmebL&S5mvR^PQ%N5rn{ zz`M=BhT7(vw`zviHvgp>s>kASY-h}d=A|AyM_ zo40C)*f#&A8mia#VpRfhke9=2s6DhoP&bwupC?teq=^UYf|Lu{M> zQVk{ivyD{=#6eyTuc5MhM^<$Z+l~&>Q2HVhFDUUMbNAoiB2%v{bjqtuc8JR*;05Q+ zckhH+>LnFir~nH$)_i0yscc`L1M2ypu2;Ep;g~&muvc0(J%mN{Dt9h~CU21+io%{= zgMnL4JXEXPsA5!GuX4vG=o@Eqb>$zs)h!lWMVo6Ycz|mwOCX_#y#Ub*ai>`zM{L9= z7szF9sUJIcllCeHJMHc9omg#;*mmN#T+rSA!Iy~od|y_FMtlHYs!uz2`)S;S6*|eywY+Dp7hm%OZAI!T62kS+9Wmc(Wdc`vUB}Jyup&6-Co-) zKY26?T!+fj_VxJ?og5C|floagush*!_!)egD~#LMM?u{j4ta2Vkl}zu^l-@YheN(S z9Pm&L2UJO=OFpQ|!`%2!gR?*ZA1><=nFGfM2?2}f5Q?QSeC|{Nd&Y>wLlpw5q(acQ zt@&6`t+D!#GZC?-c=rN$KF1z^K=5mEVQQoNf(M6fqam$%kX=kYJtIl;h;1#zeXLQ{ zj)PYfi|DF0WAkBn53PkgqpEnQs){P9s>b!?^Wa!L`IsHZ+_!qK>`W?8;U0Lf2zB+J zBH{r)h#m9&&G}Z}wv}_lX>9j1=i7YaR?ZPS#`{ut<#_)F%bxz-_=S7Ztfj%N zUg=(lXXuSD!`!0hV;n;`A3q9A4Krf_-5z|U-FoDecH^*{2MIX*Vb|wZ)#?I>(^R$J zU0|PY-s%E~9rOL|0s@{wn==ND48&<{_p=LR`Npj-fY>qK-(i>I+qQC!IF0Ro=RDUp zZ{-}ZW4^yRkNUQ)VTU-4?SAGw&o^%69I<2k-!kmZ>Bcelgg@pwOYif?)_pj(o`ZMu zX>9oyT!(+Pn(x=oYInqT{VZRq{SW18l}*3JzB{WQAhzA%O;|tI+e>`gRzEM_4&S!bCWzD6?q{29 z@Qqt-g4i~0wTb_b;DDDSIXB2hd!Gzl@nleGeEugN1ny5=v-}W7fEpck z%kS~sSuKy)c6S&p-{;%5S{`v4+x=|$eZFz49j1 z=R17kR?ZPS#`~M|oxW`==ZMqTR@2piF0MF+^!e4cx&van+R}EvyTd-;ywx2LJLdb_9R#e0rnzB2oW^!P zyF-?5-0BX99pn8Sf;qlzE9Z#Q*zR}EbA9tx&JjE2`!=p2;NLCKj+$LZs1oF8x9dnE*U?(Ag6*#zb-0dDg*$>=^nwp42#*9y zcg8nfxaZlYx>hx{w9Sd;O{$qPC%UY?sk6! z`(NFXOtgVdKZN$?=6-}=`ad_(QkSTzhYG6Nwn9GITIw2CM_bzxEp52d+*H@t7LC0RBw$AvOd|kx~&$QNoTp3{y1ljhvzUM=JS6`OV5xz;JY}Y%4s|0 z3r;_yY+)%D5$1kMZ-^+4jKN>v%1!gKiu1~`l=WQ+7Br)M7}@)!P8yk2mX&kLXgPfA zSPr#(e`B5>kh}k1ygXi3Ng;?s*{_I~R?MRkhq6C!VR>9TIF$V*i%QSb`iHWw^R4^X zK;2glmRD$7t3Mx1{~+=OV9fl-`^$p)m5Y}wT?AfH?@;z_dxusgW!I`3ud9rK+vmqA zTZiI1m47^y2pGred!QF|tmg*x-CR@El3XR{g=kHpEfKw}uD(86m5jo4ToYZ@($o-L zRR>ck+HR_^5v46HO)b%;=42yIbTAi4@igKmMO%}XwkI2_lW;C+LNl%HFpD=gwI*w# zHBHgRrnYE9qOH0X|GduOm01h+>Kc-bZHaoA&Rg26+uB=_;AwSTV{0_g264C6)wCzk z{^ItADmaC}%u3J=Y7Xi}^JG2!k{G%^m;#ZiI%7hx&XBHT3sy1Z9(1rmd5NiYg;R}> zDMDa*(;oMAs4=FqotKz$NU@SeWbw3$vPGrxPq@+X{3VMkmM&QcbC#0FOXn>p#lIa+$IDJ% zTDIU!I7!m+8E2H0E?kh3&yUY5Ta59MeDSskQEkWNUSO`!pE5XlDUbVDYlDC5xpOBx=LITNQ`1>MZzH z`ynwFj=UwHzx8aT419f3O$#LVV04|5ktdX9o!n!wY63n9y10b zZ)}!^Q-OFHgGWgHHdl}fg4M~U23Il;O~IwQE13uqoiNMG6c98t)fc!$rmG_9tjz=w z+#aO~dM-#>n%WX>aM@VTwx$-hQ1&P#sYxRm3!+s`?Jaf57AL~&NgzztrwJqbM37() zPGhkEMb*t|B*h@9u1d73MmDpQeHs>OgUJG$-;@l&TETfWO_qinsYFffX^LS>$pB-n z$>Tv*)znzyN~U6|>gpyp7efle-o-5qt!^2p)y2*AO->9VG7@56)tG32v1HUKV;D3C z#Eb%QlGTU3jA6$>1dU2|DwjcXKo^tcmT=igVGnzm6t3h#=uVhiDQw|FOg-jTO0Q$m z;ZOz0zLed@WuwD5YVqb(%DcJzIEWYKwz{?AF(w)X*=&ZC{SV{APk>0PTku+}rmjW2 z!o(vW8reM3-v>-Od#X2r8QgUheCMG;8Df*Cxa^E`^x_W0umGc%F+Vr%bnrH@GyW zq|njCCrmcR2ntSx4Rwum4RHBTBf^vI790a(10!gZC%;OxHG!+Z07eyRc)1 zcXB!O6gXW<*~46RteTvpa61>mECQ!YDSL&>aH^!a`#oDGBB7xX53W?K(~FlI@tW)8 zHIq62c}GXQn#&UDBonYeb5p%rW->|&U4A0jN+T)&QF3)bOQOatHYef%F95kKJ3ZpT z#Vw3}E)tOeLo+;Bn6zpc&drcrBOyMwladi0m*F+n)`?8`eUh1g@Ua;l4kIy)3npiH zO$`v!ST2|feyd=4VKNhB49xJVn_Ao25>=vr%Z6pZS*TIUPT{hnRJj5y80SKW4+~1+ zGA7Ift83R{v5UB5bcT2NEv?j|1)Y)eYiZE;tU&)QG=xJ{jx)55oe3*}c6JK_9NVb2y(4`oNFjyb$!0 z^)tl@Tu>|pg<=*HM5czkNV&Y;6ic}1co4yJ4sjtDKw9L@sJMhnVkk-0i#1#@Qx$1x;@vYNbPBquS20|} z%7wF}5Tm$(i!ci?!(**(<1(l*-Y_YnKjhL0N{Uvua@iD+CE8l6E8W|YFxF1W+`Fyt zY$;3Drzsb~O28wp`bxK4B!_G^rz?1rFHBSNSP-_RxhIT3Z^p{=Op8bkq^zo`=5lLn z4S}(hY;F~gvrG&bE7uAd65@F-0nf0C(2%IB6T7+Wgpk+LnlIkrd|Jq>hWYFh&Y_zF zZx;KxV3rc(i-9NDqjCsz7?@zh2*!^%g2Kud$8Zs}07MM&PUezP5N}Jqh;a_72YfQe zkd&7Eq=<7KMP4J$;d~-+Xrn65^DybnqKR{y59*tnXNoJi1m^>g6pBtRfyo6Luo9d6 zRxT?6|0uYN35G&OuuxM=-DU{B-Z7<_U=#hy_n)y{o#*sL`UII&J&+!8JAi!(JeDN|DLBFVh8LPTBQP zGvQ{uUdo1ZSz)FJ&w;_ycrKYuvE_@YTvU>YJvd*?WP(tZ6hPKXY>9}B)>W-cRKXo! zTb+GTI|Qptbw0~3n{fnKO{hwr&qPB(RHbU&z(hG9s;-t*yOxQDfvBcNioVN4!$Fix zO3_c5XatB>t&*Z=m}nG;R;x6=&P3TD!lgb~FBSh_vcZrOdCdhfcA=Cpcr?kd<2b@- zO6Z=F2cM9V7P@7NKnmBPt6`nQu{#%JHBIgC7K0Je8AIAE4awWOb_x8Pa0ss&S|~~H}g2ZXcipWG+nKf`zZPg__O4hzcc8~LT`*=eKcz7>u*WWvGfLyMG z!Bk_H$nYi&@Zj~DdYI;}vPB}2sf^(SZG{jSIRI8haSiuYyGTZ4%mD8)DS3cNGSF5t zyz|ord3J|T1{74%rj{C5kN-6bO(UP-SBi%s<1K%!7dN5t7rBypc+f&n0+2 zm4(YW@EqQ*MNyX5CZfziXeKC&7^lTqkiVuHaXJ^A0_tsInT_%M3Ou<=J+Qakj)COi zy=IMFCc^_kBfLJqD*$I+6yVsZOe-!-iIbPQrB47cjDU1yMP%^MfpBVp8xMQB$;=(- zT?SJcpHni&O7336WKIA9bn`StCSwtJYB%qH5^2EhH)j>?8&;-wQa4Ug>}y?XvbDK z$KqwQV=<~^F*n34XyWSjwx(69D$_PV7SygLS>KjkIuL5nlAm5S2)Zt;ExIS1K_drx zjW`WLxdwMQ4H^$N;gN8nK3UnIp9>rF58faS#AitOY!K>ejozH2rAW@fSK1lE*>aHA zTGdilvpQ)N3gr&+l2vZ!3ymG*!Rts)Iz!Px-l{a*1N)6>roQ2b)9@pKuWCuUrvnch z*FlL}c?}}q0WKyku`3;#2yxanSBWjQenw~t1lrV64GTB-Fp&p!sKYW3a>1lQ-o+?* zoC{8Xa8bZ667WPhNSy~-?@d>-fJ+B&4vEuV zI)sJ}_G*&}IFVY-?2R1kwaIm#9d_056qM~%H@3CdSEycYwpRt~o^3q#j1cI<;zgR? z32UMtYOHCdS162*n-PXm>ZBw7U`LPDlL$E}ma1B7+oIa!v)lZw4=G5dfn$fcH0TuxQD` z0-G$Wn8yl%m9oXQQYkmQv=quMWd+OOUEZ?g5Do=gzNA8gDYRwtm(Hu0A74-g@4M-6 zm(7P)x@TT^C!rXc^N$zZi7NG=>7{NrCyx;O*+u=PmwPb{l$~2z z>69`PfbWpoSz5Y;0jQ>}0bqemPG7Q^5yEZl^oF(f<#+ zd-EWFtQ=JL&=m9-%z_uI^@!Y=_hr4nT^bH$HL4GIfL?vI)Imtaqa+7C(3S9O@XZXf zKK#f~>(6dFlYZ!jSluACR2KTbcc5G!Zbtojr3^qbS_i4Bgv|)j9jNw66-ezt)22TV z>FiKc2TV~U%ftVtbkwnlGP6ARKUe(nlq|ZY(+E^bM)_f;+k;}M?~^@}^C%YlPR_Ym$}ia=i=Q zTQ}dshBvy!x31s#WaOS>>1}y9`>8kSy|>&);}5fV2tr{edtHm z{O!5$4IUwU_dfK@|6cQCUI6lrdI&|KF$&sz{`flvAI;(~Dxg}&p3ul7P;$Iq#u<>8PQ8W;|H zd7-moY13~G$~e&`hVDhk~;0KQhP zprhYq;!)@)sFLP$By^&9e9;Q<7xL!yhPqL2_{4(E$A_Y@8?Tq5u$Lctz=PwPLxbTn zlpS8DBAhpOZvE!G(Cz3Xeql|A-Ys977y5i4!q9Iq>M!y_pQ6r%d7($pLuhC?18Vw& zRN0jmx=R`;M`6S(HWCOu5If;8@93-%gTq;qvT`z^hfecO9z1*SoWaq-1%oGNhqH#k zPXkWNhBy6-gc1~hZrO;?AR!`SNOvyiA;{o5STJ*<7(Dn?C?sIGc>@QR!5>@9njnrH zGJOa%=Wv1c1`me+yfp1*K--RlfB4%=2yksq_JFJ|{80vM^q&S-2k@!?Tj7xi9Asza zTpx;nC2?&=WHG2hlgrJ~!OD(yKq}ULJmOQ7LHg!2cBjEy|lyg8FGjrI-fm)bPVLv8-b0!m^6; zdGo(gSy(J!nWplx7FeCAgkL#S*28*}ECRyV?1Z*|qCpMqIpS{1BPVH~hJp{&FDF1+QB zQQ_iVrKMkJ9>r!`M>AAoz{0V7Wm@L1s=W@^y^ZK%F@eh!7ArCpEEff)BxbcXHO55$ zC%@D3r={0e9w^cGw}A?$FZ{|x$T&XOXiijLBK3^Q%$(tnS)9x$=456*Co_s1;#iIq zq(L)zxmbY{K&-%tAXYHjDOl)46)TLnS_K@EGN2IPLs`Y;+^GWYnD@kSxyaNF{fB8=9G)Y z+=2y8ZDR#ab&DOPVpqpWNwJfXVkafVPD+ZMloUI4D|V_@?9^g>JqI-Fy|f z`6_brRpeHv$c?_pjlRf@zQ~Qf$c?_pjlRf@euf+U3^)22ZuB$U=-o43%$@FI?tC9} zPq{Jo91xq~X2LyB#oQBB%spGj+>=+#J%h*G6I#qYqs3;rxp&W3G53TOqcfIq?GbZN zQZe@|6?0EhG50(bb5B$;_e>RYPgODZTop@mvT{!+G535DD|UO1dq#=5r<9m`PKmiE zm6&^0iMgkhn0sD{xhIyGduEBbr%U^-zp}?wJf#t8j_F&bh(DGMk)uGVxP-uB5 zv^*4AH7c|`6j>gMtQr+rH7c^a7g^qmEbm2@_ae)CkyYCwE0!5nEHkWFW>~SzC=~GP zLHgYt?9p!{Q@_QNzb%tLy;85@!>zG;&l=xYO~CsH^4oZ2*MG$`^?s!PE+V}CC~rUM z)jar8FV*R{zVsVT=1U#^iyHL41ODDvzhIycy)~ep^yBkVc=+l+<(vk8+$A~f%*E%N z1n*{5UjjGI$*T6%@ZR96CcO`Kl6pT;1yA4C=%ZCF_-uhI`tq-{fcyo<$I|f^ zhMo5eJ0t0@hv;@+N%cR9@jNPj4skp*?R?ANZ-PvZFZ?eI;D+|`pWa?K^m{dg?+*-p z%)>(R`35(}*e+qbne5ybVCMv*~u?jL7KGqe9x8Qjcg8?&$Dznt+N^7~8T-0w?Fzk>|zW_$C z9{>4owuE2f1RQKKIrT5a-G4={@=y8zTUW%aXo+DVQ|dzb$Rds+Yb%? zIvkI@LSoU)csB6|3~t(anDGr{e+T2*?@q?G{vQpF@o2yJ^b0pkm+5x|ah*@81RuGK zXVJVrA;3<;;O{|so&QFIn|{Ae9KUdi>VSW^eS`5F^4k?)XQ#p6gYw$%s|LqBc3>z`M}Wsz~E*)p9OIFcb}m=<`eDf zew$4foV?!-H@K-k*5Ib!IB}hSa3QxvjOSDSZ#C?gdHw~{?;tymGG0t}GT<39ZoHq2 zBhKSFj`0$*vpT@eHB7%ldK2P$#^Yq?xd1ya8{C{H|H|x;dC|vsIoba#z|PzwR7swP zGJ~6bR}$Cx(e+9)zMT9v2H5$T!OeDjj@i-m`Yq!t$^M9;>El0%IFGY{@mjL8Ccw@Q z3~uJ(QQ|mku%GwRed{v;e6L~0?Em`4mXD)My5U7`j-wFogB-QySoJL)i7oq4kSW;ynI~n7)p`n(?t@=k5SIPcVHQ&(n=wA#Tu{2Bh~`$Kd95&I*H@b}lBa`wxX9ni$`Wfx)&Wz|PMN z{vPP*_#Zd8>G!wHeg_(dZ5QLcP*!k4prr&=V+{|;vF{%6@*Zt&3#`XHlIN~_&P+#A7 zPd4<;dKDP@SVp&dnW6uI!K(~z+NllTjRyY{*wJyWVO-a%!{BIN-;X~*9NV34^$Y=>GYV!Oi>Vfl*L`4f7`Zp*(`V6jeK# zzvijqCB!lR@4-LaF15t9eh0{KYlzA(-+nLId4M>#^EA^}rGg}dJOs=f7bT4AetQ<lxob^U|*kJMV!V-JjoJ`W+y{?QO=p$j+pRN{;n1?VL=U$5X=i zX0mflfSt`uzeBkb-)DRa*?B#{&R(WZX2fTVcaxntlavOp*D~U|UOJxTjNeCgz8hfY zr%YeR^C08;dG_A|>|`IWO7eJyG5#RMvy?cm*VV+aKb!q_gTc*y{(xb}?1wJ}@VANU zICXvBWqcdOiGMI3H;mJ?Uocr>XZ`#%gPZ!xh-<$cs<>Frcn|qa1lYOL;O~JAJzjpn z?2vi!DC0ZG{=Wk3jHGoJ9_LYv?<70t6X)&N%=C3U?TqgxI}Zog!N25;8;@rfpfOr#a7168t-@*qN%)@QO2ZK#>{@D`1?+>tpe}xn`w1f8hF2^IdcOb6g zS5%0^x?0 z)9*{n4w)Cb880XMM@>^2ydCq2>-^|AXE0ttcGd*gxz^xj9&ToKbe!L1d^y?wVSt^t z3~uJ(BZHfM!_$=~Uau_1Ysl{~;=J9@Hn{0`HM67ZRnK@c*}p%)&eKd^=l@y8uOvHz z@|7pvj-w53=3zQa=HZzQhstn+XatD>i&RZy^BGBX9Q z>}1VU5%741Fus-ISxlUdqa@SU@m$RKgJkF406VV{*W*sFZ@d%0L$g%;T3=s}O(TwR z_Q5}WJ+p#1uWy3!Z4~DZ4Lk1{c7Db5J3xk8595!L9r!~da^ra$O`OLwmhm34b76p; zHm2X9+=f12$4GQiGGrcY+X?-}1gc8;8_GB zrG@BXyqE0!F2K$nrmy4qfbsXq&a^qo6R+1-i1Yr|z_>nNbQ8z==IG$z`%%Mwufd-; z^f8ou6wk{B9{{|T$_zeP?O>dLhJU)B4>LI4@91^EmNDIG4%HscFr>NhXL2y zg$BnEvoe*WEx^td1~=CyZ(w%tPwwD$m!WUQ^K(OgxKfp$zcx6=lS_8~6kz9n4UX~X z_0PXCJ5jQeJy$uyJe%>1C64(Vp;YAObc16&d1U8|06Qd>_kAxKb~})a9nYFYLQ|JC*SgbOhVAjCWk1xc?f^n0mVzl7pxW%>(<>)&l@{W$S^ znf^lJ&oEw2T)&5-qCR#>Y|}e#dx}_~(pIBtD+rRc&NWcIj8=13g^_W=W$N?YUiBd*l6&*Dg^m? zX8`{d<78g^o^jnDK44t8dlvOytS|bFO0V#HaK?2zmN2f*cNZ|O&uf<&{BL9%zrGp3 zf5><_b=+SuzJ&tX#dzObcN3q+csKDg z8NZMCN`t?uLYJRc2JqV%*X{T)XI#JU6leSfvQxu&7xAkZ-&UaNyP5H3_=j7UDx_5y7t)@yU$$5}(hwxKP<&!Fb6y$(1=`Gb1@TRc zFDHI4<12_i%lJy-?=W6N+#7AztCsk9#_NgCHuyhPQTbUO!0Q?BrZU$tUarz3e!#dM z7mqMrPS>?BGQM+ya`0Ei*B+~QCSBO0yU!^W{5mFp7c;KMdj;ckIup%|)1l~OJW9Ur zGWZw7@T(_)zs9(}FaCmY9p@OjUc>sLeY&g@vl-X%pUXH6bJ1k*e_?>MZ4BUd8T|jW zGJHQ4z;`oFr#113!S@?>29Hq(STB=LV*Euavw-otu^?<<%CHTJ$}c%(pni@z6cZTF zB|e*R>h@w8<8&x4VO+15UTbjq-|!G>`(6NlnDH%2UHq1D-R^rB@1h)e6I4MwM8Cbn z#~D0>7-|*=@N*5GY3R2F@NYA&&+qpbe1Ku+sQ~_}!QW6-k)L}5_)xk&Ler?P+x-N_ z_4Pw3vp`G@hJIy+~5O^cwP?Rdfr9V2-(1|&X79LTtDB}{RNlrUs5XaGfMkf zUyFixe!lJjTC?BZm6{o}9p*+VbfVSXWtdU0xrr zfgLQ*W9T|ZY3N5ZT0g3H==&k~#`0mtw^l09!+4Y(pALnw`|$G3E0tmoEotgvQN2Uo zuftL&trl1kUEYFlfU%m}hftm~lU-&1UI75#gbt%8M z*zO(Okpbne`?e~${2=8gP|u7X*+aT^d0566BUe&*Y#wObDOCC*bh~q z?wRTv%VCUqs?q)bjDYgVS5sQSk8*iU%*uLhKF|4fz3S6?#kSeBQs4JiMkH05!+ W;pMLgDF1sZuj`5Nwg11*OCSiE@S+AqjR+bQA?Jjbpr`>7JyBjFFJ4qM2}vN)K++^Y@S@T} zS};JVg*Nr7rB|)g(w4SrqqQ0<7HqYRt+i-rn^xKerM;=5OYw9DB{o-a;|Vf{6Tx|`Dv0CC|=+UbB1UZ z=3BImI)6H5QpXt#AmX#%aK)2(@P2119_EkU>r%x%w>^HF;!*E2ziCuFjX!#?55T(+ zc$$rl!Nz+&0q>EI5&Vb5bBMFz--zcDXU_&fkx*x%(8(b_OYq6WO9U?@zCiGMiRTNx zi+F-KNAL;a(}ex=#0!XXxjKn2BAyQA#O)WvdrxvdGw&g;DjJfQ4+956Q1iT%(3>&D z%jk0#?2p?N;sxY5?^#T|Q1BaxCj`GuaW0MH9ChWLjf!(^JI*}f_YyCo&$rU+ZsJ|^ zxsqO=VSDm>8Szfy`-!s$zafrs#chE5;v6M@K=1)jaBM#u7q-tL-Yx7eB98Td+d%il znMS-<@HxaC$R9V>FC(5VcmwfF!8Z`k68tm7vx&1myNKrq`=^NK3jPxDe8GQ7oZAWe z-$R_+1IIrMRgUp25&n!IzDV%%iI)kUPrO?2Ylznq=X`G_-b@_aQ(HapwZz%~j}hM> z_;%u(iE})^NPN4nZzq1A;NK_ykkC0u9NRl?@KJ4V5#J;1KOo*N_$g3ujB^KZE>|}3 z{es7dcM|8g6%s!{oa1&q@q>a_6YmoIcH)Nw-%PxlIDAyw1H^lT{T||YyyC|8-zEM5 zajutFiATwC=D#C8ggEQ;5+5P>Nf1Dc=P2Uz;*27mE%0PKkItQ0(p zcr9@*@5RKM1iym#TA_0t@eP7k65mXmUYym$w+VhX@$G`&PrOa=J;d)5{CVO#1%HkB zLxLYBj{US=j~@`cBZ+qlK92Yi;@m%9NxVn!dBl$j zUPZiD@Mhv45QpkkTPyJ>Wyt&i;zI=gI&mCVabx?v#77aQY@DAF&ldbG;$sB=ka&*Z znJ^#4b~sM(^N8mPKAHGL!HbFGIFB3qxtRDg!Rv?@2>vnRg@W%Oo)CN&@mYd@n|O)f zKP0|D@Lv;OB=}L{iv=GD^Lvb2nc!y-uN3?e;?;uV`2*_I3O=7W&Uf^9E+yV1_!{EP zf^R0imN>mQpC`Uf@NW>`AovT!Hwu1$_-5i|CivfpZx?(hoEl>s+5{g%{64{_ z5Z@{IHN+nh{AS|21g|H)Tk!S7_Xz$O;*SabCF1RZKTZ5;!GA=&L-5}a-z)fg#Pdj}o6o9EMS~eTO)nAK=EkllUy+^y0ipd;tND!~4V+2|g&pjoV_u zM-eX*d;;-G!DkT1^Ag#oc!uba#rr>uI$MaF#xc%HuJX`QR#K#E!Jnwd^GWC#JN38B97uF7b7O4}c5wIG@=p_(HlHflhUIz0!-16NQ=Xb0_ zoX4H_Scf>hIMESq+;Cor8}s4B4+%b+c#q&Q;vWcJKs+7hQ@Z|K;v)pVg?Jn3u>Z@6 z?-crLiSHJ?m3X`0j}T86`cDzh6#Ql4+2kkQ@4@XL@oB{Avb8hdR5zYkLT9An5r?nS zcF_)T;stczmbmiHHN@q7zMQz6&#xga=kwbXht8AoYa{({Dh}7}sa;hP{~qx&nm{ch z{yOpf#Hl-Wju7t@{21{Af)6{*jZc^0V~KYQo=?0-@N0?p3VsW5o^Y|BA0eJj4T|{& z;+cYfmUx!nj}p%o{5!;R1n(rCOPt(w-Xxwc`1`~QgwCMT-MHcPC*0WoQN&Ax&IIC% z1fM~?Oz12mUM+Yv@p_^2@5Gx0-%5NPae8sSKzyU%j}hNSoXfS3c$?sF5Z@{IABgWF z&T)3K+_>!#d^quTp>sa*4#B4q-!J$q;+=w*5IUO>twLw}=O3 z8_#CqT;8F?*AeIAE_c-bb8Et-l^vsBVH(Y0r3*S=MrBm_$|b% z1z%3QN$|DA*AeIPwi4e+oXdMJ@oj>CiFh0Fe7AT`J8`@|iW}?fBYuE5Rgd!;@owT= zFTW*zlsLD~qr{^G_;`t&e=hM{VV_I9K-gbNe3r1ELwvEYe+_uV z>n+?^;NRaV&PPL%zoR(UMw0(saT@HB*cpZ&-@7NsGXy{Mglj)b@G=)W3*mK`LyKzQeeNx80>0R#a-1~*{O$n0JAm&6j`==w zJG_DI<8*>?5Z?Rc`&Ixy9g6K|KQDma6u>_cz}E-x2!ss%=Xh;}@eH@UaGgr8$CpOC z{AIxlTob1k`a%GIJAnTsfIDz~!%zQaIPP@+%jgiS61@Hzx6Q01 z&RW!*ox22w(=oMe6gu0gT)s{4f}gwkZGt9>iG9>LS-#HO3u5?fl@KR9+Qv1wmkM>k6DE82qo3QSA;Gs`QUY(=)#ptudvKR6%AytO2W*}UAKS1#8{U0eecbXm?((d9zv+&hAfMQ@ za@VHU5}UrC*z|g$wP;uIrVe=7S-j~v%6L=Jk=CLkn~J(yi@MkM9?RGegDVZ~=u1n- z%1c$wPodtkX-;NlV$=5$n|9><_1H07C+a+jqgbM~1px?8e-d{iU6!~ev3_q)QYNu4 zItGjMY}Av>MLC?;KZ$=p4uO)xJV*{yGBuS=`<_t_;GgMg?IYQ>bTnl`Li4JJD+2CLHaZ^h@>~tc>KKR*;`L(J&p!>>zw@6w#GB)4> zjn<+)K+o)V6HCZCLZE`0m2~*T>!?K55dtN5Mp8~4k;bUd4I##c!u8Rk>I06NO)b5B zRSoXv9Z)bFa3x?z5ZKo*l0`0Kw%~4FPfiEsv7+AAqF(SdW9x*!i#_l(;I+ITb2pV7O`vz%)Y6g6 zfX^y;ROhn_G@-MK?>IQbqT=J}@J?%3_z@ZwR1%tKWp&$D#wTxsmUehJ{K4Y3x-&nR zZ6vej@+qX8hN)lD>m0Du2fkc;Pc)H{F@k4?f?EIKspJ&Izaa5kR|Mn#PDbX2POOY~ zGKRKvW1-!_g`HGLIH^^_@30#6J zVl#vO1wY@DH-eAYl20}G1)jDMe8fK5DR$fmPuvJRVoSW;f5d4I8gWWIZ6oH0eYDs2 zj_?_AlHxd5)<&E~p12Wl#Fluf5ij$!jff-m(M~bq)tku7B>xo~7bMM0s9y#HOxdYuC&*=Oog&T3QiSghIUMzV~1~sT;MY*;5qdi_aj>2$1CCE zv7&Y^xPR;lWb6>A!uD%Iosh9Zpyc|TQ0Ib`KB3Ns&oo-w*EG;rn^2dbtv2t$&yXWU zEjgi1wU4L<9iKrFv2`@GCsOPq>OFCzk3ejRr`ks}d)h`Hf!Ieo#Xe%4CvNl+h=usR zmJ)z8ordnge>%MgY>au?mMyrOoHT0vN38GZ^x;G|?4F!c!`pngPK&oP`E;!SuiLtF z!Jrv7?!q(dZoJHo)5XVo;GNde@FTP|I0DfmS$uaIk9+A8&MjLy5Q!-&+NwUJRsF?_ z8;|WPQeUTUEqZKyZ#ZM~^>FV4#{Q%JW8Bf8F)jf`(AzIfOc5tt#coV#2c6+3<;A45 z#FIA~0%BX9&MwyXo|@6J3hw&SQQ2B_^w|DHMF*Db-^_lwb@tI?FD5Ep3@Y6sFMGF< zqZ3dOh|TQ1JltvP@v;%8y=7iD#&L?+%m#v(>Tz1_X&c8WVjt}kkJEZj+^8PJrZ~o@ zBe)Kp>!S{uy*!LMKpc=qU>z9Qh&ov3Wn%IQ{d15O*c-Kbxfr#8I4Bpl8jhQhsD}wXP(az~`09L)S|9M^JW_4coPR63=;L4m@nDtJ^4c>b{MX=jWSMYB5 zKJJ)2FNN4xpn>qW+BF^J8`DD9M6 zjPp01dKoPSu_d2si%IvijTVF0M?1w9lj(^YEe5eAp6XGW3Y6bNF#!X zWg*=h0#>`2nTS)80xuIIl8AjX@y<$4%Gi(rXC=qntovKW9`Ev*QAWhR+0$Ls;{;Na zvDeGQC?jIuOpFyhy;z5C%_iqMH;K893US}lorD)?<4{IyI$`AHcB3bfofv>iyzGoa z8?l*PKPEkkJZ+=W5c_DScxab-;zng5HpMwkA12(B;ea4Pa^MuS+RMwR6U2Sw)n}a; z*@-%-_p&qU1hJW2KkB5}(>Ce^v5$6&b+XPAH|hkjDb97G&Iz;$N-G^8Dmwn%uQxfu z8O+d@{czpKRr9WP+~{}E^?AW#qvy9#zli<(c5`y8_XIK%wY$yB%&1+&W@i1U-8N6# zs9nT9+9}rVPEXvZUBptnpCj2WF9)L@5c}ug*1>Ulc@h6TUM5ET5z9Kl;5;ai5p0-gZh<&tEtdm?%+^7@8mbh_pP6wS^2`75geGLu) zK1qKXPtrdNAbFsr+FJ8H=Z(l9ww&*UJJ>0$t1R%ujmRK2#c8DPbA)iOGzKhHPIx&P zZ545FPJN6JW@e(LmUx*NEfukuSwC9pB2U|>55zv&Db`1sCvMaSVq4t3?S1UKiHaX5 zwv3pUcG+i@4X;*Puz$UVi~EF54kK)+o)p1KH4c(akeLJIF8sy++A?aonhvXpJL^_laaih z(~lOM<9T2d53!F2DHbo+6E}*7*hk#=Zdq~(v^Yh}_p}Yi5&LMT=y-uAZa9wE7S{$S zzC5rPZw$i7HI%=qk#e(3cpezVLu`AH>NKgu6E}*7*cAVVr%8*voZMnyez+p4&z$<` z>HC}}m3f)D#iGm*o5kwKaZ>GR8})(MM?1ylR_}=$^?}$HKjCSTwmk7#uWR2_w0B>T z`r)b8qP?&nck6?&2vJ*^sFn$KLdM5gi-;z?7I7DhNbXw1J@8Iji-;fHwTNh<6@|a; z^Ia(K;alMk)JXE%K3&P|`HM6PiB*cYkN@(+z%Lj!gR;-^L&TbQ;(IYI=--KdFUHHl zsLOR$7KbkZ1ODD>CR7l7p{OTOF=7Yy>WMAe=c(6CJF+loQ%g3!m`gX+PBJLEiAwXn z(?x^#;m=aM&2#UMJhB)=^ z@Z??pNglB!pX#NM{hqc_8HjzfVNA)`T8KfCeNl3bggRRAJG~5y;3GCOID7;y2ph+z z-Mm_7_e9j`Kp$7|4tN>5C8B5{HZwHxaw|o&X5Z{Y<#c)38I^?anYteoj)bR7`m zv5$6&)3!`c+^9jsmUyc7BeFbgBld`Ww1c{}o+9}@yD)8ium?O62Q;m7T(>7v`*hf3Xn3s6sM$8eL z;$A^`5vle|M9XB>uT3|*%(DZY-XdX*!RLx zvTGDY*yw2+%?GiMcFN6Xn9`y*hf3X=CjiiH)4+15*NoZom+Cd zf)lQnK{iyORPur++#6H?7 zR(ZB3ZXAY)P4Rz1o#c3V83jSyM_&D|lUy%5qiBfx$gY3QE#J$_Xl{u6$gAH)EAX;2 znj2y>yM8pcgr{xP5@H|i6q{R#CvMaUVpH5`ZdwoHU2)e9j9HnUU|y@ICC=LHtnGcs zn7+mJ63))n0U&{nO+}sFrKwK5G&KPNl3YfR>O^3XS9GI^AU2B*bq32c@v29k-`5kD zMan#Rqe&pPKS*d&-jUG^2^U=LmkU6MN!aK(Qy9`0Tk;?77R{6HR>f>=1kIxA#O7 zpFQ#Jyk1UhIKo>r@!7LW?AdMai6%aK_J}=u?LE;%?s<3|97bltC;>CQVJu221vOIK zg&Rhh*D$KhhJhd5hJhwV!>EV-^?)@ev*d<>CenHEdz;v^&E6ADeD>TU_H4KJL=(9u zwO#&E2zQ{}RCK_713v*!bg&gZsVBc3`!4h$o9AH%QBiczf3d{DpszM_nq#^8$%Xit!mu07zg=DutkSjiw@%RsJatdpg>y|cDv!B2dlx!Pf

fj@Y_4-o{9oa7VfAcws7^IlB;wgANg z7DF7w)&YZ)`hq<~555Q>mXBZn_bbDM`!x>h!t6nF2^KaA?HLxC;GaG6wjeeu)yu8(Y_Rj{Yw`e~U&RvfOnd61RtvTR5zVG<^rlQU05j3oA%Ck*H+aXMw zp@D6KFhQtp-tL7e`B;1qY{6?SYM1^6tR8mv2^eDklF%3QQw&(MmyHoH#Qxbpz*Nz^ zm>t7zjPA(svT@^tf8pRnY-R&}UYCD=3M-cU*WToM z+HMi3KSk`L?SBH06gMZPJMukoqk<8e;{QNfE%5R%>Hu*-9)WdWEISZ&knplG>Hx8s zO+V_O#M3tF0I`pDigmEa6F2Grv5&a#U8!XKijK9+(>5GO?4zBc2eBrRmi>?f69V^T;X(5kI5f#zv`amR4xH)vj75m;QU?C~M(~8slQ)8x z?kkTG!D4uAL<_@9DndA!Y3Xz$f&_v~5!rIT!aTJx$LoAFO+7Z5p7TZnL;TN(O_nEb z#0Ie~kFmjGc(H+@n9lg;;%e@SqC@^e)1jcDDcj55C>>%e`$O<;gHwGjswKt663`q^ z+$bAjA)cIU^SWsK#yzZyKBTRO#_z@B&lurL-&ZbhXP$d+!)nJC@pv1&OHRLA@S{5e zN0X#O(B3w+;9@+=glFIianqt>PIZTyT3*FG)M36uy;WA)VOap_SaeN~@KA8>iJG>tT1`tu_FPH-FlQ+|$MYK4|3w23{eO4$)6_>ZGwdj4SrrW9t*{ay~ zGCuhhs@?;Cur-1*e`{%IOQx-)kWhksR9A>a%CdJ+NbKST>U?O$hkpo}_gSQDTUDVT z)mBu^gFk($=GdwV3Dv_7gOGKRG}(8G;Xl_qhG4hkZ{{IRHd&Cv=O!O?yXK6oKgISX z7Yiq|5a(3+UKS9zWEP0cEDqn%x2|x#z|%EcM{MfquGjaSg>XILWns9E*v#T^mY;62 z=Mt`$c)Et`h)rE=t{(Fr z^__)?d9{~?;W}b7i^Hq?))lT}&HGG35SzNX>$moug>b#u%ffISv6;o;VW7(=z8mqx zH}6mIHIgWFzR4l?eYm>jp8dklB*DSYr@!ihIs<;Sf7jpEd2Sk&h}d*983~_ZIq-Pj z=*b&VKy1q==d`M+`<}Z59!A@|oQ#4XwsJ~&cG2dE8^u5@#O>JyKJrM+F7Qc3FuTBK z3LR&5fjjf;VkdU`*uy`*3*Kq73;gKLF3=?DkeXd|f{$YSS4a#MG`rY~dAPF+^;TJF zvx@|zeyjR!~U!EhiR{w8$&eGYG3wyHuws`aRv1%LWf?Y31F5~_44 z?!dzgkH$yf@I1T<#813u+zC1PbT5dLwIc`8w=ndGU)`f!U z*H-sHY+pT=6GFLc`XW0POcGGk)i z=0%@D-oDM-17q_DpWD1iS@YMD%-g&qYv1PW#T9>Qd^ZhwlTZ9yfM3R<&wsx zhME=2vKyPq8=CMf_bM4SuTVqhf zpL6Mweh2x_e#}ID?Z2MyppfeWYw#;`)<7#=1K;P;zRFLL9#m%LtUD;=))nW=uQIQH z_UA$n)c|F1uD{mXa+@p(n_;b?Lke$5}?wyVC{Oq__4DKKA0(C4lzi{=zM3yS7x^B(AT z5_!(t>}+Qa{GXW(e_+D~bM>qnoar-*)c@=`4ONYoW;?|zVD`GAyf(X{uC4(lxiFb+ z%&sV}tyozLZ!5ExHqJb*m5<9?nm;~o+@xmr&4tHHD<4-g35+;SIrKS4$z14o zuckiA$~;{r_bbnHdEje)E*j*NyRS3n&YnGY&iFagXBW-KJm~Y)MRUFP#d8FMhlw!R&YC-O`YcQ! zS6{R*YNN-=i}J{s;O5oeo^g#fd{yF`;LM4IHDkjrFKdiKPTXwpS>SLThu|nU`R|^oAbqer9L2U!?IotxnO== z_5_qB`97+>Px=&v{n&=%hvj9TF&*>8b>Vn%AXQt~MQvY!=`zL+A{?5~SW#WoP`<2u z!pg>~hQ8EmO`5QJ&8_9PSJtgwQ@U^tObM*dH_nGs;-U$S4Hc!;6{Sm>FR5I) zeEFJ7YF0ouTIHMq7dR^GE0>I4s>X`ioOu^!Uj-Ls8sLJ;%(~_EHMMZIe^pI0j0W?{ zS1hY)oL2=SN6jj_)DjL23qj~eL^-Pe2}M3PFchk3tgczwR0_E`gCJPpRSP0jgF~Up zid&u2;d5lw{xy+#CxIO$H$@7@g+jN|r{>7C3`lEQqdrGg?fOV$90DauHU*Kh&IVND zDnwSb-xV1-0sxE^WKka(30Wd2t*fmhsdY_}Vd&qIs%1p>+!Yx*JQQkNv%IRQfxK&9 z6Ui6~tfHc>!5Iw>55k&OTjUhTrJ}r{(wSiLlShR@nE5n;PY;F4o9dQ33BfVXs*gAe z1)d%bHP$R!QJzb#>{$^Vm=OuVsX$YCW2xpyS|}?LD$m6Pr`!+;rG?IcB$aZTOc@&q zEm0}WGUeh(sJ^aNrM1YkyhsQxeL+t5$dsw%TdwnYnN$$LqU1VX5((jSl~9rEeA7&E zqNj6FOUswktf*6BL0uw1ogBQZOf7`Ia|N~Y%7sS_c!5iXI|R@rIOAg!`)C0w|* z(uSZz%3B|goaiVhOJhZC9n43KiVdFvv4&Y;lPG(5nBt{1D^@vo%Cs|}R$-rwlAjG# zTD1aFcF2@5PyyvD8zJdonFOsL9LROrMM4y#Ut71t`L3DZM6)5KzN)@yN!^M{voN`l z(5fZ1>Hya3BMdPGj%C44&`7$Blj2rd1lk7dR$5WhXs2bWG`F+R1fA%);9U(|{j(fA$FJwm&fh2^Qnyn?HlKGzrEA2h1XZt1nitPoRWR^b)sWb zVOGHfc%v+lQ&s6JRr7dB*3ZCI9`Xs8ZOS)5*(Fb?uv0wYf39J7+s21P>^b&X9;lBvU0dr)b2%QWy1Kte-Zlk-!VFb;)ESJc5E@uo-%fkP{J(xmku zX`vBrLarU{0k99`v%I{?jP}H|P?Pf~kwIiK7(3x?^H_-Fr-kYp>MEV#GU0MCZ*s<% z*omfNo>fcT3l?U!XF%|x&GmIFtSCm~lw!|J!Vo5yLs+|nhXb$h;im(KxRx$!aK0xT2%iHXcgMO{WYYPN zgu~6RWCDZ*PCn|ZoIl8v7^YO!I=wPsvb#$|o$dAIm`$zgLj=wc^@A*ut`gCUQ)CiG zp|PSKOEpraL5XW1%@rLZQ_po%Q8g~pE`+r5Cb%Bwo+cU2VChtvJ+F&QRcTeVKKn(n z5O8g=w$$D)nn{}Vemjoz5`Fd@4T+7=3gz(^h1QIPmkCZZ6GFD6u5yjhJ)8{3R#knY zQy?O7@+fttwY=P!EmI(8IB{8C4kwp4%Cw8Zp@zm>XPM;V!_cqSI8Bm6GY4Mpd{ib( zaT9W#R+$0~21XZWhv282LTg0FS}nFUgcs!QTcr(~=xQ5BNJ0Lr@xWtDNsk zo{hZH`I+QnfI}S}k~{~4Uhn)#a_kRk>+2^wf0rrPA3#c;GkCOljGO|U3shh!R(Y08 zD}eklVXR2VfQaBubqzJkoVc0jM6;lwz(`WnR8eiTmD8ZD;MA?&noy^m1|10|;W@&U zre4}<&?3uktG8z7r(yqk8=P&-k~`!=0-iVIIycB9Xcv{xW2s5P^73X&^mObOa92hQ(c3-(~wi$luDnZ zQINE>Ze>GFl{L9c8!{FWt7?7R7;-VB;7rv=F^)+Ua0tlg4atX;iY4WZc9%EgO5CZb z+^&q1u~b#QF+ceqx=&u&;#%E6fB$I0hI8nz=lWgPCMu6;@8PtF?aaerZ|fxT%d*Rh7=yWMYn+SPh3uUBepZIhj7uO;^gViNulV$;6n` zEmMcNsd$1{?)*)rLQjD{tJIit3S9ly`?--9B&D02(K0pWrb0t=CW*8&G^gOyaXDQ5 zTwZfK6#Xh`2*(C`05^8wnmkN!w&FV*g<&cQJX)!jO=_Qqb$OZM3v4ku6D>Y&oj zfdfV*V<@F|w(glxFP0^Hp;e4!Gv3Qe=Hx^#fC{KDZ?KP(v7n3>D%63w*{smCvC!gR zBvfe+$g~NtV;w98fG+lHGHr@Vt5k^{G7*kU92!*Ok4577r$B%1j+H9?kW7b`0>h0Pu=m1v?=a5F&q9f8_ zq*G(Exl3B~jP%fIm9kN!q@h+lEZc5^>&Eu1CJlCUQ(-*{%&&IJ-Oo=C)vR_NHL>Fi zh^FC!hpUU`<-mG^0qN0sMbl^H%XNgcl>TW;D%i`{|6Mx&!-TKJFb?ol6bXZi)Zg%FJxJUld z5Q5JnO9-Dd$KjKOM0%KU~z-Yl2J(gU0<c>mwE^s2`+WeXGrZ1S8C@hBMZtSjFhG}Lrzqqid#6(brtBPl7rJOf=zOcZ2(dnc# zx&q-zf|>KDm(H6pea^KenqO2@Xp%(n`~`F8-C#m{Mfnc&}Nk8%@qKOX<7g%G|7y)a|D5?&MPhw zI~L67E`VQ|fKk8POqe?da$4Yo28M1o6Wq*B8W_6A z#hNj7jdPOJ9Uk$I&eqig;SDCqsk&r!NPY~7^BV~!mBDHPio7k7Dpb1by9FO zqM{BKdZC|@Rh_FNU-H&6y$RVT&sQV6cr8o_KEz?w)qOE1RN~U>hndZxs) z?lkw+*D`GtN!nVbFNh>OvRFWYniT>Dao}=OJx$TWm+Q=ytPd0&4hogWx}p9*)N9D zqW`^XnYPIK>3c0xn`!Q?WqMF@Ud!}VnZRqAo|Fl^mT9j@(AP5kNTz9Pnck3T`dX&n z%0zuFQ;$eYu4Ve0O!3w-4S@NVUX261wM;`rN^&jJD4D`*nJ$tE|AW>tO%lGDYncjU zsT8+G&BVUfGS!;Kyq4*9iFqy4Mw!5CnLZ;Ew6#nRiL`(ETBdJ^ z4BWL$&r8Z{nO>C%?pmhbn)rm)GQDr^^WVOfDOzM4S;t??G|b$A*D{?WF|TDBClhEb z(^SdfUOTR3x=M0d%QRo|3GP~^GRb)@({h=>Yng5r3IEU6GJQfgpsi)PM<(%Frkygu zTg&uSnZj$Co|FkExRzfIzuL zzho^_%xuNRTBaE?ObGF8W%g ztZR%;nHiI1x&oUllug})l6=*|FwYWUkjN2|FwW=5KJC?7ch-B6Os#FV0lmoBM#J$g0GE!N16M30&BRZ>&XDl>j zkK>KMva|mmJT<}NBt41`Z2KO(3x$qFPlCUp5Pldxp=L!z?aIok(v|7~8~n&LcJ_+n|FIjlu)ZNA5_fRSPr!?HH z3I5Coe-8J!D7*ytI9OYEXK2Q#@bt)Cp-~N^!dKzz_4IiOz4GT0X%oZ0#68BirOFAvj|t%e>hDX+ zXhTl;yZ9zi0;y31Zkn1+~)Ad(B+cwXYnO5PCHcKu*V~RXz0xJ;e#XTW79JSK({bHblKpkgD)MN zJvcu2f+3Ogq44m;D~G_c+=-5x5C_}h;o*}UCwd0iP6ImxY0?IF95BWiJopOO3A@YC zpuxq%p#wVC8GZ7Eli|P}=Aho-!SDo1dYk4rgVQLl;^Ehlv@-&ZZ+!4O_}rX1WMKL> z?6F{*=Dv7;b8m6qMxl>$h78F3csL5;&iah#*^n|Q0<8c(4jKSuRh!&@>nNAY{nMj& zK#INpIMU&lkJAkxZU1$EybQ4%xcQZXvR3K+DaT^9r~9Wr<+xAV|9Iul#s>U48$Nw& zJUo$7y*5=fH#zXoIQ8^1`U0T#BqVy86s$d`=L&gGf1pQnmOA(}qLuK(q47%^8=dj+ z)TMHGp!0b37ap$+-)b#~hZ$9Uq;%=>CVYH%DSZ35skE}DeAxXXV)EtZE2b@90IDP|hi!t?Jm z<5<4&X^Qb_G6YmDf-f~SpoFE(P&!3dH^8%ejDj1)HPmyA8F}RDpQh>`4A0_DX}qR3 zcWG^1c~gCP#cfqh<8y5kgBsSpJW$FFqI3*i7#yEFK9(fvt1c$OZ#kL-zEooZ`0k?# zX3V;F4AeG0#S8sXiCSs%rb;p~W|2u2nIcJEz9bWKEfTj#o<$~FWU@uRj#R4RHs@coobadmTMI?mTP%E$?|BD<VmjF>!DOohldTd=wn{MBD#2tcrc*4Rr&vBu zv3#Cl`8>t)d5Y!p6wBu+md{fxpQl(p=UYDKTR!JoKIdCL=UYDKTR!JoKIdCL=UYDK zTRu;F2-^#A7i@;Y0MskV)iH$vxlLWJr2d}fha~Jk$#BUgHLR--E!>V zCuWa7F?#@t*&|TQ9)e=_7!vAiemOy6tf4Tm^~WB z?BOV8k4G_kK#JKTQp_HbV)mF6vj?S^Ju1cQVJT*hOEG(3irFJm%x7q_=YlbNG8nUG zgR!ahQESf!WA=nFX3q#?_LMMY&k5u9oG@WxINa!?Xfm)kF{}otc}}a zZQLGf9(m*T$Q!pu-nc#T#_f?eZjZcid*qGVBX8UudE@rT8@ET^xIOa5 z?U6TbkGyevYvsPyj=6D&{X4sReb7X{RARDb&~mUqWLk;{AgY_ zn`)ek#HSk9sp9$OzWL_9`R2a)xz5tsm5uO_Tzn*LseRdMqK!r3Icb*dcoM88sJ2|kA3)|xD?ijCn*UvZg0SII2yUIw!;T`#k^dy&k-_N6i-Yg4NOi0N;ou<QwM?Y)WJlm zcNfUkQeC;Qvb9vdZCa^*TOhmGs^2!P)Ra>odq*|p6jpY;)Ra?L*=1ByPGM!2QB65b zD>da5$ZivA$|NpknMyTyo8nAj?~~Ktn8XlgO{+fYeEfPrj;7J z1hQ*Foi++9yC&3Wqp-4j4RzWmtnApU(?(%s$6lQ_npWz}$QaS`)M=1Fn4>@_Z=i|l z%t#;%jzCzo0%33j!m1SrgJU3LU^WI`!^{}_jnUN@TaEcd%m`D=(2E&@F+(wC+{cO= z9>xuoxSK$scd?ekcuQ?Qm-y?!MBm8@azG;{8+vKgJ#&HcgLdhIjNR?c}4I z;U2yFT;1_2>YA#?Up;5xCGdFoire6pd)1Pa%iu=%(mH+*zXn&u@5`4gX{cJopO!Y@ zQ+UT$Rl_6Y)Vt))aL;-f+{cHX6GRIHwR_x0+Lh2Q|HAJxb*7rvFNvhtb+c=Dp!(EfR_=Y<&M#L*rXh3v=mA+RlXU(_$74y5<^vV-2E z&iAx@+ljLdeRRGfcqi%qfjH{y({zpr`!f2h)~&#M);~Zx)96*|6cLwkxJKi!Cdb<< zH64rr$MfTwJujNUomvI&qR-!^SLx5o!oG}h{;}ZQ{22vclRCqR%W`FDe2}}V`Wx4D z^m5&(*<-o7XrEHSd&r*$H66Xao)z|GWWQJNUgGJrKnRm{oim8zYNhXj?Sh+JhvLM! zyk#zS3N)P;!Jg}Dj%Kgd*L=yzzxA4q?#~Wk&-vafcsl9)I6&v;nmw%T^0qFGW7&B7 zv!?TXtz0MLf-cz5Rxj5u!86I98N_9r7YO?@6ou^u!MQzsDnRG!nmv{aR6$&hWu2=u4$Jqv ztt>!ihh~p&%V>`WHG92%eqFQI>+uP}*HV0br|IbJvsc)2z8?y{fpjKOX82LpSwNiQ zc{=&OR^#|~GwFOr(|Jj&mxqKs$v9sUd^_p9uIcFhye;g@NT^5f`$#8;1}9mr1aU6c zP|~?c@IumQ);MPM5b+Hf$G178vx_*I>Fx75%^s_Q^}nZaK2}hwOViQY=Ml|b*ZGsi z@fXy28%%>4`lIW_G>-jh3H7UW#5q3fXOqS=SR7urYC5|9qnf?$=hrlj@!U=E+^gx} zn8^M1L1EuTdH-7QJ)|?5208qwx1Y<1W4SP29*+tHZzr9P2Izc-xEzlj5<29j^CiJM zNdNT!{kMgE842|WzMph*ut2cM@?K4x>+x*Y%&F8k#-WpR>NSo{X&TwXbM4iJW_o-6 zie`^GUCPRFz9IMl(tlUe(d%Uhb;_8m*UM1B50cJ2;`mY5sTTI^&vMC0=c@raF9>^X zC*K$R5a|r2!9e0f`B2#Bll>6td}VpZ66g4ILD_J- zNbnD+UT)KL^me{c*mL{bB6yVi`C)+0VPW5;ym6dA3Z6|m6R6Wi_jG>}#JODT&uqcR zkj~Zsori=y`|~Bib4cf{0G+fn19V;x_8gz@ z3tm7vgK0t{{W+I7my7*5U+_ZGSr(vkr?6*#)(f5>oxK4%ZwPz#=U0NyBAx7EZoSBI zO(D+ZVt=LyzJPS@2+;YouxEeT1Yb-#uLtP#2z&PDJ;5tUXEJE;NQMa+>?f{+Ez`A#wbu*ZWPvo{yt4!55Lv7Xoy?CG5Lg zH=L&hFC(1~19V2v2`u~1{)`m7nsja?F3YusI3Cv+{{;E7L+I3#&TdUdpV#dZ_RVDf zT7dognmsi=mGenit^>HcKHnQjoXcBF{nc2FV|&={?(W>6>FD#l6`DP^hbGc#(d_kk z-Byj`ym$BS-AU;70RD{7?;?Mm7kn+{8y)Ey$a*=8IG2~}ceLOeNT(t|r-8Vf-?j-I z_Va$hHL!@&d-8hkPE+Ee3Vta3NZw2TKgde!TP5LuL@I9n+9dTK%Wx~EosX9)r;E$2cR|0hQ z3VV*vi-Nb4&Pg<2Nq@!?=W?+>7YY6}>C^}4Y!&wG&!+|NAf49(bpA`&vp+`#-%C1^ z&T#`M%QcHQmy7+mPVoJtb5DTIE@999d`0k=Nav3MIs>y^KczoI1n(rB*~DeJDujKP z<8IZ0ze+k^A})10ggwXS1;G!H&VX|rwMm`Jh|BqQVE`}Dba2YU^UuW^$EgJKH32%G z58z+cbaegw0rqbY=X&W+{|&*_gDb$NCj)fe*SMZ<=zO;z7*9RlbmDTJd3u2T*#UeUaT&Lm z;6tLWANc_~D>bhBzfR-2|DO{29JkL1K7#VSKS1XVjqCaTR^xiUM~KU~eHdUr^a8is zGCrpXK8pMtMO@Zbsm66bYc#I=xlZVFd|Cw0rhHoibbhFDJ>Nq@r^_v-b6D^(q<>M4 zYasid>BKoc?B`X2=a9}P0(3s5aXk(X3mx|JQNhQN{+O=b!{xd|@QI}VOn}Z$g+0gr4Z-tC=gf=z>v62c^*CG}z!wph z<3)J@Zw%1+IPsIftpV_#TwuGT>5#s;Il~o>;RpcG_J>g zsmAquR||bE*IL0#DBtw~IvpC<^L)XzTk_<&ou!$ z>ou;&;eO(SA$#O}KXFfh{R;v1F9q1YL7e^PIQ&ZR#pM6*0(8zB?;oG>8rREpC2`J| z<5nm+<$G;_&PI*v_40tw;c`7FcqQo{3efqRuxCG=32u4W|7y~iPF#+I*J@mk!!1IG z{j3nYmh@`^biS-{Jr0j+T+jChLZ8dkDR@2Q`&xibR&GGO6X*DFxnPmM+L$+yep7%> ztFUK3w+Y@%IBf^VaIX9wtP)3{!bUlclAt}hF|o%D|c=)i*^ z)h7K+7rc#hiiyiORA^j}!=1#r{quSKCj{s5sDn8B!{vHG@cYQ00h3(+r9Wp8XC03J zXu)@qPDOyua*gZdS|@ba&lbTSBK_6?otHJP*YD3XuIKv)q0i-dNAO*gZ*PFkrIY>R zRzjTP#^qWl_-@kwOn}Z;ggyKD4Z-)2&bt9Rp(#l}^*EeKoZD3|t&bWbIJc{d19aeP z@oJOhy+ZKE$j_nxosVf;ug5JK*ZqG$=yQA?6uh1CeKbJl_Zrvp{ZQy|J%;nm@;*)a zGl|RN=tg1BewGT}K{`7FbRN~X9*6G;9rp9Pg6}2${Q){BO?As9{U4!mJ>QFnbG>u9 zCJ4Tt@|_f*vs&YN{I>`lF4sMRzeM^!3D9{<*t4JiC3q+42i}ZmpI3P{a+yX zA}(w~zBKSDZlh)aK}ggyIntKdDP^W^}Yr-^es zGbx@w6`aSH-wSVb=Uw_xQp6`e&-SWzEjTBtn%mLGLh+}+oopO!q`K}f^T&}f(N7GzCz7wGH zs<7wyzb<$>>6}sE>dAV{(YWsa4C36bxcyu!IQOe%0Xm=2xV~=cVd5O;A>`-RH9pXR zbxrUex8D}17q#9`UpEz=?sD`~@3%(~XZ1+xbwHLYL*vhe9OpxtH(p4b%R7to3y6nBd1ndx1!R9yfc-k+ z+#a~zKP7akN$24Joep7NPxe0wus@`6y?uT_T>5kJOgC;EhYh5EF7dF4!!%*Pne49( zu)kHEchtW8D8jSg#PO~ImBf)5$Rt~T`$}c9i;PQfX-XQ z2ZOtK-0?i;-2k3B+btK{^Y!7;#AUfI5PUEBQ%zjP=cB@&%k^==_mj@P0G(e5dyeyO z1b>Ni&YR!1n6`KdydZwg7=cnfD->Wk0Q?H;`p2^coYwM*p>w7tP%F?&z*v2 zlFqXMItPi%cK!#AKLf`LpC_Jlo$D9d?^zCsu;miR`0L}^!T?@FT*hIA;G@X@rU0F9 zX?0y_b=B1;#@BF=LW%ZN$1`Gojt;y{drvQiKO#>fX>MaTtB5h z!vxPKo%zIN|8TR$^>*?Rp~HTz5_}rzuMN<7R^xj6d{N_izFk6}s|l3pW*R(Yyh7?T=qZL z2zwsKO9JdGiOcxZ2tJF-RTrT14UOyd{RDa2*D zrU}l^ExIE>XS=XxKR+kO?FuIKv`q0i+#Ab1nkdw|ZlHzebr=X;Ro@8rSpvqR`=TeOd6$q<U)8E-%L|a+4W{hp4=T#ASJJ7WUkpmk7R#bRG=Q zc~aQ3KhFrhn{7XQ}8{cvzWLnSA(!;e^v|r80oYJ=)5BA*`L=0f0}fL z-t77>{ked+tgmr`?k*1^H-|5xtPtx)oQtIl-e9t7#aqgjfFVHxm zOwzhZ)6w(2O|u`Y<$I^bv0S~RzeCf}?<+m5*$>fl+BL4KD%~y5j{Aa(H z)JZ3uL1nHU#z*&OByo(-DVokWjiXK`>C7Z9b>?gK8Jf;gjiXK$>D&>ZvqiJ#I)UAs zof=1-Y|{A_ap})K&3>rn&l?&?ogC8nQ-IFUaxj7o<1UUCmD9|{f zQKSVwB&;^n(c9Yw&3-u9qTy#Xj`{~k|ErpgUcb+1_9HZ%S2T_~U8K_;pwp|_pQ`B$ zUV>gFzdzVbI-`kWxpaRn(Co2)h^oCEC#Ko|6gXe^o}zKQpSv-~-JwA64aDaJ@LP#< zKhTARhOJKUTxt({G#!0@@}jUWqw@Yx@O;wAsBrTM!;7wSHgW84_50LUX!fsZaVQJm z%Qb$QX1`A3r)&IC;uwc4;JiJf+3WrG%bGogtboe(y2ddCIixkP(pALr>g{+1#_?Iy+j-m8dXy}t^6^7XN=X!fsb{{KMebGz*nyo~Zab!jsGy8m(F(*G%fSCh`# z0G-bfXa5r;-29%=?Dcu_yF#D+?-l$2<$L)ufB$bJF8wbRoS$3zP=L-;!k+zkR&w&k zsrL8hbmG#VQGy>Lotp!6RttOfXRYAfr1M;W&M$>Mx6d~PKSDY=HU8zgf;g9p{h29v z59w?O(D@Hx&;INb{3z-CIzZ>o!k+#4K=5ADx%^iDaxEav)PiyA*e zJ5GN_T+W}n0{DA^cdT*!KJ7O5^(1&10ROqXXA15Na_trqm;KC2VbA5gUGQ|$`F4QL z_lXaN?DTQ!HO*c>-v6j^ef&DJ*7XbL|!q=W?;1Hwr$H^#3D3{~N-d{rr~T z(@3W`KELg0u%GV;o%={<&`12^FqSx%i=PiZEx`VIjqByA zAkJ~)p+Z^j{_YZcRtme_z=1arZaD7n9DkhGg9I z{^17V95+7hZV|kabUq)T^L1g*{yZUg6Y2apKxagw>!1+znd0ON8JmD>&!+!pk;Po_r%U$K~XEAZ<=N!SC zN#~ORIu8)X{z0D?eN*VLpY4LLBmKVw=x45W{g-~8D)>gyxt_Re|923V<6xU+uaAR| z2>orO|4ohKI9N;L;O{jZeH{Eiv&V6;jdX@LyX8VZ^?q!!#`SUVM&cZYouu;-&0g1O z)wtf@wh`z4oX3|vLcg8#_h~x1{;xHz>;F;c^Efzw=Jo7T*l!_VbATSQ1D%( z)1v9<{rP_idp;f?5quBnbO-4CRoJsX#{};nor2qw^{e}HGjWas`?Eyw{iO3?fX*rZ z?&`Bn7xgE@1>cVbu+1SZkBcf{Uq<$~3f@Wl;Q*a)3w!pbL+}Hn^S1zywOM-Wk&hGrX(z%Mb^k=cK=lGNh-a|U~1?YTJ z*mHc^1wTqU?*{0cf2Uh6><4gs;rq52bKG$E$Ek0_&-dXU*pNS_@vkZBIEbS39$&si z@0sV){i@H>zW9;`|I5hkYl0J2zvYMT*`9w7=$FF200R!&dxG&!&Fh9l^Pu8BY12&d;@S zjSt|(l9O(wTF<(=~c&mzw20ogvA`1P9oFEoD|1NbKer)qM(COG@~vfx7~-y?#v|AXjwMOVGBzZcRu0r#e!%5z~!q1um6?HdEU+WcD(Cy{(U#*nd$fr zu4M_GGP=S1OTl;2y6Zm+{t)q@G+$u-UBoXEd^ho#8t1VI{V5ILcL>h)_&LG39-k1L z>+vUob3O9!xS{_zzIz+Z3nV{X@JyO_<_g|J@h=vksRtTk#}hM76kAc1n0Ol3qFG4`B}lU zh(9LyDB_)hXA^&0<9Oc9TZlR?L^{v<|2n((ATO&rj^mF~vcPgtE-KjgOf9&A7B`7o zurOO7lHkPHl3ca{tRV{q5fLX^Z$nd%v@%1@psbg1mRk)u!=ji$5*g8yEGknn%2lUE z5hAUn`#r z-#IkayBuCNDY~Eg=Hu4f5q%5d>lQ@c2XEAR_i^}Ec?KURxF8tKr#%=(FGr z^1I>w{~&xHzWdf#&(rWKjptqPx>+&48Qvg&558O8@$y*C?R{JRDR?$J#*Kwn>3ii& zc%AL%gQb?6+`rUv?7i``)Z)Tf0L2zMt<4zb1xdH^FoH zGMmcIxeE`J?9Qho+LR^CMo_xo8T9{{hGPlQjF&w)>sFNaT; zKL(#6-wLmh?}O{|%HB%+SZIVcKUXeL>V100fD5iNL+SB0Dw{^v_x!u)8lc~!>-*%h zbbTM&N7wh9qjU}Qf6{f|d{v+J?dl*OLDzlc47%>a7SnYht)}bqdox|1fBWeAoH&~J z@ua_63cTNyZS87}SD7(%^;ZpD{k4p){#r*@e?3Q6f4xdqf4xUnfA!G>5>C7I{M9d` z=?iOF`9XN4{C&9R&rW?~Ksf)C$@|v7z$egEW;R{pZ3SK9Z9QEb&_vgGYo=?w zeL&ZEEANMPsUs`t8gJtg4|y(cGYb4$aE}u|KQ2@e>hXAJK)m~X7d+R2-+;Rx{|fi# zT{jIFA9tkc8IXARyC83V-dv#6??Ak6OS5|tKb6$;g92}aAJl<=4Sz;;y#sHQx4_TK zf73r!7aNIN> zaoKh8yy!W+A%}@{U1yp7#n;GeM$5?=`TcofPQH>QYoKBS3aVNu6#r@UF-a(;m${tUmuU}b~zt0 z5bk`$WVrJY^Wn}%)WMyPcmnQx#LmRie8ley{4emv*qp3``XRI{)Z=`_C*c0RGZOB6 z#BFfrBNoD)k9Z{UH1DvXz?F_aolt`D3{6EBxFR*W>el4e`FOct7zpAJJJK^r4>A^TgA9#Ha$l4eoX9 zh42PlCw>k~IBuxl>)0C*?{(~*aOWcq!JUsd19v{6+l{f~d|a z*F`Pd*Tr(UuZy*C=OZ@3osW1K?tH|b;Lb;U2(PV*?d)+={2AWo*7i<_`<3tp`FObV z5nqNoAF&ATe8eia^AQ{2&PO~CcRr#S?tH{)xbqQZBigsu`H22-=Oe}^p5`NF7Wh5z zvUs>`4cz&NXW`CA?1B6K{21K%i0rd%?F#4Vd_>>G!#cmWAq74K?)%>PaJOqEyj%xZ z5APx04(}yD0Qdd;DY%vqvP-lu5}Fj+m8+h9@Cx||xTgQ?OK{zeX5WPCV=ntHT$fe$ z6kNNRpR3~Y9INwr1MyYzv+!zpw^8wh>zOR~^Hc0o<<*FvE}sjZAzu!!k=Mg#$+ska zEF4_hz5+i+SD6;N))V@TjunQm*7~*HIFhabdOKa~jZ5g4#d_=M9iwlfYoPy%-YLeP zfIA;?>6rL?pMQtWaX+Vbi9VLD3#o?QHO4QacZ*(6?;d?y;;rlRk+b~;{tjLJ)lmaD z?6%gU{;Hs>zb4YvU$u1g*LUdZugB@?ujlFNuVZxe*T+8>8-C&Z-7j?Y%b3K|e8kKG zzZb6NW4lf<82;Y9qXk9B z^DS-h={m`^1wI1q@B7o>UMKlF-0LI{!@W-OINa+bO>nQ1{2}plo#bSJ{~PY_WxaIc zaY^az2=#cKWDwlzB$E=~9SUiiTj2ixpNG&8@Aqvz;=N9?1MYQ_X1Lc$PQ$%U(ya3e z$Mswus73RQ-Q&UYYxr2%5q_yH*H6dWXXypwYZ33f*oK1m2E=>Z=5Xz1wQ$$p0Czou zTQ~jk|NhalR8kXoyE>}0*QnLe^3r}-<@P)7S*>5m!#k)+TBWk=U6pe$_!lnk{X0u9 z!i=iUGiNt!jV~KeAioe1UwotVBOIS?aQQmjZMj(P7y5a3>1Qa<<8R#+0~*3FlPynP zhnKHkTl$wau&_Jz=NG{ep}Oo;sXQ$$zx|8t>tXEKg7P1Aj*;bf|5(1IpnRw9F|x7! z;s5Jg%kzt$|8|vs<$sjFTIJb)_w|U!XL&Ry>r$$peHRWn;qqAifjsQBZEXLrylqUk zMU_@ahs4O;i=u|TaE@WDhRx%DTz>KL4?Y>o*Cwl4VVto1w1V=-lsfXKeyA;!W%=5I k@>hia^<8OO+xp+wM`1=|`6cg!00HsYIV1xoG?Sqoi1% z3UL}kv5r)$gEQ4ZiT;_fDqvs~0)h?7XjDey3~F?$(@IA(*wHux_WxUZuYJzm>ztb= z0mngmKhS&6ckR9Q+H1eh+560n+e!heMMO+x>tm{&75{`?~IM&_o3o?_m@-1z5P z%y$SqKV*Kl;4d-1NATY2bi03IhT1ibK}qX%%5Ry?Eeeq z&kOwrSf_bsvtC<_W<5GQYX1+{>Z(zPc@b@rZ zC-{e$-z4~_m{$t^CFZq)KgYa9@PB2#gE`!&KL5ddCv#I?$C>XEd@2fv{Jcl#KbQGF zq5l%*_X|DOGJinu8<;;N_*Ui*3w}HEFEhub`h0--Gt5nXKf%0L==mb^KEa=5-Y@ij zpZS2$KNTGp`DYflYq(K;63h#koBnMc^CIR@t3FpUFBaifGB06n`k9-Ur8#WZo$Fqs-d`f0p@9=Elw!nD1haOZE9T=6jeM|Gdn6p9t^6 zA>{x4B78pcF6PE>XEQ$__*~}Q%#EE_Fz*rJS1|8oZu;|gFn@u$vHuq4FA6=MWIm@r z=l?wR!{?c=V_wL-hxrcX7c&1A^De=E#QYGadlrZP59V1y|0~R2V15CIp9F`HpS?3Q zxS07&=0(hn--?(QGoQfW-^qL#bK{>n<|~++dCM;58%6jJGp}ZD>dynr8<`_J>hlHW zZ6f@?GT+HOpTqx#`NPc5WuAqMsQ!@oIm|CnJlore@t-~k?toS@-_IE>~JU zH~co{i8D1Xd7J+3P&~^^=u2+{cQl_?9Eowdl`MaZxv^&p^XE-?wr>sdA2Z*`{1)af zGw)*#x9AV@L4N2LdMAVJR$hsGcOdphk23U-(_Ab_|KV_2>v_fDZz6wfh0ed3Vt?oQxA+E7BJr^!Y7$m z3%-GQqu^Vaw+Vg+^PPf!kohjbA7H*m@GmjnC-~Qy?-%@s%)101WPU*KOf1#OZ{32Q z#=J-H3z+u`zL##96M|31!k_$ED0qT-k>CrN7Ylw3^Af>tV4f1ZmU*e*cQW4~_+K&KDEOzC zR}0?FyixFPFmDt5N6dFJ=kCe-Pv&jAj31t6epu-FXXeKQKg`_Y0o;t&|HC{- z@F^HCsUGGtH}=eAUclVgvxxZ&q32rWvjo49`5d9Yj`<>?e<$-|q31))O9cNk^OWF^ zF)tPTdFC4g|1tB8g1^kXnmK=Y*_han-x>ukVBRM9Ma*{!ekJo=g1?RV9>FV_?_+Mt z>sIFb1%E&DF6O2_e4P0K!4EL+7J9zQyoWh|dEaB+EBF!SeL~MG%=-n;o2vaeAow}V z4-0+?^FhH=%!dSj2Xl`dVEj*Wdmm%o!rb`zONwWE8@FmZP55Ux{7w#Esm0#+nR`5;-opGB%&VE3`Sz>K8wJll zMf=i>36XYTQY&hQ^I&tY!LDWT{6%u5CTIP(pH({m%Tf1}`EWnRtP z)X(oRuVrrf?IX--y-pv)={XJQ-y!tp;eHnJyG8hOnBOD#CCu*=dQ!~qXKw6#2lM?x zPd)Q4!QaFDfZ+Er?-u+)<~@Qx&b(Lfe`4Mz_yF^M!GFzsK=5(6uSb46EchAB2L-45 zk`#VO@T-`6Sby8)wT5|);8o1?1#e?sAb2P91anjW|Au*?;Gbt+B=|GTiv|Ba^Af>- z!8|4StISK8oBElL@sj*Q_fc#=oXdQp&~qvCYQdK?Zxs9{=52yEFyATodztTIZtUF4 ze2?H=%=ZaB|Hyp5;NN84CHPO69}xT)^KQY%V|*pQ^)NSfp2@sd@Qa!EF*p5N3G;rz z*D@avdNwmZEckZjgM#0~d`R%WWp1{182i7#JO}qt?E3I5^L)YknHLEDU(6HC%{(Co z6Abd(e&%ML@FwOtxDP=e(~r$%p3B^fr%RYm7knM_8O%+)+roU7(0?2ALcw=4pCk0_ zXTC`AFEU>&_}7>(6Z(I^JSF&1<|~++ayia?o#4~3;fDNq6LXW_*~}}2{$l3Uf?vm+ z?pM*rr29_hErP#``3~kL-Mg9JE%bkc`7Y+B96!r^kKkWnzEAKz=KBTzH|AZ;jXl3% zen9XEZ`OXJ`)Bkq;b$=K5quu=UgpL>S2OPud_D7i!K;}M2>x#7hXucv`JmvRU_K=H z!^}P0f1;1E^GD1R%-3kK_n*vnGQWj+79O-wy*kR=^jD`dKPLEv%wJ({%6F~e*4bJIV(&xFVQ4Eh-RKgxV3b7TKQ%#SkXX|eYt^C7{%!#oS? ze)^dF{)~C9;6u!(GdJ~T(%IT?Gnkun&thIE_WOb!hAn- zXs=VJYB=W7r1>4N_q^BK%dIX=sLG5R6;@Z&n~$IMFv|DED^p2+21s-t=N3Gz=? za33Di67`v{c&1mv>8@eEjQM`%CSTVx&&9f#KF0sIB((phGdK3%&U}X8dzjB+ZraP= zF`py&qs$ixJa$uVdaP_zvd% z%#Hn>%wH7YKgRr!2>%)8hnbsl?`A$I!XIRQOoaa)^H)UppE36^e$vPI;TZEA=EnZa zb9K4oity8zPZ!~5GB03m>@Q-T5aF+4K1=9d#e9wke>3wU=BB;WGN*YEeT@C@X19^m{JSD<^l=%wg#{Mqm>qPi3DW2{1aev6ekM}L+1A_mY`5^O5ZLasK;#pn^S8&sR zzIm4R|3>aNO#eBbc@J~bejhd!qM|C0GV%uRW{!u)>b<8(A{;`!Ro4+vhs{2}J1-#Cx? zmzkS!a}o1i<~$wuu4djZcq#M4%#EGzWIn{)JlCjYo`ZD*eGI>id4b@&m=`iP`ajIP zScHFoc}j%;0`m>bP5bR(UdcR5o8^6zIjy(ogKkrOUSxic2>%P_dzc$P4>8}*+?3b2 zLS0^6%*V6->C6u>&t`ru^KKD-0rMW_rW}_re_rrX=KVrX8S??b>zN;BZu+I$nIB_* zG23|$^I2Hm(8q-TYvx6Qf0p@T<`?K_-eb(GMfhIkEzFJIzR!FIb6l#=&zV2KoWH#P zV*ZTKlLZ54{`@?1Q{PTu{vz`WS^qiAbFf~akKyx~FJf-=lrX3D8GVfXtC_E0ZtQ<2 z^A_f4{_0c5{C=Tl2lEG*^Dy9bGVf+Sf%SZh`7k2E zG3V;;-ORjOgs)}(40GfEcQfx7;or~v5OY&cKFa)<2;arr!}^9kroDfOc`kEf|JRro zFgN|)KQo^t!XIK@#N71%zh+({!e?Bh%VmYoKb83g5kA4ZQs|$@yhVh+k~ys}>64?s zyp_y%iSRcuzfbV3%=Zg^8}o;lCs=<6^XHkHa@oiHMdqfTe~|f6=4M=bl=&;njX$4d zo{RMmeN6Zln9pEt!v7odIn0ecFEd{(xIc%>Meuy)H!(N%pUu3M`6O+YH9867J9B@-ot#NPR6^D`SZ-VntCc~MGv6Wfe3khw=96{u-glVqV{ZKX6XspaO*g{FBdj((4`~{(Z1M@?IZ()9nxk+~$bB`;yneVkT&tY!Df3Jw1U5;aKgDP3}W}hT_JGke>_g2eZ_WFI3@8tqJ*+icbjv|5~kh zUW9K{JU_yl6rUR5)QwN|UOsMOEaDI}UnZX5>qQl3XVXtKYlm+za=~-hTKg;~mR?Y9o z(BJ>Wd`F$WrgP);`6>R7(|;@tzXaKf3x5^#k^R4KAg!KPti0@bkAlaAKLWX3F1y%o zzZQJp`&!@c1wZtt=2SkEuJP9aDp-8Bqe;Z2+nI)+iKY@4{;D*5eH#95aI)vJtF#>x z6Z*R+P58bv{0Qq=R;J?@bJLlIrW!JOrHa}3O4LXPgSDgNTO2e5@vo%eFQnnWOv6u|>Dq6)*s}#+%>KVX@Ju#tJ~)-v{~Kxe z3u*X$^MswbTL0fLH)#}cxpWC$$ozAHoAJF{a8z&gc_t12HuD6BTes>oH8_1=@EzS} zsh;mgf|vZOcIeNA{yf(AvIy_hYQd1;d#X4BGH%zyjXZ?r2;N99{J^I`@aNCbdS)`u z*O#90+eLz#`yq>jp8XtQvEZd#f0BY1Cl0HWN+o~kE9g-@?`FYwPXFR$;#HD!|6D8h z#!qKbaBrL7-nTU0Dfj>lX!vvr?)4s0HSR-#7r#}9|7+&?`qJZRwD$nGVJuQ#kEY>Y zPs7)zI)0XV&(T5O^HLo*ccl)t=l}lraZ-h!rTAHjpWW)ZqkRLeQ@d4&PW8MX^_X}3 z?z<8Y|Dy`B`w@!rqz?X-(&Gr;aWK{K$OioC_+F~x>#2?(q&nN_a(PD&eo>I+9ZxOn zQKiM{9DJe#=7i*N()Sqsqf;T3tZYd)1zqwOHMdbkpqb;SB2X!*2(F7ZBEKXuE~-AU zizteA%SP8NbP2bxGhWWiS2gwJys7Q^kg(&GGg7;ED`Y%j`)>r^qMl<^nUC=na-fRo zF;bRXXsmAUxpTt7WDl74(s=xU;m13ZJsm15uIn1%2a0T5*LGspQ55aEYUnkU0QHD2 zL)Uex)H>P=K!w{BO6#^^Gxdzg)H6_vOg*DBrOel*Vq8K!cIc9{!Kf<@gK5w8nnZea zBE4y2$NBwv6Z?4``}wr7i9=mfR-q1sW8P(g1K=fy*05P9*C&dH&) zexS}ydQr6rihWqeJ}hGoZ!D=)D%{$*2UUyaTc$SdJ8^BKD9W9!J406{cZT)Q^wovr zZ9TUzL!3gQ4!R{7<|0~tt-GwkOYVx6oSV1(B5z$M&KpJ1dD~; zz79aUJv?@w*dU6c4cccJv@bNsaj;5#;dglMz~zuUa4@OfvDKM8(B6}GZw5^aE0PbV z(8;fLou8^$`EaTucUJ1)vROF@<~@mH`1z@hucbQn_Q8_JsTMs(J@k@p5@VPq98UMB z`6%6Y4Q1akoN`k1WJaL8KTuAUF;Gr8svP}X*0Tua(LAa+S`Z3}f;gUhxD)@aKXCce zdH4PvYDeI=?!a%|hUR&!Llz@~ErxZ&$B=e_eO4X5f_VT!t&iuyVzbbEy!5W5lfQi$PK zKomtc!u?hw+&`*D_~oE7efc#sLJze)rV$c$-8Pm+m=h>>%7k!Kxzh+s5X5OvyLT&; zrV)O51dT8pgyDI;EQy;P9HoAMM#ZBr0WD|iDU4zgu2YCve-3Zbs8jf}j4*1qj=H4(@O5d_Dg5C}dem+mwMo=H zi8f7L7c~}jE6iRF+`;`4B{I?$9T;Q=)XjOndTw*xyr;J18-nQ+)dozfg4!HAMReO$}NRTMqtyBtPZl%(&s=D4s^6@L2SExIKm|9?N?T);5TKQpGW@)96 z7;x<<1<@!94HG31jiS&nQ3|6`6dEQ5qv=u`OhMue-WN4kAz^TsM^oo+qB^JMKL?Y?)C#a7c`W{(*|Bu@%;-*3 z%yOM@Xf59}JBE8d(_`+Lh01B4gmur1R@hp(vs@<}qdfNBPpF$RXx;2f1-hMkKZIj+ zkJ9kcK)GW$VOO~+6x_@>hTpl*!br?cZ=m}<0DQlPE=E}{8v+ZQ>=AY?P`XE%y^Vo# zCwqirl#i}lssr7Q;e=y!kJ9kQK)GW$VORMdtX$dx3!Ll`b}b0XWo6_Bc37v~_OgCw zw6V}r3$s%pXoe_};k3FfW&N&b`=%!o5v^1f!>JXWC{0BBWg$I|E?HgyJEDC(*Flyj6LA09hv`+Cy#X|k0JHEd;jrw$B&!4 zgt4=_ZVY;Kr-1{t_k`nQ>T$CzN8Ke$?fy6g#ysH(v<)CX2ObT0PvV3^sqega6E9;vqGskjwF`$L=w zsxfB>l*jANcDkS>{{a2OaEsTo45Zxu7j?>+?C$j=|1*DFc zy6XgW1f)9ZEA<1wj`lq?U#(bwEVX<3UPQya@V)!g6t;bTbaJZ#i>jepNatQEEqXAp zM%E}5K6t8mz1u7U@1xk=FsZ`uY zri8R>K$(q7V39nzG+o>-60!Ksb<5it|K`(hHht9V2Cpb zA}kD{iSMXu&7MHLlTX4?^_}YnJEpf&v*uR1et^pTN-FoT37WQZAgm72@k$9J%Eq2BWpjwi#)F@nTMBOXY1-uBz-x!eYZK8;jlpYOLAD&P5sqeS z^jkwRKjg+RA8DxnPu4ku7{g-rglFv(TR@@UWzAEl0X zDGaibN0sep?+J&2bT@ca5bEh$d#nU8TABpM&|UNfU6xZ?grn{peQEUt>YdUe9916- ziG86j%#f&%7!t>j-TuHHC%c5B_KZHe1A%%cyM&|agX|7Ov#XHEuBpLCsRn-qDy=Gn zpNCN$?LFs%VGS13E!(-ThUxUTrw8+CPjdZdC_WAAlk|j42Q94AIwJLw-v>GE<7*$bfg`6VxQa zr6GRyU_d>`%3LoEu*2N-!|+K_%+tSWN{ozsq!GWuytdONvP-uD)h}}+Sz8<2FGbuZ zW+M58&xKp4oI%*$^J)M7ZNK*Y?qwOi%`AZa5YP>UCeh>IqBrDi<^rkMuUXDSzqKQYAqO z&JapCK83r6GVeG+5~Rt>L@G!^XF|EUvz@R^V$_cXO9S27e0C7w7~P}x|As)lL)-SCxnM6 zcdJ8+c$|Cp4^Y(Jah3N@^)JlJyZ4Jw&GVbRJMo*QID7G}+PUhi-8*n$4@cOPi+Mha@q~i8oN*qrf z#o>U?^=gUtc2qosK<&UhIoU-aI+KGz4JpEqhaLR`7`yhPo{^YGz+_Kqw_<5V<<=fO zB=?8IRI)!Dk~y-TV5spoc&foO1zD#iS#>IUoGM+N+B=$U0!P#AI|-G$kEZvIc$)zH zR{|H)VnEff-TIafCJ?lb#BoNt^CDKE{TGcp+WT=1vOA0;N`k2n9B6l}6ir3tuaVmOUGm?bd#m$JjHqK74w!tL#OPCtDRVIb{HQTB( zrD1(b)7l@QC_GKQeV=am@_<;XGih&~;Nf8u^`RSS*mFV}a4_X192sv_eaO4_z0_&A z$D=EFh@f+wZk^cM6C~ga=!D$_j$8=6-PEekf_rKCL7i>|KlR;xpL(A@9TZh7llFeS zhM^{BR#YmIY&|%#rQROmHnZKd7fZG@6xdFfm9R=_7p_H23KA33bmdU82O;dD-WMu~ z_6`&{e2(1O^#pelC|P@-i7wf^4_pQ(9r-CaiHOyZ-VswI!#AY8y+}Hy>CbKJ&(rRx8P5STD`jQZ)sRE>AG?igi5OQfHil+j<4YUxjhR|MH-pA;k-Dn z2h@4-Y-DB(6M&(>8O|DxuoMSoI=W+oBFBFpZ|~SK;o(n zRoxwUo1lHWkbkQe9+`TjE-3KtakCK189Y8}Pap#a+h^fl>T^5QH3gx!H;$q94bX5+ z?aAG;L|C|K3}tXQQ0|lgVX0i@DEVVE$EQHGD0&0RNkTNCp&$t- z6NF_F`d+|r%~On%^sFSt`-Ee3kFo{i1j-%52}|W;^nQMjg5!O{@hKn&dH439w#hML z_i!ap5G3Pdgs_{;OV!i@c-oJ9P^7d|&sQ;a++7DNhYhgeL;)^BfFs!)ifZd9%9@^g z#FRB*Hy2~+=L-Ynj*AFO z2ZI}G__+~L=vBaGmPWUbd18@nmPS#`bD<(L^gdFIU*V*!oi6orAqo=ONiPR!Pf#p- zDz|&LLUQ(Uu)Ps!U1*ut7Mf?)vlK**{%#(3B7~jCU7?cbN|OSIE6qnrVCoa-v5*Da zdTysnk(t71W)zBMW)D=`nb{ZGVKPHOWM)pZ;yA9VZ>RouFHJ>gPTu}oGbit8F9frv zCv;8IlV_okEw-=K=qOQ=RYMJx=IJGGs#R6fRLTNI?=G+V;)DU6}h z43cm%Q5=&*+M%(Pp6KQy2CBbz(Pl7!w9d55QxCG;-hhJ0W`I1lAz4H; zQ}p&ZqF&SWYpB;HL8&2C@hObHUT+AJa56zy zCNX@yE}^*RUFqD4@Un0mb*$&xq5&=+qECI?QT6Am*n);e1qD0hmRa8$WD ziDw@P9_`4|7$oTAhHx~&(cXM$3zR##Askg6$qnC7*jvEWGh;9uUuRH1#J8Q=>4G|; zB4l9<1-dh^(s2RdsFkC2!LC5L;{w7l%11XV*c0e>3@03;dz6#;eSvbvaKcgLx--bs zM`ox9`1H&eN@IVJu9GRk(R4>!8eM^MCsTxDl#i}74g|U#!wJXe9%X5C2g)782}hNu zD-F}2sJ&2s-$#Ap!KB)Ug1sUG!A^ianx%H!d>H#h@K{*w{pe6HxJT!z?ihEj@9&(J zdMwjpd;hHf;`_7pUmXa3J4X>wI(@_E|uau2QdS5RTMjQ)t7fcMENAaiHF5D1?RjgX*4fwDi>4&GA3h%7`v!5go}royk4QS9|O- zRQJFC?L=jGUuW_@75B@k3_pXHe0C=36{#Qi8~l7tWvI59U~3?3?r2|zfAw!F&)b9Y zq5lA#)kc)72lKRgr(6jO_1N~0 zG-JwjP?kyjF6oZ;=}_9K{x$w1f-+vh?Q}0Wi<;^SQl)6B>d6Jpk|VfLMFpaY{85|O7^mP>Qn|tJXsPEw7L+<&yp~e$fdgVnov3W{YB7D^>0VJ_8$?u)X7;RD)j-SivBgKNTDkA9-IN_RQjpZ zzd%>&F>XhDKZ2uN(E1R7E)d|}yAi;QiNp1R6wBIpP=x3)#X?y4ZA`^d9H@7Sg>a1e z*lASQ(1qzGfo^9SML0(HsQZyrpx!Z^u&drIN67p5?Yx8uAbbgvny-waY)S(QoD33n zEl}k?>I`lO)H@j@9HV}8WwSBR?U+tDM)#;quMX5ZrW1D6|G~nv6W3* zpx((K;TZL!E1R8xZpU=OF}g=xHoF4#j_HJ5^?$Ik*%MgcWRS3H!Pv@XU!dN}AmJGG zqbr;Jfo{ii!ZEr>T{c~TddGCauKJOcjhW>1BR&mxJMjJ{OilW5iBZOTDF>^b0qV6= zopdPR=EK3dF&~uIjr*~ss0-%|4x~C(cCYA2_N?f@7Gf+busrI+HytvdlLbB4$_~DA zKNKPSx6~iqSU-^J_!p(U<0*SBiRBWOIjsqZx@ikM@~2k4T8D#6CE2JS%(#KL<$l3Uq@8h8LT5Va=R6`XpZ zT7;SjmXGh=@W=~Q&_1r96rA?Bt9N1QW%j*CDBUr+xclF|wo zs53c)MoQ1psPw3ej(h<9o^msqpJqaZ z!$`(Ar}Q6TL_1J%(l*L`#Bv%X0bTJaqU9vLa84aZqttt~L(r+#fYdJG7+r@u+Nn;e z-a;Eq(Fh@c{^B@s4OC^tZJ-5+>NHRS+D-~>*{K?+wotWEr3`J9da-H*r80P_0A_5! zg>J?=J>8nQcRQ%wo=0I}w?`p4LM9q>hk7e}3eSGfrc;lbJAdY_d@6XfouX?(&x9Tg z|I$iy2Q^RK1ob0wZdU4o);sel!01~Rbu=+8i?DFhYiU_SK`PETOIW0GuzdiKSEI+! zdT>W@+0&@b=BT!s5hz#h-c3QH%h3c1KyPa#_woM5)+^14z(R;=aQ+rW)}^BFHp)8? zYV((RzDWbiLDloBgw?=p`py5Pk$VOTpE{ER=u}UR+Hl6nQJel|ZvyQJ^Txqc2mhsA z^=EcX_rsm2J_MtxE>4@H`j_Ij*>I6V-PLY&OeWofX^Qfsir#TMh78*CE?=vF0>P_e z%z=978=%K7I?ll-D80w%AD)Ehw0G~NK)U@tZb^;xoqK7>;-k7W9mP`s^@_@HVr$+~ zxhQT9xxUXHtCIAlgC&j?G#X;OT_)yyc*P}I6HfTn_uGSsI-lt%qDR(wkE)wdd5`ww zJ*v*#<~{ly^fK+=r2^v7phM41gDaX?7@5wj7~yF`px;tPJ<#!@YeDDD3dflcJdBIiQ>8Ve>o@rFK~Re86d*MX>RN&65H}o9B_gq=%oT z5-0bCKlhuTCdbYi@|DiyE2c7cnaX@1sLX^=nGe9?19&){t}>S(vrc6uAj=p!_M<}W zn5ceqB)e5L)-Khtr>?TH2jRrYJSL3J}o#w2$)XWnP!5!(AvpYA;=39o91y zHHR@JOH(Y=7McT5fv3=C5;49rwFM3i`_*t#iuFWz{@g>~gHfPQsW!!mzkI4EcJzKr zyW_P3(0g?r8!mu4*>S=E`B0NCi3ya%Z~^et&apwiGYXDAu75#H-f4q(jOkC1K3i$5 zoSIuWR^Z;m^f=WawA>46^7am6Y>PWsAFQl{Rc>6=VknYH&@czjT zy?#gMPHPUT4XR1dofB0jG8hw^-86k!bU)>MI{9g{fipt9BH?U1qq@ zf6+zRfDP?1-cF|)*XE&Cqs|yv9KE?i5v`5i8^0>eDV#YWtLc_9^L!_*5xppVDvkDg87)^`HTn%E6cM zX+EKY?FIN^pHiUoK3x*l%o6eqZV=KJdohLIffreTAcWyX^_AX>2Pk3Niv(i4sPvB1 zi`}Hu_96l8MbZ=TqEgOYq~GjC`f0qFfCgl$5MRcNMTBre2VZKm+1*Zo(t44bwwj7} zs4XeRfeG|8fdiFXHEqIhp!!Phz-}_qb|8Tm2P(ZIbzl!EwH-)6JCO859H^AD1L-$A zkbW8m7OA1FoeqQ;2bK^zsNSK*4x~V79mvtd#ESmRiJk!!lE1i47U6f`QWl{22*ai7 zE4@p5rArCKxK!yKsZ0B$O9^O~lAef5m2!3|{brZaPvg>3?NW6_L5Vx|ZqzQV#+Pzw zFat_a&O6jWJ-a+Kip}vj4EmF2cjl zfEpPY0}9zy2;aJn7qoTX(zNoqh#z+5ScGQU!*Dpo*YA~?Vf&01-HoY zMIDFn+F`=O+eezTeQmCNbU9}G2BFoqZ-`RCJx1Kuv+c{F`+URON1Bv{ zy@_~EE?r&E?umSwxfY*`WX*_IWPev~@CY@ekF5AQS5 zq%GTHS+-{w%Z9IQrO;2WxEIuZy9OQmdO`yrMrJId_CI(eYR!$NdLk1{rIvi>moe7Wu!@4)@At&x0%N1 zvjfm)Th>kb@p4^!*_QPZ9^Nw2q%BMHs+&mLly{AguHCCapKVz`=|``IFWa)igon4R zkAkQN5^3I=AF+&{ET->o2cgflY>4#hH}u+;<>(=ovXt(A0BO>erFp%6#IoV*Sw51q zEh``s(4XPUwyf~PmXRiHS+7;kdc%4KwTBT#4MCkZ_dWO3%?(X0mn8~kS6*;gVr}cD z=8C48#+Jmnvnvw~n-eY7Rf+PZrt#*Q?OA4YyV`B{ns*)++@FNp}E;`Ml=zw=`9iw;;{Hgx1E!v?eSs(WcBQ`G;$N za@+KO_|;YVdhkj0-P2T3oJA8<{h?KCaTfjSc}2eF<~pCRi5e!uOb~J8HEF&&xo$~W zD*P_;b$X;%%H*|4_e6T2D(&Yr`~MA9{!usB`G0$PQ%(7%T2ydd+ndoITAFI=wLR@HB5sitNcZDoU8uRZT$AEnO^ z_^4i#G-3U8`~(H-9P*(kH5;#OSs;c@2mM5-|0SoF8-O2sp}j4yL|0hbfnFYo57j_f zA5ECxTeN2rK9IBSHOaLI>3Qbc^c7({aqIh7<2(6Em8z0n&fg|qf5F%0+iPZ*QaO1ypevw@2mwrp9&!lI*M;dP#`_6n{vwF?a)vG+ud`IjNWnj`v_xki`|tQ$%2%&UUQ2TGZOdia@>-@XuT7fi zzD=6xzR9k*k6r$6^!f3cy})- zV);^P;b`mDZ&M%4x9OwpF!pb|-To>0$K>C97iUcvRr`3O*AFuc?t1z)Aj<2OlRwTV;%h#@3 znp(1a)ygF(K`(M$y6kG@u9d4-ETA7K!nN!0M?B0og`LwN>{92XISa_RZCN4l(OfoTB<9=+8b7StJbbV3j<58Qtc|qveGrH z)%u{csbN$3rkdKCmhFk!n!1`6=wET|8mv~R4VJB5wc-ZUAJin)jp(bdfo;oIm#Rv) zcKI@OFC}@6wr$nAhN3ZMC*l2|3(^!cm3L>-t{Y1ucFBt zek(h!Pp(MPy8rsOFT1`J1lMINRwLZf)oa!)!Zm$g!rzzTd)@jqs}}M%$?2Lnyo^%u zuD^Pn)RR>L}ytEq~2{SuWdrAz8PD$V(bPv2yU$@{Y8igjg_CgQGLeGQqdZNQ8) zwY{>bVM|s0#hV)Rea4E0rlzXe@|K#0`UJwk54ToT)h8+%>RZYyS`v-rHBHTQW3jQS zv8AT6DzT-hp|!EuThUNaUVCv>ZB<1}Qv+^^w$xN4TDCVx?yEp2US*t|IbBNknJ zDc#C!s>GdpTN!Tb*EL^8Hm)hJ-%>?3y{omVzM`7$meSLSXkdh03o|LeW@M(Ji6YIP zvna84>BWr++`X-80!Gf8FGEo8+Nyeh+C+0CPJH;9`pU-2O;>mc{M%Hu`3llu?rAM8 zudPk2sVc85ySk~Sa!b`*$X2adr@|ywEmc42)vaXDOVs0@FXVL%wRnJ0d0B!RTC%AL zCKI9@Acd+XW3NQmaf)qSoI}zfv{_ru33VPc-eAXEJaT|x2C=k*lVb*^vWt~ zTbo70O(f261HHO8qVUAJ?~=F-DG2h2_OX z7a%S3y>#`;m8)0Hg?p20mMmT8@wMvZ&F^cLCs)v*!q=(fl4aE0n`<=$;xf2iv3{)@ z%Q!slovd548h5JsdhOL~mM^;&qX}QHTfQuDPwM8Ra*(vRswh zG6Y<;cKPa6kQJ6+Frqd~;bebc`U%r-n7*cPK~c>jI0xT_^V{Z>FTCIa_jhqo`FxU_ z@A5gDi{~yRcaFNxE41R;zem&0+VKkKEhwJ{OGY~GoM`+q`U)3NDwoV%I1kRiXEbBR zXvQL$j!A!{`5EarYV;-w(ec+e&q)M> z`#9N0%0BNJ(WlBjbk&lTdac2IB<870)U!Ummi@I_C$Q|=Bu-PBaHcPH`_4Hv3+JF? z#3!61q#v)*0|epi->*;H(a%k68|>eqJ+D#cf-u9c=RB^^(rf?zL#4rWK#s3(sJbfa zF<;B}5~=@geaASC>Tdp*I-RhaZbN0)gLtMwZv1#3#N)Yvo95|mJZmoD#KXK}*m%}F#fgVG&9L#Tc~%fl-M^9X$e%nnv*uP# z9L#&%w5&LB`BL|VhKXa@Ms3lwzm%7u+Ja%lxK5$HA#HUJKbza>Tk&nekexD~9Vf>M zn~qc8K>dPmg)R1`dsCPZH~mK@e%tBK!u53gpN0R8O_UD(HXq6#*+^kY7wIrzPAv0> ziT8(*$$XHFm*fB0Tn=QvoxiQmddMApa{PJC6}Zh&zNLI#Yjago^Stt{%?mEMWZtdY zZz;d6vfhq_%~jqPfhJI<)hBb>slLxzD$1KG zy{BFAd{Tgg2u4!p5vs7hIB95CUlxUcOpFQam6}}}Z zD1cx~RYP4=au%t=ou8;=79_aU7ZqFp0T$~EqLO(!N}RS!A;PV!7^4?M($vsW9yKnP z@`(;U8Y%ZwEvbwV&46fgLu*q_Ra3;m+}RLfIT91?B1ov(#E2G1OQVdDOCMs=N z7P(hZB-|;ENG4ORaCa}pOOsF2BHRayMx&Ba2F{Pl&V!6@aYrR{C{_h-7Dq)3GyPlW z-kLOhGIDiGV{Jpk1}|$mY~Ng8URUK-$f+m}*h~WNr=n6$eKRbm*Ro$r8Hxi{OvTGO z+pWw~FV6I-mMP(>Qi$qA&Q-$mrI1`t{#DYq3h6Xt0p3@#6;gJ3rjJDlZFyGmo2C3* z*o!;UHEmv#5SlLz7&OlD;npM0XNZCxzg{p(UkWw@R$|KdmS6!Kx^(L5G(OgbRx;3Bx zH2{LLrcLGbTfHd>w=4_J*3#yxs!DIB6c%b>HJVF9({^v6lrPe9r8y;pXXJ#!`QD9E zI!#N->3nae6rUfeZt?Du()n77isn5iWM^7Nl{Hn>)zsrr-fhTw zw+x83K^D~Gfzr0BGSc-u83YZOf}pqfr7QBXX6n+24iINSP!kr1Y~W{|$zoL=5h->2 z6xkF=BmlCm0;m#^(zB8IKpO3;&ZaSnwCgg7#HL;@5XVGEa|*OaI;iZk(O{IATq$)Y zY|ET-iG(y(SOpUaGdD;|rsQRvj{;~cZ;G~)+0cw(PrHr~t?z{iim3dj2Q?mS)n!2j_&Wy)DFAM!Wu$mm%a~}U}6&?@EqoRT= ze-m0(T&y`+)X8mwFdA(U(kkCv)v{fRysRu(hh7TLhU*;rGV-!$v~P$^5s;z0Y`3qFd)y75opAvSZD_(=*Ly~YeB_~q;(SvIW@r1ikf2`*E`+%x z5Y5la8V9RrtZphtTNkDkW&5~Gj63Jji(c0FAT!O4*k<7ri9b(gv`jy#7D;CNm$8_h zUkf4GGtRHTBB9n*SuoD02ZAlqlI#qG$IPq&3l*U&JL5En)YJBeC=;X^gvEsd?fnW{}#Pn9Dv-(q6M$SxS? zSE)85V`a=iNufK4lvBq1acF)tk&KFpA&RL&*;&YY^Y*%`XxVyMIeFuKJY#k0R@Rj9 zJ_@GU8x%Dm`{MDK;?ffnFXtS07|AYBqLxkGbRo$&4U!5>`e^xS_psS#QIr;JDe=w` zak6KR$Dq`rTr*e5GLaI?%CGAMev@rYv5H+|_Qu5>rI;vU0V{-GOKvl+`0U(z0>LZEa1(ZQg2` zmp4;h8tONDH%bXIQ&W!Os}X|nEGUEfycQuGH=hz}ZlOC8o4xnCQV+Kb#{1ZdBWCAW zrzol##l3En?CeD-h`MIfi2Xt`t`G)RRCo_bJ_n_M$EIGl5R9LIyf!yuYFF!hRm!G9 z89H(${H7G1IbL=DO8BA_B01_Pu>t58QnU~WHa5i#yIFZTenmCL2B*nn7Jz!c5o$8e z&haZNysUHGil2E-j^Bm{q~0_sI3EH`)Vzcg%ppZ(_1IA4%@r~q2GwK0ic}qcx)u~k z35_W^G$E`jcgLyBMLB+pw^$^Qc_{*WDAh15u0Ze>uffIC(}1fH2D`3Y z=bZ`XLFDap<7E2~)HkUMU4c2!MI2K?z0Ft@~wK<|DTV^ZEkfAePC8me?+j4PPv-`ZRe=@ZAz zP`oiJmeUY8FN9 z$e9Guw#r*^_fFc8GYukj*DNBTV%OUYywAE-B|8V@Nc#@3x`}E`Xc@MtMpUAR^>Bxt zJEj0~kh{vNTI$zhq!W;frlNS+L{!}xy7eT-q>0lf`t@a)2q0cvv~f;68#=Lb3tK44 z>SCs$URFLdLowZ}M1Gxyk^d$oQtP{iT@TTcXA)*%RaH)mjDksOCX8*z-*h8nXUv{N zeblBhz2#ZD&WF0_a^B0z&dZ?td}>##laybO;g^?t{URCvO&R{CP2SHWJ`15+x72wr zOToFMrqVku`T5WTo{J|l_C(3Q2;ouB&X9Z_!h@eD`9g%Rs=d@(C_q)DVa|abjNo}!KFG%Q$r-98COs;wc3XFi+GtiN=R1hl_K&2+AQU2 zzmy@zbc0_j{eMzAQ%gzfV^VejWaTZ*6=l(JJ(F^$WYHB~=3A8vonSOx7G(l2cBw6k z#>>iQosDr3&j^GuG0%apIp!Hg7HTtPUV56EKk6+u#yM?kGTK%ZcElePo|rsCJ-@0e z_g;_^q>Lw9b>%fR-cO|L!VJHuxybvay!6YxHIaK4l7{j015$)~K{qedQlPH9Eix{jPW=MKrM-pTf4I@HLnkYnHt}7X zTvLcW$K(CE$miVkOP8!odL=$z@=h&v_N~Mpmy<=u4hoBd;Mg2b8wK$cpCdq{3vk59 z1#}k4B{(=FB0id*NM# zJY2IJ$E|`~u35QOgurfhWpo%OI4@_?TDo>g*_x}Dthz1?LuhR>xy&UgoUK~D<^~r= zBND-`bz4216JHX8L@aImDaDV%be)nhgFiLT1&MG`}g}p1y-7vbEmzs^5G+$4^Iqo zs8Y4BlydE5$lR;@oOluO7=W@w=Wqxmv;aGDR7bZ?ow+CtN(B}^fyprWF6=v0eaSRo z$SGVqoC-4BMTQ+GyvUe{H%A$5C%n++TZQueY#rYS+$$(Hg3- zmY$Ka;nEw06LrZszDB-61@a=a6t!;n3+?UcUdAMQFsvdYXCKcKPR%B>EJ{zle3kh!#LpwPisQ?#)NkU6$*EFMvEMyE@m$ zgEVX`kRsYHG}*^)11Fc61(VetzH;>%1Ka4#vnKnExNW)0byjxfIg{xgWVLsL6r4ZV zZ>WP!l~OPV>EiyF*B}Jh6DH#rL30b9eR{V^+0@CnZ&|No?NWAzj<688K+ez|yDS7i`|F+vm@?{~(IBzoUZj&z#N(r)DLpwYESqe}F z^|WcST;8L`PAQ1UbH3y%Vae@r2tg?)kbXuw!(yHy~`w zLUAb5l=LMjJw??ACHsw(!9wzb68gB2Wt*QhOV#a}eBC1qupWGUM2gIVuTM!q z@ZjrladLJ@^`uvOn7gU*m3c zn`-#r>l7(DCw%agkTQPob+P39;OjEU&4aINr673l^)@Nt2Vd_H+qk;%9(=td z1kQu6Ay@dCAADuM!>vjueDF0*MhG8#oh?P9d+;^KjZPDvDSBXY_kH*UQ~dHG8u7eK z-6+`X1(A}JNXhIe{w5_^DJ2(8!48vJCA(3|7EbZ;XC9E!7Abiv+g9YYNKwfYdURXl z-5~@SIZA-Xjk{clmvy?yY8hU=hr^aN?xc1yWtsE*S8m+wDbQN3GyO>+%7bW=&h;Zg zln+rwh05ADglH;6m6b~L6Cs)gQB{=^{Z@!hfoSt)C7OJbTc=KiXp45^c|w#65uM4z zjZ^O`A)5rBs5uv8Vxp8i>2#LS6Vr$=5elPwQ6^m&N*6}sE`k*E&@Hvm{R@*8L#7Y# zN8;s@LCV?~i@dBE$cx$!SMKi3&zJ&V<8ktGk@t*gisQ)DHgBzzorzLKoSP*-3q@Lm zan`#-mh)gno+eY_nb=1=cp}8-?t3-)3Dc642YMw@YfaS-)Qj^fv3icJYX| zSwG~)`J->Me%!Uk%R0Gf8ry_vzixE9@AyCOP1C(@RXMq7njQ^i+nc7p<9g@~cuw@F z%)trHiT=h7Z=VzO-sz4u!8y^1Qee)BPM3l=%sJ5$o=rK+&DzP6rSfQAcIL^GrLW(~ z(yY9E^=|e0O;wJA`LYzzLn`&->P`k}9b9?4Vb4*DfhG>?A5s8 zv)?pBahw_4;=NnSP^yRnS(~@pmEqJV(xLZPxydAuOzRf!Q*P+&1Waz-0!7}VQi76c z-Lk+tC^;GpI7R7~A{0i$COU|EL`oL0WP$fvDS9i5%1CAQMz=I(q5>$D3zYa2SL|gK zBC~jL1|2AKo9N8xFmuxaZ>Ad~dnWl|lQMsv6rt(XwR%@bT!^Xy*Ig$$atlsY-y}r~ z(P9y$PV%=XPEqa0L;;^KCG%NA(Jqm~%T$?FcuR$#2<}H=R#2pMQZ`i=v{xksr)dF2+9qXZ zaS>3}`AaE0KNM2reNvA4Lv5^uB0nUB=(>!MB7en|ds%M@Isp7>0LS5%!r}C=9?!wQ z?Z(Q!6qTPIxkL1#6rE>cE%5$b%I2DA3%r+wZ00%Cp2);kU5S^q7$%|vlLyH!hkfN` z71gb`c#}4{_2F{Zr$wqGNVsAz>uRl$?%UbD>y@Mt<#xFnKKn}auHY~Z4O`04yJ}gR z_YNT|LF1_+g?K-Km5!fXLcN5JwZ*$z3Q;Fn*yepi2(LsxQeIV2?j4W<#3F$*vPTM0 zlUdm2^$FossLkc5J>}jJDS?}mL@E89l%5ev+q~QgH;YS**7@FSDaz-F^OfF9q!^=& zN|nTIUP_3sf>Yr-OkeO$567!lp+`~@rS@G?ie_S@ZQgr?w1mus)&<_jq=cM65~cOC zQc6x>X`A;IAzgyTutm*9YHsnqCx!D+&Rc1EC+=AgqFJ)}U{o#=N>Hz(4rPcFYU zwN9NtOW-I*CAPz=QzLvzBlxq|S$xdv|&7I0pObjb>{LeU* zI_D$LZg|YdjT1QB3NTV;A6{~`+NYmR=tP|rCm6J)DIX`D5g(s2=i$OkBDwerFTK(* zLfo&ci9Y=oI!|BQXxu~}|H*)_owCNL>KK8pfTsp##{ELHFo*Dmyq1V`NWH4Zcoff5 zC;F$FbB}be8h=C{W9_$G0scxP{z#ABZF*QwBOi_Pz_;7rUzt&Mn77P{f0b_!UJg(3^@`zEp{&(Wq z28Ss|t%-O|1c{Fen&C~l#`+T)`W?ug{P?*y_|}Q<2kyYNb>zD?GjbTa@79wCu1_Ag zHudO@bKv^#KJVUavkzQ9EM?Y#>u06RK5+d#DYOqO#q|`ca-63T5f$NV+nRDR!|4FHJ;Q9$y zHsS-<-*V%*2d;lAh2p^VF)6nXTu=C-TVn2k>o-ZMbKrWel)4A5mq@X5;Cj83S_iJH zg)HrX>+LdN^uYB;WRUQ{_2*pC$phEXJsWSV1J_Tw1?n8Q{MoAl-UQauaH9P!1Zb=vkqKubY&+GT+{jAcezfC4BW~T#_&;>udWx{kJ#c-7lv)R_XGxiT;Ch}E+6S&LbA=~9aGi7` zm;={qBsK@G%cOu0T-Qp@2d=kE&IhjFCpjOu{*dJ6!1aD9FbA&xUI_lz4_rSk46qJd zKPyG%!1Z^fAUJUS6DctVu8&H=2oGHUR>ZRoTxUG$ww_Gu!1ZJ)a}Hb=NU3$;`aCK7 zvpsOVNO&SVaJ@uItOM7pq>K+-zeDo5`c1>tlA8n9tx^yixV}?L_`r3C;MRfb4@psQ z;QHfI!UwJ&lw2RU{=CF|;Q9&4`M~uzBz_#;9Jqd2N`eE|$ECzNaGm=l zw~W$0_VW>d9Ls^AGluV>O1k9hD&6Gq73t<;gwP}x&zlYy3t2+;JVU{VjZ}y zmy+PX^}D6SI&i&9%7O#ed!-~iaQ#UsG6$|75`yr+^`ow2R0pnm+_?6E>pmf}4qX46 z5LpMVeRAPA+io!uM;Bsz;&IF{W%@DzE$MiK5+dWDdPjz zostI!uJ=hvc;LEAip+uQe-wh?!1c4P;N*d8dZ_5Undpyu;QCv#d`@`a`d{1__JQkP zyP}aCxXyh{xFa}lJxfSNdEk1njIIw{U*qE84_ueJfz5&IcS>vyT-Qp0IdFZO6j%qY zcL~|+e&G7UA_0Bi`awy}f$MH5&pz3=Z}8i`mk%y$phEpPyUsv%<#Ea zj`dfne&be^lLxNJP0oR9?{TN+eghu3K2zr41P88Xx#8^t*K>s^IB;Do1?Ir@)l%@M zbKrV~o3)b%u1_Agwr9Mr_n-3pQ~L|&-lUIOyL|8>UHtV~Ge`yB{^XDPXQ?f&{?_vP z@>=}eh7IF#_uD&tN>9F07*DuvbUUNq30IZm<_TA$6qqMm@0J4dgzJ4mU_asdpp;op zxbBxS`w7>BQfNQn`hpOKPq@A!CBYM}UMUHlaD7)u!Y5omk`nWT>!=j`A9}*|TVb2~ zge&78ooP#Umi2^dvXt3RxC*4ue!_LGD;$1VIoAzrmX(VoHp|MtkOH%;+#m(kvU0PK zz3$7(7LkBnR<=uOmX#lt0==w!(8VKKR(88_{^-lfuetWn3or2JTN+yN>Pz7-eZ(4Xy*cbX<$00I6?P|RB-vEzfH z#A(C!H+rXKjM0lBq4zXIjmxEcp8WGQG+4iJc2mCK)?(++*ZfS%tlgBqkurNX<@hhV zz3o(cH{}^p={$c2n*YVs|&?eM0K)rhHIJ zt=*K53z@x}@*7g-?52ECO0C_Lzj9?G-c9L!#Vs!9&)1wHg;QQ(h*7?rzEz zQtIrcER#}qH)WF)JG&|0C#BYI%8v?J+TE0&l>wu>DSKs*a5v?ED>}KGGCI(`v364q zx&`X&rp$Q4Z9=m#wqht$?~px3%Iw{gv!u}8O?jyh%H5PHDYtf0-YjMIZpwNow02YO zlrn2KTn=jozdu zb*Ac&7zyGs_M|_s^4@`a1KiB_(o3VWgU*sPpjQ7;k*5I8f+6_u0lM!*m~*W#BC`uGL1y!FpOKku%YDknUu4vO`2~L&(wo#5 z7HEwqPGn$mAH4oMC*M?{eQ@-oCnE*g=bx`latpN2pU3%j3Y1i*%j6}Msz527Fo?+G zrA4YhUyyl3fez?Q(I2U#m!MRXx5Q*^0Jm1oqD-j2Wtp|D?~ZX(h=mE#n?X$VdCO+F zz5kBfLzLWBRM>KF9wLXgyiTqMPOb+`Eqmjv2d;4Hu>0pMS4o+*9w?JCdp*!7h4y;j zy;A6`2ksM6dp+==l!^5~x0HwLfqxPrvmW@N;9@;+M2Ow>z^g*)t_Sja?B2o8o@T8F z&J{9yJ+Mg1ob^CbO0D(423I!X^+1gq&plnWLkh)u;9e=W*8_higzkFa5h-=n1HDq} zt_S{Aik#%U#jQ^}ri_J#d3tpw4<=tCU&m zfgMt2uLpKZp}ijXTOpL|fzM01wI2AIl-cWn?@OVz9ylUp)_UN-T^ZH`FYB3BLt|CF zx)bWjkDu#hoaXzOs5i9g8j!K=CNLaU2gA)xo`!GC{XHhVeuesT8s4O*?KTP#CS4Vq z8=CMcM(<2l_KL67H{yk^G4_`xNxdpv!F)LeO0L6(p(r5 z^xHO-dlx!dv%Z@*&9B4X*leoV=Dex#7R}2xHMF$E+_2rsV!XVvrM0=NW=nkoEO@J< z+t03bLgBBTaJZ#zIC{P?m8>YMEN>}y% zQdZ&*x#E-02Tnd8uy&ojQU1LB$K6`&JRkT6DYMoCPfD4+9_W)odp+<|DRkBY$Ar{g z4~+k+JxE}NE!G1CQXZ}cE*2uQ9=Jkqu^w11#O`|FW+8Rg1C3H@tq1NBGJ8F6pOiW4 zflo=PwI1kpWg}h>JmD~d4-`tNyB@e)ikw(X>qLb@^H~MLb)E8`mEc$&a>77=Si8p9(aosTI+%3Qf93OZggcQ_kf<<18OftUgtfaUS2UC z8F>CrXJV1rT=g#8+OKPr>rFhfDE4Ri9e7I)a(GOXd%3;svX)<`neS(AD;;NDY#e9aE`IWD;V0h~?(>`D zPrfZ&zggeBX7+?{xRe3t&JMlbQolt}U!8ngxOx4t@>ZOSjKlQHc%64=kLeMTG5&vhZysJ%k+psAgaBbsgQB9M28|jOF()U1M9~fc z8Z>HTP*jjG1VKh2AlRr;QBhH`op6pb&ZxBF*tDXJGp(XHwBn44Ew+kiJAAcvt(Dw$ zZ}#^-Pk;Y>&wD-lx{`Cw@7(*YRjX>(p6Z;_{B7YqLjHf%w}rQNGvD3!P1|>>*B&`I z{w{R)rRwSZS2}OYyY`H~E!=O$JoNs*(f=tw3*k2X{~v!B{Qv&EOrOL1yW@4uL+$_m zyv+aPpO@+65BvQLJ$L3*>u&n=nBFk0htA(}XsDrPQI(MvQFXpQT9i|)p>3l7j&1yt zPOWCHIXz#8xWoDk9NZ_W{of7ke>b%L?q{0@w+uG_gU`&gZ}+VoC^agumj@p?@bEq@ zuWJVMJ?@}B@|!Duw=X|XL(ifDWB(tY{qOemzuVXUJ=>RDTD-rtyZ9Hqnd1hGoZs`> zyZ<@vxtoN(@A%21C%T^v9Wi6_H22Bv9?`xtrq@rKzVGxYV;kJ`=lXr!yp7T0_Q~`p z?a|Bq=&zgTQa^E@Oi7Q-i26xA%SKF}KF%DXNG6?6YnVK}$H7r_?{hEwly~Kya{3;5 z_~Az$(Zg-o{Rj5x>wX&PQFx#ik;XxktMcH32lTJ$r|>)r_~3#4T?Dakyb2HLf25N67V6P`%deO!=n z?4NJ0tI8RVRsJfhkV}>E7k5_i;k5&_oM&3ORvFvFUFKcz?h`t_S%$*G{1xv#{PjQEXFW3esHV*Rl17&ckg@Y8S?ZDM;EyNIqv`L|Mvej@mje#6|e=n(OCxQPB}Z|Z`Gky z{%-jNZQSVHBWM2(l^yo$P}rfg!yX-5xf6{obN$ZGnyhw!(@P#HG6EJNb~dYu~{I6?Jxhzq`fd zXjVbTw)qQWN9LB^{-OE*xGntCygc{Vu}#6bxp}hs*_-7Z?cQl88@zkju8qrWyzu&q z_wk(9Z<}|cdndVmclEJ{U35f-^>=irxj-(jec`6dYm@iW&YLQa*RR-o)9bg++rzz+ zjF;CxD;aN`uhw}}CG7uWzA9Yjkp=3j>+kN~`9H6JdTRL-|4ZdtLvs0fc|ZJ@${#Bo zYZLM3=M8c1B;!|kw5fjB)mz2?|C4?=4A%co`r&o3{(q$(z6ARJq#t(FZBT6flYUqO z>;EVHa6YX6pY+3*VEzB3A9mEfEA{_R`e6;M|KIJ0c-Sr1r`(4%qaM>|Pl_KK>Sr}X zW2e>EkBHo1zWX=1VcNtIk(1Roj2<^48asA;{lqbjj~h9D@`$MUdqBpyL;3n?BVzCP z_t&RQajW&1HbtgzM?K>IZXWvxIpiN9Qw+vVYKVG_nm#>(4=av{1`QrqGhlFSpT38U zC@YQ4#)mKyNJ?Ufn<5VDWh){n=#**W8|vedCXSz;BqL@`8s8AC)+>0`Gk8@V8;q?i zapyB*>SqP-WrJ6x!K)zJYze+sS{b~m2wnxTlm@YsmIunR;8hSyX%I_k5KAT~-F=K0 z5|{}}&jh7s%A@8_3kO-x1c79NKr%rfnIMoLjv$Pn+_Ja<>Rp?S7&CsP`*gwdhVi4L z5vAiNmW-V^Wn{zDk)tQnH}uFPQJD0gp7_G|q~@Mmq$i2-Ct=;mYuK-ghV<<-sDF6wVVr}r_}Y+?;x8;GiBQse808edN&zOG0T_3fFcLC-`DdL`=JD-lnxL_EC`@$^c> z(<>2AuS7h(67f_dGFp*{up*JeibTv6iI^*V%85=-L=5c zQ`}X-aOI#SDl7dc>VMfaP*w(|R0eHQ8C22r&++b?$K<-=2>F%?SK{>gh8a^w%pB>C zJ|J?}RpTiAH%ta^g+0-AL}`ZU4O6DN;op5~Ek3jvHDi2ynBzC0mW`$8nEnF}sUEER zh0^AYsAy3CqlWZ9qOa@~fDUj!``&*eWF1SBbu3NR zF`KMoHW__(6VWH*$|mE=CW9zTmROd|L|HNuWy!e8l5v$K<0?zWRhG__I(U&KqFHc4vAK!(YygV6wd{h*w;=`g4#Yd%tk`?N;i3%l?6CWjp zUh!cfp=2g{Cac{uS?!+5MvIT(Li_k2j!@D*K8z#PChU`0jgREQ72`uWLdg`y2XmxK zW+FbEBULi`iez#slFd<>?5mZ@5-XFvure8aWwHZQB=c2~%vWVH`pRVVl}WG4O?V~h zm@P@vF=l5P?I~uY;tFqP3{b{$(>=gG@0n+&M>Px!{&pJWK(2(lI_zdBO-Tz zSL9A2q-ler+-#}Tk&x7pkoXaj{zXXoSBT>MV>X&Ne)0r&CMDl==N_ipL984)HXjY! zl_msL5;P5uvGuYO%J%iJRYS*L_*Tkgrsv3l1-M7G&LdV5QL=l z2}$dRC>}uxCF6?6Mp8+aCX@^{9vexOj6NP4NtKMgG7)`QJT?X^mc?Tup+r{8;<1rb ziRjDXv5{1X=*!}p=7A>KuD@&sPRBZs${6~*hs2msPWhss^YPc zP@65XUM9vexO*gDGMQvgyWI(b=q3P7r4H;IS1P!*q=5K87gK2ac5GWXeJ z^zn%Tt(c5HK6fBhGWz&*B2>kv6NHk{$L9{DN`@MrJCG_FYJBcMs${6~xkIRm&m9OQ zLygZJNR>=@|myZt|g3CW;@sWSHBaN@u5|XY!NZOr{q$x!4$p9f43kXS?2+3GLNYX?o z8CQHVK&oV@@u4}XlF`RIyigUN3=m32AD>u|Dj9ve!y}b6GNEMj@yP(G6495(JG?+u z9`Eo7C895ncX*^qL|-27@JN-2zC7OHkxIHKp=9*&4lh*2Cj*3h^yA$px840%JN}dl zqH_ER$7SX5t}!@(ERXktgruH?q*8>WN&KbK`0!TC^M|)`Z0=4{`-{c()s(`22&AY(#`)iyUl8h6Q^b(TvhA7@=5|Z>1l3Ws!o=xjHZs9 zHr8!X?$oa3d*{aL$zJo9`~|y_a(A2J#QKK%$?l8taHFdXx0}jv;|=d-l!v$5%EQ}j z<>BqN^6++Bxx3va%`VZ!PyCDr*)HYQ5{4AsYby`$wUvkW+RDRwZRO#;w({^^TX}e| ztvtNfRvzAKD-Z9rm52A*%ENnY<>9@y^6*|;d3dj_JiOOd?(Vf=^?Qb$pl7&!g{R}? zJ;Ubf88%|5=5tG3FlQ0RKJWF?O5Mj@FpU6x`BWAKyF_X=mnG6)nWDH;?g8;F3*T`%WvBZ~+ zSSJGkvrWVt?`v5n;|jA))Fa-}v2GLfi1&V^i}zy8Hc@VT9gTIHs7HK3jCGr6kNB1m z>o(CI@l7Mr#XCJ_GAuLOL_OkNA?uR$2)8ZlnZdRZ8kGiJI2&xPZa)d#JG|f(UK}e6 zw)(PQNGJjK`RgI8blpl@(ZsAhEpuU`4{2dBHXitJEd@s zl_?1V&6EU@W=eukGbKT+nUWxJnUWxLnXsuc;nm9wPZJBB-OMv+ybMiCqxo!MFUZi` zw{T)yCY({138&j-N`vOklm_jc$%eTKuZw1~VXng7m~p>Vfi=p8xeBkiX2R>SnXoHo z%7R{>DGQ@=Gbyp4u;XXKo}UT3ekSbunXvO`!rq?=yMHF^|Cw+D$b?%!Cfo!v+p6O3(HjH;)GcHr_r%ZKE zWfG@5y?3+jWkRRF8|l6m+)ag(iTX}Aa$VC7*eOdg7$bBt*z54~tkrSPI)RZx^ zb=xC-3)|>?+*j zkRyidOnaW~x9xd@=;MeJD-P`O3xTQSiA~x%jlz=kjo^J{SFCpl?#n`rClJ z&jL0tcLD#i^I8145A=TE62JQ{%XqO55lOj^L%DzVZ^!w;INt=`PM^!eyTF$?pQ-A< z2Dp^lRr#;Vx!hcRpX=KexV&eJeTYfeL(Xim6ylanpck|@rcu;Gxs>~a``6sQpqEd; z*)kmT(jRP@2zv1^)Yn&n{z>q^0l36@kH+~R`4sEx=RyAz_`CvoY?s%8yN`)BFROt+ z=zO~9JO2PKp;&+TS-F!2{lR^5GhVn|@I}$pHgnE zzSj;omMb62mW9jR8}wLi3GnUxs`3Ax%B_8?ChQQCKY(7IuGe*jDVK6_zc~{0SngQh zJE(^|OaQ*vnHB4MQ-RCVjmj@l&gCuwz4dWfG_m_CBD;{FDOUQN8710Qlf`Jr=lZkKJ|Lm;gTLKNYz9 z`r_v0Jn%vPTY*bIwEEr&KInfRaQ96I&C9dkgZ>`@7ym+C<16q%|MkF4E30f!ZvA%s zC_nz&!L)H3x7(?ywO6F=RjFLsYnl6J#|a049^*L#csB_|mm1(wuWIE-0hfMa$Gwx4 zOSw2sP6xd{jh$uz-$lLU;S%t{Jl_Lc;<4@P0r1hMvD?GIcLo2K!3X`n1TOwny3RM? zqfg^^z6Wl7O5XShxNKh~>hl|L$(!w8cF6YvCk^t}Q@OP7Ze9}qKNR#h4jc=5@gJ=H z;WW_WIB+&_iL<+waRvDdQ=fZ4kK@3fL67-)4EXL4|6hPhxwb4PZh3nixYR3OVGWgF>fP)W8O|CA3Kkl2YSrgEub%kI3EE$ z#`zrRCC&zo^GncUoEu0#NA;~GF>aAOU_2dwW4%h1%Y&3_OE2P$>OTv7{^|;`@#hlO ztC9P%<9Lw=@t>zYt5SSEQ!eMS66Z#L8RPe#$;ZBkr<0!aa(#O!w{jP1xd)`^`vS-O zoJ2lxW!%3h#IIBT#o&Ya`5WmQ)#xSSx2n%(dZH)wLZ4lgTfNjKDkgr9`ixKUX(YYH za}Mz(>hoNR&uhTQz3~H_+q$;w9kSEjjM-WAMTKwO!PZdddFU)@iL5 zJ0w5o-yZlr;NMNT_@MuRz{TJ8NBw}~`Qs75@%Ukua*L-?3UbRipvUW?7o_Mf0e-Z% zi2q*>T&_>ray4-2=PUJm{$b@J#q*uVK`(i;IF|uG#?0O0v%s<37gG4=%DLQipvQ8* z1wItY-2hz5)x&`3-@viHT?+ilT<(s_xm|Vvek_!`2XHA@Uq;=5W4QyAbGb)=9_u>@ z_;FC~P~cMTJbiCCaeWz`s!zDwGeD2!&INuvlzTpKDR-Q{cQJ6R@7>C|+{K{Ba{ml` z7?k@Ma4EN1-}?)2DR;H@=l7IzxgUZa%l!=aa47dH;8Jd_zPBDYmb;l=G~{x(RL=cs zTi_=^xm|%vxz^Xa0mpI=RL;a^D3$3d&sr zT*~dD?|lj!%gxn`#ayoYQp|Yae$^59XeifxO=YuQ%3YxEZ37(3%_`?|D?pF+JplL^ zDEA=XQf{HXcL;DScZ_l_cRc8^+{wV}q1@@frQBkDZx(PY_X_1)?lqvta&H7a7RtR9 zxRhI>@7)O;%Y9Bcm-`~4mJ(ioJHx;D6+1M{d zv;i*VR_pOz2jEif8XcdDm2&1wLL1)TI}2Dc7!_^ahUgJytoFdjjaO+|j^K zvO?YCIN(xlt=4xEa4C1K*7pMCT<#^H$8s+RJ^{+T8n~1@RLi{qxRkqI%Y9rqm%9w~ zSnjjHCqlXJfe#)Je+FFQsndAA0Uz}L9{42i{|R{9j{4qjz_A^7(3?+OuU&zQPe1i3 zPvHj;@2&d&#O?g_aN?J%ehBeA<->_zr@WrHp2kL#h~KLE8N@Bl(}>@r`g4faD8GpK z66IGAAFTX(;!h~Qjkt~V_Yz;O`acu5zV#&WmsI~O@do8D6MsYbD&ljL|AY8@%0DIE zUHR9s!?-H2-#(LTiUbbBl( zK39DXAl^~+{fW<4{o%wrt9}Uae#(av@2Y$%aofJm0gl&aE>|x59T^8U>iE_KTyB*V zx<6Uo0H5bv{>}eA;L z@+nrIHhNRsNrOCZ4qSX}JK9CL<+((CDnXC&^Z_nDMOv>R8vPf*yVD04_dbG@i%Fr&@hp13mh@16+K1tIt2lr&fJh>xqVw26^5LxcJnlPdDY3 z=b`FT0eXz53b^Q)?K#xAtfs4;X^*N7x#;MN@phutEfs0Rr`aDKHQ`P71 zphus#fs4-^_4%57W~on}PI_?CAkQ6vi%&oGDOWCeo~%qB27n&N!=a#;@oIsVI|jIn zhfO+8E(9MO4;O)ciWI2JqL}e>Uhb{>wmrveVmgJ8P}5{kH=y@vqbVbGUNJ8^%8bc)UI8 z@yU4bk@#1reqClYS%*=(DqOj;DzDdiAMK@tH$$}P`bc8}s^ZVJCrd2>FcAh%pw7(X<}S*Y>6r<~*Y zj`UWqjl_%9C)>^Yv(EtK9M2KNZ64(LDLzf4w|H(NZa-AACdFqRaLn^h$}P`JHP7vL z@%3WfRXNwI8}Ta5&oJe=&JMTt>7=)M%_3f{J`bh%JWu*4*T?+|@mlq1x9g_ct5CVs z%i`IM_)zt!OYxZq9P>O|x#e@{9zKo>QuqzZB_7!y>2MV-0{<0`+xhY{pr7fji;5e+3$B%qi?|nKUei5aQWQR zJ^Hz)qTPG|=5PIWPvZ7@oRgG0i(orCoAlOi=Mi7p+L!lyiqE^Gk6L;C8sf{?*<s;Dh-;h4i;-x#ysrAFS8U zq_=wgPCQ?Is`m1JT(5!3Z9g^mc&}>!J+{jNf z)$QmL@WJz`FM(q`o%W84Z*E`fC)*J3s^uP|obxc1^p?*V#EaDD;S`@|m3MGq$@zli z^DXk}u0H<+A3X2tpci=CJ0Hn&nd-M!F7czj5IE-N5c0A7)DW*w|BJu}``hiLxBT2q zyh?r6rTDbb$$VBXi>CweYW1mA&h0gc^cK%F;KJ%4ZoVH!uK|U7eJ;Z0J|JN!0ZFC|B$Jv3o`qU`r`W~;`;a#;;)9tdCa*p#j<&uY4e%1K@Wbnc3U8jLw#+ij$?oFV_@%#?p zIL>?k9R2@E{!Qw?WvLHN@{j&S%B>wO&wCPIq&_Es4~|!7liu@bZ^@6(s1CiKW)_Gyc2*psDxBO27j`?p?Zt>gpdk*uqzMk__ ze4Yo6{r?T%Snj9fZ`;L}#PhY>Z&Q5S*BZx*5%Td7P ze4*OgM#lihel;?Mp9ma%CK0bu|LMRnp3{JfkLk|?j{1v$qkfTcY43bb9m0X=SaKLE%2w(aE$v;NjaeRfhV?TG!{eP46Di2gMHH2&WQxWrSaK0{M{ zP5_R1m`Xmy>T@3GF`kQnW52qLxP5=lHNanTm9ug3Cg3jve?qy`_jIW5O3-7wd;ogM zLy5-Us=}`<`NVc<2VC;dQOnptxwT7$`nc~*j2H32Jh-pWYUb#3F!2H}iw1!|#(zBM zUx7Sa4f-?GLmuu0J^DNWddWkB#=io%45<_Ky!99G!SmLfN-4!(e`t)K`F}ermpr@* zaqbR$CGhURaeQ#U0U9sj^NjmfpgTAB{h!So^#=kMeP`A81CII{;v<7p@^*rFniAd~h88p7b`(|3ti>`s}w~OCHc?kaCV^DDi6bxh}=$VbWVX zj}y1g=l`DKv-SQyPL5}L;qwk2X_|Dg- z)d4N_`n%KHc-srOSPz@vbqA*Kqf+<<%A50}ab7}vT)y{z0erCC-v*BHd`>=ggJ&J_ zsp|jl6ra5gY{>(bTcw=i?@xS|`ZuQdTml^9zn*+7{+o$6s{aEiK5Kwu{6qfW>m~88 za_!s2zl_EzcPPFeXYD=%^s-;D?+dsR^lw5xxta6}+W7(=0KI%Sm-#;eT;l1h@w`ty zO#qpT5eaTs&?W037o?lzf(|&qUDU zamzH|=yNssSbN<-e3|-x06y4W8%S^M^>5-U)Tie`J||LN^f_2Lx7T3h)*md+V~MX+ z|N0c4>y+nGx%Z^#pHyz;TD_hozFNzDCB>(8-%ZzdYvo+uuE6Cu$IjQPluJDAa=fSf z9}NC@d^j5P(%;r-oKt|y@nNIxV6FlmJU+Y=^x|XrzmND@_5TKZuzlP2b1S=r^SK4_ z_3Bfr+@&DsCnqcCyv+vwhFj@Z-Tz)j{`nGsTkZmXyif5L(if=y%@qA-pl=WD@)K~$ zTNm{y=pPp!AFg1zdn*@N2k@x|EMs?*y2+4i*+@wmgd_jgv#@efnZG^T#&TK0lm?&dRO6)?V8Yuh4jQOYs?{obx{|MSl+Y zTl-!>yh_WxGR5b0XlR%HhIn#klJa(LU4f$BR+(>+)`mX^W9RGhLz2*5A;tlF^z@a`Nk_Yq|s$BZd z>+a3o+UF)Hm(?XdbL5Fz&QdNuSl`P@Z}qyG_+0gQ2YfJ|Z%J?U+CY51`t&+14l5r2 z(PyA?tJi$3SG{ssUFv1uZ#4&euwGY_{yHspQHuUP;Mnd@r0}PKOa9-}I9C8ipDudA z*5bE3@5o%^JV80P`wY@so=+vdNPQkp@p*&v7SG$n7pu>Xhi|&QdMUShSvvrCACTVi^9k{_ z>a$zzrt@>4a*n4j@%8F+UW(66q_=o(C%#dAzD)6nj`DGGJgtdG(x7fRSUKlsIO#2( zQN;7r=av+oCrEGo`LDza)Ti}89~Z~7t8%NC#ZyeYi~3AV@o7{pGU?CO4=+yP4}kyX zaD4SF_~Uus8=#l{MWM#C26!9C?ek)t2es4}&lmPoZuKozpDNJf@nkT~*`VjoFUK>C!K2_?o*;^Wk3=c9f698VABBE$VfZ{U*8 zLce-+j&jMvR?se2gFkLxi$E{=pQ`aJ0WSS;z4pVk;Di0}SI~>kEcNMpjC{pkNkG13F#OJC1D)7O6wT|@Gj^7erpgyHTr54Hg zhleS*{%P^l5?`o3m#6sLM|z9rA>vKy^J9unn`3>PBExaJGjQxz!<9??TSLD(S-G?? z_NzwFOFJ&oc;*9_e$`RlbjvdE!G5(0^deoXKI=e_{puIcZv$~|aa>$X^Z2k-eRfyQ z{j)FWt-Y#=FH@iM!3X=zeLhR^*#KPHMK{OjcjdCWw4;6BZ>QtK`da+k z5MQa~9;00HfbmZzy~RJB_-gf8lH#)*xWwPlhZnu9+~QxT{BzQGQQmo&f5O|*cEs0c zJjW^LdYw#qtJh58Yt`qG6rYz#Z+U)=_s_sc+y)ub;JwQ z=cW{&rKGobo+REyeSS;v={TaL9Wl>aDYrb^@$gP5e2#LtJ^S$8ujM zpF)j)HSvz>zg1mJ{J6b$S8nk%sZWM@XZ4ww;xkvdx^AClhk`5Eyt_1R;T zkDvShLCP(k)p`IuM7h=1zSnyq_+UP-CVfB4e~SJa(pRfKZ*)tXn9sd{V?K{lZgE;Z zM-Z=3|0eLkd_GEg%jZ+X2dmHTDL&he@$p+e7Z&^1`zW_KhpA6L<+)CV`D`Tp7}Z~r zqW_fi<5d4M=rNy#^(}eEeAX(rI4z$;h)-1iE5Qfzc|YkbpG$~0sLu~6J_TdLe6H>7 zU+=2i;+&&C`zhyq&LsU@)t{51e+)S0=X3J0{H!BBPyP2fu_e!#pM#ZK{Fa}?h}-wt z&rk8Wne-OV9mE%EJZn>Ya>n^MIi5Dm)#ni9l4q>fAmFRrn?>F>s#9*;g^k-Mr|`3t zTRc{;dBhiKJkKlVcs?S%<@s~si`A!i{HELMK;;}yU*b#EXKsqm^`y6WZYI7=eLha{ z`35-V`4{DuXB*EqJIU9J`OeC@UPZ)LXgu}GInSq)-s*KW@s;YcJjLf7(p$TKKzz0O z6i(Q5dsQlL@7`|h{w$sYiLX(gGg5pm1de%LsJw&omg5i`=kHA6k1Mx$tX|8Auhn>R zCT_Z3+bcI8tJluN*Q-xmiqA~aTReXxzEORiNby-kdW+{B;?d^5K08d>biMWfj(ILq zZh5xxzkdq<2l(Lk=ysjlQtmshz3hH*qjJkp1hWPi& zhbU*CS4jVh>eqt)U5J05sV((t>z>wWf9jXQPg8Dj7H;9!Ka2Rf0?(fT9~|dj1CHgc zA)hAo|CIQ~0`LEQiqD=W`}a9NX936deE>MN@7B}2Pjh{>-0g|yb@I9+lykWclD<)W z9wFXQeKw@{%$y#^(^>TkluNnTzHgD<+Uq^y_In09Hh6!IzdLYjuluA{#5-^4%jxdy5(^2!S6pg7W7!|B+&l@%AJ;?zYz5AgZ>84-<#uOk^c{a{sYi2 z2fc(|rFnavcxSEeci@Blv-NCWmgT2OecBW6sy@AyyHJAT-a~*(eqPjeISTlFu3py9 zF9VMK^F`$rkJW1>@gj}KJ_O70^g4CZ_3BN$yZX#h&OS>>Z}B`zyi9$*Nb&hM=`GLE zAHz89cLgexb3A=OkNxme(64bTS)Q**(ccMr++LP~Uiwu(t=Dqkvb~h)_OcFqaC_MZ zdW^H<9A96l7j7?|luNs#elO7D_EHBN`_Dq~!R_LD;x$^Ym%#_Oi{D6Z?bYfuAHVg_ z!RpgnIk(po&||%B13k9a3!r}z#(`IXe=LRM`#3%WpHHFPzXJVJ;IkgM__WgFleVXO zKe0xij>@IJe*vFPz+)dhPAg9F*$4E?z^4?r1_bl`B=vv|x%I^k$tnXhykK4tIpnnG9{0Q{8-(Lq@ z;<0i!5Vts^Gkjpu?xHWzINK?gcE|qK1@ySx?M`~@SLG@CzO2{&GcZM8M|$i3Q&RLx zKriD!oo=U(67SyGSNIF?!Eqp`(Z6royZx?78{%c^bC7b$C;E&BJ?3)`@a53HAA=8$ z58I#VjNKyfJPZ0B%B5T!&kq2-UQ6+D>?IzHMVahaNK_9fsdrp@^caK>$F}^ zf)Dn?RiwB4yhD7E`fM}T2P|=-&jHG%zHxqZ`>h53H^|Rq;Bg+bKb!^rn1_piOCEar zFrxRs2lMbD@wpm*r*k$P|DMXNzgZr75MQ7^C#CpY3VO`Lt-x169-an{d3Y22F%P?( z>*KdLt=;z^K2hU5Mme|F6w+IL8;H+RpT#LYZ-E}``z7$_p}zU&wZxD0?W&yn|7g&+ zcB@)_#}QwmaV`WO?4OHCZ}t5%bM^T)#iz@>F#cBB&-VuY0@QZ^@Hju4`Sph@=lYIf zy^b>{gC6&@4}%`_^EmOBv|e9<59X)U`7QMlAIncZ@zv_nPdWFi380VbtMQ)>{6)ym zr{IJAyz2!m@w^2366I2^?AL~RS@Z|cOZ=Z`oZ~@{`?a~C$9B0E_{&i4{oo_z4%Tv? z0=<;`y_UNc^jL1I3;l}i-9y~})n|L)uRysylv{mO9vuLBDK~Fx|IUe^$8slv{#Ecl z8Tf}%NS^nZ2R?ZGe@lw~G2r%_&*Jn7_(y!{>G z?*u%K->)7OgAc~vH${IO@Yle9GWbaRUDW?H&`bP98vjk8$M|mt{p;X=H}E)qeeY@T z!TA4?qW>QF8{nURkq=n%De-sJ__tLq`IPv}H2(cTkMUQ5eiiul2Oh^S1-WGy_+b2} zr06dO{wDa}3_cQnVeB474}f0c@2Byv0zJn64(Q(k{||u2@wf5?YycmOzthG3eaRc@ zi-Fs3m5Z{sa?5{_Up+bu^b-GIjeiR0G5!Y7zYX!v1|G*FW^P#kJ{bSqDf*{@zXSen zf{*0C*xN^+f?kRoqw%-9#0#Xp82{$VC2#M7|5m``_}lpP_W~b`zkiB;7;yV+nK(@a zABn%aw~x*My~N+3@!tY^jDHd6{{ive3p|d$tuJ6X_+b1Wr06#Qe;@qYFYtcWf9!mG zJLR_h&eix206oTk5a>Su|3iSs`@s&ryc56&aXlK*ONA3X$m$^YdV z|68EP_}>Hlhv5Gq@Hl=+h+8&-55~XMrT%@9p?)vmAA$dY$}Ru3e)Z^Z&`bQcYWydI z9^;=0`j5f?kHF*plkW@o6Zl~K_onEV1OEj4SA&n_zf9x*9P|?Z5{V)0b?myvwufGo!CeEgrpt74V=?h)Oun!ca% z-H6-x(1&=9>W?RG+v7~)gH?YCaXVkQllU;zKMfp@&;OCae_}2bbj#M-!Q^G^qj@Q1 zuInGkTwhOOE*q;`&S$P0=$*`Mf5con`g_dVdH;VCZ>4-YE#K#$P_z?8Se`BugwUg$r*+;$hXRhsaEOX7*Da^IJ zE1B!-CCs(G?E8tE#?N)YK>>%^;-|C4x)^0vC4w|dno--Wmx?^OVQ0Qy613ZFoH=-%z(5%e75O@D14 z^Bag)P1qskj}os|zKZy~oE>BR_rzCTwNuOsw1Y`~CI0oJc8>X;#0y7z-k*4p@)L*` zE1yHWyYefDmngpnxE-L{HH=I+GDoagzW z#LLd!I@XT@{tdMIX({|F;>!-`5bq)HCmy}gG3G0X7v8v8%s(MseW&L+I&V(uCGo7@ zeDhep6Y(y;Z5{JU;zPgQG3JAa&syq_R3`wJ&*RwAn8L3jZr`W9nE3kdywmf<*OW+2 z+*}~yD<^sW8*%$y_bximLR1px68+u44Dj_3|G_DI81a=4$KgaXh&O3G^NCL_@`Wq{ z{tT3B_q!xcLL`oVe|$jv!v5`tihVzjHS6D%IaW-1Z}n z60cSL8^nhy|Au&-@($bhCsyBa%6BI|Re2xcvy=}b-l+T(;`5YWN_>Ixdx>BJlL!0{^L(RSYHe&UV0dHy%z%Xatt z1LAfA=11a%TCoBxN9rr_S1I3O6_#3mmzLEGZXM27F@uG`8 ze~fs;&7QwWeEGwk|BLtv<(u!|-?w_bqd zU$9*)PvP$qx9#F*;Xl;CgpDvuR6%^uh~ud;Syg zM$OUF#G5qEcYx#ltZ!3z`#oG?ZjpFIZ|7M>#4XPU61VFc#}F@wU8Cq^;(AyZ%_pwA zq3CwvUDfBW#0!~fQ~y!KE0mu`ytneJh*v3p zka$1kuMn?R{v~m{zLB@57g)V&RlhUw!OAO$4^=*pxNh#z1mJi-%YMgM%0+%N>qX#} zrUH10tS-o26b-JF+^*Yx;<~p8C0*?2sE=b{bFxU3_8*^>1Pnc_a4c%?e#2kYZvAneBS>J9Pe9gw@*vEAn!$7 zs~Zg^u3<(qiFfq2(G|pP{9HoZ#?Lp1+xYn%aT`AidW7*8YPtInFH(L2aUFJ|Q;BQ3 zqAP&oeX9pjxc$zu^oLll{p}0ZYkzCAuMezQul;RT=Gp*#nQMO=!Cd>>9Ol~J7Bbg{ zT*6%Y+Y7+u`xb0jlfr){ZvCXQ?trAe;$!`xJ8^6GLx>k@!J~;=JDx#YUq;suxBc2; z;PSm3wmhH0KO}C~r+y~hqycS}@s3ho@n5ey&hEskj`F%{;%oFgYYg#{i@p9#;*B?Z zegknk4_ZpR@I|kGjri0LJYPqA*>|3|(en(eS3$l!bH67-ysoR~`w_S6kb{Wds@Eqc z5nrVIT;lgAzY+L%(2kF%@VALuJN`i2+HuRQuea1j{H-1LC2s9_C~&+^QkTN*cbvsv z^mabDfc1KwzlgY<4=y8a*GX0rkFk$$h05FM0ip3K<+~8CQ{J0+qjLLwXY;Y^ zBvVLl*GbMJZr4d}A#T@6?Dv|@->#FqMS8nV@-1<@PSU=-rG4Z4*ZbGI5x46k2NAdH zB*Tf@b&}b{?K;U-#O*rCL&WVm$*aWeI>}eW?K(-@o?*T0I?1lYZG5obHMV@(b&}zv zx9cP`iQ9FOONiTblG}mfb&@Aj_*=wnyZDZ{T_@?#tEIkpon%+ycAca*al1}(G;zC5 zGMTttCpn*ZU6qgH7UFiD@nH#ZyH0W# z@kTw~8$-M>-}|0Ue3|kaf&T#YdMt&nVy^3~XRham9rkajSL{E{zuuksW1jb6p6e4d zjQOFSpTb-}ba)x_Lw%t46CbSnCE`Pse@T3p@_aqMlPIKKb;^r~k5OJle4O$Vh)+~L z3-|_TmrGLk-NYC9bVkn*xBFcGAa2{mM&h-4UfD^n|4Dr%o|WBv0ecajwTtKdf&U2c z4@=>v5ZCS*T}He>>vcczF3MLBFI4^!@Qo19?;=5^E%w|O1)#BE;38N_W~ z$3oyZujAen{tR(DPJ55Iolkv7+~##`(I<)*sV~mo*dv8k5x2aJAa3(IPA6{jI<6&d z^Ew_OZu2@;0$+mdo5G`mTIwZw+wQg}ZrfK+;x;}UNxab8Mkf(3R(>{dJ^hbvAg+fo z(Nf}7>hn7BYUTeVUaP!aU;iY>JxG0rDlZ~lr`&$u*7W0)A5Z$J%4ZUvrTkLjjmqyK zK2P~`#1|<4i1BQ^QXFl<9%I_v_^E6%} zK2`N!0LOV6dHq}BN4^vARjwUvDNo^t6VKNb>WLR9pF_Nh^2>>LRc^mOE7g&B3Y9-c z`Xc4;1AiUj-;lyP9qd;Wf6+Io&tAl>-TM+>pn106r8S>5%4dTf=T~2r!XE&R^Q-N5 zX~h=#I@0H9{H+i1PehON&~{4U_ItIWe-QF^BX!OSoQ3{nR6^YP$zjBcRbNlsuD9Fo##(+#RDUb!^)gQMH1P`6zfW8b zU!$LiSE;`90RP0w)y+BDhq$gDRTHmKpOM6CmCqqQSou}JpN9UhIEBAL-1^~K;`!>| z=1~7c>LvawzVokl0se0&w|5FZhIrv+{(@oy@y420;sP!vzUXMr?*aY`l>1@||B86s zqu0d#9S-yLka~&FvT5b=G}@bZVfU3WKa6gM@m z;J-qi&q?7o5w~`Hl6Z9Wb#Xpd0sjsBze?e)50~2c`52*V%3uwp9Q?q5`p-tIdL zBp&sT!-*ylx8vapiC10e^>-0pqhI>?Eb!lV==fElS}(j&9M* z0mXiLJR(8{u__jq#7dah~L;6#hrz;w8%!#4Qi^6YuEd(F)?0pO1)lR{gKU zEpOY_dx6Do=N+ZQ3)QEFc#-lGiEFow<`VC&`WuLA_lzDTUZ(ojiB~B9CviLP$RFzk zRxZ*`(y zQR)@z<%wJNWv<&~4RhURjAx$bea>Uv+VfkOxAFWL=50NHpSgDQ4b0nl{nq3Bqt(mi zNoJY1_qwB)ckp}?bKQ{6XTF)&-@$xy&!1twh3D@B$9aw@_#)z3 z-RODZ8fNr4aT`C|OlXN;%C+%xH{v#a_9t%R=NRHPex6CZ&=(ioO}t3?tHg_ye?{EJ z&o&diK)MailiVeRAIMz$+i}dbzn#Kd``hKrwE>ne*Z#JWx%RiOnQMP*H;L+{4Y?b0 z?Qi=7U#+o=!%-=G0&(jn=McC4a6NHr_oc)Oeb~_(#H}6I6Sw_chsl0LX%30s_G{gM z<2=dzQusjPc78E|xSe0jC2r>z*Aut%3;SIyiBsaS^SD){w|SEPBHny{H>IV%;$!#M z_9SlS<9&(SJjvn2?L6@m;xCs|G0 z=1GnsZu2DnNZdY8dL?n2C;1R@n71>0$l6kbi-wu>>u?fSqR z;u(N&bzv&6E6qxXqLNnRs25uYczmEqRFR+sD7|PTb~6_9brfB#$R< z^CYJew|SBm5^vNKo?D1FDSwjqGUaa(U!(jx;xv zKAU*Hu5c-Fnxn+~!GMLEPp^ zK0w^&Nxn+l=1G159Op^e@83!PL~iqvj4$%lkIGJM$%E)?b-Or%xNR5XiQ7EMvxwU~ z$!m$v+QpamFmRkF`Em+hOWd~iyg#NbxXqL7d|FF=#oy*h?oHh0N%jRU^BZj$n!@dO_avX9xA}haNN@8bZz68< zB%dU1^CaISZu2DV_w}q?nK+dRoWz-1nwEkjfI$;55DyO6kTUw06<@nIS9 zLM`}R;>F6pCtjj_i$?!M+E?PQP`)SeD&_r%S1TVuyjJ6K#I2v4MZD14MmG^JQvL+-V&(QbcNR}~`xe2!k1-*KKVNa`!s;cdyL z@WY8)eNQBA^*w{Q)%P0Wg<7!vj-JI+to$|7TR;4oxb-*t9X;`p>+QC5J>NfLUPj!m zKOauKNdp>7+^#>LLENrCUrXHXBRoRf?jyWG-0mZMOWck>J6sUf%kCrWM%?Zr*zfdN z9_&8Cv81>A2-Aq$eT0jM+i~yh#O*%9GU9e0;cen}AK_oX@jk-l7q-+Fd3WO0j@87i z9qWl(JDx?{+VL9Tc)oLg3V)8c9k+i#+|GA461Vf6&huO9E9Khx&OXHLeCH72cD_>w z9M5-Vr0@%gTYtNixV8J^#O-|NE#P>*^Gyo3-^-K!DSFG>9v8LbLAago98BEKcSaMp z^PMw@+xgDbz;RyF;uQWoaT#-E`IvaV$I-9EJ1XDiV*fu0HFC+xXn}5-+eg?Kq(uaT~XL6Sw1pqls5( zxhE61jAzrKeed2bU@FVe|s_(SGKe74_Q@$7Qk6ruP(m#cdWG;qo zIgPn`UBkSU*FVBsJLoFrt-bzR=50Lhbg6%oFyi>z`q$l=Ye(u+SxT3e^Ub{e2j-i5-sw;N(dyM|3;()1aGcjPAcc=*uI+U$b8W9%m}`6e zmASUp2h6p-eq*lf)%CKLdd2Z;dsQ&k_8Q4t+iNa!YZvC)E{_4nc}=TR_y*!y-Dum( zTjCcV4KpeyZsX@*;st*7XgcxE$}b~s@ zZTuVz9OpGnP2uyIYkynBT>IOz%(cIL#9SL7_sW*|<9M{c?ZjOB+y2b8za7I|8*(~x z?QipeODJ}payjwerug{kuWE@?^u{LWQkhA#~D#_NeM(fe=}SBHAzRm30D>&}+~ zmlQNk@ax|R9FHrOrSP|jYqLb(5x4DPvuj%76o1<;b|-GzMHTVRe)Z^h;wrs$e{fxBm7k@Q-qRZ1R8GTm5s% zGxAd6=6?in+b-&f+jemVaoaAgB5rX$MBKKEmBekk_=Z|e-XEFspB19VD&9g{T{^2l=mTCp?nze-pXeZ zuTp*~@qWthC0?!kdEzz7KPFzQ{5Rr*m2bPqKe74_Rh}U}O!=X}@wl!&g`de>`{(t{ zb&Pn7c`IM=TgxT3rb3Lxx`YvC-)yt0SGR*b3t_CgE%!F!)=!oZw|?>taqA~P z6Sw{Bc8kM$*?zVcaof)hB5wQHDa5NZ{_~0VQ+_k?YUNK7uTlOc@ml5I61V+qrw6=1 zy0>&q``xJRh}-uYe5~7n>D4~EP5ZBLJ1?+ylVNRHVuH8m3QJU#Hyk z_PbZtrRbYTZ}oa9MZc2tR^N_Npj$Ye0_7Hu%^Rsn(btmRuG7v>(JvsqU8j91MZc2t zcAd7P<~$LB<-LBKtr08o&Z|8%BZe3Z-$G?iAI(=f?+N+7UwM$z5)AF2_&$PUy zu;y)lPnswYSZg;|B-&lZ6_J~@-4r< z{rHV#k;~7z^4U|g6WaNRR>Dm-A<|c5vHpKx%KH1?=-013$LpnB=_kDYktyq6SmbNv unkQaleOZ^+uS;3~ab16nR#+Zn;N|tFrL2GL?!Nr>ZXH=F@k>p diff --git a/source/cluster/wham/src-M/obackup/rescode.o b/source/cluster/wham/src-M/obackup/rescode.o deleted file mode 100644 index 5fa41bf88aeb3196d10a4edc3b933c9031fc7336..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 12872 zcmbW74Qw38b%1B@j^s(CM2eIgS+=E>Oj?v|9mOBnvaH&o$W!iO{^3X}ihpog-YvLvp?J?!hOeln&uZ&H1VL&RK;-&hRT&A^7M$< zBx=i$ouQ9__>WbFrG>wOT@xt!E3|x@=~Gpt>Es6SIjYC#_%87qR6j+>05pW{o}>no#J3Q?K^)`8au@Lk#aU%z zagg{B;~ye^g7L?QpCle6KN;eajL#9zF+ZOsKFjp~g!mlee?|Nm=I0IKON?J9{v6{! zBK`vLTPglu5??01g?Iq!IL_CJ*Aw4Fe1-T1;@gSeB(7%iBT)AXHR_}chf|VQmjRv4 zNM7UNPf4yuy)4H5`^CC4ptC=ce7%SN8E{Q_+kHjq*Ln26F1hMuS^RgBZ!7~kdq;9L zT4nJsByT7KI@<}yP2$~Eo$4p)xEGF2uGUdI@J0d7s60}X}IomUgs8F86bIdJvCo#GbS^RyuL%X`weHl$Di23EhEeqk5 zV)$o~tMexyJ`jl?{wHXxhF3rUvDJU-cmH>F^@rc7kbzznwI>6k&p3xa{7j{>m!mVk zJl$1J<&~;ZZx9GlL&o+c{t65mcHo5c&}iVTPeGShe#Js8ZziX0W)3 z8ZtnPPE8jX`D?0EAnyD{=bPcqWs)zzI#_u8#+%<*T3Q; zm^3USQ7|oi#;{VxSlZNgx8!&0lSW=oo0*Biq~4NF>SrcXiAg<`*C#B~K<&b$nbE;; z+DMlz%Ld-d9!4pg?H^a|wd7@M`RTEI!AfN&^nAgv3V4#srZNS0`)Mu!a#SwY>*!Z2f}?}xKU6?C69%N zM?NwnggUO%aK9Ep$q(X9H5EA-VECsqmYL6{XUwFYF{Vr%#e1RXVav)|`aT`RspPbY zyl1e#e{dia9UL8qjtrOT;64mBA$p_z;ep}k;DD?lsa);_e7o3Ov7Kg+VU)Pr-Y&L^ zwc@;k^l&BL2R~;y2e)f>&x2Z9J~3%p#)Q!}oj0v~n{hhdao|APnX{*ik0rBb&c;Uv zV7NT>M}~U_W8t>Em55I!;$yS>lDLldr7|!Wrq~FBlE@~_(71?Z3TC=Bwnsk(i{63( z?a5B%QfbKMvDB=Y*JDOz!pz6av{6XS&{FaRs-goU;SYvmtzCPBU)!n)?IL!7+&cRr z&$WQ2OARfRH$N);Ge@ceT8p+1ZoW0h8h{9ZJ)}}Nn==6oRab$|MR1^n3RAfdq$vbj zNBnqm`+dSUbD|pB)l`e9=9|e?uUoHaDPh+pYqWYF`Zx1&u?`1XmY{Zv5AC2CaX&;* zmS{n(#izlJkv0n=<`#*XYTFrXYf~9s7Tbi|!rX@bh&F}JQsWak5Hx@M;>-|~^_JLHv-Q!y1nVhGc+9s)A@Cvqq zV8YB!c_rJ?73{lSNi#@t$uX~B4+y5R=?<@?%{Hmz?OqVU?p7h_!yvJ;1(-J%A)(H3 ztHXX4vXcx(Y7%!dkQcY_31Qw326iW0dBl7k>gj2U@v z&g&jRqk`d0#s=(_S#iua++vHe(-q7xQ!>DIPq#MQ1+uYhCh3*jgI0+|);ks(I{n%y zYbx)xfnJ@;rL&$GM9pT1ecZbQH$gfeX1O;0!aa+Fo9=)JGPZ1)%OD*v#iZSLxon?b z!&xSU|ICFjop5la@I5ZXp~vx+(rS33b55#8=mLzsl-YQAkWCQ zaoFC)XPB(%R_Mu8UfO-0%XU&P+aTOT-oPf^ThdmT0U(H5 zV@Bq*c-w6k+`7Y-=1nsxe#(Wdwr~=bOV&Co1ibZdCTwe$Etj6RFyXDivant3=F&!6 zYNT_MhB(Bfuv1{nQra&1xp;TkbwLqKN{NZF2+_x6G+jCN-7%7<7G}E5h2q z2r}|&97kV&%2i+iqYCV)ue(K}W~ZGE?*(Ez2vX&A@Lh2GHWJHxc%-=Tqp?beM*+Gn z6=X)ZbO&_4B=v4pJMbEX-tC-ttZ|nsi7S}Haw>WEY*4`+uwbMZhm!l&osqfn;?Y!5 zI1=O036+}SEs2`lkbsH6T-FALSxd@(%4PRS zSyBpDxe!(+UK*ru6WoeA*VbJdVL!L8l~R5um%~hf%cYbZ36Xc+4%JM-OeiHtiOK@o7M;U#~5? z`G*z9v|}dDE!)`Pj4)?lABsx4Y82gADdJU1l8)wxObl=@K z6zQ&jm>OELz#w?H9qPnm;r{4Av_JX?4{@M-Bzim?_gFaxU?dV|*@+D@0Nr$tBY<8v zIXXDN2#jhh8fJ#@aP79kG&0h|(^{H#Fuld|@bd{spwP6{z|AO!jef&XN;-74T#cDs+qA%YLf3+5F^?ldp*RM}|X}1NNYW=~MU<3Sv#MdlpYafIv{DUQ=Jy3gp?V(z|wxc%M zw7bq9+@v*Xc=HZ0t_^LlyVjAg3i`bne(-v36*@B8P*)RNqE{M+fji6d0lOB!V_kK_ z)4l-s7U!!2&j4BHhw*{xx@z?wBJ_);lHc2Hk^K9c`gNon_t}CmCPMkMQ}S3aXA7eA zyop;k+~d&`d0d37Y|x+&Ib@x0R?`W4wa4VRL!&8e{3ZVID-^0z&_>@tI=ZwVZ z(Ed=n)9?TX?HwM{#mRjf+|NOKyN7goh_~%~JvyGIJSqo0Hv2uqtK*5d!(+AIIZm!Y z>u^dsos}*D6Tp5sq8|9*wv29Q;EZlM%QrcpOtxT#J~%MC4<5`Cr(p`1W789G-#VUE z=jjx@93gIujalZ5s*PLt!X;!*#_6nV40C4!CLg@93dsp-pO)n$vw_`$RJH-RlceOm zhZYdN(ZxlqN`y`n&(ZcaM;xpB;P)$B@lY;0c*w!OL|pkfNt?nejL(w)n+`ut|Mg_2 z{M?}WX2$2p&meIgXM#BHICsPEf9&vA&pGtlfUACelliCc#9NH3j~jmF@Z*esBgLiS zpCd<2jH`dr{tj^-{~*)9L4HOUKSA}U>4*nsJQtY0%FE|Cr}{tA5f4s3KWF+XFX|%% z)nD~-Mkl?j%{NO*ZRes-f=sV~C zFBxB=ezwuYi^o4oT*dPo>8Bm~_~C$R_oEJd=cg9G=g{wP=&Qb<|DEtt@h;N8#`rm@N_B5GUJaC|GtB(F+kCK zYw!lzT(G}VA5Wm%!#T}^DCabe4gr|-QQ$)D<% zpZI>xaf5;~z&URCP)>193+ZXjH`w|wa1Jj|uq<;<-+{gD;0J6~`S<1;d<%^S_Dkwh zz7B9s`HFE)`O0xl`T7*+G`@e%ImP#F&Z+)yoKwCU=va!M^3ut<$_wX|mz0C!KZjNM z$sW=h?W>v_aQ1j*!(Wi!Glic*sjyhT73V0b;TmX-~0gY zIp|vjx9t(C9-$$`p6`X93QJ8r{LUN0r4fZQyUdZ@1!X{-Rps~KXipg@E%^3=QlnGK zl|WY~bew=A+A}qAn6}W9q^AzLI-w(eH%wV~NiLAR3ql3kau)o)m@||s`zLA3RyJH0 zzeDB>b?=}#^2f@Mj$9YNSLO^=Unl#o{6F@1%U{WU7C&%-qHYoFnpYRUe@1&axXQIP z?0NoiUh&+aqt@-VyDBE+vEujC+$UP@+iBZhB6}61+LG1$#qX{w+5dgBZGYLZb>kf8 z_V|5vCHqBueuSbHD7KIDjN9XP+?DLVQo$Z~8*Y!^dsnjm3E8WDV*9wHxc&bD`72uz diff --git a/source/cluster/wham/src-M/obackup/setup_var.o b/source/cluster/wham/src-M/obackup/setup_var.o deleted file mode 100644 index eec1329dd579895a2ebc18693ddcd0e75b63be8c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 17888 zcmbuH3v?XSdB^YULzXSslI55DUfZ%Q8+-MzF}8VFvb=b=*piTBf=S4Fc6TH#UhQsn zSGMGkpkkmk1`cU4q-kj#(m;Bk)aR6dNz;SEBZd@;+op|AoD{bdLIU)d;1<&W?)TmM z-QAgQR^gF*?46n4|9;>7?qlxUc^uso+Hs}FFua12A+8XHKCo@iw3iOr@D+1jooX z60cHN%p|^z@g>B&iPup6An`rKwf{?rXNhb755ln*dYGrjCHHeIo|e4A#s5)q-6|#d zXOdTz0PX!!^2sj#E^tG*%k{$0@d_Pv$!wbB)g?fCizU~!FUif4Pb&f1+bX$k#ge=X zcBhM9UkDKTugBHSTE>t60s@D$p7CQtif;m5C!i2Y3utKXfMY#2w1(R-nAywSL*mtp zd&zh=$q^d%>O<73CDMy3m>X(2%p&2AW!+HyrQ-?eCUVaL%U9X z4}Cw09oT*x!WQAfp_7qAKUg;|Cm(QBE4^NRJNWO7(6rXt7O<%K_WMUI!L$Z@A*)hnvU!tq__4*8B?rNVJl z8R(I2-Xrp4o~TpC%hYAuS)}%@s`D}KS=T&Yrbf?~b$=M@GE;WYh0wXf@Nd`IOP{W} z>z)rUTsRy$f9v>Hr>Ux|VftqC;m{d?Gwtm`(k#Ue<0Vzx>D#Js_(Vt!vlpJZyFZgF zYz{OoPpsM;=pByb>o_V z2Ls7`AZ6wAkkL%b+^NidD;J1mhSSmkI_CY`$9eK9esk1JHqXePK=w5uW9co?r#ru755`uyE-F% zy+Y)Z2dsQNH5^Qs1+?21*%|8WjdXQ_hUtq71kLD`MpHgMXywcSvuQYQDD-hAuD z7dP!6y}>+?$m}1D?&|Cb^}3F)>+R_32{q+&@#tVY8XH-g7#q%Ugxv zY;>QQ3-*ghx?rUmdsYRmgl^A4pLJx0vdI***Okc;D<9}F(*st%$4Z%n>7WO8n!>RC!jl#v#I z)Sns7C9Rw*!s_K9TB$N&R9^%N4v{h*TTzN<%P1Q`iO0;mP+Rf$KTCahlOp2?y2*U{* zSBjT$5t|;{SE`*%t%E8+>r2h#+8nQuv%qmq={c@1gLrdRe{w|p0h4AyYi6Oz?qj@e zHAEWEnT7aZBAFB4V)6`#Ms|;k=Lx3PT?{IYNvZybt58p9y?&Un#Lt;FV=mNWC@<~) zn`=v`7IF+;;3}L5SVtU#b#om3C4BQC+<4x^BAp|k9!3BN(Ok?-?-k3OcK-UsO3hnV zLTun-qY?+$YKu6+<&`DZ z1@Tv0ZBZ%=H1U0=&9em+%~?aqbaDtTdaAzJ zu|)NT`vS2Dgk-5Z_zbjY9?7ylTq;idXskQLl>w?QGsqs{>SCyTQFTvMi}4zT-c_Ht ztZ|kr%4N*qbSipxO;G;DaKcC#o09tu*dufFiz}y&!qzdaJi%g7yd>dU2_29%bMEtG zIe3Q4pqgH0I6Kt897Y^m3FS$+_UK*shn~5u?!F;Z+ zl~Ui!br>mdxs=)%*OscuNs3?NBFrLi$&}i+xQ0_D&E1bVHR1Er_zYO7IMzExz0b%d z<+{jzAvNavjKqGkoU#NBvYC|IW+f`?-25W)RYqzB$r@ z2%0r=Wsct%9YtjwR~Gt>0|!vKf+?OAej_Q{BEl7@auV8Fe2xpy2WdPPO@99RJ+nd5 zYjyjO^UMc9-bnE2z_SDtEQSdJR`Ig0;gag??iSS*FcI~O7>msZ-62Dh>JV3F$nhYx z5w1am*bY)W$i)UVE~I#uQxra5O@$F3G?Qs(ob^D(pExu7y^AZ1L|irPurWp`W8rEaHP5s79B{XwI_$t5#${8{X&RVRmFbd)o zR)BW{WEN*R-BRgn`5UnQ1l_2&z@;W#UH9yA_y@G_^3-vA+< zA9mkT7|^h3xdM%rmDiPI>r1@)eq%MrRytAE)-ws(z>LB3fFaT1j7RwVH6C0v!wom9 zf>G}=OjB%e8u*R*9wQbLJ2+khxrYaa#BMGuLpKT0&-qI513b_9MUWqExyCqeg8abm zJTrjD-D?id9N^Hd z(Se+Jj0NCX3{5V(T0F(26(B)BikG+m&5|sPW-W1=D=ny4De*cNHYk%^#x-0#mt!$0 z6~jBs&RZ!(jN$_>VJpDp9cwjdK08UE#(1}^oYrx5iBi#PfNQHjGYk26)P2T#v362( z-)eg|NzF=?vGZXi;E7l&>bCRMlFw{8!?{JVjO9`g^JN|g_+T_+<#|gBUoA9QERz^@ z%t}+?+_JKH5o9efb%A^sG-QfPxdJ7_W1=B5nG|8Jt@aqXe6!fadC&v%dQ!wVhhYvp zD>7WTL*~M_jQD~ zMc|3I4!5@h9z8n?>Wyp*bvqH%;mXJkTP=Hb_OcvUE(Tq4jiEsElt4#sd$eb3d*@Y7 z)Ef%H`+pq}W(r4o`?`8|JE7YUNsBWRz6)qCgIG4SWPw5OPCLvK?FsFSbVhbYuHzwg zw)aJ@2}NC2_6Fz+hgk3QbTI(cbhaaaZBDYatCJCE)t*R*8HRR*oOalajCAmBEe^ZM z20p=`V%+W*pLqA4DW5#=C-aN(aFZ&wG{6Z>PFP}kOCU zVc1`kN_3=x5WPzsd+tZ?`%c5VzRCE}f=q^|5^5C=_pQIh^Nis&j0VpSapQT>@Oq5y z#%+z)duDmP#u}Rq)C;RN-I!lFqsm*kys{R){_q5iORF|jZLSJbwN|aH_Et`Zmzi7O zvlj1qp@de*8=2vOSDn6jl=m{ohrrMCpkYOWsH(aGjNo&tI)TLi61=~U z!t?$@G?6q1((pVj85g~MJv$7lrM$P4W#pNr`yHnyiI>Sn39 z5)P&_1uM9{bJtq9v4j`v!GskX9)Q;({TaQVN~SHnZ^mLdYo9*q&*7WNpfwn!y^?V> z506QMIe5n(lwGZMOFC%^s1jsm1<0KwMeq6>4?KaF!v9C;LpC@IWJ10S{{I<$$Oey} zWa9bJ7L(3@l=3$!?BYSjwg2^ue~0{RW?cJ+1*A+oo-}c+ADrdIl&3w-<;OI@9wm-` zmc#!K@T`Y)g1F8|yP)%OzOx?GtV zelBDDJPG@4e(dq<2}}DKqx?shADEeBIyr%#pW3)R&NGbb{(6%*))(_v)0eZqX8Cn} zWrIOJ9j6Qie*D;wkTfSZqMA5v?D2HixV;@ZZQPzeN?iLN!@?jX7_X(c_fFvF0UNiM z``0#ZFZT)Jx_#EempYjKmF3stoW83po=3W!f5r0a^XM$&+Ry(ouKj$(xb7F9SBB*( zcj^S3u6MG(;MGhq;UWeTwllmnE~dYwJ*>U`GvvQxTwfR$Qa|8k1?9ob`U&_>#&sD3 zjKiWprr&2A)(tX!gK_;q?PHAV3;oNC>$boTpE2PEc0njilV!T0Nv59d# z&tAj0UZ`Xl*B=5OW?av|-)4Lxl{?P(WyF8VcpLHmVO-DG(`o$Z`i3e0TE=$}-_Ce9 z@fhQM#J|k=wZxAw{srQX+W1OhxOrg${u<}HUul5hq4Y!bU&J}tU&=Wh@8;aEf*R(W zPPikS)3^A?IH!UBJm>T+{x2B!68BU2x?Wy9ks&SP949nLTR5i^>GPb^H~OQTPg8!5 za8BRoAG2{i_R->{3HYx#r~aBk?T3fb5B1kd&Z)mboKt(nIj8b&=A4d?a!&pAea@-B zUgMnlrIPH5@#}u!ociSo8(*cGSpI%t0)BvTs;>A`#wkqkB;$JiJjJ-4Ki^|q&!2P1 zA=V4y)br;C#`XN!%XmQ6N{Fv8-a!1Dj5iYhd&c$rdCJCDQ(oMhn}F9+|6u$wKkh(U z!#Rz&2NKF#&&^@!A8*=w-&wQv1Kb_?c$a&OW++ z;t`g6lG2lO+O+H(Wr^~8G_UqC#=c!2orHon9b=g|rH6O511xID?Ypa(5)Fg~`N z3ZV%T>xJcxuTZ?6akZ!sqM7jk%}Wu++la>)-$VRH#>a@?$M`M8|Az5DBz}VNJBYu^ z_}#=mV*Gfks_&fXYOC9!a=SWiVfumBgF4#{KqsuKgsw9 z2bG_nFy3&N;_otEpn1EdPU*T{&(geo5#!Gj-_H1p#N&+X^Kp#vA5;GO89zn*amIf} z{AI?^5P#jqn^aZg?}rocIWtQ2#r*obSjV_NFRo%-pBHh)MXU0ABjaOND1I;Ffh~$Z z%J?|(7Z~5urt-haxM)}WH;f-8UPtQ%>|d;J+g6o-HRI!*if?7SjmGnJjE~U`ZI1Dy z#P48yocM!`pCSG<b+H*TEZJOjzG$xu<^COu)m8SCY*h#@|4P zkVY9lOZ*jEp^*sZ@|##ZUXjHIz<_EwKdoF z`gj}cpgoV_9NmVDp=e71+dl5%-zlK14y8c1B@PG&%$>l$XTTZSX#1G%FLK25;@>^s z472_lU5?)-JH6p~@$VyWhIyZ%%k~j%NL!v4|BeD@nDyF~${L@rQrsp`868T+=~1WxK54 y8O!bQ??IHaH`}FoaZ1ASag1|&{JRn5?7vpV9&Ne()(Px?K=!(xSUwJEZvX!hKN<%B diff --git a/source/cluster/wham/src-M/obackup/srtclust.o b/source/cluster/wham/src-M/obackup/srtclust.o deleted file mode 100644 index 2ef4ed52a3543ed317d7eeb37ee9415cca14dcdc..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 41760 zcmc(oe|%Kco%hfDNDKr>_+?QM1_X@?Ark@wwF<)Eq$VUL&?mZTm?RSt4M|J}jIH1( z#FA&krYbFMwMB(3Dy?*DTWqlgOKbd9sq!d3;x64{pSY`Qq->Xcw43MqJ?DGw-1|NE zQYZVzb6+I)-uF4@b3Wg5&OP_XTrzh>%2)V(zJQ>`C$1Dey<=PN{9bxziQHTwCWtX< z$hJ@;C_WixSe6L5l$!(@11>dBmE6x|#0tqR+g5r#Z23TGPnJSCl(LcdPR9Fy2f!&` z_DD{dZHb3q+b7aI^omM+Tk^CHmdEAa;RpTbrI9wyf(AmKr2VzDK8N_A&PVG@i4QUU zMdGK4kD_%Y@gS^m(L6>xpSbS9F5*)e?;&15JX^_$ZxJtI{0ZWv#LuGqza+kd@z;n) z8UH8ZRg8Z^yq383AAli(?b*oqWa1sfbvs-{{7%Lf6W_{ot|k5u<2MoC$#^^Qy^P;Y zd_Ut45-PUS@uQ5tMEp2$-Tvg&LHso1qhM;5;}hB&7p;FD@f^nI63=J+ zD&kWZzm9l_@dn}rjISqN#Q4{Umools;!7BRig=Xq=ZIG^{yOnm#{WQk4RJkw{!F}; z@hlhs*q+^te}VWG#xEw`M_iAe%Zcw`yn^^n#_NdhVf;4Y`-toF`)1<%8Q)I4pE!gm zmmd%xAgi_+e}(vQ;;<{1_lOTN{xR_(#(gj#u{}>SK8d)#6w&$@5zm3~j*I4( z5zlA5g7_51*ANd8r|Lx)@mVbYy~O7*{%ztV#C3b_C4L2Q-JZ`Ak23xS@m0iiKfX`= zM#fJQZzQhk&4q&4o~^`n`%ELAU_4CxPNuV*_!h?h2l4xu&Mm|rVtgaB!|k`vPp9I#g>%h+C@5XJ8++M)=l%>GQW-{&G$(@E)8hw zpyaw0)5&j0u6r-dPe?vK4QLDdZM--+9HRX-w7wM9$hA@l@i6fa?Uyu6mm_H*JkgM&7VU?0C z*&EsUVq_QIR-__3d;0V4-wdNJ+7Q_l?diX(Cc631(0&yB1^$XQRP2iOj+qsGarvwq zEb@Fn>}R~?2*;=^l$t-mk=7pY?H}46x^|evcsy&5enin)b+&y7;Bq8 zPj#5l7TQj$I!9=T&rqH05Hx-=FF*Lg$-MDBr?G1@@3=iy^^Rx}yHuZX$L+J^9nm3n z%0nD-K*|to(T!jJ!s!u&wco1O5f)-+y(1fs{g%8VEX1aKN)5-}$k7)g@=h)lIlB3@ zKkvS);WQ2P_q!i!{a(k~fK|DQ4K2X2hS;dQKkC(GX?b?69k%3EY$T7^kk53QIBID- zx&^U|wwLwvEX1rIx8xn&g4mGnkGAyp#jyic?@Ddy!(*v8GBkprHfUAqhzYS#=`PRi z@Qi85l6S;}*pMHBk+jjAR)?&Sgi+e2y3>}n!#ZLYZ8gQ6NuEt@;;;Io;INL^Mc#JM z!<5#P_wh?7^KKk~c|lHXC-Z6tn(_(`$}@{Ro8Y8ZJ3OLEFUK4@T=Vi|PAkJ!av#)o0Z zl6S<9*hStJUp~a=?BF#c>)-;*fg?b~E)Fsdu*i~k1c=xvpB}yW+b|Ru(H@<;D;3$5 zTD=oHb>m;sS7&>ytFt|Lb+&F~S7)V`Uq^EwcKRLJ*>H&^?`RIhro44F+?R^%8y@J5 zJo92i_IWDu42IYSw?klKzxzpXzcrPy3(%YEtZOWJNADmu-G$giJL4hPXURLd z3$Y=8!fgnig6=rwJ_Ju$-NA<74y#f}Oo)w2Pk9c(v^*PvJ1u!fOo(0N%^{d0PY3xu zwBCk8vMF!gK;FG2;CBQwU=dsk*l)qn7R-Q%4MQWC0ZT1;$M8dJ$Y(nImRQ=3u0rgh zo$>ICTJnyrLTt!8X26P5z4ysGgAvRIRaT`cCh88vMx`T|4QefUM|U7LlYVOTGnn?kf5@~UD6Yz>>##kT_Mq)LY_D}4wiho_z6;MtVN7J& zuzRdI!_lyajmSrE-?7h=FxO?{EF_L-bC9TRFu^=`o8$su7wd5VKAU5T#SoT3IDH%~} zJ8ob8!p3o_9^C5fIRL-^b&N_?dnw6!BZH~PU~kVekPc7caEzwp4j$2e2M^|@mvzr+a=?;z^ax@@ zKGWmiu%+#2b;K^(Ue-NZ{ir4HXm!Mfe5S|2aZB6L>WE#my{vmaza6yX9j%VokhdKN z1Mq1Z?7pNPQQu@eqTcdtyiOUxaWQ21aP$yj7av|>diKz1OWx5#hzRK* zwwHC!<08kBck~cqL*Cv)sckq#={tlMdy-H9JBOaoZpZTsUPtc!PdSlgIxh1qTaIyw z*swK%Yltb9yd!GFF7oz^CVkNj7mXvhoCsOJJ1)H{O9i2_UB5f)+>c}G}y4*?%4 z$ZKJCXOa1(ev#$F5hh~8#|V0_)RK3EiP)4^mq@*n)TiQ^UjZ($Ds#kw*r;p-T^6P>_`WEeg^?C9E`FZkpp?f~~-%xAXKi;Ta&)$JZZBxOG^159cu8!l_pTLH3zB6K0hN0Nre>iMa=IDLI&dNTx7S%JqL_ca(;D`pXvjVB@b@uQ) z@g2A19sUu!$XgQ*3>jLWx7Cz03O^mvpL?30bvENL$~^o*%bz2B#4i3a4u8m!cZ84F zl!s7zFbp_|g7T;uK|H6e3LWtvHY@aemf+c)0tT6Sit305u_=%7-~kEiF)|+f&=zM1 zg!+Tp132p}2YdRkeO2FlMqb4`&mY2#=m^>&$1>_@2gIh)%-bQ~l6SNNVi$SWm&MX; z%pM0#v9ul55xZz-JS0Pwyu&(TQy#ib4Mo`4ruy<`{D`*S8l$=&U&Vf`0TDPvF;#Z5 z?Id!hGs3U%SeNI3^+|mKh|GtXKaxya(&OW>H9ijG_~;nfTS5g^D>xb%ak@%5iQ}A- zaU&O5@{UGEY|5YUII%S$yx7p&6T*4!%x723LTA^FTUE36>1KsC?UN_f$X1(?%;(Kg zD?ms4A-3tNHyTIKeoHKQNBbdW^67KzNY3R^s~$%fh&}6pbNQyfebKd^>^S%``~Uo+<<_Z zKDx*EEHRZNVoK@3I=&}r7LkY*(Nn}>oFb~=y7dFR4rEtCct5XSIb{=Kt<`ppPD1R` zcJf%wyMHQrb6#xOt6tl~2I2Gal%Y$ak^iHMAMH|#B znHWuz%P3Dj7>hRCryhxU99ugq2aW&{e?A8)<_t}+qi?5W!qE(fKc5L}zD!l@>Mg(L zGd<&ch%?TY;NlX_qD3$vK=Z=$Cw04f1k);DHd06P9$(&;UqJQH`~y&LO7!;ZfwevW z!^zUZ*D9b+D`i+09+(QU~)`U0_wyft*A zscpJV=6XzHdNFa5fy zy)$uHs9<*E#g~O@*4KA6bhdOPLKn<#47E3f63y{Ytg|zAM`(6es5#aZ+7N499}mrL zZ4BMs+|tk-YUv8K#=E*8W2{Z)Zf(Ck-WjTIU*9GLASeBQ8no!P{I~00+Zm4~piaxe z`i>443oDmZu3P~I^m$tjqT2uGgik z;mw{$`_pSLf0|QS!;en)T934xm!9VKSU%6Tj?-(cb^m{@KTizyJYI2VesyHk(z>V+ zdR^qhvxIZ3+V!fcE3d}%k*-mlmmTH9Nz1!V?M<(XC_mTHT*she)a$?1XJt!kYS71- z)^*SrI?vzQ#(aD!n7N`e9uLLa;+<<-;$5K_Ol%#U?e($xme!U85|}3&TGw~M90aL} znR7y+P}9P~@SK^UYiC|8{=4OGxaYp)=xf$orF;!tC98re;!S7^7Bmy;TE7n0kSTPn z5Scj^qM&8LoTgH+TnxV#fM>ox^Nh7Zl%VlB@+_;YsHj|7SXQ}uW!Wm|Iog-=Fl{d@ zUtO~*0&{Oy%U9xEP;FsjEP=5vFRO^GtSPHpDSI4=TJZm|P8Ee2$2$_ky&5Je0*3G-2W?5x*Q)tQi9 z3!6k)TO!_CP=--$f@P!m=YiMr+G=OL}<*Em8cw=_(nzMX9JuIJq z@_`M8nA(0+9rVx3|dE98Sh2{d9PO!E6WTH6zK?x_%6 z>)Or^UQA?-QB59pw0Sm&wNZ!Jon=F`tt|~-5p$TW?DH{}_O>Rmh^Ig>Eivf66)fQ_ zN~nY86W6iC>@Zf;m8g@Nb8yZ9}=X0PJ*0(0ac9w9~D2TPIs}2l^ojh$kh&6ZA%fzR6;<o zbTzbh#>I;~X+Bg4hf4<^DIzP77x3Y@bhLwiO2AhiPsHk)#hXmZKRX}~yt>wwbuH#W z-~+ifV?bhi2YoGYSJRSkws9sul0`S`z zZ))il>sZocXw432vW<*SxCERwbjA`5&5bRcqL(F41UIsKq@PDv>VyT5ieply?&GNt zC$wG@Tx^M7v$TolKqTwBWVs_eZ3aal$Kd-s6%GW95y#+ZXPU@559~H{#jr}}lr#lK z03_6P*2mgz6{Fx!$k@AU%5;_56^}QHsXVbjB{sw1(%yN8DCFrSDqSisV~OYFq!Ytp zHBX(OQe&+h%`wr;Q(>k+&oVVEzRHs?N=qli*LiAKrNTfHkFm6KZKmov@uCc-{jWgi zKj9hS*gywu^4ho#wSLdDzyXX|V7Blh?IMo5x6yd_v5hz#93RYD| zR+QC(om}Ows&bVGkhPj+)k{|`i!Lv#PTQ?n29F?|71fk2k5oAk#IT~Q+!keZMGeb= z^`hytG+Ke?NrPoIOY5qyUb+$<$LQ8VR1=9TcamsX&8o`k>z&Xnh$QUHw6we`y3_@+ zY*>;R1M|*un5V8fQck|j$o>*$N%&Qsw{T~ReMhIr^jQ`D+`#Qv zar_VnrkfrU)(&g!5 zU@|w*j@lD&tJUW}J22T-dr8Ta{$_}vyxczn6iU8a;$IrL%U5zsiGKyezl@ z{CoXDEWSA}_%@`B3P2;n?x<{hG>i-C;^L-@f6iYond({(UE!F)^F$(659>SD$#o*$ zoeo$c_5JSO0S)H=AnP1H5E#MZX8cO_aHL|t)9Yf)2c zdo0lrYq&L@C@c~2?het~zSc~dFYr;j(z(5}B@wUdir-e(v@RhE>*3)Q$~$mfH$FeH ze9XcRcM6LN!!~qv`L(m4+`3qz4(pexHLI%2%T`q_U3P6iwsg~kj0!7 z7a1gMkYa<(H;Cc6*l<{EL{V&bE;c+D8=mJIp645$=Nq2q8=mJIp645$=Nq2q8=mJI zp645$OAOB?hUXH)bBW=(#PD2VcrGzKml&Q)49_Ko=LLr61%~GZhUW!_=LLr61%~GZ zhUW!_=LLr61%~H^hUbNb=Y@vng@)&ahUbNb=Y@vng@)&ahUbNb=S7C+MTX}^hUZ0w z=S7C+MTX}^hUZ0w=S7C+MTX~6!*i+OxzzAnYIrU+JeL}tOAXJZhUZelbE)BZvEg~K z;d!y)d9mSnvEg~K;d!y)d9mSnvEg~K;W=Dnm<|^iuERx!?QoIdJ6vQK4;LBE!$pSm zaFO9XTx6IJ7n$zEru(qzK5V)Vo9m;9y6?jeyzVHM3gY-q0$kNw3p|97i{^v0{~)bV=TZ34I(v!h z{7KsXG2=tDf0EW*$4|Eocwc}%@lOcgl22UgD=Nff#`U*X&G68q}_2K^U+o^Ej^}gp(?;nZd3coOItM7c-J=rJ#3vY*9#&vs@6X*5DS^lI{ z72+1g^|yFE<)MS$9)%08@U~5lhl9km|HI#!CjGxhocsT0#tSHZ{5B|DF!@pV(fU^q z*E&f^!(}PsMWl0&ht4;M>;6(I^rzrqN9$|;E2dvc`okXj`rA{qPLhPq$6H`nG+#nG zHxuXaCRlz|S_u4>C0w*llyrXKp@ZL!WY3>eyW%M0RitwcO$yx4eB!*_qQtcyk{1<> z*OLDI9{N9E`L)lzj5m_bM;dX~WbG6|YN0RW&~a@g|4WJUdT(I)lO$8exc*kUogO+rBCh@G#2*-!e+3v4XTl#j#)bRGZ@0lk>m=o#5K9<8MD1|5htA`~x&K49{Py$vzcPKQ zRtzzInCcCqL0Gu|FA?YdD;YmZI(;5G-zU!Jjo&dHV@eL+iG_NI{^&UDYmS2^I>vP7}kk0QtbpD0qPm<8bj5m``5xmZT3y-UU zIPc#&;yNx>T8Ku*J4k=GhyJfv{v-+gn(=PZ2~JQMxX*Kmb3fA=Pm<0W51l)Be)6-4 z@vWruyob&);=J9;;bSRWu(V4LxV?VCnVEL0+87yxzuD>O93Vl|E zvUZ&diRgYiA&|Hn2Rd%Z8S{7Ezq%j=BmZ*9$&e+$YSx6_Do z|2GonK4Xmclh4OI^nc0nC#6dv`WYV}9pBk118?Vi;(VMG5a&MUGJcr!+dTBY#`0^Q z_c4BybYAn&IYylOjC?`G#eIH>@#CbQBF@`k7t61GKEe1P>HLd_j+o-^CyVhR(pf>A z`>A93wVy`DPm|7W51r?U^LBfi=_uDi9OIns&(A+c<={RS64&joeO}IZ4(Z(Kq4NOC zul;Y?)q%dh?Xh4Cq*vk2bVz=g+EL0reBatTq*c!+c!^w8PM@+V2?$BY+{ z&PflQobyyc?q@9HMWnNmIFD;B%dh>kGG0nLKlIRfi#Q)w?|JZ#nLagxIK}u9s&@gs zr@;NMB(B>*`>$a#5UKP2A@t#JSI#iR=E-J{uVCBcHoG^q*t-wa*tA-$6Qokh{+*#CgA8LY(`Y$M{at z?;y_Gp_k=P3bowN_#V=EojBJyL7e+6nW6MBKR$BP_jgy=I6lhKyplNTJOV$b>GPCU zTmFZE>*cG&bvyKv&#&1yJyMcIereO$1w_~TYa6%we8tA`(T>jlrj6V4|G~z;Z_7Vv zrmWt&&r*9roWuA&^1p^Sw%emNox557BnjQi_O;fIyo z&o#t#`zJ}LoN@ha?b|$bzDwK(<-Z3%`g(r12Y=0`^BCmU{qlc^Yd>U1e8~9mfJ&J= zORafaD~M~IBne&1_#o-r=b^KkIF4r=KYBd>oavCfIKcQ2>HpP3|LobSB=>n9GoXs&{sQ%EbHeO5)mQQe_j%7@tErTRe0gA#QFT(PaONpe!f1+^czY4W1IeND5J;c zxJ#9P-tRMskA`F%pLdeZV&WLDU1v4RzlHL*dgM>B{K^G9&t$xnbbfEsvG@DGvHVFA z`ZMGD^X8H{Dg*DYWj1a}IpJe%yRKe4X?;@Qc51s5nRgnA1WqdE`loRLu5@-3fpIaDz zhIF3t(D^NK-fl;j4uvb;Vf=uO*F$ISJXMnWj}qtgUQb-NkB;kR#t%`w>pgV-fjF=C zHIMvn636)j$Ip=&6VZYgUxdHa^A@}goYOE}o|Y$tR^s~FcWwIw}t?kCRs_X)-uzoz;PB>yhsQR4c& zFYQOapY|5ZukVjeGCowVj+b1z-q$)II*u-4d=~K~j295UnQ?tQ-p+Ut<-gy??dOHv z9$dfog+4LA?#rVr|3h)rGoLW7=Z$exQ0wS%HHYz%&69B`iRCu__exs+uJhpfeK6F= z{QY0dl|%L$JpYj~l0V6K==)=rt6*ZUy~(QqezY0zXw0H zADu7x0y(bp_NYSCl#zt z`lS9Yinq30-`@re7HicuZMO2 z;IMoMe)JNe4W0jQ@gjY~(it;eTcxy`)z_t4$S*WIMbonnb>S9Exk zuc=ezv3=|dFTcs7{HIi2UtwqsUOq+TdH>g}Q6+eJK7Mdq^1j28Pp!e7h-%>TVxRjKGjYK`U4BaRhZ^!VTBQT|VKyS&792ElQ{%OCV8e<9rt7s=XGA7fcw d{tb`vUv?=ES&i~1Jj&lo<#n7GKZe5V|9>3hIJN)) diff --git a/source/cluster/wham/src-M/obackup/timing.o b/source/cluster/wham/src-M/obackup/timing.o deleted file mode 100644 index d186b87fdf5a5d6318330d2db9daba32a9e202cf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18920 zcmeI4dvH|OdBD%zUG!iDT1nstjA0=H1QDwT?|=^67a%S5HW;TA3Fgmt4(;JU=6OMIO+VAMy%u^}4dC zCB7K)N&!Zc>L_0hIr7)2+(G$T;!01=yN$&ANw1gkcF0wogk*+#7>}Rey_63_j`hxf zamI8Dh4wADp3KjC1^AT${C)7N_k#!YFnvheFH10&sIvcJTrFt^#HIUbAUiK{4Dk_{m4*zThY2JI-D$uaGx$==IU9OG^tOGtOf|u~>lB~@qC*Rd_-%PCSYWdC!1LgJS z(%||U0(5;1>wp@w!7EU~IO0RWD{s7dSVbo9%24+8^v{22BW2g?!IBV9$UnVdXyY z0!|YdgC;>Mt4j~{fVOYy)$+R_0AC3-_Pml^Ex+gdKzZ#sn}-wR`-VI~jiB%If%jMJ zp0_(apCr$a=UX&T9ym9;bbswY`G;r0o6&|9_mnZ-# zUa>qV=|t%DN4LQ+T7!2f8$2C)T!KS#+(R#l>yJF_2kFbG5qf;|^k2)1?18soU|}5I z&At=LUI=A>27ccSXEDIH!`X8*hTXIM^kVmMgErL@W^N;mWd}5 z{!Dz>{4%O2|GB!6t%84BV3)vubKqoB$i4>jum^Chnge@^s!wt3tvRC97L#2zUGVr< zgU#Ky30nC}jQVunpqYy8iq(&%%~ZNRwmaRla%KIVefP!o_b2!4i}rLxf?baCj;@x@ zNU%Pg>WdEcMSJ%y>mMB+-nT5CNXPq4F&)|;PwWb87U4w39IA~h@o!G1GO1WX_ELPv zO!+s*_d+j5Vu@X5I${n%zm1vJHtQ;?G@#vSGZV#rOr;@YdotYa=`I6>jZsmWI}Cb^ zMJ^+aSUd&&mKPWvW1iF>iVr(Q)h?qKs-MiN&Si|G%rOu;%~n8Nu>mu)kBfxc1JR{3 z$q}%##pfz_8F3Vd6oHpvkh#!kxIxGdBzSuSX6Xuz6A$U1fM}zYe5((q9>3xSQMr`(UT7r z6`v|LAn-mJwrgyp_7TLXuii=CG|7B zUp(Gw5bQFO!%oRubd`x)LFi-ctpUkMf3MSI2?&OhLrqRey=5|)w^bm@44RV!y&fc~ zWG3bet_<6mNv51eWiu^F|0JS0AR2%rC2m?hsW+-@AqdT(Nx~@m5=ij2o5W)iiuy(- zk*onpUvDgJI{Kn)0~*0X=8#OoR+*Fb`LtUsQF3$=GaM-yV58IJB9QgM0_&92p;cdB z(%Bc&mb;DnQp0Jd4YcaMk)fm`2H~Cou@59-!=`;gR={vT%qS4wgug}gF0Z%^B1l-W z6I=$v0aHxco#C=&ZUbkT6u!cRFrBb-rSKvbV%KB;O6mJdS_w^n-j}jZx$FyWBV~f) zlqH{ftGz9iUxav5=0JR}n8!pjp*KgM%jy}gTndr)rDB=B!TxwktYhLTh(->NjHi=H zD_4RP=cJVOaw)VEdT#(W0x`;DRkNTa!)a;vbuODvt&nr@X)c8u0o#ak@RVI9+_yrw zeXw3bmG&7>4Kn})(Nu3Nv0J=sxARobv!rR$>=$oxVXY+`#5Fy&PmFW<3QI0Mf6Rol zO7g-+Q9Q>!Ub8AKX>4d@FeYYmDXbJ2vy?W9Wn8>C?>ZxzxwO%e!bB6@Og38!Dw;B3 zYk-Y>KQ!Isig0gW1PQrsN72{ATm^1mRDm`1s9hx7^R3ZvZV+=p5YG<>+a^78XOmct zheL`BKN_n6aVS93rGgw0E}aLB&q zF?J>Q?bjo-jf+E5MWGFhLnn}{iq|CEi(vppVkzf+vJgDOHfSv`&)Emmvk+z+?1b{B z{Yx&Z2g77a%HHI%)l$|kg}>lJxHEBUkiuUv;iBoVo?CmRl)K?ft1sS*V5Y!!DP`4M zw!m7Pq;Lrr!YTq=rj)JYGF&QY?QXNngedV+tCbU&AA2dA%bnSOA3 zk_+{N(;su8?cnqyCe;s47r2Zaoc@u^^9QF1CQ=6{af`kA?BGr&V0hd2s6HD*1!ckX>~1;N(0TeYOrx z57-CPc5r%v%d~^jaW2yjPN%t0KRCU@g#6%ik;}D%(`7Ex4^F@4LhayGR&Bp^7HJ2k z+w3y&`TH)f)CicSm!35O#6`@U5O5Y-`hca5Py_vArKS93J7skvjT9d!kRt#%R$cXfA0?y^ItArg2Npn4wN zH@9sIHBW+=8d|czAb7hS>O>>K_HakIJ-ma5*wNe_zB3qgSm_kq$r7n#11(MkFU6bvasCD+)!#ZN*H z(bFYib!!Foat z&fHTBSBbmW$kfenmAPw-u&dNvX)LMp0|n6xx7)ZnkfRIgCRA zsm{uBpQ`M^$L(cBzOTDH_>xp<5xrcd#rxd z%G4WEnm)ds_HdDB3QU?(H_QRuT=omvPS!8*Wos^}c58ke{nD1x7UD+w zP5(yv<>#9IZ`&{VTNF?6nOLs~r1uTWJY(+7pcr2}$iJQtl{-EV{MI)rtaDIQ1bWkH zVWKuE)WAz6&5=MuV1>v%8>a{Ppq)zg$1*VyZHf;y3=Ab>nUPrEZZi{DDf;p8N^~qX z-d=cZ zM3n|o_;@*B4o2xJZww=`3&tMae+kIRWnJdwB(s23gH*NvxsxR4UA@DKI|aP3B>o#0 zKS*=wo0F{C}!(-G2pE2njRY55B342{T;Cm7m8n4hM={I!YYt)ZagTR^w$kZ6SW5`N7xb zl>dLy^wAHt8PiowzX{4p-$U5Gi3e!HD-A-f6BNz z=ggoERP9|)`T@o_5)U)pO59{TMEoJf+lU`!d>ipUXS|#ETa0ffewp!|#9g#lW4lxz zpy;*&d@bi_2&sp2nl~xVseix8ImP#V&Z+zc=d{3F=A0Hq56N@wqKQ6-b6kuetz+Cx z{4UOM;exb>b6mV3J;^!UNPo&X{?P*I?>L`s@yndke-iOf`>0%Zt!23C;`F45FVaWJt zzSVP11G$xR>aSfI$52%NBpL6=&Vh7F3&?mIo*%9b50YzhjY3g zGmNYK`UvN=E}Z6^?yH}0PV?^)=QMsrbVI3jxvBjNI4AqtHLma1I|}eUoYQzc%{h(N z4>+gs`YGo$UK5MrpJ<1?)4#Iua6_48H6)%rQkxS#w?g>SPlVgFLt4824LhV!g(f z6T_^h0N+Rs(LZ)&KPp2CG5(r`#iJV6+xwjY{6)r9doMDs+B?BG6@?cb?_yH@;Fl#K z7HV8??;Qnrzs9k>s$D~jtM5sk(>P5jS@SuK>;3Rv0sb-Lsvmst7!H$am+FT)##KLT zVcajRg@|cf?}z;bxZ3B{xRV?47j&Vx`d&z_E4ZBcm9loN^p!}RQ@H*%Qc(J8J$ZmQ z*FVVg)%<+Efc|Nwug3T11@y<6z8ZHw<5U!d;y=jrRh)(58E5*c-UgXS`2Wsu@u!8< z=3^t3HqulsgEG!uyb~~~S%#AaM~D_n6v=du?CNMWR$SSuatJPPhBGzsJWYF_Qly-h z$ADw~yba3!60;|_IeL-odHqk(s(mo0X1f3TbR*r8?9mn{3U%rUPYe;3Gp4`YjLR)T+zsoY2{jbS>!g3?+v9GxOnF99z P)@m8<)$H*g%xka8ojo$O&*Hg6o2WoLH~0N?6$Weng4dAUfpM%%?zz^d5 z6udqJepvBOgCA9VGq@C<=sXAB3t8)h>s|uSQ~Ut<0LA|dp07CTa()ZI#qW9Gg^CXa zFH!tD@G**)gO`E#MEtYBIh_yT&EV4&{}A|0#n*z@flK^f0&i4&8+Z%2`29Y3tK$2? zSAdKD8{n%H&!wiu<;ijJA@=8huUEVPd?UEj?=|3?6`ugURq^+McPhRDd>6Xf6=7Jx zM~UZ957WmBus;fW>7hR|_C2(Du-DjU_?XM)7@I?eXY@zo%G0Q8arx{=oYKDrg3qMu z_y|>kU>NvLaH+2`;JX!{0?u*qA@()k`xRdVeh^%8vI6`tIFCDgd>s6k;+w#G(JLRK z^9*>N;=92IfQ$Ys;DZ!D0$vC%`aP+Lxjak2rM(RR=W^mh_!Zz~ijM{_S9}uqbj4?a z&s4k#yiW1u;EjrZ6ubpo^0g7X6&x?YQ{c;$&MxqkivI$9wc>}t*D0Q)0JuCifJ;36 z!MUFKz)Ns7c)D-MN!A=UfR`vf4SclXb>L$Z{{VRI>7i}`^gj$f6#N44&x20@M>7qc z051n00{iXYOTaG#{}K2)W&aBJPH>)I`FI`t0J!+&4#?$s5M0`MU+^Q!{zCAh;8M<4 zfgb~x_B~98N1upU52EI<&*MYAGm-z1n-=O%1z&CGk63-vO_bL6qgYO5&OVFDZ23#+PmHoNkN5CbX%fXK-J{Xre3Rn81K*6(0u9^CTalKNftP;uYW%6rTfLq4+)EmEd>@9t5vZd_8yr zxRl%D;LVDE8+?i4FM}^v{1Es`a8z4x9DKFnXVMK0x5IVdQa*#hHz-~LzDe<0z_%#= zKJabe63_d=w=2FJd>1%gf=9vkDE=kzec%%R)8Gdb-wl39@n3@ z<(3PF!Uux)0mo&*)!_XVzX5z8I9`Hj;DZ#e1Lt*z-Jb6SPb>Zq_-Js6^E2S%6yE|q zLGc~n6^j29yi)PsgV!h?(7em#)}Z)V;LVC(2EGJb`pYQr<%&-LU#a*E@YRYpfv*F{ zOV9?sLGiWVn-u>t_!h;V0pF(h55c!9egJ%z;%|ZPQT#MoFmQS91DEo-0Q`XBh2V!2 zzY+Y1;_m@Jrg%MgE*y&ACE$G&e;B;K;*Wt31ef;t1o$AucY+TEM_9qnz|)HV0erOL z30l~5xs6l2KllW2>A#nQS15iBcqO>3_a=hRRD33Qjp7Ty>lFVGcmue^^D*#d#W#U3 z0mn=5EckN8UjkpL_^aTn6+a5T4qVE=H*G+3d2UerLhwzB7lCh4d>r^Ta4FAQ!8;Yd z6MVbk_kr(Jd=>aE#Xk$aTk&sz?@|0k@V$!f1K+3kAHny7OFK`V8J62Y#m@#m3@-aB z1>i>%zZU$c(wPKqJ~*HWL;O~O_oDSFAHti#^Ax`ye1PH~2hRtW`uYm^AZ6bPK2-4^ zfu|M!4ftrq{{lWv@jhpTE!ee%WaF|=YVfhdr&Y?^Aps_yNUNfFDx)6W~X{WnB6y_%X$w1J9-V47>dIfcH`Sx8VI1|10=F#ZNyw zEKk0lv-R`Ahbo=|Pb+>C_-Ms%10Sb&1Na2Rmw{I({s?%b;-3SrQG6?SgW}%>Z&v&l z;7b&L9eg>s%xk&lgyptU@ppi)R{RR^b&9_ed;>U!#h@H~lj7CjTNGaezD@CV@a^Ez z@796uRQzk;yA*#Oe7E912HyiN?fD@1KE?kAen9av-Vv7PA;m8SKLRfCr@@aZ{x0xi zir)?%(ETMJqB9pf7hKA}6}*q)9|7;L_~*d~D*hz+AaL=!3%o$_UxE)+{0;Cz#d{10 z%PkEq^Wy;U(TZOQK2GuLz$YmFZgAdj;6wClz$+EM8@xvG2f!N?|0H;`;+w&jDE=+* z<%<6Vd?mP)^K0O%6h8*OTJgU0K?$!9*D8Jq_&RVYhvDEG6fXncr1*QmwV@LbxTu-ng2@IH!P z58hw#Dc}PYuLU2ZcnkPY#XG>$ihl}xG`NgoUk4wj_;&CKivKrwh2sAMUI{Mk=kMS( ziszjlmS=ML++ZsBdhjb?Uj@EP>C6Y;5001MKJdeecYp_UzsrZ@_haCB;F8}jfDZ(h&ySt} z&sY3g;Df;B{_cn11>h3rFTqQc{qMm?gUjdOe*>=smvQ@4GT?ET_aXQY{toaOaEX5~ zcpW&V{~!h4tn9~vw}4~W9ZUva4o;`$xC49xINhF@qXB#?xWsuc_%_8K0Ph5s_&)}| z9h|n&%&`%CkFx(S@V(#?|F^*pfJ>Y|20sc;r{*{SK7j7~`H=YE1Rtn)k{&$ZddUZu z`1^qm0+;g72QO6iSA(a)CI0Kc$AC+m6TxRHUJ2d`F7e+5zFhHpz*m4v{O#Z?!6p8+ z;A@rr7r@tnOZ?ve-v}=8zW}~d+3x}0qx63bz84(T7Q6v|Q0XKt3hU(vxcJQj?~j2> z%I6~R0g4X;9|$hx^G@)5a4DY&;6s)Dd%+9ArF`xL9}O;XE(Wgzmv*}Xyb)aDe-xbe zf$VnsdGHo+iT?@kCE(J(wu7%!_CEq&1upTw0=^Dh;(Q%^v$7BJ!+P1K^!tMIJ`*2O zzZd3*_PdqNRp9%;X&GjY(cnkHW&XMaJV1a_ZnuNyf=l_-gZBcL{I-Di2N%EhgBL3M zkAja@`kwdqxj)QMj_Gerimj4!T zS*Kk9z73qZp*e0*7d}MiX7D`4Zv!6yF7;9eJ`h~`%iZ9-k7etB2z(s4 zl*1bEGVp@%vS0&vqq2V-yct}||9S9M#eWFC5?s~;`@z>K{zvdl;IeM{2lzH{S+`ts z3C~Tk`-0%<FSG27g$Q1^+osdDDrj0v*~{| zhF?Z%th1i>llUl}6~5j}Je$t?7=HRCZv0EO@{^50&|mQ!hz?X-zT$8hxcDv%!wCwt zJ@PxPto_xp|2R~b2!gWqI}Vn$-?z7{qjYaa@WG>rz7I{OXglctAZRb$zN7RoSp^-X z+uJ((KJ-q)W!0sJ%i21ZO)dN2_QPA*>?!_JRz2}>S$m&BWjn?V>cy8ln-k>am9>An ztbI+v@#DvzV#OzUCKziTOE2qaV?4h7xm4#tq5;X}8SQu0&^W*JMDlF#Y%-EBjO3HH zJY!$JBe#vcwU_RcJnq_2x;xC{E|W(ZwJ46=+4HzNE{_AEAe=lh_JY`57MI72yvk#K zB=6*ru`eIxv2#c1(J*VBoV9mTXq2_1*|T;uE^9~s;Z`3Yh{v~sD{$&iJ4i*U878EwHGMt zp1NwQ=T)Y+6A8OR(6kkyaF`zwshCq;i3@MXHks{HzTaV-Drmk;f~_PZ`fp{whBsu2vzvB5{s1x`|-yi${aQ-j32e$7$`=$yvG89S%As?m7NqS@nx? z*~yDMI@w|DdW?K#K{)p>`tPr?W2W8E7m3SmX}Pt!DMd9%G%p_jZ^lZ zu?T1CvL}P%%RiV;Cf}t0gR%#o;7gu0@7wR&Sk}IytbO6;_Meosf2XYdWg1VY#dp$+ z)t#b@(m?z0wbY1S`z2i-QF9~6dT;d28~6OtH~RJ~U4an7d&CDPt}t%churpsiz~j< zm&p0X!oBQ4UVnL4h7Gju!wWc&^SMbg$r8jWS8d`dE!9!Fuf25tj?x1pLfP5R^T@5V zuk+ecR(0-kPu6Jiqxy6j4dd+fN&TQ_--otx22bpWw+5_Lc|qjJX*i5sN3T_S+BB$S z`Wffhx>+xbbe#+^c6Ci@o8Xt9*ntYXBy!*c&e(PE+ECKnQEGMvXx-didMH{@9^x9} zuQPXJlo}KH4>QP7(CsW^*FQ4YrBSLZ5)U&6amJpwnU(wzFf)0mnkkR8otj~sMZ3$Z zuj!GzQ!k7?`90PQg(<0H+5wt$+8&{xkCz^#vOAD{_BaqX+;&oJ+w(4pjaF)fz@AjM)FS0F!tmRW)Gcq%Cc{8>6>t_IBHT^Zo;dnXyQW8$g9xx4LIbp z-hdyVnklFKYuau&*fH@iZee9zaER9hJL#^~nmam5544xA#Sj@YRV-X9^TgJ0p6ImZ ziOz7Iu-7r+yb})kJg@vD^%BPWj?#nerF3VAeJOKi*hv}cMuV9dHCU%3Gxln<8x5u| zl6M*mV^6-TTWXDww$qgvXVH#pFqu`cYA`L4ywjB#d-7I;IV!8m()DV_T(4(LS$Ud; z<{0Wj&IN9jA1^&XZLDM3er|k2X;FH-bPuf=I;QPru=-Ej8cSQL%kV07XJ(bkkIj{} zf3kos!1h90A-&(xmZrbl2Rh6-PX&MCi>plncU`@|RsA4e64!gz9(4yEbT7ubv_cQz z(0URl?#h47`pAh>C5*E==~%-dV|V4a@!JvpUBiXICD)r?rC>^;_htb_cTQ z54MjhkBw2NPUB?kg=%!N?KM?D=(td;-p!Ex1HtyUVCSTF2{&ux)GLBEU zu-_VacQVM>^=^COOuh|QDx;l|D<`9jV_ij=ZJ^BVXyZYFJ4Z(wpSQO)8=C0@e9nE~ z1GHe>(Y7SAW()Iy&QGX8+c}{Q@-{NUy}(`;Qa8;qI~Nj;&4{_hdmFA)nUzGY!ZPE( zG@CNkt~ihJ4Z)eB7`u^*hprC*yCWA) z9W(Y^aMrSqVkRYKO}01k;M6VS>>lDqb;pUS)BTYXr%oArPD(f%vaz#iuWOzRgFn_G89w#P*2My|Hg=Rf zafpYm_sZ#!3#Y~ydoFkw%HAtYN=znZMjo6RW1QVXT#Y$SRE^a|PMjKJ>^X6JC98Hk z$bD08oXo)55&oUFoR?jn;}xv4AZsSTDNCu_+l`=G6YW6~$uiM0c7wM)b+3aSj$Ap_ z&DeECEsED3*{j>6#8mgu$b(bejI(=)t8T}Ms_x(~QesYZGj^TWB^Gs1R(3k*akGF7 zZFw>M;N#TO!*%xYo$YO-$v*sqHyn@ooM+rp`ci=Oye{|cUQrgDa$@XeK|FN5Z|6lW zoKj+()kU-ltuYzqJ`rY^&pE?<&ne+_Il}{@Xq>@}an@+eQqsTUDxp}Saa%1T^CK5d z>t^h^;M`?z-6kcbbr(b)oLXa?-9udKcATizT^KoW>Wy)BCt2&l@t`J_lE{OT4aV6$ zbSE2QA}3BZ7<*1ktwtTxgkEh1W!ay|eUNX6y50E7qF9{9$2fZ|UGHt>kqf8sG4@=T z40gHJrbix}T4S8uLw9OzX5_@FHOASUbU7P!kq0LmjI(>_PBt1NCr&mPdrsbF<2!CI z4A$_N$SZ(Dv^Kyj(}@oqy&FY#aQwLweD2s1Me7s^V>epcQ~V0Raizw{*2tApFpOhe zMH52{<-@x1Y~ypD7`{wec4*Wlx?Tt?qR5;+$~ZQ%6YMvfs1Q~~uEIj#zqH@L*mXq% zPWSri+Q@@bql~kA=uRVFA31UAl5ut?UGA$JBM(kC7-#p;oosB5oH*HF>^iZV*vTgg zx4&{z<^DR2o|)+OG_o~{)F}?eZlvO&>(fYQ`1>oe8u@`{R=}s;W zM^2nvGS2EGYL^@6bG}tvb^hnx^i)RnPgjpd&YT=E*3L*f%+87ARgDESXZw$3wK4YP zql|3qb_Ml{{5jcSto?;epgR?m7dde%h;ddYQNA{Hqk;xR&YT=E*3P<9LHUuqlNZLm ze3X&R9isBiw z4^CY$&hDY>b+IaP;nW3V*G2fy!|~X=X|AXf-c7HKJUMm3INnoOFWz0N?@X;F)<@2q zx?$`(lYWwI^~agDdsv6*U?!9QY%kjw#pl#46Z=k_=5VjuaQU3DkM4~;In9!ByeDp&Z^M<^@!B7` za+)V&?TX7LhiY)z#b9d~Se>t{LNJ;Ao#!N{{yXN*toIjp}f zI9GLfICAdPC1ck)nq-F=fR0nHU&5DG!;eLC?3~J4JDmER9TxL2@IwRnD=GFzrPEgM zuFJwdGUiqhww#VNqv<`TeDlEZ<8SuO<2u9F2#@c4v+ou3|NEYMvu{81khY}r`8c|c z&V`$wK6tb5ZN`?Lxz5<;J;)Du)A^c^SAIwACJ-;HHZHU7DHze%d()^~ok~5LrCdV~ zSqD_tg=(<@eWx_r{V8Exbz!;TTYhcjC>$=N4xC-FGkUlC&A!vA5W<43h-}*1rqg?S zUzg8$2k9W~G<3V5dPTW#x;W#kxyZhQbi#tli(EKeo3VD$&0%*y(}Kb5Z@8P9yadtuuJIqMj3ejm+t?Yq*}d6Aqxqc{87P zn{H|v*72R(3Wn0}n#k&<%QtKVQQn*aWbEcmJY?-ICw#QDFmmA(ALFbpWDqkQBrLr4 z(pIbem$q`YFQ%s}C8#cEyCjOqY5a_{#+1GBpD^2FA{S2MXY9G)Hjs6wGas_X4RvLa z2dC~BXZO&Z#$O&eacYmT=Y(5k)(7g^OILQgs-{N)I90_sdjMT;p)(^FPE|4XTy(Fh z>LL$LRWZ))p*vO87&&pOim~V91XZU@>KfS@NE@@kQ|Dw20FdmDdy3g7eH z@k~Cg@-trpZaflx&w;*4#BZ~H6YUwkF)-gndZL6{l6(oRG}TF4@Jy`S(KjbVk>1j? zpO@3M@*U$AIzN#k`gSy5f^WS&ZNA~e-)efI%yLUU`P6*Y* zWPmHFj^0Vzpq%k(SWIk^DJF`$ldk8VH58XSGcF~^Y;xkbcaw!3_uh<1T-LYSfFOfPh*4`lEOF0e4Wt!$pCU^H@Bmi2<6JdjMSAh+R2u|gM7y;bJVu* zcBehulQ1_syyoxZ-m#wwf*ML8Ma&+5*H5|%ZPT_JOn_5q(Vkd(jcG_GhG%<3zfiZ8 zhhq{8o@8yZXFw$}_DPnMArM{ggGck1PI7md%68-q$|uWbb0f)4mgFDUe3Ji=B!jSU z3!K6wr926l$K*4QQK&miZ>I}`*OGM3<-*$|nAfr8VzyCAJIOd|Z9CfX{(Ss6-2p}& zW&oX^WFX~Bq;0I_f-(c?dU|K|Q9cdBXOm3Z;0cPChixT(<1k27F;^A&vl~ZACPZl* zY?7sMlx|~BV|-5r`JT#2h9_7VJ*NAf*hG7hxs|KqFxLV99+N;5BAsV`M5Aq{ACN(Q zK{td-abSQUwfW|a(N=IBOfmuAA4sNG(b3E_jcG8&ckb;r?H^INdHCpZCh#h8|Ek z@lT^lQTECdW!#|7mq(|!kJ2S|4)=5fsws!i?*d&{?u%7$1wfN2q z@}2D_C3{HU>pNo;?Tkk6?sc4lQJZ!;4&zK)_-8xL;mC>8aTsTH677k$`sHSjUvB$V zxgGS&jZM6AbNX07_ltHP>qX}$SzPcX(#Lj2eQdYe$M`htV{DSiGPnHgJms(Q^J$Qu z&wTP{H^zcYh|tkQ|EhO6YYiWoX7=5r)Mk1+L#8?R?@J$)e7GYo9HX4*f1jZYuoMT$sj*Z>y@*O zzB4w_&YVv}rtRcSjYG7lfh9ueuJBuboQsaqUFK&t-lUs)cb1q*ZQNcp)MdIs+$_PD zNDJN@wc!133+B_X1+z(}1&1s4_O^1ra18PbrXP4E;$+vSI(HoIFoaCA?g37v0AJ0y43nLsDSQzvVEvZIID|jMC65{ z+$Qm6O6>CvC;HuqUXgbvgN$A8wx{^*XvdYxXkO&X8TuK=x{}P6?zI<*d-<05O!`*@ z?4Y`p{Q*%-VfHyPxtiApPF*l|UDyrG*?%sp4nMc%Uf1Z}GG)ho?!rN(`xQWiz!)F0!nMitg#!8fU6EbZ-RjKKqcEL@!`Kbe_SC(xY-Z%jX+Vr!SKaQ+ zb&&_BF)+^Vp*x+qF>>NmEMw0}_d0V+_dVlPUTsU>X*mdzQ?T(;^Zn@EkBmu|heiCSq?T>|K%q-xHf?PxL_+x!@{LZWwE0 zD*iE~VP~k!cf%(7%8t@Q?QH}6%oyZnrko_WJ<68Pbl(e`XfJ3g{o3+XfHO z-xHf?Pwp1UUfv@4!|QxQ%(unurTgsr#eICg_!RvRDTVhh+d9}A^=oIOWt?fy|J>HW z{>X(h(lYj3RB~U>dM{>DVjlB47i+qW+#a`S~IJ777+_uQ4VOwMqw=L4vX}`9;em)KI^Vv!M?7G{T z2~j3jHqrUywrD=)+wXfa$oI6HWbBXm_WGXKB#Wo$W4?pFGlP6*`$@^p)=k)%CQioLJ(!8J??cyc9qH0CA;=7^_U7^;N6zHQ*md;UF9~taqdu-4 zJ#ojK-ACMUXD^+fWKqwT$hb3r+?a;(L_WQ<=0H9T#~n7w1jjL%Mg2^_l^Nu>&;8`j z>7bbqW!zyC-9FiqnFCvVPX_s(4wH;M2Ojl3v5EF%=D=3pi$T7ZKs`j*%YTTFO|+LC zZ7awHwOu_2GSbdPH*BJ>q+*Naz*T;p4D$1oubdV5&e%jdbJz9zcwK)J z6|nOq&G28iJpI>nwez9<7+Q+)zb!2{EoCQPz40Yc%jKTV8F?a~-q|gePSJAByXYSZ z-qBV@P1#gHhxykbUi{XoRkP^9r+Py3(KR9n?dKBEv8Ha2DnVbYD0C*4E=$m@jhH{M=O=kjVefwmZyFZ_ z{J)&*^vrp9U8oVx4KfaAY(jpXnmhFQ$>$t5M(s!PCNXRMuAb|9)c)SCpUic-d~~^- zIDfib=<}1c6Dc2gJ=wS@cJkU){r_9#Bk{=V|1CdnSNCM?O1C3@o@pO${hv%XbKTo* zSD}76Px8(6^XKuTI=gCaeM5cig8ccjnyc#P)z;)!HRo3^Y`$v#?AbIf*k^)zr?eTG-H>Zz;{LZ_cM1uCeL-#;Q5BY#LNn&Z?bL zKkweg`s(I|O||zG6b&sJQcyUQ(}vLh`Q)r|VRHeWGaPcS@jrI#eH`-*d~H-ZEa=-; zR?cp!np-<-ehZ6;#(i{sHroa&a&7l^{balL?fS@O_s_;%SxM`=sAMVg!Ok0l;2fGo zTCby%>u;PqapL4j!%SN!rKQAz`g>{@R5vUfR#Vl?*5k%cES)rU{NzbfgP@>j#Q5P< zA<^sDp|gt$hYcT!S5sG3OYKUVF36&V*v3zuHfekX`R_`sgDH0Yzo2RewJ)~}m=zQk zR1KXyVp!3Tq5Q6X_>iID`A|xvgWCqTv#_mHR@(Jy*VD;#3eu4u@{%&@T3gq#qo3va zllj#8-H!cVRYpd`fFHjg;GFdRQ^q zCJl#X?34ECw3icHXWBV5xRIY|+_h~BN(u{#>IM(tYn=DgRcOw5+v9xL@525?c{thp z@wVrpg5prKAQirbWqacJPHZ`*w>yWL_+!fApBbxoyvcTqAXpY8f{TNo2d@(N24A0# zB*u1w=>I(WpFfjl#s~9~pgb5z8ax(`qW{I7bu#aBtoKRlea7ZQI_#U{W8bc>i9Nw- z{Doe`uFsR4o}1-b(d7?zY~2#F)>@o5X7Se~vtCmYgj}xUJc!oClr1~br*B z6pWwOT-#7EWk~)_^pQamEkAFZKew^IftIW{)wj?(dkU|47fh*bsA{fXgpIUh;>-j! zC?g>eN3V&T#DK(`xzs@FXhe??hr= zb$t;)S?;NQ5{dfAps`1~U2xQ9G}; zY0l!{T%9z)BsI?p3ROz-97^GE2dji07xE>|v#Y9u>vYoKWTJU~^K81C2yRwsIphgx zGbkhPQOQXPzKPuNO-q$Z>q(iN$Dwd>*%?b*noQ6w%naIU4DM1FCFml)t??83Clh?D zGb4K{<*s2)Q=`5t=+P%E@*=0qdy?2Z)QcTiPs(jWef2%TVii`;3pg+H=gkh5>lDgN zeHB&TM^wToNSHyz7ko-3_AFvY3z}yb%}s7<(BljWx~hRb+Hj)IJPD$)Zvw>Z-r;xk)1=aJLYJ>hdDMbz&o8~v_mJ;;n(KnH(qjH+xwAd+%9s{_i zEo=(%l~#|-sK?Es5h1w3O$mDRB(27#+C}yA7rN!z^IQ_+#-kf*&kGZ#IWz_(u2|2W zSF(R<4~@Z%Zc-4OlG|haq>9pal};&04+(lD&fsE7{A5l0X_S;ZrF86skeePF?0l83 z=oR7;Ha9qN_Nj>j#nBlXA;nxER+dRm5>HN;{I2mgioVHBs3LD6DyO6=Z%?JsN6tcT zVc0pRCRU%8C6@5I&@z1gKt{lX71I8WOZUva+P>J1#gaNuY_yV>m@)hAruvv+JNJew z>_Pfk9;7iMH|CDwA-a)!5XYBXRF_-AV>Hfca#N?8h84Dj^|Y2GetkP9t*} z)sl-Ua)-73Ku>?>8GJJ{dproNrQevx~LHQ29EDKglv)?5br z^(w(0?7ytj?7{vUI?*2Nx9h~rVE>X%iXZIH=$n(E!I`!k-SN3M^LhU8-1{tJ?=LWV z51@oOwe#niUTe=ny)R@b+Aj4|22o05%`87*2qny&-%#wQTpeDLO>G1v(c>vuf*wsN zP4k zxSY1Lb^2wLHf#R88sFJazN(s*8GceKCvhh&k^BV8)t$Vw)G0xa{uKM{d9Sk?wt>-2P(Zj{HV#B+OP5{rWO=+raA)T)NYx~iaFr_xBlF`Lw) zV2Mt?JR{v4tkS7PVJbDW;Ik_2JS(UfO||CJDf)<^CfK44sc&!u^UN*y4Ay!{n@|U4 z6B;f4$4v@)TpZShKS5kb3H6!k&?C@==ONkDhnLC&KVK{r;u%oZje)5Voq7>vK1%h6 zs*8AzV)d|2ysLSXi;}ZkPTeU|_Xen*7g2{X$y}6LJKv7XsTa>uqOdB)vl$k-(w>4I zms17M64>u2gGrgD!EpHbt6QNx2UClqnb36FKJRe5(BP}-!ud@m?E;-P(xlax#9=y- zdL~Z|CUJ~PyzC4b&%?RWq)*Z5)KX}=G--2m+9l!OWD;9+B8?(6Wty}HbQ%wp7`s2= zrg6z-zrnp+Zg4lbSMzCaFh5>)HDur zW4QV>I<@X_v)!e3<6c%=__u#CDVh7nf92ilX^CO<1mCd9(<&y7omfgcg#dK_?}GAi zH@INpq&Lw5zr&dg!a+?eN3z-zTMq?+GmyOMWlo?;C0;AyF>)2+-l+uag zCyk#t{&pSWq_Gv_-%~onyUH$rin3BwJ5werK-qN5k-#{Y+%S2PB2=nV#+RxKODB}N z*Ksu}a-*)+sM$%^%Je1PaJ z7eXQ7VS{&I4$>BjF=~NPMec71Ev{**x;qGs%5z^iC6Q>c$hh2}lT8cn0fr`Ha(_l9 ziv{E?+O{lr7m@nKG@u*doJ9wh<~~E)LE#R5&Z70pa-XJX7B4muIg8dV%iTujcQwF# z^|IV=^7(9>uUwY9g?-R7Cb(kH(%i?1%$rvYlif>m|C0b`P;7QB&HXx|mdsTvS+PRutBp)Zt%>6Kfrtn5IXVKPWxvLBa4RRK3S(f`S z1Kg_SEZV#*_aOtsV$-tR2N}#3jg8B4R~jG|8Yk?QH$s zuCB4S{${H*we{DelI^X(`&8Qh=B>Z`bzY*azejY6Z2f&kB{*Aun^dB^_4kyU`gXSd zzU^LOZT;<4DYErCp{FB=^BZir`TJ6{dHny>+ces^zW^| ze{cPnH3IDl{(oTWZu;@2 zQ(J#u)ajY6zh_jEZ2f&-akcgLQuy zQ?0GP@ow7N-uk=Uy{@OT^*2{17KEEyveUFor`ub9t5u@A_4j$5>TLZzsZ-spzg;@n z+4|eBQ?0GPH&t5f)?e{wB)S z-!b=!o)e?3zn=6|oi#}WJtoC%{Y{G7`kNGO{q=XndQQ5MZ|2OiEf={-L4XY<`i5G* z>=rm%bk+ue_14`)$acne!TfYbm=>OyCuaV=pU4}Gw8P}?;{1C*(cV1#_kN&vAdg5Om^$iYee&jE?E61rX3ndKR(^EaCpZGOf z|NcB0VZtYoSvq-EPS3>nmgI}{ly9OX`7?e=KAOXS*YV%6<>e*Ge)KN+GAE60Nv<@B zq2a+E#LCNu4oUXS>6=)R++i-Kv}7WAHziF<-pg;#$XS|5j$)Au=-mzZ$#FT$68Ver zljF(8q+XC5ODPv52bjM%(M3ZVl55!0faJqD^je-glq zy{FfuldtlH%ah;WmqFvw$>(!8im&qDx@Mf6ozo|=A^Exq`0p&8G=H0uZAm`)Fz2i} z`8$*TWsV@Z*St3cWxp?@y!S{X|GOt&_M4vUiR_b!|44q1HInb30PB+Hk-L=>mTU@( zaof7&_c^%c<>C2qzJzSe-@@kP(|lH*{1(5|CHvFEhsiTZ=8ohPwpuEGUK)2{vW6XQ zH6?DivG^^A+L*j3XK^CgnxMiSnw*}~E76*KnKO4oatU2D?}h>@^ks>HI}4Ir;Dt4# zldtl1%ai-~Wp!Ed@mv-^i|S;Esh=UqbE5aj_fv4ml|ATh-HN1f*h%RxRDG=oMZCLA+K|$}{*U?4%Sz+ST-sAbX z#fyVWPQRLdb?&q?1J>(JGk$Np?M*$B9+lzWb);XSO0?wlIi=Ss{#FJZqr;cz?_b%N zj$C?tGw9PZ??cI4CLipPdyrmF&7rcO(^L8JV{_>1KTo;fLtlStE`5~wHm)z8D{o2zC8!xk)_YhIgc zTbhIDq3z5Q*Yw2)dJ5l+;WL6^P4ns7r&R%cop}a5G15GvroL*#KvQ6;mdR zuPCPKFm{VcQ(SxDp`!n+N z_YAvjq(%h%mFBQfu|@5S1-0*=F?(*aX=V^9V2I5njwAyqHILF^}+K9^u72(u;Yd z7xPFj=8;~^Bg2^S$@q+5Msa;Z;p~R_Rn6RPYMW_P^H8ymQa(xtv#F8SIxWALJ|wo9 zVR7MzfF4<#=h_qwcWnyo)1pzM+*8N6sHDV6Eg9*ax>6%usgdrrBi(C9I*qYtq?3`N z5pL=TmFoH(?)n|>`W^22O}nXSl{&)7VA?H>blOc#Ij1RCIpr!ByQ#%0)%9EK`Ym?- z7Q23n+|(kK>XxM2V2X;|k}Pyfvd~F&TgoUWKck%NjB;`_%E?TLlUCxUIXNkDGE(B? zqr_3-4KhFWLStRZLi~GG3Ynjl(o7po(4b<9d&zC?=}qI@bAQ%wvQ%s)YK3@2 zaZoD7!exx7$NWbhy`q7W{%f7@PO-lUeOZ>7g z@uM&C%f7^qzQm8d#E-tjkG{l@ev}{mC_nm9e)OaK=tud{kMg4*>ZD)gdH6?)O93ccu4gE zqc``=>OwzybJwh_{OHYnv$FD|H+Rmil|Lh={E0PXZl2YJe%YJbXJzG=y}5x_R({$0 zb8X6>Yg6VX+SM|5(F*xx@6WXYg7Kjn(}ASls}86{8=>R&!Q=R7EPu7 zQuSxils}86{8=>R&!Q=R7ESrHXv&{OQ~oTP@@LVMKZ~Z!ZMR!#{w$g@H{Pz5KZ~aP zSu|ztz14+&n=p6Z%F6GL=Kfn*`Tfz{fh#M&Kl-z1%G`vz7y7ek%G`!4E5ARE^rQD@ z(Ud=nruR&!Q=R7ESrHXv&{OQ~oTP z@@LVMKZ~aPSv2L(qA7nCP5HBE%AZA3{w$jIXVJ7ji>CcqH0{r#X@3??`?F};pGDLD zESmOb(X>B{ru|to?a!j=B5xK=`?F};pGDJV>)GiYX@3??o6Tos<;_EBv;FK^`Lk%+ zpGDLDESmOb(X`ovR`Oo2O`Bb4W#x@IX|oTlth_NN?a!iVe-=&qvuHZyjhJbF7ESxJ zXxg7e)BY@)_U~BJ{=}O0?^x6RT$}di+O$8{rv14#?a#Gof38jYb8Xt6Yt#N*oA&40 zv_IFT{kb;n&$VfPu1))MZQ7q})BaqW_UGEPKi8)Hxi;<3wP}B@P5XDOX@9Ow`**Bq zf38jYcdTiDu1))QtZ9F)P5X0g+MjEk9YJRk&e@+!IUO(M?CZH3qwcP0%GrQSJKoZc zyR_pk?f7%|X-7JHj3b@>M|Y3f-M}t!yt`Z9?!I`56ZI(Px=~KlqnxNmIZ=;tN~x&O zxv;3vxw5FxxwNQIUF&4Ih&~puJ|!qBbT(^?3Z0$Yq9XU&BKO)N_u3+Lty2(1#ZE~S z6}veqc5_thUYl~SO}W>m+-u$DR^+y~qLiB>`nb?84Y$b^xoxhLp-TZ6;h8XWG%Jlu_WgnR7>_u3KewIkHEZVirbYjA{{qmgcoM!J4Sx_;e` zR^;}yB6rKa$lcE`ayR>nN?c|4V}c_0GlU|y`xUwUugL9yMQ#r)a=T!W>VxhF8Aa}= z97XO&AjNKnEp|I>vD;yb-40vqcFAJ5OBTBy%M`mG+7uT#?W)-Q{HNIcbg0?gi=4JmOuZYwRVY7|LqBMNpMs!w__>bE&qEBGH@~@d*t;f8yNZ5!hJL7T zSWWG$g>&c^KW5LD_xx+t^1f=;Ec($tIWxb<91N?in}K(ki|NDuIrLl!{lMoi^9V}# zHj|FD5QH9#aR?x1NTfap56JLyga4rCis)ZWG{-IA{45bY#}pm>)FL0k4~D0~hw*Bj zKcqjR^CfVxZ^il76hDk}dDS}RUri$$eiDk~vG$m zbR^C%DqaBn-^b{m!VlTeq2uhMcp-Gk!F7ITEBjD22<}q61Uj2ybY4*Qtq}T-;$xu0 z4;k{I zKa;^Fercc6V(i~*aeEx7vbe3k0$i8FgNjc_{NJ~9?D65Z%3jLhkm56;bJZzfLFsb1 z5nRVprg$B6+GBJcQ}z0xm` zIG!Z^8CZRh86i{P690bqEm3@@$w&|^wsh?AXO*&_3HvpQ?*{)#jLxgzoDH5YWW4={ z(vdiG_+MA2L*m~H{W5TKN`FMBTG>mSb&BtY&R1e|I>B|Ezp!)$g`t_hZ&*6`N8$`m z@FVSXNc;!k_jHR74o%G8;oxk>|B$KV>o#z%KCa)xv%>mqwsg3{dtv>t!qVws>8!Qv zFEbv)KVP;u>*PV_`52vFfa`evqI3$Ob9&#<59iB{Cj~C$BlTXQ_+h?~j{7VfyM3-x z_EPVkQT!NmeiNf}RM|^Be^-0}@^xKa7?+WyKT&;wOTHwY_bD#x*H6djysYdco?j?l zf_N_Kmpz^l;5wdb6(0kgB{4dWD0_+LQN_!kvo}WPb!9K*^Jm4&p)>N#?D={(xb#z5 zf4(1F@+)yJQhYk}|0_m+x3ZTwf2=ul&Y>^p@S)qoP;ebjk>YjGX^PS5Q1%kfD#aV2 z^TQaOKY(+&T~7aR`dzqgzX0E|;rQ)wY$&+I-va&N7UyxSfd1#>4ok-#$LcM69%ovi z(_-1%^H&hT`~6jgR~NlJ&*rZ z>2yNpkm4)3^64m~pTy)t=W7DE#6Jf2rSDdJHFVa*=zIlS%4hUtbBw?5S@!mN>E#&y z7P!PC`8uZfI>a+(fN|sH>vnL_k$lZid;@eo8>90CxQu(!&i5!CiSuQ}`5#K*56ZI{xonM=K^If<=LY6cIb4*==@yS zOFXYAz6&~6oFB%obEe`A(BBZF|BSMiIKQQMGjvWF z9G0h!Gap>XGg$E@(5a8nX;bzR&jX4thtBt7bbhPsrT-pMd?j=WFUy{<3E+}1iRayl zuZGT=7@ck4(hgz98Qk`E~diN8hhUGUopuFK&U%3k9Cwc>lAbLADGU#&A1 zT#qv?;5yFx6yFE^7r?dtua&*Tc~J2K&?&q!dz|CJPov}>^uLtbB*hOw=aCqluPS?q z=W)f4KtpzNg`?ooUwbOu}<#;@Z^gG>97ct$CnhR%I4I-dmB_5Os?kvN}H zd^Gg`5u<-zppuamt|21VVasEN^3g}#2 zl)YZA1J`lB2VCk);(V{-mC*lmjQ%&3y~Nq6cnx%Ni?hdh4!FcA^UIasI!=1F%^boT zp#T0D{Rfo2#QCt|&CuB$qw`B}9p~98Hy$a^^AukK{r7?EcGaTnCC>X4Uk;t;Vsw70 z>?NLGD!vjrm!`AV%k|(=&Jxc!#aBaTMU2j8l)c3BdBxX3=YL{!a)-O+Eb*MG_y*`q z1lQ#}TiHuIcPYLJI$w*?`L42;cy=qk1v>plWH0A5xU?%-SKq3*tj8L_rCucd_ba{) zexCr>aojLaTCJ-2BN9nT2GcR}Z#7@dzQdx_^0itmBWFJp9$DtjrP zzbn2EI%7++=j*-Tk}rv8rs4;nvmr+3Ib|>Ld|UBD&^cpN_IQSY>v-rHa;N-{Klf41UkQCVTwD!FBxCD4yFZynbnn&ZEj+;#sG7AL#6l z(K)8N?i1XJm`p1>M#F;zVjdKum%D}xi zmA%Asr{Y7Q^Pe#~yOq7f^JB%+(7E89+1tYn;L;u>o_8re8aj{0=sc_JC7$hykAqJC z>$1ml3%Jyy++R#lT<%96vvkTxQuehrTHM~3d*0&XE&HEZ{AP>)!Q!`A{Os%LgbuD> zTmMpUU7iJsPe3_b9i!7=aeE){Zj0M~Kcw`f{5uq{fZs=AbberQ+wV^;Zu|WeIMEK#tjm7Oa*IV3<^J_|9%4dt>GvW7}F*-*rZu{*w zHZX^-_j44lf&T5_oG)8vk+PRK?^V1GI?u-F{K4XOIrO+8j8pp8P~5){2IqKe`&0~{ z0xwUj&Yxm*&KMWQspC0I@s-fI6z@${x>!;5wd572g7#IWao- zgG;%|`t93FN8hD=baHOa9?x~)y4+g9InK-J|5Z0N8i9u`ol_`tGLC)0;{3ea z^w3@K4NIp7v3-c=n-(8Td<^V=W$D<@%N?`qC%~3p@@@%FxSVaj7lEHfoc->H-zzQ7 zekINsmX7WB9?O0r*~{^eWpDfaq-D>355n&kEzW*xAoO!f$M*Y*Wp9`N>y~{ltNbrP zp>Td}`{5Snc#a~T3E*6A&hu}U{UpT5FY_(VI>D*@CkQ?iqw^WdesXAP{yt&Z+vT?1 zvShD4%AF4<^1XlnFLkI(B_MXW6sPIOy!P?CttGXxUGLHoyGM z;;b_PI%lF&as0NxNXE}6EM<>+fa5cD;gREQ9iq}A=#nQ3c;YXFdtP?(=cq4Rv z8KZMLIw8kt-v#NGL=knQvc;;H1>#IL^ z96CN@>Dcx4lx5F4TcGnp%igZ9Us?9=HOk?iBNk_!ZP4kB&aeB?AaJR#?XbT##{L$| zzS8phK8v&8UC>z=qw`^9zX$dkW9+wD_IFr*ziV;!yAL|A#OVA(*&l%Y*%*v;`3wf< z@_C=-x5VP?_Yia@$LQ23dl|3l6+Z%VzKCI%hdzXpLzzmV@c zi~yJRK>r+=IVM^O2- zgNe)U2K2z7#^qr5y9>c3zXPE&+_JaxTWZ-?S#eIcIL9*xI`d<6Rw(W+7{nsq} zS(e}DEzW+^(0MsV=MTz$H0*m|u+#1TY;ZQKw)_@Yoc)f2&h;@m)0F)L*f+%3FR|?9 zUXa~CY;pEm0iDms=sd6ND`Ed~jQwkteJwl0am?cEw+1?AVer-ER%mg1U0nmtm(Lb) zdTp`n?RI{@WzT*a;P)dIA545T=9e9oj@{0GY1y+*Gj#rJ+1u^BCkA&mn?wK0ajwN# zX9;u)!F4&bD0>~ZgB%3j93{fe)I&LB(@9FMIt0-VP^d!057oG<5m zNu0MUz8d%7$JZ6#4xQmMv&S%(b)m6 z{r)w^K4(^74v9zhpDzZNc%&RIQ+yBNnFpR^HTom#_La(B>g&Ub?}N_E;3VPbyrJwR zp0^Y~0G(?wDQcZt!6jc3Po?6AptC+k=SgKR@jRpW5$Gf_S?YKOg6nuLR{SV*YGZUB z0GE1{&tKLm9f|XkiXVgiGch`U1K08A*K$RLzw^WQapJcKT<2?q;^qf}=(<~DbXJ3F zzh756lCN(lZvIJ3(*H+{&Ol7|I?js~@52R4M?JWX=L5=K;<;b({?PeujLvVBy|m9m ziVuWNAr=8Tp7G$4FNtT8;)9^`NQ}-VWiRo3UGW0w{3%A~yt=Ub*z9upU&h-4a2@AW ziVubUq!^tJa9s|YW9*+(`jW42D_#h{zm3ruR3GL``@I!h@+>($>`_B|*qjeNaj@xjF9cb2Za)5!5q?%bD+1DE=e-%)z6WpA%n z@3QRS$_OvDIL9*%@vMo_`Kq#?0Q(nW?0;<8b?EApkX{0^Z@_UiR+3#}bi~!g9eO%egc(qmWl@gDoW3M;PK@c1d`;~ruzT&H( zGXtFCv2|LMy~J~$;;W(aT#U}omA%CCisEabb6L0zYWkfWPZ>Cy@%Sm@!!*nO7UHt* z`WQHu1K!d*`W(lyx5tNVmOYo-I>fWn;)99vy%`_JEFJrP_U!p#x|IJ0=nMtd^*-9N z$6F&X+2S0}Cg{*F6Y{j?sBl*>8vau^9V4 zaK`2He#`Gg7H7Y^pfdto=XZj#-vj&V82bg5eUs()Ll$Sh`=Im57@a4T{Q=nTjms$3#e+2p!79UK!j2+Rj!qTzZ^Jgr3 z);R{9t(Lt#{_nKx7aHa8&(AE*I=Ov9{zi;WZ&Z@>qdu^|1YDO-v1Px=@>^iN6^-g_gZNK8&&K?c;_P=NboRvPyr%3|!#+Ug=kl@hn+MM2 zb07UL$E6l$zw4lLO^i;tvflvvIWhKkTlP!EDZM^marV0jI-iNrd0N?Tf&HEs`vaE! zGRyB<7H7ZPpmPQWFI{f8f^)gGS~_=G_I7)|$FgVr?a=>_#Rn7LiT3=IrDM0}p76zf z-^5yv(Z?rE7yehwo9E(Me&O*=j-nVoLGkHVp32z^W-Gq_xzh|^ zrudk<&NuwyikE?ZL-7@f3yl4b72o~ng@(VbxIAwozt7LfoUeTRe(z<-qwqoC*DGEC zeuv^i!51lB2>zhO?cW*R5W}BVT==?|W5>~FOAsqn?uzb}T%?^Ciq+jqXRw`rQIwEdnwhRg5yi+%p5PdEGpWncEi zkiVk%-ZRcH_Qw?;@Qdj2`6~N;=Epxqvt8%JIDQlCT>AC%ic7!#h2qk$-%?!q^;x~#{7Szbs<`y)n-!OS zU9GtE>w7G2_v;VG@GmJY^)BCI;Cf*lsrR2Nd+FDIRb2YDJQplF(yt3o&6I=PuWyOr zwTer>zEAN0{raPdOTYe4#id{WKym5U@*EJy&v8n>KE;eqVf$w;{rY0XrC(obah`wW zkl(#$eVgB{xc(7IRJUD(yaTzy$ulNAipMrT<;v5KmiQ@U-qZJ^TJbXQTNIxFUaNRH zc&p+S;2%?bI{4#?<1vX~m&Ii*!I%6thRg5jbH0o{zoFxz)5F(@qm7Q%9P`|5nxlc< zt+`qK(7$J-Ip%}MHOIL5ea+F(f1^42ZI3hD_;bK7)g0}6tmbG3cW91sT&y|bcvN$o zKdyP-Fuw0wytg$D{4R#~!gX9P#vb)mpgFWkHAj6_YmWN*56w|u>orGxJ)=45>!+Hd zzH%_&MDe3uF4J78$78v!VLafaa4QoXT@;&kPMTAEr6l+s&Fo zYmVkLG#Yu|i;DfZF6;kKDK6{(rxlm=|I3QY`u`2ZW&M8!IzE>J=U3MMmn$yo|5C+e z{r^72W&OX<;`aJ~WeoqE;?h2!Rb1NVUd3ho|0l&|{eRX4nfm2;Wc`1o#qIU~O)-3? z;M{z{(4+-nZLfLxQuTH6_@!dc~K_696zc%xIppz&@33K_#p5pip%^pUvZhg z+7&N^&IZNP;Lj*t0{*h%qru-)d<^&*`QaPxr<~t$;8!SK27Z&`6ToLGUJib*;uYYl z6`v0NRmCg8cUatB|GyH$|Dic&kdE^%4qy4y=wN;ysX6BN3eC|#n>5G#{*dOF-@mFk z=JyvhM??RW=9u4uOWgQn{ePk6SZ9vb9P7;Knxi8%YmW8*Bbs9!|5eSgK7P^S_WJ)f zF+AteOup>(|D~EIL%T7WqrTp!IqGYP=BTevXpZ`NQghVTk2Obq{X=uq*TonR5)`({ zm(+{qsFzzUZm<6r#_*3Qo*NcVutjl%8N8&pjGwP7F5_q3;7q;P>;FQKvhWyi- z_XznnHSZa6`Q3F6!^Da9c0}8wBJ(Z}uZ!%_-mb8?z5c%;hF2;s^W)tXx7Ys<$M7#I zj$#P5D=zD+JHqhIdRS~3jYYX~zL?AUU)m9OpChO%dK={PA3DT7JfrW0geaT?52T=dr~E;@zgKw`IF_@)>Q)zKJ(v+|EGftQ5i)EO? zMcVc~G1tH658(xqRmSx7vtq9Q-0R`>8{t=8^!1G~*H3&Sykf6hh*y36eYifU>;}J? z{d(Pgc<@qLG#CCI*S|{o_M!bhO6gjY?O!=3v^+Q?yqeEAMhv2XwExFquK&)W@cJ_A zE|=ShzW(u;>(6{7yk1uGe8$)6>$k^Te*>;xMc44b*Yk*`um4HR^)KQ2GQOA&zMdBv H`uhI|yT#ud diff --git a/source/cluster/wham/src-M/obackup/work_partition.o b/source/cluster/wham/src-M/obackup/work_partition.o deleted file mode 100644 index 856098ef501d3694a7581f4fb2e31d232649f44a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 29640 zcmcJY4Rl;pwSdo^nWSlx{rv!hH_-VnvL7Y1a+xZXTWpKpA_4D7v=Lr4^@vz`QXmYH# zO2Ow6ZzRt3b}{jlf?q*AD){xp+XR0P@eRZ|{xtD!!EYr#DC~TM_^{xgBR(Sd*NN{E z{3+sl1pfu`y@J0?d>?U+f1LP3g3pA0ru(Ph7ZQI`@Ot7$1iy~>F9pAW_;JCv5Pwzh z_YqeRui1a@B3>c*r-{!a&i&!5#KVGrkN8qy=Rb+p34Vh3N@3?O#G`^wg&~Ud*(Uh; z#5V|DO?(q^Zm(6u`vhN4d|24oOngM}ZNzs8K1zI#;P(^XOPu5R3h@U7e}eb{;ye%h zjQBypUnD*z_@9U$7JM=o#QHo!9Mp6=oA@(A{}STA6#Om3j|sk(_({QI#9t-O^>7n$ z2uUaAJBU{hhfAIAAwEa&FA!fqocryg#1{+x1LBp!&VLcF6Z{XvuM&2wQoBA^3qG58 zi?FkV_%p=MqH@&`KS`X|scVS8D(trqe}g#J+YQ9as9~A+5T8Sw{bq?*5??~`+)BKY zc$oNI#B;=X-M^ps2yqHaeTn#O#Q6^AQQ~`uPbd3_i0>2pS>gwXbN&35_(9@R$<8ap z4-;p<8ORt^(3m29Ky%0>(w&;Kw}SBFnsYBJ@co)|trYkpnsaLu_~XDW<@NhxtzS`4 zq_Y<^=Ta8LFKIrl0O;%u&AE09;%N|iP|YX+I$H|Ind*<@VYn@Ii^IL=a} z1m~O1u?2BBc&#gy_2GMc_+vi&2_OEl562tlV)2Ya)nj>CwixsamuO9LXQK_fLP$M~;m~j*(ESj33TNj*o&ka&k0seCOEoJ8{Y%jhq}m98HWxcaFX9 zozWdnp3=eU@J8339DgdBcq*E&SR6gHdNCG7Jq}}WMl}EZX#SpIi2X4%{V2|%O*)$B z=uX7V`6svkG44P-J6M(C9 zh>HghJ%i@i=Qwed60zIK88pv+$F{2gh>O^sVDlVsjJpCy>^APS05l3U5w*=Y4y2Q# z>yN+XJJav{8q7KNz;%YxMt4uN$LHT2Q3su%TqQ;>~{CkN~37@ygB}KH1SiakI^~0ukKzwWBgCg2XS^hH5xeuGt6DTg|JQpVg5Jr zV^^Md)f{$WbyW>wcdVu-T{TVPFvYqjHa%0iTS8RL5yzdYY7o2Ko%jtPC~ZEn>rmt* zPROH?T{yY6LYz+DnfTOt1OK9Wda=$MlWN9i!_{ zjeiGJ?zj&I-x)OD5hqYrEg<#=s+Y(KG~e@%aaS!ME@FIQ&3DwX?Ft-m5!(}NzT=K@ zSKx@f#-R!Po9_;6zHXQ#qY1re;q?Cw_k0{p=n2{HHtl(5E_M|Zv5dv`fMtCX7h<|U z>bP(f7qQy~-20D@MHBkb!I?77uw2I-r>=4#c01*on|QfSIWAn~LR{2E?N4d&*{f(i z@@gLLdLpmFf_BGC5ak(+uhUKlu2LeFA;1m%1iPt%wcUOMag`5o5#tjZUuBMMSKx?? z*q&hEGaTctz!4WQKC!^(IksJaBQ9clf`Nw}U* zTqJ-AmTtLY+*LZnMT}3ZSsESNuD}r&u|2`SS31UBfg|=B=bImR?spzEd9{5Nr|Y?} z+SbDQdX(?=^XpIR)%G+_1fM&zg*NJh=qf*AZ-^6}2-+OuuJR);Vtir^x52UP3LJ3} z+Y@ZKO^$I_;E27(so~%e3tNtc)Sq5}2QLd6i<|H?HsQNqeuc#(~4OJj#juZa1bDt7?`pNIV(9QHo|HzzIwbMg+`e;4!=WGS+Zi`Y8@ z*}F~aF*4Vdiffxy++3e_9Jr=9#BK*C{tD>t*u{Qq>_01rqDbI~-FEd|2F%OT?_4mU zz{?y5uD}ty9h`V_LV?e4?79{d#BRHVz<>Mq9f%sA=QwZ$j@a$s#33@=^MeaV&Kj-jq>B9j`-g)dyv9ZvUzbG^xMJd=rU3oprrd*j*g)_C7g zGQ6a(JA89*D$yHGWy5{RY!(#b16sQ;eRDDs?n)00Xak_>{b~`NJL#YHzd4hP=fI~E z!qDJgkq{a~ST{;dw(Mi!8pa`{=GN66olWhX|LA$gs&(sILEG=>XU|XHkNesA|K>6t zKYvB^BCV@+ee$t*y{>NVXlnsIKDMrAeLfb=S7yK~(Pqpi6U ze)QQtnChwOh41TA?@eYCeM42a0YW)iX9M67H0 z^6sJj{%x112C}K{q?(599UJ5xP_;%i59E@4OWQ9AuYsvK1M}*tG!(iI=Cn1b;bb=4 z9v|48%(f@{;X`0<$bAp4*luWGfh0WR<|;Vf77WQqWUETlZ}*4F;B4vk?v? z(gQIx0et`V(ojX%vY@vn(hw#p1h?+p9;!IUvQoMa6T2JOT+7;$+(zKkwot`%0O>yH z+IBubtLw-T(Fihw7~j}#^u={)|Y{;eW7x&IzU&OLV-&IR;tF8 zd8TD0dWQzKkWP2W&!z`0s5>a^)|i@%tFKO_H`+YbmCohT{aU>swMw^;7{*s_C>u*{ z9!O`BY7ta{snzGwN;-O%x%E`ZwCN!$1tT++%etZ{M?Ns*u_Jc_7%FED~|~ zLNt|2+0|o4S-uz~gWX+TW0!!SKiya3l`ONf6tmU7fjCHcx~VOF)?HD-uSi9Z z=XbcrMY~oyw?R3-N4-MmLZ4_rF3qs~)7-C$+R} zrn_xtK{=uJdSHrI=L*^EbD$*sS)H#^$`(;6bRWE0N?{;i8Lq%+&p2c^8umTSwO5W;iH3c_mj zWhtFyOXGcmy>T@rr7%-q%vxHlekR2i7fk2W@1(Tamf~vox{%E`f{MY~l^RI(!(B(W zDu@5vVh+LiFg7rP0lgx}(AFhV1qLvxz?|CT7O9d&c58SSh=m|X6`Dg%3Jd3xSht5q ziW5I(<_7U7K+&~=ZV@Rx9}4eCy;IfsxJIFMyG=Z~ah7w$MY6+ia;$qMsM7Ocz-Td6 zrL-M3BXhNjN0Xy48pfkj<+zfbRLRBA0B~#O9Vbh`GAx7k^z(LigO)CV9tSI-9<&K5 zTLu}^87<36*$OS|*20}q2qP1h1}*%U5MDG5=5u?k)baP}^|DmdFceo8Jcfw?@H*}P4i zD@F6PDA%QGgd}hlND?r+T`UA83o%QsC!SC%rD#bB)PAlflT4}>Aq#>hlEpS>)CM6A zK=2uGm+t9N2_Y+m!VX|4vU6D%mRK-t#J0vW3h%qkNyCCnISj-jm{VfmvK=cfh0^tH zhI=WIO_fyGRbK6?^HMN20L77!l|pIzQi=Dfep#0Duq^3;9yKf_P?%I4n(uZYm_&jY zRG<2=5SCV>qiimwZSHeR@!q(^iucK7C^TEs1U}wAS@UnRF#CL2k=oP29L9GR|{H~1azK+_YTjR2YKRI*!}XfuN7vIck;E+ zmG@THx-wuT(*6BKGR(#dMR+xb=9LA?;PH&NDCUTI2+Yz#+_P9HMHhewW{JT*wN#4c z2VgSNTO2h)6oewNw^)CCP+cVz7O+PxUL(a9vsW!{lj0ioti>DMVx=a90xj#VYhKmV zvb63JxGHIG?TlO(X~(NF{ct_m3K?fptg37-Q?+h=XKT~i2t0ZdfNXBiw)$E(Si7#J z#!Xwh&0?D(YtGIt+w{an&u4#w!wcp@|-i%19-AYX@ZPBJ8NT^{>5f}vT&WAd&_Q=}i*58?irtKH<ws%=-0B+4-Q%~#{!rr60=jVUe7dkTA*pan9`Or)ILf;L7S=@LH?D^IM-wGXR zB@Nz}wT|uH`9$dD`Gk4<)_P>eGoKDU17DU-wzumc{))ia!P(aGz)M!pvKrqVm>djR zw*)=~pH|?$ARGcSgCQ$$8pREPvfv~uFeA9ls_d!^tPXCsDz{b!ngR9&9@be#@w07j zKp!D1Oe0jj0ApzS+5Ob zKoFP~e7|L!)qz^zEMV6z2sA+;3vOHxScA4v?>s>GIZuCfddM2cTxnDSv>!I%OzYgT z+2z5qC1o?9jsjKITgtB}zp^}BUQ>Q?MX+q9HOsmN{v%hgMA?Go+1CROz@~4gj!+F` zZ=Q{)WIkoTigZe)4%(WuSe2K*6*A#?vnH1})^lNK||{=W+s>7 zm*<$!E~a937uX{GIZ?abj*aVWF5ac8vfKLgF_#?9;g<a-H+;S7wrGXT=M1SRjtDBKH|c2Pk+u!Jh9Z6hN{hr<)ZFli?40Dele7{ zKc0iHDH2<%U@9>))HF&`yIhi*IuEJ$kOmJ~;UQN@Qd{jIH6BvyA)a_@J@M3f;;Hq- zQ|m3eC&D^UZPa;UuJgoP=ZU$_6LXy><~mQzb)J~(JTcdKVy^eZTpd~odt$El#9Z%*xxo{2gD2(&Ps|OTm>WDXH+W)h@WkBUiMhcObAu=56`q(^ zcw%1RiFt)5<`tfpSJ*N0l;!o~DZvU)308PYu)6#AW>{Z0!x{`Ns7$pN^=Xg@5oPYMu5FXZ=%j{Qw_O$#|%CQ=WPFfh_fC2GYDXl>>tVKUoV*Pz%L1OLi=cEo_(p# z6`bua6P)9y7o7F+O;(tkczvcmEt$@upNHW)l;M|?eH6I@Xi_QpKpYJPx_L>>oRm= z`}P&|Rlyr6{(6e>J$-4=3T| z0!jL{-@j3)&k?Pq)MCf<8{8}}zUc^)jOQ-mT%X)OKPoua^Fbdw zKOoNW+uoEqBKRPc>p34g^Jo(H^dEzp<+_qM`yC<2_(mg4%!kQu#K+F<1~=>T+ro}* zRjKa^K0@~KjV_pE{1+1Ect*4q{JKx@U1X=<$Ik6SpUkK`1m}nPpZM50DfBs>R|MZn z@if2=114FnX5!p`xSwqF;eEup9&D?yMhm`={60)v`h801kC34s3C?fMn~wkY0+O_| zgt(07Qo#>WJX?J1d_d@rXm3j0F8GsV=dh2R7l?Cx@_2mFhreOiF~`MaSRhEUT+0PN zLh;;0T-MJnp+BOnDz#g1euLnTeC!+(`ea6(5d1jBb17B;BpFW=amUR<6`Z-Po?)A~PUo2CIlj~;> z>2tj;r8s|L*fHZdF7&y)FAL6Z%B-T7xS?6o&T8W9m*Z&`d?m&6As;)R7Wy2|=LL_F zo!|M``K!?9cmnjYIgYc9?5rX#%e7JHb38G@H;|ouK6buJoZFY@jmHG%c7ICnO;mti z5a;;0Tt@}pMDgJ7l`+Y3H4zv>l=_O`{N~qFK6b{5b3Jb&J5%9{Buvb? zpLY<)_~}+l>un~EVc(>Q{jt^1$MyOEl?#76gb6RR@Q>T;^9ILuWFH5Gor7fO$A-SS z?{Q4%kCFageDr6}0cVi7T@I7}rNr^lw7<;I$MVu+pt{1)-wK?|^;Sb4>){C5e}|!e zv!TD;(5G8GkSg^NL*K0D&lvh>pWm?iLqk6coa6ba!Oig!nu}iSdceBiG>_eR5hMi%69M4umAMNlPe|H=D+YJ5t4Sl)=&@K)b9PRKMf)DxFIYwOe z^Vfu(3fk|OO0TrVdNAWTk2uyDEx9_La&9Lo1u^S*cli498UxaP>rdq)l+gRb73^B3(Qu|WjoBS~` zue2}KPQjNG-zRt-@y7&jB>t@6R}ue%;46twp$g}CRujKS@F?+X1#cn#Zo%7#-z<11 zaegy6``tkNi$ee1#J_9se5bPId<*r)&7F zn@)~>8qi;qoc8;^CpmR=d{aFp#}3_$ydijy_%(HwB%N(?A-OoEFtP zC8x#hi;~lG)b|X2iyeyo{EZLSuL1!Lj9=^H38eF>o*Yi?b(Q4QUK=H+_8OL)>hWWe zQ+)VFcTA37y5@adhf{mKF7>Hh&Lg>_&+Q^PwM&P=-)D!QKY5=P?U?*7p-;tC2Lz`} z#rw2uhv(0ig+9-p6;uw^=lQczaGpP}7kmMgp;z!Q@ed2WnE1a7zLfY+1?TzmWrOo~ z%9v#`)i=g(@+Fd^0;DF%slWY;QAR6r*^8K{^FF2 z%71~ux7$V1pI7?u^@4A>4F86RQfa~WJuyY|U4pONa<1l|6+BA(alv<4=V|?434Y{b z3pIaT@Kas(H+Q^Gi{-^~h3Sp@%cui0UranI_)_9Mf>#pXF8FfdA2s+0_~rCvAO3y8 zc|0B!{O+V}>Cb{cvuL(%@v~^&#d3|nzwX;@UMG0nj=5UD#o)KvruFA$AAYOgV^^2! zo_Md|>X{179~M0Psi~U(Nbu-`Hh)R*=ci56`en3kV7V~Pd4HR$`GtaSc=w;KWrFiOxkm6! zRJOR_4-mga@Z-eq7o2}D@lC<`dtu%e$LbmPr5j_k*NO)SZGI3(^MK zP2m`MR^$Hrf=~XgE<68zV^zXFF7xBxBP!}YZRcNZA9NjoswY4G-J)XouPl-uZ)~K0 V{QE}5^501Lxtv&joN;9S{{zE|<<|fJ diff --git a/source/cluster/wham/src-M/obackup/wrtclust.o b/source/cluster/wham/src-M/obackup/wrtclust.o deleted file mode 100644 index 2edbf09c57ab15a7f8c8d93cac71ee26626c388c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 212888 zcmeFa4}4!$egA(y$tNMu(xjz8fC3+|K+swORE_-6l=cIkYX4+yg8{)NP0}XNKOs#^ zfC5n(O-uvPZ#$!+i<51c>ol81BSQ#?Yf!gEWiGnTWn0x$*^CS^I`-}F{W|A;&b{Y- z?`gFJTS>+v02ODPFna z<=z5sZr}`e7aB?L7bjfmsVj0Lu3Jba=0=3PNbwvg*_ta`ai|!$N0-`L_iB zA@dRDrbNET`~~JFzurIzhd+-pH|6k3=Esg10D6U;L@yZ71_; zJ}&3&A29FZJ#Rgq|1Rd$e0&FQZ)ZNn$924IGUro!gU?pI@g8D6%-p2+_nD6f z{-?}G1%HzHnBafMe4M!{KmW>ng88W&pI``~-$w<%gn7Tx(Yh!Ne=^4!T3w|l{UgjjLK5u8o1BK-NX;O8?p{fqHK zDRcDO_?UREU|uBn&CH7hZ)Bbld@u77<`ix9d4%~g!T*rC>F-SbKF&PD=NmrEyn?w& z*FQ3^V$SaH{)72#%uRX|J-gwV5 zUnclb=GO`SbLJ}r&!HPM_-!?FQ_jz1zESWJ=C?67ez=x-o#1PkZ)0xCTMhFT!CRQ` z75qcY_X++9=KGnO^7iM0b+A7*ai|7+$?3O;w9_UCg#=R)S+ z68tLWF9@DyepK)(=EnrTllhB+KfwHD=DhJf!u(Zn{$tFOoUz6~UuHg+xzYIs^M!){ z6Z1vPO?x=OJSBK8-MFC~E@n>ETz$@BUMl$I%&%i^;&UDImCSkLtz*7g@XgFI?#9RH z>}Gx&a})m#=GDxpc~_rLGT$cn=b5)MH|6sg=KBPHfq9SMKVkl;;J;zsFZk&+fdhXY z7Cgm#Nbswfe@pNinU69z<^LAuV}fsEKF*w)9rbyT`OAWTl(`uQ82|hc^SKVxbpM;O$H!wdccqQ|3!5f&r%-qE1KIX;&hCj@FE<48f=QGR~3VxV5 z?ziwU{yDji6TF@Ie!+X0_X_@J%pYTJ;`tQwLxO*s`C;Z%%+%)?^I>uRub7Vr zei}V^KzleU`1#Don45eoW&WbzE0|9*H~zVqd6I$Qjm(P}82!D>7YY6d^AhGJ-~W(# zDRXW{y~mlC2|mocoVm&0e`JpPRD2Bo59U?OdE+I{)PAcId?E8D!7pRJSMY0?cQ7~c zU&Fjd@M`9`-^It|`!42(n49wRLFR{<8$W-X`HzL0_O=X;nh68sM4i(&7UqYToAiE&`JmvRVE&xof6jbF@FC_$1^+JdalwDg{AK25-12MY zlY-AJ*8Y4|@C%uHJODR3S20gAH|b3?FA}_p`6A|~UfjuivEUCdU&7qv*GHHy6Z|pe z*D*Ko{4(=$=BA#0gL#IziT^(_-zfM5bIh0EW6sY#NBeD?;Ab&!Wlq&!eJ*F-!`#H@ zI_ABCuVdcF+_YnxnPYwhAH#PuA7pO)+`)WE@J})y7X0(fM+AR{`6zSa=NFhCWp3j0 z6XxTB|AzU?LjQDn-i&_vRl!rtlPqk~bv5(3g5St|A#)SYTbLI!H~!zoJjL9Uw+ES* z2>wy#rOZuv_#@`m2|ma?!<>`neUte{!GFlSnz>2uFPJw7o}}lp@LLme-gsv--z)eV znRhTZ>Ajvg=B4m4>B9N|=szlWE%ScC_b@*!cqj8A=BA%|l=-mWUtm7M-1Pg;GC#)L z`19|XPY6EF{8gdWND zXI>^ao;M>tD}~PgVZK`MKW4sB@UJkxP4I6quVZfF^Uuti1b>P7UcvKdK?vg6A$T$K z1A@Pad7t3#V19_XslUI+d_eFz=7$BpoB5#NA7=g}bCcdrF&`FufcXo|O?~_t^P_@) zkNGj?rky#?{6*%bT)oQtWx)$C(Efatxryh+%nNA#3?IX9WZp~pgAYw>s81#He&+lb z+q+lsq&N0WecsqTdix0Tp|n2J@IPeU_q5Bu%)IUG`axz!%Xr^1`pk{a4~_m8_4$TR z82vZv9H(wqeey2Uen@e8>zEfa?_<7|`J0#*(0mv^#?S9yUL^SMF)wCr{8`6*vEX+z zFBSa5%rWnXkJ0%Q^NipF%r^@DHRjcVe~WOrV17vO_cI?9`~dUk1pgD}BZ5D{{HWl6!+e~%DGy`JCj|db z=97ZwU!?tJDwfeXhj{^4IFsHb%ohs&PUe_@#mAh#p7|2N>zS7c-pYKX;9blsn49+J z)6A;`{|n~Tf&{+C-XtUKfwGs!4EPY5xk%IQNjO;`8acv-oIr&A^5*ApA`IM=4Qgf=$!Hf z?Y9CR5E*_h^CH3D%)D6ea^@+)H!v?@Zv450`7*)pVO}oye&(wM{{!Y#g8wD+I>Eor zyotG)Cm&_rBKXgkw+jA$neP>R{$lOVHs;2kic?_-|S)!u7j z{+QqoG4B`r_n99O{7;z=FgN-2B=aW)|2yWxg8wV?7X<$$^D)5-F42B_QSkGaPclz( zdY3YPRq*A^X>qywnDaL>PYS-3c>!~iU-vRE61>!Mu!l9{Xp(rP`n6f?vWsBX}9}3c=sayh`x*F|QWs7cjm={ zdnMX$DZ$TRULyFV%uAW)a(v#-e3{^@nU@K^iTQPcH#0A1ZqnP%JR^87^9sTLjCqyd zPcg4%ZsPxK=5>M}W8NV6ub6KW{ItupKbx4FdUQVXR>4b|w+X(2d57RPGw)$;{L{$1 zSMa^e`viZ4dB5O)$b5jgiT~rw2L&HyJ|y@*G9MQFKbVg&H~vq&QTy!$!51!hDpuiT{U~j|u(>=Hr6@Ir9m@hnPE5P{Nv0!gw7%6 zcy5f33HNE{y@G#-d7t1vV&2c(l*38phXtQ=g)VPHf?vS=TY_K7d{pq2%#R8F9_ACw zO}g%2J}LP9%sqPU8uUXC^8&#?%e+YNFEK9`{CVan=BB?m%6zflKWC2T;rJMT=9Fr` zEff4q=H-HyFkdbBwalvoU(38s@EYb#%+2_`g*l$9<74=Tn70c43FdnR|8wST%#DAB znC}z(yUaTT|1tCZg8!O%4|5aGxmRj`9uWLO=DmVn#r#ph)6DyroBXO`en{{;nGXv7 z0Q2Vr{|NID!5?FORPZk|A7^gT`wiwV3jR;bCj_5h{<7e?S82aZGB^2k7V}pHznr

1s`PIC-^s+V?78yM(2mjhnO$dX76XrQ?wodAHye^w+WuNO#5?8@CD4v>G?c9 zX}$4M%=-ji%6y2&6{Z|s%ltXPGt7qtuVjwrxA>fAB3lk|KNpLu%Y^)g>5_#ZQ0%=|5U{$b{~F+YR(v&@^A&tX2od@pm(Ht&bb4=^|5 zw-=c|%AALH-fx%>3jG3#7@ku<$K3esEaoGEFJ^v}xe50w=EnptXa1t#Yni_+_-)Kz zWp2k6%#-w76d#jct;`oPH|Kwl`6A{fo(GsO7W@yHFJW%{Fu=S_@TZusWNymIx0qKj zr`s#_`2q92;{0*u9n4MqUt!+E+?0ppTXlXt%G}iJ1ln45NHnE7pje~)=Jb2I)w#=L>K>DOLj-o)ILPw#CyzuK73)o$|UG2hSJpB%uRW?h4~B2O*_`W{FuWMl z#ylnX7nzp|ooAU}$GphXpKmi?&D^AGjQMTMO}Ia2zD@A|%Y3iUIlWBh*M8}aM!XL=O`?K)RXW?JT!oQh?|7#Y0 zA`4HEi=)zYM;87ESvcPJ5v4Pjh5sfC$NMs(bl#bTeIxZ9kdX z^hBmJJuCtJ)P$j6=gdA zI@5X3qX;}fMaBCHTB%G|JHV>WA-ZySRp&ET4~^pj9A!=nljNA$eQ2`cK?FKpL3R}= zpD|8n(ErL23iN?@XC8WP!VfreB)J&pKb^D@C_n@-*!v2;C;|XF0waM4JoH=<>5gT( z+vqHvicIH`Oy~EWK=yMqPoyWh(i0C&mKQ!e`hUrzN7~1JdEx{v$aJgS%oE;;eGjDo zI*&YsnDCV10Zn9735B>1s?X!kXKfeMu5kx5aK z0qEl8DiegnyF`{!xkMTQ<#H5q!Ey;8NA8>83-J%{7zdajx>!D#~kR8o=t*q&>ET+nj>QZDSd^Fk%7NBE~# z_@{3w|KQ?)f5wG>a6DcAG)eyes01O;WBaF7`UgPDh5UosK((^Vqh`44Aa)DCki&aj z3r>6^)77ov{AYf8VeYfvp6pDwaevX3ZfhSZe0VV&jIM*4v<;&C*RG)+CAu*ivTcmh zm;t+OjMBdTd+)j-@xWB_I3du44O@Aq2?G}Lf!6#;dy4F;!$5+%lkJod)TXzW5YAd< zaE)pAS9OkZ#_3L@tFrCdXA2)bD!Pp$?L~AEx^C0F6;BlcP7a6QH&?LHU6qGHt(U&q zG;E#eeO>8&o#~Df*y%uK-9cy2ZZ7aX^6WlJTn{2gnfDG~FxdW4*iJ1TAwb273Jxv| zI8y`FpSSly(+Afhb`PFTEqostaPYJF0duFq1YpgmlkbmcN^xDVDMieJ4Z^67+48U8 zM9u~jcoJ6e`PFD94<;lQap^}~=<~C)LuYg!2XRVgJFLX9QTGGXcc^o^J8?~>^B$1hfni^l8thOaDfhU!?NWot%va0+`>&K#_v1L_X|><^)gl_&Qxix7y<*x6jPr1) z(}+|2G;%oUo+If4$n~yt4;sfu-bk_ZyMwOu0ZP-!qk>aRR8lr7C2mx3sH1{Y{HRb_ zJb<<#+_fFZ)^mFQMgE1S+}i-)fG)BT+Sk{e<9QK1r!S8a0zGGem3MkhU?Fb@{Yb#c zZ!+NNz}-xd4aXS(0A~$nMt3vCHXtWKz#<^{OO;#{EE+Pee0CDGA4Q-R$L7vP-^~=D zxa%80UEI676;k()bgyB0p!hkQvN3jC0~`_K*g0HcR0E%QmU&T@9M_pSHJE|KdNrIJJWq#m5+8-KGvD; z?@B+0mg9DsNbgGbJv5Z;Ob-N_kf|E6z+FTc>6>PY8b&H}Ab#Y!(gU68!xTVgda#Rj zD*I?qx&Lc4_Ms|17~OmfW@|pmtvj^0;S>rH*bh++o1mSoaQX70`N&v#?QNC^4#~%D z`6{foQ&4~-w6jG$Ys*(<<(+~89FiZ*G!9`dFjHH3AXB@q2Q3CNVvFdBYuC`3&+9X9 zr!)6|T%DQarl{J+z)2wR^kQ)RFs*}mAZ8?RO`rp4u#s@w06e`&*e0}Vic5oOwDCiQ>GXQ${6tHar>kjUl}Xu<}&Di7nn_$BlFi3QFY4vokPA0EO8$(@l8PiAAp8fazu zZD3BKfZf23Z-%-*ET3kdS{~|CK?2fxSXTJRT@SgNH}f)o?awu1Fd`8Ot=|VNHoK$y^6f=^t(fG!!~AP>J(+*h?r(8 z55Bw@IF4I+rziu5LFzsVAHkpMIF7$VBAWKvHGZ8IMZ|kGdTN5O>jV`D`*|Pr z;!^}6ib;VD!tpb(8^rM?(EV)<42oMk8AcUW>M)*ha$f1+a+3>;?uY8;+A$ z;H=@Ofx($G7#Nh;z??(@yMZ15GNCC7jwqX@R@X@cu&e8r%{bF$WmevaHgJS|Ek9bK z7WlmpNvNIMje%&^TX-9mla%tQ!_p;gI>Ct>!i){hNgD7JNwZCv>X*`owiNz+2#Wwp zspT^JWoX6X&yQ8u2s!Boj)+jUp2%;-L=#hG<(>2bhvn^vaflv^;{2}k&_k0sh5K)$ z$9t5vxX(oge(g4)kfggV;85TbS*K_G$F3r6gH~Rrjpczu@^O3FA*=0V3vh&X>}(mf z@;d6Ov!Vw`QSuXkTiGr>J3|kGC_DC3*LHt+vYnm>@ndS#yTA?Lhz-<96L2U^`!l+V zO(id?)~Jy9V9ne>IA2qNq72ZaxYwVhkXZ94)-BKSZASuTwEmR~YP7Kq7 zUOM?m`vLlf>*(n$?P2z^jZVqbDg*8tZ{m8MfL^4g*JM$1b%aR^G{BU@5Qt>?kxZBRerPgL zxDS8(kDh*Z9R$Dj+56v0?E@BRWV$Q&XS%yV)#ETMc=Df!Qh@YCl)gLLJ0?$@_}Mah zmD0&{(=$>rdhBdJq^`oZzREmpwa+$`R&=RBDA`I)-!I%!!*v-rszv=<8l8tQsa2wSPioahLu+i28?dc^h>sRAu|Q%9@oUL$EzTa0WeOwe7;3LJcgF zK9gsJ4OZUqEO1z!dq@=Bhk3FtZqG77MJd?GaB%?+hnKZe%-Z2kT6rfqz!CD1cg?=G zXdgYwz=)^=M`*`xUJ9(d6Lnx$9z_$y5rv6!gccys(~H6{BoCsbW4~*m+NEV*bdy*3 zg@tMq$_u|ywpTpqjZ0ZIm z__)LP9vimKGQ@xiEpRC884Tllt-MYe%L9kx<2JT^R@*6Uz!BQ9bEV(PJGlZJl8+q5 zAEN9y6g`YTWXBsQoq=KefDP116L2WdLs^IMzPuR54_bLAO~4WI?l7L}(DO8eAKp?} zBHPxP)v6&I87Hm4p~%c&ebBI#chU+Rl1Da0Gzh*QMQ1r;wVkK~M`&le+w$c_HjP?& zC+ff<`M9-a%xXJP2aeE=U2Ddzyc2ccu)OM!RpF^TL`&!RLv;1GCtoVO1$T>PDN_}G z?t=#1fTDIZ=5$7Po7z^XUv7Yzap`jymmWuF7{4c*u*q<|1RPGr3_HW~>+k8@*w4Ki z0y(7Dl7R%$7+bL^qzDpFG(REfO!wNcQ!mC&|4q$1mCCqdrDQ$Lq#wja{qUfiE)V?hU<8uEU+DnwN_h1HHTz>= zRA`o_o_P*6eTY7(;l>HOx)JR>IP&k57W(}LZA?=;26Uu-oHocN>o)xQ(z>ljxeedi zZKd!D{{Wu5_nYQYWO#0kq4Z5^}kcW|w21U5;Jj z@)R6Nm5(;Yx24**W$fGNlG>}>hHve*3iyQGRz>^PZET=0fXQuYlih8T(ro|{Zd1C` zE2;GI6t{u{XtzNnqo^($8>kpM%~}JnI}T{6H7I z14w5p`pjqbZzAGO50y?t<{@w>ZZnu3DzoxV(t(Bi?AGa&+i;v51kM_cTBma@)hY4R z_oNGWGd3_MQNV6s$N!14k;>yC=eJc;t|cF!R!Nm$Q4FYo8>3PX^=qs_TtaJ*Gu>41 zyJ_B|yIZMre@am zxHY^qsq!VnFB23tw%9c7yCzi)ixX_8NgY?i5`aQeD%ls zXi)>h@CF-@lOSLbke(clGwax7wVgx&M`)}2&BBM@gmUPvd9PiQb>^|v2H`{>*bUeI-6PzofX+yctpsXd6|L~B!4_Ds;i6snSVGf8>onXz29(d_-c5nLTy zUP93>d>Cu(Wgoru14lD1t5I90U za!H@B4c7!(zaFdYL>)LnJ9gB2t-KR;U?D%duD8#I<0Jz(YdC7KS2u&fUcU{@NffXf z*ztU*#~SPn>5NnHK&P?}hKb*|SLEV>M&D7pc zBfsmO&OGyz8B4CR55?AXuS^WA?o2LTuFhWFNv~bQ zyVr^^zd@tI2CB4rRM@2U{81r}^{5c%I9^B{|0TJJyb$*mY{0tN$x~n_fEh0I7_{E!!p%JUCqmB@$zXXoZjve(;E3c!@^1u=D z@uEIvwVkK~M`)|4)7uJYh&jd3RgC7wZ4gfMf!!dE=aDWy!8(W;7W6iMrYC5`3lpOs zI(8m0j}`-Ohw-QH$ur^mlOc6G=-)Pok!}T_ zz?3Al$vzucgvEm>IA*#ZAYwL9=}vDFwHT7Y>3#s+OhP5(3nfiCi|KysQ)E#0uxn-m zC#a-Rk|t@x$dh%jmv0* z!eGuW*EmC)a>Dc!06D?(N1npl>w-@KC_ij1KhoYubJxN5+x25Ed+Jr6xP(_3P@b8l zfU={S4#^j0uzI9@fX+n!Y+^d-i|gpo+>a3pEP{7q*iXH7P-Fo8`;qoR+TgY5Mtex( zVcMJ;z$3s@rw0M(^fb8X!J(6$fZv8F-t-zO8~m`JwCF~&`*B>NC$l=g+C*7@xjlzw-mgF@mdZ_tfXc_6AeH**a{WSo52)x#>zX%0*;UmCM)?Y7B`ooY{bv3F&nItD&SDCGsvuQEAONV*p;VWKkpNcvFpZ!m3Q0?Ead&s)J#TglQtZu)BtA~*doCE=jfG98c;TpXSRF4H0(EANXsIqs_P3pDJK5#zuRN6oT7(24-Y;UE)NTV}f zK%*{Y=xnbhGZ!K;?AuG0u6BIu@r#Gj!sC|$+PC8uHc)2|OwmxA?BkaLq#B+z!#)5i zcXE}7(w*M0uLzRCVIP3*Z=fQaNw0%PM0xyzeKesIaqRK{6?jh z+91EI+nixvn{pezwcCmi6uYgM_O094fH4wIq4{rYvb(KVx(y)0ZAy1~!@iVs8-R8j zR6=f3((E?uv)iz1+%}=zHW_f6_j5`Yjh1QSxUHNnw~J%;DYxNUyDbH0u-i&#-@1(r z-t5Opn`7qKs3_c(RwobSQmpC^*y}$0-4i>rSiikyEI^9RC9R2BN$M zx9f2dm6|a%Ov15Qd9L58IpRl9ySlquAvp*&;k=28^zrXfUIcni2SIwK{!zdc7r(H3|)UPFq08b0X?jVC|kg8V1aN{rnHBPa96h;miUuo zV(zNQ2Iiy;*bVIXWpo1d(o|pQ55dsVQ%c&cZYFhgD=YmN;d%R8EKzTYZE!lT5GW-B z*bOcik{+v0BQTL`DI1th8wUpL2Br!Ir6>FtJ!=C{Vzr$@2OOczldt$gRj$kEx3+!| zBKoB^2pxU6l6(d1264QCOxj^t2B?MIb)>~Qqb&~k-%9K|^9+_se#533m8!g9I zz;3jT@1qb;sAl1KGW>M8OHcN+Z=u(sdXs(pr#*>HSdYQV0Huv|efkl)9e%jA;7(*-uf(`{^bkINpILD3ZW3 zl9>HO?nI2GeR+|616E%9faQTh^7}EW36BEyXB*B8T5YHN0Y_+OTao6=ixp`@R^BOj zz*4>)8GzV_%eJzZS6m6-58Du&@&_CpLiCC#CkQA78qg6Ngi{8AWf1BOU2*(BYPB8z z14n3QTao7bU#v(Qv+|Drfu;Nm{XcF)aQqJ(9YTEnPuL(F{{zb)B37i4Z^Vi;}Uys%d79PX8(!#E-i>cEY#_ z6=NI`3p{q3A}pGu3+VIYpPe8tr{>ts^mdRst+1ePJ=0rCF)=f}Wwej(K`kd?15Jwp zlONS4`%LdBatZlwo+|)E%=9YV>CN^AHgw^eAjRR!Eut=-n(x~;uQ<5t?B zFqrA|HjO)IQ%;yBp^+0Tf3oTH9y&ERo!+a(`e+lJPVd)vfHuMD^g)e>XcJtMG7LOb zo$7uZ;p+Ksk5*Zj8b*1FLvpB@W$&g@f9H{L<+nhEJ<>i(&n)rR>x~!2==daI;u16e zUV!BvXo4Oua>K`=&QP4}`t!bw&5KAc0s1t80A6msrm@ zjt35eG2;h6rB>c?Jg|_TT_q^9;W)_v&Kk~)DnYpo$Vm{e2q=DDWURK62;d0q*p;Bd z$~#d9j*y>zC79HeKy7|Yl^_+W1R#M}2l}b0I>D%cCH)|pOT0SBTr<9btV z<(<3&4$C{gl#hGo*K$JJ8VEsf`PLJ)OB!_%x3ZYJIAV?AzEXEAONeI6^+0v3-R;6o(^)LaoUqYwiZ5^|8Z#KgOa0=McV)Jg^yW#ZT$>Dzn5 zaw=-}mb!=1M!&Y8Z+&lAfg3-*H>{$4dvC}Fx;F%-`l&YA?+shg6d;$(Ej0keMlRJ; zy3@O*Zi8g-mKs3cNDLRXvYZtIY41Bh^&(w*Kdb&qr#fOZ>HLT*#i z>^AJP+pufg)}!6l8*p2nc3Z!6TRB~BOIxpU8@{#Mn&1<5TPy8bx3PiT225^Ko9u4u zm2LxwaGTPdUTN!-ZUfM6gG$J4N}An zl2b`z`eiv1aH@lcNq!tp1t8^r(Q;-Ov}DJR{)Zlr=0!hghX7kItK zi--Dbv>aanyU~)1hs;`$I_lnntA%ikr3QD=2*Rx7pnf9!sC%lHuk@og3QS*eg$8zG zWkS#`$4LT_iw$fbI_Vt9Ktv!k+@&;x7aRB!r0B~7YmNu4wv*eyG66H0e;u;&PObq< z`RS|`X+R#DwIVopP1cH(QLh=yM0kR_0ALwO+@!@_D^hOdwGUVxI3yo;tw_dd>+IvA z0UV(nd#y-?mDf>cd0;6&!?g-kHUy{q0Y`@rf2~5b4MHaZHGr}gSOyV$tw@8_cKi<< zp&fgzNRyR!{0}VUXXyV{8-nA1;OG$I`@hWw;rJg|20_(JzP;$TwN?bJhg~buIYzfM zZMdb0KgBa_n>fdVz!AxdJ;gI(vjI5? z0(Jv3PdFDXj4u#dJuP9nKzAP9y&&y9rANfPl>C`yAGW$Q$P);@jXA8<^_BfTSaT=aRyu@JK zu7!oW0>e|xfJP(@ScC`dY>lfgFMg4LDX)m+07uA&Guy+9kK(7Q&j#xhVc>{hW2dU$ z$~&0^93k(f%KY&tJQYCd@W&=Ye@H4#f48p)U-Q!=`soNQU5|3BwU(3oq zY-6cifN!cXz!9;GUD-#hymkW11Bc|}7Q9ibt)q?*DC)ow+OZ4Xn3Z=59&kuLZowP3 z+B)i7*?}XpV-~y#EAA9L;E;HXg7=>^(0o}Hy~xRJzuOigu}K>pC!2sn(RncwJDWV3 z=m_3Da47%|$;Zv60;}z06L5rf%xo&M;!ZXJyW-T_r(gch!dr&uJ>e(s@b!zqDK3Q% zpGJ4%C(%;q+Cz~0t4E&+C99SCQJx4DBhD91s-*@CjSxsM%5 z_v5Or^kWZA<`nMVy@c9^+H`;PT||GjyNDqh1*hx+izq-lTkGh{iyNR}E3Z?CZ#2GP z`PpUKhz-ZdG+>boKb#q6+Ncf6$uwXQ6g!`Cla7aFGTZX62pS0}jc@&AoD~?c^SC zgm%o_%UE$I_kcsGK9F?)V%y zB<{@i(7UFnLd;#I{=iJ_?Ra6H{?jp-2Kqia#=xlXr}W5|M}-H`kz!!@En?iEwvW4= zt2(ru>%Q4`u1z+L+JX3{&J{S6#u;?3tyW&UkmZ40d7d$+Su_2@v-gTuKGENQ^SsX}MebSL~8)T|*JdnZ?c-Pk)}&A4U_+u)pB26ls+LCqSm+D_&*H-wcKX#a3Qt7|R2PQr?3C05?4B)}p0xRs>T zYCDw#I6^ySB`LGwP9*^jiO2PMxz%=j4jiE!+vgc8@Aw=zBp=u36;|8vIdFt_OrKX- zamVMtA#u^=(`%BZddf`o&bi&N50?XX6-jD|%v}W<2Q*a2X`89lug;8G)UU?a*``%W z?Oc7_Is~25p+)^}Afkem*+87k296FSb~4Is2u?D9qeGZUGBP$0CmFzQAi4$r z)u;C^%}YEowc3fe!|a~>H|SjGub$w#$lj(Jg6i!y z4QkKtZE&o68=T`tjqX`hcZRi3TMDljF8m-??O}-~b$2SrBkd_l5X}ag-<`IX&@q0c zhYs-x@5H``Qe@<=@KZRMqVW`!OA2a~SDKn&s0_DP_?N3rl>R2ALgIxwUF{PTTm3gZ zI5cy5wGKo7u$V*WN{{PzqKb2yBF@#TYi-mix>vt)_4EGU$?HlFVha4zl&pX!h|({O z{m6&Yu8g6yn}js@mzsnqB-4$Aw1&@BNSv#>=6I_Lo5-obZlCWtf!&g!yL~JgoN}67 ztSW4^@=kLI93ij#Kwj2MNMo$O8{sE%RnJg~3NFNZ(k{e%5)1Jb&T5EMY@ZeCRs`QP zL;{XTOzcMzDJ!pi#qz)*`MBM6iPd%*K;Q`N*xhxhm3Nvx;E;UW?z+rs>!@=H1&+{; z*$**0jS=VTjjMD${>&mOY!PPPGu#5s2T!H)wY z@)9^CA2%;cthSSvz!BOp^Rm>6J9!Bl5|3Md%B;5IbKnT=*gh|}@=pB$4#~&$dB$ox zJ_nA_j_LCXEAIFlI3(`WpFr0>KRr5wT2N&}c5(zbBIMXPQf=j(903l=$IX!jtL@|n zaD;Zu9BH!RPL2SF#AS}8N9l)C{(|c1wP1l6?~l<7z0KHeqqdqWV{0tnDkDDU}R@=!D;0W!QIZ|ZBog4uUiD%0ZZnSU{G)7~I=ka$_ zBkp~48y6Tk%=H)bR35@W;bnRmjaghXV0P$tTLbzzEuFHza}GW6!E^X{w@+>MDVUS} zz!AyRe`7NIHUas-J7)7zZpC%PSsXYN@wjz5W3?Th14n4bt^^fU-tjqbggn(}wR#B4MV|TB zT%O2o(^El3`@g|+Lb_d?UFEN`5p&WF91*eD>8`f&PP&0zd46O!o1YFe*sz?W08bH? zu0AvP=|GbW&Pf`u8yqz-ajQ|Q)pn{8aD+Ch(Hi%s7AP`y5g0W5x7Ad(1;-Y;4yD^d zvZ?}wRsCMeol~sr(5gY#r#m84brG6M*zFE0dxFu0t215co(N&82hJ+{xRoa`mgvU% zocQB{KHJj;z0eLE5#QK#so%;w1r9huUNs9vZD=Y6kyYvsu3>>zF)b>bLE;8%=uYB* zBSMdzxIruLBn~)2UMEf^g_5KaIfEn(*)W|X0Y`)xJ4wS<-boU0gnZWgO3f_4Mr`O# z;(#MUkDa(tEAJ!@I6|KD3rR8gWoG#XFjl{tUaCNA@e0U}0-Nc&z4!UA@f!t8DgN|E z!C_i*k6wvx4Af!`6lHWHv|Y1$~#3LSjhWDhHd~( z?nsf0J{yjcXTVv*nPJiFw?R311}uVt$LtFxbV=}EFmY6m;`|p(j8VqeU%OzO?%#*E zt3&&17yW{XG5>z=Xmq9@&6eo{HVN8W_@+t&97@8`teNi1i%cK1^4dcz4;+$@d+#x1 zwRO}H0!1A-LOb^T-msN-$}4b4KJGwu#A@rPbGrf@p&j#nZ`6uAr4l$KJ{DbE#ID;C^aLz$D3-La67Rf>Smy5E%ZQg^7Fc;F_kct4adWT8YCE|H9HAXE_lm8!lY77+ z@whc6Wwo6e1010pyT+7QdB^9#A^EsIFSXi^&w(SfWBRY;!`X`Dglnz8cQg)9&3 z%D)D)L=`qHofL#fNdcZBtQpS|RoUR2Vh!vDN6lm0VqI;ubyB$V1&+{;S*#nZxKpfw zL*j9pk|wL|94)yg|Q2M)={^?94sc6<&Tp&irb9ah}&IdDi^biU5iSN3-s zXYGVvgPPT2WAEfDup4_PEZsRzXZ}@m(!Dk~CzpZU;AT*>`mDB-%fJ!ZF>|@!iaWUs z91@RPvj(iTlLx>N+Occapp|!g4jht?TeF6&w&Qc)2<@0YAGYF-&w*WWr);_}n3#TN z9elwAdSZ0effr1uCkNE+m|xZ2KIZ)7_ZYumVuT{6fATx3_WYmx;#mLW7w5PMa9%L6 z(j673Lpv&PUoa8(etV2U4o>+a)2JT>b|Xa9Zw5nxaVxJgjOBqt@^SCCC#<$pNq{4? zvsDuR?m^u9OFhwRP0l=fDx#F@0WQ#T}mmhr~sf{~Etw0*wP2s#(2YB4wu!oNNY` z$(i{JCQ57|PG$o~2ST&2CwYYh@-#4mTxvsbk^vkYf*!@3BoHxxDYJn%$pCf((S4Hp zf{E3XTl|6vbSKk(!33_0>}^V+qFyjjruO{a2FJR$!8vZ!=xIzl!VkS*0xzRS7e`NZ ziYP(B7fck>F}=nCXM|s}fRia2Pmv}C6@0-2g26+da{qGkq6LM-%M<99jxOkIuLz&6 zkUTwolwL*=K35@e?#W*;aV+qH3FC>b^s&zNj2}Wc?aCNRyGcluf2m2gLLzcqNJvBY zT!qBBCiiIDT}|G?D?;|1Hoh~1IUPpC)jn*32b z#Q7mrA%9vQeIS`C43lD^ZH<;wA45209qRAQ+rG#x7F|1+R~8PxdqV)g=^vv41WWq zr?$DVsU`J>OX_eT^lF-$Ywj^A-cz$}Hzhwhc{qF9&buixn|JQsp#-K1S;t`3;fEZs zyQwK63M+10yL?UB^UU^!^v30zGM;C)Wy#V6ir+ZYxA+M9i*?cC?lgFlPnyvBObhl+mUEWMy_{X}0uV1ra z`OQ=Z%~tBl_{igI=`wnO?Zz9Z4A8OJI^hP+i{vKW@;pCXIz4__o4SmzTCVH9*_twi z>nqk%tzW+OCfXJI=^Iy7;SVN*`}@H*DYzdzC%7LxC%B)*x1ly-`RdgxmapHa;xU{3 z6{HaS55ZL%R;*i3<-u&T<*%vZX3OV=;<|RjhD{Vl71!YYs!YWV#t__pSAYliXB!U_ zPqPh_LscGi>EZmYSc#&l^WN_J`8}PyH08A{sg=u;r&GUjF8wdGeTz9q_i~=)*?gJJ z2ieXqOX^-i)@fC~ZMvwe+x>WHTwA$j4g6%bQE4>wDq9>)eweMP&*6Hm{g^H8GL5n> z$>XfPq@l)*%TX(+Z=1%x)Ro7xsh`1XgY^{q+2U{fXtq)1+%N0#@;jKnWy$Mpc{SzO zj7g@O*D{Y0ui0E{(k1gCo3B(^TC;97y{A&wb>2^}O|QS{7SA)=Y;iL6E7%?c_k(SF zaNpDyvkm&yq#;|}UaN90eI$>AWp6h7GcC8q4>Dfa@{+R9erA3D;@=+rufBhpu5YsW zY&Q8CyjJFM&^DX>6*R`Wl5#cMb~f6ATSa`YE%|S| z{)EzXlKie%e`^{O7iN3X@_{lG{C^UC=UiNOlKOGd@K1JqFm6%%aj!qg`O_KKP3N4G z`DHp9!E;_~y`c7N_9;u8&;MWh*Wa0bfN~3Ucs6Zq@Y+!O#QLV4knL>n+S%;K4R@yP z`)uMEyw>=`Y@JFII4CVGP0i*Lkc!;>ZR;=HzH{4Evq(T>qyuniQ{CoS$fp8Qk-H@q zuTQU8zW&{*6{{;ZY)r4ecuC`1mRy{|e0)mZ^Ig2;%BK1&mo0tE5*3e&Q#2=;qTAJ# z7cVJo+VYmAS6v<{%<#3=r^jFTJZQqa^#l9cPP?i4o%;Bea&;OdBgPZ>jW2GfKzU5MGph zc|}EfEd}V7j;S>_Y+PTtLI>^DH#hHWUXp6wzUzHgrLIpQxsi;D9L+81|F&e&xxo^M zYh^sRaHe2$+~A*kk~uKzZ!OQ~yC zr8lU2cFZLk=n1P1Yvb}&HhAJyvBz;rDJak>QaB7xpDdTz^r+iU3_BvB$ z!Kh7GQbX}VnV0n-XfL^9`H~yUmR`9;Z&W)now{|h`WdBLLa{2P5d7^jJ~rE{`B-nM z-|+BXweOTKXoqRztys5a&APQq?GTcW(Ow$cP3d*^yjANe*RI+~Hz<4_x3c#5=H>Lv z)7Uapt^#3X(#uz>C%wkLZtceP>*(>puEu-ochzp&y|k`IwIeH6QQ6*rCctXRaAkah z;nJixH5n^5W{Zc6GgX>t$Ky2#htqGBydeIE{mvy$Tr)g9oma1_ktZtR34y=E%HvKHkL8J zc?o^3IYt_S;TkT_lgCl%LYPsX*^XalJAR+-_1Z!1}UdFn=5^wmrYwpQ%i-qg5_RukRW*jm3UwZ3M@*7{xR>$lakH16T0Tsesa z3Cd=p63U`PZsNSe>SC$^J8F0C@REB5@5|3kq%>-*-Q7ZH2IC1R0{Ny(mBocRe2tRjE?|sQ9<|I@+HtnQ< zHEnB2{-vSY8n-hYYfgTirYh^VH}1I7`=Gjfpe4DR(B_@nTJB}kc7L+@ltkjLCR+W* zXku@&p5$tGH#cv>5Z_#UXYzfgClZZ2>NtRoyOQsv^X|BVkN34CZ=FlWe0bo#-mD0N!3UG8aLSIl ztC$Qtn9LxC&GofAn@ueHA57k)PrH&&>w7SHBat1>X^%dbT#0M9HuG5r9!y??>l*oZ z|AWb8>ez(V@nG_51&r>#2a_oRE%n=J^%^H`{J!Klr;&;h$=TDCTzCd~mQVQzWy+~& zmDMMC#zHdb`j z=K3v-txeufT+{sGM1pQoa2xb1$C8&cmyKbQN7f){rUZ{G0?;kto5O#mb~A zT_`ZRtZDa-+6Gt)GKmN&d<3pnW(GvE|B=*WTJK3&RTDYG+ai8=AA9xHPWyILYsE%Y~Jo=ge^f4 zqQ+#GOk93qp*ECCi$^slnV@jC*R;5)Se8t*csGjxa^6ZOds`)?wL(qJJL|kwX}F$F zZ}B=^?B$(;FjYO;T`Ph;mz;-6^a=Nx`~(?x?AqNV6Of-E$LhS^6luQNH`m`4zWR-1 zrs5EFE#jG%pe4|bV{(i067+DrrN-+QQOvy{FVWP{=zUT0i}MmS+nO4@r=;Psyu{A! z^;^B?rC|w$yLnrk_ku9wotl@Z-MOo!rDn7D&(bzOFR_cNC2T*HwsZ7#SHbv8X{7k! zLS^*MbqaZYKB>00;<7o?a&}(go_k<9OIps)OWb=eEEfq&&ZT*YM&*ko(n3jYBwu^i zNCV};4()K+Lgt)BCU`t#IFAgfg$r3OA`5~M1}|@(&TA@rZgyX(vtknpWm?27N!g*I zrmPjxdWI?w%JyDqqZq;u%D6=u7wdANjCZ+4FR!35KS6^`Czi>1`3V{z?eg}zXXod= zIX_XqqrQ3TJ>CInDpsbJ&0e3dwR8alXppeqGe}`YNwwN zwpQ$;C61=;(c4#@+q-95EYSM`H45=Culsm33(~|p#)vj64hZO z7Un0Kw(V@$6m6x{ZQI)1B=x+!x!UDdIzG=Qu^l`}3wA#Fl-g~LwfB1eDARI2(z0{M z7VpQ>LWyatq3rvmFr31MP2@h$J5N;2D-qDHmQ6}?o@+&c&Zi#ak&1r<_V@-L-2IMZjApZSzU2p=q-+ z-YSjf<|pnj#s+Dm;4o@yuJ`sx)72CpbwZ&I0**L^h6%fOG`6^|m;=5ebV2@{Gt~Lv zGB>A~3|s4W>ie2tp3k`eQuL#pP&u8mm@H94zd4taA#&h1=L&sEl-gU#L@iE4q^~0j z_2V_+$jwDMTXs^xmX&Dknc7kpVOm6{EjxENH_{zM=(eDtX~}(5=@URBOTpO4S``ZKTD^TS#$Nw^wd~oKM+7aaPZhJ|N2X{PQUW zJGAZpNE>Ab6)|<)W778KQxYg;%J{f6QgMQFmGOu)!u9a4vVLD!7f=$&`^xsBw4Hql z4e!+WTiO3x+TTF&rT(%{48x4Rwvp-cn&cgJPqy zM}>ETur7EDSy3jHwNhFso#eeOG&kcl2-_LwP)fG%QrF!hZ5MGWR2lrRv{FSt8c_y6 z<=VWw^C-HtyJ`@mTLOxy1dw4<^X8fzcY2?9ugfpKP+ND^*VlQ^NMngMHc)lh*?f=p zU1_H|14t|7abY~Cz&Bp${YF|BXe$ORHQwpxyIFP)wG^-67} zg67>MZ080dMMEL#?Hjk#!<0I&N}fn{12Nd4rqVV+YmYpIDlkr=*5YB;EVbOI$^ouG0=S}&x;TWh$fx)6O7)ODVOu0|_o z%@LPVb+YQA1}gtTsxZn7S4!8IqTG8D#)X2Zrm(C8Ugj zx2l+*b~7~p5-M@j6Dr$)v|T|L?rc`JXQb_I%2ub0-;qYDndlmn@t81PI*;0O-B&96 zE7DFSg}O^+n{$C%eJ;INH%`j9NE)dXp)OO|mP#9%N^ZN~>Dn-vQIMdKiZk>}6c;3# z8bgEn#CZjYy1Q$lEEnN|CYtM$Hv);vV7WTX-^5xGrmM(QzxAr-n!501*Ayg(Uq$w? z?S_H`O<_~*mnKZWoJtc;_4Q6NbBa$@lYW~Tyb9MX`8k)IiiwKNn`myjF?@TIAh~dX zhci!0&^-_4N}Z4r#iyw`R@@KW>IUU`rzG?6toEk#`Vv|zKxxN>VIq%s&gykHty-~s zwdSfq5HC=Z?dptzQWFoxVy6Tg2N#ZaF{M+cmv41|SfVfYwQO0}(mtxzjsA=iG<$un9+tj(8xcN(b?_lR?R7i9Y zP$fs5;tl@@Po?zfXP%0@GDiW6b5`J#d>cUpbTX!IGF{;!O2dt- zR;T^TX#JTu13%V9r2TUc6>^UcR%}?lY5fh$*V1A&6Fks{G?t(RNrrwszi$04E(~7? zLO)&!Ub%dAMP_*f5~txx5iyFqdmYZ%M9iSh_abbFO+Px0hD98$#t+v>i8tS)?IjRAiJ6}KO#goR` zop?ehKZ(=lCl>MJSDIr=?wPzhf8Irjx6^Yux~aI*`}Es`qX@E;kmc^3&3Af-q~+q^ zGu50u6?8H^dGnvV=IqH3(ofb@7n{4Mr*&Q`aXvjjH4i;=_B0Toa{`Y+C+;S6mj6V! z|3NyYXLtIkD?MSP!})>7mWN?4^q)X(n|C1;>oKv4W-WJ5TkE_F63ZwdyYBLyaFcOC zf*vp4bB{MHF)6gRdf#*L`3ZXFxN|cepB$4Gx}d31JATCzb>xisvM1YP^SKB+r|Z*u2^Mq{J7{*}J!H z_xh#b4Unnx9+&(w(joq=0!m+Nqz;LPyDFlSJV0R+urIOmxeNBxY~O~7?Mlo z&|0b{URM@;5Rtr!EqaAl(3C@N+7X_l$j>>0cx^-%bT)DFD;~V&UMDKVh2(O*OlF=m zT}mb_lUXDU>+W%8uuiACRo}GB zyI*+X^hIjayS>Kyu(VLfG#=hwL(36ACT(w=lW5*m>OCg;(mAwFs?qxk$*GtVZ}Og! zhPP=$sW&VwRA6Yz+xw2-^X751O1-1fL^(h)ruhC?TF#{SHkW!6l9THR|3+eRN^@zw zcgpo{HJX*-OOQ&!HRvVuiPP5MqK*eIPv4GB!U zYD>Mnu3r9GR3dBcY?70=`DdYhy>nNs*C{V3B?G3~OTFKhCMp+L2doy|(c0aR=-Fr& za4q#C+r7`am!E7s*Ppwm=bQChgOZ!|Twjw0v!3g3rNOM{`o1s(*K-|{w!nI>pG#YC zJ=brfF}R*9?;UPo_1AM1NsC?2b)K}?^<0+@-b-*tZDh2Yn%3(mcMeZbJw)|tu&VC zRU2jr#hA1Q*R=dn7~M53riX*R;G@nw>Q*%cV82re&kBWnI%!FHa1w zX?aMV;;(7>q-%P8O-uMj_;+hf%b&R!>a1z`s=+4PWWHC%7a!3EVMZ_cJClbh`{-wW~grt)ra2P@sTFXK!^v&|n+&yCt5Tr#O_(=vTQ|_LL2j+DoXcY`r zv*0{bSuAMj5KCNcBSIGjmbi@IO1s1*XU|4DbXK@@1Xj4@?5QTRv%uv;ylQ2M8|e=r z7+SS*jf+3%uUg4Si(R!+=~~)Dt5$OM)P)zVjNJ43ub{A)|MeLok3PRUGe(=7(w=Z; zjGCk^Fk|$7X$#I6eN-BQGe(a|qcdalC1DND7(Fj-V#eqP((ca~{al#LjL`|f#f;IM z+ki%8KbMDH85k87PjDw(aqB4%ouHz*1(L>y{>KAGe%wRb?%JOr=?NM z7!62!aK`BC!syNz{e!eRGe$p^R(HnezoprkF`EBAH{;F;%or^ewyZNoZ;>a4XN)$; zQ~VjDJ6+T3Ge*DbGe-Bh8S2a!bxT`d#^}@17MwBqf;0wajGhrjIb-x)X%Ea8jZ0f_ z#^~457??4dv&pSGmj-5x7P&UO+vN4P0y&d*uP@ZqtAf;ByM5mky$&ktTY;ursQYHO zzy%lTUL#F*q3(^sGM$CG8^txjg}T+kCKl?_8?l@s5L~Exx3K*#FVua%Op9HpyI)$& zLfuaagR@ZgkA=})sC(G8PG_O+kb6mBq3(Bt#VpkQq2y+v?oWjwxKQ_((iU8(>s7mj z;gsM)-FedJFVtNmO*31lTOwq5q3&BHHVbuEN`qObyIvXs3w5i7?KNMhyF&z^7wSGJ zsadGoBMo|??q^&)t%bUO>0a}{bD{2#jHF(u`!^Dsg}OhG241N96Ulj@?#q(%Lfu4- zTecHd=!LrTBsU9n&yxnTP`5-F{>K;UzC}bJ$6u&hE=^{k?pkTE3w3Xk7PC-yt29h= zp>DId?*D1;-Q%sA_W%F6*WTT9QMw3WM--C1*IN5V*j=y@iV&jRRS}Xnq1Y+uP)_b4 z+9l-35kl_CEpm1AnmnM%~}|6WpjfTHr zByQB5oBZ(q^NqTHOX~gS8+D)I73yx(UCtl<@7<{TUUK#SbffNP$?)wr>VC&uZq(hx zAIOcm(a>b?%$FN=o6-mRM%{M&nYvN8BY&oE)a}Y2>Kk>-=)<}jb$jwB+i%o8jz8Ic zqwWCur0zyt^DAzN4KgJ+>R!kn{2z3q?ga9dyixZW{#4zldn13QZ`8euKh!tsE=Yd( zU*3PB?=ktG`P~1R&;7sY#|{4Hj;a5-W6ItWB=^9mKlSY}a(h!fVQP*4_-B2R|8vKb z`Ng3Br|+1G%yMZ%``C^qd1huiZ(G3*=KuH!F?rn%8g;(;rQ~752VEThD*E;ZYnaD# zL{smY_P2u9$MEBt9$fIyF9oymf#s=A_fFdMMt+IJx<^0dre61A!D5MwpPlr|my=#B zxTT@Qxrg*c(c_a>%`I3Zc>9x)*3P*4#eyGpMRfcis<@o#c|h@Vs-i8o8l$6twm%wb z)wcKM7gT|o-^+0ih06Qls}-9IrkdvoHA&f;u}fa6dw%=8E~(p7`FVNfNAC0UmQhDd=A2+7X$WP^UHEUg-H+JN1EGVOeS)6DfZen!jhJUXS&Du>bc? zt*}C`4k%CUU~=r3YHq8ur$MJ6-60)Pw^~7YAE%$6H!GXEuCc+@1FKRC8kj%Qg*^+0 z6n2QKsyNlA9+_usNeP*Pyn$O&|BPEVHk&%aRP2n@yx8BZ@&AwHnUuD4DN211zkNUc z{|^gO7aFT zb~lY||KBzK|45^rnrG8H^6FIDpbiQDSLR)vYHjG%@k&?6D_!k6YSa7%c~!GhU&Man z|HsWv-EGa*)m-W!s~k7oxUI;+)xbkG!S1QQ#%tfdJ*s=E?(Z$_(T=947?W`=nrezG zs87n&kWr3n$knW_o9us;Qibn-we4Z!w3DWJU_S$6s&en8E{nE(V z`XT;*itRpCeN(^1fe+cL>D^^f`!4wS4!hx24Sd9aTWn-%nFU7=OpP*Cvj|aD15@kl ziuDm{Q~Ns`{=>?QUYbq}Im8FSgrvYMK4Ns&8Ktbx*vf zh{4f)XJN~Xx6dxA`{U1^i!G%V*%ICVearVT+3uLv2kHL$|5Gmcl1s{Nu`ZusefH^B zWqdwq?N{|JS36cS&e)-*mH7e9)=l#p@6))Y9f!K*9n!R->A_74o2Hv~ZkFHJ{?ymu zW`~^LAaWlZ-TGLAQ|9?!1zDi9S^enN7B$!vt9M6CLyoapjXFh5n;vFXvL~f^O`0Cv z+U)Q-4Nd^M=gS99Yl{-DlR3sYu{>U>3Q%t&IN z{4G|9o$Fp|Nl*11J(Nf zO0=%H8>04U9NjLu^t||WoOy&(B+t6p{>!HEx9SH)c#IMr9bk^1%wrGa z$I9d9PPkuO-TsUE^0cx+Q8)7pn8D`3DCRNigUru0+b0tZKKp$0xROyrqi#dY;|7_ej0sH6t|E(Gs^U|A?ASt_D9nPC00n(T4|B~tR&&Qq>L)i zJRrj-t^$?Yl0;G^E~yK~n1`9^poEKTqK>kOI?5*GvL${KRYc||=Q+)6BC$*&u}q@4 zOrp3>Y=n>V%lFZ?VCvZ zCenUF>3V#Xc_xa>edO0yx*qqwR@&D}`&t>_ea3g6@!e_6h&-(7OzWc22KI^;B`tD17_a(mj65oA^@4m!$U*fwj@!gmB z?n`|4CBFMo-+ig?zSMVL>bo!X-Ix0AOMUmHzWY+&eW~xh%y(bryD#(Im-+6?eD`I( z`!e5sneV>LcVFhaFZbP-`|itq_vOC(a^HQq@4no3U+%jv_uZHK?kjxv6~6ll-+hJe zzQT83;k&Q!-B=RRHJxlb2)?$bq{`*e}#K3(LwPZxRa(?y>9bdl#i z?T@wTV&A<#{HBY2_r<>ZV&A<#NT-W^_r<<@f8P5WbQ+8^E1{^*|e zNB6Wp)~3_Gdw;A=`(tg|A8XV8Sey38+O$8`rv0%t?T@u-f2>XWV{O_WYt#N%oA$@r zv_ICS{joOfkF{xktWEo4ZQ37e)BaeS_Q%?^Kh~!G@iFa>k7<8=O#9`MD%SK1%D(*D?$_Q$TYKX#@4u`BJ5U1@*pO8aA1 z+CPFy`$te|{|GAWA3>%4BdD~01eNxWpwj*kRN6m+O8ZApX@BHR`y+4KA9>UM$eZy; z-i$x;X8e&ihBX7nZc{BdVoAF29j6d>b{E;`~kGvUwaGyce% z@kic_Kk{b$kvHRyycvJw&G;j4#vgez{>Yp0N8XG-@@D*zH{*}I8Gq!>_#hBX7nZc{BdVoAF29j6d>b{E;`~kGvUwa zGyce%@kic_Kk{b$(K6$YmKlGv%=n{a#vjEq{wSXDNAZk5if8_#$u6Wc=fX zjDOsa@sAra{&7RbKW@nQXSo^wNFn1NDP;U3g^YisknxWcGX9Z5#y?WX_(uvE|41R@ zA1P$~BZZ8Aq>%BC6f*viLdG9!GyYhc@yFVXKh|dbu{P_EwON0x&H7_))*oxL{#cv! z$J(qv)@J>&HtUbIS%0j}`eSX@A8WJzSey07+N?j;X8o}?>yNcrf2_^=V{O(SYqS1X zoAt-qtUuOf{joOdkF{BUtj+pkZPp)av;J6{^~c(*Kh|dbu{P_EwON0x&H7_))*oxL z{#cv!$J(qv)@J>&HtUbIS%0j}`eSVtV{P5@H%6F;rC*qsAj+C)EH%kdQsQPm&BKPr zn7JnNM0PVRbII_bgVf|xr(Wh+b@qZ&Iss4W=b=+iIPqA9C-gMWbz?YS0F%>BW77A; z(~meQhRSa?9(@xNS=o4~C1fuF5wcgS2-)jBNfeL1gk0*{L_GRZl)YL-$X=}?WUsXm z@~y_BFGcz8Y{*k3%TR>xCupaY!;MJ`N$|^}>?) zIE13S{Z~nR970ik&xwyiD9Z0S@o`8pDn1S&leie%;5% zAr$4;eS92}jEav#2>Ep%ABRwsU-$8uZZax9(RQNFxCu$IK9wX~vNIq_*N zMfsKE53D8eX>D>ve_$<%Pira4cOReDQk35@{eiV4KCPt{efR#rS`weuCRg+a){^+N zmZE(3@o6nZ`R?P>T8i>FD}P`u@dwtD__Q{uT8i@B$EURv<-3nh zYm-s_z*^!DtR?YjEv@M96#Rj;BtEUB6@B;dX)Q(h?)~AU)E`btBsfA5KdB;iNP^t)&&cx-X4SYbnaxA(zIdwG`#; zb4ugWT8i?v+ERZwDUDBSlPmheNojmqOHqE^$EURv<=1_DT1!!W-N&c3$tZs~DfNew z()hHNR`lyWKCPuFzwYDHT8i@PK0d9bD8KIggTT`Gv^Ke-e-Kz2pVm^8U-$7PWQy|Z zKE8xZQGVU~18XS;R{xgV#O;-(C5amb%goJ}$vZPU^}-o(hCh(AV()|a%-Eyx*|A6E z3^{R^XK6gr60*k}gzRwwA=_^V*_tP0`wbym^Mq`_A!KWwknJ}KR2Cl$6Y{jm;)7v| z^0nfnUfq|*#~c*p)qQDv z%t29J-IvD49LcEon1hgC_wg|YMfr6fA9GNYU-$9JJVp6+AD_%qlvnp<@i9jtsw_U{ zAmr73S$xbvQC{7b#m5}UsCc9$S6^lEuu4&0)0V}dj=oKdfixY~)2~WjI&BWIoiW4~(Cz38sWSvf^q!TLXgi1Q0l1`{( z5*cL@Ib;$!WD+@K6S-#->tz!qlq5+(eHmM2uo6YG^H)~iT3t4KJjNaR35BPUKsf{MJ;d`R`(j_^*r4H&al9qA`QVf}K750`v8-_zBkAA5Yxv{0qhn z?{?JjCm(2j*LUc-=KFuchg^KN`P$ux3*_(7qs|{Le-9oqWbE)uS`4IeoO zf7PvQzUp_j`8wn9(Sy6i-<5QK)_so89B?JX!45z!Cfn67$Co+HmwY4hecbI!4gM0o z9AB(`1l<0P!yfrjw8eh=)+`$-z8dd;CB70mX}q#d4{-bKTKO`rl{gaI`e|eVmH|p< zPvz%E#S0a`P3d$n+j>q*-2BXG-X{V!c%{xeG>qiGlM z-vx246}M%tf&Vga8@8AETl9}m@w&eqL%az3mnj|H-=oSDUi!vVwRA=$PLJh!^`->$FhZev@9>w~gYq-d;exWx=_A1}kp=T!(r% zPjOp61@LnNxP7bp)f^R%KTSjw%_lDPyh`clyuPOR>R2U;z9+r~KKI5>itDGF;yW4* zsh_Ok_D|Wqri07&l|#8V5U)Z#yrXoq|L-YY_A?uZ_k~U|cBbtARB&7OyP7^P{>Oof z&jHYxp>+0E@lUDvmdMGzysx;e+G^+?E^v-imo$taNm_uc~<4jydzsE-Q$?4E<(y z5HgE>tJ`rOaPcGi!~Kb`gwDAEoogsQXA3jSbmD8E^KL+A1I3GQyMJDJ+a7UuKO5ZEu|5vG5?tzGJ@ju?`unMNUqJCWqi2_gh;M|>Kb4NI|3=v9 zOSzJ7GvZsIa~wG5I}qIFW&5El=aWtWKD%1!=)7*D_#A|06K@8cPn3?%>lccbynZL% z20Gm_IB{Obf^%MTRJ`84{su1fDW5&2xYb&TygpPqdi!dCK}B?=9?Z`)#fxxz?qru^ z!P);XikEsAMckHcm%j#dmQs8!j*g;Nh!;VpAqEfjvnROt7eAedmqTZGK&J+r+vR%F z5uY~^uatZPI^Te^{}g`tiOX#b&Uv*b-UsC#6wnzB&gEVch@Sy&_cM08%T8`hw1b8$fDI*QN5rJ3=N_!#KC z9nkqF#fzVxiI0a)ww)`8>%TuZxBKbfvY$6khmH61m#BEXpT8bl>SqDUy%*e;tJ`H6 z#V?Y41M#hPcK+Gtp5Rh$&V@yth}S^>kbus3aIT-50`c=nU+Vt>;&Q!UX+UQyIG4MN zc`C16IIlg3&q7|q!CA-tB(T;IpVtwuh0Z$xou3t#eZSRB?Gnpx_qiB4jTE>m*-r);SrR>tReFeiG?RUQ>y0M7ehb zbUp&-ayJFye+TFBqAh;4Q1X=vuU)~dzTPh#M)5h+TQA~`aouW)($W3xE{d0Wm`A)N zbiNGe{7UiS=MUoTp>z1|&M?>8KyaxC@iUlsA#~;ibe4g0KUogW-vbaMFM0pd49 z|GR*GekZpg`)o{nHgt{#=X?iIy!aVLd_HvU4d^^i@ltOu5nl+Mf_ zrLI2rH}xs=JN*KDB)HAXo_CFLH!%xIF zLZ@UuR}k0d(crco^n6x-6>l#^NIiT9&h7Xk@hvE~X#YUD;G!e`k0)Lb_vR@2OF-vt zaBjz^NGIoPM9&j%2K{XT{q_gA6?ZT%HdK7>PF&`9&jROq9!K#xCmUT#yaW6^9ng7~ z;>FKu;+>$gOIKGA`zZo%YCg8(nk==`B{^!{PzZf-@%SNcf@;{Bm>COG$#vEa6j8=8N! z;AbZ36|GcT22#BE8BF|T=*$b~JVWu)zDtR}37x!b{q?*X zxNYB^O*<|mG2j}|voZ=;~uZgdLPUjL= z5bGQY&VG6lUkjbd0iD?tFMj3{Uk{xx0y;l~bA2`|b^e)m2Dkn(6%Yp=0&erwgpW;@(+Q~+LQaW1yeig6VcOmgk(EmZ{==N<`;R+Hz z(!NcJ7eS{FIJfWV;C!8D9O-n2&UH#hx9?pPpF=&&Bicr|od9pVDme>ZS$ z-wg55(77z2Ggt9;W_-b6OmshSoK{4SgUj)T+()z`5WgDS`m|Q6T{_V>Dqi1@m+tNY zBrk+VWyBXCud~6qekM}9lzSEN#n5>^p!1cA*ZwyvzKfVNuR9*<-blW3zwRF3)~C*Q zl#0hLI~F*f_)_@1Tj}WSVll;6I~&nc#NUL@rhra|!`zDO{~*P8g|>Y;Qt{msAEr2p zj6WR@ZtLMd)8FL!$yF3z4Xqngyso!3Dqh#y=fuaO@K%RALGCA=!KJ@Rxm}4*fzHT) z&RSK?v3;}`Dib2?k8Oox7TN+|D3FJ^tgFC@zu!d zPNkFBjwoKnm#2v5pz~Wmr%6wji5>H;Pnjp$16=3K<91nJfpAg3;j{W>+9#+6u0Arj0?N;a*1$Wdk~lV@&|#ZD6jDpFL_NQ9yNC5 zJs;5dh~jfDJo=1yGwAHw+Xb+nqrfFE@zaNR8|d5=(76v>>RIL~mVw)TqUYIHQ@o6` zn*#Cs9O3+1eSMyo0q5;&47km=TYlYkbe)QCU_Q&4e|DKkyaV!mTj}Wj`5nbez5PhM z3v`N(bmegU_W_ss&$+OuAMq@7W(9N}r+D%6H1Y1x$vdikKRbi7pAN)(L+8wZ&SexY zey$|m2RcgwI&Uf7*0kfoZ)^`R-y5rP{@G`9;!z_PcRV=P|Jf8TK1UO82AzijIxkUt z&J`OiC*B@9O^$W}>}M}<$xHlnCf*4;BLg~+bC0+!bHv&3qDPH`1OT0UD4m_s* zyn2C4UgD>UcolU19MG9Z@#5!x;(egAE})Zltn;~pd1+w&iJykV`$Fd!aBi<*6fb^8 z5$_M3hXOh;fj2c??EbCgOYRG+d3_8pi{-Ze=kPt&gTTfA0O(hMTb~E1{ob(@pEIA^ zr7!V;(78eB=>6VbDPHn@nD{X0YzXKyJkFIb{&Vha)Rg#W==1^S`X5g5;^!RVEBhn?LPy4*u9~3 z_>JQF_~$ppZG6=O&ExpCC%C+1oL$|bMa+wcxBsJU%zJ^`d}H8NkEVj#`mx_pkmK07 zDqe4Q_YuDt_4AF=(fu&$>k8s}Za};iI!A(Ydkv)c9Q+R^z7RU|0y@u7ytMmL;!B{D z*UuHies%_zyu?oj;x9wz%z(}%6fb@*C%zIo&jxhfp?LB00r54^X@6qnUFH`ib~J=#-ySe_khpb6%$t9|@hg z0iD-WyxoqfU2)O-Dqf#2ckJ&1q+EnY`w}0Aa!�{x+K8rQ8dN*Ffi?fX*rvul;|c z_?}|Yy#ArMjhE{K%};hg)~C*Q066D+Ch_U;IYa5_{l+~MU+s#E77(8WowWg-rl+_S ztsm`w55)_iZC^?h@2Gem#qB=5#`I~soTIqam*om@TR-~x((NjKF9|lU52<*4J^xu1 zZ}-FVk?+?kzF6(Ie^K$;Pm@z!VbU%Op;HKMeWsPpAu3+$oT&KTPBQ*~l;WKfpQ!Y0 zUd`~?bQN#&S`0r=sQ8TX^R|lLN9lj1;s&ILq8heR<`wE+p*dvZk8;#eXHj| z`l@)Vvl2RIt9X4K{z}EQpX*6yHFWM#@p`|vNO67L<`vS(8Bcb3gE{n@p5{KcdFkz| z6S(vT+0XAsd_8o|3FwRmm*XF~J}{efa?VCHm-uGre-Y6Co#Mr3bh;B1{{>Cl`ySw& z?+M`IQ?7fAB^~kkC*m!kza*glHpPq2_lb9a&dz5zzwEP<;`+K`DY*ETdhV~{_4Tn! z!KI%sHQSP1<|uCaa~Jq|P;t9m$nQVArS$dhmVB<_txnGTv&+}Si=f|mp!=Njtpt~L zlzKaYcsX>Y26X08e9jdY-A}v{I{yslG(FR;$bMQ9?*pAv!8xxH;I=MpJIZo@fIqMF z?f$kJEBsyQ>v6XISuQ|)B0Soi_yG7k4xD`srFbcKB=KR;nIF(uq2jgwPZi%+Oq$nC ziraWOt|%Dff~-%S?+M_XZ-3%r;B$)7(fhqSD8AYi7tJ9)0XiQCbW&K+`qBQ|D&85| z_NA-hwol0RcnCP>J5|No?Ms&Hs@-2w57XfD8E|gjw<#WPqxXr=gw9Tbqj+JR3UFJl z_TPti4f^^yire~;l{zd&do|kZ+8z-yzJ*6CB76o zKL>Pn9OlXw|2g+IYD4@@=$rv=^U{7MP`vn=M0^!=mIrh`qImK18S%ByDID$$v!6r3 zB`@*QllXe*Ob+PGr+D%60P!u**$~iaHNyF1KkbM&wgF~26P)w9lHzl5bQDb?-U&Ky z26Wa_ywuN6#JfVL;%rwC`#Awz@)AG&iD#j6OF-vQiWfgm67LS3%>kW~kxPW5rZ z838^RT=pAs9D4=0%~u}>&H?9q=M!%OpI<2*y}hJHIiI2<`8Fcn0XkLST>lqI8uPTZd394`$u;v zuIJHKDxC&KBL|)Lh!5PseXz^9?v?$NfZH&uBkg!F@sZHEBA|1v;`b z-y!{+vk`qjd^*bA?K~I2<(7f7|L(+ZhE7dD=T?drKX($J4V^UsolO)k_4ym|`OrD! z{QC160B-9|@5ctKc-^1x0GE0Y|8s~hM7cSoqxVa{QoQ*8gZL8Y9DYIl{!a#HKc^Fa z89H|cbQV**_<4%>O6dF+&}lu!`D8!siLZgqKydDFmr%U;xt#bq=)4fnd5_|yy*?to z5jwkFSbsfd!6h&8Q$c()bS?|%+(hx>XBP1-&{-4E`Gw-e&+o+J18I}e;bZI1>tt}- z|Mk4^O^WMz;eUWjJ&6Bzi5FNwv$VO$y>j~=2rfF}KTW(PbS?_${DtCkuDIxC;vJy# zaX@D?#fzV<#5+N!_qh7=Ivrf{5JV_k1T%& zw|?~XpLK!wZHjjj5%b#aQuoICKS=Qd6)#e}2e>U)_w&9g-nPql)Z1k$USAiQs(6Xo zPUk9}VpZ+3l^DL!Y` zvCC1!YoRku>F9nqm*Qo=dLQwH(D^2ylYhA@U;O9X+o&<|CD1tmocr@=iWff@5?>0P zB>|m(P`vngm-uq%w3*-xv!4UOB`@)lCcY9n7X@@Cfy=lf^FDWj+tu~B^PJ*#yPM_g zMa#ggA3g4T0B-&3apyX>Dd0Z8vgSqx`M2}MfP4IyX*(f{kBB$Qnei&rF5)* z&Wf0&5Aii9cZSl@{qsJGm->H@_&VsU59l<$!j&)Wm~(HV=EOHbr$0FNhYKlQ{9HnO z3v`|f=)6nu;%7B+`5o|Gu5^akPa0hE5BOmj}Pcf1?T>G54cT7_s?aD>;Cx~ zIQP#r;M_kqDz5uyevR`hd9{K6#)?}{mFS<{z`1`OskqiZS?SpR*&h1msCa!`bS1^- z%sO_NQe*$G`+d$r=)6)Btw)f9oVr&z7J9bF8VpQ zdUPD|BIsWq(7&JJ#pgoe-J$bCK<9VxJmbS&&y?$&`(5RXvCnSAtDt`|c*?A%>+?p6 z7oWEg?+=|%13JwnJ3m%m*Jnp?_PHbhOVJj<*$JmaB=6gwCr0omJpcp92nP zV!LnDXo~&6t{>*&cji7F;$xtH9JtL_`y4^>QlIA%p8%bO0iCB5xAiIKK`X$;zl?+5 zs(5|fyT#Qm5nKPZuP-%PcF8JkD_|P@R4Q)c`yzfAxXoAJ|1e6$+x=Lz`Dd5$DqbJ| zzog@G_!{An5=lh$A*ZFQEz5qTCy2h5`|8DjX;GFL<#1}(nYCz{96|em-RXpP?#Q%Sw zxb8n+D}9}B@ie!x_!Oy9;!ELk1UR?L1d6YQ&?Mr^q4QioXRV6Y{{Kx}CM4Saxz4|> zA6fPTw?6gxTJJ#o8H#5`#JrAGyhQP-O5cvNE%DhcD&F>=mB{x66|c|BKBxE`biO9O z7CHxB>jJp`j|Z1_l>OLA#5X|aj)2ay6fb^WB;KsK^U>tG`u*$&zJvML)`R%zM!XGl zE(z#Nr}&&JF1mqu2k5*L(D{+##m`3KouE@P-4(?3JQlpE`B=_zZRD%~zZ+ck|8hL= zjMCTp|25!JZ#gS&md}ZAY3BG|Gu$itJRDqfB;Ve|3y|;C0iA{5obS`5lXEtr7l?Ol z?mqY=ptI}s_51G*&gJ$4=e$lKUXF6d1#}((=X(2tbR@6*zc`;#Zg1!x1i547IQ!q9_!#J%8_=0V@#1GH@d?m*EufR5c&X2?h);vgzBksN*Wuujm-y*T z{ATD(3+T+Fc=2;T@mlD7AJECW$@yeI4T&#=&Qajp|Enop{0t|)2s-x#bY7r%sh^jL zFNRLzo9nOVy}%_e@za_366l;8(3u2o`@fzqdqHtMUsiBS{q@;|__HYY7;vu7p%gFv zM-pESod*IsuTZ?y=NrUVL8sNN_19-NaIVh`@iox7ETA)4#h1FG;{WeZ+}5?62dz~) z`nc|&;5^RmaGMjg8v1%pDY&iYGIRVU=WAmX*T;2}z$M?c$m>=WudkmxNbxymBU(g! zJ#>CjI{Lh62V4l1a;4pOB)$3MM>^v3QsP^n|8zkAU5XcAo4z|DNJ&p|gQ_OX!r{QNPbV;9Q@B!P(~s z;_ab-e?WgJ#f#5ZhM{jpeQM}~!Jn{a}*%r`gdzbUies(2Z4V^Q< zdAk@#@#5!F;-jJSbU z&xFof0iAUeFMfU?elv8s&8a`H-r$m#_&J*REa+St(3wl|;^#i%v!U}%KxZqs-OuRb zjl*i4f6MjpMqhCDe=_k}lzS^U_qT^R9{pr7@rBUY6wqlpH;Nbb(~|fS==1|;Kj%=q z)aM1nUxv=2fX=HFFYUX6_)6$Bo9FzqpS{5)FY(ib_!{Vp3g}!(@#1F+@paI7C7|;u z#fzUWiEn^Tr+ezp>tJxnOZ*&8d^2=v0y?)*y!e?-TrQk_643b>ocsR)^PPXo^>xuh z!P$RL;*DFn^(TX;%v-&Gn@#cJe=hMh(D@>uvzg+hKDRQ5&SCdDU+m{paLG&j3?$wa zI(G$h9;0~ivxIm#bbbx!w7k#xWIt_*_lC|X;GEZJaBkl@q$57(6YmTCuLAmiP`uPz z{{2b+1EA9zoPC~7@#1F?@oMPQ26UdJc=7Wr@sZHk8qhgtf%7l@zxIf{7@Q3*?IJ!$ z6CVTp$G|z?cPL(ben5OYboO|_`C*+5xb>;8m!1L6KC6k>K!0vP|7nUBpDz%f2A$}y z_517q&VD))p9!6j0iA0oUi?faJ_|bU26TP~=X%?s;_dGTc5&%Mtsbn)tK9Hu_+WS9 zQ^30hcwg`xj9dfrPx{Zv#JjX|<=v`u^#1cFJt;$xum zN9iIIuxA!_at6}awmgx`_86#@jsXNH0XR0(AiA!QlDFi&xFoli{doA z`*2PMm%PN!>BMJ2=gxr6BNQ)wo*-Teoqq>(T0Y`@vY)oZ=R@ZdaIWXk6fb@*B)$MT zj|OyJr+BHKe-K{?ogE*ozn;5;Z|_$tT-*`FYaes{?R=%9_uH2dm;Lsi1N7UXK?~1mfQS=l<{(@y77^UO=b)llAwvy%g6zE5M~(sh`7$w?w(U13K3zuD7qd zNJrXn9`W|j|1zNS8^w#yZNv+qQ@N!6dN>7K@)bX45bpw=*#Vu$DPH_MO}r~~eh=uh zdMepJ#ZNopMbJ4Focrhb6fb@*BA$iL;(*TcitB#zEjW);{~|8q)ILwwx4K5mNQdVHKoT*k*a0lpNR`^hWBYg@)PqlVA8 zS8kU*!9_>fr4#Xm&>0@kxt!vqpVSav0-YBFIv-KI`1y?Z%g`x&w*I_I!6h&8a|rR3 z(3ud>xryS%&n)6=pz~os=SPYcKO2d!gHFkF_2+dwxa1{%P9nYmIyVP&{z~!U=V9WT zp|c^N)988Ull?R!9$`E^4xIbpP;efq4(69lIUL_VO;c_>sI;6K@PZ zp9OR}yikArcUD}NTMjPeO1m6Nyd}!*9nhJixE`mbE3V7EgY+feImFwe-1`DLUn;K4 z{iou(+-;;U`4%iq_J=~0+Z5ckyVj{vT$g*I;yV6x;&NT+65`Syt^${FVH*0+p9Ar? zQ2g>0QM}9rx9w~Dq3r+fBQE>@FTriTdjH@4MFY%Yb#8E7IeuTFxV=tQj&bmKaI2$# zU-TS`uSEPL6|a9s^mdA`Lj0mY{3{gS7x8NX@t>>s8}s6n;{Ud&_=D9rSiH=|$o4V- z`p1BCzC$R!8u6E^c%AR{6h9L2_XgshqF?zin;O6Dco#csqWKxZI$ z%B-e!&H=YoY44|%`)qGf@%sLO#}wDcMPGtTJxgBeh);u`{a$wd*-uY!(UH84B7QS; zrUi8Frg-sl5Aj;)tPSXF<@grx{fc`Pp9`VW3!L*hjpD`6S;Ut>XHG!p35u8cd4~AQ z(Ag5u+3D4!fAO<3@s-dS0M2<`Nb%z565^|%^JGBh?-Vb7-XXpkI;~%;zyItHF6|Y@tsfg-i*ey+;<7*AOgx9<{2iCq<$Fke z-En?f#dWzyfJ;3{eI7$RhkCe9>FE8#e2SO)e1P~m=zJH@iC%a9*-r!F8=!L}IQO?R zDPH^xA-)+p_XKpFqIjvF=ZQzHo$qY{opx^|^AbP15pN8gf#96iSc(@ve0kV`BVG-iQ^7f}F%&O;E+#$LKOxr=xWbUqE}Y@&Ga^BeJL&^hFt`t#}sE_sQcQ;5%m&TRpm zMHDZ79w$BvI==*Tn!Q{9cF~G>Ep$!<=j~z?$G330=M!H5oreQDZ-R3_{E~E}-qsOc z)Y_H1->UlSzbClVztr1N#Fs#4T0rM+iWfik5MK(NwE>;qDPH_U?dOitUbR@3<#8*M*_JGdA6fb@j6JHIT zO#z)|A0+Ej{Invz20AB#b3Kowc=2-{@f>vi7SMT(;>FLK#MeTn`Re-Xd2ev3XYtd8 z_&Vr}3h2~Oy!g4A_e#_*p=_19ZL(=rmkYf4|xtoPF-a9Qs4SxnE77 zc=0)jco*m_3+Sw-c&WEfh!;U;k5B5a{}OP?OZ*&6yc{~02XtnE^LX)Efd8O$?DclJ zuKo*gxvrl2w9dc2KHmXc{7XG_Bwh*sLzIrbzHvFlOFh&O?*p9|13Djq+j`KygZ(|} zh|dkg2SC60v$}k>&tt$PU-5YY@nO)J8PHh(E65_m%PMJcjB|4GcllZGsTOa z+nGb>qkzr^iWfhdh%bOn=@<3qbpp8LC4Tx7UksgF0y-8 z{>M;*3Qiq9(IeW3H_fX-du;#2z1 z{VHD9^NXY}{$C|N0OdCNwtoMG;Ou`N;=`abBA{~>IQw6w;?FddC-;x*tk0i9dGn;Hr0Q!8U zSm-_aB=el8?l37tm+Ix8q%{H!G22Rf~OtiN44 zgG*lGrz`OR&^a%lGlk;C&!348gU%ZPogBrBpRb6IfzG}g>d)(NaLG&j^d>$II#&mD z?xc9}Q%ih2bUqL0Y^Heevz7P+=p6P_{dx5Vx7(5aUf6WS8=B8@_q(0b-QZFW;{P7z zD0eM5_uH)$FaA^iay~_W3Uqpbv(9N0FMiGM7x8lt@!8NB6VSN} z-1awp9r!-QZGT(Zu^=|`meSGt?T?Aee*3!sZ?VbcCH|!zS`)8@|Nh`y59d+5)WcZf z3!(E^K<7Ed^?AqJq$57xC%y#wYXUlZ{^Igw|NAMf%dG^L`jNbjApSDSJvN|oz2bVj zn@>8D*8{{?LjSvfPTs$h?I=DQ5?=$IqrkZy&ZKzpGlcj$=-d;~d6weE&x^#@LnpPl z{&r~(F7+>db|=08I%frRE~a?#a~biC(0L}H^ENn-3m>R>-G5sB>hiMjdc4>f+}6L2 zKLDKbEh4@dK1%~SmnyFN+hoOcxp$Dh)XyB^TTt%30iAV<>vI1f9cjn>-(3AjzEOMk zzBf4c&oel_or|v~UI3lB0i7o)Ui>^uyfJjP26Wo}PX6I%H{#8pGZ38f8cXrw=TF32 zLT5=p=Pintc3efg4RqRWasJuQo{H;!att_+Qzt2|$Em5{wtX#+7P#Z3>xkztuH8(0 z>78!8yPbF~j=SCmxBm6_0=`mQkB>hQm+>*$YR$RdX}9shJAzC9ly=#d_yV;1*-A(E z{~C&ycDb7PV(7dY&{;$A;^%YXOQEyZA9Zc_?ys~6wtYi;>FKw;;W(a zNkC^K#fzU`iLZsu!Q1N3t1r0ZC4NpOz5zP726P^#c=5BC_-5#A3g|SA@?xXxrzPrCvb$Fg~ zD!;Bi<8cK0|3<`R|KA&&_y3ow__OSXSZ-C^UY~4_aqwZKqrVrng5nDi|AmUz-;?@{ z;=3TeRYBc$q~rGmm+hzs@rMTDd#d^{6{KY z`~Q*Rs}SF?LH+qwf!loT?;LGM^b((<}6K@ILhj<(Cvx%cSM3aekK>R%7 zh2Sp|?*zVvco*}-NCOTUI~6L@!sIi6R!gQ zka!>Pe-ZBs-V_^#Z7=;i&`tr~U2!|U$kH#sM-p#&nOkEL@eR0+du zp5t#3U-XUR-x6O8o@(UEw^7}d|D6N;K;kQ(aO)pQycT}WBtE8-+c8|K_@S!Y8v^{V z#HHR|C*B72xsG^y@CMj0ZN9eL4&b{fewgx;4e&n1`(i^KPQ12@tDh@~Z$L-Cjd*20 z7ylUX+@+4cMZD;G$JZ0Dndf+uChpbdYx9!!+M9SG_RohBAM=@8|5V~j(LXOF-V)=` zwZyACxPEvqap@<|6Q7U%vzqt<@Slh;1mD39XlAjc9j@AO-vIATT-vdkxU}O$;?j)Ghk(@^H8;0x|>(3=#IMngyh<5^ipLiE=c|Nd|+ZDVy21?;Y;GGn2uj=!V0GH>K zS{)mY;Ve3z;%^@ATIL$!t2(xhYkofQVb?gmjCgi(+c^Fs#qIpBESmy+$L21=`n2&& z4|O9^XX4SSX7Qf9l6c{q<}n{gyy^kRFD1UZMTNetX9Q6osIgWah zcp(z|ns_Jhyd9HybphXlcvtXp;&L2y5^*_>I*+&#ri0t8*? zmHBg+wa%N(j&kx+rvfJc-!Q1z3VFC3%+%6ixjs_o?GGg8^q=Jj&9h~ zeQxz_{L&-rUuN2yIerKA1>*8MNFNfH-%a|NxXjaK3*%zq^Co@0>$m_PNnHBRWa6@) zxtqB3tEY&|er6SMG)J_7xa?=?z1tu5;xVNo~YvY$Dcxb%~u#AQD-nYi?ydBn5M zhPltq{gDSh<=|_G%W>Lf;+2TsX)pJO==26ZfOr-7k;MCe4W zPnQvw^V5%s%lYXq#O3^Sr@fsqo3HgF=cmQQ<^1$G;&OgEg1DTYUPWBaPwyly=ci8* zm-Ewih|Bruw~FiY(+C~U=B4>A#0$_a8RBw&+K0HDpN=9f=cm^Ym-Ev(itF>!rvrQy zaXCL-Ph8GV8|+ipj#gjJPdgHq^V7qK%lYXU#O3_-65?`xI+M7ZpDs{bU#ER8z*iBM z>y1AUm+Q0*_pQs<>dST7y@<+7^z1H4`5x_YqjQg0>1-uxkKz&Ha^J=4 z#HZu^SHx%HeYBse56O2)+P&X}c;llS&k!GQhU0yR*9>?3Y~l+paC{2!h2V3Dufp~4 zXNYf^>~uaP-syVBHxVB<&+%6KyI0Bg-dN{t7crADv9LU-BwfR=|bn#t@FFoGz-oz`>p9d1J!G)@E#B0H? zC%zPX0r4F8%fzEIou5yLSDxkgZ^UZ`Io{?#_iFP!LiLAk0e%ee#%}d!2=R4R&@7h| z-vE9q@s%k1N#ctdIGy*1F9H8vaXlYb(9Nx9i_^RVahb;{Azq99+wsI@9_MW0GLJKv zxXj1RAujWA&k~pUxDScT{^4ihG9TCcpk%%>AJ>_<%*XX0F7t7x6PNk8i;2te!1css zK5hYVnU8ysxXj0Wq`01s`z65J;Ka(duZ@>>EFv!LcpPzQ$8(5FJ5EttpYP8J@TU~l z^A{@v{9ED$uKA+;;<|RUI^l#?PU3}XT z_bPeiw{Y)^neXU$AI0^&#;5?F${g)=A9J+VOU%(;pEE~$ZDWr1+M~2Cuh=Krt2=YF z*8t{duSv|&Uh|ntyD&$)e5AOZ*Vr83?aJ!>+jyiKl@W){=w#xu{~SkL_MbNqZ{v!K z9wRRM&v%H+{_{uTh0xgrJ1*PY)_*7PLy30*KaIHTKgTJq=QU;q_(JCBZ_AmZzkS6V z{Vi4DjM>%Wa?t>LF-Lzpj5+$-8O+h&{=^&&c@uN=w~Knz`LR~yy87kBhu}Wf2Nbtf zmg0K^XW@9?=4H8jU+iMy^8K>E5SQ-@JV0E&U-rG?`Zyug%M@l7TdwB25tn{mLR|X! z3B;wJk0dVr{3_zo&+j7MK6V#HPZF1Y{tod%#IGkV{k&0c7a;jcKkr0b`uSnRUgm;-^Jo^8Lz&|^;R?m|al)Me zzJxj2Yc+GU*Cys@uh!_OcJ;Viv{x~6v{zr|4PCvQ&%BZ2*D`PH_+!k`UhgxPc43Zo zX?C>Jv;OsQ!u|nXMI7lyqlm+1bPaLYf8Ix2_Mfj1m;L8g#AW|ka7@y_>_0maFLYti zvBW!pUqHMI_;ti(|9PL{`Z!@(fPcyy{p~mA=x;k8>kQa1eg8w2IU1lpbM&_{%+cRw zFh_rTfH@lS73NKxzfTm`^Vh!wcq{C{ZC*BB`bk&f(oc>eF8yQ(ap@-$iAz7Zow)Rq zCBzF|TG0o@rJwwZxb%}|$GH_HuddMPN?gX-V~NW+JBqlBvsV+Bads~8N|gHy@!sI8 zh*yFCNE~TKjgNN$l9!CLdnm5wuS)~GA90z#K9{)6Ur!+}^Vf5T%l!2-#AW{aBjPfD z{R?rKzuxhLx_oV3GJkylahbpFO&uDD{Pm5B>v`%20(=>9>;|GW#AW_^ z6LFcp-U$tA+t-#W^VdbhW&XNKaXo)MG{7ekm-*{kh|B!---yfn^&7-x{`wo@GJjpr zudW@fPno~oleo-ZR}h!^>wb#s`Rfq@K9RW0!`@0<=C2Oq#S0p63iTqi$+xLmIuOI+r!uUA~pU*8wtFA$e{`;@rMUvDKY^Vhqc zRF|**o>7V7b{<)lV*`8$aha#PoVd)>-9%jG=^i95^VcsCk1&vYOuP_$Bk@Y`<~YHz z+po>58oV>{8t|UPW&Zkf;xd0dmblDcUr$`-uOA>T^ViFW%l!2k;xd1|iMY&Pw>;Uk zoa8I>*9Q`p`Rgj;GJidc_?F2|_bTEte|?g(c;v)eB*M{?tN$C zGJoBJxXfRlMqK8v#}Titbo$p5m-*}ah|B!-bHru-`aR+@fBge-nZIs;3l6s5#`FHT z(6BpknZGV0F7wy@h|B!-dBkP@dMa_5zrKgK%wIpJxSqfMAi#en-q=-h)bup>ht1dO z$ozFD;xd1IIB}W3t|l(?*H;ji`Rkh%*Yng51^6q(W#02s;1wjFI=GJm}X zaXB6+BQEpT{fNu_^*O|4{(7?Fdj5J&fImlE+VMl;(vH6nmv(H8?b7CJ%awL)XMtJl ziyUj)_ZQ%NTDV*fm-EXVOiWXwBTFIvka*!JHvU}*9bZlHa^L%GaMrJ-c)4z0NE~mY zYT}|_OI&n-|Ld1FW=&k;NN7~z-AtU9H8bz+?*K?$x5wwUUTxi>+Ck0tX0hHd%ty!v zvc9|@Xa2D3vxn>eOU?OS$M|LYe}&usa(~P;FLocNnl%2P|D|sI9Deu6MH@Z&1FyfB zR~s2xzlIDKVm*2Jx;%<-sYX!zx@w{;KLO1froWi=nb~z@{U?Ve6*$(;Q!%q^T=%)7 z6RBZ1wnbq5#uy;JNfz&w)giF{k63^8e^`G%tk3QL+PBUruTRYp*?!4wXN#Qkom>9~ zqpugvznA%(HEnzmexISsDz~;>&w7;cw7tX8@qzURY<3wf=~1`7?I*ncpuqYq4|Z7< tp&VPjU6)Y+aE_QvpZ{qc@3aq~p>sQ&8&0^PYYX0&1{|mj>3uXWS diff --git a/source/cluster/wham/src-M/parmread.F b/source/cluster/wham/src-M/parmread.F index d29bb1f..3dcfdec 100644 --- a/source/cluster/wham/src-M/parmread.F +++ b/source/cluster/wham/src-M/parmread.F @@ -17,27 +17,35 @@ C include 'COMMON.SBRIDGE' include 'COMMON.SCCOR' include 'COMMON.SCROT' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' + character*1 t1,t2,t3 character*1 onelett(4) /"G","A","P","D"/ + character*1 toronelet(-2:2) /"p","a","G","A","P"/ logical lprint dimension blower(3,3,maxlob) double precision ip,mp + character*3 lancuch,ucase C C Body C + write (iout,*) "PARMREAD tor_mode",tor_mode + call getenv("PRINT_PARM",lancuch) + lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") + write (iout,*) "lprint ",lprint C Set LPRINT=.TRUE. for debugging dwa16=2.0d0**(1.0d0/6.0d0) - lprint=.false. itypro=20 C Assign virtual-bond length vbl=3.8D0 vblinv=1.0D0/vbl vblinv2=vblinv*vblinv #ifdef CRYST_BOND - read (ibond,*) vbldp0,akp + read (ibond,*,end=121,err=121) vbldp0,vbldpdum,akp do i=1,ntyp nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i) + read (ibond,*,end=121,err=121) vbldsc0(1,i),aksc(1,i) dsc(i) = vbldsc0(1,i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -46,10 +54,10 @@ C Assign virtual-bond length endif enddo #else - read (ibond,*) ijunk,vbldp0,akp,rjunk + read (ibond,*,end=121,err=121) ijunk,vbldp0,vbldpdum,akp,rjunk do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)) + read (ibond,*,end=121,err=121) nbondterm(i),(vbldsc0(j,i), + & aksc(j,i),abond0(j,i),j=1,nbondterm(i)) dsc(i) = vbldsc0(1,i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -72,17 +80,57 @@ C Assign virtual-bond length enddo enddo endif + read(iliptranpar,*,end=1161,err=1161) pepliptran + do i=1,ntyp + read(iliptranpar,*,end=1161,err=1161) liptranene(i) + enddo + close(iliptranpar) #ifdef CRYST_THETA C C Read the parameters of the probability distribution/energy expression C of the virtual-bond valence angles theta C do i=1,ntyp - read (ithep,*) a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - read (ithep,*) (polthet(j,i),j=0,3) - read (ithep,*) (gthet(j,i),j=1,3) - read (ithep,*) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 + read (ithep,*,end=111,err=111) a0thet(i),(athet(j,i,1,1),j=1,2), + & (bthet(j,i,1,1),j=1,2) + read (ithep,*,end=111,err=111) (polthet(j,i),j=0,3) + read (ithep,*,end=111,err=111) (gthet(j,i),j=1,3) + read (ithep,*,end=111,err=111) theta0(i),sig0(i),sigc0(i) + sigc0(i)=sigc0(i)**2 + enddo + do i=1,ntyp + athet(1,i,1,-1)=athet(1,i,1,1) + athet(2,i,1,-1)=athet(2,i,1,1) + bthet(1,i,1,-1)=-bthet(1,i,1,1) + bthet(2,i,1,-1)=-bthet(2,i,1,1) + athet(1,i,-1,1)=-athet(1,i,1,1) + athet(2,i,-1,1)=-athet(2,i,1,1) + bthet(1,i,-1,1)=bthet(1,i,1,1) + bthet(2,i,-1,1)=bthet(2,i,1,1) + enddo + do i=-ntyp,-1 + a0thet(i)=a0thet(-i) + athet(1,i,-1,-1)=athet(1,-i,1,1) + athet(2,i,-1,-1)=-athet(2,-i,1,1) + bthet(1,i,-1,-1)=bthet(1,-i,1,1) + bthet(2,i,-1,-1)=-bthet(2,-i,1,1) + athet(1,i,-1,1)=athet(1,-i,1,1) + athet(2,i,-1,1)=-athet(2,-i,1,1) + bthet(1,i,-1,1)=-bthet(1,-i,1,1) + bthet(2,i,-1,1)=bthet(2,-i,1,1) + athet(1,i,1,-1)=-athet(1,-i,1,1) + athet(2,i,1,-1)=athet(2,-i,1,1) + bthet(1,i,1,-1)=bthet(1,-i,1,1) + bthet(2,i,1,-1)=-bthet(2,-i,1,1) + theta0(i)=theta0(-i) + sig0(i)=sig0(-i) + sigc0(i)=sigc0(-i) + do j=0,3 + polthet(j,i)=polthet(j,-i) + enddo + do j=1,3 + gthet(j,i)=gthet(j,-i) + enddo enddo close (ithep) if (lprint) then @@ -119,7 +167,8 @@ c enddo & ' b1*10^1 ',' b2*10^1 ' do i=1,ntyp write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) + & a0thet(i),(100*athet(j,i,1,1),j=1,2), + & (10*bthet(j,i,1,1),j=1,2) enddo write (iout,'(/a/9x,5a/79(1h-))') & 'Parameters of the expression for sigma(theta_c):', @@ -139,58 +188,72 @@ c enddo enddo endif #else + IF (tor_mode.eq.0) THEN C C Read the parameters of Utheta determined from ab initio surfaces C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 C - read (ithep,*) nthetyp,ntheterm,ntheterm2, + read (ithep,*,end=111,err=111) nthetyp,ntheterm,ntheterm2, & ntheterm3,nsingle,ndouble nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 + read (ithep,*,end=111,err=111) (ithetyp(i),i=1,ntyp1) + do i=-ntyp1,-1 + ithetyp(i)=-ithetyp(-i) + enddo + do iblock=1,2 + do i=-maxthetyp,maxthetyp + do j=-maxthetyp,maxthetyp + do k=-maxthetyp,maxthetyp + aa0thet(i,j,k,iblock)=0.0d0 do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 + aathet(l,i,j,k,iblock)=0.0d0 enddo do l=1,ntheterm2 do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 + bbthet(m,l,i,j,k,iblock)=0.0d0 + ccthet(m,l,i,j,k,iblock)=0.0d0 + ddthet(m,l,i,j,k,iblock)=0.0d0 + eethet(m,l,i,j,k,iblock)=0.0d0 enddo enddo do l=1,ntheterm3 do m=1,ndouble do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 + ffthet(mm,m,l,i,j,k,iblock)=0.0d0 + ggthet(mm,m,l,i,j,k,iblock)=0.0d0 enddo enddo enddo enddo enddo enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)') res1,res2,res3 - read (ithep,*) aa0thet(i,j,k) - read (ithep,*)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), + enddo +C write (iout,*) "KURWA1" + do iblock=1,2 + do i=0,nthetyp + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + read (ithep,'(6a)',end=111,err=111) res1 + write(iout,*) res1,i,j,k + read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock) + read (ithep,*,end=111,err=111)(aathet(l,i,j,k,iblock), + & l=1,ntheterm) + read (ithep,*,end=111,err=111) + & ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle) + & ,ll=1,ntheterm2) + read (ithep,*,end=111,err=111) + & (((ffthet(llll,lll,ll,i,j,k,iblock), + & ffthet(lll,llll,ll,i,j,k,iblock), + & ggthet(llll,lll,ll,i,j,k,iblock) + & ,ggthet(lll,llll,ll,i,j,k,iblock), & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) enddo enddo enddo +C write(iout,*) "KURWA1.1" C C For dummy ends assign glycine-type coefficients of theta-only terms; the C coefficients of theta-and-gamma-dependent terms are zero. @@ -198,38 +261,77 @@ C do i=1,nthetyp do j=1,nthetyp do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) + aathet(l,i,j,nthetyp+1,iblock)=0.0d0 + aathet(l,nthetyp+1,i,j,iblock)=0.0d0 enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) + aa0thet(i,j,nthetyp+1,iblock)=0.0d0 + aa0thet(nthetyp+1,i,j,iblock)=0.0d0 enddo do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) + aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0 enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) + aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0 + enddo enddo +C write(iout,*) "KURWA1.5" +C Substitution for D aminoacids from symmetry. + do iblock=1,2 + do i=-nthetyp,0 + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock) + do l=1,ntheterm + aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock) + enddo + do ll=1,ntheterm2 + do lll=1,nsingle + bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock) + ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock) + ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock) + eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock) + enddo + enddo + do ll=1,ntheterm3 + do lll=2,ndouble + do llll=1,lll-1 + ffthet(llll,lll,ll,i,j,k,iblock)= + & ffthet(llll,lll,ll,-i,-j,-k,iblock) + ffthet(lll,llll,ll,i,j,k,iblock)= + & ffthet(lll,llll,ll,-i,-j,-k,iblock) + ggthet(llll,lll,ll,i,j,k,iblock)= + & -ggthet(llll,lll,ll,-i,-j,-k,iblock) + ggthet(lll,llll,ll,i,j,k,iblock)= + & -ggthet(lll,llll,ll,-i,-j,-k,iblock) + enddo !ll + enddo !lll + enddo !llll + enddo !k + enddo !j + enddo !i + enddo !iblock + C C Control printout of the coefficients of virtual-bond-angle potentials C if (lprint) then write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' + do iblock=1,2 do i=1,nthetyp+1 do j=1,nthetyp+1 do k=1,nthetyp+1 write (iout,'(//4a)') & 'Type ',onelett(i),onelett(j),onelett(k) write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) + write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock) write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) + & (l,aathet(l,i,j,k,iblock),l=1,ntheterm) do l=1,ntheterm2 write (iout,'(//2h m,4(9x,a,3h[m,i1,1h]))') & "b",l,"c",l,"d",l,"e",l do m=1,nsingle write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) + & bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock), + & ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock) enddo enddo do l=1,ntheterm3 @@ -238,24 +340,53 @@ C do m=2,ndouble do n=1,m-1 write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) + & ffthet(n,m,l,i,j,k,iblock), + & ffthet(m,n,l,i,j,k,iblock), + & ggthet(n,m,l,i,j,k,iblock), + & ggthet(m,n,l,i,j,k,iblock) enddo enddo enddo enddo enddo enddo + enddo call flush(iout) endif -#endif + ELSE + +C here will be the apropriate recalibrating for D-aminoacid + read (ithep,*,end=111,err=111) nthetyp + do i=-nthetyp+1,nthetyp-1 + read (ithep,*,end=111,err=111) nbend_kcc_Tb(i) + do j=0,nbend_kcc_Tb(i) + read (ithep,*,end=111,err=111) ijunk,v1bend_chyb(j,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Parameters of the valence-only potentials" + do i=-nthetyp+1,nthetyp-1 + write (iout,'(2a)') "Type ",toronelet(i) + do k=0,nbend_kcc_Tb(i) + write(iout,'(i5,f15.5)') k,v1bend_chyb(k,i) + enddo + enddo + endif + + ENDIF ! TOR_MODE + + close(ithep) +#endif +C write(iout,*) 'KURWA2' #ifdef CRYST_SC C C Read the parameters of the probability distribution/energy expression C of the side chains. C do i=1,ntyp +cc write (iout,*) "tu dochodze",i read (irotam,'(3x,i3,f8.3)') nlob(i),dsc(i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -271,11 +402,19 @@ C enddo enddo bsc(1,i)=0.0D0 - read(irotam,*)(censc(k,1,i),k=1,3),((blower(k,l,1),l=1,k),k=1,3) + read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), + & ((blower(k,l,1),l=1,k),k=1,3) + censc(1,1,-i)=censc(1,1,i) + censc(2,1,-i)=censc(2,1,i) + censc(3,1,-i)=-censc(3,1,i) do j=2,nlob(i) - read (irotam,*) bsc(j,i) - read (irotam,*) (censc(k,j,i),k=1,3), + read (irotam,*,end=112,err=112) bsc(j,i) + read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), & ((blower(k,l,j),l=1,k),k=1,3) + censc(1,j,-i)=censc(1,j,i) + censc(2,j,-i)=censc(2,j,i) + censc(3,j,-i)=-censc(3,j,i) +C BSC is amplitude of Gaussian enddo do j=1,nlob(i) do k=1,3 @@ -286,6 +425,14 @@ C enddo gaussc(k,l,j,i)=akl gaussc(l,k,j,i)=akl + if (((k.eq.3).and.(l.ne.3)) + & .or.((l.eq.3).and.(k.ne.3))) then + gaussc(k,l,j,-i)=-akl + gaussc(l,k,j,-i)=-akl + else + gaussc(k,l,j,-i)=akl + gaussc(l,k,j,-i)=akl + endif enddo enddo enddo @@ -330,29 +477,419 @@ C Read scrot parameters for potentials determined from all-atom AM1 calculations C added by Urszula Kozlowska 07/11/2007 C do i=1,ntyp - read (irotam,*) + read (irotam,*,end=112,err=112) if (i.eq.10) then - read (irotam,*) + read (irotam,*,end=112,err=112) else do j=1,65 - read(irotam,*) sc_parmin(j,i) + read(irotam,*,end=112,err=112) sc_parmin(j,i) enddo endif enddo #endif close(irotam) +C +C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local +C interaction energy of the Gly, Ala, and Pro prototypes. +C + read (ifourier,*,end=115,err=115) nloctyp + SPLIT_FOURIERTOR = nloctyp.lt.0 + nloctyp = iabs(nloctyp) +#ifdef NEWCORR + read (ifourier,*,end=115,err=115) (itype2loc(i),i=1,ntyp) + read (ifourier,*,end=115,err=115) (iloctyp(i),i=0,nloctyp-1) + itype2loc(ntyp1)=nloctyp + iloctyp(nloctyp)=ntyp1 + do i=1,ntyp1 + itype2loc(-i)=-itype2loc(i) + enddo +#else + iloctyp(0)=10 + iloctyp(1)=9 + iloctyp(2)=20 + iloctyp(3)=ntyp1 +#endif + do i=1,nloctyp + iloctyp(-i)=-iloctyp(i) + enddo +c write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1) +c write (iout,*) "nloctyp",nloctyp, +c & " iloctyp",(iloctyp(i),i=0,nloctyp) +#ifdef NEWCORR + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1" +c write (iout,*) ((bnew1(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2" +c write (iout,*) ((bnew2(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnew(kk,1,i) + read (ifourier,*,end=115,err=115) ccnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnew(kk,1,i) + read (ifourier,*,end=115,err=115) ddnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW" +c write (iout,*) ((ddnew(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenew(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1" +c write(iout,*)(((eenew(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0new(ii,i) + enddo +c write (iout,*) (e0new(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW" + do i=0,nloctyp-1 + do ii=1,3 + ccnew(ii,1,i)=ccnew(ii,1,i)/2 + ccnew(ii,2,i)=ccnew(ii,2,i)/2 + ddnew(ii,1,i)=ddnew(ii,1,i)/2 + ddnew(ii,2,i)=ddnew(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1(ii,1,-i)= bnew1(ii,1,i) + bnew1(ii,2,-i)=-bnew1(ii,2,i) + bnew2(ii,1,-i)= bnew2(ii,1,i) + bnew2(ii,2,-i)=-bnew2(ii,2,i) + enddo + do ii=1,3 +c ccnew(ii,1,i)=ccnew(ii,1,i)/2 +c ccnew(ii,2,i)=ccnew(ii,2,i)/2 +c ddnew(ii,1,i)=ddnew(ii,1,i)/2 +c ddnew(ii,2,i)=ddnew(ii,2,i)/2 + ccnew(ii,1,-i)=ccnew(ii,1,i) + ccnew(ii,2,-i)=-ccnew(ii,2,i) + ddnew(ii,1,-i)=ddnew(ii,1,i) + ddnew(ii,2,-i)=-ddnew(ii,2,i) + enddo + e0new(1,-i)= e0new(1,i) + e0new(2,-i)=-e0new(2,i) + e0new(3,-i)=-e0new(3,i) + do kk=1,2 + eenew(kk,1,1,-i)= eenew(kk,1,1,i) + eenew(kk,1,2,-i)=-eenew(kk,1,2,i) + eenew(kk,2,1,-i)=-eenew(kk,2,1,i) + eenew(kk,2,2,-i)= eenew(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') "Coefficients of the multibody terms" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') j,(bnew1(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') j,(bnew2(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of C" + write (iout,'(3hC11,3f10.5)') (ccnew(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of D" + write (iout,'(3hD11,3f10.5)') (ddnew(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of E" + write (iout,'(2hE0,3f10.5)') (e0new(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') j,k,(eenew(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + IF (SPLIT_FOURIERTOR) THEN + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR TOR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1 TOR" +c write (iout,*) ((bnew1tor(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2 TOR" +c write (iout,*) ((bnew2tor(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ccnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW TOR" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ddnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW TOR" +c write (iout,*) ((ddnewtor(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenewtor(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1 TOR" +c write(iout,*)(((eenewtor(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0newtor(ii,i) + enddo +c write (iout,*) (e0newtor(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW TOR" + do i=0,nloctyp-1 + do ii=1,3 + ccnewtor(ii,1,i)=ccnewtor(ii,1,i)/2 + ccnewtor(ii,2,i)=ccnewtor(ii,2,i)/2 + ddnewtor(ii,1,i)=ddnewtor(ii,1,i)/2 + ddnewtor(ii,2,i)=ddnewtor(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1tor(ii,1,-i)= bnew1tor(ii,1,i) + bnew1tor(ii,2,-i)=-bnew1tor(ii,2,i) + bnew2tor(ii,1,-i)= bnew2tor(ii,1,i) + bnew2tor(ii,2,-i)=-bnew2tor(ii,2,i) + enddo + do ii=1,3 + ccnewtor(ii,1,-i)=ccnewtor(ii,1,i) + ccnewtor(ii,2,-i)=-ccnewtor(ii,2,i) + ddnewtor(ii,1,-i)=ddnewtor(ii,1,i) + ddnewtor(ii,2,-i)=-ddnewtor(ii,2,i) + enddo + e0newtor(1,-i)= e0newtor(1,i) + e0newtor(2,-i)=-e0newtor(2,i) + e0newtor(3,-i)=-e0newtor(3,i) + do kk=1,2 + eenewtor(kk,1,1,-i)= eenewtor(kk,1,1,i) + eenewtor(kk,1,2,-i)=-eenewtor(kk,1,2,i) + eenewtor(kk,2,1,-i)=-eenewtor(kk,2,1,i) + eenewtor(kk,2,2,-i)= eenewtor(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Single-body coefficients of the torsional potentials" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1tor" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') + & j,(bnew1tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2tor" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') + & j,(bnew2tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of Ctor" + write (iout,'(3hC11,3f10.5)') (ccnewtor(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Dtor" + write (iout,'(3hD11,3f10.5)') (ddnewtor(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Etor" + write (iout,'(2hE0,3f10.5)') (e0newtor(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') + & j,k,(eenewtor(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + ELSE + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1tor(ii,j,i)=bnew1(ii,j,i) + enddo + enddo + do ii=1,3 + do j=1,2 + bnew2tor(ii,j,i)=bnew2(ii,j,i) + enddo + enddo + do ii=1,3 + ccnewtor(ii,1,i)=ccnew(ii,1,i) + ccnewtor(ii,2,i)=ccnew(ii,2,i) + ddnewtor(ii,1,i)=ddnew(ii,1,i) + ddnewtor(ii,2,i)=ddnew(ii,2,i) + enddo + enddo + ENDIF !SPLIT_FOURIER_TOR +#else + if (lprint) + & write (iout,*) "Coefficients of the expansion of Eloc(l1,l2)" + do i=0,nloctyp-1 + read (ifourier,*,end=115,err=115) + read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13) + if (lprint) then + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) + endif + if (i.gt.0) then + b(2,-i)= b(2,i) + b(3,-i)= b(3,i) + b(4,-i)=-b(4,i) + b(5,-i)=-b(5,i) + endif +c B1(1,i) = b(3) +c B1(2,i) = b(5) +c B1(1,-i) = b(3) +c B1(2,-i) = -b(5) +c b1(1,i)=0.0d0 +c b1(2,i)=0.0d0 +c B1tilde(1,i) = b(3) +c B1tilde(2,i) =-b(5) +c B1tilde(1,-i) =-b(3) +c B1tilde(2,-i) =b(5) +c b1tilde(1,i)=0.0d0 +c b1tilde(2,i)=0.0d0 +c B2(1,i) = b(2) +c B2(2,i) = b(4) +c B2(1,-i) =b(2) +c B2(2,-i) =-b(4) +cc B1tilde(1,i) = b(3,i) +cc B1tilde(2,i) =-b(5,i) +C B1tilde(1,-i) =-b(3,i) +C B1tilde(2,-i) =b(5,i) +cc b1tilde(1,i)=0.0d0 +cc b1tilde(2,i)=0.0d0 +cc B2(1,i) = b(2,i) +cc B2(2,i) = b(4,i) +C B2(1,-i) =b(2,i) +C B2(2,-i) =-b(4,i) + +c b2(1,i)=0.0d0 +c b2(2,i)=0.0d0 + CCold(1,1,i)= b(7,i) + CCold(2,2,i)=-b(7,i) + CCold(2,1,i)= b(9,i) + CCold(1,2,i)= b(9,i) + CCold(1,1,-i)= b(7,i) + CCold(2,2,-i)=-b(7,i) + CCold(2,1,-i)=-b(9,i) + CCold(1,2,-i)=-b(9,i) +c CC(1,1,i)=0.0d0 +c CC(2,2,i)=0.0d0 +c CC(2,1,i)=0.0d0 +c CC(1,2,i)=0.0d0 +c Ctilde(1,1,i)= CCold(1,1,i) +c Ctilde(1,2,i)= CCold(1,2,i) +c Ctilde(2,1,i)=-CCold(2,1,i) +c Ctilde(2,2,i)=-CCold(2,2,i) + +c Ctilde(1,1,i)=0.0d0 +c Ctilde(1,2,i)=0.0d0 +c Ctilde(2,1,i)=0.0d0 +c Ctilde(2,2,i)=0.0d0 + DDold(1,1,i)= b(6,i) + DDold(2,2,i)=-b(6,i) + DDold(2,1,i)= b(8,i) + DDold(1,2,i)= b(8,i) + DDold(1,1,-i)= b(6,i) + DDold(2,2,-i)=-b(6,i) + DDold(2,1,-i)=-b(8,i) + DDold(1,2,-i)=-b(8,i) +c DD(1,1,i)=0.0d0 +c DD(2,2,i)=0.0d0 +c DD(2,1,i)=0.0d0 +c DD(1,2,i)=0.0d0 +c Dtilde(1,1,i)= DD(1,1,i) +c Dtilde(1,2,i)= DD(1,2,i) +c Dtilde(2,1,i)=-DD(2,1,i) +c Dtilde(2,2,i)=-DD(2,2,i) + +c Dtilde(1,1,i)=0.0d0 +c Dtilde(1,2,i)=0.0d0 +c Dtilde(2,1,i)=0.0d0 +c Dtilde(2,2,i)=0.0d0 + EEold(1,1,i)= b(10,i)+b(11,i) + EEold(2,2,i)=-b(10,i)+b(11,i) + EEold(2,1,i)= b(12,i)-b(13,i) + EEold(1,2,i)= b(12,i)+b(13,i) + EEold(1,1,-i)= b(10,i)+b(11,i) + EEold(2,2,-i)=-b(10,i)+b(11,i) + EEold(2,1,-i)=-b(12,i)+b(13,i) + EEold(1,2,-i)=-b(12,i)-b(13,i) + write(iout,*) "TU DOCHODZE" + print *,"JESTEM" +c ee(1,1,i)=1.0d0 +c ee(2,2,i)=1.0d0 +c ee(2,1,i)=0.0d0 +c ee(1,2,i)=0.0d0 +c ee(2,1,i)=ee(1,2,i) + enddo + if (lprint) then + write (iout,*) + write (iout,*) + &"Coefficients of the cumulants (independent of valence angles)" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,*) 'B1' + write(iout,'(2f10.5)') B(3,i),B(5,i) + write (iout,*) 'B2' + write(iout,'(2f10.5)') B(2,i),B(4,i) + write (iout,*) 'CC' + do j=1,2 + write (iout,'(2f10.5)') CCold(j,1,i),CCold(j,2,i) + enddo + write(iout,*) 'DD' + do j=1,2 + write (iout,'(2f10.5)') DDold(j,1,i),DDold(j,2,i) + enddo + write(iout,*) 'EE' + do j=1,2 + write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i) + enddo + enddo + endif +#endif +C write (iout,*) 'KURWAKURWA' #ifdef CRYST_TOR C C Read torsional parameters in old format C - read (itorp,*) ntortyp,nterm_old + read (itorp,*,end=113,err=113) ntortyp,nterm_old write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*) (itortyp(i),i=1,ntyp) + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) do i=1,ntortyp do j=1,ntortyp - read (itorp,'(a)') + read (itorp,'(a)',end=113,err=113) do k=1,nterm_old - read (itorp,*) kk,v1(k,j,i),v2(k,j,i) + read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) enddo enddo enddo @@ -370,188 +907,360 @@ C C C Read torsional parameters C - read (itorp,*) ntortyp - read (itorp,*) (itortyp(i),i=1,ntyp) + IF (TOR_MODE.eq.0) THEN + + read (itorp,*,end=113,err=113) ntortyp + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) + do i=1,ntyp1 + itype2loc(i)=itortyp(i) + enddo write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*) nterm(i,j),nlor(i,j) + do iblock=1,2 + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo +c write (iout,*) 'ntortyp',ntortyp + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + read (itorp,*,end=113,err=113) nterm(i,j,iblock), + & nlor(i,j,iblock) + nterm(-i,-j,iblock)=nterm(i,j,iblock) + nlor(-i,-j,iblock)=nlor(i,j,iblock) v0ij=0.0d0 si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) + do k=1,nterm(i,j,iblock) + read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock), + & v2(k,i,j,iblock) + v1(k,-i,-j,iblock)=v1(k,i,j,iblock) + v2(k,-i,-j,iblock)=-v2(k,i,j,iblock) + v0ij=v0ij+si*v1(k,i,j,iblock) si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*) kk,vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) + enddo + do k=1,nlor(i,j,iblock) + read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), + & vlor2(k,i,j),vlor3(k,i,j) v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) enddo - v0(i,j)=v0ij + v0(i,j,iblock)=v0ij + v0(-i,-j,iblock)=v0ij enddo enddo + enddo close (itorp) if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j + write (iout,'(/a/)') 'Torsional constants:' + do i=1,ntortyp + do j=1,ntortyp + do iblock=1,2 + write (iout,*) 'ityp',i,' jtyp',j," block",iblock write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) + do k=1,nterm(i,j,iblock) + write (iout,'(2(1pe15.5))') v1(k,i,j,iblock), + & v2(k,i,j,iblock) enddo write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') + do k=1,nlor(i,j,iblock) + write (iout,'(3(1pe15.5))') & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) enddo + enddo enddo enddo endif C C 6/23/01 Read parameters for double torsionals C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)') t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 +c write (iout,*) "OK onelett", +c & i,j,k,t1,t2,t3 + + if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) + & .or. t3.ne.toronelet(k)) then write (iout,*) "Error in double torsional parameter file", & i,j,k,t1,t2,t3 +#ifdef MPI + call MPI_Finalize(Ierror) +#endif stop "Error in double torsional parameter file" endif - read (itordp,*) ntermd_1(i,j,k),ntermd_2(i,j,k) - read (itordp,*) (v1c(1,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1s(1,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1c(2,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1s(2,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) ((v2c(l,m,i,j,k),v2c(m,l,i,j,k), - & v2s(l,m,i,j,k),v2s(m,l,i,j,k),m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo + read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock), + & ntermd_2(i,j,k,iblock) + ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock) + ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock) + read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) +C Martix of D parameters for one dimesional foureir series + do l=1,ntermd_1(i,j,k,iblock) + v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock) + v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock) + v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock) + v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock) +c write(iout,*) "whcodze" , +c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) + enddo + read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock), + & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock), + & v2s(m,l,i,j,k,iblock), + & m=1,l-1),l=1,ntermd_2(i,j,k,iblock)) +C Martix of D parameters for two dimesional fourier series + do l=1,ntermd_2(i,j,k,iblock) + do m=1,l-1 + v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock) + v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock) + v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock) + v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock) + enddo!m + enddo!l + enddo!k + enddo!j + enddo!i + enddo!iblock if (lprint) then - write (iout,*) + write (iout,*) write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) + & ' nsingle',ntermd_1(i,j,k,iblock), + & ' ndouble',ntermd_2(i,j,k,iblock) write (iout,*) write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) + do l=1,ntermd_1(i,j,k,iblock) + write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l, + & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock), + & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock), + & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock) enddo write (iout,*) write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)), + & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) enddo enddo enddo + enddo endif + + ELSE IF (TOR_MODE.eq.1) THEN + +C read valence-torsional parameters + read (itorp,*,end=113,err=113) ntortyp + nkcctyp=ntortyp + write (iout,*) "Valence-torsional parameters read in ntortyp", + & ntortyp + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) + write (iout,*) "itortyp_kcc",(itortyp(i),i=1,ntyp) + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 +C first we read the cos and sin gamma parameters + read (itorp,'(13x,a)',end=113,err=113) string + write (iout,*) i,j,string + read (itorp,*,end=113,err=113) + & nterm_kcc(j,i),nterm_kcc_Tb(j,i) +C read (itorkcc,*,end=121,err=121) nterm_kcc_Tb(j,i) + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + read (itorp,*,end=113,err=113) ii,jj,kk, + & v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) + enddo + enddo + enddo + enddo + enddo + + ELSE +c AL 4/8/16: Calculate coefficients from one-body parameters + ntortyp=nloctyp + do i=-ntyp1,ntyp1 + itortyp(i)=itype2loc(i) + enddo + write (iout,*) + &"Val-tor parameters calculated from cumulant coefficients ntortyp" + & ,ntortyp + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + nterm_kcc(j,i)=2 + nterm_kcc_Tb(j,i)=3 + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) + v1_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,1,j) + & +bnew1tor(k,2,i)*bnew2tor(l,2,j) + v2_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,2,j) + & +bnew1tor(k,2,i)*bnew2tor(l,1,j) + enddo + enddo + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) +#ifdef CORRCD + v1_kcc(k,l,2,i,j)=-(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) +#else + v1_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) #endif -C -C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local -C correlation energies. -C - read (isccor,*) nterm_sccor - do i=1,20 - do j=1,20 - read (isccor,'(a)') - do k=1,nterm_sccor - read (isccor,*) - & kk,v1sccor(k,i,j),v2sccor(k,i,j) + enddo enddo +cf(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(theta)*b11(theta)+b21(theta)*b12(theta))*sin(gamma)+(c11(theta)*d11(theta)-c12(theta)*d12(theta))*cos(2*gamma)+(c12(theta)*d11(theta)+c11(theta)*d12(theta))*sin(2*gamma) enddo enddo - close (isccor) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants of SCCORR:' - do i=1,20 - do j=1,20 - write (iout,*) 'ityp',i,' jtyp',j - do k=1,nterm_sccor - write (iout,'(2(1pe15.5))') v1sccor(k,i,j),v2sccor(k,i,j) - enddo + + ENDIF ! TOR_MODE + + if (tor_mode.gt.0 .and. lprint) then +c Print valence-torsional parameters + write (iout,'(a)') + & "Parameters of the valence-torsional potentials" + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + write (iout,'(3a)') "Type ",toronelet(i),toronelet(j) + write (iout,'(3a5,2a15)') "itor","ival","jval","v_kcc","v2_kcc" + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + write (iout,'(3i5,2f15.4)') + & k,l-1,ll-1,v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) + enddo enddo enddo + enddo + enddo endif + +#endif +C Read of Side-chain backbone correlation parameters +C Modified 11 May 2012 by Adasko +CCC C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - read (ifourier,*) nloctyp - do i=1,nloctyp - read (ifourier,*) - read (ifourier,*) (b(ii,i),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) - endif - B1(1,i) = b(3,i) - B1(2,i) = b(5,i) - B1tilde(1,i) = b(3,i) - B1tilde(2,i) =-b(5,i) - B2(1,i) = b(2,i) - B2(2,i) = b(4,i) - CC(1,1,i)= b(7,i) - CC(2,2,i)=-b(7,i) - CC(2,1,i)= b(9,i) - CC(1,2,i)= b(9,i) - Ctilde(1,1,i)=b(7,i) - Ctilde(1,2,i)=b(9,i) - Ctilde(2,1,i)=-b(9,i) - Ctilde(2,2,i)=b(7,i) - DD(1,1,i)= b(6,i) - DD(2,2,i)=-b(6,i) - DD(2,1,i)= b(8,i) - DD(1,2,i)= b(8,i) - Dtilde(1,1,i)=b(6,i) - Dtilde(1,2,i)=b(8,i) - Dtilde(2,1,i)=-b(8,i) - Dtilde(2,2,i)=b(6,i) - EE(1,1,i)= b(10,i)+b(11,i) - EE(2,2,i)=-b(10,i)+b(11,i) - EE(2,1,i)= b(12,i)-b(13,i) - EE(1,2,i)= b(12,i)+b(13,i) + read (isccor,*,end=119,err=119) nsccortyp + read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) + do i=-ntyp,-1 + isccortyp(i)=-isccortyp(-i) enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' -c write (iout,'(f10.5)') B1(:,i) - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' -c write (iout,'(f10.5)') B2(:,i) - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) + iscprol=isccortyp(20) +c write (iout,*) 'ntortyp',ntortyp + maxinter=3 +cc maxinter is maximum interaction sites + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + read (isccor,*,end=119,err=119) + &nterm_sccor(i,j),nlor_sccor(i,j) +c write (iout,*) nterm_sccor(i,j) + v0ijsccor=0.0d0 + v0ijsccor1=0.0d0 + v0ijsccor2=0.0d0 + v0ijsccor3=0.0d0 + si=-1.0d0 + nterm_sccor(-i,j)=nterm_sccor(i,j) + nterm_sccor(-i,-j)=nterm_sccor(i,j) + nterm_sccor(i,-j)=nterm_sccor(i,j) +c write (iout,*) nterm_sccor(i,j),nterm_sccor(-i,j), +c & nterm_sccor(-i,-j),nterm_sccor(i,-j) + do k=1,nterm_sccor(i,j) + read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) + & ,v2sccor(k,l,i,j) + if (j.eq.iscprol) then + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0 + & +v2sccor(k,l,i,j)*dsqrt(0.75d0) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0 + & +v1sccor(k,l,i,j)*dsqrt(0.75d0) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + else + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + if (j.eq.isccortyp(10)) then + v1sccor(k,l,-i,j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + endif + endif + v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) + v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j) + v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j) + v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j) + si=-si + enddo + do k=1,nlor_sccor(i,j) + read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), + & vlor2sccor(k,i,j),vlor3sccor(k,i,j) + v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ + &(1+vlor3sccor(k,i,j)**2) + enddo + v0sccor(l,i,j)=v0ijsccor + v0sccor(l,-i,j)=v0ijsccor1 + v0sccor(l,i,-j)=v0ijsccor2 + v0sccor(l,-i,-j)=v0ijsccor3 + enddo enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) + enddo + close (isccor) + if (lprint) then + write (iout,'(/a/)') 'Torsional constants of SCCORR:' + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + write (iout,*) 'ityp',i,' jtyp',j + write (iout,*) 'Fourier constants' + do k=1,nterm_sccor(i,j) + write (iout,'(2(1pe15.5))') + & v1sccor(k,l,i,j),v2sccor(k,l,i,j) + enddo + write (iout,*) 'Lorenz constants' + do k=1,nlor_sccor(i,j) + write (iout,'(3(1pe15.5))') + & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) + enddo + enddo enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) enddo - enddo endif C C Read electrostatic-interaction parameters @@ -561,10 +1270,10 @@ C write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') & 'IT','JT','APP','BPP','AEL6','AEL3' endif - read (ielep,*) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*) ((elpp3(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) close (ielep) do i=1,2 do j=1,2 @@ -580,7 +1289,7 @@ C C C Read side-chain interaction parameters. C - read (isidep,*) ipot,expon + read (isidep,*,end=117,err=117) ipot,expon if (ipot.lt.1 .or. ipot.gt.5) then write (iout,'(2a)') 'Error while reading SC interaction', & 'potential file - unknown potential type.' @@ -591,7 +1300,8 @@ C & ', exponents are ',expon,2*expon goto (10,20,30,30,40) ipot C----------------------- LJ potential --------------------------------- - 10 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),(sigma0(i),i=1,ntyp) + 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), + & (sigma0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJ potential:' write (iout,'(a/)') 'The epsilon array:' @@ -602,7 +1312,7 @@ C----------------------- LJ potential --------------------------------- endif goto 50 C----------------------- LJK potential -------------------------------- - 20 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), + 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJK potential:' @@ -615,13 +1325,25 @@ C----------------------- LJK potential -------------------------------- endif goto 50 C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip0(i),i=1,ntyp), - & (alp(i),i=1,ntyp) + 30 do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) + do i=1,ntyp + read (isidep,*,end=117,err=117)(epslip(i,j),j=i,ntyp) +C write(iout,*) "WARNING!!",i,ntyp + if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) +C do j=1,ntyp +C epslip(i,j)=epslip(i,j)+0.05d0 +C enddo + enddo C For the GB potential convert sigma'**2 into chi' if (ipot.eq.4) then do i=1,ntyp - chip(i)=(chip0(i)-1.0D0)/(chip0(i)+1.0D0) + chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) enddo endif if (lprint) then @@ -636,7 +1358,7 @@ C For the GB potential convert sigma'**2 into chi' endif goto 50 C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), + 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) if (lprint) then @@ -656,6 +1378,7 @@ C Calculate the "working" parameters of SC interactions. do i=2,ntyp do j=1,i-1 eps(i,j)=eps(j,i) + epslip(i,j)=epslip(j,i) enddo enddo do i=1,ntyp @@ -673,6 +1396,7 @@ C Calculate the "working" parameters of SC interactions. do i=1,ntyp do j=i,ntyp epsij=eps(i,j) + epsijlip=epslip(i,j) if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then rrij=sigma(i,j) else @@ -684,10 +1408,16 @@ C Calculate the "working" parameters of SC interactions. epsij=eps(i,j) sigeps=dsign(1.0D0,epsij) epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) + aa_aq(i,j)=epsij*rrij*rrij + bb_aq(i,j)=-sigeps*epsij*rrij + aa_aq(j,i)=aa_aq(i,j) + bb_aq(j,i)=bb_aq(i,j) + sigeps=dsign(1.0D0,epsijlip) + epsijlip=dabs(epsijlip) + aa_lip(i,j)=epsijlip*rrij*rrij + bb_lip(i,j)=-sigeps*epsijlip*rrij + aa_lip(j,i)=aa_lip(i,j) + bb_lip(j,i)=bb_lip(i,j) if (ipot.gt.2) then sigt1sq=sigma0(i)**2 sigt2sq=sigma0(j)**2 @@ -720,7 +1450,7 @@ c augm(i,j)=0.5D0**(2*expon)*aa(i,j) endif if (lprint) then write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), + & restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j), & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) endif enddo @@ -728,12 +1458,6 @@ c augm(i,j)=0.5D0**(2*expon)*aa(i,j) C C Define the SC-p interaction constants C - do i=1,20 - do j=1,2 - eps_scp(i,j)=-1.5d0 - rscp(i,j)=4.0d0 - enddo - enddo #ifdef OLDSCP do i=1,20 C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates @@ -762,7 +1486,7 @@ C C 8/9/01 Read the SC-p interaction constants from file C do i=1,ntyp - read (iscpp,*) (eps_scp(i,j),rscp(i,j),j=1,2) + read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) enddo do i=1,ntyp aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 @@ -782,7 +1506,7 @@ C C C Define the constants of the disulfide bridge C - ebr=-5.50D0 +C ebr=-12.0D0 c c Old arbitrary potential - commented out. c @@ -793,19 +1517,80 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G** c energy surface of diethyl disulfide. c A. Liwo and U. Kozlowska, 11/24/03 c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 +C D0CM = 3.78d0 +C AKCM = 15.1d0 +C AKTH = 11.0d0 +C AKCT = 12.0d0 +C V1SS =-1.08d0 +C V2SS = 7.61d0 +C V3SS = 13.7d0 + write (iout,*) dyn_ss,'dyndyn' + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) +C write(iout,*) akcm,whpb,wsc,'KURWA' + Ht=Ht/wsc-0.25*eps(1,1) + + akcm=akcm*whpb/wsc + akth=akth*whpb/wsc + akct=akct*whpb/wsc + v1ss=v1ss*whpb/wsc + v2ss=v2ss*whpb/wsc + v3ss=v3ss*whpb/wsc + else + ss_depth=ebr/whpb-0.25*eps(1,1)*wsc/whpb + endif +C if (lprint) then write (iout,'(/a)') "Disulfide bridge parameters:" write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, & ' v3ss:',v3ss +C endif + if (shield_mode.gt.0) then + pi=3.141592d0 +C VSolvSphere the volume of solving sphere +C print *,pi,"pi" +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters + VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 + VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 + write (iout,*) VSolvSphere,VSolvSphere_div +C long axis of side chain + do i=1,ntyp + long_r_sidechain(i)=vbldsc0(1,i) + short_r_sidechain(i)=sigma0(i) + enddo + buff_shield=1.0d0 + endif return + 111 write (iout,*) "Error reading bending energy parameters." + goto 999 + 112 write (iout,*) "Error reading rotamer energy parameters." + goto 999 + 113 write (iout,*) "Error reading torsional energy parameters." + goto 999 + 114 write (iout,*) "Error reading double torsional energy parameters." + goto 999 + 115 write (iout,*) + & "Error reading cumulant (multibody energy) parameters." + goto 999 + 116 write (iout,*) "Error reading electrostatic energy parameters." + goto 999 + 1161 write (iout,*) "Error reading electrostatic energy parameters.Lip" + goto 999 + 117 write (iout,*) "Error reading side chain interaction parameters." + goto 999 + 118 write (iout,*) "Error reading SCp interaction parameters." + goto 999 + 119 write (iout,*) "Error reading SCCOR parameters" + goto 999 + 121 write (iout,*) "Error reading bond parameters" + 999 continue +#ifdef MPI + call MPI_Finalize(Ierror) +#endif + stop end diff --git a/source/cluster/wham/src-M/probabl.F b/source/cluster/wham/src-M/probabl.F index 293fb8f..a40d7d8 100644 --- a/source/cluster/wham/src-M/probabl.F +++ b/source/cluster/wham/src-M/probabl.F @@ -8,6 +8,7 @@ include "COMMON.MPI" integer ierror,errcode,status(MPI_STATUS_SIZE) #endif + include "COMMON.CONTROL" include "COMMON.IOUNITS" include "COMMON.FREE" include "COMMON.FFIELD" @@ -27,10 +28,13 @@ character*80 bxname character*2 licz1 character*5 ctemper - integer ilen + integer ilen,ijk external ilen - real*4 Fdimless(maxconf) - double precision energia(0:max_ene) + character*80 structure/'Structure'/ + real*4 Fdimless(maxconf), Fdimless_buf(maxconf) + double precision energia(0:max_ene), totfree_buf(0:maxconf), + & entfac_buf(maxconf) + double precision buffer(maxconf) do i=1,ncon list_conf(i)=i enddo @@ -41,7 +45,8 @@ c enddo write (iout,*) me," indstart",indstart(me)," indend",indend(me) call daread_ccoords(indstart(me),indend(me)) #endif -c write (iout,*) "ncon",ncon +C write (iout,*) "ncon",ncon +C call flush(iout) temper=1.0d0/(beta_h(ib)*1.987D-3) c write (iout,*) "ib",ib," beta_h",beta_h(ib)," temper",temper c quot=1.0d0/(T0*beta_h(ib)*1.987D-3) @@ -53,6 +58,7 @@ c quotl=quotl*quot c kfacl=kfacl*kfac c fT(l)=kfacl/(kfacl-1.0d0+quotl) c enddo +C#define DEBUG if (rescale_mode.eq.1) then quot=1.0d0/(T0*beta_h(ib)*1.987D-3) quotl=1.0d0 @@ -113,19 +119,25 @@ c call flush(iout) do i=1,ncon ii=i #endif -c write (iout,*) "i",i," ii",ii +C write (iout,*) "i",i," ii",ii,"ib",ib,scount(me) c call flush(iout) - if (ib.eq.1) then +c if (ib.eq.1) then do j=1,nres do k=1,3 c(k,j)=allcart(k,j,i) c(k,j+nres)=allcart(k,j+nres,i) +C write(iout,*) "coord",i,j,k,allcart(k,j,i),c(k,j), +C & c(k,j+nres),allcart(k,j+nres,i) enddo enddo +C write(iout,*) "out of j loop" +C call flush(iout) do k=1,3 c(k,nres+1)=c(k,1) c(k,nres+nres)=c(k,nres) enddo +C write(iout,*) "after nres+nres",nss_all(i) +C call flush(iout) nss=nss_all(i) do j=1,nss ihpb(j)=ihpb_all(j,i) @@ -133,20 +145,31 @@ c call flush(iout) enddo call int_from_cart1(.false.) call etotal(energia(0),fT) + if (refstr) then +c write (structure(9:),'(bz,i6.6)') i + call TMscore_sub(rmsdev,gdt_ts_tb(i), + & gdt_ha_tb(i),tmscore_tb(i),Structure,.false.) +#ifdef DEBUG + write (iout,*) i,rmsdev,gdt_ts_tb(i),gdt_ha_tb(i), + & tmscore_tb(i) +#endif + endif totfree(i)=energia(0) + totfree_buf(i)=totfree(i) c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) c write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) -c call enerprint(energia(0),fT) c call pdbout(totfree(i),16,i) +c call flush(iout) +c#define DEBUG #ifdef DEBUG - write (iout,*) i," energia",(energia(j),j=0,19) - write (iout,*) "etot", etot - write (iout,*) "ft(6)", ft(6) + write (iout,*) "conformation", i + call enerprint(energia(0),fT) #endif +c#undef DEBUG do k=1,max_ene enetb(k,i)=energia(k) enddo - endif +c endif evdw=enetb(1,i) c write (iout,*) evdw etot=energia(0) @@ -205,44 +228,91 @@ c#endif write (iout,*) "evdw2", wscp, evdw2 write (iout,*) "welec", ft(1),welec,ees write (iout,*) "evdw1", wvdwpp,evdw1 - write (iout,*) "ebe" ebe,wang + write (iout,*) "ebe", ebe,wang #endif Fdimless(i)=beta_h(ib)*etot+entfac(ii) + Fdimless_buf(i)=Fdimless(i) totfree(i)=etot + totfree_buf(i)=totfree(i) #ifdef DEBUG write (iout,*) "fdim calc", i,ii,ib, & 1.0d0/(1.987d-3*beta_h(ib)),totfree(i), & entfac(ii),Fdimless(i) #endif enddo ! i + + do ijk=1,maxconf + entfac_buf(ijk)=entfac(ijk) + Fdimless_buf(ijk)=Fdimless(ijk) + enddo + do ijk=0,maxconf + totfree_buf(ijk)=totfree(ijk) + enddo + + +c scount_buf=scount(me) +c scount_buf2=scount(0) + +c entfac_buf(indstart(me)+1)=entfac(indstart(me)+1) + #ifdef MPI - call MPI_Gatherv(Fdimless(1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv1 (Propabl)" + call MPI_Gatherv(Fdimless_buf(1),scount(me), & MPI_REAL,Fdimless(1), & scount(0),idispl(0),MPI_REAL,Master, & MPI_COMM_WORLD, IERROR) - call MPI_Gatherv(totfree(1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv2 (Propabl)" + call MPI_Gatherv(totfree_buf(1),scount(me), & MPI_DOUBLE_PRECISION,totfree(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) - call MPI_Gatherv(entfac(indstart(me)+1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv3 (Propabl)" + call MPI_Gatherv(entfac_buf(indstart(me)+1),scount(me), & MPI_DOUBLE_PRECISION,entfac(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) +c WRITE (iout,*) "Wychodze z call MPI_Gatherv (Propabl)" + if (refstr) then + do i=1,scount(me) + buffer(i)=gdt_ts_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & gdt_ts_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + do i=1,scount(me) + buffer(i)=gdt_ha_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & gdt_ha_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + do i=1,scount(me) + buffer(i)=tmscore_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & tmscore_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + endif if (me.eq.Master) then +c WRITE (iout,*) "me.eq.Master" #endif #ifdef DEBUG write (iout,*) "The FDIMLESS array before sorting" do i=1,ncon -c write (iout,*) i,fdimless(i) + write (iout,'(2i5,4f10.5)') i,list_conf(i),fdimless(i), + & gdt_ts_tb(i),gdt_ha_tb(i),tmscore_tb(i) enddo #endif +c WRITE (iout,*) "Wchodze do call mysort1" call mysort1(ncon,Fdimless,list_conf) +c WRITE (iout,*) "Wychodze z call mysort1" #ifdef DEBUG write (iout,*) "The FDIMLESS array after sorting" do i=1,ncon - write (iout,*) i,list_conf(i),fdimless(i) + write (iout,'(2i5,4f10.5)') i,list_conf(i),fdimless(i), + & gdt_ts_tb(i),gdt_ha_tb(i),tmscore_tb(i) enddo #endif +c WRITE (iout,*) "Wchodze do petli i=1,ncon totfree(i)=fdimless(i)" do i=1,ncon totfree(i)=fdimless(i) enddo diff --git a/source/cluster/wham/src-M/read_coords.F b/source/cluster/wham/src-M/read_coords.F index c34aca4..facbc27 100644 --- a/source/cluster/wham/src-M/read_coords.F +++ b/source/cluster/wham/src-M/read_coords.F @@ -62,7 +62,7 @@ c energy components in the binary databases. ICON=1 123 continue if (from_cart .and. .not. from_bx .and. .not. from_cx) then - if (efree) then + if (lefree) then read (intin,*,end=13,err=11) energy(icon),totfree(icon), & rmstb(icon), & nss_all(icon),(ihpb_all(ii,icon),jhpb_all(i,icon), @@ -79,7 +79,7 @@ c energy components in the binary databases. else read(intin,'(a80)',end=13,err=12) lineh read(lineh(:5),*,err=8) ic - if (efree) then + if (lefree) then read(lineh(6:),*,err=8) energy(icon) else read(lineh(6:),*,err=8) energy(icon) @@ -178,13 +178,13 @@ c through a ring. #endif endif -#define DEBUG +C#define DEBUG #ifdef DEBUG write (iout,*) "Opening file ",intinname(:ilen(intinname)) write (iout,*) "lenrec",lenrec_in call flush(iout) #endif -#undef DEBUG +C#undef DEBUG c write (iout,*) "maxconf",maxconf i=0 do while (.true.) @@ -218,10 +218,17 @@ c call flush(iout) call xdrfint_(ixdrf, nss, iret) if (iret.eq.0) goto 101 do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j), iret) + call xdrfint(ixdrf, jdssb(j), iret) + idssb(j)=idssb(j)-nres + jdssb(j)=jdssb(j)-nres + else call xdrfint_(ixdrf, ihpb(j), iret) if (iret.eq.0) goto 101 call xdrfint_(ixdrf, jhpb(j), iret) if (iret.eq.0) goto 101 + endif enddo call xdrffloat_(ixdrf,reini,iret) if (iret.eq.0) goto 101 @@ -243,10 +250,15 @@ c write (iout,*) "nss",nss call flush(iout) if (iret.eq.0) goto 101 do k=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(k), iret) + call xdrfint(ixdrf, jdssb(k), iret) + else call xdrfint(ixdrf, ihpb(k), iret) if (iret.eq.0) goto 101 call xdrfint(ixdrf, jhpb(k), iret) if (iret.eq.0) goto 101 + endif enddo call xdrffloat(ixdrf,reini,iret) if (iret.eq.0) goto 101 @@ -260,6 +272,10 @@ c write (iout,*) "nss",nss energy(jj+1)=reini entfac(jj+1)=refree rmstb(jj+1)=rmsdev +#ifdef DEBUG + write (iout,*) "jj",jj+1," energy",energy(jj+1), + & " entfac",entfac(jj+1)," rmsd",rmstb(jj+1) +#endif do k=1,nres do l=1,3 c(l,k)=csingle(l,k) @@ -271,6 +287,7 @@ c write (iout,*) "nss",nss enddo enddo endif +C#define DEBUG #ifdef DEBUG write (iout,'(5hREAD ,i5,3f15.4,i10)') & jj+1,energy(jj+1),entfac(jj+1), @@ -280,6 +297,7 @@ c write (iout,*) "nss",nss write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct) call flush(iout) #endif +C#undef DEBUG call add_new_cconf(jjj,jj,jj_old,icount,Next) enddo 101 continue @@ -296,9 +314,9 @@ c write (iout,*) "nss",nss #endif endif #ifdef MPI -c#ifdef DEBUG +#ifdef DEBUG write (iout,*) "jj_old",jj_old," jj",jj -c#endif +#endif call write_and_send_cconf(icount,jj_old,jj,Next) call MPI_Send(0,1,MPI_INTEGER,Next,570, & MPI_COMM_WORLD,IERROR) @@ -379,7 +397,8 @@ c------------------------------------------------------------------------------ chalen=int((nct-nnt+2)/symetr) call int_from_cart1(.false.) do j=nnt+1,nct - if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then + if ((vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) + & .and.(itype(j).ne.ntyp1)) then if (j.gt.2) then if (itel(j).ne.0 .and. itel(j-1).ne.0) then write (iout,*) "Conformation",jjj,jj+1 @@ -404,7 +423,8 @@ c------------------------------------------------------------------------------ enddo do j=nnt,nct itj=itype(j) - if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then + if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0 + & .and. itype(j).ne.ntyp1) then write (iout,*) "Conformation",jjj,jj+1 write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j) write (iout,*) "The Cartesian geometry is:" @@ -534,6 +554,10 @@ c Master sends the portion of conformations that have been read in to the neighb & MPI_REAL,Next,580,MPI_COMM_WORLD,IERROR) #endif call dawrite_ccoords(jj_old,jj,icbase) +#ifdef DEBUG + write (iout,*) "Processor",me," exit WRITE_AND_SEND_CONF" + call flush(iout) +#endif return end c------------------------------------------------------------------------------ @@ -553,7 +577,7 @@ c------------------------------------------------------------------------------ include "COMMON.VAR" include "COMMON.GEO" include "COMMON.CLUSTER" - integer i,j,k,icount,jj_old,jj,Previous,Next + integer i,j,k,l,icount,jj_old,jj,Previous,Next icount=1 #ifdef DEBUG write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF" @@ -598,8 +622,8 @@ c------------------------------------------------------------------------------ #ifdef DEBUG write (iout,*) "Processor",me," received",icount," conformations" do i=1,icount - write (iout,'(8f10.4)') (allcart(l,k,i),l=1,3,k=1,nres) - write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3,k=nnt,nct) + write (iout,'(8f10.4)') ((allcart(l,k,i),l=1,3),k=1,nres) + write (iout,'(8f10.4)')((allcart(l,k,i+nres),l=1,3),k=nnt,nct) write (iout,'(e15.5,16i5)') entfac(i) enddo #endif @@ -627,10 +651,11 @@ c------------------------------------------------------------------------------ integer i,j,ij,ii,iii integer len character*16 form,acc - character*32 nam + character*80 nam c c Read conformations off a DA scratchfile. c +C#define DEBUG #ifdef DEBUG write (iout,*) "DAREAD_COORDS" write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf @@ -646,10 +671,17 @@ c write (iout,*) "Reading binary file, record",iii," ii",ii call flush(iout) #endif + if (dyn_ss) then + read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), + & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), +c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), + & entfac(ii),rmstb(ii) + else read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), & entfac(ii),rmstb(ii) + endif #ifdef DEBUG write (iout,*) ii,iii,ij,entfac(ii) write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) @@ -660,7 +692,10 @@ c & jhpb_all(i,ij),i=1,nss) call flush(iout) #endif +C#undef DEBUG enddo +c write (iout,*) "just before leave" + call flush(iout) return end c------------------------------------------------------------------------------ @@ -703,10 +738,17 @@ c write (iout,*) "Writing binary file, record",iii," ii",ii call flush(iout) #endif + if (dyn_ss) then + write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), + & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), +c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)) + & entfac(ii),rmstb(ii) + else write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)), & entfac(ii),rmstb(ii) + endif #ifdef DEBUG write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres, diff --git a/source/cluster/wham/src-M/read_ref_str.F b/source/cluster/wham/src-M/read_ref_str.F index ef427ff..ac7b53e 100644 --- a/source/cluster/wham/src-M/read_ref_str.F +++ b/source/cluster/wham/src-M/read_ref_str.F @@ -29,7 +29,7 @@ C external ilen C nres0=nres - write (iout,*) "pdbref",pdbref +c write (iout,*) "pdbref",pdbref if (pdbref) then read(inp,'(a)') pdbfile write (iout,'(2a,1h.)') 'PDB data will be read from file ', @@ -58,12 +58,12 @@ C & nsup)) then do j=nnt+nsup-1,nnt,-1 do k=1,3 - cref(k,nres+j+i)=cref(k,nres_pdb+j) + cref_pdb(k,nres+j+i,1)=cref_pdb(k,nres_pdb+j,1) enddo enddo do j=nnt+nsup-1,nnt,-1 do k=1,3 - cref(k,j+i)=cref(k,j) + cref_pdb(k,j+i,1)=cref_pdb(k,j,1) enddo phi_ref(j+i)=phi_ref(j) theta_ref(j+i)=theta_ref(j) @@ -73,7 +73,7 @@ C #ifdef DEBUG do j=nnt,nct write (iout,'(i5,3f10.5,5x,3f10.5)') - & j,(cref(k,j),k=1,3),(cref(k,j+nres),k=1,3) + & j,(cref_pdb(k,j,1),k=1,3),(cref_pdb(k,j+nres,1),k=1,3) enddo #endif nstart_seq=nnt+i @@ -111,19 +111,19 @@ C nsup=nct-nnt+1 do i=1,2*nres do j=1,3 - cref(j,i)=c(j,i) + cref_pdb(j,i,1)=c(j,i) enddo enddo endif nend_sup=nstart_sup+nsup-1 do i=1,2*nres do j=1,3 - c(j,i)=cref(j,i) + c(j,i)=cref_pdb(j,i,1) enddo enddo do i=1,nres do j=1,3 - dc(j,nres+i)=cref(j,nres+i)-cref(j,i) + dc(j,nres+i)=cref_pdb(j,nres+i,1)-cref_pdb(j,i,1) enddo if (itype(i).ne.10) then ddsc = dist(i,nres+i) diff --git a/source/cluster/wham/src-M/readpdb.f b/source/cluster/wham/src-M/readpdb.f index 62f3f2b..40a1a97 100644 --- a/source/cluster/wham/src-M/readpdb.f +++ b/source/cluster/wham/src-M/readpdb.f @@ -1,8 +1,10 @@ subroutine readpdb C Read the PDB file and convert the peptide geometry into virtual-chain C geometry. - implicit real*8 (a-h,o-z) + implicit none include 'DIMENSIONS' + include 'sizesclu.dat' + include 'COMMON.CONTROL' include 'COMMON.LOCAL' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -12,18 +14,22 @@ C geometry. include 'COMMON.NAMES' character*3 seq,atom,res character*80 card - dimension sccor(3,20) - integer rescode - call permut(symetr) + double precision sccor(3,50) + integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old + double precision dcj + integer rescode,kkk,lll,icha,cou,kupa,iprzes ibeg=1 + ishift1=0 do read (ipdbin,'(a80)',end=10) card if (card(:3).eq.'END') then goto 10 else if (card(:3).eq.'TER') then C End current chain - ires_old=ires+1 - itype(ires_old)=21 +c ires_old=ires+1 + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + itype(ires_old)=ntyp1 ibeg=2 c write (iout,*) "Chain ended",ires,ishift,ires_old call sccenter(ires,iii,sccor) @@ -38,13 +44,13 @@ C Calculate the CM of the preceding residue. endif C Start new residue. c write (iout,'(a80)') card - read (card(24:26),*) ires + read (card(23:26),*) ires read (card(18:20),'(a3)') res if (ibeg.eq.1) then ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 - itype(1)=21 + itype(1)=ntyp1 endif c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift ibeg=0 @@ -69,6 +75,8 @@ c write (2,*) "ires",ires," ishift",ishift sccor(j,iii)=c(j,ires) enddo else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. + & atom(1:1).ne.'Q' .and. atom(1:2).ne.'1H' .and. + & atom(1:2).ne.'2H' .and. atom(1:2).ne.'3H' .and. & atom.ne.'N ' .and. atom.ne.'C ') then iii=iii+1 read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) @@ -81,14 +89,51 @@ C system nres=ires do i=2,nres-1 c write (iout,*) i,itype(i) - if (itype(i).eq.21) then -c write (iout,*) "dummy",i,itype(i) - do j=1,3 - c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2 -c c(j,i)=(c(j,i-1)+c(j,i+1))/2 - dc(j,i)=c(j,i) - enddo - endif + + if (itype(i).eq.ntyp1) then + if (itype(i+1).eq.ntyp1) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false +C if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue +C call refsys(i-3,i-2,i-1,e1,e2,e3,fail) +C if (fail) then +C e2(1)=0.0d0 +C e2(2)=1.0d0 +C e2(3)=0.0d0 +C endif !fail +C do j=1,3 +C c(j,i)=c(j,i-1)-1.9d0*e2(j) +C enddo +C else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo +C endif !unres_pdb + else !itype(i+1).eq.ntyp1 +C if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue +C call refsys(i+1,i+2,i+3,e1,e2,e3,fail) +C if (fail) then +C e2(1)=0.0d0 +C e2(2)=1.0d0 +C e2(3)=0.0d0 +C endif +C do j=1,3 +C c(j,i)=c(j,i+1)-1.9d0*e2(j) +C enddo +C else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo +C endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 enddo C Calculate the CM of the last side chain. call sccenter(ires,iii,sccor) @@ -96,9 +141,9 @@ C Calculate the CM of the last side chain. nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 - itype(nres)=21 + itype(nres)=ntyp1 do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo @@ -112,11 +157,11 @@ C Calculate the CM of the last side chain. c(j,nres+1)=c(j,1) c(j,2*nres)=c(j,nres) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then nsup=nsup-1 nstart_sup=2 do j=1,3 - dcj=c(j,4)-c(j,3) + dcj=(c(j,4)-c(j,3))/2.0 c(j,1)=c(j,2)-dcj c(j,nres+1)=c(j,1) enddo @@ -128,6 +173,8 @@ C Calculate internal coordinates. & (c(j,nres+ires),j=1,3) enddo call int_from_cart(.true.,.false.) +c write (iout,*) "After int_from_cart" +c call flush(iout) do i=1,nres-1 do j=1,3 dc(j,i)=c(j,i+1)-c(j,i) @@ -144,10 +191,100 @@ c & vbld_inv(i+nres) enddo c call chainbuild C Copy the coordinates to reference coordinates - do i=1,2*nres +c do i=1,2*nres +c do j=1,3 +c cref_pdb(j,i)=c(j,i) +c enddo +c enddo +C Splits to single chain if occurs + kkk=1 + lll=0 + cou=1 + do i=1,nres + lll=lll+1 +cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) + if (i.gt.1) then + if ((itype(i-1).eq.ntyp1).and.(i.gt.2).and.(i.ne.nres)) then + chain_length=lll-1 + kkk=kkk+1 +c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) + lll=1 + endif + endif do j=1,3 - cref(j,i)=c(j,i) + cref_pdb(j,i,cou)=c(j,i) + cref_pdb(j,i+nres,cou)=c(j,i+nres) + if (i.le.nres) then + chain_rep(j,lll,kkk)=c(j,i) + chain_rep(j,lll+nres,kkk)=c(j,i+nres) + endif + enddo + enddo + if (chain_length.eq.0) chain_length=nres + write (iout,*) chain_length + do j=1,3 + chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1) + chain_rep(j,chain_length+nres,symetr) + &=chain_rep(j,chain_length+nres,1) + enddo +c diagnostic + +c diagnostic +c write (iout,*) "spraw lancuchy",chain_length,symetr +c do i=1,24 +c do kkk=1,chain_length +c write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3) +c enddo +c enddo +c enddiagnostic +C makes copy of chains +c write (iout,*) "symetr", symetr + + if (symetr.gt.1) then + call permut(symetr) + nperm=1 + do i=1,symetr + nperm=nperm*i + enddo +c do i=1,nperm +c write(iout,*) "tabperm", (tabperm(i,kkk),kkk=1,4) +c enddo + do i=1,nperm + cou=0 + do kkk=1,symetr + icha=tabperm(i,kkk) +c write (iout,*) i,icha + do lll=1,chain_length + cou=cou+1 + if (cou.le.nres) then + do j=1,3 + kupa=mod(lll,chain_length) + iprzes=(kkk-1)*chain_length+lll + if (kupa.eq.0) kupa=chain_length +c write (iout,*) "kupa", kupa + cref_pdb(j,iprzes,i)=chain_rep(j,kupa,icha) + cref_pdb(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha) + enddo + endif + enddo enddo + enddo + endif +C-koniec robienia kopidm + do kkk=1,nperm + write (iout,*) "nowa struktura", nperm + do i=1,nres + write (iout,110) restyp(itype(i)),i,cref_pdb(1,i,kkk), + &cref_pdb(2,i,kkk), + &cref_pdb(3,i,kkk),cref_pdb(1,nres+i,kkk), + &cref_pdb(2,nres+i,kkk),cref_pdb(3,nres+i,kkk) + enddo + 100 format (//' alpha-carbon coordinates ', + & ' centroid coordinates'/ + 1 ' ', 6X,'X',11X,'Y',11X,'Z', + & 10X,'X',11X,'Y',11X,'Z') + 110 format (a,'(',i3,')',6f12.5) + enddo ishift_pdb=ishift @@ -155,8 +292,9 @@ C Copy the coordinates to reference coordinates end c--------------------------------------------------------------------------- subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) + implicit none include 'DIMENSIONS' + include 'sizesclu.dat' include 'COMMON.LOCAL' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -166,8 +304,10 @@ c--------------------------------------------------------------------------- include 'COMMON.NAMES' character*3 seq,atom,res character*80 card - dimension sccor(3,20) + double precision sccor(3,20) integer rescode + double precision dist,alpha,beta,di + integer i,j,iti logical lside,lprn if (lprn) then write (iout,'(/a)') @@ -181,17 +321,27 @@ c--------------------------------------------------------------------------- & ' Phi' endif endif - call flush(iout) - do i=nnt+1,nct + do i=2,nres iti=itype(i) -c write (iout,*) i,dist(i,i-1) - if (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0) then +c write (iout,*) i,i-1,(c(j,i),j=1,3),(c(j,i-1),j=1,3),dist(i,i-1) + if (itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1 .and. + & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i stop endif theta(i+1)=alpha(i-1,i,i+1) if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) enddo + if (itype(1).eq.ntyp1) then + do j=1,3 + c(j,1)=c(j,2)+(c(j,3)-c(j,4)) + enddo + endif + if (itype(nres).eq.ntyp1) then + do j=1,3 + c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3)) + enddo + endif if (lside) then do i=2,nres-1 do j=1,3 @@ -205,8 +355,8 @@ c write (iout,*) i,dist(i,i-1) endif if (lprn) & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di,rad2deg*alph(i), - & rad2deg*omeg(i) + & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),di, + & rad2deg*alph(i),rad2deg*omeg(i) enddo else if (lprn) then do i=2,nres @@ -219,10 +369,11 @@ c write (iout,*) i,dist(i,i-1) end c--------------------------------------------------------------------------- subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) + implicit none include 'DIMENSIONS' include 'COMMON.CHAIN' - dimension sccor(3,20) + integer ires,nscat,i,j + double precision sccor(3,20),sccmj do j=1,3 sccmj=0.0D0 do i=1,nscat diff --git a/source/cluster/wham/src-M/readrtns.F b/source/cluster/wham/src-M/readrtns.F index a723920..4e0ee56 100644 --- a/source/cluster/wham/src-M/readrtns.F +++ b/source/cluster/wham/src-M/readrtns.F @@ -15,30 +15,92 @@ C include 'COMMON.FFIELD' include 'COMMON.FREE' include 'COMMON.INTERACT' + include "COMMON.SPLITELE" + include 'COMMON.SHIELD' character*320 controlcard,ucase #ifdef MPL include 'COMMON.INFO' #endif - integer i - + integer i,i1,i2,it1,it2 + double precision pi read (INP,'(a80)') titel call card_concat(controlcard) + energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) + call readi(controlcard,'TORMODE',tor_mode,0) call readi(controlcard,'NRES',nres,0) call readi(controlcard,'RESCALE',rescale_mode,2) call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0) write (iout,*) "DISTCHAINMAX",distchainmax +C Reading the dimensions of box in x,y,z coordinates + call reada(controlcard,'BOXX',boxxsize,100.0d0) + call reada(controlcard,'BOXY',boxysize,100.0d0) + call reada(controlcard,'BOXZ',boxzsize,100.0d0) +c Cutoff range for interactions + call reada(controlcard,"R_CUT",r_cut,15.0d0) + call reada(controlcard,"LAMBDA",rlamb,0.3d0) + call reada(controlcard,"LIPTHICK",lipthick,0.0d0) + call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0) + if (lipthick.gt.0.0d0) then + bordliptop=(boxzsize+lipthick)/2.0 + bordlipbot=bordliptop-lipthick +C endif + if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) + & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE" + buflipbot=bordlipbot+lipbufthick + bufliptop=bordliptop-lipbufthick + if ((lipbufthick*2.0d0).gt.lipthick) + &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF" + endif + write(iout,*) "bordliptop=",bordliptop + write(iout,*) "bordlipbot=",bordlipbot + write(iout,*) "bufliptop=",bufliptop + write(iout,*) "buflipbot=",buflipbot +C Shielding mode + call readi(controlcard,'SHIELD',shield_mode,0) + write (iout,*) "SHIELD MODE",shield_mode + if (shield_mode.gt.0) then + pi=3.141592d0 +C VSolvSphere the volume of solving sphere +C print *,pi,"pi" +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters + VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 + VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 + write (iout,*) VSolvSphere,VSolvSphere_div +C long axis of side chain + do i=1,ntyp + long_r_sidechain(i)=vbldsc0(1,i) + short_r_sidechain(i)=sigma0(i) + enddo + buff_shield=1.0d0 + endif call readi(controlcard,'PDBOUT',outpdb,0) call readi(controlcard,'MOL2OUT',outmol2,0) refstr=(index(controlcard,'REFSTR').gt.0) - write (iout,*) "REFSTR",refstr pdbref=(index(controlcard,'PDBREF').gt.0) + refstr = refstr .or. pdbref + write (iout,*) "REFSTR",refstr," PDBREF",pdbref iscode=index(controlcard,'ONE_LETTER') tree=(index(controlcard,'MAKE_TREE').gt.0) + with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0 + call readi(controlcard,'CONSTR_DIST',constr_dist,0) + write (iout,*) "with_dihed_constr ",with_dihed_constr, + & " CONSTR_DIST",constr_dist + with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0 + write (iout,*) "with_theta_constr ",with_theta_constr + call flush(iout) min_var=(index(controlcard,'MINVAR').gt.0) plot_tree=(index(controlcard,'PLOT_TREE').gt.0) punch_dist=(index(controlcard,'PUNCH_DIST').gt.0) - call readi(controlcard,'NCUT',ncut,1) + call readi(controlcard,'NCUT',ncut,0) + if (ncut.gt.0) then + call multreada(controlcard,'CUTOFF',rcutoff,ncut,-1.0d0) + nclust=0 + else + call readi(controlcard,'NCLUST',nclust,5) + endif call readi(controlcard,'SYM',symetr,1) write (iout,*) 'sym', symetr call readi(controlcard,'NSTART',nstart,0) @@ -49,10 +111,9 @@ C lgrp=(index(controlcard,'LGRP').gt.0) caonly=(index(controlcard,'CA_ONLY').gt.0) print_dist=(index(controlcard,'PRINT_DIST').gt.0) - call multreada(controlcard,'CUTOFF',rcutoff,ncut,-1.0d0) call readi(controlcard,'IOPT',iopt,2) lside = index(controlcard,"SIDE").gt.0 - efree = index(controlcard,"EFREE").gt.0 + lefree = index(controlcard,"EFREE").gt.0 call readi(controlcard,'NTEMP',nT,1) write (iout,*) "nT",nT call multreada(controlcard,'TEMPER',beta_h,nT,300.0d0) @@ -87,16 +148,20 @@ C include 'COMMON.CONTROL' include 'COMMON.CONTACTS' include 'COMMON.TIME1' + include 'COMMON.TORCNSTR' + include 'COMMON.SHIELD' #ifdef MPL include 'COMMON.INFO' #endif character*4 sequence(maxres) - character*800 weightcard + character*800 weightcard,controlcard integer rescode double precision x(maxvar) + double precision phihel,phibet,sigmahel,sigmabet,sumv, + & secprob(3,maxres) integer itype_pdb(maxres) logical seq_comp - integer i,j + integer i,j,kkk,i1,i2,it1,it2 C C Body C @@ -115,6 +180,7 @@ C Read weights of the subsequent energy terms. call reada(weightcard,'WTURN4',wturn4,1.0D0) call reada(weightcard,'WTURN6',wturn6,1.0D0) call reada(weightcard,'WSTRAIN',wstrain,1.0D0) + call reada(weightcard,'WSCCOR',wsccor,1.0D0) call reada(weightcard,'WBOND',wbond,1.0D0) call reada(weightcard,'WTOR',wtor,1.0D0) call reada(weightcard,'WTORD',wtor_d,1.0D0) @@ -125,6 +191,54 @@ C Read weights of the subsequent energy terms. call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) if (index(weightcard,'SOFT').gt.0) ipot=6 + call reada(weightcard,"D0CM",d0cm,3.78d0) + call reada(weightcard,"AKCM",akcm,15.1d0) + call reada(weightcard,"AKTH",akth,11.0d0) + call reada(weightcard,"AKCT",akct,12.0d0) + call reada(weightcard,"V1SS",v1ss,-1.08d0) + call reada(weightcard,"V2SS",v2ss,7.61d0) + call reada(weightcard,"V3SS",v3ss,13.7d0) + call reada(weightcard,"EBR",ebr,-5.50D0) + call reada(weightcard,'WSHIELD',wshield,1.0d0) + write(iout,*) 'WSHIELD',wshield + call reada(weightcard,'WLT',wliptran,0.0D0) + call reada(weightcard,"ATRISS",atriss,0.301D0) + call reada(weightcard,"BTRISS",btriss,0.021D0) + call reada(weightcard,"CTRISS",ctriss,1.001D0) + call reada(weightcard,"DTRISS",dtriss,1.001D0) + write (iout,*) "ATRISS=", atriss + write (iout,*) "BTRISS=", btriss + write (iout,*) "CTRISS=", ctriss + write (iout,*) "DTRISS=", dtriss + dyn_ss=(index(weightcard,'DYN_SS').gt.0) + do i=1,maxres + dyn_ss_mask(i)=.false. + enddo + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo + enddo + call reada(weightcard,"HT",Ht,0.0D0) + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + endif + write (iout,'(/a)') "Disulfide bridge parameters:" + write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr + write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm + write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct + write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, + & ' v3ss:',v3ss + C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,'WCORRH',wcorr,1.0D0) if (wcorr4.gt.0.0d0) wcorr=wcorr4 @@ -146,9 +260,10 @@ C 12/1/95 Added weight for the multi-body term WCORR weights(16)=wvdwpp weights(17)=wbond weights(18)=scal14 + weights(19)=wsccor write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wturn3, - & wturn4,wturn6 + & wturn4,wturn6,wsccor 10 format (/'Energy-term weights (unscaled):'// & 'WSCC= ',f10.6,' (SC-SC)'/ & 'WSCP= ',f10.6,' (SC-p)'/ @@ -166,7 +281,9 @@ C 12/1/95 Added weight for the multi-body term WCORR & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') + & 'WTURN6= ',f10.6,' (turns, 6th order)'/ + & 'WSCCOR= ',f10.6,' (SC-backbone torsinal correalations)') + if (wcorr4.gt.0.0d0) then write (iout,'(/2a/)') 'Local-electrostatic type correlation ', & 'between contact pairs of peptide groups' @@ -190,7 +307,7 @@ C 12/1/95 Added weight for the multi-body term WCORR enddo call flush(iout) - print *,'indpdb=',indpdb,' pdbref=',pdbref +c print *,'indpdb=',indpdb,' pdbref=',pdbref C Read sequence if not taken from the pdb file. if (iscode.gt.0) then @@ -202,20 +319,20 @@ C Convert sequence to numeric code do i=1,nres itype(i)=rescode(i,sequence(i),iscode) enddo - print *,nres - print '(20i4)',(itype(i),i=1,nres) +c print *,nres +c print '(20i4)',(itype(i),i=1,nres) do i=1,nres #ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then #else - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then #endif itel(i)=0 #ifdef PROCOR - else if (itype(i+1).ne.20) then + else if (iabs(itype(i+1)).ne.20) then #else - else if (itype(i).ne.20) then + else if (iabs(itype(i)).ne.20) then #endif itel(i)=1 else @@ -227,17 +344,125 @@ C Convert sequence to numeric code write (iout,*) i,itype(i),itel(i) enddo - print *,'Call Read_Bridge.' +c print *,'Call Read_Bridge.' call read_bridge +C this fragment reads diheadral constrains nnt=1 nct=nres - print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 +c print *,'NNT=',NNT,' NCT=',NCT + if (itype(1).eq.ntyp1) nnt=2 + if (itype(nres).eq.ntyp1) nct=nct-1 if (nstart.lt.nnt) nstart=nnt if (nend.gt.nct .or. nend.eq.0) nend=nct write (iout,*) "nstart",nstart," nend",nend nres0=nres + if (with_dihed_constr) then + + read (inp,*) ndih_constr + if (ndih_constr.gt.0) then + raw_psipred=.false. +C read (inp,*) ftors +C write (iout,*) 'FTORS',ftors +C ftors is the force constant for torsional quartic constrains + read (inp,*) (idih_constr(i),phi0(i),drange(i),ftors(i), + & i=1,ndih_constr) + write (iout,*) + & 'There are',ndih_constr,' constraints on phi angles.' + do i=1,ndih_constr + write (iout,'(i5,3f8.3)') idih_constr(i),phi0(i),drange(i), + & ftors(i) + enddo + do i=1,ndih_constr + phi0(i)=deg2rad*phi0(i) + drange(i)=deg2rad*drange(i) + enddo + else if (ndih_constr.lt.0) then + raw_psipred=.true. + call card_concat(controlcard) + call reada(controlcard,"PHIHEL",phihel,50.0D0) + call reada(controlcard,"PHIBET",phibet,180.0D0) + call reada(controlcard,"SIGMAHEL",sigmahel,30.0d0) + call reada(controlcard,"SIGMABET",sigmabet,40.0d0) + call reada(controlcard,"WDIHC",wdihc,0.591d0) + write (iout,*) "Weight of the dihedral restraint term",wdihc + read(inp,'(9x,3f7.3)') + & (secprob(1,i),secprob(2,i),secprob(3,i),i=nnt,nct) + write (iout,*) "The secprob array" + do i=nnt,nct + write (iout,'(i5,3f8.3)') i,(secprob(j,i),j=1,3) + enddo + ndih_constr=0 + do i=nnt+3,nct + if (itype(i-3).ne.ntyp1 .and. itype(i-2).ne.ntyp1 + & .and. itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1) then + ndih_constr=ndih_constr+1 + idih_constr(ndih_constr)=i + sumv=0.0d0 + do j=1,3 + vpsipred(j,ndih_constr)=secprob(j,i-1)*secprob(j,i-2) + sumv=sumv+vpsipred(j,ndih_constr) + enddo + do j=1,3 + vpsipred(j,ndih_constr)=vpsipred(j,ndih_constr)/sumv + enddo + phibound(1,ndih_constr)=phihel*deg2rad + phibound(2,ndih_constr)=phibet*deg2rad + sdihed(1,ndih_constr)=sigmahel*deg2rad + sdihed(2,ndih_constr)=sigmabet*deg2rad + endif + enddo + write (iout,*) + & 'There are',ndih_constr, + & ' bimodal restraints on gamma angles.' + do i=1,ndih_constr + write(iout,'(i5,1x,a4,i5,1h-,a4,i5,4f8.3,3f10.5)') i, + & restyp(itype(idih_constr(i)-2)),idih_constr(i)-2, + & restyp(itype(idih_constr(i)-1)),idih_constr(i)-1, + & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg, + & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, + & (vpsipred(j,i),j=1,3) + enddo + + endif ! endif ndif_constr.gt.0 + endif ! with_dihed_constr + if (with_theta_constr) then +C with_theta_constr is keyword allowing for occurance of theta constrains + read (inp,*) ntheta_constr +C ntheta_constr is the number of theta constrains + if (ntheta_constr.gt.0) then +C read (inp,*) ftors + read (inp,*) (itheta_constr(i),theta_constr0(i), + & theta_drange(i),for_thet_constr(i), + & i=1,ntheta_constr) +C the above code reads from 1 to ntheta_constr +C itheta_constr(i) residue i for which is theta_constr +C theta_constr0 the global minimum value +C theta_drange is range for which there is no energy penalty +C for_thet_constr is the force constant for quartic energy penalty +C E=k*x**4 +C if(me.eq.king.or..not.out1file)then + write (iout,*) + & 'There are',ntheta_constr,' constraints on phi angles.' + do i=1,ntheta_constr + write (iout,'(i5,3f8.3)') itheta_constr(i),theta_constr0(i), + & theta_drange(i), + & for_thet_constr(i) + enddo +C endif + do i=1,ntheta_constr + theta_constr0(i)=deg2rad*theta_constr0(i) + theta_drange(i)=deg2rad*theta_drange(i) + enddo +C if(me.eq.king.or..not.out1file) +C & write (iout,*) 'FTORS',ftors +C do i=1,ntheta_constr +C ii = itheta_constr(i) +C thetabound(1,ii) = phi0(i)-drange(i) +C thetabound(2,ii) = phi0(i)+drange(i) +C enddo + endif ! ntheta_constr.gt.0 + endif! with_theta_constr + c if (pdbref) then c read(inp,'(a)') pdbfile c write (iout,'(2a)') 'PDB data will be read from file ',pdbfile @@ -299,13 +524,53 @@ c endif nstart_sup=nnt nstart_seq=nnt nsup=nct-nnt+1 + kkk=1 do i=1,2*nres do j=1,3 - cref(j,i)=c(j,i) + cref(j,i,kkk)=c(j,i) enddo enddo endif - call contact(.true.,ncont_ref,icont_ref) +c call contact(.true.,ncont_ref,icont_ref) + endif + if (ns.gt.0) then +C write (iout,'(/a,i3,a)') +C & 'The chain contains',ns,' disulfide-bridging cysteines.' + write (iout,'(20i4)') (iss(i),i=1,ns) + if (dyn_ss) then + write(iout,*)"Running with dynamic disulfide-bond formation" + else + write (iout,'(/a/)') 'Pre-formed links are:' + do i=1,nss + i1=ihpb(i)-nres + i2=jhpb(i)-nres + it1=itype(i1) + it2=itype(i2) + write (iout,'(2a,i3,3a,i3,a,3f10.3)') + & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), + & ebr,forcon(i) + enddo + write (iout,'(a)') + endif + endif + if (ns.gt.0.and.dyn_ss) then + do i=nss+1,nhpb + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. + enddo + endif +c Read distance restraints + if (constr_dist.gt.0) then + call read_dist_constr + call hpb_partition endif return end @@ -346,15 +611,17 @@ C Read information about disulfide bridges. integer i,j C Read bridging residues. read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns +c print *,'ns=',ns C Check whether the specified bridging residues are cystines. do i=1,ns - if (itype(iss(i)).ne.1) then + if (iabs(itype(iss(i))).ne.1) then write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' #ifdef MPL call mp_stopall(error_msg) @@ -395,8 +662,8 @@ C bridging residues. enddo write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' 20 continue - dhpb(i)=dbr - forcon(i)=fbr +C dhpb(i)=dbr +C forcon(i)=fbr enddo do i=1,nss ihpb(i)=ihpb(i)+nres @@ -477,6 +744,25 @@ c---------------------------------------------------------------------------- read (rekord(iread:),*) wartosc return end +C---------------------------------------------------------------------- + subroutine multreadi(rekord,lancuch,tablica,dim,default) + implicit none + integer dim,i + integer tablica(dim),default + character*(*) rekord,lancuch + character*80 aux + integer ilen,iread + external ilen + do i=1,dim + tablica(i)=default + enddo + iread=index(rekord,lancuch(:ilen(lancuch))//"=") + if (iread.eq.0) return + iread=iread+ilen(lancuch)+1 + read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) + 10 return + end + c---------------------------------------------------------------------------- subroutine card_concat(card) include 'DIMENSIONS' @@ -556,8 +842,10 @@ C Get parameter filenames and open the parameter files. open (irotam,file=rotname,status='old') call getenv('TORPAR',torname) open (itorp,file=torname,status='old') +#ifndef NEWCORR call getenv('TORDPAR',tordname) open (itordp,file=tordname,status='old') +#endif call getenv('FOURIER',fouriername) open (ifourier,file=fouriername,status='old') call getenv('ELEPAR',elename) @@ -568,6 +856,8 @@ C Get parameter filenames and open the parameter files. open (isidep1,file=sidepname,status="old") call getenv('SCCORPAR',sccorname) open (isccor,file=sccorname,status="old") + call getenv('LIPTRANPAR',liptranname) + open (iliptranpar,file=liptranname,status='old') #ifndef OLDSCP C C 8/9/01 In the newest version SCp interaction constants are read from a file @@ -578,3 +868,163 @@ C #endif return end +c-------------------------------------------------------------------------- + subroutine read_dist_constr + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.SBRIDGE' + integer ifrag_(2,100),ipair_(2,100) + double precision wfrag_(100),wpair_(100) + character*500 controlcard + logical normalize + logical lprn /.true./ + write (iout,*) "Calling read_dist_constr" +C write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup +C call flush(iout) + write(iout,*) "TU sie wywalam?" + call card_concat(controlcard) + write (iout,*) controlcard + call flush(iout) + call readi(controlcard,"NFRAG",nfrag_,0) + call readi(controlcard,"NPAIR",npair_,0) + call readi(controlcard,"NDIST",ndist_,0) + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) + call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) + call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) + call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) + call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) + normalize = index(controlcard,"NORMALIZE").gt.0 + write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ + write (iout,*) "IFRAG" + do i=1,nfrag_ + write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) + enddo + write (iout,*) "IPAIR" + do i=1,npair_ + write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) + enddo + call flush(iout) + do i=1,nfrag_ + if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup + if (ifrag_(2,i).gt.nstart_sup+nsup-1) + & ifrag_(2,i)=nstart_sup+nsup-1 +c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) + call flush(iout) + if (wfrag_(i).gt.0.0d0) then + do j=ifrag_(1,i),ifrag_(2,i)-1 + do k=j+1,ifrag_(2,i) + write (iout,*) "j",j," k",k + ddjk=dist(j,k) + if (constr_dist.eq.1) then + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i) + else if (constr_dist.eq.2) then + if (ddjk.le.dist_cut) then + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i) + endif + else + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) + endif + if (lprn) + & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) + enddo + enddo + endif + enddo + do i=1,npair_ + if (wpair_(i).gt.0.0d0) then + ii = ipair_(1,i) + jj = ipair_(2,i) + if (ii.gt.jj) then + itemp=ii + ii=jj + jj=itemp + endif + do j=ifrag_(1,ii),ifrag_(2,ii) + do k=ifrag_(1,jj),ifrag_(2,jj) + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + forcon(nhpb)=wpair_(i) + dhpb(nhpb)=dist(j,k) + write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) + enddo + enddo + endif + enddo + write (iout,*) "Distance restraints as read from input" + do i=1,ndist_ + if (constr_dist.eq.11) then + read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), + & ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1) +c fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1) + if (forcon(nhpb+1).le.0.0d0.or.fordepth(nhpb+1).le.0.0d0)cycle + nhpb=nhpb+1 + write (iout,'(a,4i5,2f8.2,2f10.5)') "+dist.restr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), + & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb) + if (ibecarb(i).gt.0) then + ihpb(i)=ihpb(i)+nres + jhpb(i)=jhpb(i)+nres + endif + else +C print *,"in else" + read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), + & ibecarb(i),forcon(nhpb+1) + if (forcon(nhpb+1).gt.0.0d0) then + nhpb=nhpb+1 + if (ibecarb(i).gt.0) then + ihpb(i)=ihpb(i)+nres + jhpb(i)=jhpb(i)+nres + endif + if (dhpb(nhpb).eq.0.0d0) + & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) + endif + write (iout,'(a,4i5,f8.2,f10.1)') "+dist.restr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(i),dhpb(nhpb),forcon(nhpb) + endif +C read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1) +C if (forcon(nhpb+1).gt.0.0d0) then +C nhpb=nhpb+1 +C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) + enddo + if (constr_dist.eq.11 .and. normalize) then + fordepthmax=fordepth(1) + do i=2,nhpb + if (fordepth(i).gt.fordepthmax) fordepthmax=fordepth(i) + enddo + do i=1,nhpb + fordepth(i)=fordepth(i)/fordepthmax + enddo + write (iout,'(/a/4a5,2a8,2a10)') + & "Normalized Lorenzian-like distance restraints", + & " Nr"," res1"," res2"," beta"," d1"," d2"," k"," V" + do i=1,nhpb + write (iout,'(4i5,2f8.2,2f10.5)')i,ihpb(i),jhpb(i),ibecarb(i), + & dhpb(i),dhpb1(i),forcon(i),fordepth(i) + enddo + endif + write (iout,*) + call hpb_partition + call flush(iout) + return + end diff --git a/source/cluster/wham/src-M/rescode.f b/source/cluster/wham/src-M/rescode.f index ca0305c..fb68350 100644 --- a/source/cluster/wham/src-M/rescode.f +++ b/source/cluster/wham/src-M/rescode.f @@ -6,7 +6,7 @@ if (itype.eq.0) then - do i=1,ntyp1 + do i=-ntyp1,ntyp1 if (ucase(nam).eq.restyp(i)) then rescode=i return @@ -15,7 +15,7 @@ else - do i=1,ntyp1 + do i=-ntyp1,ntyp1 if (nam(1:1).eq.onelet(i)) then rescode=i return diff --git a/source/cluster/wham/src-M/sizesclu.dat b/source/cluster/wham/src-M/sizesclu.dat index 1810f0c..7d0d666 100644 --- a/source/cluster/wham/src-M/sizesclu.dat +++ b/source/cluster/wham/src-M/sizesclu.dat @@ -5,7 +5,7 @@ * Max. number of conformations in the data set. * integer maxconf,maxstr_proc - PARAMETER (MAXCONF=13000) + PARAMETER (MAXCONF=8000) parameter (maxstr_proc=maxconf/2) * * Max. number of "distances" between conformations. diff --git a/source/cluster/wham/src-M/srtclust.f b/source/cluster/wham/src-M/srtclust.f index fc1b8f8..5d8b064 100644 --- a/source/cluster/wham/src-M/srtclust.f +++ b/source/cluster/wham/src-M/srtclust.f @@ -65,7 +65,30 @@ C ENDIF 72 CONTINUE 71 CONTINUE - write (iout,'("Free energies and probabilities of clusters at", + DO 81 IGR=1,NGR + LI=LICZ(IGR) + DO 82 I=1,LI + 82 IASS(NCONF(IGR,I))=IGR + 81 CONTINUE + if (lgrp) then + do i=1,ncon + iass_tot(i,icut)=iass(i) +c write (iout,*) icut,i,iass(i),iass_tot(i,icut) + enddo + endif + return + end +c---------------------------------------------------------------------- + SUBROUTINE WRITE_STATS(ICUT,NCON,IB) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'sizesclu.dat' + include 'COMMON.CLUSTER' + include 'COMMON.FREE' + include 'COMMON.IOUNITS' + double precision prob(maxgr) + write (iout, + & '("Free energies, probabilities and rmsds of clusters at", & f6.1," K")') 1.0d0/(1.987d-3*beta_h(ib)) prob(1)=1.0d0 sumprob=1.0d0 @@ -77,22 +100,18 @@ C prob(i)=prob(i)/sumprob enddo sumprob=0.0d0 - write (iout,'("clust efree prob sumprob")') + write(iout,'(/7x,4a20)') " RMSD","TMscore","GDT_TS","GDT_HA" + write(iout,'(a5,2x,a6,10a10)')"clust","efree","cl.ave.", + & "ave.str.", + & "cl.ave.","ave.str","cl.ave","ave.str.","cl.ave","ave.str.", + & "prob","sumprob" do i=1,ngr sumprob=sumprob+prob(i) - write (iout,'(i5,f8.1,2f8.5)') i,totfree_gr(i)/beta_h(ib), - & prob(i),sumprob + write (iout,'(i3,2x,f8.1,2f10.3,6f10.4,2f10.4)') + & i,totfree_gr(i)/beta_h(ib), + & rmsave(i),rms_closest(i),tmscore_ave(i),tmscore_closest(i), + & gdt_ts_ave(i),gdt_ts_closest(i),gdt_ha_ave(i), + & gdt_ha_closest(i),prob(i),sumprob enddo - DO 81 IGR=1,NGR - LI=LICZ(IGR) - DO 82 I=1,LI - 82 IASS(NCONF(IGR,I))=IGR - 81 CONTINUE - if (lgrp) then - do i=1,ncon - iass_tot(i,icut)=iass(i) -c write (iout,*) icut,i,iass(i),iass_tot(i,icut) - enddo - endif RETURN END diff --git a/source/cluster/wham/src-M/work_partition.F b/source/cluster/wham/src-M/work_partition.F index e31db53..f29b01f 100644 --- a/source/cluster/wham/src-M/work_partition.F +++ b/source/cluster/wham/src-M/work_partition.F @@ -74,12 +74,13 @@ c print *,"N",n," NCON_WORK",ncon_work if (lprint) then write (iout,*) "Partition of work between processors" - do i=0,nprocs-1 - write (iout,'(a,i5,a,i7,a,i7,a,i7)') - & "Processor",i," indstart",indstart(i), - & " indend",indend(i)," count",scount(i) - enddo - endif +C do i=0,nprocs-1 +C write (iout,'(a,i5,a,i7,a,i7,a,i7)') +C & "Processor",i," indstart",indstart(i), +C & " indend",indend(i)," count",scount(i) +C enddo + endif +c write(iout,*) "just before leave" return end #endif diff --git a/source/cluster/wham/src-M/wrtclust.f b/source/cluster/wham/src-M/wrtclust.f index f2f3eb7..5460eb6 100644 --- a/source/cluster/wham/src-M/wrtclust.f +++ b/source/cluster/wham/src-M/wrtclust.f @@ -14,7 +14,6 @@ include 'COMMON.GEO' include 'COMMON.FREE' include 'COMMON.TEMPFAC' - double precision rmsave(maxgr) CHARACTER*64 prefixp,NUMM,MUMM,EXTEN,extmol character*80 cfname character*8 ctemper @@ -84,6 +83,7 @@ C 12/8/93 Estimation of "diameters" of the subsequent families. ave_dim=0.0 amax_dim=0.0 c write (iout,*) "ecut",ecut + emin=totfree(nconf(igr,1)) do i=2,licz(igr) ii=nconf(igr,i) if (totfree(ii)-emin .gt. ecut) goto 10 @@ -111,15 +111,29 @@ c & list_conf(jj),curr_dist & 'Max. distance in the family:',amax_dim, & '; average distance in the family:',ave_dim rmsave(igr)=0.0d0 + gdt_ts_ave(igr)=0.0d0 + gdt_ha_ave(igr)=0.0d0 + tmscore_ave(igr)=0.0d0 qpart=0.0d0 + e1=totfree(nconf(igr,1)) do i=1,licz(igr) icon=nconf(igr,i) - boltz=dexp(-totfree(icon)) + boltz=dexp(-(totfree(icon)-e1)) rmsave(igr)=rmsave(igr)+boltz*rmstb(icon) + gdt_ts_ave(igr)=gdt_ts_ave(igr)+boltz*gdt_ts_tb(icon) + gdt_ha_ave(igr)=gdt_ha_ave(igr)+boltz*gdt_ha_tb(icon) + tmscore_ave(igr)=tmscore_ave(igr)+boltz*tmscore_tb(icon) qpart=qpart+boltz enddo rmsave(igr)=rmsave(igr)/qpart - write (iout,'(a,f5.2,a)') "Average RMSD",rmsave(igr)," A" + gdt_ts_ave(igr)=gdt_ts_ave(igr)/qpart + gdt_ha_ave(igr)=gdt_ha_ave(igr)/qpart + tmscore_ave(igr)=tmscore_ave(igr)/qpart + write (iout,'(a,f5.2,a,3(a,f7.4))') "Cluster averages: RMSD", + & rmsave(igr)," A, ", + & "TMscore",tmscore_ave(igr), + & ", GDT_TS",gdt_ts_ave(igr),", GDT_HA", + & gdt_ha_ave(igr) 19 CONTINUE WRITE (iout,400) WRITE (iout,500) (list_conf(I),IASS(I),I=1,NCON) @@ -191,7 +205,7 @@ c Write conformations of the family i to PDB files c write (iout,*) i,ncon_out,nconf(i,ncon_out), c & totfree(nconf(i,ncon_out)),emin1,ecut enddo - write (iout,*) "ncon_out",ncon_out +c write (iout,*) "ncon_out",ncon_out call flush(iout) do j=1,nres tempfac(1,j)=5.0d0 @@ -204,6 +218,7 @@ c & totfree(nconf(i,ncon_out)),emin1,ecut c(k,ii)=allcart(k,ii,icon) enddo enddo + call center call pdbout(totfree(icon)/beta_h(ib),rmstb(icon),titel) write (ipdb,'("TER")') enddo @@ -215,10 +230,19 @@ c Average structures and structures closest to average & position="APPEND") call ave_coord(i) write (ipdb,'(a,i5)') "REMARK CLUSTER",i + call center call pdbout(totfree_gr(i)/beta_h(ib),rmsave(i),titel) write (ipdb,'("TER")') call closest_coord(i) - call pdbout(totfree_gr(i)/beta_h(ib),rmsave(i),titel) +c write (iout,*) "Calling rmsnat" + rms_closest(i) = rmsnat(i) + call TMscore_sub(rmsd,gdt_ts_closest(i),gdt_ha_closest(i), + & tmscore_closest(i),cfname,.true.) +c write (iout,*) "Family",i," rmsd",rmsd,"gdt_ts", +c & gdt_ts_closest(i)," gdt_ha",gdt_ha_closest(i), +c & "tmscore",tmscore_closest(i) + call center + call pdbout(totfree_gr(i)/beta_h(ib),rms_closest(i),titel) write (ipdb,'("TER")') close (ipdb) I=I+1 @@ -259,6 +283,7 @@ c create InsightII command file for their displaying in different colors emin1=totfree(icon) ENDDO ENDIF + call WRITE_STATS(ICUT,NCON,IB) 100 FORMAT (//'THERE ARE ',I4,' FAMILIES OF CONFORMATIONS') 200 FORMAT (/'FAMILY ',I4,' WITH TOTAL FREE ENERGY',1pE15.5, & ' CONTAINS ',I4,' CONFORMATION(S): ') @@ -443,3 +468,32 @@ c write (iout,*) "rmsmin",rmsmin," rms",rms enddo return end +c------------------------------------------------------------------------------ + subroutine center + implicit none + include 'DIMENSIONS' + include 'sizesclu.dat' + include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' + include 'COMMON.CLUSTER' + include 'COMMON.CHAIN' + include 'COMMON.INTERACT' + include 'COMMON.VAR' + double precision przes(3) + integer i,ii,j,k,icon,jcon,jconmin,igr + przes=0.0d0 + do j=1,3 + do i=1,nres + przes(j)=przes(j)+c(j,i) + enddo + enddo + do j=1,3 + przes(j)=przes(j)/nres + enddo + do i=1,2*nres + do j=1,3 + c(j,i)=c(j,i)-przes(j) + enddo + enddo + return + end diff --git a/source/cluster/wham/src-M/xdrf/Makefile b/source/cluster/wham/src-M/xdrf/Makefile deleted file mode 100644 index 02c29f6..0000000 --- a/source/cluster/wham/src-M/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = gcc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/cluster/wham/src-M/xdrf/Makefile_jubl b/source/cluster/wham/src-M/xdrf/Makefile_jubl deleted file mode 100644 index 8dc35cf..0000000 --- a/source/cluster/wham/src-M/xdrf/Makefile_jubl +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc - -CFLAGS= -O2 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f *.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/cluster/wham/src-M/xdrf/Makefile_linux b/source/cluster/wham/src-M/xdrf/Makefile_linux deleted file mode 100644 index f03276e..0000000 --- a/source/cluster/wham/src-M/xdrf/Makefile_linux +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/cluster/wham/src-M/xdrf/RS6K.m4 b/source/cluster/wham/src-M/xdrf/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/cluster/wham/src-M/xdrf/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/cluster/wham/src-M/xdrf/ftocstr.c b/source/cluster/wham/src-M/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/cluster/wham/src-M/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/cluster/wham/src-M/xdrf/libxdrf.m4 b/source/cluster/wham/src-M/xdrf/libxdrf.m4 deleted file mode 100644 index a6da458..0000000 --- a/source/cluster/wham/src-M/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1238 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "w+"; - lmode = XDR_ENCODE; - } else if (*type == 'a' || *type == 'A') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/cluster/wham/src-M/xdrf/types.h b/source/cluster/wham/src-M/xdrf/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/cluster/wham/src-M/xdrf/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/cluster/wham/src-M/xdrf/underscore.m4 b/source/cluster/wham/src-M/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/cluster/wham/src-M/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/cluster/wham/src-M/xdrf/xdr.c b/source/cluster/wham/src-M/xdrf/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/cluster/wham/src-M/xdrf/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/cluster/wham/src-M/xdrf/xdr.h b/source/cluster/wham/src-M/xdrf/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/cluster/wham/src-M/xdrf/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/cluster/wham/src-M/xdrf/xdr_array.c b/source/cluster/wham/src-M/xdrf/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/cluster/wham/src-M/xdrf/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/cluster/wham/src-M/xdrf/xdr_float.c b/source/cluster/wham/src-M/xdrf/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/cluster/wham/src-M/xdrf/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/cluster/wham/src-M/xdrf/xdr_stdio.c b/source/cluster/wham/src-M/xdrf/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/cluster/wham/src-M/xdrf/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/cluster/wham/src-M/xdrf/xdrf.h b/source/cluster/wham/src-M/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/cluster/wham/src-M/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/cluster/wham/src/CMakeLists.txt b/source/cluster/wham/src/CMakeLists.txt index 17a7ef6..e20baf4 100644 --- a/source/cluster/wham/src/CMakeLists.txt +++ b/source/cluster/wham/src/CMakeLists.txt @@ -28,6 +28,7 @@ set(UNRES_CLUSTER_WHAM_SRC0 noyes.f parmread.F pinorm.f + printmat.f probabl.F read_coords.F readpdb.f @@ -35,6 +36,7 @@ set(UNRES_CLUSTER_WHAM_SRC0 rescode.f setup_var.f srtclust.f + ssMD.F timing.F track.F wrtclust.f @@ -50,6 +52,7 @@ set(UNRES_CLUSTER_WHAM_PP_SRC probabl.F read_coords.F readrtns.F + ssMD.F timing.F track.F work_partition.F @@ -57,23 +60,52 @@ set(UNRES_CLUSTER_WHAM_PP_SRC #================================================ -# Set comipiler flags for different sourcefiles +# Set compiler flags for different sourcefiles #================================================ if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) + set(FFLAGS0 "-mcmodel=medium -shared-intel -ip -w -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 "-std=legacy -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) + set(FFLAGS0 "-std=legacy -mcmodel=medium -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) +elseif (Fortran_COMPILER_NAME STREQUAL "pgf90") + set(FFLAGS0 "-mcmodel=medium -Mlarge_arrays -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) +else () + set(FFLAGS0 "-mcmodel=medium -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres " ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") +#========================================= # Add MPI compiler flags +#========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_CLUSTER_WHAM_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) -set(CPPFLAGS "PROCOR -DSPLITELE -DPROCOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) +#========================================= +# Settings for GAB force field +#========================================= +if(UNRES_MD_FF STREQUAL "GAB" ) + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) + +#========================================= +# Settings for E0LL2Y force field +#========================================= +elseif(UNRES_MD_FF STREQUAL "E0LL2Y") + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DSCCORPDB" ) +elseif(UNRES_MD_FF STREQUAL "4P") + set(CPPFLAGS "SPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) +endif(UNRES_MD_FF STREQUAL "GAB") +#========================================= +# Additional flags +#========================================= +set(CPPFLAGS "${CPPFLAGS} -DUNRES -DISNAN -DCLUST" ) + +#========================================= +# Compiler specific flags +#========================================= if (Fortran_COMPILER_NAME STREQUAL "ifort") # Add ifort preprocessor flags set(CPPFLAGS "${CPPFLAGS} -DPGI") @@ -83,6 +115,11 @@ elseif (Fortran_COMPILER_NAME STREQUAL "f95") elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") # Add old gfortran flags set(CPPFLAGS "${CPPFLAGS} -DG77") +elseif (Fortran_COMPILER_NAME STREQUAL "pgf90") + set(CPPFLAGS "${CPPFLAGS} -DPGI") + FILE(COPY ${CMAKE_SOURCE_DIR}/source/lib/isnan_pgi.f DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + list(APPEND UNRES_CLUSTER_WHAM_SRC0 ${CMAKE_CURRENT_BINARY_DIR}/isnan_pgi.f) + set(CMAKE_EXE_LINKER_FLAGS "-Bdynamic") endif (Fortran_COMPILER_NAME STREQUAL "ifort") @@ -110,132 +147,119 @@ set_property(SOURCE ${UNRES_CLUSTER_WHAM_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${ #======================================== # Setting binary name #======================================== -set(UNRES_CLUSTER_WHAM_BIN "unres_clustMD.exe") - -#========================================= -# cinfo.f stupid workaround for cmake -# - shame on me ]:) -#========================================= -#set_property(SOURCE compinfo.c PROPERTY CMAKE_C_FLAGS "-c" ) -#add_executable(compinfo-wham-m compinfo.c) -#set_target_properties(compinfo-wham-m PROPERTIES OUTPUT_NAME compinfo) - -#set(UNRES_CINFO_DIR "${CMAKE_CURRENT_BINARY_DIR}" ) -#add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/cinfo.f ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_CURRENT_SOURCE_DIR}/COMMON.IOUNITS ${CMAKE_CURRENT_BINARY_DIR}/COMMON.IOUNITS -# COMMAND ${CMAKE_CURRENT_BINARY_DIR}/compinfo | true -# DEPENDS compinfo-wham-m ) -#set_property(SOURCE ${UNRES_CINFO_DIR}/cinfo.f PROPERTY COMPILE_FLAGS ${FFLAGS0} ) +set(UNRES_CLUSTER_WHAM_BIN "cluster_wham_${Fortran_COMPILER_NAME}_MPI_${UNRES_MD_FF}.exe") set_property(SOURCE proc_proc.c PROPERTY COMPILE_DEFINITIONS "LINUX -DPGI" ) - - #========================================= # Set full unres CLUSTER sources #========================================= set(UNRES_CLUSTER_WHAM_SRCS ${UNRES_CLUSTER_WHAM_SRC0} proc_proc.c) - - #========================================= # Build the binary #========================================= add_executable(UNRES_CLUSTER_WHAM_BIN ${UNRES_CLUSTER_WHAM_SRCS} ) set_target_properties(UNRES_CLUSTER_WHAM_BIN PROPERTIES OUTPUT_NAME ${UNRES_CLUSTER_WHAM_BIN}) +set_property(TARGET UNRES_CLUSTER_WHAM_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #========================================= # Link libraries #========================================= -# link MPI library (libmpich.a) +# link MPI libraries if(UNRES_WITH_MPI) - target_link_libraries( UNRES_CLUSTER_WHAM_BIN ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_CLUSTER_WHAM_BIN ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a target_link_libraries( UNRES_CLUSTER_WHAM_BIN xdrf ) #========================================= -# TESTS +# Install Path #========================================= +install(TARGETS UNRES_CLUSTER_WHAM_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}/cluster) -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) - -#========================================= -# Generate data test files #========================================= -# test_single_ala.sh +# TESTS #========================================= -#FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh -#"#!/bin/sh -#export POT=GB -#export PREFIX=ala10 +# MESSAGE (STATUS "${MPI_Fortran_LIBRARIES}") + if ("${MPI_Fortran_LIBRARIES}" MATCHES "lam") + MESSAGE (STATUS "LAM MPI library detected") + set (boot_lam "-boot") + else() + set (boot_lam "") + endif() + + if (UNRES_SRUN) + set (np "-n") + set (mpiexec "srun") + elseif(UNRES_MPIRUN) + set (np "-np") + set (mpiexec "mpirun") + else() + set (np "-np") + set (mpiexec "mpiexec") + endif() + +FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/cluster_wham_mpi_E0LL2Y.sh +"#!/bin/sh +export POT=GB +export INPUT=$1 +export INTIN=1L2Y_wham +export OUTPUT=1L2Y_clust +export PDB=CART +export COORD=CX +export PRINTCOOR=PRINT_PDB #----------------------------------------------------------------------------- -#UNRES_BIN=./${UNRES_BIN} +CLUSTER_WHAM_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_CLUSTER_WHAM_BIN} #----------------------------------------------------------------------------- -#DD=${CMAKE_SOURCE_DIR}/PARAM -#export BONDPAR=$DD/bond.parm -#export THETPAR=$DD/thetaml.5parm -#export ROTPAR=$DD/scgauss.parm -#export TORPAR=$DD/torsion_631Gdp.parm -#export TORDPAR=$DD/torsion_double_631Gdp.parm -#export ELEPAR=$DD/electr_631Gdp.parm -#export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k -#export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 -#export SCPPAR=$DD/scp.parm -#export SCCORPAR=$DD/rotcorr_AM1.parm -#export PATTERN=$DD/patterns.cart +DD=${CMAKE_SOURCE_DIR}/PARAM +export BONDPAR=$DD/bond_AM1.parm +export THETPAR=$DD/theta_abinitio.parm +export ROTPAR=$DD/rotamers_AM1_aura.10022007.parm +export TORPAR=$DD/torsion_631Gdp.parm +export TORDPAR=$DD/torsion_double_631Gdp.parm +export ELEPAR=$DD/electr_631Gdp.parm +export SIDEPAR=$DD/scinter_$POT.parm +export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +export SCPPAR=$DD/scp.parm +export SCCORPAR=$DD/sccor_am1_pawel.dat +export THETPARPDB=$DD/thetaml.5parm +export ROTPARPDB=$DD/scgauss.parm +export PATTERN=$DD/patterns.cart +export CONTFUNC=GB +export SIDEP=$DD/contact.3.parm +export SCRATCHDIR=. #----------------------------------------------------------------------------- -#$UNRES_BIN -#") +echo CTEST_FULL_OUTPUT +${mpiexec} ${boot_lam} ${np} $2 $CLUSTER_WHAM_BIN +./cluster_wham_check.sh $1 +") -#========================================= -# ala10.inp -#========================================= +# +# File permissions workaround +# +FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/cluster_wham_mpi_E0LL2Y.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) -#file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp -#"ala10 unblocked -#SEED=-1111333 MD ONE_LETTER rescale_mode=2 PDBOUT -#nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & -#reset_moment=1000 reset_vel=1000 MDPDB -#WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & -#WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & -#WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & -#WVDWPP=0.11371 WHPB=1.00000 & -#CUTOFF=7.00000 WCORR4=0.00000 -#12 -#XAAAAAAAAAAX -# 0 -# 0 -# 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 -# 90.0000 90.0000 -# 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 -# 180.0000 -# 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 -# 110.0000 110.0000 -# -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 -# -120.0000 -120.0000 -#") +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/cluster_wham_check.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_clust.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) -# Add tests +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_wham.cx + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) -#if(NOT UNRES_WITH_MPI) +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) -# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) -#endif(NOT UNRES_WITH_MPI) +if(UNRES_MD_FF STREQUAL "E0LL2Y") + add_test(NAME CLUSTER_WHAM_remd COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/cluster_wham_mpi_E0LL2Y.sh 1L2Y_clust 2 ) +endif(UNRES_MD_FF STREQUAL "E0LL2Y") diff --git a/source/cluster/wham/src/COMMON.CLUSTER b/source/cluster/wham/src/COMMON.CLUSTER index 4477d19..f1ad0fd 100644 --- a/source/cluster/wham/src/COMMON.CLUSTER +++ b/source/cluster/wham/src/COMMON.CLUSTER @@ -4,11 +4,11 @@ real*4 diss,allcart double precision enetb,entfac,totfree,energy,rmstb integer ncut,ngr,licz,nconf,iass,icc,mult,list_conf, - & nss_all,ihpb_all,jhpb_all,iass_tot,iscore,nprop + & nss_all,ihpb_all,jhpb_all,iass_tot,iscore,nprop,nclust common /clu/ diss(maxdist),energy(0:maxconf), & enetb(max_ene,maxstr_proc),ecut, & entfac(maxconf),totfree(0:maxconf),totfree_gr(maxgr), - & rcutoff(max_cut+1),ncut,min_var,tree,plot_tree,lgrp + & rcutoff(max_cut+1),ncut,nclust,min_var,tree,plot_tree,lgrp common /clu1/ ngr,licz(maxgr),nconf(maxgr,maxingr),iass(maxgr), & iass_tot(maxgr,max_cut),list_conf(maxconf) common /alles/ allcart(3,maxres2,maxstr_proc),rmstb(maxconf), diff --git a/source/cluster/wham/src/COMMON.CONTROL b/source/cluster/wham/src/COMMON.CONTROL index 8c9e317..9549576 100644 --- a/source/cluster/wham/src/COMMON.CONTROL +++ b/source/cluster/wham/src/COMMON.CONTROL @@ -2,8 +2,10 @@ integer iscode,indpdb,outpdb,outmol2,iopt,nstart,nend,constr_dist logical refstr,pdbref,punch_dist,print_dist,caonly,lside, & lprint_cart,lprint_int,from_cart,efree,from_bx,from_cx, - & with_dihed_constr + & with_dihed_constr, + & print_contact_map common /cntrl/ betaT,iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_dist,caonly,lside,lprint_cart,lprint_int, & from_cart,from_bx,from_cx,efree,iopt,nstart,nend,constr_dist, - & with_dihed_constr + & with_dihed_constr, + & print_contact_map diff --git a/source/cluster/wham/src/COMMON.SCCOR b/source/cluster/wham/src/COMMON.SCCOR index 1991570..b0ec6f3 100644 --- a/source/cluster/wham/src/COMMON.SCCOR +++ b/source/cluster/wham/src/COMMON.SCCOR @@ -6,7 +6,7 @@ cc Parameters of the SCCOR term integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor common/sccor/v1sccor(maxterm_sccor,3,20,20), & v2sccor(maxterm_sccor,3,20,20), - & v0sccor(20,20), + & v0sccor(ntyp,ntyp), & vlor1sccor(maxterm_sccor,20,20), & vlor2sccor(maxterm_sccor,20,20), & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), diff --git a/source/cluster/wham/src/DIMENSIONS b/source/cluster/wham/src/DIMENSIONS index 50c38b4..c53aeb2 100644 --- a/source/cluster/wham/src/DIMENSIONS +++ b/source/cluster/wham/src/DIMENSIONS @@ -9,7 +9,7 @@ C Max. number of processors. parameter (maxprocs=16) C Max. number of AA residues integer maxres,maxres2 - parameter (maxres=650) + parameter (maxres=800) C Appr. max. number of interaction sites parameter (maxres2=2*maxres) C Max. number of variables @@ -49,7 +49,7 @@ C Max. number of lobes in SC distribution parameter (maxlob=4) C Max. number of S-S bridges integer maxss - parameter (maxss=1000) + parameter (maxss=20) C Max. number of dihedral angle constraints integer maxdih_constr parameter (maxdih_constr=maxres) diff --git a/source/cluster/wham/src/Makefile-MPICH-ifort b/source/cluster/wham/src/Makefile-MPICH-ifort index 624e253..9f015d5 100644 --- a/source/cluster/wham/src/Makefile-MPICH-ifort +++ b/source/cluster/wham/src/Makefile-MPICH-ifort @@ -1,11 +1,8 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN=../../../../bin/cluster -FC = ifort -OPT = -O3 -ip -w -#OPT = -CB -g +INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 +FC = /opt/cray/craype/2.5.3/bin/ftn +OPT = -O3 -ip -w -mcmodel=medium -dynamic FFLAGS = ${OPT} -c -I. -Iinclude_unres -I$(INSTALL_DIR)/include -CPPFLAGS = -DLINUX -DPGI -DSPLITELE -DPROCOR -DMP -DMPI -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .c.o: cc -c -DLINUX -DPGI $*.c @@ -21,23 +18,39 @@ objects = main_clust.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o geomout.o readpdb.o read_coords.o parmread.o probabl.o fitsq.o hc.o \ track.o wrtclust.o srtclust.o noyes.o contact.o printmat.o \ int_from_cart1.o energy_p_new.o icant.o proc_proc.o work_partition.o \ - setup_var.o read_ref_str.o gnmr1.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: $(objects) xdrf/libxdrf.a - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPICH-GAB.exe - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: $(objects) xdrf/libxdrf.a - $(FC) ${OPT} ${objects} ${LIBS} -o ${BIN}/unres_clustMD_MPICH-E0LL2Y.exe - -xdrf/libxdrf.a: - cd xdrf && make - + setup_var.o read_ref_str.o gnmr1.o ssMD.o + +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_GAB.exe +GAB: ${objects} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} cinfo.o ${LIBS} -o ${BIN} + +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DCLUST -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_4P.exe +4P: ${objects} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DPROCOR \ + -DCLUST -DSPLITELE -DLANG0 +E0LL2Y: BIN = ~/bin/unres_clustMD-mult_ifort_MPICH_E0LL2Y.exe +E0LL2Y: ${objects} xdrf/libxdrf.a + gcc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} cinfo.o ${LIBS} -o ${BIN} clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - + /bin/rm *.o +move: + mv *.o ${OBJ} diff --git a/source/cluster/wham/src/arcos.f b/source/cluster/wham/src/arcos.f index 052a1e4..698f704 100644 --- a/source/cluster/wham/src/arcos.f +++ b/source/cluster/wham/src/arcos.f @@ -2,7 +2,7 @@ implicit real*8 (a-h,o-z) include 'COMMON.GEO' IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=0.5D0*(PI+DSIGN(X,1.0D0)*PI) + ARCOS=0.5D0*(PI-DSIGN(X,1.0D0)*PI) RETURN 1 ARCOS=DACOS(X) RETURN diff --git a/source/cluster/wham/src/energy_p_new.F b/source/cluster/wham/src/energy_p_new.F index ee00811..1c4ef0c 100644 --- a/source/cluster/wham/src/energy_p_new.F +++ b/source/cluster/wham/src/energy_p_new.F @@ -107,7 +107,7 @@ C #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+welec*fact(1)*ees+wvdwpp*evdw1 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d @@ -115,7 +115,7 @@ C #else etot=wsc*evdw+wscp*evdw2+welec*fact(1)*(ees+evdw1) & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d @@ -152,6 +152,7 @@ C energia(18)=estr energia(19)=esccor energia(20)=edihcnstr +cc if (dyn_ss) call dyn_set_nss c detecting NaNQ i=0 #ifdef WINPGI @@ -218,7 +219,7 @@ cd write (iout,*) i,g_corr5_loc(i) & +wturn4*fact(3)*gel_loc_turn4(i) & +wturn3*fact(2)*gel_loc_turn3(i) & +wturn6*fact(5)*gel_loc_turn6(i) - & +wel_loc*fact(2)*gel_loc_loc(i)+ + & +wel_loc*fact(2)*gel_loc_loc(i) & +wsccor*fact(1)*gsccor_loc(i) enddo endif @@ -723,6 +724,7 @@ c include "DIMENSIONS.COMPAR" include 'COMMON.INTERACT' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' logical lprn common /srutu/icall integer icant @@ -748,6 +750,12 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij +c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') +c & 'evdw',i,j,evdwij,' ss' + ELSE ind=ind+1 itypj=itype(j) dscj_inv=vbld_inv(j+nres) @@ -830,6 +838,7 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif + ENDIF ! SSBOND enddo ! j enddo ! iint enddo ! i @@ -854,6 +863,7 @@ c include "DIMENSIONS.COMPAR" include 'COMMON.INTERACT' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' common /srutu/ icall logical lprn integer icant @@ -879,6 +889,13 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) +C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij +c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') +c & 'evdw',i,j,evdwij,' ss' + ELSE ind=ind+1 itypj=itype(j) dscj_inv=vbld_inv(j+nres) @@ -961,6 +978,7 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -2800,17 +2818,10 @@ C include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.NAMES' dimension ggg(3) ehpb=0.0D0 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr cd write(iout,*)'link_start=',link_start,' link_end=',link_end -#ifdef DEBUG - do i=1,nres - write (iout,'(a4,2x,i4,3f10.5,5x,3f10.5)') restyp(itype(i)),i, - & (c(j,i),j=1,3),(c(j,i+nres),j=1,3) - enddo -#endif if (link_end.eq.0) return do i=link_start,link_end C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a @@ -2825,26 +2836,25 @@ C iii and jjj point to the residues for which the distance is assigned. iii=ii jjj=jj endif -#ifdef DEBUG - write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, - & dhpb(i),dhpb1(i),forcon(i) -#endif +c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, +c & dhpb(i),dhpb1(i),forcon(i) C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. + if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond - additional check if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij cd write (iout,*) "eij",eij + endif else if (ii.gt.nres .and. jj.gt.nres) then c Restraints from contact prediction dd=dist(ii,jj) if (dhpb1(i).gt.0.0d0) then ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -#ifdef DEBUG - write (iout,*) "beta nmr", - & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) -#endif +c write (iout,*) "beta nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) else dd=dist(ii,jj) rdis=dd-dhpb(i) @@ -2852,9 +2862,7 @@ C Get the force constant corresponding to this distance. waga=forcon(i) C Calculate the contribution to energy. ehpb=ehpb+waga*rdis*rdis -#ifdef DEBUG - write (iout,*) "beta reg",dd,waga*rdis*rdis -#endif +c write (iout,*) "beta reg",dd,waga*rdis*rdis C C Evaluate gradient. C @@ -2878,19 +2886,15 @@ C target distance. if (dhpb1(i).gt.0.0d0) then ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -#ifdef DEBUG - write (iout,*) "alph nmr", - & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) -#endif +c write (iout,*) "alph nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) else rdis=dd-dhpb(i) C Get the force constant corresponding to this distance. waga=forcon(i) C Calculate the contribution to energy. ehpb=ehpb+waga*rdis*rdis -#ifdef DEBUG - write (iout,*) "alpha reg",dd,waga*rdis*rdis -#endif +c write (iout,*) "alpha reg",dd,waga*rdis*rdis C C Evaluate gradient. C @@ -2974,7 +2978,7 @@ C deltat12=om2-om1+2.0d0 cosphi=om12-om1*om2 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 + & +akct*deltad*deltat12+ebr & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, @@ -3351,6 +3355,8 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end + if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + &(itype(i).eq.ntyp1)) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -3360,7 +3366,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3) then + if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -3374,13 +3380,13 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3395,7 +3401,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 + ityp3=ithetyp(itype(i)) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -4505,6 +4511,9 @@ c 3 = SC...Ca...Ca...SCi cosphi=dcos(j*tauangle(intertyp,i)) sinphi=dsin(j*tauangle(intertyp,i)) esccor=esccor+v1ij*cosphi+v2ij*sinphi +#ifdef DEBUG + esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi +#endif gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci @@ -4886,6 +4895,7 @@ C This subroutine calculates multi-body contributions to hydrogen-bonding C Set lprn=.true. for debugging lprn=.false. eturn6=0.0d0 + ecorr6=0.0d0 #ifdef MPL n_corr=0 n_corr1=0 @@ -5062,10 +5072,10 @@ cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 cd write(2,*)'ijkl',i,j,i+1,j1 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 +c write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 +c ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) +c write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, +c & 'ecorr6=',ecorr6, wcorr6 cd write (iout,'(4e15.5)') sred_geom, cd & dabs(eello4(i,j,i+1,j1,jj,kk)), cd & dabs(eello5(i,j,i+1,j1,jj,kk)), @@ -6388,7 +6398,7 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/source/cluster/wham/src/include_unres/COMMON.CONTACTS b/source/cluster/wham/src/include_unres/COMMON.CONTACTS deleted file mode 100644 index d07a0f0..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.CONTACTS +++ /dev/null @@ -1,68 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -C Interactions of pseudo-dipoles generated by loc-el interactions. - double precision dip,dipderg,dipderx - common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), - & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres), - & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres),muder(2,maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont diff --git a/source/cluster/wham/src/include_unres/COMMON.FFIELD b/source/cluster/wham/src/include_unres/COMMON.FFIELD deleted file mode 100644 index 0c169f7..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.FFIELD +++ /dev/null @@ -1,28 +0,0 @@ -C----------------------------------------------------------------------- -C The following COMMON block selects the type of the force field used in -C calculations and defines weights of various energy terms. -C 12/1/95 wcorr added -C----------------------------------------------------------------------- - double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, - & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wbond,weights,scal14,cutoff_corr,delt_corr, - & r0_corr - integer ipot,n_ene_comp - common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, - & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wbond,weights(max_ene), - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp - common /potentials/ potname(5) - character*3 potname -C----------------------------------------------------------------------- -C wlong,welec,wtor,wang,wscloc are the weight of the energy terms -C corresponding to side-chain, electrostatic, torsional, valence-angle, -C and local side-chain terms. -C -C IPOT determines which SC...SC interaction potential will be used: -C 1 - LJ: 2n-n Lennard-Jones -C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -C 3 - BP; Berne-Pechukas (angular dependence) -C 4 - GB; Gay-Berne (angular dependence) -C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -C------------------------------------------------------------------------ diff --git a/source/cluster/wham/src/include_unres/COMMON.NAMES b/source/cluster/wham/src/include_unres/COMMON.NAMES deleted file mode 100644 index a266339..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.NAMES +++ /dev/null @@ -1,7 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(max_ene),wname(max_ene),nprint_ene, - & print_order(max_ene) diff --git a/source/cluster/wham/src/include_unres/COMMON.SBRIDGE b/source/cluster/wham/src/include_unres/COMMON.SBRIDGE index 7bba010..f866aa7 100644 --- a/source/cluster/wham/src/include_unres/COMMON.SBRIDGE +++ b/source/cluster/wham/src/include_unres/COMMON.SBRIDGE @@ -1,10 +1,17 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,dhpb, - & dhpb1,forcon,weidis - integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end, - & ibecarb - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,ns,nss, - & nfree,iss(maxss) + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + integer ns,nss,nfree,iss + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + & ns,nss,nfree,iss(maxss) + double precision dhpb,dhpb1,forcon + integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb + double precision weidis common /restraints/ weidis + integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim), + & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/cluster/wham/src/include_unres/COMMON.SCCOR b/source/cluster/wham/src/include_unres/COMMON.SCCOR deleted file mode 100644 index 5217de7..0000000 --- a/source/cluster/wham/src/include_unres/COMMON.SCCOR +++ /dev/null @@ -1,6 +0,0 @@ -C Parameters of the SCCOR term - double precision v1sccor,v2sccor - integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), - & nterm_sccor diff --git a/source/cluster/wham/src/initialize_p.F b/source/cluster/wham/src/initialize_p.F index 37e0bf9..224cb21 100644 --- a/source/cluster/wham/src/initialize_p.F +++ b/source/cluster/wham/src/initialize_p.F @@ -155,6 +155,9 @@ C Initialize the bridge arrays ihpb(i)=0 jhpb(i)=0 enddo + do i=1,maxres + dyn_ss_mask(i)=.false. + enddo C C Initialize timing. C @@ -291,6 +294,7 @@ cd & (ihpb(i),jhpb(i),i=1,nss) do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. + if (dyn_ss) go to 10 jj=jhpb(ii)-nres goto 10 endif @@ -341,7 +345,7 @@ cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj nint_gr(i)=1 istart(i,1)=i+1 iend(i,1)=nct - ind_scint=int_scint+nct-i + ind_scint=ind_scint+nct-i #endif endif #ifdef MPL diff --git a/source/cluster/wham/src/main_clust.F b/source/cluster/wham/src/main_clust.F index 4f50091..5a61e8d 100644 --- a/source/cluster/wham/src/main_clust.F +++ b/source/cluster/wham/src/main_clust.F @@ -23,7 +23,7 @@ C logical printang(max_cut) integer printpdb(max_cut) integer printmol2(max_cut) - character*240 lineh + character*240 lineh,scrachdir2d REAL CRIT(maxconf),MEMBR(maxconf) REAL CRITVAL(maxconf-1) INTEGER IA(maxconf),IB(maxconf) @@ -34,13 +34,14 @@ C DIMENSION NN(maxconf),DISNN(maxconf) LOGICAL FLAG(maxconf) integer i,j,k,l,m,n,len,lev,idum,ii,ind,ioffset,jj,icut,ncon, - & it,ncon_work,ind1 + & it,ncon_work,ind1,ilen,is,ie double precision t1,t2,tcpu,difconf + real diss_(maxdist) double precision varia(maxvar) double precision hrtime,mintime,sectime logical eof - + external ilen #ifdef MPI call MPI_Init( IERROR ) call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR ) @@ -75,6 +76,12 @@ c if (refstr) call read_ref_structure(*30) print *,'MAIN: nnt=',nnt,' nct=',nct + if (nclust.gt.0) then + PRINTANG(1)=.TRUE. + PRINTPDB(1)=outpdb + printmol2(1)=outmol2 + ncut=0 + else DO I=1,NCUT PRINTANG(I)=.FALSE. PRINTPDB(I)=0 @@ -86,12 +93,21 @@ c if (refstr) call read_ref_structure(*30) printmol2(i)=outmol2 ENDIF ENDDO + endif + if (ncut.gt.0) then write (iout,*) 'Number of cutoffs:',NCUT write (iout,*) 'Cutoff values:' DO ICUT=1,NCUT WRITE(IOUT,'(8HRCUTOFF(,I2,2H)=,F8.1,2i2)')ICUT,RCUTOFF(ICUT), & printpdb(icut),printmol2(icut) ENDDO + else if (nclust.gt.0) then + write (iout,'("Number of clusters requested",i5)') nclust + else + if (me.eq.Master) + & write (iout,*) "ERROR: Either nclust or ncut must be >0" + stop + endif DO I=1,NRES-3 MULT(I)=1 ENDDO @@ -107,7 +123,6 @@ c if (refstr) call read_ref_structure(*30) #ifdef MPI call work_partition(.true.,ncon) #endif - call probabl(iT,ncon_work,ncon,*20) if (ncon_work.lt.2) then @@ -147,7 +162,11 @@ C if (ind.ge.indstart(me) .and. ind.le.indend(me)) then #endif ind1=ind1+1 +#ifdef MPI + DISS_(IND1)=DIFCONF(I,J) +#else DISS(IND1)=DIFCONF(I,J) +#endif c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) #ifdef MPI endif @@ -161,11 +180,12 @@ c write (iout,'(2i4,i10,f10.5)') i,j,ind,DISS(IND) PRINT '(a)','End of distance computation' #ifdef MPI - call MPI_Gatherv(diss(1),scount(me),MPI_REAL,diss(1), + call MPI_Gatherv(diss_(1),scount(me),MPI_REAL,diss(1), & scount(0),idispl(0),MPI_REAL,Master,MPI_COMM_WORLD, IERROR) if (me.eq.master) then #endif - open(80,file='/tmp/distance',form='unformatted') + scrachdir2d=scratchdir(:ilen(scratchdir))//'distance' + open(80,file=scrachdir2d,form='unformatted') do i=1,ndis write(80) diss(i) enddo @@ -238,29 +258,39 @@ C CALL HCASS(N,IA,IB,CRIT,LEV,ICLASS,HVALS,IORDER,CRITVAL,HEIGHT) c CALL HCDEN(LEV,IORDER,HEIGHT,CRITVAL) +c 3/3/16 AL: added explicit number of cluters + if (nclust.gt.0) then + is=nclust-1 + ie=nclust-1 + icut=1 + else + is=1 + ie=lev-1 + endif do i=1,maxgr licz(i)=0 enddo icut=1 - i=1 - NGR=i+1 + i=is + NGR=is+1 do j=1,n licz(iclass(j,i))=licz(iclass(j,i))+1 nconf(iclass(j,i),licz(iclass(j,i)))=j c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)), c & nconf(iclass(j,i),licz(iclass(j,i))) enddo - do i=1,lev-1 - +c do i=1,lev-1 + do i=is,ie idum=lev-i DO L=1,LEV IF (HEIGHT(L).EQ.IDUM) GOTO 190 ENDDO 190 IDUM=L - write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM), - & " icut",icut," cutoff",rcutoff(icut) - IF (CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN - WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) +c write(IOUT,*) "i+1",i+1," idum",idum," critval",CRITVAL(IDUM), +c & " icut",icut," cutoff",rcutoff(icut) + IF (nclust.gt.0.or.CRITVAL(IDUM).LT. RCUTOFF(ICUT)) THEN + if (nclust.le.0) + & WRITE (iout,'(/a,f10.5)') 'AT CUTOFF:',rcutoff(icut) write (iout,'(a,f8.2)') 'Maximum distance found:', & CRITVAL(IDUM) CALL SRTCLUST(ICUT,ncon_work,iT) @@ -273,9 +303,10 @@ c & nconf(iclass(j,i),licz(iclass(j,i))) do l=1,maxgr licz(l)=0 enddo + ii=i-is+1 do j=1,n - licz(iclass(j,i))=licz(iclass(j,i))+1 - nconf(iclass(j,i),licz(iclass(j,i)))=j + licz(iclass(j,ii))=licz(iclass(j,ii))+1 + nconf(iclass(j,ii),licz(iclass(j,ii)))=j c write (iout,*) i,j,iclass(j,i),licz(iclass(j,i)), c & nconf(iclass(j,i),licz(iclass(j,i))) cd print *,j,iclass(j,i), @@ -301,17 +332,17 @@ C C close(icbase,status="delete") #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop '********** Program terminated normally.' 20 write (iout,*) "Error reading coordinates" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop 30 write (iout,*) "Error reading reference structure" #ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) + call MPI_Finalize(IERROR) #endif stop end diff --git a/source/cluster/wham/src/parmread.F b/source/cluster/wham/src/parmread.F index 7f6a145..b1a9a32 100644 --- a/source/cluster/wham/src/parmread.F +++ b/source/cluster/wham/src/parmread.F @@ -502,6 +502,7 @@ cc maxinter is maximum interaction sites if (lprint) then write (iout,'(/a/)') 'Torsional constants:' + do l=1,maxinter do i=1,nsccortyp do j=1,nsccortyp write (iout,*) 'ityp',i,' jtyp',j @@ -517,6 +518,7 @@ cc maxinter is maximum interaction sites enddo enddo enddo + enddo endif C @@ -810,7 +812,7 @@ C C C Define the constants of the disulfide bridge C - ebr=-5.50D0 +C ebr=-5.50D0 c c Old arbitrary potential - commented out. c @@ -821,19 +823,12 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G** c energy surface of diethyl disulfide. c A. Liwo and U. Kozlowska, 11/24/03 c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 - - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss +C D0CM = 3.78d0 +C AKCM = 15.1d0 +C AKTH = 11.0d0 +C AKCT = 12.0d0 +C V1SS =-1.08d0 +C V2SS = 7.61d0 +C V3SS = 13.7d0 return end diff --git a/source/cluster/wham/src/probabl.F b/source/cluster/wham/src/probabl.F index 9c21be3..bdca32a 100644 --- a/source/cluster/wham/src/probabl.F +++ b/source/cluster/wham/src/probabl.F @@ -28,19 +28,29 @@ character*5 ctemper integer ilen external ilen - real*4 Fdimless(maxconf) + real*4 Fdimless(maxconf),Fdimless_(maxconf) double precision energia(0:max_ene) + double precision totfree_(maxconf),entfac_(maxconf) do i=1,ncon list_conf(i)=i enddo c do i=1,ncon c write (iout,*) i,list_conf(i) c enddo +c do i=1,ncon +c write(iout,*) "entrop before", entfac(i),i +c enddo + #ifdef MPI write (iout,*) me," indstart",indstart(me)," indend",indend(me) call daread_ccoords(indstart(me),indend(me)) #endif +c do i=1,ncon +c write(iout,*) "entrop after", entfac(i),i +c enddo + c write (iout,*) "ncon",ncon + temper=1.0d0/(beta_h(ib)*1.987D-3) c write (iout,*) "ib",ib," beta_h",beta_h(ib)," temper",temper c quot=1.0d0/(T0*beta_h(ib)*1.987D-3) @@ -104,7 +114,7 @@ c write (iout,*) "i",i," ii",ii totfree(i)=energia(0) #define DEBUG #ifdef DEBUG -c write (iout,*) i," energia",(energia(j),j=0,n_ene) + write (iout,*) i," energia",(energia(j),j=0,20) call enerprint(energia(0),ft) call flush(iout) #endif @@ -131,6 +141,7 @@ c write (iout,*) i," energia",(energia(j),j=0,n_ene) ecorr=enetb(4,i) ecorr5=enetb(5,i) ecorr6=enetb(6,i) +cc if (wcorr6.eq.0) ecorr6=0.0d0 eel_loc=enetb(7,i) eello_turn3=enetb(8,i) eello_turn4=enetb(9,i) @@ -146,7 +157,7 @@ c write (iout,*) i," energia",(energia(j),j=0,n_ene) #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+ft(1)*welec*ees+wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc @@ -155,36 +166,50 @@ c write (iout,*) i," energia",(energia(j),j=0,n_ene) #else etot=wsc*evdw+wscp*evdw2+ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor & +wbond*estr #endif +#ifdef MPI + Fdimless_(i)=beta_h(ib)*etot+entfac(ii) + totfree_(i)=etot +#ifdef DEBUG + write (iout,*) "etrop", i,ii,ib, + & 1.0d0/(1.987d-3*beta_h(ib)),totfree(i), + & entfac(ii),Fdimless_(i) +#endif +#else Fdimless(i)=beta_h(ib)*etot+entfac(ii) totfree(i)=etot #ifdef DEBUG - write (iout,*) i,ii,ib, + write (iout,*) "etrop", i,ii,ib, & 1.0d0/(1.987d-3*beta_h(ib)),totfree(i), & entfac(ii),Fdimless(i) #endif +#endif enddo ! i #ifdef MPI - call MPI_Gatherv(Fdimless(1),scount(me), + call MPI_Gatherv(Fdimless_(1),scount(me), & MPI_REAL,Fdimless(1), & scount(0),idispl(0),MPI_REAL,Master, & MPI_COMM_WORLD, IERROR) - call MPI_Gatherv(totfree(1),scount(me), + call MPI_Gatherv(totfree_(1),scount(me), & MPI_DOUBLE_PRECISION,totfree(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) call MPI_Gatherv(entfac(indstart(me)+1),scount(me), - & MPI_DOUBLE_PRECISION,entfac(1), + & MPI_DOUBLE_PRECISION,entfac_(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) if (me.eq.Master) then + do i=1,ncon + entfac(i)=entfac_(i) + enddo #endif +c#define DEBUG #ifdef DEBUG write (iout,*) "The FDIMLESS array before sorting" do i=1,ncon @@ -198,20 +223,21 @@ c write (iout,*) i," energia",(energia(j),j=0,n_ene) write (iout,*) i,list_conf(i),fdimless(i) enddo #endif +c#undef DEBUG do i=1,ncon totfree(i)=fdimless(i) enddo qfree=0.0d0 do i=1,ncon - qfree=qfree+exp(-fdimless(i)+fdimless(1)) + qfree=qfree+dexp(dble(-fdimless(i)+fdimless(1))) enddo c write (iout,*) "qfree",qfree nlist=1 sumprob=0.0 do i=1,min0(ncon,maxstr_proc)-1 - sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree + sumprob=sumprob+dexp(dble(-fdimless(i)+fdimless(1)))/qfree #ifdef DEBUG - write (iout,*) i,ib,beta_h(ib), + write (iout,*) 'i=',i,ib,beta_h(ib), & 1.0d0/(1.987d-3*beta_h(ib)),list_conf(i), & totfree(list_conf(i)), & -entfac(list_conf(i)),fdimless(i),sumprob diff --git a/source/cluster/wham/src/read_coords.F b/source/cluster/wham/src/read_coords.F index 2a21cbe..4e90584 100644 --- a/source/cluster/wham/src/read_coords.F +++ b/source/cluster/wham/src/read_coords.F @@ -212,16 +212,26 @@ c call flush(iout) enddo enddo else + itmp=0 #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret) if (iret.eq.0) goto 101 call xdrfint_(ixdrf, nss, iret) if (iret.eq.0) goto 101 do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - if (iret.eq.0) goto 101 - call xdrfint_(ixdrf, jhpb(j), iret) - if (iret.eq.0) goto 101 +cc if (dyn_ss) then +cc call xdrfint_(ixdrf, idssb(j), iret) +cc if (iret.eq.0) goto 101 +cc call xdrfint_(ixdrf, jdssb(j), iret) +cc if (iret.eq.0) goto 101 +cc idssb(j)=idssb(j)-nres +cc jdssb(j)=jdssb(j)-nres +cc else + call xdrfint_(ixdrf, ihpb(j), iret) + if (iret.eq.0) goto 101 + call xdrfint_(ixdrf, jhpb(j), iret) + if (iret.eq.0) goto 101 +cc endif enddo call xdrffloat_(ixdrf,reini,iret) if (iret.eq.0) goto 101 @@ -243,10 +253,20 @@ c write (iout,*) "nss",nss call flush(iout) if (iret.eq.0) goto 101 do k=1,nss - call xdrfint(ixdrf, ihpb(k), iret) - if (iret.eq.0) goto 101 - call xdrfint(ixdrf, jhpb(k), iret) - if (iret.eq.0) goto 101 +cc if (dyn_ss) then +cc call xdrfint(ixdrf, idssb(k), iret) +cc if (iret.eq.0) goto 101 +cc call xdrfint(ixdrf, jdssb(k), iret) +cc if (iret.eq.0) goto 101 +cc idssb(k)=idssb(k)-nres +cc jdssb(k)=jdssb(k)-nres +cc write(iout,*) "TUTU", idssb(k),jdssb(k) +cc else + call xdrfint(ixdrf, ihpb(k), iret) + if (iret.eq.0) goto 101 + call xdrfint(ixdrf, jhpb(k), iret) + if (iret.eq.0) goto 101 +cc endif enddo call xdrffloat(ixdrf,reini,iret) if (iret.eq.0) goto 101 @@ -258,7 +278,9 @@ c write (iout,*) "nss",nss if (iret.eq.0) goto 101 #endif energy(jj+1)=reini - entfac(jj+1)=refree +cc write(iout,*) 'reini=', reini, jj+1 + entfac(jj+1)=dble(refree) +cc write(iout,*) 'refree=', refree,jj+1 rmstb(jj+1)=rmsdev do k=1,nres do l=1,3 @@ -639,10 +661,17 @@ c write (iout,*) "Reading binary file, record",iii," ii",ii call flush(iout) #endif + if (dyn_ss) then + read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), + & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), +c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), + & entfac(ii),rmstb(ii) + else read(icbase,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss), & entfac(ii),rmstb(ii) + endif #ifdef DEBUG write (iout,*) ii,iii,ij,entfac(ii) write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) @@ -696,10 +725,17 @@ c write (iout,*) "Writing binary file, record",iii," ii",ii call flush(iout) #endif + if (dyn_ss) then + write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), + & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), +c & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)) + & entfac(ii),rmstb(ii) + else write(unit_out,rec=iii) ((allcart(j,i,ij),j=1,3),i=1,nres), & ((allcart(j,i,ij),j=1,3),i=nnt+nres,nct+nres), & nss_all(ij),(ihpb_all(i,ij),jhpb_all(i,ij),i=1,nss_all(ij)), & entfac(ii),rmstb(ii) + endif #ifdef DEBUG write (iout,'(8f10.5)') ((allcart(j,i,ij),j=1,3),i=1,nres) write (iout,'(8f10.4)') ((allcart(j,i,ij),j=1,3),i=nnt+nres, diff --git a/source/cluster/wham/src/readrtns.F b/source/cluster/wham/src/readrtns.F index 8e63ff8..4a6d6e7 100644 --- a/source/cluster/wham/src/readrtns.F +++ b/source/cluster/wham/src/readrtns.F @@ -30,12 +30,14 @@ C refstr=(index(controlcard,'REFSTR').gt.0) write (iout,*) "REFSTR",refstr pdbref=(index(controlcard,'PDBREF').gt.0) + dyn_ss=(index(controlcard,'DYN_SS').gt.0) iscode=index(controlcard,'ONE_LETTER') tree=(index(controlcard,'MAKE_TREE').gt.0) min_var=(index(controlcard,'MINVAR').gt.0) plot_tree=(index(controlcard,'PLOT_TREE').gt.0) punch_dist=(index(controlcard,'PUNCH_DIST').gt.0) - call readi(controlcard,'NCUT',ncut,1) + call readi(controlcard,'NCUT',ncut,0) + call readi(controlcard,'NCLUST',nclust,5) call readi(controlcard,'NSTART',nstart,0) call readi(controlcard,'NEND',nend,0) call reada(controlcard,'ECUT',ecut,10.0d0) @@ -44,7 +46,8 @@ C lgrp=(index(controlcard,'LGRP').gt.0) caonly=(index(controlcard,'CA_ONLY').gt.0) print_dist=(index(controlcard,'PRINT_DIST').gt.0) - call multreada(controlcard,'CUTOFF',rcutoff,ncut,-1.0d0) + if (ncut.gt.0) + & call multreada(controlcard,'CUTOFF',rcutoff,ncut,-1.0d0) call readi(controlcard,'IOPT',iopt,2) lside = index(controlcard,"SIDE").gt.0 efree = index(controlcard,"EFREE").gt.0 @@ -126,9 +129,43 @@ C Read weights of the subsequent energy terms. call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) call reada(weightcard,'WSCCOR',wsccor,1.0D0) + call reada(weightcard,"D0CM",d0cm,3.78d0) + call reada(weightcard,"AKCM",akcm,15.1d0) + call reada(weightcard,"AKTH",akth,11.0d0) + call reada(weightcard,"AKCT",akct,12.0d0) + call reada(weightcard,"V1SS",v1ss,-1.08d0) + call reada(weightcard,"V2SS",v2ss,7.61d0) + call reada(weightcard,"V3SS",v3ss,13.7d0) + call reada(weightcard,"EBR",ebr,-5.50D0) if (index(weightcard,'SOFT').gt.0) ipot=6 C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,'WCORRH',wcorr,1.0D0) + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo + enddo + call reada(weightcard,"HT",Ht,0.0D0) + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + endif + write (iout,'(/a)') "Disulfide bridge parameters:" + write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr + write (iout,'(a,f10.2)') 'S-S depth: ',ss_depth + write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm + write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct + write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, + & ' v3ss:',v3ss + write (iout,'(2(a,f10.2))') 'ht:',ht,' eps:', eps(1,1) if (wcorr4.gt.0.0d0) wcorr=wcorr4 weights(1)=wsc weights(2)=wscp @@ -205,6 +242,19 @@ C Convert sequence to numeric code do i=1,nres itype(i)=rescode(i,sequence(i),iscode) enddo + if (itype(2).eq.10.and.itype(1).eq.ntyp1) then + write (iout,*) + & "Glycine is the first full residue, initial dummy deleted" + do i=1,nres + itype(i)=itype(i+1) + enddo + nres=nres-1 + endif + if (itype(nres-1).eq.10.and.itype(nres).eq.ntyp1) then + write (iout,*) + & "Glycine is the last full residue, terminal dummy deleted" + nres=nres-1 + endif print *,nres print '(20i4)',(itype(i),i=1,nres) @@ -327,7 +377,7 @@ c endif enddo enddo endif - call contact(.true.,ncont_ref,icont_ref) + call contact(print_contact_map,ncont_ref,icont_ref) endif c Read distance restraints if (constr_dist.gt.0) then @@ -431,6 +481,22 @@ c forcon(i)=fbr enddo endif endif + if (ns.gt.0.and.dyn_ss) then + do i=nss+1,nhpb + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. +c write(iout,*) i,iss(i),dyn_ss_mask(iss(i)),"ATU" + enddo + endif + print *, "Leaving brigde read" return end c---------------------------------------------------------------------------- diff --git a/source/cluster/wham/src/wrtclust.f b/source/cluster/wham/src/wrtclust.f index 97592b7..3915ebc 100644 --- a/source/cluster/wham/src/wrtclust.f +++ b/source/cluster/wham/src/wrtclust.f @@ -84,12 +84,16 @@ C 12/8/93 Estimation of "diameters" of the subsequent families. ave_dim=0.0 amax_dim=0.0 c write (iout,*) "ecut",ecut + emin=totfree(nconf(igr,1)) +c write (2,*) "emin",emin," ecut",ecut do i=2,licz(igr) ii=nconf(igr,i) +c write (2,*) " igr",igr," i",i," ii",ii," totfree",totfree(ii), +c & " emin",emin," diff",totfree(ii)-emin," ecut",ecut if (totfree(ii)-emin .gt. ecut) goto 10 do j=1,i-1 jj=nconf(igr,j) - if (jj.eq.1) exit +c if (jj.eq.1) exit if (ii.lt.jj) then ind=ioffset(ncon,ii,jj) else @@ -112,9 +116,12 @@ c & list_conf(jj),curr_dist & '; average distance in the family:',ave_dim rmsave(igr)=0.0d0 qpart=0.0d0 + emin=totfree(nconf(igr,1)) do i=1,licz(igr) icon=nconf(igr,i) - boltz=dexp(-totfree(icon)) + boltz=dexp(-totfree(icon)+emin) +c write (2,*) "igr",igr," i",i," icon",icon," totfree", +c & totfree(icon)," emin",emin," boltz",boltz," rms",rmstb(icon) rmsave(igr)=rmsave(igr)+boltz*rmstb(icon) qpart=qpart+boltz enddo diff --git a/source/cluster/wham/src/xdrf/Makefile b/source/cluster/wham/src/xdrf/Makefile deleted file mode 100644 index 02c29f6..0000000 --- a/source/cluster/wham/src/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = gcc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/cluster/wham/src/xdrf/Makefile_jubl b/source/cluster/wham/src/xdrf/Makefile_jubl deleted file mode 100644 index 8dc35cf..0000000 --- a/source/cluster/wham/src/xdrf/Makefile_jubl +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc - -CFLAGS= -O2 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f *.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/cluster/wham/src/xdrf/Makefile_linux b/source/cluster/wham/src/xdrf/Makefile_linux deleted file mode 100644 index f03276e..0000000 --- a/source/cluster/wham/src/xdrf/Makefile_linux +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/cluster/wham/src/xdrf/RS6K.m4 b/source/cluster/wham/src/xdrf/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/cluster/wham/src/xdrf/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/cluster/wham/src/xdrf/ftocstr.c b/source/cluster/wham/src/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/cluster/wham/src/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/cluster/wham/src/xdrf/libxdrf.m4 b/source/cluster/wham/src/xdrf/libxdrf.m4 deleted file mode 100644 index a6da458..0000000 --- a/source/cluster/wham/src/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1238 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "w+"; - lmode = XDR_ENCODE; - } else if (*type == 'a' || *type == 'A') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/cluster/wham/src/xdrf/types.h b/source/cluster/wham/src/xdrf/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/cluster/wham/src/xdrf/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/cluster/wham/src/xdrf/underscore.m4 b/source/cluster/wham/src/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/cluster/wham/src/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/cluster/wham/src/xdrf/xdr.c b/source/cluster/wham/src/xdrf/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/cluster/wham/src/xdrf/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/cluster/wham/src/xdrf/xdr.h b/source/cluster/wham/src/xdrf/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/cluster/wham/src/xdrf/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/cluster/wham/src/xdrf/xdr_array.c b/source/cluster/wham/src/xdrf/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/cluster/wham/src/xdrf/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/cluster/wham/src/xdrf/xdr_float.c b/source/cluster/wham/src/xdrf/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/cluster/wham/src/xdrf/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/cluster/wham/src/xdrf/xdr_stdio.c b/source/cluster/wham/src/xdrf/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/cluster/wham/src/xdrf/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/cluster/wham/src/xdrf/xdrf.h b/source/cluster/wham/src/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/cluster/wham/src/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/pymol/UNRESInpGen.py b/source/pymol/UNRESInpGen.py old mode 100755 new mode 100644 index b3d77a7..ca8c516 --- a/source/pymol/UNRESInpGen.py +++ b/source/pymol/UNRESInpGen.py @@ -52,6 +52,9 @@ class UNRESInpGenerator(Toplevel): writeSSbrige = IntVar() OM1Val = StringVar() OM2Val = StringVar() + CART = IntVar() + OVERLAP = IntVar() + NOSEARCHSC = IntVar() objects_list = ['Select object'] seq_list=[] seq_length=0 @@ -118,7 +121,7 @@ class UNRESInpGenerator(Toplevel): labelpos = 'w', label_text = 'Choose method:', menubutton_textvariable = self.OM1Val, - items = ['MD', 'MREMD' ], + items = ['MD', 'REMD/MREMD', 'MINIMIZE' ], command = self.switch_options, menubutton_width = 10 ) @@ -213,7 +216,15 @@ class UNRESInpGenerator(Toplevel): self.balloon.bind(self.gr1.md.e7, "Frequency of resetting velocities to values from Gaussian distribution") self.gr1.md.e7.component('entry').config(width=8) self.gr1.md.e7.grid(row=1,column=2, sticky=E) - + + # -- initial structure + self.gr1.md.om1 = Pmw.OptionMenu(self.gr1.md, + labelpos = 'w', + label_text = 'Start from', + items = ['PDB', 'extended', 'random' ], + menubutton_width = 8, + ) + self.gr1.md.om1.grid(row=1,column=3, sticky=E) #================================= # - thermostat frame @@ -261,6 +272,134 @@ class UNRESInpGenerator(Toplevel): self.gr1.th.e3.component('entry').config(width=8) #self.gr1.th.e2.pack(side=LEFT) + + #================================= + # - Minimization frame + self.gr1.mi = Frame(self.gr1.interior()) + #self.gr1.mi.grid(row=4, column=0, columnspan=5,sticky=W+E) + + self.gr1.mi.e1 = Pmw.EntryField(self.gr1.mi, + labelpos='w', + label_text="MAXMIN", + validate = {'validator' : 'integer', 'min': 0 , 'max' : 1000000 }, + value = "2000" ) + self.balloon.bind(self.gr1.mi.e1,'Maximum number of iterations of the SUMSL minimizer.') + self.gr1.mi.e1.component('entry').config(width=8) + self.gr1.mi.e1.pack(side=LEFT) + + self.gr1.mi.e2 = Pmw.EntryField(self.gr1.mi, + labelpos='w', + label_text="MAXFUN", + validate = {'validator' : 'integer', 'min': 0 , 'max' : 1000000 }, + value = "5000" ) + self.balloon.bind(self.gr1.mi.e2,'Maximum number of function evaluations in a single minimization.') + self.gr1.mi.e2.component('entry').config(width=8) + self.gr1.mi.e2.pack(side=LEFT) + + self.gr1.mi.c1 = Checkbutton(self.gr1.mi, + text = "CART", + variable = self.CART ) + self.balloon.bind(self.gr1.mi.c1,'Minimize in virtual-bond vectors instead of angles.') + self.gr1.mi.c1.pack(side=LEFT) + + self.gr1.mi.c2 = Checkbutton(self.gr1.mi, + text = "OVERLAP", + variable = self.OVERLAP ) + self.balloon.bind(self.gr1.mi.c2,'Fix overlaping sidechains.') + self.gr1.mi.c2.pack(side=LEFT) + + self.gr1.mi.c3 = Checkbutton(self.gr1.mi, + text = "NOSEARCHSC", + variable = self.NOSEARCHSC ) + #self.balloon.bind(self.gr1.mi.c3,'Minimize in virtual-bond vectors instead of angles.') + self.gr1.mi.c3.pack(side=LEFT) + + + #================================= + # - REMD frame + self.gr1.re = Frame(self.gr1.interior()) + #self.gr1.re.grid(row=5, column=0, columnspan=5,sticky=W+E) + + self.gr1.re.e1 = Pmw.EntryField(self.gr1.re, + labelpos = 'w', + label_text = "NREP", + validate = {'validator' : 'integer', 'min': 1 , 'max' : 32 }, + command = self.set_replica_widgets, + value = "16" ) + self.balloon.bind(self.gr1.re.e1,'Number of replicas in a REMD/MREMD run.') + self.gr1.re.e1.component('entry').config(width=8) + self.gr1.re.e1.grid(row=0, column=0, sticky=W) + + self.gr1.re.e2 = Pmw.EntryField(self.gr1.re, + labelpos = 'w', + label_text = "NSTEX", + validate = {'validator' : 'integer', 'min': 0 , 'max' : 1000000 }, + value = "1000" ) + self.balloon.bind(self.gr1.re.e2,'Number of steps after which exchange is performed in REMD/MREMD runs.') + self.gr1.re.e2.component('entry').config(width=8) + self.gr1.re.e2.grid(row=0, column=1, sticky=W) + + # -- radio select + self.gr1.re.rs = Pmw.RadioSelect(self.gr1.re, + labelpos = 'w', + label_text = 'Replica temperatures', + command = self.sel_replica_mode, + buttontype = 'radiobutton' + #frame_borderwidth = 2, + #frame_relief = 'ridge' + ) + self.gr1.re.rs.grid(row=1, column=0, columnspan=4,sticky=W) + + for text in ('Manual', 'Range'): + self.gr1.re.rs.add(text) + + # --- range + self.gr1.re.tf1 = Frame(self.gr1.re, bg="blue") + self.gr1.re.tf1.grid(row=2,column=0, columnspan=4, sticky=W) + + self.gr1.re.tf1.e1 = Pmw.EntryField(self.gr1.re.tf1, + labelpos = 'w', + label_text = "RETMIN", + validate = {'validator' : 'real', 'min': 0 , 'max' : 1000000 }, + value = "10" ) + self.balloon.bind(self.gr1.re.tf1.e1,'Minimum temperature in a REMD/MREMD run.') + self.gr1.re.tf1.e1.component('entry').config(width=8) + self.gr1.re.tf1.e1.grid(row=0, column=0, sticky=W) + + self.gr1.re.tf1.e2 = Pmw.EntryField(self.gr1.re.tf1, + labelpos = 'w', + label_text = "RETMAX", + validate = {'validator' : 'real', 'min': 0 , 'max' : 1000000 }, + value = "1000" ) + self.balloon.bind(self.gr1.re.tf1.e2,'Maxmum temperature in a REMD/MREMD run.') + self.gr1.re.tf1.e2.component('entry').config(width=8) + self.gr1.re.tf1.e2.grid(row=0, column=1, sticky=W) + + # --- manual + self.gr1.re.tf2 = Frame(self.gr1.re) + self.gr1.re.tf2.grid(row=3,column=0, columnspan=4, sticky=W) + + self.gr1.re.tf2.te = [] + for i in range(0,32): #int(self.gr1.re.e1.get())): + self.gr1.re.tf2.te.append(Pmw.EntryField(self.gr1.re.tf2, + labelpos='n', + label_text='T%02d' % (i+1), + validate = {'validator' : 'real','min' : 0, 'max' : 1000, 'minstrict' : 0}, + value = '%d' % (200+i*10))) + self.gr1.re.tf2.te[i].component('entry').config(width=3) + self.gr1.re.tf2.te[i].grid(row=1+(i//16), column=0+(i % 16)) + + self.gr1.re.tf2.nre = Pmw.EntryField(self.gr1.re.tf2, + labelpos ='n', + label_text='Rep. in Temp.', + validate = {'validator' : 'integer','min' : 1, 'max' : 100 }, + value = '2') + self.gr1.re.tf2.nre.component('entry').config(width=3) + self.gr1.re.tf2.nre.grid(row=1, column=17) + + # display manual replica options + self.gr1.re.e1.invoke() + self.gr1.re.rs.invoke('Manual') #================================= # "Force field options" group @@ -291,7 +430,10 @@ class UNRESInpGenerator(Toplevel): value = '1.00000')) self.ef[i].component('entry').config(width=8) self.ef[i].grid(row=1+(i//9), column=0+(i % 9)) + + #=================================== # "Sequence" group + # self.gr3 = Pmw.Group(self,tag_text = 'Sequence') self.gr3.grid(row=3, column=0,columnspan=4,sticky=W+E,padx=10, pady=5) @@ -526,10 +668,48 @@ class UNRESInpGenerator(Toplevel): # Hide all self.gr1.th.grid_remove() self.gr1.md.grid_remove() + self.gr1.mi.grid_remove() + self.gr1.re.grid_remove() + # Show MD stuff if self.OM1Val.get()=="MD": self.gr1.md.grid(row=2, column=0, columnspan=5, sticky=W+E) self.gr1.th.grid(row=3, column=0, columnspan=5, sticky=W+E) - + elif self.OM1Val.get()=="REMD/MREMD": + self.gr1.md.grid(row=2, column=0, columnspan=5, sticky=W+E) + self.gr1.th.grid(row=3, column=0, columnspan=5, sticky=W+E) + self.gr1.re.grid(row=5, column=0, columnspan=5, sticky=W+E) + elif self.OM1Val.get()=="MINIMIZE": + self.gr1.mi.grid(row=4,column=0,columnspan=5, sticky=W+E) + + def sel_replica_mode(self,mode): + ''' + Display replica temperatures settings + ''' + try: + self.gr1.re.tf1.grid_remove() + self.gr1.re.tf2.grid_remove() + if mode=="Range": + self.gr1.re.tf1.grid(row=2,column=0, columnspan=4, sticky=W) + elif mode=="Manual": + self.gr1.re.tf2.grid(row=3,column=0, columnspan=4, sticky=W) + except: + pass + + def set_replica_widgets(self): + ''' + Refresh list of available temperature widgets in manual mode + ''' + #print self.gr1.re.e1.get() + for i in range(0,32): #int(self.gr1.re.e1.get())): + try: + if iCA tmp0=[e[i][4], e[i][5], e[i][6]] - l=cpv.length(tmp0) + #l=cpv.length(tmp0) # random vector tmp1 = cpv.random_vector() # orthogonal vector to tmp0 and tmp1 tmp2 = cpv.cross_product(tmp1, tmp0) tmp3 = cpv.cross_product(tmp0, tmp2) + tmp0 = cpv.normalize(tmp0) tmp2 = cpv.normalize(tmp2) tmp3 = cpv.normalize(tmp3) - tmp2 = cpv.scale(tmp2,0.9*resdb[e[i][0]][3]) - tmp3 = cpv.scale(tmp3,0.9*resdb[e[i][0]][3]) - + tmp0 = cpv.scale(tmp0,resdb[e[i][0]][4]) + tmp2 = cpv.scale(tmp2,resdb[e[i][0]][3]) + tmp3 = cpv.scale(tmp3,resdb[e[i][0]][3]) + factor = 1.0 / max( cpv.length(tmp0), cpv.length(tmp2), cpv.length(tmp3)) + tmp0 = cpv.scale(tmp0, factor) + tmp2 = cpv.scale(tmp2, factor) + tmp3 = cpv.scale(tmp3, factor) obj.extend( [ COLOR, resdb[e[i][0]][0], resdb[e[i][0]][1], resdb[e[i][0]][2] ] ) - obj.extend( [ ELLIPSOID, e[i][1], e[i][2], e[i][3], e_size, ] + tmp0 + tmp2 + tmp3 ) + obj.extend( [ ELLIPSOID, e[i][1], e[i][2], e[i][3], 1.0/factor, ] + tmp0 + tmp2 + tmp3 ) + + # Get Glicynes positions + atoms=cmd.get_model(sl+' & n. CA & resn GLY').atom + g=[] + for i in xrange(0,len(atoms)): + g.append( [ atoms[i].resn, atoms[i].coord[0], atoms[i].coord[1], atoms[i].coord[2] ]) + # Draw the glicyne spheres + for i in xrange(0, len(g)): + obj.extend( [ COLOR, resdb[g[i][0]][0], resdb[g[i][0]][1], resdb[g[i][0]][2] ] ) + obj.extend( [ SPHERE, g[i][1], g[i][2], g[i][3], resdb[g[i][0]][3]]) + cmd.set('cgo_ellipsoid_quality', 2) cmd.load_cgo(obj,'UNRES_'+sl) diff --git a/source/unres/src_CSA/CMakeLists.txt b/source/unres/src_CSA/CMakeLists.txt index 89cb6a1..a3d3569 100644 --- a/source/unres/src_CSA/CMakeLists.txt +++ b/source/unres/src_CSA/CMakeLists.txt @@ -18,7 +18,7 @@ set(UNRES_CSA_SRC0 contact.f convert.f cored.f - csa.f + csa.F dfa.F diff12.f distfit.f @@ -73,6 +73,7 @@ set(UNRES_CSA_PP_SRC cartder.F chainbuild.F checkder_p.F + csa.F dfa.F econstr_local.F energy_p_new_barrier.F @@ -119,10 +120,10 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_CSA_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -135,19 +136,19 @@ set_property(SOURCE ${UNRES_CSA_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= if(UNRES_CSA_FF STREQUAL "CASP3" ) - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_TOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMOMENT" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCRYST_TOR" ) elseif(UNRES_CSA_FF STREQUAL "ALPHA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "BETA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "ALPHABETA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "CASP5") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "3P") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "4P") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) endif(UNRES_CSA_FF STREQUAL "CASP3") #========================================= @@ -177,6 +178,13 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") #========================================= set(CPPFLAGS "${CPPFLAGS} -DMP -DMPI") +#========================================= +# add 64-bit specific preprocessor flags +#========================================= +if (architektura STREQUAL "64") + set(CPPFLAGS "${CPPFLAGS} -DAMD64") +endif (architektura STREQUAL "64") + # Apply preprocesor flags to *.F files set_property(SOURCE ${UNRES_CSA_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) @@ -228,19 +236,24 @@ set(UNRES_CSA_SRCS ${UNRES_CSA_SRC0} ${UNRES_CSA_SRC3} ${CMAKE_CURRENT_BINARY_DI #========================================= add_executable(UNRES_BIN-CSA ${UNRES_CSA_SRCS} ) set_target_properties(UNRES_BIN-CSA PROPERTIES OUTPUT_NAME ${UNRES_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_BIN-CSA PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= # Link libraries #========================================= # link MPI library (libmpich.a) -target_link_libraries( UNRES_BIN-CSA ${MPIF_LIBRARIES} ) +target_link_libraries( UNRES_BIN-CSA ${MPI_Fortran_LIBRARIES} ) # link libxdrf.a #target_link_libraries( ${UNRES_BIN} xdrf ) #========================================= +# Install Path +#========================================= +install(TARGETS UNRES_BIN-CSA DESTINATION ${CMAKE_INSTALL_PREFIX}/unres/CSA) + + +#========================================= # TESTS #========================================= diff --git a/source/unres/src_CSA/COMMON.DFA b/source/unres/src_CSA/COMMON.DFA index 1c750cf..c6add4f 100644 --- a/source/unres/src_CSA/COMMON.DFA +++ b/source/unres/src_CSA/COMMON.DFA @@ -51,7 +51,7 @@ C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, & IDISLIS,IPHILIS,ITHELIS,INEILIS, & IDISNUM,IPHINUM,ITHENUM,INEINUM, - & FNEI, + & FNEI,DFACMD, DFANUM, & NCA,ICAIDX, & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL & ishiftca,ilastca @@ -82,7 +82,7 @@ C & FTHE1, FTHE2, & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, & WSHET, EDFABET, - & CK, SCK + & CK, SCK, S1, S2 c & ,DFAEXP COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), diff --git a/source/unres/src_CSA/COMMON.SCCOR b/source/unres/src_CSA/COMMON.SCCOR index 5217de7..a28f621 100644 --- a/source/unres/src_CSA/COMMON.SCCOR +++ b/source/unres/src_CSA/COMMON.SCCOR @@ -1,6 +1,6 @@ C Parameters of the SCCOR term double precision v1sccor,v2sccor integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), + common/sccor/v1sccor(maxterm_sccor,20,20), & v2sccor(maxterm_sccor,20,20), & nterm_sccor diff --git a/source/unres/src_CSA/COMMON.TORSION b/source/unres/src_CSA/COMMON.TORSION index 6b6605f..d4cb8e4 100644 --- a/source/unres/src_CSA/COMMON.TORSION +++ b/source/unres/src_CSA/COMMON.TORSION @@ -1,11 +1,17 @@ C Torsional constants of the rotation about virtual-bond dihedral angles double precision v1,v2,vlor1,vlor2,vlor3,v0 integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), - & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor) - & ,nterm_old + common/torsion/ v0(maxtor,maxtor), + & v1(maxterm,maxtor,maxtor), + & v2(maxterm,maxtor,maxtor), + & vlor1(maxlor,maxtor,maxtor), + & vlor2(maxlor,maxtor,maxtor), + & vlor3(maxlor,maxtor,maxtor), + & itortyp(ntyp), + & ntortyp, + & nterm(maxtor,maxtor), + & nlor(maxtor,maxtor), + & nterm_old C 6/23/01 - constants for double torsionals double precision v1c,v1s,v2c,v2s integer ntermd_1,ntermd_2 diff --git a/source/unres/src_CSA/Makefile b/source/unres/src_CSA/Makefile index 4b6b59c..8453cdd 120000 --- a/source/unres/src_CSA/Makefile +++ b/source/unres/src_CSA/Makefile @@ -1 +1 @@ -Makefile_4P \ No newline at end of file +Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/unres/src_CSA/Makefile-DFA-NEWPARM.kias b/source/unres/src_CSA/Makefile-DFA-NEWPARM.kias deleted file mode 100644 index 1df87fb..0000000 --- a/source/unres/src_CSA/Makefile-DFA-NEWPARM.kias +++ /dev/null @@ -1,101 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel - -FC= ifort - -OPT = -O3 -ip -w -#OPT = -O0 - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_nh_hremd_021811_dfa_csa.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile-DFA-NEWPARM.piasek b/source/unres/src_CSA/Makefile-DFA-NEWPARM.piasek deleted file mode 100644 index 43cd300..0000000 --- a/source/unres/src_CSA/Makefile-DFA-NEWPARM.piasek +++ /dev/null @@ -1,108 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -#INSTALL_DIR = /opt/mpi/mvapich -INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -#FCL = ${INSTALL_DIR}/bin/mpif77 -#CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../../../bin/unres/CSA/unres_dfa_csa-Yi.exe -#BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -#LIBS = -L$(INSTALL_DIR)/lib -lmpich -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - -#all: unresCSA -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -#unresCSA: ${object} -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo - ${FC} ${FFLAGS} cinfo.f -# ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile-DFA-OLDPARM.galera b/source/unres/src_CSA/Makefile-DFA-OLDPARM.galera deleted file mode 100644 index a56aeb6..0000000 --- a/source/unres/src_CSA/Makefile-DFA-OLDPARM.galera +++ /dev/null @@ -1,96 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -INSTALL_DIR = /opt/mpi/mvapich -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 -CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_new_em64_dfa_csa-4P.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unresCSA: ${object} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS} ${CPPFLAGS} dfa.F diff --git a/source/unres/src_CSA/Makefile-DFA-OLDPARM.gfortran b/source/unres/src_CSA/Makefile-DFA-OLDPARM.gfortran deleted file mode 100644 index 33e528a..0000000 --- a/source/unres/src_CSA/Makefile-DFA-OLDPARM.gfortran +++ /dev/null @@ -1,103 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DG77 -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -INSTALL_DIR = /users/local/mpich2-1.3.1/ - - -FC= gfortran - -OPT = -O - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -I$(INSTALL_DIR)/include -FFLAGS2 = -c -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -O -I$(INSTALL_DIR)/include -FFLAGSE = -c -O3 -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_dfa_csa_4P_gfortran.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich -lmpl -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile-DFA-OLDPARM.kias b/source/unres/src_CSA/Makefile-DFA-OLDPARM.kias deleted file mode 100644 index 54502d9..0000000 --- a/source/unres/src_CSA/Makefile-DFA-OLDPARM.kias +++ /dev/null @@ -1,101 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -#INSTALL_DIR =/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_050711_dfa_csa_4P_800.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile-DFA-OLDPARM.piasek b/source/unres/src_CSA/Makefile-DFA-OLDPARM.piasek deleted file mode 100644 index e18df8f..0000000 --- a/source/unres/src_CSA/Makefile-DFA-OLDPARM.piasek +++ /dev/null @@ -1,102 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile-single_4P b/source/unres/src_CSA/Makefile-single_4P deleted file mode 100644 index b521426..0000000 --- a/source/unres/src_CSA/Makefile-single_4P +++ /dev/null @@ -1,91 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_single-1.2.7p1.exe -LIBS = - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile_4P b/source/unres/src_CSA/Makefile_4P deleted file mode 100644 index 915eec2..0000000 --- a/source/unres/src_CSA/Makefile_4P +++ /dev/null @@ -1,100 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/Makefile_CASP3 b/source/unres/src_CSA/Makefile_CASP3 deleted file mode 100644 index c9ff0be..0000000 --- a/source/unres/src_CSA/Makefile_CASP3 +++ /dev/null @@ -1,100 +0,0 @@ -CPPFLAGS = -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DMOMENT \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa-CASP3_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA/csa.f b/source/unres/src_CSA/csa.f deleted file mode 100644 index a5149f2..0000000 --- a/source/unres/src_CSA/csa.f +++ /dev/null @@ -1,366 +0,0 @@ - subroutine make_array - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.CSA' - -ccccccccccccccccccccccccc -c Level-2: group -ccccccccccccccccccccccccc - - indg=0 - do k=1,numch -ccccccccccccccccccccccccccccccccccccccccc -! Groups the THETAs and the GAMMAs - do j=2,nres-1 - indg=indg+1 - if (j.lt.nres-1) then - ngroup(indg)=2 - else - ngroup(indg)=1 - endif - do i=1,ngroup(indg) - igroup(1,i,indg)=i - igroup(2,i,indg)=j - igroup(3,i,indg)=k - enddo - enddo -ccccccccccccccccccccccccccccccccccccccccc - enddo -! Groups the ALPHAs and the BETAs - do k=1,numch - do j=2,nres-1 - if(itype(j).ne.10) then - indg=indg+1 - ngroup(indg)=2 - do i=1,ngroup(indg) - igroup(1,i,indg)=i+2 - igroup(2,i,indg)=j - igroup(3,i,indg)=k - enddo - endif - enddo - enddo - - ntotgr=indg - write(iout,*) - write(iout,*) "# of groups: ",ntotgr - do i=1,ntotgr - write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i)) - enddo -! close(iout) - - 40 format(i3,3x,3i3) - 41 format(2i3,3x,6(3i3,2x)) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_ranvar(n,m,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' -c al m=0 - print *,'HOHOHOHO Make_RanVar!!!!!',n,m - itrial=0 - do while(m.lt.n .and. itrial.le.10000) - itrial=itrial+1 - jeden=1 - call gen_rand_conf(jeden,*10) - call intout - m=m+1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - goto 20 - 10 write (iout,*) 'Failed to generate conformation #',m+1, - & ' itrial=',itrial - 20 continue - enddo - print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_ranvar_reg(n,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' - include 'COMMON.GEO' - m=0 - print *,'HOHOHOHO Make_RanVar_reg!!!!!' - itrial=0 - do while(m.lt.n .and. itrial.le.10000) - itrial=itrial+1 - jeden=1 - call gen_rand_conf(jeden,*10) -! call intout - m=m+1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - if(m.le.n*0.1) then - dihang_in(1,j,1,m)=90.0*deg2rad - dihang_in(2,j,1,m)=50.0*deg2rad - endif - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - goto 20 - 10 write (iout,*) 'Failed to generate conformation #',m+1, - & ' itrial=',itrial - 20 continue - enddo - print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine from_pdb(n,idum) -c This subroutine stores the UNRES int variables generated from -c subroutine readpdb into the 1st conformation of in dihang_in. -c Subsequent n-1 conformations of dihang_in have identical values -c of theta and phi as the 1st conformation but random values for -c alph and omeg. -c The array cref (also generated from subroutine readpdb) is stored -c to crefjlee to be used for rmsd calculation in CSA, if necessary. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' - include 'COMMON.GEO' - - m=1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,k)=0.0d0 - - do m=2,n - do k=2,nres-1 - dihang_in(1,k,1,m)=dihang_in(1,k,1,1) - dihang_in(2,k,1,m)=dihang_in(2,k,1,1) - if(dabs(dihang_in(3,k,1,1)).gt.1.d-6) then - dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0 - dihang_in(3,k,1,m)=dihang_in(3,k,1,m)*deg2rad - endif - if(dabs(dihang_in(4,k,1,1)).gt.1.d-6) then - dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0 - dihang_in(4,k,1,m)=dihang_in(4,k,1,m)*deg2rad - endif - enddo - enddo - -c Store cref to crefjlee (they are in COMMON.CHAIN). - do k=1,2*nres - do kk=1,3 - crefjlee(kk,k)=cref(kk,k) - enddo - enddo - - open(icsa_native_int,file=csa_native_int,status="old") - do m=1,n - write(icsa_native_int,*) m,e - write(icsa_native_int,200) - & (dihang_in(1,k,1,m)*rad2deg,k=2,nres-1) - write(icsa_native_int,200) - & (dihang_in(2,k,1,m)*rad2deg,k=2,nres-2) - write(icsa_native_int,200) - & (dihang_in(3,k,1,m)*rad2deg,k=2,nres-1) - write(icsa_native_int,200) - & (dihang_in(4,k,1,m)*rad2deg,k=2,nres-1) - enddo - - do k=1,nres - write(icsa_native_int,200) (crefjlee(i,k),i=1,3) - enddo - close(icsa_native_int) - - 200 format (8f10.4) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine from_int(n,mm,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.BANK' - include 'COMMON.GEO' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - integer ilen - external ilen - logical fail - double precision energia(0:n_ene) - - open(icsa_native_int,file=csa_native_int,status="old") - read (icsa_native_int,*) - call read_angles(icsa_native_int,*10) - goto 11 - 10 write (iout,'(2a)') "CHUJ NASTAPIL - error in ", - & csa_native_int(:ilen(csa_native_int)) - 11 continue - call intout - do j=2,nres-1 - dihang_in(1,j,1,1)=theta(j+1) - dihang_in(2,j,1,1)=phi(j+2) - dihang_in(3,j,1,1)=alph(j) - dihang_in(4,j,1,1)=omeg(j) - enddo - dihang_in(2,nres-1,1,1)=0.0d0 - -c read(icsa_native_int,*) ind,e -c read(icsa_native_int,200) (dihang_in(1,k,1,1),k=2,nres-1) -c read(icsa_native_int,200) (dihang_in(2,k,1,1),k=2,nres-2) -c read(icsa_native_int,200) (dihang_in(3,k,1,1),k=2,nres-1) -c read(icsa_native_int,200) (dihang_in(4,k,1,1),k=2,nres-1) -c dihang_in(2,nres-1,1,1)=0.d0 - - maxsi=100 - maxcount_fail=100 - - do m=mm+2,n -c do k=2,nres-1 -c dihang_in(1,k,1,m)=dihang_in(1,k,1,1) -c dihang_in(2,k,1,m)=dihang_in(2,k,1,1) -c if(abs(dihang_in(3,k,1,1)).gt.1.d-3) then -c dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0 -c endif -c if(abs(dihang_in(4,k,1,1)).gt.1.d-3) then -c dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0 -c endif -c enddo -c call intout - fail=.true. - - icount_fail=0 - - DO WHILE (FAIL .AND. ICOUNT_FAIL .LE. MAXCOUNT_FAIL) - - do i=nnt,nct - if (itype(i).ne.10) then -cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1) - fail=.true. - ii=0 - do while (fail .and. ii .le. maxsi) - call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail) - ii = ii+1 - enddo - endif - enddo - call chainbuild - call etotal(energia(0)) - fail = (energia(0).ge.1.0d20) - icount_fail=icount_fail+1 - - ENDDO - - if (icount_fail.gt.maxcount_fail) then - write (iout,*) - & 'Failed to generate non-overlaping near-native conf.', - & m - endif - - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - enddo - -c do m=1,n -c write(icsa_native_int,*) m,e -c write(icsa_native_int,200) (dihang_in(1,k,1,m),k=2,nres-1) -c write(icsa_native_int,200) (dihang_in(2,k,1,m),k=2,nres-2) -c write(icsa_native_int,200) (dihang_in(3,k,1,m),k=2,nres-1) -c write(icsa_native_int,200) (dihang_in(4,k,1,m),k=2,nres-1) -c enddo -c close(icsa_native_int) - -c do m=mm+2,n -c do i=1,4 -c do j=2,nres-1 -c dihang_in(i,j,1,m)=dihang_in(i,j,1,m)*deg2rad -c enddo -c enddo -c enddo - - call dihang_to_c(dihang_in(1,1,1,1)) - -c Store c to cref (they are in COMMON.CHAIN). - do k=1,2*nres - do kk=1,3 - crefjlee(kk,k)=c(kk,k) - enddo - enddo - - call contact(.true.,ncont_ref,icont_ref,co) - -c do k=1,nres -c write(icsa_native_int,200) (crefjlee(i,k),i=1,3) -c enddo - close(icsa_native_int) - - 200 format (8f10.4) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine dihang_to_c(aarray) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - - dimension aarray(mxang,maxres,mxch) - -c do i=4,nres -c phi(i)=dihang_in(1,i-2,1,1) -c enddo - do i=2,nres-1 - theta(i+1)=aarray(1,i,1) - phi(i+2)=aarray(2,i,1) - alph(i)=aarray(3,i,1) - omeg(i)=aarray(4,i,1) - enddo - - call chainbuild - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc diff --git a/source/unres/src_CSA/energy_p_new_barrier.F b/source/unres/src_CSA/energy_p_new_barrier.F index 821d8f7..015a2b3 100644 --- a/source/unres/src_CSA/energy_p_new_barrier.F +++ b/source/unres/src_CSA/energy_p_new_barrier.F @@ -8133,7 +8133,7 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/source/unres/src_CSA/initialize_p.F b/source/unres/src_CSA/initialize_p.F index 19cf3d6..b3affab 100644 --- a/source/unres/src_CSA/initialize_p.F +++ b/source/unres/src_CSA/initialize_p.F @@ -293,11 +293,11 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.DERIV' include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1), + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1), & ntask_cont_from_all(0:max_fg_procs-1), & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), & ntask_cont_to_all(0:max_fg_procs-1), @@ -1112,15 +1112,16 @@ c--------------------------------------------------------------------------- include "COMMON.INTERACT" include "COMMON.SETUP" include "COMMON.IOUNITS" - integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1) + integer ii,jj,itask(4),ntask_cont_to, + & itask_cont_to(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,isent,k,l c Determines whether to send interaction ii,jj to other processors; a given c interaction can be sent to at most 2 processors. @@ -1202,15 +1203,15 @@ c--------------------------------------------------------------------------- include "COMMON.SETUP" include "COMMON.IOUNITS" integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:MaxProcs-1) + & itask_cont_from(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,k,l do iproc=fg_rank+1,nfgtasks-1 do k=iturn3_start_all(iproc),iturn3_end_all(iproc) @@ -1262,7 +1263,7 @@ c--------------------------------------------------------------------------- subroutine add_task(iproc,ntask_cont,itask_cont) implicit none include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:MaxProcs-1) + integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) integer ii do ii=1,ntask_cont if (itask_cont(ii).eq.iproc) return diff --git a/source/unres/src_CSA/local_move.f b/source/unres/src_CSA/local_move.f index d02a9d1..d9980fe 100644 --- a/source/unres/src_CSA/local_move.f +++ b/source/unres/src_CSA/local_move.f @@ -129,7 +129,7 @@ c$$$ endif c$$$ endif c The actual move, on residue i - iretcode=move_res(min,max,i,c) ! Discard iretcode + iretcode=move_res(min,max,i) ! Discard iretcode i=i+1 if (i.le.j) then @@ -150,7 +150,7 @@ c$$$ endif c$$$ endif c The actual move, on residue j - iretcode=move_res(min,max,j,c) ! Discard iretcode + iretcode=move_res(min,max,j) ! Discard iretcode j=j-1 endif enddo @@ -960,7 +960,8 @@ c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg R(j,i)=vbl*R(j,i) enddo enddo - i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) + imov=2 + i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov) print *,'RETURNED ',i print *,(R(i,3)/vbl,i=0,2) diff --git a/source/unres/src_CSA/parmread.F b/source/unres/src_CSA/parmread.F index 5a7b99f..0a99250 100644 --- a/source/unres/src_CSA/parmread.F +++ b/source/unres/src_CSA/parmread.F @@ -276,7 +276,7 @@ C enddo call flush(iout) endif - write (2,*) "Start reading THETA_PDB" +c write (2,*) "Start reading THETA_PDB" do i=1,ntyp read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), & (bthet(j,i),j=1,2) diff --git a/source/unres/src_CSA/readrtns_csa.F b/source/unres/src_CSA/readrtns_csa.F index 9ab4510..e88a67e 100644 --- a/source/unres/src_CSA/readrtns_csa.F +++ b/source/unres/src_CSA/readrtns_csa.F @@ -73,7 +73,7 @@ c include 'COMMON.THREAD' include 'COMMON.MCM' c include 'COMMON.MAP' include 'COMMON.HEADER' -c include 'COMMON.CSA' + include 'COMMON.CSA' include 'COMMON.CHAIN' c include 'COMMON.MUCA' c include 'COMMON.MD' @@ -808,9 +808,6 @@ c call gen_rand_conf(itmp,*31) endif C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif call setup_var if (me.eq.king .or. .not. out1file) & call intout diff --git a/source/unres/src_CSA/together.F b/source/unres/src_CSA/together.F index 8bc9d7a..099c469 100644 --- a/source/unres/src_CSA/together.F +++ b/source/unres/src_CSA/together.F @@ -878,6 +878,7 @@ c receives and stores data from soldiers include 'COMMON.CHAIN' include 'COMMON.CONTACTS' dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1) + dimension cout(2) cjlee double precision przes(3),obr(3,3) logical non_conv diff --git a/source/unres/src_CSA_DiL/CMakeLists.txt b/source/unres/src_CSA_DiL/CMakeLists.txt index 04fb4bb..5ce2b00 100644 --- a/source/unres/src_CSA_DiL/CMakeLists.txt +++ b/source/unres/src_CSA_DiL/CMakeLists.txt @@ -18,7 +18,7 @@ set(UNRES_CSA_DiL_SRC0 contact.f convert.f cored.f - csa.f + csa.F dfa.F diff12.f distfit.f @@ -73,6 +73,7 @@ set(UNRES_CSA_DiL_PP_SRC cartder.F chainbuild.F checkder_p.F + csa.F dfa.F econstr_local.F energy_p_new_barrier.F @@ -119,10 +120,10 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_CSA_DiL_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -135,19 +136,19 @@ set_property(SOURCE ${UNRES_CSA_DiL_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= if(UNRES_CSA_FF STREQUAL "CASP3" ) - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_TOR -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DMOMENT" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCRYST_TOR" ) elseif(UNRES_CSA_FF STREQUAL "ALPHA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "BETA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "ALPHABETA") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "CASP5") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DMOMENT -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "3P") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) elseif(UNRES_CSA_FF STREQUAL "4P") - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) endif(UNRES_CSA_FF STREQUAL "CASP3") #========================================= @@ -177,14 +178,24 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") #========================================= set(CPPFLAGS "${CPPFLAGS} -DMP -DMPI") +#========================================= +# add 64-bit specific preprocessor flags +#========================================= +if (architektura STREQUAL "64") + set(CPPFLAGS "${CPPFLAGS} -DAMD64") +endif (architektura STREQUAL "64") + + +#========================================= # Apply preprocesor flags to *.F files +#========================================= set_property(SOURCE ${UNRES_CSA_DiL_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) #======================================== # Setting binary name #======================================== -set(UNRES_BIN "unresCSA_${Fortran_COMPILER_NAME}_${UNRES_CSA_FF}_DiL.exe") +set(UNRES_BIN "unresCSA_DiL_${Fortran_COMPILER_NAME}_${UNRES_CSA_FF}.exe") #========================================= # cinfo.f workaround for CMake @@ -228,17 +239,19 @@ set(UNRES_CSA_DiL_SRCS ${UNRES_CSA_DiL_SRC0} ${UNRES_CSA_DiL_SRC3} ${CMAKE_CURRE #========================================= add_executable(UNRES_BIN-CSA-DIL ${UNRES_CSA_DiL_SRCS} ) set_target_properties(UNRES_BIN-CSA-DIL PROPERTIES OUTPUT_NAME ${UNRES_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) -#add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) +set_property(TARGET UNRES_BIN-CSA-DIL PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #========================================= # Link libraries #========================================= -# link MPI library (libmpich.a) -target_link_libraries( UNRES_BIN-CSA-DIL ${MPIF_LIBRARIES} ) -# link libxdrf.a -#target_link_libraries( ${UNRES_BIN} xdrf ) +# link MPI libraries +target_link_libraries( UNRES_BIN-CSA-DIL ${MPI_Fortran_LIBRARIES} ) + +#========================================= +# Install Path +#========================================= +install(TARGETS UNRES_BIN-CSA-DIL DESTINATION ${CMAKE_INSTALL_PREFIX}) + #========================================= # TESTS diff --git a/source/unres/src_CSA_DiL/COMMON.BANK b/source/unres/src_CSA_DiL/COMMON.BANK deleted file mode 100644 index 5b0fb34..0000000 --- a/source/unres/src_CSA_DiL/COMMON.BANK +++ /dev/null @@ -1,29 +0,0 @@ - real*8 dihang,etot,bvar,bene,rene,rvar,avedif,difmin, - & ebmin,ebmax,ebmaxt,cutdif,dij,dihang_in - integer ibank,is,jbank,ibmin,ibmax,nbank,nconf,iuse,nstep,icycle, - & iseed,ntbank,ntbankm,iref,nconf_in,indb,ilastnstep, - & bvar_nss,bvar_ss,bvar_ns,bvar_s, - & nss_in,iss_in,jss_in,nadd - common/varin/dihang_in(mxang,maxres,mxch,mxio),nss_in(mxio), - & iss_in(maxss,mxio),jss_in(maxss,mxio) - common/minvar/dihang(mxang,maxres,mxch,mxio),etot(mxio),rmsn(mxio) - & ,pncn(mxio),nss_out(mxio), - & iss_out(maxss,mxio),jss_out(maxss,mxio) - common/bank/ - * bvar(mxang,maxres,mxch,mxio),bene(mxio),rene(mxio), - * brmsn(mxio),rrmsn(mxio), - * bpncn(mxio),rpncn(mxio), - * rvar(mxang,maxres,mxch,mxio),ibank(mxio),is(mxio), - * avedif,difmin,ebmin,ebmax,ebmaxt,dele,difcut,cutdif, - * rmscut,pnccut, - * jbank(mxio),dij(mxio,mxio),ibmin,ibmax, - * nbank,ntbank,ntbankm,nconf,iuse,nstep,icycle,iseed,iref, - * nconf_in,ilastnstep,nadd - common/bank_disulfid/ bvar_nss(mxio),bvar_ss(2,maxss,mxio), - * bvar_ns(mxio),bvar_s(maxss,mxio) - common/mvstat/ movenx(mxio),movernx(mxio), - & nstatnx(0:mxmv,3),nstatnx_tot(0:mxmv,3),indb(mxio,9), - & parent(3,mxio) - common/send2/isend2(mxio),iff_in(maxres,mxio2), - & dihang_in2(mxang,maxres,mxch,mxio2), - & idata(5,mxio) diff --git a/source/unres/src_CSA_DiL/COMMON.BOUNDS b/source/unres/src_CSA_DiL/COMMON.BOUNDS deleted file mode 100644 index f3859ae..0000000 --- a/source/unres/src_CSA_DiL/COMMON.BOUNDS +++ /dev/null @@ -1,2 +0,0 @@ - double precision phibound(2,maxres) - common /bounds/ phibound diff --git a/source/unres/src_CSA_DiL/COMMON.CALC b/source/unres/src_CSA_DiL/COMMON.CALC deleted file mode 100644 index 67b4bb9..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CALC +++ /dev/null @@ -1,15 +0,0 @@ - integer i,j,k,l - double precision erij,rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg - common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j diff --git a/source/unres/src_CSA_DiL/COMMON.CHAIN b/source/unres/src_CSA_DiL/COMMON.CHAIN deleted file mode 100644 index f7a8a1d..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CHAIN +++ /dev/null @@ -1,12 +0,0 @@ - integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, - & nres0,nstart_seq - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, - & prod,rt,dc_work,cref,crefjlee - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), - & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), - & nsup,nstart_sup,nstart_seq - common /from_zscore/ nz_start,nz_end,iz_sc diff --git a/source/unres/src_CSA_DiL/COMMON.CONTACTS b/source/unres/src_CSA_DiL/COMMON.CONTACTS deleted file mode 100644 index dfc8da2..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CONTACTS +++ /dev/null @@ -1,75 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres), - & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres), - & Dtobr2(2,maxres),Dtobr2der(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres), - & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont -C 12/13/2008 (again Poland-Jaruzel war anniversary) -C RE: Parallelization of 4th and higher order loc-el correlations - integer ncont_sent,ncont_recv,iint_sent,iisent_local, - & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to, - & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local, - & iturn4_sent_local - common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres), - & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres), - & iturn3_sent(4,maxres),iturn4_sent(4,maxres), - & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres), - & nat_sent,iat_sent(maxres),itask_cont_from(0:max_fg_procs-1), - & itask_cont_to(0:max_fg_procs-1),ntask_cont_from,ntask_cont_to diff --git a/source/unres/src_CSA_DiL/COMMON.CONTACTS.MOMENT b/source/unres/src_CSA_DiL/COMMON.CONTACTS.MOMENT deleted file mode 100644 index 16fae0e..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CONTACTS.MOMENT +++ /dev/null @@ -1,7 +0,0 @@ -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -c 7/25/08 Commented out; not needed when cumulants used -C Interactions of pseudo-dipoles generated by loc-el interactions. - double precision dip,dipderg,dipderx - common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), - & dipderx(3,5,4,maxconts,maxres) diff --git a/source/unres/src_CSA_DiL/COMMON.CONTROL b/source/unres/src_CSA_DiL/COMMON.CONTROL deleted file mode 100644 index c12ef3a..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CONTROL +++ /dev/null @@ -1,13 +0,0 @@ - integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad, - & inprint,i2ndstr,mucadyn,constr_dist - logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec, - & sideadd,lsecondary,read_cart,unres_pdb, - & vdisulf,searchsc,lmuca,dccart,extconf,out1file, - & gnorm_check,gradout,split_ene - common /cntrl/ modecalc,iscode,indpdb,indback,indphi,iranconf, - & icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint, - & overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb - & ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file, - & constr_dist,gnorm_check,gradout,split_ene -C... minim = .true. means DO minimization. -C... energy_dec = .true. means print energy decomposition matrix diff --git a/source/unres/src_CSA_DiL/COMMON.CSA b/source/unres/src_CSA_DiL/COMMON.CSA deleted file mode 100644 index 9c117c0..0000000 --- a/source/unres/src_CSA_DiL/COMMON.CSA +++ /dev/null @@ -1,11 +0,0 @@ - integer ngroup,igroup,ntotgr,numch,irestart,ndiff,nbankm,iucut - double precision diffcut - common/alphaa/ ngroup(mxgr),igroup(3,mxang,mxgr),ntotgr,numch - common/csa_input/cut1,cut2,eglob_csa,estop,jstart,jend, - & n1,n2,n3,n4,n5,n6,n7,n8,n9,n14,n15,n16,n17,n18,n0, - & is1,is2,nseed,ntotal,icmax,nstmax,irestart,nran0,nran1,irr, - & nglob_csa,nmin_csa,ndiff,nbankm,iucut - logical ldih_bias,tm_score - common/dih_control/rdih_bias,ldih_bias,tm_score - common/diffcuta/ diffcut - diff --git a/source/unres/src_CSA_DiL/COMMON.DERIV b/source/unres/src_CSA_DiL/COMMON.DERIV deleted file mode 100644 index 4cf9f16..0000000 --- a/source/unres/src_CSA_DiL/COMMON.DERIV +++ /dev/null @@ -1,38 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, - & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT - integer nfl,icg - common /derivatT/ gvdwcT(3,maxres),gvdwxT(3,maxres) - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg , - & gdfad(3,maxres),gdfat(3,maxres),gdfan(3,maxres),gdfab(3,maxres) - - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab - integer igrad_start,igrad_end,jgrad_start(maxres), - & jgrad_end(maxres) - common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/unres/src_CSA_DiL/COMMON.DFA b/source/unres/src_CSA_DiL/COMMON.DFA deleted file mode 100644 index 1c750cf..0000000 --- a/source/unres/src_CSA_DiL/COMMON.DFA +++ /dev/null @@ -1,101 +0,0 @@ -C ======= -C COMMON.DFA -C ======= -C 2010/12/20 By Juyong Lee -C -c parameter -C [ 8 * ( Nres - 8 ) ] distance restraints -C [ 2 * ( Nres - 8 ) ] angle restraints -C [ Nres ] neighbor restraints -C Total : ~ 11 * Nres restraints -C -C - INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) - PARAMETER(MAXN=4) - real*8 wwdist,wwangle,wwnei - parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) - -C IDFAMAX - maximum number of DFA restraint including distance, angle and -C number of neighbors ( Max of assign statement ) -C IDFAMX2 - maximum number of atoms which are targets of restraints -C IDFACMD - maximum number of 'DFA' command call -C IDMAXMIN - Maximum number of minima of dist, angle and neighbor info. from fragments -C MAXN - Maximum Number of shell, currently 4 -C MAXRES - Maximum number of CAs - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc -C INTEGER -C DFANUM - Number of ALL DFA restrants -c IDFA[DIS, PHI, THE, NEI] - NUMBER of restraints -c IDISNUM - number of minima for a distance restraint -c IPHINUM - number of minima for a phi angle restraint -c ITHENUM - number of minima for a theta angle restraint -c INEINUM - number of minima for a number of neighbors restraint - -c IDISLIS - atom number of two atoms for distance restraint -c IPHILIS - atom numbers of four atoms for angle restraint -c ITHELIS - atom numbers of four atoms for angle restraint -c INEILIS - atom number of center of neighbor calculation -c JNEILIS - atom number of target of neighboring calculation -c JNEINUM - number of target atoms of neighboring term -C KSHELL - SHELL number - -C ishiftca - index shift for CA atoms in UNRES (1 if the 1st aa != GLY) -C ilastca - index of the last CA atom in UNRES (nres-1 if last aa != GLY) - -C old only for CHARMM -C STOAGDF - Store assign information ( How many assign within one command ) -C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei - - INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, - & IDISLIS,IPHILIS,ITHELIS,INEILIS, - & IDISNUM,IPHINUM,ITHENUM,INEINUM, - & FNEI, - & NCA,ICAIDX, - & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL - & ishiftca,ilastca - COMMON /IDFA/ DFACMD, DFANUM, - & IDFADIS, IDFAPHI, IDFANEI, IDFATHE, - & IDISNUM(IDFAMAX), IPHINUM(IDFAMAX), - & ITHENUM(IDFAMAX), INEINUM(IDFAMAX), - & FNEI(IDFAMAX,IDMAXMIN), IDISLIS(2,IDFAMAX), - & IPHILIS(5,IDFAMAX), ITHELIS(5,IDFAMAX), - & INEILIS(IDFAMAX), - & KSHELL(IDFAMAX), - & IDFACAT(IDFACMD), - & KDISNUM(IDFAMAX), - & NCA, ICAIDX(MAXRES) - COMMON /IDFA2/ ishiftca,ilastca - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C REAL VARIABLES -C -c SCC[DIST, PHI, THE] - weight of each calculations -c FDIST - distance minima -C FPHI - phi minima -c FTHE - theta minima -C DFAEXP : calculate expential function in advance -C - REAL*8 SCCDIST, SCCPHI, SCCTHE, SCCNEI, FDIST, FPHI1, FPHI2, - & FTHE1, FTHE2, - & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, - & WSHET, EDFABET, - & CK, SCK -c & ,DFAEXP - - COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), - & SCCPHI(IDFAMAX,IDMAXMIN), SCCTHE(IDFAMAX,IDMAXMIN), - & SCCNEI(IDFAMAX,IDMAXMIN), - & FPHI1(IDFAMAX,IDMAXMIN), FPHI2(IDFAMAX,IDMAXMIN), - & FTHE1(IDFAMAX,IDMAXMIN), FTHE2(IDFAMAX,IDMAXMIN), - & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, - & WSHET(MAXRES,MAXRES), EDFABET, - & CK(4),SCK(4),S1(4),S2(4) -c & ,DFAEXP(15001), - - DATA CK/1.0D0,1.58740105197D0,2.08008382305D0,2.51984209979D0/ - DATA SCK/1.0D0,1.25992104989D0,1.44224957031D0,1.58740105197D0/ - DATA S1/3.75D0,5.75D0,7.75D0,9.75D0/ - DATA S2/4.25D0,6.25D0,8.25D0,10.25D0/ diff --git a/source/unres/src_CSA_DiL/COMMON.DISTFIT b/source/unres/src_CSA_DiL/COMMON.DISTFIT deleted file mode 100644 index 044225b..0000000 --- a/source/unres/src_CSA_DiL/COMMON.DISTFIT +++ /dev/null @@ -1,14 +0,0 @@ -c parameter (maxres22=maxres*(maxres+1)/2) - parameter (maxres22=1) - double precision w,d0,DRDG,DD,H,XX - integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, - 1 lvar_frag,svar_frag,avar_frag - COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3) - COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), - 1 lvar_frag(mxio,3),svar_frag(mxio,3), - 2 avar_frag(mxio,5) - COMMON /WAGI/ w(MAXRES22),d0(MAXRES22) - COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22), - 1 H(MAXRES,MAXRES),XX(MAXRES) - COMMON /frozen/ mask(maxres) - COMMON /store0/ nhpb0 diff --git a/source/unres/src_CSA_DiL/COMMON.FFIELD b/source/unres/src_CSA_DiL/COMMON.FFIELD deleted file mode 100644 index 29c73f0..0000000 --- a/source/unres/src_CSA_DiL/COMMON.FFIELD +++ /dev/null @@ -1,26 +0,0 @@ -C----------------------------------------------------------------------- -C The following COMMON block selects the type of the force field used in -C calculations and defines weights of various energy terms. -C 12/1/95 wcorr added -C----------------------------------------------------------------------- - integer n_ene_comp,rescale_mode - common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang, - & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wsct,weights(n_ene),temp0, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode - common /potentials/ potname(5) - character*3 potname -C----------------------------------------------------------------------- -C wlong,welec,wtor,wang,wscloc are the weight of the energy terms -C corresponding to side-chain, electrostatic, torsional, valence-angle, -C and local side-chain terms. -C -C IPOT determines which SC...SC interaction potential will be used: -C 1 - LJ: 2n-n Lennard-Jones -C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -C 3 - BP; Berne-Pechukas (angular dependence) -C 4 - GB; Gay-Berne (angular dependence) -C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -C------------------------------------------------------------------------ diff --git a/source/unres/src_CSA_DiL/COMMON.GEO b/source/unres/src_CSA_DiL/COMMON.GEO deleted file mode 100644 index 8cfbbde..0000000 --- a/source/unres/src_CSA_DiL/COMMON.GEO +++ /dev/null @@ -1,2 +0,0 @@ - double precision pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin - common /geo/ pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin diff --git a/source/unres/src_CSA_DiL/COMMON.HAIRPIN b/source/unres/src_CSA_DiL/COMMON.HAIRPIN deleted file mode 100644 index f103268..0000000 --- a/source/unres/src_CSA_DiL/COMMON.HAIRPIN +++ /dev/null @@ -1,5 +0,0 @@ - integer nharp_seed(max_seed),nharp_tot, - & iharp_seed(4,maxres/3,max_seed),iharp_use(0:4,maxres/3,max_seed), - & nharp_use(max_seed) - common /spinka/ nharp_seed,nharp_tot,iharp_seed,iharp_use, - & nharp_use diff --git a/source/unres/src_CSA_DiL/COMMON.HEADER b/source/unres/src_CSA_DiL/COMMON.HEADER deleted file mode 100644 index 7154812..0000000 --- a/source/unres/src_CSA_DiL/COMMON.HEADER +++ /dev/null @@ -1,2 +0,0 @@ - character*80 titel - common /header/ titel diff --git a/source/unres/src_CSA_DiL/COMMON.INFO b/source/unres/src_CSA_DiL/COMMON.INFO deleted file mode 100644 index 4f63708..0000000 --- a/source/unres/src_CSA_DiL/COMMON.INFO +++ /dev/null @@ -1,21 +0,0 @@ -c NPROCS - total number of processors; -c MyID - processor's ID; -c MasterID - master processor's ID. - integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish - logical koniec - integer tag,status(MPI_STATUS_SIZE) - common /info/ myid,masterid,allgrp,dontcare, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1) -c... 5/12/96 - added variables for collective communication -c FGPROCS - Number of fine-grain processors per coarse-grain task; -c NCTASKS - Number of coarse-grain tasks; -c MYGROUP - label of the processor's FG group id; -c BOSSID - ID of group's master; -c FGLIST - list of group's FG processors. -c MSGLEN_VAR - length of the vector of variables passed to the fine-grain -c slave processors - integer fgprocs,nctasks,mygroup,bossid,cglabel, - & cglist(max_cg_procs),cgGroupID,fglist(max_fg_procs), - & fgGroupID,MyRank - common /info1/ fgprocs,nctasks,mygroup,bossid,cglabel,cglist, - & cgGroupID,fglist,fgGroupID,MyRank,msglen_var diff --git a/source/unres/src_CSA_DiL/COMMON.INTERACT b/source/unres/src_CSA_DiL/COMMON.INTERACT deleted file mode 100644 index fabad93..0000000 --- a/source/unres/src_CSA_DiL/COMMON.INTERACT +++ /dev/null @@ -1,34 +0,0 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6 - integer expon,expon2 - integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, - & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart, - & iscpend,iatsc_s,iatsc_e, - & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw, - & ispp,iscp - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), - & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), - & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), - & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, - & ielstart(maxres),ielend(maxres),ielstart_vdw(maxres), - & ielend_vdw(maxres),nscp_gr(maxres), - & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr), - & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, - & iatscp_s,iatscp_e,ispp,iscp -C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii, - & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp - common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1), - & sigmaii(ntyp,ntyp), - & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp), - & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2), - & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2) -c 12/5/03 modified 09/18/03 Bond stretching parameters. - double precision vbldp0,vbldsc0,akp,aksc,abond0 - integer nbondterm - common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, - & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),nbondterm(ntyp) - double precision wdti,wdti2,wdti4,wdti8, - & wdtii,wdtii2,wdtii4,wdtii8 - common /nosehoover_dt/ - & wdti(maxyosh),wdti2(maxyosh),wdti4(maxyosh),wdti8(maxyosh), - & wdtii(maxyosh),wdtii2(maxyosh),wdtii4(maxyosh),wdtii8(maxyosh) diff --git a/source/unres/src_CSA_DiL/COMMON.IOUNITS b/source/unres/src_CSA_DiL/COMMON.IOUNITS deleted file mode 100644 index 49b6db3..0000000 --- a/source/unres/src_CSA_DiL/COMMON.IOUNITS +++ /dev/null @@ -1,69 +0,0 @@ -C----------------------------------------------------------------------- -C I/O units used by the program -C----------------------------------------------------------------------- -C 9/18/99 - unit ifourier and filename fouriername included to identify -C the file from which the coefficients of second-order Fourier expansion -C of the local-interaction energy are read. -C 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) -C included. -C----------------------------------------------------------------------- -C General I/O units & files - integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, - & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, - & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart, - & irest1,isccor,ithep_pdb,irotam_pdb - common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, - & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, - & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag, - & icart,irest1,isccor,ithep_pdb,irotam_pdb - character*256 outname,intname,pdbname,mol2name,statname,intinname, - & entname,prefix,secpred,rest2name,qname,cartname,tmpdir, - & mremd_rst_name,curdir,pref_orig - character*4 liczba - common /fnames/ outname,intname,pdbname,mol2name,statname, - & intinname,entname,prefix,pot,secpred,rest2name,qname, - & cartname,tmpdir,mremd_rst_name,curdir,pref_orig,liczba -C CSA I/O units & files - character*256 csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - common /csafiles/ csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - integer icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb - common /csaunits/ icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb -C Parameter files - character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - common /parfiles/ bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - character*3 pot -C----------------------------------------------------------------------- -C INP - main input file -C IOUT - list file -C IGEOM - geometry output in the form of virtual-chain internal coordinates -C INTIN - geometry input (for multiple conformation processing) in int. coords. -C IPDB - Cartesian-coordinate output in PDB format -C IMOL2 - Cartesian-coordinate output in Tripos mol2 format -C IPDBIN - PDB input file -C ITHEP - virtual-bond torsional angle parametrs -C IROTAM - side-chain geometry and local-interaction parameters -C ITORP - torsional parameters -C ITORDP - double torsional parameters -C IFOURIER - coefficients of the expansion of local-interaction energy -C IELEP - electrostatic-interaction parameters -C ISIDEP - side-chain interaction parameters. -C ISCPP - SCp interaction parameters. -C IBOND - virtual-bond constant parameters and moments of inertia. -C ISCCOR - parameters of the potential of SCCOR term -C ICBASE - data base with Cartesian coords of known structures. -C ISTAT - energies and other conf. characteristics from an MCM run. -C IENTIN - entropy from preceeding simulation(s) to be read in. -C SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation. -C----------------------------------------------------------------------- diff --git a/source/unres/src_CSA_DiL/COMMON.LOCAL b/source/unres/src_CSA_DiL/COMMON.LOCAL deleted file mode 100644 index 23413fb..0000000 --- a/source/unres/src_CSA_DiL/COMMON.LOCAL +++ /dev/null @@ -1,55 +0,0 @@ - double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0, - & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 - integer nlob -C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(-ntyp:ntyp),athet(2,-ntyp:ntyp,-1:1,-1:1), - & bthet(2,-ntyp:ntyp,-1:1,-1:1),polthet(0:3,-ntyp:ntyp), - & gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp),sig0(-ntyp:ntyp), - & sigc0(-ntyp:ntyp) -C Parameters of the side-chain probability distribution - common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp), - & dsc0(ntyp1), - & nlob(ntyp1) -C Parameters of ab initio-derived potential of virtual-bond-angle bending - integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) - common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, - & ffthet, - & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, - & ndouble,nntheterm -C Virtual-bond lenghts - double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv - integer loc_start,loc_end,ithet_start,ithet_end,iphi_start, - & iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end, - & ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1), - & ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1), - & iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1), - & iphi1_displ(0:max_fg_procs-1),iphi1_count(0:max_fg_procs-1), - & ivec_displ(0:max_fg_procs-1),ivec_count(0:max_fg_procs-1), - & iset_displ(0:max_fg_procs-1),iset_count(0:max_fg_procs-1), - & iint_count(0:max_fg_procs-1),iint_displ(0:max_fg_procs-1) - common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 - common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ, - & ivec_count,iset_displ, - & iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count, - & iphi_displ,iphi_count,iphi1_displ,iphi1_count -C Inverses of the actual virtual bond lengths - common /invlen/ vbld_inv(maxres2) diff --git a/source/unres/src_CSA_DiL/COMMON.LOCMOVE b/source/unres/src_CSA_DiL/COMMON.LOCMOVE deleted file mode 100644 index 211516d..0000000 --- a/source/unres/src_CSA_DiL/COMMON.LOCMOVE +++ /dev/null @@ -1,19 +0,0 @@ -c Variables (set in init routine) never modified by local_move - integer init_called - logical locmove_output - double precision min_theta, max_theta - double precision dmin2,dmax2 - double precision flag,small,small2 - - common /loc_const/ init_called,locmove_output,min_theta, - + max_theta,dmin2,dmax2,flag,small,small2 - -c Workspace for local_move - integer a_n,b_n,res_n - double precision a_ang,b_ang,res_ang - logical a_tab,b_tab,res_tab - - common /loc_work/ res_ang(0:11),a_ang(0:7),b_ang(0:3), - + res_n,res_tab(0:2,0:2,0:11), - + a_n,a_tab(0:2,0:7), - + b_n,b_tab(0:2,0:3) diff --git a/source/unres/src_CSA_DiL/COMMON.MAXGRAD b/source/unres/src_CSA_DiL/COMMON.MAXGRAD deleted file mode 100644 index 285241a..0000000 --- a/source/unres/src_CSA_DiL/COMMON.MAXGRAD +++ /dev/null @@ -1,12 +0,0 @@ - double precision - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - common /maxgrad/ - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max diff --git a/source/unres/src_CSA_DiL/COMMON.MCM b/source/unres/src_CSA_DiL/COMMON.MCM deleted file mode 100644 index 576f912..0000000 --- a/source/unres/src_CSA_DiL/COMMON.MCM +++ /dev/null @@ -1,70 +0,0 @@ -C... Following COMMON block contains general variables controlling the MC/MCM -C... procedure -c----------------------------------------------------------------------------- - double precision Tcur,Tmin,Tmax,TstepH,TstepC,RanFract, - & overlap_cut,e_up,delte - integer nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter, - & maxrepm,ngen,ntrial,ntherm,nrepm,neneval,nsave,maxoverlap, - & nsave_part,max_mcm_it,nsweep,print_mc - logical print_stat,print_int - common /mcm/ Tcur,Tmin,Tmax,TstepH,TstepC,Rbol,betbol,RanFract, - & overlap_cut,e_up,delte, - & nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,maxrepm, - & maxoverlap,ntrial,max_mcm_it, - & ngen,ntherm,nrepm,neneval,nsave,nsave_part(max_cg_procs),nsweep, - & print_mc,print_stat,print_int -c----------------------------------------------------------------------------- -C... The meaning of the above variables is as follows: -C... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively; -C... NstepC,NStepH - Number of cooling and heating steps, respectively; -C... TstepH,TstepC - factors by which T is multiplied in order to be -C... increased or decreased. -C... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur)); -C... Rbol - the gas constant; -C... RanFract - the chance that a new conformation will be random-generated; -C... maxacc - maximum number of accepted conformations; -C... maxgen,ngen - Maximum and current number of generated conformations; -C... maxtrial,ntrial - maximum number of trials before temperature is increased -C... and current number of trials, respectively; -C... maxrepm,nrepm - maximum number of allowed minima repetition and current -C... number of minima repetitions, respectively; -C... maxoverlap - max. # of overlapping confs generated in a single iteration; -C... neneval - number of energy evaluations; -C... nsave - number of confs. in the backup array; -C... nsweep - the number of macroiterations in generating the distributions. -c------------------------------------------------------------------------------ -C... Following COMMON block contains variables controlling motion. -c------------------------------------------------------------------------------ - double precision sumpro_type,sumpro_bond - integer koniecl, Nbm,MaxSideMove,nmove,moves(-1:MaxMoveType+1), - & moves_acc(-1:MaxMoveType+1),nacc_tot,nacc_part(0:MaxProcs) - common /move/ sumpro_type(0:MaxMoveType),sumpro_bond(0:maxres), - & koniecl,Nbm,MaxSideMove,nmove,nbond_move(maxres), - & nbond_acc(maxres),moves,moves_acc - common /accept_stats/ nacc_tot,nacc_part - integer nwindow,winstart,winend,winlen - common /windows/ nwindow,winstart(maxres),winend(maxres), - & winlen(maxres) - character*16 MovTypID - common /moveID/ MovTypID(-1:MaxMoveType+1) -c------------------------------------------------------------------------------ -C... koniecl - the number of bonds to be considered "end bonds" subjected to -C... end moves; -C... Nbm - The maximum length of N-bond segment to be moved; -C... MaxSideMove - maximum number of side chains subjected to local moves -C... simultaneously; -C... nmove - the current number of attempted moves; -C... nbond_move(*) array that stores the total numbers of 2-bond,3-bond,... -C... moves; -C... nendmove - number of endmoves; -C... nbackmove - number of backbone moves; -C... nsidemove - number of local side chain moves; -C... sumpro_type(*) - array that stores the lower and upper boundary of the -C... random-number range that determines the type of move -C... (N-bond, backbone or side chain); -C... sumpro_bond(*) - array that stores the probabilities to perform bond -C... moves of consecutive segment length. -C... winstart(*) - the starting position of the perturbation window; -C... winend(*) - the end position of the perturbation window; -C... winlen(*) - length of the perturbation window; -C... nwindow - the number of perturbation windows (0 - entire chain). diff --git a/source/unres/src_CSA_DiL/COMMON.MD_ b/source/unres/src_CSA_DiL/COMMON.MD_ deleted file mode 100644 index 22dba7c..0000000 --- a/source/unres/src_CSA_DiL/COMMON.MD_ +++ /dev/null @@ -1,74 +0,0 @@ - double precision gcart, gxcart, gradcag,gradxag - common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES), - & gradcag(3,MAXRES),gradxag(3,MAXRES) - integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), - & ipair(2,100,maxprocs/20),iset, - & mset(maxprocs/20),nset - double precision IP,ISC(ntyp+1),mp, - & msc(ntyp+1),d_t_work(MAXRES6), - & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), - & d_af_work(MAXRES6),d_as_work(MAXRES6), - & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2), - & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2), - & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6), - & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), - & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) - double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, - & edriftmax, - & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), - & qfrag(50),qpair(100), - & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20), - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, - & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), - & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), - & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), - & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), - & uconst_back - integer n_timestep,ntwx,ntwe,lang,count_reset_moment, - & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, - & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0, - & maxtime_split - integer nresn,nyosh,nnos - double precision glogs,qmass,vlogs,xlogs - logical large,print_compon,tbf,rest,reset_moment,reset_vel, - & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp - integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts, - & nginv_start,nginv_counts,myginv_ng_count - common /back_constr/ uconst_back,utheta,ugamma,uscdiff, - & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back - common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, - & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag - common /mdpar/ v_ini,d_time,d_time0,scal_fric, - & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, - & ntime_split,ntime_split0,maxtime_split, - & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh - common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax, - & kinetic_T - common /lagrange/ d_t,d_t_old,d_t_new,d_t_work, - & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short, - & kinetic_force, - & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm, - & vtot,dimen,dimen1,dimen3,lang, - & reset_moment,reset_vel,count_reset_moment,count_reset_vel, - & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC - double precision scal_fric,rwat,etawat,gamp, - & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES), - & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb - common /langevin/ pstok,restok,gamp,gamsc, - & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea, - & reset_fricmat - common /mdpmpi/ igmult_start,igmult_end,my_ng_count, - & myginv_ng_count, - & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), - & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) - double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit - common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit - common /nosehoover/ glogs(maxmnh),qmass(maxmnh), - & vlogs(maxmnh),xlogs(maxmnh), - & nresn,nyosh,nnos,xiresp diff --git a/source/unres/src_CSA_DiL/COMMON.MINIM b/source/unres/src_CSA_DiL/COMMON.MINIM deleted file mode 100644 index e44f9cd..0000000 --- a/source/unres/src_CSA_DiL/COMMON.MINIM +++ /dev/null @@ -1,5 +0,0 @@ - double precision tolf,rtolf - integer maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res - common /minimm/ tolf,rtolf,maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res diff --git a/source/unres/src_CSA_DiL/COMMON.NAMES b/source/unres/src_CSA_DiL/COMMON.NAMES deleted file mode 100644 index 13dde91..0000000 --- a/source/unres/src_CSA_DiL/COMMON.NAMES +++ /dev/null @@ -1,8 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(-ntyp1:ntyp1), - & onelet(-ntyp1:ntyp1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(n_ene),wname(n_ene),nprint_ene, - & print_order(n_ene) diff --git a/source/unres/src_CSA_DiL/COMMON.SBRIDGE b/source/unres/src_CSA_DiL/COMMON.SBRIDGE deleted file mode 100644 index 4cc80c8..0000000 --- a/source/unres/src_CSA_DiL/COMMON.SBRIDGE +++ /dev/null @@ -1,12 +0,0 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) - double precision dhpb,forcon - integer ihpb,jhpb,nhpb - common /links/ dhpb(maxdim),forcon(maxdim),ihpb(maxdim), - & jhpb(maxdim),nhpb - double precision weidis - common /restraints/ weidis - integer link_start,link_end - common /links_split/ link_start,link_end diff --git a/source/unres/src_CSA_DiL/COMMON.SCCOR b/source/unres/src_CSA_DiL/COMMON.SCCOR deleted file mode 100644 index 5217de7..0000000 --- a/source/unres/src_CSA_DiL/COMMON.SCCOR +++ /dev/null @@ -1,6 +0,0 @@ -C Parameters of the SCCOR term - double precision v1sccor,v2sccor - integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), - & nterm_sccor diff --git a/source/unres/src_CSA_DiL/COMMON.SCROT b/source/unres/src_CSA_DiL/COMMON.SCROT deleted file mode 100644 index 2da7b8f..0000000 --- a/source/unres/src_CSA_DiL/COMMON.SCROT +++ /dev/null @@ -1,3 +0,0 @@ -C Parameters of the SC rotamers (local) term - double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) diff --git a/source/unres/src_CSA_DiL/COMMON.SETUP b/source/unres/src_CSA_DiL/COMMON.SETUP deleted file mode 100644 index 5039116..0000000 --- a/source/unres/src_CSA_DiL/COMMON.SETUP +++ /dev/null @@ -1,21 +0,0 @@ - integer king,idint,idreal,idchar,is_done - parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1) - integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1), - & kolor1,key1,nfgtasks1,MyRank, - & max_gs_size - logical yourjob, finished, cgdone - common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs, - & nfgtasks,nfgtasks1, - & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp - integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1), - & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1), - & MPI_PRECOMP23(0:1) - common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12, - & MPI_PRECOMP22,MPI_PRECOMP23 diff --git a/source/unres/src_CSA_DiL/COMMON.SPLITELE b/source/unres/src_CSA_DiL/COMMON.SPLITELE deleted file mode 100644 index a2f0447..0000000 --- a/source/unres/src_CSA_DiL/COMMON.SPLITELE +++ /dev/null @@ -1,2 +0,0 @@ - double precision r_cut,rlamb - common /splitele/ r_cut,rlamb diff --git a/source/unres/src_CSA_DiL/COMMON.THREAD b/source/unres/src_CSA_DiL/COMMON.THREAD deleted file mode 100644 index 5c814cc..0000000 --- a/source/unres/src_CSA_DiL/COMMON.THREAD +++ /dev/null @@ -1,7 +0,0 @@ - integer nthread,nexcl,iexam,ipatt - double precision ener0,ener,max_time_for_thread, - & ave_time_for_thread - common /thread/ nthread,nexcl,iexam(2,maxthread), - & ipatt(2,maxthread) - common /thread1/ ener0(n_ene+2,maxthread),ener(n_ene+2,maxthread), - & max_time_for_thread,ave_time_for_thread diff --git a/source/unres/src_CSA_DiL/COMMON.TIME1 b/source/unres/src_CSA_DiL/COMMON.TIME1 deleted file mode 100644 index d6203a6..0000000 --- a/source/unres/src_CSA_DiL/COMMON.TIME1 +++ /dev/null @@ -1,28 +0,0 @@ - DOUBLE PRECISION BATIME,TIMLIM,STIME,PREVTIM,SAFETY - DOUBLE PRECISION WALLTIME - INTEGER ISTOP -c FOUND_NAN - set by calcf to stop sumsl via stopx - logical FOUND_NAN - COMMON/TIME1/STIME,TIMLIM,BATIME,PREVTIM,SAFETY,WALLTIME - COMMON/STOPTIM/ISTOP - common /sumsl_flag/ FOUND_NAN - double precision t_init,t_MDsetup,t_langsetup,t_MD, - & t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_barrier_e,time_barrier_g,time_scatter, - & t_eelecij,time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_scatter_fmat,time_scatter_ginv, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_stoch,t_eshort,t_elong,t_etotal - common /timing/ t_init,t_MDsetup,t_langsetup, - & t_MD,t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_scatter,time_barrier_e,time_barrier_g, - & time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & t_eelecij,time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_scatter_fmat,time_scatter_ginv, - & time_stoch,t_eshort,t_elong,t_etotal diff --git a/source/unres/src_CSA_DiL/COMMON.TORCNSTR b/source/unres/src_CSA_DiL/COMMON.TORCNSTR deleted file mode 100644 index e4af17c..0000000 --- a/source/unres/src_CSA_DiL/COMMON.TORCNSTR +++ /dev/null @@ -1,6 +0,0 @@ - integer ndih_constr,idih_constr(maxdih_constr) - integer ndih_nconstr,idih_nconstr(maxdih_constr) - integer idihconstr_start,idihconstr_end - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end diff --git a/source/unres/src_CSA_DiL/COMMON.TORSION b/source/unres/src_CSA_DiL/COMMON.TORSION deleted file mode 100644 index 3c9ae39..0000000 --- a/source/unres/src_CSA_DiL/COMMON.TORSION +++ /dev/null @@ -1,33 +0,0 @@ -C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(-maxtor:maxtor,-maxtor:maxtor,2), - & v1(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), - & v2(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), - & vlor1(maxlor,maxtor,maxtor), - & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(-ntyp:ntyp),ntortyp, - & nterm(-maxtor:maxtor,-maxtor:maxtor,2), - & nlor(-maxtor:maxtor,-maxtor:maxtor,2) - & ,nterm_old -C 6/23/01 - constants for double torsionals - double precision v1c,v1s,v2c,v2s - integer ntermd_1,ntermd_2 - common /torsiond/ - &v1c(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), - &v1s(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), - &v2c(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, - & -maxtor:maxtor,2), - &v2s(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, - & -maxtor:maxtor,2), - & ntermd_1(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), - & ntermd_2(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -C 9/18/99 - added Fourier coeffficients of the expansion of local energy -C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde - integer nloctyp - common/fourier/ b1(2,-maxtor:maxtor),b2(2,-maxtor:maxtor) - & ,cc(2,2,-maxtor:maxtor), - & dd(2,2,-maxtor:maxtor),ee(2,2,-maxtor:maxtor), - & ctilde(2,2,-maxtor:maxtor), - & dtilde(2,2,-maxtor:maxtor),b1tilde(2,-maxtor:maxtor),nloctyp diff --git a/source/unres/src_CSA_DiL/COMMON.VAR b/source/unres/src_CSA_DiL/COMMON.VAR deleted file mode 100644 index 71158b8..0000000 --- a/source/unres/src_CSA_DiL/COMMON.VAR +++ /dev/null @@ -1,20 +0,0 @@ -C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, - & mask_theta,mask_phi,mask_side - double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, - & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,xxref,yyref,zzref - common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & vbld(2*maxres),thetaref(maxres),phiref(maxres), - & costtab(maxres), sinttab(maxres), cost2tab(maxres), - & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar -C Store the angles and variables corresponding to old conformations (for use -C in MCM). - common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), - & Origin(maxsave),nstore -C freeze some variables - logical mask_r - common /restr/ varall(maxvar),mask_r,mask_theta(maxres), - & mask_phi(maxres),mask_side(maxres) diff --git a/source/unres/src_CSA_DiL/COMMON.VECTORS b/source/unres/src_CSA_DiL/COMMON.VECTORS deleted file mode 100644 index d880c24..0000000 --- a/source/unres/src_CSA_DiL/COMMON.VECTORS +++ /dev/null @@ -1,3 +0,0 @@ - common /vectors/ uy(3,maxres),uz(3,maxres), - & uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres) - diff --git a/source/unres/src_CSA_DiL/DIMENSIONS b/source/unres/src_CSA_DiL/DIMENSIONS deleted file mode 100644 index 3225a09..0000000 --- a/source/unres/src_CSA_DiL/DIMENSIONS +++ /dev/null @@ -1,139 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - integer maxprocs - parameter (maxprocs=2048) -C Max. number of fine-grain processors - integer max_fg_procs -c parameter (max_fg_procs=maxprocs) - parameter (max_fg_procs=512) -C Max. number of coarse-grain processors - integer max_cg_procs - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=800) -C Appr. max. number of interaction sites - integer maxres2,maxres6,mmaxres2 - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) -C Max. number of variables - integer maxvar - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres/4) -c parameter (maxconts=50) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=3) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=10) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=20) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=20) -C Max. number of energy intervals - integer max_ene - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=10) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=10) -C Number of energy components - integer n_ene,n_ene2 - parameter (n_ene=27,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -C Maximum number of generated conformations - integer mxio - parameter (mxio=1000) -C Maximum number of n7 generated conformations - integer mxio2 - parameter (mxio2=100) -C Maximum number of moves (n1-n8) - integer mxmv - parameter (mxmv=18) -C Maximum number of seed - integer max_seed - parameter (max_seed=200) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) -C Maximum number of backbone fragments in restraining - integer maxfrag_back - parameter (maxfrag_back=4) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) -C Maximum number of conformation stored in cache on each CPU before sending -C to master; depends on nstex / ntwx ratio - integer max_cache_traj - parameter (max_cache_traj=10) -C Nose-Hoover chain - chain length and order of Yoshida algorithm - integer maxmnh,maxyosh - parameter(maxmnh=10,maxyosh=5) diff --git a/source/unres/src_CSA_DiL/MP.F b/source/unres/src_CSA_DiL/MP.F deleted file mode 100644 index 3b4bc70..0000000 --- a/source/unres/src_CSA_DiL/MP.F +++ /dev/null @@ -1,516 +0,0 @@ -#ifdef MPI - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - logical lprn /.false./ -c real*8 text1 /'group_i '/,text2/'group_f '/, -c & text3/'initialb'/,text4/'initiale'/, -c & text5/'openb'/,text6/'opene'/ - integer cgtasks(0:max_cg_procs) - character*3 cfgprocs - integer cg_size,fg_size,fg_size1 -c start parallel processing -c print *,'Initializing MPI' - call mpi_init(ierr) - if (ierr.ne.0) then - print *, ' cannot initialize MPI' - stop - endif -c determine # of nodes and current node - call MPI_Comm_rank( MPI_COMM_WORLD, me, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine rank of all processes' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif - call MPI_Comm_size( MPI_Comm_world, nodes, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine number of processes' - stop - endif - Nprocs=nodes - MyRank=me -C Determine the number of "fine-grain" tasks - call getenv_loc("FGPROCS",cfgprocs) - read (cfgprocs,'(i3)') nfgtasks - if (nfgtasks.eq.0) nfgtasks=1 - call getenv_loc("MAXGSPROCS",cfgprocs) - read (cfgprocs,'(i3)') max_gs_size - if (max_gs_size.eq.0) max_gs_size=2 - if (lprn) - & print *,"Processor",me," nfgtasks",nfgtasks, - & " max_gs_size",max_gs_size - if (nfgtasks.eq.1) then - CG_COMM = MPI_COMM_WORLD - fg_size=1 - fg_rank=0 - nfgtasks1=1 - fg_rank1=0 - else - nodes=nprocs/nfgtasks - if (nfgtasks*nodes.ne.nprocs) then - write (*,'(a)') 'ERROR: Number of processors assigned', - & ' to coarse-grained tasks must be divisor', - & ' of the total number of processors.' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif -C Put the ranks of coarse-grain processes in one table and create -C the respective communicator. The processes with ranks "in between" -C the ranks of CG processes will perform fine graining for the CG -C process with the next lower rank. - do i=0,nprocs-1,nfgtasks - cgtasks(i/nfgtasks)=i - enddo - if (lprn) then - print*,"Processor",me," cgtasks",(cgtasks(i),i=0,nodes-1) -c print "(a,i5,a)","Processor",myrank," Before MPI_Comm_group" - endif -c call memmon_print_usage() - call MPI_Comm_group(MPI_COMM_WORLD,world_group,IERR) - call MPI_Group_incl(world_group,nodes,cgtasks,cg_group,IERR) - call MPI_Comm_create(MPI_COMM_WORLD,cg_group,CG_COMM,IERR) - call MPI_Group_rank(cg_group,me,ierr) - call MPI_Group_free(world_group,ierr) - call MPI_Group_free(cg_group,ierr) -c print "(a,i5,a)","Processor",myrank," After MPI_Comm_group" -c call memmon_print_usage() - if (me.ne.MPI_UNDEFINED) call MPI_Comm_Rank(CG_COMM,me,ierr) - if (lprn) print *," Processor",myrank," CG rank",me -C Create communicators containig processes doing "fine grain" tasks. -C The processes within each FG_COMM should have fast communication. - kolor=MyRank/nfgtasks - key=mod(MyRank,nfgtasks) - call MPI_Comm_split(MPI_COMM_WORLD,kolor,key,FG_COMM,ierr) - call MPI_Comm_size(FG_COMM,fg_size,ierr) - if (fg_size.ne.nfgtasks) then - write (*,*) "OOOOps... the number of fg tasks is",fg_size, - & " but",nfgtasks," was requested. MyRank=",MyRank - endif - call MPI_Comm_rank(FG_COMM,fg_rank,ierr) - if (fg_size.gt.max_gs_size) then - kolor1=fg_rank/max_gs_size - key1=mod(fg_rank,max_gs_size) - call MPI_Comm_split(FG_COMM,kolor1,key1,FG_COMM1,ierr) - call MPI_Comm_size(FG_COMM1,nfgtasks1,ierr) - call MPI_Comm_rank(FG_COMM1,fg_rank1,ierr) - else - FG_COMM1=FG_COMM - nfgtasks1=nfgtasks - fg_rank1=fg_rank - endif - endif - if (fg_rank.eq.0) then - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in CG_COMM",me," size of CG_COMM",nodes, - & " size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - else - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in FG_COMM",fg_rank," size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - endif -C Initialize other variables. -c print '(a)','Before initialize' -c call memmon_print_usage() - call initialize -c print '(a,i5,a)','Processor',myrank,' After initialize' -c call memmon_print_usage() -C Open task-dependent files. -c print '(a,i5,a)','Processor',myrank,' Before openunits' -c call memmon_print_usage() - call openunits -c print '(a,i5,a)','Processor',myrank,' After openunits' -c call memmon_print_usage() - if (me.eq.king .or. fg_rank.eq.0 .and. .not. out1file) - & write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - parallel job.' -c print *,"Processor",myrank," exited OPENUNITS" - return - end -C----------------------------------------------------------------------------- - subroutine finish_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' -c include 'COMMON.REMD' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - include 'COMMON.MD_' - integer ilen - external ilen -c - call MPI_Barrier(CG_COMM,ierr) - if (nfgtasks.gt.1) - & call MPI_Bcast(-1,1,MPI_INTEGER,king,FG_COMM,IERROR) - time1=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write (iout,'(a,i4,a)') 'CG processor',me,' is finishing work.' - write (iout,*) 'Total wall clock time',time1-walltime,' sec' - if (nfgtasks.gt.1) then - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (iout,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g,"TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - & +time_barrier_e+time_barrier_g - write (*,*) 'Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",me," BROADCAST time",time_bcast, - & " REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter," SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e," BARRIER grad",time_barrier_g - endif - endif - write (*,'(a,i4,a)') 'CG processor',me,' is finishing work.' - if (ilen(tmpdir).gt.0) then - write (*,*) "Processor",me, - & ": moving output files to the parent directory..." - close(inp) - close(istat,status='keep') - if (ntwe.gt.0) call move_from_tmp(statname) - close(irest2,status='keep') -cremd if (modecalc.eq.12.or. -cremd & (modecalc.eq.14 .and. .not.restart1file)) then -cremd call move_from_tmp(rest2name) -cremd else if (modecalc.eq.14.and. me.eq.king) then -cremd call move_from_tmp(mremd_rst_name) -cremd endif -cmd if (mdpdb) then -cmd close(ipdb,status='keep') -cmd call move_from_tmp(pdbname) -cmd else if (me.eq.king .or. .not.traj1file) then -cmd close(icart,status='keep') -cmd call move_from_tmp(cartname) -cmd endif - if (me.eq.king .or. .not. out1file) then - close (iout,status='keep') - call move_from_tmp(outname) - endif - endif - return - end -c------------------------------------------------------------------------- - subroutine pattern_receive - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,ThreadType - logical flag - ThreadType=45 - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - do while (flag) - write (iout,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - write (*,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - nexcl=nexcl+1 - call mpi_irecv(iexam(1,nexcl),2,mpi_integer,status(mpi_source), - & ThreadType, CG_COMM,ireq,ierr) - write (iout,*) 'Received pattern:',nexcl,iexam(1,nexcl), - & iexam(2,nexcl) - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine pattern_send - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer source,ThreadType,ireq - ThreadType=45 - do iproc=0,nprocs-1 - if (iproc.ne.me .and. .not.Koniec(iproc) ) then - call mpi_isend(iexam(1,nexcl),2,mpi_integer,iproc, - & ThreadType, CG_COMM, ireq, ierr) - write (iout,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (*,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (iout,*) 'Pattern:',nexcl,iexam(1,nexcl),iexam(2,nexcl) - endif - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer StopType,StopId,iproc,Kwita,NBytes - StopType=66 -c Kwita=-1 -C print *,'CG processor',me,' StopType=',StopType - Koniec(me)=.true. - if (me.eq.king) then -C Master sends the STOP signal to everybody. - write (iout,'(a,a)') - & 'Master is sending STOP signal to other processors.' - do iproc=1,nprocs-1 - print *,'Koniec(',iproc,')=',Koniec(iproc) - if (.not. Koniec(iproc)) then - call mpi_send(Kwita,1,mpi_integer,iproc,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'Iproc=',iproc,' StopID=',StopID - write (*,*) 'Iproc=',iproc,' StopID=',StopID - endif - enddo - else -C Else send the STOP signal to Master. - call mpi_send(Kwita,1,mpi_integer,MasterID,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'CG processor=',me,' StopID=',StopID - write (*,*) 'CG processor=',me,' StopID=',StopID - endif - return - end -c----------------------------------------------------------------------------- - subroutine recv_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer source,StopType,StopId,iproc,Kwita - logical flag - StopType=66 - Kwita=0 - source=mpi_any_source -c print *,'CG processor:',me,' StopType=',StopType - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - do while (flag) - Koniec(status(mpi_source))=.true. - write (iout,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - write (*,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - call mpi_irecv(Kwita,1,mpi_integer,status(mpi_source),StopType, - & mpi_comm_world,ireq,ierr) - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_MCM_info(ione) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer MCM_info_Type,MCM_info_ID,iproc,one,NBytes - common /aaaa/ isend,irecv - integer nsend - save nsend - nsend=nsend+1 - MCM_info_Type=77 -cd write (iout,'(a,i4,a)') 'CG Processor',me, -cd & ' is sending MCM info to Master.' - write (*,'(a,i4,a,i8)') 'CG processor',me, - & ' is sending MCM info to Master, MCM_info_ID=',MCM_info_ID - call mpi_isend(ione,1,mpi_integer,MasterID, - & MCM_info_Type,mpi_comm_world, MCM_info_ID, ierr) -cd write (iout,*) 'CG processor',me,' has sent info to the master;', -cd & ' MCM_info_ID=',MCM_info_ID - write (*,*) 'CG processor',me,' has sent info to the master;', - & ' MCM_info_ID=',MCM_info_ID,' ierr ',ierr - isend=0 - irecv=0 - return - end -c---------------------------------------------------------------------------- - subroutine receive_MCM_info - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,MCM_info_Type,MCM_info_ID,iproc,ione - logical flag - MCM_info_Type=77 - source=mpi_any_source -c print *,'source=',source,' dontcare=',dontcare - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - do while (flag) - source=status(mpi_source) - itask=source/fgProcs+1 -cd write (iout,*) 'Master is receiving MCM info from processor ', -cd & source,' itask',itask - write (*,*) 'Master is receiving MCM info from processor ', - & source,' itask',itask - call mpi_irecv(ione,1,mpi_integer,source,MCM_info_type, - & mpi_comm_world,MCM_info_ID,ierr) -cd write (iout,*) 'Received from processor',source,' IONE=',ione - write (*,*) 'Received from processor',source,' IONE=',ione - nacc_tot=nacc_tot+1 - if (ione.eq.2) nsave_part(itask)=nsave_part(itask)+1 -cd print *,'nsave_part(',itask,')=',nsave_part(itask) -cd write (iout,*) 'Nacc_tot=',Nacc_tot -cd write (*,*) 'Nacc_tot=',Nacc_tot - source=mpi_any_source - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine send_thread_results - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,msglen,nbytes - double precision buffer(20*maxthread+2) - ThreadType=444 - EnerType=555 - ipatt(1,nthread+1)=nthread - ipatt(2,nthread+1)=nexcl - do i=1,nthread - do j=1,n_ene - ener(j,i+nthread)=ener0(j,i) - enddo - enddo - ener(1,2*nthread+1)=max_time_for_thread - ener(2,2*nthread+1)=ave_time_for_thread -C Send the IPATT array - write (iout,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - write (*,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - msglen=2*nthread+2 - call mpi_send(ipatt(1,1),msglen,MPI_INTEGER,MasterID, - & ThreadType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen - write (*,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen -C Send the energies. - msglen=n_ene2*nthread+2 - write (iout,*) 'CG processor',me,' is sending energies to master.' - write (*,*) 'CG processor',me,' is sending energies to master.' - call mpi_send(ener(1,1),msglen,MPI_DOUBLE_PRECISION,MasterID, - & EnerType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me,' has sent energies to master.' - write (*,*) 'CG processor',me,' has sent energies to master.' - return - end -c---------------------------------------------------------------------------- - subroutine receive_thread_results(iproc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,ReadyType,ReadyID,Ready,msglen,nbytes,nthread_temp - double precision buffer(20*maxthread+2),max_time_for_thread_t, - & ave_time_for_thread_t - logical flag - ThreadType=444 - EnerType=555 -C Receive the IPATT array - call mpi_probe(iproc,ThreadType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_INTEGER, MSGLEN, IERROR) - write (iout,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - write (*,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - call mpi_recv(ipatt(1,nthread+1),msglen,mpi_integer,iproc, - & ThreadType, - & mpi_comm_world,status,ierror) - write (iout,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - write (*,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - nthread_temp=ipatt(1,nthread+msglen/2) - nexcl_temp=ipatt(2,nthread+msglen/2) -C Receive the energies. - call mpi_probe(iproc,EnerType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_DOUBLE_PRECISION, MSGLEN, IERROR) - write (iout,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - write (*,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - call mpi_recv(ener(1,nthread+1),msglen, - & MPI_DOUBLE_PRECISION,iproc, - & EnerType,MPI_COMM_WORLD,status,ierror) - write (iout,*) 'Msglen=',Msglen - write (*,*) 'Msglen=',Msglen - write (iout,*) 'Master has received energies from processor',iproc - write (*,*) 'Master has received energies from processor',iproc - write (iout,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - write (*,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - do i=1,nthread_temp - do j=1,n_ene - ener0(j,nthread+i)=ener(j,nthread+nthread_temp+i) - enddo - enddo - max_time_for_thread_t=ener(1,nthread+2*nthread_temp+1) - ave_time_for_thread_t=ener(2,nthread+2*nthread_temp+1) - write (iout,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (iout,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - write (*,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (*,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - if (max_time_for_thread_t.gt.max_time_for_thread) - & max_time_for_thread=max_time_for_thread_t - ave_time_for_thread=(nthread*ave_time_for_thread+ - & nthread_temp*ave_time_for_thread_t)/(nthread+nthread_temp) - nthread=nthread+nthread_temp - return - end -#else - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SETUP' - me=0 - myrank=0 - fg_rank=0 - fg_size=1 - nodes=1 - nprocs=1 - call initialize - call openunits - write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - serial job.' - return - end -#endif diff --git a/source/unres/src_CSA_DiL/Makefile b/source/unres/src_CSA_DiL/Makefile index def0aff..8453cdd 120000 --- a/source/unres/src_CSA_DiL/Makefile +++ b/source/unres/src_CSA_DiL/Makefile @@ -1 +1 @@ -Makefile-DFA-NEWPARM.matrix \ No newline at end of file +Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.kias b/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.kias deleted file mode 100644 index 1df87fb..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.kias +++ /dev/null @@ -1,101 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel - -FC= ifort - -OPT = -O3 -ip -w -#OPT = -O0 - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_nh_hremd_021811_dfa_csa.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.matrix b/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.matrix deleted file mode 100644 index adcfcc0..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.matrix +++ /dev/null @@ -1,108 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -#INSTALL_DIR = /opt/mpi/mvapich -#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -#FCL = ${INSTALL_DIR}/bin/mpif77 -#CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../../../bin/unres/CSA/unres_dfa_csa-Yi.exe -#BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -#LIBS = -L$(INSTALL_DIR)/lib -lmpich -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - -#all: unresCSA -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -#unresCSA: ${object} -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo - ${FC} ${FFLAGS} cinfo.f -# ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.piasek b/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.piasek deleted file mode 100644 index 43cd300..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-NEWPARM.piasek +++ /dev/null @@ -1,108 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -#INSTALL_DIR = /opt/mpi/mvapich -INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -#FCL = ${INSTALL_DIR}/bin/mpif77 -#CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../../../bin/unres/CSA/unres_dfa_csa-Yi.exe -#BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -#LIBS = -L$(INSTALL_DIR)/lib -lmpich -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - -#all: unresCSA -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -#unresCSA: ${object} -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo - ${FC} ${FFLAGS} cinfo.f -# ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.galera b/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.galera deleted file mode 100644 index a56aeb6..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.galera +++ /dev/null @@ -1,96 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -INSTALL_DIR = /opt/mpi/mvapich -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 -CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_new_em64_dfa_csa-4P.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unresCSA: ${object} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS} ${CPPFLAGS} dfa.F diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.gfortran b/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.gfortran deleted file mode 100644 index 33e528a..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.gfortran +++ /dev/null @@ -1,103 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DG77 -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -INSTALL_DIR = /users/local/mpich2-1.3.1/ - - -FC= gfortran - -OPT = -O - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -I$(INSTALL_DIR)/include -FFLAGS2 = -c -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -O -I$(INSTALL_DIR)/include -FFLAGSE = -c -O3 -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_dfa_csa_4P_gfortran.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich -lmpl -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.kias b/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.kias deleted file mode 100644 index 54502d9..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.kias +++ /dev/null @@ -1,101 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -#INSTALL_DIR =/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_050711_dfa_csa_4P_800.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.piasek b/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.piasek deleted file mode 100644 index e18df8f..0000000 --- a/source/unres/src_CSA_DiL/Makefile-DFA-OLDPARM.piasek +++ /dev/null @@ -1,102 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /usr/local/mpich-1.2.7p1-intel -INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile-single_4P b/source/unres/src_CSA_DiL/Makefile-single_4P deleted file mode 100644 index b521426..0000000 --- a/source/unres/src_CSA_DiL/Makefile-single_4P +++ /dev/null @@ -1,91 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_single-1.2.7p1.exe -LIBS = - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile_4P b/source/unres/src_CSA_DiL/Makefile_4P deleted file mode 100644 index 915eec2..0000000 --- a/source/unres/src_CSA_DiL/Makefile_4P +++ /dev/null @@ -1,100 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/Makefile_CASP3 b/source/unres/src_CSA_DiL/Makefile_CASP3 deleted file mode 100644 index c9ff0be..0000000 --- a/source/unres/src_CSA_DiL/Makefile_CASP3 +++ /dev/null @@ -1,100 +0,0 @@ -CPPFLAGS = -DLINUX -DPGI -DISNAN -DMP -DMPI -DUNRES \ - -DSPLITELE -DAMD64 -DLANG0 -DMOMENT \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -O0 -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../../../bin/unres/CSA/unres_csa-CASP3_ifort_mpich-1.2.7p1.exe -LIBS = -lpthread -L$(INSTALL_DIR)/lib -lmpich - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres_csa.o arcos.o cartprint.o chainbuild.o initialize_p.o \ - matmult.o readrtns_csa.o parmread.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout_min.o readpdb.o \ - intcartderiv.o \ - MP.o printmat.o convert.o int_to_cart.o \ - dfa.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o prng_32.o contact.o gen_rand_conf.o \ - sc_move.o test.o local_move.o rmsd.o fitsq.o elecont.o djacob.o \ - distfit.o banach.o TMscore_subroutine.o minim_mult.o - -unres: ${object} -# cc -o compinfo compinfo.c -# ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS3} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - - - diff --git a/source/unres/src_CSA_DiL/README.Juyong b/source/unres/src_CSA_DiL/README.Juyong deleted file mode 100644 index b2dbf30..0000000 --- a/source/unres/src_CSA_DiL/README.Juyong +++ /dev/null @@ -1,13 +0,0 @@ -2010/12/20 - -0. added lines in the molread subroutine in readrtns_min.F file - to read dfa_weight functions, WDFA, "wdfa" variable is added in COMMON.FFIELD - -0-1. added lines in readrtns_min.F to print out dfa weights! -0-2. add subroutines to setup DFA variables & "READ fragment info" - -> init_dfa_vars - -> read_dfa_info - -1. added "gdfa_dist, gdfa_tor, gdfa_nei, gdfa_beta" to COMMON.DERIV - -2. changed n_ene in DIMENSIONS from 23 to 27, since DFA has four terms...... diff --git a/source/unres/src_CSA_DiL/TMscore_subroutine.f b/source/unres/src_CSA_DiL/TMscore_subroutine.f deleted file mode 100644 index 8e6ee9a..0000000 --- a/source/unres/src_CSA_DiL/TMscore_subroutine.f +++ /dev/null @@ -1,536 +0,0 @@ -************************************************************************* -************************************************************************* -* This is a subroutine to compare two structures and find the -* superposition that has the maximum TM-score. -* Reference: Yang Zhang, Jeffrey Skolnick, Proteins 2004 57:702-10. -* -* Explanations: -* L1--Length of the first structure -* (x1(i),y1(i),z1(i))--coordinates of i'th residue at the first structure -* n1(i)--Residue sequence number of i'th residue at the first structure -* L2--Length of the second structure -* (x2(i),y2(i),z2(i))--coordinates of i'th residue at the second structure -* n2(i)--Residue sequence number of i'th residue at the second structure -* TM--TM-score of the comparison -* Rcomm--RMSD of two structures in the common aligned residues -* Lcomm--Length of the common aligned regions -* -* Note: -* 1, Always put native as the second structure, by which TM-score -* is normalized. -* 2, The returned (x1(i),y1(i),z1(i)) are the rotated structure after -* TM-score superposition. -************************************************************************* -************************************************************************* - subroutine TMscore(L1,x1,y1,z1,n1,L2,x2,y2,z2,n2,TM,Rcomm,Lcomm) - include 'DIMENSIONS' - PARAMETER(nmax=maxres) - common/stru/xt(nmax),yt(nmax),zt(nmax),xb(nmax),yb(nmax),zb(nmax) - common/nres/nresA(nmax),nresB(nmax),nseqA,nseqB - common/para/d,d0 - common/align/n_ali,iA(nmax),iB(nmax) - common/nscore/i_ali(nmax),n_cut ![1,n_ali],align residues for the score - dimension k_ali(nmax),k_ali0(nmax) - dimension L_ini(100),iq(nmax) - common/scores/score - double precision score,score_max - dimension xa(nmax),ya(nmax),za(nmax) - - dimension x1(nmax),y1(nmax),z1(nmax),n1(nmax) - dimension x2(nmax),y2(nmax),z2(nmax),n2(nmax) - -ccc RMSD: - double precision r_1(3,nmax),r_2(3,nmax),r_3(3,nmax),w(nmax) - double precision u(3,3),t(3),rms,drms !armsd is real - data w /nmax*1.0/ -ccc - -********* convert input data **************** - nseqA=L1 - do i=1,nseqA - xa(i)=x1(i) - ya(i)=y1(i) - za(i)=z1(i) - nresA(i)=n1(i) - enddo - nseqB=L2 - do i=1,L2 - xb(i)=x2(i) - yb(i)=y2(i) - zb(i)=z2(i) - nresB(i)=n2(i) - enddo - -****************************************************************** -* pickup the aligned residues: -****************************************************************** - k=0 - do i=1,nseqA - do j=1,nseqB - if(nresA(i).eq.nresB(j))then - k=k+1 - iA(k)=i - iB(k)=j - goto 205 - endif - enddo - 205 continue - enddo - n_ali=k !number of aligned residues - Lcomm=n_ali - if(n_ali.lt.1)then -c write(*,*)'There is no common residues in the input structures' - TM=0 - Rcomm=0 - return - endif - -************///// -* parameters: -***************** -*** d0-------------> - d0=1.24*(nseqB-15)**(1.0/3.0)-1.8 - if(d0.lt.0.5)d0=0.5 -*** d0_search -----> - d0_search=d0 - if(d0_search.gt.8)d0_search=8 - if(d0_search.lt.4.5)d0_search=4.5 -*** iterative parameters -----> - n_it=20 !maximum number of iterations - d_output=5 !for output alignment - n_init_max=6 !maximum number of L_init - n_init=0 - L_ini_min=4 - if(n_ali.lt.4)L_ini_min=n_ali - do i=1,n_init_max-1 - n_init=n_init+1 - L_ini(n_init)=n_ali/2**(n_init-1) - if(L_ini(n_init).le.L_ini_min)then - L_ini(n_init)=L_ini_min - goto 402 - endif - enddo - n_init=n_init+1 - L_ini(n_init)=L_ini_min - 402 continue - -****************************************************************** -* find the maximum score starting from local structures superposition -****************************************************************** - score_max=-1 !TM-score - do 333 i_init=1,n_init - L_init=L_ini(i_init) - iL_max=n_ali-L_init+1 - do 300 iL=1,iL_max !on aligned residues, [1,nseqA] - LL=0 - ka=0 - do i=1,L_init - k=iL+i-1 ![1,n_ali] common aligned - r_1(1,i)=xa(iA(k)) - r_1(2,i)=ya(iA(k)) - r_1(3,i)=za(iA(k)) - r_2(1,i)=xb(iB(k)) - r_2(2,i)=yb(iB(k)) - r_2(3,i)=zb(iB(k)) - LL=LL+1 - ka=ka+1 - k_ali(ka)=k - enddo - call u3b(w,r_1,r_2,LL,1,rms,u,t,ier) !u rotate r_1 to r_2 - if(i_init.eq.1)then !global superposition - armsd=dsqrt(rms/LL) - Rcomm=armsd - endif - do j=1,nseqA - xt(j)=t(1)+u(1,1)*xa(j)+u(1,2)*ya(j)+u(1,3)*za(j) - yt(j)=t(2)+u(2,1)*xa(j)+u(2,2)*ya(j)+u(2,3)*za(j) - zt(j)=t(3)+u(3,1)*xa(j)+u(3,2)*ya(j)+u(3,3)*za(j) - enddo - d=d0_search-1 - call score_fun !init, get scores, n_cut+i_ali(i) for iteration - if(score_max.lt.score)then - score_max=score - ka0=ka - do i=1,ka0 - k_ali0(i)=k_ali(i) - enddo - endif -*** iteration for extending ----------------------------------> - d=d0_search+1 - do 301 it=1,n_it - LL=0 - ka=0 - do i=1,n_cut - m=i_ali(i) ![1,n_ali] - r_1(1,i)=xa(iA(m)) - r_1(2,i)=ya(iA(m)) - r_1(3,i)=za(iA(m)) - r_2(1,i)=xb(iB(m)) - r_2(2,i)=yb(iB(m)) - r_2(3,i)=zb(iB(m)) - ka=ka+1 - k_ali(ka)=m - LL=LL+1 - enddo - call u3b(w,r_1,r_2,LL,1,rms,u,t,ier) !u rotate r_1 to r_2 - do j=1,nseqA - xt(j)=t(1)+u(1,1)*xa(j)+u(1,2)*ya(j)+u(1,3)*za(j) - yt(j)=t(2)+u(2,1)*xa(j)+u(2,2)*ya(j)+u(2,3)*za(j) - zt(j)=t(3)+u(3,1)*xa(j)+u(3,2)*ya(j)+u(3,3)*za(j) - enddo - call score_fun !get scores, n_cut+i_ali(i) for iteration - if(score_max.lt.score)then - score_max=score - ka0=ka - do i=1,ka - k_ali0(i)=k_ali(i) - enddo - endif - if(it.eq.n_it)goto 302 - if(n_cut.eq.ka)then - neq=0 - do i=1,n_cut - if(i_ali(i).eq.k_ali(i))neq=neq+1 - enddo - if(n_cut.eq.neq)goto 302 - endif - 301 continue !for iteration - 302 continue - 300 continue !for shift - 333 continue !for initial length, L_ali/M - -******** return the final rotation **************** - LL=0 - do i=1,ka0 - m=k_ali0(i) !record of the best alignment - r_1(1,i)=xa(iA(m)) - r_1(2,i)=ya(iA(m)) - r_1(3,i)=za(iA(m)) - r_2(1,i)=xb(iB(m)) - r_2(2,i)=yb(iB(m)) - r_2(3,i)=zb(iB(m)) - LL=LL+1 - enddo - call u3b(w,r_1,r_2,LL,1,rms,u,t,ier) !u rotate r_1 to r_2 - do j=1,nseqA - x1(j)=t(1)+u(1,1)*xa(j)+u(1,2)*ya(j)+u(1,3)*za(j) - y1(j)=t(2)+u(2,1)*xa(j)+u(2,2)*ya(j)+u(2,3)*za(j) - z1(j)=t(3)+u(3,1)*xa(j)+u(3,2)*ya(j)+u(3,3)*za(j) - enddo - TM=score_max - -c^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - return - END - -ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c 1, collect those residues with dis -#include -#include -#include -#include - -main() -{ -FILE *in, *in1, *out; -int i,j,k,iv1,iv2,iv3; -char *p1,buf[500],buf1[500],buf2[100],buf3[100]; -struct utsname Name; -time_t Tp; - -in=fopen("cinfo.f","r"); -out=fopen("cinfo.f.new","w"); -if (fgets(buf,498,in) != NULL) - fprintf(out,"C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C\n"); -if (fgets(buf,498,in) != NULL) - sscanf(&buf[1],"%d %d %d",&iv1,&iv2,&iv3); -iv3++; -fprintf(out,"C %d %d %d\n",iv1,iv2,iv3); -fprintf(out," subroutine cinfo\n"); -fprintf(out," include 'COMMON.IOUNITS'\n"); -fprintf(out," write(iout,*)'++++ Compile info ++++'\n"); -fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3); -uname(&Name); -time(&Tp); -system("whoami > tmptmp"); -in1=fopen("tmptmp","r"); -if (fscanf(in1,"%s",buf1) != EOF) -{ -p1=ctime(&Tp); -p1[strlen(p1)-1]='\0'; -fprintf(out," write(iout,*)'compiled %s'\n",p1); -fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename); -fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname); -fprintf(out," write(iout,*)'OS release: %s '\n",Name.release); -fprintf(out," write(iout,*)'OS version:',\n"); -fprintf(out," & ' %s '\n",Name.version); -fprintf(out," write(iout,*)'flags:'\n"); -} -system("rm tmptmp"); -fclose(in1); -in1=fopen("Makefile","r"); -while(fgets(buf,498,in1) != NULL) - { - if((p1=strchr(buf,'=')) != NULL && buf[0] != '#') - { - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - else - { - while(buf[strlen(buf)-1]=='\\') - { - strcat(buf,"\\"); - fprintf(out," write(iout,*)'%s'\n",buf); - if (fgets(buf,498,in1) != NULL) - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - } - } - - fprintf(out," write(iout,*)'%s'\n",buf); - } - } -fprintf(out," write(iout,*)'++++ End of compile info ++++'\n"); -fprintf(out," return\n"); -fprintf(out," end\n"); -fclose(out); -fclose(in1); -fclose(in); -system("mv cinfo.f.new cinfo.f"); -} diff --git a/source/unres/src_CSA_DiL/contact.f b/source/unres/src_CSA_DiL/contact.f deleted file mode 100644 index 24b11d6..0000000 --- a/source/unres/src_CSA_DiL/contact.f +++ /dev/null @@ -1,195 +0,0 @@ - subroutine contact(lprint,ncont,icont,co) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - real*8 facont /1.569D0/ ! facont = (2/(1-sqrt(1-1/4)))**(1/6) - integer ncont,icont(2,maxcont) - logical lprint - ncont=0 - kkk=3 - do i=nnt+kkk,nct - iti=iabs(itype(i)) - do j=nnt,i-kkk - itj=iabs(itype(j)) - if (ipot.ne.4) then -c rcomp=sigmaii(iti,itj)+1.0D0 - rcomp=facont*sigmaii(iti,itj) - else -c rcomp=sigma(iti,itj)+1.0D0 - rcomp=facont*sigma(iti,itj) - endif -c rcomp=6.5D0 -c print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j) - if (dist(nres+i,nres+j).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'Contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif - co = 0.0d0 - do i=1,ncont - co = co + dfloat(iabs(icont(1,i)-icont(2,i))) - enddo - co = co / (nres*ncont) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract=dfloat(nmatch)/dfloat(ncont_ref) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract_nn(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont) - return - end -c---------------------------------------------------------------------------- - subroutine hairpin(lprint,nharp,iharp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - integer ncont,icont(2,maxcont) - integer nharp,iharp(4,maxres/3) - logical lprint,not_done - real*8 rcomp /6.0d0/ - ncont=0 - kkk=0 -c print *,'nnt=',nnt,' nct=',nct - do i=nnt,nct-3 - do k=1,3 - c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1)) - enddo - do j=i+2,nct-1 - do k=1,3 - c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1)) - enddo - if (dist(2*nres+1,2*nres+2).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'PP contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif -c finding hairpins - nharp=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then -c write (iout,*) "found turn at ",i1,j1 - ii1=i1 - jj1=j1 - not_done=.true. - do while (not_done) - i1=i1-1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -c write (iout,*) i1,j1,not_done - enddo - i1=i1+1 - j1=j1-1 - if (j1-i1.gt.4) then - nharp=nharp+1 - iharp(1,nharp)=i1 - iharp(2,nharp)=j1 - iharp(3,nharp)=ii1 - iharp(4,nharp)=jj1 -c write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4) - endif - endif - enddo -c do i=1,nharp -c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4) -c enddo - if (lprint) then - write (iout,*) "Hairpins:" - do i=1,nharp - i1=iharp(1,i) - j1=iharp(2,i) - ii1=iharp(3,i) - jj1=iharp(4,i) - write (iout,*) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) -c do k=jj1,j1,-1 -c write (iout,'(a,i3,$)') restyp(itype(k)),k -c enddo - enddo - endif - return - end -c---------------------------------------------------------------------------- - diff --git a/source/unres/src_CSA_DiL/convert.f b/source/unres/src_CSA_DiL/convert.f deleted file mode 100644 index dc0cccd..0000000 --- a/source/unres/src_CSA_DiL/convert.f +++ /dev/null @@ -1,196 +0,0 @@ - subroutine geom_to_var(n,x) -C -C Transfer the geometry parameters to the variable array. -C The positions of variables are as follows: -C 1. Virtual-bond torsional angles: 1 thru nres-3 -C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5 -C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru -C 2*nres-4+nside -C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1 -C thru 2*nre-4+2*nside -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - double precision x(n) -cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar - do i=4,nres - x(i-3)=phi(i) -cd print *,i,i-3,phi(i) - enddo - if (n.eq.nphi) return - do i=3,nres - x(i-2+nphi)=theta(i) -cd print *,i,i-2+nphi,theta(i) - enddo - if (n.eq.nphi+ntheta) return - do i=2,nres-1 - if (ialph(i,1).gt.0) then - x(ialph(i,1))=alph(i) - x(ialph(i,1)+nside)=omeg(i) -cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i) - endif - enddo - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom(n,x) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(n) - logical change,reduce - change=reduce(x) - if (n.gt.nphi+ntheta) then - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - endif - do i=4,nres - phi(i)=x(i-3) - enddo - if (n.eq.nphi) return - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- - logical function convert_side(alphi,omegi) - implicit none - double precision alphi,omegi - double precision pinorm - include 'COMMON.GEO' - convert_side=.false. -C Apply periodicity restrictions. - if (alphi.gt.pi) then - alphi=dwapi-alphi - omegi=pinorm(omegi+pi) - convert_side=.true. - endif - return - end -c------------------------------------------------------------------------- - logical function reduce(x) -C -C Apply periodic restrictions to variables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - logical zm,zmiana,convert_side - dimension x(nvar) - zmiana=.false. - do i=4,nres - x(i-3)=pinorm(x(i-3)) - enddo - if (nvar.gt.nphi+ntheta) then - do i=1,nside - ii=nphi+ntheta+i - iii=ii+nside - x(ii)=thetnorm(x(ii)) - x(iii)=pinorm(x(iii)) -C Apply periodic restrictions. - zm=convert_side(x(ii),x(iii)) - zmiana=zmiana.or.zm - enddo - endif - if (nvar.eq.nphi) return - do i=3,nres - ii=i-2+nphi - iii=i-3 - x(ii)=dmod(x(ii),dwapi) -C Apply periodic restrictions. - if (x(ii).gt.pi) then - zmiana=.true. - x(ii)=dwapi-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.-pi) then - zmiana=.true. - x(ii)=dwapi+x(ii) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-pi-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.0.0d0) then - zmiana=.true. - x(ii)=-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - endif - enddo - reduce=zmiana - return - end -c-------------------------------------------------------------------------- - double precision function thetnorm(x) -C This function puts x within [0,2Pi]. - implicit none - double precision x,xx - include 'COMMON.GEO' - xx=dmod(x,dwapi) - if (xx.lt.0.0d0) xx=xx+dwapi - if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi - thetnorm=xx - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom_restr(n,xx) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(maxvar),xx(maxvar) - logical change,reduce - - call xx2x(x,xx) - change=reduce(x) - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - do i=4,nres - phi(i)=x(i-3) - enddo - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- diff --git a/source/unres/src_CSA_DiL/cored.f b/source/unres/src_CSA_DiL/cored.f deleted file mode 100644 index 1cf25e5..0000000 --- a/source/unres/src_CSA_DiL/cored.f +++ /dev/null @@ -1,3151 +0,0 @@ - subroutine assst(iv, liv, lv, v) -c -c *** assess candidate step (***sol version 2.3) *** -c - integer liv, l - integer iv(liv) - double precision v(lv) -c -c *** purpose *** -c -c this subroutine is called by an unconstrained minimization -c routine to assess the next candidate step. it may recommend one -c of several courses of action, such as accepting the step, recom- -c puting it using the same or a new quadratic model, or halting due -c to convergence or false convergence. see the return code listing -c below. -c -c-------------------------- parameter usage -------------------------- -c -c iv (i/o) integer parameter and scratch vector -- see description -c below of iv values referenced. -c liv (in) length of iv array. -c lv (in) length of v array. -c v (i/o) real parameter and scratch vector -- see description -c below of v values referenced. -c -c *** iv values referenced *** -c -c iv(irc) (i/o) on input for the first step tried in a new iteration, -c iv(irc) should be set to 3 or 4 (the value to which it is -c set when step is definitely to be accepted). on input -c after step has been recomputed, iv(irc) should be -c unchanged since the previous return of assst. -c on output, iv(irc) is a return code having one of the -c following values... -c 1 = switch models or try smaller step. -c 2 = switch models or accept step. -c 3 = accept step and determine v(radfac) by gradient -c tests. -c 4 = accept step, v(radfac) has been determined. -c 5 = recompute step (using the same model). -c 6 = recompute step with radius = v(lmaxs) but do not -c evaulate the objective function. -c 7 = x-convergence (see v(xctol)). -c 8 = relative function convergence (see v(rfctol)). -c 9 = both x- and relative function convergence. -c 10 = absolute function convergence (see v(afctol)). -c 11 = singular convergence (see v(lmaxs)). -c 12 = false convergence (see v(xftol)). -c 13 = iv(irc) was out of range on input. -c return code i has precdence over i+1 for i = 9, 10, 11. -c iv(mlstgd) (i/o) saved value of iv(model). -c iv(model) (i/o) on input, iv(model) should be an integer identifying -c the current quadratic model of the objective function. -c if a previous step yielded a better function reduction, -c then iv(model) will be set to iv(mlstgd) on output. -c iv(nfcall) (in) invocation count for the objective function. -c iv(nfgcal) (i/o) value of iv(nfcall) at step that gave the biggest -c function reduction this iteration. iv(nfgcal) remains -c unchanged until a function reduction is obtained. -c iv(radinc) (i/o) the number of radius increases (or minus the number -c of decreases) so far this iteration. -c iv(restor) (out) set to 1 if v(f) has been restored and x should be -c restored to its initial value, to 2 if x should be saved, -c to 3 if x should be restored from the saved value, and to -c 0 otherwise. -c iv(stage) (i/o) count of the number of models tried so far in the -c current iteration. -c iv(stglim) (in) maximum number of models to consider. -c iv(switch) (out) set to 0 unless a new model is being tried and it -c gives a smaller function value than the previous model, -c in which case assst sets iv(switch) = 1. -c iv(toobig) (in) is nonzero if step was too big (e.g. if it caused -c overflow). -c iv(xirc) (i/o) value that iv(irc) would have in the absence of -c convergence, false convergence, and oversized steps. -c -c *** v values referenced *** -c -c v(afctol) (in) absolute function convergence tolerance. if the -c absolute value of the current function value v(f) is less -c than v(afctol), then assst returns with iv(irc) = 10. -c v(decfac) (in) factor by which to decrease radius when iv(toobig) is -c nonzero. -c v(dstnrm) (in) the 2-norm of d*step. -c v(dstsav) (i/o) value of v(dstnrm) on saved step. -c v(dst0) (in) the 2-norm of d times the newton step (when defined, -c i.e., for v(nreduc) .ge. 0). -c v(f) (i/o) on both input and output, v(f) is the objective func- -c tion value at x. if x is restored to a previous value, -c then v(f) is restored to the corresponding value. -c v(fdif) (out) the function reduction v(f0) - v(f) (for the output -c value of v(f) if an earlier step gave a bigger function -c decrease, and for the input value of v(f) otherwise). -c v(flstgd) (i/o) saved value of v(f). -c v(f0) (in) objective function value at start of iteration. -c v(gtslst) (i/o) value of v(gtstep) on saved step. -c v(gtstep) (in) inner product between step and gradient. -c v(incfac) (in) minimum factor by which to increase radius. -c v(lmaxs) (in) maximum reasonable step size (and initial step bound). -c if the actual function decrease is no more than twice -c what was predicted, if a return with iv(irc) = 7, 8, 9, -c or 10 does not occur, if v(dstnrm) .gt. v(lmaxs), and if -c v(preduc) .le. v(sctol) * abs(v(f0)), then assst re- -c turns with iv(irc) = 11. if so doing appears worthwhile, -c then assst repeats this test with v(preduc) computed for -c a step of length v(lmaxs) (by a return with iv(irc) = 6). -c v(nreduc) (i/o) function reduction predicted by quadratic model for -c newton step. if assst is called with iv(irc) = 6, i.e., -c if v(preduc) has been computed with radius = v(lmaxs) for -c use in the singular convervence test, then v(nreduc) is -c set to -v(preduc) before the latter is restored. -c v(plstgd) (i/o) value of v(preduc) on saved step. -c v(preduc) (i/o) function reduction predicted by quadratic model for -c current step. -c v(radfac) (out) factor to be used in determining the new radius, -c which should be v(radfac)*dst, where dst is either the -c output value of v(dstnrm) or the 2-norm of -c diag(newd)*step for the output value of step and the -c updated version, newd, of the scale vector d. for -c iv(irc) = 3, v(radfac) = 1.0 is returned. -c v(rdfcmn) (in) minimum value for v(radfac) in terms of the input -c value of v(dstnrm) -- suggested value = 0.1. -c v(rdfcmx) (in) maximum value for v(radfac) -- suggested value = 4.0. -c v(reldx) (in) scaled relative change in x caused by step, computed -c (e.g.) by function reldst as -c max (d(i)*abs(x(i)-x0(i)), 1 .le. i .le. p) / -c max (d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p). -c v(rfctol) (in) relative function convergence tolerance. if the -c actual function reduction is at most twice what was pre- -c dicted and v(nreduc) .le. v(rfctol)*abs(v(f0)), then -c assst returns with iv(irc) = 8 or 9. -c v(stppar) (in) marquardt parameter -- 0 means full newton step. -c v(tuner1) (in) tuning constant used to decide if the function -c reduction was much less than expected. suggested -c value = 0.1. -c v(tuner2) (in) tuning constant used to decide if the function -c reduction was large enough to accept step. suggested -c value = 10**-4. -c v(tuner3) (in) tuning constant used to decide if the radius -c should be increased. suggested value = 0.75. -c v(xctol) (in) x-convergence criterion. if step is a newton step -c (v(stppar) = 0) having v(reldx) .le. v(xctol) and giving -c at most twice the predicted function decrease, then -c assst returns iv(irc) = 7 or 9. -c v(xftol) (in) false convergence tolerance. if step gave no or only -c a small function decrease and v(reldx) .le. v(xftol), -c then assst returns with iv(irc) = 12. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine is called as part of the nl2sol (nonlinear -c least-squares) package. it may be used in any unconstrained -c minimization solver that uses dogleg, goldfeld-quandt-trotter, -c or levenberg-marquardt steps. -c -c *** algorithm notes *** -c -c see (1) for further discussion of the assessing and model -c switching strategies. while nl2sol considers only two models, -c assst is designed to handle any number of models. -c -c *** usage notes *** -c -c on the first call of an iteration, only the i/o variables -c step, x, iv(irc), iv(model), v(f), v(dstnrm), v(gtstep), and -c v(preduc) need have been initialized. between calls, no i/o -c values execpt step, x, iv(model), v(f) and the stopping toler- -c ances should be changed. -c after a return for convergence or false convergence, one can -c change the stopping tolerances and call assst again, in which -c case the stopping tests will be repeated. -c -c *** references *** -c -c (1) dennis, j.e., jr., gay, d.m., and welsch, r.e. (1981), -c an adaptive nonlinear least-squares algorithm, -c acm trans. math. software, vol. 7, no. 3. -c -c (2) powell, m.j.d. (1970) a fortran subroutine for solving -c systems of nonlinear algebraic equations, in numerical -c methods for nonlinear algebraic equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** history *** -c -c john dennis designed much of this routine, starting with -c ideas in (2). roy welsch suggested the model switching strategy. -c david gay and stephen peters cast this subroutine into a more -c portable form (winter 1977), and david gay cast it into its -c present form (fall 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** no external functions and subroutines *** -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1 -c/ -c *** no common blocks *** -c -c-------------------------- local variables -------------------------- -c - logical goodx - integer i, nfc - double precision emax, emaxs, gts, rfac1, xmax - double precision half, one, onep2, two, zero -c -c *** subscripts for iv and v *** -c - integer afctol, decfac, dstnrm, dstsav, dst0, f, fdif, flstgd, f0, - 1 gtslst, gtstep, incfac, irc, lmaxs, mlstgd, model, nfcall, - 2 nfgcal, nreduc, plstgd, preduc, radfac, radinc, rdfcmn, - 3 rdfcmx, reldx, restor, rfctol, sctol, stage, stglim, - 4 stppar, switch, toobig, tuner1, tuner2, tuner3, xctol, - 5 xftol, xirc -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, onep2/1.2d+0/, two/2.d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, onep2=1.2d+0, two=2.d+0, - 1 zero=0.d+0) -c/ -c -c/6 -c data irc/29/, mlstgd/32/, model/5/, nfcall/6/, nfgcal/7/, -c 1 radinc/8/, restor/9/, stage/10/, stglim/11/, switch/12/, -c 2 toobig/2/, xirc/13/ -c/7 - parameter (irc=29, mlstgd=32, model=5, nfcall=6, nfgcal=7, - 1 radinc=8, restor=9, stage=10, stglim=11, switch=12, - 2 toobig=2, xirc=13) -c/ -c/6 -c data afctol/31/, decfac/22/, dstnrm/2/, dst0/3/, dstsav/18/, -c 1 f/10/, fdif/11/, flstgd/12/, f0/13/, gtslst/14/, gtstep/4/, -c 2 incfac/23/, lmaxs/36/, nreduc/6/, plstgd/15/, preduc/7/, -c 3 radfac/16/, rdfcmn/24/, rdfcmx/25/, reldx/17/, rfctol/32/, -c 4 sctol/37/, stppar/5/, tuner1/26/, tuner2/27/, tuner3/28/, -c 5 xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, decfac=22, dstnrm=2, dst0=3, dstsav=18, - 1 f=10, fdif=11, flstgd=12, f0=13, gtslst=14, gtstep=4, - 2 incfac=23, lmaxs=36, nreduc=6, plstgd=15, preduc=7, - 3 radfac=16, rdfcmn=24, rdfcmx=25, reldx=17, rfctol=32, - 4 sctol=37, stppar=5, tuner1=26, tuner2=27, tuner3=28, - 5 xctol=33, xftol=34) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nfc = iv(nfcall) - iv(switch) = 0 - iv(restor) = 0 - rfac1 = one - goodx = .true. - i = iv(irc) - if (i .ge. 1 .and. i .le. 12) - 1 go to (20,30,10,10,40,280,220,220,220,220,220,170), i - iv(irc) = 13 - go to 999 -c -c *** initialize for new iteration *** -c - 10 iv(stage) = 1 - iv(radinc) = 0 - v(flstgd) = v(f0) - if (iv(toobig) .eq. 0) go to 110 - iv(stage) = -1 - iv(xirc) = i - go to 60 -c -c *** step was recomputed with new model or smaller radius *** -c *** first decide which *** -c - 20 if (iv(model) .ne. iv(mlstgd)) go to 30 -c *** old model retained, smaller radius tried *** -c *** do not consider any more new models this iteration *** - iv(stage) = iv(stglim) - iv(radinc) = -1 - go to 110 -c -c *** a new model is being tried. decide whether to keep it. *** -c - 30 iv(stage) = iv(stage) + 1 -c -c *** now we add the possibiltiy that step was recomputed with *** -c *** the same model, perhaps because of an oversized step. *** -c - 40 if (iv(stage) .gt. 0) go to 50 -c -c *** step was recomputed because it was too big. *** -c - if (iv(toobig) .ne. 0) go to 60 -c -c *** restore iv(stage) and pick up where we left off. *** -c - iv(stage) = -iv(stage) - i = iv(xirc) - go to (20, 30, 110, 110, 70), i -c - 50 if (iv(toobig) .eq. 0) go to 70 -c -c *** handle oversize step *** -c - if (iv(radinc) .gt. 0) go to 80 - iv(stage) = -iv(stage) - iv(xirc) = iv(irc) -c - 60 v(radfac) = v(decfac) - iv(radinc) = iv(radinc) - 1 - iv(irc) = 5 - iv(restor) = 1 - go to 999 -c - 70 if (v(f) .lt. v(flstgd)) go to 110 -c -c *** the new step is a loser. restore old model. *** -c - if (iv(model) .eq. iv(mlstgd)) go to 80 - iv(model) = iv(mlstgd) - iv(switch) = 1 -c -c *** restore step, etc. only if a previous step decreased v(f). -c - 80 if (v(flstgd) .ge. v(f0)) go to 110 - iv(restor) = 1 - v(f) = v(flstgd) - v(preduc) = v(plstgd) - v(gtstep) = v(gtslst) - if (iv(switch) .eq. 0) rfac1 = v(dstnrm) / v(dstsav) - v(dstnrm) = v(dstsav) - nfc = iv(nfgcal) - goodx = .false. -c - 110 v(fdif) = v(f0) - v(f) - if (v(fdif) .gt. v(tuner2) * v(preduc)) go to 140 - if(iv(radinc).gt.0) go to 140 -c -c *** no (or only a trivial) function decrease -c *** -- so try new model or smaller radius -c - if (v(f) .lt. v(f0)) go to 120 - iv(mlstgd) = iv(model) - v(flstgd) = v(f) - v(f) = v(f0) - iv(restor) = 1 - go to 130 - 120 iv(nfgcal) = nfc - 130 iv(irc) = 1 - if (iv(stage) .lt. iv(stglim)) go to 160 - iv(irc) = 5 - iv(radinc) = iv(radinc) - 1 - go to 160 -c -c *** nontrivial function decrease achieved *** -c - 140 iv(nfgcal) = nfc - rfac1 = one - v(dstsav) = v(dstnrm) - if (v(fdif) .gt. v(preduc)*v(tuner1)) go to 190 -c -c *** decrease was much less than predicted -- either change models -c *** or accept step with decreased radius. -c - if (iv(stage) .ge. iv(stglim)) go to 150 -c *** consider switching models *** - iv(irc) = 2 - go to 160 -c -c *** accept step with decreased radius *** -c - 150 iv(irc) = 4 -c -c *** set v(radfac) to fletcher*s decrease factor *** -c - 160 iv(xirc) = iv(irc) - emax = v(gtstep) + v(fdif) - v(radfac) = half * rfac1 - if (emax .lt. v(gtstep)) v(radfac) = rfac1 * dmax1(v(rdfcmn), - 1 half * v(gtstep)/emax) -c -c *** do false convergence test *** -c - 170 if (v(reldx) .le. v(xftol)) go to 180 - iv(irc) = iv(xirc) - if (v(f) .lt. v(f0)) go to 200 - go to 230 -c - 180 iv(irc) = 12 - go to 240 -c -c *** handle good function decrease *** -c - 190 if (v(fdif) .lt. (-v(tuner3) * v(gtstep))) go to 210 -c -c *** increasing radius looks worthwhile. see if we just -c *** recomputed step with a decreased radius or restored step -c *** after recomputing it with a larger radius. -c - if (iv(radinc) .lt. 0) go to 210 - if (iv(restor) .eq. 1) go to 210 -c -c *** we did not. try a longer step unless this was a newton -c *** step. -c - v(radfac) = v(rdfcmx) - gts = v(gtstep) - if (v(fdif) .lt. (half/v(radfac) - one) * gts) - 1 v(radfac) = dmax1(v(incfac), half*gts/(gts + v(fdif))) - iv(irc) = 4 - if (v(stppar) .eq. zero) go to 230 - if (v(dst0) .ge. zero .and. (v(dst0) .lt. two*v(dstnrm) - 1 .or. v(nreduc) .lt. onep2*v(fdif))) go to 230 -c *** step was not a newton step. recompute it with -c *** a larger radius. - iv(irc) = 5 - iv(radinc) = iv(radinc) + 1 -c -c *** save values corresponding to good step *** -c - 200 v(flstgd) = v(f) - iv(mlstgd) = iv(model) - if (iv(restor) .ne. 1) iv(restor) = 2 - v(dstsav) = v(dstnrm) - iv(nfgcal) = nfc - v(plstgd) = v(preduc) - v(gtslst) = v(gtstep) - go to 230 -c -c *** accept step with radius unchanged *** -c - 210 v(radfac) = one - iv(irc) = 3 - go to 230 -c -c *** come here for a restart after convergence *** -c - 220 iv(irc) = iv(xirc) - if (v(dstsav) .ge. zero) go to 240 - iv(irc) = 12 - go to 240 -c -c *** perform convergence tests *** -c - 230 iv(xirc) = iv(irc) - 240 if (iv(restor) .eq. 1 .and. v(flstgd) .lt. v(f0)) iv(restor) = 3 - if (half * v(fdif) .gt. v(preduc)) go to 999 - emax = v(rfctol) * dabs(v(f0)) - emaxs = v(sctol) * dabs(v(f0)) - if (v(dstnrm) .gt. v(lmaxs) .and. v(preduc) .le. emaxs) - 1 iv(irc) = 11 - if (v(dst0) .lt. zero) go to 250 - i = 0 - if ((v(nreduc) .gt. zero .and. v(nreduc) .le. emax) .or. - 1 (v(nreduc) .eq. zero. and. v(preduc) .eq. zero)) i = 2 - if (v(stppar) .eq. zero .and. v(reldx) .le. v(xctol) - 1 .and. goodx) i = i + 1 - if (i .gt. 0) iv(irc) = i + 6 -c -c *** consider recomputing step of length v(lmaxs) for singular -c *** convergence test. -c - 250 if (iv(irc) .gt. 5 .and. iv(irc) .ne. 12) go to 999 - if (v(dstnrm) .gt. v(lmaxs)) go to 260 - if (v(preduc) .ge. emaxs) go to 999 - if (v(dst0) .le. zero) go to 270 - if (half * v(dst0) .le. v(lmaxs)) go to 999 - go to 270 - 260 if (half * v(dstnrm) .le. v(lmaxs)) go to 999 - xmax = v(lmaxs) / v(dstnrm) - if (xmax * (two - xmax) * v(preduc) .ge. emaxs) go to 999 - 270 if (v(nreduc) .lt. zero) go to 290 -c -c *** recompute v(preduc) for use in singular convergence test *** -c - v(gtslst) = v(gtstep) - v(dstsav) = v(dstnrm) - if (iv(irc) .eq. 12) v(dstsav) = -v(dstsav) - v(plstgd) = v(preduc) - i = iv(restor) - iv(restor) = 2 - if (i .eq. 3) iv(restor) = 0 - iv(irc) = 6 - go to 999 -c -c *** perform singular convergence test with recomputed v(preduc) *** -c - 280 v(gtstep) = v(gtslst) - v(dstnrm) = dabs(v(dstsav)) - iv(irc) = iv(xirc) - if (v(dstsav) .le. zero) iv(irc) = 12 - v(nreduc) = -v(preduc) - v(preduc) = v(plstgd) - iv(restor) = 3 - 290 if (-v(nreduc) .le. v(sctol) * dabs(v(f0))) iv(irc) = 11 -c - 999 return -c -c *** last card of assst follows *** - end - subroutine deflt(alg, iv, liv, lv, v) -c -c *** supply ***sol (version 2.3) default values to iv and v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer liv, l - integer alg, iv(liv) - double precision v(lv) -c - external imdcon, vdflt - integer imdcon -c imdcon... returns machine-dependent integer constants. -c vdflt.... provides default values to v. -c - integer miv, m - integer miniv(2), minv(2) -c -c *** subscripts for iv *** -c - integer algsav, covprt, covreq, dtype, hc, ierr, inith, inits, - 1 ipivot, ivneed, lastiv, lastv, lmat, mxfcal, mxiter, - 2 nfcov, ngcov, nvdflt, outlev, parprt, parsav, perm, - 3 prunit, qrtyp, rdreq, rmat, solprt, statpr, vneed, - 4 vsave, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, covprt/14/, covreq/15/, dtype/16/, hc/71/, -c 1 ierr/75/, inith/25/, inits/25/, ipivot/76/, ivneed/3/, -c 2 lastiv/44/, lastv/45/, lmat/42/, mxfcal/17/, mxiter/18/, -c 3 nfcov/52/, ngcov/53/, nvdflt/50/, outlev/19/, parprt/20/, -c 4 parsav/49/, perm/58/, prunit/21/, qrtyp/80/, rdreq/57/, -c 5 rmat/78/, solprt/22/, statpr/23/, vneed/4/, vsave/60/, -c 6 x0prt/24/ -c/7 - parameter (algsav=51, covprt=14, covreq=15, dtype=16, hc=71, - 1 ierr=75, inith=25, inits=25, ipivot=76, ivneed=3, - 2 lastiv=44, lastv=45, lmat=42, mxfcal=17, mxiter=18, - 3 nfcov=52, ngcov=53, nvdflt=50, outlev=19, parprt=20, - 4 parsav=49, perm=58, prunit=21, qrtyp=80, rdreq=57, - 5 rmat=78, solprt=22, statpr=23, vneed=4, vsave=60, - 6 x0prt=24) -c/ - data miniv(1)/80/, miniv(2)/59/, minv(1)/98/, minv(2)/71/ -c -c------------------------------- body -------------------------------- -c - if (alg .lt. 1 .or. alg .gt. 2) go to 40 - miv = miniv(alg) - if (liv .lt. miv) go to 20 - mv = minv(alg) - if (lv .lt. mv) go to 30 - call vdflt(alg, lv, v) - iv(1) = 12 - iv(algsav) = alg - iv(ivneed) = 0 - iv(lastiv) = miv - iv(lastv) = mv - iv(lmat) = mv + 1 - iv(mxfcal) = 200 - iv(mxiter) = 150 - iv(outlev) = 1 - iv(parprt) = 1 - iv(perm) = miv + 1 - iv(prunit) = imdcon(1) - iv(solprt) = 1 - iv(statpr) = 1 - iv(vneed) = 0 - iv(x0prt) = 1 -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - iv(covprt) = 3 - iv(covreq) = 1 - iv(dtype) = 1 - iv(hc) = 0 - iv(ierr) = 0 - iv(inits) = 0 - iv(ipivot) = 0 - iv(nvdflt) = 32 - iv(parsav) = 67 - iv(qrtyp) = 1 - iv(rdreq) = 3 - iv(rmat) = 0 - iv(vsave) = 58 - go to 999 -c -c *** general optimization values -c - 10 iv(dtype) = 0 - iv(inith) = 1 - iv(nfcov) = 0 - iv(ngcov) = 0 - iv(nvdflt) = 25 - iv(parsav) = 47 - go to 999 -c - 20 iv(1) = 15 - go to 999 -c - 30 iv(1) = 16 - go to 999 -c - 40 iv(1) = 67 -c - 999 return -c *** last card of deflt follows *** - end - double precision function dotprd(p, x, y) -c -c *** return the inner product of the p-vectors x and y. *** -c - integer p - double precision x(p), y(p) -c - integer i - double precision one, sqteta, t, zero -c/+ - double precision dmax1, dabs -c/ - external rmdcon - double precision rmdcon -c -c *** rmdcon(2) returns a machine-dependent constant, sqteta, which -c *** is slightly larger than the smallest positive number that -c *** can be squared without underflowing. -c -c/6 -c data one/1.d+0/, sqteta/0.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - data sqteta/0.d+0/ -c/ -c - dotprd = zero - if (p .le. 0) go to 999 -crc if (sqteta .eq. zero) sqteta = rmdcon(2) - do 20 i = 1, p -crc t = dmax1(dabs(x(i)), dabs(y(i))) -crc if (t .gt. one) go to 10 -crc if (t .lt. sqteta) go to 20 -crc t = (x(i)/sqteta)*y(i) -crc if (dabs(t) .lt. sqteta) go to 20 - 10 dotprd = dotprd + x(i)*y(i) - 20 continue -c - 999 return -c *** last card of dotprd follows *** - end - subroutine itsum(d, g, iv, liv, lv, p, v, x) -c -c *** print iteration summary for ***sol (version 2.3) *** -c -c *** parameter declarations *** -c - integer liv, lv, p - integer iv(liv) - double precision d(p), g(p), v(lv), x(p) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer alg, i, iv1, m, nf, ng, ol, pu -c/6 -c real model1(6), model2(6) -c/7 - character*4 model1(6), model2(6) -c/ - double precision nreldf, oldf, preldf, reldf, zero -c -c *** intrinsic functions *** -c/+ - integer iabs - double precision dabs, dmax1 -c/ -c *** no external functions or subroutines *** -c -c *** subscripts for iv and v *** -c - integer algsav, dstnrm, f, fdif, f0, needhd, nfcall, nfcov, ngcov, - 1 ngcall, niter, nreduc, outlev, preduc, prntit, prunit, - 2 reldx, solprt, statpr, stppar, sused, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, needhd/36/, nfcall/6/, nfcov/52/, ngcall/30/, -c 1 ngcov/53/, niter/31/, outlev/19/, prntit/39/, prunit/21/, -c 2 solprt/22/, statpr/23/, sused/64/, x0prt/24/ -c/7 - parameter (algsav=51, needhd=36, nfcall=6, nfcov=52, ngcall=30, - 1 ngcov=53, niter=31, outlev=19, prntit=39, prunit=21, - 2 solprt=22, statpr=23, sused=64, x0prt=24) -c/ -c -c *** v subscript values *** -c -c/6 -c data dstnrm/2/, f/10/, f0/13/, fdif/11/, nreduc/6/, preduc/7/, -c 1 reldx/17/, stppar/5/ -c/7 - parameter (dstnrm=2, f=10, f0=13, fdif=11, nreduc=6, preduc=7, - 1 reldx=17, stppar=5) -c/ -c -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c/6 -c data model1(1)/4h /, model1(2)/4h /, model1(3)/4h /, -c 1 model1(4)/4h /, model1(5)/4h g /, model1(6)/4h s /, -c 2 model2(1)/4h g /, model2(2)/4h s /, model2(3)/4hg-s /, -c 3 model2(4)/4hs-g /, model2(5)/4h-s-g/, model2(6)/4h-g-s/ -c/7 - data model1/' ',' ',' ',' ',' g ',' s '/, - 1 model2/' g ',' s ','g-s ','s-g ','-s-g','-g-s'/ -c/ -c -c------------------------------- body -------------------------------- -c - pu = iv(prunit) - if (pu .eq. 0) go to 999 - iv1 = iv(1) - if (iv1 .gt. 62) iv1 = iv1 - 51 - ol = iv(outlev) - alg = iv(algsav) - if (iv1 .lt. 2 .or. iv1 .gt. 15) go to 370 - if (iv1 .ge. 12) go to 120 - if (iv1 .eq. 2 .and. iv(niter) .eq. 0) go to 390 - if (ol .eq. 0) go to 120 - if (iv1 .ge. 10 .and. iv(prntit) .eq. 0) go to 120 - if (iv1 .gt. 2) go to 10 - iv(prntit) = iv(prntit) + 1 - if (iv(prntit) .lt. iabs(ol)) go to 999 - 10 nf = iv(nfcall) - iabs(iv(nfcov)) - iv(prntit) = 0 - reldf = zero - preldf = zero - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - if (oldf .le. zero) go to 20 - reldf = v(fdif) / oldf - preldf = v(preduc) / oldf - 20 if (ol .gt. 0) go to 60 -c -c *** print short summary line *** -c - if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,30) - 30 format(/10h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,40) - 40 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar) - iv(needhd) = 0 - if (alg .eq. 2) go to 50 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar) - go to 120 -c - 50 write(pu,110) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 v(stppar) - go to 120 -c -c *** print long summary line *** -c - 60 if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,70) - 70 format(/11h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar,2x,6hd*step,2x,7hnpreldf) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,80) - 80 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar,3x,6hd*step,3x,7hnpreldf) - iv(needhd) = 0 - nreldf = zero - if (oldf .gt. zero) nreldf = v(nreduc) / oldf - if (alg .eq. 2) go to 90 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar), v(dstnrm), nreldf - go to 120 -c - 90 write(pu,110) iv(niter), nf, v(f), reldf, preldf, - 1 v(reldx), v(stppar), v(dstnrm), nreldf - 100 format(i6,i5,d10.3,2d9.2,d8.1,a3,a4,2d8.1,d9.2) - 110 format(i6,i5,d11.3,2d10.2,3d9.1,d10.2) -c - 120 if (iv(statpr) .lt. 0) go to 430 - go to (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310, - 1 330, 350, 520), iv1 -c - 130 write(pu,140) - 140 format(/26h ***** x-convergence *****) - go to 430 -c - 150 write(pu,160) - 160 format(/42h ***** relative function convergence *****) - go to 430 -c - 170 write(pu,180) - 180 format(/49h ***** x- and relative function convergence *****) - go to 430 -c - 190 write(pu,200) - 200 format(/42h ***** absolute function convergence *****) - go to 430 -c - 210 write(pu,220) - 220 format(/33h ***** singular convergence *****) - go to 430 -c - 230 write(pu,240) - 240 format(/30h ***** false convergence *****) - go to 430 -c - 250 write(pu,260) - 260 format(/38h ***** function evaluation limit *****) - go to 430 -c - 270 write(pu,280) - 280 format(/28h ***** iteration limit *****) - go to 430 -c - 290 write(pu,300) - 300 format(/18h ***** stopx *****) - go to 430 -c - 310 write(pu,320) - 320 format(/44h ***** initial f(x) cannot be computed *****) -c - go to 390 -c - 330 write(pu,340) - 340 format(/37h ***** bad parameters to assess *****) - go to 999 -c - 350 write(pu,360) - 360 format(/43h ***** gradient could not be computed *****) - if (iv(niter) .gt. 0) go to 480 - go to 390 -c - 370 write(pu,380) iv(1) - 380 format(/14h ***** iv(1) =,i5,6h *****) - go to 999 -c -c *** initial call on itsum *** -c - 390 if (iv(x0prt) .ne. 0) write(pu,400) (i, x(i), d(i), i = 1, p) - 400 format(/23h i initial x(i),8x,4hd(i)//(1x,i5,d17.6,d14.3)) -c *** the following are to avoid undefined variables when the -c *** function evaluation limit is 1... - v(dstnrm) = zero - v(fdif) = zero - v(nreduc) = zero - v(preduc) = zero - v(reldx) = zero - if (iv1 .ge. 12) go to 999 - iv(needhd) = 0 - iv(prntit) = 0 - if (ol .eq. 0) go to 999 - if (ol .lt. 0 .and. alg .eq. 1) write(pu,30) - if (ol .lt. 0 .and. alg .eq. 2) write(pu,40) - if (ol .gt. 0 .and. alg .eq. 1) write(pu,70) - if (ol .gt. 0 .and. alg .eq. 2) write(pu,80) - if (alg .eq. 1) write(pu,410) v(f) - if (alg .eq. 2) write(pu,420) v(f) - 410 format(/11h 0 1,d10.3) -c365 format(/11h 0 1,e11.3) - 420 format(/11h 0 1,d11.3) - go to 999 -c -c *** print various information requested on solution *** -c - 430 iv(needhd) = 1 - if (iv(statpr) .eq. 0) go to 480 - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - preldf = zero - nreldf = zero - if (oldf .le. zero) go to 440 - preldf = v(preduc) / oldf - nreldf = v(nreduc) / oldf - 440 nf = iv(nfcall) - iv(nfcov) - ng = iv(ngcall) - iv(ngcov) - write(pu,450) v(f), v(reldx), nf, ng, preldf, nreldf - 450 format(/9h function,d17.6,8h reldx,d17.3/12h func. evals, - 1 i8,9x,11hgrad. evals,i8/7h preldf,d16.3,6x,7hnpreldf,d15.3) -c - if (iv(nfcov) .gt. 0) write(pu,460) iv(nfcov) - 460 format(/1x,i4,50h extra func. evals for covariance and diagnost - 1ics.) - if (iv(ngcov) .gt. 0) write(pu,470) iv(ngcov) - 470 format(1x,i4,50h extra grad. evals for covariance and diagnosti - 1cs.) -c - 480 if (iv(solprt) .eq. 0) go to 999 - iv(needhd) = 1 - write(pu,490) - 490 format(/22h i final x(i),8x,4hd(i),10x,4hg(i)/) - do 500 i = 1, p - write(pu,510) i, x(i), d(i), g(i) - 500 continue - 510 format(1x,i5,d16.6,2d14.3) - go to 999 -c - 520 write(pu,530) - 530 format(/24h inconsistent dimensions) - 999 return -c *** last card of itsum follows *** - end - subroutine litvmu(n, x, l, y) -c -c *** solve (l**t)*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - integer i, ii, ij, im1, i0, j, np1 - double precision xi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 i = 1, n - 10 x(i) = y(i) - np1 = n + 1 - i0 = n*(n+1)/2 - do 30 ii = 1, n - i = np1 - ii - xi = x(i)/l(i0) - x(i) = xi - if (i .le. 1) go to 999 - i0 = i0 - i - if (xi .eq. zero) go to 30 - im1 = i - 1 - do 20 j = 1, im1 - ij = i0 + j - x(j) = x(j) - xi*l(ij) - 20 continue - 30 continue - 999 return -c *** last card of litvmu follows *** - end - subroutine livmul(n, x, l, y) -c -c *** solve l*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - external dotprd - double precision dotprd - integer i, j, k - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 k = 1, n - if (y(k) .ne. zero) go to 20 - x(k) = zero - 10 continue - go to 999 - 20 j = k*(k+1)/2 - x(k) = y(k) / l(j) - if (k .ge. n) go to 999 - k = k + 1 - do 30 i = k, n - t = dotprd(i-1, l(j+1), x) - j = j + i - x(i) = (y(i) - t)/l(j) - 30 continue - 999 return -c *** last card of livmul follows *** - end - subroutine parck(alg, d, iv, liv, lv, n, v) -c -c *** check ***sol (version 2.3) parameters, print changed values *** -c -c *** alg = 1 for regression, alg = 2 for general unconstrained opt. -c - integer alg, liv, lv, n - integer iv(liv) - double precision d(n), v(lv) -c - external rmdcon, vcopy, vdflt - double precision rmdcon -c rmdcon -- returns machine-dependent constants. -c vcopy -- copies one vector to another. -c vdflt -- supplies default parameter values to v alone. -c/+ - integer max0 -c/ -c -c *** local variables *** -c - integer i, ii, iv1, j, k, l, m, miv1, miv2, ndfalt, parsv1, pu - integer ijmp, jlim(2), miniv(2), ndflt(2) -c/6 -c integer varnm(2), sh(2) -c real cngd(3), dflt(3), vn(2,34), which(3) -c/7 - character*1 varnm(2), sh(2) - character*4 cngd(3), dflt(3), vn(2,34), which(3) -c/ - double precision big, machep, tiny, vk, vm(34), vx(34), zero -c -c *** iv and v subscripts *** -c - integer algsav, dinit, dtype, dtype0, epslon, inits, ivneed, - 1 lastiv, lastv, lmat, nextiv, nextv, nvdflt, oldn, - 2 parprt, parsav, perm, prunit, vneed -c -c -c/6 -c data algsav/51/, dinit/38/, dtype/16/, dtype0/54/, epslon/19/, -c 1 inits/25/, ivneed/3/, lastiv/44/, lastv/45/, lmat/42/, -c 2 nextiv/46/, nextv/47/, nvdflt/50/, oldn/38/, parprt/20/, -c 3 parsav/49/, perm/58/, prunit/21/, vneed/4/ -c/7 - parameter (algsav=51, dinit=38, dtype=16, dtype0=54, epslon=19, - 1 inits=25, ivneed=3, lastiv=44, lastv=45, lmat=42, - 2 nextiv=46, nextv=47, nvdflt=50, oldn=38, parprt=20, - 3 parsav=49, perm=58, prunit=21, vneed=4) - save big, machep, tiny -c/ -c - data big/0.d+0/, machep/-1.d+0/, tiny/1.d+0/, zero/0.d+0/ -c/6 -c data vn(1,1),vn(2,1)/4hepsl,4hon../ -c data vn(1,2),vn(2,2)/4hphmn,4hfc../ -c data vn(1,3),vn(2,3)/4hphmx,4hfc../ -c data vn(1,4),vn(2,4)/4hdecf,4hac../ -c data vn(1,5),vn(2,5)/4hincf,4hac../ -c data vn(1,6),vn(2,6)/4hrdfc,4hmn../ -c data vn(1,7),vn(2,7)/4hrdfc,4hmx../ -c data vn(1,8),vn(2,8)/4htune,4hr1../ -c data vn(1,9),vn(2,9)/4htune,4hr2../ -c data vn(1,10),vn(2,10)/4htune,4hr3../ -c data vn(1,11),vn(2,11)/4htune,4hr4../ -c data vn(1,12),vn(2,12)/4htune,4hr5../ -c data vn(1,13),vn(2,13)/4hafct,4hol../ -c data vn(1,14),vn(2,14)/4hrfct,4hol../ -c data vn(1,15),vn(2,15)/4hxcto,4hl.../ -c data vn(1,16),vn(2,16)/4hxfto,4hl.../ -c data vn(1,17),vn(2,17)/4hlmax,4h0.../ -c data vn(1,18),vn(2,18)/4hlmax,4hs.../ -c data vn(1,19),vn(2,19)/4hscto,4hl.../ -c data vn(1,20),vn(2,20)/4hdini,4ht.../ -c data vn(1,21),vn(2,21)/4hdtin,4hit../ -c data vn(1,22),vn(2,22)/4hd0in,4hit../ -c data vn(1,23),vn(2,23)/4hdfac,4h..../ -c data vn(1,24),vn(2,24)/4hdltf,4hdc../ -c data vn(1,25),vn(2,25)/4hdltf,4hdj../ -c data vn(1,26),vn(2,26)/4hdelt,4ha0../ -c data vn(1,27),vn(2,27)/4hfuzz,4h..../ -c data vn(1,28),vn(2,28)/4hrlim,4hit../ -c data vn(1,29),vn(2,29)/4hcosm,4hin../ -c data vn(1,30),vn(2,30)/4hhube,4hrc../ -c data vn(1,31),vn(2,31)/4hrspt,4hol../ -c data vn(1,32),vn(2,32)/4hsigm,4hin../ -c data vn(1,33),vn(2,33)/4heta0,4h..../ -c data vn(1,34),vn(2,34)/4hbias,4h..../ -c/7 - data vn(1,1),vn(2,1)/'epsl','on..'/ - data vn(1,2),vn(2,2)/'phmn','fc..'/ - data vn(1,3),vn(2,3)/'phmx','fc..'/ - data vn(1,4),vn(2,4)/'decf','ac..'/ - data vn(1,5),vn(2,5)/'incf','ac..'/ - data vn(1,6),vn(2,6)/'rdfc','mn..'/ - data vn(1,7),vn(2,7)/'rdfc','mx..'/ - data vn(1,8),vn(2,8)/'tune','r1..'/ - data vn(1,9),vn(2,9)/'tune','r2..'/ - data vn(1,10),vn(2,10)/'tune','r3..'/ - data vn(1,11),vn(2,11)/'tune','r4..'/ - data vn(1,12),vn(2,12)/'tune','r5..'/ - data vn(1,13),vn(2,13)/'afct','ol..'/ - data vn(1,14),vn(2,14)/'rfct','ol..'/ - data vn(1,15),vn(2,15)/'xcto','l...'/ - data vn(1,16),vn(2,16)/'xfto','l...'/ - data vn(1,17),vn(2,17)/'lmax','0...'/ - data vn(1,18),vn(2,18)/'lmax','s...'/ - data vn(1,19),vn(2,19)/'scto','l...'/ - data vn(1,20),vn(2,20)/'dini','t...'/ - data vn(1,21),vn(2,21)/'dtin','it..'/ - data vn(1,22),vn(2,22)/'d0in','it..'/ - data vn(1,23),vn(2,23)/'dfac','....'/ - data vn(1,24),vn(2,24)/'dltf','dc..'/ - data vn(1,25),vn(2,25)/'dltf','dj..'/ - data vn(1,26),vn(2,26)/'delt','a0..'/ - data vn(1,27),vn(2,27)/'fuzz','....'/ - data vn(1,28),vn(2,28)/'rlim','it..'/ - data vn(1,29),vn(2,29)/'cosm','in..'/ - data vn(1,30),vn(2,30)/'hube','rc..'/ - data vn(1,31),vn(2,31)/'rspt','ol..'/ - data vn(1,32),vn(2,32)/'sigm','in..'/ - data vn(1,33),vn(2,33)/'eta0','....'/ - data vn(1,34),vn(2,34)/'bias','....'/ -c/ -c - data vm(1)/1.0d-3/, vm(2)/-0.99d+0/, vm(3)/1.0d-3/, vm(4)/1.0d-2/, - 1 vm(5)/1.2d+0/, vm(6)/1.d-2/, vm(7)/1.2d+0/, vm(8)/0.d+0/, - 2 vm(9)/0.d+0/, vm(10)/1.d-3/, vm(11)/-1.d+0/, vm(13)/0.d+0/, - 3 vm(15)/0.d+0/, vm(16)/0.d+0/, vm(19)/0.d+0/, vm(20)/-10.d+0/, - 4 vm(21)/0.d+0/, vm(22)/0.d+0/, vm(23)/0.d+0/, vm(27)/1.01d+0/, - 5 vm(28)/1.d+10/, vm(30)/0.d+0/, vm(31)/0.d+0/, vm(32)/0.d+0/, - 6 vm(34)/0.d+0/ - data vx(1)/0.9d+0/, vx(2)/-1.d-3/, vx(3)/1.d+1/, vx(4)/0.8d+0/, - 1 vx(5)/1.d+2/, vx(6)/0.8d+0/, vx(7)/1.d+2/, vx(8)/0.5d+0/, - 2 vx(9)/0.5d+0/, vx(10)/1.d+0/, vx(11)/1.d+0/, vx(14)/0.1d+0/, - 3 vx(15)/1.d+0/, vx(16)/1.d+0/, vx(19)/1.d+0/, vx(23)/1.d+0/, - 4 vx(24)/1.d+0/, vx(25)/1.d+0/, vx(26)/1.d+0/, vx(27)/1.d+10/, - 5 vx(29)/1.d+0/, vx(31)/1.d+0/, vx(32)/1.d+0/, vx(33)/1.d+0/, - 6 vx(34)/1.d+0/ -c -c/6 -c data varnm(1)/1hp/, varnm(2)/1hn/, sh(1)/1hs/, sh(2)/1hh/ -c data cngd(1),cngd(2),cngd(3)/4h---c,4hhang,4hed v/, -c 1 dflt(1),dflt(2),dflt(3)/4hnond,4hefau,4hlt v/ -c/7 - data varnm(1)/'p'/, varnm(2)/'n'/, sh(1)/'s'/, sh(2)/'h'/ - data cngd(1),cngd(2),cngd(3)/'---c','hang','ed v'/, - 1 dflt(1),dflt(2),dflt(3)/'nond','efau','lt v'/ -c/ - data ijmp/33/, jlim(1)/0/, jlim(2)/24/, ndflt(1)/32/, ndflt(2)/25/ - data miniv(1)/80/, miniv(2)/59/ -c -c............................... body ................................ -c - pu = 0 - if (prunit .le. liv) pu = iv(prunit) - if (alg .lt. 1 .or. alg .gt. 2) go to 340 - if (iv(1) .eq. 0) call deflt(alg, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .ne. 13 .and. iv1 .ne. 12) go to 10 - miv1 = miniv(alg) - if (perm .le. liv) miv1 = max0(miv1, iv(perm) - 1) - if (ivneed .le. liv) miv2 = miv1 + max0(iv(ivneed), 0) - if (lastiv .le. liv) iv(lastiv) = miv2 - if (liv .lt. miv1) go to 300 - iv(ivneed) = 0 - iv(lastv) = max0(iv(vneed), 0) + iv(lmat) - 1 - iv(vneed) = 0 - if (liv .lt. miv2) go to 300 - if (lv .lt. iv(lastv)) go to 320 - 10 if (alg .eq. iv(algsav)) go to 30 - if (pu .ne. 0) write(pu,20) alg, iv(algsav) - 20 format(/39h the first parameter to deflt should be,i3, - 1 12h rather than,i3) - iv(1) = 82 - go to 999 - 30 if (iv1 .lt. 12 .or. iv1 .gt. 14) go to 60 - if (n .ge. 1) go to 50 - iv(1) = 81 - if (pu .eq. 0) go to 999 - write(pu,40) varnm(alg), n - 40 format(/8h /// bad,a1,2h =,i5) - go to 999 - 50 if (iv1 .ne. 14) iv(nextiv) = iv(perm) - if (iv1 .ne. 14) iv(nextv) = iv(lmat) - if (iv1 .eq. 13) go to 999 - k = iv(parsav) - epslon - call vdflt(alg, lv-k, v(k+1)) - iv(dtype0) = 2 - alg - iv(oldn) = n - which(1) = dflt(1) - which(2) = dflt(2) - which(3) = dflt(3) - go to 110 - 60 if (n .eq. iv(oldn)) go to 80 - iv(1) = 17 - if (pu .eq. 0) go to 999 - write(pu,70) varnm(alg), iv(oldn), n - 70 format(/5h /// ,1a1,14h changed from ,i5,4h to ,i5) - go to 999 -c - 80 if (iv1 .le. 11 .and. iv1 .ge. 1) go to 100 - iv(1) = 80 - if (pu .ne. 0) write(pu,90) iv1 - 90 format(/13h /// iv(1) =,i5,28h should be between 0 and 14.) - go to 999 -c - 100 which(1) = cngd(1) - which(2) = cngd(2) - which(3) = cngd(3) -c - 110 if (iv1 .eq. 14) iv1 = 12 - if (big .gt. tiny) go to 120 - tiny = rmdcon(1) - machep = rmdcon(3) - big = rmdcon(6) - vm(12) = machep - vx(12) = big - vx(13) = big - vm(14) = machep - vm(17) = tiny - vx(17) = big - vm(18) = tiny - vx(18) = big - vx(20) = big - vx(21) = big - vx(22) = big - vm(24) = machep - vm(25) = machep - vm(26) = machep - vx(28) = rmdcon(5) - vm(29) = machep - vx(30) = big - vm(33) = machep - 120 m = 0 - i = 1 - j = jlim(alg) - k = epslon - ndfalt = ndflt(alg) - do 150 l = 1, ndfalt - vk = v(k) - if (vk .ge. vm(i) .and. vk .le. vx(i)) go to 140 - m = k - if (pu .ne. 0) write(pu,130) vn(1,i), vn(2,i), k, vk, - 1 vm(i), vx(i) - 130 format(/6h /// ,2a4,5h.. v(,i2,3h) =,d11.3,7h should, - 1 11h be between,d11.3,4h and,d11.3) - 140 k = k + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 150 continue -c - if (iv(nvdflt) .eq. ndfalt) go to 170 - iv(1) = 51 - if (pu .eq. 0) go to 999 - write(pu,160) iv(nvdflt), ndfalt - 160 format(/13h iv(nvdflt) =,i5,13h rather than ,i5) - go to 999 - 170 if ((iv(dtype) .gt. 0 .or. v(dinit) .gt. zero) .and. iv1 .eq. 12) - 1 go to 200 - do 190 i = 1, n - if (d(i) .gt. zero) go to 190 - m = 18 - if (pu .ne. 0) write(pu,180) i, d(i) - 180 format(/8h /// d(,i3,3h) =,d11.3,19h should be positive) - 190 continue - 200 if (m .eq. 0) go to 210 - iv(1) = m - go to 999 -c - 210 if (pu .eq. 0 .or. iv(parprt) .eq. 0) go to 999 - if (iv1 .ne. 12 .or. iv(inits) .eq. alg-1) go to 230 - m = 1 - write(pu,220) sh(alg), iv(inits) - 220 format(/22h nondefault values..../5h init,a1,14h..... iv(25) =, - 1 i3) - 230 if (iv(dtype) .eq. iv(dtype0)) go to 250 - if (m .eq. 0) write(pu,260) which - m = 1 - write(pu,240) iv(dtype) - 240 format(20h dtype..... iv(16) =,i3) - 250 i = 1 - j = jlim(alg) - k = epslon - l = iv(parsav) - ndfalt = ndflt(alg) - do 290 ii = 1, ndfalt - if (v(k) .eq. v(l)) go to 280 - if (m .eq. 0) write(pu,260) which - 260 format(/1h ,3a4,9halues..../) - m = 1 - write(pu,270) vn(1,i), vn(2,i), k, v(k) - 270 format(1x,2a4,5h.. v(,i2,3h) =,d15.7) - 280 k = k + 1 - l = l + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 290 continue -c - iv(dtype0) = iv(dtype) - parsv1 = iv(parsav) - call vcopy(iv(nvdflt), v(parsv1), v(epslon)) - go to 999 -c - 300 iv(1) = 15 - if (pu .eq. 0) go to 999 - write(pu,310) liv, miv2 - 310 format(/10h /// liv =,i5,17h must be at least,i5) - if (liv .lt. miv1) go to 999 - if (lv .lt. iv(lastv)) go to 320 - go to 999 -c - 320 iv(1) = 16 - if (pu .eq. 0) go to 999 - write(pu,330) lv, iv(lastv) - 330 format(/9h /// lv =,i5,17h must be at least,i5) - go to 999 -c - 340 iv(1) = 67 - if (pu .eq. 0) go to 999 - write(pu,350) alg - 350 format(/10h /// alg =,i5,15h must be 1 or 2) -c - 999 return -c *** last card of parck follows *** - end - double precision function reldst(p, d, x, x0) -c -c *** compute and return relative difference between x and x0 *** -c *** nl2sol version 2.2 *** -c - integer p - double precision d(p), x(p), x0(p) -c/+ - double precision dabs -c/ - integer i - double precision emax, t, xmax, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - emax = zero - xmax = zero - do 10 i = 1, p - t = dabs(d(i) * (x(i) - x0(i))) - if (emax .lt. t) emax = t - t = d(i) * (dabs(x(i)) + dabs(x0(i))) - if (xmax .lt. t) xmax = t - 10 continue - reldst = zero - if (xmax .gt. zero) reldst = emax / xmax - 999 return -c *** last card of reldst follows *** - end -c logical function stopx(idummy) -c *****parameters... -c integer idummy -c -c .................................................................. -c -c *****purpose... -c this function may serve as the stopx (asynchronous interruption) -c function for the nl2sol (nonlinear least-squares) package at -c those installations which do not wish to implement a -c dynamic stopx. -c -c *****algorithm notes... -c at installations where the nl2sol system is used -c interactively, this dummy stopx should be replaced by a -c function that returns .true. if and only if the interrupt -c (break) key has been pressed since the last call on stopx. -c -c .................................................................. -c -c stopx = .false. -c return -c end - subroutine vaxpy(p, w, a, x, y) -c -c *** set w = a*x + y -- w, x, y = p-vectors, a = scalar *** -c - integer p - double precision a, w(p), x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 w(i) = a*x(i) + y(i) - return - end - subroutine vcopy(p, y, x) -c -c *** set y = x, where x and y are p-vectors *** -c - integer p - double precision x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = x(i) - return - end - subroutine vdflt(alg, lv, v) -c -c *** supply ***sol (version 2.3) default values to v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer alg, l - double precision v(lv) -c/+ - double precision dmax1 -c/ - external rmdcon - double precision rmdcon -c rmdcon... returns machine-dependent constants -c - double precision machep, mepcrt, one, sqteps, three -c -c *** subscripts for v *** -c - integer afctol, bias, cosmin, decfac, delta0, dfac, dinit, dltfdc, - 1 dltfdj, dtinit, d0init, epslon, eta0, fuzz, huberc, - 2 incfac, lmax0, lmaxs, phmnfc, phmxfc, rdfcmn, rdfcmx, - 3 rfctol, rlimit, rsptol, sctol, sigmin, tuner1, tuner2, - 4 tuner3, tuner4, tuner5, xctol, xftol -c -c/6 -c data one/1.d+0/, three/3.d+0/ -c/7 - parameter (one=1.d+0, three=3.d+0) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/, bias/43/, cosmin/47/, decfac/22/, delta0/44/, -c 1 dfac/41/, dinit/38/, dltfdc/42/, dltfdj/43/, dtinit/39/, -c 2 d0init/40/, epslon/19/, eta0/42/, fuzz/45/, huberc/48/, -c 3 incfac/23/, lmax0/35/, lmaxs/36/, phmnfc/20/, phmxfc/21/, -c 4 rdfcmn/24/, rdfcmx/25/, rfctol/32/, rlimit/46/, rsptol/49/, -c 5 sctol/37/, sigmin/50/, tuner1/26/, tuner2/27/, tuner3/28/, -c 6 tuner4/29/, tuner5/30/, xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, bias=43, cosmin=47, decfac=22, delta0=44, - 1 dfac=41, dinit=38, dltfdc=42, dltfdj=43, dtinit=39, - 2 d0init=40, epslon=19, eta0=42, fuzz=45, huberc=48, - 3 incfac=23, lmax0=35, lmaxs=36, phmnfc=20, phmxfc=21, - 4 rdfcmn=24, rdfcmx=25, rfctol=32, rlimit=46, rsptol=49, - 5 sctol=37, sigmin=50, tuner1=26, tuner2=27, tuner3=28, - 6 tuner4=29, tuner5=30, xctol=33, xftol=34) -c/ -c -c------------------------------- body -------------------------------- -c - machep = rmdcon(3) - v(afctol) = 1.d-20 - if (machep .gt. 1.d-10) v(afctol) = machep**2 - v(decfac) = 0.5d+0 - sqteps = rmdcon(4) - v(dfac) = 0.6d+0 - v(delta0) = sqteps - v(dtinit) = 1.d-6 - mepcrt = machep ** (one/three) - v(d0init) = 1.d+0 - v(epslon) = 0.1d+0 - v(incfac) = 2.d+0 - v(lmax0) = 1.d+0 - v(lmaxs) = 1.d+0 - v(phmnfc) = -0.1d+0 - v(phmxfc) = 0.1d+0 - v(rdfcmn) = 0.1d+0 - v(rdfcmx) = 4.d+0 - v(rfctol) = dmax1(1.d-10, mepcrt**2) - v(sctol) = v(rfctol) - v(tuner1) = 0.1d+0 - v(tuner2) = 1.d-4 - v(tuner3) = 0.75d+0 - v(tuner4) = 0.5d+0 - v(tuner5) = 0.75d+0 - v(xctol) = sqteps - v(xftol) = 1.d+2 * machep -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - v(cosmin) = dmax1(1.d-6, 1.d+2 * machep) - v(dinit) = 0.d+0 - v(dltfdc) = mepcrt - v(dltfdj) = sqteps - v(fuzz) = 1.5d+0 - v(huberc) = 0.7d+0 - v(rlimit) = rmdcon(5) - v(rsptol) = 1.d-3 - v(sigmin) = 1.d-4 - go to 999 -c -c *** general optimization values -c - 10 v(bias) = 0.8d+0 - v(dinit) = -1.0d+0 - v(eta0) = 1.0d+3 * machep -c - 999 return -c *** last card of vdflt follows *** - end - subroutine vscopy(p, y, s) -c -c *** set p-vector y to scalar s *** -c - integer p - double precision s, y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = s - return - end - double precision function v2norm(p, x) -c -c *** return the 2-norm of the p-vector x, taking *** -c *** care to avoid the most likely underflows. *** -c - integer p - double precision x(p) -c - integer i, j - double precision one, r, scale, sqteta, t, xi, zero -c/+ - double precision dabs, dsqrt -c/ - external rmdcon - double precision rmdcon -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - save sqteta -c/ - data sqteta/0.d+0/ -c - if (p .gt. 0) go to 10 - v2norm = zero - go to 999 - 10 do 20 i = 1, p - if (x(i) .ne. zero) go to 30 - 20 continue - v2norm = zero - go to 999 -c - 30 scale = dabs(x(i)) - if (i .lt. p) go to 40 - v2norm = scale - go to 999 - 40 t = one - if (sqteta .eq. zero) sqteta = rmdcon(2) -c -c *** sqteta is (slightly larger than) the square root of the -c *** smallest positive floating point number on the machine. -c *** the tests involving sqteta are done to prevent underflows. -c - j = i + 1 - do 60 i = j, p - xi = dabs(x(i)) - if (xi .gt. scale) go to 50 - r = xi / scale - if (r .gt. sqteta) t = t + r*r - go to 60 - 50 r = scale / xi - if (r .le. sqteta) r = zero - t = one + t * r*r - scale = xi - 60 continue -c - v2norm = scale * dsqrt(t) - 999 return -c *** last card of v2norm follows *** - end - subroutine humsl(n, d, x, calcf, calcgh, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** (analytic) gradient and hessian provided by the caller. *** -c - integer liv, lv, n - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(78 + n*(n+12)), uiparm(*), urparm(*) - external calcf, calcgh, ufparm -c -c------------------------------ discussion --------------------------- -c -c this routine is like sumsl, except that the subroutine para- -c meter calcg of sumsl (which computes the gradient of the objec- -c tive function) is replaced by the subroutine parameter calcgh, -c which computes both the gradient and (lower triangle of the) -c hessian of the objective function. the calling sequence is... -c call calcgh(n, x, nf, g, h, uiparm, urparm, ufparm) -c parameters n, x, nf, g, uiparm, urparm, and ufparm are the same -c as for sumsl, while h is an array of length n*(n+1)/2 in which -c calcgh must store the lower triangle of the hessian at x. start- -c ing at h(1), calcgh must store the hessian entries in the order -c (1,1), (2,1), (2,2), (3,1), (3,2), (3,3), ... -c the value printed (by itsum) in the column labelled stppar -c is the levenberg-marquardt used in computing the current step. -c zero means a full newton step. if the special case described in -c ref. 1 is detected, then stppar is negated. the value printed -c in the column labelled npreldf is zero if the current hessian -c is not positive definite. -c it sometimes proves worthwhile to let d be determined from the -c diagonal of the hessian matrix by setting iv(dtype) = 1 and -c v(dinit) = 0. the following iv and v components are relevant... -c -c iv(dtol)..... iv(59) gives the starting subscript in v of the dtol -c array used when d is updated. (iv(dtol) can be -c initialized by calling humsl with iv(1) = 13.) -c iv(dtype).... iv(16) tells how the scale vector d should be chosen. -c iv(dtype) .le. 0 means that d should not be updated, and -c iv(dtype) .ge. 1 means that d should be updated as -c described below with v(dfac). default = 0. -c v(dfac)..... v(41) and the dtol and d0 arrays (see v(dtinit) and -c v(d0init)) are used in updating the scale vector d when -c iv(dtype) .gt. 0. (d is initialized according to -c v(dinit), described in sumsl.) let -c d1(i) = max(sqrt(abs(h(i,i))), v(dfac)*d(i)), -c where h(i,i) is the i-th diagonal element of the current -c hessian. if iv(dtype) = 1, then d(i) is set to d1(i) -c unless d1(i) .lt. dtol(i), in which case d(i) is set to -c max(d0(i), dtol(i)). -c if iv(dtype) .ge. 2, then d is updated during the first -c iteration as for iv(dtype) = 1 (after any initialization -c due to v(dinit)) and is left unchanged thereafter. -c default = 0.6. -c v(dtinit)... v(39), if positive, is the value to which all components -c of the dtol array (see v(dfac)) are initialized. if -c v(dtinit) = 0, then it is assumed that the caller has -c stored dtol in v starting at v(iv(dtol)). -c default = 10**-6. -c v(d0init)... v(40), if positive, is the value to which all components -c of the d0 vector (see v(dfac)) are initialized. if -c v(dfac) = 0, then it is assumed that the caller has -c stored d0 in v starting at v(iv(dtol)+n). default = 1.0. -c -c *** reference *** -c -c 1. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. comput. 2, pp. 186-197. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c---------------------------- declarations --------------------------- -c - external deflt, humit -c -c deflt... provides default input values for iv and v. -c humit... reverse-communication routine that does humsl algorithm. -c - integer g1, h1, iv1, lh, nf - double precision f -c -c *** subscripts for iv *** -c - integer g, h, nextv, nfcall, nfgcal, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, h/56/, toobig/2/, -c 1 vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, h=56, toobig=2, - 1 vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - lh = n * (n + 1) / 2 - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+3)/2 - iv1 = iv(1) - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - h1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) - h1 = iv(h) -c - 20 call humit(d, f, v(g1), v(h1), iv, lh, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcgh(n, x, iv(nfgcal), v(g1), v(h1), uiparm, urparm, - 1 ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(h) = iv(g) + n - iv(nextv) = iv(h) + n*(n+1)/2 - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of humsl follows *** - end - subroutine humit(d, fx, g, h, iv, lh, liv, lv, n, v, x) -c -c *** carry out humsl (unconstrained minimization) iterations, using -c *** hessian matrix provided by the caller. -c -c *** parameter declarations *** -c - integer lh, liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), h(lh), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c h.... lower triangle of the hessian, stored rowwise. -c iv... integer value array. -c lh... length of h = p*(p+1)/2. -c liv.. length of iv (at least 60). -c lv... length of v (at least 78 + n*(n+21)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... parameter vector. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to humsl (which see), except that v can be shorter (since -c the part of v that humsl uses for storing g and h is not needed). -c moreover, compared with humsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from humsl, is not referenced by humit or the -c subroutines it calls. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call humit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c computed (e.g. if overflow would occur), which may happen -c because of an oversized step. in this case the caller -c should set iv(toobig) = iv(2) to 1, which will cause -c humit to ignore fx and try a smaller step. the para- -c meter nf that humsl passes to calcf (for possible use by -c calcgh) is a copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient of f at -c x, and h to the lower triangle of h(x), the hessian of f -c at x, and call humit again, having changed none of the -c other parameters except perhaps the scale vector d. -c the parameter nf that humsl passes to calcg is -c iv(nfgcal) = iv(7). if g(x) and h(x) cannot be evaluated, -c then the caller may set iv(nfgcal) to 0, in which case -c humit will return with iv(1) = 65. -c note -- humit overwrites h with the lower triangle -c of diag(d)**-1 * h(x) * diag(d)**-1. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl and humsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, i, j, k, l, lstgst, nn1o2, step1, - 1 temp1, w1, x01 - double precision t -c -c *** constants *** -c - double precision one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, deflt, dotprd, dupdu, gqtst, itsum, parck, - 1 reldst, slvmul, stopx, vaxpy, vcopy, vscopy, v2norm - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c deflt.... provides default iv and v input values. -c dotprd... returns inner product of two vectors. -c dupdu.... updates scale vector d. -c gqtst.... computes optimally locally constrained step. -c itsum.... prints iteration summary and info on initial and final x. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c slvmul... multiplies symmetric matrix times vector, given the lower -c triangle of the matrix. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c v2norm... returns the 2-norm of a vector. -c -c *** subscripts for iv and v *** -c - integer cnvcod, dg, dgnorm, dinit, dstnrm, dtinit, dtol, - 1 dtype, d0init, f, f0, fdif, gtstep, incfac, irc, kagqt, - 2 lmat, lmax0, lmaxs, mode, model, mxfcal, mxiter, nextv, - 3 nfcall, nfgcal, ngcall, niter, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, stppar, - 5 toobig, tuner4, tuner5, vneed, w, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, dtol/59/, dtype/16/, irc/29/, kagqt/33/, -c 1 lmat/42/, mode/35/, model/5/, mxfcal/17/, mxiter/18/, -c 2 nextv/47/, nfcall/6/, nfgcal/7/, ngcall/30/, niter/31/, -c 3 radinc/8/, restor/9/, step/40/, stglim/11/, stlstg/41/, -c 4 toobig/2/, vneed/4/, w/34/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, dtol=59, dtype=16, irc=29, kagqt=33, - 1 lmat=42, mode=35, model=5, mxfcal=17, mxiter=18, - 2 nextv=47, nfcall=6, nfgcal=7, ngcall=30, niter=31, - 3 radinc=8, restor=9, step=40, stglim=11, stlstg=41, - 4 toobig=2, vneed=4, w=34, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data dgnorm/1/, dinit/38/, dstnrm/2/, dtinit/39/, d0init/40/, -c 1 f/10/, f0/13/, fdif/11/, gtstep/4/, incfac/23/, lmax0/35/, -c 2 lmaxs/36/, preduc/7/, radfac/16/, radius/8/, rad0/9/, -c 3 reldx/17/, stppar/5/, tuner4/29/, tuner5/30/ -c/7 - parameter (dgnorm=1, dinit=38, dstnrm=2, dtinit=39, d0init=40, - 1 f=10, f0=13, fdif=11, gtstep=4, incfac=23, lmax0=35, - 2 lmaxs=36, preduc=7, radfac=16, radius=8, rad0=9, - 3 reldx=17, stppar=5, tuner4=29, tuner5=30) -c/ -c -c/6 -c data one/1.d+0/, onep2/1.2d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, onep2=1.2d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - i = iv(1) - if (i .eq. 1) go to 30 - if (i .eq. 2) go to 40 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+21)/2 + 7 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - nn1o2 = n * (n + 1) / 2 - if (lh .ge. nn1o2) go to (210,210,210,210,210,210,160,120,160, - 1 10,10,20), i - iv(1) = 66 - go to 350 -c -c *** storage allocation *** -c - 10 iv(dtol) = iv(lmat) + nn1o2 - iv(x0) = iv(dtol) + 2*n - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(dg) = iv(stlstg) + n - iv(w) = iv(dg) + n - iv(nextv) = iv(w) + 4*n + 7 - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - v(stppar) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - k = iv(dtol) - if (v(dtinit) .gt. zero) call vscopy(n, v(k), v(dtinit)) - k = k + n - if (v(d0init) .gt. zero) call vscopy(n, v(k), v(d0init)) - iv(1) = 1 - go to 999 -c - 30 v(f) = fx - if (iv(mode) .ge. 0) go to 210 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 350 -c -c *** make sure gradient could be computed *** -c - 40 if (iv(nfgcal) .ne. 0) go to 50 - iv(1) = 65 - go to 350 -c -c *** update the scale vector d *** -c - 50 dg1 = iv(dg) - if (iv(dtype) .le. 0) go to 70 - k = dg1 - j = 0 - do 60 i = 1, n - j = j + i - v(k) = h(j) - k = k + 1 - 60 continue - call dupdu(d, v(dg1), iv, liv, lv, n, v) -c -c *** compute scaled gradient and its norm *** -c - 70 dg1 = iv(dg) - k = dg1 - do 80 i = 1, n - v(k) = g(i) / d(i) - k = k + 1 - 80 continue - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** compute scaled hessian *** -c - k = 1 - do 100 i = 1, n - t = one / d(i) - do 90 j = 1, i - h(k) = t * h(k) / d(j) - k = k + 1 - 90 continue - 100 continue -c - if (iv(cnvcod) .ne. 0) go to 340 - if (iv(mode) .eq. 0) go to 300 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 110 call itsum(d, g, iv, liv, lv, n, v, x) - 120 k = iv(niter) - if (k .lt. iv(mxiter)) go to 130 - iv(1) = 10 - go to 350 -c - 130 iv(niter) = k + 1 -c -c *** initialize for start of next iteration *** -c - dg1 = iv(dg) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0 *** -c - call vcopy(n, v(x01), x) -c -c *** update radius *** -c - if (k .eq. 0) go to 150 - step1 = iv(step) - k = step1 - do 140 i = 1, n - v(k) = d(i) * v(k) - k = k + 1 - 140 continue - v(radius) = v(radfac) * v2norm(n, v(step1)) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 150 if (.not. stopx(dummy)) go to 170 - iv(1) = 11 - go to 180 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 160 if (v(f) .ge. v(f0)) go to 170 - v(radfac) = one - k = iv(niter) - go to 130 -c - 170 if (iv(nfcall) .lt. iv(mxfcal)) go to 190 - iv(1) = 9 - 180 if (v(f) .ge. v(f0)) go to 350 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 290 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 190 step1 = iv(step) - dg1 = iv(dg) - l = iv(lmat) - w1 = iv(w) - call gqtst(d, v(dg1), h, iv(kagqt), v(l), n, v(step1), v, v(w1)) - if (iv(irc) .eq. 6) go to 210 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 210 - if (iv(irc) .ne. 5) go to 200 - if (v(radfac) .le. one) go to 200 - if (v(preduc) .le. onep2 * v(fdif)) go to 210 -c -c *** compute f(x0 + step) *** -c - 200 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 210 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 220 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 220 k = iv(irc) - go to (230,260,260,260,230,240,250,250,250,250,250,250,330,300), k -c -c *** recompute step with new radius *** -c - 230 v(radius) = v(radfac) * v(dstnrm) - go to 150 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 240 v(radius) = v(lmaxs) - go to 190 -c -c *** convergence or false convergence *** -c - 250 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 340 - if (iv(xirc) .eq. 14) go to 340 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 260 if (iv(irc) .ne. 3) go to 290 - temp1 = lstgst -c -c *** prepare for gradient tests *** -c *** set temp1 = hessian * step + g(x0) -c *** = diag(d) * (h * step + g(x0)) -c -c use x0 vector as temporary. - k = x01 - do 270 i = 1, n - v(k) = d(i) * v(step1) - k = k + 1 - step1 = step1 + 1 - 270 continue - call slvmul(n, v(temp1), h, v(x01)) - do 280 i = 1, n - v(temp1) = d(i) * v(temp1) + g(i) - temp1 = temp1 + 1 - 280 continue -c -c *** compute gradient and hessian *** -c - 290 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c - 300 iv(1) = 2 - if (iv(irc) .ne. 3) go to 110 -c -c *** set v(radfac) by gradient tests *** -c - temp1 = iv(stlstg) - step1 = iv(step) -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - k = temp1 - do 310 i = 1, n - v(k) = (v(k) - g(i)) / d(i) - k = k + 1 - 310 continue -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) go to 320 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 110 - 320 v(radfac) = v(incfac) - go to 110 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 330 iv(1) = 64 - go to 350 -c -c *** print summary of final iteration and other requested items *** -c - 340 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 350 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last card of humit follows *** - end - subroutine dupdu(d, hdiag, iv, liv, lv, n, v) -c -c *** update scale vector d for humsl *** -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), hdiag(n), v(lv) -c -c *** local variables *** -c - integer dtoli, d0i, i - double precision t, vdfac -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dsqrt -c/ -c *** subscripts for iv and v *** -c - integer dfac, dtol, dtype, niter -c/6 -c data dfac/41/, dtol/59/, dtype/16/, niter/31/ -c/7 - parameter (dfac=41, dtol=59, dtype=16, niter=31) -c/ -c -c------------------------------- body -------------------------------- -c - i = iv(dtype) - if (i .eq. 1) go to 10 - if (iv(niter) .gt. 0) go to 999 -c - 10 dtoli = iv(dtol) - d0i = dtoli + n - vdfac = v(dfac) - do 20 i = 1, n - t = dmax1(dsqrt(dabs(hdiag(i))), vdfac*d(i)) - if (t .lt. v(dtoli)) t = dmax1(v(dtoli), v(d0i)) - d(i) = t - dtoli = dtoli + 1 - d0i = d0i + 1 - 20 continue -c - 999 return -c *** last card of dupdu follows *** - end - subroutine gqtst(d, dig, dihdi, ka, l, p, step, v, w) -c -c *** compute goldfeld-quandt-trotter step by more-hebden technique *** -c *** (nl2sol version 2.2), modified a la more and sorensen *** -c -c *** parameter declarations *** -c - integer ka, p -cal double precision d(p), dig(p), dihdi(1), l(1), v(21), step(p), -cal 1 w(1) - double precision d(p), dig(p), dihdi(p*(p+1)/2), l(p*(p+1)/2), - 1 v(21), step(p),w(4*p+7) -c dimension dihdi(p*(p+1)/2), l(p*(p+1)/2), w(4*p+7) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c given the (compactly stored) lower triangle of a scaled -c hessian (approximation) and a nonzero scaled gradient vector, -c this subroutine computes a goldfeld-quandt-trotter step of -c approximate length v(radius) by the more-hebden technique. in -c other words, step is computed to (approximately) minimize -c psi(step) = (g**t)*step + 0.5*(step**t)*h*step such that the -c 2-norm of d*step is at most (approximately) v(radius), where -c g is the gradient, h is the hessian, and d is a diagonal -c scale matrix whose diagonal is stored in the parameter d. -c (gqtst assumes dig = d**-1 * g and dihdi = d**-1 * h * d**-1.) -c -c *** parameter description *** -c -c d (in) = the scale vector, i.e. the diagonal of the scale -c matrix d mentioned above under purpose. -c dig (in) = the scaled gradient vector, d**-1 * g. if g = 0, then -c step = 0 and v(stppar) = 0 are returned. -c dihdi (in) = lower triangle of the scaled hessian (approximation), -c i.e., d**-1 * h * d**-1, stored compactly by rows., i.e., -c in the order (1,1), (2,1), (2,2), (3,1), (3,2), etc. -c ka (i/o) = the number of hebden iterations (so far) taken to deter- -c mine step. ka .lt. 0 on input means this is the first -c attempt to determine step (for the present dig and dihdi) -c -- ka is initialized to 0 in this case. output with -c ka = 0 (or v(stppar) = 0) means step = -(h**-1)*g. -c l (i/o) = workspace of length p*(p+1)/2 for cholesky factors. -c p (in) = number of parameters -- the hessian is a p x p matrix. -c step (i/o) = the step computed. -c v (i/o) contains various constants and variables described below. -c w (i/o) = workspace of length 4*p + 6. -c -c *** entries in v *** -c -c v(dgnorm) (i/o) = 2-norm of (d**-1)*g. -c v(dstnrm) (output) = 2-norm of d*step. -c v(dst0) (i/o) = 2-norm of d*(h**-1)*g (for pos. def. h only), or -c overestimate of smallest eigenvalue of (d**-1)*h*(d**-1). -c v(epslon) (in) = max. rel. error allowed for psi(step). for the -c step returned, psi(step) will exceed its optimal value -c by less than -v(epslon)*psi(step). suggested value = 0.1. -c v(gtstep) (out) = inner product between g and step. -c v(nreduc) (out) = psi(-(h**-1)*g) = psi(newton step) (for pos. def. -c h only -- v(nreduc) is set to zero otherwise). -c v(phmnfc) (in) = tol. (together with v(phmxfc)) for accepting step -c (more*s sigma). the error v(dstnrm) - v(radius) must lie -c between v(phmnfc)*v(radius) and v(phmxfc)*v(radius). -c v(phmxfc) (in) (see v(phmnfc).) -c suggested values -- v(phmnfc) = -0.25, v(phmxfc) = 0.5. -c v(preduc) (out) = psi(step) = predicted obj. func. reduction for step. -c v(radius) (in) = radius of current (scaled) trust region. -c v(rad0) (i/o) = value of v(radius) from previous call. -c v(stppar) (i/o) is normally the marquardt parameter, i.e. the alpha -c described below under algorithm notes. if h + alpha*d**2 -c (see algorithm notes) is (nearly) singular, however, -c then v(stppar) = -alpha. -c -c *** usage notes *** -c -c if it is desired to recompute step using a different value of -c v(radius), then this routine may be restarted by calling it -c with all parameters unchanged except v(radius). (this explains -c why step and w are listed as i/o). on an initial call (one with -c ka .lt. 0), step and w need not be initialized and only compo- -c nents v(epslon), v(stppar), v(phmnfc), v(phmxfc), v(radius), and -c v(rad0) of v must be initialized. -c -c *** algorithm notes *** -c -c the desired g-q-t step (ref. 2, 3, 4, 6) satisfies -c (h + alpha*d**2)*step = -g for some nonnegative alpha such that -c h + alpha*d**2 is positive semidefinite. alpha and step are -c computed by a scheme analogous to the one described in ref. 5. -c estimates of the smallest and largest eigenvalues of the hessian -c are obtained from the gerschgorin circle theorem enhanced by a -c simple form of the scaling described in ref. 7. cases in which -c h + alpha*d**2 is nearly (or exactly) singular are handled by -c the technique discussed in ref. 2. in these cases, a step of -c (exact) length v(radius) is returned for which psi(step) exceeds -c its optimal value by less than -v(epslon)*psi(step). the test -c suggested in ref. 6 for detecting the special case is performed -c once two matrix factorizations have been done -- doing so sooner -c seems to degrade the performance of optimization routines that -c call this routine. -c -c *** functions and subroutines called *** -c -c dotprd - returns inner product of two vectors. -c litvmu - applies inverse-transpose of compact lower triang. matrix. -c livmul - applies inverse of compact lower triang. matrix. -c lsqrt - finds cholesky factor (of compactly stored lower triang.). -c lsvmin - returns approx. to min. sing. value of lower triang. matrix. -c rmdcon - returns machine-dependent constants. -c v2norm - returns 2-norm of a vector. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), an adaptive -c nonlinear least-squares algorithm, acm trans. math. -c software, vol. 7, no. 3. -c 2. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. computing, vol. 2, no. 2, pp. -c 186-197. -c 3. goldfeld, s.m., quandt, r.e., and trotter, h.f. (1966), -c maximization by quadratic hill-climbing, econometrica 34, -c pp. 541-551. -c 4. hebden, m.d. (1973), an algorithm for minimization using exact -c second derivatives, report t.p. 515, theoretical physics -c div., a.e.r.e. harwell, oxon., england. -c 5. more, j.j. (1978), the levenberg-marquardt algorithm, implemen- -c tation and theory, pp.105-116 of springer lecture notes -c in mathematics no. 630, edited by g.a. watson, springer- -c verlag, berlin and new york. -c 6. more, j.j., and sorensen, d.c. (1981), computing a trust region -c step, technical report anl-81-83, argonne national lab. -c 7. varga, r.s. (1965), minimal gerschgorin sets, pacific j. math. 15, -c pp. 719-729. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - logical restrt - integer dggdmx, diag, diag0, dstsav, emax, emin, i, im1, inc, irc, - 1 j, k, kalim, kamin, k1, lk0, phipin, q, q0, uk0, x - double precision alphak, aki, akk, delta, dst, eps, gtsta, lk, - 1 oldphi, phi, phimax, phimin, psifac, rad, radsq, - 2 root, si, sk, sw, t, twopsi, t1, t2, uk, wi -c -c *** constants *** - double precision big, dgxfac, epsfac, four, half, kappa, negone, - 1 one, p001, six, three, two, zero -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dmin1, dsqrt -c/ -c *** external functions and subroutines *** -c - external dotprd, litvmu, livmul, lsqrt, lsvmin, rmdcon, v2norm - double precision dotprd, lsvmin, rmdcon, v2norm -c -c *** subscripts for v *** -c - integer dgnorm, dstnrm, dst0, epslon, gtstep, stppar, nreduc, - 1 phmnfc, phmxfc, preduc, radius, rad0 -c/6 -c data dgnorm/1/, dstnrm/2/, dst0/3/, epslon/19/, gtstep/4/, -c 1 nreduc/6/, phmnfc/20/, phmxfc/21/, preduc/7/, radius/8/, -c 2 rad0/9/, stppar/5/ -c/7 - parameter (dgnorm=1, dstnrm=2, dst0=3, epslon=19, gtstep=4, - 1 nreduc=6, phmnfc=20, phmxfc=21, preduc=7, radius=8, - 2 rad0=9, stppar=5) -c/ -c -c/6 -c data epsfac/50.0d+0/, four/4.0d+0/, half/0.5d+0/, -c 1 kappa/2.0d+0/, negone/-1.0d+0/, one/1.0d+0/, p001/1.0d-3/, -c 2 six/6.0d+0/, three/3.0d+0/, two/2.0d+0/, zero/0.0d+0/ -c/7 - parameter (epsfac=50.0d+0, four=4.0d+0, half=0.5d+0, - 1 kappa=2.0d+0, negone=-1.0d+0, one=1.0d+0, p001=1.0d-3, - 2 six=6.0d+0, three=3.0d+0, two=2.0d+0, zero=0.0d+0) - save dgxfac -c/ - data big/0.d+0/, dgxfac/0.d+0/ -c -c *** body *** -c -c *** store largest abs. entry in (d**-1)*h*(d**-1) at w(dggdmx). - dggdmx = p + 1 -c *** store gerschgorin over- and underestimates of the largest -c *** and smallest eigenvalues of (d**-1)*h*(d**-1) at w(emax) -c *** and w(emin) respectively. - emax = dggdmx + 1 - emin = emax + 1 -c *** for use in recomputing step, the final values of lk, uk, dst, -c *** and the inverse derivative of more*s phi at 0 (for pos. def. -c *** h) are stored in w(lk0), w(uk0), w(dstsav), and w(phipin) -c *** respectively. - lk0 = emin + 1 - phipin = lk0 + 1 - uk0 = phipin + 1 - dstsav = uk0 + 1 -c *** store diag of (d**-1)*h*(d**-1) in w(diag),...,w(diag0+p). - diag0 = dstsav - diag = diag0 + 1 -c *** store -d*step in w(q),...,w(q0+p). - q0 = diag0 + p - q = q0 + 1 -c *** allocate storage for scratch vector x *** - x = q + p - rad = v(radius) - radsq = rad**2 -c *** phitol = max. error allowed in dst = v(dstnrm) = 2-norm of -c *** d*step. - phimax = v(phmxfc) * rad - phimin = v(phmnfc) * rad - psifac = two * v(epslon) / (three * (four * (v(phmnfc) + one) * - 1 (kappa + one) + kappa + two) * rad**2) -c *** oldphi is used to detect limits of numerical accuracy. if -c *** we recompute step and it does not change, then we accept it. - oldphi = zero - eps = v(epslon) - irc = 0 - restrt = .false. - kalim = ka + 50 -c -c *** start or restart, depending on ka *** -c - if (ka .ge. 0) go to 290 -c -c *** fresh start *** -c - k = 0 - uk = negone - ka = 0 - kalim = 50 - v(dgnorm) = v2norm(p, dig) - v(nreduc) = zero - v(dst0) = zero - kamin = 3 - if (v(dgnorm) .eq. zero) kamin = 0 -c -c *** store diag(dihdi) in w(diag0+1),...,w(diag0+p) *** -c - j = 0 - do 10 i = 1, p - j = j + i - k1 = diag0 + i - w(k1) = dihdi(j) - 10 continue -c -c *** determine w(dggdmx), the largest element of dihdi *** -c - t1 = zero - j = p * (p + 1) / 2 - do 20 i = 1, j - t = dabs(dihdi(i)) - if (t1 .lt. t) t1 = t - 20 continue - w(dggdmx) = t1 -c -c *** try alpha = 0 *** -c - 30 call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 50 -c *** indef. h -- underestimate smallest eigenvalue, use this -c *** estimate to initialize lower bound lk on alpha. - j = irc*(irc+1)/2 - t = l(j) - l(j) = one - do 40 i = 1, irc - 40 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = -t / t1 / t1 - v(dst0) = -lk - if (restrt) go to 210 - go to 70 -c -c *** positive definite h -- compute unmodified newton step. *** - 50 lk = zero - t = lsvmin(p, l, w(q), w(q)) - if (t .ge. one) go to 60 - if (big .le. zero) big = rmdcon(6) - if (v(dgnorm) .ge. t*t*big) go to 70 - 60 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - v(nreduc) = half * gtsta - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - v(dst0) = dst - phi = dst - rad - if (phi .le. phimax) go to 260 - if (restrt) go to 210 -c -c *** prepare to compute gerschgorin estimates of largest (and -c *** smallest) eigenvalues. *** -c - 70 k = 0 - do 100 i = 1, p - wi = zero - if (i .eq. 1) go to 90 - im1 = i - 1 - do 80 j = 1, im1 - k = k + 1 - t = dabs(dihdi(k)) - wi = wi + t - w(j) = w(j) + t - 80 continue - 90 w(i) = wi - k = k + 1 - 100 continue -c -c *** (under-)estimate smallest eigenvalue of (d**-1)*h*(d**-1) *** -c - k = 1 - t1 = w(diag) - w(1) - if (p .le. 1) go to 120 - do 110 i = 2, p - j = diag0 + i - t = w(j) - w(i) - if (t .ge. t1) go to 110 - t1 = t - k = i - 110 continue -c - 120 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 150 i = 1, p - if (i .eq. k) go to 130 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (akk - w(j) + si - aki) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 140 - 130 inc = i - 140 k1 = k1 + inc - 150 continue -c - w(emin) = akk - t - uk = v(dgnorm)/rad - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 -c -c *** compute gerschgorin (over-)estimate of largest eigenvalue *** -c - k = 1 - t1 = w(diag) + w(1) - if (p .le. 1) go to 170 - do 160 i = 2, p - j = diag0 + i - t = w(j) + w(i) - if (t .le. t1) go to 160 - t1 = t - k = i - 160 continue -c - 170 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 200 i = 1, p - if (i .eq. k) go to 180 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (w(j) + si - aki - akk) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 190 - 180 inc = i - 190 k1 = k1 + inc - 200 continue -c - w(emax) = akk + t - lk = dmax1(lk, v(dgnorm)/rad - w(emax)) -c -c *** alphak = current value of alpha (see alg. notes above). we -c *** use more*s scheme for initializing it. - alphak = dabs(v(stppar)) * v(rad0)/rad -c - if (irc .ne. 0) go to 210 -c -c *** compute l0 for positive definite h *** -c - call livmul(p, w, l, w(q)) - t = v2norm(p, w) - w(phipin) = dst / t / t - lk = dmax1(lk, phi*w(phipin)) -c -c *** safeguard alphak and add alphak*i to (d**-1)*h*(d**-1) *** -c - 210 ka = ka + 1 - if (-v(dst0) .ge. alphak .or. alphak .lt. lk .or. alphak .ge. uk) - 1 alphak = uk * dmax1(p001, dsqrt(lk/uk)) - if (alphak .le. zero) alphak = half * uk - if (alphak .le. zero) alphak = uk - k = 0 - do 220 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) + alphak - 220 continue -c -c *** try computing cholesky decomposition *** -c - call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 240 -c -c *** (d**-1)*h*(d**-1) + alphak*i is indefinite -- overestimate -c *** smallest eigenvalue for use in updating lk *** -c - j = (irc*(irc+1))/2 - t = l(j) - l(j) = one - do 230 i = 1, irc - 230 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = alphak - t/t1/t1 - v(dst0) = -lk - go to 210 -c -c *** alphak makes (d**-1)*h*(d**-1) positive definite. -c *** compute q = -d*step, check for convergence. *** -c - 240 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - phi = dst - rad - if (phi .le. phimax .and. phi .ge. phimin) go to 270 - if (phi .eq. oldphi) go to 270 - oldphi = phi - if (phi .lt. zero) go to 330 -c -c *** unacceptable alphak -- update lk, uk, alphak *** -c - 250 if (ka .ge. kalim) go to 270 -c *** the following dmin1 is necessary because of restarts *** - if (phi .lt. zero) uk = dmin1(uk, alphak) -c *** kamin = 0 only iff the gradient vanishes *** - if (kamin .eq. 0) go to 210 - call livmul(p, w, l, w(q)) - t1 = v2norm(p, w) - alphak = alphak + (phi/t1) * (dst/t1) * (dst/rad) - lk = dmax1(lk, alphak) - go to 210 -c -c *** acceptable step on first try *** -c - 260 alphak = zero -c -c *** successful step in general. compute step = -(d**-1)*q *** -c - 270 do 280 i = 1, p - j = q0 + i - step(i) = -w(j)/d(i) - 280 continue - v(gtstep) = -gtsta - v(preduc) = half * (dabs(alphak)*dst*dst + gtsta) - go to 410 -c -c -c *** restart with new radius *** -c - 290 if (v(dst0) .le. zero .or. v(dst0) - rad .gt. phimax) go to 310 -c -c *** prepare to return newton step *** -c - restrt = .true. - ka = ka + 1 - k = 0 - do 300 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) - 300 continue - uk = negone - go to 30 -c - 310 kamin = ka + 3 - if (v(dgnorm) .eq. zero) kamin = 0 - if (ka .eq. 0) go to 50 -c - dst = w(dstsav) - alphak = dabs(v(stppar)) - phi = dst - rad - t = v(dgnorm)/rad - uk = t - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 - if (rad .gt. v(rad0)) go to 320 -c -c *** smaller radius *** - lk = zero - if (alphak .gt. zero) lk = w(lk0) - lk = dmax1(lk, t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** bigger radius *** - 320 if (alphak .gt. zero) uk = dmin1(uk, w(uk0)) - lk = dmax1(zero, -v(dst0), t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** decide whether to check for special case... in practice (from -c *** the standpoint of the calling optimization code) it seems best -c *** not to check until a few iterations have failed -- hence the -c *** test on kamin below. -c - 330 delta = alphak + dmin1(zero, v(dst0)) - twopsi = alphak*dst*dst + gtsta - if (ka .ge. kamin) go to 340 -c *** if the test in ref. 2 is satisfied, fall through to handle -c *** the special case (as soon as the more-sorensen test detects -c *** it). - if (delta .ge. psifac*twopsi) go to 370 -c -c *** check for the special case of h + alpha*d**2 (nearly) -c *** singular. use one step of inverse power method with start -c *** from lsvmin to obtain approximate eigenvector corresponding -c *** to smallest eigenvalue of (d**-1)*h*(d**-1). lsvmin returns -c *** x and w with l*w = x. -c - 340 t = lsvmin(p, l, w(x), w) -c -c *** normalize w *** - do 350 i = 1, p - 350 w(i) = t*w(i) -c *** complete current inv. power iter. -- replace w by (l**-t)*w. - call litvmu(p, w, l, w) - t2 = one/v2norm(p, w) - do 360 i = 1, p - 360 w(i) = t2*w(i) - t = t2 * t -c -c *** now w is the desired approximate (unit) eigenvector and -c *** t*x = ((d**-1)*h*(d**-1) + alphak*i)*w. -c - sw = dotprd(p, w(q), w) - t1 = (rad + dst) * (rad - dst) - root = dsqrt(sw*sw + t1) - if (sw .lt. zero) root = -root - si = t1 / (sw + root) -c -c *** the actual test for the special case... -c - if ((t2*si)**2 .le. eps*(dst**2 + alphak*radsq)) go to 380 -c -c *** update upper bound on smallest eigenvalue (when not positive) -c *** (as recommended by more and sorensen) and continue... -c - if (v(dst0) .le. zero) v(dst0) = dmin1(v(dst0), t2**2 - alphak) - lk = dmax1(lk, -v(dst0)) -c -c *** check whether we can hope to detect the special case in -c *** the available arithmetic. accept step as it is if not. -c -c *** if not yet available, obtain machine dependent value dgxfac. - 370 if (dgxfac .eq. zero) dgxfac = epsfac * rmdcon(3) -c - if (delta .gt. dgxfac*w(dggdmx)) go to 250 - go to 270 -c -c *** special case detected... negate alphak to indicate special case -c - 380 alphak = -alphak - v(preduc) = half * twopsi -c -c *** accept current step if adding si*w would lead to a -c *** further relative reduction in psi of less than v(epslon)/3. -c - t1 = zero - t = si*(alphak*sw - half*si*(alphak + t*dotprd(p,w(x),w))) - if (t .lt. eps*twopsi/six) go to 390 - v(preduc) = v(preduc) + t - dst = rad - t1 = -si - 390 do 400 i = 1, p - j = q0 + i - w(j) = t1*w(i) - w(j) - step(i) = w(j) / d(i) - 400 continue - v(gtstep) = dotprd(p, dig, w(q)) -c -c *** save values for use in a possible restart *** -c - 410 v(dstnrm) = dst - v(stppar) = alphak - w(lk0) = lk - w(uk0) = uk - v(rad0) = rad - w(dstsav) = dst -c -c *** restore diagonal of dihdi *** -c - j = 0 - do 420 i = 1, p - j = j + i - k = diag0 + i - dihdi(j) = w(k) - 420 continue -c - 999 return -c -c *** last card of gqtst follows *** - end - subroutine lsqrt(n1, n, l, a, irc) -c -c *** compute rows n1 through n of the cholesky factor l of -c *** a = l*(l**t), where l and the lower triangle of a are both -c *** stored compactly by rows (and may occupy the same storage). -c *** irc = 0 means all went well. irc = j means the leading -c *** principal j x j submatrix of a is not positive definite -- -c *** and l(j*(j+1)/2) contains the (nonpos.) reduced j-th diagonal. -c -c *** parameters *** -c - integer n1, n, irc -cal double precision l(1), a(1) - double precision l(n*(n+1)/2), a(n*(n+1)/2) -c dimension l(n*(n+1)/2), a(n*(n+1)/2) -c -c *** local variables *** -c - integer i, ij, ik, im1, i0, j, jk, jm1, j0, k - double precision t, td, zero -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c -c *** body *** -c - i0 = n1 * (n1 - 1) / 2 - do 50 i = n1, n - td = zero - if (i .eq. 1) go to 40 - j0 = 0 - im1 = i - 1 - do 30 j = 1, im1 - t = zero - if (j .eq. 1) go to 20 - jm1 = j - 1 - do 10 k = 1, jm1 - ik = i0 + k - jk = j0 + k - t = t + l(ik)*l(jk) - 10 continue - 20 ij = i0 + j - j0 = j0 + j - t = (a(ij) - t) / l(j0) - l(ij) = t - td = td + t*t - 30 continue - 40 i0 = i0 + i - t = a(i0) - td - if (t .le. zero) go to 60 - l(i0) = dsqrt(t) - 50 continue -c - irc = 0 - go to 999 -c - 60 l(i0) = t - irc = i -c - 999 return -c -c *** last card of lsqrt *** - end - double precision function lsvmin(p, l, x, y) -c -c *** estimate smallest sing. value of packed lower triang. matrix l -c -c *** parameter declarations *** -c - integer p -cal double precision l(1), x(p), y(p) - double precision l(p*(p+1)/2), x(p), y(p) -c dimension l(p*(p+1)/2) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c this function returns a good over-estimate of the smallest -c singular value of the packed lower triangular matrix l. -c -c *** parameter description *** -c -c p (in) = the order of l. l is a p x p lower triangular matrix. -c l (in) = array holding the elements of l in row order, i.e. -c l(1,1), l(2,1), l(2,2), l(3,1), l(3,2), l(3,3), etc. -c x (out) if lsvmin returns a positive value, then x is a normalized -c approximate left singular vector corresponding to the -c smallest singular value. this approximation may be very -c crude. if lsvmin returns zero, then some components of x -c are zero and the rest retain their input values. -c y (out) if lsvmin returns a positive value, then y = (l**-1)*x is an -c unnormalized approximate right singular vector correspond- -c ing to the smallest singular value. this approximation -c may be crude. if lsvmin returns zero, then y retains its -c input value. the caller may pass the same vector for x -c and y (nonstandard fortran usage), in which case y over- -c writes x (for nonzero lsvmin returns). -c -c *** algorithm notes *** -c -c the algorithm is based on (1), with the additional provision that -c lsvmin = 0 is returned if the smallest diagonal element of l -c (in magnitude) is not more than the unit roundoff times the -c largest. the algorithm uses a random number generator proposed -c in (4), which passes the spectral test with flying colors -- see -c (2) and (3). -c -c *** subroutines and functions called *** -c -c v2norm - function, returns the 2-norm of a vector. -c -c *** references *** -c -c (1) cline, a., moler, c., stewart, g., and wilkinson, j.h.(1977), -c an estimate for the condition number of a matrix, report -c tm-310, applied math. div., argonne national laboratory. -c -c (2) hoaglin, d.c. (1976), theoretical properties of congruential -c random-number generators -- an empirical view, -c memorandum ns-340, dept. of statistics, harvard univ. -c -c (3) knuth, d.e. (1969), the art of computer programming, vol. 2 -c (seminumerical algorithms), addison-wesley, reading, mass. -c -c (4) smith, c.s. (1971), multiplicative pseudo-random number -c generators with prime modulus, j. assoc. comput. mach. 18, -c pp. 586-593. -c -c *** history *** -c -c designed and coded by david m. gay (winter 1977/summer 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, and mcs76-11989. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer i, ii, ix, j, ji, jj, jjj, jm1, j0, pm1 - double precision b, sminus, splus, t, xminus, xplus -c -c *** constants *** -c - double precision half, one, r9973, zero -c -c *** intrinsic functions *** -c/+ - integer mod - real float - double precision dabs -c/ -c *** external functions and subroutines *** -c - external dotprd, v2norm, vaxpy - double precision dotprd, v2norm -c -c/6 -c data half/0.5d+0/, one/1.d+0/, r9973/9973.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, r9973=9973.d+0, zero=0.d+0) -c/ -c -c *** body *** -c - ix = 2 - pm1 = p - 1 -c -c *** first check whether to return lsvmin = 0 and initialize x *** -c - ii = 0 - j0 = p*pm1/2 - jj = j0 + p - if (l(jj) .eq. zero) go to 110 - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = b / l(jj) - x(p) = xplus - if (p .le. 1) go to 60 - do 10 i = 1, pm1 - ii = ii + i - if (l(ii) .eq. zero) go to 110 - ji = j0 + i - x(i) = xplus * l(ji) - 10 continue -c -c *** solve (l**t)*x = b, where the components of b have randomly -c *** chosen magnitudes in (.5,1) with signs chosen to make x large. -c -c do j = p-1 to 1 by -1... - do 50 jjj = 1, pm1 - j = p - jjj -c *** determine x(j) in this iteration. note for i = 1,2,...,j -c *** that x(i) holds the current partial sum for row i. - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = (b - x(j)) - xminus = (-b - x(j)) - splus = dabs(xplus) - sminus = dabs(xminus) - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - xplus = xplus/l(jj) - xminus = xminus/l(jj) - if (jm1 .eq. 0) go to 30 - do 20 i = 1, jm1 - ji = j0 + i - splus = splus + dabs(x(i) + l(ji)*xplus) - sminus = sminus + dabs(x(i) + l(ji)*xminus) - 20 continue - 30 if (sminus .gt. splus) xplus = xminus - x(j) = xplus -c *** update partial sums *** - if (jm1 .gt. 0) call vaxpy(jm1, x, xplus, l(j0+1), x) - 50 continue -c -c *** normalize x *** -c - 60 t = one/v2norm(p, x) - do 70 i = 1, p - 70 x(i) = t*x(i) -c -c *** solve l*y = x and return lsvmin = 1/twonorm(y) *** -c - do 100 j = 1, p - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - t = zero - if (jm1 .gt. 0) t = dotprd(jm1, l(j0+1), y) - y(j) = (x(j) - t) / l(jj) - 100 continue -c - lsvmin = one/v2norm(p, y) - go to 999 -c - 110 lsvmin = zero - 999 return -c *** last card of lsvmin follows *** - end - subroutine slvmul(p, y, s, x) -c -c *** set y = s * x, s = p x p symmetric matrix. *** -c *** lower triangle of s stored rowwise. *** -c -c *** parameter declarations *** -c - integer p -cal double precision s(1), x(p), y(p) - double precision s(p*(p+1)/2), x(p), y(p) -c dimension s(p*(p+1)/2) -c -c *** local variables *** -c - integer i, im1, j, k - double precision xi -c -c *** no intrinsic functions *** -c -c *** external function *** -c - external dotprd - double precision dotprd -c -c----------------------------------------------------------------------- -c - j = 1 - do 10 i = 1, p - y(i) = dotprd(i, s(j), x) - j = j + i - 10 continue -c - if (p .le. 1) go to 999 - j = 1 - do 40 i = 2, p - xi = x(i) - im1 = i - 1 - j = j + 1 - do 30 k = 1, im1 - y(k) = y(k) + s(j)*xi - j = j + 1 - 30 continue - 40 continue -c - 999 return -c *** last card of slvmul follows *** - end diff --git a/source/unres/src_CSA_DiL/csa.f b/source/unres/src_CSA_DiL/csa.f deleted file mode 100644 index a5149f2..0000000 --- a/source/unres/src_CSA_DiL/csa.f +++ /dev/null @@ -1,366 +0,0 @@ - subroutine make_array - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.CSA' - -ccccccccccccccccccccccccc -c Level-2: group -ccccccccccccccccccccccccc - - indg=0 - do k=1,numch -ccccccccccccccccccccccccccccccccccccccccc -! Groups the THETAs and the GAMMAs - do j=2,nres-1 - indg=indg+1 - if (j.lt.nres-1) then - ngroup(indg)=2 - else - ngroup(indg)=1 - endif - do i=1,ngroup(indg) - igroup(1,i,indg)=i - igroup(2,i,indg)=j - igroup(3,i,indg)=k - enddo - enddo -ccccccccccccccccccccccccccccccccccccccccc - enddo -! Groups the ALPHAs and the BETAs - do k=1,numch - do j=2,nres-1 - if(itype(j).ne.10) then - indg=indg+1 - ngroup(indg)=2 - do i=1,ngroup(indg) - igroup(1,i,indg)=i+2 - igroup(2,i,indg)=j - igroup(3,i,indg)=k - enddo - endif - enddo - enddo - - ntotgr=indg - write(iout,*) - write(iout,*) "# of groups: ",ntotgr - do i=1,ntotgr - write(iout,41) i,ngroup(i),((igroup(k,j,i),k=1,3),j=1,ngroup(i)) - enddo -! close(iout) - - 40 format(i3,3x,3i3) - 41 format(2i3,3x,6(3i3,2x)) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_ranvar(n,m,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' -c al m=0 - print *,'HOHOHOHO Make_RanVar!!!!!',n,m - itrial=0 - do while(m.lt.n .and. itrial.le.10000) - itrial=itrial+1 - jeden=1 - call gen_rand_conf(jeden,*10) - call intout - m=m+1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - goto 20 - 10 write (iout,*) 'Failed to generate conformation #',m+1, - & ' itrial=',itrial - 20 continue - enddo - print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_ranvar_reg(n,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' - include 'COMMON.GEO' - m=0 - print *,'HOHOHOHO Make_RanVar_reg!!!!!' - itrial=0 - do while(m.lt.n .and. itrial.le.10000) - itrial=itrial+1 - jeden=1 - call gen_rand_conf(jeden,*10) -! call intout - m=m+1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - if(m.le.n*0.1) then - dihang_in(1,j,1,m)=90.0*deg2rad - dihang_in(2,j,1,m)=50.0*deg2rad - endif - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - goto 20 - 10 write (iout,*) 'Failed to generate conformation #',m+1, - & ' itrial=',itrial - 20 continue - enddo - print *,'Make_RanVar!!!!! m=',m,' itrial=',itrial - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine from_pdb(n,idum) -c This subroutine stores the UNRES int variables generated from -c subroutine readpdb into the 1st conformation of in dihang_in. -c Subsequent n-1 conformations of dihang_in have identical values -c of theta and phi as the 1st conformation but random values for -c alph and omeg. -c The array cref (also generated from subroutine readpdb) is stored -c to crefjlee to be used for rmsd calculation in CSA, if necessary. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.BANK' - include 'COMMON.GEO' - - m=1 - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,k)=0.0d0 - - do m=2,n - do k=2,nres-1 - dihang_in(1,k,1,m)=dihang_in(1,k,1,1) - dihang_in(2,k,1,m)=dihang_in(2,k,1,1) - if(dabs(dihang_in(3,k,1,1)).gt.1.d-6) then - dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0 - dihang_in(3,k,1,m)=dihang_in(3,k,1,m)*deg2rad - endif - if(dabs(dihang_in(4,k,1,1)).gt.1.d-6) then - dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0 - dihang_in(4,k,1,m)=dihang_in(4,k,1,m)*deg2rad - endif - enddo - enddo - -c Store cref to crefjlee (they are in COMMON.CHAIN). - do k=1,2*nres - do kk=1,3 - crefjlee(kk,k)=cref(kk,k) - enddo - enddo - - open(icsa_native_int,file=csa_native_int,status="old") - do m=1,n - write(icsa_native_int,*) m,e - write(icsa_native_int,200) - & (dihang_in(1,k,1,m)*rad2deg,k=2,nres-1) - write(icsa_native_int,200) - & (dihang_in(2,k,1,m)*rad2deg,k=2,nres-2) - write(icsa_native_int,200) - & (dihang_in(3,k,1,m)*rad2deg,k=2,nres-1) - write(icsa_native_int,200) - & (dihang_in(4,k,1,m)*rad2deg,k=2,nres-1) - enddo - - do k=1,nres - write(icsa_native_int,200) (crefjlee(i,k),i=1,3) - enddo - close(icsa_native_int) - - 200 format (8f10.4) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine from_int(n,mm,idum) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.BANK' - include 'COMMON.GEO' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - integer ilen - external ilen - logical fail - double precision energia(0:n_ene) - - open(icsa_native_int,file=csa_native_int,status="old") - read (icsa_native_int,*) - call read_angles(icsa_native_int,*10) - goto 11 - 10 write (iout,'(2a)') "CHUJ NASTAPIL - error in ", - & csa_native_int(:ilen(csa_native_int)) - 11 continue - call intout - do j=2,nres-1 - dihang_in(1,j,1,1)=theta(j+1) - dihang_in(2,j,1,1)=phi(j+2) - dihang_in(3,j,1,1)=alph(j) - dihang_in(4,j,1,1)=omeg(j) - enddo - dihang_in(2,nres-1,1,1)=0.0d0 - -c read(icsa_native_int,*) ind,e -c read(icsa_native_int,200) (dihang_in(1,k,1,1),k=2,nres-1) -c read(icsa_native_int,200) (dihang_in(2,k,1,1),k=2,nres-2) -c read(icsa_native_int,200) (dihang_in(3,k,1,1),k=2,nres-1) -c read(icsa_native_int,200) (dihang_in(4,k,1,1),k=2,nres-1) -c dihang_in(2,nres-1,1,1)=0.d0 - - maxsi=100 - maxcount_fail=100 - - do m=mm+2,n -c do k=2,nres-1 -c dihang_in(1,k,1,m)=dihang_in(1,k,1,1) -c dihang_in(2,k,1,m)=dihang_in(2,k,1,1) -c if(abs(dihang_in(3,k,1,1)).gt.1.d-3) then -c dihang_in(3,k,1,m)=90.d0*ran1(idum)+90.d0 -c endif -c if(abs(dihang_in(4,k,1,1)).gt.1.d-3) then -c dihang_in(4,k,1,m)=360.d0*ran1(idum)-180.d0 -c endif -c enddo -c call intout - fail=.true. - - icount_fail=0 - - DO WHILE (FAIL .AND. ICOUNT_FAIL .LE. MAXCOUNT_FAIL) - - do i=nnt,nct - if (itype(i).ne.10) then -cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1) - fail=.true. - ii=0 - do while (fail .and. ii .le. maxsi) - call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail) - ii = ii+1 - enddo - endif - enddo - call chainbuild - call etotal(energia(0)) - fail = (energia(0).ge.1.0d20) - icount_fail=icount_fail+1 - - ENDDO - - if (icount_fail.gt.maxcount_fail) then - write (iout,*) - & 'Failed to generate non-overlaping near-native conf.', - & m - endif - - do j=2,nres-1 - dihang_in(1,j,1,m)=theta(j+1) - dihang_in(2,j,1,m)=phi(j+2) - dihang_in(3,j,1,m)=alph(j) - dihang_in(4,j,1,m)=omeg(j) - enddo - dihang_in(2,nres-1,1,m)=0.0d0 - enddo - -c do m=1,n -c write(icsa_native_int,*) m,e -c write(icsa_native_int,200) (dihang_in(1,k,1,m),k=2,nres-1) -c write(icsa_native_int,200) (dihang_in(2,k,1,m),k=2,nres-2) -c write(icsa_native_int,200) (dihang_in(3,k,1,m),k=2,nres-1) -c write(icsa_native_int,200) (dihang_in(4,k,1,m),k=2,nres-1) -c enddo -c close(icsa_native_int) - -c do m=mm+2,n -c do i=1,4 -c do j=2,nres-1 -c dihang_in(i,j,1,m)=dihang_in(i,j,1,m)*deg2rad -c enddo -c enddo -c enddo - - call dihang_to_c(dihang_in(1,1,1,1)) - -c Store c to cref (they are in COMMON.CHAIN). - do k=1,2*nres - do kk=1,3 - crefjlee(kk,k)=c(kk,k) - enddo - enddo - - call contact(.true.,ncont_ref,icont_ref,co) - -c do k=1,nres -c write(icsa_native_int,200) (crefjlee(i,k),i=1,3) -c enddo - close(icsa_native_int) - - 200 format (8f10.4) - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine dihang_to_c(aarray) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - - dimension aarray(mxang,maxres,mxch) - -c do i=4,nres -c phi(i)=dihang_in(1,i-2,1,1) -c enddo - do i=2,nres-1 - theta(i+1)=aarray(1,i,1) - phi(i+2)=aarray(2,i,1) - alph(i)=aarray(3,i,1) - omeg(i)=aarray(4,i,1) - enddo - - call chainbuild - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc diff --git a/source/unres/src_CSA_DiL/dfa.F b/source/unres/src_CSA_DiL/dfa.F deleted file mode 100644 index 576910c..0000000 --- a/source/unres/src_CSA_DiL/dfa.F +++ /dev/null @@ -1,3455 +0,0 @@ - subroutine init_dfa_vars - - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.DFA' - - integer ii - -C Number of restraints - idisnum = 0 - iphinum = 0 - ithenum = 0 - ineinum = 0 - - idislis = 0 - iphilis = 0 - ithelis = 0 - ineilis = 0 - jneilis = 0 - jneinum = 0 - kshell = 0 - fnei = 0 -C For beta - nca = 0 - icaidx = 0 - -C real variables -CC WEIGHTS for each min - sccdist = 0.0d0 - fdist = 0.0d0 - sccphi = 0.0d0 - sccthe = 0.0d0 - sccnei = 0.0d0 - fphi1 = 0.0d0 - fphi2 = 0.0d0 - fthe1 = 0.0d0 - fthe2 = 0.0d0 -C energies - edfatot = 0.0d0 - edfadis = 0.0d0 - edfaphi = 0.0d0 - edfathe = 0.0d0 - edfanei = 0.0d0 - edfabet = 0.0d0 -C weights for each E term -C these should be identical with - dis_inc = 0.0d0 - phi_inc = 0.0d0 - the_inc = 0.0d0 - nei_inc = 0.0d0 - beta_inc = 0.0d0 - wshet = 0.0d0 -C precalculate exp table! -c dfaexp = 0.0d0 -c do ii = 1, 15001 -c dfaexp(ii) = exp(-ii*0.001d0 + 0.0005d0) -c end do - - ishiftca=nnt-1 - ilastca=nct - - print *,'ishiftca=',ishiftca,'ilastca=',ilastca - - return - end - - - subroutine read_dfa_info -C -C read fragment informations -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DFA' - - -C NOTE THAT FILENAMES are FIXED, CURRENTLY!! -C THIS SHOULD BE MODIFIED!! - - character*320 buffer - integer iodfa - parameter(iodfa=89) - - integer i, j, nval - integer ica1, ica2,ica3,ica4,ica5 - integer ishell, inca, itmp,iitmp - double precision wtmp -C -C READ DISTANCE -C - open(iodfa, file = 'dist_dfa.dat', status = 'old', err=33) - goto 34 - 33 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - 34 continue - write(iout,'(a)') 'dist_dfa.dat is opened!' -C read title - read(iodfa, '(a)') buffer -C read number of restraints - read(iodfa, *) IDFADIS - read(iodfa, *) dis_inc - do i=1, idfadis - read(iodfa, '(i10,1x,i10,1x,i10)') ica1, ica2, nval - - idisnum(i)=nval - idislis(1,i)=ica1 - idislis(2,i)=ica2 - - do j=1, nval - read(iodfa,*) tmp - fdist(i,j) = tmp - enddo - - do j=1, nval - read(iodfa,*) tmp - sccdist(i,j) = tmp - enddo - - enddo - close(iodfa) - -C READ ANGLE RESTRAINTS -C PHI RESTRAINTS - open(iodfa, file='phi_dfa.dat',status='old',err=35) - goto 36 - 35 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - - 36 continue - write(iout,'(a)') 'phi_dfa.dat is opened!' - -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) IDFAPHI - read(iodfa,*) phi_inc - do i=1, idfaphi - read(iodfa,'(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval - - iphinum(i)=nval - - iphilis(1,i)=ica1 - iphilis(2,i)=ica2 - iphilis(3,i)=ica3 - iphilis(4,i)=ica4 - iphilis(5,i)=ica5 - - do j=1, nval - read(iodfa,*) tmp1,tmp2 - fphi1(i,j) = tmp1 - fphi2(i,j) = tmp2 - enddo - - do j=1, nval - read(iodfa,*) tmp - sccphi(i,j) = tmp - enddo - - enddo - close(iodfa) - -C THETA RESTRAINTS - open(iodfa, file='theta_dfa.dat',status='old',err=41) - goto 42 - 41 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - 42 continue - write(iout,'(a)') 'theta_dfa.dat is opened!' -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) IDFATHE - read(iodfa,*) the_inc - - do i=1, idfathe - read(iodfa, '(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval - - ithenum(i)=nval - - ithelis(1,i)=ica1 - ithelis(2,i)=ica2 - ithelis(3,i)=ica3 - ithelis(4,i)=ica4 - ithelis(5,i)=ica5 - - do j=1, nval - read(iodfa,*) tmp1,tmp2 - fthe1(i,j) = tmp1 - fthe2(i,j) = tmp2 - enddo - - do j=1, nval - read(iodfa,*) tmp - sccthe(i,j) = tmp - enddo - - enddo - close(iodfa) -C END of READING ANGLE RESTRAINT! - -C NUMBER OF NEIGHBOR CAs - open(iodfa,file='nei_dfa.dat',status='old',err=37) - goto 38 - 37 write(iout,'(a)') 'Error opening nei_dfa.dat file' - stop - 38 continue - write(iout,'(a)') 'nei_dfa.dat is opened!' -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) idfanei - read(iodfa,*) nei_inc - - do i=1, idfanei - read(iodfa,'(2(i10,1x),i10)')ica1,ishell,nval - - ineilis(i)=ica1 - kshell(i)=ishell - ineinum(i)=nval - - do j=1, nval - read(iodfa,*) inca - fnei(i,j) = inca -C write(*,*) 'READ NEI:',i,j,fnei(i,j) - enddo - - do j=1, nval - read(iodfa,*) tmp - sccnei(i,j) = tmp - enddo - - enddo - close(iodfa) -C END OF NEIGHBORING CA - -C READ BETA RESTRAINT - open(iodfa, file='beta_dfa.dat',status='old',err=39) - goto 40 - 39 write(iout,'(a)') 'Error opening beta_dfa.dat file' - stop - 40 continue - write(iout,'(a)') 'beta_dfa.dat is opened!' - - read(iodfa,'(a)') buffer - read(iodfa,*) itmp - read(iodfa,*) beta_inc - - do i=1,itmp - read(iodfa,*) ica1, iitmp - do j=1,itmp - read(iodfa,*) wtmp - wshet(i,j) = wtmp -c write(*,*) 'BETA:',i,j,wtmp,wshet(i,j) - enddo - enddo - - close(iodfa) -C END OF BETA RESTRAINT - - return - END - - subroutine edfad(edfadis) - - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - double precision edfadis - integer i, iatm1, iatm2,idiff - double precision ckk, sckk,dist,texp - double precision jix,jiy,jiz,ep,fp,scc - - edfadis=0 - gdfad=0.0d0 - - do i=1, idfadis - - iatm1=idislis(1,i)+ishiftca - iatm2=idislis(2,i)+ishiftca - idiff = abs(iatm1-iatm2) - - JIX=c(1,iatm2)-c(1,iatm1) - JIY=c(2,iatm2)-c(2,iatm1) - JIZ=c(3,iatm2)-c(3,iatm1) - DIST=SQRT(JIX*JIX+JIY*JIY+JIZ*JIZ) - - ckk=ck(idiff) - sckk=sck(idiff) - - scc = 0.0d0 - ep = 0.0d0 - fp = 0.0d0 - - do j=1,idisnum(i) - - dd = dist-fdist(i,j) - dtmp = dd*dd/ckk - if (dtmp.ge.15.0d0) then - texp = 0.0d0 - else -c texp = dfaexp( idint(dtmp*1000)+1 )/sckk - texp = exp(-dtmp)/sckk - endif - - ep=ep+sccdist(i,j)*texp - fp=fp+sccdist(i,j)*texp*dd*2.0d0/ckk - scc=scc+sccdist(i,j) -C write(*,'(2i8,6f12.5)') i, j, dist, -C & fdist(i,j), ep, fp, sccdist(i,j), scc - - enddo - - ep = -ep/scc - fp = fp/scc - - -c IF(ABS(EP).lt.1.0d-20)THEN -c EP=0.0D0 -c ENDIF -c IF (ABS(FP).lt.1.0d-20) THEN -c FP=0.0D0 -c ENDIF - - edfadis=edfadis+ep*dis_inc*wwdist - - gdfad(1,iatm1) = gdfad(1,iatm1)-jix/dist*fp*dis_inc*wwdist - gdfad(2,iatm1) = gdfad(2,iatm1)-jiy/dist*fp*dis_inc*wwdist - gdfad(3,iatm1) = gdfad(3,iatm1)-jiz/dist*fp*dis_inc*wwdist - - gdfad(1,iatm2) = gdfad(1,iatm2)+jix/dist*fp*dis_inc*wwdist - gdfad(2,iatm2) = gdfad(2,iatm2)+jiy/dist*fp*dis_inc*wwdist - gdfad(3,iatm2) = gdfad(3,iatm2)+jiz/dist*fp*dis_inc*wwdist - - enddo - - return - end - - subroutine edfat(edfator) -C DFA torsion angle - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - integer i,j,ii,iii - integer iatom(5) - double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) - double precision cwidth, cwidth2 - PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) - - edfator= 0.0d0 - enephi = 0.0d0 - enethe = 0.0d0 - gdfat(:,:) = 0.0d0 - -C START OF PHI ANGLE - do i=1, idfaphi - - aphi = 0.0d0 - do iii=1,5 - iatom(iii)=iphilis(iii,i)+ishiftca - enddo - -C ANGLE VECTOR CALCULTION - RIX=C(1,IATOM(2))-C(1,IATOM(1)) - RIY=C(2,IATOM(2))-C(2,IATOM(1)) - RIZ=C(3,IATOM(2))-C(3,IATOM(1)) - - RIPX=C(1,IATOM(3))-C(1,IATOM(2)) - RIPY=C(2,IATOM(3))-C(2,IATOM(2)) - RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) - - RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) - RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) - RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) - - RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) - RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) - RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) - - GIX=RIY*RIPZ-RIZ*RIPY - GIY=RIZ*RIPX-RIX*RIPZ - GIZ=RIX*RIPY-RIY*RIPX - - GIPX=RIPY*RIPPZ-RIPZ*RIPPY - GIPY=RIPZ*RIPPX-RIPX*RIPPZ - GIPZ=RIPX*RIPPY-RIPY*RIPPX - - CIPX=C(1,IATOM(3))-C(1,IATOM(1)) - CIPY=C(2,IATOM(3))-C(2,IATOM(1)) - CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) - - CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) - CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) - CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) - - CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) - CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) - CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) - - DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) - DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) - DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) - DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) - -C END OF ANGLE VECTOR CALCULTION - - TDOT=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ - APHI(1)=TDOT/(DGI*DRIPP) - TDOT=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z - APHI(2)=TDOT/(DGIP*DRIP3) - - ephi = 0.0d0 - tfphi1=0.0d0 - tfphi2=0.0d0 - scc=0.0d0 - - do j=1, iphinum(i) - DDPS1=APHI(1)-FPHI1(i,j) - DDPS2=APHI(2)-FPHI2(i,j) - - DTMP = (DDPS1**2+DDPS2**2)/CWIDTH2 - - if (dtmp.ge.15.0d0) then - ps_tmp = 0.0d0 - else -c ps_tmp = dfaexp(idint(dtmp*1000)+1) - ps_tmp = exp(-dtmp) - endif - - ephi=ephi+sccphi(i,j)*ps_tmp - - tfphi1=tfphi1+sccphi(i,j)*ddps1/cwidth*ps_tmp - tfphi2=tfphi2+sccphi(i,j)*ddps2/cwidth*ps_tmp - - scc=scc+sccphi(i,j) -C write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), -C & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) - ENDDO - - ephi=-ephi/scc*phi_inc*wwangle - tfphi1=tfphi1/scc*phi_inc*wwangle - tfphi2=tfphi2/scc*phi_inc*wwangle - - IF (ABS(EPHI).LT.1d-20) THEN - EPHI=0.0D0 - ENDIF - IF (ABS(TFPHI1).LT.1d-20) THEN - TFPHI1=0.0D0 - ENDIF - IF (ABS(TFPHI2).LT.1d-20) THEN - TFPHI2=0.0D0 - ENDIF - -C FORCE DIRECTION CALCULATION - TDX(1:5)=0.0D0 - TDY(1:5)=0.0D0 - TDZ(1:5)=0.0D0 - - DM1=1.0d0/(DGI*DRIPP) - - GIRPP=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ - DM2=GIRPP/(DGI**3*DRIPP) - DM3=GIRPP/(DGI*DRIPP**3) - - DM4=1.0d0/(DGIP*DRIP3) - - GIRP3=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z - DM5=GIRP3/(DGIP**3*DRIP3) - DM6=GIRP3/(DGIP*DRIP3**3) -C FIRST ATOM BY PHI1 - TDX(1)=(RIPZ*RIPPY-RIPY*RIPPZ)*DM1 - & +( GIZ* RIPY- GIY* RIPZ)*DM2 - TDY(1)=(RIPX*RIPPZ-RIPZ*RIPPX)*DM1 - & +( GIX* RIPZ- GIZ* RIPX)*DM2 - TDZ(1)=(RIPY*RIPPX-RIPX*RIPPY)*DM1 - & +( GIY* RIPX- GIX* RIPY)*DM2 - TDX(1)=TDX(1)*TFPHI1 - TDY(1)=TDY(1)*TFPHI1 - TDZ(1)=TDZ(1)*TFPHI1 -C SECOND ATOM BY PHI1 - TDX(2)=(CIPY*RIPPZ-CIPZ*RIPPY)*DM1 - & -(CIPY*GIZ-CIPZ*GIY)*DM2 - TDY(2)=(CIPZ*RIPPX-CIPX*RIPPZ)*DM1 - & -(CIPZ*GIX-CIPX*GIZ)*DM2 - TDZ(2)=(CIPX*RIPPY-CIPY*RIPPX)*DM1 - & -(CIPX*GIY-CIPY*GIX)*DM2 - TDX(2)=TDX(2)*TFPHI1 - TDY(2)=TDY(2)*TFPHI1 - TDZ(2)=TDZ(2)*TFPHI1 -C SECOND ATOM BY PHI2 - TDX(2)=TDX(2)+ - & ((RIPPZ*RIP3Y-RIPPY*RIP3Z)*DM4 - & +( GIPZ*RIPPY- GIPY*RIPPZ)*DM5)*TFPHI2 - TDY(2)=TDY(2)+ - & ((RIPPX*RIP3Z-RIPPZ*RIP3X)*DM4 - & +( GIPX*RIPPZ- GIPZ*RIPPX)*DM5)*TFPHI2 - TDZ(2)=TDZ(2)+ - & ((RIPPY*RIP3X-RIPPX*RIP3Y)*DM4 - & +( GIPY*RIPPX- GIPX*RIPPY)*DM5)*TFPHI2 -C THIRD ATOM BY PHI1 - TDX(3)=(-GIX+RIPPY*RIZ-RIPPZ*RIY)*DM1 - & -(GIY*RIZ-RIY*GIZ)*DM2+RIPPX*DM3 - TDY(3)=(-GIY+RIPPZ*RIX-RIPPX*RIZ)*DM1 - & -(GIZ*RIX-RIZ*GIX)*DM2+RIPPY*DM3 - TDZ(3)=(-GIZ+RIPPX*RIY-RIPPY*RIX)*DM1 - & -(GIX*RIY-RIX*GIY)*DM2+RIPPZ*DM3 - TDX(3)=TDX(3)*TFPHI1 - TDY(3)=TDY(3)*TFPHI1 - TDZ(3)=TDZ(3)*TFPHI1 -C THIRD ATOM BY PHI2 - TDX(3)=TDX(3)+ - & ((CIPPY*RIP3Z-CIPPZ*RIP3Y)*DM4 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5)*TFPHI2 - TDY(3)=TDY(3)+ - & ((CIPPZ*RIP3X-CIPPX*RIP3Z)*DM4 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5)*TFPHI2 - TDZ(3)=TDZ(3)+ - & ((CIPPX*RIP3Y-CIPPY*RIP3X)*DM4 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM5)*TFPHI2 -C FOURTH ATOM BY PHI1 - TDX(4)=(GIX*DM1-RIPPX*DM3)*TFPHI1 - TDY(4)=(GIY*DM1-RIPPY*DM3)*TFPHI1 - TDZ(4)=(GIZ*DM1-RIPPZ*DM3)*TFPHI1 -C FOURTH ATOM BY PHI2 - TDX(4)=TDX(4)+ - & ((-GIPX+RIP3Y*RIPZ-RIP3Z*RIPY)*DM4 - & -( GIPY*RIPZ-RIPY*GIPZ)*DM5 - & + RIP3X*DM6)*TFPHI2 - TDY(4)=TDY(4)+ - & ((-GIPY+RIP3Z*RIPX-RIP3X*RIPZ)*DM4 - & -( GIPZ*RIPX-RIPZ*GIPX)*DM5 - & + RIP3Y*DM6)*TFPHI2 - TDZ(4)=TDZ(4)+ - & ((-GIPZ+RIP3X*RIPY-RIP3Y*RIPX)*DM4 - & -( GIPX*RIPY-RIPX*GIPY)*DM5 - & + RIP3Z*DM6)*TFPHI2 -C FIFTH ATOM BY PHI2 - TDX(5)=(GIPX*DM4-RIP3X*DM6)*TFPHI2 - TDY(5)=(GIPY*DM4-RIP3Y*DM6)*TFPHI2 - TDZ(5)=(GIPZ*DM4-RIP3Z*DM6)*TFPHI2 -C END OF FORCE DIRECTION -c force calcuation - DO II=1,5 - gdfat(1,IATOM(II))=gdfat(1,IATOM(II))+TDX(II) - gdfat(2,IATOM(II))=gdfat(2,IATOM(II))+TDY(II) - gdfat(3,IATOM(II))=gdfat(3,IATOM(II))+TDZ(II) - ENDDO -c energy calculation - enephi = enephi + ephi -c end of single assignment statement - ENDDO -C END OF PHI RESTRAINT - -C START OF THETA ANGLE - do i=1, idfathe - - athe = 0.0d0 - do iii=1,5 - iatom(iii)=ithelis(iii,i)+ishiftca - enddo - - -C ANGLE VECTOR CALCULTION - RIX=C(1,IATOM(2))-C(1,IATOM(1)) - RIY=C(2,IATOM(2))-C(2,IATOM(1)) - RIZ=C(3,IATOM(2))-C(3,IATOM(1)) - - RIPX=C(1,IATOM(3))-C(1,IATOM(2)) - RIPY=C(2,IATOM(3))-C(2,IATOM(2)) - RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) - - RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) - RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) - RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) - - RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) - RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) - RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) - - GIX=RIY*RIPZ-RIZ*RIPY - GIY=RIZ*RIPX-RIX*RIPZ - GIZ=RIX*RIPY-RIY*RIPX - - GIPX=RIPY*RIPPZ-RIPZ*RIPPY - GIPY=RIPZ*RIPPX-RIPX*RIPPZ - GIPZ=RIPX*RIPPY-RIPY*RIPPX - - GIPPX=RIPPY*RIP3Z-RIPPZ*RIP3Y - GIPPY=RIPPZ*RIP3X-RIPPX*RIP3Z - GIPPZ=RIPPX*RIP3Y-RIPPY*RIP3X - - CIPX=C(1,IATOM(3))-C(1,IATOM(1)) - CIPY=C(2,IATOM(3))-C(2,IATOM(1)) - CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) - - CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) - CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) - CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) - - CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) - CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) - CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) - - DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) - DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) - DGIPP=SQRT(GIPPX*GIPPX+GIPPY*GIPPY+GIPPZ*GIPPZ) - DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) - DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) -C END OF ANGLE VECTOR CALCULTION - - TDOT=GIX*GIPX+GIY*GIPY+GIZ*GIPZ - ATHE(1)=TDOT/(DGI*DGIP) - TDOT=GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ - ATHE(2)=TDOT/(DGIP*DGIPP) - - ETHE=0.0D0 - TFTHE1=0.0D0 - TFTHE2=0.0D0 - SCC=0.0D0 - TH_TMP=0.0d0 - - do j=1,ithenum(i) - ddth1=athe(1)-fthe1(i,j) !cos(the1)-cos(the1_ref) - ddth2=athe(2)-fthe2(i,j) !cos(the2)-cos(the2_ref) - dtmp= (ddth1**2+ddth2**2)/cwidth2 - if ( dtmp .ge. 15.0d0) then - th_tmp = 0.0d0 - else -c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) - th_tmp = exp(-dtmp) - end if - - ethe=ethe+sccthe(i,j)*th_tmp - - tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) - tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) - scc=scc+sccthe(i,j) -C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), -C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) - enddo - - ethe=-ethe/scc*the_inc*wwangle - tfthe1=tfthe1/scc*the_inc*wwangle - tfthe2=tfthe2/scc*the_inc*wwangle - - IF (ABS(ETHE).LT.TENM20) THEN - ETHE=0.0D0 - ENDIF - IF (ABS(TFTHE1).LT.TENM20) THEN - TFTHE1=0.0D0 - ENDIF - IF (ABS(TFTHE2).LT.TENM20) THEN - TFTHE2=0.0D0 - ENDIF - - TDX(1:5)=0.0D0 - TDY(1:5)=0.0D0 - TDZ(1:5)=0.0D0 - - DM1=1.0d0/(DGI*DGIP) - DM2=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI**3*DGIP) - DM3=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI*DGIP**3) - - DM4=1.0d0/(DGIP*DGIPP) - DM5=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP**3*DGIPP) - DM6=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP*DGIPP**3) - -C FIRST ATOM BY THETA1 - TDX(1)=((RIPZ*GIPY-RIPY*GIPZ)*DM1 - & -(GIY*RIPZ-GIZ*RIPY)*DM2)*TFTHE1 - TDY(1)=((-RIPZ*GIPX+RIPX*GIPZ)*DM1 - & -(-GIX*RIPZ+GIZ*RIPX)*DM2)*TFTHE1 - TDZ(1)=((RIPY*GIPX-RIPX*GIPY)*DM1 - & -(GIX*RIPY-GIY*RIPX)*DM2)*TFTHE1 -C SECOND ATOM BY THETA1 - TDX(2)=((CIPY*GIPZ-CIPZ*GIPY-RIPPY*GIZ+RIPPZ*GIY)*DM1 - & -(CIPY*GIZ-CIPZ*GIY)*DM2 - & +(RIPPY*GIPZ-RIPPZ*GIPY)*DM3)*TFTHE1 - TDY(2)=((CIPZ*GIPX-CIPX*GIPZ-RIPPZ*GIX+RIPPX*GIZ)*DM1 - & -(CIPZ*GIX-CIPX*GIZ)*DM2 - & +(RIPPZ*GIPX-RIPPX*GIPZ)*DM3)*TFTHE1 - TDZ(2)=((CIPX*GIPY-CIPY*GIPX-RIPPX*GIY+RIPPY*GIX)*DM1 - & -(CIPX*GIY-CIPY*GIX)*DM2 - & +(RIPPX*GIPY-RIPPY*GIPX)*DM3)*TFTHE1 -C SECOND ATOM BY THETA2 - TDX(2)=TDX(2)+ - & ((RIPPZ*GIPPY-RIPPY*GIPPZ)*DM4 - & -(GIPY*RIPPZ-GIPZ*RIPPY)*DM5)*TFTHE2 - TDY(2)=TDY(2)+ - & ((-RIPPZ*GIPPX+RIPPX*GIPPZ)*DM4 - & -(-GIPX*RIPPZ+GIPZ*RIPPX)*DM5)*TFTHE2 - TDZ(2)=TDZ(2)+ - & ((RIPPY*GIPPX-RIPPX*GIPPY)*DM4 - & -(GIPX*RIPPY-GIPY*RIPPX)*DM5)*TFTHE2 -C THIRD ATOM BY THETA1 - TDX(3)=((GIPY*RIZ-GIPZ*RIY-GIY*CIPPZ+GIZ*CIPPY)*DM1 - & -(GIY*RIZ-GIZ*RIY)*DM2 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM3) *TFTHE1 - TDY(3)=((GIPZ*RIX-GIPX*RIZ-GIZ*CIPPX+GIX*CIPPZ)*DM1 - & -(GIZ*RIX-GIX*RIZ)*DM2 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM3) *TFTHE1 - TDZ(3)=((GIPX*RIY-GIPY*RIX-GIX*CIPPY+GIY*CIPPX)*DM1 - & -(GIX*RIY-GIY*RIX)*DM2 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM3) *TFTHE1 -C THIRD ATOM BY THETA2 - TDX(3)=TDX(3)+ - & ((CIPPY*GIPPZ-CIPPZ*GIPPY-RIP3Y*GIPZ+RIP3Z*GIPY)*DM4 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5 - & +(RIP3Y*GIPpZ-RIP3Z*GIPpY)*DM6) *TFTHE2 - TDY(3)=TDY(3)+ - & ((CIPPZ*GIPPX-CIPPX*GIPPZ-RIP3Z*GIPX+RIP3X*GIPZ)*DM4 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5 - & +(RIP3Z*GIPpX-RIP3X*GIPpZ)*DM6) *TFTHE2 - TDZ(3)=TDZ(3)+ - & ((CIPPX*GIPPY-CIPPY*GIPPX-RIP3X*GIPY+RIP3Y*GIPX)*DM4 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM5 - & +(RIP3X*GIPpY-RIP3Y*GIPpX)*DM6) *TFTHE2 -C FOURTH ATOM BY THETA1 - TDX(4)=-((GIZ*RIPY-GIY*RIPZ)*DM1 - & -(GIPZ*RIPY-GIPY*RIPZ)*DM3) *TFTHE1 - TDY(4)=-((GIX*RIPZ-GIZ*RIPX)*DM1 - & -(GIPX*RIPZ-GIPZ*RIPX)*DM3) *TFTHE1 - TDZ(4)=-((GIY*RIPX-GIX*RIPY)*DM1 - & -(GIPY*RIPX-GIPX*RIPY)*DM3) *TFTHE1 -C FOURTH ATOM BY THETA2 - TDX(4)=TDX(4)+ - & ((GIPPY*RIPZ-GIPPZ*RIPY-GIPY*CIP3Z+GIPZ*CIP3Y)*DM4 - & -(GIPY*RIPZ-GIPZ*RIPY)*DM5 - & -(CIP3Y*GIPPZ-CIP3Z*GIPPY)*DM6)*TFTHE2 - TDY(4)=TDY(4)+ - & ((GIPPZ*RIPX-GIPPX*RIPZ-GIPZ*CIP3X+GIPX*CIP3Z)*DM4 - & -(GIPZ*RIPX-GIPX*RIPZ)*DM5 - & -(CIP3Z*GIPPX-CIP3X*GIPPZ)*DM6)*TFTHE2 - TDZ(4)=TDZ(4)+ - & ((GIPPX*RIPY-GIPPY*RIPX-GIPX*CIP3Y+GIPY*CIP3X)*DM4 - & -(GIPX*RIPY-GIPY*RIPX)*DM5 - & -(CIP3X*GIPPY-CIP3Y*GIPPX)*DM6)*TFTHE2 -C FIFTH ATOM BY THETA2 - TDX(5)=-((GIPZ*RIPPY-GIPY*RIPPZ)*DM4 - & -(GIPPZ*RIPPY-GIPPY*RIPPZ)*DM6)*TFTHE2 - TDY(5)=-((GIPX*RIPPZ-GIPZ*RIPPX)*DM4 - & -(GIPPX*RIPPZ-GIPPZ*RIPPX)*DM6)*TFTHE2 - TDZ(5)=-((GIPY*RIPPX-GIPX*RIPPY)*DM4 - & -(GIPPY*RIPPX-GIPPX*RIPPY)*DM6)*TFTHE2 -C !! END OF FORCE DIRECTION!!!! - DO II=1,5 - gdfat(1,iatom(II))=gdfat(1,iatom(II))+TDX(II) - gdfat(2,iatom(II))=gdfat(2,iatom(II))+TDY(II) - gdfat(3,iatom(II))=gdfat(3,iatom(II))+TDZ(II) - ENDDO -C energy calculation - enethe = enethe + ethe - ENDDO - - edfator = enephi + enethe - - RETURN - END - - subroutine edfan(edfanei) -C DFA neighboring CA restraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - integer i,j,imin - integer kshnum, n1atom - - double precision enenei,tmp_n - double precision pai,hpai - double precision jix,jiy,jiz,ndiff,snorm_nei - double precision t2dx(maxres),t2dy(maxres),t2dz(maxres) - double precision dr,dr2,half,ntmp,dtmp - - parameter(dr=0.25d0,dr2=0.50d0,half=0.50d0) - parameter(pai=3.14159265358979323846D0) - parameter(hpai=1.5707963267948966D0) - parameter(snorm_nei=0.886226925452758D0) - - edfanei = 0.0d0 - enenei = 0.0d0 - gdfan = 0.0d0 - -c print*, 's1:', s1(:) -c print*, 's2:', s2(:) - - do i=1, idfanei - - kshnum=kshell(i) - n1atom=ineilis(i)+ishiftca -C write(*,*) 'kshnum,n1atom:', kshnum, n1atom - - tmp_n=0.0d0 - ftmp=0.0d0 - dnei=0.0d0 - dist=0.0d0 - t1dx=0.0d0 - t1dy=0.0d0 - t1dz=0.0d0 - t2dx=0.0d0 - t2dy=0.0d0 - t2dz=0.0d0 - - do j = ishiftca+1, ilastca - - if (n1atom.eq.j) cycle - - jix=c(1,j)-c(1,n1atom) - jiy=c(2,j)-c(2,n1atom) - jiz=c(3,j)-c(3,n1atom) - dist=sqrt(jix*jix+jiy*jiy+jiz*jiz) - -c write(*,*) n1atom, j, dist - - if(kshnum.ne.1)then - if (dist.lt.s1(kshnum).and. - & dist.gt.s2(kshnum-1)) then - - tmp_n=tmp_n+1.0d0 - -c write(*,*) 'case1:',tmp_n - - t1dx=t1dx+0.0d0 - t1dy=t1dy+0.0d0 - t1dz=t1dz+0.0d0 - t2dx(j)=0.0d0 - t2dy(j)=0.0d0 - t2dz(j)=0.0d0 - - elseif(dist.ge.s1(kshnum).and. - & dist.le.s2(kshnum)) then - - dnei=(dist-s1(kshnum))/dr2*pai - tmp_n=tmp_n + half*(1+cos(dnei)) -c write(*,*) 'case2:',tmp_n - ftmp=-pai*sin(dnei)/dr2/dist/2.0d0 -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp -c - elseif(dist.ge.s1(kshnum-1).and. - & dist.le.s2(kshnum-1)) then - dnei=(dist-s1(kshnum-1))/dr2*pai - tmp_n=tmp_n + 1.0d0 - half*(1+cos(dnei)) -c write(*,*) 'case3:',tmp_n - ftmp = hpai*sin(dnei)/dr2/dist -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp - - endif - - elseif(kshnum.eq.1) then - - if(dist.lt.s1(kshnum))then - - tmp_n=tmp_n+1.0d0 -c write(*,*) 'case4:',tmp_n - t1dx=t1dx+0.0d0 - t1dy=t1dy+0.0d0 - t1dz=t1dz+0.0d0 - t2dx(j)=0.0d0 - t2dy(j)=0.0d0 - t2dz(j)=0.0d0 - - elseif(dist.ge.s1(kshnum).and. - & dist.le.s2(kshnum))then - - dnei=(dist-s1(kshnum))/dr2*pai - tmp_n=tmp_n + half*(1+cos(dnei)) -c write(*,*) 'case5:',tmp_n - ftmp = -hpai*sin(dnei)/dr2/dist -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp - - endif - endif - enddo - - scc=0.0d0 - enei=0.0d0 - tmp_fnei=0.0d0 - ndiff=0.0d0 - - do imin=1,ineinum(i) - - ndiff = tmp_n-fnei(i,imin) - dtmp = ndiff*ndiff - - if (dtmp.ge.15.0d0) then - ntmp = 0.0d0 - else -c ntmp = dfaexp( idint(dtmp*1000) + 1 ) - ntmp = exp(-dtmp) - end if - - enei=enei+sccnei(i,imin)*ntmp - tmp_fnei=tmp_fnei- - & sccnei(i,imin)*ntmp*ndiff*2.0d0 - scc=scc+sccnei(i,imin) - -c write(*,'(a,1x,2i8,f12.7,i8,3f12.7)')'NEI:',i,imin,tmp_n, -c & fnei(i,imin),sccnei(i,imin),enei,scc - enddo - - enei=-enei/scc*snorm_nei*nei_inc*wwnei - tmp_fnei=tmp_fnei/scc*snorm_nei*nei_inc*wwnei - -c if (abs(enei).lt.1.0d-20)then -c enei=0.0d0 -c endif -c if (abs(tmp_fnei).lt.1.0d-20) then -c tmp_fnei=0.0d0 -c endif - -c force calculation - t1dx=t1dx*tmp_fnei - t1dy=t1dy*tmp_fnei - t1dz=t1dz*tmp_fnei - - do j=ishiftca+1,ilastca - t2dx(j)=t2dx(j)*tmp_fnei - t2dy(j)=t2dy(j)*tmp_fnei - t2dz(j)=t2dz(j)*tmp_fnei - enddo - - gdfan(1,n1atom)=gdfan(1,n1atom)+t1dx - gdfan(2,n1atom)=gdfan(2,n1atom)+t1dy - gdfan(3,n1atom)=gdfan(3,n1atom)+t1dz - - do j=ishiftca+1,ilastca - gdfan(1,j)=gdfan(1,j)+t2dx(j) - gdfan(2,j)=gdfan(2,j)+t2dy(j) - gdfan(3,j)=gdfan(3,j)+t2dz(j) - enddo -c energy calculation - - enenei=enenei+enei - - enddo - - edfanei=enenei - - return - end - - subroutine edfab(edfabeta) - - implicit real*8 (a-h,o-z) - - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - real*8 PAI - parameter(PAI=3.14159265358979323846D0) - parameter (maxca=800) -C sheet variables - real*8 bx(maxres),by(maxres),bz(maxres) - real*8 vbet(maxres,maxres) - real*8 shetfx(maxres),shetfy(maxres),shetfz(maxres) - real*8 shefx(maxres,12),shefy(maxres,12),shefz(maxres,12) - real*8 vbeta,vbetp,vbetm - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - real*8 dp45,dm45,w_beta - - real*8 cph(maxca),cth(maxca) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 sth(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - - real*8 atxnum(maxca),atynum(maxca),atznum(maxca), - & astxnum(maxca),astynum(maxca),astznum(maxca), - & atmxnum(maxca),atmynum(maxca),atmznum(maxca), - & astmxnum(maxca),astmynum(maxca),astmznum(maxca), - & atmmxnum(maxca),atmmynum(maxca),atmmznum(maxca), - & astmmxnum(maxca),astmmynum(maxca),astmmznum(maxca), - & atm3xnum(maxca),atm3ynum(maxca),atm3znum(maxca), - & astm3xnum(maxca),astm3ynum(maxca),astm3znum(maxca), - & cth_orig(maxca),sth_orig(maxca) - - common /sheca/ bx,by,bz - common /shee/ vbeta,vbet,vbetp,vbetm - common /shetf/ shetfx,shetfy,shetfz - common /shef/ shefx, shefy, shefz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - $ atmmz,atm3x,atm3y,atm3z - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - $ astmmz,astm3x,astm3y,astm3z - - common /coscos/ cph,cth - common /sinsin/ sth - -C End of sheet variables - - integer i,j - double precision enebet - - enebet=0.0d0 - bx=0.0d0;by=0.0d0;bz=0.0d0 - shetfx=0.0d0;shetfy=0.0d0;shetfz=0.0d0 - - gdfab=0.0d0 - - do i=ishiftca+1,ilastca - bx(i-ishiftca)=c(1,i) - by(i-ishiftca)=c(2,i) - bz(i-ishiftca)=c(3,i) - enddo - -c do i=1,ilastca-ishiftca -c read(99,*) bx(i),by(i),bz(i) -c enddo -c close(99) - - dca=0.25d0**2 - dshe=0.3d0**2 - ULHB=5.0D0 - ULDHB=5.0D0 - ULNEX=COS(60.0D0/180.0D0*PAI) - - DLHB=1.0D0 - DLDHB=1.0D0 - - DNEX=0.3D0**2 - - C00=COS((1.0D0+10.0D0/180.0D0)*PAI) - S00=SIN((1.0D0+10.0D0/180.0D0)*PAI) - - W_BETA=0.5D0 - DP45=W_BETA - DM45=W_BETA - -C END OF INITIALIZATION - - nca=ilastca-ishiftca - - call angvectors(nca) - call sheetforce(nca,wshet) - -c end of sheet energy and force - - do j=1,nca - shetfx(j)=shetfx(j)*beta_inc - shetfy(j)=shetfy(j)*beta_inc - shetfz(j)=shetfz(j)*beta_inc -c write(*,*)'SHETF:',shetfx(j),shetfy(j),shetfz(j) - enddo - - vbeta=vbeta*beta_inc - enebet=vbeta - edfabeta=enebet - - do j=1,nca - gdfab(1,j+ishiftca)=gdfab(1,j+ishiftca)-shetfx(j) - gdfab(2,j+ishiftca)=gdfab(2,j+ishiftca)-shetfy(j) - gdfab(3,j+ishiftca)=gdfab(3,j+ishiftca)-shetfz(j) - enddo - -#ifdef DEBUG1 - do j=1,nca - write(*,'(5x,i5,10x,3f10.5)') j,bx(j),by(j),bz(j) - enddo - - - gdfab=0 - dinc=0.001 - do j=1,nca - cth_orig(j)=cth(j) - sth_orig(j)=sth(j) - enddo - - do j=1,nca - - bx(j)=bx(j)+dinc - call angvectors(nca) - bx(j)=bx(j)-2*dinc - call angvectors(nca) - atxnum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astxnum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmxnum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmxnum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmxnum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmxnum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3xnum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3xnum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - bx(j)=bx(j)+dinc - by(j)=by(j)+dinc - call angvectors(nca) - by(j)=by(j)-2*dinc - call angvectors(nca) - by(j)=by(j)+dinc - atynum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astynum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmynum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmynum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmynum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmynum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3ynum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3ynum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - - bz(j)=bz(j)+dinc - call angvectors(nca) - bz(j)=bz(j)-2*dinc - call angvectors(nca) - bz(j)=bz(j)+dinc - - atznum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astznum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmznum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmznum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmznum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmznum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3znum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3znum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - - enddo - - do i=1,nca - write (*,'(2i5,a2,6f10.5)') - & i,1,"x",atxnum(i),atx(i),atxnum(i)/atx(i), - & astxnum(i),astx(i),astxnum(i)/astx(i), - & i,1,"y",atynum(i),aty(i),atynum(i)/aty(i), - & astynum(i),asty(i),astynum(i)/asty(i), - & i,1,"z",atznum(i),atz(i),atznum(i)/atz(i), - & astznum(i),astz(i),astznum(i)/astz(i), - & i,2,"x",atmxnum(i),atmx(i),atmxnum(i)/atmx(i), - & astmxnum(i),astmx(i),astmxnum(i)/astmx(i), - & i,2,"y",atmynum(i),atmy(i),atmynum(i)/atmy(i), - & astmynum(i),astmy(i),astmynum(i)/astmy(i), - & i,2,"z",atmznum(i),atmz(i),atmznum(i)/atmz(i), - & astmznum(i),astmz(i),astmznum(i)/astmz(i), - & i,3,"x",atmmxnum(i),atmmx(i),atmmxnum(i)/atmmx(i), - & astmmxnum(i),astmmx(i),astmmxnum(i)/astmmx(i), - & i,3,"y",atmmynum(i),atmmy(i),atmmynum(i)/atmmy(i), - & astmmynum(i),astmmy(i),astmmynum(i)/astmmy(i), - & i,3,"z",atmmznum(i),atmmz(i),atmmznum(i)/atmmz(i), - & astmmznum(i),astmmz(i),astmmznum(i)/astmmz(i), - & i,4,"x",atm3xnum(i),atm3x(i),atm3xnum(i)/atm3x(i), - & astm3xnum(i),astm3x(i),astm3xnum(i)/astm3x(i), - & i,4,"y",atm3ynum(i),atm3y(i),atm3ynum(i)/atm3y(i), - & astm3ynum(i),astm3y(i),astm3ynum(i)/astm3y(i), - & i,4,"z",atm3znum(i),atm3z(i),atm3znum(i)/atm3z(i), - & astm3znum(i),astm3z(i),astm3znum(i)/astm3z(i), - & i,0," ",cth_orig(i),sth_orig(i) - enddo - - - gdfab=0 - dinc=0.001 - - do j=1,nca - - bx(j)=bx(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - bx(j)=bx(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(1,j)=(vbeta2-vbeta1)/dinc/2 - bx(j)=bx(j)+dinc - - by(j)=by(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - by(j)=by(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(2,j)=(vbeta2-vbeta1)/dinc/2 - by(j)=by(j)+dinc - - bz(j)=bz(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - bz(j)=bz(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(3,j)=(vbeta2-vbeta1)/dinc/2 - bz(j)=bz(j)+dinc - - - enddo - - - call angvectors(nca) - call sheetforce(nca,wshet) - do j=1,nca - shetfx(j)=shetfx(j)*beta_inc - shetfy(j)=shetfy(j)*beta_inc - shetfz(j)=shetfz(j)*beta_inc - enddo - - - write(*,*) 'xyz analytical and numerical gradient' - do j=1,nca - write(*,'(5x,i5,10x,6f10.5)') j,-shetfx(j),-shetfy(j),-shetfz(j) - & ,(-gdfab(i,j),i=1,3) - enddo - - do j=1,nca - write(*,'(5x,i5,10x,3f10.2)') j,shetfx(j)/gdfab(1,j), - & shetfy(j)/gdfab(2,j), - & shetfz(j)/gdfab(3,j) - enddo - - stop -#endif - - return - end -C------------------------------------------------------------------------------- - subroutine angvectors(nca) -c implicit real*4(a-h,o-z) - implicit none - integer nca - integer maxca - parameter(maxca=800) - real*8 pai,zero - parameter(PAI=3.14159265358979323846D0,zero=0.0d0) - - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 apx(maxca),apy(maxca),apz(maxca) - real*8 apmx(maxca),apmy(maxca),apmz(maxca) - real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) - real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 cph(maxca),cth(maxca) - real*8 ulcos(maxca) - real*8 p,c - integer i, ip, ipp, ip3, j - real*8 rx(maxca, maxca), ry(maxca, maxca), rz(maxca, maxca) - real*8 rix, riy, riz, ripx, ripy, ripz, rippx, rippy, rippz - real*8 gix, giy, giz, gipx, gipy, gipz, gippx, gippy, gippz - real*8 cix, ciy, ciz, cipx, cipy, cipz - real*8 gpcrp_x, gpcrp_y, gpcrp_z, d_gpcrp, gpcrp__g - real*8 d10, d11, d12, d13, d20, d21, d22, d23, d24 - real*8 d30, d31, d32, d33, d34, d35, d40, d41, d42, d43 - real*8 d_gcr, d_gcr3, d_gmcrim,d_gmcrim3,dgmmcrimm,d_gmmcrimm3 - real*8 dg, dg3, dg30, dgm, dgm3, dgmm, dgmm3, dgp, dri - real*8 dri3, drim, drim3, drimm, drip, dripp, g3gmm, g3rim - real*8 g3x, g3y, g3z, d_gmmcrimm, g3rim_,gcr__gm - real*8 gcr_x,gcr_y,gcr_z,ggm,ggp,gmcrim__gmm - real*8 gmcrim_x,gmcrim_y,gmcrim_z,gmmcrimm__gmmm - real*8 gmmcrimm_x,gmmcrimm_y,gmmcrimm_z,gmmgm,gmmr - real*8 gmmx,gmmy,gmmz,gmrp,gmx,gmy,gmz,gpx,gpy,gpz - real*8 grpp,gx,gy,gz - real*8 rim3x,rim3y,rim3z,rimmx,rimmy,rimmz,rimx,rimy,rimz - real*8 sd10,sd11,sd20,sd21,sd22,sd30,sd31,sd32,sd40,sd41 - integer inb,nmax,iselect - - common /sheca/ bx,by,bz - common /difvec/ rx, ry, rz - common /ulang/ ulcos - common /phys1/ inb,nmax,iselect - common /phys4/ p,c - common /kyori2/ dis - common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, - & apmmz,apm3x,apm3y,apm3z - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - & atmmz,atm3x,atm3y,atm3z - common /coscos/ cph,cth - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - & astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth -C------------------------------------------------------------------------------- -c write(*,*) 'inside angvectors' -C initialize - p=0.1d0 - c=1.0d0 - inb=nca - cph=zero; cth=zero; sth=zero - apx=zero;apy=zero;apz=zero;apmx=zero;apmy=zero;apmz=zero - apmmx=zero;apmmy=zero;apmmz=zero;apm3x=zero;apm3y=zero;apm3z=zero - atx=zero;aty=zero;atz=zero;atmx=zero;atmy=zero;atmz=zero - atmmx=zero;atmmy=zero;atmmz=zero;atm3x=zero;atm3y=zero;atm3z=zero - astx=zero;asty=zero;astz=zero;astmx=zero;astmy=zero;astmz=zero - astmmx=zero;astmmy=zero;astmmz=zero;astm3x=zero;astm3y=zero - astm3z=zero -C end of initialize -C r[x,y,z] calc and distance calculation - rx=zero;ry=zero;rz=zero - - do i=1,inb - do j=1,inb - rx(i,j)=bx(j)-bx(i) - ry(i,j)=by(j)-by(i) - rz(i,j)=bz(j)-bz(i) - dis(i,j)=sqrt(rx(i,j)**2+ry(i,j)**2+rz(i,j)**2) -c write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) -c write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) -c write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) -c write(*,*) 'dis(i,j):',i,j,dis(i,j) - enddo - enddo -c end of r[x,y,z] calc -C cos calc - do i=1,inb-2 - ip=i+1 - ipp=i+2 - - if(dis(i,ip).ge.1.0e-8.and.dis(ip,ipp).ge.1.0e-8) then - ulcos(i)=rx(i,ip)*rx(ip,ipp)+ry(i,ip)*ry(ip,ipp) - $ +rz(i,ip)*rz(ip,ipp) - ulcos(i)=ulcos(i)/(dis(i,ip)*dis(ip,ipp)) - endif - enddo -c end of virtual bond angle -c write(*,*) 'inside angvectors1' -crc do i=1,inb-3 - do i=1,inb - ip=i+1 - ipp=i+2 - ip3=i+3 - rix=bx(ip)-bx(i) - riy=by(ip)-by(i) - riz=bz(ip)-bz(i) - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - rippx=bx(ip3)-bx(ipp) - rippy=by(ip3)-by(ipp) - rippz=bz(ip3)-bz(ipp) - - gx=riy*ripz-riz*ripy - gy=riz*ripx-rix*ripz - gz=rix*ripy-riy*ripx - gpx=ripy*rippz-ripz*rippy - gpy=ripz*rippx-ripx*rippz - gpz=ripx*rippy-ripy*rippx - gpcrp_x=gpy*ripz-gpz*ripy - gpcrp_y=gpz*ripx-gpx*ripz - gpcrp_z=gpx*ripy-gpy*ripx - d_gpcrp=sqrt(gpcrp_x**2+gpcrp_y**2+gpcrp_z**2) - gpcrp__g=gx*gpy*ripz+gpx*ripy*gz+ripx*gpz*gy - & -gz*gpy*ripx-gpz*ripy*gx-ripz*gpx*gy - - if(i.ge.2) then - rimx=bx(i)-bx(i-1) - rimy=by(i)-by(i-1) - rimz=bz(i)-bz(i-1) - gmx=rimy*riz-rimz*riy - gmy=rimz*rix-rimx*riz - gmz=rimx*riy-rimy*rix - dgm=sqrt(gmx**2+gmy**2+gmz**2) - dgm3=dgm**3 - ggm=gmx*gx+gmy*gy+gmz*gz - gmrp=gmx*ripx+gmy*ripy+gmz*ripz - drim=dis(i-1,i) - drim3=drim**3 - gcr_x=gy*riz-gz*riy - gcr_y=gz*rix-gx*riz - gcr_z=gx*riy-gy*rix - d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) - d_gcr3=d_gcr**3 - gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy - & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy - endif -c write(*,*) 'inside angvectors2' - if(i.ge.3) then - rimmx=bx(i-1)-bx(i-2) - rimmy=by(i-1)-by(i-2) - rimmz=bz(i-1)-bz(i-2) - drimm=dis(i-2,i-1) - gmmx=rimmy*rimz-rimmz*rimy - gmmy=rimmz*rimx-rimmx*rimz - gmmz=rimmx*rimy-rimmy*rimx - dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) - dgmm3=dgmm**3 - gmmgm=gmmx*gmx+gmmy*gmy+gmmz*gmz - gmmr=gmmx*rix+gmmy*riy+gmmz*riz - gmcrim_x=gmy*rimz-gmz*rimy - gmcrim_y=gmz*rimx-gmx*rimz - gmcrim_z=gmx*rimy-gmy*rimx - d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) - d_gmcrim3=d_gmcrim**3 - gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy - & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy - endif - - if(i.ge.4) then - rim3x=bx(i-2)-bx(i-3) - rim3y=by(i-2)-by(i-3) - rim3z=bz(i-2)-bz(i-3) - g3x=rim3y*rimmz-rim3z*rimmy - g3y=rim3z*rimmx-rim3x*rimmz - g3z=rim3x*rimmy-rim3y*rimmx - dg30=sqrt(g3x**2+g3y**2+g3z**2) - g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz - g3rim_=g3x*rimx+g3y*rimy+g3z*rimz -cc********************************************************************** - gmmcrimm_x=gmmy*rimmz-gmmz*rimmy - gmmcrimm_y=gmmz*rimmx-gmmx*rimmz - gmmcrimm_z=gmmx*rimmy-gmmy*rimmx - d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) - d_gmmcrimm3=d_gmmcrimm**3 - gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y - & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y - endif - - dri=dis(i,i+1) - drip=dis(i+1,i+2) - dripp=dis(i+2,i+3) - dri3=dri**3 - dg=sqrt(gx**2+gy**2+gz**2) - dgp=sqrt(gpx**2+gpy**2+gpz**2) - dg3=dg**3 - - ggp=gx*gpx+gy*gpy+gz*gpz - grpp=gx*rippx+gy*rippy+gz*rippz - - if(dg.gt.0.0D0.and.dripp.gt.0.0D0.and.dgp.gt.0.0D0 - & .and.d_gpcrp.gt.0.0D0) then - cph(i)=grpp/dg/dripp - cth(i)=ggp/dg/dgp - sth(i)=gpcrp__g/d_gpcrp/dg - else -c - cph(i)=1.0D0 - cth(i)=1.0D0 - sth(i)=0.0D0 - endif - -c write(*,*) 'inside angvectors3' - - if(dgp.gt.0.0D0.and.dg3.gt.0.0D0 - & .and.dripp.gt.0.0D0.and.d_gpcrp.gt.0.0D0) then - d10=1.0D0/(dg*dgp) - d11=ggp/(dg3*dgp) - d12=1.0D0/(dg*dripp) - d13=grpp/(dg3*dripp) - sd10=1.0D0/(d_gpcrp*dg) - sd11=gpcrp__g/(d_gpcrp*dg3) - else - d10=0.0D0 - d11=0.0D0 - d12=0.0D0 - d13=0.0D0 - sd10=0.0D0 - sd11=0.0D0 - endif - - atx(i)=(ripz*gpy-ripy*gpz)*d10 - & -(gy*ripz-gz*ripy)*d11 - aty(i)=(ripx*gpz-ripz*gpx)*d10 - & -(gz*ripx-gx*ripz)*d11 - atz(i)=(ripy*gpx-ripx*gpy)*d10 - & -(gx*ripy-gy*ripx)*d11 - astx(i)=sd10*(-gpx*ripy**2+ripx*gpz*ripz - & +ripy*gpy*ripx-gpx*ripz**2) - & -sd11*(gy*ripz-gz*ripy) - asty(i)=sd10*(-gpy*ripz**2+gpx*ripy*ripx - & -gpy*ripx**2+gpz*ripy*ripz) - & -sd11*(-gx*ripz+gz*ripx) - astz(i)=sd10*(ripy*gpy*ripz-gpz*ripx**2 - & -gpz*ripy**2+ripz*gpx*ripx) - & -sd11*(gx*ripy-gy*ripx) - apx(i)=(ripz*rippy-ripy*rippz)*d12 - & -(gy*ripz-gz*ripy)*d13 - apy(i)=(ripx*rippz-ripz*rippx)*d12 - & -(gz*ripx-gx*ripz)*d13 - apz(i)=(ripy*rippx-ripx*rippy)*d12 - & -(gx*ripy-gy*ripx)*d13 - - if(i.ge.2) then - cix=bx(ip)-bx(i-1) - ciy=by(ip)-by(i-1) - ciz=bz(ip)-bz(i-1) - cipx=bx(ipp)-bx(i) - cipy=by(ipp)-by(i) - cipz=bz(ipp)-bz(i) - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - if(dgm3.gt.0.0D0.and.dg3.gt.0.0D0.and.drip.gt.0.0D0 - & .and.d_gcr3.gt.0.0D0) then - d20=1.0D0/(dg*dgm) - d21=ggm/(dgm3*dg) - d22=ggm/(dgm*dg3) - d23=1.0D0/(dgm*drip) - d24=gmrp/(dgm3*drip) - sd20=1.0D0/(d_gcr*dgm) - sd21=gcr__gm/(d_gcr3*dgm) - sd22=gcr__gm/(d_gcr*dgm3) - else - d20=0.0D0 - d21=0.0D0 - d22=0.0D0 - d23=0.0D0 - d24=0.0D0 - sd20=0.0D0 - sd21=0.0D0 - sd22=0.0D0 - endif - atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 - & -(ciy*gmz-ciz*gmy)*d21 - & +(ripy*gz-ripz*gy)*d22 - atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 - & -(ciz*gmx-cix*gmz)*d21 - & +(ripz*gx-ripx*gz)*d22 - atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 - & -(cix*gmy-ciy*gmx)*d21 - & +(ripx*gy-ripy*gx)*d22 -cc********************************************************************** - astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy - & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix - & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) - & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) - & +gcr_z*(-ripz*rix+gy)) - & -sd22*(-gmy*ciz+gmz*ciy) - - astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix - & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz - & +riz*ripz*gmy) - & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) - & -gcr_z*(ripz*riy+gx)) - & -sd22*(gmx*ciz-gmz*cix) - - astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz - & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy - & -riz*gx*cix) - & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) - & +gcr_z*(ripy*riy+ripx*rix)) - & -sd22*(-gmx*ciy+gmy*cix) -cc********************************************************************** - apmx(i)=(ciy*ripz-ripy*ciz)*d23 - & -(ciy*gmz-ciz*gmy)*d24 - apmy(i)=(ciz*ripx-ripz*cix)*d23 - & -(ciz*gmx-cix*gmz)*d24 - apmz(i)=(cix*ripy-ripx*ciy)*d23 - & -(cix*gmy-ciy*gmx)*d24 - endif - - if(i.ge.3) then - if(dgm3.gt.0.0D0.and.dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 - & .and.d_gmcrim3.gt.0.0D0) then - d30=1.0D0/(dgm*dgmm) - d31=gmmgm/(dgm3*dgmm) - d32=gmmgm/(dgm*dgmm3) - d33=1.0D0/(dgmm*dri) - d34=gmmr/(dgmm3*dri) - d35=gmmr/(dgmm*dri3) - sd30=1.0D0/(d_gmcrim*dgmm) - sd31=gmcrim__gmm/(d_gmcrim3*dgmm) - sd32=gmcrim__gmm/(d_gmcrim*dgmm3) - else - d30=0.0D0 - d31=0.0D0 - d32=0.0D0 - d33=0.0D0 - d34=0.0D0 - d35=0.0D0 - sd30=0.0D0 - sd31=0.0D0 - sd32=0.0D0 - endif - -c write(*,*) 'inside angvectors4' - -cc********************************************************************** - atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 - & -(ciy*gmz-ciz*gmy)*d31 - & -(gmmy*rimmz-gmmz*rimmy)*d32 - atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 - & -(ciz*gmx-cix*gmz)*d31 - & -(gmmz*rimmx-gmmx*rimmz)*d32 - atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 - & -(cix*gmy-ciy*gmx)*d31 - & -(gmmx*rimmy-gmmy*rimmx)*d32 -cc********************************************************************** - astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy - & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz - & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy - & -ciy*rimy*gmmx-rimz*gmx*rimmz) - & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) - & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) - & -sd32*(gmmy*rimmz-rimmy*gmmz) - - astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz - & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy - & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx - & +gmz*rimy*rimmz-rimz*ciz*gmmy) - & -sd31*(gmcrim_x*(cix*rimy-gmz) - & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) - & -sd32*(-gmmx*rimmz+rimmx*gmmz) - - astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz - & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx - & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy - & +rimz*ciy*gmmy+rimz*gmx*rimmx) - & -sd31*(gmcrim_x*(cix*rimz+gmy) - & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) - & -sd32*(gmmx*rimmy-rimmx*gmmy) -c********************************************************************** - apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 - & -(gmmy*rimmz-gmmz*rimmy)*d34 - & +rix*d35 - apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 - & -(gmmz*rimmx-gmmx*rimmz)*d34 - & +riy*d35 - apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 - & -(gmmx*rimmy-gmmy*rimmx)*d34 - & +riz*d35 - endif - - if(i.ge.4) then - if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 - & .and.drim3.gt.0.0D0 - & .and.d_gmmcrimm3.gt.0.0D0) then - d40=1.0D0/(dg30*dgmm) - d41=g3gmm/(dg30*dgmm3) - d42=1.0D0/(dg30*drim) - d43=g3rim_/(dg30*drim3) - sd40=1.0D0/(dg30*d_gmmcrimm) - sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) - else - d40=0.0D0 - d41=0.0D0 - d42=0.0D0 - d43=0.0D0 - sd40=0.0D0 - sd41=0.0D0 - endif - atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 - & -(gmmy*rimmz-gmmz*rimmy)*d41 - atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 - & -(gmmz*rimmx-gmmx*rimmz)*d41 - atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 - & -(gmmx*rimmy-gmmy*rimmx)*d41 -cc********************************************************************** - astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y - & -g3z*rimmz*rimmx+rimmy**2*g3x) - & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) - & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) - - astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y - & -rimmx*rimmy*g3x+rimmz**2*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmy - & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmy) - -c & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) - - astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z - & +g3z*rimmx**2-rimmz*rimmy*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz - & +gmmcrimm_z*(rimmy**2+rimmx**2)) -c********************************************************************** - apm3x(i)=g3x*d42-rimx*d43 - apm3y(i)=g3y*d42-rimy*d43 - apm3z(i)=g3z*d42-rimz*d43 - endif - enddo -c******************************************************************************* - -c write(*,*) 'inside angvectors5' - -c do i=inb-2,inb - do i=1,0 - rimx=bx(i)-bx(i-1) - rimy=by(i)-by(i-1) - rimz=bz(i)-bz(i-1) - rimmx=bx(i-1)-bx(i-2) - rimmy=by(i-1)-by(i-2) - rimmz=bz(i-1)-bz(i-2) - rim3x=bx(i-2)-bx(i-3) - rim3y=by(i-2)-by(i-3) - rim3z=bz(i-2)-bz(i-3) - gmmx=rimmy*rimz-rimmz*rimy - gmmy=rimmz*rimx-rimmx*rimz - gmmz=rimmx*rimy-rimmy*rimx - g3x=rim3y*rimmz-rim3z*rimmy - g3y=rim3z*rimmx-rim3x*rimmz - g3z=rim3x*rimmy-rim3y*rimmx - - dg30=sqrt(g3x**2+g3y**2+g3z**2) - g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz - dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) - dgmm3=dgmm**3 - drim=dis(i-1,i) - drimm=dis(i-2,i-1) - drim3=drim**3 - g3rim_=g3x*rimx+g3y*rimy+g3z*rimz -cc********************************************************************** - gmmcrimm_x=gmmy*rimmz-gmmz*rimmy - gmmcrimm_y=gmmz*rimmx-gmmx*rimmz - gmmcrimm_z=gmmx*rimmy-gmmy*rimmx - d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) - d_gmmcrimm3=d_gmmcrimm**3 - gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y - & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y - - if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 - & .and.drim3.gt.0.0D0 - & .and.d_gmmcrimm3.gt.0.0D0) then - d40=1.0D0/(dg30*dgmm) - d41=g3gmm/(dg30*dgmm3) - d42=1.0D0/(dg30*drim) - d43=g3rim_/(dg30*drim3) - sd40=1.0D0/(dg30*d_gmmcrimm) - sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) - else - d40=0.0D0 - d41=0.0D0 - d42=0.0D0 - d43=0.0D0 - sd40=0.0D0 - sd41=0.0D0 - endif - atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 - & -(gmmy*rimmz-gmmz*rimmy)*d41 - atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 - & -(gmmz*rimmx-gmmx*rimmz)*d41 - atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 - & -(gmmx*rimmy-gmmy*rimmx)*d41 -cc********************************************************************** - astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y - & -g3z*rimmz*rimmx+rimmy**2*g3x) - & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) - & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) - - astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y - & -rimmx*rimmy*g3x+rimmz**2*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmy - & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) - - astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z - & +g3z*rimmx**2-rimmz*rimmy*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz - & +gmmcrimm_z*(rimmy**2+rimmx**2)) -cc********************************************************************** - apm3x(i)=g3x*d42-rimx*d43 - apm3y(i)=g3y*d42-rimy*d43 - apm3z(i)=g3z*d42-rimz*d43 - - if(i.le.inb-1) then - ip=i+1 - rix=bx(ip)-bx(i) - riy=by(ip)-by(i) - riz=bz(ip)-bz(i) - cix=bx(ip)-bx(i-1) - ciy=by(ip)-by(i-1) - ciz=bz(ip)-bz(i-1) - gmx=rimy*riz-rimz*riy - gmy=rimz*rix-rimx*riz - gmz=rimx*riy-rimy*rix - dgm=sqrt(gmx**2+gmy**2+gmz**2) - dgm3=dgm**3 - dri=dis(i,i+1) - dri3=dri**3 - gmmgm=gmmx*gmx+gmmy*gmy+gmmz+gmz - gmmr=gmmx*rix+gmmy*riy+gmmz*riz - gmcrim_x=gmy*rimz-gmz*rimy - gmcrim_y=gmz*rimx-gmx*rimz - gmcrim_z=gmx*rimy-gmy*rimx - d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) - d_gmcrim3=d_gmcrim**3 - gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy - & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy - - if(dgm3.gt.0.0D0.and. - & dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 - & .and.d_gmcrim3.gt.0.0D0) then - d30=1.0D0/(dgm*dgmm) - d31=gmmgm/(dgm3*dgmm) - d32=gmmgm/(dgm*dgmm3) - d33=1.0D0/(dgmm*dri) - d34=gmmr/(dgmm3*dri) - d35=gmmr/(dgmm*dri3) - sd30=1.0D0/(d_gmcrim*dgmm) - sd31=gmcrim__gmm/(d_gmcrim3*dgmm) - sd32=gmcrim__gmm/(d_gmcrim*dgmm3) - - else - d30=0.0D0 - d31=0.0D0 - d32=0.0D0 - d33=0.0D0 - d34=0.0D0 - d35=0.0D0 - sd30=0.0D0 - sd31=0.0D0 - sd32=0.0D0 - endif -cc********************************************************************** - atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 - & -(ciy*gmz-ciz*gmy)*d31 - & -(gmmy*rimmz-gmmz*rimmy)*d32 - atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 - & -(ciz*gmx-cix*gmz)*d31 - & -(gmmz*rimmx-gmmx*rimmz)*d32 - atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 - & -(cix*gmy-ciy*gmx)*d31 - & -(gmmx*rimmy-gmmy*rimmx)*d32 -cc********************************************************************** - astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy - & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz - & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy - & -ciy*rimy*gmmx-rimz*gmx*rimmz) - & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) - & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) - & -sd32*(gmmy*rimmz-rimmy*gmmz) - - astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz - & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy - & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx - & +gmz*rimy*rimmz-rimz*ciz*gmmy) - & -sd31*(gmcrim_x*(cix*rimy-gmz) - & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) - & -sd32*(-gmmx*rimmz+rimmx*gmmz) - - astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz - & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx - & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy - & +rimz*ciy*gmmy+rimz*gmx*rimmx) - & -sd31*(gmcrim_x*(cix*rimz+gmy) - & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) - & -sd32*(gmmx*rimmy-rimmx*gmmy) -cc********************************************************************** - apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 - & -(gmmy*rimmz-gmmz*rimmy)*d34 - & +rix*d35 - apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 - & -(gmmz*rimmx-gmmx*rimmz)*d34 - & +riy*d35 - apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 - & -(gmmx*rimmy-gmmy*rimmx)*d34 - & +riz*d35 - endif - -c write(*,*) 'inside angvectors6' - - if(i.eq.inb-2) then - ipp=i+2 - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - cipx=bx(ipp)-bx(i) - cipy=by(ipp)-by(i) - cipz=bz(ipp)-bz(i) - gx=riy*ripz-riz*ripy - gy=riz*ripx-rix*ripz - gz=rix*ripy-riy*ripx - ggm=gmx*gx+gmy*gy+gmz*gz - gmrp=gmx*ripx+gmy*ripy+gmz*ripz - dg=sqrt(gx**2+gy**2+gz**2) - dg3=dg**3 - drip=dis(i+1,i+2) - gcr_x=gy*riz-gz*riy - gcr_y=gz*rix-gx*riz - gcr_z=gx*riy-gy*rix - d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) - d_gcr3=d_gcr**3 - gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy - & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy - if(dgm3.gt.0.0D0.and. - & dg3.gt.0.0D0.and.drip.gt.0.0D0.and.d_gcr3.gt.0.0D0 - & ) then - d20=1.0D0/(dg*dgm) - d21=ggm/(dgm3*dg) - d22=ggm/(dgm*dg3) - d23=1.0D0/(dgm*drip) - d24=gmrp/(dgm3*drip) - sd20=1.0D0/(d_gcr*dgm) - sd21=gcr__gm/(d_gcr3*dgm) - sd22=gcr__gm/(d_gcr*dgm3) - else - d20=0.0D0 - d21=0.0D0 - d22=0.0D0 - d23=0.0D0 - d24=0.0D0 - sd20=0.0D0 - sd21=0.0D0 - sd22=0.0D0 - endif - atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 - & -(ciy*gmz-ciz*gmy)*d21 - & +(ripy*gz-ripz*gy)*d22 - atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 - & -(ciz*gmx-cix*gmz)*d21 - & +(ripz*gx-ripx*gz)*d22 - atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 - & -(cix*gmy-ciy*gmx)*d21 - & +(ripx*gy-ripy*gx)*d22 -cc********************************************************************** - astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy - & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix - & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) - & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) - & +gcr_z*(-ripz*rix+gy)) - & -sd22*(-gmy*ciz+gmz*ciy) - - astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix - & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz - & +riz*ripz*gmy) - & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) - & -gcr_z*(ripz*riy+gx)) - & -sd22*(gmx*ciz-gmz*cix) - - astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz - & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy - & -riz*gx*cix) - & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) - & +gcr_z*(ripy*riy+ripx*rix)) - & -sd22*(-gmx*ciy+gmy*cix) -cc********************************************************************** -c - apmx(i)=(ciy*ripz-ripy*ciz)*d23 - & -(ciy*gmz-ciz*gmy)*d24 - apmy(i)=(ciz*ripx-ripz*cix)*d23 - & -(ciz*gmx-cix*gmz)*d24 - apmz(i)=(cix*ripy-ripx*ciy)*d23 - & -(cix*gmy-ciy*gmx)*d24 - - endif - enddo - - return - end -c END of angvectors -c------------------------------------------------------------------------------- -C--------------------------------------------------------------------------------- - subroutine sheetforce(nca,wshet) - implicit none -C JYLEE -c this should be matched with dfa.fcm - integer maxca - parameter(maxca=800) -cc********************************************************************** - integer nca - integer i,k - integer inb,nmax,iselect - -c real*8 dfaexp(15001) - - real*8 vbeta,vbetp,vbetm - real*8 shefx(maxca,12) - real*8 shefy(maxca,12),shefz(maxca,12) - real*8 shetfx(maxca),shetfy(maxca),shetfz(maxca) - real*8 vbet(maxca,maxca) - real*8 wshet(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - - common /sheca/ bx,by,bz - common /phys1/ inb,nmax,iselect - common /shef/ shefx,shefy,shefz - common /shee/ vbeta,vbet,vbetp,vbetm - common /shetf/ shetfx,shetfy,shetfz - - inb=nca - do i=1,inb - shetfx(i)=0.0D0 - shetfy(i)=0.0D0 - shetfz(i)=0.0D0 - enddo - - do k=1,12 - do i=1,inb - shefx(i,k)=0.0D0 - shefy(i,k)=0.0D0 - shefz(i,k)=0.0D0 - enddo - enddo - - call sheetene(nca,wshet) - call sheetforce1 - - 887 format(a,1x,i6,3x,f12.8) - 888 format(a,1x,i4,1x,i4,3x,f12.8) - 889 format(a,1x,i4,3x,f12.8) - !write(2,*) 'coord : ' - do i=1,inb - !write(2,887) 'bx:',i,bx(i) - !write(2,887) 'by:',i,by(i) - !write(2,887) 'bz:',i,bz(i) - enddo - !write(2,*) 'After sheetforce1' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce5 - - !write(2,*) 'After sheetforce5' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce6 - - !write(2,*) 'After sheetforce6' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce11 - - !write(2,*) 'After sheetforce11' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce12 - - !write(2,*) 'After sheetforce12' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - do i=1,inb - do k=1,12 - shetfx(i)=shetfx(i)+shefx(i,k) - shetfy(i)=shetfy(i)+shefy(i,k) - shetfz(i)=shetfz(i)+shefz(i,k) - enddo - enddo - !write(2,*) 'Beta Finished' - do i=1,inb - !write(2,889) 'shetfx : ',i,shetfx(i) - !write(2,889) 'shetfy : ',i,shetfy(i) - !write(2,889) 'shetfz : ',i,shetfz(i) - enddo - - return - end -C end sheetforce -c------------------------------------------------------------------------------- - subroutine sheetene(nca,wshet) - implicit none - integer maxca - parameter(maxca=800) -cc****************************************************************************** - -c real*8 dfaexp(15001) - real*8 dtmp1, dtmp2, dtmp3 - - real*8 vbet(maxca,maxca) - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 cph(maxca),cth(maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 ulcos(maxca) -cc********************************************************************** - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 wshet(maxca,maxca) - real*8 dp45, dm45, w_beta - real*8 c00, s00, ulnex, dnex, dca,dlhb,ulhb,dshe,dldhb,uldhb - integer nca - integer i,ip,ipp,j,jp,jpp,inb,nmax,iselect - real*8 uum, uup - real*8 vbeta,vbetp,vbetm,y,y1,y2,yshe1,yshe2,yy1,yy2 - - common /sheca/ bx,by,bz - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /coscos/ cph,cth - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shee/ vbeta,vbet,vbetp,vbetm - common /ulang/ ulcos -cc********************************************************************** - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - & astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth - - real*8 r_pair_mat(maxca,maxca) -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m - common /beta_p/ r_pair_mat -C------------------------------------------------------------------------------- - r_pair_mat = 0.0d0 - do i=1,inb - do j=1,inb - r_pair_mat(i,j)=wshet(i,j) -c write(*,*) 'r_pair_mat :',i,j,r_pair_mat(i,j) - enddo - enddo -c stop -c - vbeta=0.0D0 - vbetp=0.0D0 - vbetm=0.0D0 - - do i=1,inb-7 - do j=i+4,inb-3 - ip=i+1 - ipp=i+2 - jp=j+1 - jpp=j+2 -cc********************************************************************** - y1=(cth(i)*c00+sth(i)*s00-1.0D0)**2 - & +(cth(j)*c00+sth(j)*s00-1.0D0)**2 - y1=-0.5d0*y1/dca - y2=(ulcos(i)-ulnex)**2+(ulcos(ip)-ulnex)**2 - & +(ulcos(j)-ulnex)**2+(ulcos(jp)-ulnex)**2 - y2=-0.5d0*y2/dnex - -cdebug y2=0 - - y=y1+y2 - -ci if(y.ge.-4) then -ci istrand(i,j)=1 -ci else -ci istrand(i,j)=0 -ci endif - -ci if(istrand(i,j).eq.1) then - - yy1=-0.5d0*(dis(ip,jp)-ulhb)**2/dlhb - yy2=-0.5d0*(dis(ipp,jpp)-ulhb)**2/dlhb - - - pin1(i,j)=(rx(ip,jp)*rx(ip,ipp)+ry(ip,jp)*ry(ip,ipp) - $ +rz(ip,jp)*rz(ip,ipp))/(dis(ip,jp)*dis(ip,ipp)) - pin2(i,j)=(rx(ip,jp)*rx(jp,jpp)+ry(ip,jp)*ry(jp,jpp) - $ +rz(ip,jp)*rz(jp,jpp))/(dis(ip,jp)*dis(jp,jpp)) - pin3(i,j)=(rx(ipp,jpp)*rx(ip,ipp)+ry(ipp,jpp)*ry(ip,ipp) - $ +rz(ipp,jpp)*rz(ip,ipp))/(dis(ipp,jpp)*dis(ip,ipp)) - pin4(i,j)=(rx(ipp,jpp)*rx(jp,jpp)+ry(ipp,jpp)*ry(jp,jpp) - $ +rz(ipp,jpp)*rz(jp,jpp))/(dis(ipp,jpp)*dis(jp,jpp)) - - yshe1=pin1(i,j)**2+pin2(i,j)**2 - yshe1=-0.5d0*yshe1/dshe - yshe2=pin3(i,j)**2+pin4(i,j)**2 - yshe2=-0.5d0*yshe2/dshe - -ci if((yshe1+yshe2).ge.-4) then -ci istrand_p(i,j)=1 -ci else -ci istrand_p(i,j)=0 -ci endif - - -C write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) -C write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) -C write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) -C write(*,*) 'dis(i,j):',i,j,dis(i,j) -C write(*,*) 'rx(ip,jp):',ip,jp,bx(ip),bx(jp),rx(ip,jp) -C write(*,*) 'rx(ip,ipp):',ip,ipp,bx(ip),bx(ipp),rx(ip,ipp) -C write(*,*) 'pin1:',pin1(i,j) -C write(*,*) 'pin2:',pin2(i,j) -C write(*,*) 'pin3:',pin3(i,j) -C write(*,*) 'pin4:',pin4(i,j) - -C write(*,*) 'y:',y -C write(*,*) 'yy1:',yy1 -C write(*,*) 'yy2:',yy2 -C write(*,*) 'yshe1:',yshe1 -C write(*,*) 'yshe2:',yshe2 -c - -ci if (istrand_p(i,j).eq.1) then - -cd yy1=0 -cd yy2=0 -cd yshe1=0 -cd yshe2=0 - dtmp1 = y+yy1+yshe1 - dtmp2 = y+yy2+yshe2 - dtmp3 = y+yy1+yy2+yshe1+yshe2 - -C write(*,*)'1', i,j,dtmp1,dtmp2,dtmp3 -C write(*,*)'2', y,yy1,yy2 -C write(*,*)'3', yshe1,yshe2 - -cc if (dtmp3.le.-35.0d0) then -c vbetap(i,j)=-dp45*exp(dtmp3) -cc vbetap(i,j)=0.0d0 -cc else -c vbetap(i,j)=-dp45*dfaexp(idint(-dtmp3*1000)+1) - vbetap(i,j)=-dp45*exp(dtmp3) -cc end if - -cc if (dtmp1.le.-35.0d0) then -c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) -cc vbetap1(i,j)=0.0d0 -cc else -c vbetap1(i,j)=-r_pair_mat(i+1,j+1) -c $ *dfaexp(idint(-dtmp1*1000)+1) - vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) -cc end if - -cc if (dtmp2.le.-35.0d0) then -C vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) -cc vbetap2(i,j)=0.0d0 -cc else -c vbetap2(i,j)=-r_pair_mat(i+2,j+2) -c $ *dfaexp(idint(-dtmp2*1000)+1) - vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) -cc end if - -c vbetap(i,j)=-dp45*exp(y+yy1+yy2+yshe1+yshe2) -c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(y+yy1+yshe1) -c vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(y+yy2+yshe2) - -! write(*,*) 'r_pair_mat>',i+1,j+1,r_pair_mat(i+1,j+1) -! write(*,*) 'r_pair_mat>',i+2,j+2,r_pair_mat(i+2,j+2) - -ci elseif (istrand_p(i,j).eq.0)then -ci vbetap(i,j)=0 -ci vbetap1(i,j)=0 -ci vbetap2(i,j)=0 -ci endif - - yy1=-0.5d0*(dis(ip,jpp)-ulhb)**2/dlhb - yy2=-0.5d0*(dis(ipp,jp)-ulhb)**2/dlhb - - pina1(i,j)=(rx(ip,jpp)*rx(ip,ipp)+ry(ip,jpp)*ry(ip,ipp) - $ +rz(ip,jpp)*rz(ip,ipp))/(dis(ip,jpp)*dis(ip,ipp)) - pina2(i,j)=(rx(ip,jpp)*rx(jp,jpp)+ry(ip,jpp)*ry(jp,jpp) - $ +rz(ip,jpp)*rz(jp,jpp))/(dis(ip,jpp)*dis(jp,jpp)) - pina3(i,j)=(rx(jp,ipp)*rx(ip,ipp)+ry(jp,ipp)*ry(ip,ipp) - $ +rz(jp,ipp)*rz(ip,ipp))/(dis(jp,ipp)*dis(ip,ipp)) - pina4(i,j)=(rx(jp,ipp)*rx(jp,jpp)+ry(jp,ipp)*ry(jp,jpp) - $ +rz(jp,ipp)*rz(jp,jpp))/(dis(jp,ipp)*dis(jp,jpp)) - - yshe1=pina1(i,j)**2+pina2(i,j)**2 - yshe1=-0.5d0*yshe1/dshe - yshe2=pina3(i,j)**2+pina4(i,j)**2 - yshe2=-0.5d0*yshe2/dshe - -ci if((yshe1+yshe2).ge.-4) then -ci istrand_m(i,j)=1 -ci else -ci istrand_m(i,j)=0 -ci endif - - -C write(*,*) 'pina1:',pina1(i,j) -C write(*,*) 'pina2:',pina2(i,j) -C write(*,*) 'pina3:',pina3(i,j) -C write(*,*) 'pina4:',pina4(i,j) -C write(*,*) 'yshe1:',yshe1 -C write(*,*) 'yshe2:',yshe2 -C write(*,*) 'dshe:',dshe - -ci if (istrand_m(i,j).eq.1) then - -cd yy1=0 -cd yy2=0 -cd yshe1=0 -cd yshe2=0 - - dtmp3=y+yy1+yy2+yshe1+yshe2 - dtmp1=y+yy1+yshe1 - dtmp2=y+yy2+yshe2 - -cc if(dtmp3 .le. -35.0d0) then -c vbetam(i,j)=-dm45*exp(dtmp3) -cc vbetam(i,j)=0.0d0 -cc else -c vbetam(i,j)=-dm45*dfaexp(idint(-dtmp3*1000)+1) - vbetam(i,j)=-dm45*exp(dtmp3) -cc end if - -cc if(dtmp1 .le. -35.0d0) then -c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) -cc vbetam1(i,j)=0.0d0 -cc else -c vbetam1(i,j)=-r_pair_mat(i+1,j+2) -c $ *dfaexp(idint(-dtmp1*1000)+1) - vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) -cc end if - -cc if(dtmp2.le.-35.0d0) then -c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) -cc vbetam2(i,j)=0.0d0 -cc else -c vbetam2(i,j)=-r_pair_mat(i+2,j+1) -c $ *dfaexp(idint(-dtmp2*1000)+1) - vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) -cc end if - -ci elseif (istrand_m(i,j).eq.0)then -ci vbetam(i,j)=0 -ci vbetam1(i,j)=0 -ci vbetam2(i,j)=0 -ci endif - - -c vbetam(i,j)=-dm45*exp(y+yy1+yy2+yshe1+yshe2) -c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(y+yy1+yshe1) -c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(y+yy2+yshe2) - -! write(*,*) 'r_pair_mat>',i+1,j+2,r_pair_mat(i+1,j+2) -! write(*,*) 'r_pair_mat>',i+2,j+1,r_pair_mat(i+2,j+1) - - uup = vbetap(i,j)+vbetap1(i,j)+vbetap2(i,j) - uum = vbetam(i,j)+vbetam1(i,j)+vbetam2(i,j) - -c write(*,*) 'uup,uum:', uup, uum - -c uup=vbetap1(i,j)+vbetap2(i,j) -c uum=vbetam1(i,j)+vbetam2(i,j) - - vbet(i,j)=uup+uum - vbetp=vbetp+uup - vbetm=vbetm+uum - vbeta=vbeta+vbet(i,j) - -ci elseif(istrand(i,j).eq.0)then -ci vbet(i,j)=0 -ci endif - -c write(*,*) 'uup,uum:',uup,uum -c write(*,*) 'vbetap(i,j):',vbetap(i,j) -c write(*,*) 'vbetap1(i,j):',vbetap1(i,j) -c write(*,*) 'vbetap2(i,j):',vbetap2(i,j) -c write(*,*) 'vbetam(i,j):',vbetam(i,j) -c write(*,*) 'vbetam1(i,j):',vbetam1(i,j) -c write(*,*) 'vbetam2(i,j):',vbetam2(i,j) -c write(*,*) 'uup:',uup -c write(*,*) 'uum:',uum -c write(*,*) 'vbetp:',vbetp -c write(*,*) 'vbetm:',vbetm -c write(*,*) 'vbet(i,j):',vbet(i,j) -c stop - - enddo - enddo - -! do i=1,inb-7 -! do j=i+4,inb-3 -! write(*,*) 'I,J:', i,j -! write(*,*) 'vbetap(i,j):',vbetap(i,j) -! write(*,*) 'vbetap1(i,j):',vbetap1(i,j) -! write(*,*) 'vbetap2(i,j):',vbetap2(i,j) -! write(*,*) 'vbetam(i,j):',vbetam(i,j) -! write(*,*) 'vbetam1(i,j):',vbetam1(i,j) -! write(*,*) 'vbetam2(i,j):',vbetam2(i,j) -! write(*,*) 'vbet(i,j):',vbet(i,j) -! enddo -! enddo - - return - end -c------------------------------------------------------------------------------- - subroutine sheetforce1 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbet(maxca,maxca) - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 cph(maxca),cth(maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12) - real*8 shefy(maxca,12),shefz(maxca,12) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 apx(maxca),apy(maxca),apz(maxca) - real*8 apmx(maxca),apmy(maxca),apmz(maxca) - real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) - real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) - real*8 ulcos(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 w_beta,dp45, dm45 - real*8 vbeta, vbetp, vbetm - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect - - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /coscos/ cph,cth - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - $ atmmz,atm3x,atm3y,atm3z - common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, - $ apmmz,apm3x,apm3y,apm3z - common /shef/ shefx,shefy,shefz - common /shee/ vbeta,vbet,vbetp,vbetm - common /ulang/ ulcos -c c********************************************************************** - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - $ astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth -C-------------------------------------------------------------------------------- -c local variables - integer i,j,im3,imm,im,ip,ipp,jm,jmm,jm3,jp,jpp - real*8 c1,v1,cc1,dmm,dmm__,fx,fy,fz,c2,v2,dmm1 - real*8 c3,v3,cc2,cc3,dmm3,dmm3__,c4,v4,c7,v7,cc7,c8,v8,cc8 - real*8 c9,v9,cc9,dmm9,dmm9__,c10,v10,dmm2,dmm1__,dmm2_1,dmm2_2 - real*8 dmm7,dmm8,dmm7__,dmm8_1,dmm8_2 -C-------------------------------------------------------------------------------- - do i=4,inb-4 - im3=i-3 - imm=i-2 - im=i-1 - c1=(cth(im3)*c00+sth(im3)*s00-1)/dca - v1=0.0D0 - do j=i+1,inb-3 - v1=v1+vbet(im3,j) - enddo - cc1=(ulcos(imm)-ulnex)/dnex - dmm=cc1/(dis(imm,im)*dis(im,i)) - dmm__=cc1*ulcos(imm)/dis(im,i)**2 - fx=rx(imm,im)*dmm-rx(im,i)*dmm__ - fy=ry(imm,im)*dmm-ry(im,i)*dmm__ - fz=rz(imm,im)*dmm-rz(im,i)*dmm__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atm3x(i)*c00+astm3x(i)*s00)*c1 - fy=fy+(atm3y(i)*c00+astm3y(i)*s00)*c1 - fz=fz+(atm3z(i)*c00+astm3z(i)*s00)*c1 - shefx(i,1)=fx*v1 - shefy(i,1)=fy*v1 - shefz(i,1)=fz*v1 - enddo - - do i=3,inb-5 - imm=i-2 - im=i-1 - ip=i+1 - c2=(cth(imm)*c00+sth(imm)*s00-1)/dca - v2=0.0D0 - do j=i+2,inb-3 - v2=v2+vbet(imm,j) - enddo - cc1=(ulcos(imm)-ulnex)/dnex - cc2=(ulcos(im)-ulnex)/dnex - dmm1=cc1/(dis(imm,im)*dis(im,i)) - dmm2=cc2/(dis(im,i)*dis(i,ip)) - dmm1__=cc1*ulcos(imm)/dis(im,i)**2 - dmm2_1=cc2*ulcos(im)/dis(im,i)**2 - dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 -cc********************************************************************** - fx=rx(imm,im)*dmm1-rx(im,i)*dmm1__+rx(i,ip)*dmm2-rx(im,i)*dmm2 - $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2 - fy=ry(imm,im)*dmm1-ry(im,i)*dmm1__+ry(i,ip)*dmm2-ry(im,i)*dmm2 - $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2 - fz=rz(imm,im)*dmm1-rz(im,i)*dmm1__+rz(i,ip)*dmm2-rz(im,i)*dmm2 - $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2 -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmmx(i)*c00+astmmx(i)*s00)*c2 - fy=fy+(atmmy(i)*c00+astmmy(i)*s00)*c2 - fz=fz+(atmmz(i)*c00+astmmz(i)*s00)*c2 - shefx(i,2)=fx*v2 - shefy(i,2)=fy*v2 - shefz(i,2)=fz*v2 - enddo - do i=2,inb-6 - im=i-1 - ip=i+1 - ipp=i+2 - c3=(cth(im)*c00+sth(im)*s00-1)/dca - v3=0.0D0 - do j=i+3,inb-3 - v3=v3+vbet(im,j) - enddo - cc2=(ulcos(im)-ulnex)/dnex - cc3=(ulcos(i)-ulnex)/dnex - dmm2=cc2/(dis(im,i)*dis(i,ip)) - dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) - dmm2_1=cc2*ulcos(im)/dis(im,i)**2 - dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 - dmm3__=cc3*ulcos(i)/dis(i,ip)**2 - fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm2-rx(im,i)*dmm2 - $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2+rx(i,ip)*dmm3__ - fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm2-ry(im,i)*dmm2 - $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2+ry(i,ip)*dmm3__ - fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm2-rz(im,i)*dmm2 - $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2+rz(i,ip)*dmm3__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmx(i)*c00+astmx(i)*s00)*c3 - fy=fy+(atmy(i)*c00+astmy(i)*s00)*c3 - fz=fz+(atmz(i)*c00+astmz(i)*s00)*c3 - shefx(i,3)=fx*v3 - shefy(i,3)=fy*v3 - shefz(i,3)=fz*v3 - enddo - do i=1,inb-7 - ip=i+1 - ipp=i+2 - c4=(cth(i)*c00+sth(i)*s00-1)/dca - v4=0.0D0 - do j=i+4,inb-3 - v4=v4+vbet(i,j) - enddo - cc3=(ulcos(i)-ulnex)/dnex - dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) - dmm3__=cc3*ulcos(i)/dis(i,ip)**2 - fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm3__ - fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm3__ - fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm3__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atx(i)*c00+astx(i)*s00)*c4 - fy=fy+(aty(i)*c00+asty(i)*s00)*c4 - fz=fz+(atz(i)*c00+astz(i)*s00)*c4 - shefx(i,4)=fx*v4 - shefy(i,4)=fy*v4 - shefz(i,4)=fz*v4 - enddo - do j=8,inb - jm3=j-3 - jmm=j-2 - jm=j-1 - c7=(cth(jm3)*c00+sth(jm3)*s00-1)/dca - v7=0.0D0 - do i=1,j-7 - v7=v7+vbet(i,jm3) - enddo - cc7=(ulcos(jmm)-ulnex)/dnex - dmm=cc7/(dis(jmm,jm)*dis(jm,j)) - dmm__=cc7*ulcos(jmm)/dis(jm,j)**2 - fx=rx(jmm,jm)*dmm-rx(jm,j)*dmm__ - fy=ry(jmm,jm)*dmm-ry(jm,j)*dmm__ - fz=rz(jmm,jm)*dmm-rz(jm,j)*dmm__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atm3x(j)*c00+astm3x(j)*s00)*c7 - fy=fy+(atm3y(j)*c00+astm3y(j)*s00)*c7 - fz=fz+(atm3z(j)*c00+astm3z(j)*s00)*c7 - shefx(j,7)=fx*v7 - shefy(j,7)=fy*v7 - shefz(j,7)=fz*v7 - enddo - do j=7,inb-1 - jm=j-1 - jmm=j-2 - jp=j+1 - c8=(cth(jmm)*c00+sth(jmm)*s00-1)/dca - v8=0.0D0 - do i=1,j-6 - v8=v8+vbet(i,jmm) - enddo - cc7=(ulcos(jmm)-ulnex)/dnex - cc8=(ulcos(jm)-ulnex)/dnex - dmm7=cc7/(dis(jmm,jm)*dis(jm,j)) - dmm8=cc8/(dis(jm,j)*dis(j,jp)) - dmm7__=cc7*ulcos(jmm)/dis(jm,j)**2 - dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 - dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 - fx=rx(jmm,jm)*dmm7+rx(j,jp)*dmm8-rx(jm,j)*dmm8 - $ -rx(jm,j)*dmm7__-rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2 - fy=ry(jmm,jm)*dmm7+ry(j,jp)*dmm8-ry(jm,j)*dmm8 - $ -ry(jm,j)*dmm7__-ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2 - fz=rz(jmm,jm)*dmm7+rz(j,jp)*dmm8-rz(jm,j)*dmm8 - $ -rz(jm,j)*dmm7__-rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2 -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmmx(j)*c00+astmmx(j)*s00)*c8 - fy=fy+(atmmy(j)*c00+astmmy(j)*s00)*c8 - fz=fz+(atmmz(j)*c00+astmmz(j)*s00)*c8 - shefx(j,8)=fx*v8 - shefy(j,8)=fy*v8 - shefz(j,8)=fz*v8 - enddo - - do j=6,inb-2 - jm=j-1 - jp=j+1 - jpp=j+2 - c9=(cth(jm)*c00+sth(jm)*s00-1)/dca - v9=0.0D0 - do i=1,j-5 - v9=v9+vbet(i,jm) - enddo - cc8=(ulcos(jm)-ulnex)/dnex - cc9=(ulcos(j)-ulnex)/dnex - dmm8=cc8/(dis(jm,j)*dis(j,jp)) - dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) - dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 - dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 - dmm9__=cc9*ulcos(j)/dis(j,jp)**2 - fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm8-rx(jm,j)*dmm8 - $ -rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2+rx(j,jp)*dmm9__ - fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm8-ry(jm,j)*dmm8 - $ -ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2+ry(j,jp)*dmm9__ - fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm8-rz(jm,j)*dmm8 - $ -rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2+rz(j,jp)*dmm9__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmx(j)*c00+astmx(j)*s00)*c9 - fy=fy+(atmy(j)*c00+astmy(j)*s00)*c9 - fz=fz+(atmz(j)*c00+astmz(j)*s00)*c9 - shefx(j,9)=fx*v9 - shefy(j,9)=fy*v9 - shefz(j,9)=fz*v9 - enddo - - do j=5,inb-3 - jp=j+1 - jpp=j+2 - c10=(cth(j)*c00+sth(j)*s00-1)/dca - v10=0.0D0 - do i=1,j-4 - v10=v10+vbet(i,j) - enddo - cc9=(ulcos(j)-ulnex)/dnex - dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) - dmm9__=cc9*ulcos(j)/dis(j,jp)**2 - fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm9__ - fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm9__ - fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm9__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atx(j)*c00+astx(j)*s00)*c10 - fy=fy+(aty(j)*c00+asty(j)*s00)*c10 - fz=fz+(atz(j)*c00+astz(j)*s00)*c10 - shefx(j,10)=fx*v10 - shefy(j,10)=fy*v10 - shefz(j,10)=fz*v10 - enddo - - return - end -c---------------------------------------------------------------------------- - subroutine sheetforce5 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -c******************************************************************************** -c local variables - integer i,imm,im,jp,jpp,j - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z - real*8 y66x,y66y,y66z,yy6,yyy4,yyy5a,yyy5b - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b -c******************************************************************************** - do i=3,inb-5 - imm=i-2 - im=i-1 - do j=i+2,inb-3 - jp=j+1 - jpp=j+2 - -ci if(istrand(imm,j).eq.1 -ci & .and.(istrand_p(imm,j)+istrand_m(imm,j)).ge.1) then - - - yy1=-(dis(i,jpp)-ulhb)/dlhb - y1x=rx(jpp,i)/dis(i,jpp) - y1y=ry(jpp,i)/dis(i,jpp) - y1z=rz(jpp,i)/dis(i,jpp) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(im,jp)*dis(im,i)) - yyy3=pin1(imm,j)/(dis(im,i)**2) - yy3=-pin1(imm,j)/dshe - y3x=(yy33*rx(im,jp)-yyy3*rx(im,i))*yy3 - y3y=(yy33*ry(im,jp)-yyy3*ry(im,i))*yy3 - y3z=(yy33*rz(im,jp)-yyy3*rz(im,i))*yy3 - - yy44=1.0D0/(dis(i,jpp)*dis(im,i)) - yyy4a=pin3(imm,j)/(dis(i,jpp)**2) - yyy4b=pin3(imm,j)/(dis(im,i)**2) - yy4=-pin3(imm,j)/dshe - y4x=(yy44*(rx(i,jpp)-rx(im,i))+yyy4a*rx(i,jpp) - $ -yyy4b*rx(im,i))*yy4 - y4y=(yy44*(ry(i,jpp)-ry(im,i))+yyy4a*ry(i,jpp) - $ -yyy4b*ry(im,i))*yy4 - y4z=(yy44*(rz(i,jpp)-rz(im,i))+yyy4a*rz(i,jpp) - $ -yyy4b*rz(im,i))*yy4 - - - yy55=1.0D0/(dis(i,jpp)*dis(jp,jpp)) - yyy5=pin4(imm,j)/(dis(i,jpp)**2) - yy5=-pin4(imm,j)/dshe - y5x=(-yy55*rx(jp,jpp)+yyy5*rx(i,jpp))*yy5 - y5y=(-yy55*ry(jp,jpp)+yyy5*ry(i,jpp))*yy5 - y5z=(-yy55*rz(jp,jpp)+yyy5*rz(i,jpp))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y3x - sy1=y3y - sz1=y3z - sx2=y11x+y4x+y5x - sy2=y11y+y4y+y5y - sz2=y11z+y4z+y5z - - shefx(i,5)=shefx(i,5)-sx*vbetap(imm,j) - $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) - shefy(i,5)=shefy(i,5)-sy*vbetap(imm,j) - $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) - shefz(i,5)=shefz(i,5)-sz*vbetap(imm,j) - $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) - -! shefx(i,5)=shefx(i,5) -! $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) -! shefy(i,5)=shefy(i,5) -! $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) -! shefz(i,5)=shefz(i,5) -! $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) - - yy6=-(dis(i,jp)-uldhb)/dldhb - y6x=rx(jp,i)/dis(i,jp) - y6y=ry(jp,i)/dis(i,jp) - y6z=rz(jp,i)/dis(i,jp) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(im,jpp)*dis(im,i)) - yyy8=pina1(imm,j)/(dis(im,i)**2) - yy8=-pina1(imm,j)/dshe - y8x=(yy88*rx(im,jpp)-yyy8*rx(im,i))*yy8 - y8y=(yy88*ry(im,jpp)-yyy8*ry(im,i))*yy8 - y8z=(yy88*rz(im,jpp)-yyy8*rz(im,i))*yy8 - - yy99=1.0D0/(dis(jp,i)*dis(im,i)) - yyy9a=pina3(imm,j)/(dis(jp,i)**2) - yyy9b=pina3(imm,j)/(dis(im,i)**2) - yy9=-pina3(imm,j)/dshe - y9x=(yy99*(rx(jp,i)+rx(im,i))-yyy9a*rx(jp,i) - $ -yyy9b*rx(im,i))*yy9 - y9y=(yy99*(ry(jp,i)+ry(im,i))-yyy9a*ry(jp,i) - $ -yyy9b*ry(im,i))*yy9 - y9z=(yy99*(rz(jp,i)+rz(im,i))-yyy9a*rz(jp,i) - $ -yyy9b*rz(im,i))*yy9 - - yy1010=1.0D0/(dis(jp,i)*dis(jp,jpp)) - yyy10=pina4(imm,j)/(dis(jp,i)**2) - yy10=-pina4(imm,j)/dshe - y10x=(yy1010*rx(jp,jpp)-yyy10*rx(jp,i))*yy10 - y10y=(yy1010*ry(jp,jpp)-yyy10*ry(jp,i))*yy10 - y10z=(yy1010*rz(jp,jpp)-yyy10*rz(jp,i))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y8x - sy1=y8y - sz1=y8z - sx2=y66x+y9x+y10x - sy2=y66y+y9y+y10y - sz2=y66z+y9z+y10z - - shefx(i,5)=shefx(i,5)-sx*vbetam(imm,j) - $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) - shefy(i,5)=shefy(i,5)-sy*vbetam(imm,j) - $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) - shefz(i,5)=shefz(i,5)-sz*vbetam(imm,j) - $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) - -! shefx(i,5)=shefx(i,5) -! $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) -! shefy(i,5)=shefy(i,5) -! $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) -! shefz(i,5)=shefz(i,5) -! $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) - -ci endif - - enddo - enddo - - return - end -c--------------------------------------------------------------------------c - subroutine sheetforce6 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -cc********************************************************************** -C local variables - integer i,imm,im,jp,jpp,j,ip - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b,yyy4 - real*8 yyy3a,yyy3b,y66z,yy6,yyy5a,yyy5b -C******************************************************************************** - do i=2,inb-6 - ip=i+1 - im=i-1 - do j=i+3,inb-3 - jp=j+1 - jpp=j+2 - -ci if(istrand(im,j).eq.1 -ci & .and.(istrand_p(im,j)+istrand_m(im,j)).ge.1) then - - - yy1=-(dis(i,jp)-ulhb)/dlhb - y1x=rx(jp,i)/dis(i,jp) - y1y=ry(jp,i)/dis(i,jp) - y1z=rz(jp,i)/dis(i,jp) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(i,jp)*dis(i,ip)) - yyy3a=pin1(im,j)/(dis(i,jp)**2) - yyy3b=pin1(im,j)/(dis(i,ip)**2) - yy3=-pin1(im,j)/dshe - y3x=(-yy33*(rx(i,ip)+rx(i,jp))+yyy3a*rx(i,jp) - $ +yyy3b*rx(i,ip))*yy3 - y3y=(-yy33*(ry(i,ip)+ry(i,jp))+yyy3a*ry(i,jp) - $ +yyy3b*ry(i,ip))*yy3 - y3z=(-yy33*(rz(i,ip)+rz(i,jp))+yyy3a*rz(i,jp) - $ +yyy3b*rz(i,ip))*yy3 - - yy44=1.0D0/(dis(i,jp)*dis(jp,jpp)) - yyy4=pin2(im,j)/(dis(i,jp)**2) - yy4=-pin2(im,j)/dshe - y4x=(-yy44*rx(jp,jpp)+yyy4*rx(i,jp))*yy4 - y4y=(-yy44*ry(jp,jpp)+yyy4*ry(i,jp))*yy4 - y4z=(-yy44*rz(jp,jpp)+yyy4*rz(i,jp))*yy4 - - yy55=1.0D0/(dis(ip,jpp)*dis(i,ip)) - yyy5=pin3(im,j)/(dis(i,ip)**2) - yy5=-pin3(im,j)/dshe - y5x=(-yy55*rx(ip,jpp)+yyy5*rx(i,ip))*yy5 - y5y=(-yy55*ry(ip,jpp)+yyy5*ry(i,ip))*yy5 - y5z=(-yy55*rz(ip,jpp)+yyy5*rz(i,ip))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y11x+y3x+y4x - sy1=y11y+y3y+y4y - sz1=y11z+y3z+y4z - sx2=y5x - sy2=y5y - sz2=y5z - - shefx(i,6)=shefx(i,6)-sx*vbetap(im,j) - $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) - shefy(i,6)=shefy(i,6)-sy*vbetap(im,j) - $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) - shefz(i,6)=shefz(i,6)-sz*vbetap(im,j) - $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) -! shefx(i,6)=shefx(i,6) -! $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) -! shefy(i,6)=shefy(i,6) -! $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) -! shefz(i,6)=shefz(i,6) -! $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) - - yy6=-(dis(jpp,i)-uldhb)/dldhb - y6x=rx(jpp,i)/dis(jpp,i) - y6y=ry(jpp,i)/dis(jpp,i) - y6z=rz(jpp,i)/dis(jpp,i) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(i,jpp)*dis(i,ip)) - yyy8a=pina1(im,j)/(dis(i,jpp)**2) - yyy8b=pina1(im,j)/(dis(i,ip)**2) - yy8=-pina1(im,j)/dshe - y8x=(-yy88*(rx(i,jpp)+rx(i,ip))+yyy8a*rx(i,jpp) - $ +yyy8b*rx(i,ip))*yy8 - y8y=(-yy88*(ry(i,jpp)+ry(i,ip))+yyy8a*ry(i,jpp) - $ +yyy8b*ry(i,ip))*yy8 - y8z=(-yy88*(rz(i,jpp)+rz(i,ip))+yyy8a*rz(i,jpp) - $ +yyy8b*rz(i,ip))*yy8 - - yy99=1.0D0/(dis(i,jpp)*dis(jp,jpp)) - yyy9=pina2(im,j)/(dis(i,jpp)**2) - yy9=-pina2(im,j)/dshe - y9x=(-yy99*rx(jp,jpp)+yyy9*rx(i,jpp))*yy9 - y9y=(-yy99*ry(jp,jpp)+yyy9*ry(i,jpp))*yy9 - y9z=(-yy99*rz(jp,jpp)+yyy9*rz(i,jpp))*yy9 - - yy1010=1.0D0/(dis(jp,ip)*dis(i,ip)) - yyy10=pina3(im,j)/(dis(i,ip)**2) - yy10=-pina3(im,j)/dshe - y10x=(-yy1010*rx(jp,ip)+yyy10*rx(i,ip))*yy10 - y10y=(-yy1010*ry(jp,ip)+yyy10*ry(i,ip))*yy10 - y10z=(-yy1010*rz(jp,ip)+yyy10*rz(i,ip))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y66x+y8x+y9x - sy1=y66y+y8y+y9y - sz1=y66z+y8z+y9z - sx2=y10x - sy2=y10y - sz2=y10z - - shefx(i,6)=shefx(i,6)-sx*vbetam(im,j) - $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) - shefy(i,6)=shefy(i,6)-sy*vbetam(im,j) - $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) - shefz(i,6)=shefz(i,6)-sz*vbetam(im,j) - $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) - -! shefx(i,6)=shefx(i,6) -! $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) -! shefy(i,6)=shefy(i,6) -! $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) -! shefz(i,6)=shefz(i,6) -! $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) - -ci endif - - enddo - enddo - - return - end -c----------------------------------------------------------------------- - subroutine sheetforce11 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -C******************************************************************************** -C local variables - integer j,jm,jmm,ip,i,ipp - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy4,yyy5a,yyy5b,yy6 - real*8 yyy9a,yyy9b,y5z,y66z,y9z,yyy8 -C******************************************************************************** - - do j=7,inb-1 - jm=j-1 - jmm=j-2 - do i=1,j-6 - ip=i+1 - ipp=i+2 - -ci if(istrand(i,jmm).eq.1 -ci & .and.(istrand_p(i,jmm)+istrand_m(i,jmm)).ge.1) then - - - yy1=-(dis(ipp,j)-ulhb)/dlhb - y1x=rx(ipp,j)/dis(ipp,j) - y1y=ry(ipp,j)/dis(ipp,j) - y1z=rz(ipp,j)/dis(ipp,j) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(ip,jm)*dis(jm,j)) - yyy3=pin2(i,jmm)/(dis(jm,j)**2) - yy3=-pin2(i,jmm)/dshe - y3x=(yy33*rx(ip,jm)-yyy3*rx(jm,j))*yy3 - y3y=(yy33*ry(ip,jm)-yyy3*ry(jm,j))*yy3 - y3z=(yy33*rz(ip,jm)-yyy3*rz(jm,j))*yy3 - - yy44=1.0D0/(dis(ipp,j)*dis(ip,ipp)) - yyy4=pin3(i,jmm)/(dis(ipp,j)**2) - yy4=-pin3(i,jmm)/dshe - y4x=(yy44*rx(ip,ipp)-yyy4*rx(ipp,j))*yy4 - y4y=(yy44*ry(ip,ipp)-yyy4*ry(ipp,j))*yy4 - y4z=(yy44*rz(ip,ipp)-yyy4*rz(ipp,j))*yy4 - - yy55=1.0D0/(dis(ipp,j)*dis(jm,j)) - yyy5a=pin4(i,jmm)/(dis(ipp,j)**2) - yyy5b=pin4(i,jmm)/(dis(jm,j)**2) - yy5=-pin4(i,jmm)/dshe - y5x=(yy55*(rx(jm,j)+rx(ipp,j))-yyy5a*rx(ipp,j) - $ -yyy5b*rx(jm,j))*yy5 - y5y=(yy55*(ry(jm,j)+ry(ipp,j))-yyy5a*ry(ipp,j) - $ -yyy5b*ry(jm,j))*yy5 - y5z=(yy55*(rz(jm,j)+rz(ipp,j))-yyy5a*rz(ipp,j) - $ -yyy5b*rz(jm,j))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y3x - sy1=y3y - sz1=y3z - sx2=y11x+y4x+y5x - sy2=y11y+y4y+y5y - sz2=y11z+y4z+y5z - - shefx(j,11)=shefx(j,11)-sx*vbetap(i,jmm) - $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) - shefy(j,11)=shefy(j,11)-sy*vbetap(i,jmm) - $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) - shefz(j,11)=shefz(j,11)-sz*vbetap(i,jmm) - $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) - -! shefx(j,11)=shefx(j,11) -! $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) -! shefy(j,11)=shefy(j,11) -! $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) -! shefz(j,11)=shefz(j,11) -! $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) - - yy6=-(dis(ip,j)-uldhb)/dldhb - y6x=rx(ip,j)/dis(ip,j) - y6y=ry(ip,j)/dis(ip,j) - y6z=rz(ip,j)/dis(ip,j) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(ip,j)*dis(ip,ipp)) - yyy8=pina1(i,jmm)/(dis(ip,j)**2) - yy8=-pina1(i,jmm)/dshe - y8x=(yy88*rx(ip,ipp)-yyy8*rx(ip,j))*yy8 - y8y=(yy88*ry(ip,ipp)-yyy8*ry(ip,j))*yy8 - y8z=(yy88*rz(ip,ipp)-yyy8*rz(ip,j))*yy8 - - yy99=1.0D0/(dis(ip,j)*dis(jm,j)) - yyy9a=pina2(i,jmm)/(dis(ip,j)**2) - yyy9b=pina2(i,jmm)/(dis(jm,j)**2) - yy9=-pina2(i,jmm)/dshe - y9x=(yy99*(rx(jm,j)+rx(ip,j))-yyy9a*rx(ip,j) - $ -yyy9b*rx(jm,j))*yy9 - y9y=(yy99*(ry(jm,j)+ry(ip,j))-yyy9a*ry(ip,j) - $ -yyy9b*ry(jm,j))*yy9 - y9z=(yy99*(rz(jm,j)+rz(ip,j))-yyy9a*rz(ip,j) - $ -yyy9b*rz(jm,j))*yy9 - - yy1010=1.0D0/(dis(jm,ipp)*dis(jm,j)) - yyy10=pina4(i,jmm)/(dis(jm,j)**2) - yy10=-pina4(i,jmm)/dshe - y10x=(yy1010*rx(jm,ipp)-yyy10*rx(jm,j))*yy10 - y10y=(yy1010*ry(jm,ipp)-yyy10*ry(jm,j))*yy10 - y10z=(yy1010*rz(jm,ipp)-yyy10*rz(jm,j))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y66x+y8x+y9x - sy1=y66y+y8y+y9y - sz1=y66z+y8z+y9z - sx2=y10x - sy2=y10y - sz2=y10z - - shefx(j,11)=shefx(j,11)-sx*vbetam(i,jmm) - $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) - shefy(j,11)=shefy(j,11)-sy*vbetam(i,jmm) - $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) - shefz(j,11)=shefz(j,11)-sz*vbetam(i,jmm) - $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) - -! shefx(j,11)=shefx(j,11) -! $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) -! shefy(j,11)=shefy(j,11) -! $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) -! shefz(j,11)=shefz(j,11) -! $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) - -ci endif - - enddo - enddo - - return - end -c----------------------------------------------------------------------- - subroutine sheetforce12 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -cc********************************************************************** -C local variables - integer j,jm,jmm,ip,i,ipp,jp - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y,y66z - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy10a,yyy10b,yy6,yyy8 -!c*************************************************************************c - do j=6,inb-2 - jp=j+1 - jm=j-1 - do i=1,j-5 - ip=i+1 - ipp=i+2 - -ci if(istrand(i,jm).eq.1 -ci & .and.(istrand_p(i,jm)+istrand_m(i,jm)).ge.1) then - - - yy1=-(dis(ip,j)-ulhb)/dlhb - y1x=rx(ip,j)/dis(ip,j) - y1y=ry(ip,j)/dis(ip,j) - y1z=rz(ip,j)/dis(ip,j) - y11x=y1x*yy1 - y11y=y1y*yy1 - y11z=y1z*yy1 - - yy33=1.0D0/(dis(ip,j)*dis(ip,ipp)) - yyy3=pin1(i,jm)/(dis(ip,j)**2) - yy3=-pin1(i,jm)/dshe - y3x=(yy33*rx(ip,ipp)-yyy3*rx(ip,j))*yy3 - y3y=(yy33*ry(ip,ipp)-yyy3*ry(ip,j))*yy3 - y3z=(yy33*rz(ip,ipp)-yyy3*rz(ip,j))*yy3 - yy44=1.0D0/(dis(ip,j)*dis(j,jp)) - - yyy4a=pin2(i,jm)/(dis(ip,j)**2) - yyy4b=pin2(i,jm)/(dis(j,jp)**2) - yy4=-pin2(i,jm)/dshe - y4x=(yy44*(rx(j,jp)-rx(ip,j))-yyy4a*rx(ip,j) - $ +yyy4b*rx(j,jp))*yy4 - y4y=(yy44*(ry(j,jp)-ry(ip,j))-yyy4a*ry(ip,j) - $ +yyy4b*ry(j,jp))*yy4 - y4z=(yy44*(rz(j,jp)-rz(ip,j))-yyy4a*rz(ip,j) - $ +yyy4b*rz(j,jp))*yy4 - - yy55=1.0D0/(dis(ipp,jp)*dis(j,jp)) - yyy5=pin4(i,jm)/(dis(j,jp)**2) - yy5=-pin4(i,jm)/dshe - y5x=(-yy55*rx(ipp,jp)+yyy5*rx(j,jp))*yy5 - y5y=(-yy55*ry(ipp,jp)+yyy5*ry(j,jp))*yy5 - y5z=(-yy55*rz(ipp,jp)+yyy5*rz(j,jp))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y11x+y3x+y4x - sy1=y11y+y3y+y4y - sz1=y11z+y3z+y4z - sx2=y5x - sy2=y5y - sz2=y5z - - shefx(j,12)=shefx(j,12)-sx*vbetap(i,jm) - $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) - shefy(j,12)=shefy(j,12)-sy*vbetap(i,jm) - $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) - shefz(j,12)=shefz(j,12)-sz*vbetap(i,jm) - $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) - -! shefx(j,12)=shefx(j,12) -! $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) -! shefy(j,12)=shefy(j,12) -! $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) -! shefz(j,12)=shefz(j,12) -! $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) - - yy6=-(dis(ipp,j)-uldhb)/dldhb - y6x=rx(ipp,j)/dis(ipp,j) - y6y=ry(ipp,j)/dis(ipp,j) - y6z=rz(ipp,j)/dis(ipp,j) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(ip,jp)*dis(j,jp)) - yyy8=pina2(i,jm)/(dis(j,jp)**2) - yy8=-pina2(i,jm)/dshe - y8x=(-yy88*rx(ip,jp)+yyy8*rx(j,jp))*yy8 - y8y=(-yy88*ry(ip,jp)+yyy8*ry(j,jp))*yy8 - y8z=(-yy88*rz(ip,jp)+yyy8*rz(j,jp))*yy8 - - yy99=1.0D0/(dis(j,ipp)*dis(ip,ipp)) - yyy9=pina3(i,jm)/(dis(j,ipp)**2) - yy9=-pina3(i,jm)/dshe - y9x=(-yy99*rx(ip,ipp)+yyy9*rx(j,ipp))*yy9 - y9y=(-yy99*ry(ip,ipp)+yyy9*ry(j,ipp))*yy9 - y9z=(-yy99*rz(ip,ipp)+yyy9*rz(j,ipp))*yy9 - - yy1010=1.0D0/(dis(j,ipp)*dis(j,jp)) - yyy10a=pina4(i,jm)/(dis(j,ipp)**2) - yyy10b=pina4(i,jm)/(dis(j,jp)**2) - yy10=-pina4(i,jm)/dshe - y10x=(-yy1010*(rx(j,ipp)+rx(j,jp))+yyy10a*rx(j,ipp) - $ +yyy10b*rx(j,jp))*yy10 - y10y=(-yy1010*(ry(j,ipp)+ry(j,jp))+yyy10a*ry(j,ipp) - $ +yyy10b*ry(j,jp))*yy10 - y10z=(-yy1010*(rz(j,ipp)+rz(j,jp))+yyy10a*rz(j,ipp) - $ +yyy10b*rz(j,jp))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y8x - sy1=y8y - sz1=y8z - sx2=y66x+y9x+y10x - sy2=y66y+y9y+y10y - sz2=y66z+y9z+y10z - - shefx(j,12)=shefx(j,12)-sx*vbetam(i,jm) - $ -sx1*vbetam1(i,jm)-sx2*vbetam2(i,jm) - shefy(j,12)=shefy(j,12)-sy*vbetam(i,jm) - $ -sy1*vbetam1(i,jm)-sy2*vbetam2(i,jm) - shefz(j,12)=shefz(j,12)-sz*vbetam(i,jm) - $ -sz1*vbetam1(i,jm)-sz2*vbetam2(i,jm) - -ci endif - - ENDDO - ENDDO - - RETURN - END -C=============================================================================== diff --git a/source/unres/src_CSA_DiL/diff12.f b/source/unres/src_CSA_DiL/diff12.f deleted file mode 100644 index 13de22e..0000000 --- a/source/unres/src_CSA_DiL/diff12.f +++ /dev/null @@ -1,82 +0,0 @@ -cccccccccccccccccccccccccccccccccc - subroutine get_diff12(aarray,barray,diff) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - dimension aarray(mxang,maxres,mxch), - & barray(mxang,maxres,mxch) - real x1(maxres),y1(maxres),z1(maxres) - integer n_1(maxres),L1 - real x2(maxres),y2(maxres),z2(maxres) - integer n_2(maxres),L2 - real TM,Rcomm - integer Lcomm - - - IF(tm_score) THEN - - do k=1,numch - do j=2,nres-1 - theta(j+1)=barray(1,j,k) - phi(j+2)=barray(2,j,k) - alph(j)=barray(3,j,k) - omeg(j)=barray(4,j,k) - enddo - enddo - call chainbuild - L1=0 - do i=nnt,nct - L1=L1+1 - n_1(L1)=L1 - x1(L1)=c(1,i) - y1(L1)=c(2,i) - z1(L1)=c(3,i) - enddo - - do k=1,numch - do j=2,nres-1 - theta(j+1)=aarray(1,j,k) - phi(j+2)=aarray(2,j,k) - alph(j)=aarray(3,j,k) - omeg(j)=aarray(4,j,k) - enddo - enddo - call chainbuild - L2=0 - do i=nnt,nct - L2=L2+1 - n_2(L2)=L2 - x2(L2)=c(1,i) - y2(L2)=c(2,i) - z2(L2)=c(3,i) - enddo - - call TMscore(L1,x1,y1,z1,n_1,L2,x2,y2,z2,n_2,TM,Rcomm,Lcomm) - diff=1.0d0-TM - -cd write(*,*)'TMscore=',TM,diff -cd write(*,*)'Number of residues in common=',Lcomm -cd write(*,*)'RMSD of the common residues=',Rcomm - - ELSE - diff=0.d0 - do k=1,numch - do j=2,nres-1 -c do i=1,4 -c do i=1,2 - do i=1,ndiff - dif=rad2deg*dabs(aarray(i,j,k)-barray(i,j,k)) - if(dif.gt.180.) dif=360.-dif - if (dif.gt.diffcut) diff=diff+dif - enddo - enddo - enddo - ENDIF - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc diff --git a/source/unres/src_CSA_DiL/distfit.f b/source/unres/src_CSA_DiL/distfit.f deleted file mode 100644 index 80e8fe4..0000000 --- a/source/unres/src_CSA_DiL/distfit.f +++ /dev/null @@ -1,207 +0,0 @@ - subroutine distfit(debug,maxit) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - DIMENSION X(MAXRES),DIAGH(MAXRES),phiold(maxres) - logical debug,sing - -cinput------------------------------------ -c NX=NRES-3 -c NY=((NRES-4)*(NRES-5))/2 -cinput------------------------------------ -ctest MAXIT=20 - TOL=0.5 - MAXMAR=10 - RL=100.0 - - CALL TRANSFER(NRES,phi,phiold) - - F0=RDIF() - -cd WRITE (IOUT,*) 'DISTFIT: F0=',F0 - - - DO IT=1,MAXIT - CALL RDERIV - CALL HEVAL - - DO I=1,NX - DIAGH(I)=H(I,I) - ENDDO - RL=RL*0.1 - - DO IMAR=1,MAXMAR - DO I=1,NX - H(I,I)=DIAGH(I)+RL - ENDDO - CALL TRANSFER(NX,XX,X) - CALL BANACH(NX,MAXRES,H,X,sing) - AIN=0.0 - DO I=1,NX - AIN=AIN+DABS(X(I)) - ENDDO - IF (AIN.LT.0.1*TOL .AND. RL.LT.1.0E-4) THEN - if (debug) then - WRITE (IOUT,*) 'DISTFIT: CONVERGENCE HAS BEEN ACHIEVED' - WRITE (IOUT,*) 'IT=',it,'F=',F0 - endif - RETURN - ENDIF - DO I=4,NRES - phi(I)=phiold(I)+mask(i)*X(I-3) -c print *,X(I-3) - ENDDO - - F1=RDIF() -cd WRITE (IOUT,*) 'IMAR=',IMAR,' RL=',RL,' F1=',F1 - IF (F1.LT.F0) THEN - CALL TRANSFER(NRES,phi,phiold) - F0=F1 - GOTO 1 - ELSE IF (DABS(F1-F0).LT.1.0E-5) THEN - if (debug) then - WRITE (IOUT,*) 'DISTFIT: CANNOT IMPROVE DISTANCE FIT' - WRITE (IOUT,*) 'IT=',it,'F=',F1 - endif - RETURN - ENDIF - RL=RL*10.0 - ENDDO - WRITE (IOUT,*) 'DISTFIT: MARQUARDT PROCEDURE HAS FAILED' - WRITE (IOUT,*) 'IT=',it,'F=',F0 - CALL TRANSFER(NRES,phiold,phi) - RETURN - 1 continue -cd write (iout,*) "it",it," imar",imar," f0",f0 - enddo - WRITE (IOUT,*) 'DISTFIT: FINAL F=',F0,'after MAXIT=',maxit - return - END - - double precision FUNCTION RDIF() - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DISTFIT' - -c print *,'in rdif' - - suma=0.0 - ind=0 - call chainbuild - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if (w(ind).ne.0.0) then - DIJ=DIST(i,j) - suma=suma+w(ind)*(DIJ-d0(ind))*(DIJ-d0(ind)) - DD(ind)=DIJ -c print '(2i3,i4,4f12.2)',i,j,ind,dij,d0(ind),w(ind),suma - endif - enddo - enddo - - RDIF=suma - RETURN - END - - SUBROUTINE RDERIV - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DISTFIT' - include 'COMMON.GEO' - DIMENSION E12(3),R13(3),R24(3),PRODU(3) - - DO I=1,NY - DO J=1,NX - DRDG(I,J)=0.0 - ENDDO - ENDDO - DO I=1,NX - I1=I+1 - I2=I+2 - CALL VEC(I1,I2,E12) - DO J=1,I - DO K=1,3 - R13(K)=C(K,J)-C(K,I1) - ENDDO - DO K=I2+1,NRES - DO L=1,3 - R24(L)=C(L,K)-C(L,I2) - ENDDO - IND=((J-1)*(2*NRES-J-6))/2+K-3 - PRODU(1)=R13(2)*R24(3)-R13(3)*R24(2) - PRODU(2)=R13(3)*R24(1)-R13(1)*R24(3) - PRODU(3)=R13(1)*R24(2)-R13(2)*R24(1) - DRDG(IND,I)=SCALAR(E12,PRODU)/DIST(J,K) - ENDDO - ENDDO - ENDDO - RETURN - END - - SUBROUTINE HEVAL - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DISTFIT' - - DO I=1,NX - XI=0.0 - HII=0.0 - DO K=1,NY - BKI=DRDG(K,I) - BKIWK=w(K)*BKI - XI=XI+BKIWK*(D0(K)-DD(K)) - HII=HII+BKI*BKIWK - ENDDO - H(I,I)=HII - XX(I)=XI - DO J=I+1,NX - HIJ=0.0 - DO K=1,NY - HIJ=HIJ+DRDG(K,I)*DRDG(K,J)*w(K) - ENDDO - H(I,J)=HIJ - H(J,I)=HIJ - ENDDO - ENDDO - RETURN - END - - - SUBROUTINE VEC(I,J,U) -* -* Find the unit vector from atom (I) to atom (J). Store in U. -* - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - DIMENSION U(3) - - ANORM=0.0 - DO K=1,3 - UK=C(K,J)-C(K,I) - ANORM=ANORM+UK*UK - U(K)=UK - ENDDO - ANORM=SQRT(ANORM) - DO K=1,3 - U(K)=U(K)/ANORM - ENDDO - RETURN - END - - SUBROUTINE TRANSFER(N,X1,X2) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION X1(N),X2(N) - DO 1 I=1,N - 1 X2(I)=X1(I) - RETURN - END - diff --git a/source/unres/src_CSA_DiL/djacob.f b/source/unres/src_CSA_DiL/djacob.f deleted file mode 100644 index e3f46bc..0000000 --- a/source/unres/src_CSA_DiL/djacob.f +++ /dev/null @@ -1,107 +0,0 @@ - SUBROUTINE DJACOB(N,NMAX,MAXJAC,E,A,C,AII) - IMPLICIT REAL*8 (A-H,O-Z) -C THE JACOBI DIAGONALIZATION PROCEDURE - COMMON INP,IOUT,IPN - DIMENSION A(NMAX,N),C(NMAX,N),AII(150),AJJ(150) - SIN45 = .70710678 - COS45 = .70710678 - S45SQ = 0.50 - C45SQ = 0.50 -C UNIT EIGENVECTOR MATRIX - DO 70 I = 1,N - DO 7 J = I,N - A(J,I)=A(I,J) - C(I,J) = 0.0 - 7 C(J,I) = 0.0 - 70 C(I,I) = 1.0 -C DETERMINATION OF SEARCH ARGUMENT, TEST - AMAX = 0.0 - DO 1 I = 1,N - DO 1 J = 1,I - TEMPA=DABS(A(I,J)) - IF (AMAX-TEMPA) 2,1,1 - 2 AMAX = TEMPA - 1 CONTINUE - TEST = AMAX*E -C SEARCH FOR LARGEST OFF DIAGONAL ELEMENT - DO 72 IJAC=1,MAXJAC - AIJMAX = 0.0 - DO 3 I = 2,N - LIM = I-1 - DO 3 J = 1,LIM - TAIJ=DABS(A(I,J)) - IF (AIJMAX-TAIJ) 4,3,3 - 4 AIJMAX = TAIJ - IPIV = I - JPIV = J - 3 CONTINUE - IF(AIJMAX-TEST)300,300,5 -C PARAMETERS FOR ROTATION - 5 TAII = A(IPIV,IPIV) - TAJJ = A(JPIV,JPIV) - TAIJ = A(IPIV,JPIV) - TMT = TAII-TAJJ - IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6 - 60 IF(TAIJ) 10,10,11 - 6 ZAMMA=TAIJ/(2.0*TMT) - 90 IF(DABS(ZAMMA)-0.38268)8,8,9 - 9 IF(ZAMMA)10,10,11 - 10 SINT = -SIN45 - GO TO 12 - 11 SINT = SIN45 - 12 COST = COS45 - SINSQ = S45SQ - COSSQ = C45SQ - GO TO 120 - 8 GAMSQ=ZAMMA*ZAMMA - SINT=2.0*ZAMMA/(1.0+GAMSQ) - COST = (1.0-GAMSQ)/(1.0+GAMSQ) - SINSQ=SINT*SINT - COSSQ=COST*COST -C ROTATION - 120 DO 13 K = 1,N - TAIK = A(IPIV,K) - TAJK = A(JPIV,K) - A(IPIV,K) = TAIK*COST+TAJK*SINT - A(JPIV,K) = TAJK*COST-TAIK*SINT - TCIK = C(IPIV,K) - TCJK = C(JPIV,K) - C(IPIV,K) = TCIK*COST+TCJK*SINT - 13 C(JPIV,K) = TCJK*COST-TCIK*SINT - A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST - A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST - A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT - A(JPIV,IPIV) = A(IPIV,JPIV) - DO 30 K = 1,N - A(K,IPIV) = A(IPIV,K) - 30 A(K,JPIV) = A(JPIV,K) - 72 CONTINUE - WRITE (IOUT,1000) AIJMAX - 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE', - 1 'MENT = ',1PE14.7) -C ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER - 300 DO 14 I=1,N - 14 AJJ(I)=A(I,I) - LT=N+1 - DO15 L=1,N - LT=LT-1 - AIIMIN=1.0E+30 - DO16 I=1,N - IF(AJJ(I)-AIIMIN)17,16,16 - 17 AIIMIN=AJJ(I) - IT=I - 16 CONTINUE - IN=L - AII(IN)=AIIMIN - AJJ(IT)=1.0E+30 - DO15 K=1,N - 15 A(IN,K)=C(IT,K) - DO 18 I=1,N - IF(A(I,1))19,22,22 - 19 T=-1.0 - GO TO 91 - 22 T=1.0 - 91 DO 18 J=1,N - 18 C(J,I)=T*A(I,J) - RETURN - END diff --git a/source/unres/src_CSA_DiL/econstr_local.F b/source/unres/src_CSA_DiL/econstr_local.F deleted file mode 100644 index e6e54f7..0000000 --- a/source/unres/src_CSA_DiL/econstr_local.F +++ /dev/null @@ -1,91 +0,0 @@ - subroutine Econstr_back -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD_' -c#ifndef LANG0 -c include 'COMMON.LANGEVIN' -c#else -c include 'COMMON.LANGEVIN.lang0' -c#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - Uconst_back=0.0d0 - do i=1,nres - dutheta(i)=0.0d0 - dugamma(i)=0.0d0 - do j=1,3 - duscdiff(j,i)=0.0d0 - duscdiffx(j,i)=0.0d0 - enddo - enddo - do i=1,nfrag_back - ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) -c -c Deviations from theta angles -c - utheta_i=0.0d0 - do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) - dtheta_i=theta(j)-thetaref(j) - utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i - dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) - enddo - utheta(i)=utheta_i/(ii-1) -c -c Deviations from gamma angles -c - ugamma_i=0.0d0 - do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset) - dgamma_i=pinorm(phi(j)-phiref(j)) -c write (iout,*) j,phi(j),phi(j)-phiref(j) - ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i - dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2) -c write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3) - enddo - ugamma(i)=ugamma_i/(ii-2) -c -c Deviations from local SC geometry -c - uscdiff(i)=0.0d0 - do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 - dxx=xxtab(j)-xxref(j) - dyy=yytab(j)-yyref(j) - dzz=zztab(j)-zzref(j) - uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz - do k=1,3 - duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* - & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ - & (ii-1) - duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* - & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ - & (ii-1) - duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* - & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) - & /(ii-1) - enddo -c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), -c & xxref(j),yyref(j),zzref(j) - enddo - uscdiff(i)=0.5d0*uscdiff(i)/(ii-1) -c write (iout,*) i," uscdiff",uscdiff(i) -c -c Put together deviations from local geometry -c - Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ - & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i) -c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i), -c & " uconst_back",uconst_back - utheta(i)=dsqrt(utheta(i)) - ugamma(i)=dsqrt(ugamma(i)) - uscdiff(i)=dsqrt(uscdiff(i)) - enddo - return - end diff --git a/source/unres/src_CSA_DiL/elecont.f b/source/unres/src_CSA_DiL/elecont.f deleted file mode 100644 index e9ed067..0000000 --- a/source/unres/src_CSA_DiL/elecont.f +++ /dev/null @@ -1,509 +0,0 @@ - subroutine elecont(lprint,ncont,icont) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - logical lprint - double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2) - double precision app_(2,2),bpp_(2,2),rpp_(2,2) - integer ncont,icont(2,maxcont) - double precision econt(maxcont) -* -* Load the constants of peptide bond - peptide bond interactions. -* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g. -* proline) - determined by averaging ECEPP energy. -* -* as of 7/06/91. -* -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ - data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ - data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ - data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ - data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/ - if (lprint) write (iout,'(a)') - & "Constants of electrostatic interaction energy expression." - do i=1,2 - do j=1,2 - rri=rpp_(i,j)**6 - app_(i,j)=epp(i,j)*rri*rri - bpp_(i,j)=-2.0*epp(i,j)*rri - ael6_(i,j)=elpp_6(i,j)*4.2**6 - ael3_(i,j)=elpp_3(i,j)*4.2**3 - if (lprint) - & write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j), - & ael3_(i,j) - enddo - enddo - ncont=0 - ees=0.0 - evdw=0.0 - do 1 i=nnt,nct-2 - xi=c(1,i) - yi=c(2,i) - zi=c(3,i) - dxi=c(1,i+1)-c(1,i) - dyi=c(2,i+1)-c(2,i) - dzi=c(3,i+1)-c(3,i) - xmedi=xi+0.5*dxi - ymedi=yi+0.5*dyi - zmedi=zi+0.5*dzi - do 4 j=i+2,nct-1 - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - if (iteli.eq.2 .and. itelj.eq.2) goto 4 - aaa=app_(iteli,itelj) - bbb=bpp_(iteli,itelj) - ael6_i=ael6_(iteli,itelj) - ael3_i=ael3_(iteli,itelj) - dxj=c(1,j+1)-c(1,j) - dyj=c(2,j+1)-c(2,j) - dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi - rrmij=1.0/(xj*xj+yj*yj+zj*zj) - rmij=sqrt(rrmij) - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - vrmij=vblinv*rmij - cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2 - cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij - cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij - fac=cosa-3.0*cosb*cosg - ev1=aaa*r6ij*r6ij - ev2=bbb*r6ij - fac3=ael6_i*r6ij - fac4=ael3_i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 - if (j.gt.i+2 .and. eesij.le.elcutoff .or. - & j.eq.i+2 .and. eesij.le.elecutoff_14) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - econt(ncont)=eesij - endif - ees=ees+eesij - evdw=evdw+evdwij - 4 continue - 1 continue - if (lprint) then - write (iout,*) 'Total average electrostatic energy: ',ees - write (iout,*) 'VDW energy between peptide-group centers: ',evdw - write (iout,*) - write (iout,*) 'Electrostatic contacts before pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif -c For given residues keep only the contacts with the greatest energy. - i=0 - do while (i.lt.ncont) - i=i+1 - ene=econt(i) - ic1=icont(1,i) - ic2=icont(2,i) - j=i - do while (j.lt.ncont) - j=j+1 - if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or. - & ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then -c write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2, -c & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont - if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j) - & .and. iabs(icont(1,k)-ic1).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j) - & .and. iabs(icont(2,k)-ic2).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - endif -c Remove ith contact - do k=i+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - i=i-1 - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - goto 20 - else if (econt(j).gt.ene .and. ic2.ne.ic1+2) - & then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2 - & .and. iabs(icont(1,k)-icont(1,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1 - & .and. iabs(icont(2,k)-icont(2,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - endif -c Remove jth contact - do k=j+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - j=j-1 - endif - endif - 21 continue - enddo - 20 continue - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Electrostatic contacts after pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif - return - end -c-------------------------------------------- - subroutine secondary2(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - integer ncont,icont(2,maxcont),isec(maxres,4),nsec(maxres) - logical lprint,not_done,freeres - double precision p1,p2 - external freeres - - if(.not.dccart) call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - nsec(i)=0 - enddo - - call elecont(lprint,ncont,icont) - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,'(a,i3,4i4)')'parallel beta', - & nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1+1 - bfrag(2,nbfrag)=i1+1 - bfrag(3,nbfrag)=jj1+1 - bfrag(4,nbfrag)=min0(j1+1,nres) - - do ij=ii1,i1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - do ij=jj1,j1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - p1=phi(i1+2)*rad2deg - p2=0.0 - if (j1+2.le.nres) p2=phi(j1+2)*rad2deg - - - if (j1.eq.i1+3 .and. - & ((p1.ge.10.and.p1.le.80).or.i1.le.2).and. - & ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2 -co if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2 - ii1=i1 - jj1=j1 - if (nsec(ii1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue - p1=phi(i1+2)*rad2deg - p2=phi(j1+2)*rad2deg - if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) - & not_done=.false. -cd write (iout,*) i1,j1,not_done,p1,p2 - enddo - j1=j1+1 - if (j1-ii1.gt.5) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=j1 - - do ij=ii1,j1 - nsec(ij)=-1 - enddo - if (lprint) then - write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=min0(i1+1,nres) - bfrag(3,nbfrag)=min0(jj1+1,nres) - bfrag(4,nbfrag)=j1 - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2) then - isec(ij,nsec(ij))=nbeta - endif - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2 .and. nsec(ij).gt.0) then - isec(ij,nsec(ij))=nbeta - endif - enddo - - - if (lprint) then - write (iout,'(a,i3,4i4)')'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - - - write(iout,*) 'UNRES seq:' - do j=1,nbfrag - write(iout,*) 'beta ',(bfrag(i,j),i=1,4) - enddo - - do j=1,nhfrag - write(iout,*) 'helix ',(hfrag(i,j),i=1,2) - enddo - endif - - return - end -c------------------------------------------------- - logical function freeres(i,j,nsec,isec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer isec(maxres,4),nsec(maxres) - freeres=.false. - - if (nsec(i).lt.0.or.nsec(j).lt.0) return - if (nsec(i).gt.1.or.nsec(j).gt.1) return - do k=1,nsec(i) - do l=1,nsec(j) - if (isec(i,k).eq.isec(j,l)) return - enddo - enddo - freeres=.true. - return - end - diff --git a/source/unres/src_CSA_DiL/energy_p_new_barrier.F b/source/unres/src_CSA_DiL/energy_p_new_barrier.F deleted file mode 100644 index c1e8ad3..0000000 --- a/source/unres/src_CSA_DiL/energy_p_new_barrier.F +++ /dev/null @@ -1,9192 +0,0 @@ - subroutine etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD_' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wsct -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wsct=weights(22) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING - time00=MPI_Wtime() -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw,evdw_p,evdw_m) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw,evdw_p,evdw_m) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw,evdw_p,evdw_m) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - -C JUYONG for dfa test! - if (wdfa_dist.gt.0) call edfad(edfadis) -c print*, 'edfad is finished!', edfadis - if (wdfa_tor.gt.0) call edfat(edfator) -c print*, 'edfat is finished!', edfator - if (wdfa_nei.gt.0) call edfan(edfanei) -c print*, 'edfan is finished!', edfanei - if (wdfa_beta.gt.0) call edfab(edfabet) -c print*, 'edfab is finished!', edfabet -C stop -C JUYONG - -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING - time01=MPI_Wtime() -#endif - call vec_and_deriv -#ifdef TIMING - time_vec=time_vec+MPI_Wtime()-time01 -#endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr - endif -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then -c call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -#ifdef TIMING - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING - time00=MPI_Wtime() -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m - energia(24)=edfadis - energia(25)=edfator - energia(26)=edfanei - energia(27)=edfabet -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING - time_sumene=time_sumene+MPI_Wtime()-time00 -#endif - -c print*, 'etot:',energia(0) - - return - end -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - edfadis=energia(24) - edfator=energia(25) - edfanei=energia(26) - edfabet=energia(27) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor - & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei - & +wdfa_beta*edfabet -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor - & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei - & +wdfa_beta*edfabet - -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres) -#else - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' -#ifdef TIMING - time01=MPI_Wtime() -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3), - & (gvdwcT(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef SPLITELE -#ifdef TSCSC - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - - enddo - enddo -#endif -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - - - enddo - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gradbufc_sum after allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef TIMING - time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo - do i=igrad_start,igrad_end - do j=jgrad_start(i),jgrad_end(i) - do k=1,3 - gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) - enddo - enddo - enddo - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=nnt,nres-1 - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - do j=i+1,nres - do k=1,3 - gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) - enddo - enddo - enddo -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=1,nct - do j=1,3 -#ifdef SPLITELE - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i) - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#endif -#ifdef TSCSC - gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+ - & wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#else - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#endif - enddo - enddo -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - & +wsccor*gsccor_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#ifdef TSCSC - gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#endif - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#ifdef TSCSC - gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#endif - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact -#ifdef TSCSC -c wsct=t_bath/temp0 - wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 -#endif - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD_' - double precision energia(0:n_ene) - etot=energia(0) -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -C Juyong - edfadis = energia(24) - edfator = energia(25) - edfanei = energia(26) - edfabet = energia(27) -C -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ebr*nss, - & Uconst,edfadis,edfator,edfanei,edfabet,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/ - & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/ - & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/ - & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ebr*nss, - & Uconst,edfadis,edfator,edfanei,edfabet,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/ - & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/ - & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/ - & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) - itypi1=iabs(itype(i+1)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j)) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij - else - evdw_m=evdw_m+evdwij - endif -#else - evdw=evdw+evdwij -#endif -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -#ifdef TSCSC - if (bb(itypi,itypj).gt.0.0d0) then - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - else - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - gvdwcT(k,i)=gvdwcT(k,i)-gg(k) - gvdwcT(k,j)=gvdwcT(k,j)+gg(k) - enddo - endif -#else - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -#endif -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (ri' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=iabs(itype(j)) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj - &)).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij -cd write (iout,*) "eij",eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=iabs(itype(i)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=iabs(itype(j)) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=iabs(itype(i)) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - ichir1=isign(1,itype(i-2)) - ichir2=isign(1,itype(i)) - if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) - if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) - if (itype(i-1).eq.10) then - itype1=isign(10,itype(i-2)) - ichir11=isign(1,itype(i-2)) - ichir12=isign(1,itype(i-2)) - itype2=isign(10,itype(i)) - ichir21=isign(1,itype(i)) - ichir22=isign(1,itype(i)) - endif - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it,ichir1,ichir2) - bthetk=bthet(k,it,ichir1,ichir2) - if (it.eq.10) then - athetk=athet(k,itype1,ichir11,ichir12) - bthetk=bthet(k,itype2,ichir21,ichir22) - endif - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) - &+athet(2,it,ichir1,ichir2)*y(1))*ss - dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) - & +bthet(2,it,ichir1,ichir2)*z(1))*ss - if (it.eq.10) then - dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) - &+athet(2,itype1,ichir11,ichir12)*y(1))*ss - dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) - & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss - endif - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(iabs(itype(i-1))) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(iabs(itype(i-2))) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(iabs(itype(i))) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(iabs(it)) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - if (iabs(itype(i)).eq.20) then - iblock=2 - else - iblock=1 - endif - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1,iblock) - v1ij=v1(j,itori,itori1,iblock) - v2ij=v2(j,itori,itori1,iblock) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1,iblock) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1,iblock) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1,iblock) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1,iblock),j=1,6), - & (v2(j,itori,itori1,iblock),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - iblock=1 - if (iabs(itype(i+1)).eq.20) iblock=2 - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 -C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2,iblock) - v1cij=v1c(1,j,itori,itori1,itori2,iblock) - v1sij=v1s(1,j,itori,itori1,itori2,iblock) - v2cij=v1c(2,j,itori,itori1,itori2,iblock) - v2sij=v1s(2,j,itori,itori1,itori2,iblock) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2,iblock) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2,iblock) - v2cdij = v2c(l,k,itori,itori1,itori2,iblock) - v1sdij = v2s(k,l,itori,itori1,itori2,iblock) - v2sdij = v2s(l,k,itori,itori1,itori2,iblock) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=iphi_start,iphi_end - esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) - phii=phi(i) - gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ /j\ C -C / \ / \ C -C /| o | | o |\ C -C \ j|/k\| / \ |/k\|l / C -C \ / \ / \ / \ / C -C o o o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C \ /l\ /j\ / C -C \ / \ / \ / C -C o| o | | o |o C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C j|/k\| / |/k\|l / C -C / \ / / \ / C -C / o / o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o \ o \ C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' -#ifdef MOMENT - include 'COMMON.CONTACTS.MOMENT' -#endif - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_CSA_DiL/fitsq.f b/source/unres/src_CSA_DiL/fitsq.f deleted file mode 100644 index 36cbd30..0000000 --- a/source/unres/src_CSA_DiL/fitsq.f +++ /dev/null @@ -1,364 +0,0 @@ - subroutine fitsq(rms,x,y,nn,t,b,non_conv) - implicit real*8 (a-h,o-z) - include 'COMMON.IOUNITS' -c x and y are the vectors of coordinates (dimensioned (3,n)) of the two -c structures to be superimposed. nn is 3*n, where n is the number of -c points. t and b are respectively the translation vector and the -c rotation matrix that transforms the second set of coordinates to the -c frame of the first set. -c eta = machine-specific variable - - dimension x(3*nn),y(3*nn),t(3) - dimension b(3,3),q(3,3),r(3,3),v(3),xav(3),yav(3),e(3),c(3,3) - logical non_conv -c eta = z00100000 -c small=25.0*rmdcon(3) -c small=25.0*eta -c small=25.0*10.e-10 -c the following is a very lenient value for 'small' - small = 0.0001D0 - non_conv=.false. - fn=nn - do 10 i=1,3 - xav(i)=0.0D0 - yav(i)=0.0D0 - do 10 j=1,3 - 10 b(j,i)=0.0D0 - nc=0 -c - do 30 n=1,nn - do 20 i=1,3 -c write(iout,*)'x = ',x(nc+i),' y = ',y(nc+i) - xav(i)=xav(i)+x(nc+i)/fn - 20 yav(i)=yav(i)+y(nc+i)/fn - 30 nc=nc+3 -c - do i=1,3 - t(i)=yav(i)-xav(i) - enddo - - rms=0.0d0 - do n=1,nn - do i=1,3 - rms=rms+(y(3*(n-1)+i)-x(3*(n-1)+i)-t(i))**2 - enddo - enddo - rms=dabs(rms/fn) - -c write(iout,*)'xav = ',(xav(j),j=1,3) -c write(iout,*)'yav = ',(yav(j),j=1,3) -c write(iout,*)'t = ',(t(j),j=1,3) -c write(iout,*)'rms=',rms - if (rms.lt.small) return - - - nc=0 - rms=0.0D0 - do 50 n=1,nn - do 40 i=1,3 - rms=rms+((x(nc+i)-xav(i))**2+(y(nc+i)-yav(i))**2)/fn - do 40 j=1,3 - b(j,i)=b(j,i)+(x(nc+i)-xav(i))*(y(nc+j)-yav(j))/fn - 40 c(j,i)=b(j,i) - 50 nc=nc+3 - call sivade(b,q,r,d,non_conv) - sn3=dsign(1.0d0,d) - do 120 i=1,3 - do 120 j=1,3 - 120 b(j,i)=-q(j,1)*r(i,1)-q(j,2)*r(i,2)-sn3*q(j,3)*r(i,3) - call mvvad(b,xav,yav,t) - do 130 i=1,3 - do 130 j=1,3 - rms=rms+2.0*c(j,i)*b(j,i) - 130 b(j,i)=-b(j,i) - if (dabs(rms).gt.small) go to 140 -* write (6,301) - return - 140 if (rms.gt.0.0d0) go to 150 -c write (iout,303) rms - rms=0.0d0 -* stop -c 150 write (iout,302) dsqrt(rms) - 150 continue - return - 301 format (5x,'rms deviation negligible') - 302 format (5x,'rms deviation ',f14.6) - 303 format (//,5x,'negative ms deviation - ',f14.6) - end -c - subroutine sivade(x,q,r,dt,non_conv) - implicit real*8(a-h,o-z) -c computes q,e and r such that q(t)xr = diag(e) - dimension x(3,3),q(3,3),r(3,3),e(3) - dimension h(3,3),p(3,3),u(3,3),d(3) - logical non_conv -c eta = z00100000 -c write (2,*) "SIVADE" - nit = 0 - small=25.0*10.d-10 -c small=25.0*eta -c small=2.0*rmdcon(3) - xnrm=0.0d0 - do 20 i=1,3 - do 10 j=1,3 - xnrm=xnrm+x(j,i)*x(j,i) - u(j,i)=0.0d0 - r(j,i)=0.0d0 - 10 h(j,i)=0.0d0 - u(i,i)=1.0 - 20 r(i,i)=1.0 - xnrm=dsqrt(xnrm) - do 110 n=1,2 - xmax=0.0d0 - do 30 j=n,3 - 30 if (dabs(x(j,n)).gt.xmax) xmax=dabs(x(j,n)) - a=0.0d0 - do 40 j=n,3 - h(j,n)=x(j,n)/xmax - 40 a=a+h(j,n)*h(j,n) - a=dsqrt(a) - den=a*(a+dabs(h(n,n))) - d(n)=1.0/den - h(n,n)=h(n,n)+dsign(a,h(n,n)) - do 70 i=n,3 - s=0.0d0 - do 50 j=n,3 - 50 s=s+h(j,n)*x(j,i) - s=d(n)*s - do 60 j=n,3 - 60 x(j,i)=x(j,i)-s*h(j,n) - 70 continue - if (n.gt.1) go to 110 - xmax=dmax1(dabs(x(1,2)),dabs(x(1,3))) - h(2,3)=x(1,2)/xmax - h(3,3)=x(1,3)/xmax - a=dsqrt(h(2,3)*h(2,3)+h(3,3)*h(3,3)) - den=a*(a+dabs(h(2,3))) - d(3)=1.0/den - h(2,3)=h(2,3)+sign(a,h(2,3)) - do 100 i=1,3 - s=0.0d0 - do 80 j=2,3 - 80 s=s+h(j,3)*x(i,j) - s=d(3)*s - do 90 j=2,3 - 90 x(i,j)=x(i,j)-s*h(j,3) - 100 continue - 110 continue - do 130 i=1,3 - do 120 j=1,3 - 120 p(j,i)=-d(1)*h(j,1)*h(i,1) - 130 p(i,i)=1.0+p(i,i) - do 140 i=2,3 - do 140 j=2,3 - u(j,i)=u(j,i)-d(2)*h(j,2)*h(i,2) - 140 r(j,i)=r(j,i)-d(3)*h(j,3)*h(i,3) - call mmmul(p,u,q) - 150 np=1 - nq=1 - nit=nit+1 -c write (2,*) "nit",nit," e",(x(i,i),i=1,3) - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif - if (dabs(x(2,3)).gt.small*(dabs(x(2,2))+abs(x(3,3)))) go to 160 - x(2,3)=0.0d0 - nq=nq+1 - 160 if (dabs(x(1,2)).gt.small*(dabs(x(1,1))+dabs(x(2,2)))) go to 180 - x(1,2)=0.0d0 - if (x(2,3).ne.0.0d0) go to 170 - nq=nq+1 - go to 180 - 170 np=np+1 - 180 if (nq.eq.3) go to 310 - npq=4-np-nq -c write (2,*) "np",np," npq",npq - if (np.gt.npq) go to 230 - n0=0 - do 220 n=np,npq - nn=n+np-1 -c write (2,*) "nn",nn - if (dabs(x(nn,nn)).gt.small*xnrm) go to 220 - x(nn,nn)=0.0d0 - if (x(nn,nn+1).eq.0.0d0) go to 220 - n0=n0+1 -c write (2,*) "nn",nn - go to (190,210,220),nn - 190 do 200 j=2,3 - 200 call givns(x,q,1,j) - go to 220 - 210 call givns(x,q,2,3) - 220 continue -c write (2,*) "nn",nn," np",np," nq",nq," n0",n0 -c write (2,*) "x",(x(i,i),i=1,3) - if (n0.ne.0) go to 150 - 230 nn=3-nq - a=x(nn,nn)*x(nn,nn) - if (nn.gt.1) a=a+x(nn-1,nn)*x(nn-1,nn) - b=x(nn+1,nn+1)*x(nn+1,nn+1)+x(nn,nn+1)*x(nn,nn+1) - c=x(nn,nn)*x(nn,nn+1) - dd=0.5*(a-b) - xn2=c*c - rt=b-xn2/(dd+sign(dsqrt(dd*dd+xn2),dd)) - y=x(np,np)*x(np,np)-rt - z=x(np,np)*x(np,np+1) - do 300 n=np,nn -c write (2,*) "n",n," a",a," b",b," c",c," y",y," z",z - if (dabs(y).lt.dabs(z)) go to 240 - t=z/y - c=1.0/dsqrt(1.0d0+t*t) - s=c*t - go to 250 - 240 t=y/z - s=1.0/dsqrt(1.0d0+t*t) - c=s*t - 250 do 260 j=1,3 - v=x(j,n) - w=x(j,n+1) - x(j,n)=c*v+s*w - x(j,n+1)=-s*v+c*w - a=r(j,n) - b=r(j,n+1) - r(j,n)=c*a+s*b - 260 r(j,n+1)=-s*a+c*b - y=x(n,n) - z=x(n+1,n) - if (dabs(y).lt.dabs(z)) go to 270 - t=z/y - c=1.0/dsqrt(1.0+t*t) - s=c*t - go to 280 - 270 t=y/z - s=1.0/dsqrt(1.0+t*t) - c=s*t - 280 do 290 j=1,3 - v=x(n,j) - w=x(n+1,j) - a=q(j,n) - b=q(j,n+1) - x(n,j)=c*v+s*w - x(n+1,j)=-s*v+c*w - q(j,n)=c*a+s*b - 290 q(j,n+1)=-s*a+c*b - if (n.ge.nn) go to 300 - y=x(n,n+1) - z=x(n,n+2) - 300 continue - go to 150 - 310 do 320 i=1,3 - 320 e(i)=x(i,i) - nit=0 - 330 n0=0 - nit=nit+1 - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif -c write (2,*) "e",(e(i),i=1,3) - do 360 i=1,3 - if (e(i).ge.0.0d0) go to 350 - e(i)=-e(i) - do 340 j=1,3 - 340 q(j,i)=-q(j,i) - 350 if (i.eq.1) go to 360 - if (dabs(e(i)).lt.dabs(e(i-1))) go to 360 - call switch(i,1,q,r,e) - n0=n0+1 - 360 continue - if (n0.ne.0) go to 330 -c write (2,*) "e",(e(i),i=1,3) - if (dabs(e(3)).gt.small*xnrm) go to 370 - e(3)=0.0d0 - if (dabs(e(2)).gt.small*xnrm) go to 370 - e(2)=0.0d0 - 370 dt=det(q(1,1),q(1,2),q(1,3))*det(r(1,1),r(1,2),r(1,3)) -c write (2,*) "nit",nit -c write (2,501) (e(i),i=1,3) - return - 501 format (/,5x,'singular values - ',3e15.5) - end - subroutine givns(a,b,m,n) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3) - if (dabs(a(m,n)).lt.dabs(a(n,n))) go to 10 - t=a(n,n)/a(m,n) - s=1.0/dsqrt(1.0+t*t) - c=s*t - go to 20 - 10 t=a(m,n)/a(n,n) - c=1.0/dsqrt(1.0+t*t) - s=c*t - 20 do 30 j=1,3 - v=a(m,j) - w=a(n,j) - x=b(j,m) - y=b(j,n) - a(m,j)=c*v-s*w - a(n,j)=s*v+c*w - b(j,m)=c*x-s*y - 30 b(j,n)=s*x+c*y - return - end - subroutine switch(n,m,u,v,d) - implicit real*8 (a-h,o-z) - dimension u(3,3),v(3,3),d(3) - do 10 i=1,3 - tem=u(i,n) - u(i,n)=u(i,n-1) - u(i,n-1)=tem - if (m.eq.0) go to 10 - tem=v(i,n) - v(i,n)=v(i,n-1) - v(i,n-1)=tem - 10 continue - tem=d(n) - d(n)=d(n-1) - d(n-1)=tem - return - end - subroutine mvvad(b,xav,yav,t) - implicit real*8 (a-h,o-z) - dimension b(3,3),xav(3),yav(3),t(3) -c dimension a(3,3),b(3),c(3),d(3) -c do 10 j=1,3 -c d(j)=c(j) -c do 10 i=1,3 -c 10 d(j)=d(j)+a(j,i)*b(i) - do 10 j=1,3 - t(j)=yav(j) - do 10 i=1,3 - 10 t(j)=t(j)+b(j,i)*xav(i) - return - end - double precision function det (a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3),b(3),c(3) - det=a(1)*(b(2)*c(3)-b(3)*c(2))+a(2)*(b(3)*c(1)-b(1)*c(3)) - 1 +a(3)*(b(1)*c(2)-b(2)*c(1)) - return - end - subroutine mmmul(a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3),c(3,3) - do 10 i=1,3 - do 10 j=1,3 - c(i,j)=0.0d0 - do 10 k=1,3 - 10 c(i,j)=c(i,j)+a(i,k)*b(k,j) - return - end - subroutine matvec(uvec,tmat,pvec,nback) - implicit real*8 (a-h,o-z) - real*8 tmat(3,3),uvec(3,nback), pvec(3,nback) -c - do 2 j=1,nback - do 1 i=1,3 - uvec(i,j) = 0.0d0 - do 1 k=1,3 - 1 uvec(i,j)=uvec(i,j)+tmat(i,k)*pvec(k,j) - 2 continue - return - end diff --git a/source/unres/src_CSA_DiL/gen_rand_conf.F b/source/unres/src_CSA_DiL/gen_rand_conf.F deleted file mode 100644 index 78d4cca..0000000 --- a/source/unres/src_CSA_DiL/gen_rand_conf.F +++ /dev/null @@ -1,911 +0,0 @@ - subroutine gen_rand_conf(nstart,*) -C Generate random conformation or chain cut and regrowth. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical overlap,back,fail -cd print *,' CG Processor',me,' maxgen=',maxgen - maxsi=100 -cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart - if (nstart.lt.5) then - it1=iabs(itype(2)) - phi(4)=gen_phi(4,iabs(itype(2)),abs(itype(3))) -c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) -c write(iout,*)'theta(3)=',rad2deg*theta(3) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(3),alph(2),omeg(2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif ! it1.ne.10 - call orig_frame - i=4 - nstart=4 - else - i=nstart - nstart=max0(i,4) - endif - - maxnit=0 - - nit=0 - niter=0 - back=.false. - do while (i.le.nres .and. niter.lt.maxgen) - if (i.lt.nstart) then - if(iprint.gt.1) then - write (iout,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - write (*,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - endif - return1 - endif - it1=abs(itype(i-1)) - it2=abs(itype(i-2)) - it=abs(itype(i)) -c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, -c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen - phi(i+1)=gen_phi(i+1,it1,it) - if (back) then - phi(i)=gen_phi(i+1,it2,it1) - print *,'phi(',i,')=',phi(i) - theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) - if (it2.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i-1) - endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i) - if (overlap(i-1)) then - if (nit.lt.maxnit) then - back=.true. - nit=nit+1 - else - nit=0 - if (i.gt.3) then - back=.true. - i=i-1 - else - write (iout,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - write (*,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - return1 - endif - endif - else - back=.false. - nit=0 - i=i+1 - endif - niter=niter+1 - enddo - if (niter.ge.maxgen) then - write (iout,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - write (*,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - return1 - endif - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo - return - end -c------------------------------------------------------------------------- - logical function overlap(i) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - data redfac /0.5D0/ - overlap=.false. - iti=abs(itype(i)) - if (iti.gt.ntyp) return -C Check for SC-SC overlaps. -cd print *,'nnt=',nnt,' nct=',nct - do j=nnt,i-1 - itj=abs(itype(j)) - if (j.lt.i-1 .or. ipot.ne.4) then - rcomp=sigmaii(iti,itj) - else - rcomp=sigma(iti,itj) - endif -cd print *,'j=',j - if (dist(nres+i,nres+j).lt.redfac*rcomp) then - overlap=.true. -c print *,'overlap, SC-SC: i=',i,' j=',j, -c & ' dist=',dist(nres+i,nres+j),' rcomp=', -c & rcomp - return - endif - enddo -C Check for overlaps between the added peptide group and the preceding -C SCs. - iteli=itel(i) - do j=1,3 - c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itj=abs(itype(j)) -cd print *,'overlap, p-Sc: i=',i,' j=',j, -cd & ' dist=',dist(nres+j,maxres2+1) - if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for overlaps between the added side chain and the preceding peptide -C groups. - do j=1,nnt-2 - do k=1,3 - c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, SC-p: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,maxres2+1) - if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for p-p overlaps - do j=1,3 - c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itelj=itel(j) - do k=1,3 - c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, p-p: i=',i,' j=',j, -cd & ' dist=',dist(maxres2+1,maxres2+2) - if(iteli.ne.0.and.itelj.ne.0)then - if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then - overlap=.true. - return - endif - endif - enddo - return - end -c-------------------------------------------------------------------------- - double precision function gen_phi(i,it1,it2) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' -c gen_phi=ran_number(-pi,pi) -C 8/13/98 Generate phi using pre-defined boundaries - gen_phi=ran_number(phibound(1,i),phibound(2,i)) - return - end -c--------------------------------------------------------------------------- - double precision function gen_theta(it,gama,gama1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - double precision y(2),z(2) - double precision theta_max,theta_min -c print *,'gen_theta: it=',it - theta_min=0.05D0*pi - theta_max=0.95D0*pi - if (dabs(gama).gt.dwapi) then - y(1)=dcos(gama) - y(2)=dsin(gama) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (dabs(gama1).gt.dwapi) then - z(1)=dcos(gama1) - z(2)=dsin(gama1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif - thet_pred_mean=a0thet(it) - do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it,1,1)*y(k) - & +bthet(k,it,1,1)*z(k) - enddo - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo - sig=0.5D0/(sig*sig+sigc0(it)) - ak=dexp(gthet(1,it)- - &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2) -c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) -c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak - theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak) - if (theta_temp.lt.theta_min) theta_temp=theta_min - if (theta_temp.gt.theta_max) theta_temp=theta_max - gen_theta=theta_temp -c print '(a)','Exiting GENTHETA.' - return - end -c------------------------------------------------------------------------- - subroutine gen_side(it,the,al,om,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision MaxBoxLen /10.0D0/ - double precision Ap_inv(3,3),a(3,3),z(3,maxlob),W1(maxlob), - & sumW(0:maxlob),y(2),cm(2),eig(2),box(2,2),work(100),detAp(maxlob) - double precision eig_limit /1.0D-8/ - double precision Big /10.0D0/ - double precision vec(3,3) - logical lprint,fail,lcheck - lcheck=.false. - lprint=.false. - fail=.false. - if (the.eq.0.0D0 .or. the.eq.pi) then -#ifdef MPI - write (*,'(a,i4,a,i3,a,1pe14.5)') - & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the -#else -cd write (iout,'(a,i3,a,1pe14.5)') -cd & 'Error in GenSide: it=',it,' theta=',the -#endif - fail=.true. - return - endif - tant=dtan(the-pipol) - nlobit=nlob(it) - if (lprint) then -#ifdef MPI - print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.' - write (iout,'(a,i4,a)') 'Processor:',me,' Enter Gen_Side.' -#endif - print *,'it=',it,' nlobit=',nlobit,' the=',the,' tant=',tant - write (iout,*) 'it=',it,' nlobit=',nlobit,' the=',the, - & ' tant=',tant - endif - do i=1,nlobit - zz1=tant-censc(1,i,it) - do k=1,3 - do l=1,3 - a(k,l)=gaussc(k,l,i,it) - enddo - enddo - detApi=a(2,2)*a(3,3)-a(2,3)**2 - Ap_inv(2,2)=a(3,3)/detApi - Ap_inv(2,3)=-a(2,3)/detApi - Ap_inv(3,2)=Ap_inv(2,3) - Ap_inv(3,3)=a(2,2)/detApi - if (lprint) then - write (*,'(/a,i2/)') 'Cluster #',i - write (*,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - write (iout,'(/a,i2/)') 'Cluster #',i - write (iout,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - endif - W1i=0.0D0 - do k=2,3 - do l=2,3 - W1i=W1i+a(k,1)*a(l,1)*Ap_inv(k,l) - enddo - enddo - W1i=a(1,1)-W1i - W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1) -c if (lprint) write(*,'(a,3(1pe15.5)/)') -c & 'detAp, W1, anormi',detApi,W1i,anormi - do k=2,3 - zk=censc(k,i,it) - do l=2,3 - zk=zk+zz1*Ap_inv(k,l)*a(l,1) - enddo - z(k,i)=zk - enddo - detAp(i)=dsqrt(detApi) - enddo - - if (lprint) then - print *,'W1:',(w1(i),i=1,nlobit) - print *,'detAp:',(detAp(i),i=1,nlobit) - print *,'Z' - do i=1,nlobit - print '(i2,3f10.5)',i,(rad2deg*z(j,i),j=2,3) - enddo - write (iout,*) 'W1:',(w1(i),i=1,nlobit) - write (iout,*) 'detAp:',(detAp(i),i=1,nlobit) - write (iout,*) 'Z' - do i=1,nlobit - write (iout,'(i2,3f10.5)') i,(rad2deg*z(j,i),j=2,3) - enddo - endif - if (lcheck) then -C Writing the distribution just to check the procedure - fac=0.0D0 - dV=deg2rad**2*10.0D0 - sum=0.0D0 - sum1=0.0D0 - do i=1,nlobit - fac=fac+W1(i)/detAp(i) - enddo - fac=1.0D0/(2.0D0*fac*pi) -cd print *,it,'fac=',fac - do ial=90,180,2 - y(1)=deg2rad*ial - do iom=-180,180,5 - y(2)=deg2rad*iom - wart=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo - y2=y(2) - - do iii=-1,1 - - y(2)=y2+iii*dwapi - - wykl=0.0D0 - do j=1,2 - do k=1,2 - wykl=wykl+a(j,k)*(y(j)-z(j+1,i))*(y(k)-z(k+1,i)) - enddo - enddo - wart=wart+W1(i)*dexp(-0.5D0*wykl) - - enddo - - y(2)=y2 - - enddo -c print *,'y',y(1),y(2),' fac=',fac - wart=fac*wart - write (20,'(2f10.3,1pd15.5)') y(1)*rad2deg,y(2)*rad2deg,wart - sum=sum+wart - sum1=sum1+1.0D0 - enddo - enddo -c print *,'it=',it,' sum=',sum*dV,' sum1=',sum1*dV - return - endif - -C Calculate the CM of the system -C - do i=1,nlobit - W1(i)=W1(i)/detAp(i) - enddo - sumW(0)=0.0D0 - do i=1,nlobit - sumW(i)=sumW(i-1)+W1(i) - enddo - cm(1)=z(2,1)*W1(1) - cm(2)=z(3,1)*W1(1) - do j=2,nlobit - cm(1)=cm(1)+z(2,j)*W1(j) - cm(2)=cm(2)+W1(j)*(z(3,1)+pinorm(z(3,j)-z(3,1))) - enddo - cm(1)=cm(1)/sumW(nlobit) - cm(2)=cm(2)/sumW(nlobit) - if (cm(1).gt.Big .or. cm(1).lt.-Big .or. - & cm(2).gt.Big .or. cm(2).lt.-Big) then -cd write (iout,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (iout,'(i5,2(1pe14.5))') it,cm(1),cm(2) -cd write (*,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (*,'(i5,2(1pe14.5))') it,cm(1),cm(2) - fail=.true. - return - endif -cd print *,'CM:',cm(1),cm(2) -C -C Find the largest search distance from CM -C - radmax=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo -#ifdef NAG - call f02faf('N','U',2,a,3,eig,work,100,ifail) -#else - call djacob(2,3,10000,1.0d-10,a,vec,eig) -#endif -#ifdef MPI - if (lprint) then - print *,'*************** CG Processor',me - print *,'CM:',cm(1),cm(2) - write (iout,*) '*************** CG Processor',me - write (iout,*) 'CM:',cm(1),cm(2) - print '(A,8f10.5)','Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - write (iout,'(A,8f10.5)') - & 'Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - endif -#endif - if (eig(1).lt.eig_limit) then - write(iout,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - write(*,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif - radius=0.0D0 -cd print *,'i=',i - do j=1,2 - radius=radius+pinorm(z(j+1,i)-cm(j))**2 - enddo - radius=dsqrt(radius)+3.0D0/dsqrt(eig(1)) - if (radius.gt.radmax) radmax=radius - enddo - if (radmax.gt.pi) radmax=pi -C -C Determine the boundaries of the search rectangle. -C - if (lprint) then - print '(a,4(1pe14.4))','W1: ',(W1(i),i=1,nlob(it) ) - print '(a,4(1pe14.4))','radmax: ',radmax - endif - box(1,1)=dmax1(cm(1)-radmax,0.0D0) - box(2,1)=dmin1(cm(1)+radmax,pi) - box(1,2)=cm(2)-radmax - box(2,2)=cm(2)+radmax - if (lprint) then -#ifdef MPI - print *,'CG Processor',me,' Array BOX:' -#else - print *,'Array BOX:' -#endif - print '(4(1pe14.4))',((box(k,j),k=1,2),j=1,2) - print '(a,4(1pe14.4))','sumW: ',(sumW(i),i=0,nlob(it) ) -#ifdef MPI - write (iout,*)'CG Processor',me,' Array BOX:' -#else - write (iout,*)'Array BOX:' -#endif - write(iout,'(4(1pe14.4))') ((box(k,j),k=1,2),j=1,2) - write(iout,'(a,4(1pe14.4))')'sumW: ',(sumW(i),i=0,nlob(it) ) - endif - if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then -#ifdef MPI - write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' - write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' -#else -c write (iout,'(a)') 'Bad sampling box.' -#endif - fail=.true. - return - endif - which_lobe=ran_number(0.0D0,sumW(nlobit)) -c print '(a,1pe14.4)','which_lobe=',which_lobe - do i=1,nlobit - if (sumW(i-1).le.which_lobe .and. sumW(i).ge.which_lobe) goto 1 - enddo - 1 ilob=i -c print *,'ilob=',ilob,' nlob=',nlob(it) - do i=2,3 - cm(i-1)=z(i,ilob) - do j=2,3 - a(i-1,j-1)=gaussc(i,j,ilob,it) - enddo - enddo -cd print '(a,i4,a)','CG Processor',me,' Calling MultNorm1.' - call mult_norm1(3,2,a,cm,box,y,fail) - if (fail) return - al=y(1) - om=pinorm(y(2)) -cd print *,'al=',al,' om=',om -cd stop - return - end -c--------------------------------------------------------------------------- - double precision function ran_number(x1,x2) -C Calculate a random real number from the range (x1,x2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - double precision x1,x2,fctor - data fctor /2147483647.0D0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ran_number=x1+(x2-x1)*prng_next(me) -#else - call vrnd(ix,1) - ran_number=x1+(x2-x1)*ix/fctor -#endif - return - end -c-------------------------------------------------------------------------- - integer function iran_num(n1,n2) -C Calculate a random integer number from the range (n1,n2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer n1,n2,ix - real fctor /2147483647.0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ix=n1+(n2-n1+1)*prng_next(me) - if (ix.lt.n1) ix=n1 - if (ix.gt.n2) ix=n2 - iran_num=ix -#else - call vrnd(ix,1) - ix=n1+(n2-n1+1)*(ix/fctor) - if (ix.gt.n2) ix=n2 - iran_num=ix -#endif - return - end -c-------------------------------------------------------------------------- - double precision function binorm(x1,x2,sigma1,sigma2,ak) - implicit real*8 (a-h,o-z) -c print '(a)','Enter BINORM.' - alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2) - aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2) - seg=sigma1/(sigma1+ak*sigma2) - alen=ran_number(0.0D0,1.0D0) - if (alen.lt.seg) then - binorm=anorm_distr(x1,sigma1,alowb,aupb) - else - binorm=anorm_distr(x2,sigma2,alowb,aupb) - endif -c print '(a)','Exiting BINORM.' - return - end -c----------------------------------------------------------------------- -c double precision function anorm_distr(x,sigma,alowb,aupb) -c implicit real*8 (a-h,o-z) -c print '(a)','Enter ANORM_DISTR.' -c 10 y=ran_number(alowb,aupb) -c expon=dexp(-0.5D0*((y-x)/sigma)**2) -c ran=ran_number(0.0D0,1.0D0) -c if (expon.lt.ran) goto 10 -c anorm_distr=y -c print '(a)','Exiting ANORM_DISTR.' -c return -c end -c----------------------------------------------------------------------- - double precision function anorm_distr(x,sigma,alowb,aupb) - implicit real*8 (a-h,o-z) -c to make a normally distributed deviate with zero mean and unit variance -c - integer iset - real fac,gset,rsq,v1,v2,ran1 - save iset,gset - data iset/0/ - if(iset.eq.0) then -1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - rsq=v1**2+v2**2 - if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1 - fac=sqrt(-2.0d0*log(rsq)/rsq) - gset=v1*fac - gaussdev=v2*fac - iset=1 - else - gaussdev=gset - iset=0 - endif - anorm_distr=x+gaussdev*sigma - return - end -c------------------------------------------------------------------------ - subroutine mult_norm(lda,n,a,x,fail) -C -C Generate the vector X whose elements obey the multiple-normal distribution -C from exp(-0.5*X'AX). LDA is the leading dimension of the moment matrix A, -C n is the dimension of the problem. FAIL is set at .TRUE., if the smallest -C eigenvalue of the matrix A is close to 0. -C - implicit double precision (a-h,o-z) - double precision a(lda,n),x(n),eig(100),vec(3,3),work(100) - double precision eig_limit /1.0D-8/ - logical fail - fail=.false. -c print '(a)','Enter MULT_NORM.' -C -C Find the smallest eigenvalue of the matrix A. -C -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo -#ifdef NAG - call f02faf('V','U',2,a,lda,eig,work,100,ifail) -#else - call djacob(2,lda,10000,1.0d-10,a,vec,eig) -#endif -c print '(8f10.5)',(eig(i),i=1,n) -C print '(a)' -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo - if (eig(1).lt.eig_limit) then - print *,'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C - do i=1,n - sigma=1.0D0/dsqrt(eig(i)) - alim=-3.0D0*sigma - work(i)=anorm_distr(0.0D0,sigma,-alim,alim) - enddo -C -C Transform the vector of normal variables back to the original basis. -C - do i=1,n - xi=0.0D0 - do j=1,n - xi=xi+a(i,j)*work(j) - enddo - x(i)=xi - enddo - return - end -c------------------------------------------------------------------------ - subroutine mult_norm1(lda,n,a,z,box,x,fail) -C -C Generate the vector X whose elements obey the multi-gaussian multi-dimensional -C distribution from sum_{i=1}^m W(i)exp[-0.5*X'(i)A(i)X(i)]. LDA is the -C leading dimension of the moment matrix A, n is the dimension of the -C distribution, nlob is the number of lobes. FAIL is set at .TRUE., if the -C smallest eigenvalue of the matrix A is close to 0. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - double precision a(lda,n),z(n),x(n),box(n,n) - double precision etmp - include 'COMMON.IOUNITS' -#ifdef MP - include 'COMMON.SETUP' -#endif - logical fail -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C -cd print *,'CG Processor',me,' entered MultNorm1.' -cd print '(2(1pe14.4),3x,1pe14.4)',((a(i,j),j=1,2),z(i),i=1,2) -cd do i=1,n -cd print *,i,box(1,i),box(2,i) -cd enddo - istep = 0 - 10 istep = istep + 1 - if (istep.gt.10000) then -c write (iout,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (*,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (iout,*) 'box',box -c write (iout,*) 'a',a -c write (iout,*) 'z',z - fail=.true. - return - endif - do i=1,n - x(i)=ran_number(box(1,i),box(2,i)) - enddo - ww=0.0D0 - do i=1,n - xi=pinorm(x(i)-z(i)) - ww=ww+0.5D0*a(i,i)*xi*xi - do j=i+1,n - ww=ww+a(i,j)*xi*pinorm(x(j)-z(j)) - enddo - enddo - dec=ran_number(0.0D0,1.0D0) -c print *,(x(i),i=1,n),ww,dexp(-ww),dec -crc if (dec.gt.dexp(-ww)) goto 10 - if(-ww.lt.100) then - etmp=dexp(-ww) - else - return - endif - if (dec.gt.etmp) goto 10 -cd print *,'CG Processor',me,' exitting MultNorm1.' - return - end -c -crc-------------------------------------- - subroutine overlap_sc(scfail) -c Internal and cartesian coordinates must be consistent as input, -c and will be up-to-date on return. -c At the end of this procedure, scfail is true if there are -c overlapping residues left, or false otherwise (success) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical had_overlaps,fail,scfail - integer ioverlap(maxres),ioverlap_last - - had_overlaps=.false. - call overlap_sc_list(ioverlap,ioverlap_last) - if (ioverlap_last.gt.0) then - write (iout,*) '#OVERLAPing residues ',ioverlap_last - write (iout,'(20i4)') (ioverlap(k),k=1,ioverlap_last) - had_overlaps=.true. - endif - - maxsi=1000 - do k=1,1000 - if (ioverlap_last.eq.0) exit - - do ires=1,ioverlap_last - i=ioverlap(ires) - iti=abs(itype(i)) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) goto 999 - endif - enddo - - call chainbuild - call overlap_sc_list(ioverlap,ioverlap_last) -c write (iout,*) 'Overlaping residues ',ioverlap_last, -c & (ioverlap(j),j=1,ioverlap_last) - enddo - - if (k.le.1000.and.ioverlap_last.eq.0) then - scfail=.false. - if (had_overlaps) then - write (iout,*) '#OVERLAPing all corrected after ',k, - & ' random generation' - endif - else - scfail=.true. - write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last - write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last) - endif - - return - - 999 continue - write (iout,'(a30,i5,a12,i4)') - & '#OVERLAP FAIL in gen_side after',maxsi, - & 'iter for RES',i - scfail=.true. - return - end - - subroutine overlap_sc_list(ioverlap,ioverlap_last) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.CALC' - logical fail - integer ioverlap(maxres),ioverlap_last - data redfac /0.5D0/ - - ioverlap_last=0 -C Check for SC-SC overlaps and mark residues -c print *,'>>overlap_sc nnt=',nnt,' nct=',nct - ind=0 - do i=iatsc_s,iatsc_e - itypi=abs(itype(i)) - itypi1=abs(itype(i+1)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -c - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - if (j.gt.i+1) then - rcomp=sigmaii(itypi,itypj) - else - rcomp=sigma(itypi,itypj) - endif -c print '(2(a3,2i3),a3,2f10.5)', -c & ' i=',i,iti,' j=',j,itj,' d=',dist(nres+i,nres+j) -c & ,rcomp - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij - -ct if ( 1.0/rij .lt. redfac*rcomp .or. -ct & rij_shift.le.0.0D0 ) then - if ( rij_shift.le.0.0D0 ) then -cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)') -cd & 'overlap SC-SC: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,nres+j),' rcomp=', -cd & rcomp,1.0/rij,rij_shift - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=i - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.i) ioverlap_last=ioverlap_last-1 - enddo - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=j - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1 - enddo - endif - enddo - enddo - enddo - return - end diff --git a/source/unres/src_CSA_DiL/geomout_min.F b/source/unres/src_CSA_DiL/geomout_min.F deleted file mode 100644 index e634c5a..0000000 --- a/source/unres/src_CSA_DiL/geomout_min.F +++ /dev/null @@ -1,348 +0,0 @@ - subroutine pdbout(etot,tytul,iunit) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD_' - character*50 tytul - dimension ica(maxres) - write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot -cmodel write (iunit,'(a5,i6)') 'MODEL',1 - if (nhfrag.gt.0) then - do j=1,nhfrag - iti=itype(hfrag(1,j)) - itj=itype(hfrag(2,j)) - if (j.lt.10) then - write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - else - write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - endif - enddo - endif - - if (nbfrag.gt.0) then - - do j=1,nbfrag - - iti=itype(bfrag(1,j)) - itj=itype(bfrag(2,j)-1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') - & 'SHEET',1,'B',j,2, - & restyp(iti),bfrag(1,j)-1, - & restyp(itj),bfrag(2,j)-2,0 - - if (bfrag(3,j).gt.bfrag(4,j)) then - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)+1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itl),bfrag(4,j), - & restyp(itk),bfrag(3,j)-1,-1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - else - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)-1) - - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itk),bfrag(3,j)-1, - & restyp(itl),bfrag(4,j)-2,1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - - - endif - - enddo - endif - - if (nss.gt.0) then - do i=1,nss - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-1-nres, - & 'CYS',jhpb(i)-1-nres - enddo - endif - - iatom=0 - do i=nnt,nct - ires=i-nnt+1 - iatom=iatom+1 - ica(i)=iatom - iti=itype(i) - write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i) - if (iti.ne.10) then - iatom=iatom+1 - write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), - & vtot(i+nres) - endif - enddo - write (iunit,'(a)') 'TER' - do i=nnt,nct-1 - if (itype(i).eq.10) then - write (iunit,30) ica(i),ica(i+1) - else - write (iunit,30) ica(i),ica(i+1),ica(i)+1 - endif - enddo - if (itype(nct).ne.10) then - write (iunit,30) ica(nct),ica(nct)+1 - endif - do i=1,nss - write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 - enddo - write (iunit,'(a6)') 'ENDMDL' - 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) - 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I5) - return - end -c------------------------------------------------------------------------------ - subroutine MOL2out(etot,tytul) -C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 -C format. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - character*50 tytul,fd - character*3 zahl - character*6 res_num,pom,ucase -#ifdef AIX - call fdate_(fd) -#elif (defined CRAY) - call date(fd) -#else - call fdate(fd) -#endif - write (imol2,'(a)') '#' - write (imol2,'(a)') - & '# Creating user name: unres' - write (imol2,'(2a)') '# Creation time: ', - & fd - write (imol2,'(/a)') '\@MOLECULE' - write (imol2,'(a)') tytul - write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 - write (imol2,'(a)') 'SMALL' - write (imol2,'(a)') 'USER_CHARGES' - write (imol2,'(a)') '\@ATOM' - do i=nnt,nct - write (zahl,'(i3)') i - pom=ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 - enddo - write (imol2,'(a)') '\@BOND' - do i=nnt,nct-1 - write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 - enddo - do i=1,nss - write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 - enddo - write (imol2,'(a)') '\@SUBSTRUCTURE' - do i=nnt,nct - write (zahl,'(i3)') i - pom = ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 - enddo - 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') - 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') - return - end -c------------------------------------------------------------------------ - subroutine intout - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - write (iout,'(/a)') 'Geometry of the virtual chain.' - write (iout,'(7a)') ' Res ',' d',' Theta', - & ' Gamma',' Dsc',' Alpha',' Beta ' - do i=1,nres - iti=itype(i) - write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), - & rad2deg*omeg(i) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine briefout(it,ener) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' -c print '(a,i5)',intname,igeom -#if defined(AIX) || defined(PGI) - open (igeom,file=intname,position='append') -#else - open (igeom,file=intname,access='append') -#endif - IF (NSS.LE.9) THEN - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) - ELSE - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) - WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) - ENDIF -c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) -c if (nvar.gt.nphi+ntheta) then - write (igeom,200) (rad2deg*alph(i),i=2,nres-1) - write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) -c endif - close(igeom) - 180 format (I5,F12.3,I2,9(1X,2I3)) - 190 format (3X,11(1X,2I3)) - 200 format (8F10.4) - return - end -#ifdef WINIFL - subroutine fdate(fd) - character*32 fd - write(fd,'(32x)') - return - end -#endif -c----------------------------------------------------------------- - subroutine statout(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD_' -c include 'COMMON.REMD' - include 'COMMON.SETUP' - integer itime - double precision energia(0:n_ene) - double precision gyrate - external gyrate - common /gucio/ cm - character*256 line1,line2 - character*4 format1,format2 - character*30 format -#ifdef AIX - if(itime.eq.0) then - open(istat,file=statname,position="append") - endif -#else -#ifdef PGI - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif -#endif - if (refstr) then -c call rms_nac_nnc(rms,frac,frac_nn,co,.false.) - write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a133" - else - write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a114" - endif - if(usampl.and.totT.gt.eq_time) then - write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, - & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair - & +21*nfrag_back - elseif(hremd.gt.0) then - write(line2,'(i5)') iset - format2="a005" - else - format2="a001" - line2=' ' - endif - if (print_compon) then - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",20f12.3)" - write (istat,format) line1,line2, - & (potEcomp(print_order(i)),i=1,nprint_ene) - else - write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" - write (istat,format) line1,line2 - endif -#if defined(AIX) - call flush(istat) -#else - close(istat) -#endif - return - end -c--------------------------------------------------------------- - double precision function gyrate() - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision cen(3),rg - - do j=1,3 - cen(j)=0.0d0 - enddo - - do i=nnt,nct - do j=1,3 - cen(j)=cen(j)+c(j,i) - enddo - enddo - do j=1,3 - cen(j)=cen(j)/dble(nct-nnt+1) - enddo - rg = 0.0d0 - do i = nnt, nct - do j=1,3 - rg = rg + (c(j,i)-cen(j))**2 - enddo - end do - gyrate = sqrt(rg/dble(nct-nnt+1)) - return - end - diff --git a/source/unres/src_CSA_DiL/gradient_p.F b/source/unres/src_CSA_DiL/gradient_p.F deleted file mode 100644 index 25d1b12..0000000 --- a/source/unres/src_CSA_DiL/gradient_p.F +++ /dev/null @@ -1,408 +0,0 @@ - subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD_' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c This subroutine calculates total internal coordinate gradient. -c Depending on the number of function evaluations, either whole energy -c is evaluated beforehand, Cartesian coordinates and their derivatives in -c internal coordinates are reevaluated or only the cartesian-in-internal -c coordinate derivatives are evaluated. The subroutine was designed to work -c with SUMSL. -c -c - icg=mod(nf,2)+1 - -cd print *,'grad',nf,icg - if (nf-nfl+1) 20,30,40 - 20 call func(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom(n,x) - call chainbuild -c write (iout,*) 'grad 30' -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -c write (iout,*) 'grad 40' -c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - ind=0 - ind1=0 - do i=1,nres-2 - gthetai=0.0D0 - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 -c ind=indmat(i,j) -c print *,'GRAD: i=',i,' jc=',j,' ind=',ind - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - enddo - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - enddo - enddo - do j=i+1,nres-1 - ind1=ind1+1 -c ind1=indmat(i,j) -c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 - do k=1,3 - gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) - gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) - enddo - enddo - if (i.gt.1) g(i-1)=gphii - if (n.gt.nphi) g(nphi+i)=gthetai - enddo - if (n.le.nphi+ntheta) goto 10 - do i=2,nres-1 - if (itype(i).ne.10) then - galphai=0.0D0 - gomegai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ialph(i,1))=galphai - g(ialph(i,1)+nside)=gomegai - endif - enddo -C -C Add the components corresponding to local energy terms. -C - 10 continue - do i=1,nvar -cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg) - g(i)=g(i)+gloc(i,icg) - enddo -C Uncomment following three lines for diagnostics. -cd call intout -cd call briefout(0,0.0d0) -cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n) - return - end -C------------------------------------------------------------------------- - subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 continue -#ifdef OSF -c Intercept NaNs in the coordinates -c write(iout,*) (var(i),i=1,nvar) - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - if (x_sum.ne.x_sum) then - write(iout,*)" *** grad_restr : Found NaN in coordinates" - call flush(iout) - print *," *** grad_restr : Found NaN in coordinates" - return - endif -#endif - call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C------------------------------------------------------------------------- - subroutine cartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD_' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -c -c This subrouting calculates total Cartesian coordinate gradient. -c The subroutine chainbuild_cart and energy MUST be called beforehand. -c -#ifdef TIMING - time00=MPI_Wtime() -#endif - icg=1 - call sum_gradient -#ifdef TIMING -#endif -cd write (iout,*) "After sum_gradient" -cd do i=1,nres-1 -cd write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) -cd write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) -cd enddo -c If performing constraint dynamics, add the gradients of the constraint energy - if(usampl.and.totT.gt.eq_time) then - do i=1,nct - do j=1,3 - gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i) - gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i) - enddo - enddo - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+dugamma(i) - enddo - do i=1,nres-2 - gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) - enddo - endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - call intcartderiv -#ifdef TIMING - time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 -#endif -cd call checkintcartgrad -cd write(iout,*) 'calling int_to_cart' -cd write (iout,*) "gcart, gxcart, gloc before int_to_cart" - do i=1,nct - do j=1,3 - gcart(j,i)=gradc(j,i,icg) - gxcart(j,i)=gradx(j,i,icg) - enddo -cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3),gloc(i,icg) - enddo -#ifdef TIMING - time01=MPI_Wtime() -#endif - call int_to_cart -#ifdef TIMING - time_inttocart=time_inttocart+MPI_Wtime()-time01 -#endif -cd write (iout,*) "gcart and gxcart after int_to_cart" -cd do i=0,nres-1 -cd write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3) -cd enddo -#ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 -#endif - return - end -C------------------------------------------------------------------------- - subroutine zerograd - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD_' -C -C Initialize Cartesian-coordinate gradient -C - do i=1,nres - do j=1,3 - gvdwx(j,i)=0.0D0 - gvdwxT(j,i)=0.0D0 - gradx_scp(j,i)=0.0D0 - gvdwc(j,i)=0.0D0 - gvdwcT(j,i)=0.0D0 - gvdwc_scp(j,i)=0.0D0 - gvdwc_scpp(j,i)=0.0d0 - gelc (j,i)=0.0D0 - gelc_long(j,i)=0.0D0 - gradb(j,i)=0.0d0 - gradbx(j,i)=0.0d0 - gvdwpp(j,i)=0.0d0 - gel_loc(j,i)=0.0d0 - gel_loc_long(j,i)=0.0d0 - ghpbc(j,i)=0.0D0 - ghpbx(j,i)=0.0D0 - gcorr3_turn(j,i)=0.0d0 - gcorr4_turn(j,i)=0.0d0 - gradcorr(j,i)=0.0d0 - gradcorr_long(j,i)=0.0d0 - gradcorr5_long(j,i)=0.0d0 - gradcorr6_long(j,i)=0.0d0 - gcorr6_turn_long(j,i)=0.0d0 - gradcorr5(j,i)=0.0d0 - gradcorr6(j,i)=0.0d0 - gcorr6_turn(j,i)=0.0d0 - gsccorc(j,i)=0.0d0 - gsccorx(j,i)=0.0d0 - gradc(j,i,icg)=0.0d0 - gradx(j,i,icg)=0.0d0 - gscloc(j,i)=0.0d0 - gsclocx(j,i)=0.0d0 - enddo - enddo -C -C Initialize the gradient of local energy terms. -C - do i=1,4*nres - gloc(i,icg)=0.0D0 - enddo - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - g_corr5_loc(i)=0.0d0 - g_corr6_loc(i)=0.0d0 - gel_loc_turn3(i)=0.0d0 - gel_loc_turn4(i)=0.0d0 - gel_loc_turn6(i)=0.0d0 - gsccor_loc(i)=0.0d0 - enddo -c initialize gcart and gxcart - do i=0,nres - do j=1,3 - gcart(j,i)=0.0d0 - gxcart(j,i)=0.0d0 - enddo - enddo - return - end -c------------------------------------------------------------------------- - double precision function fdum() - fdum=0.0D0 - return - end diff --git a/source/unres/src_CSA_DiL/indexx.f b/source/unres/src_CSA_DiL/indexx.f deleted file mode 100644 index b903862..0000000 --- a/source/unres/src_CSA_DiL/indexx.f +++ /dev/null @@ -1,81 +0,0 @@ - SUBROUTINE indexx(n,arr,indx) - implicit real*8 (a-h,o-z) - INTEGER n,indx(n),M,NSTACK - REAL*8 arr(n) -c PARAMETER (M=7,NSTACK=50) - PARAMETER (M=7,NSTACK=500) - INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(NSTACK) - REAL*8 a - do 11 j=1,n - indx(j)=j -11 continue - jstack=0 - l=1 - ir=n -1 if(ir-l.lt.M)then - do 13 j=l+1,ir - indxt=indx(j) - a=arr(indxt) - do 12 i=j-1,1,-1 - if(arr(indx(i)).le.a)goto 2 - indx(i+1)=indx(i) -12 continue - i=0 -2 indx(i+1)=indxt -13 continue - if(jstack.eq.0)return - ir=istack(jstack) - l=istack(jstack-1) - jstack=jstack-2 - else - k=(l+ir)/2 - itemp=indx(k) - indx(k)=indx(l+1) - indx(l+1)=itemp - if(arr(indx(l+1)).gt.arr(indx(ir)))then - itemp=indx(l+1) - indx(l+1)=indx(ir) - indx(ir)=itemp - endif - if(arr(indx(l)).gt.arr(indx(ir)))then - itemp=indx(l) - indx(l)=indx(ir) - indx(ir)=itemp - endif - if(arr(indx(l+1)).gt.arr(indx(l)))then - itemp=indx(l+1) - indx(l+1)=indx(l) - indx(l)=itemp - endif - i=l+1 - j=ir - indxt=indx(l) - a=arr(indxt) -3 continue - i=i+1 - if(arr(indx(i)).lt.a)goto 3 -4 continue - j=j-1 - if(arr(indx(j)).gt.a)goto 4 - if(j.lt.i)goto 5 - itemp=indx(i) - indx(i)=indx(j) - indx(j)=itemp - goto 3 -5 indx(l)=indx(j) - indx(j)=indxt - jstack=jstack+2 - if(jstack.gt.NSTACK)pause 'NSTACK too small in indexx' - if(ir-i+1.ge.j-l)then - istack(jstack)=ir - istack(jstack-1)=i - ir=j-1 - else - istack(jstack)=j-1 - istack(jstack-1)=l - l=i - endif - endif - goto 1 - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915aZ%. diff --git a/source/unres/src_CSA_DiL/initialize_p.F b/source/unres/src_CSA_DiL/initialize_p.F deleted file mode 100644 index 015faac..0000000 --- a/source/unres/src_CSA_DiL/initialize_p.F +++ /dev/null @@ -1,1416 +0,0 @@ - block data - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' -c include 'COMMON.MD' - data MovTypID - & /'pool','chain regrow','multi-bond','phi','theta','side chain', - & 'total'/ -c Conversion from poises to molecular unit and the gas constant -c data cPoise /2.9361d0/, Rb /0.001986d0/ - end -c-------------------------------------------------------------------------- - subroutine initialize -C -C Define constants and zero out tables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MCM' - include 'COMMON.MINIM' - include 'COMMON.DERIV' - include 'COMMON.SPLITELE' -c Common blocks from the diagonalization routines - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - logical mask_r -c real*8 text1 /'initial_i'/ - - mask_r=.false. -#ifndef ISNAN -c NaNQ initialization - i=-1 - arg=100.0d0 - rr=dacos(arg) -#ifdef WINPGI - idumm=proc_proc(rr,i) -#else - call proc_proc(rr,i) -#endif -#endif - - kdiag=0 - icorfl=0 - iw=2 -C -C The following is just to define auxiliary variables used in angle conversion -C - pi=4.0D0*datan(1.0D0) - dwapi=2.0D0*pi - dwapi3=dwapi/3.0D0 - pipol=0.5D0*pi - deg2rad=pi/180.0D0 - rad2deg=1.0D0/deg2rad - angmin=10.0D0*deg2rad -C -C Define I/O units. -C - inp= 1 - iout= 2 - ipdbin= 3 - ipdb= 7 - icart = 30 - imol2= 4 - igeom= 8 - intin= 9 - ithep= 11 - ithep_pdb=51 - irotam=12 - irotam_pdb=52 - itorp= 13 - itordp= 23 - ielep= 14 - isidep=15 - iscpp=25 - icbase=16 - ifourier=20 - istat= 17 - irest1=55 - irest2=56 - iifrag=57 - ientin=18 - ientout=19 - ibond = 28 - isccor = 29 -crc for write_rmsbank1 - izs1=21 -cdr include secondary structure prediction bias - isecpred=27 -C -C CSA I/O units (separated from others especially for Jooyoung) -C - icsa_rbank=30 - icsa_seed=31 - icsa_history=32 - icsa_bank=33 - icsa_bank1=34 - icsa_alpha=35 - icsa_alpha1=36 - icsa_bankt=37 - icsa_int=39 - icsa_bank_reminimized=38 - icsa_native_int=41 - icsa_in=40 -crc for ifc error 118 - icsa_pdb=42 -C -C Set default weights of the energy terms. -C - wlong=1.0D0 - welec=1.0D0 - wtor =1.0D0 - wang =1.0D0 - wscloc=1.0D0 - wstrain=1.0D0 -C -C Zero out tables. -C - print '(a,$)','Inside initialize' -c call memmon_print_usage() - do i=1,maxres2 - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 - enddo - enddo - do i=1,maxres - do j=1,3 - xloc(j,i)=0.0D0 - enddo - enddo - do i=1,ntyp - do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - augm(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 - chi(i,j)=0.0D0 - enddo - do j=1,2 - bad(i,j)=0.0D0 - enddo - chip(i)=0.0D0 - alp(i)=0.0D0 - sigma0(i)=0.0D0 - sigii(i)=0.0D0 - rr0(i)=0.0D0 - a0thet(i)=0.0D0 - do j=1,2 - do ichir1=-1,1 - do ichir2=-1,1 - athet(j,i,ichir1,ichir2)=0.0D0 - bthet(j,i,ichir1,ichir2)=0.0D0 - enddo - enddo - enddo - do j=0,3 - polthet(j,i)=0.0D0 - enddo - do j=1,3 - gthet(j,i)=0.0D0 - enddo - theta0(i)=0.0D0 - sig0(i)=0.0D0 - sigc0(i)=0.0D0 - do j=1,maxlob - bsc(j,i)=0.0D0 - do k=1,3 - censc(k,j,i)=0.0D0 - enddo - do k=1,3 - do l=1,3 - gaussc(l,k,j,i)=0.0D0 - enddo - enddo - nlob(i)=0 - enddo - enddo - nlob(ntyp1)=0 - dsc(ntyp1)=0.0D0 - do i=-maxtor,maxtor - itortyp(i)=0 - do iblock=1,2 - do j=-maxtor,maxtor - do k=1,maxterm - v1(k,j,i,iblock)=0.0D0 - v2(k,j,i,iblock)=0.0D0 - enddo - enddo - enddo - enddo - do iblock=1,2 - do i=-maxtor,maxtor - do j=-maxtor,maxtor - do k=-maxtor,maxtor - do l=1,maxtermd_1 - v1c(1,l,i,j,k,iblock)=0.0D0 - v1s(1,l,i,j,k,iblock)=0.0D0 - v1c(2,l,i,j,k,iblock)=0.0D0 - v1s(2,l,i,j,k,iblock)=0.0D0 - enddo !l - do l=1,maxtermd_2 - do m=1,maxtermd_2 - v2c(m,l,i,j,k,iblock)=0.0D0 - v2s(m,l,i,j,k,iblock)=0.0D0 - enddo !m - enddo !l - enddo !k - enddo !j - enddo !i - enddo !i - do i=1,maxres - itype(i)=0 - itel(i)=0 - enddo -C Initialize the bridge arrays - ns=0 - nss=0 - nhpb=0 - do i=1,maxss - iss(i)=0 - enddo - do i=1,maxdim - dhpb(i)=0.0D0 - enddo - do i=1,maxres - ihpb(i)=0 - jhpb(i)=0 - enddo -C -C Initialize timing. -C - call set_timers -C -C Initialize variables used in minimization. -C -c maxfun=5000 -c maxit=2000 - maxfun=500 - maxit=200 - tolf=1.0D-2 - rtolf=5.0D-4 -C -C Initialize the variables responsible for the mode of gradient storage. -C - nfl=0 - icg=1 -C -C Initialize constants used to split the energy into long- and short-range -C components -C - r_cut=2.0d0 - rlamb=0.3d0 -#ifndef SPLITELE - nprint_ene=nprint_ene-1 -#endif - return - end -c------------------------------------------------------------------------- - block data nazwy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - data restyp / - &'DD' ,'DPR','DLY','DAR','DHI','DAS','DGL','DSG','DGN','DSN','DTH', - &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER', - &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ - data onelet / - &'z','p','k','r','h','d','e','n','q','s','t','g', - &'a','y','w','v','l','i','f','m','c','x', - &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ - data potname /'LJ','LJK','BP','GB','GBV'/ - data ename / - & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", - & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", - & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", - & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ", - & "DFA DIS","DFA TOR","DFA NEI","DFA BET"/ - data wname / - & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", - & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR", - & " "," ","WDFAD","WDFAT","WDFAN","WDFAB"/ - data nprint_ene /24/ - data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, - & 21,24,25,26,27,0,0,0/ - end -c--------------------------------------------------------------------------- - subroutine init_int_table - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer blocklengths(15),displs(15) -#endif - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.SBRIDGE' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1), - & ntask_cont_from_all(0:max_fg_procs-1), - & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), - & ntask_cont_to_all(0:max_fg_procs-1), - & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) - integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP - logical scheck,lprint,flag -#ifdef MPI - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - do i=0,nfgtasks-1 - itask_cont_from(i)=fg_rank - itask_cont_to(i)=fg_rank - enddo - lprint=.false. - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif -c lprint=.false. - do i=1,maxres - nint_gr(i)=0 - nscp_gr(i)=0 - do j=1,maxint_gr - istart(i,1)=0 - iend(i,1)=0 - ielstart(i)=0 - ielend(i)=0 - iscpstart(i,1)=0 - iscpend(i,1)=0 - enddo - enddo - ind_scint=0 - ind_scint_old=0 -cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', -cd & (ihpb(i),jhpb(i),i=1,nss) - do i=nnt,nct-1 - scheck=.false. - do ii=1,nss - if (ihpb(ii).eq.i+nres) then - scheck=.true. - jj=jhpb(ii)-nres - goto 10 - endif - enddo - 10 continue -cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj - if (scheck) then - if (jj.eq.i+1) then -#ifdef MPI -c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+2 - iend(i,1)=nct -#endif - else if (jj.eq.nct) then -#ifdef MPI -c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct-1 -#endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else - nint_gr(i)=2 - istart(i,1)=i+1 - iend(i,1)=jj-1 - istart(i,2)=jj+1 - iend(i,2)=nct -#endif - endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct - ind_scint=ind_scint+nct-i -#endif - endif -#ifdef MPI - ind_scint_old=ind_scint -#endif - enddo - 12 continue -#ifndef MPI - iatsc_s=nnt - iatsc_e=nct-1 -#endif -#ifdef MPI - if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor, - & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e -#endif - if (lprint) then - write (iout,'(a)') 'Interaction array:' - do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') - & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) - enddo - endif - ispp=4 -#ifdef MPI -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue - if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 -c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) -c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, -c & " my_ele_inde_vdw",my_ele_inde_vdw - ind_eleint_vdw=0 - ind_eleint_vdw_old=0 - iatel_s_vdw=0 - iatel_e_vdw=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, - & my_ele_inde_vdw,i, - & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), - & ielend_vdw(i),*15) -c write (iout,*) i," ielstart_vdw",ielstart_vdw(i), -c & " ielend_vdw",ielend_vdw(i) - enddo ! i - if (iatel_s_vdw.eq.0) iatel_s_vdw=1 - 15 continue -#else - iatel_s=nnt - iatel_e=nct-5 - do i=iatel_s,iatel_e - ielstart(i)=i+4 - ielend(i)=nct-1 - enddo - iatel_s_vdw=nnt - iatel_e_vdw=nct-3 - do i=iatel_s_vdw,iatel_e_vdw - ielstart_vdw(i)=i+2 - ielend_vdw(i)=nct-1 - enddo -#endif - if (lprint) then - write (*,'(a)') 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank - write (iout,*) 'Electrostatic interaction array:' - do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) - enddo - endif ! lprint -c iscp=3 - iscp=2 -C Partition the SC-p interaction array -#ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else - iatscp_s=nnt - iatscp_e=nct-1 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=i+iscp - iscpend(i,1)=nct - elseif (i.gt.nct-iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - else - nscp_gr(i)=2 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - iscpstart(i,2)=i+iscp - iscpend(i,2)=nct - endif - enddo ! i -#endif - if (lprint) then - write (iout,'(a)') 'SC-p interaction array:' - do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') - & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) - enddo - endif ! lprint -C Partition local interactions -#ifdef MPI - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iturn3_start,iturn3_end) - iturn3_start=iturn3_start+nnt - iphi_start=iturn3_start+2 - iturn3_end=iturn3_end+nnt - iphi_end=iturn3_end+2 - iturn3_start=iturn3_start-1 - iturn3_end=iturn3_end-1 - call int_bounds(nres-3,iphi1_start,iphi1_end) - iphi1_start=iphi1_start+3 - iphi1_end=iphi1_end+3 - call int_bounds(nct-nnt-3,iturn4_start,iturn4_end) - iturn4_start=iturn4_start+nnt - iphid_start=iturn4_start+2 - iturn4_end=iturn4_end+nnt - iphid_end=iturn4_end+2 - iturn4_start=iturn4_start-1 - iturn4_end=iturn4_end-1 - call int_bounds(nres-2,ibond_start,ibond_end) - ibond_start=ibond_start+1 - ibond_end=ibond_end+1 - call int_bounds(nct-nnt,ibondp_start,ibondp_end) - ibondp_start=ibondp_start+nnt - ibondp_end=ibondp_end+nnt - call int_bounds1(nres-1,ivec_start,ivec_end) - print *,"Processor",myrank,fg_rank,fg_rank1, - & " ivec_start",ivec_start," ivec_end",ivec_end - iset_start=loc_start+2 - iset_end=loc_end+2 - if (ndih_constr.eq.0) then - idihconstr_start=1 - idihconstr_end=0 - else - call int_bounds(ndih_constr,idihconstr_start,idihconstr_end) - endif - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo - if (lprint) then - write (*,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end, - & ' iphid_start',iphid_start,' iphid_end',iphid_end, - & ' ibond_start',ibond_start,' ibond_end',ibond_end, - & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end, - & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end, - & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end, - & ' ivec_start',ivec_start,' ivec_end',ivec_end, - & ' iset_start',iset_start,' iset_end',iset_end, - & ' idihconstr_start',idihconstr_start,' idihconstr_end', - & idihconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo - endif - if (nfgtasks.gt.1) then - call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - iaux=ivec_end-ivec_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iset_end-iset_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ibond_end-ibond_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ithet_end-ithet_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi_end-iphi_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi1_end-iphi1_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - do i=0,maxprocs-1 - do j=1,maxres - ielstart_all(j,i)=0 - ielend_all(j,i)=0 - enddo - enddo - call MPI_Allgather(iturn3_start,1,MPI_INTEGER, - & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_start,1,MPI_INTEGER, - & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn3_end,1,MPI_INTEGER, - & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_end,1,MPI_INTEGER, - & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_s,1,MPI_INTEGER, - & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_e,1,MPI_INTEGER, - & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER, - & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielend(1),maxres,MPI_INTEGER, - & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - if (lprint) then - write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks) - write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks) - write (iout,*) "iturn3_start_all", - & (iturn3_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn3_end_all", - & (iturn3_end_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_start_all", - & (iturn4_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_end_all", - & (iturn4_end_all(i),i=0,nfgtasks-1) - write (iout,*) "The ielstart_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1) - enddo - write (iout,*) "The ielend_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1) - enddo - call flush(iout) - endif - ntask_cont_from=0 - ntask_cont_to=0 - itask_cont_from(0)=fg_rank - itask_cont_to(0)=fg_rank - flag=.false. - do ii=iturn3_start,iturn3_end - call add_int(ii,ii+2,iturn3_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn4_start,iturn4_end - call add_int(ii,ii+3,iturn4_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn3_start,iturn3_end - call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from) - enddo - do ii=iturn4_start,iturn4_end - call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from) - enddo - if (lprint) then - write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - endif -c write (iout,*) "Loop forward" -c call flush(iout) - do i=iatel_s,iatel_e -c write (iout,*) "from loop i=",i -c call flush(iout) - do j=ielstart(i),ielend(i) - call add_int_from(i,j,ntask_cont_from,itask_cont_from) - enddo - enddo -c write (iout,*) "Loop backward iatel_e-1",iatel_e-1, -c & " iatel_e",iatel_e -c call flush(iout) - nat_sent=0 - do i=iatel_s,iatel_e -c write (iout,*) "i",i," ielstart",ielstart(i), -c & " ielend",ielend(i) -c call flush(iout) - flag=.false. - do j=ielstart(i),ielend(i) - call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to, - & itask_cont_to,flag) - enddo - if (flag) then - nat_sent=nat_sent+1 - iat_sent(nat_sent)=i - endif - enddo - if (lprint) then - write (iout,*)"After longrange ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - write (iout,*) "iint_sent" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - enddo - write (iout,*) "iturn3_sent iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Gather(ntask_cont_from,1,MPI_INTEGER, - & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_from ended" -c call flush(iout) - call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER, - & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king, - & FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_from ended" -c call flush(iout) - call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all, - & 1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_to ended" -c call flush(iout) - call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER, - & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_to ended" -c call flush(iout) - if (fg_rank.eq.king) then - write (iout,*)"Contact receive task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_from_all(i), - & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i)) - enddo - write (iout,*) - call flush(iout) - write (iout,*) "Contact send task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_to_all(i), - & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i)) - enddo - write (iout,*) - call flush(iout) -C Check if every send will have a matching receive - ncheck_to=0 - ncheck_from=0 - do i=0,nfgtasks-1 - ncheck_to=ncheck_to+ntask_cont_to_all(i) - ncheck_from=ncheck_from+ntask_cont_from_all(i) - enddo - write (iout,*) "Control sums",ncheck_from,ncheck_to - if (ncheck_from.ne.ncheck_to) then - write (iout,*) "Error: #receive differs from #send." - write (iout,*) "Terminating program...!" - call flush(iout) - flag=.false. - else - flag=.true. - do i=0,nfgtasks-1 - do j=1,ntask_cont_to_all(i) - ii=itask_cont_to_all(j,i) - do k=1,ntask_cont_from_all(ii) - if (itask_cont_from_all(k,ii).eq.i) then - if(lprint)write(iout,*)"Matching send/receive",i,ii - exit - endif - enddo - if (k.eq.ntask_cont_from_all(ii)+1) then - flag=.false. - write (iout,*) "Error: send by",j," to",ii, - & " would have no matching receive" - endif - enddo - enddo - endif - if (.not.flag) then - write (iout,*) "Unmatched sends; terminating program" - call flush(iout) - endif - endif - call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR) -c write (iout,*) "flag broadcast ended flag=",flag -c call flush(iout) - if (.not.flag) then - call MPI_Finalize(IERROR) - stop "Error in INIT_INT_TABLE: unmatched send/receive." - endif - call MPI_Comm_group(FG_COMM,fg_group,IERR) -c write (iout,*) "MPI_Comm_group ended" -c call flush(iout) - call MPI_Group_incl(fg_group,ntask_cont_from+1, - & itask_cont_from(0),CONT_FROM_GROUP,IERR) - call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0), - & CONT_TO_GROUP,IERR) - do i=1,nat_sent - ii=iat_sent(i) - iaux=4*(ielend(ii)-ielstart(ii)+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP, - & iint_sent_local(1,ielstart(ii),i),IERR ) -c write (iout,*) "Ranks translated i=",i -c call flush(iout) - enddo - iaux=4*(iturn3_end-iturn3_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn3_sent(1,iturn3_start),CONT_TO_GROUP, - & iturn3_sent_local(1,iturn3_start),IERR) - iaux=4*(iturn4_end-iturn4_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn4_sent(1,iturn4_start),CONT_TO_GROUP, - & iturn4_sent_local(1,iturn4_start),IERR) - if (lprint) then - write (iout,*) "iint_sent_local" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - call flush(iout) - enddo - write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Group_free(fg_group,ierr) - call MPI_Group_free(cont_from_group,ierr) - call MPI_Group_free(cont_to_group,ierr) - call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR) - call MPI_Type_commit(MPI_UYZ,IERROR) - call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD, - & IERROR) - call MPI_Type_commit(MPI_UYZGRAD,IERROR) - call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR) - call MPI_Type_commit(MPI_MU,IERROR) - call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR) - call MPI_Type_commit(MPI_MAT1,IERROR) - call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR) - call MPI_Type_commit(MPI_MAT2,IERROR) - call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR) - call MPI_Type_commit(MPI_THET,IERROR) - call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR) - call MPI_Type_commit(MPI_GAM,IERROR) -#ifndef MATGATHER -c 9/22/08 Derived types to send matrices which appear in correlation terms - do i=0,nfgtasks-1 - if (ivec_count(i).eq.ivec_count(0)) then - lentyp(i)=0 - else - lentyp(i)=1 - endif - enddo - do ind_typ=lentyp(0),lentyp(nfgtasks-1) - if (ind_typ.eq.0) then - ichunk=ivec_count(0) - else - ichunk=ivec_count(1) - endif -c do i=1,4 -c blocklengths(i)=4 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1 -c do i=1,4 -c blocklengths(i)=2 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 - do i=1,8 - blocklengths(i)=2 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR) - do i=1,8 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR) - do i=1,6 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,6 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,6 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(6,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR) - do i=1,2 - blocklengths(i)=8 - enddo - displs(1)=0 - do i=2,2 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,2 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(2,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR) - do i=1,4 - blocklengths(i)=1 - enddo - displs(1)=0 - do i=2,4 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,4 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(4,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR) - call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR) - enddo -#endif - endif - iint_start=ivec_start+1 - iint_end=ivec_end+1 - do i=0,nfgtasks-1 - iint_count(i)=ivec_count(i) - iint_displ(i)=ivec_displ(i) - ivec_displ(i)=ivec_displ(i)-1 - iset_displ(i)=iset_displ(i)-1 - ithet_displ(i)=ithet_displ(i)-1 - iphi_displ(i)=iphi_displ(i)-1 - iphi1_displ(i)=iphi1_displ(i)-1 - ibond_displ(i)=ibond_displ(i)-1 - enddo - if (nfgtasks.gt.1 .and. fg_rank.eq.king - & .and. (me.eq.0 .or. out1file)) then - write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT" - do i=0,nfgtasks-1 - write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i), - & iset_count(i) - enddo - write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end, - & " iphi1_start",iphi1_start," iphi1_end",iphi1_end - write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL" - do i=0,nfgtasks-1 - write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i), - & iphi1_displ(i) - enddo - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',nfgtasks, - & ' fine-grain processors.' - endif -#else - loc_start=2 - loc_end=nres-1 - ithet_start=3 - ithet_end=nres - iturn3_start=nnt - iturn3_end=nct-3 - iturn4_start=nnt - iturn4_end=nct-4 - iphi_start=nnt+3 - iphi_end=nct - iphi1_start=4 - iphi1_end=nres - idihconstr_start=1 - idihconstr_end=ndih_constr - iphid_start=iphi_start - iphid_end=iphi_end-1 - ibond_start=2 - ibond_end=nres-1 - ibondp_start=nnt+1 - ibondp_end=nct - ivec_start=1 - ivec_end=nres-1 - iset_start=3 - iset_end=nres+1 - iint_start=2 - iint_end=nres-1 -#endif - return - end -#ifdef MPI -c--------------------------------------------------------------------------- - subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) - integer iproc,isent,k,l -c Determines whether to send interaction ii,jj to other processors; a given -c interaction can be sent to at most 2 processors. -c Sets flag=.true. if interaction ii,jj needs to be sent to at least -c one processor, otherwise flag is unchanged from the input value. - isent=0 - itask(1)=fg_rank - itask(2)=fg_rank - itask(3)=fg_rank - itask(4)=fg_rank -c write (iout,*) "ii",ii," jj",jj -c Loop over processors to check if anybody could need interaction ii,jj - do iproc=0,fg_rank-1 -c Check if the interaction matches any turn3 at iproc - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo -C Check if the interaction matches any turn4 at iproc - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and. - & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then - if (ielstart_all(ii-1,iproc).le.jj-1.and. - & ielend_all(ii-1,iproc).ge.jj-1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - if (ielstart_all(ii-1,iproc).le.jj+1.and. - & ielend_all(ii-1,iproc).ge.jj+1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:MaxProcs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) - integer iproc,k,l - do iproc=fg_rank+1,nfgtasks-1 - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then - if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc)) - & then - if (jj+1.ge.ielstart_all(ii+1,iproc).and. - & jj+1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj-1.ge.ielstart_all(ii+1,iproc).and. - & jj-1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc)) - & then - if (jj-1.ge.ielstart_all(ii-1,iproc).and. - & jj-1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj+1.ge.ielstart_all(ii-1,iproc).and. - & jj+1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_task(iproc,ntask_cont,itask_cont) - implicit none - include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:MaxProcs-1) - integer ii - do ii=1,ntask_cont - if (itask_cont(ii).eq.iproc) return - enddo - ntask_cont=ntask_cont+1 - itask_cont(ntask_cont)=iproc - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks - do i=1,nfgtasks - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks - do i=1,nexcess - int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds1(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks1 - do i=1,nfgtasks1 - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks1 - do i=1,nexcess - int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank1-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank1) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_partition(int_index,lower_index,upper_index,atom, - & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer int_index,lower_index,upper_index,atom,at_start,at_end, - & first_atom,last_atom,int_gr,jat_start,jat_end - logical lprn - lprn=.false. - if (lprn) write (iout,*) 'int_index=',int_index - int_index_old=int_index - int_index=int_index+last_atom-first_atom+1 - if (lprn) - & write (iout,*) 'int_index=',int_index, - & ' int_index_old',int_index_old, - & ' lower_index=',lower_index, - & ' upper_index=',upper_index, - & ' atom=',atom,' first_atom=',first_atom, - & ' last_atom=',last_atom - if (int_index.ge.lower_index) then - int_gr=int_gr+1 - if (at_start.eq.0) then - at_start=atom - jat_start=first_atom-1+lower_index-int_index_old - else - jat_start=first_atom - endif - if (lprn) write (iout,*) 'jat_start',jat_start - if (int_index.ge.upper_index) then - at_end=atom - jat_end=first_atom-1+upper_index-int_index_old - return1 - else - jat_end=last_atom - endif - if (lprn) write (iout,*) 'jat_end',jat_end - endif - return - end -#endif -c------------------------------------------------------------------------------ - subroutine hpb_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' -#ifdef MPI - call int_bounds(nhpb,link_start,link_end) - if (.not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nhpb',nhpb,' link_start=',link_start, - & ' link_end',link_end -#else - link_start=1 - link_end=nhpb -#endif - return - end diff --git a/source/unres/src_CSA_DiL/int_to_cart.f b/source/unres/src_CSA_DiL/int_to_cart.f deleted file mode 100644 index 97324ec..0000000 --- a/source/unres/src_CSA_DiL/int_to_cart.f +++ /dev/null @@ -1,119 +0,0 @@ - subroutine int_to_cart -c-------------------------------------------------------------- -c This subroutine converts the energy derivatives from internal -c coordinates to cartesian coordinates -c------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD_' - include 'COMMON.IOUNITS' - -c calculating dE/ddc1 - if (nres.lt.3) return - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) - & +gloc(nres-2,icg)*dtheta(j,1,3) - if(itype(2).ne.10) then - gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,1,2) - endif - enddo -c Calculating the remainder of dE/ddc2 - do j=1,3 - gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ - & gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4) - if(itype(2).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,2,2) - endif - if(itype(3).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+ - & gloc(ialph(3,1)+nside,icg)*domega(j,1,3) - endif - if(nres.gt.4) then - gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5) - endif - enddo -c If there are only five residues - if(nres.eq.5) then - do j=1,3 - gcart(j,3)=gcart(j,3)+gloc(1,icg)*dphi(j,3,4)+gloc(2,icg)* - & dphi(j,2,5)+gloc(nres-1,icg)*dtheta(j,2,4)+gloc(nres,icg)* - & dtheta(j,1,5) - if(itype(3).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(3,1),icg)* - & dalpha(j,2,3)+gloc(ialph(3,1)+nside,icg)*domega(j,2,3) - endif - if(itype(4).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(4,1),icg)* - & dalpha(j,1,4)+gloc(ialph(4,1)+nside,icg)*domega(j,1,4) - endif - enddo - endif -c If there are more than five residues - if(nres.gt.5) then - do i=3,nres-3 - do j=1,3 - gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1) - & +gloc(i-1,icg)*dphi(j,2,i+2)+ - & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+ - & gloc(nres+i-3,icg)*dtheta(j,1,i+2) - if(itype(i).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+ - & gloc(ialph(i,1)+nside,icg)*domega(j,2,i) - endif - if(itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1) - & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1) - endif - enddo - enddo - endif -c Setting dE/ddnres-2 - if(nres.gt.5) then - do j=1,3 - gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)* - & dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres) - & +gloc(2*nres-6,icg)* - & dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres) - if(itype(nres-2).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)* - & dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)* - & domega(j,2,nres-2) - endif - if(itype(nres-1).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,1,nres-1) - endif - enddo - endif -c Settind dE/ddnres-1 - do j=1,3 - gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+ - & gloc(2*nres-5,icg)*dtheta(j,2,nres) - if(itype(nres-1).ne.10) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,2,nres-1) - endif - enddo -c The side-chain vector derivatives - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) - & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) - enddo - endif - enddo - return - end - - diff --git a/source/unres/src_CSA_DiL/intcartderiv.F b/source/unres/src_CSA_DiL/intcartderiv.F deleted file mode 100644 index 5fea875..0000000 --- a/source/unres/src_CSA_DiL/intcartderiv.F +++ /dev/null @@ -1,466 +0,0 @@ - subroutine intcartderiv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.LOCAL' - double precision dcostheta(3,2,maxres), - & dcosphi(3,3,maxres),dsinphi(3,3,maxres), - & dcosalpha(3,3,maxres),dcosomega(3,3,maxres), - & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3), - & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3) - -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1 .and. me.eq.king) - & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - pi4 = 0.5d0*pipol - pi34 = 3*pi4 - -c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end -c Derivatives of theta's -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) - do j=1,3 - dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ - & vbld(i-1) - dtheta(j,1,i)=-1/sint*dcostheta(j,1,i) - dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ - & vbld(i) - dtheta(j,2,i)=-1/sint*dcostheta(j,2,i) - enddo - enddo - -c Derivatives of phi: -c If phi is 0 or 180 degrees, then the formulas -c have to be derived by power series expansion of the -c conventional formulas around 0 and 180. -#ifdef PARINTDER - do i=iphi1_start,iphi1_end -#else - do i=4,nres -#endif -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(theta(i-1)) - sing=dsin(phi(i)) - cost=dcos(theta(i)) - cost1=dcos(theta(i-1)) - cosg=dcos(phi(i)) - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. - & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) - dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) - dsinphi(j,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) -c Bug fixed 3/24/05 (AL) - dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dphi(j,1,i)=-1/sing*dcosphi(j,1,i) - dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcostheta(j,1,i) - dphi(j,2,i)=-1/sing*dcosphi(j,2,i) - dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1))/vbld(i) - dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - enddo - endif - enddo -#ifdef CRYST_SC -c Derivatives of side-chain angles alpha and omega -#if defined(MPI) && defined(PARINTDER) - do i=ibond_start,ibond_end -#else - do i=2,nres-1 -#endif - if(itype(i).ne.10) then - fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) - fac6=fac5/vbld(i) - fac7=fac5*fac5 - fac8=fac5/vbld(i+1) - fac9=fac5/vbld(i+nres) - scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*( - & scalar(dC_norm(1,i),dC_norm(1,i+nres)) - & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) - sina=sqrt(1-cosa*cosa) - sino=dsin(omeg(i)) - do j=1,3 - dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- - & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) - dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) - dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- - & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) - dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) - dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- - & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ - & vbld(i+nres)) - dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) - enddo -c obtaining the derivatives of omega from sines - if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. - & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then - fac15=dcos(theta(i+1))/(dsin(theta(i+1))* - & dsin(theta(i+1))) - fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) - fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) - call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) - coso_inv=1.0d0/dcos(omeg(i)) - do j=1,3 - dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) - & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-( - & sino*dc_norm(j,i-1))/vbld(i) - domega(j,1,i)=coso_inv*dsinomega(j,1,i) - dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) - & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) - & -sino*dc_norm(j,i)/vbld(i+1) - domega(j,2,i)=coso_inv*dsinomega(j,2,i) - dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- - & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ - & vbld(i+nres) - domega(j,3,i)=coso_inv*dsinomega(j,3,i) - enddo - else -c obtaining the derivatives of omega from cosines - fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) - fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) - fac12=fac10*sina - fac13=fac12*fac12 - fac14=sina*sina - do j=1,3 - dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* - & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ - & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* - & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 - domega(j,1,i)=-1/sino*dcosomega(j,1,i) - dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* - & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* - & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ - & (scala2-fac11*cosa)*(0.25d0*sina/fac10* - & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i) - & ))/fac13 - domega(j,2,i)=-1/sino*dcosomega(j,2,i) - dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- - & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ - & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 - domega(j,3,i)=-1/sino*dcosomega(j,3,i) - enddo - endif - endif - enddo -#endif -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1) then -#ifdef DEBUG -cd write (iout,*) "Gather dtheta" -cd call flush(iout) - write (iout,*) "dtheta before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) - enddo -#endif - call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank), - & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET, - & king,FG_COMM,IERROR) -#ifdef DEBUG -cd write (iout,*) "Gather dphi" -cd call flush(iout) - write (iout,*) "dphi before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) - enddo -#endif - call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank), - & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather dalpha" -cd call flush(iout) -#ifdef CRYST_SC - call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather domega" -cd call flush(iout) - call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -#endif - endif -#endif -#ifdef DEBUG - write (iout,*) "dtheta after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2) - enddo - write (iout,*) "dphi after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) - enddo -#endif - return - end - - subroutine checkintcartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - double precision dthetanum(3,2,maxres),dphinum(3,3,maxres) - & ,dalphanum(3,3,maxres), domeganum(3,3,maxres) - double precision theta_s(maxres),phi_s(maxres),alph_s(maxres), - & omeg_s(maxres),dc_norm_s(3) - double precision aincr /1.0d-5/ - - do i=1,nres - phi_s(i)=phi(i) - theta_s(i)=theta(i) - alph_s(i)=alph(i) - omeg_s(i)=omeg(i) - enddo -c Check theta gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of theta" - write (iout,*) - do i=3,nres - do j=1,3 - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - call int_from_cart1(.false.) - dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3), - & (dtheta(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3), - & (dthetanum(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') - & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3), - & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3) - write (iout,*) - enddo -c Check gamma gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of gamma" - do i=4,nres - do j=1,3 - dcji=dc(j,i-3) - dc(j,i-3)=dcji+aincr - call chainbuild_cart - dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3), - & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3), - & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dphinum(j,1,i)/dphi(j,1,i),j=1,3), - & (dphinum(j,2,i)/dphi(j,2,i),j=1,3), - & (dphinum(j,3,i)/dphi(j,3,i),j=1,3) - write (iout,*) - enddo -c Check alpha gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of alpha" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - dalphanum(j,1,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - dalphanum(j,2,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - dalphanum(j,3,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3), - & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3), - & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3), - & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3), - & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3) - write (iout,*) - enddo -c Check omega gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of omega" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - domeganum(j,1,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - domeganum(j,2,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - domeganum(j,3,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3), - & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3), - & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (domeganum(j,1,i)/domega(j,1,i),j=1,3), - & (domeganum(j,2,i)/domega(j,2,i),j=1,3), - & (domeganum(j,3,i)/domega(j,3,i),j=1,3) - write (iout,*) - enddo - return - end - - subroutine chainbuild_cart - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' - -#ifdef MPI - if (nfgtasks.gt.1) then -c write (iout,*) "BCAST in chainbuild_cart" -c call flush(iout) -c Broadcast the order to build the chain and compute internal coordinates -c to the slaves. The slaves receive the order in ERGASTULUM. - time00=MPI_Wtime() -c write (iout,*) "CHAINBUILD_CART: DC before BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo - if (fg_rank.eq.0) - & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_bcast7=time_bcast7+MPI_Wtime()-time00 - time01=MPI_Wtime() - call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "CHAINBUILD_CART: DC after BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo -c write (iout,*) "End BCAST in chainbuild_cart" -c call flush(iout) - time_bcast=time_bcast+MPI_Wtime()-time00 - time_bcastc=time_bcastc+MPI_Wtime()-time01 - endif -#endif - do j=1,3 - c(j,1)=dc(j,0) - enddo - do i=2,nres - do j=1,3 - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo - enddo - do i=1,nres - do j=1,3 - c(j,i+nres)=c(j,i)+dc(j,i+nres) - enddo - enddo -c write (iout,*) "CHAINBUILD_CART" -c call cartprint - call int_from_cart1(.false.) - return - end diff --git a/source/unres/src_CSA_DiL/intcor.f b/source/unres/src_CSA_DiL/intcor.f deleted file mode 100644 index a3cd5d0..0000000 --- a/source/unres/src_CSA_DiL/intcor.f +++ /dev/null @@ -1,91 +0,0 @@ -C -C------------------------------------------------------------------------------ -C - double precision function alpha(i1,i2,i3) -c -c Calculates the planar angle between atoms (i1), (i2), and (i3). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - vnorm=dsqrt(x12*x12+y12*y12+z12*z12) - wnorm=dsqrt(x23*x23+y23*y23+z23*z23) - scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm) - alpha=arcos(scalar) - return - end -C -C------------------------------------------------------------------------------ -C - double precision function beta(i1,i2,i3,i4) -c -c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4) -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - x34=c(1,i4)-c(1,i3) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - y34=c(2,i4)-c(2,i3) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - z34=c(3,i4)-c(3,i3) -cd print '(2i3,3f10.5)',i1,i2,x12,y12,z12 -cd print '(2i3,3f10.5)',i2,i3,x23,y23,z23 -cd print '(2i3,3f10.5)',i3,i4,x34,y34,z34 - wx=-y23*z34+y34*z23 - wy=x23*z34-z23*x34 - wz=-x23*y34+y23*x34 - wnorm=dsqrt(wx*wx+wy*wy+wz*wz) - vx=y12*z23-z12*y23 - vy=-x12*z23+z12*x23 - vz=x12*y23-y12*x23 - vnorm=dsqrt(vx*vx+vy*vy+vz*vz) - if (vnorm.gt.1.0D-13 .and. wnorm.gt.1.0D-13) then - scalar=(vx*wx+vy*wy+vz*wz)/(vnorm*wnorm) - if (dabs(scalar).gt.1.0D0) - &scalar=0.99999999999999D0*scalar/dabs(scalar) - angle=dacos(scalar) -cd print '(2i4,10f7.3)',i2,i3,vx,vy,vz,wx,wy,wz,vnorm,wnorm, -cd &scalar,angle - else - angle=pi - endif -c if (angle.le.0.0D0) angle=pi+angle - tx=vy*wz-vz*wy - ty=-vx*wz+vz*wx - tz=vx*wy-vy*wx - scalar=tx*x23+ty*y23+tz*z23 - if (scalar.lt.0.0D0) angle=-angle - beta=angle - return - end -C -C------------------------------------------------------------------------------ -C - function dist(i1,i2) -c -c Calculates the distance between atoms (i1) and (i2). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - y12=c(2,i1)-c(2,i2) - z12=c(3,i1)-c(3,i2) - dist=dsqrt(x12*x12+y12*y12+z12*z12) - return - end -C diff --git a/source/unres/src_CSA_DiL/intlocal.f b/source/unres/src_CSA_DiL/intlocal.f deleted file mode 100644 index 2dbcc88..0000000 --- a/source/unres/src_CSA_DiL/intlocal.f +++ /dev/null @@ -1,517 +0,0 @@ - subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2, - & si1,si2,si3,si4,transp,q) - implicit none - integer ity1,ity2 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4 - logical transp - double precision elocal,ele - double precision delta,delta2,sum,ene,sumene,boltz - double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=20 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum=0.0d0 - sumene=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - ene= - & -elocal(ity1,lambda1,lambda2,.false.)* - & elocal(ity2,lambda3,lambda4,transp)* - & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)* - & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2) -cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2), -cd & elocal(ity2,lambda3,gamma2-pi-lambda4), -cd & ele(lambda1,lambda2,a1,si1,si3), -cd & ele(lambda3,lambda4,a2,si2,si4) - sum=sum+ene - enddo - enddo - enddo - enddo - q=sum/(2*pi)**4*delta**4 - write (2,* )'sum',sum,' q',q - return - end -c--------------------------------------------------------------------------- - subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4, - & a1,koniec,q1,q2,q3,q4) - implicit none - integer ity1,ity2,ity3,ity4 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1, - & lambda2,lambda3,lambda4 - logical koniec - double precision elocal,ele - double precision delta,delta2,sum1,sum2,sum3,sum4, - & ene1,ene2,ene3,ene4,boltz - double precision q1,q2,q3,q4,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - if (.not.koniec) then - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda2,lambda4,a1) - else - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda2,-lambda4,a1) - endif - ene2= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda2,lambda3,a1) - if (.not.koniec) then - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda1,lambda4,a1) - else - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda1,-lambda4,a1) - endif - ene4= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda1,lambda3,a1) - sum1=sum1+ene1 - sum2=sum2+ene2 - sum3=sum3+ene3 - sum4=sum4+ene4 - enddo - enddo - enddo - enddo - q1=sum1/(2*pi)**4*delta**4 - q2=sum2/(2*pi)**4*delta**4 - q3=sum3/(2*pi)**4*delta**4 - q4=sum4/(2*pi)**4*delta**4 - write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4 - return - end -c------------------------------------------------------------------------- - subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4, - & a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - sum1=sum1+pom*eloc1 - endif - eloc3=elocal(ity3,lambda2,lambda5,.false.) - sum2=sum2+pom*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc4 - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda5,.false.) - sum4=sum4+pom*eloc6 - endif - enddo - enddo - enddo - enddo - enddo - pom=1.0d0/(2*pi)**5*delta**5 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom -c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4 - return - end -c------------------------------------------------------------------------- - subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2, - & ity3,ity4,ity5,ity6,a1,a2,ene_turn6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom,ene5 - double precision ene_turn6,sum5,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, - & ' gamma3=',gamma3,' gamma4=',gamma4 - write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 - write(2,*) 'a1=',a1 - write(2,*) 'a2=',a2 - - sum5=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - ele1=ele(lambda1,-lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.) - eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.) - sum5=sum5+pom*eloc3*eloc4 - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**5*delta**5 - ene_turn6=sum5*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4, - & ene5,ene6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - sum5=0.0d0 - sum6=0.0d0 - eloc1=0.0d0 - eloc6=0.0d0 - eloc61=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - do ilam6=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - lambda6=ilam6*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - endif - eloc3=elocal(ity3,lambda2,lambda6,.false.) - sum1=sum1+pom*eloc1*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda6,.false.) - eloc61=elocal(ity6,lambda4,lambda5,.false.) - endif - sum2=sum2+pom*eloc4*eloc6 - eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc1*eloc41 - sum4=sum4+pom*eloc1*eloc6 - sum5=sum5+pom*eloc3*eloc4 - sum6=sum6+pom*eloc3*eloc61 - enddo - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**6*delta**6 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom - ene5=sum5*pom - ene6=sum6*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2 -cd write(2,*) ity1,ity2 -cd write(2,*) 'a1=',a1 -cd write(2,*) si1, - - sum1=0.0d0 - eloc1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - ele1=ele(lambda1,si1*lambda3,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - if (si1.gt.0) then - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - else - eloc2=elocal(ity2,lambda2,lambda3,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2 - enddo - enddo - enddo - pom=1.0d0/(2*pi)**3*delta**3 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1, - & ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3 -cd write(2,*) ity1,ity2,ity3 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'si1=',si1 - sum1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - ele1=ele(lambda1,si1*lambda4,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - if (si1.gt.0) then - eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.) - else - eloc3=elocal(ity3,lambda3,lambda4,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2*eloc3 - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**4*delta**4 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - double precision function elocal(i,x,y,transp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TORSION' - integer i - double precision x,y,u(2),v(2),cu(2),dv(2),ev(2) - double precision scalar2 - logical transp - u(1)=dcos(x) - u(2)=dsin(x) - v(1)=dcos(y) - v(2)=dsin(y) - if (transp) then - call matvec2(cc(1,1,i),v,cu) - call matvec2(dd(1,1,i),u,dv) - call matvec2(ee(1,1,i),u,ev) - elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+ - & scalar2(dv,u)+scalar2(ev,v) - else - call matvec2(cc(1,1,i),u,cu) - call matvec2(dd(1,1,i),v,dv) - call matvec2(ee(1,1,i),v,ev) - elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+ - & scalar2(dv,v)+scalar2(ev,u) - endif - return - end -c------------------------------------------------------------------------- - double precision function ele(x,y,a) - implicit none - double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2) - double precision scalar2 - u(1)=-cos(x) - u(2)= sin(x) - v(1)=-cos(y) - v(2)= sin(y) - call matvec2(a,v,av) - ele=scalar2(u,av) - return - end diff --git a/source/unres/src_CSA_DiL/local_move.f b/source/unres/src_CSA_DiL/local_move.f deleted file mode 100644 index d02a9d1..0000000 --- a/source/unres/src_CSA_DiL/local_move.f +++ /dev/null @@ -1,970 +0,0 @@ -c------------------------------------------------------------- - - subroutine local_move_init(debug) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' ! Needed by COMMON.LOCAL - include 'COMMON.GEO' ! For pi, deg2rad - include 'COMMON.LOCAL' ! For vbl - include 'COMMON.LOCMOVE' - -c INPUT arguments - logical debug - - -c Determine wheter to do some debugging output - locmove_output=debug - -c Set the init_called flag to 1 - init_called=1 - -c The following are never changed - min_theta=60.D0*deg2rad ! (0,PI) - max_theta=175.D0*deg2rad ! (0,PI) - dmin2=vbl*vbl*2.*(1.-cos(min_theta)) - dmax2=vbl*vbl*2.*(1.-cos(max_theta)) - flag=1.0D300 - small=1.0D-5 - small2=0.5*small*small - -c Not really necessary... - a_n=0 - b_n=0 - res_n=0 - - return - end - -c------------------------------------------------------------- - - subroutine local_move(n_start, n_end, PHImin, PHImax) -c Perform a local move between residues m and n (inclusive) -c PHImin and PHImax [0,PI] determine the size of the move -c Works on whatever structure is in the variables theta and phi, -c sidechain variables are left untouched -c The final structure is NOT minimized, but both the cartesian -c variables c and the angles are up-to-date at the end (no further -c chainbuild is required) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MINIM' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - double precision ran_number - external ran_number - -c INPUT arguments - integer n_start, n_end ! First and last residues to move - double precision PHImin, PHImax ! min/max angles [0,PI] - -c Local variables - integer i,j - double precision min,max - integer iretcode - - -c Check if local_move_init was called. This assumes that it -c would not be 1 if not explicitely initialized - if (init_called.ne.1) then - write(6,*)' *** local_move_init not called!!!' - stop - endif - -c Quick check for crazy range - if (n_start.gt.n_end .or. n_start.lt.1 .or. n_end.gt.nres) then - write(6,'(a,i3,a,i3)') - + ' *** Cannot make local move between n_start = ', - + n_start,' and n_end = ',n_end - return - endif - -c Take care of end residues first... - if (n_start.eq.1) then -c Move residue 1 (completely random) - theta(3)=ran_number(min_theta,max_theta) - phi(4)=ran_number(-PI,PI) - i=2 - else - i=n_start - endif - if (n_end.eq.nres) then -c Move residue nres (completely random) - theta(nres)=ran_number(min_theta,max_theta) - phi(nres)=ran_number(-PI,PI) - j=nres-1 - else - j=n_end - endif - -c ...then go through all other residues one by one -c Start from the two extremes and converge - call chainbuild - do while (i.le.j) - min=PHImin - max=PHImax -c$$$c Move the first two residues by less than the others -c$$$ if (i-n_start.lt.3) then -c$$$ if (i-n_start.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (i-n_start.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (i-n_start.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue i - iretcode=move_res(min,max,i,c) ! Discard iretcode - i=i+1 - - if (i.le.j) then - min=PHImin - max=PHImax -c$$$c Move the last two residues by less than the others -c$$$ if (n_end-j.lt.3) then -c$$$ if (n_end-j.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (n_end-j.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (n_end-j.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue j - iretcode=move_res(min,max,j,c) ! Discard iretcode - j=j-1 - endif - enddo - - call int_from_cart(.false.,.false.) - - return - end - -c------------------------------------------------------------- - - subroutine output_tabs -c Prints out the contents of a_..., b_..., res_... - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Local variables - integer i,j - - - write(6,*)'a_...' - write(6,'(8f7.1)')(a_ang(i)*rad2deg,i=0,a_n-1) - write(6,'(8(2x,3l1,2x))')((a_tab(i,j),i=0,2),j=0,a_n-1) - - write(6,*)'b_...' - write(6,'(4f7.1)')(b_ang(i)*rad2deg,i=0,b_n-1) - write(6,'(4(2x,3l1,2x))')((b_tab(i,j),i=0,2),j=0,b_n-1) - - write(6,*)'res_...' - write(6,'(12f7.1)')(res_ang(i)*rad2deg,i=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(0,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(1,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(2,i,j),i=0,2),j=0,res_n-1) - - return - end - -c------------------------------------------------------------- - - subroutine angles2tab(PHImin,PHImax,n,ang,tab) -c Only uses angles if [0,PI] (but PHImin cannot be 0., -c and PHImax cannot be PI) - implicit none - -c Includes - include 'COMMON.GEO' - -c INPUT arguments - double precision PHImin,PHImax - -c OUTPUT arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - - - if (PHImin .eq. PHImax) then -c Special case with two 010's - n = 2; - ang(0) = -PHImin; - ang(1) = PHImin; - tab(0,0) = .false. - tab(2,0) = .false. - tab(0,1) = .false. - tab(2,1) = .false. - tab(1,0) = .true. - tab(1,1) = .true. - else if (PHImin .eq. PI) then -c Special case with one 010 - n = 1 - ang(0) = PI - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else if (PHImax .eq. 0.) then -c Special case with one 010 - n = 1 - ang(0) = 0. - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else -c Standard cases - n = 0 - if (PHImin .gt. 0.) then -c Start of range (011) - ang(n) = PHImin - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = -PHImin - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - if (PHImax .lt. PI) then -c Start of range (011) - ang(n) = -PHImax - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = PHImax - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine minmax_angles(x,y,z,r,n,ang,tab) -c When solutions do not exist, assume all angles -c are acceptable - i.e., initial geometry must be correct - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Input arguments - double precision x,y,z,r - -c Output arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - -c Local variables - double precision num, denom, phi - double precision Kmin, Kmax - integer i - - - num = x*x + y*y + z*z - denom = x*x + y*y - n = 0 - if (denom .gt. 0.) then - phi = atan2(y,x) - denom = 2.*r*sqrt(denom) - num = num+r*r - Kmin = (num - dmin2)/denom - Kmax = (num - dmax2)/denom - -c Allowed values of K (else all angles are acceptable) -c -1 <= Kmin < 1 -c -1 < Kmax <= 1 - if (Kmin .gt. 1. .or. abs(Kmin-1.) .lt. small2) then - Kmin = -flag - else if (Kmin .lt. -1. .or. abs(Kmin+1.) .lt. small2) then - Kmin = PI - else - Kmin = acos(Kmin) - endif - - if (Kmax .lt. -1. .or. abs(Kmax+1.) .lt. small2) then - Kmax = flag - else if (Kmax .gt. 1. .or. abs(Kmax-1.) .lt. small2) then - Kmax = 0. - else - Kmax = acos(Kmax) - endif - - if (Kmax .lt. Kmin) Kmax = Kmin - - call angles2tab(Kmin, Kmax, n, ang, tab) - -c Add phi and check that angles are within range (-PI,PI] - do i=0,n-1 - ang(i) = ang(i)+phi - if (ang(i) .le. -PI) then - ang(i) = ang(i)+2.*PI - else if (ang(i) .gt. PI) then - ang(i) = ang(i)-2.*PI - endif - enddo - endif - - return - end - -c------------------------------------------------------------- - - subroutine construct_tab -c Take a_... and b_... values and produces the results res_... -c x_ang are assumed to be all different (diff > small) -c x_tab(1,i) must be 1 for all i (i.e., all x_ang are acceptable) - implicit none - -c Includes - include 'COMMON.LOCMOVE' - -c Local variables - integer n_max,i,j,index - logical done - double precision phi - - - n_max = a_n + b_n - if (n_max .eq. 0) then - res_n = 0 - return - endif - - do i=0,n_max-1 - do j=0,1 - res_tab(j,0,i) = .true. - res_tab(j,2,i) = .true. - res_tab(j,1,i) = .false. - enddo - enddo - - index = 0 - phi = -flag - done = .false. - do while (.not.done) - res_ang(index) = flag - -c Check a first... - do i=0,a_n-1 - if ((a_ang(i)-phi).gt.small .and. - + a_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = a_ang(i) -c Copy the values from a_tab into res_tab(0,,) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) -c Set default values for res_tab(1,,) - res_tab(1,0,index) = .true. - res_tab(1,1,index) = .false. - res_tab(1,2,index) = .true. - else if (abs(a_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to a b_ang) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) - endif - enddo -c ...then check b - do i=0,b_n-1 - if ((b_ang(i)-phi).gt.small .and. - + b_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = b_ang(i) -c Copy the values from b_tab into res_tab(1,,) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) -c Set default values for res_tab(0,,) - res_tab(0,0,index) = .true. - res_tab(0,1,index) = .false. - res_tab(0,2,index) = .true. - else if (abs(b_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to an a_ang) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) - endif - enddo - - if (res_ang(index) .eq. flag) then - res_n = index - done = .true. - else if (index .eq. n_max-1) then - res_n = n_max - done = .true. - else - phi = res_ang(index) ! Store previous angle - index = index+1 - endif - enddo - -c Fill the gaps -c First a... - index = 0 - if (a_n .gt. 0) then - do while (.not.res_tab(0,1,index)) - index=index+1 - enddo - done = res_tab(0,2,index) - do i=index+1,res_n-1 - if (res_tab(0,1,i)) then - done = res_tab(0,2,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - done = res_tab(0,0,index) - do i=index-1,0,-1 - if (res_tab(0,1,i)) then - done = res_tab(0,0,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(0,0,i) = .true. - res_tab(0,1,i) = .true. - res_tab(0,2,i) = .true. - enddo - endif -c ...then b - index = 0 - if (b_n .gt. 0) then - do while (.not.res_tab(1,1,index)) - index=index+1 - enddo - done = res_tab(1,2,index) - do i=index+1,res_n-1 - if (res_tab(1,1,i)) then - done = res_tab(1,2,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - done = res_tab(1,0,index) - do i=index-1,0,-1 - if (res_tab(1,1,i)) then - done = res_tab(1,0,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(1,0,i) = .true. - res_tab(1,1,i) = .true. - res_tab(1,2,i) = .true. - enddo - endif - -c Finally fill the last row with AND operation - do i=0,res_n-1 - do j=0,2 - res_tab(2,j,i) = (res_tab(0,j,i) .and. res_tab(1,j,i)) - enddo - enddo - - return - end - -c------------------------------------------------------------- - - subroutine construct_ranges(phi_n,phi_start,phi_end) -c Given the data in res_..., construct a table of -c min/max allowed angles - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - -c Local variables - logical done - integer index - - - if (res_n .eq. 0) then -c Any move is allowed - phi_n = 1 - phi_start(0) = -PI - phi_end(0) = PI - else - phi_n = 0 - index = 0 - done = .false. - do while (.not.done) -c Find start of range (01x) - done = .false. - do while (.not.done) - if (res_tab(2,0,index).or.(.not.res_tab(2,1,index))) then - index=index+1 - else - done = .true. - phi_start(phi_n) = res_ang(index) - endif - if (index .eq. res_n) done = .true. - enddo -c If a start was found (index < res_n), find the end of range (x10) -c It may not be found without wrapping around - if (index .lt. res_n) then - done = .false. - do while (.not.done) - if ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) then - index=index+1 - else - done = .true. - endif - if (index .eq. res_n) done = .true. - enddo - if (index .lt. res_n) then -c Found the end of the range - phi_end(phi_n) = res_ang(index) - phi_n=phi_n+1 - index=index+1 - if (index .eq. res_n) then - done = .true. - else - done = .false. - endif - else -c Need to wrap around - done = .true. - phi_end(phi_n) = flag - endif - endif - enddo -c Take care of the last one if need to wrap around - if (phi_end(phi_n) .eq. flag) then - index = 0 - do while ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) - index=index+1 - enddo - phi_end(phi_n) = res_ang(index) + 2.*PI - phi_n=phi_n+1 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine fix_no_moves(phi) - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - double precision phi - -c Local variables - integer index - double precision diff,temp - - -c Look for first 01x in gammas (there MUST be at least one) - diff = flag - index = 0 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index+1 - enddo - if (res_ang(index) .le. 0.D0) then ! Make sure it's from PHImax -c Try to increase PHImax - if (index .gt. 0) then - phi = res_ang(index-1) - diff = abs(res_ang(index) - res_ang(index-1)) - endif -c Look for last (corresponding) x10 - index = res_n - 1 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index-1 - enddo - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif - endif - -c If increasing PHImax didn't work, decreasing PHImin -c will (with one exception) -c Look for first x10 (there MUST be at least one) - index = 0 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index+1 - enddo - if (res_ang(index) .lt. 0.D0) then ! Make sure it's from PHImin -c Try to decrease PHImin - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (res_ang(index+1) .le. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif -c Look for last (corresponding) 01x - index = res_n - 1 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index-1 - enddo - if (index .gt. 0) then - temp = abs(res_ang(index) - res_ang(index-1)) - if (res_ang(index-1) .ge. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index-1) - diff = temp - endif - endif - endif - -c If it still didn't work, it must be PHImax == 0. or PHImin == PI - if (diff .eq. flag) then - index = 0 - if (res_tab(index,1,0) .or. (.not.res_tab(index,1,1)) .or. - + res_tab(index,1,2)) index = res_n - 1 -c This MUST work at this point - if (index .eq. 0) then - phi = res_ang(1) - else - phi = res_ang(index - 1) - endif - endif - - return - end - -c------------------------------------------------------------- - - integer function move_res(PHImin,PHImax,i_move) -c Moves residue i_move (in array c), leaving everything else fixed -c Starting geometry is not checked, it should be correct! -c R(,i_move) is the only residue that will move, but must have -c 1 < i_move < nres (i.e., cannot move ends) -c Whether any output is done is controlled by locmove_output -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c External functions - double precision ran_number - external ran_number - -c Input arguments - double precision PHImin,PHImax - integer i_move - -c RETURN VALUES: -c 0: move successfull -c 1: Dmin or Dmax had to be modified -c 2: move failed - check your input geometry - - -c Local variables - double precision X(0:2),Y(0:2),Z(0:2),Orig(0:2) - double precision P(0:2) - logical no_moves,done - integer index,i,j - double precision phi,temp,radius - double precision phi_start(0:11), phi_end(0:11) - integer phi_n - -c Set up the coordinate system - do i=0,2 - Orig(i)=0.5*(c(i+1,i_move-1)+c(i+1,i_move+1)) ! Position of origin - enddo - - do i=0,2 - Z(i)=c(i+1,i_move+1)-c(i+1,i_move-1) - enddo - temp=sqrt(Z(0)*Z(0)+Z(1)*Z(1)+Z(2)*Z(2)) - do i=0,2 - Z(i)=Z(i)/temp - enddo - - do i=0,2 - X(i)=c(i+1,i_move)-Orig(i) - enddo -c radius is the radius of the circle on which c(,i_move) can move - radius=sqrt(X(0)*X(0)+X(1)*X(1)+X(2)*X(2)) - do i=0,2 - X(i)=X(i)/radius - enddo - - Y(0)=Z(1)*X(2)-X(1)*Z(2) - Y(1)=X(0)*Z(2)-Z(0)*X(2) - Y(2)=Z(0)*X(1)-X(0)*Z(1) - -c Calculate min, max angles coming from dmin, dmax to c(,i_move-2) - if (i_move.gt.2) then - do i=0,2 - P(i)=c(i+1,i_move-2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,a_n,a_ang,a_tab) - else - a_n=0 - endif - -c Calculate min, max angles coming from dmin, dmax to c(,i_move+2) - if (i_move.lt.nres-2) then - do i=0,2 - P(i)=c(i+1,i_move+2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,b_n,b_ang,b_tab) - else - b_n=0 - endif - -c Construct the resulting table for alpha and beta - call construct_tab() - - if (locmove_output) then - print *,'ALPHAS & BETAS TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - if (no_moves) then - if (locmove_output) print *,' *** Cannot move anywhere' - move_res=2 - return - endif - -c Transfer res_... into a_... - a_n = 0 - do i=0,res_n-1 - if ( (res_tab(2,0,i).neqv.res_tab(2,1,i)) .or. - + (res_tab(2,0,i).neqv.res_tab(2,2,i)) ) then - a_ang(a_n) = res_ang(i) - do j=0,2 - a_tab(j,a_n) = res_tab(2,j,i) - enddo - a_n=a_n+1 - endif - enddo - -c Check that the PHI's are within [0,PI] - if (PHImin .lt. 0. .or. abs(PHImin) .lt. small) PHImin = -flag - if (PHImin .gt. PI .or. abs(PHImin-PI) .lt. small) PHImin = PI - if (PHImax .gt. PI .or. abs(PHImax-PI) .lt. small) PHImax = flag - if (PHImax .lt. 0. .or. abs(PHImax) .lt. small) PHImax = 0. - if (PHImax .lt. PHImin) PHImax = PHImin -c Calculate min and max angles coming from PHImin and PHImax, -c and put them in b_... - call angles2tab(PHImin, PHImax, b_n, b_ang, b_tab) -c Construct the final table - call construct_tab() - - if (locmove_output) then - print *,'FINAL TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - - if (no_moves) then -c Take care of the case where no solution exists... - call fix_no_moves(phi) - if (locmove_output) then - print *,' *** Had to modify PHImin or PHImax' - print *,'phi: ',phi*rad2deg - endif - move_res=1 - else -c ...or calculate the solution -c Construct phi_start/phi_end arrays - call construct_ranges(phi_n, phi_start, phi_end) -c Choose random angle phi in allowed range(s) - temp = 0. - do i=0,phi_n-1 - temp = temp + phi_end(i) - phi_start(i) - enddo - phi = ran_number(phi_start(0),phi_start(0)+temp) - index = 0 - done = .false. - do while (.not.done) - if (phi .lt. phi_end(index)) then - done = .true. - else - index=index+1 - endif - if (index .eq. phi_n) then - done = .true. - else if (.not.done) then - phi = phi + phi_start(index) - phi_end(index-1) - endif - enddo - if (index.eq.phi_n) phi=phi_end(phi_n-1) ! Fix numerical errors - if (phi .gt. PI) phi = phi-2.*PI - - if (locmove_output) then - print *,'ALLOWED RANGE(S)' - do i=0,phi_n-1 - print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg - enddo - print *,'phi: ',phi*rad2deg - endif - move_res=0 - endif - -c Re-use radius as temp variable - temp=radius*cos(phi) - radius=radius*sin(phi) - do i=0,2 - c(i+1,i_move)=Orig(i)+temp*X(i)+radius*Y(i) - enddo - - return - end - -c------------------------------------------------------------- - - subroutine loc_test -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - -c Local variables - integer i,j - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - double precision phi - double precision R(0:2,0:5) - - locmove_output=.true. - -c call angles2tab(30.*deg2rad,70.*deg2rad,a_n,a_ang,a_tab) -c call angles2tab(80.*deg2rad,130.*deg2rad,b_n,b_ang,b_tab) -c call minmax_angles(0.D0,3.8D0,0.D0,3.8D0,b_n,b_ang,b_tab) -c call construct_tab -c call output_tabs - -c call construct_ranges(phi_n,phi_start,phi_end) -c do i=0,phi_n-1 -c print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg -c enddo - -c call fix_no_moves(phi) -c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg - - R(0,0)=0.D0 - R(1,0)=0.D0 - R(2,0)=0.D0 - R(0,1)=0.D0 - R(1,1)=-cos(28.D0*deg2rad) - R(2,1)=-0.5D0-sin(28.D0*deg2rad) - R(0,2)=0.D0 - R(1,2)=0.D0 - R(2,2)=-0.5D0 - R(0,3)=cos(30.D0*deg2rad) - R(1,3)=0.D0 - R(2,3)=0.D0 - R(0,4)=0.D0 - R(1,4)=0.D0 - R(2,4)=0.5D0 - R(0,5)=0.D0 - R(1,5)=cos(26.D0*deg2rad) - R(2,5)=0.5D0+sin(26.D0*deg2rad) - do i=1,5 - do j=0,2 - R(j,i)=vbl*R(j,i) - enddo - enddo - i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) - print *,'RETURNED ',i - print *,(R(i,3)/vbl,i=0,2) - - return - end - -c------------------------------------------------------------- diff --git a/source/unres/src_CSA_DiL/matmult.f b/source/unres/src_CSA_DiL/matmult.f deleted file mode 100644 index e9257cf..0000000 --- a/source/unres/src_CSA_DiL/matmult.f +++ /dev/null @@ -1,18 +0,0 @@ - SUBROUTINE MATMULT(A1,A2,A3) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(3,3),A2(3,3),A3(3,3) - DIMENSION AI3(3,3) - DO 1 I=1,3 - DO 2 J=1,3 - A3IJ=0.0 - DO 3 K=1,3 - 3 A3IJ=A3IJ+A1(I,K)*A2(K,J) - AI3(I,J)=A3IJ - 2 CONTINUE - 1 CONTINUE - DO 4 I=1,3 - DO 4 J=1,3 - 4 A3(I,J)=AI3(I,J) - RETURN - END diff --git a/source/unres/src_CSA_DiL/minim_jlee.F b/source/unres/src_CSA_DiL/minim_jlee.F deleted file mode 100644 index 2b53f11..0000000 --- a/source/unres/src_CSA_DiL/minim_jlee.F +++ /dev/null @@ -1,452 +0,0 @@ -#ifdef MPI - subroutine minim_jlee -c controls minimization and sorting routines - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'COMMON.CONTROL' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.CHAIN' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - dimension var2(maxvar) - integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - double precision energia(0:n_ene),time0s,time1s - dimension indx(9),info(12) - dimension iv(liv) - dimension idum(1),rdum(1) - dimension icont(2,maxcont) - logical check_var,fail - integer iloop(2) - common /przechowalnia/ v - data rad /1.745329252d-2/ -c receive # of start -! print *,'Processor',me,' calling MINIM_JLEE maxfun',maxfun, -! & ' maxmin',maxmin,' tolf',tolf,' rtolf',rtolf - nhpb0=nhpb - 10 continue - time0s=MPI_WTIME() -c print *, 'MINIM_JLEE: ',me,' is waiting' - call mpi_recv(info,12,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - time1s=MPI_WTIME() - write (iout,'(a12,f10.4,a4)')'Waiting for ',time1s-time0s,' sec' - call flush(iout) - if (info(1).eq.0.and.info(2).eq.-2) then -cd write (iout,*) 'Parallel tmscore for refresh bank' -cd call flush(iout) - call refresh_bank_worker_tmscore(var) - goto 10 - endif - n=info(1) -c print *, 'MINIM_JLEE: ',me,' received: ',n - -crc if (ierr.ne.0) go to 100 -c if # = 0, return - if (n.eq.0) then - write (iout,*) 'Finishing minim_jlee - signal',n,' from master' - call flush(iout) - return - endif - - nfun=0 - IF (n.lt.0) THEN - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(iffr,nres,mpi_integer, - * king,idint,CG_COMM,muster,ierr) - call mpi_recv(var2,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - ELSE -c receive initial values of variables - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -crc if (ierr.ne.0) go to 100 - ENDIF - - if(vdisulf.and.info(2).ne.-1) then - if(info(4).ne.0)then - call mpi_recv(ihpbt,info(4),mpi_integer, - * king,idint,CG_COMM,muster,ierr) - call mpi_recv(jhpbt,info(4),mpi_integer, - * king,idint,CG_COMM,muster,ierr) - endif - endif - - IF (n.lt.0) THEN - n=-n - nhpb=nhpb0 - link_start=1 - link_end=nhpb - call init_int_table - call contact_cp(var,var2,iffr,nfun,n) - ENDIF - - if(vdisulf.and.info(2).ne.-1) then - nss=0 - if(info(4).ne.0)then -cd write(iout,*) 'SS=',info(4),'N=',info(1),'IT=',info(2) - call var_to_geom(nvar,var) - call chainbuild - do i=1,info(4) - if (dist(ihpbt(i),jhpbt(i)).lt.7.0) then - nss=nss+1 - ihpb(nss)=ihpbt(i) - jhpb(nss)=jhpbt(i) -cd write(iout,*) 'SS mv=',info(3), -cd & ihpb(nss)-nres,jhpb(nss)-nres, -cd & dist(ihpb(nss),jhpb(nss)) - dhpb(nss)=dbr - forcon(nss)=fbr - else -cd write(iout,*) 'rm SS mv=',info(3), -cd & ihpbt(i)-nres,jhpbt(i)-nres,dist(ihpbt(i),jhpbt(i)) - endif - enddo - endif - nhpb=nss - link_start=1 - link_end=nhpb - call init_int_table - endif - - if (info(3).eq.14) then - write(iout,*) 'calling local_move',info(7),info(8) - call local_move_init(.false.) - call var_to_geom(nvar,var) - call local_move(info(7),info(8),20d0,50d0) - call geom_to_var(nvar,var) - endif - - - if (info(3).eq.16) then - write(iout,*) 'calling beta_slide',info(7),info(8), - & info(10), info(11), info(12) - call var_to_geom(nvar,var) - call beta_slide(info(7),info(8),info(10),info(11),info(12) - & ,nfun,n) - call geom_to_var(nvar,var) - endif - - - if (info(3).eq.17) then - write(iout,*) 'calling beta_zip',info(7),info(8) - call var_to_geom(nvar,var) - call beta_zip(info(7),info(8),nfun,n) - call geom_to_var(nvar,var) - endif - - -crc overlap test - - if (overlapsc) then - - call var_to_geom(nvar,var) - call chainbuild - call etotal(energia(0)) - nfun=nfun+1 - if (energia(1).eq.1.0d20) then - info(3)=-info(3) - write (iout,'(a,1pe14.5)')'#OVERLAP evdw=1d20',energia(1) - call overlap_sc(fail) - if(.not.fail) then - call geom_to_var(nvar,var) - call etotal(energia(0)) - nfun=nfun+1 - write (iout,'(a,1pe14.5)')'#OVERLAP evdw after',energia(1) - else - v(10)=1.0d20 - iv(1)=-1 - goto 201 - endif - endif - endif - - if (searchsc) then - call var_to_geom(nvar,var) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) -cd write(iout,*) 'sc_move',nft_sc,etot - endif - - if (check_var(var,info)) then - v(10)=1.0d21 - iv(1)=6 - goto 201 - endif - - -crc - -! write (iout,*) 'MINIM_JLEE: Processor',me,' nvar',nvar -! write (iout,'(8f10.4)') (var(i),i=1,nvar) -! write (*,*) 'MINIM_JLEE: Processor',me,' received nvar',nvar -! write (*,'(8f10.4)') (var(i),i=1,nvar) - - do i=1,nvar - garbage(i)=var(i) - enddo - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -cd iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -cd iv(22)=1 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 - -c if(me.eq.3.and.n.eq.255) then -c print *,' CHUJ: stoi' -c iv(21)=6 -c iv(22)=1 -c iv(23)=1 -c iv(24)=1 -c endif - -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy -! write (iout,*) 'Processor',me,' nvar',nvar -! write (iout,*) 'Variables BEFORE minimization:' -! write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar) - -c print *, 'MINIM_JLEE: ',me,' before SUMSL ' - - call func(nvar,var,nf,eee,idum,rdum,fdum) - nfun=nfun+1 - if(eee.ge.1.0d20) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - go to 201 - endif - -ct time0s=MPI_WTIME() - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -ct write(iout,*) 'sumsl time=',MPI_WTIME()-time0s,iv(7),v(10) -c print *, 'MINIM_JLEE: ',me,' after SUMSL ' - -c find which conformation was returned from sumsl - nfun=nfun+iv(7) -! print *,'Processor',me,' iv(17)',iv(17),' iv(18)',iv(18),' nf',nf, -! & ' retcode',iv(1),' energy',v(10),' tolf',v(31),' rtolf',v(32) -c if (iv(1).ne.4 .or. nf.le.1) then -c write (*,*) 'Processor',me,' something bad in SUMSL',iv(1),nf -c write (*,*) 'Initial Variables' -c write (*,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar) -c write (*,*) 'Variables' -c write (*,'(8f10.4)') (rad2deg*var(i),i=1,nvar) -c write (*,*) 'Vector d' -c write (*,'(8f10.4)') (d(i),i=1,nvar) -c write (iout,*) 'Processor',me,' something bad in SUMSL', -c & iv(1),nf -c write (iout,*) 'Initial Variables' -c write (iout,'(8f10.4)') (rad2deg*garbage(i),i=1,nvar) -c write (iout,*) 'Variables' -c write (iout,'(8f10.4)') (rad2deg*var(i),i=1,nvar) -c write (iout,*) 'Vector d' -c write (iout,'(8f10.4)') (d(i),i=1,nvar) -c endif -c if (nf.lt.iv(6)-1) then -c recalculate intra- and interchain energies -c call func(nvar,var,nf,v(10),iv,v,fdum) -c else if (nf.eq.iv(6)-1) then -c regenerate conformation -c call var_to_geom(nvar,var) -c call chainbuild -c endif -c change origin and axes to standard ECEPP format -c call var_to_geom(nvar,var) -! write (iout,*) 'MINIM_JLEE after minim: Processor',me,' nvar',nvar -! write (iout,'(8f10.4)') (var(i),i=1,nvar) -! write (iout,*) 'Energy:',v(10) -c send back output -c print *, 'MINIM_JLEE: ',me,' minimized: ',n - 201 continue - indx(1)=n -c return code: 6-gradient 9-number of ftn evaluation, etc - indx(2)=iv(1) -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(3)=nfun - indx(4)=info(2) - indx(5)=info(3) - indx(6)=nss - indx(7)=info(5) - indx(8)=info(6) - indx(9)=info(9) - call mpi_send(indx,9,mpi_integer,king,idint,CG_COMM, - * ierr) -c send back energies -c al & cc -c calculate contact order -#ifdef CO_BIAS - call contact(.false.,ncont,icont,co) - erg(1)=v(10)-1.0d2*co -#else - erg(1)=v(10) -#endif - j=1 - call mpi_send(erg,j,mpi_double_precision,king,idreal, - * CG_COMM,ierr) -#ifdef CO_BIAS - call mpi_send(co,j,mpi_double_precision,king,idreal, - * CG_COMM,ierr) -#endif -c send back values of variables - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) -! print * , 'MINIM_JLEE: Processor',me,' send erg and var ' - - if(vdisulf.and.info(2).ne.-1.and.nss.ne.0) then -cd call intout -cd call chainbuild -cd call etotal(energia(0)) -cd etot=energia(0) -cd call enerprint(energia(0)) - call mpi_send(ihpb,nss,mpi_integer, - * king,idint,CG_COMM,ierr) - call mpi_send(jhpb,nss,mpi_integer, - * king,idint,CG_COMM,ierr) - endif - - go to 10 - 100 print *, ' error in receiving message from emperor', me - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 200 print *, ' error in sending message to emperor' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 300 print *, ' error in communicating with emperor' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 956 format (' initial energy could not be calculated',41x) - 957 format (80x) - 965 format (' convergence code ',i2,' # of function calls ', - * i4,' # of gradient calls ',i4,10x) - 975 format (' energy ',1p,e12.4,' scaled gradient ',e11.3,32x) - end -#else - subroutine minim_jlee -c controls minimization and sorting routines - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - write (iout,*) "Unsupported option for serial version" - return - end -#endif - - logical function check_var(var,info) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.SETUP' - dimension var(maxvar) - dimension info(3) -C AL ------- - check_var=.false. - do i=nphi+ntheta+1,nphi+ntheta+nside -! Check the side chain "valence" angles alpha - if (var(i).lt.1.0d-7) then - write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (iout,*) 'Processor',me,'received bad variables!!!!' - write (iout,*) 'Variables' - write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (iout,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle alpha',i-nphi-ntheta,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (*,*) 'Processor',me,'received bad variables!!!!' - write (*,*) 'Variables' - write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (*,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle alpha',i-nphi-ntheta,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - check_var=.true. - return - endif - enddo -! Check the backbone "valence" angles theta - do i=nphi+1,nphi+ntheta - if (var(i).lt.1.0d-7) then - write (iout,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (iout,*) 'Processor',me,'received bad variables!!!!' - write (iout,*) 'Variables' - write (iout,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (iout,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (iout,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle theta',i-nphi,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - write (*,*) 'CHUJ NASTAPIL ABSOLUTNY!!!!!!!!!!!!' - write (*,*) 'Processor',me,'received bad variables!!!!' - write (*,*) 'Variables' - write (*,'(8f10.4)') (rad2deg*var(j),j=1,nvar) - write (*,*) 'Continuing calculations at this point', - & ' could destroy the results obtained so far... ABORTING!!!!!!' - write (*,'(a19,i5,f10.4,a4,2i4,a3,i3)') - & 'valence angle theta',i-nphi,var(i), - & 'n it',info(1),info(2),'mv ',info(3) - check_var=.true. - return - endif - enddo - return - end diff --git a/source/unres/src_CSA_DiL/minim_mult.F b/source/unres/src_CSA_DiL/minim_mult.F deleted file mode 100644 index 0af0b3b..0000000 --- a/source/unres/src_CSA_DiL/minim_mult.F +++ /dev/null @@ -1,131 +0,0 @@ -#ifdef MPI - subroutine minim_mcmf - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - dimension indx(6) - dimension iv(liv) - dimension idum(1),rdum(1) - double precision przes(3),obrot(3,3) - logical non_conv - data rad /1.745329252d-2/ - common /przechowalnia/ v - - ichuj=0 - 10 continue - ichuj = ichuj + 1 - call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - if (indx(1).eq.0) return -c print *, 'worker ',me,' received order ',indx(2) - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene0,1,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -c print *, 'worker ',me,' var read ' - - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy - - call func(nvar,var,nf,eee,idum,rdum,fdum) - if(eee.gt.1.0d18) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - nf=1 - go to 201 - endif - - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -c find which conformation was returned from sumsl - nf=iv(7)+1 - 201 continue -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(4)=nf - indx(5)=iv(1) - eee=v(10) - - call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM, - * ierr) -c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10) -c print *,indx(2),indx(5) - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) - call mpi_send(eee,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - go to 10 - - return - end -#else - subroutine minim_mcmf - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - write (iout,*) "Unsupported option for serial version" - return - end -#endif - diff --git a/source/unres/src_CSA_DiL/minimize_p.F b/source/unres/src_CSA_DiL/minimize_p.F deleted file mode 100644 index 876db34..0000000 --- a/source/unres/src_CSA_DiL/minimize_p.F +++ /dev/null @@ -1,641 +0,0 @@ - subroutine minimize(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -********************************************************************* -* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -* the calling subprogram. * -* when d(i)=1.0, then v(35) is the length of the initial step, * -* calculated in the usual pythagorean way. * -* absolute convergence occurs when the function is within v(31) of * -* zero. unless you know the minimum value in advance, abs convg * -* is probably not useful. * -* relative convergence is when the model predicts that the function * -* will decrease by less than v(32)*abs(fun). * -********************************************************************* - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr,grad_restr - logical not_done,change,reduce -c common /przechowalnia/ v - - icall = 1 - - NOT_DONE=.TRUE. - -c DO WHILE (NOT_DONE) - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -cd print *,'Calling SUMSL' -c call var_to_geom(nvar,x) -c call chainbuild -c call etotal(energia(0)) -c etot = energia(0) - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr,grad_restr, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) -cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot -cd write (iout,'(/a,i4/)') 'SUMSL return code:',iv(1) -c call intout -c change=reduce(x) - call var_to_geom(nvar,x) -c if (change) then -c write (iout,'(a)') 'Reduction worked, minimizing again...' -c else -c not_done=.false. -c endif - call chainbuild -c call etotal(energia(0)) -c etot=energia(0) -c call enerprint(energia(0)) - nfun=iv(6) - -c write (*,*) 'Processor',MyID,' leaves MINIMIZE.' - -c ENDDO ! NOT_DONE - - return - end -#ifdef MPI -c---------------------------------------------------------------------------- - subroutine ergastulum - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.MD_' - include 'COMMON.TIME1' - double precision z(maxres6),d_a_tmp(maxres6) - double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy - integer icall /0/ -C Workers wait for variables and NF, and NFL from the boss - iorder=0 - do while (iorder.ge.0) -c write (*,*) 'Processor',fg_rank,' CG group',kolor, -c & ' receives order from Master' - time00=MPI_Wtime() - call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - if (icall.gt.4 .and. iorder.ge.0) - & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00 - icall=icall+1 -c write (*,*) -c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder - if (iorder.eq.0) then - call zerograd - call etotal(edum) -c write (2,*) "After etotal" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.2) then - call zerograd -cmd call etotal_short(edum) -c write (2,*) "After etotal_short" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.3) then - call zerograd -cmd call etotal_long(edum) -c write (2,*) "After etotal_long" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.1) then - call sum_gradient -c write (2,*) "After sum_gradient" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.4) then -cmd call ginv_mult(z,d_a_tmp) - else if (iorder.eq.5) then -c Setup MD things for a slave - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) -c write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - myginv_ng_count=maxres2*my_ng_count -c write (2,*) "igmult_start",igmult_start," igmult_end", -c & igmult_end," my_ng_count",my_ng_count -c call flush(2) - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) -c write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) -c call flush(2) -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (2,*) "dimen",dimen," dimen3",dimen3 -c write (2,*) "End MD setup" -c call flush(2) -c write (iout,*) "My chunk of ginv_block" -c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) - else if (iorder.eq.6) then - call int_from_cart1(.false.) - else if (iorder.eq.7) then - call chainbuild_cart - else if (iorder.eq.8) then - call intcartderiv - else if (iorder.eq.9) then -cmd call fricmat_mult(z,d_a_tmp) - else if (iorder.eq.10) then -cmd call setup_fricmat - endif - enddo - write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' leves ERGASTULUM.' - write(*,*)'Processor',fg_rank,' wait times for respective orders', - & (' order[',i,']',time_order(i),i=0,10) - return - end -#endif -************************************************************************ - subroutine func(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 -cd print *,'func',nf,nfl,icg - call var_to_geom(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -************************************************************************ - subroutine func_restr(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -c------------------------------------------------------- - subroutine x2xx(x,xx,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - varall(i)=x(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - endif - enddo - enddo - - n=ig - - return - end - - subroutine xx2x(x,xx) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - x(i)=varall(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - endif - enddo - enddo - - return - end - -c---------------------------------------------------------- - subroutine minim_dc(etot,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) -c common /przechowalnia/ v - - double precision energia(0:n_ene) - external func_dc,grad_dc,fdum - logical not_done,change,reduce - double precision g(maxvar),f1 - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,6*nres - d(i)=1.0D-1 - enddo - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - x(k)=dc(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - x(k)=dc(j,i+nres) - enddo - endif - enddo - - call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -cd call zerograd -cd nf=0 -cd call func_dc(k,x,nf,f,idum,rdum,fdum) -cd call grad_dc(k,x,nf,g,idum,rdum,fdum) -cd -cd do i=1,k -cd x(i)=x(i)+1.0D-5 -cd call func_dc(k,x,nf,f1,idum,rdum,fdum) -cd x(i)=x(i)-1.0D-5 -cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5 -cd enddo - - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - return - end - - subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - double precision energia(0:n_ene) - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf -cbad icg=mod(nf,2)+1 - icg=1 - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - - call zerograd - call etotal(energia(0)) - f=energia(0) - -cd print *,'func_dc ',nf,nfl,f - - return - end - - subroutine grad_dc(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD_' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1),k - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c -c -cbad icg=mod(nf,2)+1 - icg=1 -cd print *,'grad_dc ',nf,nfl,nf-nfl+1,icg - if (nf-nfl+1) 20,30,40 - 20 call func_dc(n,x,nf,f,uiparm,urparm,ufparm) -cd print *,20 - if (nf.eq.0) return - goto 40 - 30 continue -cd print *,30 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartgrad -cd print *,40 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - g(k)=gcart(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - g(k)=gxcart(j,i) - enddo - endif - enddo - - return - end diff --git a/source/unres/src_CSA_DiL/misc.f b/source/unres/src_CSA_DiL/misc.f deleted file mode 100644 index e189839..0000000 --- a/source/unres/src_CSA_DiL/misc.f +++ /dev/null @@ -1,203 +0,0 @@ -C $Date: 1994/10/12 17:24:21 $ -C $Revision: 2.5 $ -C -C -C - logical function find_arg(ipos,line,errflag) - parameter (maxlen=80) - character*80 line - character*1 empty /' '/,equal /'='/ - logical errflag -* This function returns .TRUE., if an argument follows keyword keywd; if so -* IPOS will point to the first non-blank character of the argument. Returns -* .FALSE., if no argument follows the keyword; in this case IPOS points -* to the first non-blank character of the next keyword. - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - errflag=.false. - if (line(ipos:ipos).eq.equal) then - find_arg=.true. - ipos=ipos+1 - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen) errflag=.true. - else - find_arg=.false. - endif - return - end - logical function find_group(iunit,jout,key1) - character*(*) key1 - character*80 karta,ucase - integer ilen - external ilen - logical lcom - rewind (iunit) - karta=' ' - ll=ilen(key1) - do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta)) - read (iunit,'(a)',end=10) karta - enddo - write (jout,'(2a)') '> ',karta(1:78) - find_group=.true. - return - 10 find_group=.false. - return - end - logical function iblnk(charc) - character*1 charc - integer n - n = ichar(charc) - iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ') - return - end - integer function ilen(string) - character*(*) string - logical iblnk - - ilen = len(string) -1 if ( ilen .gt. 0 ) then - if ( iblnk( string(ilen:ilen) ) ) then - ilen = ilen - 1 - goto 1 - endif - endif - return - end - integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset) - character*16 keywd,keywdset(1:nkey,0:nkey) - character*16 ucase - do i=1,narg - if (ucase(keywd).eq.keywdset(i,ikey)) then -* Match found - in_keywd_set=i - return - endif - enddo -* No match to the allowed set of keywords if this point is reached. - in_keywd_set=0 - return - end - character*(*) function lcase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(lcase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - lcase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'A') .and. lle(c,'Z')) then - lcase(i:i) = char(ichar(c) + idiff) - endif - 99 continue - return - end - logical function lcom(ipos,karta) - character*80 karta - character koment(2) /'!','#'/ - lcom=.false. - do i=1,2 - if (karta(ipos:ipos).eq.koment(i)) lcom=.true. - enddo - return - end - logical function lower_case(ch) - character*(*) ch - lower_case=(ch.ge.'a' .and. ch.le.'z') - return - end - subroutine mykey(line,keywd,ipos,blankline,errflag) -* This subroutine seeks a non-empty substring keywd in the string LINE. -* The substring begins with the first character different from blank and -* "=" encountered right to the pointer IPOS (inclusively) and terminates -* at the character left to the first blank or "=". When the subroutine is -* exited, the pointer IPOS is moved to the position of the terminator in LINE. -* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains -* only separators or the maximum length of the data line (80) has been reached. -* The logical variable ERRFLAG is set at .TRUE. if the string -* consists only from a "=". - parameter (maxlen=80) - character*1 empty /' '/,equal /'='/,comma /','/ - character*(*) keywd - character*80 line - logical blankline,errflag,lcom - errflag=.false. - do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen)) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen .or. lcom(ipos,line) ) then -* At this point the rest of the input line turned out to contain only blanks -* or to be commented out. - blankline=.true. - return - endif - blankline=.false. - istart=ipos -* Checks whether the current char is a separator. - do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal - & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - iend=ipos-1 -* Error flag set to .true., if the length of the keyword was found less than 1. - if (iend.lt.istart) then - errflag=.true. - return - endif - keywd=line(istart:iend) - return - end - subroutine numstr(inum,numm) - character*10 huj /'0123456789'/ - character*(*) numm - inumm=inum - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(3:3)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(2:2)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(1:1)=huj(inum2+1:inum2+1) - return - end - character*(*) function ucase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(ucase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - ucase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'a') .and. lle(c,'z')) then - ucase(i:i) = char(ichar(c) - idiff) - endif - 99 continue - return - end diff --git a/source/unres/src_CSA_DiL/newconf.F b/source/unres/src_CSA_DiL/newconf.F deleted file mode 100644 index df93149..0000000 --- a/source/unres/src_CSA_DiL/newconf.F +++ /dev/null @@ -1,2456 +0,0 @@ -#ifdef MPI -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine make_var(n,idum,iter_csa) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.HAIRPIN' - include 'COMMON.VAR' - include 'COMMON.DISTFIT' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical nicht_getan,nicht_getan1,fail,lfound - integer nharp,iharp(4,maxres/3),nconf_harp - integer iisucc(mxio) - logical ifused(mxio) - integer nhx_seed(max_seed),ihx_seed(4,maxres/3,max_seed) - integer nhx_use(max_seed),ihx_use(0:4,maxres/3,max_seed) - integer nlx_seed(max_seed),ilx_seed(2,maxres/3,max_seed), - & nlx_use(max_seed),ilx_use(maxres/3,max_seed) - real ran1,ran2 - - write (iout,*) 'make_var : nseed=',nseed,'ntry=',n - index=0 - -c----------------------------------------- - if (n7.gt.0.or.n8.gt.0.or.n9.gt.0.or.n14.gt.0.or.n15.gt.0 - & .or.n16.gt.0.or.n17.gt.0.or.n18.gt.0) - & call select_frag(n7frag,n8frag,n14frag, - & n15frag,nbefrag,iter_csa) - -c--------------------------------------------------- -c N18 - random perturbation of one phi(=gamma) angle in a loop -c - IF (n18.gt.0) THEN - nlx_tot=0 - do iters=1,nseed - i1=is(iters) - nlx_seed(iters)=0 - do i2=1,n14frag - if (lvar_frag(i2,1).eq.i1) then - nlx_seed(iters)=nlx_seed(iters)+5 - ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2) - ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3) - ilx_use(nlx_seed(iters),iters)=5 - endif - enddo - nlx_use(iters)=nlx_seed(iters) - nlx_tot=nlx_tot+nlx_seed(iters) - enddo - - if (nlx_tot .ge. n18*nseed) then - ntot_gen=n18*nseed - else - ntot_gen=(nlx_tot/nseed)*nseed - endif - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nlx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nlx_seed(iters)) - if (ilx_use(iih,iters).gt.0) then - nicht_getan=.false. - ilx_use(iih,iters)=ilx_use(iih,iters)-1 - nlx_use(iters)=nlx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=18 - parent(1,index)=iseed - parent(2,index)=0 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - jr=iran_num(ilx_seed(1,iih,iters),ilx_seed(2,iih,iters)) - d=ran_number(-pi,pi) - dihang_in(2,jr-2,1,index)=pinorm(dihang_in(2,jr-2,1,index)+d) - - - if (ngen.eq.ntot_gen) goto 145 - endif - enddo - enddo - 145 continue - - ENDIF - - -c----------------------------------------- -c N17 : zip a beta in a seed by forcing one additional p-p contact -c - IF (n17.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - nhx_use(iters)=0 - do i2=1,nbefrag - if (avar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_use(2,nhx_seed(iters),iters)=1 - if (avar_frag(i2,5)-avar_frag(i2,3).le.3.and. - & avar_frag(i2,2).gt.1.and.avar_frag(i2,4).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - else - if (avar_frag(i2,4).gt.avar_frag(i2,5)) then - if (avar_frag(i2,2).gt.1.and. - & avar_frag(i2,4).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)+1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - if (avar_frag(i2,3).lt.nres.and. - & avar_frag(i2,5).gt.1) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)-1 - ihx_use(0,nhx_seed(iters),iters)= - & ihx_use(0,nhx_seed(iters),iters)+1 - ihx_use(2,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - else - if (avar_frag(i2,2).gt.1.and. - & avar_frag(i2,4).gt.1) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,2)-1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,4)-1 - ihx_use(0,nhx_seed(iters),iters)=1 - ihx_use(1,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - if (avar_frag(i2,3).lt.nres.and. - & avar_frag(i2,5).lt.nres) then - ihx_seed(1,nhx_seed(iters),iters)=avar_frag(i2,3)+1 - ihx_seed(2,nhx_seed(iters),iters)=avar_frag(i2,5)+1 - ihx_use(0,nhx_seed(iters),iters)= - & ihx_use(0,nhx_seed(iters),iters)+1 - ihx_use(2,nhx_seed(iters),iters)=0 - nhx_use(iters)=nhx_use(iters)+1 - endif - endif - endif - endif - enddo - - nhx_tot=nhx_tot+nhx_use(iters) -cd write (iout,*) "debug N17",iters,nhx_seed(iters), -cd & nhx_use(iters),nhx_tot - enddo - - if (nhx_tot .ge. n17*nseed) then - ntot_gen=n17*nseed - else if (nhx_tot .ge. nseed) then - ntot_gen=(nhx_tot/nseed)*nseed - else - ntot_gen=nhx_tot - endif -cd write (iout,*) "debug N17==",ntot_gen,nhx_tot,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then -cd write (iout,*) "debug N17",nhx_use(iters),ngen,ntot_gen -cd write (iout,*) "debugN17^", -cd & (ihx_use(0,k,iters),k=1,nhx_use(iters)) - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) -cd write (iout,*) "debugN17^",iih - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,2) -cd write (iout,*) "debugN17=",iih,nhx_seed(iters) -cd write (iout,*) "debugN17-",iim,'##', -cd & (ihx_use(k,iih,iters),k=0,2) -cd call flush(iout) - do while (ihx_use(iim,iih,iters).eq.1) - iim=iran_num(1,2) -cd write (iout,*) "debugN17-",iim,'##', -cd & (ihx_use(k,iih,iters),k=0,2) -cd call flush(iout) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=17 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - if (iim.eq.1) then - idata(1,index)=ihx_seed(1,iih,iters) - idata(2,index)=ihx_seed(2,iih,iters) - else - idata(1,index)=ihx_seed(3,iih,iters) - idata(2,index)=ihx_seed(4,iih,iters) - endif - - if (ngen.eq.ntot_gen) goto 115 - endif - enddo - enddo - 115 continue - write (iout,*) "N17",n17," ngen/nseed",ngen/nseed, - & ngen,nseed - - - ENDIF -c----------------------------------------- -c N16 : slide non local beta in a seed by +/- 1 or +/- 2 -c - IF (n16.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - do i2=1,n7frag - if (bvar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_seed(1,nhx_seed(iters),iters)=bvar_frag(i2,3) - ihx_seed(2,nhx_seed(iters),iters)=bvar_frag(i2,4) - ihx_seed(3,nhx_seed(iters),iters)=bvar_frag(i2,5) - ihx_seed(4,nhx_seed(iters),iters)=bvar_frag(i2,6) - ihx_use(0,nhx_seed(iters),iters)=4 - do i3=1,4 - ihx_use(i3,nhx_seed(iters),iters)=0 - enddo - endif - enddo - nhx_use(iters)=4*nhx_seed(iters) - nhx_tot=nhx_tot+nhx_seed(iters) -cd write (iout,*) "debug N16",iters,nhx_seed(iters) - enddo - - if (4*nhx_tot .ge. n16*nseed) then - ntot_gen=n16*nseed - else if (4*nhx_tot .ge. nseed) then - ntot_gen=(4*nhx_tot/nseed)*nseed - else - ntot_gen=4*nhx_tot - endif - write (iout,*) "debug N16",ntot_gen,4*nhx_tot,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,4) - do while (ihx_use(iim,iih,iters).eq.1) -cd write (iout,*) iim, -cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters) - iim=iran_num(1,4) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=16 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do i=1,4 - idata(i,index)=ihx_seed(i,iih,iters) - enddo - idata(5,index)=iim - - if (ngen.eq.ntot_gen) goto 116 - endif - enddo - enddo - 116 continue - write (iout,*) "N16",n16," ngen/nseed",ngen/nseed, - & ngen,nseed - ENDIF -c----------------------------------------- -c N15 : copy two 2nd structure elements from 1 or 2 conf. in bank to a seed -c - IF (n15.gt.0) THEN - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - do idummy=1,n15 - iter=0 - 84 continue - - iran=0 - iif=iran_num(1,n15frag) - do while( (ifused(iif) .or. svar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n15frag) - iran=iran+1 - enddo - if(iran.ge.mxio) goto 811 - - iran=0 - iig=iran_num(1,n15frag) - do while( (ifused(iig) .or. svar_frag(iig,1).eq.iseed .or. - & .not.(svar_frag(iif,3).lt.svar_frag(iig,2).or. - & svar_frag(iig,3).lt.svar_frag(iif,2)) ) .and. - & iran.le.mxio ) - iig=iran_num(1,n15frag) - iran=iran+1 - enddo - if(iran.ge.mxio) goto 811 - - index=index+1 - movenx(index)=15 - parent(1,index)=iseed - parent(2,index)=svar_frag(iif,1) - parent(3,index)=svar_frag(iig,1) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - ifused(iif)=.true. - ifused(iig)=.true. - call newconf_copy(idum,dihang_in(1,1,1,index), - & svar_frag(iif,1),svar_frag(iif,2),svar_frag(iif,3)) - - do j=svar_frag(iig,2),svar_frag(iig,3) - do i=1,4 - dihang_in(i,j,1,index)=bvar(i,j,1,svar_frag(iig,1)) - enddo - enddo - - - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) then - index=index-1 - ifused(iif)=.false. - goto 84 - endif - endif - - 811 continue - enddo - enddo - ENDIF - -c----------------------------------------- -c N14 local_move (Maurizio) for loops in a seed -c - IF (n14.gt.0) THEN - nlx_tot=0 - do iters=1,nseed - i1=is(iters) - nlx_seed(iters)=0 - do i2=1,n14frag - if (lvar_frag(i2,1).eq.i1) then - nlx_seed(iters)=nlx_seed(iters)+3 - ilx_seed(1,nlx_seed(iters),iters)=lvar_frag(i2,2) - ilx_seed(2,nlx_seed(iters),iters)=lvar_frag(i2,3) - ilx_use(nlx_seed(iters),iters)=3 - endif - enddo - nlx_use(iters)=nlx_seed(iters) - nlx_tot=nlx_tot+nlx_seed(iters) -cd write (iout,*) "debug N14",iters,nlx_seed(iters) - enddo - - if (nlx_tot .ge. n14*nseed) then - ntot_gen=n14*nseed - else - ntot_gen=(nlx_tot/nseed)*nseed - endif -cd write (iout,*) "debug N14",ntot_gen,n14frag,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nlx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nlx_seed(iters)) - if (ilx_use(iih,iters).gt.0) then - nicht_getan=.false. - ilx_use(iih,iters)=ilx_use(iih,iters)-1 - nlx_use(iters)=nlx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=14 - parent(1,index)=iseed - parent(2,index)=0 - - idata(1,index)=ilx_seed(1,iih,iters) - idata(2,index)=ilx_seed(2,iih,iters) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - if (ngen.eq.ntot_gen) goto 131 - endif - enddo - enddo - 131 continue -cd write (iout,*) "N14",n14," ngen/nseed",ngen/nseed, -cd & ngen,nseed - - ENDIF -c----------------------------------------- -c N9 : shift a helix in a seed -c - IF (n9.gt.0) THEN - nhx_tot=0 - do iters=1,nseed - i1=is(iters) - nhx_seed(iters)=0 - do i2=1,n8frag - if (hvar_frag(i2,1).eq.i1) then - nhx_seed(iters)=nhx_seed(iters)+1 - ihx_seed(1,nhx_seed(iters),iters)=hvar_frag(i2,2) - ihx_seed(2,nhx_seed(iters),iters)=hvar_frag(i2,3) - ihx_use(0,nhx_seed(iters),iters)=4 - do i3=1,4 - ihx_use(i3,nhx_seed(iters),iters)=0 - enddo - endif - enddo - nhx_use(iters)=4*nhx_seed(iters) - nhx_tot=nhx_tot+nhx_seed(iters) -cd write (iout,*) "debug N9",iters,nhx_seed(iters) - enddo - - if (4*nhx_tot .ge. n9*nseed) then - ntot_gen=n9*nseed - else - ntot_gen=(4*nhx_tot/nseed)*nseed - endif -cd write (iout,*) "debug N9",ntot_gen,n8frag,nseed - - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) - if (nhx_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nhx_seed(iters)) - if (ihx_use(0,iih,iters).gt.0) then - iim=iran_num(1,4) - do while (ihx_use(iim,iih,iters).eq.1) -cd write (iout,*) iim, -cd & ihx_use(0,iih,iters),ihx_use(iim,iih,iters) - iim=iran_num(1,4) - enddo - nicht_getan=.false. - ihx_use(iim,iih,iters)=1 - ihx_use(0,iih,iters)=ihx_use(0,iih,iters)-1 - nhx_use(iters)=nhx_use(iters)-1 - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=9 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - jstart=max(nnt,ihx_seed(1,iih,iters)+1) - jend=min(nct,ihx_seed(2,iih,iters)) -cd write (iout,*) "debug N9",iters,iih,jstart,jend - if (iim.eq.1) then - ishift=-2 - else if (iim.eq.2) then - ishift=-1 - else if (iim.eq.3) then - ishift=1 - else if (iim.eq.4) then - ishift=2 - else - write (iout,*) 'CHUJ NASTAPIL: iim=',iim - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do j=jstart,jend - if (itype(j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (j+ishift.ge.nnt.and.j+ishift.le.nct) - & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed) - enddo - enddo - if (ishift.gt.0) then - do j=0,ishift-1 - if (itype(jend+j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (jend+j.ge.nnt.and.jend+j.le.nct) - & dihang_in(i,jstart+j,1,index)=bvar(i,jend+j,1,iseed) - enddo - enddo - else - do j=0,-ishift-1 - if (itype(jstart+j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (jend+j.ge.nnt.and.jend+j.le.nct) - & dihang_in(i,jend+j,1,index)=bvar(i,jstart+j,1,iseed) - enddo - enddo - endif - if (ngen.eq.ntot_gen) goto 133 - endif - enddo - enddo - 133 continue -cd write (iout,*) "N9",n9," ngen/nseed",ngen/nseed, -cd & ngen,nseed - - ENDIF -c----------------------------------------- -c N8 : copy a helix from bank to seed -c - if (n8.gt.0) then - if (n8frag.lt.n8) then - write (iout,*) "N8: only ",n8frag,'helices' - n8c=n8frag - else - n8c=n8 - endif - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - - do idummy=1,n8c - iter=0 - 94 continue - iran=0 - iif=iran_num(1,n8frag) - do while( (ifused(iif) .or. hvar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n8frag) - iran=iran+1 - enddo - - if(iran.ge.mxio) goto 911 - - index=index+1 - movenx(index)=8 - parent(1,index)=iseed - parent(2,index)=hvar_frag(iif,1) - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - ifused(iif)=.true. - if (hvar_frag(iif,3)-hvar_frag(iif,2).le.6) then - call newconf_copy(idum,dihang_in(1,1,1,index), - & hvar_frag(iif,1),hvar_frag(iif,2),hvar_frag(iif,3)) - else - ih_start=iran_num(hvar_frag(iif,2),hvar_frag(iif,3)-6) - ih_end=iran_num(ih_start,hvar_frag(iif,3)) - call newconf_copy(idum,dihang_in(1,1,1,index), - & hvar_frag(iif,1),ih_start,ih_end) - endif - iter=iter+1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) then - index=index-1 - ifused(iif)=.false. - goto 94 - endif - endif - - - 911 continue - - enddo - enddo - - endif - -c----------------------------------------- -c N7 : copy nonlocal beta fragment from bank to seed -c - if (n7.gt.0) then - if (n7frag.lt.n7) then - write (iout,*) "N7: only ",n7frag,'nonlocal fragments' - n7c=n7frag - else - n7c=n7 - endif - - do i=1,maxres - do j=1,mxio2 - iff_in(i,j)=0 - enddo - enddo - index2=0 - do i=1,mxio - isend2(i)=0 - enddo - - do iters=1,nseed - iseed=is(iters) - do i=1,mxio - ifused(i)=.false. - enddo - - do idummy=1,n7c - iran=0 - iif=iran_num(1,n7frag) - do while( (ifused(iif) .or. bvar_frag(iif,1).eq.iseed) .and. - & iran.le.mxio ) - iif=iran_num(1,n7frag) - iran=iran+1 - enddo - -cd write (*,'(3i5,l,4i5)'),iters,idummy,iif,ifused(iif), -cd & bvar_frag(iif,1),iseed,iran,index2 - - if(iran.ge.mxio) goto 999 - if(index2.ge.mxio2) goto 999 - - index=index+1 - movenx(index)=7 - parent(1,index)=iseed - parent(2,index)=bvar_frag(iif,1) - index2=index2+1 - isend2(index)=index2 - ifused(iif)=.true. - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in2(i,j,k,index2)=bvar(i,j,k,bvar_frag(iif,1)) - enddo - enddo - enddo - - if (bvar_frag(iif,2).eq.4) then - do i=bvar_frag(iif,3),bvar_frag(iif,4) - iff_in(i,index2)=1 - enddo - if (bvar_frag(iif,5).lt.bvar_frag(iif,6)) then -cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4), -cd & bvar_frag(iif,5),bvar_frag(iif,6) - do i=bvar_frag(iif,5),bvar_frag(iif,6) - iff_in(i,index2)=1 - enddo - else -cd print *,'###',bvar_frag(iif,3),bvar_frag(iif,4), -cd & bvar_frag(iif,6),bvar_frag(iif,5) - do i=bvar_frag(iif,6),bvar_frag(iif,5) - iff_in(i,index2)=1 - enddo - endif - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - 999 continue - - enddo - enddo - - endif -c----------------------------------------------- -c N6 : copy random continues fragment from bank to seed -c - do iters=1,nseed - iseed=is(iters) - do idummy=1,n6 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 104 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 104 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 104 - endif - enddo - enddo -c----------------------------------------- - if (n3.gt.0.or.n4.gt.0) call gen_hairpin - nconf_harp=0 - do iters=1,nseed - if (nharp_seed(iters).gt.0) nconf_harp=nconf_harp+1 - enddo -c----------------------------------------- -c N3 : copy hairpin from bank to seed -c - do iters=1,nseed - iseed=is(iters) - nsucc=0 - nacc=0 - do idummy=1,n3 - index=index+1 - iter=0 - 124 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 124 - do k=1,nsucc - if (i1.eq.iisucc(k).and.nsucc.lt.nconf_harp-1) goto 124 - enddo - nsucc=nsucc+1 - iisucc(nsucc)=i1 - iter=iter+1 - call newconf_residue_hairpin(idum,dihang_in(1,1,1,index), - & i1,fail) - if (fail) then - if (icycle.le.0 .and. nsucc.eq.nconf .or. - & icycle.gt.0 .and. nsucc.eq.nbank) then - index=index-1 - goto 125 - else - goto 124 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 124 - endif - movenx(index)=3 - parent(1,index)=iseed - parent(2,index)=i1 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - nacc=nacc+1 - enddo -c if not enough hairpins, supplement with windows - 125 continue -cdd if (n3.ne.0) write (iout,*) "N3",n3," nsucc",nsucc," nacc",nacc - do idummy=nacc+1,n3 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - parent(1,index)=iseed - parent(2,index)=i1 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 114 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 114 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 114 - endif - enddo - enddo -c----------------------------------------- -c N4 : shift a turn in hairpin in seed -c - IF (N4.GT.0) THEN - if (4*nharp_tot .ge. n4*nseed) then - ntot_gen=n4*nseed - else - ntot_gen=(4*nharp_tot/nseed)*nseed - endif - ngen=0 - do while (ngen.lt.ntot_gen) - do iters=1,nseed - iseed=is(iters) -c write (iout,*) 'iters',iters,' iseed',iseed,' nharp_seed', -c & nharp_seed(iters),' nharp_use',nharp_use(iters), -c & ' ntot_gen',ntot_gen -c write (iout,*) 'iharp_use(0)', -c & (iharp_use(0,k,iters),k=1,nharp_seed(iters)) - if (nharp_use(iters).gt.0) then - nicht_getan=.true. - do while (nicht_getan) - iih=iran_num(1,nharp_seed(iters)) -c write (iout,*) 'iih',iih,' iharp_use', -c & (iharp_use(k,iih,iters),k=1,4) - if (iharp_use(0,iih,iters).gt.0) then - nicht_getan1=.true. - do while (nicht_getan1) - iim=iran_num(1,4) - nicht_getan1=iharp_use(iim,iih,iters).eq.1 - enddo - nicht_getan=.false. - iharp_use(iim,iih,iters)=1 - iharp_use(0,iih,iters)=iharp_use(0,iih,iters)-1 - nharp_use(iters)=nharp_use(iters)-1 -cdd write (iout,'(a16,i3,a5,i2,a10,2i4)') -cdd & 'N4 selected hairpin',iih,' move',iim,' iharp_seed', -cdd & iharp_seed(1,iih,iters),iharp_seed(2,iih,iters) - endif - enddo - ngen=ngen+1 - index=index+1 - movenx(index)=4 - parent(1,index)=iseed - parent(2,index)=0 - - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - jstart=iharp_seed(1,iih,iters)+1 - jend=iharp_seed(2,iih,iters) - if (iim.eq.1) then - ishift=-2 - else if (iim.eq.2) then - ishift=-1 - else if (iim.eq.3) then - ishift=1 - else if (iim.eq.4) then - ishift=2 - else - write (iout,*) 'CHUJ NASTAPIL: iim=',iim - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -c write (iout,*) 'jstart',jstart,' jend',jend,' ishift',ishift -c write (iout,*) 'Before turn shift' -c do j=2,nres-1 -c theta(j+1)=dihang_in(1,j,1,index) -c phi(j+2)=dihang_in(2,j,1,index) -c alph(j)=dihang_in(3,j,1,index) -c omeg(j)=dihang_in(4,j,1,index) -c enddo -c call intout - do j=jstart,jend - if (itype(j).eq.10) then - iang=2 - else - iang=4 - endif - do i=1,iang - if (j+ishift.ge.nnt.and.j+ishift.le.nct) - & dihang_in(i,j+ishift,1,index)=bvar(i,j,1,iseed) - enddo - enddo -c write (iout,*) 'After turn shift' -c do j=2,nres-1 -c theta(j+1)=dihang_in(1,j,1,index) -c phi(j+2)=dihang_in(2,j,1,index) -c alph(j)=dihang_in(3,j,1,index) -c omeg(j)=dihang_in(4,j,1,index) -c enddo -c call intout - if (ngen.eq.ntot_gen) goto 135 - endif - enddo - enddo -c if not enough hairpins, supplement with windows -c write (iout,*) 'end of enddo' - 135 continue -cdd write (iout,*) "N4",n4," ngen/nseed",ngen/nseed, -cdd & ngen,nseed - do iters=1,nseed - iseed=is(iters) - do idummy=ngen/nseed+1,n4 - isize=(is2-is1+1)*ran1(idum)+is1 - index=index+1 - movenx(index)=6 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - iter=0 - 134 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 134 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 134 - endif - enddo - enddo - ENDIF -c----------------------------------------- -c N5 : copy one residue from bank to seed (normally switched off - use N1) -c - do iters=1,nseed - iseed=is(iters) - isize=1 - do i=1,n5 - index=index+1 - movenx(index)=5 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - - iter=0 - 105 continue - if(icycle.le.0) then - i1=nconf* ran1(idum)+1 - i1=nbank-nconf+i1 - else - i1=nbank* ran1(idum)+1 - endif - if(i1.eq.iseed) goto 105 - iter=iter+1 - call newconf_residue(idum,dihang_in(1,1,1,index),i1,isize) - parent(1,index)=iseed - parent(2,index)=i1 - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 105 - endif - enddo - enddo -c----------------------------------------- -c N2 : copy backbone of one residue from bank or first bank to seed -c (normally switched off - use N1) -c - do iters=1,nseed - iseed=is(iters) - do i=n2,1,-1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - iseed=ran1(idum)*nconf+1 - iseed=nbank-nconf+iseed - endif - index=index+1 - movenx(index)=2 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 102 i1= ran1(idum)*nbank+1 - if(i1.eq.iseed) goto 102 - iter=iter+1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - nran=mod(i-1,nran0)+3 - call newconf1arr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=-iseed - parent(2,index)=-i1 - else if(icycle.le.0.and.iters.le.iuse) then - nran=mod(i-1,nran0)+1 - call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - nran=mod(i-1,nran1)+1 - if(ran1(idum).lt.0.5) then - call newconf1abr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - call newconf1abb(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=i1 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 102 - endif - enddo - enddo -c----------------------------------------- -c N1 : copy backbone or sidechain of one residue from bank or -c first bank to seed -c - do iters=1,nseed - iseed=is(iters) - do i=n1,1,-1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - iseed=ran1(idum)*nconf+1 - iseed=nbank-nconf+iseed - endif - index=index+1 - movenx(index)=1 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - iter=0 - 101 i1= ran1(idum)*nbank+1 - - if(i1.eq.iseed) goto 101 - iter=iter+1 - if(icycle.le.0.and.iuse.gt.nconf-irr) then - nran=mod(i-1,nran0)+3 - call newconf1rr(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=-iseed - parent(2,index)=-i1 - else if(icycle.le.0.and.iters.le.iuse) then - nran=mod(i-1,nran0)+1 - call newconf1br(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - nran=mod(i-1,nran1)+1 - if(ran1(idum).lt.0.5) then - call newconf1br(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=-i1 - else - call newconf1bb(idum,dihang_in(1,1,1,index),nran,i1) - parent(1,index)=iseed - parent(2,index)=i1 - endif - endif - if(iter.lt.10) then - call check_old(icheck,index) - if(icheck.eq.1) goto 101 - endif - enddo - enddo -c----------------------------------------- -c N0 just all seeds -c - IF (n0.gt.0) THEN - do iters=1,nseed - iseed=is(iters) - index=index+1 - movenx(index)=0 - parent(1,index)=iseed - parent(2,index)=0 - - if (vdisulf) then - nss_in(index)=bvar_nss(iseed) - do ij=1,nss_in(index) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - endif - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - enddo - ENDIF -c----------------------------------------- - if (vdisulf) then - do iters=1,nseed - iseed=is(iters) - - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,iseed) - phi(j+2)=bvar(2,j,k,iseed) - alph(j)=bvar(3,j,k,iseed) - omeg(j)=bvar(4,j,k,iseed) - enddo - enddo - call chainbuild - -cd write(iout,*) 'makevar DYNSS',iseed,'#',bvar_ns(iseed), -cd & (bvar_s(k,iseed),k=1,bvar_ns(iseed)), -cd & bvar_nss(iseed), -cd & (bvar_ss(1,k,iseed)-nres,'-', -cd & bvar_ss(2,k,iseed)-nres,k=1,bvar_nss(iseed)) - - do i1=1,bvar_ns(iseed) -c -c N10 fussion of free halfcysteines in seed -c first select CYS with distance < 7A -c - do j1=i1+1,bvar_ns(iseed) - if (dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-bvar_s(j1,iseed)).gt.3) then - - index=index+1 - movenx(index)=10 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - enddo - ij=bvar_nss(iseed)+1 - nss_in(index)=ij - iss_in(ij,index)=bvar_s(i1,iseed)+nres - jss_in(ij,index)=bvar_s(j1,iseed)+nres - -cd write(iout,*) 'makevar NSS0',index, -cd & dist(bvar_s(i1,iseed)+nres,bvar_s(j1,iseed)+nres), -cd & nss_in(index),iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - enddo -c -c N11 type I transdisulfidation -c - do j1=1,bvar_nss(iseed) - if (dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-(bvar_ss(1,j1,iseed)-nres)) - & .gt.3) then - - index=index+1 - movenx(index)=11 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(j1,index)=bvar_s(i1,iseed)+nres - jss_in(j1,index)=bvar_ss(1,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(1,j1,iseed) - jss_in(j1,index)=bvar_s(i1,iseed)+nres - endif - -cd write(iout,*) 'makevar NSS1 #1',index, -cd & bvar_s(i1,iseed),bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(1,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - endif - if (dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_s(i1,iseed)-(bvar_ss(2,j1,iseed)-nres)) - & .gt.3) then - - index=index+1 - movenx(index)=11 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(j1,index)=bvar_s(i1,iseed)+nres - jss_in(j1,index)=bvar_ss(2,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(2,j1,iseed) - jss_in(j1,index)=bvar_s(i1,iseed)+nres - endif - - -cd write(iout,*) 'makevar NSS1 #2',index, -cd & bvar_s(i1,iseed),bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_s(i1,iseed)+nres,bvar_ss(2,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - enddo - enddo - -c -c N12 type II transdisulfidation -c - do i1=1,bvar_nss(iseed) - do j1=i1+1,bvar_nss(iseed) - if (dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_ss(1,i1,iseed)-bvar_ss(1,j1,iseed)) - & .gt.3.and. - & iabs(bvar_ss(2,i1,iseed)-bvar_ss(2,j1,iseed)) - & .gt.3) then - index=index+1 - movenx(index)=12 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.i1 .and. ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(i1,index)=bvar_ss(1,i1,iseed) - jss_in(i1,index)=bvar_ss(1,j1,iseed) - if (iss_in(i1,index).gt.jss_in(i1,index)) then - iss_in(i1,index)=bvar_ss(1,j1,iseed) - jss_in(i1,index)=bvar_ss(1,i1,iseed) - endif - iss_in(j1,index)=bvar_ss(2,i1,iseed) - jss_in(j1,index)=bvar_ss(2,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(2,j1,iseed) - jss_in(j1,index)=bvar_ss(2,i1,iseed) - endif - - -cd write(iout,*) 'makevar NSS2 #1',index, -cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_ss(1,i1,iseed),bvar_ss(1,j1,iseed)), -cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_ss(2,i1,iseed),bvar_ss(2,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - if (dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)) - & .lt.7.0.and. - & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)) - & .lt.7.0.and. - & iabs(bvar_ss(1,i1,iseed)-bvar_ss(2,j1,iseed)) - & .gt.3.and. - & iabs(bvar_ss(2,i1,iseed)-bvar_ss(1,j1,iseed)) - & .gt.3) then - index=index+1 - movenx(index)=12 - parent(1,index)=iseed - parent(2,index)=0 - do ij=1,bvar_nss(iseed) - if (ij.ne.i1 .and. ij.ne.j1) then - iss_in(ij,index)=bvar_ss(1,ij,iseed) - jss_in(ij,index)=bvar_ss(2,ij,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed) - iss_in(i1,index)=bvar_ss(1,i1,iseed) - jss_in(i1,index)=bvar_ss(2,j1,iseed) - if (iss_in(i1,index).gt.jss_in(i1,index)) then - iss_in(i1,index)=bvar_ss(2,j1,iseed) - jss_in(i1,index)=bvar_ss(1,i1,iseed) - endif - iss_in(j1,index)=bvar_ss(2,i1,iseed) - jss_in(j1,index)=bvar_ss(1,j1,iseed) - if (iss_in(j1,index).gt.jss_in(j1,index)) then - iss_in(j1,index)=bvar_ss(1,j1,iseed) - jss_in(j1,index)=bvar_ss(2,i1,iseed) - endif - - -cd write(iout,*) 'makevar NSS2 #2',index, -cd & bvar_ss(1,i1,iseed)-nres,bvar_ss(2,j1,iseed)-nres, -cd & dist(bvar_ss(1,i1,iseed),bvar_ss(2,j1,iseed)), -cd & bvar_ss(2,i1,iseed)-nres,bvar_ss(1,j1,iseed)-nres, -cd & dist(bvar_ss(2,i1,iseed),bvar_ss(1,j1,iseed)), -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - - enddo - enddo -c -c N13 removal of disulfide bond -c - if (bvar_nss(iseed).gt.0) then - i1=bvar_nss(iseed)*ran1(idum)+1 - - index=index+1 - movenx(index)=13 - parent(1,index)=iseed - parent(2,index)=0 - ij=0 - do j1=1,bvar_nss(iseed) - if (j1.ne.i1) then - ij=ij+1 - iss_in(ij,index)=bvar_ss(1,j1,iseed) - jss_in(ij,index)=bvar_ss(2,j1,iseed) - endif - enddo - nss_in(index)=bvar_nss(iseed)-1 - -cd write(iout,*) 'NSS3',index,i1, -cd & bvar_ss(1,i1,iseed)-nres,'=',bvar_ss(2,i1,iseed)-nres,'#', -cd & (iss_in(ij,index)-nres,'-',jss_in(ij,index)-nres, -cd & ij=1,nss_in(index)) - - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - endif - - enddo - endif -c----------------------------------------- - - - - if(index.ne.n) write(iout,*)'make_var : ntry=',index - - n=index -cd do ii=1,n -cd write (istat,*) "======== ii=",ii," the dihang array" -cd do i=1,nres -cd write (istat,'(i5,4f15.5)') i,(dihang_in(k,i,1,ii)*rad2deg,k=1,4) -cd enddo -cd enddo - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine check_old(icheck,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - data ctdif /10./ - data ctdiff /60./ - - i1=n - do i2=1,n-1 - diff=0.d0 - do m=1,numch - do j=2,nres-1 - do i=1,4 - dif=rad2deg*dabs(dihang_in(i,j,m,i1)-dihang_in(i,j,m,i2)) - if(dif.gt.180.0) dif=360.0-dif - if(dif.gt.ctdif) goto 100 - diff=diff+dif - if(diff.gt.ctdiff) goto 100 - enddo - enddo - enddo - icheck=1 - return - 100 continue - enddo - - icheck=0 - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1rr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=rvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1br(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - i=0 - do j=1,ndih_nconstr - if(igroup(2,1,iran).eq.idih_nconstr(j))i=j - enddo - if(i.eq.0) then - juhc=0 -4321 juhc=juhc+1 - iran= ran1(idum)*number+1 - i=0 - do j=1,ndih_nconstr - if(igroup(2,1,iran).eq.idih_nconstr(j))i=j - enddo - if(i.eq.0.or.juhc.lt.1000)goto 4321 - if(juhc.eq.1000) then - print *, 'move 6 : failed to find unconstrained group' - write(iout,*) 'move 6 : failed to find unconstrained group' - endif - endif - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1bb(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=ntotgr - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1arr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=rvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1abr(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-rvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=rvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf1abb(idum,vvar,nran,i1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - do index=1,nran - iold(index) = 0 - enddo - - number=nres-2 - - iter=0 - do index=1,nran - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - if(iter.gt.number) return - iter=iter+1 - if(iter.eq.1) goto 11 - do ind=1,index-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - if(iter.gt.number) goto 20 - goto 10 - 20 continue - do ind=1,ngroup(iran) - i=igroup(1,ind,iran) - j=igroup(2,ind,iran) - k=igroup(3,ind,iran) - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - iold(index)=iran - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_residue(idum,vvar,i1,isize) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - k=1 - number=nres+isize-2 - iter=1 - 10 iran= ran1(idum)*number+1 - if(i2ndstr.gt.0) then - rtmp=ran1(idum) - if(rtmp.le.rdih_bias) then - iran=ran1(idum)*ndih_nconstr+1 - iran=idih_nconstr(iran) - endif - endif - istart=iran-isize+1 - iend=iran - if(istart.lt.2) istart=2 - if(iend.gt.nres-1) iend=nres-1 - - if(iter.eq.1) goto 11 - do ind=1,iter-1 - if(iran.eq.iold(ind)) goto 10 - enddo - 11 continue - - do j=istart,iend - do i=1,4 - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - enddo - iold(iter)=iran - iter=iter+1 - if(iter.gt.number) goto 20 - goto 10 - - 20 continue - do j=istart,iend - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - enddo - - return - end - -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_copy(idum,vvar,i1,istart,iend) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - ctdif=10. - - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - - - do j=istart,iend - do i=1,4 - vvar(i,j,1)=bvar(i,j,1,i1) - enddo - enddo - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine newconf_residue_hairpin(idum,vvar,i1,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - real ran1,ran2 - dimension vvar(mxang,maxres,mxch),iold(ntotal) - integer nharp,iharp(4,maxres/3),icipa(maxres/3) - logical fail,not_done - ctdif=10. - - fail=.false. - if (iseed.gt.mxio .or. iseed.lt.1) then - write (iout,*) 'Dimension ERROR in NEWCONF: ISEED',iseed - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,iseed) - enddo - enddo - enddo - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo -c call intout - call chainbuild - call hairpin(.false.,nharp,iharp) - - if (nharp.eq.0) then - fail=.true. - return - endif - - n_used=0 - - DO III=1,NHARP - - not_done = .true. - icount=0 - do while (not_done) - icount=icount+1 - iih=iran_num(1,nharp) - do k=1,n_used - if (iih.eq.icipa(k)) then - iih=0 - goto 22 - endif - enddo - not_done=.false. - n_used=n_used+1 - icipa(n_used)=iih - 22 continue - not_done = not_done .and. icount.le.nharp - enddo - - if (iih.eq.0) then - write (iout,*) "CHUJ NASTAPIL W NEWCONF_RESIDUE_HAIRPIN!!!!" - fail=.true. - return - endif - - istart=iharp(1,iih)+1 - iend=iharp(2,iih) - -cdd write (iout,*) "newconf_residue_hairpin: iih",iih, -cdd & " istart",istart," iend",iend - - do k=1,numch - do j=istart,iend - do i=1,4 - dif=rad2deg*dabs(vvar(i,j,k)-bvar(i,j,k,i1)) - if(dif.gt.180.) dif=360.-dif - if(dif.gt.ctdif) goto 20 - enddo - enddo - enddo - goto 10 - 20 continue - do k=1,numch - do j=istart,iend - do i=1,4 - vvar(i,j,k)=bvar(i,j,k,i1) - enddo - enddo - enddo -c do j=1,numch -c do l=2,nres-1 -c write (iout,'(4f8.3)') (rad2deg*vvar(i,l,j),i=1,4) -c enddo -c enddo - return - 10 continue - ENDDO - - fail=.true. - - return - end -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine gen_hairpin - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HAIRPIN' - -c write (iout,*) 'Entering GEN_HAIRPIN' - do iters=1,nseed - i1=is(iters) - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo - call chainbuild - call hairpin(.false.,nharp_seed(iters),iharp_seed(1,1,iters)) - enddo - - nharp_tot=0 - do iters=1,nseed - nharp_tot=nharp_tot+nharp_seed(iters) - nharp_use(iters)=4*nharp_seed(iters) - do j=1,nharp_seed(iters) - iharp_use(0,j,iters)=4 - do k=1,4 - iharp_use(k,j,iters)=0 - enddo - enddo - enddo - - write (iout,*) 'GEN_HAIRPIN: nharp_tot',nharp_tot -cdd do i=1,nseed -cdd write (iout,*) 'seed',i -cdd write (iout,*) 'nharp_seed',nharp_seed(i), -cdd & ' nharp_use',nharp_use(i) -cd write (iout,*) 'iharp_seed, iharp_use' -cd do j=1,nharp_seed(i) -cd write (iout,'(7i3)') iharp_seed(1,j,i),iharp_seed(2,j,i), -cd & (iharp_use(k,j,i),k=0,4) -cd enddo -cdd enddo - return - end - -ccccccccccccccccccccccccccccccccccccccccccccccccc -ccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine select_frag(nn,nh,nl,ns,nb,i_csa) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HAIRPIN' - include 'COMMON.DISTFIT' - character*50 linia - integer isec(maxres) - - - nn=0 - nh=0 - nl=0 - ns=0 - nb=0 -cd write (iout,*) 'Entering select_frag' - do i1=1,nbank - do i=1,nres - isec(i)=0 - enddo - do k=1,numch - do j=2,nres-1 - theta(j+1)=bvar(1,j,k,i1) - phi(j+2)=bvar(2,j,k,i1) - alph(j)=bvar(3,j,k,i1) - omeg(j)=bvar(4,j,k,i1) - enddo - enddo - call chainbuild -cd write (iout,*) ' -- ',i1,' -- ' - call secondary2(.false.) -c -c bvar_frag nn==pair of nonlocal strands in beta sheet (loop>4) -c strands > 4 residues; used by N7 and N16 -c - do j=1,nbfrag -c -Ctest 09/12/02 bfrag(2,j)-bfrag(1,j).gt.3 -c - do i=bfrag(1,j),bfrag(2,j) - isec(i)=1 - enddo - do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j)) - isec(i)=1 - enddo - - if ( (bfrag(3,j).lt.bfrag(4,j) .or. - & bfrag(4,j)-bfrag(2,j).gt.4) .and. - & bfrag(2,j)-bfrag(1,j).gt.4 ) then - nn=nn+1 - - - if (bfrag(3,j).lt.bfrag(4,j)) then - write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(3,j)-1,"-",bfrag(4,j)-1 - else - write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(4,j)-1,"-",bfrag(3,j)-1 - - endif -cd call write_pdb(i_csa*1000+nn+nh,linia,0d0) - - bvar_frag(nn,1)=i1 - bvar_frag(nn,2)=4 - do i=1,4 - bvar_frag(nn,i+2)=bfrag(i,j) - enddo - endif - enddo - -c -c hvar_frag nh==helices; used by N8 and N9 -c - do j=1,nhfrag - - do i=hfrag(1,j),hfrag(2,j) - isec(i)=2 - enddo - - if ( hfrag(2,j)-hfrag(1,j).gt.4 ) then - nh=nh+1 - -cd write(linia,'(a6,i3,a1,i3)') -cd & "select",hfrag(1,j)-1,"-",hfrag(2,j)-1 -cd call write_pdb(i_csa*1000+nn+nh,linia,0d0) - - hvar_frag(nh,1)=i1 - hvar_frag(nh,2)=hfrag(1,j) - hvar_frag(nh,3)=hfrag(2,j) - endif - enddo - - -cv write(iout,'(i4,1pe12.4,1x,1000i1)') -cv & i1,bene(i1),(isec(i),i=1,nres) -cv write(linia,'(i4,1x,1000i1)') -cv & i1,(isec(i),i=1,nres) -cv call write_pdb(i_csa*1000+i1,linia,bene(i1)) -c -c lvar_frag nl==loops; used by N14 -c - i=1 - nl1=nl - do while (i.lt.nres) - if (isec(i).eq.0) then - nl=nl+1 - lvar_frag(nl,1)=i1 - lvar_frag(nl,2)=i - i=i+1 - do while (isec(i).eq.0.and.i.le.nres) - i=i+1 - enddo - lvar_frag(nl,3)=i-1 - if (lvar_frag(nl,3)-lvar_frag(nl,2).lt.1) nl=nl-1 - endif - i=i+1 - enddo -cd write(iout,'(4i5)') (i,(lvar_frag(i,ii),ii=1,3),i=nl1+1,nl) - -c -c svar_frag ns==an secondary structure element; used by N15 -c - i=1 - ns1=ns - do while (i.lt.nres) - if (isec(i).gt.0) then - ns=ns+1 - svar_frag(ns,1)=i1 - svar_frag(ns,2)=i - i=i+1 - do while (isec(i).gt.0.and.isec(i-1).eq.isec(i) - & .and.i.le.nres) - i=i+1 - enddo - svar_frag(ns,3)=i-1 - if (svar_frag(ns,3)-svar_frag(ns,2).lt.1) ns=ns-1 - endif - if (isec(i).eq.0) i=i+1 - enddo -cd write(iout,'(4i5)') (i,(svar_frag(i,ii),ii=1,3),i=ns1+1,ns) - -c -c avar_frag nb==any pair of beta strands; used by N17 -c - do j=1,nbfrag - nb=nb+1 - avar_frag(nb,1)=i1 - do i=1,4 - avar_frag(nb,i+1)=bfrag(i,j) - enddo - enddo - - enddo - - return - end -#endif diff --git a/source/unres/src_CSA_DiL/parmread.F b/source/unres/src_CSA_DiL/parmread.F deleted file mode 100644 index 44d0370..0000000 --- a/source/unres/src_CSA_DiL/parmread.F +++ /dev/null @@ -1,1132 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD_' - include 'COMMON.SETUP' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - character*1 toronelet(-2:2) /"p","a","G","A","P"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2), - & (bthet(j,i,1,1),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - do i=1,ntyp - athet(1,i,1,-1)=athet(1,i,1,1) - athet(2,i,1,-1)=athet(2,i,1,1) - bthet(1,i,1,-1)=-bthet(1,i,1,1) - bthet(2,i,1,-1)=-bthet(2,i,1,1) - athet(1,i,-1,1)=-athet(1,i,1,1) - athet(2,i,-1,1)=-athet(2,i,1,1) - bthet(1,i,-1,1)=bthet(1,i,1,1) - bthet(2,i,-1,1)=bthet(2,i,1,1) - enddo - do i=-ntyp,-1 - a0thet(i)=a0thet(-i) - athet(1,i,-1,-1)=athet(1,-i,1,1) - athet(2,i,-1,-1)=-athet(2,-i,1,1) - bthet(1,i,-1,-1)=bthet(1,-i,1,1) - bthet(2,i,-1,-1)=-bthet(2,-i,1,1) - athet(1,i,-1,1)=athet(1,-i,1,1) - athet(2,i,-1,1)=-athet(2,-i,1,1) - bthet(1,i,-1,1)=-bthet(1,-i,1,1) - bthet(2,i,-1,1)=bthet(2,-i,1,1) - athet(1,i,1,-1)=-athet(1,-i,1,1) - athet(2,i,1,-1)=athet(2,-i,1,1) - bthet(1,i,1,-1)=bthet(1,-i,1,1) - bthet(2,i,1,-1)=-bthet(2,-i,1,1) - theta0(i)=theta0(-i) - sig0(i)=sig0(-i) - sigc0(i)=sigc0(-i) - do j=0,3 - polthet(j,i)=polthet(j,-i) - enddo - do j=1,3 - gthet(j,i)=gthet(j,-i) - enddo - enddo - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i,1,1),j=1,2), - $ (10*bthet(j,i,1,1),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) - enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) - enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) - enddo -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 - write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - write (2,*) "Start reading THETA_PDB" - do i=1,ntyp - read (ithep_pdb,*,err=111,end=111) a0thet(i), - & (athet(j,i,1,1),j=1,2), - & (bthet(j,i,1,1),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - write (2,*) "End reading THETA_PDB" - enddo - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - censc(1,1,-i)=censc(1,1,i) - censc(2,1,-i)=censc(2,1,i) - censc(3,1,-i)=-censc(3,1,i) - - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - censc(1,j,-i)=censc(1,j,i) - censc(2,j,-i)=censc(2,j,i) - censc(3,j,-i)=-censc(3,j,i) -C BSC is amplitude of Gaussian - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - if (((k.eq.3).and.(l.ne.3)) - & .or.((l.eq.3).and.(k.ne.3))) then - gaussc(k,l,j,-i)=-akl - gaussc(l,k,j,-i)=-akl - else - gaussc(k,l,j,-i)=akl - gaussc(l,k,j,-i)=akl - endif - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) -#endif - close(irotam) - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do iblock=1,2 - do i=-ntyp,-1 - itortyp(i)=-itortyp(-i) - enddo -c write (iout,*) 'ntortyp',ntortyp - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - read (itorp,*,end=113,err=113) nterm(i,j,iblock), - & nlor(i,j,iblock) - nterm(-i,-j,iblock)=nterm(i,j,iblock) - nlor(-i,-j,iblock)=nlor(i,j,iblock) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j,iblock) - read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock), - & v2(k,i,j,iblock) - v1(k,-i,-j,iblock)=v1(k,i,j,iblock) - v2(k,-i,-j,iblock)=-v2(k,i,j,iblock) - v0ij=v0ij+si*v1(k,i,j,iblock) - si=-si -c write(iout,*) i,j,k,iblock,nterm(i,j,iblock) -c write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock), -c &v2(k,-i,-j,iblock),v2(k,i,j,iblock) - enddo - do k=1,nlor(i,j,iblock) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j,iblock)=v0ij - v0(-i,-j,iblock)=v0ij - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j,iblock) - write (iout,'(2(1pe15.5))') v1(k,i,j,iblock), - & v2(k,i,j,iblock) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j,iblock) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - endif -C -C 6/23/01 Read parameters for double torsionals -C - do iblock=1,2 - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - do k=-ntortyp+1,ntortyp-1 - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 -c write (iout,*) "OK onelett", -c & i,j,k,t1,t2,t3 - - if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) - & .or. t3.ne.toronelet(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock), - & ntermd_2(i,j,k,iblock) - ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock) - ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) -C Matrix of D parameters for one dimesional foureir series - do l=1,ntermd_1(i,j,k,iblock) - v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock) - v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock) - v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock) - v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock) -c write(iout,*) "whcodze" , -c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) - enddo - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock), - & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock), - & v2s(m,l,i,j,k,iblock), - & m=1,l-1),l=1,ntermd_2(i,j,k,iblock)) -C Matrix of D parameters for two dimesional fourier series - do l=1,ntermd_2(i,j,k,iblock) - do m=1,l-1 - v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock) - v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock) - v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock) - v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock) - enddo!m - enddo!l - enddo!k - enddo!j - enddo!i - enddo!iblock - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do iblock=1,2 - do i=1,ntortyp - do j=-ntortyp,ntortyp - do k=-ntortyp,ntortyp - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k,iblock), - & ' ndouble',ntermd_2(i,j,k,iblock) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k,iblock) - write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock), - & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) - do l=1,ntermd_2(i,j,k,iblock) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) - do l=1,ntermd_2(i,j,k,iblock) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)), - & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock)) - enddo - write (iout,*) - enddo - enddo - enddo - enddo - endif -#endif -C -C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local -C correlation energies. -C - read (isccor,*,end=119,err=119) nterm_sccor - do i=1,20 - do j=1,20 - read (isccor,'(a)') - do k=1,nterm_sccor - read (isccor,*,end=119,err=119) kk,v1sccor(k,i,j), - & v2sccor(k,i,j) - enddo - enddo - enddo - close (isccor) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants of SCCORR:' - do i=1,20 - do j=1,20 - write (iout,*) 'ityp',i,' jtyp',j - do k=1,nterm_sccor - write (iout,'(2(1pe15.5))') v1sccor(k,i,j),v2sccor(k,i,j) - enddo - enddo - enddo - endif -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - if (lprint) then - write (iout,*) - write (iout,*) "Coefficients of the cumulants" - endif - read (ifourier,*) nloctyp - do i=0,nloctyp-1 - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13) - endif - B1(1,i) = b(3) - B1(2,i) = b(5) - B1(1,-i) = b(3) - B1(2,-i) = -b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 - B1tilde(1,i) = b(3) - B1tilde(2,i) =-b(5) - B1tilde(1,-i) =-b(3) - B1tilde(2,-i) =b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 - B2(1,i) = b(2) - B2(2,i) = b(4) - B2(1,-i) =b(2) - B2(2,-i) =-b(4) - -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CC(1,1,i)= b(7) - CC(2,2,i)=-b(7) - CC(2,1,i)= b(9) - CC(1,2,i)= b(9) - CC(1,1,-i)= b(7) - CC(2,2,-i)=-b(7) - CC(2,1,-i)=-b(9) - CC(1,2,-i)=-b(9) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 - Ctilde(1,1,i)=b(7) - Ctilde(1,2,i)=b(9) - Ctilde(2,1,i)=-b(9) - Ctilde(2,2,i)=b(7) - Ctilde(1,1,-i)=b(7) - Ctilde(1,2,-i)=-b(9) - Ctilde(2,1,-i)=b(9) - Ctilde(2,2,-i)=b(7) -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DD(1,1,i)= b(6) - DD(2,2,i)=-b(6) - DD(2,1,i)= b(8) - DD(1,2,i)= b(8) - DD(1,1,-i)= b(6) - DD(2,2,-i)=-b(6) - DD(2,1,-i)=-b(8) - DD(1,2,-i)=-b(8) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 - Dtilde(1,1,i)=b(6) - Dtilde(1,2,i)=b(8) - Dtilde(2,1,i)=-b(8) - Dtilde(2,2,i)=b(6) - Dtilde(1,1,-i)=b(6) - Dtilde(1,2,-i)=-b(8) - Dtilde(2,1,-i)=b(8) - Dtilde(2,2,-i)=b(6) -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EE(1,1,i)= b(10)+b(11) - EE(2,2,i)=-b(10)+b(11) - EE(2,1,i)= b(12)-b(13) - EE(1,2,i)= b(12)+b(13) - EE(1,1,-i)= b(10)+b(11) - EE(2,2,-i)=-b(10)+b(11) - EE(2,1,-i)=-b(12)+b(13) - EE(1,2,-i)=-b(12)-b(13) -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) - enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) - enddo - enddo - endif -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.5) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 50 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 50 -C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 50 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - 50 continue - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - enddo - enddo - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - rrij=sigma(i,j) - else - rrij=rr0(i)+rr0(j) - endif - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) - if (ipot.gt.2) then - sigt1sq=sigma0(i)**2 - sigt2sq=sigma0(j)**2 - sigii1=sigii(i) - sigii2=sigii(j) - ratsig1=sigt2sq/sigt1sq - ratsig2=1.0D0/ratsig1 - chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1) - if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - else - rsum_max=sigma(i,j) - endif -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - if (lprint) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - endif - enddo - enddo -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,20 -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo - - if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" - do i=1,20 - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -#endif -C -C Define the constants of the disulfide bridge -C - ebr=-5.50D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif - - return - end diff --git a/source/unres/src_CSA_DiL/pinorm.f b/source/unres/src_CSA_DiL/pinorm.f deleted file mode 100644 index 91392bf..0000000 --- a/source/unres/src_CSA_DiL/pinorm.f +++ /dev/null @@ -1,17 +0,0 @@ - double precision function pinorm(x) - implicit real*8 (a-h,o-z) -c -c this function takes an angle (in radians) and puts it in the range of -c -pi to +pi. -c - integer n - include 'COMMON.GEO' - n = x / dwapi - pinorm = x - n * dwapi - if ( pinorm .gt. pi ) then - pinorm = pinorm - dwapi - else if ( pinorm .lt. - pi ) then - pinorm = pinorm + dwapi - end if - return - end diff --git a/source/unres/src_CSA_DiL/printmat.f b/source/unres/src_CSA_DiL/printmat.f deleted file mode 100644 index be2b38f..0000000 --- a/source/unres/src_CSA_DiL/printmat.f +++ /dev/null @@ -1,16 +0,0 @@ - subroutine printmat(ldim,m,n,iout,key,a) - character*3 key(n) - double precision a(ldim,n) - do 1 i=1,n,8 - nlim=min0(i+7,n) - write (iout,1000) (key(k),k=i,nlim) - write (iout,1020) - 1000 format (/5x,8(6x,a3)) - 1020 format (/80(1h-)/) - do 2 j=1,n - write (iout,1010) key(j),(a(j,k),k=i,nlim) - 2 continue - 1 continue - 1010 format (a3,2x,8(f9.4)) - return - end diff --git a/source/unres/src_CSA_DiL/prng_32.F b/source/unres/src_CSA_DiL/prng_32.F deleted file mode 100644 index 9448f31..0000000 --- a/source/unres/src_CSA_DiL/prng_32.F +++ /dev/null @@ -1,1077 +0,0 @@ -#if defined(AIX) || defined(AMD64) - real*8 function prng_next(mel) - implicit none - integer me,mel -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (mel, iseed) - implicit none - integer me,mel - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end -#else - real function prng_next(me) -crc logical prng_restart, prng_chkpnt -c -c Calling sequence: -c = prng_next ( ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses 4 16-bit packets, and uses a block data common -c area for the initial seeds and constants. A 64-bit floating point -c number is returned. -c -c The arrays "l" and "n" are full-word aligned, being padded by zeros -c That is, rows 1-4 in a given column are for real, rows 5-16 are bogus -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c - real tpm12 - integer iseed(4) - parameter(tpm12 = 1.d0/65536.d0) - parameter(nmax=1021) -c external prngblk - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - data m1,m2,m3,m4 / 0, 8037, 61950, 30779/ - if (me .lt. 0 .or. me .gt. nmax) then - prng_next=-1.0 - return - endif - l1=l(1,me) - l2=l(2,me) - l3=l(3,me) - l4=l(4,me) - i1=l1*m4+l2*m3+l3*m2+l4*m1 + n(1,me) - i2=l2*m4+l3*m3+l4*m2 + n(2,me) - i3=l3*m4+l4*m3 + n(3,me) - i4=l4*m4 + n(4,me) - l4=and(i4,65535) - i3=i3+ishft(i4,-16) - l3=and(i3,65535) - i2=i2+ishft(i3,-16) - l2=and(i2,65535) - l1=and(i1+ishft(i2,-16),65535) - prng_next=tpm12*(l1+tpm12*(l2+tpm12*(l3+tpm12*l4))) - l(1,me)=l1 - l(2,me)=l2 - l(3,me)=l3 - l(4,me)=l4 - return - end -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c -crc entry prng_chkpnt (me, iseed) - logical function prng_chkpnt (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed(1)=l(1,me) - iseed(2)=l(2,me) - iseed(3)=l(3,me) - iseed(4)=l(4,me) - endif - return - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c seed is an 4-element integer array containing the "l"-values -c -crc entry prng_restart (me, iseed) - logical function prng_restart (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - l(1,me)=iseed(1) - l(2,me)=iseed(2) - l(3,me)=iseed(3) - l(4,me)=iseed(4) - endif - return - end - - block data prngblk -c -c Sequence of prime numbers represented as pairs of 16-bit integers -c modulo 2**16, obtained from Mal Kalos August 28, 1992. Only 98 -c continuation cards are allowed by ksr Fortran, so several DATA -c statements are used to initialize 1022 generators. -c -c @cornell university, 1992 -c - parameter(nmax=1021,nmax1=2*nmax+2) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - -c High order quads in arrays "l" and "n" are initialized to zero : rows 1-2 -c Rows 5-16 remain uninitialized. They are just pads, never used. - DATA ((l(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - DATA ((n(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - -c The rest of array "l" and "n" are initialized to a 20-bit seed - DATA ((l(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180,51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((l(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((l(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181,1015,181,1021,181,1023,181,1041,181,1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - DATA ((n(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180, 51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((n(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((n(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181, 1015,181, 1021,181, 1023,181, 1041,181, 1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - end -#endif diff --git a/source/unres/src_CSA_DiL/ran.f b/source/unres/src_CSA_DiL/ran.f deleted file mode 100644 index dd23252..0000000 --- a/source/unres/src_CSA_DiL/ran.f +++ /dev/null @@ -1,128 +0,0 @@ -ccccccccccccccccccccccccccccccccccccccccccccccccc - FUNCTION ran0(idum) - INTEGER idum,IA,IM,IQ,IR,MASK - REAL ran0,AM - PARAMETER (IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836, - *MASK=123459876) - INTEGER k - idum=ieor(idum,MASK) - k=idum/IQ - idum=IA*(idum-k*IQ)-IR*k - if (idum.lt.0) idum=idum+IM - ran0=AM*idum - idum=ieor(idum,MASK) - return - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915 -ccccccccccccccccccccccccccccccccccccccccccccccccc - FUNCTION ran1(idum) - INTEGER idum,IA,IM,IQ,IR,NTAB,NDIV - REAL ran1,AM,EPS,RNMX - PARAMETER (IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836, - *NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=1.2e-7,RNMX=1.-EPS) - INTEGER j,k,iv(NTAB),iy - SAVE iv,iy - DATA iv /NTAB*0/, iy /0/ - if (idum.le.0.or.iy.eq.0) then - idum=max(-idum,1) - do 11 j=NTAB+8,1,-1 - k=idum/IQ - idum=IA*(idum-k*IQ)-IR*k - if (idum.lt.0) idum=idum+IM - if (j.le.NTAB) iv(j)=idum -11 continue - iy=iv(1) - endif - k=idum/IQ - idum=IA*(idum-k*IQ)-IR*k - if (idum.lt.0) idum=idum+IM - j=1+iy/NDIV - iy=iv(j) - iv(j)=idum - ran1=min(AM*iy,RNMX) - return - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915 -ccccccccccccccccccccccccccccccccccccccccccccccccc - FUNCTION ran2(idum) - INTEGER idum,IM1,IM2,IMM1,IA1,IA2,IQ1,IQ2,IR1,IR2,NTAB,NDIV - REAL ran2,AM,EPS,RNMX - PARAMETER (IM1=2147483563,IM2=2147483399,AM=1./IM1,IMM1=IM1-1, - *IA1=40014,IA2=40692,IQ1=53668,IQ2=52774,IR1=12211,IR2=3791, - *NTAB=32,NDIV=1+IMM1/NTAB,EPS=1.2e-7,RNMX=1.-EPS) - INTEGER idum2,j,k,iv(NTAB),iy - SAVE iv,iy,idum2 - DATA idum2/123456789/, iv/NTAB*0/, iy/0/ - if (idum.le.0) then - idum=max(-idum,1) - idum2=idum - do 11 j=NTAB+8,1,-1 - k=idum/IQ1 - idum=IA1*(idum-k*IQ1)-k*IR1 - if (idum.lt.0) idum=idum+IM1 - if (j.le.NTAB) iv(j)=idum -11 continue - iy=iv(1) - endif - k=idum/IQ1 - idum=IA1*(idum-k*IQ1)-k*IR1 - if (idum.lt.0) idum=idum+IM1 - k=idum2/IQ2 - idum2=IA2*(idum2-k*IQ2)-k*IR2 - if (idum2.lt.0) idum2=idum2+IM2 - j=1+iy/NDIV - iy=iv(j)-idum2 - iv(j)=idum - if(iy.lt.1)iy=iy+IMM1 - ran2=min(AM*iy,RNMX) - return - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915 -ccccccccccccccccccccccccccccccccccccccccccccccccc - FUNCTION ran3(idum) - INTEGER idum - INTEGER MBIG,MSEED,MZ -C REAL MBIG,MSEED,MZ - REAL ran3,FAC - PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG) -C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG) - INTEGER i,iff,ii,inext,inextp,k - INTEGER mj,mk,ma(55) -C REAL mj,mk,ma(55) - SAVE iff,inext,inextp,ma - DATA iff /0/ - if(idum.lt.0.or.iff.eq.0)then - iff=1 - mj=MSEED-iabs(idum) - mj=mod(mj,MBIG) - ma(55)=mj - mk=1 - do 11 i=1,54 - ii=mod(21*i,55) - ma(ii)=mk - mk=mj-mk - if(mk.lt.MZ)mk=mk+MBIG - mj=ma(ii) -11 continue - do 13 k=1,4 - do 12 i=1,55 - ma(i)=ma(i)-ma(1+mod(i+30,55)) - if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG -12 continue -13 continue - inext=0 - inextp=31 - idum=1 - endif - inext=inext+1 - if(inext.eq.56)inext=1 - inextp=inextp+1 - if(inextp.eq.56)inextp=1 - mj=ma(inext)-ma(inextp) - if(mj.lt.MZ)mj=mj+MBIG - ma(inext)=mj - ran3=mj*FAC - return - END -C (C) Copr. 1986-92 Numerical Recipes Software *11915 -ccccccccccccccccccccccccccccccccccccccccccccccccc diff --git a/source/unres/src_CSA_DiL/randgens.f b/source/unres/src_CSA_DiL/randgens.f deleted file mode 100644 index 0daeb35..0000000 --- a/source/unres/src_CSA_DiL/randgens.f +++ /dev/null @@ -1,99 +0,0 @@ -C $Date: 1994/10/04 16:19:52 $ -C $Revision: 2.1 $ -C -C -C See help for RANDOMV on the PSFSHARE disk to understand these -C subroutines. This is the VS Fortran version of this code. -C -C - SUBROUTINE VRND(VEC,N) - INTEGER A(250) - COMMON /VRANDD/ A, I, I147 - INTEGER LOOP,I,I147,VEC(N) - DO 23000 LOOP=1,N - I=I+1 - IF(.NOT.(I.GE.251))GOTO 23002 - I=1 -23002 CONTINUE - I147=I147+1 - IF(.NOT.(I147.GE.251))GOTO 23004 - I147=1 -23004 CONTINUE - A(I)=IEOR(A(I147),A(I)) - VEC(LOOP)=A(I) -23000 CONTINUE - RETURN - END -C -C - DOUBLE PRECISION FUNCTION RNDV(IDUM) - DOUBLE PRECISION RM1,RM2,R(99) - INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM - SAVE - DATA IA1,IC1,M1/1279,351762,1664557/ - DATA IA2,IC2,M2/2011,221592,1048583/ - DATA IA3,IC3,M3/15551,6150,29101/ - IF(.NOT.(IDUM.LT.0))GOTO 23006 - IX1 = MOD(-IDUM,M1) - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IX1,M2) - IX1 = MOD(IA1*IX1+IC1,M1) - IX3 = MOD(IX1,M3) - RM1 = 1./DBLE(M1) - RM2 = 1./DBLE(M2) - DO 23008 J = 1,99 - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 -23008 CONTINUE -23006 CONTINUE - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - IX3 = MOD(IA3*IX3+IC3,M3) - J = 1+(99*IX3)/M3 - RNDV = R(J) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 - IDUM = IX1 - RETURN - END -C -C - SUBROUTINE VRNDST(SEED) - INTEGER A(250),LOOP,IDUM,SEED - DOUBLE PRECISION RNDV - COMMON /VRANDD/ A, I, I147 - I=0 - I147=103 - IDUM=SEED - DO 23010 LOOP=1,250 - A(LOOP)=INT(RNDV(IDUM)*2147483647) -23010 CONTINUE - RETURN - END -C -C - SUBROUTINE VRNDIN(IODEV) - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - READ(IODEV) A, I, I147 - RETURN - END -C -C - SUBROUTINE VRNDOU(IODEV) -C This corresponds to VRNDOUT in the APFTN64 version - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - WRITE(IODEV) A, I, I147 - RETURN - END - FUNCTION RNUNF(N) - INTEGER IRAN1(2000) - DATA FCTOR /2147483647.0D0/ -C We get only one random number, here! DR 9/1/92 - CALL VRND(IRAN1,1) - RNUNF= DBLE( IRAN1(1) ) / FCTOR -C****************************** -C write(6,*) 'rnunf in rnunf = ',rnunf - RETURN - END diff --git a/source/unres/src_CSA_DiL/readpdb.F b/source/unres/src_CSA_DiL/readpdb.F deleted file mode 100644 index eb4ba3f..0000000 --- a/source/unres/src_CSA_DiL/readpdb.F +++ /dev/null @@ -1,428 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - logical fail - integer rescode - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - - - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c include "mpif.h" - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if(me.eq.king.or..not.out1file)then - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' - endif - endif - endif - do i=1,nres-1 - iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) -C 9/29/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) - & di=dsc(itype(i)) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c include "mpif.h" - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end diff --git a/source/unres/src_CSA_DiL/readrtns_csa.F b/source/unres/src_CSA_DiL/readrtns_csa.F deleted file mode 100644 index a6ed1f8..0000000 --- a/source/unres/src_CSA_DiL/readrtns_csa.F +++ /dev/null @@ -1,1920 +0,0 @@ - subroutine readrtns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical file_exist -C Read force-field parameters except weights - call parmread -C Read job setup parameters - call read_control -C Read control parameters for energy minimzation if required - if (minim) call read_minim -C Read MCM control parameters if required -c if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread -C Read MD control parameters if reqjuired -c if (modecalc.eq.12) call read_MDpar -C Read MREMD control parameters if required -c if (modecalc.eq.14) then -c call read_MDpar -c call read_REMDpar -c endif -C Read MUCA control parameters if required -c if (lmuca) call read_muca -C Read CSA control parameters if required (from fort.40 if exists -C otherwise from general input file) - if (modecalc.eq.8) then - inquire (file="fort.40",exist=file_exist) - if (.not.file_exist) call csaread - endif -cfmc if (modecalc.eq.10) call mcmfread -C Read molecule information, molecule geometry, energy-term weights, and -C restraints if requested - call molread - -C Print restraint information -#ifdef MPI - if (.not. out1file .or. me.eq.king) then -#endif - if (nhpb.gt.nss) - &write (iout,'(a,i5,a)') "The following",nhpb-nss, - & " distance constraints have been imposed" - do i=nss+1,nhpb - write (iout,'(3i6,f10.5)') i-nss,ihpb(i),jhpb(i),forcon(i) - enddo -#ifdef MPI - endif -#endif -c print *,"Processor",myrank," leaves READRTNS" - return - end -C------------------------------------------------------------------------------- - subroutine read_control -C -C Read contorl data -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -c include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' -c include 'COMMON.MAP' - include 'COMMON.HEADER' -c include 'COMMON.CSA' - include 'COMMON.CHAIN' -c include 'COMMON.MUCA' -c include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/ - character*80 ucase - character*320 controlcard - - nglob_csa=0 - eglob_csa=1d99 - nmin_csa=0 - read (INP,'(a)') titel - call card_concat(controlcard) -c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0 -c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file - call reada(controlcard,'SEED',seed,0.0D0) - call random_init(seed) -C Set up the time limit (caution! The time must be input in minutes!) - read_cart=index(controlcard,'READ_CART').gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours - unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 - call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes - call reada(controlcard,'RMSDBC',rmsdbc,3.0D0) - call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0) - call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0) - call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0) - call reada(controlcard,'DRMS',drms,0.1D0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc - write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1 - write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max - write (iout,'(a,f10.1)')'DRMS = ',drms - write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm - write (iout,'(a,f10.1)') 'Time limit (min):',timlim - endif - call readi(controlcard,'NZ_START',nz_start,0) - call readi(controlcard,'NZ_END',nz_end,0) - call readi(controlcard,'IZ_SC',iz_sc,0) - timlim=60.0D0*timlim - safety = 60.0d0*safety - timem=timlim - modecalc=0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - minim=(index(controlcard,'MINIMIZE').gt.0) - dccart=(index(controlcard,'CART').gt.0) - overlapsc=(index(controlcard,'OVERLAP').gt.0) - overlapsc=.not.overlapsc - searchsc=(index(controlcard,'NOSEARCHSC').gt.0) - searchsc=.not.searchsc - sideadd=(index(controlcard,'SIDEADD').gt.0) - energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) - outpdb=(index(controlcard,'PDBOUT').gt.0) - outmol2=(index(controlcard,'MOL2OUT').gt.0) - pdbref=(index(controlcard,'PDBREF').gt.0) - refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) - indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) - call readi(controlcard,'IPRINT',iprint,0) - call readi(controlcard,'MAXGEN',maxgen,10000) - call readi(controlcard,'MAXOVERLAP',maxoverlap,1000) - call readi(controlcard,"KDIAG",kdiag,0) - call readi(controlcard,"RESCALE_MODE",rescale_mode,0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) - & write (iout,*) "RESCALE_MODE",rescale_mode - split_ene=index(controlcard,'SPLIT_ENE').gt.0 - if (index(controlcard,'REGULAR').gt.0.0D0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - modecalc=1 - refstr=.true. - endif - if (index(controlcard,'CHECKGRAD').gt.0) then - modecalc=5 - if (index(controlcard,'CART').gt.0) then - icheckgrad=1 - elseif (index(controlcard,'CARINT').gt.0) then - icheckgrad=2 - else - icheckgrad=3 - endif - elseif (index(controlcard,'THREAD').gt.0) then - modecalc=2 - call readi(controlcard,'THREAD',nthread,0) - if (nthread.gt.0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - else - if (fg_rank.eq.0) - & write (iout,'(a)')'A number has to follow the THREAD keyword.' - stop 'Error termination in Read_Control.' - endif - else if (index(controlcard,'MCMA').gt.0) then - modecalc=3 - else if (index(controlcard,'MCEE').gt.0) then - modecalc=6 - else if (index(controlcard,'MULTCONF').gt.0) then - modecalc=4 - else if (index(controlcard,'MAP').gt.0) then - modecalc=7 - call readi(controlcard,'MAP',nmap,0) - else if (index(controlcard,'CSA').gt.0) then - modecalc=8 -crc else if (index(controlcard,'ZSCORE').gt.0) then -crc -crc ZSCORE is rm from UNRES, modecalc=9 is available -crc -crc modecalc=9 -cfcm else if (index(controlcard,'MCMF').gt.0) then -cfmc modecalc=10 - else if (index(controlcard,'SOFTREG').gt.0) then - modecalc=11 - else if (index(controlcard,'CHECK_BOND').gt.0) then - modecalc=-1 - else if (index(controlcard,'TEST').gt.0) then - modecalc=-2 - else if (index(controlcard,'MD').gt.0) then - modecalc=12 - else if (index(controlcard,'RE ').gt.0) then - modecalc=14 - endif - - lmuca=index(controlcard,'MUCA').gt.0 - call readi(controlcard,'MUCADYN',mucadyn,0) - call readi(controlcard,'MUCASMOOTH',muca_smooth,0) - if (lmuca .and. (me.eq.king .or. .not.out1file )) - & then - write (iout,*) 'MUCADYN=',mucadyn - write (iout,*) 'MUCASMOOTH=',muca_smooth - endif - - iscode=index(controlcard,'ONE_LETTER') - indphi=index(controlcard,'PHI') - indback=index(controlcard,'BACK') - iranconf=index(controlcard,'RAND_CONF') - i2ndstr=index(controlcard,'USE_SEC_PRED') - gradout=index(controlcard,'GRADOUT').gt.0 - gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 - - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') diagmeth(kdiag), - & ' routine used to diagonalize matrices.' - return - end -c------------------------------------------------------------------------------ - subroutine molread -C -C Read molecular data. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer error_msg -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' -c include 'COMMON.DBASE' -c include 'COMMON.THREAD' - include 'COMMON.CONTACTS' - include 'COMMON.TORCNSTR' - include 'COMMON.TIME1' - include 'COMMON.BOUNDS' -c include 'COMMON.MD' -c include 'COMMON.REMD' - include 'COMMON.SETUP' - character*4 sequence(maxres) - integer rescode - double precision x(maxvar) - character*256 pdbfile - character*320 weightcard - character*80 weightcard_t,ucase - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - logical seq_comp,fail - double precision energia(0:n_ene) - integer ilen - external ilen -C -C Body -C -C Read weights of the subsequent energy terms. - - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) -C Juyong - call reada(weightcard,'WDFAD',wdfa_dist,0.0d0) - call reada(weightcard,'WDFAT',wdfa_tor,0.0d0) - call reada(weightcard,'WDFAN',wdfa_nei,0.0d0) - call reada(weightcard,'WDFAB',wdfa_beta,0.0d0) -C - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - weights(1)=wsc - weights(2)=wscp - weights(3)=welec - weights(4)=wcorr - weights(5)=wcorr5 - weights(6)=wcorr6 - weights(7)=wel_loc - weights(8)=wturn3 - weights(9)=wturn4 - weights(10)=wturn6 - weights(11)=wang - weights(12)=wscloc - weights(13)=wtor - weights(14)=wtor_d - weights(15)=wstrain - weights(16)=wvdwpp - weights(17)=wbond - weights(18)=scal14 - weights(21)=wsccor -C JUYONG - weights(24)=wdfa_dist - weights(25)=wdfa_tor - weights(26)=wdfa_nei - weights(27)=wdfa_beta -C - - if(me.eq.king.or..not.out1file) - & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta - - 10 format (/'Energy-term weights (unscaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)'/ - & 'WDFA_D= ',f10.6,' (DFA, distance)' / - & 'WDFA_T= ',f10.6,' (DFA, torsional)' / - & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' / - & 'WDFA_B= ',f10.6,' (DFA, beta formation)') - - if(me.eq.king.or..not.out1file)then - if (wcorr4.gt.0.0d0) then - write (iout,'(/2a/)') 'Local-electrostatic type correlation ', - & 'between contact pairs of peptide groups' - write (iout,'(2(a,f5.3/))') - & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr, - & 'Range of quenching the correlation terms:',2*delt_corr - else if (wcorr.gt.0.0d0) then - write (iout,'(/2a/)') 'Hydrogen-bonding correlation ', - & 'between contact pairs of peptide groups' - endif - write (iout,'(a,f8.3)') - & 'Scaling factor of 1,4 SC-p interactions:',scal14 - write (iout,'(a,f8.3)') - & 'General scaling factor of SC-p interactions:',scalscp - endif - r0_corr=cutoff_corr-delt_corr - do i=1,20 - aad(i,1)=scalscp*aad(i,1) - aad(i,2)=scalscp*aad(i,2) - bad(i,1)=scalscp*bad(i,1) - bad(i,2)=scalscp*bad(i,2) - enddo -c call rescale_weights(t_bath) - if(me.eq.king.or..not.out1file) - & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta - - 22 format (/'Energy-term weights (scaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)'/ - & 'WDFA_D= ',f10.6,' (DFA, distance)' / - & 'WDFA_T= ',f10.6,' (DFA, torsional)' / - & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' / - & 'WDFA_B= ',f10.6,' (DFA, beta formation)') - - if(me.eq.king.or..not.out1file) - & write (iout,*) "Reference temperature for weights calculation:", - & temp0 - call reada(weightcard,"D0CM",d0cm,3.78d0) - call reada(weightcard,"AKCM",akcm,15.1d0) - call reada(weightcard,"AKTH",akth,11.0d0) - call reada(weightcard,"AKCT",akct,12.0d0) - call reada(weightcard,"V1SS",v1ss,-1.08d0) - call reada(weightcard,"V2SS",v2ss,7.61d0) - call reada(weightcard,"V3SS",v3ss,13.7d0) - call reada(weightcard,"EBR",ebr,-5.50D0) - if(me.eq.king.or..not.out1file) then - write (iout,*) "Parameters of the SS-bond potential:" - write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, - & " AKCT",akct - write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr - print *,'indpdb=',indpdb,' pdbref=',pdbref - endif - if (indpdb.gt.0 .or. pdbref) then - read(inp,'(a)') pdbfile - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') 'PDB data will be read from file ', - & pdbfile(:ilen(pdbfile)) - open(ipdbin,file=pdbfile,status='old',err=33) - goto 34 - 33 write (iout,'(a)') 'Error opening PDB file.' - stop - 34 continue -c print *,'Begin reading pdb data' - call readpdb -c print *,'Finished reading pdb data' - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3,a,i3)')'nsup=',nsup, - & ' nstart_sup=',nstart_sup - do i=1,nres - itype_pdb(i)=itype(i) - enddo - close (ipdbin) - nnt=nstart_sup - nct=nstart_sup+nsup-1 - call contact(.false.,ncont_ref,icont_ref,co) - - if (sideadd) then -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "Before sideadd" - call intout - if(me.eq.king.or..not.out1file) - & write(iout,*)'Adding sidechains' - maxsi=1000 - do i=2,nres-1 - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) -c call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) write(iout,*)'Adding sidechain failed for res ', - & i,' after ',nsi,' trials' - endif - enddo - endif -C 10/03/12 Adam: Recalculate coordinates with new side chain positions - call chainbuild -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "After sideadd" - call intout - endif - - if (indpdb.eq.0) then -C Read sequence if not taken from the pdb file. - read (inp,*) nres -c print *,'nres=',nres - if (iscode.gt.0) then - read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres) - else - read (inp,'(20(1x,a3))') (sequence(i),i=1,nres) - endif -C Convert sequence to numeric code - do i=1,nres - itype(i)=rescode(i,sequence(i),iscode) - enddo -C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(iabs(itype(i))) - vbld_inv(i+nres)=dsc_inv(iabs(itype(i))) -c write (iout,*) "i",i," itype",itype(i), -c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo - endif -c print *,nres -c print '(20i4)',(itype(i),i=1,nres) - do i=1,nres -#ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then -#else - if (itype(i).eq.21) then -#endif - itel(i)=0 -#ifdef PROCOR - else if (iabs(itype(i+1)).ne.20) then -#else - else if (iabs(itype(i)).ne.20) then -#endif - itel(i)=1 - else - itel(i)=2 - endif - enddo - if(me.eq.king.or..not.out1file)then - write (iout,*) "ITEL" - do i=1,nres-1 - write (iout,*) i,itype(i),itel(i) - enddo - print *,'Call Read_Bridge.' - endif - call read_bridge -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - read (inp,*) ndih_constr - if (ndih_constr.gt.0) then - read (inp,*) ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) - if(me.eq.king.or..not.out1file)then - write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' - do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) - enddo - endif - do i=1,ndih_constr - phi0(i)=deg2rad*phi0(i) - drange(i)=deg2rad*drange(i) - enddo - if(me.eq.king.or..not.out1file) - & write (iout,*) 'FTORS',ftors - do i=1,ndih_constr - ii = idih_constr(i) - phibound(1,ii) = phi0(i)-drange(i) - phibound(2,ii) = phi0(i)+drange(i) - enddo - endif - nnt=1 -#ifdef MPI - if (me.eq.king) then -#endif - write (iout,'(a)') 'Boundaries in phi angle sampling:' - do i=1,nres - write (iout,'(a3,i5,2f10.1)') - & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg - enddo -#ifdef MP - endif -#endif - nct=nres -cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - -C Juyong:READ init_vars -C Initialize variables! -C Juyong:READ read_info -C READ fragment information!! -C both routines should be in dfa.F file!! - - if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. - & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then - call init_dfa_vars - print*, 'init_dfa_vars finished!' - call read_dfa_info - print*, 'read_dfa_info finished!' - endif -C -C - - - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3)') 'nsup=',nsup - nstart_seq=nnt - if (nsup.le.(nct-nnt+1)) then - do i=0,nct-nnt+1-nsup - if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then - nstart_seq=nnt+i - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - stop - else - do i=0,nsup-(nct-nnt+1) - if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1)) - & then - nstart_sup=nstart_sup+i - nsup=nct-nnt+1 - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - endif - 111 continue - if (nsup.eq.0) nsup=nct-nnt - if (nstart_sup.eq.0) nstart_sup=nnt - if (nstart_seq.eq.0) nstart_seq=nnt - if(me.eq.king.or..not.out1file) - & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, - & ' nstart_seq=',nstart_seq - endif -c--- Zscore rms ------- - if (nz_start.eq.0) nz_start=nnt - if (nz_end.eq.0 .and. nsup.gt.0) then - nz_end=nnt+nsup-1 - else if (nz_end.eq.0) then - nz_end=nct - endif - if(me.eq.king.or..not.out1file)then - write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end - write (iout,*) 'IZ_SC=',iz_sc - endif -c---------------------- - call init_int_table - if (refstr) then - if (.not.pdbref) then - call read_angles(inp,*38) - goto 39 - 38 write (iout,'(a)') 'Error reading reference structure.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) - stop 'Error reading reference structure' -#endif - 39 call chainbuild - call setup_var -czscore call geom_to_var(nvar,coord_exp_zs(1,1)) - nstart_sup=nnt - nstart_seq=nnt - nsup=nct-nnt+1 - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - call contact(.true.,ncont_ref,icont_ref,co) - endif -c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup - call flush(iout) - if (constr_dist.gt.0) call read_dist_constr -c write (iout,*) "After read_dist_constr nhpb",nhpb - call hpb_partition - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Contact order:',co - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup - do i=1,ncont_ref - do j=1,2 - icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup - enddo - if(me.eq.king.or..not.out1file) - & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ', - & icont_ref(1,i),' ', - & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i) - enddo - endif - endif - if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 - & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. - & modecalc.ne.10) then -C If input structure hasn't been supplied from the PDB file read or generate -C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then - if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) - & write (iout,'(a)') 'Initial geometry will be read in.' - if (read_cart) then - read(inp,'(8f10.5)',end=36,err=36) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - return - else - call read_angles(inp,*36) - endif - goto 37 - 36 write (iout,'(a)') 'Error reading angle file.' -#ifdef MPI - call mpi_finalize( MPI_COMM_WORLD,IERR ) -#endif - stop 'Error reading angle file.' - 37 continue - else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - if (itype(i).le.0) omeg(i)=-omeg(i) - enddo - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a)') 'Random-generated initial geometry.' - - -#ifdef MPI - if (me.eq.king .or. fg_rank.eq.0 .and. ( - & modecalc.eq.12 .or. modecalc.eq.14) ) then -#endif - do itrial=1,100 - itmp=1 -c call gen_rand_conf(itmp,*30) - goto 40 - 30 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Processor:',me, - & ' Failed to generate random conformation', - & ' itrial=',itrial - call intout - -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - call flush(iout) -#ifdef MPI - call MPI_Abort(mpi_comm_world,error_msg,ierrcode) - 40 continue - endif -#else - do itrial=1,100 - itmp=1 -c call gen_rand_conf(itmp,*31) - goto 40 - 31 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Failed to generate random conformation', - & ', itrial=',itrial - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - stop - 40 continue -#endif - endif - elseif (modecalc.eq.4) then - read (inp,'(a)') intinname - open (intin,file=intinname,status='old',err=333) - if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0) - & write (iout,'(a)') 'intinname',intinname - write (*,'(a)') 'Processor',myrank,' intinname',intinname - goto 334 - 333 write (iout,'(2a)') 'Error opening angle file ',intinname -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERR) -#endif - stop 'Error opening angle file.' - 334 continue - - endif -C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif - call setup_var - if (me.eq.king .or. .not. out1file) - & call intout - if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then - write (iout,'(/a,i3,a)') - & 'The chain contains',ns,' disulfide-bridging cysteines.' - write (iout,'(20i4)') (iss(i),i=1,ns) - write (iout,'(/a/)') 'Pre-formed links are:' - do i=1,nss - i1=ihpb(i)-nres - i2=jhpb(i)-nres - it1=itype(i1) - it2=itype(i2) - if (me.eq.king.or..not.out1file) - & write (iout,'(2a,i3,3a,i3,a,3f10.3)') - & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), - & ebr,forcon(i) - enddo - write (iout,'(a)') - endif -c if (i2ndstr.gt.0) call secstrp2dihc -c call geom_to_var(nvar,x) -c call etotal(energia(0)) -c call enerprint(energia(0)) -c call briefout(0,etot) -c stop -cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT -cd write (iout,'(a)') 'Variable list:' -cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar) -#ifdef MPI - if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file)) - & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') - & 'Processor',myrank,': end reading molecular data.' -#endif - return - end -c-------------------------------------------------------------------------- - logical function seq_comp(itypea,itypeb,length) - implicit none - integer length,itypea(length),itypeb(length) - integer i - do i=1,length - if (itypea(i).ne.itypeb(i)) then - seq_comp=.false. - return - endif - enddo - seq_comp=.true. - return - end -c----------------------------------------------------------------------------- - subroutine read_bridge -C Read information about disulfide bridges. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' -c include 'COMMON.DBASE' -c include 'COMMON.THREAD' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -C Read bridging residues. - read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns - if(me.eq.king.or..not.out1file) - & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) -C Check whether the specified bridging residues are cystines. - do i=1,ns - if (itype(iss(i)).ne.1) then - if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, - & ' can form a disulfide bridge?!!!' - write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, - & ' can form a disulfide bridge?!!!' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo -C Read preformed bridges. - if (ns.gt.0) then - read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) - if (nss.gt.0) then - nhpb=nss -C Check if the residues involved in bridges are in the specified list of -C bridging residues. - do i=1,nss - do j=1,i-1 - if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j) - & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then - write (iout,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' - write (*,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo - do j=1,ns - if (ihpb(i).eq.iss(j)) goto 10 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 10 continue - do j=1,ns - if (jhpb(i).eq.iss(j)) goto 20 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 20 continue - dhpb(i)=dbr - forcon(i)=fbr - enddo - do i=1,nss - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - enddo - endif - endif - return - end -c---------------------------------------------------------------------------- - subroutine read_x(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' -c Read coordinates from input -c - read(kanal,'(8f10.5)',end=10,err=10) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - - return - 10 return1 - end -c------------------------------------------------------------------------------ - subroutine setup_var - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' -c include 'COMMON.DBASE' -c include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Set up variable list. - ntheta=nres-2 - nphi=nres-3 - nvar=ntheta+nphi - nside=0 - do i=2,nres-1 - if (itype(i).ne.10) then - nside=nside+1 - ialph(i,1)=nvar+nside - ialph(nside,2)=i - endif - enddo - if (indphi.gt.0) then - nvar=nphi - else if (indback.gt.0) then - nvar=nphi+ntheta - else - nvar=nvar+2*nside - endif -cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1) - return - end -c---------------------------------------------------------------------------- - subroutine gen_dist_constr -C Generate CA distance constraints. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' -c include 'COMMON.DBASE' -c include 'COMMON.THREAD' - include 'COMMON.TIME1' - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - character*2 iden -cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct -cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct, -cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq, -cd & ' nsup',nsup - do i=nstart_sup,nstart_sup+nsup-1 -cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), -cd & ' seq_pdb', restyp(itype_pdb(i)) - do j=i+2,nstart_sup+nsup-1 - nhpb=nhpb+1 - ihpb(nhpb)=i+nstart_seq-nstart_sup - jhpb(nhpb)=j+nstart_seq-nstart_sup - forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) - enddo - enddo -cd write (iout,'(a)') 'Distance constraints:' -cd do i=nss+1,nhpb -cd ii=ihpb(i) -cd jj=jhpb(i) -cd iden='CA' -cd if (ii.gt.nres) then -cd iden='SC' -cd ii=ii-nres -cd jj=jj-nres -cd endif -cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)') -cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, -cd & dhpb(i),forcon(i) -cd enddo - return - end -c---------------------------------------------------------------------------- - subroutine csaread - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.CONTROL' - character*80 ucase - character*620 mcmcard - call card_concat(mcmcard) - - call readi(mcmcard,'NCONF',nconf,50) - call readi(mcmcard,'NADD',nadd,0) - call readi(mcmcard,'JSTART',jstart,1) - call readi(mcmcard,'JEND',jend,1) - call readi(mcmcard,'NSTMAX',nstmax,500000) - call readi(mcmcard,'N0',n0,1) - call readi(mcmcard,'N1',n1,6) - call readi(mcmcard,'N2',n2,4) - call readi(mcmcard,'N3',n3,0) - call readi(mcmcard,'N4',n4,0) - call readi(mcmcard,'N5',n5,0) - call readi(mcmcard,'N6',n6,10) - call readi(mcmcard,'N7',n7,0) - call readi(mcmcard,'N8',n8,0) - call readi(mcmcard,'N9',n9,0) - call readi(mcmcard,'N14',n14,0) - call readi(mcmcard,'N15',n15,0) - call readi(mcmcard,'N16',n16,0) - call readi(mcmcard,'N17',n17,0) - call readi(mcmcard,'N18',n18,0) - - vdisulf=(index(mcmcard,'DYNSS').gt.0) - - call readi(mcmcard,'NDIFF',ndiff,2) - call reada(mcmcard,'DIFFCUT',diffcut,0.0d0) - call readi(mcmcard,'IS1',is1,1) - call readi(mcmcard,'IS2',is2,8) - call readi(mcmcard,'NRAN0',nran0,4) - call readi(mcmcard,'NRAN1',nran1,2) - call readi(mcmcard,'IRR',irr,1) - call readi(mcmcard,'NSEED',nseed,20) - call readi(mcmcard,'NTOTAL',ntotal,10000) - call reada(mcmcard,'CUT1',cut1,2.0d0) - call reada(mcmcard,'CUT2',cut2,5.0d0) - call reada(mcmcard,'ESTOP',estop,-300000.0d0) - call readi(mcmcard,'ICMAX',icmax,1) - call readi(mcmcard,'NBANKM',nbankm,400) - call readi(mcmcard,'IUCUT',iucut,2) - call readi(mcmcard,'IRESTART',irestart,0) -c!bankt call readi(mcmcard,'NBANKTM',ntbankm,0) - ntbankm=0 -c!bankt - call reada(mcmcard,'DELE',dele,20.0d0) - call reada(mcmcard,'DIFCUT',difcut,720.0d0) - call readi(mcmcard,'IREF',iref,0) - call reada(mcmcard,'RMSCUT',rmscut,4.0d0) - call reada(mcmcard,'PNCCUT',pnccut,0.5d0) - call readi(mcmcard,'NCONF_IN',nconf_in,0) - call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0) - write (iout,*) "NCONF_IN",nconf_in - tm_score=(index(mcmcard,'TMSCORE').gt.0) - if (tm_score) write (iout,*) "Using TM_Score instead of DIFF", - & " for torsional angles" - return - end - - subroutine read_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MINIM' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 minimcard - call card_concat(minimcard) - call readi(minimcard,'MAXMIN',maxmin,2000) - call readi(minimcard,'MAXFUN',maxfun,5000) - call readi(minimcard,'MINMIN',minmin,maxmin) - call readi(minimcard,'MINFUN',minfun,maxmin) - call reada(minimcard,'TOLF',tolf,1.0D-2) - call reada(minimcard,'RTOLF',rtolf,1.0D-4) - print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1) - print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1) - print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1) - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Options in energy minimization:' - write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') - & 'MaxMin:',MaxMin,' MaxFun:',MaxFun, - & 'MinMin:',MinMin,' MinFun:',MinFun, - & ' TolF:',TolF,' RTolF:',RTolF - return - end -c---------------------------------------------------------------------------- - subroutine read_angles(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' -c Read angles from input -c - read (kanal,*,err=10,end=10) (theta(i),i=3,nres) - read (kanal,*,err=10,end=10) (phi(i),i=4,nres) - read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1) - read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1) - - do i=1,nres -c 9/7/01 avoid 180 deg valence angle - if (theta(i).gt.179.99d0) theta(i)=179.99d0 -c - theta(i)=deg2rad*theta(i) - phi(i)=deg2rad*phi(i) - alph(i)=deg2rad*alph(i) - omeg(i)=deg2rad*omeg(i) - enddo - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine openunits - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - character*16 form,nodename - integer nodelen -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' -c include 'COMMON.MD' - include 'COMMON.CONTROL' - integer lenpre,lenpot,ilen,lentmp - external ilen - character*3 out1file_text,ucase - character*3 ll - external ucase -c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits" - call getenv_loc("PREFIX",prefix) - pref_orig = prefix - call getenv_loc("POT",pot) - call getenv_loc("DIRTMP",tmpdir) - call getenv_loc("CURDIR",curdir) - call getenv_loc("OUT1FILE",out1file_text) -c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV" - out1file_text=ucase(out1file_text) - if (out1file_text(1:1).eq."Y") then - out1file=.true. - else - out1file=fg_rank.gt.0 - endif - lenpre=ilen(prefix) - lenpot=ilen(pot) - lentmp=ilen(tmpdir) - if (lentmp.gt.0) then - write (*,'(80(1h!))') - write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!" - write (*,'(80(1h!))') - write (*,*)"All output files will be on node /tmp directory." -#ifdef MPI - call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR ) - if (me.eq.king) then - write (*,*) "The master node is ",nodename - else if (fg_rank.eq.0) then - write (*,*) "I am the CG slave node ",nodename - else - write (*,*) "I am the FG slave node ",nodename - endif -#endif - PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre) - lenpre = lentmp+lenpre+1 - endif - entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' -C Get the names and open the input files -#if defined(WINIFL) || defined(WINPGI) - open(1,file=pref_orig(:ilen(pref_orig))// - & '.inp',status='old',readonly,shared) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly,shared) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly,shared) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly,shared) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly,shared) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly,shared) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly,shared) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly,shared) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & action='read') -c print *,"Processor",myrank," opened file 1" - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -c print *,"Processor",myrank," opened file 9" -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') -c print *,"Processor",myrank," opened file IBOND" - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -c print *,"Processor",myrank," opened file ITHEP" -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',action='read') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -c print *,"Processor",myrank," opened file IROTAM" -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORP" - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORDP" - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') -c print *,"Processor",myrank," opened file ISCCOR" - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') -c print *,"Processor",myrank," opened file IFOURIER" - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') -c print *,"Processor",myrank," opened file IELEP" - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -c print *,"Processor",myrank," opened file ISIDEP" -c print *,"Processor",myrank," opened parameter files" -#elif (defined G77) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') -#else - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & readonly) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - print *,"thetname_pdb ",thetname_pdb - open (ithep_pdb,file=thetname_pdb,status='old',readonly) - print *,ithep_pdb," opened" -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly) - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',readonly) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly) -#endif -#ifndef OLDSCP -C -C 8/9/01 In the newest version SCp interaction constants are read from a file -C Use -DOLDSCP to use hard-coded constants instead. -C - call getenv_loc('SCPPAR',scpname) -#if defined(WINIFL) || defined(WINPGI) - open (iscpp,file=scpname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (iscpp,file=scpname,status='old',action='read') -#elif (defined G77) - open (iscpp,file=scpname,status='old') -#else - open (iscpp,file=scpname,status='old',readonly) -#endif -#endif - call getenv_loc('PATTERN',patname) -#if defined(WINIFL) || defined(WINPGI) - open (icbase,file=patname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (icbase,file=patname,status='old',action='read') -#elif (defined G77) - open (icbase,file=patname,status='old') -#else - open (icbase,file=patname,status='old',readonly) -#endif -#ifdef MPI -C Open output file only for CG processes -c print *,"Processor",myrank," fg_rank",fg_rank - if (fg_rank.eq.0) then - - if (nodes.eq.1) then - npos=3 - else - npos = dlog10(dfloat(nodes-1))+1 - endif - if (npos.lt.3) npos=3 - write (liczba,'(i1)') npos - form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) - & //')' - write (liczba,form) me - outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// - & liczba(:ilen(liczba)) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //liczba(:ilen(liczba))//'.stat') - rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) - & //'.rst' -c if(usampl) then -c qname=prefix(:lenpre)//'_'//pot(:lenpot)// -c & liczba(:ilen(liczba))//'.const' -c endif - - endif -#else - outname=prefix(:lenpre)//'.out_'//pot(:lenpot) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot)// - & '.stat') - rest2name=prefix(:ilen(prefix))//'.rst' -c if(usampl) then -c qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const' -c endif -#endif -#if defined(AIX) || defined(PGI) - if (me.eq.king .or. .not. out1file) - & open(iout,file=outname,status='unknown') -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif - if(me.eq.king) then - open(igeom,file=intname,status='unknown',position='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',position='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#else - if (me.eq.king .or. .not.out1file) - & open(iout,file=outname,status='unknown') -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif - if(me.eq.king) then - open(igeom,file=intname,status='unknown',access='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',access='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#endif - csa_rbank=prefix(:lenpre)//'.CSA.rbank' - csa_seed=prefix(:lenpre)//'.CSA.seed' - csa_history=prefix(:lenpre)//'.CSA.history' - csa_bank=prefix(:lenpre)//'.CSA.bank' - csa_bank1=prefix(:lenpre)//'.CSA.bank1' - csa_alpha=prefix(:lenpre)//'.CSA.alpha' - csa_alpha1=prefix(:lenpre)//'.CSA.alpha1' -c!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt' - csa_int=prefix(:lenpre)//'.int' - csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized' - csa_native_int=prefix(:lenpre)//'.CSA.native.int' - csa_in=prefix(:lenpre)//'.CSA.in' -c print *,"Processor",myrank,"fg_rank",fg_rank," opened files" -C Write file names - if (me.eq.king)then - write (iout,'(80(1h-))') - write (iout,'(30x,a)') "FILE ASSIGNMENT" - write (iout,'(80(1h-))') - write (iout,*) "Input file : ", - & pref_orig(:ilen(pref_orig))//'.inp' - write (iout,*) "Output file : ", - & outname(:ilen(outname)) - write (iout,*) - write (iout,*) "Sidechain potential file : ", - & sidename(:ilen(sidename)) -#ifndef OLDSCP - write (iout,*) "SCp potential file : ", - & scpname(:ilen(scpname)) -#endif - write (iout,*) "Electrostatic potential file : ", - & elename(:ilen(elename)) - write (iout,*) "Cumulant coefficient file : ", - & fouriername(:ilen(fouriername)) - write (iout,*) "Torsional parameter file : ", - & torname(:ilen(torname)) - write (iout,*) "Double torsional parameter file : ", - & tordname(:ilen(tordname)) - write (iout,*) "SCCOR parameter file : ", - & sccorname(:ilen(sccorname)) - write (iout,*) "Bond & inertia constant file : ", - & bondname(:ilen(bondname)) - write (iout,*) "Bending parameter file : ", - & thetname(:ilen(thetname)) - write (iout,*) "Rotamer parameter file : ", - & rotname(:ilen(rotname)) - write (iout,*) "Threading database : ", - & patname(:ilen(patname)) - if (lentmp.ne.0) - &write (iout,*)" DIRTMP : ", - & tmpdir(:lentmp) - write (iout,'(80(1h-))') - endif - return - end -c---------------------------------------------------------------------------- - subroutine card_concat(card) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*(*) card - character*80 karta,ucase - external ilen - read (inp,'(a)') karta - karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end - - subroutine read_dist_constr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - integer ifrag_(2,100),ipair_(2,100) - double precision wfrag_(100),wpair_(100) - character*500 controlcard - write (iout,*) "Calling read_dist_constr" - write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup - call flush(iout) - call card_concat(controlcard) - call readi(controlcard,"NFRAG",nfrag_,0) - call readi(controlcard,"NPAIR",npair_,0) - call readi(controlcard,"NDIST",ndist_,0) - call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) - call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) - call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) - call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) - call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) -c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ -c write (iout,*) "IFRAG" -c do i=1,nfrag_ -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) -c enddo -c write (iout,*) "IPAIR" -c do i=1,npair_ -c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) -c enddo - call flush(iout) - do i=1,nfrag_ - if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup - if (ifrag_(2,i).gt.nstart_sup+nsup-1) - & ifrag_(2,i)=nstart_sup+nsup-1 -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) - call flush(iout) - if (wfrag_(i).gt.0.0d0) then - do j=ifrag_(1,i),ifrag_(2,i)-1 - do k=j+1,ifrag_(2,i) - write (iout,*) "j",j," k",k - ddjk=dist(j,k) - if (constr_dist.eq.1) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - else if (constr_dist.eq.2) then - if (ddjk.le.dist_cut) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - endif - else - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) - endif -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,npair_ - if (wpair_(i).gt.0.0d0) then - ii = ipair_(1,i) - jj = ipair_(2,i) - if (ii.gt.jj) then - itemp=ii - ii=jj - jj=itemp - endif - do j=ifrag_(1,ii),ifrag_(2,ii) - do k=ifrag_(1,jj),ifrag_(2,jj) - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - forcon(nhpb)=wpair_(i) - dhpb(nhpb)=dist(j,k) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,ndist_ - read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1) - if (forcon(nhpb+1).gt.0.0d0) then - nhpb=nhpb+1 - dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - endif - enddo - call flush(iout) - return - end -c------------------------------------------------------------------------------- -#ifdef WINIFL - subroutine flush(iu) - return - end -#endif -#ifdef AIX - subroutine flush(iu) - call flush_(iu) - return - end -#endif -c------------------------------------------------------------------------------ - subroutine copy_to_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - character* 256 tmpfile - integer ilen - external ilen - logical ex - tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source)) - inquire(file=tmpfile,exist=ex) - if (ex) then - write (*,*) "Copying ",tmpfile(:ilen(tmpfile)), - & " to temporary directory..." - write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir - call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir) - endif - return - end -c------------------------------------------------------------------------------ - subroutine move_from_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - integer ilen - external ilen - write (*,*) "Moving ",source(:ilen(source)), - & " from temporary directory to working directory" - write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir - call system("/bin/mv "//source(:ilen(source))//" "//curdir) - return - end -c------------------------------------------------------------------------------ - subroutine random_init(seed) -C -C Initialize random number generator -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef AMD64 - integer*8 iseedi8 -#endif -#ifdef MPI - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 - integer iseed_array(4) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -c include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' -c include 'COMMON.MAP' - include 'COMMON.HEADER' -c include 'COMMON.CSA' - include 'COMMON.CHAIN' -c include 'COMMON.MUCA' -c include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - iseed=-dint(dabs(seed)) - if (iseed.eq.0) then - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' - write (*,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' -#ifdef MPI - call mpi_finalize(mpi_comm_world,ierr) -#endif - stop 'Bad random seed.' - endif -#ifdef MPI - if (fg_rank.eq.0) then - seed=seed*(me+1)+1 -#ifdef AMD64 - iseedi8=dint(seed) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - OKRandom = prng_restart(me,iseedi8) -#else - do i=1,4 - tmp=65536.0d0**(4-i) - iseed_array(i) = dint(seed/tmp) - seed=seed-iseed_array(i)*tmp - enddo - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - write (*,*) 'MPI: node= ',me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - OKRandom = prng_restart(me,iseed_array) -#endif - if (OKRandom) then - r1=ran_number(0.0D0,1.0D0) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'ran_num',r1 - if (r1.lt.0.0d0) OKRandom=.false. - endif - if (.not.OKRandom) then - write (iout,*) 'PRNG IS NOT WORKING!!!' - print *,'PRNG IS NOT WORKING!!!' - if (me.eq.0) then - call flush(iout) - call mpi_abort(mpi_comm_world,error_msg,ierr) - stop - else - write (iout,*) 'too many processors for parallel prng' - write (*,*) 'too many processors for parallel prng' - call flush(iout) - stop - endif - endif - endif -#else - call vrndst(iseed) - write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0) -#endif - return - end diff --git a/source/unres/src_CSA_DiL/refsys.f b/source/unres/src_CSA_DiL/refsys.f deleted file mode 100644 index 8efc1ea..0000000 --- a/source/unres/src_CSA_DiL/refsys.f +++ /dev/null @@ -1,59 +0,0 @@ - subroutine refsys(i2,i3,i4,e1,e2,e3,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c this subroutine calculates unity vectors of a local reference system -c defined by atoms (i2), (i3), and (i4). the x axis is the axis from -c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms -c (i2), (i3), and (i4). z axis is directed according to the sign of the -c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms -c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4) -c form a linear fragment. returns vectors e1, e2, and e3. - logical fail - double precision e1(3),e2(3),e3(3) - double precision u(3),z(3) - include "COMMON.CHAIN" - data coinc /1.0d-13/,align /1.0d-13/ - fail=.false. - s1=0.0d0 - s2=0.0d0 - do 1 i=1,3 - zi=c(i,i2)-c(i,i3) - ui=c(i,i4)-c(i,i3) - s1=s1+zi*zi - s2=s2+ui*ui - z(i)=zi - 1 u(i)=ui - s1=sqrt(s1) - s2=sqrt(s2) - if (s1.gt.coinc) goto 2 - write (iout,1000) i2,i3,i1 - fail=.true. - return - 2 if (s2.gt.coinc) goto 4 - write(iout,1000) i3,i4,i1 - fail=.true. - return - 4 s1=1.0/s1 - s2=1.0/s2 - v1=z(2)*u(3)-z(3)*u(2) - v2=z(3)*u(1)-z(1)*u(3) - v3=z(1)*u(2)-z(2)*u(1) - anorm=sqrt(v1*v1+v2*v2+v3*v3) - if (anorm.gt.align) goto 6 - write (iout,1010) i2,i3,i4,i1 - fail=.true. - return - 6 anorm=1.0/anorm - e3(1)=v1*anorm - e3(2)=v2*anorm - e3(3)=v3*anorm - e1(1)=z(1)*s1 - e1(2)=z(2)*s1 - e1(3)=z(3)*s1 - e2(1)=e1(3)*e3(2)-e1(2)*e3(3) - e2(2)=e1(1)*e3(3)-e1(3)*e3(1) - e2(3)=e1(2)*e3(1)-e1(1)*e3(2) - 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.') - 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear') - return - end diff --git a/source/unres/src_CSA_DiL/rescode.f b/source/unres/src_CSA_DiL/rescode.f deleted file mode 100644 index 12abbbe..0000000 --- a/source/unres/src_CSA_DiL/rescode.f +++ /dev/null @@ -1,33 +0,0 @@ - integer function rescode(iseq,nam,itype) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - character*3 nam,ucase - - if (itype.eq.0) then - - do i=-ntyp1,ntyp1 -cc write(iout,*),i,ucase(nam),restyp(i) - if (ucase(nam).eq.restyp(i)) then - rescode=i - return - endif - enddo - - else - - do i=-ntyp1,ntyp1 - if (nam(1:1).eq.onelet(i)) then - rescode=i - return - endif - enddo - - endif - - write (iout,10) iseq,nam - stop - 10 format ('**** Error - residue',i4,' has an unresolved name ',a3) - end - diff --git a/source/unres/src_CSA_DiL/rmdd.f b/source/unres/src_CSA_DiL/rmdd.f deleted file mode 100644 index 799ab47..0000000 --- a/source/unres/src_CSA_DiL/rmdd.f +++ /dev/null @@ -1,159 +0,0 @@ -c algorithm 611, collected algorithms from acm. -c algorithm appeared in acm-trans. math. software, vol.9, no. 4, -c dec., 1983, p. 503-524. - integer function imdcon(k) -c - integer k -c -c *** return integer machine-dependent constants *** -c -c *** k = 1 means return standard output unit number. *** -c *** k = 2 means return alternate output unit number. *** -c *** k = 3 means return input unit number. *** -c (note -- k = 2, 3 are used only by test programs.) -c -c +++ port version follows... -c external i1mach -c integer i1mach -c integer mdperm(3) -c data mdperm(1)/2/, mdperm(2)/4/, mdperm(3)/1/ -c imdcon = i1mach(mdperm(k)) -c +++ end of port version +++ -c -c +++ non-port version follows... - integer mdcon(3) - data mdcon(1)/6/, mdcon(2)/8/, mdcon(3)/5/ - imdcon = mdcon(k) -c +++ end of non-port version +++ -c - 999 return -c *** last card of imdcon follows *** - end - double precision function rmdcon(k) -c -c *** return machine dependent constants used by nl2sol *** -c -c +++ comments below contain data statements for various machines. +++ -c +++ to convert to another machine, place a c in column 1 of the +++ -c +++ data statement line(s) that correspond to the current machine +++ -c +++ and remove the c from column 1 of the data statement line(s) +++ -c +++ that correspond to the new machine. +++ -c - integer k -c -c *** the constant returned depends on k... -c -c *** k = 1... smallest pos. eta such that -eta exists. -c *** k = 2... square root of eta. -c *** k = 3... unit roundoff = smallest pos. no. machep such -c *** that 1 + machep .gt. 1 .and. 1 - machep .lt. 1. -c *** k = 4... square root of machep. -c *** k = 5... square root of big (see k = 6). -c *** k = 6... largest machine no. big such that -big exists. -c - double precision big, eta, machep - integer bigi(4), etai(4), machei(4) -c/+ - double precision dsqrt -c/ - equivalence (big,bigi(1)), (eta,etai(1)), (machep,machei(1)) -c -c +++ ibm 360, ibm 370, or xerox +++ -c -c data big/z7fffffffffffffff/, eta/z0010000000000000/, -c 1 machep/z3410000000000000/ -c -c +++ data general +++ -c -c data big/0.7237005577d+76/, eta/0.5397605347d-78/, -c 1 machep/2.22044605d-16/ -c -c +++ dec 11 +++ -c -c data big/1.7d+38/, eta/2.938735878d-39/, machep/2.775557562d-17/ -c -c +++ hp3000 +++ -c -c data big/1.157920892d+77/, eta/8.636168556d-78/, -c 1 machep/5.551115124d-17/ -c -c +++ honeywell +++ -c -c data big/1.69d+38/, eta/5.9d-39/, machep/2.1680435d-19/ -c -c +++ dec10 +++ -c -c data big/"377777100000000000000000/, -c 1 eta/"002400400000000000000000/, -c 2 machep/"104400000000000000000000/ -c -c +++ burroughs +++ -c -c data big/o0777777777777777,o7777777777777777/, -c 1 eta/o1771000000000000,o7770000000000000/, -c 2 machep/o1451000000000000,o0000000000000000/ -c -c +++ control data +++ -c -c data big/37767777777777777777b,37167777777777777777b/, -c 1 eta/00014000000000000000b,00000000000000000000b/, -c 2 machep/15614000000000000000b,15010000000000000000b/ -c -c +++ prime +++ -c -c data big/1.0d+9786/, eta/1.0d-9860/, machep/1.4210855d-14/ -c -c +++ univac +++ -c -c data big/8.988d+307/, eta/1.2d-308/, machep/1.734723476d-18/ -c -c +++ vax +++ -c - data big/1.7d+38/, eta/2.939d-39/, machep/1.3877788d-17/ -c -c +++ cray 1 +++ -c -c data bigi(1)/577767777777777777777b/, -c 1 bigi(2)/000007777777777777776b/, -c 2 etai(1)/200004000000000000000b/, -c 3 etai(2)/000000000000000000000b/, -c 4 machei(1)/377224000000000000000b/, -c 5 machei(2)/000000000000000000000b/ -c -c +++ port library -- requires more than just a data statement... +++ -c -c external d1mach -c double precision d1mach, zero -c data big/0.d+0/, eta/0.d+0/, machep/0.d+0/, zero/0.d+0/ -c if (big .gt. zero) go to 1 -c big = d1mach(2) -c eta = d1mach(1) -c machep = d1mach(4) -c1 continue -c -c +++ end of port +++ -c -c------------------------------- body -------------------------------- -c - go to (10, 20, 30, 40, 50, 60), k -c - 10 rmdcon = eta - go to 999 -c - 20 rmdcon = dsqrt(256.d+0*eta)/16.d+0 - go to 999 -c - 30 rmdcon = machep - go to 999 -c - 40 rmdcon = dsqrt(machep) - go to 999 -c - 50 rmdcon = dsqrt(big/256.d+0)*16.d+0 - go to 999 -c - 60 rmdcon = big -c - 999 return -c *** last card of rmdcon follows *** - end diff --git a/source/unres/src_CSA_DiL/rmsd.F b/source/unres/src_CSA_DiL/rmsd.F deleted file mode 100644 index 8e07b0c..0000000 --- a/source/unres/src_CSA_DiL/rmsd.F +++ /dev/null @@ -1,184 +0,0 @@ - subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - include 'COMMON.IOUNITS' - double precision przes(3),obr(3,3) - logical non_conv,lprn -c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, -c & obr,non_conv) -c rms=dsqrt(rms) - call rmsd(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref) - if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100, - & ' % of nonnative contacts:',frac_nn*100, - & ' contact order:',co - - return - end -c--------------------------------------------------------------------------- - subroutine rmsd(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 -c print *,"nz_start",nz_start," nz_end",nz_end - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,nres+i) - enddo - endif - enddo - -c ----- diagnostics -c write (iout,*) 'Ccopy and CREFcopy' -c print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c ----- end diagnostics - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd' - write (iout,*) 'Problems in FITSQ!!! rmsd' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI -c call mpi_abort(mpi_comm_world,ierror,ierrcode) - roznica=100.0 -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) -c ---- diagnostics -c write (iout,*) "rms",drms -c ---- end diagnostics - return - end - -c-------------------------------------------- - subroutine rmsd_csa(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i) - crefcopy(k,iatom)=crefjlee(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i) - crefcopy(k,iatom)=crefjlee(k,nres+i) - enddo - endif - enddo - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd_csa' - write (iout,*) 'Problems in FITSQ!!! rmsd_csa' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI - call mpi_abort(mpi_comm_world,ierror,ierrcode) -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) - return - end - -c--------------------------------------------------------------------------- - subroutine calc_tmscore(tmscore_dp,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - real x1(maxres),y1(maxres),z1(maxres) - integer n_1(maxres),L1 - real x2(maxres),y2(maxres),z2(maxres) - integer n_2(maxres),L2 - real TM,Rcomm - integer Lcomm - logical lprn - - L1=0 -c print *,"nz_start",nz_start," nz_end",nz_end - do i=nz_start,nz_end - L1=L1+1 - n_1(L1)=L1 - x1(L1)=c(1,i+nstart_seq-nstart_sup) - y1(L1)=c(2,i+nstart_seq-nstart_sup) - z1(L1)=c(3,i+nstart_seq-nstart_sup) - - n_2(L1)=L1 - x2(L1)=cref(1,i) - y2(L1)=cref(2,i) - z2(L1)=cref(3,i) - enddo - L2=L1 - - call TMscore(L1,x1,y1,z1,n_1,L2,x2,y2,z2,n_2,TM,Rcomm,Lcomm) - - tmscore_dp=TM - if (lprn) then - write (iout,'(a40,f8.2)') - & 'TM-score with the reference structure: ',TM - endif - return - end - diff --git a/source/unres/src_CSA_DiL/sc_move.F b/source/unres/src_CSA_DiL/sc_move.F deleted file mode 100644 index 74e9bf2..0000000 --- a/source/unres/src_CSA_DiL/sc_move.F +++ /dev/null @@ -1,823 +0,0 @@ - subroutine sc_move(n_start,n_end,n_maxtry,e_drop, - + n_fun,etot) -c Perform a quick search over side-chain arrangments (over -c residues n_start to n_end) for a given (frozen) CA trace -c Only side-chains are minimized (at most n_maxtry times each), -c not CA positions -c Stops if energy drops by e_drop, otherwise tries all residues -c in the given range -c If there is an energy drop, full minimization may be useful -c n_start, n_end CAN be modified by this routine, but only if -c out of bounds (n_start <= 1, n_end >= nres, n_start < n_end) -c NOTE: this move should never increase the energy -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c External functions - integer iran_num - external iran_num - -c Input arguments - integer n_start,n_end,n_maxtry - double precision e_drop - -c Output arguments - integer n_fun - double precision etot - -c Local variables - double precision energy(0:n_ene) - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision orig_e,cur_e - integer n,n_steps,n_first,n_cur,n_tot,i - double precision orig_w(n_ene) - double precision wtime - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - orig_w(15)=wvdwpp - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - wvdwpp=0.D0 - -c Make sure n_start, n_end are within proper range - if (n_start.lt.2) n_start=2 - if (n_end.gt.nres-1) n_end=nres-1 -crc if (n_start.lt.n_end) then - if (n_start.gt.n_end) then - n_start=2 - n_end=nres-1 - endif - -c Save the initial values of energy and coordinates -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'start sc ene',energy(0) -cd call enerprint(energy(0)) -crc etot=energy(0) - n_fun=0 -crc orig_e=etot -crc cur_e=orig_e -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo - -ct wtime=MPI_WTIME() -c Try (one by one) all specified residues, starting from a -c random position in sequence -c Stop early if the energy has decreased by at least e_drop - n_tot=n_end-n_start+1 - n_first=iran_num(0,n_tot-1) - n_steps=0 - n=0 -crc do while (n.lt.n_tot .and. orig_e-etot.lt.e_drop) - do while (n.lt.n_tot) - n_cur=n_start+mod(n_first+n,n_tot) - call single_sc_move(n_cur,n_maxtry,e_drop, - + n_steps,n_fun,etot) -c If a lower energy was found, update the current structure... -crc if (etot.lt.cur_e) then -crc cur_e=etot -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo -crc else -c ...else revert to the previous one -crc etot=cur_e -crc do i=2,nres-1 -crc alph(i)=cur_alph(i) -crc omeg(i)=cur_omeg(i) -crc enddo -crc endif - n=n+1 -cd -cd call chainbuild -cd call etotal(energy) -cd print *,'running',n,energy(0) - enddo - -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'end sc ene',energy(0) - -c Put the original weights back to calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - wvdwpp=orig_w(15) - -crc n_fun=n_fun+1 -ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime - return - end - -c------------------------------------------------------------- - - subroutine single_sc_move(res_pick,n_maxtry,e_drop, - + n_steps,n_fun,e_sc) -c Perturb one side-chain (res_pick) and minimize the -c neighbouring region, keeping all CA's and non-neighbouring -c side-chains fixed -c Try until e_drop energy improvement is achieved, or n_maxtry -c attempts have been made -c At the start, e_sc should contain the side-chain-only energy(0) -c nsteps and nfun for this move are ADDED to n_steps and n_fun -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - -c External functions - double precision dist - external dist - -c Input arguments - integer res_pick,n_maxtry - double precision e_drop - -c Input/Output arguments - integer n_steps,n_fun - double precision e_sc - -c Local variables - logical fail - integer i,j - integer nres_moved - integer iretcode,loc_nfun,orig_maxfun,n_try - double precision sc_dist,sc_dist_cutoff - double precision energy(0:n_ene),orig_e,cur_e - double precision evdw,escloc - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision var(maxvar) - - double precision orig_theta(1:nres),orig_phi(1:nres), - + orig_alph(1:nres),orig_omeg(1:nres) - - -c Define what is meant by "neighbouring side-chain" - sc_dist_cutoff=5.0D0 - -c Don't do glycine or ends - i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return - -c Freeze everything (later will relax only selected side-chains) - mask_r=.true. - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=0 - enddo - -c Find the neighbours of the side-chain to move -c and save initial variables -crc orig_e=e_sc -crc cur_e=orig_e - nres_moved=0 - do i=2,nres-1 -c Don't do glycine (itype(j)==10) - if (itype(i).ne.10) then - sc_dist=dist(nres+i,nres+res_pick) - else - sc_dist=sc_dist_cutoff - endif - if (sc_dist.lt.sc_dist_cutoff) then - nres_moved=nres_moved+1 - mask_side(i)=1 - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - - call chainbuild - call egb1(evdw) - call esc(escloc) - e_sc=wsc*evdw+wscloc*escloc -cd call etotal(energy) -cd print *,'new ',(energy(k),k=0,n_ene) - orig_e=e_sc - cur_e=orig_e - - n_try=0 - do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop) -c Move the selected residue (don't worry if it fails) - call gen_side(iabs(itype(res_pick)),theta(res_pick+1), - + alph(res_pick),omeg(res_pick),fail) - -c Minimize the side-chains starting from the new arrangement - call geom_to_var(nvar,var) - orig_maxfun=maxfun - maxfun=7 - -crc do i=1,nres -crc orig_theta(i)=theta(i) -crc orig_phi(i)=phi(i) -crc orig_alph(i)=alph(i) -crc orig_omeg(i)=omeg(i) -crc enddo - - call minimize_sc1(e_sc,var,iretcode,loc_nfun) - -cv write(*,'(2i3,2f12.5,2i3)') -cv & res_pick,nres_moved,orig_e,e_sc-cur_e, -cv & iretcode,loc_nfun - -c$$$ if (iretcode.eq.8) then -c$$$ write(iout,*)'Coordinates just after code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ do i=1,nres -c$$$ theta(i)=orig_theta(i) -c$$$ phi(i)=orig_phi(i) -c$$$ alph(i)=orig_alph(i) -c$$$ omeg(i)=orig_omeg(i) -c$$$ enddo -c$$$ write(iout,*)'Coordinates just before code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ endif - - n_fun=n_fun+loc_nfun - maxfun=orig_maxfun - call var_to_geom(nvar,var) - -c If a lower energy was found, update the current structure... - if (e_sc.lt.cur_e) then -cv call chainbuild -cv call etotal(energy) -cd call egb1(evdw) -cd call esc(escloc) -cd e_sc1=wsc*evdw+wscloc*escloc -cd print *,' new',e_sc1,energy(0) -cv print *,'new ',energy(0) -cd call enerprint(energy(0)) - cur_e=e_sc - do i=2,nres-1 - if (mask_side(i).eq.1) then - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - else -c ...else revert to the previous one - e_sc=cur_e - do i=2,nres-1 - if (mask_side(i).eq.1) then - alph(i)=cur_alph(i) - omeg(i)=cur_omeg(i) - endif - enddo - endif - n_try=n_try+1 - - enddo - n_steps=n_steps+n_try - -c Reset the minimization mask_r to false - mask_r=.false. - - return - end - -c------------------------------------------------------------- - - subroutine sc_minimize(etot,iretcode,nfun) -c Minimizes side-chains only, leaving backbone frozen -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c Output arguments - double precision etot - integer iretcode,nfun - -c Local variables - integer i - double precision orig_w(n_ene),energy(0:n_ene) - double precision var(maxvar) - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - -c Prepare to freeze backbone - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=1 - enddo - -c Minimize the side-chains - mask_r=.true. - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - call var_to_geom(nvar,var) - mask_r=.false. - -c Put the original weights back and calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - - call chainbuild - call etotal(energy) - etot=energy(0) - - return - end - -c------------------------------------------------------------- - subroutine minimize_sc1(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr1,grad_restr1 - logical not_done,change,reduce - common /przechowalnia/ v - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr1,grad_restr1, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - - return - end -************************************************************************ - subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.TIME1' - common /chuju/ jjj - double precision energia(0:n_ene),evdw,escloc - integer jjj - double precision ufparm,e1,e2 - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf - icg=mod(nf,2)+1 - -#ifdef OSF -c Intercept NaNs in the coordinates, before calling etotal - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - FOUND_NAN=.false. - if (x_sum.ne.x_sum) then - write(iout,*)" *** func_restr1 : Found NaN in coordinates" - f=1.0D+73 - FOUND_NAN=.true. - return - endif -#endif - - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call egb1(evdw) - call esc(escloc) - f=wsc*evdw+wscloc*escloc -cd call etotal(energia(0)) -cd f=wsc*energia(1)+wscloc*energia(12) -cd print *,f,evdw,escloc,energia(0) -C -C Sum up the components of the Cartesian gradient. -C - do i=1,nct - do j=1,3 - gradx(j,i,icg)=wsc*gvdwx(j,i) - enddo - enddo - - return - end -c------------------------------------------------------- - subroutine grad_restr1(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr1(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C----------------------------------------------------------------------------- - subroutine egb1(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - - - itypi=iabs(itype(i)) - itypi1=iabs(itype(i+1)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN - ind=ind+1 - itypj=iabs(itype(j)) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) -C For diagnostics only!!! -c chi1=0.0D0 -c chi2=0.0D0 -c chi12=0.0D0 -c chip1=0.0D0 -c chip2=0.0D0 -c chip12=0.0D0 -c alf1=0.0D0 -c alf2=0.0D0 -c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -cd & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -cd & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad - ENDIF - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- diff --git a/source/unres/src_CSA_DiL/shift.F b/source/unres/src_CSA_DiL/shift.F deleted file mode 100644 index 6eb9b3f..0000000 --- a/source/unres/src_CSA_DiL/shift.F +++ /dev/null @@ -1,105 +0,0 @@ -c--------------------------------- - subroutine csa_read - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - - open(icsa_in,file=csa_in,status="old",err=100) - read(icsa_in,*) nconf - read(icsa_in,*) jstart,jend - read(icsa_in,*) nstmax - read(icsa_in,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2 - read(icsa_in,*) nran0,nran1,irr - read(icsa_in,*) nseed - read(icsa_in,*) ntotal,cut1,cut2 - read(icsa_in,*) estop - read(icsa_in,*) icmax,irestart - read(icsa_in,*) ntbankm,dele,difcut - read(icsa_in,*) iref,rmscut,pnccut - read(icsa_in,*) ndiff - close(icsa_in) - - return - - 100 continue - return - end -c--------------------------------- - subroutine initial_write - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - - open(icsa_seed,file=csa_seed,status="unknown") - write(icsa_seed,*) "seed" - close(31) -#if defined(AIX) || defined(PGI) - open(icsa_history,file=csa_history,status="unknown", - & position="append") -#else - open(icsa_history,file=csa_history,status="unknown", - & access="append") -#endif - write(icsa_history,*) nconf - write(icsa_history,*) jstart,jend - write(icsa_history,*) nstmax - write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2 - write(icsa_history,*) nran0,nran1,irr - write(icsa_history,*) nseed - write(icsa_history,*) ntotal,cut1,cut2 - write(icsa_history,*) estop - write(icsa_history,*) icmax,irestart - write(icsa_history,*) ntbankm,dele,difcut - write(icsa_history,*) iref,rmscut,pnccut - write(icsa_history,*) ndiff - - write(icsa_history,*) - close(icsa_history) - - open(icsa_bank1,file=csa_bank1,status="unknown") - write(icsa_bank1,*) 0 - close(icsa_bank1) - - return - end -c--------------------------------- - subroutine restart_write - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - -#if defined(AIX) || defined(PGI) - open(icsa_history,file=csa_history,position="append") -#else - open(icsa_history,file=csa_history,access="append") -#endif - write(icsa_history,*) - write(icsa_history,*) "This is restart" - write(icsa_history,*) - write(icsa_history,*) nconf - write(icsa_history,*) jstart,jend - write(icsa_history,*) nstmax - write(icsa_history,*) n1,n2,n3,n4,n5,n6,n7,n8,is1,is2 - write(icsa_history,*) nran0,nran1,irr - write(icsa_history,*) nseed - write(icsa_history,*) ntotal,cut1,cut2 - write(icsa_history,*) estop - write(icsa_history,*) icmax,irestart - write(icsa_history,*) ntbankm,dele,difcut - write(icsa_history,*) iref,rmscut,pnccut - write(icsa_history,*) ndiff - write(icsa_history,*) - write(icsa_history,*) "irestart is: ", irestart - - write(icsa_history,*) - close(icsa_history) - - return - end -c--------------------------------- diff --git a/source/unres/src_CSA_DiL/sumsld.f b/source/unres/src_CSA_DiL/sumsld.f deleted file mode 100644 index 1ce7b78..0000000 --- a/source/unres/src_CSA_DiL/sumsld.f +++ /dev/null @@ -1,1446 +0,0 @@ - subroutine sumsl(n, d, x, calcf, calcg, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** analytic gradient and hessian approx. from secant update *** -c - integer n, liv, lv - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(71 + n*(n+15)/2), uiparm(*), urparm(*) - external calcf, calcg, ufparm -c -c *** purpose *** -c -c this routine interacts with subroutine sumit in an attempt -c to find an n-vector x* that minimizes the (unconstrained) -c objective function computed by calcf. (often the x* found is -c a local minimizer rather than a global one.) -c -c-------------------------- parameter usage -------------------------- -c -c n........ (input) the number of variables on which f depends, i.e., -c the number of components in x. -c d........ (input/output) a scale vector such that d(i)*x(i), -c i = 1,2,...,n, are all in comparable units. -c d can strongly affect the behavior of sumsl. -c finding the best choice of d is generally a trial- -c and-error process. choosing d so that d(i)*x(i) -c has about the same value for all i often works well. -c the defaults provided by subroutine deflt (see i -c below) require the caller to supply d. -c x........ (input/output) before (initially) calling sumsl, the call- -c er should set x to an initial guess at x*. when -c sumsl returns, x contains the best point so far -c found, i.e., the one that gives the least value so -c far seen for f(x). -c calcf.... (input) a subroutine that, given x, computes f(x). calcf -c must be declared external in the calling program. -c it is invoked by -c call calcf(n, x, nf, f, uiparm, urparm, ufparm) -c when calcf is called, nf is the invocation -c count for calcf. nf is included for possible use -c with calcg. if x is out of bounds (e.g., if it -c would cause overflow in computing f(x)), then calcf -c should set nf to 0. this will cause a shorter step -c to be attempted. (if x is in bounds, then calcf -c should not change nf.) the other parameters are as -c described above and below. calcf should not change -c n, p, or x. -c calcg.... (input) a subroutine that, given x, computes g(x), the gra- -c dient of f at x. calcg must be declared external in -c the calling program. it is invoked by -c call calcg(n, x, nf, g, uiparm, urparm, ufaprm) -c when calcg is called, nf is the invocation -c count for calcf at the time f(x) was evaluated. the -c x passed to calcg is usually the one passed to calcf -c on either its most recent invocation or the one -c prior to it. if calcf saves intermediate results -c for use by calcg, then it is possible to tell from -c nf whether they are valid for the current x (or -c which copy is valid if two copies are kept). if g -c cannot be computed at x, then calcg should set nf to -c 0. in this case, sumsl will return with iv(1) = 65. -c (if g can be computed at x, then calcg should not -c changed nf.) the other parameters to calcg are as -c described above and below. calcg should not change -c n or x. -c iv....... (input/output) an integer value array of length liv (see -c below) that helps control the sumsl algorithm and -c that is used to store various intermediate quanti- -c ties. of particular interest are the initialization/ -c return code iv(1) and the entries in iv that control -c printing and limit the number of iterations and func- -c tion evaluations. see the section on iv input -c values below. -c liv...... (input) length of iv array. must be at least 60. if li -c is too small, then sumsl returns with iv(1) = 15. -c when sumsl returns, the smallest allowed value of -c liv is stored in iv(lastiv) -- see the section on -c iv output values below. (this is intended for use -c with extensions of sumsl that handle constraints.) -c lv....... (input) length of v array. must be at least 71+n*(n+15)/2. -c (at least 77+n*(n+17)/2 for smsno, at least -c 78+n*(n+12) for humsl). if lv is too small, then -c sumsl returns with iv(1) = 16. when sumsl returns, -c the smallest allowed value of lv is stored in -c iv(lastv) -- see the section on iv output values -c below. -c v........ (input/output) a floating-point value array of length l -c (see below) that helps control the sumsl algorithm -c and that is used to store various intermediate -c quantities. of particular interest are the entries -c in v that limit the length of the first step -c attempted (lmax0) and specify convergence tolerances -c (afctol, lmaxs, rfctol, sctol, xctol, xftol). -c uiparm... (input) user integer parameter array passed without change -c to calcf and calcg. -c urparm... (input) user floating-point parameter array passed without -c change to calcf and calcg. -c ufparm... (input) user external subroutine or function passed without -c change to calcf and calcg. -c -c *** iv input values (from subroutine deflt) *** -c -c iv(1)... on input, iv(1) should have a value between 0 and 14...... -c 0 and 12 mean this is a fresh start. 0 means that -c deflt(2, iv, liv, lv, v) -c is to be called to provide all default values to iv and -c v. 12 (the value that deflt assigns to iv(1)) means the -c caller has already called deflt and has possibly changed -c some iv and/or v entries to non-default values. -c 13 means deflt has been called and that sumsl (and -c sumit) should only do their storage allocation. that is, -c they should set the output components of iv that tell -c where various subarrays arrays of v begin, such as iv(g) -c (and, for humsl and humit only, iv(dtol)), and return. -c 14 means that a storage has been allocated (by a call -c with iv(1) = 13) and that the algorithm should be -c started. when called with iv(1) = 13, sumsl returns -c iv(1) = 14 unless liv or lv is too small (or n is not -c positive). default = 12. -c iv(inith).... iv(25) tells whether the hessian approximation h should -c be initialized. 1 (the default) means sumit should -c initialize h to the diagonal matrix whose i-th diagonal -c element is d(i)**2. 0 means the caller has supplied a -c cholesky factor l of the initial hessian approximation -c h = l*(l**t) in v, starting at v(iv(lmat)) = v(iv(42)) -c (and stored compactly by rows). note that iv(lmat) may -c be initialized by calling sumsl with iv(1) = 13 (see -c the iv(1) discussion above). default = 1. -c iv(mxfcal)... iv(17) gives the maximum number of function evaluations -c (calls on calcf) allowed. if this number does not suf- -c fice, then sumsl returns with iv(1) = 9. default = 200. -c iv(mxiter)... iv(18) gives the maximum number of iterations allowed. -c it also indirectly limits the number of gradient evalua- -c tions (calls on calcg) to iv(mxiter) + 1. if iv(mxiter) -c iterations do not suffice, then sumsl returns with -c iv(1) = 10. default = 150. -c iv(outlev)... iv(19) controls the number and length of iteration sum- -c mary lines printed (by itsum). iv(outlev) = 0 means do -c not print any summary lines. otherwise, print a summary -c line after each abs(iv(outlev)) iterations. if iv(outlev) -c is positive, then summary lines of length 78 (plus carri- -c age control) are printed, including the following... the -c iteration and function evaluation counts, f = the current -c function value, relative difference in function values -c achieved by the latest step (i.e., reldf = (f0-v(f))/f01, -c where f01 is the maximum of abs(v(f)) and abs(v(f0)) and -c v(f0) is the function value from the previous itera- -c tion), the relative function reduction predicted for the -c step just taken (i.e., preldf = v(preduc) / f01, where -c v(preduc) is described below), the scaled relative change -c in x (see v(reldx) below), the step parameter for the -c step just taken (stppar = 0 means a full newton step, -c between 0 and 1 means a relaxed newton step, between 1 -c and 2 means a double dogleg step, greater than 2 means -c a scaled down cauchy step -- see subroutine dbldog), the -c 2-norm of the scale vector d times the step just taken -c (see v(dstnrm) below), and npreldf, i.e., -c v(nreduc)/f01, where v(nreduc) is described below -- if -c npreldf is positive, then it is the relative function -c reduction predicted for a newton step (one with -c stppar = 0). if npreldf is negative, then it is the -c negative of the relative function reduction predicted -c for a step computed with step bound v(lmaxs) for use in -c testing for singular convergence. -c if iv(outlev) is negative, then lines of length 50 -c are printed, including only the first 6 items listed -c above (through reldx). -c default = 1. -c iv(parprt)... iv(20) = 1 means print any nondefault v values on a -c fresh start or any changed v values on a restart. -c iv(parprt) = 0 means skip this printing. default = 1. -c iv(prunit)... iv(21) is the output unit number on which all printing -c is done. iv(prunit) = 0 means suppress all printing. -c default = standard output unit (unit 6 on most systems). -c iv(solprt)... iv(22) = 1 means print out the value of x returned (as -c well as the gradient and the scale vector d). -c iv(solprt) = 0 means skip this printing. default = 1. -c iv(statpr)... iv(23) = 1 means print summary statistics upon return- -c ing. these consist of the function value, the scaled -c relative change in x caused by the most recent step (see -c v(reldx) below), the number of function and gradient -c evaluations (calls on calcf and calcg), and the relative -c function reductions predicted for the last step taken and -c for a newton step (or perhaps a step bounded by v(lmaxs) -c -- see the descriptions of preldf and npreldf under -c iv(outlev) above). -c iv(statpr) = 0 means skip this printing. -c iv(statpr) = -1 means skip this printing as well as that -c of the one-line termination reason message. default = 1. -c iv(x0prt).... iv(24) = 1 means print the initial x and scale vector d -c (on a fresh start only). iv(x0prt) = 0 means skip this -c printing. default = 1. -c -c *** (selected) iv output values *** -c -c iv(1)........ on output, iv(1) is a return code.... -c 3 = x-convergence. the scaled relative difference (see -c v(reldx)) between the current parameter vector x and -c a locally optimal parameter vector is very likely at -c most v(xctol). -c 4 = relative function convergence. the relative differ- -c ence between the current function value and its lo- -c cally optimal value is very likely at most v(rfctol). -c 5 = both x- and relative function convergence (i.e., the -c conditions for iv(1) = 3 and iv(1) = 4 both hold). -c 6 = absolute function convergence. the current function -c value is at most v(afctol) in absolute value. -c 7 = singular convergence. the hessian near the current -c iterate appears to be singular or nearly so, and a -c step of length at most v(lmaxs) is unlikely to yield -c a relative function decrease of more than v(sctol). -c 8 = false convergence. the iterates appear to be converg- -c ing to a noncritical point. this may mean that the -c convergence tolerances (v(afctol), v(rfctol), -c v(xctol)) are too small for the accuracy to which -c the function and gradient are being computed, that -c there is an error in computing the gradient, or that -c the function or gradient is discontinuous near x. -c 9 = function evaluation limit reached without other con- -c vergence (see iv(mxfcal)). -c 10 = iteration limit reached without other convergence -c (see iv(mxiter)). -c 11 = stopx returned .true. (external interrupt). see the -c usage notes below. -c 14 = storage has been allocated (after a call with -c iv(1) = 13). -c 17 = restart attempted with n changed. -c 18 = d has a negative component and iv(dtype) .le. 0. -c 19...43 = v(iv(1)) is out of range. -c 63 = f(x) cannot be computed at the initial x. -c 64 = bad parameters passed to assess (which should not -c occur). -c 65 = the gradient could not be computed at x (see calcg -c above). -c 67 = bad first parameter to deflt. -c 80 = iv(1) was out of range. -c 81 = n is not positive. -c iv(g)........ iv(28) is the starting subscript in v of the current -c gradient vector (the one corresponding to x). -c iv(lastiv)... iv(44) is the least acceptable value of liv. (it is -c only set if liv is at least 44.) -c iv(lastv).... iv(45) is the least acceptable value of lv. (it is -c only set if liv is large enough, at least iv(lastiv).) -c iv(nfcall)... iv(6) is the number of calls so far made on calcf (i.e., -c function evaluations). -c iv(ngcall)... iv(30) is the number of gradient evaluations (calls on -c calcg). -c iv(niter).... iv(31) is the number of iterations performed. -c -c *** (selected) v input values (from subroutine deflt) *** -c -c v(bias)..... v(43) is the bias parameter used in subroutine dbldog -- -c see that subroutine for details. default = 0.8. -c v(afctol)... v(31) is the absolute function convergence tolerance. -c if sumsl finds a point where the function value is less -c than v(afctol) in absolute value, and if sumsl does not -c return with iv(1) = 3, 4, or 5, then it returns with -c iv(1) = 6. this test can be turned off by setting -c v(afctol) to zero. default = max(10**-20, machep**2), -c where machep is the unit roundoff. -c v(dinit).... v(38), if nonnegative, is the value to which the scale -c vector d is initialized. default = -1. -c v(lmax0).... v(35) gives the maximum 2-norm allowed for d times the -c very first step that sumsl attempts. this parameter can -c markedly affect the performance of sumsl. -c v(lmaxs).... v(36) is used in testing for singular convergence -- if -c the function reduction predicted for a step of length -c bounded by v(lmaxs) is at most v(sctol) * abs(f0), where -c f0 is the function value at the start of the current -c iteration, and if sumsl does not return with iv(1) = 3, -c 4, 5, or 6, then it returns with iv(1) = 7. default = 1. -c v(rfctol)... v(32) is the relative function convergence tolerance. -c if the current model predicts a maximum possible function -c reduction (see v(nreduc)) of at most v(rfctol)*abs(f0) -c at the start of the current iteration, where f0 is the -c then current function value, and if the last step attempt- -c ed achieved no more than twice the predicted function -c decrease, then sumsl returns with iv(1) = 4 (or 5). -c default = max(10**-10, machep**(2/3)), where machep is -c the unit roundoff. -c v(sctol).... v(37) is the singular convergence tolerance -- see the -c description of v(lmaxs) above. -c v(tuner1)... v(26) helps decide when to check for false convergence. -c this is done if the actual function decrease from the -c current step is no more than v(tuner1) times its predict- -c ed value. default = 0.1. -c v(xctol).... v(33) is the x-convergence tolerance. if a newton step -c (see v(nreduc)) is tried that has v(reldx) .le. v(xctol) -c and if this step yields at most twice the predicted func- -c tion decrease, then sumsl returns with iv(1) = 3 (or 5). -c (see the description of v(reldx) below.) -c default = machep**0.5, where machep is the unit roundoff. -c v(xftol).... v(34) is the false convergence tolerance. if a step is -c tried that gives no more than v(tuner1) times the predict- -c ed function decrease and that has v(reldx) .le. v(xftol), -c and if sumsl does not return with iv(1) = 3, 4, 5, 6, or -c 7, then it returns with iv(1) = 8. (see the description -c of v(reldx) below.) default = 100*machep, where -c machep is the unit roundoff. -c v(*)........ deflt supplies to v a number of tuning constants, with -c which it should ordinarily be unnecessary to tinker. see -c section 17 of version 2.2 of the nl2sol usage summary -c (i.e., the appendix to ref. 1) for details on v(i), -c i = decfac, incfac, phmnfc, phmxfc, rdfcmn, rdfcmx, -c tuner2, tuner3, tuner4, tuner5. -c -c *** (selected) v output values *** -c -c v(dgnorm)... v(1) is the 2-norm of (diag(d)**-1)*g, where g is the -c most recently computed gradient. -c v(dstnrm)... v(2) is the 2-norm of diag(d)*step, where step is the -c current step. -c v(f)........ v(10) is the current function value. -c v(f0)....... v(13) is the function value at the start of the current -c iteration. -c v(nreduc)... v(6), if positive, is the maximum function reduction -c possible according to the current model, i.e., the func- -c tion reduction predicted for a newton step (i.e., -c step = -h**-1 * g, where g is the current gradient and -c h is the current hessian approximation). -c if v(nreduc) is negative, then it is the negative of -c the function reduction predicted for a step computed with -c a step bound of v(lmaxs) for use in testing for singular -c convergence. -c v(preduc)... v(7) is the function reduction predicted (by the current -c quadratic model) for the current step. this (divided by -c v(f0)) is used in testing for relative function -c convergence. -c v(reldx).... v(17) is the scaled relative change in x caused by the -c current step, computed as -c max(abs(d(i)*(x(i)-x0(i)), 1 .le. i .le. p) / -c max(d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p), -c where x = x0 + step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c this routine uses a hessian approximation computed from the -c bfgs update (see ref 3). only a cholesky factor of the hessian -c approximation is stored, and this is updated using ideas from -c ref. 4. steps are computed by the double dogleg scheme described -c in ref. 2. the steps are assessed as in ref. 1. -c -c *** usage notes *** -c -c after a return with iv(1) .le. 11, it is possible to restart, -c i.e., to change some of the iv and v input values described above -c and continue the algorithm from the point where it was interrupt- -c ed. iv(1) should not be changed, nor should any entries of i -c and v other than the input values (those supplied by deflt). -c those who do not wish to write a calcg which computes the -c gradient analytically should call smsno rather than sumsl. -c smsno uses finite differences to compute an approximate gradient. -c those who would prefer to provide f and g (the function and -c gradient) by reverse communication rather than by writing subrou- -c tines calcf and calcg may call on sumit directly. see the com- -c ments at the beginning of sumit. -c those who use sumsl interactively may wish to supply their -c own stopx function, which should return .true. if the break key -c has been pressed since stopx was last invoked. this makes it -c possible to externally interrupt sumsl (which will return with -c iv(1) = 11 if stopx returns .true.). -c storage for g is allocated at the end of v. thus the caller -c may make v longer than specified above and may allow calcg to use -c elements of g beyond the first n as scratch storage. -c -c *** portability notes *** -c -c the sumsl distribution tape contains both single- and double- -c precision versions of the sumsl source code, so it should be un- -c necessary to change precisions. -c only the functions imdcon and rmdcon contain machine-dependent -c constants. to change from one machine to another, it should -c suffice to change the (few) relevant lines in these functions. -c intrinsic functions are explicitly declared. on certain com- -c puters (e.g. univac), it may be necessary to comment out these -c declarations. so that this may be done automatically by a simple -c program, such declarations are preceded by a comment having c/+ -c in columns 1-3 and blanks in columns 4-72 and are followed by -c a comment having c/ in columns 1 and 2 and blanks in columns 3-72. -c the sumsl source code is expressed in 1966 ansi standard -c fortran. it may be converted to fortran 77 by commenting out all -c lines that fall between a line having c/6 in columns 1-3 and a -c line having c/7 in columns 1-3 and by removing (i.e., replacing -c by a blank) the c in column 1 of the lines that follow the c/7 -c line and precede a line having c/ in columns 1-2 and blanks in -c columns 3-72. these changes convert some data statements into -c parameter statements, convert some variables from real to -c character*4, and make the data statements that initialize these -c variables use character strings delimited by primes instead -c of hollerith constants. (such variables and data statements -c appear only in modules itsum and parck. parameter statements -c appear nearly everywhere.) these changes also add save state- -c ments for variables given machine-dependent constants by rmdcon. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), algorithm 573 -- -c an adaptive nonlinear least-squares algorithm, acm trans. -c math. software 7, pp. 369-383. -c -c 2. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c -c 3. dennis, j.e., and more, j.j. (1977), quasi-newton methods, motiva- -c tion and theory, siam rev. 19, pp. 46-89. -c -c 4. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (winter 1980). revised summer 1982. -c this subroutine was written in connection with research -c supported in part by the national science foundation under -c grants mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, -c and mcs-7906671. -c. -c -c---------------------------- declarations --------------------------- -c - external deflt, sumit -c -c deflt... supplies default iv and v input components. -c sumit... reverse-communication routine that carries out sumsl algo- -c rithm. -c - integer g1, iv1, nf - double precision f -c -c *** subscripts for iv *** -c - integer nextv, nfcall, nfgcal, g, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, toobig/2/, vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, toobig=2, vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .eq. 12 .or. iv1 .eq. 13) iv(vneed) = iv(vneed) + n - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) -c - 20 call sumit(d, f, v(g1), iv, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcg(n, x, iv(nfgcal), v(g1), uiparm, urparm, ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(nextv) = iv(g) + n - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of sumsl follows *** - end - subroutine sumit(d, fx, g, iv, liv, lv, n, v, x) -c -c *** carry out sumsl (unconstrained minimization) iterations, using -c *** double-dogleg/bfgs steps. -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c iv... integer value array. -c liv.. length of iv (at least 60). -c lv... length of v (at least 71 + n*(n+13)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... vector of parameters to be optimized. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to sumsl (which see), except that v can be shorter (since -c the part of v that sumsl uses for storing g is not needed). -c moreover, compared with sumsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from sumsl (and smsno), is not referenced by -c sumit or the subroutines it calls. -c fx and g need not have been initialized when sumit is called -c with iv(1) = 12, 13, or 14. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call sumit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c (e.g. if overflow would occur), which may happen because -c of an oversized step. in this case the caller should set -c iv(toobig) = iv(2) to 1, which will cause sumit to ig- -c nore fx and try a smaller step. the parameter nf that -c sumsl passes to calcf (for possible use by calcg) is a -c copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient vector -c of f at x, and call sumit again, having changed none of -c the other parameters except possibly the scale vector d -c when iv(dtype) = 0. the parameter nf that sumsl passes -c to calcg is iv(nfgcal) = iv(7). if g(x) cannot be -c evaluated, then the caller may set iv(nfgcal) to 0, in -c which case sumit will return with iv(1) = 65. -c. -c *** general *** -c -c coded by david m. gay (december 1979). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, g01, i, k, l, lstgst, nwtst1, step1, - 1 temp1, w, x01, z - double precision t -c -c *** constants *** -c - double precision half, negone, one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, dbdog, deflt, dotprd, itsum, litvmu, livmul, - 1 ltvmul, lupdat, lvmul, parck, reldst, stopx, vaxpy, - 2 vcopy, vscopy, vvmulp, v2norm, wzbfgs - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c dbdog.... computes double-dogleg (candidate) step. -c deflt.... supplies default iv and v input components. -c dotprd... returns inner product of two vectors. -c itsum.... prints iteration summary and info on initial and final x. -c litvmu... multiplies inverse transpose of lower triangle times vector. -c livmul... multiplies inverse of lower triangle times vector. -c ltvmul... multiplies transpose of lower triangle times vector. -c lupdt.... updates cholesky factor of hessian approximation. -c lvmul.... multiplies lower triangle times vector. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c vvmulp... multiplies vector by vector raised to power (componentwise). -c v2norm... returns the 2-norm of a vector. -c wzbfgs... computes w and z for lupdat corresponding to bfgs update. -c -c *** subscripts for iv and v *** -c - integer afctol - integer cnvcod, dg, dgnorm, dinit, dstnrm, dst0, f, f0, fdif, - 1 gthg, gtstep, g0, incfac, inith, irc, kagqt, lmat, lmax0, - 2 lmaxs, mode, model, mxfcal, mxiter, nextv, nfcall, nfgcal, - 3 ngcall, niter, nreduc, nwtstp, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, toobig, - 5 tuner4, tuner5, vneed, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, g0/48/, inith/25/, irc/29/, kagqt/33/, -c 1 mode/35/, model/5/, mxfcal/17/, mxiter/18/, nfcall/6/, -c 2 nfgcal/7/, ngcall/30/, niter/31/, nwtstp/34/, radinc/8/, -c 3 restor/9/, step/40/, stglim/11/, stlstg/41/, toobig/2/, -c 4 vneed/4/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, g0=48, inith=25, irc=29, kagqt=33, - 1 mode=35, model=5, mxfcal=17, mxiter=18, nfcall=6, - 2 nfgcal=7, ngcall=30, niter=31, nwtstp=34, radinc=8, - 3 restor=9, step=40, stglim=11, stlstg=41, toobig=2, - 4 vneed=4, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/ -c data dgnorm/1/, dinit/38/, dstnrm/2/, dst0/3/, f/10/, f0/13/, -c 1 fdif/11/, gthg/44/, gtstep/4/, incfac/23/, lmat/42/, -c 2 lmax0/35/, lmaxs/36/, nextv/47/, nreduc/6/, preduc/7/, -c 3 radfac/16/, radius/8/, rad0/9/, reldx/17/, tuner4/29/, -c 4 tuner5/30/ -c/7 - parameter (afctol=31) - parameter (dgnorm=1, dinit=38, dstnrm=2, dst0=3, f=10, f0=13, - 1 fdif=11, gthg=44, gtstep=4, incfac=23, lmat=42, - 2 lmax0=35, lmaxs=36, nextv=47, nreduc=6, preduc=7, - 3 radfac=16, radius=8, rad0=9, reldx=17, tuner4=29, - 4 tuner5=30) -c/ -c -c/6 -c data half/0.5d+0/, negone/-1.d+0/, one/1.d+0/, onep2/1.2d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, negone=-1.d+0, one=1.d+0, onep2=1.2d+0, - 1 zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c -C Following SAVE statement inserted. - save l - i = iv(1) - if (i .eq. 1) go to 50 - if (i .eq. 2) go to 60 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+13)/2 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - go to (180, 180, 180, 180, 180, 180, 120, 90, 120, 10, 10, 20), i -c -c *** storage allocation *** -c -10 l = iv(lmat) - iv(x0) = l + n*(n+1)/2 - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(g0) = iv(stlstg) + n - iv(nwtstp) = iv(g0) + n - iv(dg) = iv(nwtstp) + n - iv(nextv) = iv(dg) + n - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - if (iv(inith) .ne. 1) go to 40 -c -c *** set the initial hessian approximation to diag(d)**-2 *** -c - l = iv(lmat) - call vscopy(n*(n+1)/2, v(l), zero) - k = l - 1 - do 30 i = 1, n - k = k + i - t = d(i) - if (t .le. zero) t = one - v(k) = t - 30 continue -c -c *** compute initial function value *** -c - 40 iv(1) = 1 - go to 999 -c - 50 v(f) = fx - if (iv(mode) .ge. 0) go to 180 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 300 -c -c *** make sure gradient could be computed *** -c - 60 if (iv(nfgcal) .ne. 0) go to 70 - iv(1) = 65 - go to 300 -c - 70 dg1 = iv(dg) - call vvmulp(n, v(dg1), g, d, -1) - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** test norm of gradient *** -c - if (v(dgnorm) .gt. v(afctol)) go to 75 - iv(irc) = 10 - iv(cnvcod) = iv(irc) - 4 -c - 75 if (iv(cnvcod) .ne. 0) go to 290 - if (iv(mode) .eq. 0) go to 250 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 80 call itsum(d, g, iv, liv, lv, n, v, x) - 90 k = iv(niter) - if (k .lt. iv(mxiter)) go to 100 - iv(1) = 10 - go to 300 -c -c *** update radius *** -c - 100 iv(niter) = k + 1 - if(k.gt.0)v(radius) = v(radfac) * v(dstnrm) -c -c *** initialize for start of next iteration *** -c - g01 = iv(g0) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0, g to g0 *** -c - call vcopy(n, v(x01), x) - call vcopy(n, v(g01), g) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 110 if (.not. stopx(dummy)) go to 130 - iv(1) = 11 - go to 140 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 120 if (v(f) .ge. v(f0)) go to 130 - v(radfac) = one - k = iv(niter) - go to 100 -c - 130 if (iv(nfcall) .lt. iv(mxfcal)) go to 150 - iv(1) = 9 - 140 if (v(f) .ge. v(f0)) go to 300 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 240 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 150 step1 = iv(step) - dg1 = iv(dg) - nwtst1 = iv(nwtstp) - if (iv(kagqt) .ge. 0) go to 160 - l = iv(lmat) - call livmul(n, v(nwtst1), v(l), g) - v(nreduc) = half * dotprd(n, v(nwtst1), v(nwtst1)) - call litvmu(n, v(nwtst1), v(l), v(nwtst1)) - call vvmulp(n, v(step1), v(nwtst1), d, 1) - v(dst0) = v2norm(n, v(step1)) - call vvmulp(n, v(dg1), v(dg1), d, -1) - call ltvmul(n, v(step1), v(l), v(dg1)) - v(gthg) = v2norm(n, v(step1)) - iv(kagqt) = 0 - 160 call dbdog(v(dg1), lv, n, v(nwtst1), v(step1), v) - if (iv(irc) .eq. 6) go to 180 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 180 - if (iv(irc) .ne. 5) go to 170 - if (v(radfac) .le. one) go to 170 - if (v(preduc) .le. onep2 * v(fdif)) go to 180 -c -c *** compute f(x0 + step) *** -c - 170 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 180 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 190 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 190 k = iv(irc) - go to (200,230,230,230,200,210,220,220,220,220,220,220,280,250), k -c -c *** recompute step with changed radius *** -c - 200 v(radius) = v(radfac) * v(dstnrm) - go to 110 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 210 v(radius) = v(lmaxs) - go to 150 -c -c *** convergence or false convergence *** -c - 220 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 290 - if (iv(xirc) .eq. 14) go to 290 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 230 if (iv(irc) .ne. 3) go to 240 - step1 = iv(step) - temp1 = iv(stlstg) -c -c *** set temp1 = hessian * step for use in gradient tests *** -c - l = iv(lmat) - call ltvmul(n, v(temp1), v(l), v(step1)) - call lvmul(n, v(temp1), v(l), v(temp1)) -c -c *** compute gradient *** -c - 240 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c -c *** initializations -- g0 = g - g0, etc. *** -c - 250 g01 = iv(g0) - call vaxpy(n, v(g01), negone, v(g01), g) - step1 = iv(step) - temp1 = iv(stlstg) - if (iv(irc) .ne. 3) go to 270 -c -c *** set v(radfac) by gradient tests *** -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - call vaxpy(n, v(temp1), negone, v(g01), v(temp1)) - call vvmulp(n, v(temp1), v(temp1), d, -1) -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) - 1 go to 260 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 270 - 260 v(radfac) = v(incfac) -c -c *** update h, loop *** -c - 270 w = iv(nwtstp) - z = iv(x0) - l = iv(lmat) - call wzbfgs(v(l), n, v(step1), v(w), v(g01), v(z)) -c -c ** use the n-vectors starting at v(step1) and v(g01) for scratch.. - call lupdat(v(temp1), v(step1), v(l), v(g01), v(l), n, v(w), v(z)) - iv(1) = 2 - go to 80 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 280 iv(1) = 64 - go to 300 -c -c *** print summary of final iteration and other requested items *** -c - 290 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 300 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last line of sumit follows *** - end - subroutine dbdog(dig, lv, n, nwtstp, step, v) -c -c *** compute double dogleg step *** -c -c *** parameter declarations *** -c - integer lv, n - double precision dig(n), nwtstp(n), step(n), v(lv) -c -c *** purpose *** -c -c this subroutine computes a candidate step (for use in an uncon- -c strained minimization code) by the double dogleg algorithm of -c dennis and mei (ref. 1), which is a variation on powell*s dogleg -c scheme (ref. 2, p. 95). -c -c-------------------------- parameter usage -------------------------- -c -c dig (input) diag(d)**-2 * g -- see algorithm notes. -c g (input) the current gradient vector. -c lv (input) length of v. -c n (input) number of components in dig, g, nwtstp, and step. -c nwtstp (input) negative newton step -- see algorithm notes. -c step (output) the computed step. -c v (i/o) values array, the following components of which are -c used here... -c v(bias) (input) bias for relaxed newton step, which is v(bias) of -c the way from the full newton to the fully relaxed newton -c step. recommended value = 0.8 . -c v(dgnorm) (input) 2-norm of diag(d)**-1 * g -- see algorithm notes. -c v(dstnrm) (output) 2-norm of diag(d) * step, which is v(radius) -c unless v(stppar) = 0 -- see algorithm notes. -c v(dst0) (input) 2-norm of diag(d) * nwtstp -- see algorithm notes. -c v(grdfac) (output) the coefficient of dig in the step returned -- -c step(i) = v(grdfac)*dig(i) + v(nwtfac)*nwtstp(i). -c v(gthg) (input) square-root of (dig**t) * (hessian) * dig -- see -c algorithm notes. -c v(gtstep) (output) inner product between g and step. -c v(nreduc) (output) function reduction predicted for the full newton -c step. -c v(nwtfac) (output) the coefficient of nwtstp in the step returned -- -c see v(grdfac) above. -c v(preduc) (output) function reduction predicted for the step returned. -c v(radius) (input) the trust region radius. d times the step returned -c has 2-norm v(radius) unless v(stppar) = 0. -c v(stppar) (output) code telling how step was computed... 0 means a -c full newton step. between 0 and 1 means v(stppar) of the -c way from the newton to the relaxed newton step. between -c 1 and 2 means a true double dogleg step, v(stppar) - 1 of -c the way from the relaxed newton to the cauchy step. -c greater than 2 means 1 / (v(stppar) - 1) times the cauchy -c step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c let g and h be the current gradient and hessian approxima- -c tion respectively and let d be the current scale vector. this -c routine assumes dig = diag(d)**-2 * g and nwtstp = h**-1 * g. -c the step computed is the same one would get by replacing g and h -c by diag(d)**-1 * g and diag(d)**-1 * h * diag(d)**-1, -c computing step, and translating step back to the original -c variables, i.e., premultiplying it by diag(d)**-1. -c -c *** references *** -c -c 1. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c 2. powell, m.j.d. (1970), a hybrid method for non-linear equations, -c in numerical methods for non-linear equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, v2norm - double precision dotprd, v2norm -c -c dotprd... returns inner product of two vectors. -c v2norm... returns 2-norm of a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cfact, cnorm, ctrnwt, ghinvg, femnsq, gnorm, - 1 nwtnrm, relax, rlambd, t, t1, t2 - double precision half, one, two, zero -c -c *** v subscripts *** -c - integer bias, dgnorm, dstnrm, dst0, grdfac, gthg, gtstep, - 1 nreduc, nwtfac, preduc, radius, stppar -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, two/2.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, two=2.d+0, zero=0.d+0) -c/ -c -c/6 -c data bias/43/, dgnorm/1/, dstnrm/2/, dst0/3/, grdfac/45/, -c 1 gthg/44/, gtstep/4/, nreduc/6/, nwtfac/46/, preduc/7/, -c 2 radius/8/, stppar/5/ -c/7 - parameter (bias=43, dgnorm=1, dstnrm=2, dst0=3, grdfac=45, - 1 gthg=44, gtstep=4, nreduc=6, nwtfac=46, preduc=7, - 2 radius=8, stppar=5) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nwtnrm = v(dst0) - rlambd = one - if (nwtnrm .gt. zero) rlambd = v(radius) / nwtnrm - gnorm = v(dgnorm) - ghinvg = two * v(nreduc) - v(grdfac) = zero - v(nwtfac) = zero - if (rlambd .lt. one) go to 30 -c -c *** the newton step is inside the trust region *** -c - v(stppar) = zero - v(dstnrm) = nwtnrm - v(gtstep) = -ghinvg - v(preduc) = v(nreduc) - v(nwtfac) = -one - do 20 i = 1, n - 20 step(i) = -nwtstp(i) - go to 999 -c - 30 v(dstnrm) = v(radius) - cfact = (gnorm / v(gthg))**2 -c *** cauchy step = -cfact * g. - cnorm = gnorm * cfact - relax = one - v(bias) * (one - gnorm*cnorm/ghinvg) - if (rlambd .lt. relax) go to 50 -c -c *** step is between relaxed newton and full newton steps *** -c - v(stppar) = one - (rlambd - relax) / (one - relax) - t = -rlambd - v(gtstep) = t * ghinvg - v(preduc) = rlambd * (one - half*rlambd) * ghinvg - v(nwtfac) = t - do 40 i = 1, n - 40 step(i) = t * nwtstp(i) - go to 999 -c - 50 if (cnorm .lt. v(radius)) go to 70 -c -c *** the cauchy step lies outside the trust region -- -c *** step = scaled cauchy step *** -c - t = -v(radius) / gnorm - v(grdfac) = t - v(stppar) = one + cnorm / v(radius) - v(gtstep) = -v(radius) * gnorm - v(preduc) = v(radius)*(gnorm - half*v(radius)*(v(gthg)/gnorm)**2) - do 60 i = 1, n - 60 step(i) = t * dig(i) - go to 999 -c -c *** compute dogleg step between cauchy and relaxed newton *** -c *** femur = relaxed newton step minus cauchy step *** -c - 70 ctrnwt = cfact * relax * ghinvg / gnorm -c *** ctrnwt = inner prod. of cauchy and relaxed newton steps, -c *** scaled by gnorm**-1. - t1 = ctrnwt - gnorm*cfact**2 -c *** t1 = inner prod. of femur and cauchy step, scaled by -c *** gnorm**-1. - t2 = v(radius)*(v(radius)/gnorm) - gnorm*cfact**2 - t = relax * nwtnrm - femnsq = (t/gnorm)*t - ctrnwt - t1 -c *** femnsq = square of 2-norm of femur, scaled by gnorm**-1. - t = t2 / (t1 + dsqrt(t1**2 + femnsq*t2)) -c *** dogleg step = cauchy step + t * femur. - t1 = (t - one) * cfact - v(grdfac) = t1 - t2 = -t * relax - v(nwtfac) = t2 - v(stppar) = two - t - v(gtstep) = t1*gnorm**2 + t2*ghinvg - v(preduc) = -t1*gnorm * ((t2 + one)*gnorm) - 1 - t2 * (one + half*t2)*ghinvg - 2 - half * (v(gthg)*t1)**2 - do 80 i = 1, n - 80 step(i) = t1*dig(i) + t2*nwtstp(i) -c - 999 return -c *** last line of dbdog follows *** - end - subroutine ltvmul(n, x, l, y) -c -c *** compute x = (l**t)*y, where l is an n x n lower -c *** triangular matrix stored compactly by rows. x and y may -c *** occupy the same storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ij, i0, j - double precision yi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - i0 = 0 - do 20 i = 1, n - yi = y(i) - x(i) = zero - do 10 j = 1, i - ij = i0 + j - x(j) = x(j) + yi*l(ij) - 10 continue - i0 = i0 + i - 20 continue - 999 return -c *** last card of ltvmul follows *** - end - subroutine lupdat(beta, gamma, l, lambda, lplus, n, w, z) -c -c *** compute lplus = secant update of l *** -c -c *** parameter declarations *** -c - integer n -cal double precision beta(n), gamma(n), l(1), lambda(n), lplus(1), - double precision beta(n), gamma(n), l(n*(n+1)/2), lambda(n), - 1 lplus(n*(n+1)/2),w(n), z(n) -c dimension l(n*(n+1)/2), lplus(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c beta = scratch vector. -c gamma = scratch vector. -c l (input) lower triangular matrix, stored rowwise. -c lambda = scratch vector. -c lplus (output) lower triangular matrix, stored rowwise, which may -c occupy the same storage as l. -c n (input) length of vector parameters and order of matrices. -c w (input, destroyed on output) right singular vector of rank 1 -c correction to l. -c z (input, destroyed on output) left singular vector of rank 1 -c correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine updates the cholesky factor l of a symmetric -c positive definite matrix to which a secant update is being -c applied -- it computes a cholesky factor lplus of -c l * (i + z*w**t) * (i + w*z**t) * l**t. it is assumed that w -c and z have been chosen so that the updated matrix is strictly -c positive definite. -c -c *** algorithm notes *** -c -c this code uses recurrence 3 of ref. 1 (with d(j) = 1 for all j) -c to compute lplus of the form l * (i + z*w**t) * q, where q -c is an orthogonal matrix that makes the result lower triangular. -c lplus may have some negative diagonal elements. -c -c *** references *** -c -c 1. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i, ij, j, jj, jp1, k, nm1, np1 - double precision a, b, bj, eta, gj, lj, lij, ljj, nu, s, theta, - 1 wj, zj - double precision one, zero -c -c *** data initializations *** -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nu = one - eta = zero - if (n .le. 1) go to 30 - nm1 = n - 1 -c -c *** temporarily store s(j) = sum over k = j+1 to n of w(k)**2 in -c *** lambda(j). -c - s = zero - do 10 i = 1, nm1 - j = n - i - s = s + w(j+1)**2 - lambda(j) = s - 10 continue -c -c *** compute lambda, gamma, and beta by goldfarb*s recurrence 3. -c - do 20 j = 1, nm1 - wj = w(j) - a = nu*z(j) - eta*wj - theta = one + a*wj - s = a*lambda(j) - lj = dsqrt(theta**2 + a*s) - if (theta .gt. zero) lj = -lj - lambda(j) = lj - b = theta*wj + s - gamma(j) = b * nu / lj - beta(j) = (a - b*eta) / lj - nu = -nu / lj - eta = -(eta + (a**2)/(theta - lj)) / lj - 20 continue - 30 lambda(n) = one + (nu*z(n) - eta*w(n))*w(n) -c -c *** update l, gradually overwriting w and z with l*w and l*z. -c - np1 = n + 1 - jj = n * (n + 1) / 2 - do 60 k = 1, n - j = np1 - k - lj = lambda(j) - ljj = l(jj) - lplus(jj) = lj * ljj - wj = w(j) - w(j) = ljj * wj - zj = z(j) - z(j) = ljj * zj - if (k .eq. 1) go to 50 - bj = beta(j) - gj = gamma(j) - ij = jj + j - jp1 = j + 1 - do 40 i = jp1, n - lij = l(ij) - lplus(ij) = lj*lij + bj*w(i) + gj*z(i) - w(i) = w(i) + lij*wj - z(i) = z(i) + lij*zj - ij = ij + i - 40 continue - 50 jj = jj - j - 60 continue -c - 999 return -c *** last card of lupdat follows *** - end - subroutine lvmul(n, x, l, y) -c -c *** compute x = l*y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ii, ij, i0, j, np1 - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - np1 = n + 1 - i0 = n*(n+1)/2 - do 20 ii = 1, n - i = np1 - ii - i0 = i0 - i - t = zero - do 10 j = 1, i - ij = i0 + j - t = t + l(ij)*y(j) - 10 continue - x(i) = t - 20 continue - 999 return -c *** last card of lvmul follows *** - end - subroutine vvmulp(n, x, y, z, k) -c -c *** set x(i) = y(i) * z(i)**k, 1 .le. i .le. n (for k = 1 or -1) *** -c - integer n, k - double precision x(n), y(n), z(n) - integer i -c - if (k .ge. 0) go to 20 - do 10 i = 1, n - 10 x(i) = y(i) / z(i) - go to 999 -c - 20 do 30 i = 1, n - 30 x(i) = y(i) * z(i) - 999 return -c *** last card of vvmulp follows *** - end - subroutine wzbfgs (l, n, s, w, y, z) -c -c *** compute y and z for lupdat corresponding to bfgs update. -c - integer n -cal double precision l(1), s(n), w(n), y(n), z(n) - double precision l(n*(n+1)/2), s(n), w(n), y(n), z(n) -c dimension l(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c l (i/o) cholesky factor of hessian, a lower triang. matrix stored -c compactly by rows. -c n (input) order of l and length of s, w, y, z. -c s (input) the step just taken. -c w (output) right singular vector of rank 1 correction to l. -c y (input) change in gradients corresponding to s. -c z (output) left singular vector of rank 1 correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c when s is computed in certain ways, e.g. by gqtstp or -c dbldog, it is possible to save n**2/2 operations since (l**t)*s -c or l*(l**t)*s is then known. -c if the bfgs update to l*(l**t) would reduce its determinant to -c less than eps times its old value, then this routine in effect -c replaces y by theta*y + (1 - theta)*l*(l**t)*s, where theta -c (between 0 and 1) is chosen to make the reduction factor = eps. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, livmul, ltvmul - double precision dotprd -c dotprd returns inner product of two vectors. -c livmul multiplies l**-1 times a vector. -c ltvmul multiplies l**t times a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cs, cy, eps, epsrt, one, shs, ys, theta -c -c *** data initializations *** -c -c/6 -c data eps/0.1d+0/, one/1.d+0/ -c/7 - parameter (eps=0.1d+0, one=1.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - call ltvmul(n, w, l, s) - shs = dotprd(n, w, w) - ys = dotprd(n, y, s) - if (ys .ge. eps*shs) go to 10 - theta = (one - eps) * shs / (shs - ys) - epsrt = dsqrt(eps) - cy = theta / (shs * epsrt) - cs = (one + (theta-one)/epsrt) / shs - go to 20 - 10 cy = one / (dsqrt(ys) * dsqrt(shs)) - cs = one / shs - 20 call livmul(n, z, l, y) - do 30 i = 1, n - 30 z(i) = cy * z(i) - cs * w(i) -c - 999 return -c *** last card of wzbfgs follows *** - end diff --git a/source/unres/src_CSA_DiL/test.F b/source/unres/src_CSA_DiL/test.F deleted file mode 100644 index a065af9..0000000 --- a/source/unres/src_CSA_DiL/test.F +++ /dev/null @@ -1,2800 +0,0 @@ - subroutine test - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar),var1(maxvar) - integer j1,j2 - logical debug,accepted - debug=.true. - - - call geom_to_var(nvar,var1) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',0,etot,rms - call secondary2(.false.) - - call write_pdb(0,'first structure',etot) - - j1=13 - j2=21 - da=180.0*deg2rad - - - - temp=3000.0d0 - betbol=1.0D0/(1.9858D-3*temp) - jr=iran_num(j1,j2) - d=ran_number(-pi,pi) -c phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot0=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',1,etot0,rms - call write_pdb(1,'perturb structure',etot0) - - do i=2,500,2 - jr=iran_num(j1,j2) - d=ran_number(-da,da) - phiold=phi(jr) - phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - - if (etot.lt.etot0) then - accepted=.true. - else - accepted=.false. - xxr=ran_number(0.0D0,1.0D0) - xxh=betbol*(etot-etot0) - if (xxh.lt.50.0D0) then - xxh=dexp(-xxh) - if (xxh.gt.xxr) accepted=.true. - endif - endif - accepted=.true. -c print *,etot0,etot,accepted - if (accepted) then - etot0=etot - call rmsd(rms) - write(iout,*) 'etot=',i,etot,rms - call write_pdb(i,'MC structure',etot) -c minimize -c call geom_to_var(nvar,var1) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun - call var_to_geom(nvar,var) - call chainbuild - call rmsd(rms) - write(iout,*) 'etot mcm=',i,etot,rms - call write_pdb(i+1,'MCM structure',etot) - call var_to_geom(nvar,var1) -c -------- - else - phi(jr)=phiold - endif - enddo - -c minimize -c call sc_move(2,nres-1,1,10d0,nft_sc,etot) -c call geom_to_var(nvar,var) -c -c call chainbuild -c call write_pdb(998 ,'sc min',etot) -c -c call minimize(etot,var,iretcode,nfun) -c write(iout,*)'------------------------------------------------' -c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun -c -c call var_to_geom(nvar,var) -c call chainbuild -c call write_pdb(999,'full min',etot) - - - return - end - - - subroutine test_n16 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar),var1(maxvar) - integer jdata(5) - logical debug - debug=.true. - -c - call geom_to_var(nvar,var1) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - call write_pdb(1,'first structure',etot) - call secondary2(.true.) - - do i=1,4 - jdata(i)=bfrag(i,2) - enddo - - DO ij=1,4 - ieval=0 - jdata(5)=ij - call var_to_geom(nvar,var1) - write(iout,*) 'N16 test',(jdata(i),i=1,5) - call beta_slide(jdata(1),jdata(2),jdata(3),jdata(4),jdata(5) - & ,ieval,ij) - call geom_to_var(nvar,var) - - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(ij*100+99,'full min',etot) - endif - - - ENDDO - - return - end - - - subroutine test_local - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling local_move' - call local_move_init(.false.) - call local_move(24,29,20d0,50d0) - call chainbuild - call write_pdb(3,'third structure',etot) - - write(iout,*) 'calling sc_move' - call sc_move(24,29,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'last structure',etot) - - - return - end - - subroutine test_sc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling sc_move 2nd time' - - call sc_move(nnt,nct,5,1d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(3,'last structure',etot) - return - end -c-------------------------------------------------------- - subroutine bgrow(bstrand,nbstrand,in,ind,new) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - integer bstrand(maxres/3,6) - - ishift=iabs(bstrand(in,ind+4)-new) - - print *,'bgrow',bstrand(in,ind+4),new,ishift - - bstrand(in,ind)=new - - if(ind.eq.1)then - bstrand(nbstrand,5)=bstrand(nbstrand,1) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,5).lt.bstrand(i,6)) then - bstrand(i,5)=bstrand(i,5)-ishift - else - bstrand(i,5)=bstrand(i,5)+ishift - endif - ENDIF - enddo - else - bstrand(nbstrand,6)=bstrand(nbstrand,2) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,6).lt.bstrand(i,5)) then - bstrand(i,6)=bstrand(i,6)-ishift - else - bstrand(i,6)=bstrand(i,6)+ishift - endif - ENDIF - enddo - endif - - - return - end - - -c------------------------------------------ - subroutine test11 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' -c - include 'COMMON.DISTFIT' - integer if(20,maxres),nif,ifa(20) - integer ibc(0:maxres,0:maxres),istrand(20) - integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 - integer itmp(20,maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar),vorg(maxvar) -c - logical debug,ltest,usedbfrag(maxres/3) - character*50 linia -c - integer betasheet(maxres),ibetasheet(maxres),nbetasheet - integer bstrand(maxres/3,6),nbstrand - -c------------------------ - - debug=.true. -c------------------------ - nbstrand=0 - nbetasheet=0 - do i=1,nres - betasheet(i)=0 - ibetasheet(i)=0 - enddo - call geom_to_var(nvar,vorg) - call secondary2(debug) - - if (nbfrag.le.1) return - - do i=1,nbfrag - usedbfrag(i)=.false. - enddo - - - nbetasheet=nbetasheet+1 - nbstrand=2 - bstrand(1,1)=bfrag(1,1) - bstrand(1,2)=bfrag(2,1) - bstrand(1,3)=nbetasheet - bstrand(1,4)=1 - bstrand(1,5)=bfrag(1,1) - bstrand(1,6)=bfrag(2,1) - do i=bfrag(1,1),bfrag(2,1) - betasheet(i)=nbetasheet - ibetasheet(i)=1 - enddo -c - bstrand(2,1)=bfrag(3,1) - bstrand(2,2)=bfrag(4,1) - bstrand(2,3)=nbetasheet - bstrand(2,5)=bfrag(3,1) - bstrand(2,6)=bfrag(4,1) - - if (bfrag(3,1).le.bfrag(4,1)) then - bstrand(2,4)=2 - do i=bfrag(3,1),bfrag(4,1) - betasheet(i)=nbetasheet - ibetasheet(i)=2 - enddo - else - bstrand(2,4)=-2 - do i=bfrag(4,1),bfrag(3,1) - betasheet(i)=nbetasheet - ibetasheet(i)=2 - enddo - endif - - iused_nbfrag=1 - - do while (iused_nbfrag.ne.nbfrag) - - do j=2,nbfrag - - IF (.not.usedbfrag(j)) THEN - - write (*,*) j,(bfrag(i,j),i=1,4) - do jk=6,1,-1 - write (*,'(i4,a3,10i4)') jk,'B',(bstrand(i,jk),i=1,nbstrand) - enddo - write (*,*) '------------------' - - - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - if(betasheet(i).eq.nbetasheet) then - in=ibetasheet(i) - do k=bfrag(3,j),bfrag(4,j) - betasheet(k)=nbetasheet - ibetasheet(k)=in - enddo - nbstrand=nbstrand+1 - usedbfrag(j)=.true. - iused_nbfrag=iused_nbfrag+1 - do k=bfrag(1,j),bfrag(2,j) - betasheet(k)=nbetasheet - ibetasheet(k)=nbstrand - enddo - if (bstrand(in,4).lt.0) then - bstrand(nbstrand,1)=bfrag(2,j) - bstrand(nbstrand,2)=bfrag(1,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=-nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).lt.bfrag(4,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(4,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)+ - & (bstrand(in,5)-bfrag(4,j)) - endif - if(bstrand(in,2).gt.bfrag(3,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(3,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)- - & (-bstrand(in,6)+bfrag(3,j)) - endif - else - bstrand(nbstrand,1)=bfrag(1,j) - bstrand(nbstrand,2)=bfrag(2,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).gt.bfrag(3,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(3,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)- - & (-bstrand(in,5)+bfrag(3,j)) - endif - if(bstrand(in,2).lt.bfrag(4,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(4,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)+ - & (bstrand(in,6)-bfrag(4,j)) - endif - endif - goto 11 - endif - if(betasheet(bfrag(1,j)+i-bfrag(3,j)).eq.nbetasheet) then - in=ibetasheet(bfrag(1,j)+i-bfrag(3,j)) - do k=bfrag(1,j),bfrag(2,j) - betasheet(k)=nbetasheet - ibetasheet(k)=in - enddo - nbstrand=nbstrand+1 - usedbfrag(j)=.true. - iused_nbfrag=iused_nbfrag+1 - do k=bfrag(3,1),bfrag(4,1) - betasheet(k)=nbetasheet - ibetasheet(k)=nbstrand - enddo - if (bstrand(in,4).lt.0) then - bstrand(nbstrand,1)=bfrag(4,j) - bstrand(nbstrand,2)=bfrag(3,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=-nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).lt.bfrag(2,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(2,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)+ - & (bstrand(in,5)-bfrag(2,j)) - endif - if(bstrand(in,2).gt.bfrag(1,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(1,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)- - & (-bstrand(in,6)+bfrag(1,j)) - endif - else - bstrand(nbstrand,1)=bfrag(3,j) - bstrand(nbstrand,2)=bfrag(4,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).gt.bfrag(1,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(1,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)- - & (-bstrand(in,5)+bfrag(1,j)) - endif - if(bstrand(in,2).lt.bfrag(2,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(2,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)+ - & (bstrand(in,6)-bfrag(2,j)) - endif - endif - goto 11 - endif - enddo - else - do i=bfrag(4,j),bfrag(3,j) - if(betasheet(i).eq.nbetasheet) then - in=ibetasheet(i) - do k=bfrag(4,j),bfrag(3,j) - betasheet(k)=nbetasheet - ibetasheet(k)=in - enddo - nbstrand=nbstrand+1 - usedbfrag(j)=.true. - iused_nbfrag=iused_nbfrag+1 - do k=bfrag(1,j),bfrag(2,j) - betasheet(k)=nbetasheet - ibetasheet(k)=nbstrand - enddo - if (bstrand(in,4).lt.0) then - bstrand(nbstrand,1)=bfrag(1,j) - bstrand(nbstrand,2)=bfrag(2,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).lt.bfrag(3,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(3,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)- - & (bstrand(in,5)-bfrag(3,j)) - endif - if(bstrand(in,2).gt.bfrag(4,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(4,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)+ - & (-bstrand(in,6)+bfrag(4,j)) - endif - else - bstrand(nbstrand,1)=bfrag(2,j) - bstrand(nbstrand,2)=bfrag(1,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=-nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).gt.bfrag(4,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(4,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)+ - & (-bstrand(in,5)+bfrag(4,j)) - endif - if(bstrand(in,2).lt.bfrag(3,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(3,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)- - & (bstrand(in,6)-bfrag(3,j)) - endif - endif - goto 11 - endif - if(betasheet(bfrag(2,j)-i+bfrag(4,j)).eq.nbetasheet) then - in=ibetasheet(bfrag(2,j)-i+bfrag(4,j)) - do k=bfrag(1,j),bfrag(2,j) - betasheet(k)=nbetasheet - ibetasheet(k)=in - enddo - nbstrand=nbstrand+1 - usedbfrag(j)=.true. - iused_nbfrag=iused_nbfrag+1 - do k=bfrag(4,j),bfrag(3,j) - betasheet(k)=nbetasheet - ibetasheet(k)=nbstrand - enddo - if (bstrand(in,4).lt.0) then - bstrand(nbstrand,1)=bfrag(4,j) - bstrand(nbstrand,2)=bfrag(3,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).lt.bfrag(2,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(2,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)- - & (bstrand(in,5)-bfrag(2,j)) - endif - if(bstrand(in,2).gt.bfrag(1,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(1,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)+ - & (-bstrand(in,6)+bfrag(1,j)) - endif - else - bstrand(nbstrand,1)=bfrag(3,j) - bstrand(nbstrand,2)=bfrag(4,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,4)=-nbstrand - bstrand(nbstrand,5)=bstrand(nbstrand,1) - bstrand(nbstrand,6)=bstrand(nbstrand,2) - if(bstrand(in,1).gt.bfrag(1,j)) then - call bgrow(bstrand,nbstrand,in,1,bfrag(1,j)) - else - bstrand(nbstrand,5)=bstrand(nbstrand,5)+ - & (-bstrand(in,5)+bfrag(1,j)) - endif - if(bstrand(in,2).lt.bfrag(2,j)) then - call bgrow(bstrand,nbstrand,in,2,bfrag(2,j)) - else - bstrand(nbstrand,6)=bstrand(nbstrand,6)- - & (bstrand(in,6)-bfrag(2,j)) - endif - endif - goto 11 - endif - enddo - endif - - - - ENDIF - enddo - - j=2 - do while (usedbfrag(j)) - j=j+1 - enddo - - nbstrand=nbstrand+1 - nbetasheet=nbetasheet+1 - bstrand(nbstrand,1)=bfrag(1,j) - bstrand(nbstrand,2)=bfrag(2,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,5)=bfrag(1,j) - bstrand(nbstrand,6)=bfrag(2,j) - - bstrand(nbstrand,4)=nbstrand - do i=bfrag(1,j),bfrag(2,j) - betasheet(i)=nbetasheet - ibetasheet(i)=nbstrand - enddo -c - nbstrand=nbstrand+1 - bstrand(nbstrand,1)=bfrag(3,j) - bstrand(nbstrand,2)=bfrag(4,j) - bstrand(nbstrand,3)=nbetasheet - bstrand(nbstrand,5)=bfrag(3,j) - bstrand(nbstrand,6)=bfrag(4,j) - - if (bfrag(3,j).le.bfrag(4,j)) then - bstrand(nbstrand,4)=nbstrand - do i=bfrag(3,j),bfrag(4,j) - betasheet(i)=nbetasheet - ibetasheet(i)=nbstrand - enddo - else - bstrand(nbstrand,4)=-nbstrand - do i=bfrag(4,j),bfrag(3,j) - betasheet(i)=nbetasheet - ibetasheet(i)=nbstrand - enddo - endif - - iused_nbfrag=iused_nbfrag+1 - usedbfrag(j)=.true. - - - 11 continue - do jk=6,1,-1 - write (*,'(i4,a3,10i4)') jk,'A',(bstrand(i,jk),i=1,nbstrand) - enddo - - - enddo - - do i=1,nres - if (betasheet(i).ne.0) write(*,*) i,betasheet(i),ibetasheet(i) - enddo - write(*,*) - do j=6,1,-1 - write (*,'(i4,a3,10i4)') j,':',(bstrand(i,j),i=1,nbstrand) - enddo - -c------------------------ - nifb=0 - do i=1,nbstrand - do j=i+1,nbstrand - if(iabs(bstrand(i,5)-bstrand(j,5)).le.5 .or. - & iabs(bstrand(i,6)-bstrand(j,6)).le.5 ) then - nifb=nifb+1 - ifb(nifb,1)=bstrand(i,4) - ifb(nifb,2)=bstrand(j,4) - endif - enddo - enddo - - write(*,*) - do i=1,nifb - write (*,'(a3,20i4)') "ifb",i,ifb(i,1),ifb(i,2) - enddo - - do i=1,nbstrand - ifa(i)=bstrand(i,4) - enddo - write (*,'(a3,20i4)') "ifa",(ifa(i),i=1,nbstrand) - - nif=iabs(bstrand(1,6)-bstrand(1,5))+1 - do j=2,nbstrand - if (iabs(bstrand(j,6)-bstrand(j,5))+1.gt.nif) - & nif=iabs(bstrand(j,6)-bstrand(j,5))+1 - enddo - - write(*,*) nif - do i=1,nif - do j=1,nbstrand - if(j,i)=bstrand(j,6)+(i-1)*sign(1,bstrand(j,5)-bstrand(j,6)) - if (if(j,i).gt.0) then - if(betasheet(if(j,i)).eq.0 .or. - & ibetasheet(if(j,i)).ne.iabs(bstrand(j,4))) if(j,i)=0 - else - if(j,i)=0 - endif - enddo - write(*,'(a3,10i4)') 'if ',(if(j,i),j=1,nbstrand) - enddo - -c read (inp,*) (ifa(i),i=1,4) -c do i=1,nres -c read (inp,*,err=20,end=20) (if(j,i),j=1,4) -c enddo -c 20 nif=i-1 - stop -c------------------------ - - isa=4 - is=2*isa-1 - iconf=0 -cccccccccccccccccccccccccccccccccc - DO ig=1,is**isa-1 -cccccccccccccccccccccccccccccccccc - - ii=ig - do j=1,is - istrand(is-j+1)=int(ii/is**(is-j)) - ii=ii-istrand(is-j+1)*is**(is-j) - enddo - ltest=.true. - do k=1,isa - istrand(k)=istrand(k)+1 - if(istrand(k).gt.isa) istrand(k)=istrand(k)-2*isa-1 - enddo - do k=1,isa - do l=1,isa - if(istrand(k).eq.istrand(l).and.k.ne.l.or. - & istrand(k).eq.-istrand(l).and.k.ne.l) ltest=.false. - enddo - enddo - - lifb0=1 - do m=1,nifb - lifb(m)=0 - do k=1,isa-1 - if( - & ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or. - & ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or. - & -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or. - & -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1)) - & lifb(m)=1 - enddo - lifb0=lifb0*lifb(m) - enddo - - if (mod(isa,2).eq.0) then - do k=isa/2+1,isa - if (istrand(k).eq.1) ltest=.false. - enddo - else - do k=(isa+1)/2+1,isa - if (istrand(k).eq.1) ltest=.false. - enddo - endif - - IF (ltest.and.lifb0.eq.1) THEN - iconf=iconf+1 - - call var_to_geom(nvar,vorg) - - write (*,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa) - write (iout,'(i5,i10,10i3)') iconf,ig,(istrand(k),k=1,isa) - write (linia,'(10i3)') (istrand(k),k=1,isa) - - do i=1,nres - do j=1,nres - ibc(i,j)=0 - enddo - enddo - - - do i=1,4 - if ( sign(1,istrand(i)).eq.sign(1,ifa(iabs(istrand(i)))) ) then - do j=1,nif - itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),j) - enddo - else - do j=1,nif - itmp(iabs(istrand(i)),j)=if(iabs(ifa(iabs(istrand(i)))),nif-j+1) - enddo - endif - enddo - - do i=1,nif - write(*,*) (itmp(j,i),j=1,4) - enddo - - do i=1,nif -c ifa(1),ifa(2),ifa(3),ifa(4) -c if(1,i),if(2,i),if(3,i),if(4,i) - do k=1,isa-1 - ltest=.false. - do m=1,nifb - if( - & ifb(m,1).eq.istrand(k).and.ifb(m,2).eq.istrand(k+1).or. - & ifb(m,2).eq.istrand(k).and.ifb(m,1).eq.istrand(k+1).or. - & -ifb(m,1).eq.istrand(k).and.-ifb(m,2).eq.istrand(k+1).or. - & -ifb(m,2).eq.istrand(k).and.-ifb(m,1).eq.istrand(k+1)) - & then - ltest=.true. - goto 110 - endif - enddo - 110 continue - if (ltest) then - ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-1 - else - ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+1)),i))=-2 - endif -c - if (k.lt.3) - & ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+2)),i))=-3 - if (k.lt.2) - & ibc(itmp(iabs(istrand(k)),i),itmp(iabs(istrand(k+3)),i))=-4 - enddo - enddo -c------------------------ - -c -c freeze sec.elements -c - do i=1,nres - mask(i)=1 - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - enddo - mask_r=.true. - -c------------------------ -c generate constrains -c - nhpb0=nhpb - call chainbuild - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( ibc(i,j).eq.-1 .or. ibc(j,i).eq.-1) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(i,j).eq.-2 .or. ibc(j,i).eq.-2) then - d0(ind)=5.0 - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(i,j).eq.-3 .or. ibc(j,i).eq.-3) then - d0(ind)=11.0 - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(i,j).eq.-4 .or. ibc(j,i).eq.-4) then - d0(ind)=16.0 - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(i,j).gt.0 ) then - d0(ind)=DIST(i,ibc(i,j)) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(j,i).gt.0 ) then - d0(ind)=DIST(ibc(j,i),j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - dd(ind)=d0(ind) - enddo - enddo - call hpb_partition -cd-------------------------- - - write(iout,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)), - & ibc(jhpb(i),ihpb(i)),' --', - & ihpb(i),jhpb(i),dhpb(i),i=1,nhpb) - -cd nhpb=0 -cd goto 901 -c -c - call contact_cp_min(varia,ifun,iconf,linia,debug) - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ifun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - write (linia,'(a10,10i3)') 'full_min',(istrand(k),k=1,isa) - call var_to_geom(nvar,varia) - call chainbuild - call write_pdb(900+iconf,linia,etot) - endif - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) -cd call intout -cd call briefout(0,etot) -cd call secondary2(.true.) - - 901 CONTINUE -ctest return -cccccccccccccccccccccccccccccccccccc - ENDIF - ENDDO -cccccccccccccccccccccccccccccccccccc - - return - 10 write (iout,'(a)') 'Error reading test structure.' - return - end -c-------------------------------------------------------- - - subroutine test3 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' -c - include 'COMMON.DISTFIT' - integer if(3,maxres),nif - integer ibc(maxres,maxres),istrand(20) - integer ibd(maxres),ifb(10,2),nifb,lifb(10),lifb0 - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - logical debug,ltest - character*50 linia -c - do i=1,nres - read (inp,*,err=20,end=20) if(1,i),if(2,i),if(3,i) - enddo - 20 nif=i-1 - write (*,'(a4,3i5)') ('if =',if(1,i),if(2,i),if(3,i), - & i=1,nif) - - -c------------------------ - call secondary2(debug) -c------------------------ - do i=1,nres - do j=1,nres - ibc(i,j)=0 - enddo - enddo - -c -c freeze sec.elements and store indexes for beta constrains -c - do i=1,nres - mask(i)=1 - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - ibc(bfrag(1,j)+i-bfrag(3,j),i)=-1 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - ibc(bfrag(2,j)-i+bfrag(4,j),i)=-1 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - enddo - mask_r=.true. - - -c ---------------- test -------------- - do i=1,nif - if (ibc(if(1,i),if(2,i)).eq.-1) then - ibc(if(1,i),if(2,i))=if(3,i) - ibc(if(1,i),if(3,i))=if(2,i) - else if (ibc(if(2,i),if(1,i)).eq.-1) then - ibc(if(2,i),if(1,i))=0 - ibc(if(1,i),if(2,i))=if(3,i) - ibc(if(1,i),if(3,i))=if(2,i) - else - ibc(if(1,i),if(2,i))=if(3,i) - ibc(if(1,i),if(3,i))=if(2,i) - endif - enddo - - do i=1,nres - do j=1,nres - if (ibc(i,j).ne.0) write(*,'(3i5)') i,j,ibc(i,j) - enddo - enddo -c------------------------ - call chainbuild - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( ibc(i,j).eq.-1 ) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(i,j).gt.0 ) then - d0(ind)=DIST(i,ibc(i,j)) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else if ( ibc(j,i).gt.0 ) then - d0(ind)=DIST(ibc(j,i),j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - enddo - enddo - call hpb_partition - -cd-------------------------- - write(*,'(i3,2i4,a3,2i4,f7.2)') (i,ibc(ihpb(i),jhpb(i)), - & ibc(jhpb(i),ihpb(i)),' --', - & ihpb(i),jhpb(i),dhpb(i),i=1,nhpb) - - - linia='dist' - debug=.true. - in_pdb=7 -c - call contact_cp_min(varia,ieval,in_pdb,linia,debug) - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,varia) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - call secondary2(.true.) - - return - 10 write (iout,'(a)') 'Error reading test structure.' - return - end - - - - - subroutine test__ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' -c - include 'COMMON.DISTFIT' - integer if(2,2),ind - integer iff(maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision theta2(maxres),phi2(maxres),alph2(maxres), - & omeg2(maxres), - & theta1(maxres),phi1(maxres),alph1(maxres), - & omeg1(maxres) - double precision varia(maxvar),varia2(maxvar) -c - - - read (inp,*,err=10,end=10) if(1,1),if(1,2),if(2,1),if(2,2) - write (iout,'(a4,4i5)') 'if =',if(1,1),if(1,2),if(2,1),if(2,2) - read (inp,*,err=10,end=10) (theta2(i),i=3,nres) - read (inp,*,err=10,end=10) (phi2(i),i=4,nres) - read (inp,*,err=10,end=10) (alph2(i),i=2,nres-1) - read (inp,*,err=10,end=10) (omeg2(i),i=2,nres-1) - do i=1,nres - theta2(i)=deg2rad*theta2(i) - phi2(i)=deg2rad*phi2(i) - alph2(i)=deg2rad*alph2(i) - omeg2(i)=deg2rad*omeg2(i) - enddo - do i=1,nres - theta1(i)=theta(i) - phi1(i)=phi(i) - alph1(i)=alph(i) - omeg1(i)=omeg(i) - enddo - - do i=1,nres - mask(i)=1 - enddo - - -c------------------------ - do i=1,nres - iff(i)=0 - enddo - do j=1,2 - do i=if(j,1),if(j,2) - iff(i)=1 - enddo - enddo - - call chainbuild - call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call secondary(.true.) - - call secondary2(.true.) - - do j=1,nbfrag - if ( (bfrag(3,j).lt.bfrag(4,j) .or. - & bfrag(4,j)-bfrag(2,j).gt.4) .and. - & bfrag(2,j)-bfrag(1,j).gt.3 ) then - nn=nn+1 - - if (bfrag(3,j).lt.bfrag(4,j)) then - write(iout,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(3,j)-1,"-",bfrag(4,j)-1 - else - write(iout,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "select",bfrag(1,j)-1,"-",bfrag(2,j)-1 - & ,",",bfrag(4,j)-1,"-",bfrag(3,j)-1 - endif - endif - enddo - - do i=1,nres - theta(i)=theta2(i) - phi(i)=phi2(i) - alph(i)=alph2(i) - omeg(i)=omeg2(i) - enddo - - call chainbuild - call geom_to_var(nvar,varia2) - call write_pdb(2,'second structure',0d0) - - - -c------------------------------------------------------- - - ifun=-1 - call contact_cp(varia,varia2,iff,ifun,7) - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ifun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,varia) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - - return - 10 write (iout,'(a)') 'Error reading test structure.' - return - end - -c------------------------------------------------- -c------------------------------------------------- - - subroutine secondary(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) - logical lprint,not_done - real dcont(maxres*maxres/2),d - real rcomp /7.0/ - real rbeta /5.2/ - real ralfa /5.2/ - real r310 /6.6/ - double precision xpi(3),xpj(3) - - - - call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - isec(i,3)=0 - enddo - - do i=2,nres-3 - do k=1,3 - xpi(k)=0.5d0*(c(k,i-1)+c(k,i)) - enddo - do j=i+2,nres - do k=1,3 - xpj(k)=0.5d0*(c(k,j-1)+c(k,j)) - enddo -cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) + -cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) + -cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j)) -cd print *,'CA',i,j,d - d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) + - & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) + - & (xpi(3)-xpj(3))*(xpi(3)-xpj(3)) - if ( d.lt.rcomp*rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - dcont(ncont)=sqrt(d) - endif - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,'(a)') '#PP contact map distances:' - do i=1,ncont - write (iout,'(3i4,f10.5)') - & i,icont(1,i),icont(2,i),dcont(i) - enddo - endif - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) - & .and. dcont(j).le.rbeta .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=j1 - - do ij=ii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - do ij=jj1,j1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (dcont(i).le.rbeta.and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & .and. dcont(j).le.rbeta ) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - if(lprint)write (iout,*)'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=max0(ii1-1,1) - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=max0(j1-1,1) - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - - if (lprint) then - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+3.and.dcont(i).le.r310 - & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i) -cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i) - ii1=i1 - jj1=j1 - if (isec(ii1,1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - if (j1-ii1.gt.4) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=max0(j1-1,1) - - do ij=ii1,j1 - isec(ij,1)=-1 - enddo - if (lprint) then - write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - endif - - - return - end -c---------------------------------------------------------------------------- - - subroutine write_pdb(npdb,titelloc,ee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*50 titelloc1 - character*(*) titelloc - character*3 zahl - character*5 liczba5 - double precision ee - integer npdb,ilen - external ilen - - titelloc1=titelloc - lenpre=ilen(prefix) - if (npdb.lt.1000) then - call numstr(npdb,zahl) - open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb') - else - if (npdb.lt.10000) then - write(liczba5,'(i1,i4)') 0,npdb - else - write(liczba5,'(i5)') npdb - endif - open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb') - endif - call pdbout(ee,titelloc1,ipdb) - close(ipdb) - return - end - -c----------------------------------------------------------- - subroutine contact_cp2(var,var2,iff,ieval,in_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - - character*50 linia - integer nf,ij(4) - double precision var(maxvar),var2(maxvar) - double precision time0,time1 - integer iff(maxres),ieval - double precision theta1(maxres),phi1(maxres),alph1(maxres), - & omeg1(maxres) - - - call var_to_geom(nvar,var) - call chainbuild - nhpb0=nhpb - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - enddo - enddo - call hpb_partition - - do i=1,nres - theta1(i)=theta(i) - phi1(i)=phi(i) - alph1(i)=alph(i) - omeg1(i)=omeg(i) - enddo - - call var_to_geom(nvar,var2) - - do i=1,nres - if ( iff(i).eq.1 ) then - theta(i)=theta1(i) - phi(i)=phi1(i) - alph(i)=alph1(i) - omeg(i)=omeg1(i) - endif - enddo - - call chainbuild - - NX=NRES-3 - NY=((NRES-4)*(NRES-5))/2 - call distfit(.true.,200) - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - - ipot=6 - maxmin=2000 - maxfun=5000 - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun - - call var_to_geom(nvar,var) - call chainbuild - - - iwsk=0 - nf=0 - if (iff(1).eq.1) then - iwsk=1 - nf=nf+1 - ij(nf)=0 - endif - do i=2,nres - if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then - iwsk=1 - nf=nf+1 - ij(nf)=i - endif - if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then - iwsk=0 - nf=nf+1 - ij(nf)=i-1 - endif - enddo - if (iff(nres).eq.1) then - nf=nf+1 - ij(nf)=nres - endif - - -cd write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') -cd & "select",ij(1),"-",ij(2), -cd & ",",ij(3),"-",ij(4) -cd call write_pdb(in_pdb,linia,etot) - - - ipot=ipot0 - maxmin=maxmin0 - maxfun=maxfun0 - call minimize(etot,var,iretcode,nfun) - ieval=nfun - - nhpb= nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - - return - end -c----------------------------------------------------------- - subroutine contact_cp(var,var2,iff,ieval,in_pdb) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - - character*50 linia - integer nf,ij(4) - double precision energy(0:n_ene) - double precision var(maxvar),var2(maxvar) - double precision time0,time1 - integer iff(maxres),ieval - double precision theta1(maxres),phi1(maxres),alph1(maxres), - & omeg1(maxres) - logical debug - - debug=.false. -c debug=.true. - if (ieval.eq.-1) debug=.true. - - -c -c store selected dist. constrains from 1st structure -c -#ifdef OSF -c Intercept NaNs in the coordinates -c write(iout,*) (var(i),i=1,nvar) - x_sum=0.D0 - do i=1,nvar - x_sum=x_sum+var(i) - enddo - if (x_sum.ne.x_sum) then - write(iout,*)" *** contact_cp : Found NaN in coordinates" - call flush(iout) - print *," *** contact_cp : Found NaN in coordinates" - return - endif -#endif - - - call var_to_geom(nvar,var) - call chainbuild - nhpb0=nhpb - ind=0 - do i=1,nres-3 - do j=i+3,nres - ind=ind+1 - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - d0(ind)=DIST(i,j) - w(ind)=10.0 - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=10.0 - dhpb(nhpb)=d0(ind) - else - w(ind)=0.0 - endif - enddo - enddo - call hpb_partition - - do i=1,nres - theta1(i)=theta(i) - phi1(i)=phi(i) - alph1(i)=alph(i) - omeg1(i)=omeg(i) - enddo - -c -c freeze sec.elements from 2nd structure -c - do i=1,nres - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - enddo - - call var_to_geom(nvar,var2) - call secondary2(debug) - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask(i)=0 - mask_phi(i)=0 - mask_theta(i)=0 - enddo - enddo - mask_r=.true. - -c -c copy selected res from 1st to 2nd structure -c - - do i=1,nres - if ( iff(i).eq.1 ) then - theta(i)=theta1(i) - phi(i)=phi1(i) - alph(i)=alph1(i) - omeg(i)=omeg1(i) - endif - enddo - - if(debug) then -c -c prepare description in linia variable -c - iwsk=0 - nf=0 - if (iff(1).eq.1) then - iwsk=1 - nf=nf+1 - ij(nf)=1 - endif - do i=2,nres - if ( iwsk.eq.0.and.iff(i-1).eq.0.and.iff(i).eq.1 ) then - iwsk=1 - nf=nf+1 - ij(nf)=i - endif - if ( iwsk.eq.1.and.iff(i-1).eq.1.and.iff(i).eq.0 ) then - iwsk=0 - nf=nf+1 - ij(nf)=i-1 - endif - enddo - if (iff(nres).eq.1) then - nf=nf+1 - ij(nf)=nres - endif - - write(linia,'(a6,i3,a1,i3,a1,i3,a1,i3)') - & "SELECT",ij(1)-1,"-",ij(2)-1, - & ",",ij(3)-1,"-",ij(4)-1 - - endif -c -c run optimization -c - call contact_cp_min(var,ieval,in_pdb,linia,debug) - - return - end - - subroutine contact_cp_min(var,ieval,in_pdb,linia,debug) -c -c input : theta,phi,alph,omeg,in_pdb,linia,debug -c output : var,ieval -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - - character*50 linia - integer nf,ij(4) - double precision energy(0:n_ene) - double precision var(maxvar) - double precision time0,time1 - integer ieval,info(3) - logical debug,fail,check_var,reduce,change - - write(iout,'(a20,i6,a20)') - & '------------------',in_pdb,'-------------------' - - if (debug) then - call chainbuild - call write_pdb(1000+in_pdb,'combined structure',0d0) -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - endif - -c -c run optimization of distances -c -c uses d0(),w() and mask() for frozen 2D -c -ctest--------------------------------------------- -ctest NX=NRES-3 -ctest NY=((NRES-4)*(NRES-5))/2 -ctest call distfit(debug,5000) - - do i=1,nres - mask_side(i)=0 - enddo - - ipot01=ipot - maxmin01=maxmin - maxfun01=maxfun -c wstrain01=wstrain - wsc01=wsc - wscp01=wscp - welec01=welec - wvdwpp01=wvdwpp -c wang01=wang - wscloc01=wscloc - wtor01=wtor - wtor_d01=wtor_d - - ipot=6 - maxmin=2000 - maxfun=4000 -c wstrain=1.0 - wsc=0.0 - wscp=0.0 - welec=0.0 - wvdwpp=0.0 -c wang=0.0 - wscloc=0.0 - wtor=0.0 - wtor_d=0.0 - - call geom_to_var(nvar,var) -cde change=reduce(var) - if (check_var(var,info)) then - write(iout,*) 'cp_min error in input' - print *,'cp_min error in input' - return - endif - -cd call etotal(energy(0)) -cd call enerprint(energy(0)) -cd call check_eint - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif -cdtest call minimize(etot,var,iretcode,nfun) -cdtest write(iout,*)'SUMSL return code is',iretcode,' eval SDIST',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - -cd call etotal(energy(0)) -cd call enerprint(energy(0)) -cd call check_eint - - do i=1,nres - mask_side(i)=1 - enddo - - ipot=ipot01 - maxmin=maxmin01 - maxfun=maxfun01 -c wstrain=wstrain01 - wsc=wsc01 - wscp=wscp01 - welec=welec01 - wvdwpp=wvdwpp01 -c wang=wang01 - wscloc=wscloc01 - wtor=wtor01 - wtor_d=wtor_d01 -ctest-------------------------------------------------- - - if(debug) then -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,a)')' Time for distfit ',time1-time0,' sec' - call write_pdb(2000+in_pdb,'distfit structure',0d0) - endif - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain -c -c run soft pot. optimization -c with constrains: -c nhpb,ihpb(),jhpb(),forcon(),dhpb() and hpb_partition -c and frozen 2D: -c mask_phi(),mask_theta(),mask_side(),mask_r -c - ipot=6 - maxmin=2000 - maxfun=4000 - -cde change=reduce(var) -cde if (check_var(var,info)) write(iout,*) 'error before soft' -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, - & nfun/(time1-time0),' SOFT eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(3000+in_pdb,'soft structure',etot) - endif -c -c run full UNRES optimization with constrains and frozen 2D -c the same variables as soft pot. optimizatio -c - ipot=ipot0 - maxmin=maxmin0 - maxfun=maxfun0 -c -c check overlaps before calling full UNRES minim -c - call var_to_geom(nvar,var) - call chainbuild - call etotal(energy(0)) -#ifdef OSF - write(iout,*) 'N7 ',energy(0) - if (energy(0).ne.energy(0)) then - write(iout,*) 'N7 error - gives NaN',energy(0) - endif -#endif - ieval=1 - if (energy(1).eq.1.0d20) then - write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw=1d20',energy(1) - call overlap_sc(fail) - if(.not.fail) then - call etotal(energy(0)) - ieval=ieval+1 - write (iout,'(a,1pe14.5)')'#N7_OVERLAP evdw after',energy(1) - else - mask_r=.false. - nhpb= nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - return - endif - endif - call flush(iout) -c -cdte time0=MPI_WTIME() -cde change=reduce(var) -cde if (check_var(var,info)) then -cde write(iout,*) 'error before mask dist' -cde call var_to_geom(nvar,var) -cde call chainbuild -cde call write_pdb(10000+in_pdb,'before mask dist',etot) -cde endif -cdte call minimize(etot,var,iretcode,nfun) -cdte write(iout,*)'SUMSL MASK DIST return code is',iretcode, -cdte & ' eval ',nfun -cdte ieval=ieval+nfun -cdte -cdte time1=MPI_WTIME() -cdte write (iout,'(a,f6.2,f8.2,a)') -cdte & ' Time for mask dist min.',time1-time0, -cdte & nfun/(time1-time0),' eval/s' -cdte call flush(iout) - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(4000+in_pdb,'mask dist',etot) - endif -c -c switch off freezing of 2D and -c run full UNRES optimization with constrains -c - mask_r=.false. -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif -cde change=reduce(var) -cde if (check_var(var,info)) then -cde write(iout,*) 'error before dist' -cde call var_to_geom(nvar,var) -cde call chainbuild -cde call write_pdb(11000+in_pdb,'before dist',etot) -cde endif - - call minimize(etot,var,iretcode,nfun) - -cde change=reduce(var) -cde if (check_var(var,info)) then -cde write(iout,*) 'error after dist',ico -cde call var_to_geom(nvar,var) -cde call chainbuild -cde call write_pdb(12000+in_pdb+ico*1000,'after dist',etot) -cde endif - write(iout,*)'SUMSL DIST return code is',iretcode,' eval ',nfun - ieval=ieval+nfun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' -cde call etotal(energy(0)) -cde write(iout,*) 'N7 after dist',energy(0) - call flush(iout) - - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(in_pdb,linia,etot) - endif -c -c reset constrains -c - nhpb= nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - - return - end -c-------------------------------------------------------- - subroutine softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.INTERACT' -c - include 'COMMON.DISTFIT' - integer iff(maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - integer ieval -c - logical debug,ltest,fail - character*50 linia -c - linia='test' - debug=.true. - in_pdb=0 - - - -c------------------------ -c -c freeze sec.elements -c - do i=1,nres - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - iff(i)=0 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - enddo - mask_r=.true. - - - - nhpb0=nhpb -c -c store dist. constrains -c - do i=1,nres-3 - do j=i+3,nres - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=0.1 - dhpb(nhpb)=DIST(i,j) - endif - enddo - enddo - call hpb_partition - - if (debug) then - call chainbuild - call write_pdb(100+in_pdb,'input reg. structure',0d0) - endif - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - wang0=wang -c -c run soft pot. optimization -c - ipot=6 - wang=3.0 - maxmin=2000 - maxfun=4000 - call geom_to_var(nvar,var) -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, - & nfun/(time1-time0),' SOFT eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(300+in_pdb,'soft structure',etot) - endif -c -c run full UNRES optimization with constrains and frozen 2D -c the same variables as soft pot. optimizatio -c - ipot=ipot0 - wang=wang0 - maxmin=maxmin0 - maxfun=maxfun0 -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK DIST return code is',iretcode, - & ' eval ',nfun - ieval=nfun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for mask dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(400+in_pdb,'mask & dist',etot) - endif -c -c switch off constrains and -c run full UNRES optimization with frozen 2D -c - -c -c reset constrains -c - nhpb_c=nhpb - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun - ieval=ieval+nfun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(500+in_pdb,'mask 2d frozen',etot) - endif - - mask_r=.false. - - -c -c run full UNRES optimization with constrains and NO frozen 2D -c - - nhpb=nhpb_c - link_start=1 - link_end=nhpb - maxfun=maxfun0/5 - - do ico=1,5 - - wstrain=wstrain0/ico - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=nfun - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(600+in_pdb+ico,'dist cons',etot) - endif - - enddo -c - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - maxfun=maxfun0 - - -c - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval - -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - return - end - - - subroutine beta_slide(i1,i2,i3,i4,i5,ieval,ij) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - integer jdata(5),isec(maxres) -c - jdata(1)=i1 - jdata(2)=i2 - jdata(3)=i3 - jdata(4)=i4 - jdata(5)=i5 - - call secondary2(.false.) - - do i=1,nres - isec(i)=0 - enddo - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - isec(i)=1 - enddo - do i=bfrag(4,j),bfrag(3,j),sign(1,bfrag(3,j)-bfrag(4,j)) - isec(i)=1 - enddo - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - isec(i)=2 - enddo - enddo - -c -c cut strands at the ends -c - if (jdata(2)-jdata(1).gt.3) then - jdata(1)=jdata(1)+1 - jdata(2)=jdata(2)-1 - if (jdata(3).lt.jdata(4)) then - jdata(3)=jdata(3)+1 - jdata(4)=jdata(4)-1 - else - jdata(3)=jdata(3)-1 - jdata(4)=jdata(4)+1 - endif - endif - -cv call chainbuild -cv call etotal(energy(0)) -cv etot=energy(0) -cv write(iout,*) nnt,nct,etot -cv call write_pdb(ij*100,'first structure',etot) -cv write(iout,*) 'N16 test',(jdata(i),i=1,5) - -c------------------------ -c generate constrains -c - ishift=jdata(5)-2 - if(ishift.eq.0) ishift=-2 - nhpb0=nhpb - call chainbuild - do i=jdata(1),jdata(2) - isec(i)=-1 - if(jdata(4).gt.jdata(3))then - do j=jdata(3)+i-jdata(1)-2,jdata(3)+i-jdata(1)+2 - isec(j)=-1 -cd print *,i,j,j+ishift - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=1000.0 - dhpb(nhpb)=DIST(i,j+ishift) - enddo - else - do j=jdata(3)-i+jdata(1)+2,jdata(3)-i+jdata(1)-2,-1 - isec(j)=-1 -cd print *,i,j,j+ishift - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=1000.0 - dhpb(nhpb)=DIST(i,j+ishift) - enddo - endif - enddo - - do i=nnt,nct-2 - do j=i+2,nct - if(isec(i).gt.0.or.isec(j).gt.0) then -cd print *,i,j - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=0.1 - dhpb(nhpb)=DIST(i,j) - endif - enddo - enddo - - call hpb_partition - - call geom_to_var(nvar,var) - maxfun0=maxfun - wstrain0=wstrain - maxfun=4000/5 - - do ico=1,5 - - wstrain=wstrain0/ico - - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=ieval+nfun - - enddo -c - nhpb=nhpb0 - call hpb_partition - wstrain=wstrain0 - maxfun=maxfun0 -c -cd print *,etot - wscloc0=wscloc - wscloc=10.0 - call sc_move(nnt,nct,100,100d0,nft_sc,etot) - wscloc=wscloc0 -cv call chainbuild -cv call etotal(energy(0)) -cv etot=energy(0) -cv call write_pdb(ij*100+10,'sc_move',etot) -cd call intout -cd print *,nft_sc,etot - - return - end - - subroutine beta_zip(i1,i2,ieval,ij) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - character*10 test - -cv call chainbuild -cv call etotal(energy(0)) -cv etot=energy(0) -cv write(test,'(2i5)') i1,i2 -cv call write_pdb(ij*100,test,etot) -cv write(iout,*) 'N17 test',i1,i2,etot,ij - -c -c generate constrains -c - nhpb0=nhpb - nhpb=nhpb+1 - ihpb(nhpb)=i1 - jhpb(nhpb)=i2 - forcon(nhpb)=1000.0 - dhpb(nhpb)=4.0 - - call hpb_partition - - call geom_to_var(nvar,var) - maxfun0=maxfun - wstrain0=wstrain - maxfun=1000/5 - - do ico=1,5 - wstrain=wstrain0/ico - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=ieval+nfun -c do not comment the next line - call var_to_geom(nvar,var) -cv call chainbuild -cv call write_pdb(ij*100+ico,'dist cons',etot) - enddo - - nhpb=nhpb0 - call hpb_partition - wstrain=wstrain0 - maxfun=maxfun0 - -cv call etotal(energy(0)) -cv etot=energy(0) -cv write(iout,*) 'N17 test end',i1,i2,etot,ij - - - return - end diff --git a/source/unres/src_CSA_DiL/timing.F b/source/unres/src_CSA_DiL/timing.F deleted file mode 100644 index 340ff3d..0000000 --- a/source/unres/src_CSA_DiL/timing.F +++ /dev/null @@ -1,340 +0,0 @@ -C $Date: 1994/10/05 16:41:52 $ -C $Revision: 2.2 $ -C -C -C - subroutine set_timers -c - implicit none - double precision tcpu - include 'COMMON.TIME1' -#ifdef MP - include 'mpif.h' -#endif -C Diminish the assigned time limit a little so that there is some time to -C end a batch job -c timlim=batime-150.0 -C Calculate the initial time, if it is not zero (e.g. for the SUN). - stime=tcpu() -#ifdef MPI - walltime=MPI_WTIME() - time_reduce=0.0d0 - time_allreduce=0.0d0 - time_bcast=0.0d0 - time_gather=0.0d0 - time_sendrecv=0.0d0 - time_scatter=0.0d0 - time_scatter_fmat=0.0d0 - time_scatter_ginv=0.0d0 - time_scatter_fmatmult=0.0d0 - time_scatter_ginvmult=0.0d0 - time_barrier_e=0.0d0 - time_barrier_g=0.0d0 - time_enecalc=0.0d0 - time_sumene=0.0d0 - time_lagrangian=0.0d0 - time_sumgradient=0.0d0 - time_intcartderiv=0.0d0 - time_inttocart=0.0d0 - time_ginvmult=0.0d0 - time_fricmatmult=0.0d0 - time_cartgrad=0.0d0 - time_bcastc=0.0d0 - time_bcast7=0.0d0 - time_bcastw=0.0d0 - time_intfcart=0.0d0 - time_vec=0.0d0 - time_mat=0.0d0 - time_fric=0.0d0 - time_stoch=0.0d0 - time_fricmatmult=0.0d0 - time_fsample=0.0d0 -#endif -cd print *,' in SET_TIMERS stime=',stime - return - end -C------------------------------------------------------------------------------ - logical function stopx(nf) -C This function returns .true. if one of the following reasons to exit SUMSL -C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: -C -C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false. -C... 1 - Time up in current node; -C... 2 - STOP signal was received from another node because the -C... node's task was accomplished (parallel only); -C... -1 - STOP signal was received from another node because of error; -C... -2 - STOP signal was received from another node, because -C... the node's time was up. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nf - logical ovrtim -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer Kwita - -cd print *,'Processor',MyID,' NF=',nf -#ifndef MPI - if (ovrtim()) then -C Finish if time is up. - stopx = .true. - WhatsUp=1 -#ifdef MPL - else if (mod(nf,100).eq.0) then -C Other processors might have finished. Check this every 100th function -C evaluation. -C Master checks if any other processor has sent accepted conformation(s) to it. - if (MyID.ne.MasterID) call receive_mcm_info - if (MyID.eq.MasterID) call receive_conf -cd print *,'Processor ',MyID,' is checking STOP: nf=',nf - call recv_stop_sig(Kwita) - if (Kwita.eq.-1) then - write (iout,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - write (*,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - stopx=.true. - WhatsUp=2 - elseif (Kwita.eq.-2) then - write (iout,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - WhatsUp=-2 - stopx=.true. - else if (Kwita.eq.-3) then - write (iout,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - WhatsUp=-1 - stopx=.true. - else - stopx=.false. - WhatsUp=0 - endif -#endif - else - stopx = .false. - WhatsUp=0 - endif -#else - stopx=.false. -#endif - -#ifdef OSF -c Check for FOUND_NAN flag - if (FOUND_NAN) then - write(iout,*)" *** stopx : Found a NaN" - stopx=.true. - endif -#endif - - return - end -C-------------------------------------------------------------------------- - logical function ovrtim() - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - real*8 tcpu -#ifdef MPI - include "mpif.h" - curtim = MPI_Wtime()-walltime -#else - curtim= tcpu() -#endif -C curtim is the current time in seconds. -c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety - if (curtim .ge. timlim - safety) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') - & "***************** Elapsed time (",curtim, - & " s) is within the safety limit (",safety, - & " s) of the allocated time (",timlim," s). Terminating." - ovrtim=.true. - else - ovrtim=.false. - endif - return - end -************************************************************************** - double precision function tcpu() - include 'COMMON.TIME1' -#ifdef ES9000 -**************************** -C Next definition for EAGLE (ibm-es9000) - real*8 micseconds - integer rcode - tcpu=cputime(micseconds,rcode) - tcpu=(micseconds/1.0E6) - stime -**************************** -#endif -#ifdef SUN -**************************** -C Next definitions for sun - REAL*8 ECPU,ETIME,ETCPU - dimension tarray(2) - tcpu=etime(tarray) - tcpu=tarray(1) -**************************** -#endif -#ifdef KSR -**************************** -C Next definitions for ksr -C this function uses the ksr timer ALL_SECONDS from the PMON library to -C return the elapsed time in seconds - tcpu= all_seconds() - stime -**************************** -#endif -#ifdef SGI -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - -#ifdef LINUX -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - - -#ifdef CRAY -**************************** -C Next definitions for Cray -C call date(curdat) -C curdat=curdat(1:9) -C call clock(curtim) -C curtim=curtim(1:8) - cpusec = second() - tcpu=cpusec - stime -**************************** -#endif -#ifdef AIX -**************************** -C Next definitions for RS6000 - integer*4 i1,mclock - i1 = mclock() - tcpu = (i1+0.0D0)/100.0D0 -#endif -#ifdef WINPGI -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif -#ifdef WINIFL -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif - - return - end -C--------------------------------------------------------------------------- - subroutine dajczas(rntime,hrtime,mintime,sectime) - include 'COMMON.IOUNITS' - real*8 rntime,hrtime,mintime,sectime - hrtime=rntime/3600.0D0 - hrtime=aint(hrtime) - mintime=aint((rntime-3600.0D0*hrtime)/60.0D0) - sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0) - if (sectime.eq.60.0D0) then - sectime=0.0D0 - mintime=mintime+1.0D0 - endif - ihr=hrtime - imn=mintime - isc=sectime - write (iout,328) ihr,imn,isc - 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 , - 1 ' minutes ', I2 ,' seconds *****') - return - end -C--------------------------------------------------------------------------- - subroutine print_detailed_timing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -c time1=MPI_WTIME() - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g, - & "TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - write (*,*) fg_rank,myrank, - & ': Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",fg_rank,myrank, - & ": BROADCAST time",time_bcast," REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter, - & " SCATTER fmatmult",time_scatter_fmatmult, - & " SCATTER ginvmult",time_scatter_ginvmult, - & " SCATTER fmat",time_scatter_fmat, - & " SCATTER ginv",time_scatter_ginv, - & " SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e, - & " BARRIER GRAD",time_barrier_g, - & " BCAST7",time_bcast7," BCASTC",time_bcastc, - & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce, - & " TOTAL", - & time_bcast+time_reduce+time_gather+time_scatter+ - & time_sendrecv+time_barrier+time_bcastc - write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc - write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene - write (*,*) "Processor",fg_rank,myrank," intfromcart", - & time_intfcart - write (*,*) "Processor",fg_rank,myrank," vecandderiv", - & time_vec - write (*,*) "Processor",fg_rank,myrank," setmatrices", - & time_mat - write (*,*) "Processor",fg_rank,myrank," ginvmult", - & time_ginvmult - write (*,*) "Processor",fg_rank,myrank," fricmatmult", - & time_fricmatmult - write (*,*) "Processor",fg_rank,myrank," inttocart", - & time_inttocart - write (*,*) "Processor",fg_rank,myrank," sumgradient", - & time_sumgradient - write (*,*) "Processor",fg_rank,myrank," intcartderiv", - & time_intcartderiv - if (fg_rank.eq.0) then - write (*,*) "Processor",fg_rank,myrank," lagrangian", - & time_lagrangian - write (*,*) "Processor",fg_rank,myrank," cartgrad", - & time_cartgrad - endif - return - end diff --git a/source/unres/src_CSA_DiL/together.F b/source/unres/src_CSA_DiL/together.F deleted file mode 100644 index 8bc9d7a..0000000 --- a/source/unres/src_CSA_DiL/together.F +++ /dev/null @@ -1,1293 +0,0 @@ -#ifdef MPI - Subroutine together -c feeds tasks for parallel processing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - real ran1,ran2 - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - real tcpu - double precision time_start,time_start_c,time0f,time0i - logical ovrtim,sync_iter,timeout,flag,timeout1 - dimension muster(mpi_status_size) - dimension t100(0:100),indx(mxio) - dimension xout(maxvar),eout(mxch*(mxch+1)/2+1),ind(9) - dimension cout(2) - parameter (rad=1.745329252d-2) - -cccccccccccccccccccccccccccccccccccccccccccccccc - IF (ME.EQ.KING) THEN - - time0f=MPI_WTIME() - ilastnstep=1 - sync_iter=.false. - numch=1 - nrmsdb=0 - nrmsdb1=0 - rmsdbc1c=rmsdbc1 - nstep=0 - call csa_read - call make_array - - if(iref.ne.0) call from_int(1,0,idum) - -c To minimize input conformation (bank conformation) -c Output to $mol.reminimized - if (irestart.lt.0) then - call read_bank(0,nft,cutdifr) - if (irestart.lt.-10) then - p_cut=nres*4.d0 - call prune_bank(p_cut) - return - endif - call reminimize(jlee) - return - endif - - if (irestart.eq.0) then - call initial_write - nbank=nconf - ntbank=nconf - if (ntbankm.eq.0) ntbank=0 - nstep=0 - nft=0 - do i=1,mxio - ibank(i)=0 - jbank(i)=0 - enddo - else - call restart_write -c!bankt call read_bankt(jlee,nft,cutdifr) - call read_bank(jlee,nft,cutdifr) - call read_rbank(jlee,adif) - if(iref.ne.0) call from_int(1,0,idum) - endif - - nstmax=nstmax+nstep - ntrial=n1+n2+n3+n4+n5+n6+n7+n8 - ntry=ntrial+1 - ntry=ntry*nseed - -c ntrial : number of trial conformations per seed. -c ntry : total number of trial conformations including seed conformations. - - idum2=-123 -#ifdef G77 - imax=2**30-1 -#else - imax=2**31-1 -#endif - ENDIF - - call mpi_bcast(jend,1,mpi_integer,0,CG_COMM,ierr) -cccccccccccccccccccccccccccccccccccccccc - do 300 jlee=1,jend -cccccccccccccccccccccccccccccccccccccccc - 331 continue - IF (ME.EQ.KING) THEN - if(sync_iter) goto 333 - idum=- ran2(idum2)*imax - if(jlee.lt.jstart) goto 300 - -C Restart the random number generator for conformation generation - - if(irestart.gt.0) then - idum2=idum2+nstep - if(idum2.le.0) idum2=-idum2+1 - idum=- ran2(idum2)*imax - endif - - idumm=idum - call vrndst(idumm) - - open(icsa_seed,file=csa_seed,status="old") - write(icsa_seed,*) "jlee : ",jlee - close(icsa_seed) - - call history_append - write(icsa_history,*) "number of procs is ",nodes - write(icsa_history,*) jlee,idum,idum2 - close(icsa_history) - -cccccccccccccccccccccccccccccccccccccccccccccccc - 333 icycle=0 - - call history_append - write(icsa_history,*) "nbank is ",nbank - close(icsa_history) - - if(irestart.eq.1) goto 111 - if(irestart.eq.2) then - icycle=0 - do i=1,nbank - ibank(i)=1 - enddo - do i=nbank+1,nbank+nconf - ibank(i)=0 - enddo - endif - -c start energy minimization - nconfr=max0(nconf+nadd,nodes-1) - if (sync_iter) nconf_in=0 -c king-emperor - feed input and sort output - write (iout,*) "NCONF_IN",nconf_in - m=0 - if (nconf_in.gt.0) then -c al 7/2/00 - added possibility to read in some of the initial conformations - do m=1,nconf_in - read (intin,'(i5)',end=11,err=12) iconf - 12 continue - write (iout,*) "write READ_ANGLES",iconf,m - call read_angles(intin,*11) - if (iref.eq.0) then - mm=m - else - mm=m+1 - endif - do j=2,nres-1 - dihang_in(1,j,1,mm)=theta(j+1) - dihang_in(2,j,1,mm)=phi(j+2) - dihang_in(3,j,1,mm)=alph(j) - dihang_in(4,j,1,mm)=omeg(j) - enddo - enddo ! m - goto 13 - 11 write (iout,*) nconf_in," conformations requested, but only", - & m-1," found in the angle file." - nconf_in=m-1 - 13 continue - m=nconf_in - write (iout,*) nconf_in, - & " initial conformations have been read in." - endif - if (iref.eq.0) then - if (nconfr.gt.nconf_in) then - call make_ranvar(nconfr,m,idum) - write (iout,*) nconfr-nconf_in, - & " conformations have been generated randomly." - endif - else - nconfr=nconfr*2 - call from_int(nconfr,m,idum) -c call from_pdb(nconfr,idum) - endif - write (iout,*) 'Exitted from make_ranvar nconfr=',nconfr - write (*,*) 'Exitted from make_ranvar nconfr=',nconfr - do m=1,nconfr - write (iout,*) 'Initial conformation',m - write(iout,'(8f10.4)') (rad2deg*dihang_in(1,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(2,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(3,j,1,m),j=2,nres-1) - write(iout,'(8f10.4)') (rad2deg*dihang_in(4,j,1,m),j=2,nres-1) - enddo - write(iout,*)'Calling FEEDIN NCONF',nconfr - time1i=MPI_WTIME() - call feedin(nconfr,nft) - write (iout,*) ' Time for first bank min.',MPI_WTIME()-time1i - call history_append - write(icsa_history,*) jlee,nft,nbank - write(icsa_history,851) (etot(i),i=1,nconfr) - write(icsa_history,850) (rmsn(i),i=1,nconfr) - write(icsa_history,850) (pncn(i),i=1,nconfr) - write(icsa_history,*) - close(icsa_history) - ELSE -c To minimize input conformation (bank conformation) -c Output to $mol.reminimized - if (irestart.lt.0) then - call reminimize(jlee) - return - endif - if (irestart.eq.1) goto 111 -c soldier - perform energy minimization - 334 call minim_jlee - - - ENDIF - -ccccccccccccccccccccccccccccccccccc -c need to syncronize all procs - call mpi_barrier(CG_COMM,ierr) - if (ierr.ne.0) then - print *, ' cannot synchronize MPI' - stop - endif -ccccccccccccccccccccccccccccccccccc - - IF (ME.EQ.KING) THEN - -c print *,"ok after minim" - nstep=nstep+nconf - if(irestart.eq.2) then - nbank=nbank+nconf -c ntbank=ntbank+nconf - if(ntbank.gt.ntbankm) ntbank=ntbankm - endif -c print *,"ok before indexx" - if(iref.eq.0) then - call indexx(nconfr,etot,indx) - else -c cc/al 7/6/00 - do k=1,nconfr - indx(k)=k - enddo - call indexx(nconfr-nconf_in,rmsn(nconf_in+1),indx(nconf_in+1)) - do k=nconf_in+1,nconfr - indx(k)=indx(k)+nconf_in - enddo -c cc/al -c call indexx(nconfr,rmsn,indx) - endif -c print *,"ok after indexx" - do im=1,nconf - m=indx(im) - if (m.gt.mxio .or. m.lt.1) then - write (iout,*) 'Dimension ERROR in TOGEHER: IM',im,' M',m - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - jbank(im+nbank-nconf)=0 - bene(im+nbank-nconf)=etot(m) - rene(im+nbank-nconf)=etot(m) -c!bankt btene(im)=etot(m) -c - brmsn(im+nbank-nconf)=rmsn(m) - bpncn(im+nbank-nconf)=pncn(m) - rrmsn(im+nbank-nconf)=rmsn(m) - rpncn(im+nbank-nconf)=pncn(m) - if (im+nbank-nconf.gt.mxio .or. im+nbank-nconf.lt.1) then - write (iout,*) 'Dimension ERROR in TOGEHER: IM',im, - & ' NBANK',nbank,' NCONF',nconf,' IM+NBANK-NCONF',im+nbank-nconf - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do k=1,numch - do j=2,nres-1 - do i=1,4 - bvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m) - rvar(i,j,k,im+nbank-nconf)=dihang(i,j,k,m) -c!bankt btvar(i,j,k,im)=dihang(i,j,k,m) -c - enddo - enddo - enddo - if(iref.eq.1) then - if(brmsn(im+nbank-nconf).gt.rmscut.or. - & bpncn(im+nbank-nconf).lt.pnccut) ibank(im+nbank-nconf)=9 - endif - if(vdisulf) then - bvar_ns(im+nbank-nconf)=ns-2*nss - k=0 - do i=1,ns - j=1 - do while( iss(i).ne.ihpb(j)-nres .and. - & iss(i).ne.jhpb(j)-nres .and. j.le.nss) - j=j+1 - enddo - if (j.gt.nss) then - k=k+1 - bvar_s(k,im+nbank-nconf)=iss(i) - endif - enddo - endif - bvar_nss(im+nbank-nconf)=nss - do i=1,nss - bvar_ss(1,i,im+nbank-nconf)=ihpb(i) - bvar_ss(2,i,im+nbank-nconf)=jhpb(i) - enddo - enddo - ENDIF - - 111 continue - - IF (ME.EQ.KING) THEN - - call find_max - call find_min - - if (tm_score) then - call get_diff_p - else - call get_diff - endif - if(nbank.eq.nconf.and.irestart.eq.0) then - adif=avedif - endif - - write (iout,*) "AVEDIF",avedif - cutdif=adif/cut1 - ctdif1=adif/cut2 - -cd print *,"adif,xctdif,cutdifr" -cd print *,adif,xctdif,cutdifr - nst=ntotal/ntrial/nseed - xctdif=(cutdif/ctdif1)**(-1.0/nst) - if(irestart.ge.1) call estimate_cutdif(adif,xctdif,cutdifr) -c print *,"ok after estimate" - - irestart=0 - - call write_rbank(jlee,adif,nft) - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) -c call write_bank1(jlee) - call history_append - write(icsa_history,*) "xctdif: ", xctdif,nst,adif/cut1,ctdif1 - write(icsa_history,851) (bene(i),i=1,nbank) - write(icsa_history,850) (brmsn(i),i=1,nbank) - write(icsa_history,850) (bpncn(i),i=1,nbank) - close(icsa_history) - 850 format(10f8.3) - 851 format(5e15.6) - - ifar=nseed/4*3+1 - ifar=nseed+1 - ENDIF - - - finished=.false. - iter = 0 - irecv = 0 - isent =0 - ifrom= 0 - time0i=MPI_WTIME() - time1i=time0i - time_start_c=time0i - if (.not.sync_iter) then - time_start=time0i - nft00=nft - else - sync_iter=.false. - endif - nft00_c=nft - nft0i=nft -ccccccccccccccccccccccccccccccccccccccc - do while (.not. finished) -ccccccccccccccccccccccccccccccccccccccc -crc print *,"iter ", iter,' isent=',isent - - IF (ME.EQ.KING) THEN -c start energy minimization - - if (isent.eq.0) then -c king-emperor - select seeds & make var & feed input -cd print *,'generating new conf',ntrial,MPI_WTIME() - call select_is(nseed,ifar,idum) - - open(icsa_seed,file=csa_seed,status="old") - write(icsa_seed,39) - & jlee,icycle,nstep,(is(i),bene(is(i)),i=1,nseed) - close(icsa_seed) - call history_append - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - close(icsa_history) - - - - call make_var(ntry,idum,iter) -cd print *,'new trial generated',ntrial,MPI_WTIME() - time2i=MPI_WTIME() - write (iout,'(a20,i4,f12.2)') - & 'Time for make trial',iter+1,time2i-time1i - endif - -crc write(iout,*)'1:Calling FEEDIN NTRY',NTRY,' ntrial',ntrial -crc call feedin(ntry,nft) - - isent=isent+1 - if (isent.ge.nodes.or.iter.gt.0) then -ct print *,'waiting ',MPI_WTIME() - irecv=irecv+1 - call recv(0,ifrom,xout,eout,ind,timeout) -ct print *,' ',irecv,' received from',ifrom,MPI_WTIME() - - if(tm_score) then - nft=nft+ind(3) - movernx(irecv)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,irecv) - if(vdisulf) then - nss_out(irecv)=nss - do i=1,nss - iss_out(i,irecv)=ihpb(i) - jss_out(i,irecv)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb) - endif - - if(tm_score.and.eout(1).lt.ebmax) then - if(iref.eq.0 .or. - & (rmsn(irecv).le.rmscut.and.pncn(irecv).ge.pnccut)) - & call refresh_bank_master_tmscore(ifrom,eout(1),irecv) - endif - else - ifrom=ifrom+1 - endif - -ct print *,'sending to',ifrom,MPI_WTIME() - call send(isent,ifrom,iter) -ct print *,isent,' sent ',MPI_WTIME() - -c store results ----------------------------------------------- - if ((isent.ge.nodes.or.iter.gt.0).and..not.tm_score) then - nft=nft+ind(3) - movernx(irecv)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,irecv) - if(vdisulf) then - nss_out(irecv)=nss - do i=1,nss - iss_out(i,irecv)=ihpb(i) - jss_out(i,irecv)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,irecv,iw_pdb) - endif -c-------------------------------------------------------------- - if (isent.eq.ntry) then - time1i=MPI_WTIME() - write (iout,'(a18,f12.2,a14,f10.2)') - & 'Nonsetup time ',time1i-time_start_c, - & ' sec, Eval/s =',(nft-nft00_c)/(time1i-time_start_c) - write (iout,'(a14,i4,f12.2,a14,f10.2)') - & 'Time for iter ',iter+1,time1i-time0i, - & ' sec, Eval/s =',(nft-nft0i)/(time1i-time0i) - time0i=time1i - nft0i=nft - cutdif=cutdif*xctdif - if(cutdif.lt.ctdif1) cutdif=ctdif1 - if (iter.eq.0) then - print *,'UPDATING ',ntry-nodes+1,irecv - write(iout,*) 'UPDATING ',ntry-nodes+1 - iter=iter+1 -c----------------- call update(ntry-nodes+1) ------------------- - nstep=nstep+ntry-nseed-(nodes-1) - if (tm_score) then -ctm call refresh_bank(ntry) - call print_mv_stat - do i=0,mxmv - do j=1,3 - nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j) - nstatnx(i,j)=0 - enddo - enddo - else - call refresh_bank(ntry-nodes+1) - endif -c!bankt call refresh_bankt(ntry-nodes+1) - else -c----------------- call update(ntry) --------------------------- - iter=iter+1 - print *,'UPDATING ',ntry,irecv - write(iout,*) 'UPDATING ',ntry - nstep=nstep+ntry-nseed - if (tm_score) then -ctm call refresh_bank(ntry) - call print_mv_stat - do i=0,mxmv - do j=1,3 - nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j) - nstatnx(i,j)=0 - enddo - enddo - else - call refresh_bank(ntry) - endif -c!bankt call refresh_bankt(ntry) - endif -c----------------------------------------------------------------- - - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) - call find_min - - time1i=MPI_WTIME() - write (iout,'(a20,i4,f12.2)') - & 'Time for refresh ',iter,time1i-time0i - - if(ebmin.lt.estop) finished=.true. - if(icycle.gt.icmax) then - call write_bank1(jlee) - do i=1,nbank -c ibank(i)=2 - ibank(i)=1 - enddo - nbank=nbank+nconf - if(nbank.gt.nbankm) then - nbank=nbank-nconf - finished=.true. - else -crc goto 333 - sync_iter=.true. - endif - endif - if(nstep.gt.nstmax) finished=.true. - - if(finished.or.sync_iter) then - do ij=1,nodes-1 - call recv(1,ifrom,xout,eout,ind,timeout) - if (timeout) then - nstep=nstep+ij-1 - print *,'ERROR worker is not responding' - write(iout,*) 'ERROR worker is not responding' - time1i=MPI_WTIME()-time_start_c - print *,'End of cycle, master time for ',iter,' iters ', - & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i - write (iout,*) 'End of cycle, master time for ',iter, - & ' iters ',time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i - print *,'UPDATING ',ij-1 - write(iout,*) 'UPDATING ',ij-1 - call flush(iout) - call refresh_bank(ij-1) -c!bankt call refresh_bankt(ij-1) - goto 1002 - endif -c print *,'node ',ifrom,' finished ',ij,nft - write(iout,*) 'node ',ifrom,' finished ',ij,nft - call flush(iout) - nft=nft+ind(3) - movernx(ij)=iabs(ind(5)) - call getx(ind,xout,eout,cout,rad,iw_pdb,ij) - if(vdisulf) then - nss_out(ij)=nss - do i=1,nss - iss_out(i,ij)=ihpb(i) - jss_out(i,ij)=jhpb(i) - enddo - endif - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ij,iw_pdb) - enddo - nstep=nstep+nodes-1 -crc print *,'---------bcast finished--------',finished - time1i=MPI_WTIME()-time_start_c - print *,'End of cycle, master time for ',iter,' iters ', - & time1i,'sec, Eval/s ',(nft-nft00_c)/time1i - write (iout,*) 'End of cycle, master time for ',iter, - & ' iters ',time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00_c)/time1i - -ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr) -ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0, -ctimeout & CG_COMM,ierr) - do ij=1,nodes-1 - tstart=MPI_WTIME() - call mpi_issend(finished,1,mpi_logical,ij,idchar, - & CG_COMM,ireq,ierr) - call mpi_issend(sync_iter,1,mpi_logical,ij,idchar, - & CG_COMM,ireq2,ierr) - flag=.false. - timeout1=.false. - do while(.not. (flag .or. timeout1)) - call MPI_TEST(ireq2,flag,muster,ierr) - tend1=MPI_WTIME() - if(tend1-tstart.gt.60) then - print *,'ERROR worker ',ij,' is not responding' - write(iout,*) 'ERROR worker ',ij,' is not responding' - timeout1=.true. - endif - enddo - if(timeout1) then - write(iout,*) 'worker ',ij,' NOT OK ',tend1-tstart - timeout=.true. - else - write(iout,*) 'worker ',ij,' OK ',tend1-tstart - endif - enddo - print *,'UPDATING ',nodes-1,ij - write(iout,*) 'UPDATING ',nodes-1 - call refresh_bank(nodes-1) -c!bankt call refresh_bankt(nodes-1) - 1002 continue - call write_bank(jlee,nft) -c!bankt call write_bankt(jlee,nft) - call find_min - - do i=0,mxmv - do j=1,3 - nstatnx_tot(i,j)=nstatnx_tot(i,j)+nstatnx(i,j) - nstatnx(i,j)=0 - enddo - enddo - - write(iout,*)'### Total stats:' - do i=0,mxmv - if(nstatnx_tot(i,1).ne.0) then - if (i.le.9) then - write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '### N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc', - & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1) - else - write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '###N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3),'%acc', - & (nstatnx_tot(i,2)+nstatnx_tot(i,3))*100.0/nstatnx_tot(i,1) - endif - else - if (i.le.9) then - write(iout,'(a5,i1,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '### N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3), - & ' %acc',0.0 - else - write(iout,'(a4,i2,a7,i6,a7,i4,a5,i4,a5,f5.1)') - & '###N',i,' total=',nstatnx_tot(i,1), - & ' close=',nstatnx_tot(i,2),' far=',nstatnx_tot(i,3), - & ' %acc',0.0 - endif - endif - enddo - - endif - if(sync_iter) goto 331 - - 39 format(2i3,i7,5(i4,f8.3,1x),19(/,13x,5(i4,f8.3,1x))) - 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4) - 43 format(10i8) - 44 format('jlee =',i3,':',4f10.1,' E =',f15.5,i7,i10) - - isent=0 - irecv=0 - endif - ELSE - if (tm_score) then - call get_diff_p - endif -c soldier - perform energy minimization - call minim_jlee - print *,'End of minim, proc',me,'time ',MPI_WTIME()-time_start - write (iout,*) 'End of minim, proc',me,'time ', - & MPI_WTIME()-time_start - call flush(iout) -ctimeout call mpi_bcast(finished,1,mpi_logical,0,CG_COMM,ierr) -ctimeout call mpi_bcast(sync_iter,1,mpi_logical,0,CG_COMM,ierr) - call mpi_recv(finished,1,mpi_logical,0,idchar, - * CG_COMM,muster,ierr) - call mpi_recv(sync_iter,1,mpi_logical,0,idchar, - * CG_COMM,muster,ierr) - if(sync_iter) goto 331 - ENDIF - -ccccccccccccccccccccccccccccccccccccccc - enddo -ccccccccccccccccccccccccccccccccccccccc - - IF (ME.EQ.KING) THEN - call history_append - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - - write(icsa_history,44) jlee,0.0,0.0,0.0, - & 0.0,ebmin,nstep,nft - write(icsa_history,*) - close(icsa_history) - - time1i=MPI_WTIME()-time_start - print *,'End of RUN, master time ', - & time1i,'sec, Eval/s ',(nft-nft00)/time1i - write (iout,*) 'End of RUN, master time ', - & time1i,' sec' - write (iout,*) 'Total eval/s ',(nft-nft00)/time1i - - if(timeout) then - write(iout,*) '!!!! ERROR worker was not responding' - write(iout,*) '!!!! cannot finish work normally' - write(iout,*) 'Processor0 is calling MPI_ABORT' - print *,'!!!! ERROR worker was not responding' - print *,'!!!! cannot finish work normally' - print *,'Processor0 is calling MPI_ABORT' - call flush(iout) - call mpi_abort(mpi_comm_world, 111, ierr) - endif - ENDIF - -cccccccccccccccccccccccccccccc - 300 continue -cccccccccccccccccccccccccccccc - - return - end -#else - Subroutine together -c feeds tasks for parallel processing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - write (iout,*) "Unsupported option for the serial version" - return - end -#endif -#ifdef MPI -c------------------------------------------------- - subroutine feedin(nconf,nft) -c sends out starting conformations and receives results of energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(9),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - parameter (rad=1.745329252d-2) - - print *,'FEEDIN: NCONF=',nconf - mm=0 -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - if (nconf .lt. nodes-1) then - write (*,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1', - & nconf,nodes-1 - write (iout,*) 'FATAL ERROR in FEEDIN, nconf < nodes -1', - & nconf,nodes-1 - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif - do n=1,nconf -c pull out external and internal variables for next start - call putx(xin,n,rad) -! write (iout,*) 'XIN from FEEDIN N=',n -! write(iout,'(8f10.4)') (xin(j),j=1,nvar) - mm=mm+1 - if (mm.lt.nodes) then -c feed task to soldier -! print *, ' sending input for start # ',n - info(1)=n - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - else -c find an available soldier - call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) -! print *, ' receiving output from start # ',ind(1) - man=muster(mpi_source) -c receive final energies and variables - nft=nft+ind(3) - call mpi_recv(eout,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr -c feed next task to soldier -! print *, ' sending input for start # ',n - info(1)=n - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - info(7)=0 - info(8)=0 - info(9)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) -c retrieve latest results - call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1)) - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb) - endif - enddo -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc -c no more input -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - do j=1,nodes-1 -c wait for a soldier - call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) -crc if (ierr.ne.0) go to 30 -! print *, ' receiving output from start # ',ind(1) - man=muster(mpi_source) -c receive final energies and variables - nft=nft+ind(3) - call mpi_recv(eout,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif -crc if (ierr.ne.0) go to 30 - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr -crc if (ierr.ne.0) go to 30 -c halt soldier - info(1)=0 - info(2)=-1 - info(3)=0 - info(4)=0 - info(5)=0 - info(6)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM, - * ierr) -c retrieve results - call getx(ind,xout,eout,cout,rad,iw_pdb,ind(1)) - if(iw_pdb.gt.0) - & call write_csa_pdb(xout,eout,nft,ind(1),iw_pdb) - enddo -cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - return - 10 print *, ' dispatching error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 20 print *, ' communication error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - 30 print *, ' receiving error' - call mpi_abort(mpi_comm_world,ierror,ierrcode) - return - end -cccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine getx(ind,xout,eout,cout,rad,iw_pdb,k) -c receives and stores data from soldiers - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - dimension ind(9),xout(maxvar),eout(mxch*(mxch+1)/2+1) -cjlee - double precision przes(3),obr(3,3) - logical non_conv -cjlee - iw_pdb=2 - if (k.gt.mxio .or. k.lt.1) then - write (iout,*) - & 'ERROR - dimensions of ANGMIN have been exceeded K=',k - call mpi_abort(mpi_comm_world,ierror,ierrcode) - endif -c store ind() - do j=1,9 - indb(k,j)=ind(j) - enddo -c store energies - etot(k)=eout(1) -c retrieve dihedral angles etc - call var_to_geom(nvar,xout) - do j=2,nres-1 - dihang(1,j,1,k)=theta(j+1) - dihang(2,j,1,k)=phi(j+2) - dihang(3,j,1,k)=alph(j) - dihang(4,j,1,k)=omeg(j) - enddo - dihang(2,nres-1,1,k)=0.0d0 -cjlee - if(iref.eq.0) then - iw_pdb=1 -cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a4,i3,i4)') -cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' mv ', -cd & ind(5),ind(4) - return - endif - call chainbuild -c call dihang_to_c(dihang(1,1,1,k)) -c call fitsq(rms,c(1,1),crefjlee(1,1),nres,przes,obr,non_conv) -c call fitsq(rms,c(1,2),crefjlee(1,2),nres-1,przes,obr,non_conv) -c call fitsq(rms,c(1,nstart_seq),crefjlee(1,nstart_sup), -c & nsup,przes,obr,non_conv) -c rmsn(k)=dsqrt(rms) - - call rmsd_csa(rmsn(k)) - call contact(.false.,ncont,icont,co) - pncn(k)=contact_fract(ncont,ncont_ref,icont,icont_ref) - -cd write(iout,'(i3,a3,i4,i5,a6,1pe12.4,a5 -cd & ,0pf5.2,a5,f5.1,a,f6.3,a4,i3,i4)') -cd & ind(2),' e ',ind(3),ind(1),' etot ',etot(k),' rms ', -cd & rmsn(k),' %NC ',pncn(k)*100,' cont.order',co,' mv ', -cd & ind(5),ind(4) - - - if (rmsn(k).gt.rmscut.or.pncn(k).lt.pnccut) iw_pdb=0 - return - end -cccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine putx(xin,n,rad) -c gets starting variables - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - dimension xin(maxvar) - -c pull out starting values for variables -! write (iout,*)'PUTX: N=',n - do m=1,numch -! write (iout,'(8f10.4)') (dihang_in(1,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(2,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(3,j,m,n),j=2,nres-1) -! write (iout,'(8f10.4)') (dihang_in(4,j,m,n),j=2,nres-1) - do j=2,nres-1 - theta(j+1)=dihang_in(1,j,m,n) - phi(j+2)=dihang_in(2,j,m,n) - alph(j)=dihang_in(3,j,m,n) - omeg(j)=dihang_in(4,j,m,n) - enddo - enddo -c set up array of variables - call geom_to_var(nvar,xin) -! write (iout,*) 'xin in PUTX N=',n -! call intout -! write (iout,'(8f10.4)') (xin(i),i=1,nvar) - return - end -c-------------------------------------------------------- - subroutine putx2(xin,iff,n) -c gets starting variables - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - dimension xin(maxvar),iff(maxres) - -c pull out starting values for variables - do m=1,numch - do j=2,nres-1 - theta(j+1)=dihang_in2(1,j,m,n) - phi(j+2)=dihang_in2(2,j,m,n) - alph(j)=dihang_in2(3,j,m,n) - omeg(j)=dihang_in2(4,j,m,n) - enddo - enddo -c set up array of variables - call geom_to_var(nvar,xin) - - do i=1,nres - iff(i)=iff_in(i,n) - enddo - return - end - -c------------------------------------------------------- - subroutine prune_bank(p_cut) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -c--------------------------- -c This subroutine prunes bank conformations using p_cut -c--------------------------- - - nprune=0 - nprune=nprune+1 - m=1 - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang(i,j,k,nprune)=bvar(i,j,k,m) - enddo - enddo - enddo - bene(nprune)=bene(m) - brmsn(nprune)=brmsn(m) - bpncn(nprune)=bpncn(m) - - do m=2,nbank - ddmin=9.d190 - do ip=1,nprune - call get_diff12(dihang(1,1,1,ip),bvar(1,1,1,m),diff) - if(diff.lt.p_cut) goto 100 - if(diff.lt.ddmin) ddmin=diff - enddo - nprune=nprune+1 - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang(i,j,k,nprune)=bvar(i,j,k,m) - enddo - enddo - enddo - bene(nprune)=bene(m) - brmsn(nprune)=brmsn(m) - bpncn(nprune)=bpncn(m) - 100 continue - write (iout,*) 'Pruning :',m,nprune,p_cut,ddmin - enddo - nbank=nprune - print *, 'Pruning :',m,nprune,p_cut - call write_bank(0,0) - - return - end -c------------------------------------------------------- - - subroutine reminimize(jlee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CSA' - include 'COMMON.BANK' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -c--------------------------- -c This subroutine re-minimizes bank conformations: -c--------------------------- - - ntry=nbank - - call find_max - call find_min - - if (me.eq.king) then - open(icsa_history,file=csa_history,status="old") - write(icsa_history,*) "Re-minimization",nodes,"nodes" - write(icsa_history,851) (bene(i),i=1,nbank) - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - close(icsa_history) - do index=1,ntry - do k=1,numch - do j=2,nres-1 - do i=1,4 - dihang_in(i,j,k,index)=bvar(i,j,k,index) - enddo - enddo - enddo - enddo - nft=0 - call feedin(ntry,nft) - else - call minim_jlee - endif - - call find_max - call find_min - - if (me.eq.king) then - do i=1,ntry - call replace_bvar(i,i) - enddo - open(icsa_history,file=csa_history,status="old") - write(icsa_history,40) jlee,icycle,nstep,cutdif,ibmin,ibmax, - * ebmin,ebmax,nft,iuse,nbank,ntbank - write(icsa_history,851) (bene(i),i=1,nbank) - close(icsa_history) - call write_bank_reminimized(jlee,nft) - endif - - 40 format(2i2,i8,f8.1,2i4,2(1pe14.5),i10,3i4) - 851 format(5e15.6) - 850 format(5e15.10) -c 850 format(10f8.3) - - return - end -c------------------------------------------------------- - subroutine send(n,mm,it) -c sends out starting conformation for minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(8),xin2(maxvar),iff(maxres),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - parameter (rad=1.745329252d-2) - - if (isend2(n).eq.0) then -c pull out external and internal variables for next start - call putx(xin,n,rad) - info(1)=n - info(2)=it - info(3)=movenx(n) - info(4)=nss_in(n) - info(5)=parent(1,n) - info(6)=parent(2,n) - - if (movenx(n).eq.14.or.movenx(n).eq.17) then - info(7)=idata(1,n) - info(8)=idata(2,n) - else if (movenx(n).eq.16) then - info(7)=idata(1,n) - info(8)=idata(2,n) - info(10)=idata(3,n) - info(11)=idata(4,n) - info(12)=idata(5,n) - else - info(7)=0 - info(8)=0 - info(10)=0 - info(11)=0 - info(12)=0 - endif - - if (movenx(n).eq.15) then - info(9)=parent(3,n) - else - info(9)=0 - endif - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - else -c distfit & minimization for n7 move - info(1)=-n - info(2)=it - info(3)=movenx(n) - info(4)=nss_in(n) - info(5)=parent(1,n) - info(6)=parent(2,n) - info(7)=0 - info(8)=0 - info(9)=0 - call mpi_send(info,12,mpi_integer,mm,idint,CG_COMM, - * ierr) - call putx2(xin,iff,isend2(n)) - call mpi_send(xin,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(iff,nres,mpi_integer,mm, - * idint,CG_COMM,ierr) - call putx(xin2,n,rad) - call mpi_send(xin2,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - endif - if (vdisulf.and.nss_in(n).ne.0) then - call mpi_send(iss_in(1,n),nss_in(n),mpi_integer,mm, - * idint,CG_COMM,ierr) - call mpi_send(jss_in(1,n),nss_in(n),mpi_integer,mm, - * idint,CG_COMM,ierr) - endif - return - end -c------------------------------------------------- - - subroutine recv(ihalt,man,xout,eout,ind,tout) -c receives results of energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.BANK' - include 'COMMON.CHAIN' - include 'mpif.h' - dimension xin(maxvar),xout(maxvar),eout(mxch*(mxch+1)/2+1), - * cout(2),ind(9),info(12) - dimension muster(mpi_status_size) - include 'COMMON.SETUP' - logical tout,flag - double precision twait,tstart,tend1 - parameter(twait=600.0d0) - -c find an available soldier - tout=.false. - flag=.false. - tstart=MPI_WTIME() - do while(.not. (flag .or. tout)) - call MPI_IPROBE(mpi_any_source,idint,CG_COMM,flag, - * muster,ierr) - tend1=MPI_WTIME() - if(tend1-tstart.gt.twait .and. ihalt.eq.1) tout=.true. -c_error if(tend1-tstart.gt.twait) tout=.true. - enddo - if (tout) then - write(iout,*) 'ERROR = timeout for recv ',tend1-tstart - call flush(iout) - return - endif - man=muster(mpi_source) - -ctimeout call mpi_recv(ind,9,mpi_integer,mpi_any_source,idint, -ctimeout * CG_COMM,muster,ierr) -! print *, ' receiving output from start # ',ind(1) -ct print *,'receiving ',MPI_WTIME() -ctimeout man=muster(mpi_source) - call mpi_recv(ind,9,mpi_integer,man,idint, - * CG_COMM,muster,ierr) -ctimeout -c receive final energies and variables - call mpi_recv(eout,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,eout -#ifdef CO_BIAS - call mpi_recv(co,1,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - write (iout,'(a15,f3.2,$)') ' BIAS by contact order*100 ',co -#endif - call mpi_recv(xout,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) -! print *,nvar , ierr - if(vdisulf) nss=ind(6) - if(vdisulf.and.nss.ne.0) then - call mpi_recv(ihpb,nss,mpi_integer, - * man,idint,CG_COMM,muster,ierr) - call mpi_recv(jhpb,nss,mpi_integer, - * man,idint,CG_COMM,muster,ierr) - endif -c halt soldier - if(ihalt.eq.1) then -c print *,'sending halt to ',man - write(iout,*) 'sending halt to ',man - info(1)=0 - info(2)=0 - call mpi_send(info,12,mpi_integer,man,idint,CG_COMM,ierr) - endif - return - end - -c---------------------------------------------------------- - subroutine history_append - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - -#if defined(AIX) || defined(PGI) - open(icsa_history,file=csa_history,position="append") -#else - open(icsa_history,file=csa_history,access="append") -#endif - return - end -#endif diff --git a/source/unres/src_CSA_DiL/unres_csa.F b/source/unres/src_CSA_DiL/unres_csa.F deleted file mode 100644 index ce55133..0000000 --- a/source/unres/src_CSA_DiL/unres_csa.F +++ /dev/null @@ -1,556 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C U N R E S C -C C -C Program to carry out conformational search of proteins in an united-residue C -C approximation. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#endif - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' -c include 'COMMON.REMD' -c include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision hrtime,mintime,sectime - character*64 text_mode_calc(-2:14) /'test', - & 'SC rotamer distribution', - & 'Energy evaluation or minimization', - & 'Regularization of PDB structure', - & 'Threading of a sequence on PDB structures', - & 'Monte Carlo (with minimization) ', - & 'Energy minimization of multiple conformations', - & 'Checking energy gradient', - & 'Entropic sampling Monte Carlo (with minimization)', - & 'Energy map', - & 'CSA calculations', - & 'Not used 9', - & 'Not used 10', - & 'Soft regularization of PDB structure', - & 'Mesoscopic molecular dynamics (MD) ', - & 'Not used 13', - & 'Replica exchange molecular dynamics (REMD)'/ - external ilen - -c call memmon_print_usage() - - call init_task - if (me.eq.king) - & write(iout,*)'### LAST MODIFIED 11/03/09 1:19PM by czarek' - if (me.eq.king) call cinfo -C Read force field parameters and job setup data - call readrtns - call flush(iout) -C - if (me.eq.king .or. .not. out1file) then - write (iout,'(2a/)') - & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), - & ' calculation.' - if (minim) write (iout,'(a)') - & 'Conformations will be energy-minimized.' - write (iout,'(80(1h*)/)') - endif - call flush(iout) -C -c if (modecalc.eq.-2) then -c call test -c stop -c else if (modecalc.eq.-1) then -c write(iout,*) "call check_sc_map next" -c call check_bond -c stop -c endif -#ifdef MPI - if (fg_rank.gt.0) then -C Fine-grain slaves just do energy and gradient components. - call ergastulum ! slave workhouse in Latin - else -#endif - if (modecalc.eq.0) then - call exec_eeval_or_minim -c else if (modecalc.eq.1) then -c call exec_regularize -c else if (modecalc.eq.2) then -c call exec_thread -c else if (modecalc.eq.3 .or. modecalc .eq.6) then -c call exec_MC - else if (modecalc.eq.4) then - call exec_mult_eeval_or_minim - else if (modecalc.eq.5) then - call exec_checkgrad -c else if (ModeCalc.eq.7) then -c call exec_map - else if (ModeCalc.eq.8) then - call exec_CSA -c else if (modecalc.eq.11) then -c call exec_softreg -c else if (modecalc.eq.12) then -c call exec_MD -c else if (modecalc.eq.14) then -c call exec_MREMD - else - write (iout,'(a)') 'This calculation type is not supported', - & ModeCalc - endif -#ifdef MPI - endif -C Finish task. - if (fg_rank.eq.0) call finish_task -c call memmon_print_usage() -#ifdef TIMING - call print_detailed_timing -#endif - call MPI_Finalize(ierr) - stop 'Bye Bye...' -#else - call dajczas(tcpu(),hrtime,mintime,sectime) - stop '********** Program terminated normally.' -#endif - end -c--------------------------------------------------------------------------- - subroutine exec_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' -c include 'COMMON.REMD' -c include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:n_ene) - double precision energy_long(0:n_ene),energy_short(0:n_ene) - double precision varia(maxvar) - if (indpdb.eq.0) call chainbuild -c time00=MPI_Wtime() - call chainbuild_cart -c if (split_ene) then -c print *,"Processor",myrank," after chainbuild" -c icall=1 -c call etotal_long(energy_long(0)) -c write (iout,*) "Printing long range energy" -c call enerprint(energy_long(0)) -c call etotal_short(energy_short(0)) -c write (iout,*) "Printing short range energy" -c call enerprint(energy_short(0)) -c do i=0,n_ene -c energy(i)=energy_long(i)+energy_short(i) -c write (iout,*) i,energy_long(i),energy_short(i),energy(i) -c enddo -c write (iout,*) "Printing long+short range energy" -c call enerprint(energy(0)) -c endif - call etotal(energy(0)) -c time_ene=MPI_Wtime()-time00 - write (iout,*) "Time for energy evaluation",time_ene - print *,"after etotal" - etota = energy(0) - etot =etota - call enerprint(energy(0)) -c call hairpin(.true.,nharp,iharp) -c call secondary2(.true.) - if (minim) then - - if (dccart) then - print *, 'Calling MINIM_DC' -c time1=MPI_WTIME() - call minim_dc(etot,iretcode,nfun) - else - if (indpdb.ne.0) then - call bond_regular - call chainbuild - endif - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' -c time1=MPI_WTIME() - call minimize(etot,varia,iretcode,nfun) - endif - print *,'SUMSL return code is',iretcode,' eval ',nfun -c evals=nfun/(MPI_WTIME()-time1) - print *,'# eval/s',evals - print *,'refstr=',refstr -c call hairpin(.true.,nharp,iharp) -c call secondary2(.true.) - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - - call intout - call briefout(0,etot) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 - write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals - else - print *,'refstr=',refstr - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call briefout(0,etot) - endif - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - return - end - - subroutine exec_checkgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' -c include 'COMMON.REMD' - include 'COMMON.MD_' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:max_ene) -c do i=2,nres -c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0) -c if (itype(i).ne.10) -c & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0) -c enddo - if (indpdb.eq.0) call chainbuild -c do i=0,nres -c do j=1,3 -c dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0) -c enddo -c enddo -c do i=1,nres-1 -c if (itype(i).ne.10) then -c do j=1,3 -c dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0) -c enddo -c endif -c enddo -c do j=1,3 -c dc(j,0)=ran_number(-0.2d0,0.2d0) -c enddo - usampl=.true. - totT=1.d0 - eq_time=0.0d0 -c call read_fragments -c read(inp,*) t_bath -c call rescale_weights(t_bath) - call chainbuild_cart - call cartprint - call intout - icall=1 - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back - print *,'icheckgrad=',icheckgrad - goto (10,20,30) icheckgrad - 10 call check_ecartint - return - 20 call check_cartgrad - return - 30 call check_eint - return - end -c--------------------------------------------------------------------------- - subroutine exec_CSA -#ifdef MPI - include "mpif.h" -#endif - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -C Conformational Space Annealling programmed by Jooyoung Lee. -C This method works only with parallel machines! -#ifdef MPI - call together -#else - write (iout,*) "CSA works on parallel machines only" -#endif - return - end -c--------------------------------------------------------------------------- -#ifdef MPI - subroutine exec_mult_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - integer muster(mpi_status_size) - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision varia(maxvar) - integer ind(6) - double precision energy(0:n_ene) - logical eof - eof=.false. - - if(me.ne.king) then - call minim_mcmf - return - endif - - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,100a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,100a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact", - & "cont.order","TMscore" - else - write (istat,'(a5,100a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - - if (.not.minim) then - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - call etotal(energy(0)) - call briefout(iconf,energy(0)) - call enerprint(energy(0)) - etot=energy(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call calc_tmscore(tm,.true.) - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co,tm - else - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo -1100 continue - goto 1101 - endif - - mm=0 - imm=0 - nft=0 - ene0=0.0d0 - n=0 - iconf=0 - do while (.not. eof) - mm=mm+1 - if (mm.lt.nodes) then - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - ene0=0.0d0 - call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) -c print *,'task ',n,' sent to worker ',mm,nvar - else - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) -c print *,'receiving result from worker ',man,' (',iii1,iii,')' - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -c print *,'result received from worker ',man,' sending now' - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(iconf,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call calc_tmscore(tm,.true.) - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co,tm - else - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - - imm=imm-1 - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - nf_mcmf=nf_mcmf+ind(4) - nmin=nmin+1 - endif - enddo -11 continue - do j=1,imm - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(iconf,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call calc_tmscore(tm,.true.) - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co,tm - else - write (istat,'(i5,100(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - nmin=nmin+1 - enddo -1101 continue - do i=1, nodes-1 - ind(1)=0 - ind(2)=0 - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM, - * ierr) - enddo - return - end -#else - subroutine exec_mult_eeval_or_minim - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - write (iout,*) "Unsupported option in serial version" - return - end -#endif -c--------------------------------------------------------------------------- - diff --git a/source/unres/src_Eshel/Makefile_single_gfortran b/source/unres/src_Eshel/Makefile_single_gfortran index 599260c..b04dc55 100644 --- a/source/unres/src_Eshel/Makefile_single_gfortran +++ b/source/unres/src_Eshel/Makefile_single_gfortran @@ -6,11 +6,11 @@ CC = cc CFLAGS = -DLINUX -DPGI -c -#OPT = -O -OPT1 = -fbounds-check -g -O +OPT = -O +#OPT1 = -fbounds-check -g -O -OPT = -fbounds-check -g -#OPT1 = -g +#OPT = -fbounds-check -g +OPT1 = -g # -Mvect <---slows down # -Minline=name:matmat2 <---false convergence diff --git a/source/unres/src_Eshel/readpdb.F b/source/unres/src_Eshel/readpdb.F index 3ce8334..5d6acc0 100644 --- a/source/unres/src_Eshel/readpdb.F +++ b/source/unres/src_Eshel/readpdb.F @@ -13,30 +13,25 @@ C geometry. include 'COMMON.CONTROL' include 'COMMON.DISTFIT' include 'COMMON.SETUP' - integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity, - & ishift_pdb - logical lprn /.true./,fail - double precision e1(3),e2(3),e3(3) - double precision dcj,efree_temp - character*3 seq,res - character*5 atom + character*3 seq,atom,res character*80 card - double precision sccor(3,20) + dimension sccor(3,20) + double precision e1(3),e2(3),e3(3) + logical fail integer rescode - efree_temp=0.0d0 ibeg=1 - ishift1=0 - ishift=0 -c write (2,*) "UNRES_PDB",unres_pdb - ires=0 - ires_old=0 - iii=0 lsecondary=.false. nhfrag=0 nbfrag=0 + do i=1,maxres + itype(i)=21 + do j=1,3 + c(j,i)=0.0d0 + c(j,i+nres)=0.0d0 + enddo + enddo do i=1,10000 read (ipdbin,'(a80)',end=10) card -c write (iout,'(a)') card if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -55,118 +50,86 @@ crc to be corrected !!! crc---------------------------------------- endif if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -c Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp C Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then - read (card(12:16),*) atom -c write (iout,*) "! ",atom," !",ires -c if (atom.eq.'CA' .or. atom.eq.'CH3') then - read (card(23:26),*) ires - read (card(18:20),'(a3)') res -c write (iout,*) "ires",ires,ires-ishift+ishift1, -c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old - if (ires-ishift+ishift1.ne.ires_old) then + read (card(14:16),'(a3)') atom + if (atom.eq.'CA' .or. atom.eq.'CH3') then C Calculate the CM of the preceding residue. -c if (ibeg.eq.0) call sccenter(ires,iii,sccor) if (ibeg.eq.0) then -c write (iout,*) "Calculating sidechain center iii",iii if (unres_pdb) then do j=1,3 - dc(j,ires)=sccor(j,iii) + dc(j,ires+nres)=sccor(j,iii) enddo else - call sccenter(ires_old,iii,sccor) + call sccenter(ires,iii,sccor) endif - iii=0 endif C Start new residue. - if (res.eq.'Cl-' .or. res.eq.'Na+') then - ires=ires_old - cycle - else if (ibeg.eq.1) then -c write (iout,*) "BEG ires",ires + read (card(24:26),*) ires + read (card(18:20),'(a3)') res + if (ibeg.eq.1) then ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 itype(1)=21 endif - ires=ires-ishift+ishift1 - ires_old=ires -c write (iout,*) "ishift",ishift," ires",ires, -c & " ires_old",ires_old ibeg=0 - else - ishift=ishift-(ires-ishift+ishift1-ires_old-1) - ires=ires-ishift+ishift1 - ires_old=ires endif - if (res.eq.'ACE' .or. res.eq.'NHE') then - itype(ires)=10 + ires=ires-ishift + if (res.eq.'ACE') then + ity=10 else itype(ires)=rescode(ires,res,0) endif - else - ires=ires-ishift+ishift1 - endif -c write (iout,*) "ires_old",ires_old," ires",ires - if (card(27:27).eq."A" .or. card(27:27).eq."B") then -c ishift1=ishift1+1 - endif -c write (2,*) "ires",ires," res ",res," ity",ity - if (atom.eq.'CA' .or. atom.eq.'CH3' .or. - & res.eq.'NHE'.and.atom(:2).eq.'HN') then read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c write (iout,*) "backbone ",atom -#ifdef DEBUG - write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) -#endif - iii=iii+1 +c if(me.eq.king.or..not.out1file) +c & write (iout,'(2i3,2x,a,3f8.3)') +c & ires,itype(ires),res,(c(j,ires),j=1,3) + iii=1 do j=1,3 sccor(j,iii)=c(j,ires) enddo - if (ishift.ne.0) then - ires_ca=ires+ishift-ishift1 - else - ires_ca=ires - endif -c write (*,*) card(23:27),ires,itype(ires) - else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. - & atom.ne.'N' .and. atom.ne.'C' .and. - & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. - & atom.ne.'OXT' .and. atom(:2).ne.'3H') then -c write (iout,*) "sidechain ",atom + else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. + & atom.ne.'N ' .and. atom.ne.'C ') then iii=iii+1 read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) endif endif enddo - 10 write (iout,'(a,i5)') ' Number of residues found: ',ires - if (ires.eq.0) return + 10 if(me.eq.king.or..not.out1file) + & write (iout,'(a,i5)') ' Nres: ',ires C Calculate the CM of the last side chain. - if (iii.gt.0) then if (unres_pdb) then do j=1,3 - dc(j,ires)=sccor(j,iii) + dc(j,ires+nres)=sccor(j,iii) enddo - else + else if (.not.catrace) then call sccenter(ires,iii,sccor) endif - endif nres=ires nsup=nres nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 itype(nres)=21 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,nres)=c(j,nres-1)-3.8d0*e2(j) + enddo + else if (.not.catrace) then do j=1,3 dcj=c(j,nres-2)-c(j,nres-3) c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo + endif endif do i=2,nres-1 do j=1,3 @@ -191,7 +154,7 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue do j=1,3 c(j,1)=c(j,2)-3.8d0*e2(j) enddo - else + else if (.not.catrace) then do j=1,3 dcj=c(j,4)-c(j,3) c(j,1)=c(j,2)-dcj @@ -199,24 +162,6 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue enddo endif endif -C Copy the coordinates to reference coordinates -c do i=1,2*nres -c do j=1,3 -c cref(j,i)=c(j,i) -c enddo -c enddo -C Calculate internal coordinates. - if (lprn) then - write (iout,'(/a)') - & "Cartesian coordinates of the reference structure" - write (iout,'(a,3(3x,a5),5x,3(3x,a5))') - & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" - do ires=1,nres - write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') - & restyp(itype(ires)),ires,(c(j,ires),j=1,3), - & (c(j,ires+nres),j=1,3) - enddo - endif C Calculate internal coordinates. if(me.eq.king.or..not.out1file)then write (iout,'(a)') @@ -227,8 +172,8 @@ C Calculate internal coordinates. & (c(j,nres+ires),j=1,3) enddo endif - call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) + call int_from_cart(.not.catrace,.false.) + if (.not.catrace) call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) @@ -267,7 +212,7 @@ C Copy the coordinates to reference coordinates hfrag(i,j)=hfrag(i,j)-ishift enddo enddo - ishift_pdb=ishift + return end c--------------------------------------------------------------------------- @@ -286,8 +231,7 @@ c--------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.CONTROL' include 'COMMON.SETUP' - character*3 seq,res -c character*5 atom + character*3 seq,atom,res character*80 card dimension sccor(3,20) integer rescode @@ -307,6 +251,7 @@ c character*5 atom endif endif do i=1,nres-1 + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iti=itype(i) if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i @@ -333,6 +278,7 @@ c endif c endif if (lside) then do i=2,nres-1 + if (itype(i).eq.ntyp1) cycle do j=1,3 c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) @@ -340,7 +286,7 @@ c endif iti=itype(i) di=dist(i,nres+i) C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) + if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0) & di=dsc(itype(i)) vbld(i+nres)=di if (itype(i).ne.10) then diff --git a/source/unres/src_Eshel/readpdb.F.safe b/source/unres/src_Eshel/readpdb.F.safe deleted file mode 100644 index 5d6acc0..0000000 --- a/source/unres/src_Eshel/readpdb.F.safe +++ /dev/null @@ -1,441 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - logical fail - integer rescode - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do i=1,maxres - itype(i)=21 - do j=1,3 - c(j,i)=0.0d0 - c(j,i+nres)=0.0d0 - enddo - enddo - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else if (.not.catrace) then - call sccenter(ires,iii,sccor) - endif - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) - enddo - else if (.not.catrace) then - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) - enddo - else if (.not.catrace) then - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call int_from_cart(.not.catrace,.false.) - if (.not.catrace) call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - - - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if(me.eq.king.or..not.out1file)then - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' - endif - endif - endif - do i=1,nres-1 - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle - iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif - if (lside) then - do i=2,nres-1 - if (itype(i).eq.ntyp1) cycle - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) -C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0) - & di=dsc(itype(i)) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/CMakeLists.txt b/source/unres/src_MD-DFA-restraints/CMakeLists.txt deleted file mode 100644 index a0353f4..0000000 --- a/source/unres/src_MD-DFA-restraints/CMakeLists.txt +++ /dev/null @@ -1,398 +0,0 @@ -# -# CMake project file for UNRES with MD for single chains -# - -enable_language (Fortran) - - -#================================ -# Set source file lists -#================================ -set(UNRES_MD_SRC0 - add.f - arcos.f - banach.f - blas.f - bond_move.f - cartder.F - cartprint.f - check_sc_distr.f - check_bond.f - chainbuild.F - checkder_p.F - compare_s1.F - contact.f - convert.f - cored.f - dihed_cons.F - djacob.f - econstr_local.F - eigen.f - elecont.f - energy_split-sep.F - entmcm.F - fitsq.f - gauss.f - gen_rand_conf.F - geomout.F - gnmr1.f - intcartderiv.F - initialize_p.F - int_to_cart.f - intcor.f - intlocal.f - kinetic_lesyng.f - lagrangian_lesyng.F - local_move.f - map.f - matmult.f - mc.F - mcm.F - MD_A-MTS.F - minimize_p.F - minim_mcmf.F - misc.f - moments.f - MP.F - MREMD.F - muca_md.f - parmread.F - pinorm.f - printmat.f - q_measure.F - randgens.f - rattle.F - readpdb.F - readrtns.F - refsys.f - regularize.F - rescode.f - rmdd.f - rmsd.F - sc_move.F - sort.f - stochfric.F - sumsld.f - surfatom.f - test.F - timing.F - thread.F - unres.F - ssMD.F -) - -if(Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "f95") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "gfortran") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -else() - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - -set(UNRES_MD_SRC3 - energy_p_new_barrier.F - energy_p_new-sep_barrier.F - gradient_p.F ) - -set(UNRES_MD_PP_SRC - cartder.F - chainbuild.F - checkder_p.F - compare_s1.F - dihed_cons.F - econstr_local.F - energy_p_new_barrier.F - energy_p_new-sep_barrier.F - energy_split-sep.F - entmcm.F - gen_rand_conf.F - geomout.F - gradient_p.F - initialize_p.F - intcartderiv.F - lagrangian_lesyng.F - mc.F - mcm.F - MD_A-MTS.F - minimize_p.F - minim_mcmf.F - MP.F - MREMD.F - parmread.F - q_measure1.F - q_measure3.F - q_measure.F - rattle.F - readpdb.F - readrtns.F - regularize.F - rmsd.F - sc_move.F - stochfric.F - test.F - thread.F - timing.F - unres.F - proc_proc.c -) - - -if(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_PP_SRC ${UNRES_MD_PP_SRC} prng_32.F) -endif(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - -#================================================ -# Set comipiler flags for different sourcefiles -#================================================ -if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-ip -w" ) - set(FFLAGS1 "-w -g -d2 -CA -CB" ) - set(FFLAGS2 "-w -g -00 ") - #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" ) - set(FFLAGS3 "-w -ipo " ) -elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 "-std=legacy -I. " ) - set(FFLAGS1 "-std=legacy -g -I. " ) - set(FFLAGS2 "-std=legacy -I. ") - #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" ) - set(FFLAGS3 "-std=legacy -I. " ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - -# Add MPI compiler flags -if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") -endif(UNRES_WITH_MPI) - -set_property(SOURCE ${UNRES_MD_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) -#set_property(SOURCE ${UNRES_MD_SRC1} PROPERTY COMPILE_FLAGS ${FFLAGS1} ) -#set_property(SOURCE ${UNRES_MD_SRC2} PROPERTY COMPILE_FLAGS ${FFLAGS2} ) -set_property(SOURCE ${UNRES_MD_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) - -#========================================= -# Settings for GAB force field -#========================================= -if(UNRES_MD_FF STREQUAL "GAB" ) - # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) - -#========================================= -# Settings for E0LL2Y force field -#========================================= -elseif(UNRES_MD_FF STREQUAL "E0LL2Y") - # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" ) -endif(UNRES_MD_FF STREQUAL "GAB") - -#========================================= -# System specific flags -#========================================= -if(${CMAKE_SYSTEM_NAME} MATCHES "Linux") - set(CPPFLAGS "${CPPFLAGS} -DLINUX") -endif(${CMAKE_SYSTEM_NAME} MATCHES "Linux") - -#========================================= -# Compiler specific flags -#========================================= - -if (Fortran_COMPILER_NAME STREQUAL "ifort") - # Add ifort preprocessor flags - set(CPPFLAGS "${CPPFLAGS} -DPGI") -elseif (Fortran_COMPILER_NAME STREQUAL "f95") - # Add new gfortran flags - set(CPPFLAGS "${CPPFLAGS} -DG77") -elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - # Add old gfortran flags - set(CPPFLAGS "${CPPFLAGS} -DG77") -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - -#========================================= -# Add MPI preprocessor flags -#========================================= -if (UNRES_WITH_MPI) - set(CPPFLAGS "${CPPFLAGS} -DMP -DMPI") -endif(UNRES_WITH_MPI) - -#========================================= -# Apply preprocesor flags to *.F files -#========================================= -set_property(SOURCE ${UNRES_MD_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) - - -#======================================== -# Setting binary name -#======================================== -if(UNRES_WITH_MPI) - # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") -else(UNRES_WITH_MPI) - # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") -endif(UNRES_WITH_MPI) - -#========================================= -# cinfo.f workaround for cmake -#========================================= -# get the current date -TODAY(DATE) -# generate cinfo.f - -set(CINFO "${CMAKE_CURRENT_BINARY_DIR}/cinfo.f") -FILE(WRITE ${CINFO} -"C CMake generated file - subroutine cinfo - include 'COMMON.IOUNITS' - write(iout,*)'++++ Compile info ++++' - write(iout,*)'Version ${UNRES_MAJOR}.${UNRES_MINOR} build ${UNRES_PATCH}' -") - -CINFO_FORMAT(${CINFO} "Compiled" "${DATE}" ) -CINFO_FORMAT(${CINFO} "Compiled by" "$ENV{USER}@$ENV{HOST}" ) -CINFO_FORMAT(${CINFO} "OS name:" "${CMAKE_SYSTEM_NAME}" ) -CINFO_FORMAT(${CINFO} "OS release:" "${CMAKE_SYSTEM}" ) -CINFO_FORMAT(${CINFO} "Fortran Compiler:" "${CMAKE_Fortran_COMPILER}" ) -CINFO_FORMAT(${CINFO} "MD Force field:" "${UNRES_MD_FF}" ) -CINFO_FORMAT(${CINFO} "CPPFLAGS =" "${CPPFLAGS}") - -FILE(APPEND ${CINFO} -" write(iout,*)'++++ End of compile info ++++' - return - end ") - -# add include path -set_property(SOURCE ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f PROPERTY COMPILE_FLAGS "${FFLAGS0} -I${CMAKE_CURRENT_SOURCE_DIR}") - -#========================================= -# Set full unres MD sources -#========================================= -set(UNRES_MD_SRCS ${UNRES_MD_SRC0} ${UNRES_MD_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f ) - - -#========================================= -# Build the binary -#========================================= -add_executable(UNRES_BIN-MD ${UNRES_MD_SRCS} ) -set_target_properties(UNRES_BIN-MD PROPERTIES OUTPUT_NAME ${UNRES_BIN}) -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) -#add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) - - -#========================================= -# Link libraries -#========================================= -# link MPI library (libmpich.a) -if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD ${MPIF_LIBRARIES} ) -endif(UNRES_WITH_MPI) -# link libxdrf.a -#message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") -target_link_libraries( UNRES_BIN-MD xdrf ) - -#========================================= -# TESTS -#========================================= - -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) - -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) - -#========================================= -# Generate data test files -#========================================= -# test_single_ala.sh -#========================================= - -FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh -"#!/bin/sh -export POT=GB -export PREFIX=ala10 -#----------------------------------------------------------------------------- -UNRES_BIN=./${UNRES_BIN} -#----------------------------------------------------------------------------- -DD=${CMAKE_SOURCE_DIR}/PARAM -export BONDPAR=$DD/bond.parm -export THETPAR=$DD/thetaml.5parm -export ROTPAR=$DD/scgauss.parm -export TORPAR=$DD/torsion_631Gdp.parm -export TORDPAR=$DD/torsion_double_631Gdp.parm -export ELEPAR=$DD/electr_631Gdp.parm -export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k -export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 -export SCPPAR=$DD/scp.parm -export SCCORPAR=$DD/sccor_pdb_shelly.dat -export PATTERN=$DD/patterns.cart -#----------------------------------------------------------------------------- -$UNRES_BIN -") - -# -# File permissions workaround -# -FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh - DESTINATION ${CMAKE_CURRENT_BINARY_DIR} - FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE -) - - - -#========================================= -# ala10.inp -#========================================= - -file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp -"ala10 unblocked -SEED=-1111333 MD ONE_LETTER rescale_mode=2 -nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & -reset_moment=1000 reset_vel=1000 -WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & -WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & -WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & -WVDWPP=0.11371 WHPB=1.00000 & -CUTOFF=7.00000 WCORR4=0.00000 -12 -XAAAAAAAAAAX - 0 - 0 - 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 - 90.0000 90.0000 - 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 - 180.0000 - 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 - 110.0000 110.0000 - -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 - -120.0000 -120.0000 -") - - -# Add tests - -if(NOT UNRES_WITH_MPI) - - add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -else(NOT UNRES_WITH_MPI) - - - add_test(NAME UNRES_MD_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -endif(NOT UNRES_WITH_MPI) - diff --git a/source/unres/src_MD-DFA-restraints/COMMON.BOUNDS b/source/unres/src_MD-DFA-restraints/COMMON.BOUNDS deleted file mode 100644 index f3859ae..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.BOUNDS +++ /dev/null @@ -1,2 +0,0 @@ - double precision phibound(2,maxres) - common /bounds/ phibound diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CACHE b/source/unres/src_MD-DFA-restraints/COMMON.CACHE deleted file mode 100644 index 8cb0cbc..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CACHE +++ /dev/null @@ -1,6 +0,0 @@ - integer ncache,CachSrc(max_cache),isent(max_cache), - & iused(max_cache) - logical cache_update - double precision ecache(max_cache),xcache(maxvar,max_cache) - common /cache/ ecache,xcache,ncache,CachSrc,isent,iused, - & cache_update diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CALC b/source/unres/src_MD-DFA-restraints/COMMON.CALC deleted file mode 100644 index 67b4bb9..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CALC +++ /dev/null @@ -1,15 +0,0 @@ - integer i,j,k,l - double precision erij,rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg - common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CHAIN b/source/unres/src_MD-DFA-restraints/COMMON.CHAIN deleted file mode 100644 index 6e19f8d..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CHAIN +++ /dev/null @@ -1,13 +0,0 @@ - integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, - & nres0,nstart_seq - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, - & prod,rt,dc_work,cref,crefjlee,dc_norm2 - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_norm2(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), - & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), - & nsup,nstart_sup,nstart_seq - common /from_zscore/ nz_start,nz_end,iz_sc diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS b/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS deleted file mode 100644 index 5b3a90d..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS +++ /dev/null @@ -1,82 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -c 7/25/08 Commented out; not needed when cumulants used -C Interactions of pseudo-dipoles generated by loc-el interactions. -c double precision dip,dipderg,dipderx -c common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), -c & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres), - & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres), - & Dtobr2(2,maxres),Dtobr2der(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres), - & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont -C 12/13/2008 (again Poland-Jaruzel war anniversary) -C RE: Parallelization of 4th and higher order loc-el correlations - integer ncont_sent,ncont_recv,iint_sent,iisent_local, - & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to, - & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local, - & iturn4_sent_local - common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres), - & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres), - & iturn3_sent(4,maxres),iturn4_sent(4,maxres), - & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres), - & nat_sent,iat_sent(maxres),itask_cont_from(0:max_fg_procs-1), - & itask_cont_to(0:max_fg_procs-1),ntask_cont_from,ntask_cont_to diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS.moment b/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS.moment deleted file mode 100644 index d07a0f0..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CONTACTS.moment +++ /dev/null @@ -1,68 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -C Interactions of pseudo-dipoles generated by loc-el interactions. - double precision dip,dipderg,dipderx - common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), - & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres), - & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres),muder(2,maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont diff --git a/source/unres/src_MD-DFA-restraints/COMMON.CONTROL b/source/unres/src_MD-DFA-restraints/COMMON.CONTROL deleted file mode 100644 index 9fce3c5..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.CONTROL +++ /dev/null @@ -1,15 +0,0 @@ - integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad, - & inprint,i2ndstr,mucadyn,constr_dist,constr_homology - real*8 waga_dist, waga_angle - logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec, - & sideadd,lsecondary,read_cart,unres_pdb, - & vdisulf,searchsc,lmuca,dccart,extconf,out1file, - & gnorm_check,gradout,split_ene - common /cntrl/ modecalc,iscode,indpdb,indback,indphi,iranconf, - & icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint, - & overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb - & ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file, - & constr_dist,gnorm_check,gradout,split_ene,constr_homology, - & waga_dist, waga_angle -C... minim = .true. means DO minimization. -C... energy_dec = .true. means print energy decomposition matrix diff --git a/source/unres/src_MD-DFA-restraints/COMMON.DBASE b/source/unres/src_MD-DFA-restraints/COMMON.DBASE deleted file mode 100644 index 4f07780..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.DBASE +++ /dev/null @@ -1,3 +0,0 @@ - common /struct/ cart_base(3,maxres_base,maxseq),str_nam(maxseq), - & nres_base(3,maxseq),nseq - character*8 str_nam diff --git a/source/unres/src_MD-DFA-restraints/COMMON.DERIV b/source/unres/src_MD-DFA-restraints/COMMON.DERIV deleted file mode 100644 index 67ebfdc..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.DERIV +++ /dev/null @@ -1,37 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, - & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT,gvdwx - integer nfl,icg - common /derivatT/ gvdwcT(3,maxres),gvdwxT(3,maxres) - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg, - & gdfad(3,maxres),gdfat(3,maxres),gdfan(3,maxres),gdfab(3,maxres) - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab - integer igrad_start,igrad_end,jgrad_start(maxres), - & jgrad_end(maxres) - common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/unres/src_MD-DFA-restraints/COMMON.DFA b/source/unres/src_MD-DFA-restraints/COMMON.DFA deleted file mode 100644 index c6add4f..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.DFA +++ /dev/null @@ -1,101 +0,0 @@ -C ======= -C COMMON.DFA -C ======= -C 2010/12/20 By Juyong Lee -C -c parameter -C [ 8 * ( Nres - 8 ) ] distance restraints -C [ 2 * ( Nres - 8 ) ] angle restraints -C [ Nres ] neighbor restraints -C Total : ~ 11 * Nres restraints -C -C - INTEGER IDFAMAX,IDFAMX2,IDFACMD,IDMAXMIN, MAXN - PARAMETER(IDFAMAX=4000,IDFAMX2=1000,IDFACMD=500,IDMAXMIN=500) - PARAMETER(MAXN=4) - real*8 wwdist,wwangle,wwnei - parameter(wwdist=1.0d0,wwangle=1.0d0,wwnei=1.0d0) - -C IDFAMAX - maximum number of DFA restraint including distance, angle and -C number of neighbors ( Max of assign statement ) -C IDFAMX2 - maximum number of atoms which are targets of restraints -C IDFACMD - maximum number of 'DFA' command call -C IDMAXMIN - Maximum number of minima of dist, angle and neighbor info. from fragments -C MAXN - Maximum Number of shell, currently 4 -C MAXRES - Maximum number of CAs - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCc -C INTEGER -C DFANUM - Number of ALL DFA restrants -c IDFA[DIS, PHI, THE, NEI] - NUMBER of restraints -c IDISNUM - number of minima for a distance restraint -c IPHINUM - number of minima for a phi angle restraint -c ITHENUM - number of minima for a theta angle restraint -c INEINUM - number of minima for a number of neighbors restraint - -c IDISLIS - atom number of two atoms for distance restraint -c IPHILIS - atom numbers of four atoms for angle restraint -c ITHELIS - atom numbers of four atoms for angle restraint -c INEILIS - atom number of center of neighbor calculation -c JNEILIS - atom number of target of neighboring calculation -c JNEINUM - number of target atoms of neighboring term -C KSHELL - SHELL number - -C ishiftca - index shift for CA atoms in UNRES (1 if the 1st aa != GLY) -C ilastca - index of the last CA atom in UNRES (nres-1 if last aa != GLY) - -C old only for CHARMM -C STOAGDF - Store assign information ( How many assign within one command ) -C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei - - INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, - & IDISLIS,IPHILIS,ITHELIS,INEILIS, - & IDISNUM,IPHINUM,ITHENUM,INEINUM, - & FNEI,DFACMD, DFANUM, - & NCA,ICAIDX, - & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL - & ishiftca,ilastca - COMMON /IDFA/ DFACMD, DFANUM, - & IDFADIS, IDFAPHI, IDFANEI, IDFATHE, - & IDISNUM(IDFAMAX), IPHINUM(IDFAMAX), - & ITHENUM(IDFAMAX), INEINUM(IDFAMAX), - & FNEI(IDFAMAX,IDMAXMIN), IDISLIS(2,IDFAMAX), - & IPHILIS(5,IDFAMAX), ITHELIS(5,IDFAMAX), - & INEILIS(IDFAMAX), - & KSHELL(IDFAMAX), - & IDFACAT(IDFACMD), - & KDISNUM(IDFAMAX), - & NCA, ICAIDX(MAXRES) - COMMON /IDFA2/ ishiftca,ilastca - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C REAL VARIABLES -C -c SCC[DIST, PHI, THE] - weight of each calculations -c FDIST - distance minima -C FPHI - phi minima -c FTHE - theta minima -C DFAEXP : calculate expential function in advance -C - REAL*8 SCCDIST, SCCPHI, SCCTHE, SCCNEI, FDIST, FPHI1, FPHI2, - & FTHE1, FTHE2, - & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, - & WSHET, EDFABET, - & CK, SCK, S1, S2 -c & ,DFAEXP - - COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), - & SCCPHI(IDFAMAX,IDMAXMIN), SCCTHE(IDFAMAX,IDMAXMIN), - & SCCNEI(IDFAMAX,IDMAXMIN), - & FPHI1(IDFAMAX,IDMAXMIN), FPHI2(IDFAMAX,IDMAXMIN), - & FTHE1(IDFAMAX,IDMAXMIN), FTHE2(IDFAMAX,IDMAXMIN), - & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, - & WSHET(MAXRES,MAXRES), EDFABET, - & CK(4),SCK(4),S1(4),S2(4) -c & ,DFAEXP(15001), - - DATA CK/1.0D0,1.58740105197D0,2.08008382305D0,2.51984209979D0/ - DATA SCK/1.0D0,1.25992104989D0,1.44224957031D0,1.58740105197D0/ - DATA S1/3.75D0,5.75D0,7.75D0,9.75D0/ - DATA S2/4.25D0,6.25D0,8.25D0,10.25D0/ diff --git a/source/unres/src_MD-DFA-restraints/COMMON.DISTFIT b/source/unres/src_MD-DFA-restraints/COMMON.DISTFIT deleted file mode 100644 index 683228a..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.DISTFIT +++ /dev/null @@ -1,14 +0,0 @@ -c parameter (maxres22=maxres*(maxres+1)/2) - parameter (maxres22=1) - double precision w,d0,DRDG,DD,H,XX - integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, - 1 lvar_frag,svar_frag,avar_frag - COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3) -csa COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), -csa 1 lvar_frag(mxio,3),svar_frag(mxio,3), -csa 2 avar_frag(mxio,5) - COMMON /WAGI/ w(MAXRES22),d0(MAXRES22) - COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22), - 1 H(MAXRES,MAXRES),XX(MAXRES) - COMMON /frozen/ mask(maxres) - COMMON /store0/ nhpb0 diff --git a/source/unres/src_MD-DFA-restraints/COMMON.FFIELD b/source/unres/src_MD-DFA-restraints/COMMON.FFIELD deleted file mode 100644 index 29c73f0..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.FFIELD +++ /dev/null @@ -1,26 +0,0 @@ -C----------------------------------------------------------------------- -C The following COMMON block selects the type of the force field used in -C calculations and defines weights of various energy terms. -C 12/1/95 wcorr added -C----------------------------------------------------------------------- - integer n_ene_comp,rescale_mode - common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang, - & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wsct,weights(n_ene),temp0, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta, - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode - common /potentials/ potname(5) - character*3 potname -C----------------------------------------------------------------------- -C wlong,welec,wtor,wang,wscloc are the weight of the energy terms -C corresponding to side-chain, electrostatic, torsional, valence-angle, -C and local side-chain terms. -C -C IPOT determines which SC...SC interaction potential will be used: -C 1 - LJ: 2n-n Lennard-Jones -C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -C 3 - BP; Berne-Pechukas (angular dependence) -C 4 - GB; Gay-Berne (angular dependence) -C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -C------------------------------------------------------------------------ diff --git a/source/unres/src_MD-DFA-restraints/COMMON.GEO b/source/unres/src_MD-DFA-restraints/COMMON.GEO deleted file mode 100644 index 8cfbbde..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.GEO +++ /dev/null @@ -1,2 +0,0 @@ - double precision pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin - common /geo/ pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin diff --git a/source/unres/src_MD-DFA-restraints/COMMON.HAIRPIN b/source/unres/src_MD-DFA-restraints/COMMON.HAIRPIN deleted file mode 100644 index f103268..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.HAIRPIN +++ /dev/null @@ -1,5 +0,0 @@ - integer nharp_seed(max_seed),nharp_tot, - & iharp_seed(4,maxres/3,max_seed),iharp_use(0:4,maxres/3,max_seed), - & nharp_use(max_seed) - common /spinka/ nharp_seed,nharp_tot,iharp_seed,iharp_use, - & nharp_use diff --git a/source/unres/src_MD-DFA-restraints/COMMON.HEADER b/source/unres/src_MD-DFA-restraints/COMMON.HEADER deleted file mode 100644 index 7154812..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.HEADER +++ /dev/null @@ -1,2 +0,0 @@ - character*80 titel - common /header/ titel diff --git a/source/unres/src_MD-DFA-restraints/COMMON.INFO b/source/unres/src_MD-DFA-restraints/COMMON.INFO deleted file mode 100644 index 4f63708..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.INFO +++ /dev/null @@ -1,21 +0,0 @@ -c NPROCS - total number of processors; -c MyID - processor's ID; -c MasterID - master processor's ID. - integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish - logical koniec - integer tag,status(MPI_STATUS_SIZE) - common /info/ myid,masterid,allgrp,dontcare, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1) -c... 5/12/96 - added variables for collective communication -c FGPROCS - Number of fine-grain processors per coarse-grain task; -c NCTASKS - Number of coarse-grain tasks; -c MYGROUP - label of the processor's FG group id; -c BOSSID - ID of group's master; -c FGLIST - list of group's FG processors. -c MSGLEN_VAR - length of the vector of variables passed to the fine-grain -c slave processors - integer fgprocs,nctasks,mygroup,bossid,cglabel, - & cglist(max_cg_procs),cgGroupID,fglist(max_fg_procs), - & fgGroupID,MyRank - common /info1/ fgprocs,nctasks,mygroup,bossid,cglabel,cglist, - & cgGroupID,fglist,fgGroupID,MyRank,msglen_var diff --git a/source/unres/src_MD-DFA-restraints/COMMON.INTERACT b/source/unres/src_MD-DFA-restraints/COMMON.INTERACT deleted file mode 100644 index fabad93..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.INTERACT +++ /dev/null @@ -1,34 +0,0 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6 - integer expon,expon2 - integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, - & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart, - & iscpend,iatsc_s,iatsc_e, - & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw, - & ispp,iscp - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), - & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), - & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), - & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, - & ielstart(maxres),ielend(maxres),ielstart_vdw(maxres), - & ielend_vdw(maxres),nscp_gr(maxres), - & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr), - & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, - & iatscp_s,iatscp_e,ispp,iscp -C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii, - & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp - common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1), - & sigmaii(ntyp,ntyp), - & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp), - & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2), - & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2) -c 12/5/03 modified 09/18/03 Bond stretching parameters. - double precision vbldp0,vbldsc0,akp,aksc,abond0 - integer nbondterm - common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, - & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),nbondterm(ntyp) - double precision wdti,wdti2,wdti4,wdti8, - & wdtii,wdtii2,wdtii4,wdtii8 - common /nosehoover_dt/ - & wdti(maxyosh),wdti2(maxyosh),wdti4(maxyosh),wdti8(maxyosh), - & wdtii(maxyosh),wdtii2(maxyosh),wdtii4(maxyosh),wdtii8(maxyosh) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.IOUNITS b/source/unres/src_MD-DFA-restraints/COMMON.IOUNITS deleted file mode 100644 index 49b6db3..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.IOUNITS +++ /dev/null @@ -1,69 +0,0 @@ -C----------------------------------------------------------------------- -C I/O units used by the program -C----------------------------------------------------------------------- -C 9/18/99 - unit ifourier and filename fouriername included to identify -C the file from which the coefficients of second-order Fourier expansion -C of the local-interaction energy are read. -C 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) -C included. -C----------------------------------------------------------------------- -C General I/O units & files - integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, - & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, - & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart, - & irest1,isccor,ithep_pdb,irotam_pdb - common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, - & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, - & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag, - & icart,irest1,isccor,ithep_pdb,irotam_pdb - character*256 outname,intname,pdbname,mol2name,statname,intinname, - & entname,prefix,secpred,rest2name,qname,cartname,tmpdir, - & mremd_rst_name,curdir,pref_orig - character*4 liczba - common /fnames/ outname,intname,pdbname,mol2name,statname, - & intinname,entname,prefix,pot,secpred,rest2name,qname, - & cartname,tmpdir,mremd_rst_name,curdir,pref_orig,liczba -C CSA I/O units & files - character*256 csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - common /csafiles/ csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - integer icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb - common /csaunits/ icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb -C Parameter files - character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - common /parfiles/ bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - character*3 pot -C----------------------------------------------------------------------- -C INP - main input file -C IOUT - list file -C IGEOM - geometry output in the form of virtual-chain internal coordinates -C INTIN - geometry input (for multiple conformation processing) in int. coords. -C IPDB - Cartesian-coordinate output in PDB format -C IMOL2 - Cartesian-coordinate output in Tripos mol2 format -C IPDBIN - PDB input file -C ITHEP - virtual-bond torsional angle parametrs -C IROTAM - side-chain geometry and local-interaction parameters -C ITORP - torsional parameters -C ITORDP - double torsional parameters -C IFOURIER - coefficients of the expansion of local-interaction energy -C IELEP - electrostatic-interaction parameters -C ISIDEP - side-chain interaction parameters. -C ISCPP - SCp interaction parameters. -C IBOND - virtual-bond constant parameters and moments of inertia. -C ISCCOR - parameters of the potential of SCCOR term -C ICBASE - data base with Cartesian coords of known structures. -C ISTAT - energies and other conf. characteristics from an MCM run. -C IENTIN - entropy from preceeding simulation(s) to be read in. -C SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation. -C----------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN b/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN deleted file mode 100644 index 6a703e2..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN +++ /dev/null @@ -1,21 +0,0 @@ - double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2), - & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6), - & stoch_work(MAXRES6), - & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2), - & pfric_mat(MAXRES2,MAXRES2),vfric_mat(MAXRES2,MAXRES2), - & afric_mat(MAXRES2,MAXRES2),prand_mat(MAXRES2,MAXRES2), - & vrand_mat1(MAXRES2,MAXRES2),vrand_mat2(MAXRES2,MAXRES2), - & pfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & afric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & vfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & prand0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & vrand0_mat1(MAXRES2,MAXRES2,0:maxflag_stoch), - & vrand0_mat2(MAXRES2,MAXRES2,0:maxflag_stoch), - & mt1(maxres2,maxres2),mt2(maxres2,maxres2),mt3(maxres2,maxres2) - logical flag_stoch(0:maxflag_stoch) - common /langforc/ friction,stochforc, - & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1, - & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat, - & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1, - & vrand0_mat2,flag_stoch - common /langmat/ mt1,mt2,mt3 diff --git a/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN.lang0 b/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN.lang0 deleted file mode 100644 index 354a0c4..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.LANGEVIN.lang0 +++ /dev/null @@ -1,11 +0,0 @@ - double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2), - & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6), - & stoch_work(MAXRES6), - & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2) - logical flag_stoch(0:maxflag_stoch) - common /langforc/ friction,stochforc, - & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1, - & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat, - & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1, - & vrand0_mat2,flag_stoch - common /langmat/ mt1,mt2,mt3 diff --git a/source/unres/src_MD-DFA-restraints/COMMON.LOCAL b/source/unres/src_MD-DFA-restraints/COMMON.LOCAL deleted file mode 100644 index a3f68dc..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.LOCAL +++ /dev/null @@ -1,55 +0,0 @@ - double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0, - & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 - integer nlob -C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) -C Parameters of the side-chain probability distribution - common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), - & nlob(ntyp1) -C Parameters of ab initio-derived potential of virtual-bond-angle bending - integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) - common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, - & ffthet, - & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, - & ndouble,nntheterm -C Virtual-bond lenghts - double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv - integer loc_start,loc_end,ithet_start,ithet_end,iphi_start, - & iphi_end,iphid_start,iphid_end,itau_start,itau_end,ibond_start, - & ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end, - & ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1), - & ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1), - & iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1), - & iphi1_displ(0:max_fg_procs-1),iphi1_count(0:max_fg_procs-1), - & ivec_displ(0:max_fg_procs-1),ivec_count(0:max_fg_procs-1), - & iset_displ(0:max_fg_procs-1),iset_count(0:max_fg_procs-1), - & iint_count(0:max_fg_procs-1),iint_displ(0:max_fg_procs-1) - common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 - common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end,iphid_start,iphid_end,itau_start,itau_end, - & ibond_start,ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ, - & ivec_count,iset_displ, - & iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count, - & iphi_displ,iphi_count,iphi1_displ,iphi1_count -C Inverses of the actual virtual bond lengths - common /invlen/ vbld_inv(maxres2) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.LOCMOVE b/source/unres/src_MD-DFA-restraints/COMMON.LOCMOVE deleted file mode 100644 index 211516d..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.LOCMOVE +++ /dev/null @@ -1,19 +0,0 @@ -c Variables (set in init routine) never modified by local_move - integer init_called - logical locmove_output - double precision min_theta, max_theta - double precision dmin2,dmax2 - double precision flag,small,small2 - - common /loc_const/ init_called,locmove_output,min_theta, - + max_theta,dmin2,dmax2,flag,small,small2 - -c Workspace for local_move - integer a_n,b_n,res_n - double precision a_ang,b_ang,res_ang - logical a_tab,b_tab,res_tab - - common /loc_work/ res_ang(0:11),a_ang(0:7),b_ang(0:3), - + res_n,res_tab(0:2,0:2,0:11), - + a_n,a_tab(0:2,0:7), - + b_n,b_tab(0:2,0:3) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MAP b/source/unres/src_MD-DFA-restraints/COMMON.MAP deleted file mode 100644 index 77e97e7..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MAP +++ /dev/null @@ -1,4 +0,0 @@ - integer nmap,res1,res2,nstep - double precision ang_from,ang_to - common /mapp/ ang_from(maxvar),ang_to(maxvar),nmap,kang(maxvar), - & res1(maxvar),res2(maxvar),nstep(maxvar) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MAXGRAD b/source/unres/src_MD-DFA-restraints/COMMON.MAXGRAD deleted file mode 100644 index 285241a..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MAXGRAD +++ /dev/null @@ -1,12 +0,0 @@ - double precision - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - common /maxgrad/ - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MCE b/source/unres/src_MD-DFA-restraints/COMMON.MCE deleted file mode 100644 index 2d79184..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MCE +++ /dev/null @@ -1,13 +0,0 @@ - double precision entropy(-max_ene-4:max_ene),nminima(maxsave), - & nhist(-max_ene:max_ene) - logical ent_read,multican - common /mce/ entropy,emin,emax,nhist,nminima,ent_read,multican, - & indminn,indmaxx - integer npool - double precision xpool,epool,pool_fraction - common /pool/ xpool(maxvar,max_pool),epool(max_pool), - & pool_fraction,npool - integer save_frequency,message_frequency,pool_read_freq, - & pool_save_freq,print_freq - common /mce_counters/ save_frequency,message_frequency, - & pool_read_freq,pool_save_freq,print_freq diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MCM b/source/unres/src_MD-DFA-restraints/COMMON.MCM deleted file mode 100644 index 576f912..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MCM +++ /dev/null @@ -1,70 +0,0 @@ -C... Following COMMON block contains general variables controlling the MC/MCM -C... procedure -c----------------------------------------------------------------------------- - double precision Tcur,Tmin,Tmax,TstepH,TstepC,RanFract, - & overlap_cut,e_up,delte - integer nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter, - & maxrepm,ngen,ntrial,ntherm,nrepm,neneval,nsave,maxoverlap, - & nsave_part,max_mcm_it,nsweep,print_mc - logical print_stat,print_int - common /mcm/ Tcur,Tmin,Tmax,TstepH,TstepC,Rbol,betbol,RanFract, - & overlap_cut,e_up,delte, - & nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,maxrepm, - & maxoverlap,ntrial,max_mcm_it, - & ngen,ntherm,nrepm,neneval,nsave,nsave_part(max_cg_procs),nsweep, - & print_mc,print_stat,print_int -c----------------------------------------------------------------------------- -C... The meaning of the above variables is as follows: -C... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively; -C... NstepC,NStepH - Number of cooling and heating steps, respectively; -C... TstepH,TstepC - factors by which T is multiplied in order to be -C... increased or decreased. -C... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur)); -C... Rbol - the gas constant; -C... RanFract - the chance that a new conformation will be random-generated; -C... maxacc - maximum number of accepted conformations; -C... maxgen,ngen - Maximum and current number of generated conformations; -C... maxtrial,ntrial - maximum number of trials before temperature is increased -C... and current number of trials, respectively; -C... maxrepm,nrepm - maximum number of allowed minima repetition and current -C... number of minima repetitions, respectively; -C... maxoverlap - max. # of overlapping confs generated in a single iteration; -C... neneval - number of energy evaluations; -C... nsave - number of confs. in the backup array; -C... nsweep - the number of macroiterations in generating the distributions. -c------------------------------------------------------------------------------ -C... Following COMMON block contains variables controlling motion. -c------------------------------------------------------------------------------ - double precision sumpro_type,sumpro_bond - integer koniecl, Nbm,MaxSideMove,nmove,moves(-1:MaxMoveType+1), - & moves_acc(-1:MaxMoveType+1),nacc_tot,nacc_part(0:MaxProcs) - common /move/ sumpro_type(0:MaxMoveType),sumpro_bond(0:maxres), - & koniecl,Nbm,MaxSideMove,nmove,nbond_move(maxres), - & nbond_acc(maxres),moves,moves_acc - common /accept_stats/ nacc_tot,nacc_part - integer nwindow,winstart,winend,winlen - common /windows/ nwindow,winstart(maxres),winend(maxres), - & winlen(maxres) - character*16 MovTypID - common /moveID/ MovTypID(-1:MaxMoveType+1) -c------------------------------------------------------------------------------ -C... koniecl - the number of bonds to be considered "end bonds" subjected to -C... end moves; -C... Nbm - The maximum length of N-bond segment to be moved; -C... MaxSideMove - maximum number of side chains subjected to local moves -C... simultaneously; -C... nmove - the current number of attempted moves; -C... nbond_move(*) array that stores the total numbers of 2-bond,3-bond,... -C... moves; -C... nendmove - number of endmoves; -C... nbackmove - number of backbone moves; -C... nsidemove - number of local side chain moves; -C... sumpro_type(*) - array that stores the lower and upper boundary of the -C... random-number range that determines the type of move -C... (N-bond, backbone or side chain); -C... sumpro_bond(*) - array that stores the probabilities to perform bond -C... moves of consecutive segment length. -C... winstart(*) - the starting position of the perturbation window; -C... winend(*) - the end position of the perturbation window; -C... winlen(*) - length of the perturbation window; -C... nwindow - the number of perturbation windows (0 - entire chain). diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MD b/source/unres/src_MD-DFA-restraints/COMMON.MD deleted file mode 100644 index bd38d1b..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MD +++ /dev/null @@ -1,87 +0,0 @@ - double precision gcart, gxcart, gradcag,gradxag - common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES), - & gradcag(3,MAXRES),gradxag(3,MAXRES) - integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), - & ipair(2,100,maxprocs/20),iset, - & mset(maxprocs/20),nset - double precision IP,ISC(ntyp+1),mp, - & msc(ntyp+1),d_t_work(MAXRES6), - & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), - & d_af_work(MAXRES6),d_as_work(MAXRES6), - & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2), - & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2), - & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6), - & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), - & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) - - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), - & dih(max_template,maxres),sigma_dih(max_template,maxres) - - integer ires_homo(maxdim),jres_homo(maxdim) - - double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, - & edriftmax, - & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), - & qfrag(50),qpair(100), - & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20), - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, - & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), - & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), - & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), - & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), - & uconst_back - integer n_timestep,ntwx,ntwe,lang,count_reset_moment, - & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, - & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0, - & maxtime_split,lim_odl,lim_dih,link_start_homo,link_end_homo, - & idihconstr_start_homo,idihconstr_end_homo - integer nresn,nyosh,nnos - double precision glogs,qmass,vlogs,xlogs - logical large,print_compon,tbf,rest,reset_moment,reset_vel, - & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp - integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts, - & nginv_start,nginv_counts,myginv_ng_count - common /back_constr/ uconst_back,utheta,ugamma,uscdiff, - & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back - common /homrestr/ odl,dih,sigma_dih,sigma_odl, - & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo, - & link_end_homo,idihconstr_start_homo,idihconstr_end_homo - common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, - & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag - common /mdpar/ v_ini,d_time,d_time0,scal_fric, - & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, - & ntime_split,ntime_split0,maxtime_split, - & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh - common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax, - & kinetic_T - common /lagrange/ d_t,d_t_old,d_t_new,d_t_work, - & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short, - & kinetic_force, - & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm, - & vtot,dimen,dimen1,dimen3,lang, - & reset_moment,reset_vel,count_reset_moment,count_reset_vel, - & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC - double precision scal_fric,rwat,etawat,gamp, - & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES), - & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb - common /langevin/ pstok,restok,gamp,gamsc, - & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea, - & reset_fricmat - common /mdpmpi/ igmult_start,igmult_end,my_ng_count, - & myginv_ng_count, - & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), - & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) - double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit,hhh - common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit,hhh - common /nosehoover/ glogs(maxmnh),qmass(maxmnh), - & vlogs(maxmnh),xlogs(maxmnh), - & nresn,nyosh,nnos,xiresp - integer hmc,hmc_acc - double precision dc_hmc,hmc_etot,totThmc - common /hmc_md/ dc_hmc(3,0:maxres2),hmc_etot,totThmc,hmc,hmc_acc diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MINIM b/source/unres/src_MD-DFA-restraints/COMMON.MINIM deleted file mode 100644 index e44f9cd..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MINIM +++ /dev/null @@ -1,5 +0,0 @@ - double precision tolf,rtolf - integer maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res - common /minimm/ tolf,rtolf,maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res diff --git a/source/unres/src_MD-DFA-restraints/COMMON.MUCA b/source/unres/src_MD-DFA-restraints/COMMON.MUCA deleted file mode 100644 index 7529c15..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.MUCA +++ /dev/null @@ -1,10 +0,0 @@ - double precision emuca(4*maxres),nemuca(4*maxres), - & nemuca2(4*maxres),elow,ehigh,factor, - & elowi(maxprocs),ehighi(maxprocs),hbin, - & hist(4*maxres),factor_min - integer nmuca,imtime,muca_smooth - common /double_muca/ emuca,nemuca, - & nemuca2,elow,ehigh,factor,hbin,hist,factor_min - common /integer_muca/ nmuca,imtime,muca_smooth - common /mucarem/ elowi,ehighi - diff --git a/source/unres/src_MD-DFA-restraints/COMMON.NAMES b/source/unres/src_MD-DFA-restraints/COMMON.NAMES deleted file mode 100644 index e6f926b..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.NAMES +++ /dev/null @@ -1,7 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(n_ene),wname(n_ene),nprint_ene, - & print_order(n_ene) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.REMD b/source/unres/src_MD-DFA-restraints/COMMON.REMD deleted file mode 100644 index b283b5b..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.REMD +++ /dev/null @@ -1,36 +0,0 @@ - integer nrep,nstex,hremd - logical remd_tlist,remd_mlist,mremdsync,restart1file,traj1file - double precision retmin,retmax,remd_t(maxprocs) - double precision hweights(maxprocs/20,n_ene) - integer remd_m(maxprocs),i_sync_step - integer*2 i2rep(0:maxprocs),i2set(0:maxprocs) - integer*2 ifirst(maxprocs) - integer*2 nupa(0:maxprocs/4,0:maxprocs), - & ndowna(0:maxprocs/4,0:maxprocs) - real t_restart1(5,maxprocs) - integer iset_restart1(maxprocs) - logical t_exchange_only - common /remdcommon/ nrep,nstex,retmin,retmax,remd_t,remd_tlist, - & remd_mlist,remd_m,mremdsync,restart1file, - & traj1file,i_sync_step,t_exchange_only - common /hamilt_remd/ hweights,hremd - common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, - & iset_restart1 - real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache,uscdiff_cache, - & ugamma_cache,utheta_cache - integer ntwx_cache,ii_write,max_cache_traj_use - common /traj1cache/ totT_cache(max_cache_traj), - & EK_cache(max_cache_traj), - & potE_cache(max_cache_traj), - & t_bath_cache(max_cache_traj), - & Uconst_cache(max_cache_traj), - & qfrag_cache(50,max_cache_traj), - & qpair_cache(100,max_cache_traj), - & ugamma_cache(maxfrag_back,max_cache_traj), - & utheta_cache(maxfrag_back,max_cache_traj), - & uscdiff_cache(maxfrag_back,max_cache_traj), - & c_cache(3,maxres2+2,max_cache_traj), - & iset_cache(max_cache_traj),ntwx_cache, - & ii_write,max_cache_traj_use - diff --git a/source/unres/src_MD-DFA-restraints/COMMON.SBRIDGE b/source/unres/src_MD-DFA-restraints/COMMON.SBRIDGE deleted file mode 100644 index 91dd2cd..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.SBRIDGE +++ /dev/null @@ -1,17 +0,0 @@ - double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss - common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) - double precision dhpb,dhpb1,forcon - integer ihpb,jhpb,nhpb,idssb,jdssb - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb - double precision weidis - common /restraints/ weidis - integer link_start,link_end - common /links_split/ link_start,link_end - double precision Ht,dyn_ssbond_ij - logical dyn_ss,dyn_ss_mask - common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim), - & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.SCCOR b/source/unres/src_MD-DFA-restraints/COMMON.SCCOR deleted file mode 100644 index 8de6d3c..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.SCCOR +++ /dev/null @@ -1,17 +0,0 @@ -cc Parameters of the SCCOR term - double precision v1sccor,v2sccor,vlor1sccor, - & vlor2sccor,vlor3sccor,gloc_sc, - & dcostau,dsintau,dtauangle,dcosomicron, - & domicron,v0sccor - integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor - common/sccor/v1sccor(maxterm_sccor,3,20,20), - & v2sccor(maxterm_sccor,3,20,20), - & vlor1sccor(maxterm_sccor,20,20), - & vlor2sccor(maxterm_sccor,20,20), - & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), - & v0sccor(ntyp,ntyp), - & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), - & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), - & domicron(3,3,3,maxres2), - & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp, - & nlor_sccor(ntyp,ntyp) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.SCROT b/source/unres/src_MD-DFA-restraints/COMMON.SCROT deleted file mode 100644 index 2da7b8f..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.SCROT +++ /dev/null @@ -1,3 +0,0 @@ -C Parameters of the SC rotamers (local) term - double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.SETUP b/source/unres/src_MD-DFA-restraints/COMMON.SETUP deleted file mode 100644 index 5039116..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.SETUP +++ /dev/null @@ -1,21 +0,0 @@ - integer king,idint,idreal,idchar,is_done - parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1) - integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1), - & kolor1,key1,nfgtasks1,MyRank, - & max_gs_size - logical yourjob, finished, cgdone - common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs, - & nfgtasks,nfgtasks1, - & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp - integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1), - & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1), - & MPI_PRECOMP23(0:1) - common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12, - & MPI_PRECOMP22,MPI_PRECOMP23 diff --git a/source/unres/src_MD-DFA-restraints/COMMON.SPLITELE b/source/unres/src_MD-DFA-restraints/COMMON.SPLITELE deleted file mode 100644 index a2f0447..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.SPLITELE +++ /dev/null @@ -1,2 +0,0 @@ - double precision r_cut,rlamb - common /splitele/ r_cut,rlamb diff --git a/source/unres/src_MD-DFA-restraints/COMMON.THREAD b/source/unres/src_MD-DFA-restraints/COMMON.THREAD deleted file mode 100644 index 5c814cc..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.THREAD +++ /dev/null @@ -1,7 +0,0 @@ - integer nthread,nexcl,iexam,ipatt - double precision ener0,ener,max_time_for_thread, - & ave_time_for_thread - common /thread/ nthread,nexcl,iexam(2,maxthread), - & ipatt(2,maxthread) - common /thread1/ ener0(n_ene+2,maxthread),ener(n_ene+2,maxthread), - & max_time_for_thread,ave_time_for_thread diff --git a/source/unres/src_MD-DFA-restraints/COMMON.TIME1 b/source/unres/src_MD-DFA-restraints/COMMON.TIME1 deleted file mode 100644 index d6203a6..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.TIME1 +++ /dev/null @@ -1,28 +0,0 @@ - DOUBLE PRECISION BATIME,TIMLIM,STIME,PREVTIM,SAFETY - DOUBLE PRECISION WALLTIME - INTEGER ISTOP -c FOUND_NAN - set by calcf to stop sumsl via stopx - logical FOUND_NAN - COMMON/TIME1/STIME,TIMLIM,BATIME,PREVTIM,SAFETY,WALLTIME - COMMON/STOPTIM/ISTOP - common /sumsl_flag/ FOUND_NAN - double precision t_init,t_MDsetup,t_langsetup,t_MD, - & t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_barrier_e,time_barrier_g,time_scatter, - & t_eelecij,time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_scatter_fmat,time_scatter_ginv, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_stoch,t_eshort,t_elong,t_etotal - common /timing/ t_init,t_MDsetup,t_langsetup, - & t_MD,t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_scatter,time_barrier_e,time_barrier_g, - & time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & t_eelecij,time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_scatter_fmat,time_scatter_ginv, - & time_stoch,t_eshort,t_elong,t_etotal diff --git a/source/unres/src_MD-DFA-restraints/COMMON.TORCNSTR b/source/unres/src_MD-DFA-restraints/COMMON.TORCNSTR deleted file mode 100644 index e4af17c..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.TORCNSTR +++ /dev/null @@ -1,6 +0,0 @@ - integer ndih_constr,idih_constr(maxdih_constr) - integer ndih_nconstr,idih_nconstr(maxdih_constr) - integer idihconstr_start,idihconstr_end - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end diff --git a/source/unres/src_MD-DFA-restraints/COMMON.TORSION b/source/unres/src_MD-DFA-restraints/COMMON.TORSION deleted file mode 100644 index 6b6605f..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.TORSION +++ /dev/null @@ -1,23 +0,0 @@ -C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), - & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor) - & ,nterm_old -C 6/23/01 - constants for double torsionals - double precision v1c,v1s,v2c,v2s - integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) -C 9/18/99 - added Fourier coeffficients of the expansion of local energy -C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp diff --git a/source/unres/src_MD-DFA-restraints/COMMON.VAR b/source/unres/src_MD-DFA-restraints/COMMON.VAR deleted file mode 100644 index edc81d7..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.VAR +++ /dev/null @@ -1,21 +0,0 @@ -C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, - & mask_theta,mask_phi,mask_side - double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, - & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,xxref,yyref,zzref,tauangle,omicron - common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & omicron(2,maxres),tauangle(3,maxres), - & vbld(2*maxres),thetaref(maxres),phiref(maxres), - & costtab(maxres), sinttab(maxres), cost2tab(maxres), - & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar -C Store the angles and variables corresponding to old conformations (for use -C in MCM). - common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), - & Origin(maxsave),nstore -C freeze some variables - logical mask_r - common /restr/ varall(maxvar),mask_r,mask_theta(maxres), - & mask_phi(maxres),mask_side(maxres) diff --git a/source/unres/src_MD-DFA-restraints/COMMON.VECTORS b/source/unres/src_MD-DFA-restraints/COMMON.VECTORS deleted file mode 100644 index d880c24..0000000 --- a/source/unres/src_MD-DFA-restraints/COMMON.VECTORS +++ /dev/null @@ -1,3 +0,0 @@ - common /vectors/ uy(3,maxres),uz(3,maxres), - & uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres) - diff --git a/source/unres/src_MD-DFA-restraints/DIMENSIONS b/source/unres/src_MD-DFA-restraints/DIMENSIONS deleted file mode 100644 index 6546327..0000000 --- a/source/unres/src_MD-DFA-restraints/DIMENSIONS +++ /dev/null @@ -1,142 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - integer maxprocs - parameter (maxprocs=2048) -C Max. number of fine-grain processors - integer max_fg_procs -c parameter (max_fg_procs=maxprocs) - parameter (max_fg_procs=512) -C Max. number of coarse-grain processors - integer max_cg_procs - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=800) -C Appr. max. number of interaction sites - integer maxres2,maxres6,mmaxres2 - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) -C Max. number of variables - integer maxvar - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres/4) -c parameter (maxconts=50) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=6) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=10) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=20) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=20) -C Max. number of energy intervals - integer max_ene - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=10) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=10) -C Number of energy components - integer n_ene,n_ene2 - parameter (n_ene=28,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -csaC Maximum number of generated conformations -csa integer mxio -csa parameter (mxio=2) -csaC Maximum number of n7 generated conformations -csa integer mxio2 -csa parameter (mxio2=2) -csaC Maximum number of moves (n1-n8) -csa integer mxmv -csa parameter (mxmv=18) -csaC Maximum number of seed -csa integer max_seed -csa parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) -C Maximum number of backbone fragments in restraining - integer maxfrag_back - parameter (maxfrag_back=4) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) -C Maximum number of conformation stored in cache on each CPU before sending -C to master; depends on nstex / ntwx ratio - integer max_cache_traj - parameter (max_cache_traj=10) -C Nose-Hoover chain - chain length and order of Yoshida algorithm - integer maxmnh,maxyosh - parameter(maxmnh=10,maxyosh=5) -C Maximum number of templates in homology-modeling restraints - integer max_template - parameter(max_template=19) diff --git a/source/unres/src_MD-DFA-restraints/DIMENSIONS.2100 b/source/unres/src_MD-DFA-restraints/DIMENSIONS.2100 deleted file mode 100644 index 7990793..0000000 --- a/source/unres/src_MD-DFA-restraints/DIMENSIONS.2100 +++ /dev/null @@ -1,80 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - parameter (maxprocs=2100) -C Max. number of fine-grain processors - parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - parameter (maxres=150) -C Appr. max. number of interaction sites - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres6=(maxres6*(maxres6+1)/2)) -C Max. number of variables - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - parameter (maxconts=maxres) -C Number of AA types (at present only natural AA's will be handled - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of lobes in SC distribution - parameter (maxlob=4) -C Max. number of S-S bridges - parameter (maxss=20) -C Max. number of dihedral angle constraints - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - parameter (maxres_base=10) -C Max. number of threading attempts - parameter (maxthread=20) -C Max. number of move types in MCM - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - parameter (maxsave=20) -C Max. number of energy intervals - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - parameter (max_cache=10) -C Max. number of conformations in the pool - parameter (max_pool=10) -C Number of energy components - parameter (n_ene=22,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - parameter (mxang=4) -C Maximum number of groups of angles - parameter (mxgr=2*maxres) -C Maximum number of chains - parameter (mxch=1) -C Maximum number of generated conformations - parameter (mxio=2) -C Maximum number of n7 generated conformations - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - parameter (mxmv=18) -C Maximum number of seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) diff --git a/source/unres/src_MD-DFA-restraints/DIMENSIONS.4100 b/source/unres/src_MD-DFA-restraints/DIMENSIONS.4100 deleted file mode 100644 index 2a68d39..0000000 --- a/source/unres/src_MD-DFA-restraints/DIMENSIONS.4100 +++ /dev/null @@ -1,80 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - parameter (maxprocs=4100) -C Max. number of fine-grain processors - parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - parameter (maxres=150) -C Appr. max. number of interaction sites - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres6=(maxres6*(maxres6+1)/2)) -C Max. number of variables - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - parameter (maxconts=maxres) -C Number of AA types (at present only natural AA's will be handled - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of lobes in SC distribution - parameter (maxlob=4) -C Max. number of S-S bridges - parameter (maxss=20) -C Max. number of dihedral angle constraints - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - parameter (maxres_base=10) -C Max. number of threading attempts - parameter (maxthread=20) -C Max. number of move types in MCM - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - parameter (maxsave=20) -C Max. number of energy intervals - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - parameter (max_cache=10) -C Max. number of conformations in the pool - parameter (max_pool=10) -C Number of energy components - parameter (n_ene=22,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - parameter (mxang=4) -C Maximum number of groups of angles - parameter (mxgr=2*maxres) -C Maximum number of chains - parameter (mxch=1) -C Maximum number of generated conformations - parameter (mxio=2) -C Maximum number of n7 generated conformations - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - parameter (mxmv=18) -C Maximum number of seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) diff --git a/source/unres/src_MD-DFA-restraints/MD_A-MTS.F b/source/unres/src_MD-DFA-restraints/MD_A-MTS.F deleted file mode 100644 index 95f174d..0000000 --- a/source/unres/src_MD-DFA-restraints/MD_A-MTS.F +++ /dev/null @@ -1,3461 +0,0 @@ - subroutine MD -c------------------------------------------------ -c The driver for molecular dynamics subroutines -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision cm(3),L(3),vcm(3) -#ifdef VOUT - double precision v_work(maxres6),v_transf(maxres6) -#endif - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -c -#ifdef MPI - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_" - & //liczba(:ilen(liczba))//'.rst') -#else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst') -#endif - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - do itime=1,n_timestep - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) - write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) -#ifdef VOUT - do j=1,3 - v_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i+nres) - enddo - endif - enddo - - write (66,'(80f10.5)') - & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres) - do i=1,ind - v_transf(i)=0.0d0 - do j=1,ind - v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j) - enddo - v_transf(i)= v_transf(i)*dsqrt(geigen(i)) - enddo - write (67,'(80f10.5)') (v_transf(i),i=1,ind) -#endif - endif - if (mod(itime,ntwx).eq.0) then - write (tytul,'("time",f8.2)') totT - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - close(irest2) - rstcount=0 - endif - enddo -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' -#ifdef TIMING_ENE - write (iout,*) "time for etotal",t_etotal," elong",t_elong, - & " eshort",t_eshort - write (iout,*) "time_fric",time_fric," time_stoch",time_stoch, - & " time_fricmatmult",time_fricmatmult," time_fsample ", - & time_fsample -#endif - return - end -c------------------------------------------------------------------------------- - subroutine velverlet_step(itime) -c------------------------------------------------------------------------------- -c Perform a single velocity Verlet step; the time step can be rescaled if -c increments in accelerations exceed the threshold -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror,ierrcode -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.MUCA' - double precision vcm(3),incr(3) - double precision cm(3),L(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /20/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - double precision HNose1,HNose,HNose_nh,H,vtnp(maxres6) - double precision vtnp_(maxres6),vtnp_a(maxres6) -c - scale=.true. - icount_scale=0 - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - itime_scal=0 - do while (scale) - icount_scale=icount_scale+1 - if (icount_scale.gt.maxcount_scale) then - write (iout,*) - & "ERROR: too many attempts at scaling down the time step. ", - & "amax=",amax,"epdrift=",epdrift, - & "damax=",damax,"edriftmax=",edriftmax, - & "d_time=",d_time - call flush(iout) -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE) -#endif - stop - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else if (tnp1) then - call tnp1_step1 - else if (tnp) then - call tnp_step1 - else - if (tnh) then - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)*scale_nh - enddo - enddo - endif - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,*) "dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) -#ifdef TIMING_ENE -#ifdef MPI - t_etotal=t_etotal+MPI_Wtime()-tt0 -#else - t_etotal=t_etotal+tcpu()-tt0 -#endif -#endif - E_old=potE - potE=potEcomp(0)-potEcomp(20) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/(itime_scal+1)**2 - call predict_edrift(epdrift) - if (amax/(itime_scal+1).gt.damax .or. epdrift.gt.edriftmax) then -c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step - scale=.true. - ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax)) - & /dlog(2.0d0)+1 - itime_scal=itime_scal+ifac_time -c fac_time=dmin1(damax/amax,0.5d0) - fac_time=0.5d0**ifac_time - d_time=d_time*fac_time - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 -c write (iout,*) "Calling sd_verlet_setup: 1" -c Rescale the stochastic forces and recalculate or restore -c the matrices of tinker integrator - if (itime_scal.gt.maxflag_stoch) then - if (large) write (iout,'(a,i5,a)') - & "Calculate matrices for stochastic step;", - & " itime_scal ",itime_scal - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - write (iout,'(2a,i3,a,i3,1h.)') - & "Warning: cannot store matrices for stochastic", - & " integration because the index",itime_scal, - & " is greater than",maxflag_stoch - write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct", - & " integration Langevin algorithm for better efficiency." - else if (flag_stoch(itime_scal)) then - if (large) write (iout,'(a,i5,a,l1)') - & "Restore matrices for stochastic step; itime_scal ", - & itime_scal," flag ",flag_stoch(itime_scal) - do i=1,dimen3 - do j=1,dimen3 - pfric_mat(i,j)=pfric0_mat(i,j,itime_scal) - afric_mat(i,j)=afric0_mat(i,j,itime_scal) - vfric_mat(i,j)=vfric0_mat(i,j,itime_scal) - prand_mat(i,j)=prand0_mat(i,j,itime_scal) - vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal) - vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal) - enddo - enddo - else - if (large) write (iout,'(2a,i5,a,l1)') - & "Calculate & store matrices for stochastic step;", - & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal) - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - flag_stoch(ifac_time)=.true. - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,itime_scal)=pfric_mat(i,j) - afric0_mat(i,j,itime_scal)=afric_mat(i,j) - vfric0_mat(i,j,itime_scal)=vfric_mat(i,j) - prand0_mat(i,j,itime_scal)=prand_mat(i,j) - vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j) - vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j) - enddo - enddo - endif - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen3 - stochforcvec(i)=fac_time*stochforcvec(i) - enddo -#endif - else if (lang.eq.1) then -c Rescale the accelerations due to stochastic forces - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen3 - d_as_work(i)=d_as_work(i)*fac_time - enddo - endif - if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)') - & "itime",itime," Timestep scaled down to ", - & d_time," ifac_time",ifac_time," itime_scal",itime_scal - else -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else if (tnp1) then - call tnp1_step2 - else if (tnp) then - call tnp_step2 - else - call verlet2 - if (tnh) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - endif - if (rattle) call rattle2 - totT=totT+d_time - if (d_time.ne.d_time0) then - d_time=d_time0 -#ifndef LANG0 - if (lang.eq.2 .or. lang.eq.3) then - if (large) write (iout,'(a)') - & "Restore original matrices for stochastic step" -c write (iout,*) "Calling sd_verlet_setup: 2" -c Restore the matrices of tinker integrator if the time step has been restored - do i=1,dimen3 - do j=1,dimen3 - pfric_mat(i,j)=pfric0_mat(i,j,0) - afric_mat(i,j)=afric0_mat(i,j,0) - vfric_mat(i,j)=vfric0_mat(i,j,0) - prand_mat(i,j)=prand0_mat(i,j,0) - vrand_mat1(i,j)=vrand0_mat1(i,j,0) - vrand_mat2(i,j)=vrand0_mat2(i,j,0) - enddo - enddo - endif -#endif - endif - scale=.false. - endif - enddo -c Calculate the kinetic and the total energy and the kinetic temperature - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - d_t(j,i)=d_t(j,i)/s_np - enddo - enddo - endif - call kinetic(EK) - totE=EK+potE -c diagnostics -c call kinetic1(EK1) -c write (iout,*) "step",itime," EK",EK," EK1",EK1 -c end diagnostics -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) then - - if(tnp .or. tnp1) then - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H=(HNose1-H0)*s_np -cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 -cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H=HNose1-H0 - hhh=h -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - endif - - if (large) then - itnp=0 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,inres) - enddo - endif - enddo - -c Transform velocities from UNRES coordinate space to cartesian and Gvec -c eigenvector space - - do i=1,dimen3 - vtnp_(i)=0.0d0 - vtnp_a(i)=0.0d0 - do j=1,dimen3 - vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j) - vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j) - enddo - vtnp_(i)=vtnp_(i)*dsqrt(geigen(i)) - enddo - - do i=1,dimen3 - write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i) - enddo - - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - endif - return - end -c------------------------------------------------------------------------------- - subroutine RESPA_step(itime) -c------------------------------------------------------------------------------- -c Perform a single RESPA step. -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision energia_short(0:n_ene), - & energia_long(0:n_ene) - double precision cm(3),L(3),vcm(3),incr(3) - double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2), - & d_a_old0(3,0:maxres2) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /10/ - common /gucio/ cm,energia_short - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - double precision vtnp(maxres6), vtnp_(maxres6), vtnp_a(maxres6) - common /cipiszcze/ itt - itt=itime - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***************** RESPA itime",itime - write (iout,*) "Cartesian and internal coordinates: step 0" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 0" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c -c Perform the initial RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA ini" - if (tnp1) then - call tnp_respa_step1 - else if (tnp) then - call tnp_respa_step1 - else - if (tnh.and..not.xiresp) then - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - call RESPA_vel - endif - -cd if(tnp .or. tnp1) then -cd write (iout,'(a,3f)') "EE1 NP S, pi",totT, s_np, pi_np -cd endif - - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the short-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif -C 7/2/2009 commented out -c call zerograd -c call etotal_short(energia_short) - if (tnp.or.tnp1) potE=energia_short(0) -c call cartgrad -c call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces from previous MD step - do i=0,2*nres - do j=1,3 - d_a(j,i)=d_a_short(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo -c 6/30/08 A-MTS: attempt at increasing the split number - do i=0,2*nres - do j=1,3 - dc_old0(j,i)=dc_old(j,i) - d_t_old0(j,i)=d_t_old(j,i) - d_a_old0(j,i)=d_a_old(j,i) - enddo - enddo - if (ntime_split.gt.ntime_split0) ntime_split=ntime_split/2 - if (ntime_split.lt.ntime_split0) ntime_split=ntime_split0 -c - scale=.true. - d_time0=d_time - do while (scale) - - scale=.false. -c write (iout,*) "itime",itime," ntime_split",ntime_split -c Split the time step - d_time=d_time0/ntime_split -c Perform the short-range RESPA steps (velocity Verlet increments of -c positions and velocities using short-range forces) -c write (iout,*) "*********************** RESPA split" - do itsplit=1,ntime_split - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else if (tnp1) then - call tnp1_respa_i_step1 - else if (tnp) then - call tnp_respa_i_step1 - else - if (tnh.and.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8) - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)*scale_nh - enddo - enddo -cd write(iout,*) "SSS1",itsplit,EK,scale_nh - endif - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***** ITSPLIT",itsplit - write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) -c call cartprint - call intout - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal_short(energia_short) - E_old=potE - potE=energia_short(0) -#ifdef TIMING_ENE -#ifdef MPI - t_eshort=t_eshort+MPI_Wtime()-tt0 -#else - t_eshort=t_eshort+tcpu()-tt0 -#endif -#endif - call cartgrad -c Get the new accelerations - call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*)"energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -c 6/30/08 A-MTS -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/ntime_split**2 - call predict_edrift(epdrift) - if (ntwe.gt.0 .and. large .and. mod(itime,ntwe).eq.0) - & write (iout,*) "amax",amax," damax",damax, - & " epdrift",epdrift," epdriftmax",epdriftmax -c Exit loop and try with increased split number if the change of -c acceleration is too big - if (amax.gt.damax .or. epdrift.gt.edriftmax) then - if (ntime_split.lt.maxtime_split) then - scale=.true. - ntime_split=ntime_split*2 - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc_old0(j,i) - d_t_old(j,i)=d_t_old0(j,i) - d_a_old(j,i)=d_a_old0(j,i) - enddo - enddo - write (iout,*) "acceleration/energy drift too large",amax, - & epdrift," split increased to ",ntime_split," itime",itime, - & " itsplit",itsplit - exit - else - write (iout,*) - & "Uh-hu. Bumpy landscape. Maximum splitting number", - & maxtime_split, - & " already reached!!! Trying to carry on!" - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else if (tnp1) then - call tnp1_respa_i_step2 - else if (tnp) then - call tnp_respa_i_step2 - else - call verlet2 - if (tnh.and.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo -cd write(iout,*) "SSS2",itsplit,EK,scale_nh - endif - endif - if (rattle) call rattle2 -c Backup the coordinates, velocities, and accelerations - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - if (tnp) d_t(j,i)=d_t(j,i)/s_np - if (tnp1) d_t(j,i)=d_t(j,i)/s_np - enddo - enddo - endif - - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - enddo - - enddo ! while scale - -c Restore the time step - d_time=d_time0 -c Compute long-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - E_long=energia_long(0) - potE=energia_short(0)+energia_long(0) -#ifdef TIMING_ENE -#ifdef MPI - t_elong=t_elong+MPI_Wtime()-tt0 -#else - t_elong=t_elong+tcpu()-tt0 -#endif -#endif - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Compute accelerations from long-range forces - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Cartesian and internal coordinates: step 2" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the final RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA fin" - if (tnp1) then - call tnp_respa_step2 - else if (tnp) then - call tnp_respa_step2 - else - call RESPA_vel - if (tnh.and..not.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - endif - - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_old(j,i)/s_np - enddo - enddo - endif - -c Compute the complete potential energy - do i=0,n_ene - potEcomp(i)=energia_short(i)+energia_long(i) - enddo - potE=potEcomp(0)-potEcomp(20) -c potE=energia_short(0)+energia_long(0) - totT=totT+d_time -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - - if (mod(itime,ntwe).eq.0) then - - if(tnp .or. tnp1) then -#ifndef G77 - write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit, - & E_long,energia_short(0) -#else - write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit, - & E_long,energia_short(0) -#endif - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H=(HNose1-H0)*s_np -cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 -cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h -cd write (iout,'(a,3f)') "EE2 NP S, pi",totT, s_np, pi_np - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H=HNose1-H0 -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h - endif - - - if (large) then - itnp=0 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,inres) - enddo - endif - enddo - -c Transform velocities from UNRES coordinate space to cartesian and Gvec -c eigenvector space - - do i=1,dimen3 - vtnp_(i)=0.0d0 - vtnp_a(i)=0.0d0 - do j=1,dimen3 - vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j) - vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j) - enddo - vtnp_(i)=vtnp_(i)*dsqrt(geigen(i)) - enddo - - do i=1,dimen3 - write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i) - enddo - - endif - endif - endif - - - return - end -c--------------------------------------------------------------------- - subroutine RESPA_vel -c First and last RESPA step (incrementing velocities using long-range -c forces). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine verlet1 -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2 - -#ifdef DEBUG - write (iout,*) "VELVERLET1 START: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - do j=1,3 - adt=d_a_old(j,0)*d_time - adt2=0.5d0*adt - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+adt2 - d_t(j,0)=d_t_old(j,0)+adt - enddo - do i=nnt,nct-1 - do j=1,3 - adt=d_a_old(j,i)*d_time - adt2=0.5d0*adt - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+adt2 - d_t(j,i)=d_t_old(j,i)+adt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=d_a_old(j,inres)*d_time - adt2=0.5d0*adt - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+adt2 - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - endif - enddo -#ifdef DEBUG - write (iout,*) "VELVERLET1 END: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - return - end -c--------------------------------------------------------------------- - subroutine verlet2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine sddir_precalc -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute friction and stochastic forces -c -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call friction_force -#ifdef MPI - time_fric=time_fric+MPI_Wtime()-time00 - time00=MPI_Wtime() -#else - time_fric=time_fric+tcpu()-time00 - time00=tcpu() -#endif - call stochastic_force(stochforcvec) -#ifdef MPI - time_stoch=time_stoch+MPI_Wtime()-time00 -#else - time_stoch=time_stoch+tcpu()-time00 -#endif -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(fric_work, d_af_work) - call ginv_mult(stochforcvec, d_as_work) - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet1 -c Applying velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. - double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3) - double precision adt,adt2 -c -c Add the contribution from BOTH friction and stochastic force to the -c coordinates, but ONLY the contribution from the friction forces to velocities -c - do j=1,3 - adt=(d_a_old(j,0)+d_af_work(j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt - d_t(j,0)=d_t_old(j,0)+adt - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt - d_t(j,i)=d_t_old(j,i)+adt - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6) - double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/ -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. -c The correlation coefficients are calculated at low-friction limit. -c Also, friction forces are now not calculated with new velocities. - -c call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(stochforcvec, d_as_work1) - -c -c Update velocities -c - do j=1,3 - d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j)) - & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j)) - & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) - & +d_af_work(ind+j))+sin60*d_as_work(ind+j) - & +cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine max_accel -c -c Find the maximum difference in the accelerations of the the sites -c at the beginning and the end of the time step. -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision aux(3),accel(3),accel_old(3),dacc - do j=1,3 -c aux(j)=d_a(j,0)-d_a_old(j,0) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - amax=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then -c 7/3/08 changed to asymmetric difference - do j=1,3 -c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) - accel_old(j)=accel_old(j)+0.5d0*d_a_old(j,i) - accel(j)=accel(j)+0.5d0*d_a(j,i) -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - endif - enddo -c Side chains - do j=1,3 -c accel(j)=aux(j) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - if (nnt.eq.2) then - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,1) - accel(j)=accel(j)+d_a(j,1) - enddo - endif - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 -c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) - accel_old(j)=accel_old(j)+d_a_old(j,i+nres) - accel(j)=accel(j)+d_a(j,i+nres) - enddo - endif - do j=1,3 -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,i) - accel(j)=accel(j)+d_a(j,i) -c aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i) - enddo - enddo - return - end -c--------------------------------------------------------------------- - subroutine predict_edrift(epdrift) -c -c Predict the drift of the potential energy -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MUCA' - double precision epdrift,epdriftij -c Drift of the potential energy - epdrift=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "back",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif -c Side chains - if (itype(i).ne.10) then - do j=1,3 - epdriftij= - & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "side",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif - enddo - epdrift=0.5d0*epdrift*d_time*d_time -c write (iout,*) "epdrift",epdrift - return - end -c----------------------------------------------------------------------- - subroutine verlet_bath -c -c Coupling to the thermostat by using the Berendsen algorithm -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision T_half,fact -c - T_half=2.0d0/(dimen3*Rb)*EK - fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0)) -c write(iout,*) "T_half", T_half -c write(iout,*) "EK", EK -c write(iout,*) "fact", fact - do j=1,3 - d_t(j,0)=fact*d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=fact*d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=fact*d_t(j,inres) - enddo - endif - enddo - return - end -c--------------------------------------------------------- - subroutine init_MD -c Set up the initial conditions of a MD simulation - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - character*16 form - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.REMD' - real*8 energia_long(0:n_ene), - & energia_short(0:n_ene),vcm(3),incr(3),E_short - double precision cm(3),L(3),xv,sigv,lowb,highb - double precision varia(maxvar) - character*256 qstr - integer ilen - external ilen - character*50 tytul - logical file_exist - common /gucio/ cm - d_time0=d_time -c write(iout,*) "d_time", d_time -c Compute the standard deviations of stochastic forces for Langevin dynamics -c if the friction coefficients do not depend on surface area - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - endif -c Open the pdb file for snapshotshots -#ifdef MPI - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".pdb") - open(ipdb, - & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".pdb") - else -#ifdef NOXDR - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".x") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".x" -#else - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".cx") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".cx" -#endif - endif -#else - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb") - open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb") - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx") - cartname=prefix(:ilen(prefix))//"_MD.cx" - endif -#endif - if (usampl) then - write (qstr,'(256(1h ))') - ipos=1 - do i=1,nfrag - iq = qinfrag(i,iset)*10 - iw = wfrag(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo - do i=1,npair - iq = qinpair(i,iset)*10 - iw = wpair(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo -c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb' -#ifdef NOXDR -c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x' -#else -c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx' -#endif -c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' - endif - icg=1 - if (rest) then - if (restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) - write (*,*) me," Before broadcast: file_exist",file_exist -#ifdef MPI - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) - write (*,*) me," After broadcast: file_exist",file_exist -#endif -c inquire(file=mremd_rst_name,exist=file_exist) - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state read by master and distributed" - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_' - & //liczba(:ilen(liczba))//'.rst') - inquire(file=rest2name,exist=file_exist) - endif - if(file_exist) then - if(.not.restart1file) then - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state will be read from file ", - & rest2name(:ilen(rest2name)) - call readrst - endif - call rescale_weights(t_bath) - else - if(me.eq.king.or..not.out1file)then - if (restart1file) then - write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), - & " does not exist" - else - write(iout,*) "File ",rest2name(:ilen(rest2name)), - & " does not exist" - endif - write(iout,*) "Initial velocities randomly generated" - endif - call random_vel - totT=0.0d0 - endif - else -c Generate initial velocities - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial velocities randomly generated" - call random_vel - totT=0.0d0 - endif -c rest2name = prefix(:ilen(prefix))//'.rst' - if(me.eq.king.or..not.out1file)then - write (iout,*) "Initial velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - call flush(iout) -c Zeroing the total angular momentum of the system - write(iout,*) "Calling the zero-angular - & momentum subroutine" - endif - call inertia_tensor -c Getting the potential energy and forces and velocities and accelerations - call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo -c Removing the velocity of the center of mass - call vcm_vel(vcm) - if(me.eq.king.or..not.out1file)then - write (iout,*) "vcm right after adjustment:" - write (iout,*) (vcm(j),j=1,3) - call flush(iout) - endif - if (.not.rest) then - call chainbuild - if(iranconf.ne.0) then - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SC_move',nft_sc,etot - endif - - if(dccart)then - print *, 'Calling MINIM_DC' - call minim_dc(etot,iretcode,nfun) - else - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - endif - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun - endif - endif - call chainbuild_cart - call kinetic(EK) - if (tbf) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK - if(me.eq.king.or..not.out1file)then - call cartprint - call intout - endif -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0=tcpu() -#endif - call zerograd - call etotal(potEcomp) -#ifdef TIMING_ENE -#ifdef MPI - t_etotal=t_etotal+MPI_Wtime()-tt0 -#else - t_etotal=t_etotal+tcpu()-tt0 -#endif -#endif - potE=potEcomp(0) - - if(tnp .or. tnp1) then - s_np=1.0 - pi_np=0.0 - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H0=Hnose1 - write(iout,*) 'H0= ',H0 - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H0=HNose1 - write (iout,*) 'H0= ',H0 - endif - - if (hmc.gt.0) then - hmc_acc=0 - hmc_etot=potE+EK - if(me.eq.king.or..not.out1file) - & write(iout,*) 'HMC',hmc_etot,potE,EK - do i=1,2*nres - do j=1,3 - dc_hmc(j,i)=dc(j,i) - enddo - enddo - endif - - call cartgrad - call lagrangian - call max_accel - if (amax*d_time .gt. dvmax) then - d_time=d_time*dvmax/amax - if(me.eq.king.or..not.out1file) write (iout,*) - & "Time step reduced to",d_time, - & " because of too large initial acceleration." - endif - if(me.eq.king.or..not.out1file)then - write(iout,*) "Potential energy and its components" - call enerprint(potEcomp) -c write(iout,*) (potEcomp(i),i=0,n_ene) - endif - potE=potEcomp(0)-potEcomp(20) - totE=EK+potE - itime=0 - if (ntwe.ne.0) call statout(itime) - if(me.eq.king.or..not.out1file) - & write (iout,'(/a/3(a25,1pe14.5/))') "Initial:", - & " Kinetic energy",EK," potential energy",potE, - & " total energy",totE," maximum acceleration ", - & amax - if (large) then - write (iout,*) "Initial coordinates" - do i=1,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3), - & (c(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial velocities" - write (iout,"(13x,' backbone ',23x,' side chain')") - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial accelerations" - do i=0,nres -c write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - write (iout,'(i3,3f15.10,3x,3f15.10)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo -c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3) - enddo - if (RESPA) then -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_short(energia_short) -#ifdef TIMING_ENE -#ifdef MPI - t_eshort=t_eshort+MPI_Wtime()-tt0 -#else - t_eshort=t_eshort+tcpu()-tt0 -#endif -#endif - - if(tnp .or. tnp1) then - E_short=energia_short(0) - HNose1=Hnose(EK,s_np,E_short,pi_np,Q_np,t_bath,dimen3) - Csplit=Hnose1 -c Csplit =110 -c_new_var_csplit Csplit=H0-E_long -c Csplit = H0-energia_short(0) - write(iout,*) 'Csplit= ',Csplit - endif - - - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0), - & " energia_short",energia_short(0), - & " total",energia_long(0)+energia_short(0) - write (iout,*) "Initial fast-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0=tcpu() -#endif - call zerograd - call etotal_long(energia_long) -#ifdef TIMING_ENE -#ifdef MPI - t_elong=t_elong+MPI_Wtime()-tt0 -#else - t_elong=t_elong+tcpu()-tt0 -#endif -#endif - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Initial slow-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - endif - - - - return - end -c----------------------------------------------------------- - subroutine random_vel - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb -c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m -c First generate velocities in the eigenspace of the G matrix -c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3 -c call flush(iout) -c write (iout,*) "RANDOM_VEL dimen",dimen - xv=0.0d0 - ii=0 - do i=1,dimen - do k=1,3 - ii=ii+1 - sigv=dsqrt((Rb*t_bath)/geigen(i)) - lowb=-5*sigv - highb=5*sigv - d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) -c write (iout,*) "i",i," ii",ii," geigen",geigen(i), -c & " d_t_work_new",d_t_work_new(ii) - enddo - enddo - call flush(iout) -c diagnostics -c Ek1=0.0d0 -c ii=0 -c do i=1,dimen -c do k=1,3 -c ii=ii+1 -c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(ii)**2 -c enddo -c enddo -c write (iout,*) "Ek from eigenvectors",Ek1 -c end diagnostics -c Transform velocities to UNRES coordinate space - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_t_work(ind)=0.0d0 - do j=1,dimen - d_t_work(ind)=d_t_work(ind) - & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1) - enddo -c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) -c call flush(iout) - enddo - enddo -c Transfer to the d_t vector - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_t(j,i)=d_t_work(ind) - enddo - enddo -c do i=0,nres-1 -c write (iout,*) "d_t",i,(d_t(j,i),j=1,3) -c enddo -c call flush(iout) - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_t(j,i+nres)=d_t_work(ind) - enddo - endif - enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 -c call flush(iout) - return - end -#ifndef LANG0 -c----------------------------------------------------------- - subroutine sd_verlet_p_setup -c Sets up the parameters of stochastic Verlet algorithm - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0 * d_time * d_time - prand_vec(i) = 0.0d0 - vrand_vec1(i) = 0.0d0 - vrand_vec2(i) = 0.0d0 -c -c Analytical expressions when friction coefficient is large -c - else - if (gdt .ge. gdt_radius) then - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = (1.0d0-egdt) / fricgam(i) - afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i) - pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt - vterm = 1.0d0 - egdt**2 - rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm) -c -c Use series expansions when friction coefficient is small -c - else - gdt2 = gdt * gdt - gdt3 = gdt * gdt2 - gdt4 = gdt2 * gdt2 - gdt5 = gdt2 * gdt3 - gdt6 = gdt3 * gdt3 - gdt7 = gdt3 * gdt4 - gdt8 = gdt4 * gdt4 - gdt9 = gdt4 * gdt5 - afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0 - & - gdt5/120.0d0 + gdt6/720.0d0 - & - gdt7/5040.0d0 + gdt8/40320.0d0 - & - gdt9/362880.0d0) / fricgam(i)**2 - vfric_vec(i) = d_time - fricgam(i)*afric_vec(i) - pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i) - pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0 - & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0 - & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0 - & + 127.0d0*gdt9/90720.0d0 - vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0 - & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0 - & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0 - & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0 - rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0 - & - 17.0d0*gdt2/1280.0d0 - & + 17.0d0*gdt3/6144.0d0 - & + 40967.0d0*gdt4/34406400.0d0 - & - 57203.0d0*gdt5/275251200.0d0 - & - 1429487.0d0*gdt6/13212057600.0d0) - end if -c -c Compute the scaling factors of random terms for the nonzero friction case -c - ktm = 0.5d0*d_time/fricgam(i) - psig = dsqrt(ktm*pterm) / fricgam(i) - vsig = dsqrt(ktm*vterm) - rhoc = dsqrt(1.0d0 - rho*rho) - prand_vec(i) = psig - vrand_vec1(i) = vsig * rho - vrand_vec2(i) = vsig * rhoc - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c -#ifndef LANG0 - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#endif -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine eigtransf1(n,ndim,ab,d,c) - implicit none - integer n,ndim - double precision ab(ndim,ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+ab(k,j,i)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine eigtransf(n,ndim,a,b,d,c) - implicit none - integer n,ndim - double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine sd_verlet1 -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) - -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) - ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+ - & vrand_mat2(i,j)*stochforcvecV(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c----------------------------------------------------------- - subroutine sd_verlet_ciccotti_setup -c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's -c version - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - write (iout,*) "i",i," fricgam",fricgam(i) - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Analytical expressions when friction coefficient is large -c - else - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = dexp(-0.5d0*gdt)*d_time - afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Compute the scaling factors of random terms for the nonzero friction case -c -c ktm = 0.5d0*d_time/fricgam(i) -c psig = dsqrt(ktm*pterm) / fricgam(i) -c vsig = dsqrt(ktm*vterm) -c prand_vec(i) = psig*afric_vec(i) -c vrand_vec2(i) = vsig*vfric_vec(i) - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine sd_verlet1_ciccotti -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo - -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2_ciccotti -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) -c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) - ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -#endif -c------------------------------------------------------ - double precision function HNose(ek,s,e,pi,Q,t_bath,dimenl) - implicit none - double precision ek,s,e,pi,Q,t_bath,Rb - integer dimenl - Rb=0.001986d0 - HNose=ek+e+pi**2/(2*Q)+dimenl*Rb*t_bath*log(s) -c print '(6f15.5,i5,a2,2f15.5)',ek,s,e,pi,Q,t_bath,dimenl,"--", -c & pi**2/(2*Q),dimenl*Rb*t_bath*log(s) - return - end -c----------------------------------------------------------------- - double precision function HNose_nh(eki,e) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MD' - HNose_nh=eki+e+dimen3*Rb*t_bath*xlogs(1)+qmass(1)*vlogs(1)**2/2 - do i=2,nnos - HNose_nh=HNose_nh+qmass(i)*vlogs(i)**2/2+Rb*t_bath*xlogs(i) - enddo -c write(4,'(5e15.5)') -c & vlogs(1),xlogs(1),HNose,eki,e - return - end -c----------------------------------------------------------------- - SUBROUTINE NHCINT(akin,scale,wdti,wdti2,wdti4,wdti8) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MD' - double precision akin,gnkt,dt,aa,gkt,scale - double precision wdti(maxyosh),wdti2(maxyosh), - & wdti4(maxyosh),wdti8(maxyosh) - integer i,iresn,iyosh,inos,nnos1 - - dt=d_time - nnos1=nnos+1 - GKT = Rb*t_bath - GNKT = dimen3*GKT - akin=akin*2 - - -C THIS ROUTINE DOES THE NOSE-HOOVER PART OF THE -C INTEGRATION FROM t=0 TO t=DT/2 -C GET THE TOTAL KINETIC ENERGY - SCALE = 1.D0 -c CALL GETKINP(MASS,VX,VY,VZ,AKIN) -C UPDATE THE FORCES - GLOGS(1) = (AKIN - GNKT)/QMASS(1) -C START THE MULTIPLE TIME STEP PROCEDURE - DO IRESN = 1,NRESN - DO IYOSH = 1,NYOSH -C UPDATE THE THERMOSTAT VELOCITIES - VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH) - DO INOS = 1,NNOS-1 - AA = EXP(-WDTI8(IYOSH)*VLOGS(NNOS1-INOS) ) - VLOGS(NNOS-INOS) = VLOGS(NNOS-INOS)*AA*AA - & + WDTI4(IYOSH)*GLOGS(NNOS-INOS)*AA - ENDDO -C UPDATE THE PARTICLE VELOCITIES - AA = EXP(-WDTI2(IYOSH)*VLOGS(1) ) - SCALE = SCALE*AA -C UPDATE THE FORCES - GLOGS(1) = (SCALE*SCALE*AKIN - GNKT)/QMASS(1) -C UPDATE THE THERMOSTAT POSITIONS - DO INOS = 1,NNOS - XLOGS(INOS) = XLOGS(INOS) + VLOGS(INOS)*WDTI2(IYOSH) - ENDDO -C UPDATE THE THERMOSTAT VELOCITIES - DO INOS = 1,NNOS-1 - AA = EXP(-WDTI8(IYOSH)*VLOGS(INOS+1) ) - VLOGS(INOS) = VLOGS(INOS)*AA*AA - & + WDTI4(IYOSH)*GLOGS(INOS)*AA - GLOGS(INOS+1) = (QMASS(INOS)*VLOGS(INOS)*VLOGS(INOS) - & -GKT)/QMASS(INOS+1) - ENDDO - VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH) - ENDDO - ENDDO -C UPDATE THE PARTICLE VELOCITIES -c outside of this subroutine -c DO I = 1,N -c VX(I) = VX(I)*SCALE -c VY(I) = VY(I)*SCALE -c VZ(I) = VZ(I)*SCALE -c ENDDO - RETURN - END -c----------------------------------------------------------------- - subroutine tnp1_respa_i_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c JPSJ 70 75 (2001) S. Nose -c -c d_t is not updated here -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2,tmp - - tmp=1+pi_np/(2*Q_np)*0.5*d_time - s12_np=s_np*tmp**2 - pistar=pi_np/tmp - s12_dt=d_time/s12_np - d_time_s12=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt - enddo - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine tnp1_respa_i_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s12 - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s12_np**2 - - d_time_s12=0.5d0*s12_np*d_time - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12 - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12 - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12 - enddo - endif - enddo - - pistar=pistar+(EK-0.5*(E_old+potE) - & -dimen3*Rb*t_bath*log(s12_np)+Csplit-dimen3*Rb*t_bath)*d_time - tmp=1+pistar/(2*Q_np)*0.5*d_time - s_np=s12_np*tmp**2 - pi_np=pistar/tmp - - return - end -c------------------------------------------------------- - - subroutine tnp1_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c JPSJ 70 75 (2001) S. Nose -c -c d_t is not updated here -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2,tmp - - tmp=1+pi_np/(2*Q_np)*0.5*d_time - s12_np=s_np*tmp**2 - pistar=pi_np/tmp - s12_dt=d_time/s12_np - d_time_s12=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt - enddo - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine tnp1_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s12 - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s12_np**2 - - d_time_s12=0.5d0*s12_np*d_time - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12 - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12 - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12 - enddo - endif - enddo - -cd write(iout,*) 'pistar',pistar,EK,E_old,potE,s12_np - pistar=pistar+(EK-0.5*(E_old+potE) - & -dimen3*Rb*t_bath*log(s12_np)+H0-dimen3*Rb*t_bath)*d_time - tmp=1+pistar/(2*Q_np)*0.5*d_time - s_np=s12_np*tmp**2 - pi_np=pistar/tmp - - return - end - -c----------------------------------------------------------------- - subroutine tnp_respa_i_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - - d_time_s=d_time*0.5*s_np -ct2 d_time_s=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s - enddo - endif - enddo - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s_np**2 - - C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-Csplit) - & -pi_np - - pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) - tmp=0.5*d_time*pistar/Q_np - s12_np=s_np*(1.0+tmp)/(1.0-tmp) - - d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np) -ct2 d_time_ss=d_time/s12_np -c d_time_ss=0.5*d_time*(1.0/sold_np+1.0/s_np) - - do j=1,3 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss - enddo - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss - enddo - endif - enddo - - return - end -c--------------------------------------------------------------------- - - subroutine tnp_respa_i_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - - EK=EK*(s_np/s12_np)**2 - HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) - pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath - & -HNose1+Csplit) - -cr print '(a,5f)','i_step2',EK,potE,HNose1,pi_np,E_long - d_time_s=d_time*0.5*s12_np -c d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - s_np=s12_np - - return - end -c----------------------------------------------------------------- - subroutine tnp_respa_step1 -c Applying Nose-Poincare algorithm - step 1 to vel for RESPA -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - double precision energia(0:n_ene) - - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - -c C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0) -c & -pi_np -c -c pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) -c tmp=0.5*d_time*pistar/Q_np -c s12_np=s_np*(1.0+tmp)/(1.0-tmp) -c write(iout,*) 'tnp_respa_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp - -ct1 pi_np=pistar -c sold_np=s_np -c s_np=s12_np - -c------------------------------------- -c test of reviewer's comment - pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0) -cr print '(a,3f)','1 pi_np,s_np',pi_np,s_np,E_long -c------------------------------------- - - return - end -c--------------------------------------------------------------------- - subroutine tnp_respa_step2 -c Step 2 of the velocity Verlet algorithm: update velocities for RESPA - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - -ct1 s12_np=s_np -ct2 pistar=pi_np - -ct call kinetic(EK) -ct HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) -ct pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath) -ct & -0.5*d_time*(HNose1-H0) - -c------------------------------------- -c test of reviewer's comment - pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0) -cr print '(a,3f)','2 pi_np,s_np',pi_np,s_np,E_long -c------------------------------------- - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - -cd s_np=s12_np - - return - end -c--------------------------------------------------------------------- - subroutine tnp_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s - enddo - endif - enddo - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s_np**2 - - C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0) - & -pi_np - - pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) - tmp=0.5*d_time*pistar/Q_np - s12_np=s_np*(1.0+tmp)/(1.0-tmp) -c write(iout,*) 'tnp_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp - - d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np) - - do j=1,3 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss - enddo - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss - enddo - endif - enddo - - return - end -c----------------------------------------------------------------- - subroutine tnp_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - - EK=EK*(s_np/s12_np)**2 - HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) - pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath) - & -0.5*d_time*(HNose1-H0) - -cd write(iout,'(a,4f)') 'mmm',EK,potE,HNose1,pi_np - d_time_s=d_time*0.5*s12_np - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - s_np=s12_np - - return - end - - subroutine hmc_test(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.CHAIN' - - hmc_acc=hmc_acc+1 - delta=-(potE+EK-hmc_etot)/(Rb*t_bath) - if (delta .lt. -50.0d0) then - delta=0.0d0 - else - delta=dexp(delta) - endif - xxx=ran_number(0.0d0,1.0d0) - - if (me.eq.king .or. .not. out1file) - & write(iout,'(a8,i5,6f10.4)') - & 'HMC',itime,potE+EK,potE,EK,hmc_etot,delta,xxx - - if (delta .le. xxx) then - do i=1,2*nres - do j=1,3 - dc(j,i)=dc_hmc(j,i) - enddo - enddo - itime=itime-hmc - totT=totThmc - else - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'HMC accepting new' - totThmc=totT - do i=1,2*nres - do j=1,3 - dc_hmc(j,i)=dc(j,i) - enddo - enddo - endif - - call chainbuild_cart - call random_vel - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - call etotal(potEcomp) - potE=potEcomp(0) - hmc_etot=potE+EK - if (me.eq.king .or. .not. out1file) - & write(iout,'(a8,i5,3f10.4)')'HMC new',itime,potE+EK,potE,EK - - - return - end diff --git a/source/unres/src_MD-DFA-restraints/MP.F b/source/unres/src_MD-DFA-restraints/MP.F deleted file mode 100644 index b08897c..0000000 --- a/source/unres/src_MD-DFA-restraints/MP.F +++ /dev/null @@ -1,516 +0,0 @@ -#ifdef MPI - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - logical lprn /.false./ -c real*8 text1 /'group_i '/,text2/'group_f '/, -c & text3/'initialb'/,text4/'initiale'/, -c & text5/'openb'/,text6/'opene'/ - integer cgtasks(0:max_cg_procs) - character*3 cfgprocs - integer cg_size,fg_size,fg_size1 -c start parallel processing -c print *,'Initializing MPI' - call mpi_init(ierr) - if (ierr.ne.0) then - print *, ' cannot initialize MPI' - stop - endif -c determine # of nodes and current node - call MPI_Comm_rank( MPI_COMM_WORLD, me, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine rank of all processes' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif - call MPI_Comm_size( MPI_Comm_world, nodes, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine number of processes' - stop - endif - Nprocs=nodes - MyRank=me -C Determine the number of "fine-grain" tasks - call getenv_loc("FGPROCS",cfgprocs) - read (cfgprocs,'(i3)') nfgtasks - if (nfgtasks.eq.0) nfgtasks=1 - call getenv_loc("MAXGSPROCS",cfgprocs) - read (cfgprocs,'(i3)') max_gs_size - if (max_gs_size.eq.0) max_gs_size=2 - if (lprn) - & print *,"Processor",me," nfgtasks",nfgtasks, - & " max_gs_size",max_gs_size - if (nfgtasks.eq.1) then - CG_COMM = MPI_COMM_WORLD - fg_size=1 - fg_rank=0 - nfgtasks1=1 - fg_rank1=0 - else - nodes=nprocs/nfgtasks - if (nfgtasks*nodes.ne.nprocs) then - write (*,'(a)') 'ERROR: Number of processors assigned', - & ' to coarse-grained tasks must be divisor', - & ' of the total number of processors.' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif -C Put the ranks of coarse-grain processes in one table and create -C the respective communicator. The processes with ranks "in between" -C the ranks of CG processes will perform fine graining for the CG -C process with the next lower rank. - do i=0,nprocs-1,nfgtasks - cgtasks(i/nfgtasks)=i - enddo - if (lprn) then - print*,"Processor",me," cgtasks",(cgtasks(i),i=0,nodes-1) -c print "(a,i5,a)","Processor",myrank," Before MPI_Comm_group" - endif -c call memmon_print_usage() - call MPI_Comm_group(MPI_COMM_WORLD,world_group,IERR) - call MPI_Group_incl(world_group,nodes,cgtasks,cg_group,IERR) - call MPI_Comm_create(MPI_COMM_WORLD,cg_group,CG_COMM,IERR) - call MPI_Group_rank(cg_group,me,ierr) - call MPI_Group_free(world_group,ierr) - call MPI_Group_free(cg_group,ierr) -c print "(a,i5,a)","Processor",myrank," After MPI_Comm_group" -c call memmon_print_usage() - if (me.ne.MPI_UNDEFINED) call MPI_Comm_Rank(CG_COMM,me,ierr) - if (lprn) print *," Processor",myrank," CG rank",me -C Create communicators containig processes doing "fine grain" tasks. -C The processes within each FG_COMM should have fast communication. - kolor=MyRank/nfgtasks - key=mod(MyRank,nfgtasks) - call MPI_Comm_split(MPI_COMM_WORLD,kolor,key,FG_COMM,ierr) - call MPI_Comm_size(FG_COMM,fg_size,ierr) - if (fg_size.ne.nfgtasks) then - write (*,*) "OOOOps... the number of fg tasks is",fg_size, - & " but",nfgtasks," was requested. MyRank=",MyRank - endif - call MPI_Comm_rank(FG_COMM,fg_rank,ierr) - if (fg_size.gt.max_gs_size) then - kolor1=fg_rank/max_gs_size - key1=mod(fg_rank,max_gs_size) - call MPI_Comm_split(FG_COMM,kolor1,key1,FG_COMM1,ierr) - call MPI_Comm_size(FG_COMM1,nfgtasks1,ierr) - call MPI_Comm_rank(FG_COMM1,fg_rank1,ierr) - else - FG_COMM1=FG_COMM - nfgtasks1=nfgtasks - fg_rank1=fg_rank - endif - endif - if (fg_rank.eq.0) then - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in CG_COMM",me," size of CG_COMM",nodes, - & " size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - else - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in FG_COMM",fg_rank," size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - endif -C Initialize other variables. -c print '(a)','Before initialize' -c call memmon_print_usage() - call initialize -c print '(a,i5,a)','Processor',myrank,' After initialize' -c call memmon_print_usage() -C Open task-dependent files. -c print '(a,i5,a)','Processor',myrank,' Before openunits' -c call memmon_print_usage() - call openunits -c print '(a,i5,a)','Processor',myrank,' After openunits' -c call memmon_print_usage() - if (me.eq.king .or. fg_rank.eq.0 .and. .not. out1file) - & write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - parallel job.' -c print *,"Processor",myrank," exited OPENUNITS" - return - end -C----------------------------------------------------------------------------- - subroutine finish_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.REMD' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - include 'COMMON.MD' - integer ilen - external ilen -c - call MPI_Barrier(CG_COMM,ierr) - if (nfgtasks.gt.1) - & call MPI_Bcast(-1,1,MPI_INTEGER,king,FG_COMM,IERROR) - time1=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write (iout,'(a,i4,a)') 'CG processor',me,' is finishing work.' - write (iout,*) 'Total wall clock time',time1-walltime,' sec' - if (nfgtasks.gt.1) then - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (iout,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g,"TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - & +time_barrier_e+time_barrier_g - write (*,*) 'Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",me," BROADCAST time",time_bcast, - & " REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter," SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e," BARRIER grad",time_barrier_g - endif - endif - write (*,'(a,i4,a)') 'CG processor',me,' is finishing work.' - if (ilen(tmpdir).gt.0) then - write (*,*) "Processor",me, - & ": moving output files to the parent directory..." - close(inp) - close(istat,status='keep') - if (ntwe.gt.0) call move_from_tmp(statname) - close(irest2,status='keep') - if (modecalc.eq.12.or. - & (modecalc.eq.14 .and. .not.restart1file)) then - call move_from_tmp(rest2name) - else if (modecalc.eq.14.and. me.eq.king) then - call move_from_tmp(mremd_rst_name) - endif - if (mdpdb) then - close(ipdb,status='keep') - call move_from_tmp(pdbname) - else if (me.eq.king .or. .not.traj1file) then - close(icart,status='keep') - call move_from_tmp(cartname) - endif - if (me.eq.king .or. .not. out1file) then - close (iout,status='keep') - call move_from_tmp(outname) - endif - endif - return - end -c------------------------------------------------------------------------- - subroutine pattern_receive - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,ThreadType - logical flag - ThreadType=45 - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - do while (flag) - write (iout,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - write (*,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - nexcl=nexcl+1 - call mpi_irecv(iexam(1,nexcl),2,mpi_integer,status(mpi_source), - & ThreadType, CG_COMM,ireq,ierr) - write (iout,*) 'Received pattern:',nexcl,iexam(1,nexcl), - & iexam(2,nexcl) - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine pattern_send - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer source,ThreadType,ireq - ThreadType=45 - do iproc=0,nprocs-1 - if (iproc.ne.me .and. .not.Koniec(iproc) ) then - call mpi_isend(iexam(1,nexcl),2,mpi_integer,iproc, - & ThreadType, CG_COMM, ireq, ierr) - write (iout,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (*,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (iout,*) 'Pattern:',nexcl,iexam(1,nexcl),iexam(2,nexcl) - endif - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer StopType,StopId,iproc,Kwita,NBytes - StopType=66 -c Kwita=-1 -C print *,'CG processor',me,' StopType=',StopType - Koniec(me)=.true. - if (me.eq.king) then -C Master sends the STOP signal to everybody. - write (iout,'(a,a)') - & 'Master is sending STOP signal to other processors.' - do iproc=1,nprocs-1 - print *,'Koniec(',iproc,')=',Koniec(iproc) - if (.not. Koniec(iproc)) then - call mpi_send(Kwita,1,mpi_integer,iproc,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'Iproc=',iproc,' StopID=',StopID - write (*,*) 'Iproc=',iproc,' StopID=',StopID - endif - enddo - else -C Else send the STOP signal to Master. - call mpi_send(Kwita,1,mpi_integer,MasterID,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'CG processor=',me,' StopID=',StopID - write (*,*) 'CG processor=',me,' StopID=',StopID - endif - return - end -c----------------------------------------------------------------------------- - subroutine recv_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer source,StopType,StopId,iproc,Kwita - logical flag - StopType=66 - Kwita=0 - source=mpi_any_source -c print *,'CG processor:',me,' StopType=',StopType - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - do while (flag) - Koniec(status(mpi_source))=.true. - write (iout,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - write (*,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - call mpi_irecv(Kwita,1,mpi_integer,status(mpi_source),StopType, - & mpi_comm_world,ireq,ierr) - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_MCM_info(ione) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer MCM_info_Type,MCM_info_ID,iproc,one,NBytes - common /aaaa/ isend,irecv - integer nsend - save nsend - nsend=nsend+1 - MCM_info_Type=77 -cd write (iout,'(a,i4,a)') 'CG Processor',me, -cd & ' is sending MCM info to Master.' - write (*,'(a,i4,a,i8)') 'CG processor',me, - & ' is sending MCM info to Master, MCM_info_ID=',MCM_info_ID - call mpi_isend(ione,1,mpi_integer,MasterID, - & MCM_info_Type,mpi_comm_world, MCM_info_ID, ierr) -cd write (iout,*) 'CG processor',me,' has sent info to the master;', -cd & ' MCM_info_ID=',MCM_info_ID - write (*,*) 'CG processor',me,' has sent info to the master;', - & ' MCM_info_ID=',MCM_info_ID,' ierr ',ierr - isend=0 - irecv=0 - return - end -c---------------------------------------------------------------------------- - subroutine receive_MCM_info - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,MCM_info_Type,MCM_info_ID,iproc,ione - logical flag - MCM_info_Type=77 - source=mpi_any_source -c print *,'source=',source,' dontcare=',dontcare - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - do while (flag) - source=status(mpi_source) - itask=source/fgProcs+1 -cd write (iout,*) 'Master is receiving MCM info from processor ', -cd & source,' itask',itask - write (*,*) 'Master is receiving MCM info from processor ', - & source,' itask',itask - call mpi_irecv(ione,1,mpi_integer,source,MCM_info_type, - & mpi_comm_world,MCM_info_ID,ierr) -cd write (iout,*) 'Received from processor',source,' IONE=',ione - write (*,*) 'Received from processor',source,' IONE=',ione - nacc_tot=nacc_tot+1 - if (ione.eq.2) nsave_part(itask)=nsave_part(itask)+1 -cd print *,'nsave_part(',itask,')=',nsave_part(itask) -cd write (iout,*) 'Nacc_tot=',Nacc_tot -cd write (*,*) 'Nacc_tot=',Nacc_tot - source=mpi_any_source - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine send_thread_results - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,msglen,nbytes - double precision buffer(20*maxthread+2) - ThreadType=444 - EnerType=555 - ipatt(1,nthread+1)=nthread - ipatt(2,nthread+1)=nexcl - do i=1,nthread - do j=1,n_ene - ener(j,i+nthread)=ener0(j,i) - enddo - enddo - ener(1,2*nthread+1)=max_time_for_thread - ener(2,2*nthread+1)=ave_time_for_thread -C Send the IPATT array - write (iout,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - write (*,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - msglen=2*nthread+2 - call mpi_send(ipatt(1,1),msglen,MPI_INTEGER,MasterID, - & ThreadType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen - write (*,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen -C Send the energies. - msglen=n_ene2*nthread+2 - write (iout,*) 'CG processor',me,' is sending energies to master.' - write (*,*) 'CG processor',me,' is sending energies to master.' - call mpi_send(ener(1,1),msglen,MPI_DOUBLE_PRECISION,MasterID, - & EnerType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me,' has sent energies to master.' - write (*,*) 'CG processor',me,' has sent energies to master.' - return - end -c---------------------------------------------------------------------------- - subroutine receive_thread_results(iproc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,ReadyType,ReadyID,Ready,msglen,nbytes,nthread_temp - double precision buffer(20*maxthread+2),max_time_for_thread_t, - & ave_time_for_thread_t - logical flag - ThreadType=444 - EnerType=555 -C Receive the IPATT array - call mpi_probe(iproc,ThreadType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_INTEGER, MSGLEN, IERROR) - write (iout,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - write (*,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - call mpi_recv(ipatt(1,nthread+1),msglen,mpi_integer,iproc, - & ThreadType, - & mpi_comm_world,status,ierror) - write (iout,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - write (*,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - nthread_temp=ipatt(1,nthread+msglen/2) - nexcl_temp=ipatt(2,nthread+msglen/2) -C Receive the energies. - call mpi_probe(iproc,EnerType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_DOUBLE_PRECISION, MSGLEN, IERROR) - write (iout,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - write (*,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - call mpi_recv(ener(1,nthread+1),msglen, - & MPI_DOUBLE_PRECISION,iproc, - & EnerType,MPI_COMM_WORLD,status,ierror) - write (iout,*) 'Msglen=',Msglen - write (*,*) 'Msglen=',Msglen - write (iout,*) 'Master has received energies from processor',iproc - write (*,*) 'Master has received energies from processor',iproc - write (iout,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - write (*,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - do i=1,nthread_temp - do j=1,n_ene - ener0(j,nthread+i)=ener(j,nthread+nthread_temp+i) - enddo - enddo - max_time_for_thread_t=ener(1,nthread+2*nthread_temp+1) - ave_time_for_thread_t=ener(2,nthread+2*nthread_temp+1) - write (iout,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (iout,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - write (*,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (*,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - if (max_time_for_thread_t.gt.max_time_for_thread) - & max_time_for_thread=max_time_for_thread_t - ave_time_for_thread=(nthread*ave_time_for_thread+ - & nthread_temp*ave_time_for_thread_t)/(nthread+nthread_temp) - nthread=nthread+nthread_temp - return - end -#else - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SETUP' - me=0 - myrank=0 - fg_rank=0 - fg_size=1 - nodes=1 - nprocs=1 - call initialize - call openunits - write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - serial job.' - return - end -#endif diff --git a/source/unres/src_MD-DFA-restraints/MREMD.F b/source/unres/src_MD-DFA-restraints/MREMD.F deleted file mode 100644 index be6af9c..0000000 --- a/source/unres/src_MD-DFA-restraints/MREMD.F +++ /dev/null @@ -1,2117 +0,0 @@ -#ifdef MPI - subroutine MREMD - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.MUCA' - integer ERRCODE - double precision cm(3),L(3),vcm(3) - double precision energia(0:n_ene) - double precision remd_t_bath(maxprocs) - integer iremd_iset(maxprocs) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - double precision remd_ene(0:n_ene+4,maxprocs),t_bath_old - integer iremd_acc(maxprocs),iremd_tot(maxprocs) - integer iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs) - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -cold integer nup(0:maxprocs),ndown(0:maxprocs) - integer rep2i(0:maxprocs),ireqi(maxprocs) - integer icache_all(maxprocs) - integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - logical synflag,end_of_run,file_exist /.false./,ovrtim - real ene_tol /1.0e-5/ - -cdeb imin_itime_old=0 - ntwx_cache=0 - time00=MPI_WTIME() - time01=time00 - if(me.eq.king.or..not.out1file) then - write (iout,*) 'MREMD',nodes,'time before',time00-walltime - write (iout,*) "NREP=",nrep - endif - - synflag=.false. - if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then - call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst") - endif - mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst" - -cd print *,'MREMD',nodes -cd print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep) -cde write (iout,*) "Start MREMD: me",me," t_bath",t_bath - - if(hremd.gt.0) then - nset=hremd - do i=1,nset - mset(i)=1 - enddo - endif - - k=0 - rep2i(k)=-1 - do il=1,max0(nset,1) - do il1=1,max0(mset(il),1) - do i=1,nrep - iremd_acc(i)=0 - iremd_acc_usa(i)=0 - iremd_tot(i)=0 - do j=1,remd_m(i) - i2rep(k)=i - i2set(k)=il - rep2i(i)=k - k=k+1 - i_index(i,j,il,il1)=k - enddo - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write(iout,*) "i2rep",(i2rep(i),i=0,nodes-1) - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i,j,il,il1,i_index(i,j,il,il1)" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - -c print *,'i2rep',me,i2rep(me) -c print *,'rep2i',(rep2i(i),i=0,nrep) - -cold if (i2rep(me).eq.nrep) then -cold nup(0)=0 -cold else -cold nup(0)=remd_m(i2rep(me)+1) -cold k=rep2i(int(i2rep(me)))+1 -cold do i=1,nup(0) -cold nup(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0)) - -cold if (i2rep(me).eq.1) then -cold ndown(0)=0 -cold else -cold ndown(0)=remd_m(i2rep(me)-1) -cold k=rep2i(i2rep(me)-2)+1 -cold do i=1,ndown(0) -cold ndown(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) - - - write (*,*) "Processor",me," rest",rest," - & restart1fie",restart1file - if(rest.and.restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) -cd write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) -cd write (*,*) me," After broadcast: file_exist",file_exist - if(file_exist) then - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Master is reading restart1file' - call read1restart(i_index) - else - if(me.eq.king.or..not.out1file) - & write (iout,*) 'WARNING : no restart1file' - endif - - if(me.eq.king.or..not.out1file) then - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - endif - - if(me.eq.king) then - if (rest.and..not.restart1file) - & inquire(file=mremd_rst_name,exist=file_exist) - if(.not.file_exist.and.rest.and..not.restart1file) - & write(iout,*) 'WARNING : no restart file',mremd_rst_name - IF (rest.and.file_exist.and..not.restart1file) THEN - write (iout,*) 'Master is reading restart file', - & mremd_rst_name - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl.or.hremd.gt.0) then - read (irest2,*) - read (irest2,*) nset - read (irest2,*) - read (irest2,*) (mset(i),i=1,nset) - read (irest2,*) - read (irest2,*) (i2set(i),i=0,nodes-1) - read (irest2,*) - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - read(irest2,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - - close(irest2) - - write (iout,'(a6,1000i5)') "i2rep",(i2rep(i),i=0,nodes-1) - write (iout,'(a6,1000i5)') "ifirst", - & (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", - & (nupa(i,il),i=1,nupa(0,il)) - write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - ELSE IF (.not.(rest.and.file_exist)) THEN - do il=1,remd_m(1) - ifirst(il)=il - enddo - - do il=1,nodes - if (i2rep(il-1).eq.nrep) then - nupa(0,il)=0 - else - nupa(0,il)=remd_m(i2rep(il-1)+1) - k=rep2i(int(i2rep(il-1)))+1 - do i=1,nupa(0,il) - nupa(i,il)=k+1 - k=k+1 - enddo - endif - if (i2rep(il-1).eq.1) then - ndowna(0,il)=0 - else - ndowna(0,il)=remd_m(i2rep(il-1)-1) - k=rep2i(i2rep(il-1)-2)+1 - do i=1,ndowna(0,il) - ndowna(i,il)=k+1 - k=k+1 - enddo - endif - enddo - - write (iout,'(a6,100i4)') "ifirst", - & (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", - & (nupa(i,il),i=1,nupa(0,il)) - write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - - ENDIF - endif -c -c t_bath=retmin+(retmax-retmin)*me/(nodes-1) - if(.not.(rest.and.file_exist.and.restart1file)) then - if (me .eq. king) then - t_bath=retmin - else - t_bath=retmin+(retmax-retmin)*exp(float(i2rep(me)-nrep)) - endif -cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep) - if (remd_tlist) t_bath=remd_t(int(i2rep(me))) - - endif - if(usampl.or.hremd.gt.0) then - iset=i2set(me) - if (hremd.gt.0) call set_hweights(iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) me,"iset=",iset,"t_bath=",t_bath - endif -c - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - -c print *,'irep',me,t_bath - if (.not.rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD Temperature:",t_bath - call rescale_weights(t_bath) - endif - - -c------copy MD-------------- -c The driver for molecular dynamics subroutines -c------------------------------------------------ - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - if(me.eq.king.or..not.out1file) - & write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD - if (rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD restart Temperature:",t_bath - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - elseif (lang.gt.0 .and. surfarea ) then - call setup_fricmat - endif - call rescale_weights(t_bath) - endif - -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - time00=MPI_WTIME() - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'Setup time',time00-walltime -ctime call flush(iout) -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - itime=0 - end_of_run=.false. - do while(.not.end_of_run) - itime=itime+1 - if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true. - if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true. - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - if (me.eq.king .or. .not. out1file) - & write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) -cd write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if(hmc.gt.0 .and. mod(itime,hmc).eq.0) then - call statout(itime) - call hmc_test(itime) - endif - if(ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) - endif - if (mod(itime,ntwx).eq.0.and..not.traj1file) then - write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (mod(itime,ntwx).eq.0.and.traj1file) then - if(ntwx_cache.lt.max_cache_traj_use) then - ntwx_cache=ntwx_cache+1 - else - if (max_cache_traj_use.ne.1) - & print *,itime,"processor ",me," over cache ",ntwx_cache - do i=1,ntwx_cache-1 - - totT_cache(i)=totT_cache(i+1) - EK_cache(i)=EK_cache(i+1) - potE_cache(i)=potE_cache(i+1) - t_bath_cache(i)=t_bath_cache(i+1) - Uconst_cache(i)=Uconst_cache(i+1) - iset_cache(i)=iset_cache(i+1) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,i+1) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,i+1) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,i+1) - ugamma_cache(ii,i)=ugamma_cache(ii,i+1) - uscdiff_cache(ii,i)=uscdiff_cache(ii,i+1) - enddo - - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,i+1) - enddo - enddo - enddo - endif - - totT_cache(ntwx_cache)=totT - EK_cache(ntwx_cache)=EK - potE_cache(ntwx_cache)=potE - t_bath_cache(ntwx_cache)=t_bath - Uconst_cache(ntwx_cache)=Uconst - iset_cache(ntwx_cache)=iset - - do i=1,nfrag - qfrag_cache(i,ntwx_cache)=qfrag(i) - enddo - do i=1,npair - qpair_cache(i,ntwx_cache)=qpair(i) - enddo - do i=1,nfrag_back - utheta_cache(i,ntwx_cache)=utheta(i) - ugamma_cache(i,ntwx_cache)=ugamma(i) - uscdiff_cache(i,ntwx_cache)=uscdiff(i) - enddo - - do i=1,nres*2 - do j=1,3 - c_cache(j,i,ntwx_cache)=c(j,i) - enddo - enddo - - endif - if ((rstcount.eq.1000.or.itime.eq.n_timestep) - & .and..not.restart1file) then - - if(me.eq.king) then - open(irest1,file=mremd_rst_name,status='unknown') - write (irest1,*) "i2rep" - write (irest1,*) (i2rep(i),i=0,nodes-1) - write (irest1,*) "ifirst" - write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (irest1,*) "nupa",il - write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - write (irest1,*) "ndowna",il - write (irest1,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl.or.hremd.gt.0) then - write (irest1,*) "nset" - write (irest1,*) nset - write (irest1,*) "mset" - write (irest1,*) (mset(i),i=1,nset) - write (irest1,*) "i2set" - write (irest1,*) (i2set(i),i=0,nodes-1) - write (irest1,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - write(irest1,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - endif - close(irest1) - endif - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl.or.hremd.gt.0) then - write (irest2,*) iset - endif - close(irest2) - rstcount=0 - endif - -c REMD - exchange -c forced synchronization - if (mod(itime,i_sync_step).eq.0 .and. me.ne.king - & .and. .not. mremdsync) then - synflag=.false. - call mpi_iprobe(0,101,CG_COMM,synflag,status,ierr) - if (synflag) then - call mpi_recv(itime_master, 1, MPI_INTEGER, - & 0,101,CG_COMM, status, ierr) - call mpi_barrier(CG_COMM, ierr) -cdeb if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) - if(traj1file) - & call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (.not.out1file) - & write(iout,*) 'REMD synchro at',itime_master,itime - if (itime_master.ge.n_timestep .or. ovrtim()) - & end_of_run=.true. -ctime call flush(iout) - endif - endif - -c REMD - exchange - if ((mod(itime,nstex).eq.0.and.me.eq.king - & .or.end_of_run.and.me.eq.king ) - & .and. .not. mremdsync ) then - synflag=.true. - time01_=MPI_WTIME() - do i=1,nodes-1 - call mpi_isend(itime,1,MPI_INTEGER,i,101, - & CG_COMM, ireqi(i), ierr) -cd write(iout,*) 'REMD synchro with',i -cd call flush(iout) - enddo - call mpi_waitall(nodes-1,ireqi,statusi,ierr) - call mpi_barrier(CG_COMM, ierr) - time01=MPI_WTIME() - write(iout,*) 'REMD synchro at',itime,'time=',time01-time01_ - if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & itime_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' REMD synchro itime', -cdeb & (itime_all(i),i=1,nodes) - if(traj1file) then -cdeb imin_itime=itime_all(1) -cdeb do i=2,nodes -cdeb if(itime_all(i).lt.imin_itime) imin_itime=itime_all(i) -cdeb enddo -cdeb ii_write=(imin_itime-imin_itime_old)/ntwx -cdeb imin_itime_old=int(imin_itime/ntwx)*ntwx -cdeb write(iout,*) imin_itime,imin_itime_old,ii_write - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) -c write(iout,'(a19,8000i8)') ' ntwx_cache', -c & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo -c write(iout,*) "MIN ii_write=",ii_write - endif - endif -ctime call flush(iout) - endif - if(mremdsync .and. mod(itime,nstex).eq.0) then - synflag=.true. - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'REMD synchro at',itime - - if(traj1file) then - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (me.eq.king) then - write(iout,'(a19,8000i8)') ' ntwx_cache', - & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo - write(iout,*) "MIN ii_write=",ii_write - endif - endif -ctest call flush(iout) - endif - if (synflag) then -c Update the time safety limiy - if (time001-time00.gt.safety) then - safety=time001-time00+600 - if (me.eq.king .or. .not. out1file) - & write (iout,*) "****** SAFETY increased to",safety," s" - endif - if (ovrtim()) end_of_run=.true. - endif - if(synflag.and..not.end_of_run) then - time02=MPI_WTIME() - synflag=.false. - -c write(iout,*) 'REMD before',me,t_bath - -c call mpi_gather(t_bath,1,mpi_double_precision, -c & remd_t_bath,1,mpi_double_precision,king, -c & CG_COMM,ierr) - potEcomp(n_ene+1)=t_bath - t_bath_old=t_bath - if (usampl) then - potEcomp(n_ene+2)=iset - if (iset.lt.nset) then - i_set_temp=iset - iset=iset+1 - call EconstrQ - potEcomp(n_ene+3)=Uconst - iset=i_set_temp - endif - if (iset.gt.1) then - i_set_temp=iset - iset=iset-1 - call EconstrQ - potEcomp(n_ene+4)=Uconst - iset=i_set_temp - endif - endif - if(hremd.gt.0) potEcomp(n_ene+2)=iset - call mpi_gather(potEcomp(0),n_ene+5,mpi_double_precision, - & remd_ene(0,1),n_ene+5,mpi_double_precision,king, - & CG_COMM,ierr) - if(lmuca) then - call mpi_gather(elow,1,mpi_double_precision, - & elowi,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_gather(ehigh,1,mpi_double_precision, - & ehighi,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - - time03=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD gather times=',time03-time01 - & ,time03-time02 - endif - - if (restart1file) call write1rst(i_index) - - time04=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing rst time=',time04-time03 - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' ntwx_cache after traj1file', -cdeb & (icache_all(i),i=1,nodes) -cd end - - - time05=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing traj time=',time05-time04 -ctime call flush(iout) - endif - - - if (me.eq.king) then - do i=1,nodes - remd_t_bath(i)=remd_ene(n_ene+1,i) - iremd_iset(i)=remd_ene(n_ene+2,i) - enddo -#ifdef DEBUG - if(lmuca) then -co write(iout,*) 'REMD exchange temp,ene,elow,ehigh' - do i=1,nodes - write(iout,'(i4,4f12.5)') i,remd_t_bath(i),remd_ene(0,i), - & elowi(i),ehighi(i) - enddo - else - write(iout,*) 'REMD exchange temp,ene' - do i=1,nodes - write(iout,'(i4,2f12.5)') i,remd_t_bath(i),remd_ene(0,i) - write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) - enddo - endif -#endif -c------------------------------------- - IF(.not.usampl.and.hremd.eq.0) THEN -#ifdef DEBUG - write (iout,*) "Enter exchnge, remd_m",remd_m(1), - & " nodes",nodes -ctime call flush(iout) - write (iout,*) "remd_m(1)",remd_m(1) -#endif - do irr=1,remd_m(1) - i=ifirst(iran_num(1,remd_m(1))) -#ifdef DEBUG - write (iout,*) "i",i -#endif -ctime call flush(iout) - - do ii=1,nodes-1 - -#ifdef DEBUG - write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i)) -#endif - if(i.gt.0.and.nupa(0,i).gt.0) then - iex=i -c if (i.eq.1 .and. int(nupa(0,i)).eq.1) then -c write (iout,*) -c & "CHUJ ABSOLUTNY!!! No way to sample a distinct replica in MREMD" -c call flush(iout) -c call MPI_Abort(MPI_COMM_WORLD,ERRCODE,ierr) -c endif -c do while (iex.eq.i) -c write (iout,*) "upper",nupa(int(nupa(0,i)),i) - iex=nupa(iran_num(1,int(nupa(0,i))),i) -c enddo -c write (iout,*) "nupa(0,i)",nupa(0,i)," iex",iex - if (lmuca) then - call muca_delta(remd_t_bath,remd_ene,i,iex,delta) - else -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -c write (iout,*) "i",i," ene_i_i",ene_i_i, -c & " iex",iex," ene_iex_iex",ene_iex_iex -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(i) -c call flush(iout) - call rescale_weights(remd_t_bath(i)) - -c write (iout,*) "0,iex",remd_t_bath(i) -c call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -c write (iout,*) "ene_iex_i",remd_ene(0,iex) - -c write (iout,*) "0,i",remd_t_bath(i) -c call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -c write (iout,*) "ene_i_i",remd_ene(0,i) -c call flush(iout) -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(iex) - if (abs(ene_i_i-remd_ene(0,i)).gt.ene_tol) then - write (iout,*) "ERROR: inconsistent energies:",i, - & ene_i_i,remd_ene(0,i) - endif - call rescale_weights(remd_t_bath(iex)) - -c write (iout,*) "0,i",remd_t_bath(iex) -c call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -c write (iout,*) "ene_i_iex",remd_ene(0,i) -c call flush(iout) - ene_i_iex=remd_ene(0,i) - -c write (iout,*) "0,iex",remd_t_bath(iex) -c call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - if (abs(ene_iex_iex-remd_ene(0,iex)).gt.ene_tol) then - write (iout,*) "ERROR: inconsistent energies:",iex, - & ene_iex_iex,remd_ene(0,iex) - endif -c write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -c write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -c & " ene_i_iex",ene_i_iex, -c & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex -c call flush(iout) - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -c write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - endif - if (delta .gt. 50.0d0) then - delta=0.0d0 - else -#ifdef OSF - if(isnan(delta))then - delta=0.0d0 - else if (delta.lt.-50.0d0) then - delta=dexp(50.0d0) - else - delta=dexp(-delta) - endif -#else - delta=dexp(-delta) -#endif - endif - iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -c write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx -c call flush(iout) - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - if(lmuca) then - tmp=elowi(i) - elowi(i)=elowi(iex) - elowi(iex)=tmp - tmp=ehighi(i) - ehighi(i)=ehighi(iex) - ehighi(iex)=tmp - endif - - - do k=0,nodes - itmp=nupa(k,i) - nupa(k,i)=nupa(k,iex) - nupa(k,iex)=itmp - itmp=ndowna(k,i) - ndowna(k,i)=ndowna(k,iex) - ndowna(k,iex)=itmp - enddo - do il=1,nodes - if (ifirst(il).eq.i) ifirst(il)=iex - do k=1,nupa(0,il) - if (nupa(k,il).eq.i) then - nupa(k,il)=iex - elseif (nupa(k,il).eq.iex) then - nupa(k,il)=i - endif - enddo - do k=1,ndowna(0,il) - if (ndowna(k,il).eq.i) then - ndowna(k,il)=iex - elseif (ndowna(k,il).eq.iex) then - ndowna(k,il)=i - endif - enddo - enddo - - iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - -c write(iout,*) 'exchange',i,iex -c write (iout,'(a8,100i4)') "@ ifirst", -c & (ifirst(k),k=1,remd_m(1)) -c do il=1,nodes -c write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":", -c & (nupa(k,il),k=1,nupa(0,il)) -c write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":", -c & (ndowna(k,il),k=1,ndowna(0,il)) -c enddo -c call flush(iout) - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - i=iex - endif - endif - enddo - enddo -cd write (iout,*) "exchange completed" -cd call flush(iout) - ELSEIF (usampl) THEN - do ii=1,nodes -cd write(iout,*) "########",ii - - i_temp=iran_num(1,nrep) - i_mult=iran_num(1,remd_m(i_temp)) - i_iset=iran_num(1,nset) - i_mset=iran_num(1,mset(i_iset)) - i=i_index(i_temp,i_mult,i_iset,i_mset) - -cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - - if(t_exchange_only)then - i_dir=1 - else - i_dir=iran_num(1,3) - endif -cd write(iout,*) "i_dir=",i_dir - - if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then - - i_temp1=i_temp - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - elseif(remd_m(i_temp+1).gt.0.and.mset(i_iset+1).gt.0)then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - else - goto 444 - endif - -cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 -ctime call flush(iout) - -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -co write (iout,*) "rescaling weights with temperature", -co & remd_t_bath(i) - call rescale_weights(remd_t_bath(i)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -cd write (iout,*) "ene_iex_i",remd_ene(0,iex) -c call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_i",remd_ene(0,i) -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(iex) -c if (real(ene_i_i).ne.real(remd_ene(0,i))) then -c write (iout,*) "ERROR: inconsistent energies:",i, -c & ene_i_i,remd_ene(0,i) -c endif - call rescale_weights(remd_t_bath(iex)) - call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_iex",remd_ene(0,i) - ene_i_iex=remd_ene(0,i) -c call sum_energy(remd_ene(0,iex),.false.) -c if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then -c write (iout,*) "ERROR: inconsistent energies:",iex, -c & ene_iex_iex,remd_ene(0,iex) -c endif -cd write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -cd write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -cd & " ene_i_iex",ene_i_iex, -cd & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -cd write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - if (delta .gt. 50.0d0) then - delta=0.0d0 - else - delta=dexp(-delta) - endif - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_tot_usa(int(i2set(i-1)))= - & iremd_tot_usa(int(i2set(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - - itmp=iremd_iset(i) - iremd_iset(i)=iremd_iset(iex) - iremd_iset(iex)=itmp - - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_acc_usa(int(i2set(i-1)))= - & iremd_acc_usa(int(i2set(i-1)))+1 - - itmp=i2set(i-1) - i2set(i-1)=i2set(iex-1) - i2set(iex-1)=itmp - - itmp=i_index(i_temp,i_mult,i_iset,i_mset) - i_index(i_temp,i_mult,i_iset,i_mset)= - & i_index(i_temp1,i_mult1,i_iset1,i_mset1) - i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - remd_ene(20,iex)=econstr_temp_iex - remd_ene(20,i)=econstr_temp_i - endif - -cd do il=1,nset -cd do il1=1,mset(il) -cd do i=1,nrep -cd do j=1,remd_m(i) -cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1) -cd enddo -cd enddo -cd enddo -cd enddo - - 444 continue - - enddo - - ELSEIF (hremd.gt.0) THEN - do ii=1,nodes -cd write(iout,*) "########",ii - - i_temp=iran_num(1,nrep) - i_mult=iran_num(1,remd_m(i_temp)) - i_iset=iran_num(1,nset) - i_mset=1 - i=i_index(i_temp,i_mult,i_iset,i_mset) - -cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - - if(t_exchange_only)then - i_dir=1 - else - i_dir=iran_num(1,3) - endif - -cd write(iout,*) "i_dir=",i_dir - - if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(i_dir.eq.2)then - - i_temp1=i_temp - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=iran_num(1,hremd) - do while(i_iset1.eq.i_iset) - i_iset1=iran_num(1,hremd) - enddo - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(remd_m(i_temp+1).gt.0)then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=iran_num(1,hremd) - do while(i_iset1.eq.i_iset) - i_iset1=iran_num(1,hremd) - enddo - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - else - goto 445 - endif - -cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 -ctime call flush(iout) - -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) - - call set_hweights(i_iset) - call rescale_weights(remd_t_bath(i)) - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) - - call set_hweights(i_iset1) - call rescale_weights(remd_t_bath(iex)) - call sum_energy(remd_ene(0,i),.false.) - ene_i_iex=remd_ene(0,i) - -cd write(iout,*) ene_iex_iex,ene_i_i,ene_iex_i,ene_i_iex - - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta - - if (delta .gt. 50.0d0) then - delta=0.0d0 - else - delta=dexp(-delta) - endif - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_tot_usa(int(i2set(i-1)))= - & iremd_tot_usa(int(i2set(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx - if (delta .gt. xxx) then - -cd write (iout,*) "exchange" - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - - itmp=iremd_iset(i) - iremd_iset(i)=iremd_iset(iex) - iremd_iset(iex)=itmp - - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_acc_usa(int(i2set(i-1)))= - & iremd_acc_usa(int(i2set(i-1)))+1 - - itmp=i2set(i-1) - i2set(i-1)=i2set(iex-1) - i2set(iex-1)=itmp - - itmp=i_index(i_temp,i_mult,i_iset,i_mset) - i_index(i_temp,i_mult,i_iset,i_mset)= - & i_index(i_temp1,i_mult1,i_iset1,i_mset1) - i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp - -cd do il=1,nset -cd do il1=1,mset(il) -cd do i=1,nrep -cd do j=1,remd_m(i) -cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1) -cd enddo -cd enddo -cd enddo -cd enddo - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - endif - - - - 445 continue - - enddo - - ENDIF - -c------------------------------------- - write (iout,*) "NREP",nrep - do i=1,nrep - if(iremd_tot(i).ne.0) - & write(iout,'(a3,i4,2f12.5,i5)') 'ACC',i,remd_t(i) - & ,iremd_acc(i)/(1.0*iremd_tot(i)),iremd_tot(i) - enddo - - if(usampl) then - do i=1,nset - if(iremd_tot_usa(i).ne.0) - & write(iout,'(a10,i4,f12.5,i8)') 'ACC_usampl',i, - & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i) - enddo - endif - - if(hremd.gt.0) then - do i=1,nset - if(iremd_tot_usa(i).ne.0) - & write(iout,'(a10,i4,f12.5,i8)') 'ACC_hremd',i, - & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i) - enddo - endif - - -ctime call flush(iout) - -cd write (iout,'(a6,100i4)') "ifirst", -cd & (ifirst(i),i=1,remd_m(1)) -cd do il=1,nodes -cd write (iout,'(a5,i4,a1,100i4)') "nup",il,":", -cd & (nupa(i,il),i=1,nupa(0,il)) -cd write (iout,'(a5,i4,a1,100i4)') "ndown",il,":", -cd & (ndowna(i,il),i=1,ndowna(0,il)) -cd enddo - endif - - time06=MPI_WTIME() -cd write (iout,*) "Before scatter" -cd call flush(iout) - call mpi_scatter(remd_t_bath,1,mpi_double_precision, - & t_bath,1,mpi_double_precision,king, - & CG_COMM,ierr) -cd write (iout,*) "After scatter" -cd call flush(iout) - if(usampl.or.hremd.gt.0) - & call mpi_scatter(iremd_iset,1,mpi_integer, - & iset,1,mpi_integer,king, - & CG_COMM,ierr) - - time07=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD scatter time=',time07-time06 - endif - - if(lmuca) then - call mpi_scatter(elowi,1,mpi_double_precision, - & elow,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_scatter(ehighi,1,mpi_double_precision, - & ehigh,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - - if(hremd.gt.0) call set_hweights(iset) - call rescale_weights(t_bath) -co write (iout,*) "Processor",me, -co & " rescaling weights with temperature",t_bath - - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if (lang.gt.0) then - do i=nnt,nct-1 - stdforcp(i)=stdforcp(i)*sqrt(t_bath/t_bath_old) - enddo - do i=nnt,nct - stdforcsc(i)=stdforcsc(i)*sqrt(t_bath/t_bath_old) - enddo - endif -cde write(iout,*) 'REMD after',me,t_bath - time08=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD exchange time=',time08-time02 -ctime call flush(iout) - endif - endif - enddo - - if (restart1file) then - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'writing restart at the end of run' - call write1rst(i_index) - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a40,8000i8)') -cdeb & ' ntwx_cache after traj1file at the end', -cdeb & (icache_all(i),i=1,nodes) -cd end - - -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - if (me.eq.king .or. .not. out1file) then - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - if(hmc.gt.0) write (iout,*) 'HMC acceptance ratio', - & n_timestep*1.0d0/hmc/hmc_acc - endif - return - end - -c----------------------------------------------------------------------- - subroutine write1rst(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & d_restart2(3,2*maxres*maxprocs) - real t5_restart1(5) - integer iret,itmp - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - common /przechowalnia/ d_restart1,d_restart2 - - t5_restart1(1)=totT - t5_restart1(2)=EK - t5_restart1(3)=potE - t5_restart1(4)=t_bath - t5_restart1(5)=Uconst - - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=d_t(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart1,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=dc(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart2,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then -#ifdef AIX - call xdrfopen_(ixdrf,mremd_rst_name, "w", iret) - do i=0,nodes-1 - call xdrfint_(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint_(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - do i=0,nupa(0,il) - call xdrfint_(ixdrf, nupa(i,il), iret) - enddo - - do i=0,ndowna(0,il) - call xdrfint_(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes - do j=1,4 - call xdrffloat_(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat_(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo - - if(usampl) then - call xdrfint_(ixdrf, nset, iret) - do i=1,nset - call xdrfint_(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint_(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - itmp=i_index(i,j,il,il1) - call xdrfint_(ixdrf,itmp, iret) - enddo - enddo - enddo - enddo - - endif - call xdrfclose_(ixdrf, iret) -#else - call xdrfopen(ixdrf,mremd_rst_name, "w", iret) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - do i=0,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - - do i=0,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo - - - if(usampl) then - call xdrfint(ixdrf, nset, iret) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - itmp=i_index(i,j,il,il1) - call xdrfint(ixdrf,itmp, iret) - enddo - enddo - enddo - enddo - - endif - call xdrfclose(ixdrf, iret) -#endif - endif - return - end - - - subroutine write1traj - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real t5_restart1(5) - integer iret,itmp - real xcoord(3,maxres2+2),prec - real r_qfrag(50),r_qpair(100) - real r_utheta(50),r_ugamma(100),r_uscdiff(100) - real p_qfrag(50*maxprocs),p_qpair(100*maxprocs) - real p_utheta(50*maxprocs),p_ugamma(100*maxprocs), - & p_uscdiff(100*maxprocs) - real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2) - common /przechowalnia/ p_c - - call mpi_bcast(ii_write,1,mpi_integer, - & king,CG_COMM,ierr) - -c debugging - print *,'traj1file',me,ii_write,ntwx_cache -c end debugging - -#ifdef AIX - if(me.eq.king) call xdrfopen_(ixdrf,cartname, "a", iret) -#else - if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) -#endif - do ii=1,ii_write - t5_restart1(1)=totT_cache(ii) - t5_restart1(2)=EK_cache(ii) - t5_restart1(3)=potE_cache(ii) - t5_restart1(4)=t_bath_cache(ii) - t5_restart1(5)=Uconst_cache(ii) - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - call mpi_gather(iset_cache(ii),1,mpi_integer, - & iset_restart1,1,mpi_integer,king,CG_COMM,ierr) - - do i=1,nfrag - r_qfrag(i)=qfrag_cache(i,ii) - enddo - do i=1,npair - r_qpair(i)=qpair_cache(i,ii) - enddo - do i=1,nfrag_back - r_utheta(i)=utheta_cache(i,ii) - r_ugamma(i)=ugamma_cache(i,ii) - r_uscdiff(i)=uscdiff_cache(i,ii) - enddo - - call mpi_gather(r_qfrag,nfrag,mpi_real, - & p_qfrag,nfrag,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_qpair,npair,mpi_real, - & p_qpair,npair,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_utheta,nfrag_back,mpi_real, - & p_utheta,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_ugamma,nfrag_back,mpi_real, - & p_ugamma,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_uscdiff,nfrag_back,mpi_real, - & p_uscdiff,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - -#ifdef DEBUG - write (iout,*) "p_qfrag" - do i=1,nodes - write (iout,*) i,(p_qfrag((i-1)*nfrag+j),j=1,nfrag) - enddo - write (iout,*) "p_qpair" - do i=1,nodes - write (iout,*) i,(p_qpair((i-1)*npair+j),j=1,npair) - enddo -ctime call flush(iout) -#endif - do i=1,nres*2 - do j=1,3 - r_c(j,i)=c_cache(j,i,ii) - enddo - enddo - - call mpi_gather(r_c,3*2*nres,mpi_real, - & p_c,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then -#ifdef AIX - do il=1,nodes - call xdrffloat_(ixdrf, real(t_restart1(1,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(3,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(5,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret) - call xdrfint_(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint_(ixdrf, idssb(j)+nres, iret) - call xdrfint_(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) - call xdrfint_(ixdrf, iset_restart1(il), iret) - do i=1,nfrag - call xdrffloat_(ixdrf, p_qfrag(i+(il-1)*nfrag), iret) - enddo - do i=1,npair - call xdrffloat_(ixdrf, p_qpair(i+(il-1)*npair), iret) - enddo - do i=1,nfrag_back - call xdrffloat_(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret) - call xdrffloat_(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret) - call xdrffloat_(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret) - enddo - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=p_c(j,i+(il-1)*nres*2) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2) - enddo - enddo - itmp=nres+nct-nnt+1 - call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) - enddo -#else - do il=1,nodes - call xdrffloat(ixdrf, real(t_restart1(1,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(3,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(5,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - call xdrfint(ixdrf, iset_restart1(il), iret) - do i=1,nfrag - call xdrffloat(ixdrf, p_qfrag(i+(il-1)*nfrag), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, p_qpair(i+(il-1)*npair), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret) - enddo - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=p_c(j,i+(il-1)*nres*2) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2) - enddo - enddo - itmp=nres+nct-nnt+1 - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - enddo -#endif - endif - enddo -#ifdef AIX - if(me.eq.king) call xdrfclose_(ixdrf, iret) -#else - if(me.eq.king) call xdrfclose(ixdrf, iret) -#endif - do i=1,ntwx_cache-ii_write - - totT_cache(i)=totT_cache(ii_write+i) - EK_cache(i)=EK_cache(ii_write+i) - potE_cache(i)=potE_cache(ii_write+i) - t_bath_cache(i)=t_bath_cache(ii_write+i) - Uconst_cache(i)=Uconst_cache(ii_write+i) - iset_cache(i)=iset_cache(ii_write+i) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,ii_write+i) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,ii_write+i) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,ii_write+i) - ugamma_cache(ii,i)=ugamma_cache(ii,ii_write+i) - uscdiff_cache(ii,i)=uscdiff_cache(ii,ii_write+i) - enddo - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,ii_write+i) - enddo - enddo - enddo - ntwx_cache=ntwx_cache-ii_write - return - end - - - subroutine read1restart(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - common /przechowalnia/ d_restart1 - write (*,*) "Processor",me," called read1restart" - - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read(irest2,*,err=334) i - write(iout,*) "Reading old rst in ASCI format" - close(irest2) - call read1restart_old - return - 334 continue -#ifdef AIX - call xdrfopen_(ixdrf,mremd_rst_name, "r", iret) - - do i=0,nodes-1 - call xdrfint_(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint_(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - call xdrfint_(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint_(ixdrf, nupa(i,il), iret) - enddo - - call xdrfint_(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint_(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes - do j=1,4 - call xdrffloat_(ixdrf, t_restart1(j,il), iret) - enddo - enddo -#else - call xdrfopen(ixdrf,mremd_rst_name, "r", iret) - - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - call xdrfint(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - - call xdrfint(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo -#endif - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 -#ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) -#else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) -#endif - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 -#ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) -#else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) -#endif - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - - - if(usampl) then -#ifdef AIX - if(me.eq.king)then - call xdrfint_(ixdrf, nset, iret) - do i=1,nset - call xdrfint_(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint_(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - call xdrfint_(ixdrf,itmp, iret) - i_index(i,j,il,il1)=itmp - enddo - enddo - enddo - enddo - endif -#else - if(me.eq.king)then - call xdrfint(ixdrf, nset, iret) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - call xdrfint(ixdrf,itmp, iret) - i_index(i,j,il,il1)=itmp - enddo - enddo - enddo - enddo - endif -#endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its -c own element -c call mpi_scatter(i2set,1,mpi_integer, -c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) - call mpi_bcast(i2set(0),nodes,mpi_integer,king, - & CG_COMM,ierr) - iset=i2set(me) - - endif - - - if(me.eq.king) close(irest2) - return - end - - subroutine read1restart_old - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - common /przechowalnia/ d_restart1 - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - do il=1,nodes - read(irest2,*) (t_restart1(j,il),j=1,4) - enddo - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king) close(irest2) - return - end -c------------------------------------------------------------------- - subroutine set_hweights(iiset) - implicit real*8 (a-h,o-z) - integer i - include 'DIMENSIONS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - - do i=1,n_ene - weights(i)=hweights(iiset,i) - enddo - - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - return - end -#endif diff --git a/source/unres/src_MD-DFA-restraints/Makefile b/source/unres/src_MD-DFA-restraints/Makefile deleted file mode 100644 index d4615a5..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile +++ /dev/null @@ -1,133 +0,0 @@ -################################################################### -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - -FC = ifort -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGS3 = -c -w -O3 -mp -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -CC = cc - -CFLAGS = -DLINUX -DPGI -c - -OPT = -O3 -ip -w - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: - @echo "Specify force field: GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o dfa.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../bin/unres_ifort_MPICH-restr-DFA_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_MPICH-restr-DFA_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -dfa.o : dfa.F - ${FC} -mp ${FFLAGS3} ${CPPFLAGS} dfa.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile-intrepid-with-tau b/source/unres/src_MD-DFA-restraints/Makefile-intrepid-with-tau deleted file mode 100644 index eae1cc5..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile-intrepid-with-tau +++ /dev/null @@ -1,154 +0,0 @@ -# -FC1=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -FC=tau_f90.sh -OPT = -O3 -qarch=450 -qtune=450 -qfixed -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT = -O -qarch=450 -qtune=450 -qfixed -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT = -O0 -C -g -qarch=450 -qtune=450 -qfixed -OPT1 = -O0 -g -qarch=450 -qtune=450 -qfixed -OPT2 = -O2 -qarch=450 -qtune=450 -qfixed -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT2 = ${OPT} -OPTE = -O4 -qarch=450 -qtune=450 -qfixed -#OPTE = -O4 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPTE=${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-O4-test.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} --print-map ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o; /bin/rm *.pp.* - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -compinfo: compinfo.o - ${CC} ${CFLAGS} compfinfo.c - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -prng_32.o: prng_32.F - ${FC} -qfixed -O0 prng_32.F - -prng.o: prng.f - ${FC1} ${FFLAGS} prng.f - -readrtns_CSA.o: readrtns_CSA.F - ${FC1} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC1} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F diff --git a/source/unres/src_MD-DFA-restraints/Makefile.tau-mpi-f77-pdt b/source/unres/src_MD-DFA-restraints/Makefile.tau-mpi-f77-pdt deleted file mode 100644 index c8dc5fe..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile.tau-mpi-f77-pdt +++ /dev/null @@ -1,860 +0,0 @@ -#**************************************************************************** -#* TAU Portable Profiling Package ** -#* http://www.cs.uoregon.edu/research/tau ** -#**************************************************************************** -#* Copyright 1997-2002 ** -#* Department of Computer and Information Science, University of Oregon ** -#* Advanced Computing Laboratory, Los Alamos National Laboratory ** -#**************************************************************************** -####################################################################### -## pC++/Sage++ Copyright (C) 1993,1995 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -####################################################################### -# This is a sample Makefile that contains the Profiling and Tracing -# options. Makefiles of other applications and libraries (not included -# in this distribution) should include this Makefile. -# It defines the following variables that should be added to CFLAGS -# TAU_INCLUDE - Include path for tau headers -# TAU_DEFS - Defines that are needed for tracing and profiling only. -# And for linking add to LIBS -# TAU_LIBS - TAU Tracing and Profiling library libprof.a -# -# When the user needs to turn off tracing and profiling and run the -# application without any runtime overhead of instrumentation, simply -# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep -# TAUINC. -####################################################################### - -########### Automatically modified by the configure script ############ -CONFIG_ARCH=bgp -TAU_ARCH=bgp -CONFIG_CC=bgxlc_r -CONFIG_CXX=bgxlC_r -TAU_CC_FE=$(CONFIG_CC) -TAU_CXX_FE=$(CONFIG_CXX) - -# Front end C/C++ Compilers -#BGL#TAU_CC_FE=xlc #ENDIF# -#BGL#TAU_CXX_FE=xlC #ENDIF# -TAU_CC_FE=xlc #ENDIF##BGP# -TAU_CXX_FE=xlC #ENDIF##BGP# -#CATAMOUNT#TAU_CC_FE=gcc #ENDIF# -#CATAMOUNT#TAU_CXX_FE=g++ #ENDIF# -#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF# -#SC_GFORTRAN#TAU_CXX_FE=g++ #ENDIF# -#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF# -#SC_PATHSCALE#TAU_CXX_FE=g++ #ENDIF# - -PCXX_OPT=-g -USER_OPT= -EXTRADIR=/opt/ibmcmp/xlf/bg/11.1/bin/.. -EXTRADIRCXX=/opt/ibmcmp/vacpp/bg/9.0/bin/.. -TAUROOT=/soft/apps/tau/tau_latest -TULIPDIR= -TAUEXTRASHLIBOPTS= -TAUGCCLIBOPTS= -TAUGCCLIBDIR= -TAUGFORTRANLIBDIR= -PCLDIR= -PAPIDIR= -PAPISUBDIR= -CHARMDIR= -PDTDIR=/soft/apps/tau/pdtoolkit-3.12 -PDTCOMPDIR= -DYNINSTDIR= -JDKDIR= -SLOG2DIR= -OPARIDIR= -TAU_OPARI_TOOL= -EPILOGDIR= -EPILOGBINDIR= -EPILOGINCDIR= -EPILOGLIBDIR= -EPILOGEXTRALINKCMD= -VAMPIRTRACEDIR= -KTAU_INCDIR= -KTAU_INCUSERDIR= -KTAU_LIB= -KTAU_KALLSYMS_PATH= -PYTHON_INCDIR= -PYTHON_LIBDIR= -PERFINCDIR= -PERFLIBDIR= -PERFLIBRARY= -TAU_SHMEM_INC= -TAU_SHMEM_LIB= -TAU_CONFIG=-mpi-pdt -TAU_MPI_INC=-I/bgsys/drivers/ppcfloor/comm/include -TAU_MPI_LIB=-L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_FLIB=-lfmpich.cnk -L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPILIB_DIR=/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_LIB= -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_FLIB=-lfmpich.cnk -L/bgsys/drivers/ppcfloor/comm/lib -FULL_CXX=mpixlcxx_r -FULL_CC=mpixlc_r -TAU_PREFIX_INSTALL_DIR=/soft/apps/tau/tau_latest - -TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin -TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include -TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib - -####################################################################### - -#OPARI#TAU_OPARI_TOOL=$(TAU_BIN_DIR)/opari #ENDIF# -#ENABLE64BIT#ABI = -64 #ENDIF# -#ENABLEN32BIT#ABI = -n32 #ENDIF# -#ENABLE32BIT#ABI = -32 #ENDIF# - -####################################################################### -#SP1#IBM_XLC_ABI = -q32 #ENDIF# -#SP1#IBM_GNU_ABI = -maix32 #ENDIF# -#IBM64#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64#IBM_GNU_ABI = -maix64 #ENDIF# -#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF# -#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF# -#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF# -#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF# -#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF# -#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF# -#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF# -#MIPS32#ABI = $(SC_ABI) #ENDIF# -#MIPS64#ABI = $(SC_ABI) #ENDIF# - -IBM_ABI = $(IBM_XLC_ABI) #ENDIF##USE_IBMXLC# -#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF# -#SP1# ABI = $(IBM_ABI) #ENDIF# -#PPC64# ABI = $(IBM_ABI) #ENDIF# -#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF# -#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF# -#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF# -#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF# -#SOL2#ABI = $(SUN_ABI) #ENDIF# -#SUNX86_64#ABI = $(SUN_ABI) #ENDIF# -#FORCEIA32#ABI = -m32#ENDIF# -####################################################################### -F90_ABI = $(ABI) -#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF# -####################################################################### - -############# Standard Defines ############## -TAU_CC = $(CONFIG_CC) $(ABI) $(ISA) -TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA) -TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA) -TAU_INSTALL = /bin/cp -TAU_SHELL = /bin/sh -LSX = .a -############################################# -# JAVA DEFAULT ARCH -############################################# -JDKARCH = linux -#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF# -#SOL2#JDKARCH = solaris #ENDIF# -#SGIMP#JDKARCH = irix #ENDIF# -#SP1#JDKARCH = aix #ENDIF# -#T3E#JDKARCH = cray #ENDIF# -############################################# -# JAVA OBJECTS -############################################# -#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF# -#JAVA#TAUJAPI = Profile.class #ENDIF# - - -############################################# -# OpenMP OBJECTS -############################################# -#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF# - -############################################# -# Opari OBJECTS -############################################# -#OPARI#OPARI_O = TauOpari.o #ENDIF# -#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF# -#EPILOG#OPARI_O = #ENDIF# -#VAMPIRTRACE#OPARI_O = #ENDIF# -#GNU#OPARI_O = #ENDIF# - -############################################# -# CallPath OBJECTS -############################################# -#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF# -#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF# - -############################################# -# Python Binding OBJECTS -############################################# -#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF# - -############################################# -# DYNINST DEFAULT ARCH -############################################# -DYNINST_PLATFORM = $(PLATFORM) - - -#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF# - -############# OpenMP Fortran Option ######## -#OPENMP#TAU_F90_OPT = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF# -#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF# -#GUIDE#TAU_F90_OPT = #ENDIF# -#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF# -#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF# -#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF# - -TAU_R =_r #ENDIF##THREADSAFE_COMPILERS# - -############# Fortran Compiler ############# -#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = xlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##IBM_FORTRAN# -TAU_F90 = mpixlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##BGP# -#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_FORTRAN#TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_CATAMOUNT#TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# - - -############# Portable F90 Options ############# -#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -TAU_F90_FIXED = -qfixed #ENDIF##IBM_FORTRAN# -TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF##IBM_FORTRAN# -#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF# -#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# - -############# Profiling Options ############# -PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE# -#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF# -#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF# -#PCL#PCL_O = PclLayer.o #ENDIF# -#PAPI#PAPI_O = PapiLayer.o #ENDIF# -#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF# -#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF# -#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF# -#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF# -PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB# -#CRAYX1CC#PROFILEOPT7 = #ENDIF# -#CRAYCC#PROFILEOPT7 = #ENDIF# -#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF# -#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF# -#RTTI#PROFILEOPT9 = -DRTTI #ENDIF# -#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF# -#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF# -#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF# -#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF# -#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF# -#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF# -#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF# -#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF# -#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF# -#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF# -#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF# -#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF# -#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF# -#TRACE#TRACEOPT = -DTRACING_ON #ENDIF# -#TRACE#EVENTS_O = Tracer.o #ENDIF# -#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF# -#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF# -#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF# -#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF# -#MPITRACE#EVENTS_O = Tracer.o #ENDIF# -#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF# -#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF# -#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF# -#TAU_SPROC#THR_O = SprocLayer.o #ENDIF# -#JAVA#THR_O = JavaThreadLayer.o #ENDIF# -#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF# -#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF# -#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF# -#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF# -#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF# -#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#PGI#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF# -#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF# -#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF# -#HPGNU#PROFILEOPT21 = -fPIC #ENDIF# -#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF# -#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF# -#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF# -#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF# -PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF##USE_IBMXLC# -#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF# -#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF# -#JAVA#PROFILEOPT23 = -DJAVA #ENDIF# -#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF# -#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF# -PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI# -PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED# -#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF# -#GNU#PROFILEOPT27 = #ENDIF# -#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF# -#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF# -#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF# -#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF# -#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF# -#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF# -#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF# -#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF# -#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF# -#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF# -#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -#BGPTIMERS#PROFILEOPT30 = -DBGP_TIMERS -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF# -#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF# -#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF# -#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF# -#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF# -#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF# -#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF# -#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF# -#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#SCALASCA#PROFILEOPT36 = -DTAU_SCALASCA -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF# -#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF# -#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF# -#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF# -#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF# -#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF# -#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF# -#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF# -#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF# -#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF# -#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF# -#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF# -# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore -#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF# -PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST# -#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF# -PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP# -PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER# -#CATAMOUNT#PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF# -#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF# -PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR# -PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX# -PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR# -#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF# - -#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF# -#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF# -#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF# -#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE -D__xlc__ #ENDIF##BGP# -# Omit the -D_LARGETFILE64_SOURCE till we can check the IBM crash -#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF# -#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF# -#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF# -#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF# -#WEAKMPIINIT#PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF# -#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF# -#MPICH_IGNORE_CXX_SEEK#PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF# -PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##BGP# -#MPICH2_MPI_INPLACE#PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF# - - -############# RENCI Scalable Trace Lib Options ############# -STFF_DIR= -SDDF_DIR= -#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF# -#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF# -#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF# - -############# KTAU (again) ############# -#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF# - -#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF# - -#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -PROFILEOPT72 = -DTAU_BGP -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF##BGP# - -#For F90 support for all platforms -FWRAPPER = TauFMpi.o -MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2# -MPI2EXTENSIONS = #ENDIF##BGP# -#CRAYX1CC#MPI2EXTENSIONS = #ENDIF# - -#SGICOUNTERS#LEXTRA = -lperfex #ENDIF# -#ALPHATIMERS#LEXTRA = -lrt #ENDIF# -#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF# -#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF# -#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# -#Due to some problems with older versions of libpfm, we are using the static lib -#IA64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#PAPIPFM##LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF# -#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF# -#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF# -#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF# -#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF# -#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF# -#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF# -#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF# - -TAU_PAPI_EXTRA_FLAGS = $(LEXTRA) -#IA64PAPI#TAU_PAPI_EXTRA_FLAGS = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# - - -# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis. -#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#PAPI##TAU_PAPI_RPATH = #ENDIF# -#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF# -#BGLPAPI#TAU_PAPI_RPATH = #ENDIF# -#BGPPAPI#TAU_PAPI_RPATH = #ENDIF# -#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF# -#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF# -#PGI#TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF# - -# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath -# because they are likely going to link with ifort -#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF# -#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF# -#IBMPAPI#TAU_PAPI_RPATH = #ENDIF# -#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF# -#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF# - -#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF# -#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF# -#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF# -#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF# - -TAU_GCCLIB = -lgcc_s -TAU_GCCLIB = #ENDIF##BGP# -#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF# -#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF# -#BGL#TAU_GCCLIB = -lgcc #ENDIF# -#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF# -#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF# -#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF# -#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF# -#GNU_GFORTRAN#TAU_FORTRANLIBS = -L$(TAUGFORTRANLIBDIR) -lgfortran -lgfortranbegin #ENDIF# -#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF# -TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF##IBM_FORTRAN# - -TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF# -#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF# -TAU_FORLIBDIR=lib #ENDIF##IBM_FORTRAN# -#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF# -TAU_FORLIBDIR=bglib #ENDIF##BGP# -#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF# -#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF# - -TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF##BGP# -#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF# -TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF##BGP# -TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF##BGP# - -#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#PGI_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF# -#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF# -#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF# -#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF# -#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF# -#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF# -#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF# -# LINKER OPTIONS -TAU_LINKER_OPT2 = $(LEXTRA) - - -#ACC#TAUHELPER = -AA #ENDIF# -#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF# -#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF# -#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF# -#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF# -#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF# -#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF# -#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF# -#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF# -#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF# -#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF# -#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF# - - -#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF# - -## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add -#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF# -#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF# -#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#PGI#TAU_CXXLIBS = -lstd -lC #ENDIF# -#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF# -#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF# - -TAU_SGI_INIT = /usr/lib32/c++init.o -#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF# -#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF# -#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF# - -#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF# -#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF# -#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF# -#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF# -#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF# -#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF# -#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF# -#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF# -TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF##BGP# -#SP1#TAU_XLCLIBS = -lC #ENDIF# -TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF##USE_IBMXLC# -#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF# -#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF# - -# EXTERNAL PACKAGES: VAMPIRTRACE -#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# - -# EXTERNAL PACKAGES: EPILOG -#SCALASCA#TAU_ELG_SERIAL_SUFFIX =.ser #ENDIF# -#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg$(TAU_ELG_SERIAL_SUFFIX) $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# - -# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up -#FORCESHARED#TAU_LINKER_OPT3=#ENDIF# - -TAU_LINKER_OPT4 = $(LEXTRA1) -#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF# -#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF# -#GNU#TAU_LINKER_OPT5 = #ENDIF# -#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF# -#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#GUIDE#TAU_LINKER_OPT5 = #ENDIF# -#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF# - -# MALLINFO needs -lmalloc on sgi, sun -#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SOL2#TAU_LINKER_OPT6 = #ENDIF# -#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF# - -# We need -lCio with SGI CC 7.4+ -#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF# - -# charm -#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF# - -# extra libs -#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF# - -#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF# - -TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF# -#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF# - -TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF# -#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF# - - -#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF# -#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF# -#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF# -#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF# -#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF# -#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF# - -TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI# -#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# -#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# - -############################################## -# Build TAU_LINKER_SHOPTS -#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF# -TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF##USE_IBMXLC# -#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF# -#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF# - -############################################## -# MPI _r suffix check (as in libmpi_r) -#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF# - -############################################## -# Flags to build a shared object: TAU_SHFLAGS -#GNU#AR_SHFLAGS = -shared #ENDIF# -#PGI#AR_SHFLAGS = -shared #ENDIF# -#SGICC#AR_SHFLAGS = -shared #ENDIF# -#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF# -#SOL2#AR_SHFLAGS = -G #ENDIF# -#SUN386I#AR_SHFLAGS = -G #ENDIF# -#SUNX86_64#AR_SHFLAGS = -G #ENDIF# -AR_SHFLAGS = -G #ENDIF##USE_IBMXLC# -#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF# -#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF# -#ACC#AR_SHFLAGS = -b #ENDIF# -TAU_SHFLAGS = $(AR_SHFLAGS) -o - -############# RANLIB Options ############# -TAU_RANLIB = echo "Built" -#APPLECXX#TAU_RANLIB = ranlib #ENDIF# -#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF# - -############################################## -TAU_AR = ar #ENDIF# -#SP1#TAU_AR = ar -X32 #ENDIF# -#IBM64#TAU_AR = ar -X64 #ENDIF# -#PPC64#TAU_AR = ar #ENDIF# -#IBM64LINUX#TAU_AR = ar #ENDIF# - - -############################################## -# PDT OPTIONS -# You can specify -pdtcompdir=intel -pdtarchdir=x86_64 -# If nothing is specified, PDTARCHDIR uses TAU_ARCH -PDTARCHDIRORIG=$(TAU_ARCH) -PDTARCHITECTURE=x86_64 -PDTARCHDIRFINAL=$(PDTARCHDIRORIG) -#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF# -PDTARCHDIR=$(PDTARCHDIRFINAL) -#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF# - - -############################################## - -PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \ - $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \ - $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \ - $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \ - $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \ - $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \ - $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \ - $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \ - $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \ - $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \ - $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \ - $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \ - $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \ - $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \ - $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \ - $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \ - $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \ - $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \ - $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \ - $(TRACEOPT) - -############################################## - -TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \ - $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \ - $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \ - $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12) - -############################################## - -############# TAU Fortran #################### -TAU_LINKER=$(TAU_CXX) -#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -# Intel efc compiler acts as a linker - NO. Let C++ be the linker. - -############################################## -############# TAU Options #################### -TAUDEFS = $(PROFILEOPTS) - -TAUINC = -I$(TAU_INC_DIR) - -TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAUMPILIBS = $(TAU_MPI_LIB) - -TAUMPIFLIBS = $(TAU_MPI_FLIB) - -### ACL S/W requirement -TAU_DEFS = $(TAUDEFS) - -TAU_INCLUDE = -I$(TAU_INC_DIR) -#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF# -#PERFLIB#TAU_DEFS = #ENDIF# -#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF# - -TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory -#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# -#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# - -TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) -#PERFLIB#TAU_LIBS = #ENDIF# - -TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) -#PERFLIB#TAU_SHLIBS = #ENDIF# -TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) - -TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable - -TAU_MPI_INCLUDE = $(TAU_MPI_INC) - -TAU_MPI_LIBS = $(TAU_MPI_LIB) - -TAU_MPI_FLIBS = $(TAU_MPI_FLIB) - -## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL) -TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG) - -## Don't include -lpthread or -lsmarts. Let app. do that. -############################################# -## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS -#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF# -TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI# -#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF# -#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF# -TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI# -TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI# -TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI# -TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI# - -#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF# -#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF# -############################################# -#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF# -#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF# -#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF# - -TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC) - -TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB) -############################################# -# TAU COMPILER SHELL SCRIPT OPTIONS -TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\ - -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \ - -optNoMpi \ - -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \ - -optTauCC="$(TAU_CC)" \ - -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \ - -optTauDefs="$(TAU_DEFS)" \ - -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\ - -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - $(TAU_COMPILER_EXTRA_OPTIONS) \ - -optIncludeMemory="$(TAU_INCLUDE_MEMORY)" -############################################# - -TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) -SHAREDEXTRAS= -#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF# -TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS) -############################################# -# These options could be included in the application Makefile as -#CFLAGS = $(TAUDEFS) $(TAUINC) -# -#LIBS = $(TAULIBS) -# -# To run the application without Profiling/Tracing use -#CFLAGS = $(TAUINC) -# Don't use TAUDEFS but do include TAUINC -# Also ignore TAULIBS when Profiling/Tracing is not used. -############################################# - diff --git a/source/unres/src_MD-DFA-restraints/Makefile_MPICH_PGI b/source/unres/src_MD-DFA-restraints/Makefile_MPICH_PGI deleted file mode 100644 index f55b08f..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_MPICH_PGI +++ /dev/null @@ -1,126 +0,0 @@ -FC= mpif90 -OPT = -fast - -FFLAGS = -c ${OPT} -#FFLAGS = -c -g -C -FFLAGS1 = -c -g -FFLAGS2 = -c -g -O0 -FFLAGSE = -c -fast -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 - -CFLAGS = -c -DLINUX -DPGI - -LIBS = xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - -LIBS = xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o proc_proc.o\ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = /users/adam/bin/unres_PGI_MPI_GAB-r.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = /users/adam/bin/unres_PGI_MPI_E0LL2Y-r.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_MPICH_ifort b/source/unres/src_MD-DFA-restraints/Makefile_MPICH_ifort deleted file mode 100644 index d763388..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_MPICH_ifort +++ /dev/null @@ -1,127 +0,0 @@ -################################################################### -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - - -FC= ifort - -OPT = -O3 -ip - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -O3 -ipo -opt_report -I$(INSTALL_DIR)/include - - -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - - -all: no_option - @echo "give optin GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o dfa.o ssMD.o - -no_option: - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_aix_xlf b/source/unres/src_MD-DFA-restraints/Makefile_aix_xlf deleted file mode 100644 index b226425..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_aix_xlf +++ /dev/null @@ -1,113 +0,0 @@ -CPPFLAGS = -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DSPLITELE -WF,-DISNAN -WF,-DAIX -#-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -INSTALL_DIR = -# -FC= mpxlf90 -qfixed -w - -OPT = -q64 - -FFLAGS = -c ${OPT} -O3 -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_MD.exe -LIBS = -qipa - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F diff --git a/source/unres/src_MD-DFA-restraints/Makefile_bigben b/source/unres/src_MD-DFA-restraints/Makefile_bigben deleted file mode 100644 index 261dd8e..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_bigben +++ /dev/null @@ -1,138 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = ${OPT} -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \ -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DPARVEC #-DPARINT -DPARINTDER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_bigben-oldparm b/source/unres/src_MD-DFA-restraints/Makefile_bigben-oldparm deleted file mode 100644 index 87d66c7..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_bigben-oldparm +++ /dev/null @@ -1,136 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-matgather-oldparm.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC -DPARINT -DPARINTDER \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_bigben-tau b/source/unres/src_MD-DFA-restraints/Makefile_bigben-tau deleted file mode 100644 index ee02905..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_bigben-tau +++ /dev/null @@ -1,137 +0,0 @@ -# -#FC= ftn -TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi -FC=tau_f90.sh -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-noparint-barrier-tau.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.pp.[fF] *.pp.inst.[fF] - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_galera b/source/unres/src_MD-DFA-restraints/Makefile_galera deleted file mode 100644 index 899ec63..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_galera +++ /dev/null @@ -1,147 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -#INSTALL_DIR = /users/software/mpich2.x86_64/ -#INSTALL_DIR = /opt/mpi/mvapich2 -INSTALL_DIR = /opt/mpi/mvapich - -FC= ifort -FCL= ${INSTALL_DIR}/bin/mpif77 - -OPT = -O3 -ip -w -xHost - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -xHost -O3 -ipo -ipo_obj -no-prec-div -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_hremd_mpich1.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FCL} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_intrepid b/source/unres/src_MD-DFA-restraints/Makefile_intrepid deleted file mode 100644 index 2b57f9e..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_intrepid +++ /dev/null @@ -1,151 +0,0 @@ -# -FC=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -OPT = -O4 -qarch=450 -qtune=450 -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -#OPT = -O -qarch=450 -qtune=450 -#OPT = -O0 -C -g -qarch=450 -qtune=450 #-qdebug=function_trace -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT1 = -O -g -qarch=450 -qtune=450 -#OPT1 = -O -g -qarch=450 -qtune=450 -qdebug=function_trace -OPT1 = ${OPT} -#OPT2 = -O2 -qarch=450 -qtune=450 -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -OPT2 = ${OPT} -#OPTE = -O4 -qarch=450 -qtune=450 -#OPTE = -O4 -qarch=450 -qtune=450 -OPTE=${OPT} - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-O4-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-PARINT-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-parvecmatint-O4-notau1.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-notau1.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 -#-WF,-DPARINT -WF,-DPARINTDER -#-WF,-DPARVEC -WF,-DPARMAT -WF,-DMATGATHER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -obj: ${object} - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -compinfo: compinfo.c - ${CC} ${CFLAGS} compinfo.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_single_gfortran b/source/unres/src_MD-DFA-restraints/Makefile_single_gfortran deleted file mode 100644 index 3ef2052..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_single_gfortran +++ /dev/null @@ -1,130 +0,0 @@ -FC= gfortran -FFLAGS = -c ${OPT} -I. -FFLAGS1 = -c ${OPT1} -I. - -CC = cc - -CFLAGS = -DLINUX -DPGI -c - -OPT = -O -fbounds-check -g -OPT1 = -g - -#OPT = -fbounds-check -g -#OPT1 = -g - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -LIBS = -Lxdrf -lxdrf -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: - @echo "Specify force field: GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng_32.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_gfortran_single_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_gfortran_single_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -newconf.o: newconf.F - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.F - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS1} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS1} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS1} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -fitsq.o: fitsq.f - ${FC} ${FFLAGS1} ${CPPFLAGS} fitsq.f - -rmsd.o: rmsd.F - ${FC} ${FFLAGS1} ${CPPFLAGS} rmsd.F - -contact.o: contact.f - ${FC} ${FFLAGS1} ${CPPFLAGS} contact.f - -minim_jlee.o: minim_jlee.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minim_jlee.F - -minimize_p.o: minimize_p.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minimize_p.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F - - -test.o: test.F - ${FC} ${FFLAGS1} ${CPPFLAGS} test.F - -elecont.o: elecont.f - ${FC} ${FFLAGS} ${CPPFLAGS} elecont.f - -eigen.o: eigen.f - ${FC} ${FFLAGS1} eigen.f - -blas.o: blas.f - ${FC} ${FFLAGS1} blas.f - -add.o: add.f - ${FC} ${FFLAGS1} add.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/Makefile_single_ifort b/source/unres/src_MD-DFA-restraints/Makefile_single_ifort deleted file mode 100644 index c651e39..0000000 --- a/source/unres/src_MD-DFA-restraints/Makefile_single_ifort +++ /dev/null @@ -1,127 +0,0 @@ -FC = ifort -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -CC = cc - -CFLAGS = -DLINUX -DPGI -c - -OPT = -O3 -ip -w - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -LIBS = -Lxdrf -lxdrf -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: - @echo "Specify force field: GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_ifort_single_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_single_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-DFA-restraints/README b/source/unres/src_MD-DFA-restraints/README deleted file mode 100644 index 2b1d2be..0000000 --- a/source/unres/src_MD-DFA-restraints/README +++ /dev/null @@ -1,2 +0,0 @@ -The program will fail if there is no "Makefile" file. -You must copy (cp MakeXXXX Makefile) or use a symbolic link (ln -s MakeXXXX Makefile) before compiling. diff --git a/source/unres/src_MD-DFA-restraints/add.f b/source/unres/src_MD-DFA-restraints/add.f deleted file mode 100644 index fd91a70..0000000 --- a/source/unres/src_MD-DFA-restraints/add.f +++ /dev/null @@ -1,28 +0,0 @@ - SUBROUTINE ABRT - STOP 'IN ABRT' - END -C*MODULE MTHLIB *DECK VCLR - SUBROUTINE VCLR(A,INCA,N) -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) -C - DIMENSION A(*) -C - PARAMETER (ZERO=0.0D+00) -C -C ----- ZERO OUT VECTOR -A-, USING INCREMENT -INCA- ----- -C - IF (INCA .NE. 1) GO TO 200 - DO 110 L=1,N - A(L) = ZERO - 110 CONTINUE - RETURN -C - 200 CONTINUE - LA=1-INCA - DO 210 L=1,N - LA=LA+INCA - A(LA) = ZERO - 210 CONTINUE - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/arcos.f b/source/unres/src_MD-DFA-restraints/arcos.f deleted file mode 100644 index f054118..0000000 --- a/source/unres/src_MD-DFA-restraints/arcos.f +++ /dev/null @@ -1,9 +0,0 @@ - FUNCTION ARCOS(X) - implicit real*8 (a-h,o-z) - include 'COMMON.GEO' - IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=PIPOL*(1.0d0-DSIGN(1.0D0,X)) - RETURN - 1 ARCOS=DACOS(X) - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/banach.f b/source/unres/src_MD-DFA-restraints/banach.f deleted file mode 100644 index 7c43d77..0000000 --- a/source/unres/src_MD-DFA-restraints/banach.f +++ /dev/null @@ -1,99 +0,0 @@ -C -C********************** - SUBROUTINE BANACH(N,NMAX,A,X,osob) -C********************** -C Banachiewicz - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6) - COMMON /BANII/ D - logical osob - osob=.false. - if (dabs(a(1,1)).lt.1.0d-15) then - osob=.true. - return - endif - D(1)=1./A(1,1) - DO 80 I=2,N - A(I,1)=A(1,I) - DO 81 J=2,I-1 - XX=A(J,I) - DO 82 K=1,J-1 - XX=XX-A(I,K)*A(J,K) - 82 CONTINUE - A(I,J)=XX - 81 CONTINUE - XX=A(I,I) - JJJJ=I-1 - DO 83 J=1,JJJJ - AIJ=A(I,J) - AIJD=AIJ*D(J) - A(I,J)=AIJD - XX=XX-AIJ*AIJD - 83 CONTINUE - if (dabs(xx).lt.1.0d-15) then - osob=.true. - return - endif - D(I)=1./XX - 80 CONTINUE -C - CALL BANAII(N,NMAX,A,X) - RETURN - END -C************************ - SUBROUTINE BANAII(N,NMAX,A,X) -C************************ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6) - COMMON /BANII/ D - DO 90 I=1,N - Z=X(I) - JJJJ=I-1 - DO 91 J=JJJJ,1,-1 - Z=Z-A(I,J)*X(J) - 91 CONTINUE - X(I)=Z - 90 CONTINUE - DO 92 I=N,1,-1 - Z=X(I)*D(I) - JJJJ=I+1 - DO 93 J=JJJJ,N - Z=Z-A(J,I)*X(J) - 93 CONTINUE - X(I)=Z - 92 CONTINUE - RETURN - END -C - SUBROUTINE MATINVERT(N,NMAX,A,A1,osob) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),A1(NMAX,NMAX),D(MAXRES6) - COMMON /BANII/ D - DIMENSION X(NMAX) - logical osob - DO I=1,N - X(I)=0.0 - ENDDO - X(1)=1.0 - CALL BANACH(N,NMAX,A,X,osob) - if (osob) return - DO I=1,N - A1(I,1)=X(I) - ENDDO - DO I=2,N - DO J=1,N - X(J)=0.0 - ENDDO - X(I)=1.0 - CALL BANAII(N,NMAX,A,X) - DO J=1,N - A1(J,I)=X(J) - ENDDO - ENDDO - RETURN - END - - diff --git a/source/unres/src_MD-DFA-restraints/blas.f b/source/unres/src_MD-DFA-restraints/blas.f deleted file mode 100644 index 142d821..0000000 --- a/source/unres/src_MD-DFA-restraints/blas.f +++ /dev/null @@ -1,575 +0,0 @@ -C 10 NOV 94 - MWS - DNRM2: REMOVE FTNCHECK WARNINGS -C 11 JUN 94 - MWS - INCLUDE A COPY OF DGEMV (LEVEL TWO ROUTINE) -C 11 AUG 87 - MWS - SANITIZE FLOATING POINT CONSTANTS IN DNRM2 -C 26 MAR 87 - MWS - USE GENERIC SIGN IN DROTG -C 28 NOV 86 - STE - SUPPLY ALL LEVEL ONE BLAS -C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS -C -C BASIC LINEAR ALGEBRA SUBPROGRAMS (BLAS) FROM LINPACK (LEVEL 1) -C -C THIS MODULE SHOULD BE COMPILED ONLY IF SPECIALLY CODED -C VERSIONS OF THESE ROUTINES ARE NOT AVAILABLE ON THE TARGET MACHINE -C -C*MODULE BLAS1 *DECK DASUM - DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) -C -C TAKES THE SUM OF THE ABSOLUTE VALUES. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DOUBLE PRECISION DX(1),DTEMP - INTEGER I,INCX,M,MP1,N,NINCX -C - DASUM = 0.0D+00 - DTEMP = 0.0D+00 - IF(N.LE.0)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DTEMP = DTEMP + ABS(DX(I)) - 10 CONTINUE - DASUM = DTEMP - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,6) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + ABS(DX(I)) - 30 CONTINUE - IF( N .LT. 6 ) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,6 - DTEMP = DTEMP + ABS(DX(I)) + ABS(DX(I + 1)) + ABS(DX(I + 2)) - * + ABS(DX(I + 3)) + ABS(DX(I + 4)) + ABS(DX(I + 5)) - 50 CONTINUE - 60 DASUM = DTEMP - RETURN - END -C*MODULE BLAS1 *DECK DAXPY - SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C CONSTANT TIMES A VECTOR PLUS A VECTOR. -C DY(I) = DY(I) + DA * DX(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF (DA .EQ. 0.0D+00) RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DY(IY) = DY(IY) + DA*DX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,4) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DY(I) = DY(I) + DA*DX(I) - 30 CONTINUE - IF( N .LT. 4 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,4 - DY(I) = DY(I) + DA*DX(I) - DY(I + 1) = DY(I + 1) + DA*DX(I + 1) - DY(I + 2) = DY(I + 2) + DA*DX(I + 2) - DY(I + 3) = DY(I + 3) + DA*DX(I + 3) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DCOPY - SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(*),DY(*) -C -C COPIES A VECTOR. -C DY(I) <== DX(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DY(IY) = DX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,7) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DY(I) = DX(I) - 30 CONTINUE - IF( N .LT. 7 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,7 - DY(I) = DX(I) - DY(I + 1) = DX(I + 1) - DY(I + 2) = DX(I + 2) - DY(I + 3) = DX(I + 3) - DY(I + 4) = DX(I + 4) - DY(I + 5) = DX(I + 5) - DY(I + 6) = DX(I + 6) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DDOT - DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C FORMS THE DOT PRODUCT OF TWO VECTORS. -C DOT = DX(I) * DY(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DDOT = 0.0D+00 - DTEMP = 0.0D+00 - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = DTEMP + DX(IX)*DY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - DDOT = DTEMP - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,5) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + DX(I)*DY(I) - 30 CONTINUE - IF( N .LT. 5 ) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) + - * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4) - 50 CONTINUE - 60 DDOT = DTEMP - RETURN - END -C*MODULE BLAS1 *DECK DNRM2 - DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX) - INTEGER NEXT - DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE - DATA ZERO, ONE /0.0D+00, 1.0D+00/ -C -C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE -C INCREMENT INCX . -C IF N .LE. 0 RETURN WITH RESULT = 0. -C IF N .GE. 1 THEN INCX MUST BE .GE. 1 -C -C C.L.LAWSON, 1978 JAN 08 -C -C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE -C HOPEFULLY APPLICABLE TO ALL MACHINES. -C CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. -C CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. -C WHERE -C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. -C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) -C V = LARGEST NO. (OVERFLOW LIMIT) -C -C BRIEF OUTLINE OF ALGORITHM.. -C -C PHASE 1 SCANS ZERO COMPONENTS. -C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO -C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO -C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M -C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. -C -C VALUES FOR CUTLO AND CUTHI.. -C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER -C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. -C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE -C UNIVAC AND DEC AT 2**(-103) -C THUS CUTLO = 2**(-51) = 4.44089E-16 -C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. -C THUS CUTHI = 2**(63.5) = 1.30438E19 -C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. -C THUS CUTLO = 2**(-33.5) = 8.23181D-11 -C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D+19 -C DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 / -C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / - DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 / -C - J=0 - IF(N .GT. 0) GO TO 10 - DNRM2 = ZERO - GO TO 300 -C - 10 ASSIGN 30 TO NEXT - SUM = ZERO - NN = N * INCX -C BEGIN MAIN LOOP - I = 1 - 20 GO TO NEXT,(30, 50, 70, 110) - 30 IF( ABS(DX(I)) .GT. CUTLO) GO TO 85 - ASSIGN 50 TO NEXT - XMAX = ZERO -C -C PHASE 1. SUM IS ZERO -C - 50 IF( DX(I) .EQ. ZERO) GO TO 200 - IF( ABS(DX(I)) .GT. CUTLO) GO TO 85 -C -C PREPARE FOR PHASE 2. - ASSIGN 70 TO NEXT - GO TO 105 -C -C PREPARE FOR PHASE 4. -C - 100 I = J - ASSIGN 110 TO NEXT - SUM = (SUM / DX(I)) / DX(I) - 105 XMAX = ABS(DX(I)) - GO TO 115 -C -C PHASE 2. SUM IS SMALL. -C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. -C - 70 IF( ABS(DX(I)) .GT. CUTLO ) GO TO 75 -C -C COMMON CODE FOR PHASES 2 AND 4. -C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. -C - 110 IF( ABS(DX(I)) .LE. XMAX ) GO TO 115 - SUM = ONE + SUM * (XMAX / DX(I))**2 - XMAX = ABS(DX(I)) - GO TO 200 -C - 115 SUM = SUM + (DX(I)/XMAX)**2 - GO TO 200 -C -C -C PREPARE FOR PHASE 3. -C - 75 SUM = (SUM * XMAX) * XMAX -C -C -C FOR REAL OR D.P. SET HITEST = CUTHI/N -C FOR COMPLEX SET HITEST = CUTHI/(2*N) -C - 85 HITEST = CUTHI/N -C -C PHASE 3. SUM IS MID-RANGE. NO SCALING. -C - DO 95 J =I,NN,INCX - IF(ABS(DX(J)) .GE. HITEST) GO TO 100 - 95 SUM = SUM + DX(J)**2 - DNRM2 = SQRT( SUM ) - GO TO 300 -C - 200 CONTINUE - I = I + INCX - IF ( I .LE. NN ) GO TO 20 -C -C END OF MAIN LOOP. -C -C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. -C - DNRM2 = XMAX * SQRT(SUM) - 300 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DROT - SUBROUTINE DROT (N,DX,INCX,DY,INCY,C,S) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C APPLIES A PLANE ROTATION. -C DX(I) = C*DX(I) + S*DY(I) -C DY(I) = -S*DX(I) + C*DY(I) -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL -C TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = C*DX(IX) + S*DY(IY) - DY(IY) = C*DY(IY) - S*DX(IX) - DX(IX) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C - 20 DO 30 I = 1,N - DTEMP = C*DX(I) + S*DY(I) - DY(I) = C*DY(I) - S*DX(I) - DX(I) = DTEMP - 30 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DROTG - SUBROUTINE DROTG(DA,DB,C,S) -C -C CONSTRUCT GIVENS PLANE ROTATION. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DOUBLE PRECISION DA,DB,C,S,ROE,SCALE,R,Z - DOUBLE PRECISION ZERO, ONE -C - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00) -C -C----------------------------------------------------------------------- -C -C - ROE = DB - IF( ABS(DA) .GT. ABS(DB) ) ROE = DA - SCALE = ABS(DA) + ABS(DB) - IF( SCALE .NE. ZERO ) GO TO 10 - C = ONE - S = ZERO - R = ZERO - GO TO 20 -C - 10 R = SCALE*SQRT((DA/SCALE)**2 + (DB/SCALE)**2) - R = SIGN(ONE,ROE)*R - C = DA/R - S = DB/R - 20 Z = ONE - IF( ABS(DA) .GT. ABS(DB) ) Z = S - IF( ABS(DB) .GE. ABS(DA) .AND. C .NE. ZERO ) Z = ONE/C - DA = R - DB = Z - RETURN - END -C*MODULE BLAS1 *DECK DSCAL - SUBROUTINE DSCAL(N,DA,DX,INCX) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1) -C -C SCALES A VECTOR BY A CONSTANT. -C DX(I) = DA * DX(I) -C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DX(I) = DA*DX(I) - 10 CONTINUE - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,5) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DX(I) = DA*DX(I) - 30 CONTINUE - IF( N .LT. 5 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - DX(I) = DA*DX(I) - DX(I + 1) = DA*DX(I + 1) - DX(I + 2) = DA*DX(I + 2) - DX(I + 3) = DA*DX(I + 3) - DX(I + 4) = DA*DX(I + 4) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DSWAP - SUBROUTINE DSWAP (N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C INTERCHANGES TWO VECTORS. -C DX(I) <==> DY(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL -C TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = DX(IX) - DX(IX) = DY(IY) - DY(IY) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,3) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - 30 CONTINUE - IF( N .LT. 3 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,3 - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - DTEMP = DX(I + 1) - DX(I + 1) = DY(I + 1) - DY(I + 1) = DTEMP - DTEMP = DX(I + 2) - DX(I + 2) = DY(I + 2) - DY(I + 2) = DTEMP - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK IDAMAX - INTEGER FUNCTION IDAMAX(N,DX,INCX) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1) -C -C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IDAMAX = 0 - IF( N .LT. 1 ) RETURN - IDAMAX = 1 - IF(N.EQ.1)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - IX = 1 - RMAX = ABS(DX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF(ABS(DX(IX)).LE.RMAX) GO TO 5 - IDAMAX = I - RMAX = ABS(DX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C - 20 RMAX = ABS(DX(1)) - DO 30 I = 2,N - IF(ABS(DX(I)).LE.RMAX) GO TO 30 - IDAMAX = I - RMAX = ABS(DX(I)) - 30 CONTINUE - RETURN - END -C*MODULE BLAS *DECK DGEMV - SUBROUTINE DGEMV(FORMA,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - CHARACTER*1 FORMA - DIMENSION A(LDA,*),X(*),Y(*) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00) -C -C CLONE OF -DGEMV- WRITTEN BY MIKE SCHMIDT -C - LOCY = 1 - IF(FORMA.EQ.'T') GO TO 200 -C -C Y = ALPHA * A * X + BETA * Y -C - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 110 I=1,M - Y(LOCY) = DDOT(N,A(I,1),LDA,X,INCX) - LOCY = LOCY+INCY - 110 CONTINUE - ELSE - DO 120 I=1,M - Y(LOCY) = ALPHA*DDOT(N,A(I,1),LDA,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 120 CONTINUE - END IF - RETURN -C -C Y = ALPHA * A-TRANSPOSE * X + BETA * Y -C - 200 CONTINUE - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 210 I=1,N - Y(LOCY) = DDOT(M,A(1,I),1,X,INCX) - LOCY = LOCY+INCY - 210 CONTINUE - ELSE - DO 220 I=1,N - Y(LOCY) = ALPHA*DDOT(M,A(1,I),1,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 220 CONTINUE - END IF - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/bond_move.f b/source/unres/src_MD-DFA-restraints/bond_move.f deleted file mode 100644 index 4843f60..0000000 --- a/source/unres/src_MD-DFA-restraints/bond_move.f +++ /dev/null @@ -1,124 +0,0 @@ - subroutine bond_move(nbond,nstart,psi,lprint,error) -C Move NBOND fragment starting from the CA(nstart) by angle PSI. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nbond,nstart - double precision psi - logical fail,error,lprint - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - dimension x(3),e(3,3),e1(3),e2(3),e3(3),rot(3,3),trans(3,3) - error=.false. - nend=nstart+nbond - if (print_mc.gt.2) then - write (iout,*) 'nstart=',nstart,' nend=',nend,' nbond=',nbond - write (iout,*) 'psi=',psi - write (iout,'(a)') 'Original coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - if (nstart.lt.1 .or. nend .gt.nres .or. nbond.lt.2 .or. - & nbond.ge.nres-1) then - write (iout,'(a)') 'Bad data in BOND_MOVE.' - error=.true. - return - endif -C Generate the reference system. - i2=nend - i3=nstart - i4=nstart+1 - call refsys(i2,i3,i4,e1,e2,e3,error) -C Return, if couldn't define the reference system. - if (error) return -C Compute the transformation matrix. - cospsi=dcos(psi) - sinpsi=dsin(psi) - rot(1,1)=1.0D0 - rot(1,2)=0.0D0 - rot(1,3)=0.0D0 - rot(2,1)=0.0D0 - rot(2,2)=cospsi - rot(2,3)=-sinpsi - rot(3,1)=0.0D0 - rot(3,2)=sinpsi - rot(3,3)=cospsi - do i=1,3 - e(1,i)=e1(i) - e(2,i)=e2(i) - e(3,i)=e3(i) - enddo - - if (print_mc.gt.2) then - write (iout,'(a)') 'Reference system and matrix r:' - do i=1,3 - write(iout,'(i5,2(3f10.5,5x))')i,(e(i,j),j=1,3),(rot(i,j),j=1,3) - enddo - endif - - call matmult(rot,e,trans) - do i=1,3 - do j=1,3 - e(i,1)=e1(i) - e(i,2)=e2(i) - e(i,3)=e3(i) - enddo - enddo - call matmult(e,trans,trans) - - if (lprint) then - write (iout,'(a)') 'The trans matrix:' - do i=1,3 - write (iout,'(i5,3f10.5)') i,(trans(i,j),j=1,3) - enddo - endif - - do i=nstart,nend - do j=1,3 - rij=c(j,nstart) - do k=1,3 - rij=rij+trans(j,k)*(c(k,i)-c(k,nstart)) - enddo - x(j)=rij - enddo - do j=1,3 - c(j,i)=x(j) - enddo - enddo - - if (lprint) then - write (iout,'(a)') 'Rotated coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - -c call int_from_cart(.false.,lprint) - if (nstart.gt.1) then - theta(nstart+1)=alpha(nstart-1,nstart,nstart+1) - phi(nstart+2)=beta(nstart-1,nstart,nstart+1,nstart+2) - if (nstart.gt.2) phi(nstart+1)= - & beta(nstart-2,nstart-1,nstart,nstart+1) - endif - if (nend.lt.nres) then - theta(nend+1)=alpha(nend-1,nend,nend+1) - phi(nend+1)=beta(nend-2,nend-1,nend,nend+1) - if (nend.lt.nres-1) phi(nend+2)= - & beta(nend-1,nend,nend+1,nend+2) - endif - if (print_mc.gt.2) then - write (iout,'(/a,i3,a,i3,a/)') - & 'Moved internal coordinates of the ',nstart,'-',nend, - & ' fragment:' - do i=nstart+1,nstart+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - do i=nend+1,nend+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/build.txt b/source/unres/src_MD-DFA-restraints/build.txt deleted file mode 100644 index a5eba7c..0000000 --- a/source/unres/src_MD-DFA-restraints/build.txt +++ /dev/null @@ -1 +0,0 @@ -cmake /users/czarek/UNRES/GIT/unres/ -DMPIF_LOCAL_DIR=/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh \ No newline at end of file diff --git a/source/unres/src_MD-DFA-restraints/cartder.F b/source/unres/src_MD-DFA-restraints/cartder.F deleted file mode 100644 index e2e8c1a..0000000 --- a/source/unres/src_MD-DFA-restraints/cartder.F +++ /dev/null @@ -1,314 +0,0 @@ - subroutine cartder -*********************************************************************** -* This subroutine calculates the derivatives of the consecutive virtual -* bond vectors and the SC vectors in the virtual-bond angles theta and -* virtual-torsional angles phi, as well as the derivatives of SC vectors -* in the angles alpha and omega, describing the location of a side chain -* in its local coordinate system. -* -* The derivatives are stored in the following arrays: -* -* DDCDV - the derivatives of virtual-bond vectors DC in theta and phi. -* The structure is as follows: -* -* dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0 -* dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4) -* . . . . . . . . . . . . . . . . . . -* dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4) -* . -* . -* . -* dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N) -* -* DXDV - the derivatives of the side-chain vectors in theta and phi. -* The structure is same as above. -* -* DCDS - the derivatives of the side chain vectors in the local spherical -* andgles alph and omega: -* -* dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2) -* dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3) -* . -* . -* . -* dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1) -* -* Version of March '95, based on an early version of November '91. -* -*********************************************************************** - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3), - & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres) - dimension xx(3),xx1(3) -c common /przechowalnia/ fromto -* get the position of the jth ijth fragment of the chain coordinate system -* in the fromto array. - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* calculate the derivatives of transformation matrix elements in theta -* - do i=1,nres-2 - rdt(1,1,i)=-rt(1,2,i) - rdt(1,2,i)= rt(1,1,i) - rdt(1,3,i)= 0.0d0 - rdt(2,1,i)=-rt(2,2,i) - rdt(2,2,i)= rt(2,1,i) - rdt(2,3,i)= 0.0d0 - rdt(3,1,i)=-rt(3,2,i) - rdt(3,2,i)= rt(3,1,i) - rdt(3,3,i)= 0.0d0 - enddo -* -* derivatives in phi -* - do i=2,nres-2 - drt(1,1,i)= 0.0d0 - drt(1,2,i)= 0.0d0 - drt(1,3,i)= 0.0d0 - drt(2,1,i)= rt(3,1,i) - drt(2,2,i)= rt(3,2,i) - drt(2,3,i)= rt(3,3,i) - drt(3,1,i)=-rt(2,1,i) - drt(3,2,i)=-rt(2,2,i) - drt(3,3,i)=-rt(2,3,i) - enddo -* -* generate the matrix products of type r(i)t(i)...r(j)t(j) -* - do i=2,nres-2 - ind=indmat(i,i+1) - do k=1,3 - do l=1,3 - temp(k,l)=rt(k,l,i) - enddo - enddo - do k=1,3 - do l=1,3 - fromto(k,l,ind)=temp(k,l) - enddo - enddo - do j=i+1,nres-2 - ind=indmat(i,j+1) - do k=1,3 - do l=1,3 - dpkl=0.0d0 - do m=1,3 - dpkl=dpkl+temp(k,m)*rt(m,l,j) - enddo - dp(k,l)=dpkl - fromto(k,l,ind)=dpkl - enddo - enddo - do k=1,3 - do l=1,3 - temp(k,l)=dp(k,l) - enddo - enddo - enddo - enddo -* -* Calculate derivatives. -* - ind1=0 - do i=1,nres-2 - ind1=ind1+1 -* -* Derivatives of DC(i+1) in theta(i+2) -* - do j=1,3 - do k=1,2 - dpjk=0.0D0 - do l=1,3 - dpjk=dpjk+prod(j,l,i)*rdt(l,k,i) - enddo - dp(j,k)=dpjk - prordt(j,k,i)=dp(j,k) - enddo - dp(j,3)=0.0D0 - dcdv(j,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in theta(i+2) -* - xx1(1)=-0.5D0*xloc(2,i+1) - xx1(2)= 0.5D0*xloc(1,i+1) - do j=1,3 - xj=0.0D0 - do k=1,2 - xj=xj+r(j,k,i)*xx1(k) - enddo - xx(j)=xj - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j,ind1)=rj - enddo -* -* Derivatives of SC(i+1) in theta(i+3). The have to be handled differently -* than the other off-diagonal derivatives. -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j,ind1+1)=dxoiij - enddo -cd print *,ind1+1,(dxdv(j,ind1+1),j=1,3) -* -* Derivatives of DC(i+1) in phi(i+2) -* - do j=1,3 - do k=1,3 - dpjk=0.0 - do l=2,3 - dpjk=dpjk+prod(j,l,i)*drt(l,k,i) - enddo - dp(j,k)=dpjk - prodrt(j,k,i)=dp(j,k) - enddo - dcdv(j+3,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in phi(i+2) -* - xx(1)= 0.0D0 - xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i) - xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i) - do j=1,3 - rj=0.0D0 - do k=2,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j+3,ind1)=-rj - enddo -* -* Derivatives of SC(i+1) in phi(i+3). -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j+3,ind1+1)=dxoiij - enddo -* -* Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru -* theta(nres) and phi(i+3) thru phi(nres). -* - do j=i+1,nres-2 - ind1=ind1+1 - ind=indmat(i+1,j+1) -cd print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1 - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,2 - tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo -cd print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3) -cd print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3) -cd print '(9f8.3)',((temp(k,l),l=1,3),k=1,3) -* Derivatives of virtual-bond vectors in theta - do k=1,3 - dcdv(k,ind1)=vbld(i+1)*temp(k,1) - enddo -cd print '(3f8.3)',(dcdv(k,ind1),k=1,3) -* Derivatives of SC vectors in theta - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k,ind1+1)=dxoijk - enddo -* -*--- Calculate the derivatives in phi -* - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,3 - tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo - do k=1,3 - dcdv(k+3,ind1)=vbld(i+1)*temp(k,1) - enddo - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k+3,ind1+1)=dxoijk - enddo - enddo - enddo -* -* Derivatives in alpha and omega: -* - do i=2,nres-1 -c dsci=dsc(itype(i)) - dsci=vbld(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if(alphi.ne.alphi) alphi=100.0 - if(omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif -cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - temp(1,1)=-dsci*sinalphi - temp(2,1)= dsci*cosalphi*cosomegi - temp(3,1)=-dsci*cosalphi*sinomegi - temp(1,2)=0.0D0 - temp(2,2)=-dsci*sinalphi*sinomegi - temp(3,2)=-dsci*sinalphi*cosomegi - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - jjj=0 -cd print *,((temp(l,k),l=1,3),k=1,2) - do j=1,2 - xp=temp(1,j) - yp=temp(2,j) - xxp= xp*cost2+yp*sint2 - yyp=-xp*sint2+yp*cost2 - zzp=temp(3,j) - xx(1)=xxp - xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1) - xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1) - do k=1,3 - dj=0.0D0 - do l=1,3 - dj=dj+prod(k,l,i-1)*xx(l) - enddo - dxds(jjj+k,i)=dj - enddo - jjj=jjj+3 - enddo - enddo - return - end - diff --git a/source/unres/src_MD-DFA-restraints/cartprint.f b/source/unres/src_MD-DFA-restraints/cartprint.f deleted file mode 100644 index d79409e..0000000 --- a/source/unres/src_MD-DFA-restraints/cartprint.f +++ /dev/null @@ -1,19 +0,0 @@ - subroutine cartprint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - write (iout,100) - do i=1,nres - write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i), - & c(3,i),c(1,nres+i),c(2,nres+i),c(3,nres+i) - enddo - 100 format (//' alpha-carbon coordinates ', - & ' centroid coordinates'/ - 1 ' ', 6X,'X',11X,'Y',11X,'Z', - & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i3,')',6f12.5) - return - end diff --git a/source/unres/src_MD-DFA-restraints/chainbuild.F b/source/unres/src_MD-DFA-restraints/chainbuild.F deleted file mode 100644 index 45a1a53..0000000 --- a/source/unres/src_MD-DFA-restraints/chainbuild.F +++ /dev/null @@ -1,274 +0,0 @@ - subroutine chainbuild -C -C Build the virtual polypeptide chain. Side-chain centroids are moveable. -C As of 2/17/95. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - logical lprn -C Set lprn=.true. for debugging - lprn = .false. -C -C Define the origin and orientation of the coordinate system and locate the -C first three CA's and SC(2). -C - call orig_frame -* -* Build the alpha-carbon chain. -* - do i=4,nres - call locate_next_res(i) - enddo -C -C First and last SC must coincide with the corresponding CA. -C - do j=1,3 - dc(j,nres+1)=0.0D0 - dc_norm(j,nres+1)=0.0D0 - dc(j,nres+nres)=0.0D0 - dc_norm(j,nres+nres)=0.0D0 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo -* -* Temporary diagnosis -* - if (lprn) then - - call cartprint - write (iout,'(/a)') 'Recalculated internal coordinates' - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - be=0.0D0 - if (i.gt.3) be=rad2deg*beta(i-3,i-2,i-1,i) - be1=rad2deg*beta(nres+i,i,maxres2,i+1) - alfai=0.0D0 - if (i.gt.2) alfai=rad2deg*alpha(i-2,i-1,i) - write (iout,1212) restyp(itype(i)),i,dist(i-1,i), - & alfai,be,dist(nres+i,i),rad2deg*alpha(nres+i,i,maxres2),be1 - enddo - 1212 format (a3,'(',i3,')',2(f10.5,2f10.2)) - - endif - - return - end -c------------------------------------------------------------------------- - subroutine orig_frame -C -C Define the origin and orientation of the coordinate system and locate -C the first three atoms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - cost=dcos(theta(3)) - sint=dsin(theta(3)) - t(1,1,1)=-cost - t(1,2,1)=-sint - t(1,3,1)= 0.0D0 - t(2,1,1)=-sint - t(2,2,1)= cost - t(2,3,1)= 0.0D0 - t(3,1,1)= 0.0D0 - t(3,2,1)= 0.0D0 - t(3,3,1)= 1.0D0 - r(1,1,1)= 1.0D0 - r(1,2,1)= 0.0D0 - r(1,3,1)= 0.0D0 - r(2,1,1)= 0.0D0 - r(2,2,1)= 1.0D0 - r(2,3,1)= 0.0D0 - r(3,1,1)= 0.0D0 - r(3,2,1)= 0.0D0 - r(3,3,1)= 1.0D0 - do i=1,3 - do j=1,3 - rt(i,j,1)=t(i,j,1) - enddo - enddo - do i=1,3 - do j=1,3 - prod(i,j,1)=0.0D0 - prod(i,j,2)=t(i,j,1) - enddo - prod(i,i,1)=1.0D0 - enddo - c(1,1)=0.0D0 - c(2,1)=0.0D0 - c(3,1)=0.0D0 - c(1,2)=vbld(2) - c(2,2)=0.0D0 - c(3,2)=0.0D0 - dc(1,0)=0.0d0 - dc(2,0)=0.0D0 - dc(3,0)=0.0D0 - dc(1,1)=vbld(2) - dc(2,1)=0.0D0 - dc(3,1)=0.0D0 - dc_norm(1,0)=0.0D0 - dc_norm(2,0)=0.0D0 - dc_norm(3,0)=0.0D0 - dc_norm(1,1)=1.0D0 - dc_norm(2,1)=0.0D0 - dc_norm(3,1)=0.0D0 - do j=1,3 - dc_norm(j,2)=prod(j,1,2) - dc(j,2)=vbld(3)*prod(j,1,2) - c(j,3)=c(j,2)+dc(j,2) - enddo - call locate_side_chain(2) - return - end -c----------------------------------------------------------------------------- - subroutine locate_next_res(i) -C -C Locate CA(i) and SC(i-1) -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' -C -C Define the rotation matrices corresponding to CA(i) -C -#ifdef OSF - theti=theta(i) - if (theti.ne.theti) theti=100.0 - phii=phi(i) - if (phii.ne.phii) phii=180.0 -#else - theti=theta(i) - phii=phi(i) -#endif - cost=dcos(theti) - sint=dsin(theti) - cosphi=dcos(phii) - sinphi=dsin(phii) -* Define the matrices of the rotation about the virtual-bond valence angles -* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this -* program), R(i,j,k), and, the cumulative matrices of rotation RT - t(1,1,i-2)=-cost - t(1,2,i-2)=-sint - t(1,3,i-2)= 0.0D0 - t(2,1,i-2)=-sint - t(2,2,i-2)= cost - t(2,3,i-2)= 0.0D0 - t(3,1,i-2)= 0.0D0 - t(3,2,i-2)= 0.0D0 - t(3,3,i-2)= 1.0D0 - r(1,1,i-2)= 1.0D0 - r(1,2,i-2)= 0.0D0 - r(1,3,i-2)= 0.0D0 - r(2,1,i-2)= 0.0D0 - r(2,2,i-2)=-cosphi - r(2,3,i-2)= sinphi - r(3,1,i-2)= 0.0D0 - r(3,2,i-2)= sinphi - r(3,3,i-2)= cosphi - rt(1,1,i-2)=-cost - rt(1,2,i-2)=-sint - rt(1,3,i-2)=0.0D0 - rt(2,1,i-2)=sint*cosphi - rt(2,2,i-2)=-cost*cosphi - rt(2,3,i-2)=sinphi - rt(3,1,i-2)=-sint*sinphi - rt(3,2,i-2)=cost*sinphi - rt(3,3,i-2)=cosphi - call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1)) - do j=1,3 - dc_norm(j,i-1)=prod(j,1,i-1) - dc(j,i-1)=vbld(i)*prod(j,1,i-1) - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo -cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3) -C -C Now calculate the coordinates of SC(i-1) -C - call locate_side_chain(i-1) - return - end -c----------------------------------------------------------------------------- - subroutine locate_side_chain(i) -C -C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - dimension xx(3) - -c dsci=dsc(itype(i)) -c dsci_inv=dsc_inv(itype(i)) - dsci=vbld(i+nres) - dsci_inv=vbld_inv(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if (alphi.ne.alphi) alphi=100.0 - if (omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - xp= dsci*cosalphi - yp= dsci*sinalphi*cosomegi - zp=-dsci*sinalphi*sinomegi -* Now we have to rotate the coordinate system by 180-theta(i)/2 so as to get its -* X-axis aligned with the vector DC(*,i) - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - xx(1)= xp*cost2+yp*sint2 - xx(2)=-xp*sint2+yp*cost2 - xx(3)= zp -cd print '(a3,i3,3f10.5,5x,3f10.5)',restyp(itype(i)),i, -cd & xp,yp,zp,(xx(k),k=1,3) - do j=1,3 - xloc(j,i)=xx(j) - enddo -* Bring the SC vectors to the common coordinate system. - xx(1)=xloc(1,i) - xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1) - xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1) - do j=1,3 - xrot(j,i)=xx(j) - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i-1)*xx(k) - enddo - dc(j,nres+i)=rj - dc_norm(j,nres+i)=rj*dsci_inv - c(j,nres+i)=c(j,i)+rj - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/change.awk b/source/unres/src_MD-DFA-restraints/change.awk deleted file mode 100644 index d192a6e..0000000 --- a/source/unres/src_MD-DFA-restraints/change.awk +++ /dev/null @@ -1,11 +0,0 @@ -{ - if($0==" include 'COMMON.LANGEVIN'") { - print "#ifndef LANG0" - print " include 'COMMON.LANGEVIN'" - print "#else" - print " include 'COMMON.LANGEVIN.lang0'" - print "#endif" - }else{ - print $0 - } -} diff --git a/source/unres/src_MD-DFA-restraints/check_bond.f b/source/unres/src_MD-DFA-restraints/check_bond.f deleted file mode 100644 index c8a4ad1..0000000 --- a/source/unres/src_MD-DFA-restraints/check_bond.f +++ /dev/null @@ -1,20 +0,0 @@ - subroutine check_bond -C Subroutine is checking if the fitted function which describs sc_rot_pot -C is correct, printing, alpha,beta, energy, data - for some known theta. -C theta angle is read from the input file. Sc_rot_pot are printed -C for the second residue in sequance. - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision energia(0:n_ene) - it=itype(2) - do i=1,101 - vbld(nres+2)=0.5d0+0.05d0*(i-1) - call chainbuild - call etotal(energia) - write (2,*) vbld(nres+2),energia(17) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/check_sc_distr.f b/source/unres/src_MD-DFA-restraints/check_sc_distr.f deleted file mode 100644 index db2ed1b..0000000 --- a/source/unres/src_MD-DFA-restraints/check_sc_distr.f +++ /dev/null @@ -1,43 +0,0 @@ - subroutine check_sc_distr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - logical fail - double precision varia(maxvar) - double precision hrtime,mintime,sectime - parameter (MaxSample=10000000,delt=1.0D0/MaxSample) - dimension prob(0:72,0:90) - dV=2.0D0*5.0D0*deg2rad*deg2rad - print *,'dv=',dv - do 10 it=1,1 - if (it.eq.10) goto 10 - open (20,file=restyp(it)//'_distr.sdc',status='unknown') - call gen_side(it,90.0D0*deg2rad,al,om,fail) - close (20) - goto 10 - open (20,file=restyp(it)//'_distr1.sdc',status='unknown') - do i=0,90 - do j=0,72 - prob(j,i)=0.0D0 - enddo - enddo - do isample=1,MaxSample - call gen_side(it,90.0D0*deg2rad,al,om) - indal=rad2deg*al/2 - indom=(rad2deg*om+180.0D0)/5 - prob(indom,indal)=prob(indom,indal)+delt - enddo - do i=45,90 - do j=0,72 - write (20,'(2f10.3,1pd15.5)') 2*i+0.0D0,5*j-180.0D0, - & prob(j,i)/dV - enddo - enddo - 10 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/checkder_p.F b/source/unres/src_MD-DFA-restraints/checkder_p.F deleted file mode 100644 index 4d0379e..0000000 --- a/source/unres/src_MD-DFA-restraints/checkder_p.F +++ /dev/null @@ -1,713 +0,0 @@ - subroutine check_cartgrad -C Check the gradient of Cartesian coordinates in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.DERIV' - include 'COMMON.SCCOR' - dimension temp(6,maxres),xx(3),gg(3) - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* Check the gradient of the virtual-bond and SC vectors in the internal -* coordinates. -* - aincr=1.0d-7 - aincr2=5.0d-8 - call cartder - write (iout,'(a)') '**************** dx/dalpha' - write (iout,'(a)') - do i=2,nres-1 - alphi=alph(i) - alph(i)=alph(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - alph(i)=alphi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/domega' - write (iout,'(a)') - do i=2,nres-1 - omegi=omeg(i) - omeg(i)=omeg(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k+3,i))/ - & (aincr*dabs(dxds(k+3,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - omeg(i)=omegi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/dtheta' - write (iout,'(a)') - do i=3,nres - theti=theta(i) - theta(i)=theta(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'i=',i-2,' j=',j-1,' ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k,ii))/ - & (aincr*dabs(dxdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - write (iout,'(a)') - theta(i)=theti - call chainbuild - enddo - write (iout,'(a)') '***************** dx/dphi' - write (iout,'(a)') - do i=4,nres - phi(i)=phi(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ - & (aincr*dabs(dxdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - phi(i)=phi(i)-aincr - call chainbuild - enddo - write (iout,'(a)') '****************** ddc/dtheta' - do i=1,nres-2 - thet=theta(i+2) - theta(i+2)=thet+aincr - do j=i,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+1,nres-1 - ii = indmat(i,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k,ii))/ - & (aincr*dabs(dcdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - theta(i+2)=thet - enddo - write (iout,'(a)') '******************* ddc/dphi' - do i=1,nres-3 - phii=phi(i+3) - phi(i+3)=phii+aincr - do j=1,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+2,nres-1 - ii = indmat(i+1,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ - & (aincr*dabs(dcdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - phi(i+3)=phii - enddo - return - end -C---------------------------------------------------------------------------- - subroutine check_ecart -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar) - dimension grad_s(6,maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - icg=1 - nf=0 - nfl=0 - call zerograd - aincr=1.0D-7 - print '(a)','CG processor',me,' calling CHECK_CART.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gradc(j,i,icg) - grad_s(j+3,i)=gradx(j,i,icg) - enddo - enddo - call flush(iout) - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=1,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - enddo - do j=1,3 - dc(j,i)=dc(j,i)+aincr - do k=i+1,nres - c(j,k)=c(j,k)+aincr - c(j,k+nres)=c(j,k+nres)+aincr - enddo - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j)=(etot1-etot)/aincr - dc(j,i)=ddc(j) - do k=i+1,nres - c(j,k)=c(j,k)-aincr - c(j,k+nres)=c(j,k+nres)-aincr - enddo - enddo - do j=1,3 - c(j,i+nres)=c(j,i+nres)+aincr - dc(j,i+nres)=dc(j,i+nres)+aincr - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j+3)=(etot1-etot)/aincr - c(j,i+nres)=xx(j) - dc(j,i+nres)=ddx(j) - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine check_ecartint -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - include 'COMMON.LOCAL' - include 'COMMON.SPLITELE' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar), - & g(maxvar) - dimension dcnorm_safe(3),dxnorm_safe(3) - dimension grad_s(6,0:maxres),grad_s1(6,0:maxres) - double precision phi_temp(maxres),theta_temp(maxres), - & alph_temp(maxres),omeg_temp(maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - r_cut=2.0d0 - rlambd=0.3d0 - icg=1 - nf=0 - nfl=0 - call intout -c call intcartderiv -c call checkintcartgrad - call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - if (.not.split_ene) then - call etotal(energia(0)) -c do i=1,nres -c write (iout,*) "atu?", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - etot=energia(0) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - else -!- split gradient check - call zerograd - call etotal_long(energia(0)) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "longrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - call zerograd - call etotal_short(energia(0)) - call enerprint(energia(0)) -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "shortrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s1(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s1(j,i)=gcart(j,i) - grad_s1(j+3,i)=gxcart(j,i) - enddo - enddo - endif - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=0,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - do k=1,3 - dcnorm_safe(k)=dc_norm(k,i) - dxnorm_safe(k)=dc_norm(k,i+nres) - enddo - enddo - do j=1,3 - dc(j,i)=ddc(j)+aincr - call chainbuild_cart -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. -c if (nfgtasks.gt.1) -c & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) -c write (iout,*) "etot11",etot11," etot12",etot12 - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i)=ddc(j)-aincr - call chainbuild_cart -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j)=(etot12-etot22)/(2*aincr) -!- end split gradient -c write (iout,*) "etot21",etot21," etot22",etot22 - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i)=ddc(j) - call chainbuild_cart - enddo - do j=1,3 - dc(j,i+nres)=ddx(j)+aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm+ and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) -c write (iout,*) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i+nres)=ddx(j)-aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm- and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j+3)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j+3)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j+3)=(etot12-etot22)/(2*aincr) -!- end split gradient - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i+nres)=ddx(j) - call chainbuild_cart - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) - if (split_ene) then - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i), - & k=1,6) - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6), - & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6) - endif - enddo - return - end -c------------------------------------------------------------------------- - subroutine int_from_cart1(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.SETUP' - include 'COMMON.TIME1' - logical lprn - if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' -#ifdef TIMING - time01=MPI_Wtime() -#endif -#if defined(PARINT) && defined(MPI) - do i=iint_start,iint_end+1 -#else - do i=2,nres -#endif - dnorm1=dist(i-1,i) - dnorm2=dist(i,i+1) - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 - & +(c(j,i+1)-c(j,i))/dnorm2) - enddo - be=0.0D0 - if (i.gt.2) then - if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1) - if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then - tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) - endif - if (itype(i-1).ne.10) then - tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) - omicron(1,i)=alpha(i-2,i-1,i-1+nres) - omicron(2,i)=alpha(i-1+nres,i-1,i) - endif - if (itype(i).ne.10) then - tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) - endif - endif - omeg(i)=beta(nres+i,i,maxres2,i+1) - alph(i)=alpha(nres+i,i,maxres2) - theta(i+1)=alpha(i-1,i,i+1) - vbld(i)=dist(i-1,i) - vbld_inv(i)=1.0d0/vbld(i) - vbld(nres+i)=dist(nres+i,i) - if (itype(i).ne.10) then - vbld_inv(nres+i)=1.0d0/vbld(nres+i) - else - vbld_inv(nres+i)=0.0d0 - endif - enddo - -#if defined(PARINT) && defined(MPI) - if (nfgtasks1.gt.1) then -cd write(iout,*) "iint_start",iint_start," iint_count", -cd & (iint_count(i),i=0,nfgtasks-1)," iint_displ", -cd & (iint_displ(i),i=0,nfgtasks-1) -cd write (iout,*) "Gather vbld backbone" -cd call flush(iout) - time00=MPI_Wtime() - call MPI_Allgatherv(vbld(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld_inv(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld(iint_start+nres),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(nres+1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start+nres), - & iint_count(fg_rank1),MPI_DOUBLE_PRECISION,vbld_inv(nres+1), - & iint_count(0),iint_displ(0),MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather theta" -cd call flush(iout) - call MPI_Allgatherv(theta(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,theta(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather phi" -cd call flush(iout) - call MPI_Allgatherv(phi(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,phi(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#ifdef CRYST_SC -cd write (iout,*) "Gather alph" -cd call flush(iout) - call MPI_Allgatherv(alph(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,alph(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather omeg" -cd call flush(iout) - call MPI_Allgatherv(omeg(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,omeg(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#endif - time_gather=time_gather+MPI_Wtime()-time00 - endif -#endif - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - enddo - if (lprn) then - do i=2,nres - write (iout,1212) restyp(itype(i)),i,vbld(i), - &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), - &rad2deg*alph(i),rad2deg*omeg(i) - enddo - endif - 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) -#ifdef TIMING - time_intfcart=time_intfcart+MPI_Wtime()-time01 -#endif - return - end -c---------------------------------------------------------------------------- - subroutine check_eint -C Check the gradient of energy in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - common /srutu/ icall - dimension x(maxvar),gana(maxvar),gg(maxvar) - integer uiparm(1) - double precision urparm(1) - double precision energia(0:n_ene),energia1(0:n_ene), - & energia2(0:n_ene) - character*6 key - external fdum - call zerograd - aincr=1.0D-7 - print '(a)','Calling CHECK_INT.' - nf=0 - nfl=0 - icg=1 - call geom_to_var(nvar,x) - call var_to_geom(nvar,x) - call chainbuild - icall=1 - print *,'ICG=',ICG - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - print *,'ICG=',ICG -#ifdef MPL - if (MyID.ne.BossID) then - call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID) - nf=x(nvar+1) - nfl=x(nvar+2) - icg=x(nvar+3) - endif -#endif - nf=1 - nfl=3 -cd write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) - call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) -cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar) - icall=1 - do i=1,nvar - xi=x(i) - x(i)=xi-0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia1(0)) - etot1=energia1(0) - x(i)=xi+0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia2(0)) - etot2=energia2(0) - gg(i)=(etot2-etot1)/aincr - write (iout,*) i,etot1,etot2 - x(i)=xi - enddo - write (iout,'(/2a)')' Variable Numerical Analytical', - & ' RelDiff*100% ' - do i=1,nvar - if (i.le.nphi) then - ii=i - key = ' phi' - else if (i.le.nphi+ntheta) then - ii=i-nphi - key=' theta' - else if (i.le.nphi+ntheta+nside) then - ii=i-(nphi+ntheta) - key=' alpha' - else - ii=i-(nphi+ntheta+nside) - key=' omega' - endif - write (iout,'(i3,a,i3,3(1pd16.6))') - & i,key,ii,gg(i),gana(i), - & 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/compare_s1.F b/source/unres/src_MD-DFA-restraints/compare_s1.F deleted file mode 100644 index 300e7ed..0000000 --- a/source/unres/src_MD-DFA-restraints/compare_s1.F +++ /dev/null @@ -1,188 +0,0 @@ - subroutine compare_s1(n_thr,num_thread_save,energyx,x, - & icomp,enetbss,coordss,rms_d,modif,iprint) -C This subroutine compares the new conformation, whose variables are in X -C with the previously accumulated conformations whose energies and variables -C are stored in ENETBSS and COORDSS, respectively. The meaning of other -C variables is as follows: -C -C N_THR - on input the previous # of accumulated confs, on output the current -C # of accumulated confs. -C N_REPEAT - an array that indicates how many times the structure has already -C been used to start the reversed-reversing procedure. Addition of -C a new structure replacement of a structure with a similar, but -C lower-energy structure resets the respective entry in N_REPEAT to zero -C I9 - output unit -C ENERGYX,X - the energy and variables of the new conformations. -C ICOMP - comparison result: -C 0 - the new structure is similar to one of the previous ones and does -C not have a remarkably lower energy and is therefore rejected; -C 1 - the new structure is different and is added to the set, because -C there is still room in the COORDSS and ENETBSS arrays; -C 2 - the new structure is different, but higher in energy than any -C previous one and is therefore rejected -C 3 - there is no more room in the COORDSS and ENETBSS arrays, but -C the new structure is lower in energy than at least the highest- -C energy previous structure and therefore replaces it. -C 9 - the new structure is similar to a number of previous structures, -C but has a remarkably lower energy than any of them; therefore -C replaces all these structures; -C MODIF - a logical variable that shows whether to include the new structure -C in the set of accumulated structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' -crc include 'COMMON.DEFORM' - include 'COMMON.IOUNITS' -#ifdef UNRES - include 'COMMON.CHAIN' -#endif - - dimension x(maxvar) - dimension x1(maxvar) - double precision przes(3),obrot(3,3) - integer list(max_thread) - logical non_conv,modif - double precision enetbss(max_threadss) - double precision coordss(maxvar,max_threadss) - - nlist=0 -#ifdef UNRES - call var_to_geom(nvar,x) - call chainbuild - do k=1,2*nres - do kk=1,3 - cref(kk,k)=c(kk,k) - enddo - enddo -#endif -c write(iout,*)'*ene=',energyx - j=0 - enex_jp=-1.0d+99 - do i=1,n_thr - do k=1,nvar - x1(k)=coordss(k,i) - enddo - if (iprint.gt.3) then - write (iout,*) 'Compare_ss, i=',i - write (iout,*) 'New structure Energy:',energyx - write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar) - write (iout,*) 'Template structure Energy:',enetbss(i) - write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar) - endif - -#ifdef UNRES - call var_to_geom(nvar,x1) - call chainbuild -cd write(iout,*)'C and CREF' -cd write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3), -cd & (cref(j,k),j=1,3),k=1,nres) - call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!!' - print *,'X' - print '(10f8.3)',(x(k),k=1,nvar) - print *,'X1' - print '(10f8.3)',(x1(k),k=1,nvar) - print *,'C and CREF' - print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3), - & (cref(j,k),j=1,3),k=1,nres) - endif - roznica=dsqrt(dabs(roznica)) - iresult = 1 - if (roznica.lt.rms_d) iresult = 0 -#else - energyy=enetbss(i) - call cmprs(x,x1,roznica,energyx,energyy,iresult) -#endif - if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica -c print '(i5,f8.3)',i,roznica - if(iresult.eq.0) then - nlist = nlist + 1 - list(nlist)=i - if (iprint.gt.1) write(iout,*) - if(energyx.ge.enetbss(i)) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - same as nr ',i, - & ' RMS',roznica - minimize_s_flag=0 - icomp=0 - go to 1106 - endif - endif - if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then - j=i - enex_jp=enetbss(i) - endif - enddo - if (iprint.gt.1) write(iout,*) - if(nlist.gt.0) then - if (modif) then - if (iprint.gt.1) - & write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ', - & list(1) - else - if (iprint.gt.1) - & write(iout,'(a,i3)') - & 's*>> structure accepted1 - would repl nr ',list(1) - endif - icomp=9 - if (.not. modif) goto 1106 - j=list(1) - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - do j=2,nlist - if (iprint.gt.1) write(iout,'(i3,$)')list(j) - do kk=list(j)+1,nlist - enetbss(kk-1)=enetbss(kk) - do i=1,nvar - coordss(i,kk-1)=coordss(i,kk) - enddo - enddo - enddo - if (iprint.gt.1) write(iout,*) - go to 1106 - endif - if(n_thr.lt.num_thread_save) then - icomp=1 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1 - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would add with nr ', - & n_thr+1 - goto 1106 - endif - n_thr=n_thr+1 - enetbss(n_thr)=energyx - do i=1,nvar - coordss(i,n_thr)=x(i) - enddo - else - if(j.eq.0) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - too high energy' - icomp=2 - go to 1106 - end if - icomp=3 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - repl nr ',j - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would repl nr ',j - goto 1106 - endif - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - end if - -1106 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/compinfo.c b/source/unres/src_MD-DFA-restraints/compinfo.c deleted file mode 100644 index e28f686..0000000 --- a/source/unres/src_MD-DFA-restraints/compinfo.c +++ /dev/null @@ -1,82 +0,0 @@ -#include -#include -#include -#include -#include - -main() -{ -FILE *in, *in1, *out; -int i,j,k,iv1,iv2,iv3; -char *p1,buf[500],buf1[500],buf2[100],buf3[100]; -struct utsname Name; -time_t Tp; - -in=fopen("cinfo.f","r"); -out=fopen("cinfo.f.new","w"); -if (fgets(buf,498,in) != NULL) - fprintf(out,"C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C\n"); -if (fgets(buf,498,in) != NULL) - sscanf(&buf[1],"%d %d %d",&iv1,&iv2,&iv3); -iv3++; -fprintf(out,"C %d %d %d\n",iv1,iv2,iv3); -fprintf(out," subroutine cinfo\n"); -fprintf(out," include 'COMMON.IOUNITS'\n"); -fprintf(out," write(iout,*)'++++ Compile info ++++'\n"); -fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3); -uname(&Name); -time(&Tp); -system("whoami > tmptmp"); -in1=fopen("tmptmp","r"); -if (fscanf(in1,"%s",buf1) != EOF) -{ -p1=ctime(&Tp); -p1[strlen(p1)-1]='\0'; -fprintf(out," write(iout,*)'compiled %s'\n",p1); -fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename); -fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname); -fprintf(out," write(iout,*)'OS release: %s '\n",Name.release); -fprintf(out," write(iout,*)'OS version:',\n"); -fprintf(out," & ' %s '\n",Name.version); -fprintf(out," write(iout,*)'flags:'\n"); -} -system("rm tmptmp"); -fclose(in1); -in1=fopen("Makefile","r"); -while(fgets(buf,498,in1) != NULL) - { - if((p1=strchr(buf,'=')) != NULL && buf[0] != '#') - { - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - else - { - while(buf[strlen(buf)-1]=='\\') - { - strcat(buf,"\\"); - fprintf(out," write(iout,*)'%s'\n",buf); - if (fgets(buf,498,in1) != NULL) - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - } - } - - fprintf(out," write(iout,*)'%s'\n",buf); - } - } -fprintf(out," write(iout,*)'++++ End of compile info ++++'\n"); -fprintf(out," return\n"); -fprintf(out," end\n"); -fclose(out); -fclose(in1); -fclose(in); -system("mv cinfo.f.new cinfo.f"); -} diff --git a/source/unres/src_MD-DFA-restraints/contact.f b/source/unres/src_MD-DFA-restraints/contact.f deleted file mode 100644 index a244d86..0000000 --- a/source/unres/src_MD-DFA-restraints/contact.f +++ /dev/null @@ -1,195 +0,0 @@ - subroutine contact(lprint,ncont,icont,co) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - real*8 facont /1.569D0/ ! facont = (2/(1-sqrt(1-1/4)))**(1/6) - integer ncont,icont(2,maxcont) - logical lprint - ncont=0 - kkk=3 - do i=nnt+kkk,nct - iti=itype(i) - do j=nnt,i-kkk - itj=itype(j) - if (ipot.ne.4) then -c rcomp=sigmaii(iti,itj)+1.0D0 - rcomp=facont*sigmaii(iti,itj) - else -c rcomp=sigma(iti,itj)+1.0D0 - rcomp=facont*sigma(iti,itj) - endif -c rcomp=6.5D0 -c print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j) - if (dist(nres+i,nres+j).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'Contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif - co = 0.0d0 - do i=1,ncont - co = co + dfloat(iabs(icont(1,i)-icont(2,i))) - enddo - co = co / (nres*ncont) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract=dfloat(nmatch)/dfloat(ncont_ref) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract_nn(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont) - return - end -c---------------------------------------------------------------------------- - subroutine hairpin(lprint,nharp,iharp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - integer ncont,icont(2,maxcont) - integer nharp,iharp(4,maxres/3) - logical lprint,not_done - real*8 rcomp /6.0d0/ - ncont=0 - kkk=0 -c print *,'nnt=',nnt,' nct=',nct - do i=nnt,nct-3 - do k=1,3 - c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1)) - enddo - do j=i+2,nct-1 - do k=1,3 - c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1)) - enddo - if (dist(2*nres+1,2*nres+2).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'PP contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif -c finding hairpins - nharp=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then -c write (iout,*) "found turn at ",i1,j1 - ii1=i1 - jj1=j1 - not_done=.true. - do while (not_done) - i1=i1-1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -c write (iout,*) i1,j1,not_done - enddo - i1=i1+1 - j1=j1-1 - if (j1-i1.gt.4) then - nharp=nharp+1 - iharp(1,nharp)=i1 - iharp(2,nharp)=j1 - iharp(3,nharp)=ii1 - iharp(4,nharp)=jj1 -c write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4) - endif - endif - enddo -c do i=1,nharp -c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4) -c enddo - if (lprint) then - write (iout,*) "Hairpins:" - do i=1,nharp - i1=iharp(1,i) - j1=iharp(2,i) - ii1=iharp(3,i) - jj1=iharp(4,i) - write (iout,*) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) -c do k=jj1,j1,-1 -c write (iout,'(a,i3,$)') restyp(itype(k)),k -c enddo - enddo - endif - return - end -c---------------------------------------------------------------------------- - diff --git a/source/unres/src_MD-DFA-restraints/convert.f b/source/unres/src_MD-DFA-restraints/convert.f deleted file mode 100644 index dc0cccd..0000000 --- a/source/unres/src_MD-DFA-restraints/convert.f +++ /dev/null @@ -1,196 +0,0 @@ - subroutine geom_to_var(n,x) -C -C Transfer the geometry parameters to the variable array. -C The positions of variables are as follows: -C 1. Virtual-bond torsional angles: 1 thru nres-3 -C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5 -C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru -C 2*nres-4+nside -C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1 -C thru 2*nre-4+2*nside -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - double precision x(n) -cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar - do i=4,nres - x(i-3)=phi(i) -cd print *,i,i-3,phi(i) - enddo - if (n.eq.nphi) return - do i=3,nres - x(i-2+nphi)=theta(i) -cd print *,i,i-2+nphi,theta(i) - enddo - if (n.eq.nphi+ntheta) return - do i=2,nres-1 - if (ialph(i,1).gt.0) then - x(ialph(i,1))=alph(i) - x(ialph(i,1)+nside)=omeg(i) -cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i) - endif - enddo - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom(n,x) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(n) - logical change,reduce - change=reduce(x) - if (n.gt.nphi+ntheta) then - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - endif - do i=4,nres - phi(i)=x(i-3) - enddo - if (n.eq.nphi) return - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- - logical function convert_side(alphi,omegi) - implicit none - double precision alphi,omegi - double precision pinorm - include 'COMMON.GEO' - convert_side=.false. -C Apply periodicity restrictions. - if (alphi.gt.pi) then - alphi=dwapi-alphi - omegi=pinorm(omegi+pi) - convert_side=.true. - endif - return - end -c------------------------------------------------------------------------- - logical function reduce(x) -C -C Apply periodic restrictions to variables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - logical zm,zmiana,convert_side - dimension x(nvar) - zmiana=.false. - do i=4,nres - x(i-3)=pinorm(x(i-3)) - enddo - if (nvar.gt.nphi+ntheta) then - do i=1,nside - ii=nphi+ntheta+i - iii=ii+nside - x(ii)=thetnorm(x(ii)) - x(iii)=pinorm(x(iii)) -C Apply periodic restrictions. - zm=convert_side(x(ii),x(iii)) - zmiana=zmiana.or.zm - enddo - endif - if (nvar.eq.nphi) return - do i=3,nres - ii=i-2+nphi - iii=i-3 - x(ii)=dmod(x(ii),dwapi) -C Apply periodic restrictions. - if (x(ii).gt.pi) then - zmiana=.true. - x(ii)=dwapi-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.-pi) then - zmiana=.true. - x(ii)=dwapi+x(ii) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-pi-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.0.0d0) then - zmiana=.true. - x(ii)=-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - endif - enddo - reduce=zmiana - return - end -c-------------------------------------------------------------------------- - double precision function thetnorm(x) -C This function puts x within [0,2Pi]. - implicit none - double precision x,xx - include 'COMMON.GEO' - xx=dmod(x,dwapi) - if (xx.lt.0.0d0) xx=xx+dwapi - if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi - thetnorm=xx - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom_restr(n,xx) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(maxvar),xx(maxvar) - logical change,reduce - - call xx2x(x,xx) - change=reduce(x) - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - do i=4,nres - phi(i)=x(i-3) - enddo - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/cored.f b/source/unres/src_MD-DFA-restraints/cored.f deleted file mode 100644 index 1cf25e5..0000000 --- a/source/unres/src_MD-DFA-restraints/cored.f +++ /dev/null @@ -1,3151 +0,0 @@ - subroutine assst(iv, liv, lv, v) -c -c *** assess candidate step (***sol version 2.3) *** -c - integer liv, l - integer iv(liv) - double precision v(lv) -c -c *** purpose *** -c -c this subroutine is called by an unconstrained minimization -c routine to assess the next candidate step. it may recommend one -c of several courses of action, such as accepting the step, recom- -c puting it using the same or a new quadratic model, or halting due -c to convergence or false convergence. see the return code listing -c below. -c -c-------------------------- parameter usage -------------------------- -c -c iv (i/o) integer parameter and scratch vector -- see description -c below of iv values referenced. -c liv (in) length of iv array. -c lv (in) length of v array. -c v (i/o) real parameter and scratch vector -- see description -c below of v values referenced. -c -c *** iv values referenced *** -c -c iv(irc) (i/o) on input for the first step tried in a new iteration, -c iv(irc) should be set to 3 or 4 (the value to which it is -c set when step is definitely to be accepted). on input -c after step has been recomputed, iv(irc) should be -c unchanged since the previous return of assst. -c on output, iv(irc) is a return code having one of the -c following values... -c 1 = switch models or try smaller step. -c 2 = switch models or accept step. -c 3 = accept step and determine v(radfac) by gradient -c tests. -c 4 = accept step, v(radfac) has been determined. -c 5 = recompute step (using the same model). -c 6 = recompute step with radius = v(lmaxs) but do not -c evaulate the objective function. -c 7 = x-convergence (see v(xctol)). -c 8 = relative function convergence (see v(rfctol)). -c 9 = both x- and relative function convergence. -c 10 = absolute function convergence (see v(afctol)). -c 11 = singular convergence (see v(lmaxs)). -c 12 = false convergence (see v(xftol)). -c 13 = iv(irc) was out of range on input. -c return code i has precdence over i+1 for i = 9, 10, 11. -c iv(mlstgd) (i/o) saved value of iv(model). -c iv(model) (i/o) on input, iv(model) should be an integer identifying -c the current quadratic model of the objective function. -c if a previous step yielded a better function reduction, -c then iv(model) will be set to iv(mlstgd) on output. -c iv(nfcall) (in) invocation count for the objective function. -c iv(nfgcal) (i/o) value of iv(nfcall) at step that gave the biggest -c function reduction this iteration. iv(nfgcal) remains -c unchanged until a function reduction is obtained. -c iv(radinc) (i/o) the number of radius increases (or minus the number -c of decreases) so far this iteration. -c iv(restor) (out) set to 1 if v(f) has been restored and x should be -c restored to its initial value, to 2 if x should be saved, -c to 3 if x should be restored from the saved value, and to -c 0 otherwise. -c iv(stage) (i/o) count of the number of models tried so far in the -c current iteration. -c iv(stglim) (in) maximum number of models to consider. -c iv(switch) (out) set to 0 unless a new model is being tried and it -c gives a smaller function value than the previous model, -c in which case assst sets iv(switch) = 1. -c iv(toobig) (in) is nonzero if step was too big (e.g. if it caused -c overflow). -c iv(xirc) (i/o) value that iv(irc) would have in the absence of -c convergence, false convergence, and oversized steps. -c -c *** v values referenced *** -c -c v(afctol) (in) absolute function convergence tolerance. if the -c absolute value of the current function value v(f) is less -c than v(afctol), then assst returns with iv(irc) = 10. -c v(decfac) (in) factor by which to decrease radius when iv(toobig) is -c nonzero. -c v(dstnrm) (in) the 2-norm of d*step. -c v(dstsav) (i/o) value of v(dstnrm) on saved step. -c v(dst0) (in) the 2-norm of d times the newton step (when defined, -c i.e., for v(nreduc) .ge. 0). -c v(f) (i/o) on both input and output, v(f) is the objective func- -c tion value at x. if x is restored to a previous value, -c then v(f) is restored to the corresponding value. -c v(fdif) (out) the function reduction v(f0) - v(f) (for the output -c value of v(f) if an earlier step gave a bigger function -c decrease, and for the input value of v(f) otherwise). -c v(flstgd) (i/o) saved value of v(f). -c v(f0) (in) objective function value at start of iteration. -c v(gtslst) (i/o) value of v(gtstep) on saved step. -c v(gtstep) (in) inner product between step and gradient. -c v(incfac) (in) minimum factor by which to increase radius. -c v(lmaxs) (in) maximum reasonable step size (and initial step bound). -c if the actual function decrease is no more than twice -c what was predicted, if a return with iv(irc) = 7, 8, 9, -c or 10 does not occur, if v(dstnrm) .gt. v(lmaxs), and if -c v(preduc) .le. v(sctol) * abs(v(f0)), then assst re- -c turns with iv(irc) = 11. if so doing appears worthwhile, -c then assst repeats this test with v(preduc) computed for -c a step of length v(lmaxs) (by a return with iv(irc) = 6). -c v(nreduc) (i/o) function reduction predicted by quadratic model for -c newton step. if assst is called with iv(irc) = 6, i.e., -c if v(preduc) has been computed with radius = v(lmaxs) for -c use in the singular convervence test, then v(nreduc) is -c set to -v(preduc) before the latter is restored. -c v(plstgd) (i/o) value of v(preduc) on saved step. -c v(preduc) (i/o) function reduction predicted by quadratic model for -c current step. -c v(radfac) (out) factor to be used in determining the new radius, -c which should be v(radfac)*dst, where dst is either the -c output value of v(dstnrm) or the 2-norm of -c diag(newd)*step for the output value of step and the -c updated version, newd, of the scale vector d. for -c iv(irc) = 3, v(radfac) = 1.0 is returned. -c v(rdfcmn) (in) minimum value for v(radfac) in terms of the input -c value of v(dstnrm) -- suggested value = 0.1. -c v(rdfcmx) (in) maximum value for v(radfac) -- suggested value = 4.0. -c v(reldx) (in) scaled relative change in x caused by step, computed -c (e.g.) by function reldst as -c max (d(i)*abs(x(i)-x0(i)), 1 .le. i .le. p) / -c max (d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p). -c v(rfctol) (in) relative function convergence tolerance. if the -c actual function reduction is at most twice what was pre- -c dicted and v(nreduc) .le. v(rfctol)*abs(v(f0)), then -c assst returns with iv(irc) = 8 or 9. -c v(stppar) (in) marquardt parameter -- 0 means full newton step. -c v(tuner1) (in) tuning constant used to decide if the function -c reduction was much less than expected. suggested -c value = 0.1. -c v(tuner2) (in) tuning constant used to decide if the function -c reduction was large enough to accept step. suggested -c value = 10**-4. -c v(tuner3) (in) tuning constant used to decide if the radius -c should be increased. suggested value = 0.75. -c v(xctol) (in) x-convergence criterion. if step is a newton step -c (v(stppar) = 0) having v(reldx) .le. v(xctol) and giving -c at most twice the predicted function decrease, then -c assst returns iv(irc) = 7 or 9. -c v(xftol) (in) false convergence tolerance. if step gave no or only -c a small function decrease and v(reldx) .le. v(xftol), -c then assst returns with iv(irc) = 12. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine is called as part of the nl2sol (nonlinear -c least-squares) package. it may be used in any unconstrained -c minimization solver that uses dogleg, goldfeld-quandt-trotter, -c or levenberg-marquardt steps. -c -c *** algorithm notes *** -c -c see (1) for further discussion of the assessing and model -c switching strategies. while nl2sol considers only two models, -c assst is designed to handle any number of models. -c -c *** usage notes *** -c -c on the first call of an iteration, only the i/o variables -c step, x, iv(irc), iv(model), v(f), v(dstnrm), v(gtstep), and -c v(preduc) need have been initialized. between calls, no i/o -c values execpt step, x, iv(model), v(f) and the stopping toler- -c ances should be changed. -c after a return for convergence or false convergence, one can -c change the stopping tolerances and call assst again, in which -c case the stopping tests will be repeated. -c -c *** references *** -c -c (1) dennis, j.e., jr., gay, d.m., and welsch, r.e. (1981), -c an adaptive nonlinear least-squares algorithm, -c acm trans. math. software, vol. 7, no. 3. -c -c (2) powell, m.j.d. (1970) a fortran subroutine for solving -c systems of nonlinear algebraic equations, in numerical -c methods for nonlinear algebraic equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** history *** -c -c john dennis designed much of this routine, starting with -c ideas in (2). roy welsch suggested the model switching strategy. -c david gay and stephen peters cast this subroutine into a more -c portable form (winter 1977), and david gay cast it into its -c present form (fall 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** no external functions and subroutines *** -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1 -c/ -c *** no common blocks *** -c -c-------------------------- local variables -------------------------- -c - logical goodx - integer i, nfc - double precision emax, emaxs, gts, rfac1, xmax - double precision half, one, onep2, two, zero -c -c *** subscripts for iv and v *** -c - integer afctol, decfac, dstnrm, dstsav, dst0, f, fdif, flstgd, f0, - 1 gtslst, gtstep, incfac, irc, lmaxs, mlstgd, model, nfcall, - 2 nfgcal, nreduc, plstgd, preduc, radfac, radinc, rdfcmn, - 3 rdfcmx, reldx, restor, rfctol, sctol, stage, stglim, - 4 stppar, switch, toobig, tuner1, tuner2, tuner3, xctol, - 5 xftol, xirc -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, onep2/1.2d+0/, two/2.d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, onep2=1.2d+0, two=2.d+0, - 1 zero=0.d+0) -c/ -c -c/6 -c data irc/29/, mlstgd/32/, model/5/, nfcall/6/, nfgcal/7/, -c 1 radinc/8/, restor/9/, stage/10/, stglim/11/, switch/12/, -c 2 toobig/2/, xirc/13/ -c/7 - parameter (irc=29, mlstgd=32, model=5, nfcall=6, nfgcal=7, - 1 radinc=8, restor=9, stage=10, stglim=11, switch=12, - 2 toobig=2, xirc=13) -c/ -c/6 -c data afctol/31/, decfac/22/, dstnrm/2/, dst0/3/, dstsav/18/, -c 1 f/10/, fdif/11/, flstgd/12/, f0/13/, gtslst/14/, gtstep/4/, -c 2 incfac/23/, lmaxs/36/, nreduc/6/, plstgd/15/, preduc/7/, -c 3 radfac/16/, rdfcmn/24/, rdfcmx/25/, reldx/17/, rfctol/32/, -c 4 sctol/37/, stppar/5/, tuner1/26/, tuner2/27/, tuner3/28/, -c 5 xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, decfac=22, dstnrm=2, dst0=3, dstsav=18, - 1 f=10, fdif=11, flstgd=12, f0=13, gtslst=14, gtstep=4, - 2 incfac=23, lmaxs=36, nreduc=6, plstgd=15, preduc=7, - 3 radfac=16, rdfcmn=24, rdfcmx=25, reldx=17, rfctol=32, - 4 sctol=37, stppar=5, tuner1=26, tuner2=27, tuner3=28, - 5 xctol=33, xftol=34) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nfc = iv(nfcall) - iv(switch) = 0 - iv(restor) = 0 - rfac1 = one - goodx = .true. - i = iv(irc) - if (i .ge. 1 .and. i .le. 12) - 1 go to (20,30,10,10,40,280,220,220,220,220,220,170), i - iv(irc) = 13 - go to 999 -c -c *** initialize for new iteration *** -c - 10 iv(stage) = 1 - iv(radinc) = 0 - v(flstgd) = v(f0) - if (iv(toobig) .eq. 0) go to 110 - iv(stage) = -1 - iv(xirc) = i - go to 60 -c -c *** step was recomputed with new model or smaller radius *** -c *** first decide which *** -c - 20 if (iv(model) .ne. iv(mlstgd)) go to 30 -c *** old model retained, smaller radius tried *** -c *** do not consider any more new models this iteration *** - iv(stage) = iv(stglim) - iv(radinc) = -1 - go to 110 -c -c *** a new model is being tried. decide whether to keep it. *** -c - 30 iv(stage) = iv(stage) + 1 -c -c *** now we add the possibiltiy that step was recomputed with *** -c *** the same model, perhaps because of an oversized step. *** -c - 40 if (iv(stage) .gt. 0) go to 50 -c -c *** step was recomputed because it was too big. *** -c - if (iv(toobig) .ne. 0) go to 60 -c -c *** restore iv(stage) and pick up where we left off. *** -c - iv(stage) = -iv(stage) - i = iv(xirc) - go to (20, 30, 110, 110, 70), i -c - 50 if (iv(toobig) .eq. 0) go to 70 -c -c *** handle oversize step *** -c - if (iv(radinc) .gt. 0) go to 80 - iv(stage) = -iv(stage) - iv(xirc) = iv(irc) -c - 60 v(radfac) = v(decfac) - iv(radinc) = iv(radinc) - 1 - iv(irc) = 5 - iv(restor) = 1 - go to 999 -c - 70 if (v(f) .lt. v(flstgd)) go to 110 -c -c *** the new step is a loser. restore old model. *** -c - if (iv(model) .eq. iv(mlstgd)) go to 80 - iv(model) = iv(mlstgd) - iv(switch) = 1 -c -c *** restore step, etc. only if a previous step decreased v(f). -c - 80 if (v(flstgd) .ge. v(f0)) go to 110 - iv(restor) = 1 - v(f) = v(flstgd) - v(preduc) = v(plstgd) - v(gtstep) = v(gtslst) - if (iv(switch) .eq. 0) rfac1 = v(dstnrm) / v(dstsav) - v(dstnrm) = v(dstsav) - nfc = iv(nfgcal) - goodx = .false. -c - 110 v(fdif) = v(f0) - v(f) - if (v(fdif) .gt. v(tuner2) * v(preduc)) go to 140 - if(iv(radinc).gt.0) go to 140 -c -c *** no (or only a trivial) function decrease -c *** -- so try new model or smaller radius -c - if (v(f) .lt. v(f0)) go to 120 - iv(mlstgd) = iv(model) - v(flstgd) = v(f) - v(f) = v(f0) - iv(restor) = 1 - go to 130 - 120 iv(nfgcal) = nfc - 130 iv(irc) = 1 - if (iv(stage) .lt. iv(stglim)) go to 160 - iv(irc) = 5 - iv(radinc) = iv(radinc) - 1 - go to 160 -c -c *** nontrivial function decrease achieved *** -c - 140 iv(nfgcal) = nfc - rfac1 = one - v(dstsav) = v(dstnrm) - if (v(fdif) .gt. v(preduc)*v(tuner1)) go to 190 -c -c *** decrease was much less than predicted -- either change models -c *** or accept step with decreased radius. -c - if (iv(stage) .ge. iv(stglim)) go to 150 -c *** consider switching models *** - iv(irc) = 2 - go to 160 -c -c *** accept step with decreased radius *** -c - 150 iv(irc) = 4 -c -c *** set v(radfac) to fletcher*s decrease factor *** -c - 160 iv(xirc) = iv(irc) - emax = v(gtstep) + v(fdif) - v(radfac) = half * rfac1 - if (emax .lt. v(gtstep)) v(radfac) = rfac1 * dmax1(v(rdfcmn), - 1 half * v(gtstep)/emax) -c -c *** do false convergence test *** -c - 170 if (v(reldx) .le. v(xftol)) go to 180 - iv(irc) = iv(xirc) - if (v(f) .lt. v(f0)) go to 200 - go to 230 -c - 180 iv(irc) = 12 - go to 240 -c -c *** handle good function decrease *** -c - 190 if (v(fdif) .lt. (-v(tuner3) * v(gtstep))) go to 210 -c -c *** increasing radius looks worthwhile. see if we just -c *** recomputed step with a decreased radius or restored step -c *** after recomputing it with a larger radius. -c - if (iv(radinc) .lt. 0) go to 210 - if (iv(restor) .eq. 1) go to 210 -c -c *** we did not. try a longer step unless this was a newton -c *** step. -c - v(radfac) = v(rdfcmx) - gts = v(gtstep) - if (v(fdif) .lt. (half/v(radfac) - one) * gts) - 1 v(radfac) = dmax1(v(incfac), half*gts/(gts + v(fdif))) - iv(irc) = 4 - if (v(stppar) .eq. zero) go to 230 - if (v(dst0) .ge. zero .and. (v(dst0) .lt. two*v(dstnrm) - 1 .or. v(nreduc) .lt. onep2*v(fdif))) go to 230 -c *** step was not a newton step. recompute it with -c *** a larger radius. - iv(irc) = 5 - iv(radinc) = iv(radinc) + 1 -c -c *** save values corresponding to good step *** -c - 200 v(flstgd) = v(f) - iv(mlstgd) = iv(model) - if (iv(restor) .ne. 1) iv(restor) = 2 - v(dstsav) = v(dstnrm) - iv(nfgcal) = nfc - v(plstgd) = v(preduc) - v(gtslst) = v(gtstep) - go to 230 -c -c *** accept step with radius unchanged *** -c - 210 v(radfac) = one - iv(irc) = 3 - go to 230 -c -c *** come here for a restart after convergence *** -c - 220 iv(irc) = iv(xirc) - if (v(dstsav) .ge. zero) go to 240 - iv(irc) = 12 - go to 240 -c -c *** perform convergence tests *** -c - 230 iv(xirc) = iv(irc) - 240 if (iv(restor) .eq. 1 .and. v(flstgd) .lt. v(f0)) iv(restor) = 3 - if (half * v(fdif) .gt. v(preduc)) go to 999 - emax = v(rfctol) * dabs(v(f0)) - emaxs = v(sctol) * dabs(v(f0)) - if (v(dstnrm) .gt. v(lmaxs) .and. v(preduc) .le. emaxs) - 1 iv(irc) = 11 - if (v(dst0) .lt. zero) go to 250 - i = 0 - if ((v(nreduc) .gt. zero .and. v(nreduc) .le. emax) .or. - 1 (v(nreduc) .eq. zero. and. v(preduc) .eq. zero)) i = 2 - if (v(stppar) .eq. zero .and. v(reldx) .le. v(xctol) - 1 .and. goodx) i = i + 1 - if (i .gt. 0) iv(irc) = i + 6 -c -c *** consider recomputing step of length v(lmaxs) for singular -c *** convergence test. -c - 250 if (iv(irc) .gt. 5 .and. iv(irc) .ne. 12) go to 999 - if (v(dstnrm) .gt. v(lmaxs)) go to 260 - if (v(preduc) .ge. emaxs) go to 999 - if (v(dst0) .le. zero) go to 270 - if (half * v(dst0) .le. v(lmaxs)) go to 999 - go to 270 - 260 if (half * v(dstnrm) .le. v(lmaxs)) go to 999 - xmax = v(lmaxs) / v(dstnrm) - if (xmax * (two - xmax) * v(preduc) .ge. emaxs) go to 999 - 270 if (v(nreduc) .lt. zero) go to 290 -c -c *** recompute v(preduc) for use in singular convergence test *** -c - v(gtslst) = v(gtstep) - v(dstsav) = v(dstnrm) - if (iv(irc) .eq. 12) v(dstsav) = -v(dstsav) - v(plstgd) = v(preduc) - i = iv(restor) - iv(restor) = 2 - if (i .eq. 3) iv(restor) = 0 - iv(irc) = 6 - go to 999 -c -c *** perform singular convergence test with recomputed v(preduc) *** -c - 280 v(gtstep) = v(gtslst) - v(dstnrm) = dabs(v(dstsav)) - iv(irc) = iv(xirc) - if (v(dstsav) .le. zero) iv(irc) = 12 - v(nreduc) = -v(preduc) - v(preduc) = v(plstgd) - iv(restor) = 3 - 290 if (-v(nreduc) .le. v(sctol) * dabs(v(f0))) iv(irc) = 11 -c - 999 return -c -c *** last card of assst follows *** - end - subroutine deflt(alg, iv, liv, lv, v) -c -c *** supply ***sol (version 2.3) default values to iv and v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer liv, l - integer alg, iv(liv) - double precision v(lv) -c - external imdcon, vdflt - integer imdcon -c imdcon... returns machine-dependent integer constants. -c vdflt.... provides default values to v. -c - integer miv, m - integer miniv(2), minv(2) -c -c *** subscripts for iv *** -c - integer algsav, covprt, covreq, dtype, hc, ierr, inith, inits, - 1 ipivot, ivneed, lastiv, lastv, lmat, mxfcal, mxiter, - 2 nfcov, ngcov, nvdflt, outlev, parprt, parsav, perm, - 3 prunit, qrtyp, rdreq, rmat, solprt, statpr, vneed, - 4 vsave, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, covprt/14/, covreq/15/, dtype/16/, hc/71/, -c 1 ierr/75/, inith/25/, inits/25/, ipivot/76/, ivneed/3/, -c 2 lastiv/44/, lastv/45/, lmat/42/, mxfcal/17/, mxiter/18/, -c 3 nfcov/52/, ngcov/53/, nvdflt/50/, outlev/19/, parprt/20/, -c 4 parsav/49/, perm/58/, prunit/21/, qrtyp/80/, rdreq/57/, -c 5 rmat/78/, solprt/22/, statpr/23/, vneed/4/, vsave/60/, -c 6 x0prt/24/ -c/7 - parameter (algsav=51, covprt=14, covreq=15, dtype=16, hc=71, - 1 ierr=75, inith=25, inits=25, ipivot=76, ivneed=3, - 2 lastiv=44, lastv=45, lmat=42, mxfcal=17, mxiter=18, - 3 nfcov=52, ngcov=53, nvdflt=50, outlev=19, parprt=20, - 4 parsav=49, perm=58, prunit=21, qrtyp=80, rdreq=57, - 5 rmat=78, solprt=22, statpr=23, vneed=4, vsave=60, - 6 x0prt=24) -c/ - data miniv(1)/80/, miniv(2)/59/, minv(1)/98/, minv(2)/71/ -c -c------------------------------- body -------------------------------- -c - if (alg .lt. 1 .or. alg .gt. 2) go to 40 - miv = miniv(alg) - if (liv .lt. miv) go to 20 - mv = minv(alg) - if (lv .lt. mv) go to 30 - call vdflt(alg, lv, v) - iv(1) = 12 - iv(algsav) = alg - iv(ivneed) = 0 - iv(lastiv) = miv - iv(lastv) = mv - iv(lmat) = mv + 1 - iv(mxfcal) = 200 - iv(mxiter) = 150 - iv(outlev) = 1 - iv(parprt) = 1 - iv(perm) = miv + 1 - iv(prunit) = imdcon(1) - iv(solprt) = 1 - iv(statpr) = 1 - iv(vneed) = 0 - iv(x0prt) = 1 -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - iv(covprt) = 3 - iv(covreq) = 1 - iv(dtype) = 1 - iv(hc) = 0 - iv(ierr) = 0 - iv(inits) = 0 - iv(ipivot) = 0 - iv(nvdflt) = 32 - iv(parsav) = 67 - iv(qrtyp) = 1 - iv(rdreq) = 3 - iv(rmat) = 0 - iv(vsave) = 58 - go to 999 -c -c *** general optimization values -c - 10 iv(dtype) = 0 - iv(inith) = 1 - iv(nfcov) = 0 - iv(ngcov) = 0 - iv(nvdflt) = 25 - iv(parsav) = 47 - go to 999 -c - 20 iv(1) = 15 - go to 999 -c - 30 iv(1) = 16 - go to 999 -c - 40 iv(1) = 67 -c - 999 return -c *** last card of deflt follows *** - end - double precision function dotprd(p, x, y) -c -c *** return the inner product of the p-vectors x and y. *** -c - integer p - double precision x(p), y(p) -c - integer i - double precision one, sqteta, t, zero -c/+ - double precision dmax1, dabs -c/ - external rmdcon - double precision rmdcon -c -c *** rmdcon(2) returns a machine-dependent constant, sqteta, which -c *** is slightly larger than the smallest positive number that -c *** can be squared without underflowing. -c -c/6 -c data one/1.d+0/, sqteta/0.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - data sqteta/0.d+0/ -c/ -c - dotprd = zero - if (p .le. 0) go to 999 -crc if (sqteta .eq. zero) sqteta = rmdcon(2) - do 20 i = 1, p -crc t = dmax1(dabs(x(i)), dabs(y(i))) -crc if (t .gt. one) go to 10 -crc if (t .lt. sqteta) go to 20 -crc t = (x(i)/sqteta)*y(i) -crc if (dabs(t) .lt. sqteta) go to 20 - 10 dotprd = dotprd + x(i)*y(i) - 20 continue -c - 999 return -c *** last card of dotprd follows *** - end - subroutine itsum(d, g, iv, liv, lv, p, v, x) -c -c *** print iteration summary for ***sol (version 2.3) *** -c -c *** parameter declarations *** -c - integer liv, lv, p - integer iv(liv) - double precision d(p), g(p), v(lv), x(p) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer alg, i, iv1, m, nf, ng, ol, pu -c/6 -c real model1(6), model2(6) -c/7 - character*4 model1(6), model2(6) -c/ - double precision nreldf, oldf, preldf, reldf, zero -c -c *** intrinsic functions *** -c/+ - integer iabs - double precision dabs, dmax1 -c/ -c *** no external functions or subroutines *** -c -c *** subscripts for iv and v *** -c - integer algsav, dstnrm, f, fdif, f0, needhd, nfcall, nfcov, ngcov, - 1 ngcall, niter, nreduc, outlev, preduc, prntit, prunit, - 2 reldx, solprt, statpr, stppar, sused, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, needhd/36/, nfcall/6/, nfcov/52/, ngcall/30/, -c 1 ngcov/53/, niter/31/, outlev/19/, prntit/39/, prunit/21/, -c 2 solprt/22/, statpr/23/, sused/64/, x0prt/24/ -c/7 - parameter (algsav=51, needhd=36, nfcall=6, nfcov=52, ngcall=30, - 1 ngcov=53, niter=31, outlev=19, prntit=39, prunit=21, - 2 solprt=22, statpr=23, sused=64, x0prt=24) -c/ -c -c *** v subscript values *** -c -c/6 -c data dstnrm/2/, f/10/, f0/13/, fdif/11/, nreduc/6/, preduc/7/, -c 1 reldx/17/, stppar/5/ -c/7 - parameter (dstnrm=2, f=10, f0=13, fdif=11, nreduc=6, preduc=7, - 1 reldx=17, stppar=5) -c/ -c -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c/6 -c data model1(1)/4h /, model1(2)/4h /, model1(3)/4h /, -c 1 model1(4)/4h /, model1(5)/4h g /, model1(6)/4h s /, -c 2 model2(1)/4h g /, model2(2)/4h s /, model2(3)/4hg-s /, -c 3 model2(4)/4hs-g /, model2(5)/4h-s-g/, model2(6)/4h-g-s/ -c/7 - data model1/' ',' ',' ',' ',' g ',' s '/, - 1 model2/' g ',' s ','g-s ','s-g ','-s-g','-g-s'/ -c/ -c -c------------------------------- body -------------------------------- -c - pu = iv(prunit) - if (pu .eq. 0) go to 999 - iv1 = iv(1) - if (iv1 .gt. 62) iv1 = iv1 - 51 - ol = iv(outlev) - alg = iv(algsav) - if (iv1 .lt. 2 .or. iv1 .gt. 15) go to 370 - if (iv1 .ge. 12) go to 120 - if (iv1 .eq. 2 .and. iv(niter) .eq. 0) go to 390 - if (ol .eq. 0) go to 120 - if (iv1 .ge. 10 .and. iv(prntit) .eq. 0) go to 120 - if (iv1 .gt. 2) go to 10 - iv(prntit) = iv(prntit) + 1 - if (iv(prntit) .lt. iabs(ol)) go to 999 - 10 nf = iv(nfcall) - iabs(iv(nfcov)) - iv(prntit) = 0 - reldf = zero - preldf = zero - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - if (oldf .le. zero) go to 20 - reldf = v(fdif) / oldf - preldf = v(preduc) / oldf - 20 if (ol .gt. 0) go to 60 -c -c *** print short summary line *** -c - if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,30) - 30 format(/10h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,40) - 40 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar) - iv(needhd) = 0 - if (alg .eq. 2) go to 50 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar) - go to 120 -c - 50 write(pu,110) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 v(stppar) - go to 120 -c -c *** print long summary line *** -c - 60 if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,70) - 70 format(/11h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar,2x,6hd*step,2x,7hnpreldf) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,80) - 80 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar,3x,6hd*step,3x,7hnpreldf) - iv(needhd) = 0 - nreldf = zero - if (oldf .gt. zero) nreldf = v(nreduc) / oldf - if (alg .eq. 2) go to 90 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar), v(dstnrm), nreldf - go to 120 -c - 90 write(pu,110) iv(niter), nf, v(f), reldf, preldf, - 1 v(reldx), v(stppar), v(dstnrm), nreldf - 100 format(i6,i5,d10.3,2d9.2,d8.1,a3,a4,2d8.1,d9.2) - 110 format(i6,i5,d11.3,2d10.2,3d9.1,d10.2) -c - 120 if (iv(statpr) .lt. 0) go to 430 - go to (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310, - 1 330, 350, 520), iv1 -c - 130 write(pu,140) - 140 format(/26h ***** x-convergence *****) - go to 430 -c - 150 write(pu,160) - 160 format(/42h ***** relative function convergence *****) - go to 430 -c - 170 write(pu,180) - 180 format(/49h ***** x- and relative function convergence *****) - go to 430 -c - 190 write(pu,200) - 200 format(/42h ***** absolute function convergence *****) - go to 430 -c - 210 write(pu,220) - 220 format(/33h ***** singular convergence *****) - go to 430 -c - 230 write(pu,240) - 240 format(/30h ***** false convergence *****) - go to 430 -c - 250 write(pu,260) - 260 format(/38h ***** function evaluation limit *****) - go to 430 -c - 270 write(pu,280) - 280 format(/28h ***** iteration limit *****) - go to 430 -c - 290 write(pu,300) - 300 format(/18h ***** stopx *****) - go to 430 -c - 310 write(pu,320) - 320 format(/44h ***** initial f(x) cannot be computed *****) -c - go to 390 -c - 330 write(pu,340) - 340 format(/37h ***** bad parameters to assess *****) - go to 999 -c - 350 write(pu,360) - 360 format(/43h ***** gradient could not be computed *****) - if (iv(niter) .gt. 0) go to 480 - go to 390 -c - 370 write(pu,380) iv(1) - 380 format(/14h ***** iv(1) =,i5,6h *****) - go to 999 -c -c *** initial call on itsum *** -c - 390 if (iv(x0prt) .ne. 0) write(pu,400) (i, x(i), d(i), i = 1, p) - 400 format(/23h i initial x(i),8x,4hd(i)//(1x,i5,d17.6,d14.3)) -c *** the following are to avoid undefined variables when the -c *** function evaluation limit is 1... - v(dstnrm) = zero - v(fdif) = zero - v(nreduc) = zero - v(preduc) = zero - v(reldx) = zero - if (iv1 .ge. 12) go to 999 - iv(needhd) = 0 - iv(prntit) = 0 - if (ol .eq. 0) go to 999 - if (ol .lt. 0 .and. alg .eq. 1) write(pu,30) - if (ol .lt. 0 .and. alg .eq. 2) write(pu,40) - if (ol .gt. 0 .and. alg .eq. 1) write(pu,70) - if (ol .gt. 0 .and. alg .eq. 2) write(pu,80) - if (alg .eq. 1) write(pu,410) v(f) - if (alg .eq. 2) write(pu,420) v(f) - 410 format(/11h 0 1,d10.3) -c365 format(/11h 0 1,e11.3) - 420 format(/11h 0 1,d11.3) - go to 999 -c -c *** print various information requested on solution *** -c - 430 iv(needhd) = 1 - if (iv(statpr) .eq. 0) go to 480 - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - preldf = zero - nreldf = zero - if (oldf .le. zero) go to 440 - preldf = v(preduc) / oldf - nreldf = v(nreduc) / oldf - 440 nf = iv(nfcall) - iv(nfcov) - ng = iv(ngcall) - iv(ngcov) - write(pu,450) v(f), v(reldx), nf, ng, preldf, nreldf - 450 format(/9h function,d17.6,8h reldx,d17.3/12h func. evals, - 1 i8,9x,11hgrad. evals,i8/7h preldf,d16.3,6x,7hnpreldf,d15.3) -c - if (iv(nfcov) .gt. 0) write(pu,460) iv(nfcov) - 460 format(/1x,i4,50h extra func. evals for covariance and diagnost - 1ics.) - if (iv(ngcov) .gt. 0) write(pu,470) iv(ngcov) - 470 format(1x,i4,50h extra grad. evals for covariance and diagnosti - 1cs.) -c - 480 if (iv(solprt) .eq. 0) go to 999 - iv(needhd) = 1 - write(pu,490) - 490 format(/22h i final x(i),8x,4hd(i),10x,4hg(i)/) - do 500 i = 1, p - write(pu,510) i, x(i), d(i), g(i) - 500 continue - 510 format(1x,i5,d16.6,2d14.3) - go to 999 -c - 520 write(pu,530) - 530 format(/24h inconsistent dimensions) - 999 return -c *** last card of itsum follows *** - end - subroutine litvmu(n, x, l, y) -c -c *** solve (l**t)*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - integer i, ii, ij, im1, i0, j, np1 - double precision xi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 i = 1, n - 10 x(i) = y(i) - np1 = n + 1 - i0 = n*(n+1)/2 - do 30 ii = 1, n - i = np1 - ii - xi = x(i)/l(i0) - x(i) = xi - if (i .le. 1) go to 999 - i0 = i0 - i - if (xi .eq. zero) go to 30 - im1 = i - 1 - do 20 j = 1, im1 - ij = i0 + j - x(j) = x(j) - xi*l(ij) - 20 continue - 30 continue - 999 return -c *** last card of litvmu follows *** - end - subroutine livmul(n, x, l, y) -c -c *** solve l*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - external dotprd - double precision dotprd - integer i, j, k - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 k = 1, n - if (y(k) .ne. zero) go to 20 - x(k) = zero - 10 continue - go to 999 - 20 j = k*(k+1)/2 - x(k) = y(k) / l(j) - if (k .ge. n) go to 999 - k = k + 1 - do 30 i = k, n - t = dotprd(i-1, l(j+1), x) - j = j + i - x(i) = (y(i) - t)/l(j) - 30 continue - 999 return -c *** last card of livmul follows *** - end - subroutine parck(alg, d, iv, liv, lv, n, v) -c -c *** check ***sol (version 2.3) parameters, print changed values *** -c -c *** alg = 1 for regression, alg = 2 for general unconstrained opt. -c - integer alg, liv, lv, n - integer iv(liv) - double precision d(n), v(lv) -c - external rmdcon, vcopy, vdflt - double precision rmdcon -c rmdcon -- returns machine-dependent constants. -c vcopy -- copies one vector to another. -c vdflt -- supplies default parameter values to v alone. -c/+ - integer max0 -c/ -c -c *** local variables *** -c - integer i, ii, iv1, j, k, l, m, miv1, miv2, ndfalt, parsv1, pu - integer ijmp, jlim(2), miniv(2), ndflt(2) -c/6 -c integer varnm(2), sh(2) -c real cngd(3), dflt(3), vn(2,34), which(3) -c/7 - character*1 varnm(2), sh(2) - character*4 cngd(3), dflt(3), vn(2,34), which(3) -c/ - double precision big, machep, tiny, vk, vm(34), vx(34), zero -c -c *** iv and v subscripts *** -c - integer algsav, dinit, dtype, dtype0, epslon, inits, ivneed, - 1 lastiv, lastv, lmat, nextiv, nextv, nvdflt, oldn, - 2 parprt, parsav, perm, prunit, vneed -c -c -c/6 -c data algsav/51/, dinit/38/, dtype/16/, dtype0/54/, epslon/19/, -c 1 inits/25/, ivneed/3/, lastiv/44/, lastv/45/, lmat/42/, -c 2 nextiv/46/, nextv/47/, nvdflt/50/, oldn/38/, parprt/20/, -c 3 parsav/49/, perm/58/, prunit/21/, vneed/4/ -c/7 - parameter (algsav=51, dinit=38, dtype=16, dtype0=54, epslon=19, - 1 inits=25, ivneed=3, lastiv=44, lastv=45, lmat=42, - 2 nextiv=46, nextv=47, nvdflt=50, oldn=38, parprt=20, - 3 parsav=49, perm=58, prunit=21, vneed=4) - save big, machep, tiny -c/ -c - data big/0.d+0/, machep/-1.d+0/, tiny/1.d+0/, zero/0.d+0/ -c/6 -c data vn(1,1),vn(2,1)/4hepsl,4hon../ -c data vn(1,2),vn(2,2)/4hphmn,4hfc../ -c data vn(1,3),vn(2,3)/4hphmx,4hfc../ -c data vn(1,4),vn(2,4)/4hdecf,4hac../ -c data vn(1,5),vn(2,5)/4hincf,4hac../ -c data vn(1,6),vn(2,6)/4hrdfc,4hmn../ -c data vn(1,7),vn(2,7)/4hrdfc,4hmx../ -c data vn(1,8),vn(2,8)/4htune,4hr1../ -c data vn(1,9),vn(2,9)/4htune,4hr2../ -c data vn(1,10),vn(2,10)/4htune,4hr3../ -c data vn(1,11),vn(2,11)/4htune,4hr4../ -c data vn(1,12),vn(2,12)/4htune,4hr5../ -c data vn(1,13),vn(2,13)/4hafct,4hol../ -c data vn(1,14),vn(2,14)/4hrfct,4hol../ -c data vn(1,15),vn(2,15)/4hxcto,4hl.../ -c data vn(1,16),vn(2,16)/4hxfto,4hl.../ -c data vn(1,17),vn(2,17)/4hlmax,4h0.../ -c data vn(1,18),vn(2,18)/4hlmax,4hs.../ -c data vn(1,19),vn(2,19)/4hscto,4hl.../ -c data vn(1,20),vn(2,20)/4hdini,4ht.../ -c data vn(1,21),vn(2,21)/4hdtin,4hit../ -c data vn(1,22),vn(2,22)/4hd0in,4hit../ -c data vn(1,23),vn(2,23)/4hdfac,4h..../ -c data vn(1,24),vn(2,24)/4hdltf,4hdc../ -c data vn(1,25),vn(2,25)/4hdltf,4hdj../ -c data vn(1,26),vn(2,26)/4hdelt,4ha0../ -c data vn(1,27),vn(2,27)/4hfuzz,4h..../ -c data vn(1,28),vn(2,28)/4hrlim,4hit../ -c data vn(1,29),vn(2,29)/4hcosm,4hin../ -c data vn(1,30),vn(2,30)/4hhube,4hrc../ -c data vn(1,31),vn(2,31)/4hrspt,4hol../ -c data vn(1,32),vn(2,32)/4hsigm,4hin../ -c data vn(1,33),vn(2,33)/4heta0,4h..../ -c data vn(1,34),vn(2,34)/4hbias,4h..../ -c/7 - data vn(1,1),vn(2,1)/'epsl','on..'/ - data vn(1,2),vn(2,2)/'phmn','fc..'/ - data vn(1,3),vn(2,3)/'phmx','fc..'/ - data vn(1,4),vn(2,4)/'decf','ac..'/ - data vn(1,5),vn(2,5)/'incf','ac..'/ - data vn(1,6),vn(2,6)/'rdfc','mn..'/ - data vn(1,7),vn(2,7)/'rdfc','mx..'/ - data vn(1,8),vn(2,8)/'tune','r1..'/ - data vn(1,9),vn(2,9)/'tune','r2..'/ - data vn(1,10),vn(2,10)/'tune','r3..'/ - data vn(1,11),vn(2,11)/'tune','r4..'/ - data vn(1,12),vn(2,12)/'tune','r5..'/ - data vn(1,13),vn(2,13)/'afct','ol..'/ - data vn(1,14),vn(2,14)/'rfct','ol..'/ - data vn(1,15),vn(2,15)/'xcto','l...'/ - data vn(1,16),vn(2,16)/'xfto','l...'/ - data vn(1,17),vn(2,17)/'lmax','0...'/ - data vn(1,18),vn(2,18)/'lmax','s...'/ - data vn(1,19),vn(2,19)/'scto','l...'/ - data vn(1,20),vn(2,20)/'dini','t...'/ - data vn(1,21),vn(2,21)/'dtin','it..'/ - data vn(1,22),vn(2,22)/'d0in','it..'/ - data vn(1,23),vn(2,23)/'dfac','....'/ - data vn(1,24),vn(2,24)/'dltf','dc..'/ - data vn(1,25),vn(2,25)/'dltf','dj..'/ - data vn(1,26),vn(2,26)/'delt','a0..'/ - data vn(1,27),vn(2,27)/'fuzz','....'/ - data vn(1,28),vn(2,28)/'rlim','it..'/ - data vn(1,29),vn(2,29)/'cosm','in..'/ - data vn(1,30),vn(2,30)/'hube','rc..'/ - data vn(1,31),vn(2,31)/'rspt','ol..'/ - data vn(1,32),vn(2,32)/'sigm','in..'/ - data vn(1,33),vn(2,33)/'eta0','....'/ - data vn(1,34),vn(2,34)/'bias','....'/ -c/ -c - data vm(1)/1.0d-3/, vm(2)/-0.99d+0/, vm(3)/1.0d-3/, vm(4)/1.0d-2/, - 1 vm(5)/1.2d+0/, vm(6)/1.d-2/, vm(7)/1.2d+0/, vm(8)/0.d+0/, - 2 vm(9)/0.d+0/, vm(10)/1.d-3/, vm(11)/-1.d+0/, vm(13)/0.d+0/, - 3 vm(15)/0.d+0/, vm(16)/0.d+0/, vm(19)/0.d+0/, vm(20)/-10.d+0/, - 4 vm(21)/0.d+0/, vm(22)/0.d+0/, vm(23)/0.d+0/, vm(27)/1.01d+0/, - 5 vm(28)/1.d+10/, vm(30)/0.d+0/, vm(31)/0.d+0/, vm(32)/0.d+0/, - 6 vm(34)/0.d+0/ - data vx(1)/0.9d+0/, vx(2)/-1.d-3/, vx(3)/1.d+1/, vx(4)/0.8d+0/, - 1 vx(5)/1.d+2/, vx(6)/0.8d+0/, vx(7)/1.d+2/, vx(8)/0.5d+0/, - 2 vx(9)/0.5d+0/, vx(10)/1.d+0/, vx(11)/1.d+0/, vx(14)/0.1d+0/, - 3 vx(15)/1.d+0/, vx(16)/1.d+0/, vx(19)/1.d+0/, vx(23)/1.d+0/, - 4 vx(24)/1.d+0/, vx(25)/1.d+0/, vx(26)/1.d+0/, vx(27)/1.d+10/, - 5 vx(29)/1.d+0/, vx(31)/1.d+0/, vx(32)/1.d+0/, vx(33)/1.d+0/, - 6 vx(34)/1.d+0/ -c -c/6 -c data varnm(1)/1hp/, varnm(2)/1hn/, sh(1)/1hs/, sh(2)/1hh/ -c data cngd(1),cngd(2),cngd(3)/4h---c,4hhang,4hed v/, -c 1 dflt(1),dflt(2),dflt(3)/4hnond,4hefau,4hlt v/ -c/7 - data varnm(1)/'p'/, varnm(2)/'n'/, sh(1)/'s'/, sh(2)/'h'/ - data cngd(1),cngd(2),cngd(3)/'---c','hang','ed v'/, - 1 dflt(1),dflt(2),dflt(3)/'nond','efau','lt v'/ -c/ - data ijmp/33/, jlim(1)/0/, jlim(2)/24/, ndflt(1)/32/, ndflt(2)/25/ - data miniv(1)/80/, miniv(2)/59/ -c -c............................... body ................................ -c - pu = 0 - if (prunit .le. liv) pu = iv(prunit) - if (alg .lt. 1 .or. alg .gt. 2) go to 340 - if (iv(1) .eq. 0) call deflt(alg, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .ne. 13 .and. iv1 .ne. 12) go to 10 - miv1 = miniv(alg) - if (perm .le. liv) miv1 = max0(miv1, iv(perm) - 1) - if (ivneed .le. liv) miv2 = miv1 + max0(iv(ivneed), 0) - if (lastiv .le. liv) iv(lastiv) = miv2 - if (liv .lt. miv1) go to 300 - iv(ivneed) = 0 - iv(lastv) = max0(iv(vneed), 0) + iv(lmat) - 1 - iv(vneed) = 0 - if (liv .lt. miv2) go to 300 - if (lv .lt. iv(lastv)) go to 320 - 10 if (alg .eq. iv(algsav)) go to 30 - if (pu .ne. 0) write(pu,20) alg, iv(algsav) - 20 format(/39h the first parameter to deflt should be,i3, - 1 12h rather than,i3) - iv(1) = 82 - go to 999 - 30 if (iv1 .lt. 12 .or. iv1 .gt. 14) go to 60 - if (n .ge. 1) go to 50 - iv(1) = 81 - if (pu .eq. 0) go to 999 - write(pu,40) varnm(alg), n - 40 format(/8h /// bad,a1,2h =,i5) - go to 999 - 50 if (iv1 .ne. 14) iv(nextiv) = iv(perm) - if (iv1 .ne. 14) iv(nextv) = iv(lmat) - if (iv1 .eq. 13) go to 999 - k = iv(parsav) - epslon - call vdflt(alg, lv-k, v(k+1)) - iv(dtype0) = 2 - alg - iv(oldn) = n - which(1) = dflt(1) - which(2) = dflt(2) - which(3) = dflt(3) - go to 110 - 60 if (n .eq. iv(oldn)) go to 80 - iv(1) = 17 - if (pu .eq. 0) go to 999 - write(pu,70) varnm(alg), iv(oldn), n - 70 format(/5h /// ,1a1,14h changed from ,i5,4h to ,i5) - go to 999 -c - 80 if (iv1 .le. 11 .and. iv1 .ge. 1) go to 100 - iv(1) = 80 - if (pu .ne. 0) write(pu,90) iv1 - 90 format(/13h /// iv(1) =,i5,28h should be between 0 and 14.) - go to 999 -c - 100 which(1) = cngd(1) - which(2) = cngd(2) - which(3) = cngd(3) -c - 110 if (iv1 .eq. 14) iv1 = 12 - if (big .gt. tiny) go to 120 - tiny = rmdcon(1) - machep = rmdcon(3) - big = rmdcon(6) - vm(12) = machep - vx(12) = big - vx(13) = big - vm(14) = machep - vm(17) = tiny - vx(17) = big - vm(18) = tiny - vx(18) = big - vx(20) = big - vx(21) = big - vx(22) = big - vm(24) = machep - vm(25) = machep - vm(26) = machep - vx(28) = rmdcon(5) - vm(29) = machep - vx(30) = big - vm(33) = machep - 120 m = 0 - i = 1 - j = jlim(alg) - k = epslon - ndfalt = ndflt(alg) - do 150 l = 1, ndfalt - vk = v(k) - if (vk .ge. vm(i) .and. vk .le. vx(i)) go to 140 - m = k - if (pu .ne. 0) write(pu,130) vn(1,i), vn(2,i), k, vk, - 1 vm(i), vx(i) - 130 format(/6h /// ,2a4,5h.. v(,i2,3h) =,d11.3,7h should, - 1 11h be between,d11.3,4h and,d11.3) - 140 k = k + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 150 continue -c - if (iv(nvdflt) .eq. ndfalt) go to 170 - iv(1) = 51 - if (pu .eq. 0) go to 999 - write(pu,160) iv(nvdflt), ndfalt - 160 format(/13h iv(nvdflt) =,i5,13h rather than ,i5) - go to 999 - 170 if ((iv(dtype) .gt. 0 .or. v(dinit) .gt. zero) .and. iv1 .eq. 12) - 1 go to 200 - do 190 i = 1, n - if (d(i) .gt. zero) go to 190 - m = 18 - if (pu .ne. 0) write(pu,180) i, d(i) - 180 format(/8h /// d(,i3,3h) =,d11.3,19h should be positive) - 190 continue - 200 if (m .eq. 0) go to 210 - iv(1) = m - go to 999 -c - 210 if (pu .eq. 0 .or. iv(parprt) .eq. 0) go to 999 - if (iv1 .ne. 12 .or. iv(inits) .eq. alg-1) go to 230 - m = 1 - write(pu,220) sh(alg), iv(inits) - 220 format(/22h nondefault values..../5h init,a1,14h..... iv(25) =, - 1 i3) - 230 if (iv(dtype) .eq. iv(dtype0)) go to 250 - if (m .eq. 0) write(pu,260) which - m = 1 - write(pu,240) iv(dtype) - 240 format(20h dtype..... iv(16) =,i3) - 250 i = 1 - j = jlim(alg) - k = epslon - l = iv(parsav) - ndfalt = ndflt(alg) - do 290 ii = 1, ndfalt - if (v(k) .eq. v(l)) go to 280 - if (m .eq. 0) write(pu,260) which - 260 format(/1h ,3a4,9halues..../) - m = 1 - write(pu,270) vn(1,i), vn(2,i), k, v(k) - 270 format(1x,2a4,5h.. v(,i2,3h) =,d15.7) - 280 k = k + 1 - l = l + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 290 continue -c - iv(dtype0) = iv(dtype) - parsv1 = iv(parsav) - call vcopy(iv(nvdflt), v(parsv1), v(epslon)) - go to 999 -c - 300 iv(1) = 15 - if (pu .eq. 0) go to 999 - write(pu,310) liv, miv2 - 310 format(/10h /// liv =,i5,17h must be at least,i5) - if (liv .lt. miv1) go to 999 - if (lv .lt. iv(lastv)) go to 320 - go to 999 -c - 320 iv(1) = 16 - if (pu .eq. 0) go to 999 - write(pu,330) lv, iv(lastv) - 330 format(/9h /// lv =,i5,17h must be at least,i5) - go to 999 -c - 340 iv(1) = 67 - if (pu .eq. 0) go to 999 - write(pu,350) alg - 350 format(/10h /// alg =,i5,15h must be 1 or 2) -c - 999 return -c *** last card of parck follows *** - end - double precision function reldst(p, d, x, x0) -c -c *** compute and return relative difference between x and x0 *** -c *** nl2sol version 2.2 *** -c - integer p - double precision d(p), x(p), x0(p) -c/+ - double precision dabs -c/ - integer i - double precision emax, t, xmax, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - emax = zero - xmax = zero - do 10 i = 1, p - t = dabs(d(i) * (x(i) - x0(i))) - if (emax .lt. t) emax = t - t = d(i) * (dabs(x(i)) + dabs(x0(i))) - if (xmax .lt. t) xmax = t - 10 continue - reldst = zero - if (xmax .gt. zero) reldst = emax / xmax - 999 return -c *** last card of reldst follows *** - end -c logical function stopx(idummy) -c *****parameters... -c integer idummy -c -c .................................................................. -c -c *****purpose... -c this function may serve as the stopx (asynchronous interruption) -c function for the nl2sol (nonlinear least-squares) package at -c those installations which do not wish to implement a -c dynamic stopx. -c -c *****algorithm notes... -c at installations where the nl2sol system is used -c interactively, this dummy stopx should be replaced by a -c function that returns .true. if and only if the interrupt -c (break) key has been pressed since the last call on stopx. -c -c .................................................................. -c -c stopx = .false. -c return -c end - subroutine vaxpy(p, w, a, x, y) -c -c *** set w = a*x + y -- w, x, y = p-vectors, a = scalar *** -c - integer p - double precision a, w(p), x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 w(i) = a*x(i) + y(i) - return - end - subroutine vcopy(p, y, x) -c -c *** set y = x, where x and y are p-vectors *** -c - integer p - double precision x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = x(i) - return - end - subroutine vdflt(alg, lv, v) -c -c *** supply ***sol (version 2.3) default values to v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer alg, l - double precision v(lv) -c/+ - double precision dmax1 -c/ - external rmdcon - double precision rmdcon -c rmdcon... returns machine-dependent constants -c - double precision machep, mepcrt, one, sqteps, three -c -c *** subscripts for v *** -c - integer afctol, bias, cosmin, decfac, delta0, dfac, dinit, dltfdc, - 1 dltfdj, dtinit, d0init, epslon, eta0, fuzz, huberc, - 2 incfac, lmax0, lmaxs, phmnfc, phmxfc, rdfcmn, rdfcmx, - 3 rfctol, rlimit, rsptol, sctol, sigmin, tuner1, tuner2, - 4 tuner3, tuner4, tuner5, xctol, xftol -c -c/6 -c data one/1.d+0/, three/3.d+0/ -c/7 - parameter (one=1.d+0, three=3.d+0) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/, bias/43/, cosmin/47/, decfac/22/, delta0/44/, -c 1 dfac/41/, dinit/38/, dltfdc/42/, dltfdj/43/, dtinit/39/, -c 2 d0init/40/, epslon/19/, eta0/42/, fuzz/45/, huberc/48/, -c 3 incfac/23/, lmax0/35/, lmaxs/36/, phmnfc/20/, phmxfc/21/, -c 4 rdfcmn/24/, rdfcmx/25/, rfctol/32/, rlimit/46/, rsptol/49/, -c 5 sctol/37/, sigmin/50/, tuner1/26/, tuner2/27/, tuner3/28/, -c 6 tuner4/29/, tuner5/30/, xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, bias=43, cosmin=47, decfac=22, delta0=44, - 1 dfac=41, dinit=38, dltfdc=42, dltfdj=43, dtinit=39, - 2 d0init=40, epslon=19, eta0=42, fuzz=45, huberc=48, - 3 incfac=23, lmax0=35, lmaxs=36, phmnfc=20, phmxfc=21, - 4 rdfcmn=24, rdfcmx=25, rfctol=32, rlimit=46, rsptol=49, - 5 sctol=37, sigmin=50, tuner1=26, tuner2=27, tuner3=28, - 6 tuner4=29, tuner5=30, xctol=33, xftol=34) -c/ -c -c------------------------------- body -------------------------------- -c - machep = rmdcon(3) - v(afctol) = 1.d-20 - if (machep .gt. 1.d-10) v(afctol) = machep**2 - v(decfac) = 0.5d+0 - sqteps = rmdcon(4) - v(dfac) = 0.6d+0 - v(delta0) = sqteps - v(dtinit) = 1.d-6 - mepcrt = machep ** (one/three) - v(d0init) = 1.d+0 - v(epslon) = 0.1d+0 - v(incfac) = 2.d+0 - v(lmax0) = 1.d+0 - v(lmaxs) = 1.d+0 - v(phmnfc) = -0.1d+0 - v(phmxfc) = 0.1d+0 - v(rdfcmn) = 0.1d+0 - v(rdfcmx) = 4.d+0 - v(rfctol) = dmax1(1.d-10, mepcrt**2) - v(sctol) = v(rfctol) - v(tuner1) = 0.1d+0 - v(tuner2) = 1.d-4 - v(tuner3) = 0.75d+0 - v(tuner4) = 0.5d+0 - v(tuner5) = 0.75d+0 - v(xctol) = sqteps - v(xftol) = 1.d+2 * machep -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - v(cosmin) = dmax1(1.d-6, 1.d+2 * machep) - v(dinit) = 0.d+0 - v(dltfdc) = mepcrt - v(dltfdj) = sqteps - v(fuzz) = 1.5d+0 - v(huberc) = 0.7d+0 - v(rlimit) = rmdcon(5) - v(rsptol) = 1.d-3 - v(sigmin) = 1.d-4 - go to 999 -c -c *** general optimization values -c - 10 v(bias) = 0.8d+0 - v(dinit) = -1.0d+0 - v(eta0) = 1.0d+3 * machep -c - 999 return -c *** last card of vdflt follows *** - end - subroutine vscopy(p, y, s) -c -c *** set p-vector y to scalar s *** -c - integer p - double precision s, y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = s - return - end - double precision function v2norm(p, x) -c -c *** return the 2-norm of the p-vector x, taking *** -c *** care to avoid the most likely underflows. *** -c - integer p - double precision x(p) -c - integer i, j - double precision one, r, scale, sqteta, t, xi, zero -c/+ - double precision dabs, dsqrt -c/ - external rmdcon - double precision rmdcon -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - save sqteta -c/ - data sqteta/0.d+0/ -c - if (p .gt. 0) go to 10 - v2norm = zero - go to 999 - 10 do 20 i = 1, p - if (x(i) .ne. zero) go to 30 - 20 continue - v2norm = zero - go to 999 -c - 30 scale = dabs(x(i)) - if (i .lt. p) go to 40 - v2norm = scale - go to 999 - 40 t = one - if (sqteta .eq. zero) sqteta = rmdcon(2) -c -c *** sqteta is (slightly larger than) the square root of the -c *** smallest positive floating point number on the machine. -c *** the tests involving sqteta are done to prevent underflows. -c - j = i + 1 - do 60 i = j, p - xi = dabs(x(i)) - if (xi .gt. scale) go to 50 - r = xi / scale - if (r .gt. sqteta) t = t + r*r - go to 60 - 50 r = scale / xi - if (r .le. sqteta) r = zero - t = one + t * r*r - scale = xi - 60 continue -c - v2norm = scale * dsqrt(t) - 999 return -c *** last card of v2norm follows *** - end - subroutine humsl(n, d, x, calcf, calcgh, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** (analytic) gradient and hessian provided by the caller. *** -c - integer liv, lv, n - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(78 + n*(n+12)), uiparm(*), urparm(*) - external calcf, calcgh, ufparm -c -c------------------------------ discussion --------------------------- -c -c this routine is like sumsl, except that the subroutine para- -c meter calcg of sumsl (which computes the gradient of the objec- -c tive function) is replaced by the subroutine parameter calcgh, -c which computes both the gradient and (lower triangle of the) -c hessian of the objective function. the calling sequence is... -c call calcgh(n, x, nf, g, h, uiparm, urparm, ufparm) -c parameters n, x, nf, g, uiparm, urparm, and ufparm are the same -c as for sumsl, while h is an array of length n*(n+1)/2 in which -c calcgh must store the lower triangle of the hessian at x. start- -c ing at h(1), calcgh must store the hessian entries in the order -c (1,1), (2,1), (2,2), (3,1), (3,2), (3,3), ... -c the value printed (by itsum) in the column labelled stppar -c is the levenberg-marquardt used in computing the current step. -c zero means a full newton step. if the special case described in -c ref. 1 is detected, then stppar is negated. the value printed -c in the column labelled npreldf is zero if the current hessian -c is not positive definite. -c it sometimes proves worthwhile to let d be determined from the -c diagonal of the hessian matrix by setting iv(dtype) = 1 and -c v(dinit) = 0. the following iv and v components are relevant... -c -c iv(dtol)..... iv(59) gives the starting subscript in v of the dtol -c array used when d is updated. (iv(dtol) can be -c initialized by calling humsl with iv(1) = 13.) -c iv(dtype).... iv(16) tells how the scale vector d should be chosen. -c iv(dtype) .le. 0 means that d should not be updated, and -c iv(dtype) .ge. 1 means that d should be updated as -c described below with v(dfac). default = 0. -c v(dfac)..... v(41) and the dtol and d0 arrays (see v(dtinit) and -c v(d0init)) are used in updating the scale vector d when -c iv(dtype) .gt. 0. (d is initialized according to -c v(dinit), described in sumsl.) let -c d1(i) = max(sqrt(abs(h(i,i))), v(dfac)*d(i)), -c where h(i,i) is the i-th diagonal element of the current -c hessian. if iv(dtype) = 1, then d(i) is set to d1(i) -c unless d1(i) .lt. dtol(i), in which case d(i) is set to -c max(d0(i), dtol(i)). -c if iv(dtype) .ge. 2, then d is updated during the first -c iteration as for iv(dtype) = 1 (after any initialization -c due to v(dinit)) and is left unchanged thereafter. -c default = 0.6. -c v(dtinit)... v(39), if positive, is the value to which all components -c of the dtol array (see v(dfac)) are initialized. if -c v(dtinit) = 0, then it is assumed that the caller has -c stored dtol in v starting at v(iv(dtol)). -c default = 10**-6. -c v(d0init)... v(40), if positive, is the value to which all components -c of the d0 vector (see v(dfac)) are initialized. if -c v(dfac) = 0, then it is assumed that the caller has -c stored d0 in v starting at v(iv(dtol)+n). default = 1.0. -c -c *** reference *** -c -c 1. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. comput. 2, pp. 186-197. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c---------------------------- declarations --------------------------- -c - external deflt, humit -c -c deflt... provides default input values for iv and v. -c humit... reverse-communication routine that does humsl algorithm. -c - integer g1, h1, iv1, lh, nf - double precision f -c -c *** subscripts for iv *** -c - integer g, h, nextv, nfcall, nfgcal, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, h/56/, toobig/2/, -c 1 vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, h=56, toobig=2, - 1 vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - lh = n * (n + 1) / 2 - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+3)/2 - iv1 = iv(1) - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - h1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) - h1 = iv(h) -c - 20 call humit(d, f, v(g1), v(h1), iv, lh, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcgh(n, x, iv(nfgcal), v(g1), v(h1), uiparm, urparm, - 1 ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(h) = iv(g) + n - iv(nextv) = iv(h) + n*(n+1)/2 - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of humsl follows *** - end - subroutine humit(d, fx, g, h, iv, lh, liv, lv, n, v, x) -c -c *** carry out humsl (unconstrained minimization) iterations, using -c *** hessian matrix provided by the caller. -c -c *** parameter declarations *** -c - integer lh, liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), h(lh), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c h.... lower triangle of the hessian, stored rowwise. -c iv... integer value array. -c lh... length of h = p*(p+1)/2. -c liv.. length of iv (at least 60). -c lv... length of v (at least 78 + n*(n+21)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... parameter vector. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to humsl (which see), except that v can be shorter (since -c the part of v that humsl uses for storing g and h is not needed). -c moreover, compared with humsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from humsl, is not referenced by humit or the -c subroutines it calls. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call humit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c computed (e.g. if overflow would occur), which may happen -c because of an oversized step. in this case the caller -c should set iv(toobig) = iv(2) to 1, which will cause -c humit to ignore fx and try a smaller step. the para- -c meter nf that humsl passes to calcf (for possible use by -c calcgh) is a copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient of f at -c x, and h to the lower triangle of h(x), the hessian of f -c at x, and call humit again, having changed none of the -c other parameters except perhaps the scale vector d. -c the parameter nf that humsl passes to calcg is -c iv(nfgcal) = iv(7). if g(x) and h(x) cannot be evaluated, -c then the caller may set iv(nfgcal) to 0, in which case -c humit will return with iv(1) = 65. -c note -- humit overwrites h with the lower triangle -c of diag(d)**-1 * h(x) * diag(d)**-1. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl and humsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, i, j, k, l, lstgst, nn1o2, step1, - 1 temp1, w1, x01 - double precision t -c -c *** constants *** -c - double precision one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, deflt, dotprd, dupdu, gqtst, itsum, parck, - 1 reldst, slvmul, stopx, vaxpy, vcopy, vscopy, v2norm - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c deflt.... provides default iv and v input values. -c dotprd... returns inner product of two vectors. -c dupdu.... updates scale vector d. -c gqtst.... computes optimally locally constrained step. -c itsum.... prints iteration summary and info on initial and final x. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c slvmul... multiplies symmetric matrix times vector, given the lower -c triangle of the matrix. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c v2norm... returns the 2-norm of a vector. -c -c *** subscripts for iv and v *** -c - integer cnvcod, dg, dgnorm, dinit, dstnrm, dtinit, dtol, - 1 dtype, d0init, f, f0, fdif, gtstep, incfac, irc, kagqt, - 2 lmat, lmax0, lmaxs, mode, model, mxfcal, mxiter, nextv, - 3 nfcall, nfgcal, ngcall, niter, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, stppar, - 5 toobig, tuner4, tuner5, vneed, w, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, dtol/59/, dtype/16/, irc/29/, kagqt/33/, -c 1 lmat/42/, mode/35/, model/5/, mxfcal/17/, mxiter/18/, -c 2 nextv/47/, nfcall/6/, nfgcal/7/, ngcall/30/, niter/31/, -c 3 radinc/8/, restor/9/, step/40/, stglim/11/, stlstg/41/, -c 4 toobig/2/, vneed/4/, w/34/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, dtol=59, dtype=16, irc=29, kagqt=33, - 1 lmat=42, mode=35, model=5, mxfcal=17, mxiter=18, - 2 nextv=47, nfcall=6, nfgcal=7, ngcall=30, niter=31, - 3 radinc=8, restor=9, step=40, stglim=11, stlstg=41, - 4 toobig=2, vneed=4, w=34, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data dgnorm/1/, dinit/38/, dstnrm/2/, dtinit/39/, d0init/40/, -c 1 f/10/, f0/13/, fdif/11/, gtstep/4/, incfac/23/, lmax0/35/, -c 2 lmaxs/36/, preduc/7/, radfac/16/, radius/8/, rad0/9/, -c 3 reldx/17/, stppar/5/, tuner4/29/, tuner5/30/ -c/7 - parameter (dgnorm=1, dinit=38, dstnrm=2, dtinit=39, d0init=40, - 1 f=10, f0=13, fdif=11, gtstep=4, incfac=23, lmax0=35, - 2 lmaxs=36, preduc=7, radfac=16, radius=8, rad0=9, - 3 reldx=17, stppar=5, tuner4=29, tuner5=30) -c/ -c -c/6 -c data one/1.d+0/, onep2/1.2d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, onep2=1.2d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - i = iv(1) - if (i .eq. 1) go to 30 - if (i .eq. 2) go to 40 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+21)/2 + 7 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - nn1o2 = n * (n + 1) / 2 - if (lh .ge. nn1o2) go to (210,210,210,210,210,210,160,120,160, - 1 10,10,20), i - iv(1) = 66 - go to 350 -c -c *** storage allocation *** -c - 10 iv(dtol) = iv(lmat) + nn1o2 - iv(x0) = iv(dtol) + 2*n - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(dg) = iv(stlstg) + n - iv(w) = iv(dg) + n - iv(nextv) = iv(w) + 4*n + 7 - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - v(stppar) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - k = iv(dtol) - if (v(dtinit) .gt. zero) call vscopy(n, v(k), v(dtinit)) - k = k + n - if (v(d0init) .gt. zero) call vscopy(n, v(k), v(d0init)) - iv(1) = 1 - go to 999 -c - 30 v(f) = fx - if (iv(mode) .ge. 0) go to 210 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 350 -c -c *** make sure gradient could be computed *** -c - 40 if (iv(nfgcal) .ne. 0) go to 50 - iv(1) = 65 - go to 350 -c -c *** update the scale vector d *** -c - 50 dg1 = iv(dg) - if (iv(dtype) .le. 0) go to 70 - k = dg1 - j = 0 - do 60 i = 1, n - j = j + i - v(k) = h(j) - k = k + 1 - 60 continue - call dupdu(d, v(dg1), iv, liv, lv, n, v) -c -c *** compute scaled gradient and its norm *** -c - 70 dg1 = iv(dg) - k = dg1 - do 80 i = 1, n - v(k) = g(i) / d(i) - k = k + 1 - 80 continue - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** compute scaled hessian *** -c - k = 1 - do 100 i = 1, n - t = one / d(i) - do 90 j = 1, i - h(k) = t * h(k) / d(j) - k = k + 1 - 90 continue - 100 continue -c - if (iv(cnvcod) .ne. 0) go to 340 - if (iv(mode) .eq. 0) go to 300 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 110 call itsum(d, g, iv, liv, lv, n, v, x) - 120 k = iv(niter) - if (k .lt. iv(mxiter)) go to 130 - iv(1) = 10 - go to 350 -c - 130 iv(niter) = k + 1 -c -c *** initialize for start of next iteration *** -c - dg1 = iv(dg) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0 *** -c - call vcopy(n, v(x01), x) -c -c *** update radius *** -c - if (k .eq. 0) go to 150 - step1 = iv(step) - k = step1 - do 140 i = 1, n - v(k) = d(i) * v(k) - k = k + 1 - 140 continue - v(radius) = v(radfac) * v2norm(n, v(step1)) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 150 if (.not. stopx(dummy)) go to 170 - iv(1) = 11 - go to 180 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 160 if (v(f) .ge. v(f0)) go to 170 - v(radfac) = one - k = iv(niter) - go to 130 -c - 170 if (iv(nfcall) .lt. iv(mxfcal)) go to 190 - iv(1) = 9 - 180 if (v(f) .ge. v(f0)) go to 350 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 290 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 190 step1 = iv(step) - dg1 = iv(dg) - l = iv(lmat) - w1 = iv(w) - call gqtst(d, v(dg1), h, iv(kagqt), v(l), n, v(step1), v, v(w1)) - if (iv(irc) .eq. 6) go to 210 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 210 - if (iv(irc) .ne. 5) go to 200 - if (v(radfac) .le. one) go to 200 - if (v(preduc) .le. onep2 * v(fdif)) go to 210 -c -c *** compute f(x0 + step) *** -c - 200 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 210 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 220 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 220 k = iv(irc) - go to (230,260,260,260,230,240,250,250,250,250,250,250,330,300), k -c -c *** recompute step with new radius *** -c - 230 v(radius) = v(radfac) * v(dstnrm) - go to 150 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 240 v(radius) = v(lmaxs) - go to 190 -c -c *** convergence or false convergence *** -c - 250 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 340 - if (iv(xirc) .eq. 14) go to 340 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 260 if (iv(irc) .ne. 3) go to 290 - temp1 = lstgst -c -c *** prepare for gradient tests *** -c *** set temp1 = hessian * step + g(x0) -c *** = diag(d) * (h * step + g(x0)) -c -c use x0 vector as temporary. - k = x01 - do 270 i = 1, n - v(k) = d(i) * v(step1) - k = k + 1 - step1 = step1 + 1 - 270 continue - call slvmul(n, v(temp1), h, v(x01)) - do 280 i = 1, n - v(temp1) = d(i) * v(temp1) + g(i) - temp1 = temp1 + 1 - 280 continue -c -c *** compute gradient and hessian *** -c - 290 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c - 300 iv(1) = 2 - if (iv(irc) .ne. 3) go to 110 -c -c *** set v(radfac) by gradient tests *** -c - temp1 = iv(stlstg) - step1 = iv(step) -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - k = temp1 - do 310 i = 1, n - v(k) = (v(k) - g(i)) / d(i) - k = k + 1 - 310 continue -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) go to 320 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 110 - 320 v(radfac) = v(incfac) - go to 110 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 330 iv(1) = 64 - go to 350 -c -c *** print summary of final iteration and other requested items *** -c - 340 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 350 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last card of humit follows *** - end - subroutine dupdu(d, hdiag, iv, liv, lv, n, v) -c -c *** update scale vector d for humsl *** -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), hdiag(n), v(lv) -c -c *** local variables *** -c - integer dtoli, d0i, i - double precision t, vdfac -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dsqrt -c/ -c *** subscripts for iv and v *** -c - integer dfac, dtol, dtype, niter -c/6 -c data dfac/41/, dtol/59/, dtype/16/, niter/31/ -c/7 - parameter (dfac=41, dtol=59, dtype=16, niter=31) -c/ -c -c------------------------------- body -------------------------------- -c - i = iv(dtype) - if (i .eq. 1) go to 10 - if (iv(niter) .gt. 0) go to 999 -c - 10 dtoli = iv(dtol) - d0i = dtoli + n - vdfac = v(dfac) - do 20 i = 1, n - t = dmax1(dsqrt(dabs(hdiag(i))), vdfac*d(i)) - if (t .lt. v(dtoli)) t = dmax1(v(dtoli), v(d0i)) - d(i) = t - dtoli = dtoli + 1 - d0i = d0i + 1 - 20 continue -c - 999 return -c *** last card of dupdu follows *** - end - subroutine gqtst(d, dig, dihdi, ka, l, p, step, v, w) -c -c *** compute goldfeld-quandt-trotter step by more-hebden technique *** -c *** (nl2sol version 2.2), modified a la more and sorensen *** -c -c *** parameter declarations *** -c - integer ka, p -cal double precision d(p), dig(p), dihdi(1), l(1), v(21), step(p), -cal 1 w(1) - double precision d(p), dig(p), dihdi(p*(p+1)/2), l(p*(p+1)/2), - 1 v(21), step(p),w(4*p+7) -c dimension dihdi(p*(p+1)/2), l(p*(p+1)/2), w(4*p+7) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c given the (compactly stored) lower triangle of a scaled -c hessian (approximation) and a nonzero scaled gradient vector, -c this subroutine computes a goldfeld-quandt-trotter step of -c approximate length v(radius) by the more-hebden technique. in -c other words, step is computed to (approximately) minimize -c psi(step) = (g**t)*step + 0.5*(step**t)*h*step such that the -c 2-norm of d*step is at most (approximately) v(radius), where -c g is the gradient, h is the hessian, and d is a diagonal -c scale matrix whose diagonal is stored in the parameter d. -c (gqtst assumes dig = d**-1 * g and dihdi = d**-1 * h * d**-1.) -c -c *** parameter description *** -c -c d (in) = the scale vector, i.e. the diagonal of the scale -c matrix d mentioned above under purpose. -c dig (in) = the scaled gradient vector, d**-1 * g. if g = 0, then -c step = 0 and v(stppar) = 0 are returned. -c dihdi (in) = lower triangle of the scaled hessian (approximation), -c i.e., d**-1 * h * d**-1, stored compactly by rows., i.e., -c in the order (1,1), (2,1), (2,2), (3,1), (3,2), etc. -c ka (i/o) = the number of hebden iterations (so far) taken to deter- -c mine step. ka .lt. 0 on input means this is the first -c attempt to determine step (for the present dig and dihdi) -c -- ka is initialized to 0 in this case. output with -c ka = 0 (or v(stppar) = 0) means step = -(h**-1)*g. -c l (i/o) = workspace of length p*(p+1)/2 for cholesky factors. -c p (in) = number of parameters -- the hessian is a p x p matrix. -c step (i/o) = the step computed. -c v (i/o) contains various constants and variables described below. -c w (i/o) = workspace of length 4*p + 6. -c -c *** entries in v *** -c -c v(dgnorm) (i/o) = 2-norm of (d**-1)*g. -c v(dstnrm) (output) = 2-norm of d*step. -c v(dst0) (i/o) = 2-norm of d*(h**-1)*g (for pos. def. h only), or -c overestimate of smallest eigenvalue of (d**-1)*h*(d**-1). -c v(epslon) (in) = max. rel. error allowed for psi(step). for the -c step returned, psi(step) will exceed its optimal value -c by less than -v(epslon)*psi(step). suggested value = 0.1. -c v(gtstep) (out) = inner product between g and step. -c v(nreduc) (out) = psi(-(h**-1)*g) = psi(newton step) (for pos. def. -c h only -- v(nreduc) is set to zero otherwise). -c v(phmnfc) (in) = tol. (together with v(phmxfc)) for accepting step -c (more*s sigma). the error v(dstnrm) - v(radius) must lie -c between v(phmnfc)*v(radius) and v(phmxfc)*v(radius). -c v(phmxfc) (in) (see v(phmnfc).) -c suggested values -- v(phmnfc) = -0.25, v(phmxfc) = 0.5. -c v(preduc) (out) = psi(step) = predicted obj. func. reduction for step. -c v(radius) (in) = radius of current (scaled) trust region. -c v(rad0) (i/o) = value of v(radius) from previous call. -c v(stppar) (i/o) is normally the marquardt parameter, i.e. the alpha -c described below under algorithm notes. if h + alpha*d**2 -c (see algorithm notes) is (nearly) singular, however, -c then v(stppar) = -alpha. -c -c *** usage notes *** -c -c if it is desired to recompute step using a different value of -c v(radius), then this routine may be restarted by calling it -c with all parameters unchanged except v(radius). (this explains -c why step and w are listed as i/o). on an initial call (one with -c ka .lt. 0), step and w need not be initialized and only compo- -c nents v(epslon), v(stppar), v(phmnfc), v(phmxfc), v(radius), and -c v(rad0) of v must be initialized. -c -c *** algorithm notes *** -c -c the desired g-q-t step (ref. 2, 3, 4, 6) satisfies -c (h + alpha*d**2)*step = -g for some nonnegative alpha such that -c h + alpha*d**2 is positive semidefinite. alpha and step are -c computed by a scheme analogous to the one described in ref. 5. -c estimates of the smallest and largest eigenvalues of the hessian -c are obtained from the gerschgorin circle theorem enhanced by a -c simple form of the scaling described in ref. 7. cases in which -c h + alpha*d**2 is nearly (or exactly) singular are handled by -c the technique discussed in ref. 2. in these cases, a step of -c (exact) length v(radius) is returned for which psi(step) exceeds -c its optimal value by less than -v(epslon)*psi(step). the test -c suggested in ref. 6 for detecting the special case is performed -c once two matrix factorizations have been done -- doing so sooner -c seems to degrade the performance of optimization routines that -c call this routine. -c -c *** functions and subroutines called *** -c -c dotprd - returns inner product of two vectors. -c litvmu - applies inverse-transpose of compact lower triang. matrix. -c livmul - applies inverse of compact lower triang. matrix. -c lsqrt - finds cholesky factor (of compactly stored lower triang.). -c lsvmin - returns approx. to min. sing. value of lower triang. matrix. -c rmdcon - returns machine-dependent constants. -c v2norm - returns 2-norm of a vector. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), an adaptive -c nonlinear least-squares algorithm, acm trans. math. -c software, vol. 7, no. 3. -c 2. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. computing, vol. 2, no. 2, pp. -c 186-197. -c 3. goldfeld, s.m., quandt, r.e., and trotter, h.f. (1966), -c maximization by quadratic hill-climbing, econometrica 34, -c pp. 541-551. -c 4. hebden, m.d. (1973), an algorithm for minimization using exact -c second derivatives, report t.p. 515, theoretical physics -c div., a.e.r.e. harwell, oxon., england. -c 5. more, j.j. (1978), the levenberg-marquardt algorithm, implemen- -c tation and theory, pp.105-116 of springer lecture notes -c in mathematics no. 630, edited by g.a. watson, springer- -c verlag, berlin and new york. -c 6. more, j.j., and sorensen, d.c. (1981), computing a trust region -c step, technical report anl-81-83, argonne national lab. -c 7. varga, r.s. (1965), minimal gerschgorin sets, pacific j. math. 15, -c pp. 719-729. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - logical restrt - integer dggdmx, diag, diag0, dstsav, emax, emin, i, im1, inc, irc, - 1 j, k, kalim, kamin, k1, lk0, phipin, q, q0, uk0, x - double precision alphak, aki, akk, delta, dst, eps, gtsta, lk, - 1 oldphi, phi, phimax, phimin, psifac, rad, radsq, - 2 root, si, sk, sw, t, twopsi, t1, t2, uk, wi -c -c *** constants *** - double precision big, dgxfac, epsfac, four, half, kappa, negone, - 1 one, p001, six, three, two, zero -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dmin1, dsqrt -c/ -c *** external functions and subroutines *** -c - external dotprd, litvmu, livmul, lsqrt, lsvmin, rmdcon, v2norm - double precision dotprd, lsvmin, rmdcon, v2norm -c -c *** subscripts for v *** -c - integer dgnorm, dstnrm, dst0, epslon, gtstep, stppar, nreduc, - 1 phmnfc, phmxfc, preduc, radius, rad0 -c/6 -c data dgnorm/1/, dstnrm/2/, dst0/3/, epslon/19/, gtstep/4/, -c 1 nreduc/6/, phmnfc/20/, phmxfc/21/, preduc/7/, radius/8/, -c 2 rad0/9/, stppar/5/ -c/7 - parameter (dgnorm=1, dstnrm=2, dst0=3, epslon=19, gtstep=4, - 1 nreduc=6, phmnfc=20, phmxfc=21, preduc=7, radius=8, - 2 rad0=9, stppar=5) -c/ -c -c/6 -c data epsfac/50.0d+0/, four/4.0d+0/, half/0.5d+0/, -c 1 kappa/2.0d+0/, negone/-1.0d+0/, one/1.0d+0/, p001/1.0d-3/, -c 2 six/6.0d+0/, three/3.0d+0/, two/2.0d+0/, zero/0.0d+0/ -c/7 - parameter (epsfac=50.0d+0, four=4.0d+0, half=0.5d+0, - 1 kappa=2.0d+0, negone=-1.0d+0, one=1.0d+0, p001=1.0d-3, - 2 six=6.0d+0, three=3.0d+0, two=2.0d+0, zero=0.0d+0) - save dgxfac -c/ - data big/0.d+0/, dgxfac/0.d+0/ -c -c *** body *** -c -c *** store largest abs. entry in (d**-1)*h*(d**-1) at w(dggdmx). - dggdmx = p + 1 -c *** store gerschgorin over- and underestimates of the largest -c *** and smallest eigenvalues of (d**-1)*h*(d**-1) at w(emax) -c *** and w(emin) respectively. - emax = dggdmx + 1 - emin = emax + 1 -c *** for use in recomputing step, the final values of lk, uk, dst, -c *** and the inverse derivative of more*s phi at 0 (for pos. def. -c *** h) are stored in w(lk0), w(uk0), w(dstsav), and w(phipin) -c *** respectively. - lk0 = emin + 1 - phipin = lk0 + 1 - uk0 = phipin + 1 - dstsav = uk0 + 1 -c *** store diag of (d**-1)*h*(d**-1) in w(diag),...,w(diag0+p). - diag0 = dstsav - diag = diag0 + 1 -c *** store -d*step in w(q),...,w(q0+p). - q0 = diag0 + p - q = q0 + 1 -c *** allocate storage for scratch vector x *** - x = q + p - rad = v(radius) - radsq = rad**2 -c *** phitol = max. error allowed in dst = v(dstnrm) = 2-norm of -c *** d*step. - phimax = v(phmxfc) * rad - phimin = v(phmnfc) * rad - psifac = two * v(epslon) / (three * (four * (v(phmnfc) + one) * - 1 (kappa + one) + kappa + two) * rad**2) -c *** oldphi is used to detect limits of numerical accuracy. if -c *** we recompute step and it does not change, then we accept it. - oldphi = zero - eps = v(epslon) - irc = 0 - restrt = .false. - kalim = ka + 50 -c -c *** start or restart, depending on ka *** -c - if (ka .ge. 0) go to 290 -c -c *** fresh start *** -c - k = 0 - uk = negone - ka = 0 - kalim = 50 - v(dgnorm) = v2norm(p, dig) - v(nreduc) = zero - v(dst0) = zero - kamin = 3 - if (v(dgnorm) .eq. zero) kamin = 0 -c -c *** store diag(dihdi) in w(diag0+1),...,w(diag0+p) *** -c - j = 0 - do 10 i = 1, p - j = j + i - k1 = diag0 + i - w(k1) = dihdi(j) - 10 continue -c -c *** determine w(dggdmx), the largest element of dihdi *** -c - t1 = zero - j = p * (p + 1) / 2 - do 20 i = 1, j - t = dabs(dihdi(i)) - if (t1 .lt. t) t1 = t - 20 continue - w(dggdmx) = t1 -c -c *** try alpha = 0 *** -c - 30 call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 50 -c *** indef. h -- underestimate smallest eigenvalue, use this -c *** estimate to initialize lower bound lk on alpha. - j = irc*(irc+1)/2 - t = l(j) - l(j) = one - do 40 i = 1, irc - 40 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = -t / t1 / t1 - v(dst0) = -lk - if (restrt) go to 210 - go to 70 -c -c *** positive definite h -- compute unmodified newton step. *** - 50 lk = zero - t = lsvmin(p, l, w(q), w(q)) - if (t .ge. one) go to 60 - if (big .le. zero) big = rmdcon(6) - if (v(dgnorm) .ge. t*t*big) go to 70 - 60 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - v(nreduc) = half * gtsta - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - v(dst0) = dst - phi = dst - rad - if (phi .le. phimax) go to 260 - if (restrt) go to 210 -c -c *** prepare to compute gerschgorin estimates of largest (and -c *** smallest) eigenvalues. *** -c - 70 k = 0 - do 100 i = 1, p - wi = zero - if (i .eq. 1) go to 90 - im1 = i - 1 - do 80 j = 1, im1 - k = k + 1 - t = dabs(dihdi(k)) - wi = wi + t - w(j) = w(j) + t - 80 continue - 90 w(i) = wi - k = k + 1 - 100 continue -c -c *** (under-)estimate smallest eigenvalue of (d**-1)*h*(d**-1) *** -c - k = 1 - t1 = w(diag) - w(1) - if (p .le. 1) go to 120 - do 110 i = 2, p - j = diag0 + i - t = w(j) - w(i) - if (t .ge. t1) go to 110 - t1 = t - k = i - 110 continue -c - 120 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 150 i = 1, p - if (i .eq. k) go to 130 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (akk - w(j) + si - aki) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 140 - 130 inc = i - 140 k1 = k1 + inc - 150 continue -c - w(emin) = akk - t - uk = v(dgnorm)/rad - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 -c -c *** compute gerschgorin (over-)estimate of largest eigenvalue *** -c - k = 1 - t1 = w(diag) + w(1) - if (p .le. 1) go to 170 - do 160 i = 2, p - j = diag0 + i - t = w(j) + w(i) - if (t .le. t1) go to 160 - t1 = t - k = i - 160 continue -c - 170 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 200 i = 1, p - if (i .eq. k) go to 180 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (w(j) + si - aki - akk) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 190 - 180 inc = i - 190 k1 = k1 + inc - 200 continue -c - w(emax) = akk + t - lk = dmax1(lk, v(dgnorm)/rad - w(emax)) -c -c *** alphak = current value of alpha (see alg. notes above). we -c *** use more*s scheme for initializing it. - alphak = dabs(v(stppar)) * v(rad0)/rad -c - if (irc .ne. 0) go to 210 -c -c *** compute l0 for positive definite h *** -c - call livmul(p, w, l, w(q)) - t = v2norm(p, w) - w(phipin) = dst / t / t - lk = dmax1(lk, phi*w(phipin)) -c -c *** safeguard alphak and add alphak*i to (d**-1)*h*(d**-1) *** -c - 210 ka = ka + 1 - if (-v(dst0) .ge. alphak .or. alphak .lt. lk .or. alphak .ge. uk) - 1 alphak = uk * dmax1(p001, dsqrt(lk/uk)) - if (alphak .le. zero) alphak = half * uk - if (alphak .le. zero) alphak = uk - k = 0 - do 220 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) + alphak - 220 continue -c -c *** try computing cholesky decomposition *** -c - call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 240 -c -c *** (d**-1)*h*(d**-1) + alphak*i is indefinite -- overestimate -c *** smallest eigenvalue for use in updating lk *** -c - j = (irc*(irc+1))/2 - t = l(j) - l(j) = one - do 230 i = 1, irc - 230 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = alphak - t/t1/t1 - v(dst0) = -lk - go to 210 -c -c *** alphak makes (d**-1)*h*(d**-1) positive definite. -c *** compute q = -d*step, check for convergence. *** -c - 240 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - phi = dst - rad - if (phi .le. phimax .and. phi .ge. phimin) go to 270 - if (phi .eq. oldphi) go to 270 - oldphi = phi - if (phi .lt. zero) go to 330 -c -c *** unacceptable alphak -- update lk, uk, alphak *** -c - 250 if (ka .ge. kalim) go to 270 -c *** the following dmin1 is necessary because of restarts *** - if (phi .lt. zero) uk = dmin1(uk, alphak) -c *** kamin = 0 only iff the gradient vanishes *** - if (kamin .eq. 0) go to 210 - call livmul(p, w, l, w(q)) - t1 = v2norm(p, w) - alphak = alphak + (phi/t1) * (dst/t1) * (dst/rad) - lk = dmax1(lk, alphak) - go to 210 -c -c *** acceptable step on first try *** -c - 260 alphak = zero -c -c *** successful step in general. compute step = -(d**-1)*q *** -c - 270 do 280 i = 1, p - j = q0 + i - step(i) = -w(j)/d(i) - 280 continue - v(gtstep) = -gtsta - v(preduc) = half * (dabs(alphak)*dst*dst + gtsta) - go to 410 -c -c -c *** restart with new radius *** -c - 290 if (v(dst0) .le. zero .or. v(dst0) - rad .gt. phimax) go to 310 -c -c *** prepare to return newton step *** -c - restrt = .true. - ka = ka + 1 - k = 0 - do 300 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) - 300 continue - uk = negone - go to 30 -c - 310 kamin = ka + 3 - if (v(dgnorm) .eq. zero) kamin = 0 - if (ka .eq. 0) go to 50 -c - dst = w(dstsav) - alphak = dabs(v(stppar)) - phi = dst - rad - t = v(dgnorm)/rad - uk = t - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 - if (rad .gt. v(rad0)) go to 320 -c -c *** smaller radius *** - lk = zero - if (alphak .gt. zero) lk = w(lk0) - lk = dmax1(lk, t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** bigger radius *** - 320 if (alphak .gt. zero) uk = dmin1(uk, w(uk0)) - lk = dmax1(zero, -v(dst0), t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** decide whether to check for special case... in practice (from -c *** the standpoint of the calling optimization code) it seems best -c *** not to check until a few iterations have failed -- hence the -c *** test on kamin below. -c - 330 delta = alphak + dmin1(zero, v(dst0)) - twopsi = alphak*dst*dst + gtsta - if (ka .ge. kamin) go to 340 -c *** if the test in ref. 2 is satisfied, fall through to handle -c *** the special case (as soon as the more-sorensen test detects -c *** it). - if (delta .ge. psifac*twopsi) go to 370 -c -c *** check for the special case of h + alpha*d**2 (nearly) -c *** singular. use one step of inverse power method with start -c *** from lsvmin to obtain approximate eigenvector corresponding -c *** to smallest eigenvalue of (d**-1)*h*(d**-1). lsvmin returns -c *** x and w with l*w = x. -c - 340 t = lsvmin(p, l, w(x), w) -c -c *** normalize w *** - do 350 i = 1, p - 350 w(i) = t*w(i) -c *** complete current inv. power iter. -- replace w by (l**-t)*w. - call litvmu(p, w, l, w) - t2 = one/v2norm(p, w) - do 360 i = 1, p - 360 w(i) = t2*w(i) - t = t2 * t -c -c *** now w is the desired approximate (unit) eigenvector and -c *** t*x = ((d**-1)*h*(d**-1) + alphak*i)*w. -c - sw = dotprd(p, w(q), w) - t1 = (rad + dst) * (rad - dst) - root = dsqrt(sw*sw + t1) - if (sw .lt. zero) root = -root - si = t1 / (sw + root) -c -c *** the actual test for the special case... -c - if ((t2*si)**2 .le. eps*(dst**2 + alphak*radsq)) go to 380 -c -c *** update upper bound on smallest eigenvalue (when not positive) -c *** (as recommended by more and sorensen) and continue... -c - if (v(dst0) .le. zero) v(dst0) = dmin1(v(dst0), t2**2 - alphak) - lk = dmax1(lk, -v(dst0)) -c -c *** check whether we can hope to detect the special case in -c *** the available arithmetic. accept step as it is if not. -c -c *** if not yet available, obtain machine dependent value dgxfac. - 370 if (dgxfac .eq. zero) dgxfac = epsfac * rmdcon(3) -c - if (delta .gt. dgxfac*w(dggdmx)) go to 250 - go to 270 -c -c *** special case detected... negate alphak to indicate special case -c - 380 alphak = -alphak - v(preduc) = half * twopsi -c -c *** accept current step if adding si*w would lead to a -c *** further relative reduction in psi of less than v(epslon)/3. -c - t1 = zero - t = si*(alphak*sw - half*si*(alphak + t*dotprd(p,w(x),w))) - if (t .lt. eps*twopsi/six) go to 390 - v(preduc) = v(preduc) + t - dst = rad - t1 = -si - 390 do 400 i = 1, p - j = q0 + i - w(j) = t1*w(i) - w(j) - step(i) = w(j) / d(i) - 400 continue - v(gtstep) = dotprd(p, dig, w(q)) -c -c *** save values for use in a possible restart *** -c - 410 v(dstnrm) = dst - v(stppar) = alphak - w(lk0) = lk - w(uk0) = uk - v(rad0) = rad - w(dstsav) = dst -c -c *** restore diagonal of dihdi *** -c - j = 0 - do 420 i = 1, p - j = j + i - k = diag0 + i - dihdi(j) = w(k) - 420 continue -c - 999 return -c -c *** last card of gqtst follows *** - end - subroutine lsqrt(n1, n, l, a, irc) -c -c *** compute rows n1 through n of the cholesky factor l of -c *** a = l*(l**t), where l and the lower triangle of a are both -c *** stored compactly by rows (and may occupy the same storage). -c *** irc = 0 means all went well. irc = j means the leading -c *** principal j x j submatrix of a is not positive definite -- -c *** and l(j*(j+1)/2) contains the (nonpos.) reduced j-th diagonal. -c -c *** parameters *** -c - integer n1, n, irc -cal double precision l(1), a(1) - double precision l(n*(n+1)/2), a(n*(n+1)/2) -c dimension l(n*(n+1)/2), a(n*(n+1)/2) -c -c *** local variables *** -c - integer i, ij, ik, im1, i0, j, jk, jm1, j0, k - double precision t, td, zero -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c -c *** body *** -c - i0 = n1 * (n1 - 1) / 2 - do 50 i = n1, n - td = zero - if (i .eq. 1) go to 40 - j0 = 0 - im1 = i - 1 - do 30 j = 1, im1 - t = zero - if (j .eq. 1) go to 20 - jm1 = j - 1 - do 10 k = 1, jm1 - ik = i0 + k - jk = j0 + k - t = t + l(ik)*l(jk) - 10 continue - 20 ij = i0 + j - j0 = j0 + j - t = (a(ij) - t) / l(j0) - l(ij) = t - td = td + t*t - 30 continue - 40 i0 = i0 + i - t = a(i0) - td - if (t .le. zero) go to 60 - l(i0) = dsqrt(t) - 50 continue -c - irc = 0 - go to 999 -c - 60 l(i0) = t - irc = i -c - 999 return -c -c *** last card of lsqrt *** - end - double precision function lsvmin(p, l, x, y) -c -c *** estimate smallest sing. value of packed lower triang. matrix l -c -c *** parameter declarations *** -c - integer p -cal double precision l(1), x(p), y(p) - double precision l(p*(p+1)/2), x(p), y(p) -c dimension l(p*(p+1)/2) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c this function returns a good over-estimate of the smallest -c singular value of the packed lower triangular matrix l. -c -c *** parameter description *** -c -c p (in) = the order of l. l is a p x p lower triangular matrix. -c l (in) = array holding the elements of l in row order, i.e. -c l(1,1), l(2,1), l(2,2), l(3,1), l(3,2), l(3,3), etc. -c x (out) if lsvmin returns a positive value, then x is a normalized -c approximate left singular vector corresponding to the -c smallest singular value. this approximation may be very -c crude. if lsvmin returns zero, then some components of x -c are zero and the rest retain their input values. -c y (out) if lsvmin returns a positive value, then y = (l**-1)*x is an -c unnormalized approximate right singular vector correspond- -c ing to the smallest singular value. this approximation -c may be crude. if lsvmin returns zero, then y retains its -c input value. the caller may pass the same vector for x -c and y (nonstandard fortran usage), in which case y over- -c writes x (for nonzero lsvmin returns). -c -c *** algorithm notes *** -c -c the algorithm is based on (1), with the additional provision that -c lsvmin = 0 is returned if the smallest diagonal element of l -c (in magnitude) is not more than the unit roundoff times the -c largest. the algorithm uses a random number generator proposed -c in (4), which passes the spectral test with flying colors -- see -c (2) and (3). -c -c *** subroutines and functions called *** -c -c v2norm - function, returns the 2-norm of a vector. -c -c *** references *** -c -c (1) cline, a., moler, c., stewart, g., and wilkinson, j.h.(1977), -c an estimate for the condition number of a matrix, report -c tm-310, applied math. div., argonne national laboratory. -c -c (2) hoaglin, d.c. (1976), theoretical properties of congruential -c random-number generators -- an empirical view, -c memorandum ns-340, dept. of statistics, harvard univ. -c -c (3) knuth, d.e. (1969), the art of computer programming, vol. 2 -c (seminumerical algorithms), addison-wesley, reading, mass. -c -c (4) smith, c.s. (1971), multiplicative pseudo-random number -c generators with prime modulus, j. assoc. comput. mach. 18, -c pp. 586-593. -c -c *** history *** -c -c designed and coded by david m. gay (winter 1977/summer 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, and mcs76-11989. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer i, ii, ix, j, ji, jj, jjj, jm1, j0, pm1 - double precision b, sminus, splus, t, xminus, xplus -c -c *** constants *** -c - double precision half, one, r9973, zero -c -c *** intrinsic functions *** -c/+ - integer mod - real float - double precision dabs -c/ -c *** external functions and subroutines *** -c - external dotprd, v2norm, vaxpy - double precision dotprd, v2norm -c -c/6 -c data half/0.5d+0/, one/1.d+0/, r9973/9973.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, r9973=9973.d+0, zero=0.d+0) -c/ -c -c *** body *** -c - ix = 2 - pm1 = p - 1 -c -c *** first check whether to return lsvmin = 0 and initialize x *** -c - ii = 0 - j0 = p*pm1/2 - jj = j0 + p - if (l(jj) .eq. zero) go to 110 - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = b / l(jj) - x(p) = xplus - if (p .le. 1) go to 60 - do 10 i = 1, pm1 - ii = ii + i - if (l(ii) .eq. zero) go to 110 - ji = j0 + i - x(i) = xplus * l(ji) - 10 continue -c -c *** solve (l**t)*x = b, where the components of b have randomly -c *** chosen magnitudes in (.5,1) with signs chosen to make x large. -c -c do j = p-1 to 1 by -1... - do 50 jjj = 1, pm1 - j = p - jjj -c *** determine x(j) in this iteration. note for i = 1,2,...,j -c *** that x(i) holds the current partial sum for row i. - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = (b - x(j)) - xminus = (-b - x(j)) - splus = dabs(xplus) - sminus = dabs(xminus) - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - xplus = xplus/l(jj) - xminus = xminus/l(jj) - if (jm1 .eq. 0) go to 30 - do 20 i = 1, jm1 - ji = j0 + i - splus = splus + dabs(x(i) + l(ji)*xplus) - sminus = sminus + dabs(x(i) + l(ji)*xminus) - 20 continue - 30 if (sminus .gt. splus) xplus = xminus - x(j) = xplus -c *** update partial sums *** - if (jm1 .gt. 0) call vaxpy(jm1, x, xplus, l(j0+1), x) - 50 continue -c -c *** normalize x *** -c - 60 t = one/v2norm(p, x) - do 70 i = 1, p - 70 x(i) = t*x(i) -c -c *** solve l*y = x and return lsvmin = 1/twonorm(y) *** -c - do 100 j = 1, p - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - t = zero - if (jm1 .gt. 0) t = dotprd(jm1, l(j0+1), y) - y(j) = (x(j) - t) / l(jj) - 100 continue -c - lsvmin = one/v2norm(p, y) - go to 999 -c - 110 lsvmin = zero - 999 return -c *** last card of lsvmin follows *** - end - subroutine slvmul(p, y, s, x) -c -c *** set y = s * x, s = p x p symmetric matrix. *** -c *** lower triangle of s stored rowwise. *** -c -c *** parameter declarations *** -c - integer p -cal double precision s(1), x(p), y(p) - double precision s(p*(p+1)/2), x(p), y(p) -c dimension s(p*(p+1)/2) -c -c *** local variables *** -c - integer i, im1, j, k - double precision xi -c -c *** no intrinsic functions *** -c -c *** external function *** -c - external dotprd - double precision dotprd -c -c----------------------------------------------------------------------- -c - j = 1 - do 10 i = 1, p - y(i) = dotprd(i, s(j), x) - j = j + i - 10 continue -c - if (p .le. 1) go to 999 - j = 1 - do 40 i = 2, p - xi = x(i) - im1 = i - 1 - j = j + 1 - do 30 k = 1, im1 - y(k) = y(k) + s(j)*xi - j = j + 1 - 30 continue - 40 continue -c - 999 return -c *** last card of slvmul follows *** - end diff --git a/source/unres/src_MD-DFA-restraints/dfa.F b/source/unres/src_MD-DFA-restraints/dfa.F deleted file mode 100644 index 576910c..0000000 --- a/source/unres/src_MD-DFA-restraints/dfa.F +++ /dev/null @@ -1,3455 +0,0 @@ - subroutine init_dfa_vars - - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.DFA' - - integer ii - -C Number of restraints - idisnum = 0 - iphinum = 0 - ithenum = 0 - ineinum = 0 - - idislis = 0 - iphilis = 0 - ithelis = 0 - ineilis = 0 - jneilis = 0 - jneinum = 0 - kshell = 0 - fnei = 0 -C For beta - nca = 0 - icaidx = 0 - -C real variables -CC WEIGHTS for each min - sccdist = 0.0d0 - fdist = 0.0d0 - sccphi = 0.0d0 - sccthe = 0.0d0 - sccnei = 0.0d0 - fphi1 = 0.0d0 - fphi2 = 0.0d0 - fthe1 = 0.0d0 - fthe2 = 0.0d0 -C energies - edfatot = 0.0d0 - edfadis = 0.0d0 - edfaphi = 0.0d0 - edfathe = 0.0d0 - edfanei = 0.0d0 - edfabet = 0.0d0 -C weights for each E term -C these should be identical with - dis_inc = 0.0d0 - phi_inc = 0.0d0 - the_inc = 0.0d0 - nei_inc = 0.0d0 - beta_inc = 0.0d0 - wshet = 0.0d0 -C precalculate exp table! -c dfaexp = 0.0d0 -c do ii = 1, 15001 -c dfaexp(ii) = exp(-ii*0.001d0 + 0.0005d0) -c end do - - ishiftca=nnt-1 - ilastca=nct - - print *,'ishiftca=',ishiftca,'ilastca=',ilastca - - return - end - - - subroutine read_dfa_info -C -C read fragment informations -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DFA' - - -C NOTE THAT FILENAMES are FIXED, CURRENTLY!! -C THIS SHOULD BE MODIFIED!! - - character*320 buffer - integer iodfa - parameter(iodfa=89) - - integer i, j, nval - integer ica1, ica2,ica3,ica4,ica5 - integer ishell, inca, itmp,iitmp - double precision wtmp -C -C READ DISTANCE -C - open(iodfa, file = 'dist_dfa.dat', status = 'old', err=33) - goto 34 - 33 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - 34 continue - write(iout,'(a)') 'dist_dfa.dat is opened!' -C read title - read(iodfa, '(a)') buffer -C read number of restraints - read(iodfa, *) IDFADIS - read(iodfa, *) dis_inc - do i=1, idfadis - read(iodfa, '(i10,1x,i10,1x,i10)') ica1, ica2, nval - - idisnum(i)=nval - idislis(1,i)=ica1 - idislis(2,i)=ica2 - - do j=1, nval - read(iodfa,*) tmp - fdist(i,j) = tmp - enddo - - do j=1, nval - read(iodfa,*) tmp - sccdist(i,j) = tmp - enddo - - enddo - close(iodfa) - -C READ ANGLE RESTRAINTS -C PHI RESTRAINTS - open(iodfa, file='phi_dfa.dat',status='old',err=35) - goto 36 - 35 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - - 36 continue - write(iout,'(a)') 'phi_dfa.dat is opened!' - -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) IDFAPHI - read(iodfa,*) phi_inc - do i=1, idfaphi - read(iodfa,'(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval - - iphinum(i)=nval - - iphilis(1,i)=ica1 - iphilis(2,i)=ica2 - iphilis(3,i)=ica3 - iphilis(4,i)=ica4 - iphilis(5,i)=ica5 - - do j=1, nval - read(iodfa,*) tmp1,tmp2 - fphi1(i,j) = tmp1 - fphi2(i,j) = tmp2 - enddo - - do j=1, nval - read(iodfa,*) tmp - sccphi(i,j) = tmp - enddo - - enddo - close(iodfa) - -C THETA RESTRAINTS - open(iodfa, file='theta_dfa.dat',status='old',err=41) - goto 42 - 41 write(iout,'(a)') 'Error opening dist_dfa.dat file' - stop - 42 continue - write(iout,'(a)') 'theta_dfa.dat is opened!' -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) IDFATHE - read(iodfa,*) the_inc - - do i=1, idfathe - read(iodfa, '(5(i10,1x),1x,i10)')ica1,ica2,ica3,ica4,ica5,nval - - ithenum(i)=nval - - ithelis(1,i)=ica1 - ithelis(2,i)=ica2 - ithelis(3,i)=ica3 - ithelis(4,i)=ica4 - ithelis(5,i)=ica5 - - do j=1, nval - read(iodfa,*) tmp1,tmp2 - fthe1(i,j) = tmp1 - fthe2(i,j) = tmp2 - enddo - - do j=1, nval - read(iodfa,*) tmp - sccthe(i,j) = tmp - enddo - - enddo - close(iodfa) -C END of READING ANGLE RESTRAINT! - -C NUMBER OF NEIGHBOR CAs - open(iodfa,file='nei_dfa.dat',status='old',err=37) - goto 38 - 37 write(iout,'(a)') 'Error opening nei_dfa.dat file' - stop - 38 continue - write(iout,'(a)') 'nei_dfa.dat is opened!' -C READ TITLE - read(iodfa, '(a)') buffer -C READ NUMBER OF RESTRAINTS - READ(iodfa, *) idfanei - read(iodfa,*) nei_inc - - do i=1, idfanei - read(iodfa,'(2(i10,1x),i10)')ica1,ishell,nval - - ineilis(i)=ica1 - kshell(i)=ishell - ineinum(i)=nval - - do j=1, nval - read(iodfa,*) inca - fnei(i,j) = inca -C write(*,*) 'READ NEI:',i,j,fnei(i,j) - enddo - - do j=1, nval - read(iodfa,*) tmp - sccnei(i,j) = tmp - enddo - - enddo - close(iodfa) -C END OF NEIGHBORING CA - -C READ BETA RESTRAINT - open(iodfa, file='beta_dfa.dat',status='old',err=39) - goto 40 - 39 write(iout,'(a)') 'Error opening beta_dfa.dat file' - stop - 40 continue - write(iout,'(a)') 'beta_dfa.dat is opened!' - - read(iodfa,'(a)') buffer - read(iodfa,*) itmp - read(iodfa,*) beta_inc - - do i=1,itmp - read(iodfa,*) ica1, iitmp - do j=1,itmp - read(iodfa,*) wtmp - wshet(i,j) = wtmp -c write(*,*) 'BETA:',i,j,wtmp,wshet(i,j) - enddo - enddo - - close(iodfa) -C END OF BETA RESTRAINT - - return - END - - subroutine edfad(edfadis) - - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - double precision edfadis - integer i, iatm1, iatm2,idiff - double precision ckk, sckk,dist,texp - double precision jix,jiy,jiz,ep,fp,scc - - edfadis=0 - gdfad=0.0d0 - - do i=1, idfadis - - iatm1=idislis(1,i)+ishiftca - iatm2=idislis(2,i)+ishiftca - idiff = abs(iatm1-iatm2) - - JIX=c(1,iatm2)-c(1,iatm1) - JIY=c(2,iatm2)-c(2,iatm1) - JIZ=c(3,iatm2)-c(3,iatm1) - DIST=SQRT(JIX*JIX+JIY*JIY+JIZ*JIZ) - - ckk=ck(idiff) - sckk=sck(idiff) - - scc = 0.0d0 - ep = 0.0d0 - fp = 0.0d0 - - do j=1,idisnum(i) - - dd = dist-fdist(i,j) - dtmp = dd*dd/ckk - if (dtmp.ge.15.0d0) then - texp = 0.0d0 - else -c texp = dfaexp( idint(dtmp*1000)+1 )/sckk - texp = exp(-dtmp)/sckk - endif - - ep=ep+sccdist(i,j)*texp - fp=fp+sccdist(i,j)*texp*dd*2.0d0/ckk - scc=scc+sccdist(i,j) -C write(*,'(2i8,6f12.5)') i, j, dist, -C & fdist(i,j), ep, fp, sccdist(i,j), scc - - enddo - - ep = -ep/scc - fp = fp/scc - - -c IF(ABS(EP).lt.1.0d-20)THEN -c EP=0.0D0 -c ENDIF -c IF (ABS(FP).lt.1.0d-20) THEN -c FP=0.0D0 -c ENDIF - - edfadis=edfadis+ep*dis_inc*wwdist - - gdfad(1,iatm1) = gdfad(1,iatm1)-jix/dist*fp*dis_inc*wwdist - gdfad(2,iatm1) = gdfad(2,iatm1)-jiy/dist*fp*dis_inc*wwdist - gdfad(3,iatm1) = gdfad(3,iatm1)-jiz/dist*fp*dis_inc*wwdist - - gdfad(1,iatm2) = gdfad(1,iatm2)+jix/dist*fp*dis_inc*wwdist - gdfad(2,iatm2) = gdfad(2,iatm2)+jiy/dist*fp*dis_inc*wwdist - gdfad(3,iatm2) = gdfad(3,iatm2)+jiz/dist*fp*dis_inc*wwdist - - enddo - - return - end - - subroutine edfat(edfator) -C DFA torsion angle - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - integer i,j,ii,iii - integer iatom(5) - double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) - double precision cwidth, cwidth2 - PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) - - edfator= 0.0d0 - enephi = 0.0d0 - enethe = 0.0d0 - gdfat(:,:) = 0.0d0 - -C START OF PHI ANGLE - do i=1, idfaphi - - aphi = 0.0d0 - do iii=1,5 - iatom(iii)=iphilis(iii,i)+ishiftca - enddo - -C ANGLE VECTOR CALCULTION - RIX=C(1,IATOM(2))-C(1,IATOM(1)) - RIY=C(2,IATOM(2))-C(2,IATOM(1)) - RIZ=C(3,IATOM(2))-C(3,IATOM(1)) - - RIPX=C(1,IATOM(3))-C(1,IATOM(2)) - RIPY=C(2,IATOM(3))-C(2,IATOM(2)) - RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) - - RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) - RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) - RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) - - RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) - RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) - RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) - - GIX=RIY*RIPZ-RIZ*RIPY - GIY=RIZ*RIPX-RIX*RIPZ - GIZ=RIX*RIPY-RIY*RIPX - - GIPX=RIPY*RIPPZ-RIPZ*RIPPY - GIPY=RIPZ*RIPPX-RIPX*RIPPZ - GIPZ=RIPX*RIPPY-RIPY*RIPPX - - CIPX=C(1,IATOM(3))-C(1,IATOM(1)) - CIPY=C(2,IATOM(3))-C(2,IATOM(1)) - CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) - - CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) - CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) - CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) - - CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) - CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) - CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) - - DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) - DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) - DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) - DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) - -C END OF ANGLE VECTOR CALCULTION - - TDOT=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ - APHI(1)=TDOT/(DGI*DRIPP) - TDOT=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z - APHI(2)=TDOT/(DGIP*DRIP3) - - ephi = 0.0d0 - tfphi1=0.0d0 - tfphi2=0.0d0 - scc=0.0d0 - - do j=1, iphinum(i) - DDPS1=APHI(1)-FPHI1(i,j) - DDPS2=APHI(2)-FPHI2(i,j) - - DTMP = (DDPS1**2+DDPS2**2)/CWIDTH2 - - if (dtmp.ge.15.0d0) then - ps_tmp = 0.0d0 - else -c ps_tmp = dfaexp(idint(dtmp*1000)+1) - ps_tmp = exp(-dtmp) - endif - - ephi=ephi+sccphi(i,j)*ps_tmp - - tfphi1=tfphi1+sccphi(i,j)*ddps1/cwidth*ps_tmp - tfphi2=tfphi2+sccphi(i,j)*ddps2/cwidth*ps_tmp - - scc=scc+sccphi(i,j) -C write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), -C & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) - ENDDO - - ephi=-ephi/scc*phi_inc*wwangle - tfphi1=tfphi1/scc*phi_inc*wwangle - tfphi2=tfphi2/scc*phi_inc*wwangle - - IF (ABS(EPHI).LT.1d-20) THEN - EPHI=0.0D0 - ENDIF - IF (ABS(TFPHI1).LT.1d-20) THEN - TFPHI1=0.0D0 - ENDIF - IF (ABS(TFPHI2).LT.1d-20) THEN - TFPHI2=0.0D0 - ENDIF - -C FORCE DIRECTION CALCULATION - TDX(1:5)=0.0D0 - TDY(1:5)=0.0D0 - TDZ(1:5)=0.0D0 - - DM1=1.0d0/(DGI*DRIPP) - - GIRPP=GIX*RIPPX+GIY*RIPPY+GIZ*RIPPZ - DM2=GIRPP/(DGI**3*DRIPP) - DM3=GIRPP/(DGI*DRIPP**3) - - DM4=1.0d0/(DGIP*DRIP3) - - GIRP3=GIPX*RIP3X+GIPY*RIP3Y+GIPZ*RIP3Z - DM5=GIRP3/(DGIP**3*DRIP3) - DM6=GIRP3/(DGIP*DRIP3**3) -C FIRST ATOM BY PHI1 - TDX(1)=(RIPZ*RIPPY-RIPY*RIPPZ)*DM1 - & +( GIZ* RIPY- GIY* RIPZ)*DM2 - TDY(1)=(RIPX*RIPPZ-RIPZ*RIPPX)*DM1 - & +( GIX* RIPZ- GIZ* RIPX)*DM2 - TDZ(1)=(RIPY*RIPPX-RIPX*RIPPY)*DM1 - & +( GIY* RIPX- GIX* RIPY)*DM2 - TDX(1)=TDX(1)*TFPHI1 - TDY(1)=TDY(1)*TFPHI1 - TDZ(1)=TDZ(1)*TFPHI1 -C SECOND ATOM BY PHI1 - TDX(2)=(CIPY*RIPPZ-CIPZ*RIPPY)*DM1 - & -(CIPY*GIZ-CIPZ*GIY)*DM2 - TDY(2)=(CIPZ*RIPPX-CIPX*RIPPZ)*DM1 - & -(CIPZ*GIX-CIPX*GIZ)*DM2 - TDZ(2)=(CIPX*RIPPY-CIPY*RIPPX)*DM1 - & -(CIPX*GIY-CIPY*GIX)*DM2 - TDX(2)=TDX(2)*TFPHI1 - TDY(2)=TDY(2)*TFPHI1 - TDZ(2)=TDZ(2)*TFPHI1 -C SECOND ATOM BY PHI2 - TDX(2)=TDX(2)+ - & ((RIPPZ*RIP3Y-RIPPY*RIP3Z)*DM4 - & +( GIPZ*RIPPY- GIPY*RIPPZ)*DM5)*TFPHI2 - TDY(2)=TDY(2)+ - & ((RIPPX*RIP3Z-RIPPZ*RIP3X)*DM4 - & +( GIPX*RIPPZ- GIPZ*RIPPX)*DM5)*TFPHI2 - TDZ(2)=TDZ(2)+ - & ((RIPPY*RIP3X-RIPPX*RIP3Y)*DM4 - & +( GIPY*RIPPX- GIPX*RIPPY)*DM5)*TFPHI2 -C THIRD ATOM BY PHI1 - TDX(3)=(-GIX+RIPPY*RIZ-RIPPZ*RIY)*DM1 - & -(GIY*RIZ-RIY*GIZ)*DM2+RIPPX*DM3 - TDY(3)=(-GIY+RIPPZ*RIX-RIPPX*RIZ)*DM1 - & -(GIZ*RIX-RIZ*GIX)*DM2+RIPPY*DM3 - TDZ(3)=(-GIZ+RIPPX*RIY-RIPPY*RIX)*DM1 - & -(GIX*RIY-RIX*GIY)*DM2+RIPPZ*DM3 - TDX(3)=TDX(3)*TFPHI1 - TDY(3)=TDY(3)*TFPHI1 - TDZ(3)=TDZ(3)*TFPHI1 -C THIRD ATOM BY PHI2 - TDX(3)=TDX(3)+ - & ((CIPPY*RIP3Z-CIPPZ*RIP3Y)*DM4 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5)*TFPHI2 - TDY(3)=TDY(3)+ - & ((CIPPZ*RIP3X-CIPPX*RIP3Z)*DM4 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5)*TFPHI2 - TDZ(3)=TDZ(3)+ - & ((CIPPX*RIP3Y-CIPPY*RIP3X)*DM4 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM5)*TFPHI2 -C FOURTH ATOM BY PHI1 - TDX(4)=(GIX*DM1-RIPPX*DM3)*TFPHI1 - TDY(4)=(GIY*DM1-RIPPY*DM3)*TFPHI1 - TDZ(4)=(GIZ*DM1-RIPPZ*DM3)*TFPHI1 -C FOURTH ATOM BY PHI2 - TDX(4)=TDX(4)+ - & ((-GIPX+RIP3Y*RIPZ-RIP3Z*RIPY)*DM4 - & -( GIPY*RIPZ-RIPY*GIPZ)*DM5 - & + RIP3X*DM6)*TFPHI2 - TDY(4)=TDY(4)+ - & ((-GIPY+RIP3Z*RIPX-RIP3X*RIPZ)*DM4 - & -( GIPZ*RIPX-RIPZ*GIPX)*DM5 - & + RIP3Y*DM6)*TFPHI2 - TDZ(4)=TDZ(4)+ - & ((-GIPZ+RIP3X*RIPY-RIP3Y*RIPX)*DM4 - & -( GIPX*RIPY-RIPX*GIPY)*DM5 - & + RIP3Z*DM6)*TFPHI2 -C FIFTH ATOM BY PHI2 - TDX(5)=(GIPX*DM4-RIP3X*DM6)*TFPHI2 - TDY(5)=(GIPY*DM4-RIP3Y*DM6)*TFPHI2 - TDZ(5)=(GIPZ*DM4-RIP3Z*DM6)*TFPHI2 -C END OF FORCE DIRECTION -c force calcuation - DO II=1,5 - gdfat(1,IATOM(II))=gdfat(1,IATOM(II))+TDX(II) - gdfat(2,IATOM(II))=gdfat(2,IATOM(II))+TDY(II) - gdfat(3,IATOM(II))=gdfat(3,IATOM(II))+TDZ(II) - ENDDO -c energy calculation - enephi = enephi + ephi -c end of single assignment statement - ENDDO -C END OF PHI RESTRAINT - -C START OF THETA ANGLE - do i=1, idfathe - - athe = 0.0d0 - do iii=1,5 - iatom(iii)=ithelis(iii,i)+ishiftca - enddo - - -C ANGLE VECTOR CALCULTION - RIX=C(1,IATOM(2))-C(1,IATOM(1)) - RIY=C(2,IATOM(2))-C(2,IATOM(1)) - RIZ=C(3,IATOM(2))-C(3,IATOM(1)) - - RIPX=C(1,IATOM(3))-C(1,IATOM(2)) - RIPY=C(2,IATOM(3))-C(2,IATOM(2)) - RIPZ=C(3,IATOM(3))-C(3,IATOM(2)) - - RIPPX=C(1,IATOM(4))-C(1,IATOM(3)) - RIPPY=C(2,IATOM(4))-C(2,IATOM(3)) - RIPPZ=C(3,IATOM(4))-C(3,IATOM(3)) - - RIP3X=C(1,IATOM(5))-C(1,IATOM(4)) - RIP3Y=C(2,IATOM(5))-C(2,IATOM(4)) - RIP3Z=C(3,IATOM(5))-C(3,IATOM(4)) - - GIX=RIY*RIPZ-RIZ*RIPY - GIY=RIZ*RIPX-RIX*RIPZ - GIZ=RIX*RIPY-RIY*RIPX - - GIPX=RIPY*RIPPZ-RIPZ*RIPPY - GIPY=RIPZ*RIPPX-RIPX*RIPPZ - GIPZ=RIPX*RIPPY-RIPY*RIPPX - - GIPPX=RIPPY*RIP3Z-RIPPZ*RIP3Y - GIPPY=RIPPZ*RIP3X-RIPPX*RIP3Z - GIPPZ=RIPPX*RIP3Y-RIPPY*RIP3X - - CIPX=C(1,IATOM(3))-C(1,IATOM(1)) - CIPY=C(2,IATOM(3))-C(2,IATOM(1)) - CIPZ=C(3,IATOM(3))-C(3,IATOM(1)) - - CIPPX=C(1,IATOM(4))-C(1,IATOM(2)) - CIPPY=C(2,IATOM(4))-C(2,IATOM(2)) - CIPPZ=C(3,IATOM(4))-C(3,IATOM(2)) - - CIP3X=C(1,IATOM(5))-C(1,IATOM(3)) - CIP3Y=C(2,IATOM(5))-C(2,IATOM(3)) - CIP3Z=C(3,IATOM(5))-C(3,IATOM(3)) - - DGI=SQRT(GIX*GIX+GIY*GIY+GIZ*GIZ) - DGIP=SQRT(GIPX*GIPX+GIPY*GIPY+GIPZ*GIPZ) - DGIPP=SQRT(GIPPX*GIPPX+GIPPY*GIPPY+GIPPZ*GIPPZ) - DRIPP=SQRT(RIPPX*RIPPX+RIPPY*RIPPY+RIPPZ*RIPPZ) - DRIP3=SQRT(RIP3X*RIP3X+RIP3Y*RIP3Y+RIP3Z*RIP3Z) -C END OF ANGLE VECTOR CALCULTION - - TDOT=GIX*GIPX+GIY*GIPY+GIZ*GIPZ - ATHE(1)=TDOT/(DGI*DGIP) - TDOT=GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ - ATHE(2)=TDOT/(DGIP*DGIPP) - - ETHE=0.0D0 - TFTHE1=0.0D0 - TFTHE2=0.0D0 - SCC=0.0D0 - TH_TMP=0.0d0 - - do j=1,ithenum(i) - ddth1=athe(1)-fthe1(i,j) !cos(the1)-cos(the1_ref) - ddth2=athe(2)-fthe2(i,j) !cos(the2)-cos(the2_ref) - dtmp= (ddth1**2+ddth2**2)/cwidth2 - if ( dtmp .ge. 15.0d0) then - th_tmp = 0.0d0 - else -c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) - th_tmp = exp(-dtmp) - end if - - ethe=ethe+sccthe(i,j)*th_tmp - - tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) - tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) - scc=scc+sccthe(i,j) -C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), -C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) - enddo - - ethe=-ethe/scc*the_inc*wwangle - tfthe1=tfthe1/scc*the_inc*wwangle - tfthe2=tfthe2/scc*the_inc*wwangle - - IF (ABS(ETHE).LT.TENM20) THEN - ETHE=0.0D0 - ENDIF - IF (ABS(TFTHE1).LT.TENM20) THEN - TFTHE1=0.0D0 - ENDIF - IF (ABS(TFTHE2).LT.TENM20) THEN - TFTHE2=0.0D0 - ENDIF - - TDX(1:5)=0.0D0 - TDY(1:5)=0.0D0 - TDZ(1:5)=0.0D0 - - DM1=1.0d0/(DGI*DGIP) - DM2=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI**3*DGIP) - DM3=(GIX*GIPX+GIY*GIPY+GIZ*GIPZ)/(DGI*DGIP**3) - - DM4=1.0d0/(DGIP*DGIPP) - DM5=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP**3*DGIPP) - DM6=(GIPX*GIPPX+GIPY*GIPPY+GIPZ*GIPPZ)/(DGIP*DGIPP**3) - -C FIRST ATOM BY THETA1 - TDX(1)=((RIPZ*GIPY-RIPY*GIPZ)*DM1 - & -(GIY*RIPZ-GIZ*RIPY)*DM2)*TFTHE1 - TDY(1)=((-RIPZ*GIPX+RIPX*GIPZ)*DM1 - & -(-GIX*RIPZ+GIZ*RIPX)*DM2)*TFTHE1 - TDZ(1)=((RIPY*GIPX-RIPX*GIPY)*DM1 - & -(GIX*RIPY-GIY*RIPX)*DM2)*TFTHE1 -C SECOND ATOM BY THETA1 - TDX(2)=((CIPY*GIPZ-CIPZ*GIPY-RIPPY*GIZ+RIPPZ*GIY)*DM1 - & -(CIPY*GIZ-CIPZ*GIY)*DM2 - & +(RIPPY*GIPZ-RIPPZ*GIPY)*DM3)*TFTHE1 - TDY(2)=((CIPZ*GIPX-CIPX*GIPZ-RIPPZ*GIX+RIPPX*GIZ)*DM1 - & -(CIPZ*GIX-CIPX*GIZ)*DM2 - & +(RIPPZ*GIPX-RIPPX*GIPZ)*DM3)*TFTHE1 - TDZ(2)=((CIPX*GIPY-CIPY*GIPX-RIPPX*GIY+RIPPY*GIX)*DM1 - & -(CIPX*GIY-CIPY*GIX)*DM2 - & +(RIPPX*GIPY-RIPPY*GIPX)*DM3)*TFTHE1 -C SECOND ATOM BY THETA2 - TDX(2)=TDX(2)+ - & ((RIPPZ*GIPPY-RIPPY*GIPPZ)*DM4 - & -(GIPY*RIPPZ-GIPZ*RIPPY)*DM5)*TFTHE2 - TDY(2)=TDY(2)+ - & ((-RIPPZ*GIPPX+RIPPX*GIPPZ)*DM4 - & -(-GIPX*RIPPZ+GIPZ*RIPPX)*DM5)*TFTHE2 - TDZ(2)=TDZ(2)+ - & ((RIPPY*GIPPX-RIPPX*GIPPY)*DM4 - & -(GIPX*RIPPY-GIPY*RIPPX)*DM5)*TFTHE2 -C THIRD ATOM BY THETA1 - TDX(3)=((GIPY*RIZ-GIPZ*RIY-GIY*CIPPZ+GIZ*CIPPY)*DM1 - & -(GIY*RIZ-GIZ*RIY)*DM2 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM3) *TFTHE1 - TDY(3)=((GIPZ*RIX-GIPX*RIZ-GIZ*CIPPX+GIX*CIPPZ)*DM1 - & -(GIZ*RIX-GIX*RIZ)*DM2 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM3) *TFTHE1 - TDZ(3)=((GIPX*RIY-GIPY*RIX-GIX*CIPPY+GIY*CIPPX)*DM1 - & -(GIX*RIY-GIY*RIX)*DM2 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM3) *TFTHE1 -C THIRD ATOM BY THETA2 - TDX(3)=TDX(3)+ - & ((CIPPY*GIPPZ-CIPPZ*GIPPY-RIP3Y*GIPZ+RIP3Z*GIPY)*DM4 - & -(CIPPY*GIPZ-CIPPZ*GIPY)*DM5 - & +(RIP3Y*GIPpZ-RIP3Z*GIPpY)*DM6) *TFTHE2 - TDY(3)=TDY(3)+ - & ((CIPPZ*GIPPX-CIPPX*GIPPZ-RIP3Z*GIPX+RIP3X*GIPZ)*DM4 - & -(CIPPZ*GIPX-CIPPX*GIPZ)*DM5 - & +(RIP3Z*GIPpX-RIP3X*GIPpZ)*DM6) *TFTHE2 - TDZ(3)=TDZ(3)+ - & ((CIPPX*GIPPY-CIPPY*GIPPX-RIP3X*GIPY+RIP3Y*GIPX)*DM4 - & -(CIPPX*GIPY-CIPPY*GIPX)*DM5 - & +(RIP3X*GIPpY-RIP3Y*GIPpX)*DM6) *TFTHE2 -C FOURTH ATOM BY THETA1 - TDX(4)=-((GIZ*RIPY-GIY*RIPZ)*DM1 - & -(GIPZ*RIPY-GIPY*RIPZ)*DM3) *TFTHE1 - TDY(4)=-((GIX*RIPZ-GIZ*RIPX)*DM1 - & -(GIPX*RIPZ-GIPZ*RIPX)*DM3) *TFTHE1 - TDZ(4)=-((GIY*RIPX-GIX*RIPY)*DM1 - & -(GIPY*RIPX-GIPX*RIPY)*DM3) *TFTHE1 -C FOURTH ATOM BY THETA2 - TDX(4)=TDX(4)+ - & ((GIPPY*RIPZ-GIPPZ*RIPY-GIPY*CIP3Z+GIPZ*CIP3Y)*DM4 - & -(GIPY*RIPZ-GIPZ*RIPY)*DM5 - & -(CIP3Y*GIPPZ-CIP3Z*GIPPY)*DM6)*TFTHE2 - TDY(4)=TDY(4)+ - & ((GIPPZ*RIPX-GIPPX*RIPZ-GIPZ*CIP3X+GIPX*CIP3Z)*DM4 - & -(GIPZ*RIPX-GIPX*RIPZ)*DM5 - & -(CIP3Z*GIPPX-CIP3X*GIPPZ)*DM6)*TFTHE2 - TDZ(4)=TDZ(4)+ - & ((GIPPX*RIPY-GIPPY*RIPX-GIPX*CIP3Y+GIPY*CIP3X)*DM4 - & -(GIPX*RIPY-GIPY*RIPX)*DM5 - & -(CIP3X*GIPPY-CIP3Y*GIPPX)*DM6)*TFTHE2 -C FIFTH ATOM BY THETA2 - TDX(5)=-((GIPZ*RIPPY-GIPY*RIPPZ)*DM4 - & -(GIPPZ*RIPPY-GIPPY*RIPPZ)*DM6)*TFTHE2 - TDY(5)=-((GIPX*RIPPZ-GIPZ*RIPPX)*DM4 - & -(GIPPX*RIPPZ-GIPPZ*RIPPX)*DM6)*TFTHE2 - TDZ(5)=-((GIPY*RIPPX-GIPX*RIPPY)*DM4 - & -(GIPPY*RIPPX-GIPPX*RIPPY)*DM6)*TFTHE2 -C !! END OF FORCE DIRECTION!!!! - DO II=1,5 - gdfat(1,iatom(II))=gdfat(1,iatom(II))+TDX(II) - gdfat(2,iatom(II))=gdfat(2,iatom(II))+TDY(II) - gdfat(3,iatom(II))=gdfat(3,iatom(II))+TDZ(II) - ENDDO -C energy calculation - enethe = enethe + ethe - ENDDO - - edfator = enephi + enethe - - RETURN - END - - subroutine edfan(edfanei) -C DFA neighboring CA restraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - integer i,j,imin - integer kshnum, n1atom - - double precision enenei,tmp_n - double precision pai,hpai - double precision jix,jiy,jiz,ndiff,snorm_nei - double precision t2dx(maxres),t2dy(maxres),t2dz(maxres) - double precision dr,dr2,half,ntmp,dtmp - - parameter(dr=0.25d0,dr2=0.50d0,half=0.50d0) - parameter(pai=3.14159265358979323846D0) - parameter(hpai=1.5707963267948966D0) - parameter(snorm_nei=0.886226925452758D0) - - edfanei = 0.0d0 - enenei = 0.0d0 - gdfan = 0.0d0 - -c print*, 's1:', s1(:) -c print*, 's2:', s2(:) - - do i=1, idfanei - - kshnum=kshell(i) - n1atom=ineilis(i)+ishiftca -C write(*,*) 'kshnum,n1atom:', kshnum, n1atom - - tmp_n=0.0d0 - ftmp=0.0d0 - dnei=0.0d0 - dist=0.0d0 - t1dx=0.0d0 - t1dy=0.0d0 - t1dz=0.0d0 - t2dx=0.0d0 - t2dy=0.0d0 - t2dz=0.0d0 - - do j = ishiftca+1, ilastca - - if (n1atom.eq.j) cycle - - jix=c(1,j)-c(1,n1atom) - jiy=c(2,j)-c(2,n1atom) - jiz=c(3,j)-c(3,n1atom) - dist=sqrt(jix*jix+jiy*jiy+jiz*jiz) - -c write(*,*) n1atom, j, dist - - if(kshnum.ne.1)then - if (dist.lt.s1(kshnum).and. - & dist.gt.s2(kshnum-1)) then - - tmp_n=tmp_n+1.0d0 - -c write(*,*) 'case1:',tmp_n - - t1dx=t1dx+0.0d0 - t1dy=t1dy+0.0d0 - t1dz=t1dz+0.0d0 - t2dx(j)=0.0d0 - t2dy(j)=0.0d0 - t2dz(j)=0.0d0 - - elseif(dist.ge.s1(kshnum).and. - & dist.le.s2(kshnum)) then - - dnei=(dist-s1(kshnum))/dr2*pai - tmp_n=tmp_n + half*(1+cos(dnei)) -c write(*,*) 'case2:',tmp_n - ftmp=-pai*sin(dnei)/dr2/dist/2.0d0 -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp -c - elseif(dist.ge.s1(kshnum-1).and. - & dist.le.s2(kshnum-1)) then - dnei=(dist-s1(kshnum-1))/dr2*pai - tmp_n=tmp_n + 1.0d0 - half*(1+cos(dnei)) -c write(*,*) 'case3:',tmp_n - ftmp = hpai*sin(dnei)/dr2/dist -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp - - endif - - elseif(kshnum.eq.1) then - - if(dist.lt.s1(kshnum))then - - tmp_n=tmp_n+1.0d0 -c write(*,*) 'case4:',tmp_n - t1dx=t1dx+0.0d0 - t1dy=t1dy+0.0d0 - t1dz=t1dz+0.0d0 - t2dx(j)=0.0d0 - t2dy(j)=0.0d0 - t2dz(j)=0.0d0 - - elseif(dist.ge.s1(kshnum).and. - & dist.le.s2(kshnum))then - - dnei=(dist-s1(kshnum))/dr2*pai - tmp_n=tmp_n + half*(1+cos(dnei)) -c write(*,*) 'case5:',tmp_n - ftmp = -hpai*sin(dnei)/dr2/dist -c center atom - t1dx=t1dx+jix*ftmp - t1dy=t1dy+jiy*ftmp - t1dz=t1dz+jiz*ftmp -c neighbor atoms - t2dx(j)=-jix*ftmp - t2dy(j)=-jiy*ftmp - t2dz(j)=-jiz*ftmp - - endif - endif - enddo - - scc=0.0d0 - enei=0.0d0 - tmp_fnei=0.0d0 - ndiff=0.0d0 - - do imin=1,ineinum(i) - - ndiff = tmp_n-fnei(i,imin) - dtmp = ndiff*ndiff - - if (dtmp.ge.15.0d0) then - ntmp = 0.0d0 - else -c ntmp = dfaexp( idint(dtmp*1000) + 1 ) - ntmp = exp(-dtmp) - end if - - enei=enei+sccnei(i,imin)*ntmp - tmp_fnei=tmp_fnei- - & sccnei(i,imin)*ntmp*ndiff*2.0d0 - scc=scc+sccnei(i,imin) - -c write(*,'(a,1x,2i8,f12.7,i8,3f12.7)')'NEI:',i,imin,tmp_n, -c & fnei(i,imin),sccnei(i,imin),enei,scc - enddo - - enei=-enei/scc*snorm_nei*nei_inc*wwnei - tmp_fnei=tmp_fnei/scc*snorm_nei*nei_inc*wwnei - -c if (abs(enei).lt.1.0d-20)then -c enei=0.0d0 -c endif -c if (abs(tmp_fnei).lt.1.0d-20) then -c tmp_fnei=0.0d0 -c endif - -c force calculation - t1dx=t1dx*tmp_fnei - t1dy=t1dy*tmp_fnei - t1dz=t1dz*tmp_fnei - - do j=ishiftca+1,ilastca - t2dx(j)=t2dx(j)*tmp_fnei - t2dy(j)=t2dy(j)*tmp_fnei - t2dz(j)=t2dz(j)*tmp_fnei - enddo - - gdfan(1,n1atom)=gdfan(1,n1atom)+t1dx - gdfan(2,n1atom)=gdfan(2,n1atom)+t1dy - gdfan(3,n1atom)=gdfan(3,n1atom)+t1dz - - do j=ishiftca+1,ilastca - gdfan(1,j)=gdfan(1,j)+t2dx(j) - gdfan(2,j)=gdfan(2,j)+t2dy(j) - gdfan(3,j)=gdfan(3,j)+t2dz(j) - enddo -c energy calculation - - enenei=enenei+enei - - enddo - - edfanei=enenei - - return - end - - subroutine edfab(edfabeta) - - implicit real*8 (a-h,o-z) - - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.DFA' - - real*8 PAI - parameter(PAI=3.14159265358979323846D0) - parameter (maxca=800) -C sheet variables - real*8 bx(maxres),by(maxres),bz(maxres) - real*8 vbet(maxres,maxres) - real*8 shetfx(maxres),shetfy(maxres),shetfz(maxres) - real*8 shefx(maxres,12),shefy(maxres,12),shefz(maxres,12) - real*8 vbeta,vbetp,vbetm - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - real*8 dp45,dm45,w_beta - - real*8 cph(maxca),cth(maxca) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 sth(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - - real*8 atxnum(maxca),atynum(maxca),atznum(maxca), - & astxnum(maxca),astynum(maxca),astznum(maxca), - & atmxnum(maxca),atmynum(maxca),atmznum(maxca), - & astmxnum(maxca),astmynum(maxca),astmznum(maxca), - & atmmxnum(maxca),atmmynum(maxca),atmmznum(maxca), - & astmmxnum(maxca),astmmynum(maxca),astmmznum(maxca), - & atm3xnum(maxca),atm3ynum(maxca),atm3znum(maxca), - & astm3xnum(maxca),astm3ynum(maxca),astm3znum(maxca), - & cth_orig(maxca),sth_orig(maxca) - - common /sheca/ bx,by,bz - common /shee/ vbeta,vbet,vbetp,vbetm - common /shetf/ shetfx,shetfy,shetfz - common /shef/ shefx, shefy, shefz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - $ atmmz,atm3x,atm3y,atm3z - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - $ astmmz,astm3x,astm3y,astm3z - - common /coscos/ cph,cth - common /sinsin/ sth - -C End of sheet variables - - integer i,j - double precision enebet - - enebet=0.0d0 - bx=0.0d0;by=0.0d0;bz=0.0d0 - shetfx=0.0d0;shetfy=0.0d0;shetfz=0.0d0 - - gdfab=0.0d0 - - do i=ishiftca+1,ilastca - bx(i-ishiftca)=c(1,i) - by(i-ishiftca)=c(2,i) - bz(i-ishiftca)=c(3,i) - enddo - -c do i=1,ilastca-ishiftca -c read(99,*) bx(i),by(i),bz(i) -c enddo -c close(99) - - dca=0.25d0**2 - dshe=0.3d0**2 - ULHB=5.0D0 - ULDHB=5.0D0 - ULNEX=COS(60.0D0/180.0D0*PAI) - - DLHB=1.0D0 - DLDHB=1.0D0 - - DNEX=0.3D0**2 - - C00=COS((1.0D0+10.0D0/180.0D0)*PAI) - S00=SIN((1.0D0+10.0D0/180.0D0)*PAI) - - W_BETA=0.5D0 - DP45=W_BETA - DM45=W_BETA - -C END OF INITIALIZATION - - nca=ilastca-ishiftca - - call angvectors(nca) - call sheetforce(nca,wshet) - -c end of sheet energy and force - - do j=1,nca - shetfx(j)=shetfx(j)*beta_inc - shetfy(j)=shetfy(j)*beta_inc - shetfz(j)=shetfz(j)*beta_inc -c write(*,*)'SHETF:',shetfx(j),shetfy(j),shetfz(j) - enddo - - vbeta=vbeta*beta_inc - enebet=vbeta - edfabeta=enebet - - do j=1,nca - gdfab(1,j+ishiftca)=gdfab(1,j+ishiftca)-shetfx(j) - gdfab(2,j+ishiftca)=gdfab(2,j+ishiftca)-shetfy(j) - gdfab(3,j+ishiftca)=gdfab(3,j+ishiftca)-shetfz(j) - enddo - -#ifdef DEBUG1 - do j=1,nca - write(*,'(5x,i5,10x,3f10.5)') j,bx(j),by(j),bz(j) - enddo - - - gdfab=0 - dinc=0.001 - do j=1,nca - cth_orig(j)=cth(j) - sth_orig(j)=sth(j) - enddo - - do j=1,nca - - bx(j)=bx(j)+dinc - call angvectors(nca) - bx(j)=bx(j)-2*dinc - call angvectors(nca) - atxnum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astxnum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmxnum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmxnum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmxnum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmxnum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3xnum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3xnum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - bx(j)=bx(j)+dinc - by(j)=by(j)+dinc - call angvectors(nca) - by(j)=by(j)-2*dinc - call angvectors(nca) - by(j)=by(j)+dinc - atynum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astynum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmynum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmynum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmynum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmynum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3ynum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3ynum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - - bz(j)=bz(j)+dinc - call angvectors(nca) - bz(j)=bz(j)-2*dinc - call angvectors(nca) - bz(j)=bz(j)+dinc - - atznum(j)=0.5*(cth(j)-cth_orig(j))/dinc - astznum(j)=0.5*(sth(j)-sth_orig(j))/dinc - if (j.gt.1) then - atmznum(j)=0.5*(cth(j-1)-cth_orig(j-1))/dinc - astmznum(j)=0.5*(sth(j-1)-sth_orig(j-1))/dinc - endif - if (j.gt.2) then - atmmznum(j)=0.5*(cth(j-2)-cth_orig(j-2))/dinc - astmmznum(j)=0.5*(sth(j-2)-sth_orig(j-2))/dinc - endif - if (j.gt.3) then - atm3znum(j)=0.5*(cth(j-3)-cth_orig(j-3))/dinc - astm3znum(j)=0.5*(sth(j-3)-sth_orig(j-3))/dinc - endif - - enddo - - do i=1,nca - write (*,'(2i5,a2,6f10.5)') - & i,1,"x",atxnum(i),atx(i),atxnum(i)/atx(i), - & astxnum(i),astx(i),astxnum(i)/astx(i), - & i,1,"y",atynum(i),aty(i),atynum(i)/aty(i), - & astynum(i),asty(i),astynum(i)/asty(i), - & i,1,"z",atznum(i),atz(i),atznum(i)/atz(i), - & astznum(i),astz(i),astznum(i)/astz(i), - & i,2,"x",atmxnum(i),atmx(i),atmxnum(i)/atmx(i), - & astmxnum(i),astmx(i),astmxnum(i)/astmx(i), - & i,2,"y",atmynum(i),atmy(i),atmynum(i)/atmy(i), - & astmynum(i),astmy(i),astmynum(i)/astmy(i), - & i,2,"z",atmznum(i),atmz(i),atmznum(i)/atmz(i), - & astmznum(i),astmz(i),astmznum(i)/astmz(i), - & i,3,"x",atmmxnum(i),atmmx(i),atmmxnum(i)/atmmx(i), - & astmmxnum(i),astmmx(i),astmmxnum(i)/astmmx(i), - & i,3,"y",atmmynum(i),atmmy(i),atmmynum(i)/atmmy(i), - & astmmynum(i),astmmy(i),astmmynum(i)/astmmy(i), - & i,3,"z",atmmznum(i),atmmz(i),atmmznum(i)/atmmz(i), - & astmmznum(i),astmmz(i),astmmznum(i)/astmmz(i), - & i,4,"x",atm3xnum(i),atm3x(i),atm3xnum(i)/atm3x(i), - & astm3xnum(i),astm3x(i),astm3xnum(i)/astm3x(i), - & i,4,"y",atm3ynum(i),atm3y(i),atm3ynum(i)/atm3y(i), - & astm3ynum(i),astm3y(i),astm3ynum(i)/astm3y(i), - & i,4,"z",atm3znum(i),atm3z(i),atm3znum(i)/atm3z(i), - & astm3znum(i),astm3z(i),astm3znum(i)/astm3z(i), - & i,0," ",cth_orig(i),sth_orig(i) - enddo - - - gdfab=0 - dinc=0.001 - - do j=1,nca - - bx(j)=bx(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - bx(j)=bx(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(1,j)=(vbeta2-vbeta1)/dinc/2 - bx(j)=bx(j)+dinc - - by(j)=by(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - by(j)=by(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(2,j)=(vbeta2-vbeta1)/dinc/2 - by(j)=by(j)+dinc - - bz(j)=bz(j)+dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta1=vbeta*beta_inc - bz(j)=bz(j)-2*dinc - call angvectors(nca) - call sheetforce(nca,wshet) - vbeta2=vbeta*beta_inc - gdfab(3,j)=(vbeta2-vbeta1)/dinc/2 - bz(j)=bz(j)+dinc - - - enddo - - - call angvectors(nca) - call sheetforce(nca,wshet) - do j=1,nca - shetfx(j)=shetfx(j)*beta_inc - shetfy(j)=shetfy(j)*beta_inc - shetfz(j)=shetfz(j)*beta_inc - enddo - - - write(*,*) 'xyz analytical and numerical gradient' - do j=1,nca - write(*,'(5x,i5,10x,6f10.5)') j,-shetfx(j),-shetfy(j),-shetfz(j) - & ,(-gdfab(i,j),i=1,3) - enddo - - do j=1,nca - write(*,'(5x,i5,10x,3f10.2)') j,shetfx(j)/gdfab(1,j), - & shetfy(j)/gdfab(2,j), - & shetfz(j)/gdfab(3,j) - enddo - - stop -#endif - - return - end -C------------------------------------------------------------------------------- - subroutine angvectors(nca) -c implicit real*4(a-h,o-z) - implicit none - integer nca - integer maxca - parameter(maxca=800) - real*8 pai,zero - parameter(PAI=3.14159265358979323846D0,zero=0.0d0) - - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 apx(maxca),apy(maxca),apz(maxca) - real*8 apmx(maxca),apmy(maxca),apmz(maxca) - real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) - real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 cph(maxca),cth(maxca) - real*8 ulcos(maxca) - real*8 p,c - integer i, ip, ipp, ip3, j - real*8 rx(maxca, maxca), ry(maxca, maxca), rz(maxca, maxca) - real*8 rix, riy, riz, ripx, ripy, ripz, rippx, rippy, rippz - real*8 gix, giy, giz, gipx, gipy, gipz, gippx, gippy, gippz - real*8 cix, ciy, ciz, cipx, cipy, cipz - real*8 gpcrp_x, gpcrp_y, gpcrp_z, d_gpcrp, gpcrp__g - real*8 d10, d11, d12, d13, d20, d21, d22, d23, d24 - real*8 d30, d31, d32, d33, d34, d35, d40, d41, d42, d43 - real*8 d_gcr, d_gcr3, d_gmcrim,d_gmcrim3,dgmmcrimm,d_gmmcrimm3 - real*8 dg, dg3, dg30, dgm, dgm3, dgmm, dgmm3, dgp, dri - real*8 dri3, drim, drim3, drimm, drip, dripp, g3gmm, g3rim - real*8 g3x, g3y, g3z, d_gmmcrimm, g3rim_,gcr__gm - real*8 gcr_x,gcr_y,gcr_z,ggm,ggp,gmcrim__gmm - real*8 gmcrim_x,gmcrim_y,gmcrim_z,gmmcrimm__gmmm - real*8 gmmcrimm_x,gmmcrimm_y,gmmcrimm_z,gmmgm,gmmr - real*8 gmmx,gmmy,gmmz,gmrp,gmx,gmy,gmz,gpx,gpy,gpz - real*8 grpp,gx,gy,gz - real*8 rim3x,rim3y,rim3z,rimmx,rimmy,rimmz,rimx,rimy,rimz - real*8 sd10,sd11,sd20,sd21,sd22,sd30,sd31,sd32,sd40,sd41 - integer inb,nmax,iselect - - common /sheca/ bx,by,bz - common /difvec/ rx, ry, rz - common /ulang/ ulcos - common /phys1/ inb,nmax,iselect - common /phys4/ p,c - common /kyori2/ dis - common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, - & apmmz,apm3x,apm3y,apm3z - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - & atmmz,atm3x,atm3y,atm3z - common /coscos/ cph,cth - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - & astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth -C------------------------------------------------------------------------------- -c write(*,*) 'inside angvectors' -C initialize - p=0.1d0 - c=1.0d0 - inb=nca - cph=zero; cth=zero; sth=zero - apx=zero;apy=zero;apz=zero;apmx=zero;apmy=zero;apmz=zero - apmmx=zero;apmmy=zero;apmmz=zero;apm3x=zero;apm3y=zero;apm3z=zero - atx=zero;aty=zero;atz=zero;atmx=zero;atmy=zero;atmz=zero - atmmx=zero;atmmy=zero;atmmz=zero;atm3x=zero;atm3y=zero;atm3z=zero - astx=zero;asty=zero;astz=zero;astmx=zero;astmy=zero;astmz=zero - astmmx=zero;astmmy=zero;astmmz=zero;astm3x=zero;astm3y=zero - astm3z=zero -C end of initialize -C r[x,y,z] calc and distance calculation - rx=zero;ry=zero;rz=zero - - do i=1,inb - do j=1,inb - rx(i,j)=bx(j)-bx(i) - ry(i,j)=by(j)-by(i) - rz(i,j)=bz(j)-bz(i) - dis(i,j)=sqrt(rx(i,j)**2+ry(i,j)**2+rz(i,j)**2) -c write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) -c write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) -c write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) -c write(*,*) 'dis(i,j):',i,j,dis(i,j) - enddo - enddo -c end of r[x,y,z] calc -C cos calc - do i=1,inb-2 - ip=i+1 - ipp=i+2 - - if(dis(i,ip).ge.1.0e-8.and.dis(ip,ipp).ge.1.0e-8) then - ulcos(i)=rx(i,ip)*rx(ip,ipp)+ry(i,ip)*ry(ip,ipp) - $ +rz(i,ip)*rz(ip,ipp) - ulcos(i)=ulcos(i)/(dis(i,ip)*dis(ip,ipp)) - endif - enddo -c end of virtual bond angle -c write(*,*) 'inside angvectors1' -crc do i=1,inb-3 - do i=1,inb - ip=i+1 - ipp=i+2 - ip3=i+3 - rix=bx(ip)-bx(i) - riy=by(ip)-by(i) - riz=bz(ip)-bz(i) - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - rippx=bx(ip3)-bx(ipp) - rippy=by(ip3)-by(ipp) - rippz=bz(ip3)-bz(ipp) - - gx=riy*ripz-riz*ripy - gy=riz*ripx-rix*ripz - gz=rix*ripy-riy*ripx - gpx=ripy*rippz-ripz*rippy - gpy=ripz*rippx-ripx*rippz - gpz=ripx*rippy-ripy*rippx - gpcrp_x=gpy*ripz-gpz*ripy - gpcrp_y=gpz*ripx-gpx*ripz - gpcrp_z=gpx*ripy-gpy*ripx - d_gpcrp=sqrt(gpcrp_x**2+gpcrp_y**2+gpcrp_z**2) - gpcrp__g=gx*gpy*ripz+gpx*ripy*gz+ripx*gpz*gy - & -gz*gpy*ripx-gpz*ripy*gx-ripz*gpx*gy - - if(i.ge.2) then - rimx=bx(i)-bx(i-1) - rimy=by(i)-by(i-1) - rimz=bz(i)-bz(i-1) - gmx=rimy*riz-rimz*riy - gmy=rimz*rix-rimx*riz - gmz=rimx*riy-rimy*rix - dgm=sqrt(gmx**2+gmy**2+gmz**2) - dgm3=dgm**3 - ggm=gmx*gx+gmy*gy+gmz*gz - gmrp=gmx*ripx+gmy*ripy+gmz*ripz - drim=dis(i-1,i) - drim3=drim**3 - gcr_x=gy*riz-gz*riy - gcr_y=gz*rix-gx*riz - gcr_z=gx*riy-gy*rix - d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) - d_gcr3=d_gcr**3 - gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy - & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy - endif -c write(*,*) 'inside angvectors2' - if(i.ge.3) then - rimmx=bx(i-1)-bx(i-2) - rimmy=by(i-1)-by(i-2) - rimmz=bz(i-1)-bz(i-2) - drimm=dis(i-2,i-1) - gmmx=rimmy*rimz-rimmz*rimy - gmmy=rimmz*rimx-rimmx*rimz - gmmz=rimmx*rimy-rimmy*rimx - dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) - dgmm3=dgmm**3 - gmmgm=gmmx*gmx+gmmy*gmy+gmmz*gmz - gmmr=gmmx*rix+gmmy*riy+gmmz*riz - gmcrim_x=gmy*rimz-gmz*rimy - gmcrim_y=gmz*rimx-gmx*rimz - gmcrim_z=gmx*rimy-gmy*rimx - d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) - d_gmcrim3=d_gmcrim**3 - gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy - & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy - endif - - if(i.ge.4) then - rim3x=bx(i-2)-bx(i-3) - rim3y=by(i-2)-by(i-3) - rim3z=bz(i-2)-bz(i-3) - g3x=rim3y*rimmz-rim3z*rimmy - g3y=rim3z*rimmx-rim3x*rimmz - g3z=rim3x*rimmy-rim3y*rimmx - dg30=sqrt(g3x**2+g3y**2+g3z**2) - g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz - g3rim_=g3x*rimx+g3y*rimy+g3z*rimz -cc********************************************************************** - gmmcrimm_x=gmmy*rimmz-gmmz*rimmy - gmmcrimm_y=gmmz*rimmx-gmmx*rimmz - gmmcrimm_z=gmmx*rimmy-gmmy*rimmx - d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) - d_gmmcrimm3=d_gmmcrimm**3 - gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y - & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y - endif - - dri=dis(i,i+1) - drip=dis(i+1,i+2) - dripp=dis(i+2,i+3) - dri3=dri**3 - dg=sqrt(gx**2+gy**2+gz**2) - dgp=sqrt(gpx**2+gpy**2+gpz**2) - dg3=dg**3 - - ggp=gx*gpx+gy*gpy+gz*gpz - grpp=gx*rippx+gy*rippy+gz*rippz - - if(dg.gt.0.0D0.and.dripp.gt.0.0D0.and.dgp.gt.0.0D0 - & .and.d_gpcrp.gt.0.0D0) then - cph(i)=grpp/dg/dripp - cth(i)=ggp/dg/dgp - sth(i)=gpcrp__g/d_gpcrp/dg - else -c - cph(i)=1.0D0 - cth(i)=1.0D0 - sth(i)=0.0D0 - endif - -c write(*,*) 'inside angvectors3' - - if(dgp.gt.0.0D0.and.dg3.gt.0.0D0 - & .and.dripp.gt.0.0D0.and.d_gpcrp.gt.0.0D0) then - d10=1.0D0/(dg*dgp) - d11=ggp/(dg3*dgp) - d12=1.0D0/(dg*dripp) - d13=grpp/(dg3*dripp) - sd10=1.0D0/(d_gpcrp*dg) - sd11=gpcrp__g/(d_gpcrp*dg3) - else - d10=0.0D0 - d11=0.0D0 - d12=0.0D0 - d13=0.0D0 - sd10=0.0D0 - sd11=0.0D0 - endif - - atx(i)=(ripz*gpy-ripy*gpz)*d10 - & -(gy*ripz-gz*ripy)*d11 - aty(i)=(ripx*gpz-ripz*gpx)*d10 - & -(gz*ripx-gx*ripz)*d11 - atz(i)=(ripy*gpx-ripx*gpy)*d10 - & -(gx*ripy-gy*ripx)*d11 - astx(i)=sd10*(-gpx*ripy**2+ripx*gpz*ripz - & +ripy*gpy*ripx-gpx*ripz**2) - & -sd11*(gy*ripz-gz*ripy) - asty(i)=sd10*(-gpy*ripz**2+gpx*ripy*ripx - & -gpy*ripx**2+gpz*ripy*ripz) - & -sd11*(-gx*ripz+gz*ripx) - astz(i)=sd10*(ripy*gpy*ripz-gpz*ripx**2 - & -gpz*ripy**2+ripz*gpx*ripx) - & -sd11*(gx*ripy-gy*ripx) - apx(i)=(ripz*rippy-ripy*rippz)*d12 - & -(gy*ripz-gz*ripy)*d13 - apy(i)=(ripx*rippz-ripz*rippx)*d12 - & -(gz*ripx-gx*ripz)*d13 - apz(i)=(ripy*rippx-ripx*rippy)*d12 - & -(gx*ripy-gy*ripx)*d13 - - if(i.ge.2) then - cix=bx(ip)-bx(i-1) - ciy=by(ip)-by(i-1) - ciz=bz(ip)-bz(i-1) - cipx=bx(ipp)-bx(i) - cipy=by(ipp)-by(i) - cipz=bz(ipp)-bz(i) - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - if(dgm3.gt.0.0D0.and.dg3.gt.0.0D0.and.drip.gt.0.0D0 - & .and.d_gcr3.gt.0.0D0) then - d20=1.0D0/(dg*dgm) - d21=ggm/(dgm3*dg) - d22=ggm/(dgm*dg3) - d23=1.0D0/(dgm*drip) - d24=gmrp/(dgm3*drip) - sd20=1.0D0/(d_gcr*dgm) - sd21=gcr__gm/(d_gcr3*dgm) - sd22=gcr__gm/(d_gcr*dgm3) - else - d20=0.0D0 - d21=0.0D0 - d22=0.0D0 - d23=0.0D0 - d24=0.0D0 - sd20=0.0D0 - sd21=0.0D0 - sd22=0.0D0 - endif - atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 - & -(ciy*gmz-ciz*gmy)*d21 - & +(ripy*gz-ripz*gy)*d22 - atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 - & -(ciz*gmx-cix*gmz)*d21 - & +(ripz*gx-ripx*gz)*d22 - atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 - & -(cix*gmy-ciy*gmx)*d21 - & +(ripx*gy-ripy*gx)*d22 -cc********************************************************************** - astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy - & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix - & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) - & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) - & +gcr_z*(-ripz*rix+gy)) - & -sd22*(-gmy*ciz+gmz*ciy) - - astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix - & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz - & +riz*ripz*gmy) - & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) - & -gcr_z*(ripz*riy+gx)) - & -sd22*(gmx*ciz-gmz*cix) - - astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz - & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy - & -riz*gx*cix) - & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) - & +gcr_z*(ripy*riy+ripx*rix)) - & -sd22*(-gmx*ciy+gmy*cix) -cc********************************************************************** - apmx(i)=(ciy*ripz-ripy*ciz)*d23 - & -(ciy*gmz-ciz*gmy)*d24 - apmy(i)=(ciz*ripx-ripz*cix)*d23 - & -(ciz*gmx-cix*gmz)*d24 - apmz(i)=(cix*ripy-ripx*ciy)*d23 - & -(cix*gmy-ciy*gmx)*d24 - endif - - if(i.ge.3) then - if(dgm3.gt.0.0D0.and.dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 - & .and.d_gmcrim3.gt.0.0D0) then - d30=1.0D0/(dgm*dgmm) - d31=gmmgm/(dgm3*dgmm) - d32=gmmgm/(dgm*dgmm3) - d33=1.0D0/(dgmm*dri) - d34=gmmr/(dgmm3*dri) - d35=gmmr/(dgmm*dri3) - sd30=1.0D0/(d_gmcrim*dgmm) - sd31=gmcrim__gmm/(d_gmcrim3*dgmm) - sd32=gmcrim__gmm/(d_gmcrim*dgmm3) - else - d30=0.0D0 - d31=0.0D0 - d32=0.0D0 - d33=0.0D0 - d34=0.0D0 - d35=0.0D0 - sd30=0.0D0 - sd31=0.0D0 - sd32=0.0D0 - endif - -c write(*,*) 'inside angvectors4' - -cc********************************************************************** - atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 - & -(ciy*gmz-ciz*gmy)*d31 - & -(gmmy*rimmz-gmmz*rimmy)*d32 - atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 - & -(ciz*gmx-cix*gmz)*d31 - & -(gmmz*rimmx-gmmx*rimmz)*d32 - atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 - & -(cix*gmy-ciy*gmx)*d31 - & -(gmmx*rimmy-gmmy*rimmx)*d32 -cc********************************************************************** - astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy - & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz - & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy - & -ciy*rimy*gmmx-rimz*gmx*rimmz) - & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) - & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) - & -sd32*(gmmy*rimmz-rimmy*gmmz) - - astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz - & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy - & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx - & +gmz*rimy*rimmz-rimz*ciz*gmmy) - & -sd31*(gmcrim_x*(cix*rimy-gmz) - & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) - & -sd32*(-gmmx*rimmz+rimmx*gmmz) - - astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz - & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx - & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy - & +rimz*ciy*gmmy+rimz*gmx*rimmx) - & -sd31*(gmcrim_x*(cix*rimz+gmy) - & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) - & -sd32*(gmmx*rimmy-rimmx*gmmy) -c********************************************************************** - apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 - & -(gmmy*rimmz-gmmz*rimmy)*d34 - & +rix*d35 - apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 - & -(gmmz*rimmx-gmmx*rimmz)*d34 - & +riy*d35 - apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 - & -(gmmx*rimmy-gmmy*rimmx)*d34 - & +riz*d35 - endif - - if(i.ge.4) then - if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 - & .and.drim3.gt.0.0D0 - & .and.d_gmmcrimm3.gt.0.0D0) then - d40=1.0D0/(dg30*dgmm) - d41=g3gmm/(dg30*dgmm3) - d42=1.0D0/(dg30*drim) - d43=g3rim_/(dg30*drim3) - sd40=1.0D0/(dg30*d_gmmcrimm) - sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) - else - d40=0.0D0 - d41=0.0D0 - d42=0.0D0 - d43=0.0D0 - sd40=0.0D0 - sd41=0.0D0 - endif - atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 - & -(gmmy*rimmz-gmmz*rimmy)*d41 - atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 - & -(gmmz*rimmx-gmmx*rimmz)*d41 - atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 - & -(gmmx*rimmy-gmmy*rimmx)*d41 -cc********************************************************************** - astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y - & -g3z*rimmz*rimmx+rimmy**2*g3x) - & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) - & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) - - astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y - & -rimmx*rimmy*g3x+rimmz**2*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmy - & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmy) - -c & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) - - astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z - & +g3z*rimmx**2-rimmz*rimmy*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz - & +gmmcrimm_z*(rimmy**2+rimmx**2)) -c********************************************************************** - apm3x(i)=g3x*d42-rimx*d43 - apm3y(i)=g3y*d42-rimy*d43 - apm3z(i)=g3z*d42-rimz*d43 - endif - enddo -c******************************************************************************* - -c write(*,*) 'inside angvectors5' - -c do i=inb-2,inb - do i=1,0 - rimx=bx(i)-bx(i-1) - rimy=by(i)-by(i-1) - rimz=bz(i)-bz(i-1) - rimmx=bx(i-1)-bx(i-2) - rimmy=by(i-1)-by(i-2) - rimmz=bz(i-1)-bz(i-2) - rim3x=bx(i-2)-bx(i-3) - rim3y=by(i-2)-by(i-3) - rim3z=bz(i-2)-bz(i-3) - gmmx=rimmy*rimz-rimmz*rimy - gmmy=rimmz*rimx-rimmx*rimz - gmmz=rimmx*rimy-rimmy*rimx - g3x=rim3y*rimmz-rim3z*rimmy - g3y=rim3z*rimmx-rim3x*rimmz - g3z=rim3x*rimmy-rim3y*rimmx - - dg30=sqrt(g3x**2+g3y**2+g3z**2) - g3gmm=g3x*gmmx+g3y*gmmy+g3z*gmmz - dgmm=sqrt(gmmx**2+gmmy**2+gmmz**2) - dgmm3=dgmm**3 - drim=dis(i-1,i) - drimm=dis(i-2,i-1) - drim3=drim**3 - g3rim_=g3x*rimx+g3y*rimy+g3z*rimz -cc********************************************************************** - gmmcrimm_x=gmmy*rimmz-gmmz*rimmy - gmmcrimm_y=gmmz*rimmx-gmmx*rimmz - gmmcrimm_z=gmmx*rimmy-gmmy*rimmx - d_gmmcrimm=sqrt(gmmcrimm_x**2+gmmcrimm_y**2+gmmcrimm_z**2) - d_gmmcrimm3=d_gmmcrimm**3 - gmmcrimm__gmmm=g3x*gmmy*rimmz+gmmx*rimmy*g3z+rimmx*gmmz*g3y - & -g3z*gmmy*rimmx-gmmz*rimmy*g3x-rimmz*gmmx*g3y - - if(dg30.gt.0.0D0.and.dgmm3.gt.0.0D0 - & .and.drim3.gt.0.0D0 - & .and.d_gmmcrimm3.gt.0.0D0) then - d40=1.0D0/(dg30*dgmm) - d41=g3gmm/(dg30*dgmm3) - d42=1.0D0/(dg30*drim) - d43=g3rim_/(dg30*drim3) - sd40=1.0D0/(dg30*d_gmmcrimm) - sd41=gmmcrimm__gmmm/(d_gmmcrimm3*dg30) - else - d40=0.0D0 - d41=0.0D0 - d42=0.0D0 - d43=0.0D0 - sd40=0.0D0 - sd41=0.0D0 - endif - atm3x(i)=(g3y*rimmz-g3z*rimmy)*d40 - & -(gmmy*rimmz-gmmz*rimmy)*d41 - atm3y(i)=(g3z*rimmx-g3x*rimmz)*d40 - & -(gmmz*rimmx-gmmx*rimmz)*d41 - atm3z(i)=(g3x*rimmy-g3y*rimmx)*d40 - & -(gmmx*rimmy-gmmy*rimmx)*d41 -cc********************************************************************** - astm3x(i)=sd40*(g3x*rimmz**2-rimmx*rimmy*g3y - & -g3z*rimmz*rimmx+rimmy**2*g3x) - & -sd41*(gmmcrimm_x*(rimmz**2+rimmy**2) - & -gmmcrimm_y*rimmy*rimmx-gmmcrimm_z*rimmz*rimmx) - - astm3y(i)=sd40*(-rimmz*rimmy*g3z+rimmx**2*g3y - & -rimmx*rimmy*g3x+rimmz**2*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmy - & +gmmcrimm_y*(rimmx**2+rimmz**2)-gmmcrimm_z*rimmz*rimmx) - - astm3z(i)=sd40*(-g3x*rimmx*rimmz+rimmy**2*g3z - & +g3z*rimmx**2-rimmz*rimmy*g3y) - & -sd41*(-gmmcrimm_x*rimmx*rimmz-gmmcrimm_y*rimmy*rimmz - & +gmmcrimm_z*(rimmy**2+rimmx**2)) -cc********************************************************************** - apm3x(i)=g3x*d42-rimx*d43 - apm3y(i)=g3y*d42-rimy*d43 - apm3z(i)=g3z*d42-rimz*d43 - - if(i.le.inb-1) then - ip=i+1 - rix=bx(ip)-bx(i) - riy=by(ip)-by(i) - riz=bz(ip)-bz(i) - cix=bx(ip)-bx(i-1) - ciy=by(ip)-by(i-1) - ciz=bz(ip)-bz(i-1) - gmx=rimy*riz-rimz*riy - gmy=rimz*rix-rimx*riz - gmz=rimx*riy-rimy*rix - dgm=sqrt(gmx**2+gmy**2+gmz**2) - dgm3=dgm**3 - dri=dis(i,i+1) - dri3=dri**3 - gmmgm=gmmx*gmx+gmmy*gmy+gmmz+gmz - gmmr=gmmx*rix+gmmy*riy+gmmz*riz - gmcrim_x=gmy*rimz-gmz*rimy - gmcrim_y=gmz*rimx-gmx*rimz - gmcrim_z=gmx*rimy-gmy*rimx - d_gmcrim=sqrt(gmcrim_x**2+gmcrim_y**2+gmcrim_z**2) - d_gmcrim3=d_gmcrim**3 - gmcrim__gmm=gmmx*gmy*rimz+gmx*rimy*gmmz+rimx*gmz*gmmy - & -gmmz*gmy*rimx-gmz*rimy*gmmx-rimz*gmx*gmmy - - if(dgm3.gt.0.0D0.and. - & dgmm3.gt.0.0D0.and.dri3.gt.0.0D0 - & .and.d_gmcrim3.gt.0.0D0) then - d30=1.0D0/(dgm*dgmm) - d31=gmmgm/(dgm3*dgmm) - d32=gmmgm/(dgm*dgmm3) - d33=1.0D0/(dgmm*dri) - d34=gmmr/(dgmm3*dri) - d35=gmmr/(dgmm*dri3) - sd30=1.0D0/(d_gmcrim*dgmm) - sd31=gmcrim__gmm/(d_gmcrim3*dgmm) - sd32=gmcrim__gmm/(d_gmcrim*dgmm3) - - else - d30=0.0D0 - d31=0.0D0 - d32=0.0D0 - d33=0.0D0 - d34=0.0D0 - d35=0.0D0 - sd30=0.0D0 - sd31=0.0D0 - sd32=0.0D0 - endif -cc********************************************************************** - atmmx(i)=(ciy*gmmz-ciz*gmmy-rimmy*gmz+rimmz*gmy)*d30 - & -(ciy*gmz-ciz*gmy)*d31 - & -(gmmy*rimmz-gmmz*rimmy)*d32 - atmmy(i)=(ciz*gmmx-cix*gmmz-rimmz*gmx+rimmx*gmz)*d30 - & -(ciz*gmx-cix*gmz)*d31 - & -(gmmz*rimmx-gmmx*rimmz)*d32 - atmmz(i)=(cix*gmmy-ciy*gmmx-rimmx*gmy+rimmy*gmx)*d30 - & -(cix*gmy-ciy*gmx)*d31 - & -(gmmx*rimmy-gmmy*rimmx)*d32 -cc********************************************************************** - astmmx(i)=sd30*(-gmmx*ciz*rimz-gmx*rimy*rimmy - & +gmz*gmmy+rimx*ciy*gmmy+rimx*gmz*rimmz - & +rimmy*gmy*rimx+gmmz*ciz*rimx-gmmz*gmy - & -ciy*rimy*gmmx-rimz*gmx*rimmz) - & -sd31*(gmcrim_x*(-ciz*rimz-ciy*rimy) - & +gmcrim_y*(ciy*rimx+gmz)+gmcrim_z*(ciz*rimx-gmy)) - & -sd32*(gmmy*rimmz-rimmy*gmmz) - - astmmy(i)=sd30*(-rimmz*gmy*rimz+ciz*rimy*gmmz - & +gmx*gmmz+gmx*rimy*rimmx-rimx*cix*gmmy - & -rimmx*gmy*rimx+cix*rimy*gmmx-gmz*gmmx - & +gmz*rimy*rimmz-rimz*ciz*gmmy) - & -sd31*(gmcrim_x*(cix*rimy-gmz) - & +gmcrim_y*(-cix*rimx-ciz*rimz)+gmcrim_z*(ciz*rimy+gmx)) - & -sd32*(-gmmx*rimmz+rimmx*gmmz) - - astmmz(i)=sd30*(rimmy*gmy*rimz+gmmx*cix*rimz - & +gmmx*gmy-ciy*rimy*gmmz-rimx*gmz*rimmx - & -gmmz*cix*rimx-gmz*rimy*rimmy-gmx*gmmy - & +rimz*ciy*gmmy+rimz*gmx*rimmx) - & -sd31*(gmcrim_x*(cix*rimz+gmy) - & +gmcrim_y*(ciy*rimz-gmx)+gmcrim_z*(-ciy*rimy-cix*rimx)) - & -sd32*(gmmx*rimmy-rimmx*gmmy) -cc********************************************************************** - apmmx(i)=(riy*rimmz-riz*rimmy-gmmx)*d33 - & -(gmmy*rimmz-gmmz*rimmy)*d34 - & +rix*d35 - apmmy(i)=(riz*rimmx-rix*rimmz-gmmy)*d33 - & -(gmmz*rimmx-gmmx*rimmz)*d34 - & +riy*d35 - apmmz(i)=(rix*rimmy-riy*rimmx-gmmz)*d33 - & -(gmmx*rimmy-gmmy*rimmx)*d34 - & +riz*d35 - endif - -c write(*,*) 'inside angvectors6' - - if(i.eq.inb-2) then - ipp=i+2 - ripx=bx(ipp)-bx(ip) - ripy=by(ipp)-by(ip) - ripz=bz(ipp)-bz(ip) - cipx=bx(ipp)-bx(i) - cipy=by(ipp)-by(i) - cipz=bz(ipp)-bz(i) - gx=riy*ripz-riz*ripy - gy=riz*ripx-rix*ripz - gz=rix*ripy-riy*ripx - ggm=gmx*gx+gmy*gy+gmz*gz - gmrp=gmx*ripx+gmy*ripy+gmz*ripz - dg=sqrt(gx**2+gy**2+gz**2) - dg3=dg**3 - drip=dis(i+1,i+2) - gcr_x=gy*riz-gz*riy - gcr_y=gz*rix-gx*riz - gcr_z=gx*riy-gy*rix - d_gcr=sqrt(gcr_x**2+gcr_y**2+gcr_z**2) - d_gcr3=d_gcr**3 - gcr__gm=gmx*gy*riz+gx*riy*gmz+rix*gz*gmy - & -gmz*gy*rix-gz*riy*gmx-riz*gx*gmy - if(dgm3.gt.0.0D0.and. - & dg3.gt.0.0D0.and.drip.gt.0.0D0.and.d_gcr3.gt.0.0D0 - & ) then - d20=1.0D0/(dg*dgm) - d21=ggm/(dgm3*dg) - d22=ggm/(dgm*dg3) - d23=1.0D0/(dgm*drip) - d24=gmrp/(dgm3*drip) - sd20=1.0D0/(d_gcr*dgm) - sd21=gcr__gm/(d_gcr3*dgm) - sd22=gcr__gm/(d_gcr*dgm3) - else - d20=0.0D0 - d21=0.0D0 - d22=0.0D0 - d23=0.0D0 - d24=0.0D0 - sd20=0.0D0 - sd21=0.0D0 - sd22=0.0D0 - endif - atmx(i)=(ciy*gz-ciz*gy-ripy*gmz+ripz*gmy)*d20 - & -(ciy*gmz-ciz*gmy)*d21 - & +(ripy*gz-ripz*gy)*d22 - atmy(i)=(ciz*gx-cix*gz-ripz*gmx+ripx*gmz)*d20 - & -(ciz*gmx-cix*gmz)*d21 - & +(ripz*gx-ripx*gz)*d22 - atmz(i)=(cix*gy-ciy*gx-ripx*gmy+ripy*gmx)*d20 - & -(cix*gmy-ciy*gmx)*d21 - & +(ripx*gy-ripy*gx)*d22 -cc********************************************************************** - astmx(i)=sd20*(gmx*ripz*riz+gx*riy*ciy-gz*gmy - & -rix*ripy*gmy-rix*gz*ciz-ciy*gy*rix-gmz*ripz*rix - & +gmz*gy+ripy*riy*gmx+riz*gx*ciz) - & -sd21*(gcr_x*(ripz*riz+ripy*riy)+gcr_y*(-ripy*rix-gz) - & +gcr_z*(-ripz*rix+gy)) - & -sd22*(-gmy*ciz+gmz*ciy) - - astmy(i)=sd20*(ciz*gy*riz-ripz*riy*gmz-gx*gmz-gx*riy*cix - & +rix*ripx*gmy+cix*gy*rix-ripx*riy*gmx+gz*gmx-gz*riy*ciz - & +riz*ripz*gmy) - & -sd21*(gcr_x*(-ripx*riy+gz)+gcr_y*(ripx*rix+ripz*riz) - & -gcr_z*(ripz*riy+gx)) - & -sd22*(gmx*ciz-gmz*cix) - - astmz(i)=sd20*(-ciy*gy*riz-gmx*ripx*riz-gmx*gy+ripy*riy*gmz - & +rix*gz*cix+gmz*ripx*rix+gz*riy*ciy+gx*gmy-riz*ripy*gmy - & -riz*gx*cix) - & -sd21*(gcr_x*(-ripx*riz-gy)+gcr_y*(-ripy*riz+gx) - & +gcr_z*(ripy*riy+ripx*rix)) - & -sd22*(-gmx*ciy+gmy*cix) -cc********************************************************************** -c - apmx(i)=(ciy*ripz-ripy*ciz)*d23 - & -(ciy*gmz-ciz*gmy)*d24 - apmy(i)=(ciz*ripx-ripz*cix)*d23 - & -(ciz*gmx-cix*gmz)*d24 - apmz(i)=(cix*ripy-ripx*ciy)*d23 - & -(cix*gmy-ciy*gmx)*d24 - - endif - enddo - - return - end -c END of angvectors -c------------------------------------------------------------------------------- -C--------------------------------------------------------------------------------- - subroutine sheetforce(nca,wshet) - implicit none -C JYLEE -c this should be matched with dfa.fcm - integer maxca - parameter(maxca=800) -cc********************************************************************** - integer nca - integer i,k - integer inb,nmax,iselect - -c real*8 dfaexp(15001) - - real*8 vbeta,vbetp,vbetm - real*8 shefx(maxca,12) - real*8 shefy(maxca,12),shefz(maxca,12) - real*8 shetfx(maxca),shetfy(maxca),shetfz(maxca) - real*8 vbet(maxca,maxca) - real*8 wshet(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - - common /sheca/ bx,by,bz - common /phys1/ inb,nmax,iselect - common /shef/ shefx,shefy,shefz - common /shee/ vbeta,vbet,vbetp,vbetm - common /shetf/ shetfx,shetfy,shetfz - - inb=nca - do i=1,inb - shetfx(i)=0.0D0 - shetfy(i)=0.0D0 - shetfz(i)=0.0D0 - enddo - - do k=1,12 - do i=1,inb - shefx(i,k)=0.0D0 - shefy(i,k)=0.0D0 - shefz(i,k)=0.0D0 - enddo - enddo - - call sheetene(nca,wshet) - call sheetforce1 - - 887 format(a,1x,i6,3x,f12.8) - 888 format(a,1x,i4,1x,i4,3x,f12.8) - 889 format(a,1x,i4,3x,f12.8) - !write(2,*) 'coord : ' - do i=1,inb - !write(2,887) 'bx:',i,bx(i) - !write(2,887) 'by:',i,by(i) - !write(2,887) 'bz:',i,bz(i) - enddo - !write(2,*) 'After sheetforce1' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce5 - - !write(2,*) 'After sheetforce5' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce6 - - !write(2,*) 'After sheetforce6' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce11 - - !write(2,*) 'After sheetforce11' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - call sheetforce12 - - !write(2,*) 'After sheetforce12' - do i=1,inb - do k=1,12 - !write(2,888) 'shefx :',i,k,shefx(i,k) - !write(2,888) 'shefy :',i,k,shefy(i,k) - !write(2,888) 'shefz :',i,k,shefz(i,k) - enddo - enddo - - do i=1,inb - do k=1,12 - shetfx(i)=shetfx(i)+shefx(i,k) - shetfy(i)=shetfy(i)+shefy(i,k) - shetfz(i)=shetfz(i)+shefz(i,k) - enddo - enddo - !write(2,*) 'Beta Finished' - do i=1,inb - !write(2,889) 'shetfx : ',i,shetfx(i) - !write(2,889) 'shetfy : ',i,shetfy(i) - !write(2,889) 'shetfz : ',i,shetfz(i) - enddo - - return - end -C end sheetforce -c------------------------------------------------------------------------------- - subroutine sheetene(nca,wshet) - implicit none - integer maxca - parameter(maxca=800) -cc****************************************************************************** - -c real*8 dfaexp(15001) - real*8 dtmp1, dtmp2, dtmp3 - - real*8 vbet(maxca,maxca) - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 cph(maxca),cth(maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 ulcos(maxca) -cc********************************************************************** - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 wshet(maxca,maxca) - real*8 dp45, dm45, w_beta - real*8 c00, s00, ulnex, dnex, dca,dlhb,ulhb,dshe,dldhb,uldhb - integer nca - integer i,ip,ipp,j,jp,jpp,inb,nmax,iselect - real*8 uum, uup - real*8 vbeta,vbetp,vbetm,y,y1,y2,yshe1,yshe2,yy1,yy2 - - common /sheca/ bx,by,bz - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /coscos/ cph,cth - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - & c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shee/ vbeta,vbet,vbetp,vbetm - common /ulang/ ulcos -cc********************************************************************** - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - & astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth - - real*8 r_pair_mat(maxca,maxca) -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m - common /beta_p/ r_pair_mat -C------------------------------------------------------------------------------- - r_pair_mat = 0.0d0 - do i=1,inb - do j=1,inb - r_pair_mat(i,j)=wshet(i,j) -c write(*,*) 'r_pair_mat :',i,j,r_pair_mat(i,j) - enddo - enddo -c stop -c - vbeta=0.0D0 - vbetp=0.0D0 - vbetm=0.0D0 - - do i=1,inb-7 - do j=i+4,inb-3 - ip=i+1 - ipp=i+2 - jp=j+1 - jpp=j+2 -cc********************************************************************** - y1=(cth(i)*c00+sth(i)*s00-1.0D0)**2 - & +(cth(j)*c00+sth(j)*s00-1.0D0)**2 - y1=-0.5d0*y1/dca - y2=(ulcos(i)-ulnex)**2+(ulcos(ip)-ulnex)**2 - & +(ulcos(j)-ulnex)**2+(ulcos(jp)-ulnex)**2 - y2=-0.5d0*y2/dnex - -cdebug y2=0 - - y=y1+y2 - -ci if(y.ge.-4) then -ci istrand(i,j)=1 -ci else -ci istrand(i,j)=0 -ci endif - -ci if(istrand(i,j).eq.1) then - - yy1=-0.5d0*(dis(ip,jp)-ulhb)**2/dlhb - yy2=-0.5d0*(dis(ipp,jpp)-ulhb)**2/dlhb - - - pin1(i,j)=(rx(ip,jp)*rx(ip,ipp)+ry(ip,jp)*ry(ip,ipp) - $ +rz(ip,jp)*rz(ip,ipp))/(dis(ip,jp)*dis(ip,ipp)) - pin2(i,j)=(rx(ip,jp)*rx(jp,jpp)+ry(ip,jp)*ry(jp,jpp) - $ +rz(ip,jp)*rz(jp,jpp))/(dis(ip,jp)*dis(jp,jpp)) - pin3(i,j)=(rx(ipp,jpp)*rx(ip,ipp)+ry(ipp,jpp)*ry(ip,ipp) - $ +rz(ipp,jpp)*rz(ip,ipp))/(dis(ipp,jpp)*dis(ip,ipp)) - pin4(i,j)=(rx(ipp,jpp)*rx(jp,jpp)+ry(ipp,jpp)*ry(jp,jpp) - $ +rz(ipp,jpp)*rz(jp,jpp))/(dis(ipp,jpp)*dis(jp,jpp)) - - yshe1=pin1(i,j)**2+pin2(i,j)**2 - yshe1=-0.5d0*yshe1/dshe - yshe2=pin3(i,j)**2+pin4(i,j)**2 - yshe2=-0.5d0*yshe2/dshe - -ci if((yshe1+yshe2).ge.-4) then -ci istrand_p(i,j)=1 -ci else -ci istrand_p(i,j)=0 -ci endif - - -C write(*,*) 'rx(i,j):',i,j,rx(i,j),bx(j),bx(i) -C write(*,*) 'ry(i,j):',i,j,ry(i,j),by(j),by(i) -C write(*,*) 'rz(i,j):',i,j,rz(i,j),bz(j),bz(i) -C write(*,*) 'dis(i,j):',i,j,dis(i,j) -C write(*,*) 'rx(ip,jp):',ip,jp,bx(ip),bx(jp),rx(ip,jp) -C write(*,*) 'rx(ip,ipp):',ip,ipp,bx(ip),bx(ipp),rx(ip,ipp) -C write(*,*) 'pin1:',pin1(i,j) -C write(*,*) 'pin2:',pin2(i,j) -C write(*,*) 'pin3:',pin3(i,j) -C write(*,*) 'pin4:',pin4(i,j) - -C write(*,*) 'y:',y -C write(*,*) 'yy1:',yy1 -C write(*,*) 'yy2:',yy2 -C write(*,*) 'yshe1:',yshe1 -C write(*,*) 'yshe2:',yshe2 -c - -ci if (istrand_p(i,j).eq.1) then - -cd yy1=0 -cd yy2=0 -cd yshe1=0 -cd yshe2=0 - dtmp1 = y+yy1+yshe1 - dtmp2 = y+yy2+yshe2 - dtmp3 = y+yy1+yy2+yshe1+yshe2 - -C write(*,*)'1', i,j,dtmp1,dtmp2,dtmp3 -C write(*,*)'2', y,yy1,yy2 -C write(*,*)'3', yshe1,yshe2 - -cc if (dtmp3.le.-35.0d0) then -c vbetap(i,j)=-dp45*exp(dtmp3) -cc vbetap(i,j)=0.0d0 -cc else -c vbetap(i,j)=-dp45*dfaexp(idint(-dtmp3*1000)+1) - vbetap(i,j)=-dp45*exp(dtmp3) -cc end if - -cc if (dtmp1.le.-35.0d0) then -c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) -cc vbetap1(i,j)=0.0d0 -cc else -c vbetap1(i,j)=-r_pair_mat(i+1,j+1) -c $ *dfaexp(idint(-dtmp1*1000)+1) - vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(dtmp1) -cc end if - -cc if (dtmp2.le.-35.0d0) then -C vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) -cc vbetap2(i,j)=0.0d0 -cc else -c vbetap2(i,j)=-r_pair_mat(i+2,j+2) -c $ *dfaexp(idint(-dtmp2*1000)+1) - vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(dtmp2) -cc end if - -c vbetap(i,j)=-dp45*exp(y+yy1+yy2+yshe1+yshe2) -c vbetap1(i,j)=-r_pair_mat(i+1,j+1)*exp(y+yy1+yshe1) -c vbetap2(i,j)=-r_pair_mat(i+2,j+2)*exp(y+yy2+yshe2) - -! write(*,*) 'r_pair_mat>',i+1,j+1,r_pair_mat(i+1,j+1) -! write(*,*) 'r_pair_mat>',i+2,j+2,r_pair_mat(i+2,j+2) - -ci elseif (istrand_p(i,j).eq.0)then -ci vbetap(i,j)=0 -ci vbetap1(i,j)=0 -ci vbetap2(i,j)=0 -ci endif - - yy1=-0.5d0*(dis(ip,jpp)-ulhb)**2/dlhb - yy2=-0.5d0*(dis(ipp,jp)-ulhb)**2/dlhb - - pina1(i,j)=(rx(ip,jpp)*rx(ip,ipp)+ry(ip,jpp)*ry(ip,ipp) - $ +rz(ip,jpp)*rz(ip,ipp))/(dis(ip,jpp)*dis(ip,ipp)) - pina2(i,j)=(rx(ip,jpp)*rx(jp,jpp)+ry(ip,jpp)*ry(jp,jpp) - $ +rz(ip,jpp)*rz(jp,jpp))/(dis(ip,jpp)*dis(jp,jpp)) - pina3(i,j)=(rx(jp,ipp)*rx(ip,ipp)+ry(jp,ipp)*ry(ip,ipp) - $ +rz(jp,ipp)*rz(ip,ipp))/(dis(jp,ipp)*dis(ip,ipp)) - pina4(i,j)=(rx(jp,ipp)*rx(jp,jpp)+ry(jp,ipp)*ry(jp,jpp) - $ +rz(jp,ipp)*rz(jp,jpp))/(dis(jp,ipp)*dis(jp,jpp)) - - yshe1=pina1(i,j)**2+pina2(i,j)**2 - yshe1=-0.5d0*yshe1/dshe - yshe2=pina3(i,j)**2+pina4(i,j)**2 - yshe2=-0.5d0*yshe2/dshe - -ci if((yshe1+yshe2).ge.-4) then -ci istrand_m(i,j)=1 -ci else -ci istrand_m(i,j)=0 -ci endif - - -C write(*,*) 'pina1:',pina1(i,j) -C write(*,*) 'pina2:',pina2(i,j) -C write(*,*) 'pina3:',pina3(i,j) -C write(*,*) 'pina4:',pina4(i,j) -C write(*,*) 'yshe1:',yshe1 -C write(*,*) 'yshe2:',yshe2 -C write(*,*) 'dshe:',dshe - -ci if (istrand_m(i,j).eq.1) then - -cd yy1=0 -cd yy2=0 -cd yshe1=0 -cd yshe2=0 - - dtmp3=y+yy1+yy2+yshe1+yshe2 - dtmp1=y+yy1+yshe1 - dtmp2=y+yy2+yshe2 - -cc if(dtmp3 .le. -35.0d0) then -c vbetam(i,j)=-dm45*exp(dtmp3) -cc vbetam(i,j)=0.0d0 -cc else -c vbetam(i,j)=-dm45*dfaexp(idint(-dtmp3*1000)+1) - vbetam(i,j)=-dm45*exp(dtmp3) -cc end if - -cc if(dtmp1 .le. -35.0d0) then -c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) -cc vbetam1(i,j)=0.0d0 -cc else -c vbetam1(i,j)=-r_pair_mat(i+1,j+2) -c $ *dfaexp(idint(-dtmp1*1000)+1) - vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(dtmp1) -cc end if - -cc if(dtmp2.le.-35.0d0) then -c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) -cc vbetam2(i,j)=0.0d0 -cc else -c vbetam2(i,j)=-r_pair_mat(i+2,j+1) -c $ *dfaexp(idint(-dtmp2*1000)+1) - vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(dtmp2) -cc end if - -ci elseif (istrand_m(i,j).eq.0)then -ci vbetam(i,j)=0 -ci vbetam1(i,j)=0 -ci vbetam2(i,j)=0 -ci endif - - -c vbetam(i,j)=-dm45*exp(y+yy1+yy2+yshe1+yshe2) -c vbetam1(i,j)=-r_pair_mat(i+1,j+2)*exp(y+yy1+yshe1) -c vbetam2(i,j)=-r_pair_mat(i+2,j+1)*exp(y+yy2+yshe2) - -! write(*,*) 'r_pair_mat>',i+1,j+2,r_pair_mat(i+1,j+2) -! write(*,*) 'r_pair_mat>',i+2,j+1,r_pair_mat(i+2,j+1) - - uup = vbetap(i,j)+vbetap1(i,j)+vbetap2(i,j) - uum = vbetam(i,j)+vbetam1(i,j)+vbetam2(i,j) - -c write(*,*) 'uup,uum:', uup, uum - -c uup=vbetap1(i,j)+vbetap2(i,j) -c uum=vbetam1(i,j)+vbetam2(i,j) - - vbet(i,j)=uup+uum - vbetp=vbetp+uup - vbetm=vbetm+uum - vbeta=vbeta+vbet(i,j) - -ci elseif(istrand(i,j).eq.0)then -ci vbet(i,j)=0 -ci endif - -c write(*,*) 'uup,uum:',uup,uum -c write(*,*) 'vbetap(i,j):',vbetap(i,j) -c write(*,*) 'vbetap1(i,j):',vbetap1(i,j) -c write(*,*) 'vbetap2(i,j):',vbetap2(i,j) -c write(*,*) 'vbetam(i,j):',vbetam(i,j) -c write(*,*) 'vbetam1(i,j):',vbetam1(i,j) -c write(*,*) 'vbetam2(i,j):',vbetam2(i,j) -c write(*,*) 'uup:',uup -c write(*,*) 'uum:',uum -c write(*,*) 'vbetp:',vbetp -c write(*,*) 'vbetm:',vbetm -c write(*,*) 'vbet(i,j):',vbet(i,j) -c stop - - enddo - enddo - -! do i=1,inb-7 -! do j=i+4,inb-3 -! write(*,*) 'I,J:', i,j -! write(*,*) 'vbetap(i,j):',vbetap(i,j) -! write(*,*) 'vbetap1(i,j):',vbetap1(i,j) -! write(*,*) 'vbetap2(i,j):',vbetap2(i,j) -! write(*,*) 'vbetam(i,j):',vbetam(i,j) -! write(*,*) 'vbetam1(i,j):',vbetam1(i,j) -! write(*,*) 'vbetam2(i,j):',vbetam2(i,j) -! write(*,*) 'vbet(i,j):',vbet(i,j) -! enddo -! enddo - - return - end -c------------------------------------------------------------------------------- - subroutine sheetforce1 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbet(maxca,maxca) - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 cph(maxca),cth(maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12) - real*8 shefy(maxca,12),shefz(maxca,12) - real*8 atx(maxca),aty(maxca),atz(maxca) - real*8 atmx(maxca),atmy(maxca),atmz(maxca) - real*8 atmmx(maxca),atmmy(maxca),atmmz(maxca) - real*8 atm3x(maxca),atm3y(maxca),atm3z(maxca) - real*8 apx(maxca),apy(maxca),apz(maxca) - real*8 apmx(maxca),apmy(maxca),apmz(maxca) - real*8 apmmx(maxca),apmmy(maxca),apmmz(maxca) - real*8 apm3x(maxca),apm3y(maxca),apm3z(maxca) - real*8 ulcos(maxca) - real*8 astx(maxca),asty(maxca),astz(maxca) - real*8 astmx(maxca),astmy(maxca),astmz(maxca) - real*8 astmmx(maxca),astmmy(maxca),astmmz(maxca) - real*8 astm3x(maxca),astm3y(maxca),astm3z(maxca) - real*8 sth(maxca) - real*8 w_beta,dp45, dm45 - real*8 vbeta, vbetp, vbetm - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect - - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /coscos/ cph,cth - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /angvt/ atx,aty,atz,atmx,atmy,atmz,atmmx,atmmy, - $ atmmz,atm3x,atm3y,atm3z - common /angvp/ apx,apy,apz,apmx,apmy,apmz,apmmx,apmmy, - $ apmmz,apm3x,apm3y,apm3z - common /shef/ shefx,shefy,shefz - common /shee/ vbeta,vbet,vbetp,vbetm - common /ulang/ ulcos -c c********************************************************************** - common /angvt2/ astx,asty,astz,astmx,astmy,astmz,astmmx,astmmy, - $ astmmz,astm3x,astm3y,astm3z - common /sinsin/ sth -C-------------------------------------------------------------------------------- -c local variables - integer i,j,im3,imm,im,ip,ipp,jm,jmm,jm3,jp,jpp - real*8 c1,v1,cc1,dmm,dmm__,fx,fy,fz,c2,v2,dmm1 - real*8 c3,v3,cc2,cc3,dmm3,dmm3__,c4,v4,c7,v7,cc7,c8,v8,cc8 - real*8 c9,v9,cc9,dmm9,dmm9__,c10,v10,dmm2,dmm1__,dmm2_1,dmm2_2 - real*8 dmm7,dmm8,dmm7__,dmm8_1,dmm8_2 -C-------------------------------------------------------------------------------- - do i=4,inb-4 - im3=i-3 - imm=i-2 - im=i-1 - c1=(cth(im3)*c00+sth(im3)*s00-1)/dca - v1=0.0D0 - do j=i+1,inb-3 - v1=v1+vbet(im3,j) - enddo - cc1=(ulcos(imm)-ulnex)/dnex - dmm=cc1/(dis(imm,im)*dis(im,i)) - dmm__=cc1*ulcos(imm)/dis(im,i)**2 - fx=rx(imm,im)*dmm-rx(im,i)*dmm__ - fy=ry(imm,im)*dmm-ry(im,i)*dmm__ - fz=rz(imm,im)*dmm-rz(im,i)*dmm__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atm3x(i)*c00+astm3x(i)*s00)*c1 - fy=fy+(atm3y(i)*c00+astm3y(i)*s00)*c1 - fz=fz+(atm3z(i)*c00+astm3z(i)*s00)*c1 - shefx(i,1)=fx*v1 - shefy(i,1)=fy*v1 - shefz(i,1)=fz*v1 - enddo - - do i=3,inb-5 - imm=i-2 - im=i-1 - ip=i+1 - c2=(cth(imm)*c00+sth(imm)*s00-1)/dca - v2=0.0D0 - do j=i+2,inb-3 - v2=v2+vbet(imm,j) - enddo - cc1=(ulcos(imm)-ulnex)/dnex - cc2=(ulcos(im)-ulnex)/dnex - dmm1=cc1/(dis(imm,im)*dis(im,i)) - dmm2=cc2/(dis(im,i)*dis(i,ip)) - dmm1__=cc1*ulcos(imm)/dis(im,i)**2 - dmm2_1=cc2*ulcos(im)/dis(im,i)**2 - dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 -cc********************************************************************** - fx=rx(imm,im)*dmm1-rx(im,i)*dmm1__+rx(i,ip)*dmm2-rx(im,i)*dmm2 - $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2 - fy=ry(imm,im)*dmm1-ry(im,i)*dmm1__+ry(i,ip)*dmm2-ry(im,i)*dmm2 - $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2 - fz=rz(imm,im)*dmm1-rz(im,i)*dmm1__+rz(i,ip)*dmm2-rz(im,i)*dmm2 - $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2 -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmmx(i)*c00+astmmx(i)*s00)*c2 - fy=fy+(atmmy(i)*c00+astmmy(i)*s00)*c2 - fz=fz+(atmmz(i)*c00+astmmz(i)*s00)*c2 - shefx(i,2)=fx*v2 - shefy(i,2)=fy*v2 - shefz(i,2)=fz*v2 - enddo - do i=2,inb-6 - im=i-1 - ip=i+1 - ipp=i+2 - c3=(cth(im)*c00+sth(im)*s00-1)/dca - v3=0.0D0 - do j=i+3,inb-3 - v3=v3+vbet(im,j) - enddo - cc2=(ulcos(im)-ulnex)/dnex - cc3=(ulcos(i)-ulnex)/dnex - dmm2=cc2/(dis(im,i)*dis(i,ip)) - dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) - dmm2_1=cc2*ulcos(im)/dis(im,i)**2 - dmm2_2=cc2*ulcos(im)/dis(i,ip)**2 - dmm3__=cc3*ulcos(i)/dis(i,ip)**2 - fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm2-rx(im,i)*dmm2 - $ -rx(im,i)*dmm2_1+rx(i,ip)*dmm2_2+rx(i,ip)*dmm3__ - fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm2-ry(im,i)*dmm2 - $ -ry(im,i)*dmm2_1+ry(i,ip)*dmm2_2+ry(i,ip)*dmm3__ - fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm2-rz(im,i)*dmm2 - $ -rz(im,i)*dmm2_1+rz(i,ip)*dmm2_2+rz(i,ip)*dmm3__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmx(i)*c00+astmx(i)*s00)*c3 - fy=fy+(atmy(i)*c00+astmy(i)*s00)*c3 - fz=fz+(atmz(i)*c00+astmz(i)*s00)*c3 - shefx(i,3)=fx*v3 - shefy(i,3)=fy*v3 - shefz(i,3)=fz*v3 - enddo - do i=1,inb-7 - ip=i+1 - ipp=i+2 - c4=(cth(i)*c00+sth(i)*s00-1)/dca - v4=0.0D0 - do j=i+4,inb-3 - v4=v4+vbet(i,j) - enddo - cc3=(ulcos(i)-ulnex)/dnex - dmm3=cc3/(dis(i,ip)*dis(ip,ipp)) - dmm3__=cc3*ulcos(i)/dis(i,ip)**2 - fx=-rx(ip,ipp)*dmm3+rx(i,ip)*dmm3__ - fy=-ry(ip,ipp)*dmm3+ry(i,ip)*dmm3__ - fz=-rz(ip,ipp)*dmm3+rz(i,ip)*dmm3__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atx(i)*c00+astx(i)*s00)*c4 - fy=fy+(aty(i)*c00+asty(i)*s00)*c4 - fz=fz+(atz(i)*c00+astz(i)*s00)*c4 - shefx(i,4)=fx*v4 - shefy(i,4)=fy*v4 - shefz(i,4)=fz*v4 - enddo - do j=8,inb - jm3=j-3 - jmm=j-2 - jm=j-1 - c7=(cth(jm3)*c00+sth(jm3)*s00-1)/dca - v7=0.0D0 - do i=1,j-7 - v7=v7+vbet(i,jm3) - enddo - cc7=(ulcos(jmm)-ulnex)/dnex - dmm=cc7/(dis(jmm,jm)*dis(jm,j)) - dmm__=cc7*ulcos(jmm)/dis(jm,j)**2 - fx=rx(jmm,jm)*dmm-rx(jm,j)*dmm__ - fy=ry(jmm,jm)*dmm-ry(jm,j)*dmm__ - fz=rz(jmm,jm)*dmm-rz(jm,j)*dmm__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atm3x(j)*c00+astm3x(j)*s00)*c7 - fy=fy+(atm3y(j)*c00+astm3y(j)*s00)*c7 - fz=fz+(atm3z(j)*c00+astm3z(j)*s00)*c7 - shefx(j,7)=fx*v7 - shefy(j,7)=fy*v7 - shefz(j,7)=fz*v7 - enddo - do j=7,inb-1 - jm=j-1 - jmm=j-2 - jp=j+1 - c8=(cth(jmm)*c00+sth(jmm)*s00-1)/dca - v8=0.0D0 - do i=1,j-6 - v8=v8+vbet(i,jmm) - enddo - cc7=(ulcos(jmm)-ulnex)/dnex - cc8=(ulcos(jm)-ulnex)/dnex - dmm7=cc7/(dis(jmm,jm)*dis(jm,j)) - dmm8=cc8/(dis(jm,j)*dis(j,jp)) - dmm7__=cc7*ulcos(jmm)/dis(jm,j)**2 - dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 - dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 - fx=rx(jmm,jm)*dmm7+rx(j,jp)*dmm8-rx(jm,j)*dmm8 - $ -rx(jm,j)*dmm7__-rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2 - fy=ry(jmm,jm)*dmm7+ry(j,jp)*dmm8-ry(jm,j)*dmm8 - $ -ry(jm,j)*dmm7__-ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2 - fz=rz(jmm,jm)*dmm7+rz(j,jp)*dmm8-rz(jm,j)*dmm8 - $ -rz(jm,j)*dmm7__-rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2 -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmmx(j)*c00+astmmx(j)*s00)*c8 - fy=fy+(atmmy(j)*c00+astmmy(j)*s00)*c8 - fz=fz+(atmmz(j)*c00+astmmz(j)*s00)*c8 - shefx(j,8)=fx*v8 - shefy(j,8)=fy*v8 - shefz(j,8)=fz*v8 - enddo - - do j=6,inb-2 - jm=j-1 - jp=j+1 - jpp=j+2 - c9=(cth(jm)*c00+sth(jm)*s00-1)/dca - v9=0.0D0 - do i=1,j-5 - v9=v9+vbet(i,jm) - enddo - cc8=(ulcos(jm)-ulnex)/dnex - cc9=(ulcos(j)-ulnex)/dnex - dmm8=cc8/(dis(jm,j)*dis(j,jp)) - dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) - dmm8_1=cc8*ulcos(jm)/dis(jm,j)**2 - dmm8_2=cc8*ulcos(jm)/dis(j,jp)**2 - dmm9__=cc9*ulcos(j)/dis(j,jp)**2 - fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm8-rx(jm,j)*dmm8 - $ -rx(jm,j)*dmm8_1+rx(j,jp)*dmm8_2+rx(j,jp)*dmm9__ - fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm8-ry(jm,j)*dmm8 - $ -ry(jm,j)*dmm8_1+ry(j,jp)*dmm8_2+ry(j,jp)*dmm9__ - fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm8-rz(jm,j)*dmm8 - $ -rz(jm,j)*dmm8_1+rz(j,jp)*dmm8_2+rz(j,jp)*dmm9__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atmx(j)*c00+astmx(j)*s00)*c9 - fy=fy+(atmy(j)*c00+astmy(j)*s00)*c9 - fz=fz+(atmz(j)*c00+astmz(j)*s00)*c9 - shefx(j,9)=fx*v9 - shefy(j,9)=fy*v9 - shefz(j,9)=fz*v9 - enddo - - do j=5,inb-3 - jp=j+1 - jpp=j+2 - c10=(cth(j)*c00+sth(j)*s00-1)/dca - v10=0.0D0 - do i=1,j-4 - v10=v10+vbet(i,j) - enddo - cc9=(ulcos(j)-ulnex)/dnex - dmm9=cc9/(dis(j,jp)*dis(jp,jpp)) - dmm9__=cc9*ulcos(j)/dis(j,jp)**2 - fx=-rx(jp,jpp)*dmm9+rx(j,jp)*dmm9__ - fy=-ry(jp,jpp)*dmm9+ry(j,jp)*dmm9__ - fz=-rz(jp,jpp)*dmm9+rz(j,jp)*dmm9__ -cd fx=0 -cd fy=0 -cd fz=0 - fx=fx+(atx(j)*c00+astx(j)*s00)*c10 - fy=fy+(aty(j)*c00+asty(j)*s00)*c10 - fz=fz+(atz(j)*c00+astz(j)*s00)*c10 - shefx(j,10)=fx*v10 - shefy(j,10)=fy*v10 - shefz(j,10)=fz*v10 - enddo - - return - end -c---------------------------------------------------------------------------- - subroutine sheetforce5 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -c******************************************************************************** -c local variables - integer i,imm,im,jp,jpp,j - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z - real*8 y66x,y66y,y66z,yy6,yyy4,yyy5a,yyy5b - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b -c******************************************************************************** - do i=3,inb-5 - imm=i-2 - im=i-1 - do j=i+2,inb-3 - jp=j+1 - jpp=j+2 - -ci if(istrand(imm,j).eq.1 -ci & .and.(istrand_p(imm,j)+istrand_m(imm,j)).ge.1) then - - - yy1=-(dis(i,jpp)-ulhb)/dlhb - y1x=rx(jpp,i)/dis(i,jpp) - y1y=ry(jpp,i)/dis(i,jpp) - y1z=rz(jpp,i)/dis(i,jpp) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(im,jp)*dis(im,i)) - yyy3=pin1(imm,j)/(dis(im,i)**2) - yy3=-pin1(imm,j)/dshe - y3x=(yy33*rx(im,jp)-yyy3*rx(im,i))*yy3 - y3y=(yy33*ry(im,jp)-yyy3*ry(im,i))*yy3 - y3z=(yy33*rz(im,jp)-yyy3*rz(im,i))*yy3 - - yy44=1.0D0/(dis(i,jpp)*dis(im,i)) - yyy4a=pin3(imm,j)/(dis(i,jpp)**2) - yyy4b=pin3(imm,j)/(dis(im,i)**2) - yy4=-pin3(imm,j)/dshe - y4x=(yy44*(rx(i,jpp)-rx(im,i))+yyy4a*rx(i,jpp) - $ -yyy4b*rx(im,i))*yy4 - y4y=(yy44*(ry(i,jpp)-ry(im,i))+yyy4a*ry(i,jpp) - $ -yyy4b*ry(im,i))*yy4 - y4z=(yy44*(rz(i,jpp)-rz(im,i))+yyy4a*rz(i,jpp) - $ -yyy4b*rz(im,i))*yy4 - - - yy55=1.0D0/(dis(i,jpp)*dis(jp,jpp)) - yyy5=pin4(imm,j)/(dis(i,jpp)**2) - yy5=-pin4(imm,j)/dshe - y5x=(-yy55*rx(jp,jpp)+yyy5*rx(i,jpp))*yy5 - y5y=(-yy55*ry(jp,jpp)+yyy5*ry(i,jpp))*yy5 - y5z=(-yy55*rz(jp,jpp)+yyy5*rz(i,jpp))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y3x - sy1=y3y - sz1=y3z - sx2=y11x+y4x+y5x - sy2=y11y+y4y+y5y - sz2=y11z+y4z+y5z - - shefx(i,5)=shefx(i,5)-sx*vbetap(imm,j) - $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) - shefy(i,5)=shefy(i,5)-sy*vbetap(imm,j) - $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) - shefz(i,5)=shefz(i,5)-sz*vbetap(imm,j) - $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) - -! shefx(i,5)=shefx(i,5) -! $ -sx1*vbetap1(imm,j)-sx2*vbetap2(imm,j) -! shefy(i,5)=shefy(i,5) -! $ -sy1*vbetap1(imm,j)-sy2*vbetap2(imm,j) -! shefz(i,5)=shefz(i,5) -! $ -sz1*vbetap1(imm,j)-sz2*vbetap2(imm,j) - - yy6=-(dis(i,jp)-uldhb)/dldhb - y6x=rx(jp,i)/dis(i,jp) - y6y=ry(jp,i)/dis(i,jp) - y6z=rz(jp,i)/dis(i,jp) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(im,jpp)*dis(im,i)) - yyy8=pina1(imm,j)/(dis(im,i)**2) - yy8=-pina1(imm,j)/dshe - y8x=(yy88*rx(im,jpp)-yyy8*rx(im,i))*yy8 - y8y=(yy88*ry(im,jpp)-yyy8*ry(im,i))*yy8 - y8z=(yy88*rz(im,jpp)-yyy8*rz(im,i))*yy8 - - yy99=1.0D0/(dis(jp,i)*dis(im,i)) - yyy9a=pina3(imm,j)/(dis(jp,i)**2) - yyy9b=pina3(imm,j)/(dis(im,i)**2) - yy9=-pina3(imm,j)/dshe - y9x=(yy99*(rx(jp,i)+rx(im,i))-yyy9a*rx(jp,i) - $ -yyy9b*rx(im,i))*yy9 - y9y=(yy99*(ry(jp,i)+ry(im,i))-yyy9a*ry(jp,i) - $ -yyy9b*ry(im,i))*yy9 - y9z=(yy99*(rz(jp,i)+rz(im,i))-yyy9a*rz(jp,i) - $ -yyy9b*rz(im,i))*yy9 - - yy1010=1.0D0/(dis(jp,i)*dis(jp,jpp)) - yyy10=pina4(imm,j)/(dis(jp,i)**2) - yy10=-pina4(imm,j)/dshe - y10x=(yy1010*rx(jp,jpp)-yyy10*rx(jp,i))*yy10 - y10y=(yy1010*ry(jp,jpp)-yyy10*ry(jp,i))*yy10 - y10z=(yy1010*rz(jp,jpp)-yyy10*rz(jp,i))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y8x - sy1=y8y - sz1=y8z - sx2=y66x+y9x+y10x - sy2=y66y+y9y+y10y - sz2=y66z+y9z+y10z - - shefx(i,5)=shefx(i,5)-sx*vbetam(imm,j) - $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) - shefy(i,5)=shefy(i,5)-sy*vbetam(imm,j) - $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) - shefz(i,5)=shefz(i,5)-sz*vbetam(imm,j) - $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) - -! shefx(i,5)=shefx(i,5) -! $ -sx1*vbetam1(imm,j)-sx2*vbetam2(imm,j) -! shefy(i,5)=shefy(i,5) -! $ -sy1*vbetam1(imm,j)-sy2*vbetam2(imm,j) -! shefz(i,5)=shefz(i,5) -! $ -sz1*vbetam1(imm,j)-sz2*vbetam2(imm,j) - -ci endif - - enddo - enddo - - return - end -c--------------------------------------------------------------------------c - subroutine sheetforce6 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -cc********************************************************************** -C local variables - integer i,imm,im,jp,jpp,j,ip - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy8,yyy9a,yyy9b,yyy4 - real*8 yyy3a,yyy3b,y66z,yy6,yyy5a,yyy5b -C******************************************************************************** - do i=2,inb-6 - ip=i+1 - im=i-1 - do j=i+3,inb-3 - jp=j+1 - jpp=j+2 - -ci if(istrand(im,j).eq.1 -ci & .and.(istrand_p(im,j)+istrand_m(im,j)).ge.1) then - - - yy1=-(dis(i,jp)-ulhb)/dlhb - y1x=rx(jp,i)/dis(i,jp) - y1y=ry(jp,i)/dis(i,jp) - y1z=rz(jp,i)/dis(i,jp) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(i,jp)*dis(i,ip)) - yyy3a=pin1(im,j)/(dis(i,jp)**2) - yyy3b=pin1(im,j)/(dis(i,ip)**2) - yy3=-pin1(im,j)/dshe - y3x=(-yy33*(rx(i,ip)+rx(i,jp))+yyy3a*rx(i,jp) - $ +yyy3b*rx(i,ip))*yy3 - y3y=(-yy33*(ry(i,ip)+ry(i,jp))+yyy3a*ry(i,jp) - $ +yyy3b*ry(i,ip))*yy3 - y3z=(-yy33*(rz(i,ip)+rz(i,jp))+yyy3a*rz(i,jp) - $ +yyy3b*rz(i,ip))*yy3 - - yy44=1.0D0/(dis(i,jp)*dis(jp,jpp)) - yyy4=pin2(im,j)/(dis(i,jp)**2) - yy4=-pin2(im,j)/dshe - y4x=(-yy44*rx(jp,jpp)+yyy4*rx(i,jp))*yy4 - y4y=(-yy44*ry(jp,jpp)+yyy4*ry(i,jp))*yy4 - y4z=(-yy44*rz(jp,jpp)+yyy4*rz(i,jp))*yy4 - - yy55=1.0D0/(dis(ip,jpp)*dis(i,ip)) - yyy5=pin3(im,j)/(dis(i,ip)**2) - yy5=-pin3(im,j)/dshe - y5x=(-yy55*rx(ip,jpp)+yyy5*rx(i,ip))*yy5 - y5y=(-yy55*ry(ip,jpp)+yyy5*ry(i,ip))*yy5 - y5z=(-yy55*rz(ip,jpp)+yyy5*rz(i,ip))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y11x+y3x+y4x - sy1=y11y+y3y+y4y - sz1=y11z+y3z+y4z - sx2=y5x - sy2=y5y - sz2=y5z - - shefx(i,6)=shefx(i,6)-sx*vbetap(im,j) - $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) - shefy(i,6)=shefy(i,6)-sy*vbetap(im,j) - $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) - shefz(i,6)=shefz(i,6)-sz*vbetap(im,j) - $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) -! shefx(i,6)=shefx(i,6) -! $ -sx1*vbetap1(im,j)-sx2*vbetap2(im,j) -! shefy(i,6)=shefy(i,6) -! $ -sy1*vbetap1(im,j)-sy2*vbetap2(im,j) -! shefz(i,6)=shefz(i,6) -! $ -sz1*vbetap1(im,j)-sz2*vbetap2(im,j) - - yy6=-(dis(jpp,i)-uldhb)/dldhb - y6x=rx(jpp,i)/dis(jpp,i) - y6y=ry(jpp,i)/dis(jpp,i) - y6z=rz(jpp,i)/dis(jpp,i) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(i,jpp)*dis(i,ip)) - yyy8a=pina1(im,j)/(dis(i,jpp)**2) - yyy8b=pina1(im,j)/(dis(i,ip)**2) - yy8=-pina1(im,j)/dshe - y8x=(-yy88*(rx(i,jpp)+rx(i,ip))+yyy8a*rx(i,jpp) - $ +yyy8b*rx(i,ip))*yy8 - y8y=(-yy88*(ry(i,jpp)+ry(i,ip))+yyy8a*ry(i,jpp) - $ +yyy8b*ry(i,ip))*yy8 - y8z=(-yy88*(rz(i,jpp)+rz(i,ip))+yyy8a*rz(i,jpp) - $ +yyy8b*rz(i,ip))*yy8 - - yy99=1.0D0/(dis(i,jpp)*dis(jp,jpp)) - yyy9=pina2(im,j)/(dis(i,jpp)**2) - yy9=-pina2(im,j)/dshe - y9x=(-yy99*rx(jp,jpp)+yyy9*rx(i,jpp))*yy9 - y9y=(-yy99*ry(jp,jpp)+yyy9*ry(i,jpp))*yy9 - y9z=(-yy99*rz(jp,jpp)+yyy9*rz(i,jpp))*yy9 - - yy1010=1.0D0/(dis(jp,ip)*dis(i,ip)) - yyy10=pina3(im,j)/(dis(i,ip)**2) - yy10=-pina3(im,j)/dshe - y10x=(-yy1010*rx(jp,ip)+yyy10*rx(i,ip))*yy10 - y10y=(-yy1010*ry(jp,ip)+yyy10*ry(i,ip))*yy10 - y10z=(-yy1010*rz(jp,ip)+yyy10*rz(i,ip))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y66x+y8x+y9x - sy1=y66y+y8y+y9y - sz1=y66z+y8z+y9z - sx2=y10x - sy2=y10y - sz2=y10z - - shefx(i,6)=shefx(i,6)-sx*vbetam(im,j) - $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) - shefy(i,6)=shefy(i,6)-sy*vbetam(im,j) - $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) - shefz(i,6)=shefz(i,6)-sz*vbetam(im,j) - $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) - -! shefx(i,6)=shefx(i,6) -! $ -sx1*vbetam1(im,j)-sx2*vbetam2(im,j) -! shefy(i,6)=shefy(i,6) -! $ -sy1*vbetam1(im,j)-sy2*vbetam2(im,j) -! shefz(i,6)=shefz(i,6) -! $ -sz1*vbetam1(im,j)-sz2*vbetam2(im,j) - -ci endif - - enddo - enddo - - return - end -c----------------------------------------------------------------------- - subroutine sheetforce11 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -C******************************************************************************** -C local variables - integer j,jm,jmm,ip,i,ipp - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy4,yyy5a,yyy5b,yy6 - real*8 yyy9a,yyy9b,y5z,y66z,y9z,yyy8 -C******************************************************************************** - - do j=7,inb-1 - jm=j-1 - jmm=j-2 - do i=1,j-6 - ip=i+1 - ipp=i+2 - -ci if(istrand(i,jmm).eq.1 -ci & .and.(istrand_p(i,jmm)+istrand_m(i,jmm)).ge.1) then - - - yy1=-(dis(ipp,j)-ulhb)/dlhb - y1x=rx(ipp,j)/dis(ipp,j) - y1y=ry(ipp,j)/dis(ipp,j) - y1z=rz(ipp,j)/dis(ipp,j) - y11x=yy1*y1x - y11y=yy1*y1y - y11z=yy1*y1z - - yy33=1.0D0/(dis(ip,jm)*dis(jm,j)) - yyy3=pin2(i,jmm)/(dis(jm,j)**2) - yy3=-pin2(i,jmm)/dshe - y3x=(yy33*rx(ip,jm)-yyy3*rx(jm,j))*yy3 - y3y=(yy33*ry(ip,jm)-yyy3*ry(jm,j))*yy3 - y3z=(yy33*rz(ip,jm)-yyy3*rz(jm,j))*yy3 - - yy44=1.0D0/(dis(ipp,j)*dis(ip,ipp)) - yyy4=pin3(i,jmm)/(dis(ipp,j)**2) - yy4=-pin3(i,jmm)/dshe - y4x=(yy44*rx(ip,ipp)-yyy4*rx(ipp,j))*yy4 - y4y=(yy44*ry(ip,ipp)-yyy4*ry(ipp,j))*yy4 - y4z=(yy44*rz(ip,ipp)-yyy4*rz(ipp,j))*yy4 - - yy55=1.0D0/(dis(ipp,j)*dis(jm,j)) - yyy5a=pin4(i,jmm)/(dis(ipp,j)**2) - yyy5b=pin4(i,jmm)/(dis(jm,j)**2) - yy5=-pin4(i,jmm)/dshe - y5x=(yy55*(rx(jm,j)+rx(ipp,j))-yyy5a*rx(ipp,j) - $ -yyy5b*rx(jm,j))*yy5 - y5y=(yy55*(ry(jm,j)+ry(ipp,j))-yyy5a*ry(ipp,j) - $ -yyy5b*ry(jm,j))*yy5 - y5z=(yy55*(rz(jm,j)+rz(ipp,j))-yyy5a*rz(ipp,j) - $ -yyy5b*rz(jm,j))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y3x - sy1=y3y - sz1=y3z - sx2=y11x+y4x+y5x - sy2=y11y+y4y+y5y - sz2=y11z+y4z+y5z - - shefx(j,11)=shefx(j,11)-sx*vbetap(i,jmm) - $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) - shefy(j,11)=shefy(j,11)-sy*vbetap(i,jmm) - $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) - shefz(j,11)=shefz(j,11)-sz*vbetap(i,jmm) - $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) - -! shefx(j,11)=shefx(j,11) -! $ -sx1*vbetap1(i,jmm)-sx2*vbetap2(i,jmm) -! shefy(j,11)=shefy(j,11) -! $ -sy1*vbetap1(i,jmm)-sy2*vbetap2(i,jmm) -! shefz(j,11)=shefz(j,11) -! $ -sz1*vbetap1(i,jmm)-sz2*vbetap2(i,jmm) - - yy6=-(dis(ip,j)-uldhb)/dldhb - y6x=rx(ip,j)/dis(ip,j) - y6y=ry(ip,j)/dis(ip,j) - y6z=rz(ip,j)/dis(ip,j) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(ip,j)*dis(ip,ipp)) - yyy8=pina1(i,jmm)/(dis(ip,j)**2) - yy8=-pina1(i,jmm)/dshe - y8x=(yy88*rx(ip,ipp)-yyy8*rx(ip,j))*yy8 - y8y=(yy88*ry(ip,ipp)-yyy8*ry(ip,j))*yy8 - y8z=(yy88*rz(ip,ipp)-yyy8*rz(ip,j))*yy8 - - yy99=1.0D0/(dis(ip,j)*dis(jm,j)) - yyy9a=pina2(i,jmm)/(dis(ip,j)**2) - yyy9b=pina2(i,jmm)/(dis(jm,j)**2) - yy9=-pina2(i,jmm)/dshe - y9x=(yy99*(rx(jm,j)+rx(ip,j))-yyy9a*rx(ip,j) - $ -yyy9b*rx(jm,j))*yy9 - y9y=(yy99*(ry(jm,j)+ry(ip,j))-yyy9a*ry(ip,j) - $ -yyy9b*ry(jm,j))*yy9 - y9z=(yy99*(rz(jm,j)+rz(ip,j))-yyy9a*rz(ip,j) - $ -yyy9b*rz(jm,j))*yy9 - - yy1010=1.0D0/(dis(jm,ipp)*dis(jm,j)) - yyy10=pina4(i,jmm)/(dis(jm,j)**2) - yy10=-pina4(i,jmm)/dshe - y10x=(yy1010*rx(jm,ipp)-yyy10*rx(jm,j))*yy10 - y10y=(yy1010*ry(jm,ipp)-yyy10*ry(jm,j))*yy10 - y10z=(yy1010*rz(jm,ipp)-yyy10*rz(jm,j))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y66x+y8x+y9x - sy1=y66y+y8y+y9y - sz1=y66z+y8z+y9z - sx2=y10x - sy2=y10y - sz2=y10z - - shefx(j,11)=shefx(j,11)-sx*vbetam(i,jmm) - $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) - shefy(j,11)=shefy(j,11)-sy*vbetam(i,jmm) - $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) - shefz(j,11)=shefz(j,11)-sz*vbetam(i,jmm) - $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) - -! shefx(j,11)=shefx(j,11) -! $ -sx1*vbetam1(i,jmm)-sx2*vbetam2(i,jmm) -! shefy(j,11)=shefy(j,11) -! $ -sy1*vbetam1(i,jmm)-sy2*vbetam2(i,jmm) -! shefz(j,11)=shefz(j,11) -! $ -sz1*vbetam1(i,jmm)-sz2*vbetam2(i,jmm) - -ci endif - - enddo - enddo - - return - end -c----------------------------------------------------------------------- - subroutine sheetforce12 - implicit none - integer maxca - parameter(maxca=800) -cc********************************************************************** - real*8 vbetap(maxca,maxca),vbetam(maxca,maxca) - real*8 vbetap1(maxca,maxca),vbetam1(maxca,maxca) - real*8 vbetap2(maxca,maxca),vbetam2(maxca,maxca) - real*8 pin1(maxca,maxca),pin2(maxca,maxca) - real*8 pin3(maxca,maxca),pin4(maxca,maxca) - real*8 pina1(maxca,maxca),pina2(maxca,maxca) - real*8 pina3(maxca,maxca),pina4(maxca,maxca) - real*8 rx(maxca,maxca) - real*8 ry(maxca,maxca),rz(maxca,maxca) - real*8 bx(maxca),by(maxca),bz(maxca) - real*8 dis(maxca,maxca) - real*8 shefx(maxca,12),shefy(maxca,12) - real*8 shefz(maxca,12) - real*8 dp45,dm45,w_beta - real*8 dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - integer inb,nmax,iselect -cc********************************************************************** - common /phys1/ inb,nmax,iselect - common /kyori2/ dis - common /difvec/ rx,ry,rz - common /sheparm/ dca,dlhb,ulhb,dshe,dldhb,uldhb, - $ c00,s00,ulnex,dnex - common /sheconst/ dp45,dm45,w_beta - common /she/ vbetap,vbetam,vbetap1,vbetap2,vbetam1,vbetam2 - common /shepin/ pin1,pin2,pin3,pin4,pina1,pina2,pina3,pina4 - common /shef/ shefx,shefy,shefz -ci integer istrand(maxca,maxca) -ci integer istrand_p(maxca,maxca),istrand_m(maxca,maxca) -ci common /shetest/ istrand,istrand_p,istrand_m -cc********************************************************************** -C local variables - integer j,jm,jmm,ip,i,ipp,jp - real*8 yy1,y1x,y1y,y1z,y11x,y11y,y11z,yy33,yyy3,yy3,y3x,y3y,y3z - real*8 yy44,yyy4a,yyy4b,yy4,y4x,y4y,y4z,yy55,yyy5,yy5,y5x,y5y,y5z - real*8 sx,sy,sz,sx1,sy1,sz1,sx2,sy2,sz2,y6x,y6y,y6z,y66x,y66y,y66z - real*8 yy88,yyy8a,yyy8b,yy8,y8x,y8y,y8z,yy99,yyy9,yy9,y9x,y9y,y9z - real*8 yy1010,yyy10,yy10,y10x,y10y,y10z,yyy10a,yyy10b,yy6,yyy8 -!c*************************************************************************c - do j=6,inb-2 - jp=j+1 - jm=j-1 - do i=1,j-5 - ip=i+1 - ipp=i+2 - -ci if(istrand(i,jm).eq.1 -ci & .and.(istrand_p(i,jm)+istrand_m(i,jm)).ge.1) then - - - yy1=-(dis(ip,j)-ulhb)/dlhb - y1x=rx(ip,j)/dis(ip,j) - y1y=ry(ip,j)/dis(ip,j) - y1z=rz(ip,j)/dis(ip,j) - y11x=y1x*yy1 - y11y=y1y*yy1 - y11z=y1z*yy1 - - yy33=1.0D0/(dis(ip,j)*dis(ip,ipp)) - yyy3=pin1(i,jm)/(dis(ip,j)**2) - yy3=-pin1(i,jm)/dshe - y3x=(yy33*rx(ip,ipp)-yyy3*rx(ip,j))*yy3 - y3y=(yy33*ry(ip,ipp)-yyy3*ry(ip,j))*yy3 - y3z=(yy33*rz(ip,ipp)-yyy3*rz(ip,j))*yy3 - yy44=1.0D0/(dis(ip,j)*dis(j,jp)) - - yyy4a=pin2(i,jm)/(dis(ip,j)**2) - yyy4b=pin2(i,jm)/(dis(j,jp)**2) - yy4=-pin2(i,jm)/dshe - y4x=(yy44*(rx(j,jp)-rx(ip,j))-yyy4a*rx(ip,j) - $ +yyy4b*rx(j,jp))*yy4 - y4y=(yy44*(ry(j,jp)-ry(ip,j))-yyy4a*ry(ip,j) - $ +yyy4b*ry(j,jp))*yy4 - y4z=(yy44*(rz(j,jp)-rz(ip,j))-yyy4a*rz(ip,j) - $ +yyy4b*rz(j,jp))*yy4 - - yy55=1.0D0/(dis(ipp,jp)*dis(j,jp)) - yyy5=pin4(i,jm)/(dis(j,jp)**2) - yy5=-pin4(i,jm)/dshe - y5x=(-yy55*rx(ipp,jp)+yyy5*rx(j,jp))*yy5 - y5y=(-yy55*ry(ipp,jp)+yyy5*ry(j,jp))*yy5 - y5z=(-yy55*rz(ipp,jp)+yyy5*rz(j,jp))*yy5 - - sx=y11x+y3x+y4x+y5x - sy=y11y+y3y+y4y+y5y - sz=y11z+y3z+y4z+y5z - - sx1=y11x+y3x+y4x - sy1=y11y+y3y+y4y - sz1=y11z+y3z+y4z - sx2=y5x - sy2=y5y - sz2=y5z - - shefx(j,12)=shefx(j,12)-sx*vbetap(i,jm) - $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) - shefy(j,12)=shefy(j,12)-sy*vbetap(i,jm) - $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) - shefz(j,12)=shefz(j,12)-sz*vbetap(i,jm) - $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) - -! shefx(j,12)=shefx(j,12) -! $ -sx1*vbetap1(i,jm)-sx2*vbetap2(i,jm) -! shefy(j,12)=shefy(j,12) -! $ -sy1*vbetap1(i,jm)-sy2*vbetap2(i,jm) -! shefz(j,12)=shefz(j,12) -! $ -sz1*vbetap1(i,jm)-sz2*vbetap2(i,jm) - - yy6=-(dis(ipp,j)-uldhb)/dldhb - y6x=rx(ipp,j)/dis(ipp,j) - y6y=ry(ipp,j)/dis(ipp,j) - y6z=rz(ipp,j)/dis(ipp,j) - y66x=yy6*y6x - y66y=yy6*y6y - y66z=yy6*y6z - - yy88=1.0D0/(dis(ip,jp)*dis(j,jp)) - yyy8=pina2(i,jm)/(dis(j,jp)**2) - yy8=-pina2(i,jm)/dshe - y8x=(-yy88*rx(ip,jp)+yyy8*rx(j,jp))*yy8 - y8y=(-yy88*ry(ip,jp)+yyy8*ry(j,jp))*yy8 - y8z=(-yy88*rz(ip,jp)+yyy8*rz(j,jp))*yy8 - - yy99=1.0D0/(dis(j,ipp)*dis(ip,ipp)) - yyy9=pina3(i,jm)/(dis(j,ipp)**2) - yy9=-pina3(i,jm)/dshe - y9x=(-yy99*rx(ip,ipp)+yyy9*rx(j,ipp))*yy9 - y9y=(-yy99*ry(ip,ipp)+yyy9*ry(j,ipp))*yy9 - y9z=(-yy99*rz(ip,ipp)+yyy9*rz(j,ipp))*yy9 - - yy1010=1.0D0/(dis(j,ipp)*dis(j,jp)) - yyy10a=pina4(i,jm)/(dis(j,ipp)**2) - yyy10b=pina4(i,jm)/(dis(j,jp)**2) - yy10=-pina4(i,jm)/dshe - y10x=(-yy1010*(rx(j,ipp)+rx(j,jp))+yyy10a*rx(j,ipp) - $ +yyy10b*rx(j,jp))*yy10 - y10y=(-yy1010*(ry(j,ipp)+ry(j,jp))+yyy10a*ry(j,ipp) - $ +yyy10b*ry(j,jp))*yy10 - y10z=(-yy1010*(rz(j,ipp)+rz(j,jp))+yyy10a*rz(j,ipp) - $ +yyy10b*rz(j,jp))*yy10 - - sx=y66x+y8x+y9x+y10x - sy=y66y+y8y+y9y+y10y - sz=y66z+y8z+y9z+y10z - - sx1=y8x - sy1=y8y - sz1=y8z - sx2=y66x+y9x+y10x - sy2=y66y+y9y+y10y - sz2=y66z+y9z+y10z - - shefx(j,12)=shefx(j,12)-sx*vbetam(i,jm) - $ -sx1*vbetam1(i,jm)-sx2*vbetam2(i,jm) - shefy(j,12)=shefy(j,12)-sy*vbetam(i,jm) - $ -sy1*vbetam1(i,jm)-sy2*vbetam2(i,jm) - shefz(j,12)=shefz(j,12)-sz*vbetam(i,jm) - $ -sz1*vbetam1(i,jm)-sz2*vbetam2(i,jm) - -ci endif - - ENDDO - ENDDO - - RETURN - END -C=============================================================================== diff --git a/source/unres/src_MD-DFA-restraints/dihed_cons.F b/source/unres/src_MD-DFA-restraints/dihed_cons.F deleted file mode 100644 index e45405f..0000000 --- a/source/unres/src_MD-DFA-restraints/dihed_cons.F +++ /dev/null @@ -1,185 +0,0 @@ - subroutine secstrp2dihc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' - include 'COMMON.CHAIN' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - character*80 line - logical errflag - external ilen - -cdr call getenv_loc('SECPREDFIL',secpred) - lenpre=ilen(prefix) - secpred=prefix(:lenpre)//'.spred' - -#if defined(WINIFL) || defined(WINPGI) - open(isecpred,file=secpred,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(isecpred,file=secpred,status='old',action='read') -#elif (defined G77) - open(isecpred,file=secpred,status='old') -#else - open(isecpred,file=secpred,status='old',action='read') -#endif -C read secondary structure prediction from JPRED here! -! read(isecpred,'(A80)',err=100,end=100) line -! read(line,'(f10.3)',err=110) ftors - read(isecpred,'(f10.3)',err=110) ftors - - write (iout,*) 'FTORS factor =',ftors -! initialize secstruc to any - do i=1,nres - secstruc(i) ='-' - enddo - ndih_constr=0 - ndih_nconstr=0 - - call read_secstr_pred(isecpred,iout,errflag) - if (errflag) then - write(iout,*)'There is a problem with the list of secondary-', - & 'structure prediction' - goto 100 - endif -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - - ii=0 - do i=1,nres - if ( secstruc(i) .eq. 'H') then -C Helix restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 45.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else if (secstruc(i) .eq. 'E') then -C strand restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 180.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else -C no restraints for this residue - ndih_nconstr=ndih_nconstr+1 - idih_nconstr(ndih_nconstr)=i - endif - enddo - ndih_constr=ii - return -100 continue - write(iout,'(A30,A80)')'Error reading file SECPRED',secpred - return - 110 continue - write(iout,'(A20)')'Error reading FTORS' - return - end - - subroutine read_secstr_pred(jin,jout,errors) - - implicit real*8 (a-h,o-z) - INCLUDE 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - EXTERNAL ILEN - character*80 line,line1,ucase - logical errflag,errors,blankline - - errors=.false. - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) -C Remember that we number full residues starting from 2, then, iseq=1 and iseq=nres -C correspond to the end-groups. ADD to the secondary structure prediction "-" for the -C end-groups in the input file "*.spred" - - iseq=1 - do while (index(line1,'$END').eq.0) -* Override commented lines. - ipos=1 - blankline=.false. - do while (.not.blankline) - line1=' ' - call mykey(line,line1,ipos,blankline,errflag) - if (errflag) write (jout,'(2a)') - & 'Error when reading sequence in line: ',line - errors=errors .or. errflag - if (.not. blankline .and. .not. errflag) then - ipos1=2 - iend=ilen(line1) - if (iseq.le.maxres) then - if (line1(1:1).eq.'-' ) then - secstruc(iseq)=line1(1:1) - else if ( ( ucase(line1(1:1)).eq.'E' ) .or. - & ( ucase(line1(1:1)).eq.'H' ) ) then - secstruc(iseq)=ucase(line1(1:1)) - else - errors=.true. - write (jout,1010) line1(1:1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - do while (ipos1.le.iend) - - iseq=iseq+1 - il=1 - ipos1=ipos1+1 - if (iseq.le.maxres) then - if (line1(ipos1-1:ipos1-1).eq.'-' ) then - secstruc(iseq)=line1(ipos1-1:ipos1-1) - else if((ucase(line1(ipos1-1:ipos1-1)).eq.'E').or. - & (ucase(line1(ipos1-1:ipos1-1)).eq.'H') ) then - secstruc(iseq)=ucase(line1(ipos1-1:ipos1-1)) - else - errors=.true. - write (jout,1010) line1(ipos1-1:ipos1-1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - enddo - iseq=iseq+1 - endif - enddo - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) - enddo - -cd write (jout,'(10a8)') (sequence(i),i=1,iseq-1) - -cd check whether the found length of the chain is correct. - length_of_chain=iseq-1 - if (length_of_chain .ne. nres) then -! errors=.true. - write (jout,'(a,i4,a,i4,a)') - & 'Error: the number of labels specified in $SEC_STRUC_PRED (' - & ,length_of_chain,') does not match with the number of residues (' - & ,nres,').' - endif - 80 continue - - 1000 format('Error - the number of residues (',i4, - & ') has exceeded maximum (',i4,').') - 1010 format ('Error - unrecognized secondary structure label',a4, - & ' in position',i4) - return - end diff --git a/source/unres/src_MD-DFA-restraints/djacob.f b/source/unres/src_MD-DFA-restraints/djacob.f deleted file mode 100644 index e3f46bc..0000000 --- a/source/unres/src_MD-DFA-restraints/djacob.f +++ /dev/null @@ -1,107 +0,0 @@ - SUBROUTINE DJACOB(N,NMAX,MAXJAC,E,A,C,AII) - IMPLICIT REAL*8 (A-H,O-Z) -C THE JACOBI DIAGONALIZATION PROCEDURE - COMMON INP,IOUT,IPN - DIMENSION A(NMAX,N),C(NMAX,N),AII(150),AJJ(150) - SIN45 = .70710678 - COS45 = .70710678 - S45SQ = 0.50 - C45SQ = 0.50 -C UNIT EIGENVECTOR MATRIX - DO 70 I = 1,N - DO 7 J = I,N - A(J,I)=A(I,J) - C(I,J) = 0.0 - 7 C(J,I) = 0.0 - 70 C(I,I) = 1.0 -C DETERMINATION OF SEARCH ARGUMENT, TEST - AMAX = 0.0 - DO 1 I = 1,N - DO 1 J = 1,I - TEMPA=DABS(A(I,J)) - IF (AMAX-TEMPA) 2,1,1 - 2 AMAX = TEMPA - 1 CONTINUE - TEST = AMAX*E -C SEARCH FOR LARGEST OFF DIAGONAL ELEMENT - DO 72 IJAC=1,MAXJAC - AIJMAX = 0.0 - DO 3 I = 2,N - LIM = I-1 - DO 3 J = 1,LIM - TAIJ=DABS(A(I,J)) - IF (AIJMAX-TAIJ) 4,3,3 - 4 AIJMAX = TAIJ - IPIV = I - JPIV = J - 3 CONTINUE - IF(AIJMAX-TEST)300,300,5 -C PARAMETERS FOR ROTATION - 5 TAII = A(IPIV,IPIV) - TAJJ = A(JPIV,JPIV) - TAIJ = A(IPIV,JPIV) - TMT = TAII-TAJJ - IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6 - 60 IF(TAIJ) 10,10,11 - 6 ZAMMA=TAIJ/(2.0*TMT) - 90 IF(DABS(ZAMMA)-0.38268)8,8,9 - 9 IF(ZAMMA)10,10,11 - 10 SINT = -SIN45 - GO TO 12 - 11 SINT = SIN45 - 12 COST = COS45 - SINSQ = S45SQ - COSSQ = C45SQ - GO TO 120 - 8 GAMSQ=ZAMMA*ZAMMA - SINT=2.0*ZAMMA/(1.0+GAMSQ) - COST = (1.0-GAMSQ)/(1.0+GAMSQ) - SINSQ=SINT*SINT - COSSQ=COST*COST -C ROTATION - 120 DO 13 K = 1,N - TAIK = A(IPIV,K) - TAJK = A(JPIV,K) - A(IPIV,K) = TAIK*COST+TAJK*SINT - A(JPIV,K) = TAJK*COST-TAIK*SINT - TCIK = C(IPIV,K) - TCJK = C(JPIV,K) - C(IPIV,K) = TCIK*COST+TCJK*SINT - 13 C(JPIV,K) = TCJK*COST-TCIK*SINT - A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST - A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST - A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT - A(JPIV,IPIV) = A(IPIV,JPIV) - DO 30 K = 1,N - A(K,IPIV) = A(IPIV,K) - 30 A(K,JPIV) = A(JPIV,K) - 72 CONTINUE - WRITE (IOUT,1000) AIJMAX - 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE', - 1 'MENT = ',1PE14.7) -C ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER - 300 DO 14 I=1,N - 14 AJJ(I)=A(I,I) - LT=N+1 - DO15 L=1,N - LT=LT-1 - AIIMIN=1.0E+30 - DO16 I=1,N - IF(AJJ(I)-AIIMIN)17,16,16 - 17 AIIMIN=AJJ(I) - IT=I - 16 CONTINUE - IN=L - AII(IN)=AIIMIN - AJJ(IT)=1.0E+30 - DO15 K=1,N - 15 A(IN,K)=C(IT,K) - DO 18 I=1,N - IF(A(I,1))19,22,22 - 19 T=-1.0 - GO TO 91 - 22 T=1.0 - 91 DO 18 J=1,N - 18 C(J,I)=T*A(I,J) - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/econstr_local.F b/source/unres/src_MD-DFA-restraints/econstr_local.F deleted file mode 100644 index f11acfb..0000000 --- a/source/unres/src_MD-DFA-restraints/econstr_local.F +++ /dev/null @@ -1,91 +0,0 @@ - subroutine Econstr_back -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - Uconst_back=0.0d0 - do i=1,nres - dutheta(i)=0.0d0 - dugamma(i)=0.0d0 - do j=1,3 - duscdiff(j,i)=0.0d0 - duscdiffx(j,i)=0.0d0 - enddo - enddo - do i=1,nfrag_back - ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) -c -c Deviations from theta angles -c - utheta_i=0.0d0 - do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) - dtheta_i=theta(j)-thetaref(j) - utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i - dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) - enddo - utheta(i)=utheta_i/(ii-1) -c -c Deviations from gamma angles -c - ugamma_i=0.0d0 - do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset) - dgamma_i=pinorm(phi(j)-phiref(j)) -c write (iout,*) j,phi(j),phi(j)-phiref(j) - ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i - dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2) -c write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3) - enddo - ugamma(i)=ugamma_i/(ii-2) -c -c Deviations from local SC geometry -c - uscdiff(i)=0.0d0 - do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 - dxx=xxtab(j)-xxref(j) - dyy=yytab(j)-yyref(j) - dzz=zztab(j)-zzref(j) - uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz - do k=1,3 - duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* - & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ - & (ii-1) - duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* - & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ - & (ii-1) - duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* - & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) - & /(ii-1) - enddo -c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), -c & xxref(j),yyref(j),zzref(j) - enddo - uscdiff(i)=0.5d0*uscdiff(i)/(ii-1) -c write (iout,*) i," uscdiff",uscdiff(i) -c -c Put together deviations from local geometry -c - Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ - & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i) -c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i), -c & " uconst_back",uconst_back - utheta(i)=dsqrt(utheta(i)) - ugamma(i)=dsqrt(ugamma(i)) - uscdiff(i)=dsqrt(uscdiff(i)) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/eigen.f b/source/unres/src_MD-DFA-restraints/eigen.f deleted file mode 100644 index e4088ee..0000000 --- a/source/unres/src_MD-DFA-restraints/eigen.f +++ /dev/null @@ -1,2351 +0,0 @@ -C 10 AUG 94 - MWS - INCREASE NUMBER OF DAF RECORDS -C 31 MAR 94 - MWS - ADD A VARIABLE TO END OF MACHSW COMMON -C 26 JUN 93 - MWS - ETRED3: ADD RETURN FOR SPECIAL CASE N=1 -C 4 JAN 92 - TLW - MAKE WRITES PARALLEL;ADD COMMON PAR -C 30 AUG 91 - MWS - JACDIA: LIMIT ITERATIONS, USE EPSLON IN TEST. -C 14 JUL 91 - MWS - JACOBI DIAGONALIZATION ALLOWS FOR LDVEC.NE.N -C 29 JAN 91 - TLW - GLDIAG: CHANGED COMMON DIAGSW TO MACHSW -C 29 OCT 90 - STE - FIX JACDIA UNDEFINED VARIABLE BUG -C 14 SEP 90 - MK - NEW JACOBI DIAGONALIZATION (KDIAG=3) -C 27 MAR 88 - MWS - ALLOW FOR VECTOR ROUTINE IN GLDIAG -C 11 AUG 87 - MWS - SANITIZE CONSTANTS IN EQLRAT -C 15 FEB 87 - STE - FIX EINVIT SUB-MATRIX LOOP LIMIT -C SCRATCH ARRAYS ARE N*8 REAL AND N INTEGER -C 8 DEC 86 - STE - USE PERF INDEX FROM ESTPI1 TO JUDGE EINVIT FAILURE -C 30 NOV 86 - STE - DELETE LIGENB, MAKE EVVRSP DEFAULT -C (GIVEIS FAILS ON CRAY FOR BENCHMC AND BENCHCI) -C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS -C 11 OCT 85 - STE - LIGENB,TQL2: USE DROT,DSWAP; TINVTB: SCALE VECTOR -C BEFORE NORMALIZING; GENERIC FUNCTIONS -C 24 FEB 84 - STE - INITIALIZE INDEX ARRAY FOR LIGENB IN GLDIAG -C 1 DEC 83 - STE - CHANGE MACHEP FROM 2**-54 TO 2**-50 -C 28 SEP 82 - MWS - CONVERT TO IBM -C -C*MODULE EIGEN *DECK EINVIT - SUBROUTINE EINVIT(NM,N,D,E,E2,M,W,IND,Z,IERR,RV1,RV2,RV3,RV4,RV6) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF TINVIT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TINVIT IS A TRANSLATION OF THE INVERSE ITERATION TECHNIQUE -C* IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C* SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES. -C* -C* METHOD - -C* INVERSE ITERATION. -C* -C* ON ENTRY - -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C* IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF CORRESPONDING ELEMENTS OF E, -C* WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C* E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C* THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE -C* SUM OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST -C* CONTAIN 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, -C* OR 2.0 IF THE EIGENVALUES ARE IN DESCENDING ORDER. -C* IF TQLRAT, BISECT, TRIDIB, OR IMTQLV -C* HAS BEEN USED TO FIND THE EIGENVALUES, THEIR -C* OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE. -C* M - INTEGER -C* THE NUMBER OF SPECIFIED EIGENVECTORS. -C* W - W.P. REAL (M) -C* CONTAINS THE M EIGENVALUES IN ASCENDING -C* OR DESCENDING ORDER. -C* IND - INTEGER (M) -C* CONTAINS IN FIRST M POSITIONS THE SUBMATRIX INDICES -C* ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C* 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX -C* FROM THE TOP, 2 FOR THOSE BELONGING TO THE SECOND -C* SUBMATRIX, ETC. -C* IERR - INTEGER (LOGICAL UNIT NUMBER) -C* LOGICAL UNIT FOR ERROR MESSAGES -C* -C* ON EXIT - -C* ALL INPUT ARRAYS ARE UNALTERED. -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE ASSOCIATED SET OF ORTHONORMAL -C* EIGENVECTORS. ANY VECTOR WHICH WHICH FAILS TO CONVERGE -C* IS LEFT AS IS (BUT NORMALIZED) WHEN ITERATING STOPPED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C* EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS. -C* (ONLY LAST FAILURE TO CONVERGE IS REPORTED) -C* -C* RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C* -C* RV1 - W.P. REAL (N) -C* DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV2 - W.P. REAL (N) -C* SUPER(1)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV3 - W.P. REAL (N) -C* SUPER(2)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV4 - W.P. REAL (N) -C* ELEMENTS DEFINING L IN LU DECOMPOSITION -C* RV6 - W.P. REAL (N) -C* APPROXIMATE EIGENVECTOR -C* -C* DIFFERENCES FROM EISPACK 3 - -C* EPS3 IS SCALED BY EPSCAL (ENHANCES CONVERGENCE, BUT -C* LOWERS ACCURACY)! -C* ONE MORE ITERATION (MINIMUM 2) IS PERFORMED AFTER CONVERGENCE -C* (ENHANCES ACCURACY)! -C* REPLACE LOOP WITH PYTHAG WITH SINGLE CALL TO DNRM2! -C* IF NOT CONVERGED, USE PERFORMANCE INDEX TO DECIDE ON ERROR -C* VALUE SETTING, BUT DO NOT STOP! -C* L.U. FOR ERROR MESSAGES PASSED THROUGH IERR -C* USE PARAMETER STATEMENTS AND GENERIC INTRINSIC FUNCTIONS -C* USE LEVEL 1 BLAS -C* USE IF-THEN-ELSE TO CLARIFY LOGIC -C* LOOP OVER SUBSPACES MADE INTO DO LOOP. -C* LOOP OVER INVERSE ITERATIONS MADE INTO DO LOOP -C* ZERO ONLY REQUIRED PORTIONS OF OUTPUT VECTOR -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C* -C - LOGICAL CONVGD,GOPARR,DSKWRK,MASWRK -C - INTEGER GROUP,I,IERR,ITS,J,JJ,M,N,NM,P,Q,R,S,SUBMAT,TAG - INTEGER IND(M) -C - DOUBLE PRECISION D(N),E(N),E2(N),W(M),Z(NM,M) - DOUBLE PRECISION RV1(N),RV2(N),RV3(N),RV4(N),RV6(N) - DOUBLE PRECISION ANORM,EPS2,EPS3,EPS4,NORM,ORDER,RHO,U,UK,V - DOUBLE PRECISION X0,X1,XU - DOUBLE PRECISION EPSCAL,GRPTOL,HUNDRD,ONE,TEN,ZERO - DOUBLE PRECISION EPSLON, ESTPI1, DASUM, DDOT, DNRM2 -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00, GRPTOL = 0.001D+00) - PARAMETER (EPSCAL = 0.5D+00, HUNDRD = 100.0D+00, TEN = 10.0D+00) -C - 001 FORMAT(' EIGENVECTOR ROUTINE EINVIT DID NOT CONVERGE FOR VECTOR' - * ,I5,'. NORM =',1P,E10.2,' PERFORMANCE INDEX =',E10.2/ - * ' (AN ERROR HALT WILL OCCUR IF THE PI IS GREATER THAN 100)') -C -C----------------------------------------------------------------------- -C - LUEMSG = IERR - IERR = 0 - X0 = ZERO - UK = ZERO - NORM = ZERO - EPS2 = ZERO - EPS3 = ZERO - EPS4 = ZERO - GROUP = 0 - TAG = 0 - ORDER = ONE - E2(1) - Q = 0 - DO 930 SUBMAT = 1, N - P = Q + 1 -C -C .......... ESTABLISH AND PROCESS NEXT SUBMATRIX .......... -C - DO 120 Q = P, N-1 - IF (E2(Q+1) .EQ. ZERO) GO TO 140 - 120 CONTINUE - Q = N -C -C .......... FIND VECTORS BY INVERSE ITERATION .......... -C - 140 CONTINUE - TAG = TAG + 1 - ANORM = ZERO - S = 0 -C - DO 920 R = 1, M - IF (IND(R) .NE. TAG) GO TO 920 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 510 -C -C .......... CHECK FOR ISOLATED ROOT .......... -C - XU = ONE - IF (P .EQ. Q) THEN - RV6(P) = ONE - CONVGD = .TRUE. - GO TO 860 -C - END IF - NORM = ABS(D(P)) - DO 500 I = P+1, Q - NORM = MAX( NORM, ABS(D(I)) + ABS(E(I)) ) - 500 CONTINUE -C -C .......... EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ......... -C - EPS2 = GRPTOL * NORM - EPS3 = EPSCAL * EPSLON(NORM) - UK = Q - P + 1 - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - GROUP = 0 - GO TO 520 -C -C .......... LOOK FOR CLOSE OR COINCIDENT ROOTS .......... -C - 510 IF (ABS(X1-X0) .GE. EPS2) THEN -C -C ROOTS ARE SEPERATE -C - GROUP = 0 - ELSE -C -C ROOTS ARE CLOSE -C - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. EPS3) X1 = X0 + ORDER * EPS3 - END IF -C -C .......... ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR .......... -C - 520 CONTINUE -C - U = D(P) - X1 - V = E(P+1) - RV6(P) = UK - DO 550 I = P+1, Q - RV6(I) = UK - IF (ABS(E(I)) .GT. ABS(U)) THEN -C -C EXCHANGE ROWS BEFORE ELIMINATION -C -C *** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ....... -C - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) -C - ELSE -C -C STRAIGHT ELIMINATION -C - XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = ZERO - U = D(I) - X1 - XU * V - V = E(I+1) - END IF - 550 CONTINUE -C - IF (ABS(U) .LE. EPS3) U = EPS3 - RV1(Q) = U - RV2(Q) = ZERO - RV3(Q) = ZERO -C -C DO INVERSE ITERATIONS -C - CONVGD = .FALSE. - DO 800 ITS = 1, 5 - IF (ITS .EQ. 1) GO TO 600 -C -C .......... FORWARD SUBSTITUTION .......... -C - IF (NORM .EQ. ZERO) THEN - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - ELSE - XU = EPS4 / NORM - CALL DSCAL (Q-P+1, XU, RV6(P), 1) - END IF -C -C ... ELIMINATION OPERATIONS ON NEXT VECTOR -C - DO 590 I = P+1, Q - U = RV6(I) -C -C IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS .......... -C - IF (RV1(I-1) .EQ. E(I)) THEN - U = RV6(I-1) - RV6(I-1) = RV6(I) - ELSE - U = RV6(I) - END IF - RV6(I) = U - RV4(I) * RV6(I-1) - 590 CONTINUE - 600 CONTINUE -C -C .......... BACK SUBSTITUTION -C - RV6(Q) = RV6(Q) / RV1(Q) - V = U - U = RV6(Q) - NORM = ABS(U) - DO 620 I = Q-1, P, -1 - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - NORM = NORM + ABS(U) - 620 CONTINUE - IF (GROUP .EQ. 0) GO TO 700 -C -C ....... ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP .......... -C - J = R - DO 680 JJ = 1, GROUP - 630 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 630 - CALL DAXPY(Q-P+1, -DDOT(Q-P+1,RV6(P),1,Z(P,J),1), - * Z(P,J),1,RV6(P),1) - 680 CONTINUE - NORM = DASUM(Q-P+1, RV6(P), 1) - 700 CONTINUE -C - IF (CONVGD) GO TO 840 - IF (NORM .GE. ONE) CONVGD = .TRUE. - 800 CONTINUE -C -C .......... NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER .......... -C - 840 CONTINUE -C - XU = ONE / DNRM2(Q-P+1,RV6(P),1) -C - 860 CONTINUE - DO 870 I = 1, P-1 - Z(I,R) = ZERO - 870 CONTINUE - DO 890 I = P,Q - Z(I,R) = RV6(I) * XU - 890 CONTINUE - DO 900 I = Q+1, N - Z(I,R) = ZERO - 900 CONTINUE -C - IF (.NOT.CONVGD) THEN - RHO = ESTPI1(Q-P+1,X1,D(P),E(P),Z(P,R),ANORM) - IF (RHO .GE. TEN .AND. LUEMSG .GT. 0 .AND. MASWRK) - * WRITE(LUEMSG,001) R,NORM,RHO -C -C *** SET ERROR -- NON-CONVERGED EIGENVECTOR .......... -C - IF (RHO .GT. HUNDRD) IERR = -R - END IF -C - X0 = X1 - 920 CONTINUE -C - IF (Q .EQ. N) GO TO 940 - 930 CONTINUE - 940 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ELAUM - SUBROUTINE ELAU(HINV,L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G - DOUBLE PRECISION HALF - DOUBLE PRECISION HH - DOUBLE PRECISION HINV - DOUBLE PRECISION ZERO -C - PARAMETER (ZERO = 0.0D+00, HALF = 0.5D+00) -C - JL = L - E(1) = A(1) * D(1) - JK = 2 - DO 210 J = 2, JL - F = D(J) - G = ZERO - JM1 = J - 1 -C - DO 200 K = 1, JM1 - G = G + A(JK) * D(K) - E(K) = E(K) + A(JK) * F - JK = JK + 1 - 200 CONTINUE -C - E(J) = G + A(JK) * F - JK = JK + 1 - 210 CONTINUE -C -C .......... FORM P .......... -C - F = ZERO - DO 245 J = 1, L - E(J) = E(J) * HINV - F = F + E(J) * D(J) - 245 CONTINUE -C -C .......... FORM Q .......... -C - HH = F * HALF * HINV - DO 250 J = 1, L - 250 E(J) = E(J) - HH * D(J) -C - RETURN - END -C*MODULE EIGEN *DECK EPSLON - DOUBLE PRECISION FUNCTION EPSLON (X) -C* -C* AUTHORS - -C* THIS ROUTINE WAS TAKEN FROM EISPACK EDITION 3 DATED 4/6/83 -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE NOV 1986 -C* -C* PURPOSE - -C* ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X. -C* -C* ON ENTRY - -C* X - WORKING PRECISION REAL -C* VALUES TO FIND EPSLON FOR -C* -C* ON EXIT - -C* EPSLON - WORKING PRECISION REAL -C* SMALLEST POSITIVE VALUE SUCH THAT X+EPSLON .NE. ZERO -C* -C* QUALIFICATIONS - -C* THIS ROUTINE SHOULD PERFORM PROPERLY ON ALL SYSTEMS -C* SATISFYING THE FOLLOWING TWO ASSUMPTIONS, -C* 1. THE BASE USED IN REPRESENTING FLOATING POINT -C* NUMBERS IS NOT A POWER OF THREE. -C* 2. THE QUANTITY A IN STATEMENT 10 IS REPRESENTED TO -C* THE ACCURACY USED IN FLOATING POINT VARIABLES -C* THAT ARE STORED IN MEMORY. -C* THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO -C* FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING -C* ASSUMPTION 2. -C* UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT, -C* A IS NOT EXACTLY EQUAL TO FOUR-THIRDS, -C* B HAS A ZERO FOR ITS LAST BIT OR DIGIT, -C* C IS NOT EXACTLY EQUAL TO ONE, -C* EPS MEASURES THE SEPARATION OF 1.0 FROM -C* THE NEXT LARGER FLOATING POINT NUMBER. -C* THE DEVELOPERS OF EISPACK WOULD APPRECIATE BEING INFORMED -C* ABOUT ANY SYSTEMS WHERE THESE ASSUMPTIONS DO NOT HOLD. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* USE IS MADE OF PARAMETER STATEMENTS AND INTRINSIC FUNCTIONS -C* --NO EXECUTEABLE CODE CHANGES-- -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - DOUBLE PRECISION A,B,C,EPS,X - DOUBLE PRECISION ZERO, ONE, THREE, FOUR -C - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, THREE=3.0D+00, FOUR=4.0D+00) -C -C----------------------------------------------------------------------- -C - A = FOUR/THREE - 10 B = A - ONE - C = B + B + B - EPS = ABS(C - ONE) - IF (EPS .EQ. ZERO) GO TO 10 - EPSLON = EPS*ABS(X) - RETURN - END -C*MODULE EIGEN *DECK EQLRAT - SUBROUTINE EQLRAT(N,DIAG,E,E2IN,D,IND,IERR,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE EQLRAT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TQLRAT IS A TRANSLATION OF THE ALGOL PROCEDURE TQLRAT, -C* ALGORITHM 464, COMM. ACM 16, 689(1973) BY REINSCH. -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC -C* TRIDIAGONAL MATRIX -C* -C* METHOD - -C* RATIONAL QL -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE SUBDIAGONAL ELEMENTS OF -C* THE INPUT MATRIX IN ITS LAST N-1 POSITIONS. -C* E2(1) IS ARBITRARY. -C* -C* ON EXIT - -C* D - W.P. REAL (N) -C* CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C* ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C* ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C* THE SMALLEST EIGENVALUES. -C* E2 - W.P. REAL (N) -C* DESTROYED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* J IF THE J-TH EIGENVALUE HAS NOT BEEN -C* DETERMINED AFTER 30 ITERATIONS. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* G=G+B INSTEAD OF IF(G.EQ.0) G=B ; B=B/4 -C* F77 BACKWARD LOOPS INSTEAD OF F66 CONSTRUCT -C* GENERIC INTRINSIC FUNCTIONS -C* ARRARY IND ADDED FOR USE BY EINVIT -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,J,L,M,N,II,L1,IERR - INTEGER IND(N) -C - DOUBLE PRECISION D(N),E(N),E2(N),DIAG(N),E2IN(N) - DOUBLE PRECISION B,C,F,G,H,P,R,S,T,EPSLON - DOUBLE PRECISION SCALE,ZERO,ONE -C - PARAMETER (ZERO = 0.0D+00, SCALE= 1.0D+00/64.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- - IERR = 0 - D(1)=DIAG(1) - IND(1) = 1 - K = 0 - ITAG = 0 - IF (N .EQ. 1) GO TO 1001 -C - DO 100 I = 2, N - D(I)=DIAG(I) - 100 E2(I-1) = E2IN(I) -C - F = ZERO - T = ZERO - B = EPSLON(ONE) - C = B *B - B = B * SCALE - E2(N) = ZERO -C - DO 290 L = 1, N - H = ABS(D(L)) + ABS(E(L)) - IF (T .GE. H) GO TO 105 - T = H - B = EPSLON(T) - C = B * B - B = B * SCALE - 105 CONTINUE -C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT .......... - M = L - 1 - 110 M = M + 1 - IF (E2(M) .GT. C) GO TO 110 -C .......... E2(N) IS ALWAYS ZERO, SO THERE IS AN EXIT -C FROM THE LOOP .......... -C - IF (M .LE. K) GO TO 125 - IF (M .NE. N) E2IN(M+1) = ZERO - K = M - ITAG = ITAG + 1 - 125 CONTINUE - IF (M .EQ. L) GO TO 210 -C -C ITERATE -C - DO 205 J = 1, 30 -C .......... FORM SHIFT .......... - L1 = L + 1 - S = SQRT(E2(L)) - G = D(L) - P = (D(L1) - G) / (2.0D+00 * S) - R = SQRT(P*P+1.0D+00) - D(L) = S / (P + SIGN(R,P)) - H = G - D(L) -C - DO 140 I = L1, N - 140 D(I) = D(I) - H -C - F = F + H -C .......... RATIONAL QL TRANSFORMATION .......... - G = D(M) + B - H = G - S = ZERO - DO 200 I = M-1,L,-1 - P = G * H - R = P + E2(I) - E2(I+1) = S * R - S = E2(I) / R - D(I+1) = H + S * (H + D(I)) - G = D(I) - E2(I) / G + B - H = G * P / R - 200 CONTINUE -C - E2(L) = S * G - D(L) = H -C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST - IF (H .EQ. ZERO) GO TO 210 - IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210 - E2(L) = H * E2(L) - IF (E2(L) .EQ. ZERO) GO TO 210 - 205 CONTINUE -C .......... SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS .......... - IERR = L - GO TO 1001 -C -C CONVERGED -C - 210 P = D(L) + F -C .......... ORDER EIGENVALUES .......... - I = 1 - IF (L .EQ. 1) GO TO 250 - IF (P .LT. D(1)) GO TO 230 - I = L -C .......... LOOP TO FIND ORDERED POSITION - 220 I = I - 1 - IF (P .LT. D(I)) GO TO 220 -C - I = I + 1 - IF (I .EQ. L) GO TO 250 - 230 CONTINUE - DO 240 II = L, I+1, -1 - D(II) = D(II-1) - IND(II) = IND(II-1) - 240 CONTINUE -C - 250 CONTINUE - D(I) = P - IND(I) = ITAG - 290 CONTINUE -C - 1001 RETURN - END -C*MODULE EIGEN *DECK ESTPI1 - DOUBLE PRECISION FUNCTION ESTPI1 (N,EVAL,D,E,X,ANORM) -C* -C* AUTHOR - -C* STEPHEN T. ELBERT (AMES LABORATORY-USDOE) DATE: 5 DEC 1986 -C* -C* PURPOSE - -C* EVALUATE SYMMETRIC TRIDIAGONAL MATRIX PERFORMANCE INDEX -C* * * * * * -C* FOR 1 EIGENVECTOR -C* * -C* -C* METHOD - -C* THIS ROUTINE FORMS THE 1-NORM OF THE RESIDUAL MATRIX A*X-X*EVAL -C* WHERE A IS A SYMMETRIC TRIDIAGONAL MATRIX STORED -C* IN THE DIAGONAL (D) AND SUB-DIAGONAL (E) VECTORS, EVAL IS THE -C* EIGENVALUE OF AN EIGENVECTOR OF A, NAMELY X. -C* THIS NORM IS SCALED BY MACHINE ACCURACY FOR THE PROBLEM SIZE. -C* ALL NORMS APPEARING IN THE COMMENTS BELOW ARE 1-NORMS. -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* EVAL - W.P. REAL -C* THE EIGENVALUE CORRESPONDING TO VECTOR X. -C* D - W.P. REAL (N) -C* THE DIAGONAL VECTOR OF A. -C* E - W.P. REAL (N) -C* THE SUB-DIAGONAL VECTOR OF A. -C* X - W.P. REAL (N) -C* AN EIGENVECTOR OF A. -C* ANORM - W.P. REAL -C* THE NORM OF A IF IT HAS BEEN PREVIOUSLY COMPUTED. -C* -C* ON EXIT - -C* ANORM - W.P. REAL -C* THE NORM OF A, COMPUTED IF INITIALLY ZERO. -C* ESTPI1 - W.P. REAL -C* !!A*X-X*EVAL!! / (EPSLON(10*N)*!!A!!*!!X!!); -C* WHERE EPSLON(X) IS THE SMALLEST NUMBER SUCH THAT -C* X + EPSLON(X) .NE. X -C* -C* ESTPI1 .LT. 1 == SATISFACTORY PERFORMANCE -C* .GE. 1 AND .LE. 100 == MARGINAL PERFORMANCE -C* .GT. 100 == POOR PERFORMANCE -C* (SEE LECT. NOTES IN COMP. SCI. VOL.6 PP 124-125) -C - DOUBLE PRECISION ANORM,EVAL,RNORM,SIZE,XNORM - DOUBLE PRECISION D(N), E(N), X(N) - DOUBLE PRECISION EPSLON, ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - ESTPI1 = ZERO - IF( N .LE. 1 ) RETURN - SIZE = 10 * N - IF (ANORM .EQ. ZERO) THEN -C -C COMPUTE NORM OF A -C - ANORM = MAX( ABS(D(1)) + ABS(E(2)) - * ,ABS(D(N)) + ABS(E(N))) - DO 110 I = 2, N-1 - ANORM = MAX( ANORM, ABS(E(I))+ABS(D(I))+ABS(E(I+1))) - 110 CONTINUE - IF(ANORM .EQ. ZERO) ANORM = ONE - END IF -C -C COMPUTE NORMS OF RESIDUAL AND EIGENVECTOR -C - XNORM = ABS(X(1)) + ABS(X(N)) - RNORM = ABS( (D(1)-EVAL)*X(1) + E(2)*X(2)) - * +ABS( (D(N)-EVAL)*X(N) + E(N)*X(N-1)) - DO 120 I = 2, N-1 - XNORM = XNORM + ABS(X(I)) - RNORM = RNORM + ABS(E(I)*X(I-1) + (D(I)-EVAL)*X(I) - * + E(I+1)*X(I+1)) - 120 CONTINUE -C - ESTPI1 = RNORM / (EPSLON(SIZE)*ANORM*XNORM) - RETURN - END -C*MODULE EIGEN *DECK ETRBK3 - SUBROUTINE ETRBK3(NM,N,NV,A,M,Z) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF ROUTINE TRBAK3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRBAK3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C* MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C* SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY ETRED3. -C* -C* METHOD - -C* THE CALCULATION IS CARRIED OUT BY FORMING THE MATRIX PRODUCT -C* Q*Z -C* WHERE Q IS A PRODUCT OF THE ORTHOGONAL SYMMETRIC MATRICES -C* Q = PROD(I)[1 - U(I)*.TRANSPOSE.U(I)*H(I)] -C* U IS THE AUGMENTED SUB-DIAGONAL ROWS OF A AND -C* Z IS THE SET OF EIGENVECTORS OF THE TRIDIAGONAL -C* MATRIX F WHICH WAS FORMED FROM THE ORIGINAL SYMMETRIC -C* MATRIX C BY THE SIMILARITY TRANSFORMATION -C* F = Q(TRANSPOSE) C Q -C* NOTE THAT ETRBK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C* -C* -C* COMPLEXITY - -C* M*N**2 -C* -C* ON ENTRY- -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY A AS -C* DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT. -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION BY ETRED3 IN -C* ITS FIRST NV = N*(N+1)/2 POSITIONS. -C* M - INTEGER -C* THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. -C* Z - W.P REAL (NM,M) -C* CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C* IN ITS FIRST M COLUMNS. -C* -C* ON EXIT- -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE TRANSFORMED EIGENVECTORS -C* IN ITS FIRST M COLUMNS. -C* -C* DIFFERENCES WITH EISPACK 3 - -C* THE TWO INNER LOOPS ARE REPLACED BY DDOT AND DAXPY. -C* MULTIPLICATION USED INSTEAD OF DIVISION TO FIND S. -C* OUTER LOOP RANGE CHANGED FROM 2,N TO 3,N. -C* ADDRESS POINTERS FOR A SIMPLIFIED. -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,II,IM1,IZ,J,M,N,NM,NV -C - DOUBLE PRECISION A(NV),Z(NM,M) - DOUBLE PRECISION H,S,DDOT,ZERO -C - PARAMETER (ZERO = 0.0D+00) -C -C----------------------------------------------------------------------- -C - IF (M .EQ. 0) RETURN - IF (N .LE. 2) RETURN -C - II=3 - DO 140 I = 3, N - IZ=II+1 - II=II+I - H = A(II) - IF (H .EQ. ZERO) GO TO 140 - IM1 = I - 1 - DO 130 J = 1, M - S = -( DDOT(IM1,A(IZ),1,Z(1,J),1) * H) * H - CALL DAXPY(IM1,S,A(IZ),1,Z(1,J),1) - 130 CONTINUE - 140 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ETRED3 - SUBROUTINE ETRED3(N,NV,A,D,E,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE TRED3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRED3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE JUN 1986 -C* -C* PURPOSE - -C* THIS ROUTINE REDUCES A REAL SYMMETRIC (PACKED) MATRIX, STORED -C* AS A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C* USING ORTHOGONAL SIMILARITY TRANSFORMATIONS, PRESERVING THE -C* INFORMATION ABOUT THE TRANSFORMATIONS IN A. -C* -C* METHOD - -C* THE TRIDIAGONAL REDUCTION IS PERFORMED IN THE FOLLOWING WAY. -C* STARTING WITH J=N, THE ELEMENTS IN THE J-TH ROW TO THE -C* LEFT OF THE DIAGONAL ARE FIRST SCALED, TO AVOID POSSIBLE -C* UNDERFLOW IN THE TRANSFORMATION THAT MIGHT RESULT IN SEVERE -C* DEPARTURE FROM ORTHOGONALITY. THE SUM OF SQUARES SIGMA OF -C* THESE SCALED ELEMENTS IS NEXT FORMED. THEN, A VECTOR U AND -C* A SCALAR -C* H = U(TRANSPOSE) * U / 2 -C* DEFINE A REFLECTION OPERATOR -C* P = I - U * U(TRANSPOSE) / H -C* WHICH IS ORTHOGONAL AND SYMMETRIC AND FOR WHICH THE -C* SIMILIARITY TRANSFORMATION PAP ELIMINATES THE ELEMENTS IN -C* THE J-TH ROW OF A TO THE LEFT OF THE SUBDIAGONAL AND THE -C* SYMMETRICAL ELEMENTS IN THE J-TH COLUMN. -C* -C* THE NON-ZERO COMPONENTS OF U ARE THE ELEMENTS OF THE J-TH -C* ROW TO THE LEFT OF THE DIAGONAL WITH THE LAST OF THEM -C* AUGMENTED BY THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE SUBDIAGONAL ELEMENT. BY STORING THE TRANSFORMED SUB- -C* DIAGONAL ELEMENT IN E(J) AND NOT OVERWRITING THE ROW -C* ELEMENTS ELIMINATED IN THE TRANSFORMATION, FULL INFORMATION -C* ABOUT P IS SAVE FOR LATER USE IN ETRBK3. -C* -C* THE TRANSFORMATION SETS E2(J) EQUAL TO SIGMA AND E(J) -C* EQUAL TO THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE REPLACED SUBDIAGONAL ELEMENT. -C* -C* THE ABOVE STEPS ARE REPEATED ON FURTHER ROWS OF THE -C* TRANSFORMED A IN REVERSE ORDER UNTIL A IS REDUCED TO TRI- -C* DIAGONAL FORM, THAT IS, REPEATED FOR J = N-1,N-2,...,3. -C* -C* COMPLEXITY - -C* 2/3 N**3 -C* -C* ON ENTRY- -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C* AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT -C* A - W.P. REAL (NV) -C* CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C* INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C* ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C* -C* ON EXIT- -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF -C* E. MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* OUTER LOOP CHANGED FROM II=1,N TO I=N,3,-1 -C* PARAMETER STATEMENT AND GENERIC INTRINSIC FUNCTIONS USED -C* SCALE.NE.0 TEST NOW SPOTS TRI-DIAGONAL FORM -C* VALUES LESS THAN EPSLON CLEARED TO ZERO -C* USE BLAS(1) -C* U NOT COPIED TO D, LEFT IN A -C* E2 COMPUTED FROM E -C* INNER LOOPS SPLIT INTO ROUTINES ELAU AND FREDA -C* INVERSE OF H STORED INSTEAD OF H -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,IIA,IZ0,L,N,NV -C - DOUBLE PRECISION A(NV),D(N),E(N),E2(N) - DOUBLE PRECISION AIIMAX,F,G,H,HROOT,SCALE,SCALEI - DOUBLE PRECISION DASUM, DNRM2 - DOUBLE PRECISION ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - IF (N .LE. 2) GO TO 310 - IZ0 = (N*N+N)/2 - AIIMAX = ABS(A(IZ0)) - DO 300 I = N, 3, -1 - L = I - 1 - IIA = IZ0 - IZ0 = IZ0 - I - AIIMAX = MAX(AIIMAX, ABS(A(IIA))) - SCALE = DASUM (L, A(IZ0+1), 1) - IF(SCALE .EQ. ABS(A(IIA-1)) .OR. AIIMAX+SCALE .EQ. AIIMAX) THEN -C -C THIS ROW IS ALREADY IN TRI-DIAGONAL FORM -C - D(I) = A(IIA) - IF (AIIMAX+D(I) .EQ. AIIMAX) D(I) = ZERO - E(I) = A(IIA-1) - IF (AIIMAX+E(I) .EQ. AIIMAX) E(I) = ZERO - E2(I) = E(I)*E(I) - A(IIA) = ZERO - GO TO 300 -C - END IF -C - SCALEI = ONE / SCALE - CALL DSCAL(L,SCALEI,A(IZ0+1),1) - HROOT = DNRM2(L,A(IZ0+1),1) -C - F = A(IZ0+L) - G = -SIGN(HROOT,F) - E(I) = SCALE * G - E2(I) = E(I)*E(I) - H = HROOT*HROOT - F * G - A(IZ0+L) = F - G - D(I) = A(IIA) - A(IIA) = ONE / SQRT(H) -C .......... FORM P THEN Q IN E(1:L) .......... - CALL ELAU(ONE/H,L,A(IZ0+1),A,E) -C .......... FORM REDUCED A .......... - CALL FREDA(L,A(IZ0+1),A,E) -C - 300 CONTINUE - 310 CONTINUE - E(1) = ZERO - E2(1)= ZERO - D(1) = A(1) - IF(N.EQ.1) RETURN -C - E(2) = A(2) - E2(2)= A(2)*A(2) - D(2) = A(3) - RETURN - END -C*MODULE EIGEN *DECK EVVRSP - SUBROUTINE EVVRSP(MSGFL,N,NVECT,LENA,NV,A,B,IND,ROOT, - * VECT,IORDER,IERR) -C* -C* AUTHOR: S. T. ELBERT, AMES LABORATORY-USDOE, JUNE 1985 -C* -C* PURPOSE - -C* FINDS (ALL) EIGENVALUES AND (SOME OR ALL) EIGENVECTORS -C* * * * -C* OF A REAL SYMMETRIC PACKED MATRIX. -C* * * * -C* -C* METHOD - -C* THE METHOD AS PRESENTED IN THIS ROUTINE CONSISTS OF FOUR STEPS: -C* FIRST, THE INPUT MATRIX IS REDUCED TO TRIDIAGONAL FORM BY THE -C* HOUSEHOLDER TECHNIQUE (ORTHOGONAL SIMILARITY TRANSFORMATIONS). -C* SECOND, THE ROOTS ARE LOCATED USING THE RATIONAL QL METHOD. -C* THIRD, THE VECTORS OF THE TRIDIAGONAL FORM ARE EVALUATED BY THE -C* INVERSE ITERATION TECHNIQUE. VECTORS FOR DEGENERATE OR NEAR- -C* DEGENERATE ROOTS ARE FORCED TO BE ORTHOGONAL. -C* FOURTH, THE TRIDIAGONAL VECTORS ARE ROTATED TO VECTORS OF THE -C* ORIGINAL ARRAY. -C* -C* THESE ROUTINES ARE MODIFICATIONS OF THE EISPACK 3 -C* ROUTINES TRED3, TQLRAT, TINVIT AND TRBAK3 -C* -C* FOR FURTHER DETAILS, SEE EISPACK USERS GUIDE, B. T. SMITH -C* ET AL, SPRINGER-VERLAG, LECTURE NOTES IN COMPUTER SCIENCE, -C* VOL. 6, 2-ND EDITION, 1976. ANOTHER GOOD REFERENCE IS -C* THE SYMMETRIC EIGENVALUE PROBLEM BY B. N. PARLETT -C* PUBLISHED BY PRENTICE-HALL, INC., ENGLEWOOD CLIFFS, N.J. (1980) -C* -C* ON ENTRY - -C* MSGFL - INTEGER (LOGICAL UNIT NO.) -C* FILE WHERE ERROR MESSAGES WILL BE PRINTED. -C* IF MSGFL IS 0, ERROR MESSAGES WILL BE PRINTED ON LU 6. -C* IF MSGFL IS NEGATIVE, NO ERROR MESSAGES PRINTED. -C* N - INTEGER -C* ORDER OF MATRIX A. -C* NVECT - INTEGER -C* NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N. -C* LENA - INTEGER -C* DIMENSION OF A IN CALLING ROUTINE. MUST NOT BE LESS -C* THAN (N*N+N)/2. -C* NV - INTEGER -C* ROW DIMENSION OF VECT IN CALLING ROUTINE. N .LE. NV. -C* A - WORKING PRECISION REAL (LENA) -C* INPUT MATRIX, ROWS OF THE LOWER TRIANGLE PACKED INTO -C* LINEAR ARRAY OF DIMENSION N*(N+1)/2. THE PACKED ORDER -C* IS A(1,1), A(2,1), A(2,2), A(3,1), A(3,2), ... -C* B - WORKING PRECISION REAL (N,8) -C* SCRATCH ARRAY, 8*N ELEMENTS -C* IND - INTEGER (N) -C* SCRATCH ARRAY OF LENGTH N. -C* IORDER - INTEGER -C* ROOT ORDERING FLAG. -C* = 0, ROOTS WILL BE PUT IN ASCENDING ORDER. -C* = 2, ROOTS WILL BE PUT IN DESCENDING ORDER. -C* -C* ON EXIT - -C* A - DESTORYED. NOW HOLDS REFLECTION OPERATORS. -C* ROOT - WORKING PRECISION REAL (N) -C* ALL EIGENVALUES IN ASCENDING OR DESCENDING ORDER. -C* IF IORDER = 0, ROOT(1) .LE. ... .LE. ROOT(N) -C* IF IORDER = 2, ROOT(1) .GE. ... .GE. ROOT(N) -C* VECT - WORKING PRECISION REAL (NV,NVECT) -C* EIGENVECTORS FOR ROOT(1), ..., ROOT(NVECT). -C* IERR - INTEGER -C* = 0 IF NO ERROR DETECTED, -C* = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C* = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C* (FAILURES SHOULD BE VERY RARE. CONTACT C. MOLER.) -C* -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DOUBLE PRECISION A(LENA) - DOUBLE PRECISION B(N,8) - DOUBLE PRECISION ROOT(N) - DOUBLE PRECISION T - DOUBLE PRECISION VECT(NV,*) -C - INTEGER IND(N) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - 900 FORMAT(26H0*** EVVRSP PARAMETERS ***/ - + 14H *** N = ,I8,4H ***/ - + 14H *** NVECT = ,I8,4H ***/ - + 14H *** LENA = ,I8,4H ***/ - + 14H *** NV = ,I8,4H ***/ - + 14H *** IORDER = ,I8,4H ***/ - + 14H *** IERR = ,I8,4H ***) - 901 FORMAT(37H VALUE OF LENA IS LESS THAN (N*N+N)/2) - 902 FORMAT(39H EQLRAT HAS FAILED TO CONVERGE FOR ROOT,I5) - 903 FORMAT(18H NV IS LESS THAN N) - 904 FORMAT(41H EINVIT HAS FAILED TO CONVERGE FOR VECTOR,I5) - 905 FORMAT(51H VALUE OF IORDER MUST BE 0 (SMALLEST ROOT FIRST) OR - * ,23H 2 (LARGEST ROOT FIRST)) - 906 FORMAT(' VALUE OF N IS LESS THAN OR EQUAL ZERO') -C -C----------------------------------------------------------------------- -C - LMSGFL=MSGFL - IF (MSGFL .EQ. 0) LMSGFL=6 - IERR = N - 1 - IF (N .LE. 0) GO TO 800 - IERR = N + 1 - IF ( (N*N+N)/2 .GT. LENA) GO TO 810 -C -C REDUCE REAL SYMMETRIC MATRIX A TO TRIDIAGONAL FORM -C - CALL ETRED3(N,LENA,A,B(1,1),B(1,2),B(1,3)) -C -C FIND ALL EIGENVALUES OF TRIDIAGONAL MATRIX -C - CALL EQLRAT(N,B(1,1),B(1,2),B(1,3),ROOT,IND,IERR,B(1,4)) - IF (IERR .NE. 0) GO TO 820 -C -C CHECK THE DESIRED ORDER OF THE EIGENVALUES -C - B(1,3) = IORDER - IF (IORDER .EQ. 0) GO TO 300 - IF (IORDER .NE. 2) GO TO 850 -C -C ORDER ROOTS IN DESCENDING ORDER (LARGEST FIRST)... -C TURN ROOT AND IND ARRAYS END FOR END -C - DO 210 I = 1, N/2 - J = N+1-I - T = ROOT(I) - ROOT(I) = ROOT(J) - ROOT(J) = T - L = IND(I) - IND(I) = IND(J) - IND(J) = L - 210 CONTINUE -C -C FIND I AND J MARKING THE START AND END OF A SEQUENCE -C OF DEGENERATE ROOTS -C - I=0 - 220 CONTINUE - I = I+1 - IF (I .GT. N) GO TO 300 - DO 230 J=I,N - IF (ROOT(J) .NE. ROOT(I)) GO TO 240 - 230 CONTINUE - J = N+1 - 240 CONTINUE - J = J-1 - IF (J .EQ. I) GO TO 220 -C -C TURN AROUND IND BETWEEN I AND J -C - JSV = J - KLIM = (J-I+1)/2 - DO 250 K=1,KLIM - L = IND(J) - IND(J) = IND(I) - IND(I) = L - I = I+1 - J = J-1 - 250 CONTINUE - I = JSV - GO TO 220 -C - 300 CONTINUE -C - IF (NVECT .LE. 0) RETURN - IF (NV .LT. N) GO TO 830 -C -C FIND EIGENVECTORS OF TRI-DIAGONAL MATRIX VIA INVERSE ITERATION -C - IERR = LMSGFL - CALL EINVIT(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,IND, - + VECT,IERR,B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .NE. 0) GO TO 840 -C -C FIND EIGENVECTORS OF SYMMETRIC MATRIX VIA BACK TRANSFORMATION -C - 400 CONTINUE - CALL ETRBK3(NV,N,LENA,A,NVECT,VECT) - RETURN -C -C ERROR MESSAGE SECTION -C - 800 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,906) - GO TO 890 -C - 810 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,901) - GO TO 890 -C - 820 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,902) IERR - GO TO 890 -C - 830 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,903) - GO TO 890 -C - 840 CONTINUE - IF ((LMSGFL .GT. 0).AND.MASWRK) WRITE(LMSGFL,904) -IERR - GO TO 400 -C - 850 IERR=-1 - IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,905) - GO TO 890 -C - 890 CONTINUE - IF (MASWRK) WRITE(LMSGFL,900) N,NVECT,LENA,NV,IORDER,IERR - RETURN - END -C*MODULE EIGEN *DECK FREDA - SUBROUTINE FREDA(L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G -C - JK = 1 -C -C .......... FORM REDUCED A .......... -C - DO 280 J = 1, L - F = D(J) - G = E(J) -C - DO 260 K = 1, J - A(JK) = A(JK) - F * E(K) - G * D(K) - JK = JK + 1 - 260 CONTINUE -C - 280 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK GIVEIS - SUBROUTINE GIVEIS(N,NVECT,NV,A,B,INDB,ROOT,VECT,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(*),B(N,8),INDB(N),ROOT(N),VECT(NV,NVECT) -C -C EISPACK-BASED SUBSTITUTE FOR QCPE ROUTINE GIVENS. -C FINDS ALL EIGENVALUES AND SOME EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX. AUTHOR.. C. MOLER AND D. SPANGLER, N.R.C.C., 4/1/79. -C -C INPUT.. -C N = ORDER OF MATRIX . -C NVECT = NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N . -C NV = LEADING DIMENSION OF VECT . -C A = INPUT MATRIX, COLUMNS OF THE UPPER TRIANGLE PACKED INTO -C LINEAR ARRAY OF DIMENSION N*(N+1)/2 . -C B = SCRATCH ARRAY, 8*N ELEMENTS (NOTE THIS IS MORE THAN -C PREVIOUS VERSIONS OF GIVENS.) -C IND = INDEX ARRAY OF N ELEMENTS -C -C OUTPUT.. -C A DESTROYED . -C ROOT = ALL EIGENVALUES, ROOT(1) .LE. ... .LE. ROOT(N) . -C (FOR OTHER ORDERINGS, SEE BELOW.) -C VECT = EIGENVECTORS FOR ROOT(1),..., ROOT(NVECT) . -C IERR = 0 IF NO ERROR DETECTED, -C = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C (FAILURES SHOULD BE VERY RARE. CONTACT MOLER.) -C -C CALLS MODIFIED EISPACK ROUTINES TRED3B, IMTQLV, TINVTB, AND -C TRBK3B. THE ROUTINES TRED3B, TINVTB, AND TRBK3B. -C THE ORIGINAL EISPACK ROUTINES TRED3, TINVIT, AND TRBAK3 -C WERE MODIFIED BY THE INTRODUCTION OF TWO ROUTINES FROM THE -C BLAS LIBRARY - DDOT AND DAXPY. -C -C IF TINVIT FAILS TO CONVERGE, TQL2 IS CALLED -C -C SEE EISPACK USERS GUIDE, B. T. SMITH ET AL, SPRINGER-VERLAG -C LECTURE NOTES IN COMPUTER SCIENCE, VOL. 6, 2-ND EDITION, 1976 . -C NOTE THAT IMTQLV AND TINVTB HAVE INTERNAL MACHINE -C DEPENDENT CONSTANTS. -C - DATA ONE, ZERO /1.0D+00, 0.0D+00/ - CALL TRED3B(N,(N*N+N)/2,A,B(1,1),B(1,2),B(1,3)) - CALL IMTQLV(N,B(1,1),B(1,2),B(1,3),ROOT,INDB,IERR,B(1,4)) - IF (IERR .NE. 0) RETURN -C -C TO REORDER ROOTS... -C K = N/2 -C B(1,3) = 2.0D+00 -C DO 50 I = 1, K -C J = N+1-I -C T = ROOT(I) -C ROOT(I) = ROOT(J) -C ROOT(J) = T -C 50 CONTINUE -C - IF (NVECT .LE. 0) RETURN - CALL TINVTB(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,INDB,VECT,IERR, - + B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .EQ. 0) GO TO 160 -C -C IF INVERSE ITERATION GIVES AN ERROR IN DETERMINING THE -C EIGENVECTORS, TRY THE QL ALGORITHM IF ALL THE EIGENVECTORS -C ARE DESIRED. -C - IF (NVECT .NE. N) RETURN - DO 120 I = 1, NVECT - DO 100 J = 1, N - VECT(I,J) = ZERO - 100 CONTINUE - VECT(I,I) = ONE - 120 CONTINUE - CALL TQL2 (NV,N,B(1,1),B(1,2),VECT,IERR) - DO 140 I = 1, NVECT - ROOT(I) = B(I,1) - 140 CONTINUE - IF (IERR .NE. 0) RETURN - 160 CALL TRBK3B(NV,N,(N*N+N)/2,A,NVECT,VECT) - RETURN - END -C*MODULE EIGEN *DECK GLDIAG - SUBROUTINE GLDIAG(LDVECT,NVECT,N,H,WRK,EIG,VECTOR,IERR,IWRK) -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DIMENSION H(*),WRK(N,8),EIG(N),VECTOR(LDVECT,NVECT),IWRK(N) -C - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C -C ----- GENERAL ROUTINE TO DIAGONALIZE A SYMMETRIC MATRIX ----- -C IF KDIAG = 0, USE A ROUTINE FROM THE VECTOR LIBRARY, -C IF AVAILABLE (SEE THE SUBROUTINE 'GLDIAG' -C IN VECTOR.SRC), OR EVVRSP OTHERWISE -C = 1, USE EVVRSP -C = 2, USE GIVEIS -C = 3, USE JACOBI -C -C N = DIMENSION (ORDER) OF MATRIX TO BE SOLVED -C LDVECT = LEADING DIMENSION OF VECTOR -C NVECT = NUMBER OF VECTORS DESIRED -C H = MATRIX TO BE DIAGONALIZED -C WRK = N*8 W.P. REAL WORDS OF SCRATCH SPACE -C EIG = EIGENVECTORS (OUTPUT) -C VECTOR = EIGENVECTORS (OUTPUT) -C IERR = ERROR FLAG (OUTPUT) -C IWRK = N INTEGER WORDS OF SCRATCH SPACE -C - IERR = 0 -C -C ----- USE STEVE ELBERT'S ROUTINE ----- -C - IF(KDIAG.LE.1 .OR. KDIAG.GT.3) THEN - LENH = (N*N+N)/2 - KORDER =0 - CALL EVVRSP(IW,N,NVECT,LENH,LDVECT,H,WRK,IWRK,EIG,VECTOR - * ,KORDER,IERR) - END IF -C -C ----- USE MODIFIED EISPAK ROUTINE ----- -C - IF(KDIAG.EQ.2) - * CALL GIVEIS(N,NVECT,LDVECT,H,WRK,IWRK,EIG,VECTOR,IERR) -C -C ----- USE JACOBI ROTATION ROUTINE ----- -C - IF(KDIAG.EQ.3) THEN - IF(NVECT.EQ.N) THEN - CALL JACDG(H,VECTOR,EIG,IWRK,WRK,LDVECT,N) - ELSE - IF (MASWRK) WRITE(IW,9000) N,NVECT,LDVECT - CALL ABRT - END IF - END IF - RETURN -C - 9000 FORMAT(1X,'IN -GLDIAG-, N,NVECT,LDVECT=',3I8/ - * 1X,'THE JACOBI CODE CANNOT COPE WITH N.NE.NVECT!'/ - * 1X,'SO THIS RUN DOES NOT PERMIT KDIAG=3.') - END -C*MODULE EIGEN *DECK IMTQLV - SUBROUTINE IMTQLV(N,D,E,E2,W,IND,IERR,RV1) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - INTEGER TAG - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),E2(N),W(N),RV1(N),IND(N) -C -C THIS ROUTINE IS A VARIANT OF IMTQL1 WHICH IS A TRANSLATION OF -C ALGOL PROCEDURE IMTQL1, NUM. MATH. 12, 377-383(1968) BY MARTIN AND -C WILKINSON, AS MODIFIED IN NUM. MATH. 15, 450(1970) BY DUBRULLE. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC TRIDIAGONAL -C MATRIX BY THE IMPLICIT QL METHOD AND ASSOCIATES WITH THEM -C THEIR CORRESPONDING SUBMATRIX INDICES. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2(1) IS ARBITRARY. -C -C ON OUTPUT- -C -C D AND E ARE UNALTERED, -C -C ELEMENTS OF E2, CORRESPONDING TO ELEMENTS OF E REGARDED -C AS NEGLIGIBLE, HAVE BEEN REPLACED BY ZERO CAUSING THE -C MATRIX TO SPLIT INTO A DIRECT SUM OF SUBMATRICES. -C E2(1) IS ALSO SET TO ZERO, -C -C W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C THE SMALLEST EIGENVALUES, -C -C IND CONTAINS THE SUBMATRIX INDICES ASSOCIATED WITH THE -C CORRESPONDING EIGENVALUES IN W -- 1 FOR EIGENVALUES -C BELONGING TO THE FIRST SUBMATRIX FROM THE TOP, -C 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC., -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS, -C -C RV1 IS A TEMPORARY STORAGE ARRAY. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - K = 0 - TAG = 0 -C - DO 100 I = 1, N - W(I) = D(I) - IF (I .NE. 1) RV1(I-1) = E(I) - 100 CONTINUE -C - E2(1) = 0.0D+00 - RV1(N) = 0.0D+00 -C - DO 360 L = 1, N - J = 0 -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - 120 DO 140 M = L, N - IF (M .EQ. N) GO TO 160 - IF (ABS(RV1(M)) .LE. MACHEP * (ABS(W(M)) + ABS(W(M+1)))) GO TO - + 160 -C ********** GUARD AGAINST UNDERFLOWED ELEMENT OF E2 ********** - IF (E2(M+1) .EQ. 0.0D+00) GO TO 180 - 140 CONTINUE -C - 160 IF (M .LE. K) GO TO 200 - IF (M .NE. N) E2(M+1) = 0.0D+00 - 180 K = M - TAG = TAG + 1 - 200 P = W(L) - IF (M .EQ. L) GO TO 280 - IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - G = (W(L+1) - P) / (2.0D+00 * RV1(L)) - R = SQRT(G*G+1.0D+00) - G = W(M) - P + RV1(L) / (G + SIGN(R,G)) - S = 1.0D+00 - C = 1.0D+00 - P = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - F = S * RV1(I) - B = C * RV1(I) - IF (ABS(F) .LT. ABS(G)) GO TO 220 - C = G / F - R = SQRT(C*C+1.0D+00) - RV1(I+1) = F * R - S = 1.0D+00 / R - C = C * S - GO TO 240 - 220 S = F / G - R = SQRT(S*S+1.0D+00) - RV1(I+1) = G * R - C = 1.0D+00 / R - S = S * C - 240 G = W(I+1) - P - R = (W(I) - G) * S + 2.0D+00 * C * B - P = S * R - W(I+1) = G + P - G = C * R - B - 260 CONTINUE -C - W(L) = W(L) - P - RV1(L) = G - RV1(M) = 0.0D+00 - GO TO 120 -C ********** ORDER EIGENVALUES ********** - 280 IF (L .EQ. 1) GO TO 320 -C ********** FOR I=L STEP -1 UNTIL 2 DO -- ********** - DO 300 II = 2, L - I = L + 2 - II - IF (P .GE. W(I-1)) GO TO 340 - W(I) = W(I-1) - IND(I) = IND(I-1) - 300 CONTINUE -C - 320 I = 1 - 340 W(I) = P - IND(I) = TAG - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF IMTQLV ********** - END -C*MODULE EIGEN *DECK JACDG - SUBROUTINE JACDG(A,VEC,EIG,JBIG,BIG,LDVEC,N) -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) -C - DIMENSION A(*),VEC(LDVEC,N),EIG(N),JBIG(N),BIG(N) -C - PARAMETER (ONE=1.0D+00) -C -C ----- JACOBI DIAGONALIZATION OF SYMMETRIC MATRIX ----- -C SYMMETRIC MATRIX -A- OF DIMENSION -N- IS DESTROYED ON EXIT. -C ALL EIGENVECTORS ARE FOUND, SO -VEC- MUST BE SQUARE, -C UNLESS SOMEONE TAKES THE TROUBLE TO LOOK AT -NMAX- BELOW. -C -BIG- AND -JBIG- ARE SCRATCH WORK ARRAYS. -C - CALL VCLR(VEC,1,LDVEC*N) - DO 20 I = 1,N - VEC(I,I) = ONE - 20 CONTINUE -C - NB1 = N - NB2 = (NB1*NB1+NB1)/2 - NMIN = 1 - NMAX = NB1 -C - CALL JACDIA(A,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) -C - DO 30 I=1,N - EIG(I) = A((I*I+I)/2) - 30 CONTINUE -C - CALL JACORD(VEC,EIG,NB1,LDVEC) - RETURN - END -C*MODULE EIGEN *DECK JACDIA - SUBROUTINE JACDIA(F,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - LOGICAL GOPARR,DSKWRK,MASWRK - DIMENSION F(NB2),VEC(LDVEC,NB1),BIG(NB1),JBIG(NB1) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ROOT2=0.707106781186548D+00 ) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, D1050=1.05D+00, - * D1500=1.5D+00, D3875=3.875D+00, - * D0500=0.5D+00, D1375=1.375D+00, D0250=0.25D+00 ) - PARAMETER (C2=1.0D-12, C3=4.0D-16, - * C4=2.0D-16, C5=8.0D-09, C6=3.0D-06 ) -C -C F IS THE MATRIX TO BE DIAGONALIZED, F IS STORED TRIANGULAR -C VEC IS THE ARRAY OF EIGENVECTORS, DIMENSION NB1*NB1 -C BIG AND JBIG ARE TEMPORARY SCRATCH AREAS OF DIMENSION NB1 -C THE ROTATIONS AMONG THE FIRST NMIN BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C THE ROTATIONS AMONG THE LAST NB1-NMAX BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C - IEAA=0 - IEAB=0 - TT=ZERO - EPS = 64.0D+00*EPSLON(ONE) -C -C LOOP OVER COLUMNS (K) OF TRIANGULAR MATRIX TO DETERMINE -C LARGEST OFF-DIAGONAL ELEMENTS IN ROW(I). -C - DO 20 I=1,NB1 - BIG(I)=ZERO - JBIG(I)=0 - IF(I.LT.NMIN .OR. I.EQ.1) GO TO 20 - II = (I*I-I)/2 - J=MIN(I-1,NMAX) - DO 10 K=1,J - IF(ABS(BIG(I)).GE.ABS(F(II+K))) GO TO 10 - BIG(I)=F(II+K) - JBIG(I)=K - 10 CONTINUE - 20 CONTINUE -C -C ----- 2X2 JACOBI ITERATIONS BEGIN HERE ----- -C - MAXIT=MAX(NB2*20,500) - ITER=0 - 30 CONTINUE - ITER=ITER+1 -C -C FIND SMALLEST DIAGONAL ELEMENT -C - SD=D1050 - JJ=0 - DO 40 J=1,NB1 - JJ=JJ+J - SD= MIN(SD,ABS(F(JJ))) - 40 CONTINUE - TEST = MAX(EPS, C2*MAX(SD,C6)) -C -C FIND LARGEST OFF-DIAGONAL ELEMENT -C - T=ZERO - I1=MAX(2,NMIN) - IB = I1 - DO 50 I=I1,NB1 - IF(T.GE.ABS(BIG(I))) GO TO 50 - T= ABS(BIG(I)) - IB=I - 50 CONTINUE -C -C TEST FOR CONVERGENCE, THEN DETERMINE ROTATION. -C - IF(T.LT.TEST) RETURN -C ****** -C - IF(ITER.GT.MAXIT) THEN - IF (MASWRK) THEN - WRITE(6,*) 'JACOBI DIAGONALIZATION FAILS, DIMENSION=',NB1 - WRITE(6,9020) ITER,T,TEST,SD - ENDIF - CALL ABRT - STOP - END IF -C - IA=JBIG(IB) - IAA=IA*(IA-1)/2 - IBB=IB*(IB-1)/2 - DIF=F(IAA+IA)-F(IBB+IB) - IF(ABS(DIF).GT.C3*T) GO TO 70 - SX=ROOT2 - CX=ROOT2 - GO TO 110 - 70 T2X2=BIG(IB)/DIF - T2X25=T2X2*T2X2 - IF(T2X25 . GT . C4) GO TO 80 - CX=ONE - SX=T2X2 - GO TO 110 - 80 IF(T2X25 . GT . C5) GO TO 90 - SX=T2X2*(ONE-D1500*T2X25) - CX=ONE-D0500*T2X25 - GO TO 110 - 90 IF(T2X25 . GT . C6) GO TO 100 - CX=ONE+T2X25*(T2X25*D1375 - D0500) - SX= T2X2*(ONE + T2X25*(T2X25*D3875 - D1500)) - GO TO 110 - 100 T=D0250 / SQRT(D0250 + T2X25) - CX= SQRT(D0500 + T) - SX= SIGN( SQRT(D0500 - T),T2X2) - 110 IEAR=IAA+1 - IEBR=IBB+1 -C - DO 230 IR=1,NB1 - T=F(IEAR)*SX - F(IEAR)=F(IEAR)*CX+F(IEBR)*SX - F(IEBR)=T-F(IEBR)*CX - IF(IR-IA) 220,120,130 - 120 TT=F(IEBR) - IEAA=IEAR - IEAB=IEBR - F(IEBR)=BIG(IB) - IEAR=IEAR+IR-1 - IF(JBIG(IR)) 200,220,200 - 130 T=F(IEAR) - IT=IA - IEAR=IEAR+IR-1 - IF(IR-IB) 180,150,160 - 150 F(IEAA)=F(IEAA)*CX+F(IEAB)*SX - F(IEAB)=TT*CX+F(IEBR)*SX - F(IEBR)=TT*SX-F(IEBR)*CX - IEBR=IEBR+IR-1 - GO TO 200 - 160 IF( ABS(T) . GE . ABS(F(IEBR))) GO TO 170 - IF(IB.GT.NMAX) GO TO 170 - T=F(IEBR) - IT=IB - 170 IEBR=IEBR+IR-1 - 180 IF( ABS(T) . LT . ABS(BIG(IR))) GO TO 190 - BIG(IR) = T - JBIG(IR) = IT - GO TO 220 - 190 IF(IA . NE . JBIG(IR) . AND . IB . NE . JBIG(IR)) GO TO 220 - 200 KQ=IEAR-IR-IA+1 - BIG(IR)=ZERO - IR1=MIN(IR-1,NMAX) - DO 210 I=1,IR1 - K=KQ+I - IF(ABS(BIG(IR)) . GE . ABS(F(K))) GO TO 210 - BIG(IR) = F(K) - JBIG(IR)=I - 210 CONTINUE - 220 IEAR=IEAR+1 - 230 IEBR=IEBR+1 -C - DO 240 I=1,NB1 - T1=VEC(I,IA)*CX + VEC(I,IB)*SX - T2=VEC(I,IA)*SX - VEC(I,IB)*CX - VEC(I,IA)=T1 - VEC(I,IB)=T2 - 240 CONTINUE - GO TO 30 -C - 9020 FORMAT(1X,'ITER=',I6,' T,TEST,SD=',1P,3E20.10) - END -C*MODULE EIGEN *DECK JACORD - SUBROUTINE JACORD(VEC,EIG,N,LDVEC) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION VEC(LDVEC,N),EIG(N) -C -C ---- SORT EIGENDATA INTO ASCENDING ORDER ----- -C - DO 290 I = 1, N - JJ = I - DO 270 J = I, N - IF (EIG(J) .LT. EIG(JJ)) JJ = J - 270 CONTINUE - IF (JJ .EQ. I) GO TO 290 - T = EIG(JJ) - EIG(JJ) = EIG(I) - EIG(I) = T - DO 280 J = 1, N - T = VEC(J,JJ) - VEC(J,JJ) = VEC(J,I) - VEC(J,I) = T - 280 CONTINUE - 290 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK TINVTB - SUBROUTINE TINVTB(NM,N,D,E,E2,M,W,IND,Z, - * IERR,RV1,RV2,RV3,RV4,RV6) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION D(N),E(N),E2(N),W(M),Z(NM,M), - * RV1(N),RV2(N),RV3(N),RV4(N),RV6(N),IND(M) - DOUBLE PRECISION MACHEP,NORM - INTEGER P,Q,R,S,TAG,GROUP -C ------------------------------------------------------------------ -C -C THIS ROUTINE IS A TRANSLATION OF THE INVERSE ITERATION TECH- -C NIQUE IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C -C THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES, -C USING INVERSE ITERATION. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E, -C WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE SUM -C OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST CONTAIN -C 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, OR 2.0 -C IF THE EIGENVALUES ARE IN DESCENDING ORDER. IF BISECT, -C TRIDIB, OR IMTQLV HAS BEEN USED TO FIND THE EIGENVALUES, -C THEIR OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE, -C -C M IS THE NUMBER OF SPECIFIED EIGENVALUES, -C -C W CONTAINS THE M EIGENVALUES IN ASCENDING OR DESCENDING ORDER, -C -C IND CONTAINS IN ITS FIRST M POSITIONS THE SUBMATRIX INDICES -C ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX FROM -C THE TOP, 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC. -C -C ON OUTPUT- -C -C ALL INPUT ARRAYS ARE UNALTERED, -C -C Z CONTAINS THE ASSOCIATED SET OF ORTHONORMAL EIGENVECTORS. -C ANY VECTOR WHICH FAILS TO CONVERGE IS SET TO ZERO, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS, -C -C RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (M .EQ. 0) GO TO 680 - TAG = 0 - ORDER = 1.0D+00 - E2(1) - XU = 0.0D+00 - UK = 0.0D+00 - X0 = 0.0D+00 - U = 0.0D+00 - EPS2 = 0.0D+00 - EPS3 = 0.0D+00 - EPS4 = 0.0D+00 - GROUP = 0 - Q = 0 -C ********** ESTABLISH AND PROCESS NEXT SUBMATRIX ********** - 100 P = Q + 1 - IP = P + 1 -C - DO 120 Q = P, N - IF (Q .EQ. N) GO TO 140 - IF (E2(Q+1) .EQ. 0.0D+00) GO TO 140 - 120 CONTINUE -C ********** FIND VECTORS BY INVERSE ITERATION ********** - 140 TAG = TAG + 1 - IQMP = Q - P + 1 - S = 0 -C - DO 660 R = 1, M - IF (IND(R) .NE. TAG) GO TO 660 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 220 -C ********** CHECK FOR ISOLATED ROOT ********** - XU = 1.0D+00 - IF (P .NE. Q) GO TO 160 - RV6(P) = 1.0D+00 - GO TO 600 - 160 NORM = ABS(D(P)) -C - DO 180 I = IP, Q - 180 NORM = NORM + ABS(D(I)) + ABS(E(I)) -C ********** EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ********** - EPS2 = 1.0D-03 * NORM - EPS3 = MACHEP * NORM - UK = IQMP - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - 200 GROUP = 0 - GO TO 240 -C ********** LOOK FOR CLOSE OR COINCIDENT ROOTS ********** - 220 IF (ABS(X1-X0) .GE. EPS2) GO TO 200 - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. 0.0D+00) X1 = X0 + ORDER * EPS3 -C ********** ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR ********** - 240 V = 0.0D+00 -C - DO 300 I = P, Q - RV6(I) = UK - IF (I .EQ. P) GO TO 280 - IF (ABS(E(I)) .LT. ABS(U)) GO TO 260 -C ********** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ********** - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = 0.0D+00 - IF (I .NE. Q) RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) - GO TO 300 - 260 XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = 0.0D+00 - 280 U = D(I) - X1 - XU * V - IF (I .NE. Q) V = E(I+1) - 300 CONTINUE -C - IF (U .EQ. 0.0D+00) U = EPS3 - RV1(Q) = U - RV2(Q) = 0.0D+00 - RV3(Q) = 0.0D+00 -C ********** BACK SUBSTITUTION -C FOR I=Q STEP -1 UNTIL P DO -- ********** - 320 DO 340 II = P, Q - I = P + Q - II - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - 340 CONTINUE -C ********** ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP ********** - IF (GROUP .EQ. 0) GO TO 400 - J = R -C - DO 380 JJ = 1, GROUP - 360 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 360 - XU = DDOT(IQMP,RV6(P),1,Z(P,J),1) -C - CALL DAXPY(IQMP,-XU,Z(P,J),1,RV6(P),1) -C - 380 CONTINUE -C - 400 NORM = 0.0D+00 -C - DO 420 I = P, Q - 420 NORM = NORM + ABS(RV6(I)) -C - IF (NORM .GE. 1.0D+00) GO TO 560 -C ********** FORWARD SUBSTITUTION ********** - IF (ITS .EQ. 5) GO TO 540 - IF (NORM .NE. 0.0D+00) GO TO 440 - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - GO TO 480 - 440 XU = EPS4 / NORM -C - DO 460 I = P, Q - 460 RV6(I) = RV6(I) * XU -C ********** ELIMINATION OPERATIONS ON NEXT VECTOR -C ITERATE ********** - 480 DO 520 I = IP, Q - U = RV6(I) -C ********** IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS ********** - IF (RV1(I-1) .NE. E(I)) GO TO 500 - U = RV6(I-1) - RV6(I-1) = RV6(I) - 500 RV6(I) = U - RV4(I) * RV6(I-1) - 520 CONTINUE -C - ITS = ITS + 1 - GO TO 320 -C ********** SET ERROR -- NON-CONVERGED EIGENVECTOR ********** - 540 IERR = -R - XU = 0.0D+00 - GO TO 600 -C ********** NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER ********** - 560 U = 0.0D+00 -C - DO 580 I = P, Q - RV6(I) = RV6(I) / NORM - 580 U = U + RV6(I)**2 -C - XU = 1.0D+00 / SQRT(U) -C - 600 DO 620 I = 1, N - 620 Z(I,R) = 0.0D+00 -C - DO 640 I = P, Q - 640 Z(I,R) = RV6(I) * XU -C - X0 = X1 - 660 CONTINUE -C - IF (Q .LT. N) GO TO 100 - 680 RETURN -C ********** LAST CARD OF TINVIT ********** - END -C*MODULE EIGEN *DECK TQL2 -C -C ------------------------------------------------------------------ -C - SUBROUTINE TQL2(NM,N,D,E,Z,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),Z(NM,N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQL2, -C NUM. MATH. 11, 293-306(1968) BY BOWDLER, MARTIN, REINSCH, AND -C WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS -C OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE QL METHOD. -C THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO -C BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS -C FULL MATRIX TO TRIDIAGONAL FORM. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE -C REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS -C OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN -C THE IDENTITY MATRIX. -C -C ON OUTPUT- -C -C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT -C UNORDERED FOR INDICES 1,2,...,IERR-1, -C -C E HAS BEEN DESTROYED, -C -C Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC -C TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE, -C Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED -C EIGENVALUES, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (N .EQ. 1) GO TO 400 -C - DO 100 I = 2, N - 100 E(I-1) = E(I) -C - F = 0.0D+00 - B = 0.0D+00 - E(N) = 0.0D+00 -C - DO 300 L = 1, N - J = 0 - H = MACHEP * (ABS(D(L)) + ABS(E(L))) - IF (B .LT. H) B = H -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - DO 120 M = L, N - IF (ABS(E(M)) .LE. B) GO TO 140 -C ********** E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT -C THROUGH THE BOTTOM OF THE LOOP ********** - 120 CONTINUE -C - 140 IF (M .EQ. L) GO TO 280 - 160 IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - L1 = L + 1 - G = D(L) - P = (D(L1) - G) / (2.0D+00 * E(L)) - R = SQRT(P*P+1.0D+00) - D(L) = E(L) / (P + SIGN(R,P)) - H = G - D(L) -C - DO 180 I = L1, N - 180 D(I) = D(I) - H -C - F = F + H -C ********** QL TRANSFORMATION ********** - P = D(M) - C = 1.0D+00 - S = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - G = C * E(I) - H = C * P - IF (ABS(P) .LT. ABS(E(I))) GO TO 200 - C = E(I) / P - R = SQRT(C*C+1.0D+00) - E(I+1) = S * P * R - S = C / R - C = 1.0D+00 / R - GO TO 220 - 200 C = P / E(I) - R = SQRT(C*C+1.0D+00) - E(I+1) = S * E(I) * R - S = 1.0D+00 / R - C = C * S - 220 P = C * D(I) - S * G - D(I+1) = H + S * (C * G + S * D(I)) -C ********** FORM VECTOR ********** - CALL DROT(N,Z(1,I+1),1,Z(1,I),1,C,S) -C - 260 CONTINUE -C - E(L) = S * P - D(L) = C * P - IF (ABS(E(L)) .GT. B) GO TO 160 - 280 D(L) = D(L) + F - 300 CONTINUE -C ********** ORDER EIGENVALUES AND EIGENVECTORS ********** - DO 360 II = 2, N - I = II - 1 - K = I - P = D(I) -C - DO 320 J = II, N - IF (D(J) .GE. P) GO TO 320 - K = J - P = D(J) - 320 CONTINUE -C - IF (K .EQ. I) GO TO 360 - D(K) = D(I) - D(I) = P -C - CALL DSWAP(N,Z(1,I),1,Z(1,K),1) -C - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF TQL2 ********** - END -C*MODULE EIGEN *DECK TRBK3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRBK3B(NM,N,NV,A,M,Z) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),Z(NM,M) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY TRED3B. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANSFORMATIONS -C USED IN THE REDUCTION BY TRED3B IN ITS FIRST -C N*(N+1)/2 POSITIONS, -C -C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED, -C -C Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C IN ITS FIRST M COLUMNS. -C -C ON OUTPUT- -C -C Z CONTAINS THE TRANSFORMED EIGENVECTORS -C IN ITS FIRST M COLUMNS. -C -C NOTE THAT TRBAK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C - IF (M .EQ. 0) GO TO 140 - IF (N .EQ. 1) GO TO 140 -C - DO 120 I = 2, N - L = I - 1 - IZ = (I * L) / 2 - IK = IZ + I - H = A(IK) - IF (H .EQ. 0.0D+00) GO TO 120 -C - DO 100 J = 1, M - S = -DDOT(L,A(IZ+1),1,Z(1,J),1) -C -C ********** DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW ********** - S = (S / H) / H -C - CALL DAXPY(L,S,A(IZ+1),1,Z(1,J),1) -C - 100 CONTINUE -C - 120 CONTINUE -C - 140 RETURN -C ********** LAST CARD OF TRBAK3 ********** - END -C*MODULE EIGEN *DECK TRED3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRED3B(N,NV,A,D,E,E2) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),D(N),E(N),E2(N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE REDUCES A REAL SYMMETRIC MATRIX, STORED AS -C A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C USING ORTHOGONAL SIMILARITY TRANSFORMATIONS. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C -C ON OUTPUT- -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C TRANSFORMATIONS USED IN THE REDUCTION, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** FOR I=N STEP -1 UNTIL 1 DO -- ********** - DO 300 II = 1, N - I = N + 1 - II - L = I - 1 - IZ = (I * L) / 2 - H = 0.0D+00 - SCALE = 0.0D+00 - IF (L .LT. 1) GO TO 120 -C ********** SCALE ROW (ALGOL TOL THEN NOT NEEDED) ********** - DO 100 K = 1, L - IZ = IZ + 1 - D(K) = A(IZ) - SCALE = SCALE + ABS(D(K)) - 100 CONTINUE -C - IF (SCALE .NE. 0.0D+00) GO TO 140 - 120 E(I) = 0.0D+00 - E2(I) = 0.0D+00 - GO TO 280 -C - 140 DO 160 K = 1, L - D(K) = D(K) / SCALE - H = H + D(K) * D(K) - 160 CONTINUE -C - E2(I) = SCALE * SCALE * H - F = D(L) - G = -SIGN(SQRT(H),F) - E(I) = SCALE * G - H = H - F * G - D(L) = F - G - A(IZ) = SCALE * D(L) - IF (L .EQ. 1) GO TO 280 - F = 0.0D+00 -C - JK = 1 - DO 220 J = 1, L - JM1 = J - 1 - DT = D(J) - G = 0.0D+00 -C ********** FORM ELEMENT OF A*U ********** - IF (JM1 .EQ. 0) GO TO 200 - DO 180 K = 1, JM1 - E(K) = E(K) + DT * A(JK) - G = G + D(K) * A(JK) - JK = JK + 1 - 180 CONTINUE - 200 E(J) = G + A(JK) * DT - JK = JK + 1 -C ********** FORM ELEMENT OF P ********** - 220 CONTINUE - F = 0.0D+00 - DO 240 J = 1, L - E(J) = E(J) / H - F = F + E(J) * D(J) - 240 CONTINUE -C - HH = F / (H + H) - JK = 0 -C ********** FORM REDUCED A ********** - DO 260 J = 1, L - F = D(J) - G = E(J) - HH * F - E(J) = G -C - DO 260 K = 1, J - JK = JK + 1 - A(JK) = A(JK) - F * E(K) - G * D(K) - 260 CONTINUE -C - 280 D(I) = A(IZ+1) - A(IZ+1) = SCALE * SQRT(H) - 300 CONTINUE -C - RETURN -C ********** LAST CARD OF TRED3 ********** - END diff --git a/source/unres/src_MD-DFA-restraints/elecont.f b/source/unres/src_MD-DFA-restraints/elecont.f deleted file mode 100644 index e9ed067..0000000 --- a/source/unres/src_MD-DFA-restraints/elecont.f +++ /dev/null @@ -1,509 +0,0 @@ - subroutine elecont(lprint,ncont,icont) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - logical lprint - double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2) - double precision app_(2,2),bpp_(2,2),rpp_(2,2) - integer ncont,icont(2,maxcont) - double precision econt(maxcont) -* -* Load the constants of peptide bond - peptide bond interactions. -* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g. -* proline) - determined by averaging ECEPP energy. -* -* as of 7/06/91. -* -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ - data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ - data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ - data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ - data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/ - if (lprint) write (iout,'(a)') - & "Constants of electrostatic interaction energy expression." - do i=1,2 - do j=1,2 - rri=rpp_(i,j)**6 - app_(i,j)=epp(i,j)*rri*rri - bpp_(i,j)=-2.0*epp(i,j)*rri - ael6_(i,j)=elpp_6(i,j)*4.2**6 - ael3_(i,j)=elpp_3(i,j)*4.2**3 - if (lprint) - & write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j), - & ael3_(i,j) - enddo - enddo - ncont=0 - ees=0.0 - evdw=0.0 - do 1 i=nnt,nct-2 - xi=c(1,i) - yi=c(2,i) - zi=c(3,i) - dxi=c(1,i+1)-c(1,i) - dyi=c(2,i+1)-c(2,i) - dzi=c(3,i+1)-c(3,i) - xmedi=xi+0.5*dxi - ymedi=yi+0.5*dyi - zmedi=zi+0.5*dzi - do 4 j=i+2,nct-1 - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - if (iteli.eq.2 .and. itelj.eq.2) goto 4 - aaa=app_(iteli,itelj) - bbb=bpp_(iteli,itelj) - ael6_i=ael6_(iteli,itelj) - ael3_i=ael3_(iteli,itelj) - dxj=c(1,j+1)-c(1,j) - dyj=c(2,j+1)-c(2,j) - dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi - rrmij=1.0/(xj*xj+yj*yj+zj*zj) - rmij=sqrt(rrmij) - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - vrmij=vblinv*rmij - cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2 - cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij - cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij - fac=cosa-3.0*cosb*cosg - ev1=aaa*r6ij*r6ij - ev2=bbb*r6ij - fac3=ael6_i*r6ij - fac4=ael3_i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 - if (j.gt.i+2 .and. eesij.le.elcutoff .or. - & j.eq.i+2 .and. eesij.le.elecutoff_14) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - econt(ncont)=eesij - endif - ees=ees+eesij - evdw=evdw+evdwij - 4 continue - 1 continue - if (lprint) then - write (iout,*) 'Total average electrostatic energy: ',ees - write (iout,*) 'VDW energy between peptide-group centers: ',evdw - write (iout,*) - write (iout,*) 'Electrostatic contacts before pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif -c For given residues keep only the contacts with the greatest energy. - i=0 - do while (i.lt.ncont) - i=i+1 - ene=econt(i) - ic1=icont(1,i) - ic2=icont(2,i) - j=i - do while (j.lt.ncont) - j=j+1 - if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or. - & ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then -c write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2, -c & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont - if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j) - & .and. iabs(icont(1,k)-ic1).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j) - & .and. iabs(icont(2,k)-ic2).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - endif -c Remove ith contact - do k=i+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - i=i-1 - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - goto 20 - else if (econt(j).gt.ene .and. ic2.ne.ic1+2) - & then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2 - & .and. iabs(icont(1,k)-icont(1,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1 - & .and. iabs(icont(2,k)-icont(2,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - endif -c Remove jth contact - do k=j+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - j=j-1 - endif - endif - 21 continue - enddo - 20 continue - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Electrostatic contacts after pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif - return - end -c-------------------------------------------- - subroutine secondary2(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - integer ncont,icont(2,maxcont),isec(maxres,4),nsec(maxres) - logical lprint,not_done,freeres - double precision p1,p2 - external freeres - - if(.not.dccart) call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - nsec(i)=0 - enddo - - call elecont(lprint,ncont,icont) - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,'(a,i3,4i4)')'parallel beta', - & nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1+1 - bfrag(2,nbfrag)=i1+1 - bfrag(3,nbfrag)=jj1+1 - bfrag(4,nbfrag)=min0(j1+1,nres) - - do ij=ii1,i1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - do ij=jj1,j1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - p1=phi(i1+2)*rad2deg - p2=0.0 - if (j1+2.le.nres) p2=phi(j1+2)*rad2deg - - - if (j1.eq.i1+3 .and. - & ((p1.ge.10.and.p1.le.80).or.i1.le.2).and. - & ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2 -co if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2 - ii1=i1 - jj1=j1 - if (nsec(ii1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue - p1=phi(i1+2)*rad2deg - p2=phi(j1+2)*rad2deg - if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) - & not_done=.false. -cd write (iout,*) i1,j1,not_done,p1,p2 - enddo - j1=j1+1 - if (j1-ii1.gt.5) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=j1 - - do ij=ii1,j1 - nsec(ij)=-1 - enddo - if (lprint) then - write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=min0(i1+1,nres) - bfrag(3,nbfrag)=min0(jj1+1,nres) - bfrag(4,nbfrag)=j1 - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2) then - isec(ij,nsec(ij))=nbeta - endif - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2 .and. nsec(ij).gt.0) then - isec(ij,nsec(ij))=nbeta - endif - enddo - - - if (lprint) then - write (iout,'(a,i3,4i4)')'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - - - write(iout,*) 'UNRES seq:' - do j=1,nbfrag - write(iout,*) 'beta ',(bfrag(i,j),i=1,4) - enddo - - do j=1,nhfrag - write(iout,*) 'helix ',(hfrag(i,j),i=1,2) - enddo - endif - - return - end -c------------------------------------------------- - logical function freeres(i,j,nsec,isec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer isec(maxres,4),nsec(maxres) - freeres=.false. - - if (nsec(i).lt.0.or.nsec(j).lt.0) return - if (nsec(i).gt.1.or.nsec(j).gt.1) return - do k=1,nsec(i) - do l=1,nsec(j) - if (isec(i,k).eq.isec(j,l)) return - enddo - enddo - freeres=.true. - return - end - diff --git a/source/unres/src_MD-DFA-restraints/energy_p_new-sep_barrier.F b/source/unres/src_MD-DFA-restraints/energy_p_new-sep_barrier.F deleted file mode 100644 index c89aee2..0000000 --- a/source/unres/src_MD-DFA-restraints/energy_p_new-sep_barrier.F +++ /dev/null @@ -1,2322 +0,0 @@ -C----------------------------------------------------------------------- - double precision function sscale(r) - double precision r,gamm - include "COMMON.SPLITELE" - if(r.lt.r_cut-rlamb) then - sscale=1.0d0 - else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then - gamm=(r-(r_cut-rlamb))/rlamb - sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) - else - sscale=0d0 - endif - return - end -C----------------------------------------------------------------------- - subroutine elj_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------- - subroutine elj_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine eljk_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine eljk_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine ebp_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine ebp_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine egb_long(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*(1.0d0-sss) - else - evdw_m=evdw_m+evdwij*(1.0d0-sss) - endif -#else - evdw=evdw+evdwij*(1.0d0-sss) -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(1.0d0-sss) - else - call sc_grad_scale(1.0d0-sss) - endif -#else - call sc_grad_scale(1.0d0-sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egb_short(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*sss - else - evdw_m=evdw_m+evdwij*sss - endif -#else - evdw=evdw+evdwij*sss -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(sss) - else - call sc_grad_scale(sss) - endif -#else - call sc_grad_scale(sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egbv_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- - subroutine egbv_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - return - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale_T(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwcT(l,i)=gvdwcT(l,i)-gg(l) - gvdwcT(l,j)=gvdwcT(l,j)+gg(l) - enddo - return - end - -C-------------------------------------------------------------------------- - subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C -C This subroutine calculates the average interaction energy and its gradient -C in the virtual-bond vectors between non-adjacent peptide groups, based on -C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. -C The potential depends both on the distance of peptide-group centers and on -C the orientation of the CA-CA virtual bonds. -C - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -cd write(iout,*) 'In EELEC' -cd do i=1,nloctyp -cd write(iout,*) 'Type',i -cd write(iout,*) 'B1',B1(:,i) -cd write(iout,*) 'B2',B2(:,i) -cd write(iout,*) 'CC',CC(:,:,i) -cd write(iout,*) 'DD',DD(:,:,i) -cd write(iout,*) 'EE',EE(:,:,i) -cd enddo -cd call check_vecgrad -cd stop - if (icheckgrad.eq.1) then - do i=1,nres-1 - fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) - do k=1,3 - dc_norm(k,i)=dc(k,i)*fac - enddo -c write (iout,*) 'i',i,' fac',fac - enddo - endif - if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. - & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -c call vec_and_deriv -#ifdef TIMING - time01=MPI_Wtime() -#endif - call set_matrices -#ifdef TIMING - time_mat=time_mat+MPI_Wtime()-time01 -#endif - endif -cd do i=1,nres-1 -cd write (iout,*) 'i=',i -cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -cd enddo -cd do k=1,3 -cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') -cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) -cd enddo -cd enddo - t_eelecij=0.0d0 - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=1,nres - num_cont_hb(i)=0 - enddo -cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - enddo -c -c -c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -C -C Loop over i,i+2 and i,i+3 pairs of the peptide groups -C - do i=iturn3_start,iturn3_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 - call eelecij_scale(i,i+2,ees,evdw1,eel_loc) - if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) - num_cont_hb(i)=num_conti - enddo - do i=iturn4_start,iturn4_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=num_cont_hb(i) - call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) - num_cont_hb(i)=num_conti - enddo ! i -c -c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -c - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - num_conti=num_cont_hb(i) - do j=ielstart(i),ielend(i) - call eelecij_scale(i,j,ees,evdw1,eel_loc) - enddo ! j - num_cont_hb(i)=num_conti - enddo ! i -c write (iout,*) "Number of loop steps in EELEC:",ind -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 -cd print *,"Processor",fg_rank," t_eelecij",t_eelecij - return - end -C------------------------------------------------------------------------------- - subroutine eelecij_scale(i,j,ees,evdw1,eel_loc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -c time00=MPI_Wtime() -cd write (iout,*) "eelecij",i,j - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - ael6i=ael6(iteli,itelj) - ael3i=ael3(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - rmij=1.0D0/rij -c For extracting the short-range part of Evdwpp - sss=sscale(rij/rpp(iteli,itelj)) - - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj - cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij - cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij - fac=cosa-3.0D0*cosb*cosg - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - fac3=ael6i*r6ij - fac4=ael3i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 -C 12/26/95 - for the evaluation of multi-body H-bonding interactions - ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij - evdw1=evdw1+evdwij*(1.0d0-sss) -cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, -cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, -cd & xmedi,ymedi,zmedi,xj,yj,zj - - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij - endif - -C -C Calculate contributions to the Cartesian gradient. -C -#ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) - facel=-3*rrmij*(el1+eesij) - fac1=fac - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -cgrad enddo -cgrad enddo -#else - facvdw=ev1+evdwij*(1.0d0-sss) - facel=el1+eesij - fac1=fac - fac=-3*rrmij*(facvdw+facvdw+facel) - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc(k,j)+ggg(k) - gelc_long(k,i)=gelc(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -#endif -* -* Angular part -* - ecosa=2.0D0*fac3*fac1+fac4 - fac4=-3.0D0*fac4 - fac3=-6.0D0*fac3 - ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4) - ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4) - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo -cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), -cd & (dcosg(k),k=1,3) - do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) - enddo -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -c gelc(k,j)=gelc(k,j)+ghalf -c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -c enddo -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo - IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 - & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C -C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction -C energy of a peptide unit is assumed in the form of a second-order -C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. -C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms -C are computed for EVERY pair of non-contiguous peptide groups. -C - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - kkk=0 - do k=1,2 - do l=1,2 - kkk=kkk+1 - muij(kkk)=mu(k,i)*mu(l,j) - enddo - enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij - ury=scalar(uy(1,i),erij) - urz=scalar(uz(1,i),erij) - vry=scalar(uy(1,j),erij) - vrz=scalar(uz(1,j),erij) - a22=scalar(uy(1,i),uy(1,j))-3*ury*vry - a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz - a32=scalar(uz(1,i),uy(1,j))-3*urz*vry - a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz - fac=dsqrt(-ael6i)*r3ij - a22=a22*fac - a23=a23*fac - a32=a32*fac - a33=a33*fac -cd write (iout,'(4i5,4f10.5)') -cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 -cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -cd & uy(:,j),uz(:,j) -cd write (iout,'(4f10.5)') -cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), -cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) -cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(9f10.5/)') -cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij -C Derivatives of the elements of A in virtual-bond vectors - call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) - do k=1,3 - uryg(k,1)=scalar(erder(1,k),uy(1,i)) - uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) - uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1)) - urzg(k,1)=scalar(erder(1,k),uz(1,i)) - urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1)) - urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1)) - vryg(k,1)=scalar(erder(1,k),uy(1,j)) - vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1)) - vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1)) - vrzg(k,1)=scalar(erder(1,k),uz(1,j)) - vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) - vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) - enddo -C Compute radial contributions to the gradient - facr=-3.0d0*rrmij - a22der=a22*facr - a23der=a23*facr - a32der=a32*facr - a33der=a33*facr - agg(1,1)=a22der*xj - agg(2,1)=a22der*yj - agg(3,1)=a22der*zj - agg(1,2)=a23der*xj - agg(2,2)=a23der*yj - agg(3,2)=a23der*zj - agg(1,3)=a32der*xj - agg(2,3)=a32der*yj - agg(3,3)=a32der*zj - agg(1,4)=a33der*xj - agg(2,4)=a33der*yj - agg(3,4)=a33der*zj -C Add the contributions coming from er - fac3=-3.0d0*fac - do k=1,3 - agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury) - agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury) - agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz) - agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz) - enddo - do k=1,3 -C Derivatives in DC(i) -cgrad ghalf1=0.5d0*agg(k,1) -cgrad ghalf2=0.5d0*agg(k,2) -cgrad ghalf3=0.5d0*agg(k,3) -cgrad ghalf4=0.5d0*agg(k,4) - aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)!+ghalf1 - aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)!+ghalf2 - aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)!+ghalf3 - aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -C Derivatives in DC(i+1) - aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)!+agg(k,1) - aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) - aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)!+agg(k,3) - aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -C Derivatives in DC(j) - aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)!+ghalf1 - aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)!+ghalf2 - aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)!+ghalf3 - aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -C Derivatives in DC(j+1) or DC(nres-1) - aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) - & -3.0d0*vryg(k,3)*ury) - aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) - & -3.0d0*vrzg(k,3)*ury) - aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) - & -3.0d0*vryg(k,3)*urz) - aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) - & -3.0d0*vrzg(k,3)*urz) -cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -cgrad do l=1,4 -cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -cgrad enddo -cgrad endif - enddo - acipa(1,1)=a22 - acipa(1,2)=a23 - acipa(2,1)=a32 - acipa(2,2)=a33 - a22=-a22 - a23=-a23 - do l=1,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - if (j.lt.nres-1) then - a22=-a22 - a32=-a32 - do l=1,3,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - else - a22=-a22 - a23=-a23 - a32=-a32 - a33=-a33 - do l=1,4 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - endif - ENDIF ! WCORR - IF (wel_loc.gt.0.0d0) THEN -C Contribution to the local-electrostatic energy coming from the i-j pair - eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) - & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eelloc',i,j,eel_loc_ij - - eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma - if (i.gt.1) - & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) - gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -cgrad ghalf=0.5d0*ggg(l) -cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf - enddo -cgrad do k=i+1,j2 -cgrad do l=1,3 -cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -C Remaining derivatives of eello - do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) - enddo - ENDIF -C Change 12/26/95 to calculate four-body contributions to H-bonding energy -c if (j.gt.i+1 .and. num_conti.le.maxconts) then - if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 - & .and. num_conti.le.maxconts) then -c write (iout,*) i,j," entered corr" -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -c r0ij=1.02D0*rpp(iteli,itelj) -c r0ij=1.11D0*rpp(iteli,itelj) - r0ij=2.20D0*rpp(iteli,itelj) -c r0ij=1.55D0*rpp(iteli,itelj) - call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) - if (fcont.gt.0.0D0) then - num_conti=num_conti+1 - if (num_conti.gt.maxconts) then - write (iout,*) 'WARNING - max. # of contacts exceeded;', - & ' will skip next contacts for this conf.' - else - jcont_hb(num_conti,i)=j -cd write (iout,*) "i",i," j",j," num_conti",num_conti, -cd & " jcont_hb",jcont_hb(num_conti,i) - IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. - & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el -C terms. - d_cont(num_conti,i)=rij -cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij -C --- Electrostatic-interaction matrix --- - a_chuj(1,1,num_conti,i)=a22 - a_chuj(1,2,num_conti,i)=a23 - a_chuj(2,1,num_conti,i)=a32 - a_chuj(2,2,num_conti,i)=a33 -C --- Gradient of rij - do kkk=1,3 - grij_hb_cont(kkk,num_conti,i)=erij(kkk) - enddo - kkll=0 - do k=1,2 - do l=1,2 - kkll=kkll+1 - do m=1,3 - a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll) - a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll) - a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) - a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) - a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) - enddo - enddo - enddo - ENDIF - IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN -C Calculate contact energies - cosa4=4.0D0*cosa - wij=cosa-3.0D0*cosb*cosg - cosbg1=cosb+cosg - cosbg2=cosb-cosg -c fac3=dsqrt(-ael6i)/r0ij**3 - fac3=dsqrt(-ael6i)*r3ij -c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 - if (ees0tmp.gt.0) then - ees0pij=dsqrt(ees0tmp) - else - ees0pij=0 - endif -c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) - ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 - if (ees0tmp.gt.0) then - ees0mij=dsqrt(ees0tmp) - else - ees0mij=0 - endif -c ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) -C Diagnostics. Comment out or remove after debugging! -c ees0p(num_conti,i)=0.5D0*fac3*ees0pij -c ees0m(num_conti,i)=0.5D0*fac3*ees0mij -c ees0m(num_conti,i)=0.0D0 -C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -C Angular derivatives of the contact function - ees0pij1=fac3/ees0pij - ees0mij1=fac3/ees0mij - fac3p=-3.0D0*fac3*rrmij - ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) - ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) -c ees0mij1=0.0D0 - ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) - ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) - ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) - ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) - ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) - ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) - ecosap=ecosa1+ecosa2 - ecosbp=ecosb1+ecosb2 - ecosgp=ecosg1+ecosg2 - ecosam=ecosa1-ecosa2 - ecosbm=ecosb1-ecosb2 - ecosgm=ecosg1-ecosg2 -C Diagnostics -c ecosap=ecosa1 -c ecosbp=ecosb1 -c ecosgp=ecosg1 -c ecosam=0.0D0 -c ecosbm=0.0D0 -c ecosgm=0.0D0 -C End diagnostics - facont_hb(num_conti,i)=fcont - fprimcont=fprimcont/rij -cd facont_hb(num_conti,i)=1.0D0 -C Following line is for diagnostics. -cd fprimcont=0.0D0 - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo - do k=1,3 - gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) - gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) - enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj -C Derivatives due to the contact function - gacont_hbr(1,num_conti,i)=fprimcont*xj - gacont_hbr(2,num_conti,i)=fprimcont*yj - gacont_hbr(3,num_conti,i)=fprimcont*zj - do k=1,3 -c -c 10/24/08 cgrad and ! comments indicate the parts of the code removed -c following the change of gradient-summation algorithm. -c -cgrad ghalfp=0.5D0*gggp(k) -cgrad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) - enddo - ENDIF ! wcorr - endif ! num_conti.le.maxconts - endif ! fcont.gt.0 - endif ! j.gt.i+1 - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then - do k=1,4 - do l=1,3 - ghalf=0.5d0*agg(l,k) - aggi(l,k)=aggi(l,k)+ghalf - aggi1(l,k)=aggi1(l,k)+agg(l,k) - aggj(l,k)=aggj(l,k)+ghalf - enddo - enddo - if (j.eq.nres-1 .and. i.lt.j-2) then - do k=1,4 - do l=1,3 - aggj1(l,k)=aggj1(l,k)+agg(l,k) - enddo - enddo - endif - endif -c t_eelecij=t_eelecij+MPI_Wtime()-time00 - return - end -C----------------------------------------------------------------------- - subroutine evdwpp_short(evdw1) -C -C Compute Evdwpp -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - dimension ggg(3) -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif - evdw1=0.0D0 -c write (iout,*) "iatel_s_vdw",iatel_s_vdw, -c & " iatel_e_vdw",iatel_e_vdw - call flush(iout) - do i=iatel_s_vdw,iatel_e_vdw - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 -c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), -c & ' ielend',ielend_vdw(i) - call flush(iout) - do j=ielstart_vdw(i),ielend_vdw(i) - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - sss=sscale(rij/rpp(iteli,itelj)) - if (sss.gt.0.0d0) then - rmij=1.0D0/rij - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - evdwij=ev1+ev2 - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - endif - evdw1=evdw1+evdwij*sss -C -C Calculate contributions to the Cartesian gradient. -C - facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo - endif - enddo ! j - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp_long(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.lt.1.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss) - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*(1.0d0-sss) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*(1.0d0-sss) - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine escp_short(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.gt.0.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*sss - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*sss - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*sss - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end diff --git a/source/unres/src_MD-DFA-restraints/energy_p_new_barrier.F b/source/unres/src_MD-DFA-restraints/energy_p_new_barrier.F deleted file mode 100644 index 5707b4b..0000000 --- a/source/unres/src_MD-DFA-restraints/energy_p_new_barrier.F +++ /dev/null @@ -1,9496 +0,0 @@ - subroutine etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wsct -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wsct=weights(22) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw,evdw_p,evdw_m) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw,evdw_p,evdw_m) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw,evdw_p,evdw_m) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -C BARTEK for dfa test! - if (wdfa_dist.gt.0) then - call edfad(edfadis) - else - edfadis=0 - endif -c print*, 'edfad is finished!', edfadis - if (wdfa_tor.gt.0) then - call edfat(edfator) - else - edfator=0 - endif -c print*, 'edfat is finished!', edfator - if (wdfa_nei.gt.0) then - call edfan(edfanei) - else - edfanei=0 - endif -c print*, 'edfan is finished!', edfanei - if (wdfa_beta.gt.0) then - call edfab(edfabet) - else - edfabet=0 - endif -c print*, 'edfab is finished!', edfabet -cmc -cmc Sep-06: egb takes care of dynamic ss bonds too -cmc -c if (dyn_ss) call dyn_set_nss - -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif - call vec_and_deriv -#ifdef TIMING -#ifdef MPI - time_vec=time_vec+MPI_Wtime()-time01 -#else - time_vec=time_vec+tcpu()-time01 -#endif -#endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif - - if (constr_homology.ge.1) then - call e_modeller(ehomology_constr) - else - ehomology_constr=0.0d0 - endif - - -c write(iout,*) ehomology_constr -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr - endif -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -#ifdef TIMING -#ifdef MPI - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#else - time_enecalc=time_enecalc+tcpu()-time00 -#endif -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m - energia(24)=ehomology_constr - energia(25)=edfadis - energia(26)=edfator - energia(27)=edfanei - energia(28)=edfabet -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) - if (dyn_ss) call dyn_set_nss -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING -#ifdef MPI - time_sumene=time_sumene+MPI_Wtime()-time00 -#else - time_sumene=time_sumene+tcpu()-time00 -#endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - ehomology_constr=energia(24) - edfadis=energia(25) - edfator=energia(26) - edfanei=energia(27) - edfabet=energia(28) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr - & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei - & +wdfa_beta*edfabet -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr - & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei - & +wdfa_beta*edfabet -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' -#endif - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres) - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' - include 'COMMON.SCCOR' -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time01=tcpu() -#endif -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3), - & (gvdwcT(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef SPLITELE -#ifdef TSCSC - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - enddo - enddo -#endif -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i)+ - & wdfa_dist*gdfad(j,i)+ - & wdfa_tor*gdfat(j,i)+ - & wdfa_nei*gdfan(j,i)+ - & wdfa_beta*gdfab(j,i) - enddo - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - enddo - enddo -c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG -c write (iout,*) "gradbufc_sum after allreduce" -c do i=1,nres -c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -c enddo -c call flush(iout) -#endif -#ifdef TIMING -c time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif -c -c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -c do not parallelize this part. -c -c do i=igrad_start,igrad_end -c do j=jgrad_start(i),jgrad_end(i) -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -c enddo -c enddo -c enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - gradbufc(j,i)=0.0d0 - enddo - enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -c do i=nnt,nres-1 -c do k=1,3 -c gradbufc(k,i)=0.0d0 -c enddo -c do j=i+1,nres -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -c enddo -c enddo -c enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=1,nct - do j=1,3 -#ifdef SPLITELE - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#endif -#ifdef TSCSC - gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+ - & wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#else - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#endif - enddo - enddo -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo -#ifdef DEBUG - write (iout,*) "gloc_sc before reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif - do i=1,nres - do j=1,3 - gloc_scbuf(j,i)=gloc_sc(j,i,icg) - enddo - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc_sc after reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#ifdef TSCSC - gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#endif - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#ifdef TSCSC - gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#endif - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING -#ifdef MPI - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#else - time_sumgradient=time_sumgradient+tcpu()-time01 -#endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact -#ifdef TSCSC -c wsct=t_bath/temp0 - wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 -#endif - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - ehomology_constr=energia(24) -C Bartek - edfadis = energia(25) - edfator = energia(26) - edfanei = energia(27) - edfabet = energia(28) - -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ehomology_constr, ebr*nss, - & Uconst,edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei, - & edfabet,wdfa_beta,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ - & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/ - & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/ - & 'EDFAN= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA NCa energy)'/ - & 'EDFAB= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA Beta energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ehomology_constr,ebr*nss,Uconst,edfadis,wdfa_dist,edfator, - & wdfa_tor,edfanei,wdfa_nei,edfabet,wdfa_beta, - & etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'EDFAD= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA distance energy)'/ - & 'EDFAT= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA torsion energy)'/ - & 'EDFAN= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA NCa energy)'/ - & 'EDFAB= ',1pE16.6,' WEIGHT=',1pD16.6,' (DFA Beta energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij - else - evdw_m=evdw_m+evdwij - endif -#else - evdw=evdw+evdwij -#endif -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -#ifdef TSCSC - if (bb(itypi,itypj).gt.0.0d0) then - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - else - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - gvdwcT(k,i)=gvdwcT(k,i)-gg(k) - gvdwcT(k,j)=gvdwcT(k,j)+gg(k) - enddo - endif -#else - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -#endif -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (ri' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, -c & dhpb(i),dhpb1(i),forcon(i) -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. -cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then -C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds - if (.not.dyn_ss .and. i.le.nss) then -C 15/02/13 CC dynamic SSbond - additional check - if (ii.gt.nres - & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij - endif -cd write (iout,*) "eij",eij - else if (ii.gt.nres .and. jj.gt.nres) then -c Restraints from contact prediction - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "beta nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "beta reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "alph nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "alpha reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12+ebr - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue -c lprn1=.true. - if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)') - & 'ebe', i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai -c lprn1=.false. - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci - write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ -c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA - subroutine e_modeller(ehomology_constr) - ehomology_constr=0.0 - write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!" - return - end -C !!!!!!!! NIE CZYTANE !!!!!!!!!!! - -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -c write (iout,*) "gloci", gloc(i-3,icg) -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- -c MODELLER restraint function - subroutine e_modeller(ehomology_constr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - integer nnn, i, j, k, ki, irec, l - integer katy, odleglosci, test7 - real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template) - real*8 distance(max_template),distancek(max_template), - & min_odl,godl(max_template),dih_diff(max_template) - - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - - - do i=1,19 - distancek(i)=9999999.9 - enddo - - - odleg=0.0d0 - -c Pseudo-energy and gradient from homology restraints (MODELLER-like -c function) -C AL 5/2/14 - Introduce list of restraints - do ii = link_start_homo,link_end_homo - i = ires_homo(ii) - j = jres_homo(ii) - dij=dist(i,j) - do k=1,constr_homology - distance(k)=odl(k,ii)-dij - distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii) - enddo - - min_odl=minval(distancek) -#ifdef DEBUG - write (iout,*) "ij dij",i,j,dij - write (iout,*) "distance",(distance(k),k=1,constr_homology) - write (iout,*) "distancek",(distancek(k),k=1,constr_homology) - write (iout,* )"min_odl",min_odl -#endif - odleg2=0.0d0 - do k=1,constr_homology -c Nie wiem po co to liczycie jeszcze raz! -c odleg3=-waga_dist*((distance(i,j,k)**2)/ -c & (2*(sigma_odl(i,j,k))**2)) - godl(k)=dexp(-distancek(k)+min_odl) - odleg2=odleg2+godl(k) - -ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3, -ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=", -ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1), -ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k) - - enddo -#ifdef DEBUG - write (iout,*) "godl",(godl(k),k=1,constr_homology) - write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 -#endif - odleg=odleg-dLOG(odleg2/constr_homology)+min_odl -c Gradient - sum_godl=odleg2 - sum_sgodl=0.0 - do k=1,constr_homology -c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) -c & *waga_dist)+min_odl - sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist - sum_sgodl=sum_sgodl+sgodl - -c sgodl2=sgodl2+sgodl -c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1" -c write(iout,*) "constr_homology=",constr_homology -c write(iout,*) i, j, k, "TEST K" - enddo - - grad_odl3=sum_sgodl/(sum_godl*dij) - - -c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2" -c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2), -c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) - -ccc write(iout,*) godl, sgodl, grad_odl3 - -c grad_odl=grad_odl+grad_odl3 - - do jik=1,3 - ggodl=grad_odl3*(c(jik,i)-c(jik,j)) -ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1)) -ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl, -ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) - ghpbc(jik,i)=ghpbc(jik,i)+ggodl - ghpbc(jik,j)=ghpbc(jik,j)-ggodl -ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl, -ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) - - enddo -ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=", -ccc & dLOG(odleg2),"-odleg=", -odleg - - enddo ! ii -c Pseudo-energy and gradient from dihedral-angle restraints from -c homology templates -c write (iout,*) "End of distance loop" -c call flush(iout) - kat=0.0d0 -c write (iout,*) idihconstr_start_homo,idihconstr_end_homo - do i=idihconstr_start_homo,idihconstr_end_homo - kat2=0.0d0 -c betai=beta(i,i+1,i+2,i+3) - betai = phi(i+3) - do k=1,constr_homology - dih_diff(k)=pinorm(dih(k,i)-betai) -c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)= -c & -(6.28318-dih_diff(i,k)) -c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)= -c & 6.28318+dih_diff(i,k) - - kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i) - gdih(k)=dexp(kat3) - kat2=kat2+gdih(k) -c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3) -c write(*,*)"" - enddo -#ifdef DEBUG - write (iout,*) "i",i," betai",betai," kat2",kat2 - write (iout,*) "gdih",(gdih(k),k=1,constr_homology) -#endif - if (kat2.le.1.0d-14) cycle - kat=kat-dLOG(kat2/constr_homology) - -ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=", -ccc & dLOG(kat2), "-kat=", -kat - -c ---------------------------------------------------------------------- -c Gradient -c ---------------------------------------------------------------------- - - sum_gdih=kat2 - sum_sgdih=0.0 - do k=1,constr_homology - sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle - sum_sgdih=sum_sgdih+sgdih - enddo - grad_dih3=sum_sgdih/sum_gdih - -c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3 -ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3, -ccc & gloc(nphi+i-3,icg) - gloc(i,icg)=gloc(i,icg)+grad_dih3 -ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3, -ccc & gloc(nphi+i-3,icg) - - enddo - - -c Total energy from homology restraints -#ifdef DEBUG - write (iout,*) "odleg",odleg," kat",kat -#endif - ehomology_constr=odleg+kat - return - - 748 format(a8,f12.3,a6,f12.3,a7,f12.3) - 747 format(a12,i4,i4,i4,f8.3,f8.3) - 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3) - 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3) - 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, - & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3) - end - -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 -c write (iout,*) "gloci", gloc(i-3,icg) - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=itau_start,itau_end - esccor_ii=0.0D0 - isccori=isccortyp(itype(i-2)) - isccori1=isccortyp(itype(i-1)) - phii=phi(i) -cccc Added 9 May 2012 -cc Tauangle is torsional engle depending on the value of first digit -c(see comment below) -cc Omicron is flat angle depending on the value of first digit -c(see comment below) - - - do intertyp=1,3 !intertyp -cc Added 09 May 2012 (Adasko) -cc Intertyp means interaction type of backbone mainchain correlation: -c 1 = SC...Ca...Ca...Ca -c 2 = Ca...Ca...Ca...SC -c 3 = SC...Ca...Ca...SCi - gloci=0.0D0 - if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. - & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or. - & (itype(i-1).eq.21))) - & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) - & .or.(itype(i-2).eq.21))) - & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. - & (itype(i-1).eq.21)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21)) - & cycle - do j=1,nterm_sccor(isccori,isccori1) - v1ij=v1sccor(j,intertyp,isccori,isccori1) - v2ij=v2sccor(j,intertyp,isccori,isccori1) - cosphi=dcos(j*tauangle(intertyp,i)) - sinphi=dsin(j*tauangle(intertyp,i)) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci -c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi -c &gloc_sc(intertyp,i-3,icg) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,intertyp,itori,itori1),j=1,6) - & ,(v2sccor(j,intertyp,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo !intertyp - enddo -c do i=1,nres -c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(2),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C \ /l\ /j\ / C -C \ / \ / \ / C -C o| o | | o |o C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C j|/k\| / |/k\|l / C -C / \ / / \ / C -C / o / o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o \ o \ C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD-DFA-restraints/energy_split-sep.F b/source/unres/src_MD-DFA-restraints/energy_split-sep.F deleted file mode 100644 index 97442a3..0000000 --- a/source/unres/src_MD-DFA-restraints/energy_split-sep.F +++ /dev/null @@ -1,500 +0,0 @@ - subroutine etotal_long(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the long-range slow-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.MD' -c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI -c if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_LONG Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif - call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart -c call int_from_cart1(.false.) - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -cd print *,'nnt=',nnt,' nct=',nct -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_long(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_long(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_long(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_long(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_long(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - call vec_and_deriv - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp_long(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else - call escp_soft_sphere(evdw2,evdw2_14) - endif -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) - endif -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -C -C Sum the energies -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(20)=Uconst+Uconst_back - energia(22)=evdw_p - energia(23)=evdw_m - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine etotal_short(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the short-range fast-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CONTROL' - -c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot -c call flush(iout) - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks -c call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_short(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_short(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_short(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_short(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_short(evdw) - goto 107 -C Soft-sphere potential - already dealt with in the long-range part - 106 evdw=0.0d0 -c 106 call e_softsphere_short(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - -C BARTEK for dfa test! - if (wdfa_dist.gt.0) call edfad(edfadis) -c print*, 'edfad is finished!', edfadis - if (wdfa_tor.gt.0) call edfat(edfator) -c print*, 'edfat is finished!', edfator - if (wdfa_nei.gt.0) call edfan(edfanei) -c print*, 'edfan is finished!', edfanei - if (wdfa_beta.gt.0) call edfab(edfabet) -c print*, 'edfab is finished!', edfabet -c -c Calculate the short-range part of Evdwpp -c - call evdwpp_short(evdw1) -c -c Calculate the short-range part of ESCp -c - if (ipot.lt.6) then - call escp_short(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. - call edis(ehpb) -C -C Calculate the virtual-bond-angle energy. -C - call ebend(ebe) -C -C Calculate the SC local energy. -C - call vec_and_deriv - call esc(escloc) -C -C Calculate the virtual-bond torsional energy. -C - call etor(etors,edihcnstr) -c -c Homology restraints -c - if (constr_homology.ge.1) then - call e_modeller(ehomology_constr) - else - ehomology_constr=0.0d0 - endif -C -C 6/23/01 Calculate double-torsional energy -C - call etor_d(etors_d) -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -C -C Put energy components into an array -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(16)=evdw1 -#else - energia(3)=evdw1 -#endif - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(17)=estr - energia(19)=edihcnstr - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m - energia(24)=ehomology_constr - energia(25)=edfadis - energia(26)=edfator - energia(27)=edfanei - energia(28)=edfabet -c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) - return - end diff --git a/source/unres/src_MD-DFA-restraints/entmcm.F b/source/unres/src_MD-DFA-restraints/entmcm.F deleted file mode 100644 index 3c2dc5a..0000000 --- a/source/unres/src_MD-DFA-restraints/entmcm.F +++ /dev/null @@ -1,684 +0,0 @@ - subroutine entmcm -C Does modified entropic sampling in the space of minima. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,ehighest,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - double precision energia(0:n_ene),energia_ave(0:n_ene) -C -cd write (iout,*) 'print_mc=',print_mc - WhatsUp=0 - maxtrial_iter=50 -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - indminn=-max_ene - indmaxx=max_ene - delte=0.5D0 - facee=1.0D0/(maxacc*delte) - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else - call gen_rand_conf(1,*20) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 -#ifdef MPL - if (MyID.eq.MasterID) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif -#endif - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) - call minimize(etot,varia,iretcode,nfun) - call etotal(energia(0)) - etot = energia(0) - write (iout,'(/80(1h*)/a/80(1h*))') - & 'Results of the first energy minimization:' - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - write (istat,'(i5,11(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot,rms,frac,co - else - write (istat,'(i5,9(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - neneval=neneval+nfun+1 - if (.not. ent_read) then -C Initialize the entropy array - do i=-max_ene,max_ene - emin=etot -C Uncomment the line below for actual entropic sampling (start with uniform -C energy distribution). -c entropy(i)=0.0D0 -C Uncomment the line below for multicanonical sampling (start with Boltzmann -C distribution). - entropy(i)=(emin+i*delte)*betbol - enddo - emax=10000000.0D0 - emin=etot - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done = (iretcode.ne.11) -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - indeold=(eold-emin)/delte - deix=eold-(emin+indeold*delte) - dent=entropy(indeold+1)-entropy(indeold) -cd write (iout,*) 'indeold=',indeold,' deix=',deix,' dent=',dent -cd write (*,*) 'Processor',MyID,' indeold=',indeold,' deix=',deix, -cd & ' dent=',dent - sold=entropy(indeold)+(dent/delte)*deix - elowest=etot - write (iout,*) 'eold=',eold,' sold=',sold,' elowest=',etot - write (*,*) 'Processor',MyID,' eold=',eold,' sold=',sold, - & ' elowest=',etot - if (minim) call zapis(varia,etot) - nminima(1)=1.0D0 -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - else - call send_MCM_info(2) - endif -#endif - do iene=indminn,indmaxx - nhist(iene)=0.0D0 - enddo - do i=2,maxsave - nminima(i)=0.0D0 - enddo -C Main loop. -c---------------------------------------------------------------------------- - elowest=1.0D10 - ehighest=-1.0D10 - it=0 - do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0) write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0) write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+1 - endif - if (print_mc.gt.2) then - write (iout,'(a)') 'Total energies of trial conf:' - call enerprint(energia(0)) - else if (print_mc.eq.1) then - write (iout,'(a,i6,a,1pe16.6)') - & 'Trial conformation:',ngen,' energy:',etot - endif -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accepting(etot,eold,scur,sold,varia,varold, - & accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irep=conf_comp(varia,etot) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup, - & przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - if (print_mc.gt.0) - & write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,11(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,co - elseif (print_stat) then - write (istat,'(i5,10(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - if (print_mc.gt.1) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) -#ifdef MPL - if (MyID.ne.MasterID) then - call recv_stop_sig(Kwita) -cd print *,'Processor:',MyID,' STOP=',Kwita - if (irep.eq.0) then - call send_MCM_info(2) - else - call send_MCM_info(1) - endif - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo - if (irep.eq.0) then - irep=nsave+1 -cd write (iout,*) 'Accepted conformation:' -cd write (iout,*) (rad2deg*varia(i),i=1,nphi) - if (minim) call zapis(varia,etot) - do i=1,n_ene - ener(i,nsave)=energia(i) - enddo - ener(n_ene+1,nsave)=etot - ener(n_ene+2,nsave)=frac - endif - nminima(irep)=nminima(irep)+1.0D0 -c print *,'irep=',irep,' nminima=',nminima(irep) -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif - if (ntrial.gt.maxtrial_iter .and. npool.gt.0) then -C Take a conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Iteration',it,' max. # of trials exceeded.' - write (iout,*) - & 'Take conformation',ii,' from the pool energy=',epool(ii) - if (print_mc.gt.2) - & write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - ntrial=0 - endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) -#endif - 21 continue -#ifdef MPL - if (MyID.eq.MasterID) then -c call receive_MCM_results - call receive_energies -#endif - do i=1,nsave - if (esave(i).lt.elowest) elowest=esave(i) - if (esave(i).gt.ehighest) ehighest=esave(i) - enddo - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - if (isweep.eq.1 .and. .not.ent_read) then - emin=elowest - emax=ehighest - write (iout,*) 'EMAX=',emax - indminn=0 - indmaxx=(ehighest-emin)/delte - indmin=indminn - indmax=indmaxx - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ent_read=.true. - else - indmin=(elowest-emin)/delte - indmax=(ehighest-emin)/delte - if (indmin.lt.indminn) indminn=indmin - if (indmax.gt.indmaxx) indmaxx=indmax - endif - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Construct energy histogram - do i=1,nsave - inde=(esave(i)-emin)/delte - nhist(inde)=nhist(inde)+nminima(i) - enddo -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo -Cd do i=indmaxx+1 -Cd entropy(i)=1.0D+10 -Cd enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - entropy(-max_ene-4)=dfloat(indminn) - entropy(-max_ene-3)=dfloat(indmaxx) - entropy(-max_ene-2)=emin - entropy(-max_ene-1)=emax - call send_MCM_update -cd print *,entname,ientout - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - else - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo -c call send_MCM_results - call send_energies - call receive_MCM_update - indminn=entropy(-max_ene-4) - indmaxx=entropy(-max_ene-3) - emin=entropy(-max_ene-2) - emax=entropy(-max_ene-1) - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif - if (WhatsUp.lt.-1) return -#else - if (ovrtim() .or. WhatsUp.lt.0) return -#endif - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - write (iout,'(a,i10)') 'Number of chain regrowths:',nregrow - write (iout,'(a,i10)') 'Accepted chain regrowths:',nregrow_acc - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accepting(ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - double precision tole /1.0D-1/, tola /5.0D0/ - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - else if (dabs(ecur-eold).lt.tole .and. - & dif_ang(nphi,x,xold).lt.tola) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too similar' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - indecur=(ecur-emin)/delte - if (iabs(indecur).gt.max_ene) then - write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.eq.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0) write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.1) then - write(iout,*)'ecur=',ecur,' indecur=',indecur,' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation rejected.' - endif - endif - return - end -c----------------------------------------------------------------------------- - subroutine read_pool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.VAR' - double precision varia(maxvar) - print '(a)','Call READ_POOL' - do npool=1,max_pool - print *,'i=',i - read (intin,'(i5,f10.5)',end=10,err=10) iconf,epool(npool) - if (epool(npool).eq.0.0D0) goto 10 - call read_angles(intin,*10) - call geom_to_var(nvar,xpool(1,npool)) - enddo - goto 11 - 10 npool=npool-1 - 11 write (iout,'(a,i5)') 'Number of pool conformations:',npool - if (print_mc.gt.2) then - do i=1,npool - write (iout,'(a,i5,a,1pe14.5)') 'Pool conformation',i,' energy', - & epool(i) - write (iout,'(10f8.3)') (rad2deg*xpool(j,i),j=1,nvar) - enddo - endif ! (print_mc.gt.2) - return - end diff --git a/source/unres/src_MD-DFA-restraints/fitsq.f b/source/unres/src_MD-DFA-restraints/fitsq.f deleted file mode 100644 index 36cbd30..0000000 --- a/source/unres/src_MD-DFA-restraints/fitsq.f +++ /dev/null @@ -1,364 +0,0 @@ - subroutine fitsq(rms,x,y,nn,t,b,non_conv) - implicit real*8 (a-h,o-z) - include 'COMMON.IOUNITS' -c x and y are the vectors of coordinates (dimensioned (3,n)) of the two -c structures to be superimposed. nn is 3*n, where n is the number of -c points. t and b are respectively the translation vector and the -c rotation matrix that transforms the second set of coordinates to the -c frame of the first set. -c eta = machine-specific variable - - dimension x(3*nn),y(3*nn),t(3) - dimension b(3,3),q(3,3),r(3,3),v(3),xav(3),yav(3),e(3),c(3,3) - logical non_conv -c eta = z00100000 -c small=25.0*rmdcon(3) -c small=25.0*eta -c small=25.0*10.e-10 -c the following is a very lenient value for 'small' - small = 0.0001D0 - non_conv=.false. - fn=nn - do 10 i=1,3 - xav(i)=0.0D0 - yav(i)=0.0D0 - do 10 j=1,3 - 10 b(j,i)=0.0D0 - nc=0 -c - do 30 n=1,nn - do 20 i=1,3 -c write(iout,*)'x = ',x(nc+i),' y = ',y(nc+i) - xav(i)=xav(i)+x(nc+i)/fn - 20 yav(i)=yav(i)+y(nc+i)/fn - 30 nc=nc+3 -c - do i=1,3 - t(i)=yav(i)-xav(i) - enddo - - rms=0.0d0 - do n=1,nn - do i=1,3 - rms=rms+(y(3*(n-1)+i)-x(3*(n-1)+i)-t(i))**2 - enddo - enddo - rms=dabs(rms/fn) - -c write(iout,*)'xav = ',(xav(j),j=1,3) -c write(iout,*)'yav = ',(yav(j),j=1,3) -c write(iout,*)'t = ',(t(j),j=1,3) -c write(iout,*)'rms=',rms - if (rms.lt.small) return - - - nc=0 - rms=0.0D0 - do 50 n=1,nn - do 40 i=1,3 - rms=rms+((x(nc+i)-xav(i))**2+(y(nc+i)-yav(i))**2)/fn - do 40 j=1,3 - b(j,i)=b(j,i)+(x(nc+i)-xav(i))*(y(nc+j)-yav(j))/fn - 40 c(j,i)=b(j,i) - 50 nc=nc+3 - call sivade(b,q,r,d,non_conv) - sn3=dsign(1.0d0,d) - do 120 i=1,3 - do 120 j=1,3 - 120 b(j,i)=-q(j,1)*r(i,1)-q(j,2)*r(i,2)-sn3*q(j,3)*r(i,3) - call mvvad(b,xav,yav,t) - do 130 i=1,3 - do 130 j=1,3 - rms=rms+2.0*c(j,i)*b(j,i) - 130 b(j,i)=-b(j,i) - if (dabs(rms).gt.small) go to 140 -* write (6,301) - return - 140 if (rms.gt.0.0d0) go to 150 -c write (iout,303) rms - rms=0.0d0 -* stop -c 150 write (iout,302) dsqrt(rms) - 150 continue - return - 301 format (5x,'rms deviation negligible') - 302 format (5x,'rms deviation ',f14.6) - 303 format (//,5x,'negative ms deviation - ',f14.6) - end -c - subroutine sivade(x,q,r,dt,non_conv) - implicit real*8(a-h,o-z) -c computes q,e and r such that q(t)xr = diag(e) - dimension x(3,3),q(3,3),r(3,3),e(3) - dimension h(3,3),p(3,3),u(3,3),d(3) - logical non_conv -c eta = z00100000 -c write (2,*) "SIVADE" - nit = 0 - small=25.0*10.d-10 -c small=25.0*eta -c small=2.0*rmdcon(3) - xnrm=0.0d0 - do 20 i=1,3 - do 10 j=1,3 - xnrm=xnrm+x(j,i)*x(j,i) - u(j,i)=0.0d0 - r(j,i)=0.0d0 - 10 h(j,i)=0.0d0 - u(i,i)=1.0 - 20 r(i,i)=1.0 - xnrm=dsqrt(xnrm) - do 110 n=1,2 - xmax=0.0d0 - do 30 j=n,3 - 30 if (dabs(x(j,n)).gt.xmax) xmax=dabs(x(j,n)) - a=0.0d0 - do 40 j=n,3 - h(j,n)=x(j,n)/xmax - 40 a=a+h(j,n)*h(j,n) - a=dsqrt(a) - den=a*(a+dabs(h(n,n))) - d(n)=1.0/den - h(n,n)=h(n,n)+dsign(a,h(n,n)) - do 70 i=n,3 - s=0.0d0 - do 50 j=n,3 - 50 s=s+h(j,n)*x(j,i) - s=d(n)*s - do 60 j=n,3 - 60 x(j,i)=x(j,i)-s*h(j,n) - 70 continue - if (n.gt.1) go to 110 - xmax=dmax1(dabs(x(1,2)),dabs(x(1,3))) - h(2,3)=x(1,2)/xmax - h(3,3)=x(1,3)/xmax - a=dsqrt(h(2,3)*h(2,3)+h(3,3)*h(3,3)) - den=a*(a+dabs(h(2,3))) - d(3)=1.0/den - h(2,3)=h(2,3)+sign(a,h(2,3)) - do 100 i=1,3 - s=0.0d0 - do 80 j=2,3 - 80 s=s+h(j,3)*x(i,j) - s=d(3)*s - do 90 j=2,3 - 90 x(i,j)=x(i,j)-s*h(j,3) - 100 continue - 110 continue - do 130 i=1,3 - do 120 j=1,3 - 120 p(j,i)=-d(1)*h(j,1)*h(i,1) - 130 p(i,i)=1.0+p(i,i) - do 140 i=2,3 - do 140 j=2,3 - u(j,i)=u(j,i)-d(2)*h(j,2)*h(i,2) - 140 r(j,i)=r(j,i)-d(3)*h(j,3)*h(i,3) - call mmmul(p,u,q) - 150 np=1 - nq=1 - nit=nit+1 -c write (2,*) "nit",nit," e",(x(i,i),i=1,3) - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif - if (dabs(x(2,3)).gt.small*(dabs(x(2,2))+abs(x(3,3)))) go to 160 - x(2,3)=0.0d0 - nq=nq+1 - 160 if (dabs(x(1,2)).gt.small*(dabs(x(1,1))+dabs(x(2,2)))) go to 180 - x(1,2)=0.0d0 - if (x(2,3).ne.0.0d0) go to 170 - nq=nq+1 - go to 180 - 170 np=np+1 - 180 if (nq.eq.3) go to 310 - npq=4-np-nq -c write (2,*) "np",np," npq",npq - if (np.gt.npq) go to 230 - n0=0 - do 220 n=np,npq - nn=n+np-1 -c write (2,*) "nn",nn - if (dabs(x(nn,nn)).gt.small*xnrm) go to 220 - x(nn,nn)=0.0d0 - if (x(nn,nn+1).eq.0.0d0) go to 220 - n0=n0+1 -c write (2,*) "nn",nn - go to (190,210,220),nn - 190 do 200 j=2,3 - 200 call givns(x,q,1,j) - go to 220 - 210 call givns(x,q,2,3) - 220 continue -c write (2,*) "nn",nn," np",np," nq",nq," n0",n0 -c write (2,*) "x",(x(i,i),i=1,3) - if (n0.ne.0) go to 150 - 230 nn=3-nq - a=x(nn,nn)*x(nn,nn) - if (nn.gt.1) a=a+x(nn-1,nn)*x(nn-1,nn) - b=x(nn+1,nn+1)*x(nn+1,nn+1)+x(nn,nn+1)*x(nn,nn+1) - c=x(nn,nn)*x(nn,nn+1) - dd=0.5*(a-b) - xn2=c*c - rt=b-xn2/(dd+sign(dsqrt(dd*dd+xn2),dd)) - y=x(np,np)*x(np,np)-rt - z=x(np,np)*x(np,np+1) - do 300 n=np,nn -c write (2,*) "n",n," a",a," b",b," c",c," y",y," z",z - if (dabs(y).lt.dabs(z)) go to 240 - t=z/y - c=1.0/dsqrt(1.0d0+t*t) - s=c*t - go to 250 - 240 t=y/z - s=1.0/dsqrt(1.0d0+t*t) - c=s*t - 250 do 260 j=1,3 - v=x(j,n) - w=x(j,n+1) - x(j,n)=c*v+s*w - x(j,n+1)=-s*v+c*w - a=r(j,n) - b=r(j,n+1) - r(j,n)=c*a+s*b - 260 r(j,n+1)=-s*a+c*b - y=x(n,n) - z=x(n+1,n) - if (dabs(y).lt.dabs(z)) go to 270 - t=z/y - c=1.0/dsqrt(1.0+t*t) - s=c*t - go to 280 - 270 t=y/z - s=1.0/dsqrt(1.0+t*t) - c=s*t - 280 do 290 j=1,3 - v=x(n,j) - w=x(n+1,j) - a=q(j,n) - b=q(j,n+1) - x(n,j)=c*v+s*w - x(n+1,j)=-s*v+c*w - q(j,n)=c*a+s*b - 290 q(j,n+1)=-s*a+c*b - if (n.ge.nn) go to 300 - y=x(n,n+1) - z=x(n,n+2) - 300 continue - go to 150 - 310 do 320 i=1,3 - 320 e(i)=x(i,i) - nit=0 - 330 n0=0 - nit=nit+1 - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif -c write (2,*) "e",(e(i),i=1,3) - do 360 i=1,3 - if (e(i).ge.0.0d0) go to 350 - e(i)=-e(i) - do 340 j=1,3 - 340 q(j,i)=-q(j,i) - 350 if (i.eq.1) go to 360 - if (dabs(e(i)).lt.dabs(e(i-1))) go to 360 - call switch(i,1,q,r,e) - n0=n0+1 - 360 continue - if (n0.ne.0) go to 330 -c write (2,*) "e",(e(i),i=1,3) - if (dabs(e(3)).gt.small*xnrm) go to 370 - e(3)=0.0d0 - if (dabs(e(2)).gt.small*xnrm) go to 370 - e(2)=0.0d0 - 370 dt=det(q(1,1),q(1,2),q(1,3))*det(r(1,1),r(1,2),r(1,3)) -c write (2,*) "nit",nit -c write (2,501) (e(i),i=1,3) - return - 501 format (/,5x,'singular values - ',3e15.5) - end - subroutine givns(a,b,m,n) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3) - if (dabs(a(m,n)).lt.dabs(a(n,n))) go to 10 - t=a(n,n)/a(m,n) - s=1.0/dsqrt(1.0+t*t) - c=s*t - go to 20 - 10 t=a(m,n)/a(n,n) - c=1.0/dsqrt(1.0+t*t) - s=c*t - 20 do 30 j=1,3 - v=a(m,j) - w=a(n,j) - x=b(j,m) - y=b(j,n) - a(m,j)=c*v-s*w - a(n,j)=s*v+c*w - b(j,m)=c*x-s*y - 30 b(j,n)=s*x+c*y - return - end - subroutine switch(n,m,u,v,d) - implicit real*8 (a-h,o-z) - dimension u(3,3),v(3,3),d(3) - do 10 i=1,3 - tem=u(i,n) - u(i,n)=u(i,n-1) - u(i,n-1)=tem - if (m.eq.0) go to 10 - tem=v(i,n) - v(i,n)=v(i,n-1) - v(i,n-1)=tem - 10 continue - tem=d(n) - d(n)=d(n-1) - d(n-1)=tem - return - end - subroutine mvvad(b,xav,yav,t) - implicit real*8 (a-h,o-z) - dimension b(3,3),xav(3),yav(3),t(3) -c dimension a(3,3),b(3),c(3),d(3) -c do 10 j=1,3 -c d(j)=c(j) -c do 10 i=1,3 -c 10 d(j)=d(j)+a(j,i)*b(i) - do 10 j=1,3 - t(j)=yav(j) - do 10 i=1,3 - 10 t(j)=t(j)+b(j,i)*xav(i) - return - end - double precision function det (a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3),b(3),c(3) - det=a(1)*(b(2)*c(3)-b(3)*c(2))+a(2)*(b(3)*c(1)-b(1)*c(3)) - 1 +a(3)*(b(1)*c(2)-b(2)*c(1)) - return - end - subroutine mmmul(a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3),c(3,3) - do 10 i=1,3 - do 10 j=1,3 - c(i,j)=0.0d0 - do 10 k=1,3 - 10 c(i,j)=c(i,j)+a(i,k)*b(k,j) - return - end - subroutine matvec(uvec,tmat,pvec,nback) - implicit real*8 (a-h,o-z) - real*8 tmat(3,3),uvec(3,nback), pvec(3,nback) -c - do 2 j=1,nback - do 1 i=1,3 - uvec(i,j) = 0.0d0 - do 1 k=1,3 - 1 uvec(i,j)=uvec(i,j)+tmat(i,k)*pvec(k,j) - 2 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/gauss.f b/source/unres/src_MD-DFA-restraints/gauss.f deleted file mode 100644 index 7ba6e1d..0000000 --- a/source/unres/src_MD-DFA-restraints/gauss.f +++ /dev/null @@ -1,69 +0,0 @@ - subroutine gauss(RO,AP,MT,M,N,*) -c -c CALCULATES (RO**(-1))*AP BY GAUSS ELIMINATION -c RO IS A SQUARE MATRIX -c THE CALCULATED PRODUCT IS STORED IN AP -c ABNORMAL EXIT IF RO IS SINGULAR -c - integer MT, M, N, M1,I,J,IM, - & I1,MI,MI1 - double precision RO(MT,M),AP(MT,N),X,RM,PR, - & Y - if(M.ne.1)goto 10 - X=RO(1,1) - if(dabs(X).le.1.0D-13) return 1 - X=1.0/X - do 16 I=1,N -16 AP(1,I)=AP(1,I)*X - return -10 continue - M1=M-1 - DO1 I=1,M1 - IM=I - RM=DABS(RO(I,I)) - I1=I+1 - do 2 J=I1,M - if(DABS(RO(J,I)).LE.RM) goto 2 - RM=DABS(RO(J,I)) - IM=J -2 continue - If(IM.eq.I)goto 17 - do 3 J=1,N - PR=AP(I,J) - AP(I,J)=AP(IM,J) -3 AP(IM,J)=PR - do 4 J=I,M - PR=RO(I,J) - RO(I,J)=RO(IM,J) -4 RO(IM,J)=PR -17 X=RO(I,I) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 5 J=1,N -5 AP(I,J)=X*AP(I,J) - do 6 J=I1,M -6 RO(I,J)=X*RO(I,J) - do 7 J=I1,M - Y=RO(J,I) - do 8 K=1,N -8 AP(J,K)=AP(J,K)-Y*AP(I,K) - do 9 K=I1,M -9 RO(J,K)=RO(J,K)-Y*RO(I,K) -7 continue -1 continue - X=RO(M,M) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 11 J=1,N -11 AP(M,J)=X*AP(M,J) - do 12 I=1,M1 - MI=M-I - MI1=MI+1 - do 14 J=1,N - X=AP(MI,J) - do 15 K=MI1,M -15 X=X-AP(K,J)*RO(MI,K) -14 AP(MI,J)=X -12 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/gen_rand_conf.F b/source/unres/src_MD-DFA-restraints/gen_rand_conf.F deleted file mode 100644 index 6cc31ba..0000000 --- a/source/unres/src_MD-DFA-restraints/gen_rand_conf.F +++ /dev/null @@ -1,910 +0,0 @@ - subroutine gen_rand_conf(nstart,*) -C Generate random conformation or chain cut and regrowth. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical overlap,back,fail -cd print *,' CG Processor',me,' maxgen=',maxgen - maxsi=100 -cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart - if (nstart.lt.5) then - it1=itype(2) - phi(4)=gen_phi(4,itype(2),itype(3)) -c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) -c write(iout,*)'theta(3)=',rad2deg*theta(3) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(3),alph(2),omeg(2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif ! it1.ne.10 - call orig_frame - i=4 - nstart=4 - else - i=nstart - nstart=max0(i,4) - endif - - maxnit=0 - - nit=0 - niter=0 - back=.false. - do while (i.le.nres .and. niter.lt.maxgen) - if (i.lt.nstart) then - if(iprint.gt.1) then - write (iout,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - write (*,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - endif - return1 - endif - it1=itype(i-1) - it2=itype(i-2) - it=itype(i) -c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, -c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen - phi(i+1)=gen_phi(i+1,it1,it) - if (back) then - phi(i)=gen_phi(i+1,it2,it1) -c print *,'phi(',i,')=',phi(i) - theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) - if (it2.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i-1) - endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i) - if (overlap(i-1)) then - if (nit.lt.maxnit) then - back=.true. - nit=nit+1 - else - nit=0 - if (i.gt.3) then - back=.true. - i=i-1 - else - write (iout,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - write (*,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - return1 - endif - endif - else - back=.false. - nit=0 - i=i+1 - endif - niter=niter+1 - enddo - if (niter.ge.maxgen) then - write (iout,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - write (*,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - return1 - endif - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo - return - end -c------------------------------------------------------------------------- - logical function overlap(i) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - data redfac /0.5D0/ - overlap=.false. - iti=itype(i) - if (iti.gt.ntyp) return -C Check for SC-SC overlaps. -cd print *,'nnt=',nnt,' nct=',nct - do j=nnt,i-1 - itj=itype(j) - if (j.lt.i-1 .or. ipot.ne.4) then - rcomp=sigmaii(iti,itj) - else - rcomp=sigma(iti,itj) - endif -cd print *,'j=',j - if (dist(nres+i,nres+j).lt.redfac*rcomp) then - overlap=.true. -c print *,'overlap, SC-SC: i=',i,' j=',j, -c & ' dist=',dist(nres+i,nres+j),' rcomp=', -c & rcomp - return - endif - enddo -C Check for overlaps between the added peptide group and the preceding -C SCs. - iteli=itel(i) - do j=1,3 - c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itj=itype(j) -cd print *,'overlap, p-Sc: i=',i,' j=',j, -cd & ' dist=',dist(nres+j,maxres2+1) - if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for overlaps between the added side chain and the preceding peptide -C groups. - do j=1,nnt-2 - do k=1,3 - c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, SC-p: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,maxres2+1) - if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for p-p overlaps - do j=1,3 - c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itelj=itel(j) - do k=1,3 - c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, p-p: i=',i,' j=',j, -cd & ' dist=',dist(maxres2+1,maxres2+2) - if(iteli.ne.0.and.itelj.ne.0)then - if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then - overlap=.true. - return - endif - endif - enddo - return - end -c-------------------------------------------------------------------------- - double precision function gen_phi(i,it1,it2) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' -c gen_phi=ran_number(-pi,pi) -C 8/13/98 Generate phi using pre-defined boundaries - gen_phi=ran_number(phibound(1,i),phibound(2,i)) - return - end -c--------------------------------------------------------------------------- - double precision function gen_theta(it,gama,gama1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - double precision y(2),z(2) - double precision theta_max,theta_min -c print *,'gen_theta: it=',it - theta_min=0.05D0*pi - theta_max=0.95D0*pi - if (dabs(gama).gt.dwapi) then - y(1)=dcos(gama) - y(2)=dsin(gama) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (dabs(gama1).gt.dwapi) then - z(1)=dcos(gama1) - z(2)=dsin(gama1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif - thet_pred_mean=a0thet(it) - do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k) - enddo - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo - sig=0.5D0/(sig*sig+sigc0(it)) - ak=dexp(gthet(1,it)- - &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2) -c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) -c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak - theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak) - if (theta_temp.lt.theta_min) theta_temp=theta_min - if (theta_temp.gt.theta_max) theta_temp=theta_max - gen_theta=theta_temp -c print '(a)','Exiting GENTHETA.' - return - end -c------------------------------------------------------------------------- - subroutine gen_side(it,the,al,om,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision MaxBoxLen /10.0D0/ - double precision Ap_inv(3,3),a(3,3),z(3,maxlob),W1(maxlob), - & sumW(0:maxlob),y(2),cm(2),eig(2),box(2,2),work(100),detAp(maxlob) - double precision eig_limit /1.0D-8/ - double precision Big /10.0D0/ - double precision vec(3,3) - logical lprint,fail,lcheck - lcheck=.false. - lprint=.false. - fail=.false. - if (the.eq.0.0D0 .or. the.eq.pi) then -#ifdef MPI - write (*,'(a,i4,a,i3,a,1pe14.5)') - & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the -#else -cd write (iout,'(a,i3,a,1pe14.5)') -cd & 'Error in GenSide: it=',it,' theta=',the -#endif - fail=.true. - return - endif - tant=dtan(the-pipol) - nlobit=nlob(it) - if (lprint) then -#ifdef MPI - print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.' - write (iout,'(a,i4,a)') 'Processor:',me,' Enter Gen_Side.' -#endif - print *,'it=',it,' nlobit=',nlobit,' the=',the,' tant=',tant - write (iout,*) 'it=',it,' nlobit=',nlobit,' the=',the, - & ' tant=',tant - endif - do i=1,nlobit - zz1=tant-censc(1,i,it) - do k=1,3 - do l=1,3 - a(k,l)=gaussc(k,l,i,it) - enddo - enddo - detApi=a(2,2)*a(3,3)-a(2,3)**2 - Ap_inv(2,2)=a(3,3)/detApi - Ap_inv(2,3)=-a(2,3)/detApi - Ap_inv(3,2)=Ap_inv(2,3) - Ap_inv(3,3)=a(2,2)/detApi - if (lprint) then - write (*,'(/a,i2/)') 'Cluster #',i - write (*,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - write (iout,'(/a,i2/)') 'Cluster #',i - write (iout,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - endif - W1i=0.0D0 - do k=2,3 - do l=2,3 - W1i=W1i+a(k,1)*a(l,1)*Ap_inv(k,l) - enddo - enddo - W1i=a(1,1)-W1i - W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1) -c if (lprint) write(*,'(a,3(1pe15.5)/)') -c & 'detAp, W1, anormi',detApi,W1i,anormi - do k=2,3 - zk=censc(k,i,it) - do l=2,3 - zk=zk+zz1*Ap_inv(k,l)*a(l,1) - enddo - z(k,i)=zk - enddo - detAp(i)=dsqrt(detApi) - enddo - - if (lprint) then - print *,'W1:',(w1(i),i=1,nlobit) - print *,'detAp:',(detAp(i),i=1,nlobit) - print *,'Z' - do i=1,nlobit - print '(i2,3f10.5)',i,(rad2deg*z(j,i),j=2,3) - enddo - write (iout,*) 'W1:',(w1(i),i=1,nlobit) - write (iout,*) 'detAp:',(detAp(i),i=1,nlobit) - write (iout,*) 'Z' - do i=1,nlobit - write (iout,'(i2,3f10.5)') i,(rad2deg*z(j,i),j=2,3) - enddo - endif - if (lcheck) then -C Writing the distribution just to check the procedure - fac=0.0D0 - dV=deg2rad**2*10.0D0 - sum=0.0D0 - sum1=0.0D0 - do i=1,nlobit - fac=fac+W1(i)/detAp(i) - enddo - fac=1.0D0/(2.0D0*fac*pi) -cd print *,it,'fac=',fac - do ial=90,180,2 - y(1)=deg2rad*ial - do iom=-180,180,5 - y(2)=deg2rad*iom - wart=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo - y2=y(2) - - do iii=-1,1 - - y(2)=y2+iii*dwapi - - wykl=0.0D0 - do j=1,2 - do k=1,2 - wykl=wykl+a(j,k)*(y(j)-z(j+1,i))*(y(k)-z(k+1,i)) - enddo - enddo - wart=wart+W1(i)*dexp(-0.5D0*wykl) - - enddo - - y(2)=y2 - - enddo -c print *,'y',y(1),y(2),' fac=',fac - wart=fac*wart - write (20,'(2f10.3,1pd15.5)') y(1)*rad2deg,y(2)*rad2deg,wart - sum=sum+wart - sum1=sum1+1.0D0 - enddo - enddo -c print *,'it=',it,' sum=',sum*dV,' sum1=',sum1*dV - return - endif - -C Calculate the CM of the system -C - do i=1,nlobit - W1(i)=W1(i)/detAp(i) - enddo - sumW(0)=0.0D0 - do i=1,nlobit - sumW(i)=sumW(i-1)+W1(i) - enddo - cm(1)=z(2,1)*W1(1) - cm(2)=z(3,1)*W1(1) - do j=2,nlobit - cm(1)=cm(1)+z(2,j)*W1(j) - cm(2)=cm(2)+W1(j)*(z(3,1)+pinorm(z(3,j)-z(3,1))) - enddo - cm(1)=cm(1)/sumW(nlobit) - cm(2)=cm(2)/sumW(nlobit) - if (cm(1).gt.Big .or. cm(1).lt.-Big .or. - & cm(2).gt.Big .or. cm(2).lt.-Big) then -cd write (iout,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (iout,'(i5,2(1pe14.5))') it,cm(1),cm(2) -cd write (*,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (*,'(i5,2(1pe14.5))') it,cm(1),cm(2) - fail=.true. - return - endif -cd print *,'CM:',cm(1),cm(2) -C -C Find the largest search distance from CM -C - radmax=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo -#ifdef NAG - call f02faf('N','U',2,a,3,eig,work,100,ifail) -#else - call djacob(2,3,10000,1.0d-10,a,vec,eig) -#endif -#ifdef MPI - if (lprint) then - print *,'*************** CG Processor',me - print *,'CM:',cm(1),cm(2) - write (iout,*) '*************** CG Processor',me - write (iout,*) 'CM:',cm(1),cm(2) - print '(A,8f10.5)','Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - write (iout,'(A,8f10.5)') - & 'Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - endif -#endif - if (eig(1).lt.eig_limit) then - write(iout,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - write(*,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif - radius=0.0D0 -cd print *,'i=',i - do j=1,2 - radius=radius+pinorm(z(j+1,i)-cm(j))**2 - enddo - radius=dsqrt(radius)+3.0D0/dsqrt(eig(1)) - if (radius.gt.radmax) radmax=radius - enddo - if (radmax.gt.pi) radmax=pi -C -C Determine the boundaries of the search rectangle. -C - if (lprint) then - print '(a,4(1pe14.4))','W1: ',(W1(i),i=1,nlob(it) ) - print '(a,4(1pe14.4))','radmax: ',radmax - endif - box(1,1)=dmax1(cm(1)-radmax,0.0D0) - box(2,1)=dmin1(cm(1)+radmax,pi) - box(1,2)=cm(2)-radmax - box(2,2)=cm(2)+radmax - if (lprint) then -#ifdef MPI - print *,'CG Processor',me,' Array BOX:' -#else - print *,'Array BOX:' -#endif - print '(4(1pe14.4))',((box(k,j),k=1,2),j=1,2) - print '(a,4(1pe14.4))','sumW: ',(sumW(i),i=0,nlob(it) ) -#ifdef MPI - write (iout,*)'CG Processor',me,' Array BOX:' -#else - write (iout,*)'Array BOX:' -#endif - write(iout,'(4(1pe14.4))') ((box(k,j),k=1,2),j=1,2) - write(iout,'(a,4(1pe14.4))')'sumW: ',(sumW(i),i=0,nlob(it) ) - endif - if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then -#ifdef MPI - write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' - write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' -#else -c write (iout,'(a)') 'Bad sampling box.' -#endif - fail=.true. - return - endif - which_lobe=ran_number(0.0D0,sumW(nlobit)) -c print '(a,1pe14.4)','which_lobe=',which_lobe - do i=1,nlobit - if (sumW(i-1).le.which_lobe .and. sumW(i).ge.which_lobe) goto 1 - enddo - 1 ilob=i -c print *,'ilob=',ilob,' nlob=',nlob(it) - do i=2,3 - cm(i-1)=z(i,ilob) - do j=2,3 - a(i-1,j-1)=gaussc(i,j,ilob,it) - enddo - enddo -cd print '(a,i4,a)','CG Processor',me,' Calling MultNorm1.' - call mult_norm1(3,2,a,cm,box,y,fail) - if (fail) return - al=y(1) - om=pinorm(y(2)) -cd print *,'al=',al,' om=',om -cd stop - return - end -c--------------------------------------------------------------------------- - double precision function ran_number(x1,x2) -C Calculate a random real number from the range (x1,x2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - double precision x1,x2,fctor - data fctor /2147483647.0D0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ran_number=x1+(x2-x1)*prng_next(me) -#else - call vrnd(ix,1) - ran_number=x1+(x2-x1)*ix/fctor -#endif - return - end -c-------------------------------------------------------------------------- - integer function iran_num(n1,n2) -C Calculate a random integer number from the range (n1,n2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer n1,n2,ix - real fctor /2147483647.0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ix=n1+(n2-n1+1)*prng_next(me) - if (ix.lt.n1) ix=n1 - if (ix.gt.n2) ix=n2 - iran_num=ix -#else - call vrnd(ix,1) - ix=n1+(n2-n1+1)*(ix/fctor) - if (ix.gt.n2) ix=n2 - iran_num=ix -#endif - return - end -c-------------------------------------------------------------------------- - double precision function binorm(x1,x2,sigma1,sigma2,ak) - implicit real*8 (a-h,o-z) -c print '(a)','Enter BINORM.' - alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2) - aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2) - seg=sigma1/(sigma1+ak*sigma2) - alen=ran_number(0.0D0,1.0D0) - if (alen.lt.seg) then - binorm=anorm_distr(x1,sigma1,alowb,aupb) - else - binorm=anorm_distr(x2,sigma2,alowb,aupb) - endif -c print '(a)','Exiting BINORM.' - return - end -c----------------------------------------------------------------------- -c double precision function anorm_distr(x,sigma,alowb,aupb) -c implicit real*8 (a-h,o-z) -c print '(a)','Enter ANORM_DISTR.' -c 10 y=ran_number(alowb,aupb) -c expon=dexp(-0.5D0*((y-x)/sigma)**2) -c ran=ran_number(0.0D0,1.0D0) -c if (expon.lt.ran) goto 10 -c anorm_distr=y -c print '(a)','Exiting ANORM_DISTR.' -c return -c end -c----------------------------------------------------------------------- - double precision function anorm_distr(x,sigma,alowb,aupb) - implicit real*8 (a-h,o-z) -c to make a normally distributed deviate with zero mean and unit variance -c - integer iset - real fac,gset,rsq,v1,v2,ran1 - save iset,gset - data iset/0/ - if(iset.eq.0) then -1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - rsq=v1**2+v2**2 - if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1 - fac=sqrt(-2.0d0*log(rsq)/rsq) - gset=v1*fac - gaussdev=v2*fac - iset=1 - else - gaussdev=gset - iset=0 - endif - anorm_distr=x+gaussdev*sigma - return - end -c------------------------------------------------------------------------ - subroutine mult_norm(lda,n,a,x,fail) -C -C Generate the vector X whose elements obey the multiple-normal distribution -C from exp(-0.5*X'AX). LDA is the leading dimension of the moment matrix A, -C n is the dimension of the problem. FAIL is set at .TRUE., if the smallest -C eigenvalue of the matrix A is close to 0. -C - implicit double precision (a-h,o-z) - double precision a(lda,n),x(n),eig(100),vec(3,3),work(100) - double precision eig_limit /1.0D-8/ - logical fail - fail=.false. -c print '(a)','Enter MULT_NORM.' -C -C Find the smallest eigenvalue of the matrix A. -C -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo -#ifdef NAG - call f02faf('V','U',2,a,lda,eig,work,100,ifail) -#else - call djacob(2,lda,10000,1.0d-10,a,vec,eig) -#endif -c print '(8f10.5)',(eig(i),i=1,n) -C print '(a)' -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo - if (eig(1).lt.eig_limit) then - print *,'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C - do i=1,n - sigma=1.0D0/dsqrt(eig(i)) - alim=-3.0D0*sigma - work(i)=anorm_distr(0.0D0,sigma,-alim,alim) - enddo -C -C Transform the vector of normal variables back to the original basis. -C - do i=1,n - xi=0.0D0 - do j=1,n - xi=xi+a(i,j)*work(j) - enddo - x(i)=xi - enddo - return - end -c------------------------------------------------------------------------ - subroutine mult_norm1(lda,n,a,z,box,x,fail) -C -C Generate the vector X whose elements obey the multi-gaussian multi-dimensional -C distribution from sum_{i=1}^m W(i)exp[-0.5*X'(i)A(i)X(i)]. LDA is the -C leading dimension of the moment matrix A, n is the dimension of the -C distribution, nlob is the number of lobes. FAIL is set at .TRUE., if the -C smallest eigenvalue of the matrix A is close to 0. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - double precision a(lda,n),z(n),x(n),box(n,n) - double precision etmp - include 'COMMON.IOUNITS' -#ifdef MP - include 'COMMON.SETUP' -#endif - logical fail -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C -cd print *,'CG Processor',me,' entered MultNorm1.' -cd print '(2(1pe14.4),3x,1pe14.4)',((a(i,j),j=1,2),z(i),i=1,2) -cd do i=1,n -cd print *,i,box(1,i),box(2,i) -cd enddo - istep = 0 - 10 istep = istep + 1 - if (istep.gt.10000) then -c write (iout,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (*,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (iout,*) 'box',box -c write (iout,*) 'a',a -c write (iout,*) 'z',z - fail=.true. - return - endif - do i=1,n - x(i)=ran_number(box(1,i),box(2,i)) - enddo - ww=0.0D0 - do i=1,n - xi=pinorm(x(i)-z(i)) - ww=ww+0.5D0*a(i,i)*xi*xi - do j=i+1,n - ww=ww+a(i,j)*xi*pinorm(x(j)-z(j)) - enddo - enddo - dec=ran_number(0.0D0,1.0D0) -c print *,(x(i),i=1,n),ww,dexp(-ww),dec -crc if (dec.gt.dexp(-ww)) goto 10 - if(-ww.lt.100) then - etmp=dexp(-ww) - else - return - endif - if (dec.gt.etmp) goto 10 -cd print *,'CG Processor',me,' exitting MultNorm1.' - return - end -c -crc-------------------------------------- - subroutine overlap_sc(scfail) -c Internal and cartesian coordinates must be consistent as input, -c and will be up-to-date on return. -c At the end of this procedure, scfail is true if there are -c overlapping residues left, or false otherwise (success) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical had_overlaps,fail,scfail - integer ioverlap(maxres),ioverlap_last - - had_overlaps=.false. - call overlap_sc_list(ioverlap,ioverlap_last) - if (ioverlap_last.gt.0) then - write (iout,*) '#OVERLAPing residues ',ioverlap_last - write (iout,'(20i4)') (ioverlap(k),k=1,ioverlap_last) - had_overlaps=.true. - endif - - maxsi=1000 - do k=1,1000 - if (ioverlap_last.eq.0) exit - - do ires=1,ioverlap_last - i=ioverlap(ires) - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) goto 999 - endif - enddo - - call chainbuild - call overlap_sc_list(ioverlap,ioverlap_last) -c write (iout,*) 'Overlaping residues ',ioverlap_last, -c & (ioverlap(j),j=1,ioverlap_last) - enddo - - if (k.le.1000.and.ioverlap_last.eq.0) then - scfail=.false. - if (had_overlaps) then - write (iout,*) '#OVERLAPing all corrected after ',k, - & ' random generation' - endif - else - scfail=.true. - write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last - write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last) - endif - - return - - 999 continue - write (iout,'(a30,i5,a12,i4)') - & '#OVERLAP FAIL in gen_side after',maxsi, - & 'iter for RES',i - scfail=.true. - return - end - - subroutine overlap_sc_list(ioverlap,ioverlap_last) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.CALC' - logical fail - integer ioverlap(maxres),ioverlap_last - data redfac /0.5D0/ - - ioverlap_last=0 -C Check for SC-SC overlaps and mark residues -c print *,'>>overlap_sc nnt=',nnt,' nct=',nct - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -c - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - if (j.gt.i+1) then - rcomp=sigmaii(itypi,itypj) - else - rcomp=sigma(itypi,itypj) - endif -c print '(2(a3,2i3),a3,2f10.5)', -c & ' i=',i,iti,' j=',j,itj,' d=',dist(nres+i,nres+j) -c & ,rcomp - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij - -ct if ( 1.0/rij .lt. redfac*rcomp .or. -ct & rij_shift.le.0.0D0 ) then - if ( rij_shift.le.0.0D0 ) then -cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)') -cd & 'overlap SC-SC: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,nres+j),' rcomp=', -cd & rcomp,1.0/rij,rij_shift - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=i - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.i) ioverlap_last=ioverlap_last-1 - enddo - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=j - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1 - enddo - endif - enddo - enddo - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/geomout.F b/source/unres/src_MD-DFA-restraints/geomout.F deleted file mode 100644 index a5c6f96..0000000 --- a/source/unres/src_MD-DFA-restraints/geomout.F +++ /dev/null @@ -1,522 +0,0 @@ - subroutine pdbout(etot,tytul,iunit) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - character*50 tytul - dimension ica(maxres) - write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot -cmodel write (iunit,'(a5,i6)') 'MODEL',1 - if (nhfrag.gt.0) then - do j=1,nhfrag - iti=itype(hfrag(1,j)) - itj=itype(hfrag(2,j)) - if (j.lt.10) then - write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - else - write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - endif - enddo - endif - - if (nbfrag.gt.0) then - - do j=1,nbfrag - - iti=itype(bfrag(1,j)) - itj=itype(bfrag(2,j)-1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') - & 'SHEET',1,'B',j,2, - & restyp(iti),bfrag(1,j)-1, - & restyp(itj),bfrag(2,j)-2,0 - - if (bfrag(3,j).gt.bfrag(4,j)) then - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)+1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itl),bfrag(4,j), - & restyp(itk),bfrag(3,j)-1,-1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - else - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)-1) - - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itk),bfrag(3,j)-1, - & restyp(itl),bfrag(4,j)-2,1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - - - endif - - enddo - endif - - if (nss.gt.0) then - do i=1,nss - if (dyn_ss) then - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',idssb(i)-nnt+1, - & 'CYS',jdssb(i)-nnt+1 - else - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, - & 'CYS',jhpb(i)-nnt+1-nres - endif - enddo - endif - - iatom=0 - do i=nnt,nct - ires=i-nnt+1 - iatom=iatom+1 - ica(i)=iatom - iti=itype(i) - write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i) - if (iti.ne.10) then - iatom=iatom+1 - write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), - & vtot(i+nres) - endif - enddo - write (iunit,'(a)') 'TER' - do i=nnt,nct-1 - if (itype(i).eq.10) then - write (iunit,30) ica(i),ica(i+1) - else - write (iunit,30) ica(i),ica(i+1),ica(i)+1 - endif - enddo - if (itype(nct).ne.10) then - write (iunit,30) ica(nct),ica(nct)+1 - endif - do i=1,nss - if (dyn_ss) then - write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 - else - write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 - endif - enddo - write (iunit,'(a6)') 'ENDMDL' - 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) - 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I5) - return - end -c------------------------------------------------------------------------------ - subroutine MOL2out(etot,tytul) -C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 -C format. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - character*32 tytul,fd - character*3 zahl - character*6 res_num,pom,ucase -#ifdef AIX - call fdate_(fd) -#elif (defined CRAY) - call date(fd) -#else - call fdate(fd) -#endif - write (imol2,'(a)') '#' - write (imol2,'(a)') - & '# Creating user name: unres' - write (imol2,'(2a)') '# Creation time: ', - & fd - write (imol2,'(/a)') '\@MOLECULE' - write (imol2,'(a)') tytul - write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 - write (imol2,'(a)') 'SMALL' - write (imol2,'(a)') 'USER_CHARGES' - write (imol2,'(a)') '\@ATOM' - do i=nnt,nct - write (zahl,'(i3)') i - pom=ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 - enddo - write (imol2,'(a)') '\@BOND' - do i=nnt,nct-1 - write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 - enddo - do i=1,nss - write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 - enddo - write (imol2,'(a)') '\@SUBSTRUCTURE' - do i=nnt,nct - write (zahl,'(i3)') i - pom = ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 - enddo - 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') - 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') - return - end -c------------------------------------------------------------------------ - subroutine intout - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - write (iout,'(/a)') 'Geometry of the virtual chain.' - write (iout,'(7a)') ' Res ',' d',' Theta', - & ' Gamma',' Dsc',' Alpha',' Beta ' - do i=1,nres - iti=itype(i) - write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), - & rad2deg*omeg(i) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine briefout(it,ener) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' -c print '(a,i5)',intname,igeom -#if defined(AIX) || defined(PGI) - open (igeom,file=intname,position='append') -#else - open (igeom,file=intname,access='append') -#endif - IF (NSS.LE.9) THEN - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) - ELSE - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) - WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) - ENDIF -c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) -c if (nvar.gt.nphi+ntheta) then - write (igeom,200) (rad2deg*alph(i),i=2,nres-1) - write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) -c endif - close(igeom) - 180 format (I5,F12.3,I2,9(1X,2I3)) - 190 format (3X,11(1X,2I3)) - 200 format (8F10.4) - return - end -#ifdef WINIFL - subroutine fdate(fd) - character*32 fd - write(fd,'(32x)') - return - end -#endif -c---------------------------------------------------------------- -#ifdef NOXDR - subroutine cartout(time) -#else - subroutine cartoutx(time) -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time -#if defined(AIX) || defined(PGI) - open(icart,file=cartname,position="append") -#else - open(icart,file=cartname,access="append") -#endif - write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - if (dyn_ss) then - write (icart,'(i4,$)') - & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) - else - write (icart,'(i4,$)') - & nss,(ihpb(j),jhpb(j),j=1,nss) - endif - write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, - & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write (icart,'(8f10.5)') - & ((c(k,j),k=1,3),j=1,nres), - & ((c(k,j+nres),k=1,3),j=nnt,nct) - close(icart) - return - end -c----------------------------------------------------------------- -#ifndef NOXDR - subroutine cartout(time) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#else - parameter (me=0) -#endif - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time - integer iret,itmp - real xcoord(3,maxres2+2),prec - -#ifdef AIX - call xdrfopen_(ixdrf,cartname, "a", iret) - call xdrffloat_(ixdrf, real(time), iret) - call xdrffloat_(ixdrf, real(potE), iret) - call xdrffloat_(ixdrf, real(uconst), iret) - call xdrffloat_(ixdrf, real(uconst_back), iret) - call xdrffloat_(ixdrf, real(t_bath), iret) - call xdrfint_(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint_(ixdrf, idssb(j)+nres, iret) - call xdrfint_(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat_(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat_(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat_(ixdrf, real(utheta(i)), iret) - call xdrffloat_(ixdrf, real(ugamma(i)), iret) - call xdrffloat_(ixdrf, real(uscdiff(i)), iret) - enddo -#else - call xdrfopen(ixdrf,cartname, "a", iret) - call xdrffloat(ixdrf, real(time), iret) - call xdrffloat(ixdrf, real(potE), iret) - call xdrffloat(ixdrf, real(uconst), iret) - call xdrffloat(ixdrf, real(uconst_back), iret) - call xdrffloat(ixdrf, real(t_bath), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, real(utheta(i)), iret) - call xdrffloat(ixdrf, real(ugamma(i)), iret) - call xdrffloat(ixdrf, real(uscdiff(i)), iret) - enddo -#endif - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=c(j,i) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=c(j,i+nres) - enddo - enddo - - itmp=nres+nct-nnt+1 -#ifdef AIX - call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose_(ixdrf, iret) -#else - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose(ixdrf, iret) -#endif - return - end -#endif -c----------------------------------------------------------------- - subroutine statout(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - integer itime - double precision energia(0:n_ene) - double precision gyrate - external gyrate - common /gucio/ cm - character*256 line1,line2 - character*4 format1,format2 - character*30 format -#ifdef AIX - if(itime.eq.0) then - open(istat,file=statname,position="append") - endif -#else -#ifdef PGI - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif -#endif - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.false.) - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a145" - else - write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a133" - endif - else - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a126" - else - write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a114" - endif - endif - if(usampl.and.totT.gt.eq_time) then - write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, - & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair - & +21*nfrag_back - elseif(hremd.gt.0) then - write(line2,'(i5)') iset - format2="a005" - else - format2="a001" - line2=' ' - endif - if (print_compon) then - if(itime.eq.0) then - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",100a12)" - write (istat,format) "#","", - & (ename(print_order(i)),i=1,nprint_ene) - endif - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",100f12.3)" - write (istat,format) line1,line2, - & (potEcomp(print_order(i)),i=1,nprint_ene) - else - write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" - write (istat,format) line1,line2 - endif -#if defined(AIX) - call flush(istat) -#else - close(istat) -#endif - return - end -c--------------------------------------------------------------- - double precision function gyrate() - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision cen(3),rg - - do j=1,3 - cen(j)=0.0d0 - enddo - - do i=nnt,nct - do j=1,3 - cen(j)=cen(j)+c(j,i) - enddo - enddo - do j=1,3 - cen(j)=cen(j)/dble(nct-nnt+1) - enddo - rg = 0.0d0 - do i = nnt, nct - do j=1,3 - rg = rg + (c(j,i)-cen(j))**2 - enddo - end do - gyrate = sqrt(rg/dble(nct-nnt+1)) - return - end - diff --git a/source/unres/src_MD-DFA-restraints/gnmr1.f b/source/unres/src_MD-DFA-restraints/gnmr1.f deleted file mode 100644 index 905e746..0000000 --- a/source/unres/src_MD-DFA-restraints/gnmr1.f +++ /dev/null @@ -1,43 +0,0 @@ - double precision function gnmr1(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1=(ymin-y)**wykl/wykl - else if (y.gt.ymax) then - gnmr1=(y-ymax)**wykl/wykl - else - gnmr1=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function gnmr1prim(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1prim=-(ymin-y)**(wykl-1) - else if (y.gt.ymax) then - gnmr1prim=(y-ymax)**(wykl-1) - else - gnmr1prim=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function harmonic(y,ymax) - implicit none - double precision y,ymax - double precision wykl /2.0d0/ - harmonic=(y-ymax)**wykl - return - end -c------------------------------------------------------------------------------- - double precision function harmonicprim(y,ymax) - double precision y,ymin,ymax - double precision wykl /2.0d0/ - harmonicprim=(y-ymax)*wykl - return - end -c--------------------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/gradient_p.F b/source/unres/src_MD-DFA-restraints/gradient_p.F deleted file mode 100644 index 7fec1e8..0000000 --- a/source/unres/src_MD-DFA-restraints/gradient_p.F +++ /dev/null @@ -1,421 +0,0 @@ - subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c This subroutine calculates total internal coordinate gradient. -c Depending on the number of function evaluations, either whole energy -c is evaluated beforehand, Cartesian coordinates and their derivatives in -c internal coordinates are reevaluated or only the cartesian-in-internal -c coordinate derivatives are evaluated. The subroutine was designed to work -c with SUMSL. -c -c - icg=mod(nf,2)+1 - -cd print *,'grad',nf,icg - if (nf-nfl+1) 20,30,40 - 20 call func(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom(n,x) - call chainbuild -c write (iout,*) 'grad 30' -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -c write (iout,*) 'grad 40' -c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - ind=0 - ind1=0 - do i=1,nres-2 - gthetai=0.0D0 - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 -c ind=indmat(i,j) -c print *,'GRAD: i=',i,' jc=',j,' ind=',ind - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - enddo - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - enddo - enddo - do j=i+1,nres-1 - ind1=ind1+1 -c ind1=indmat(i,j) -c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 - do k=1,3 - gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) - gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) - enddo - enddo - if (i.gt.1) g(i-1)=gphii - if (n.gt.nphi) g(nphi+i)=gthetai - enddo - if (n.le.nphi+ntheta) goto 10 - do i=2,nres-1 - if (itype(i).ne.10) then - galphai=0.0D0 - gomegai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ialph(i,1))=galphai - g(ialph(i,1)+nside)=gomegai - endif - enddo -C -C Add the components corresponding to local energy terms. -C - 10 continue - do i=1,nvar -cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg) - g(i)=g(i)+gloc(i,icg) - enddo -C Uncomment following three lines for diagnostics. -cd call intout -cd call briefout(0,0.0d0) -cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n) - return - end -C------------------------------------------------------------------------- - subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 continue -#ifdef OSF -c Intercept NaNs in the coordinates -c write(iout,*) (var(i),i=1,nvar) - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - if (x_sum.ne.x_sum) then - write(iout,*)" *** grad_restr : Found NaN in coordinates" - call flush(iout) - print *," *** grad_restr : Found NaN in coordinates" - return - endif -#endif - call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C------------------------------------------------------------------------- - subroutine cartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SCCOR' -c -c This subrouting calculates total Cartesian coordinate gradient. -c The subroutine chainbuild_cart and energy MUST be called beforehand. -c -c do i=1,nres -c write (iout,*) "przed sum_grad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - -#ifdef TIMING - time00=MPI_Wtime() -#endif - icg=1 - call sum_gradient -#ifdef TIMING -#endif -c do i=1,nres -c write (iout,*) "checkgrad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo -cd write (iout,*) "After sum_gradient" -cd do i=1,nres-1 -cd write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) -cd write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) -cd enddo -c If performing constraint dynamics, add the gradients of the constraint energy - if(usampl.and.totT.gt.eq_time) then - do i=1,nct - do j=1,3 - gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i) - gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i) - enddo - enddo - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+dugamma(i) - enddo - do i=1,nres-2 - gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) - enddo - endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - call intcartderiv -#ifdef TIMING - time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 -#endif -cd call checkintcartgrad -cd write(iout,*) 'calling int_to_cart' -cd write (iout,*) "gcart, gxcart, gloc before int_to_cart" - do i=1,nct - do j=1,3 - gcart(j,i)=gradc(j,i,icg) - gxcart(j,i)=gradx(j,i,icg) - enddo -cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3),gloc(i,icg) - enddo -#ifdef TIMING - time01=MPI_Wtime() -#endif - call int_to_cart -#ifdef TIMING - time_inttocart=time_inttocart+MPI_Wtime()-time01 -#endif -cd write (iout,*) "gcart and gxcart after int_to_cart" -cd do i=0,nres-1 -cd write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3) -cd enddo -#ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 -#endif - return - end -C------------------------------------------------------------------------- - subroutine zerograd - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.SCCOR' -C -C Initialize Cartesian-coordinate gradient -C - do i=1,nres - do j=1,3 - gvdwx(j,i)=0.0D0 - gvdwxT(j,i)=0.0D0 - gradx_scp(j,i)=0.0D0 - gvdwc(j,i)=0.0D0 - gvdwcT(j,i)=0.0D0 - gvdwc_scp(j,i)=0.0D0 - gvdwc_scpp(j,i)=0.0d0 - gelc (j,i)=0.0D0 - gelc_long(j,i)=0.0D0 - gradb(j,i)=0.0d0 - gradbx(j,i)=0.0d0 - gvdwpp(j,i)=0.0d0 - gel_loc(j,i)=0.0d0 - gel_loc_long(j,i)=0.0d0 - ghpbc(j,i)=0.0D0 - ghpbx(j,i)=0.0D0 - gcorr3_turn(j,i)=0.0d0 - gcorr4_turn(j,i)=0.0d0 - gradcorr(j,i)=0.0d0 - gradcorr_long(j,i)=0.0d0 - gradcorr5_long(j,i)=0.0d0 - gradcorr6_long(j,i)=0.0d0 - gcorr6_turn_long(j,i)=0.0d0 - gradcorr5(j,i)=0.0d0 - gradcorr6(j,i)=0.0d0 - gcorr6_turn(j,i)=0.0d0 - gsccorc(j,i)=0.0d0 - gsccorx(j,i)=0.0d0 - gradc(j,i,icg)=0.0d0 - gradx(j,i,icg)=0.0d0 - gscloc(j,i)=0.0d0 - gsclocx(j,i)=0.0d0 - do intertyp=1,3 - gloc_sc(intertyp,i,icg)=0.0d0 - enddo - enddo - enddo -C -C Initialize the gradient of local energy terms. -C - do i=1,4*nres - gloc(i,icg)=0.0D0 - enddo - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - g_corr5_loc(i)=0.0d0 - g_corr6_loc(i)=0.0d0 - gel_loc_turn3(i)=0.0d0 - gel_loc_turn4(i)=0.0d0 - gel_loc_turn6(i)=0.0d0 - gsccor_loc(i)=0.0d0 - enddo -c initialize gcart and gxcart - do i=0,nres - do j=1,3 - gcart(j,i)=0.0d0 - gxcart(j,i)=0.0d0 - enddo - enddo - return - end -c------------------------------------------------------------------------- - double precision function fdum() - fdum=0.0D0 - return - end diff --git a/source/unres/src_MD-DFA-restraints/initialize_p.F b/source/unres/src_MD-DFA-restraints/initialize_p.F deleted file mode 100644 index d02ebd1..0000000 --- a/source/unres/src_MD-DFA-restraints/initialize_p.F +++ /dev/null @@ -1,1439 +0,0 @@ - block data - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MD' - data MovTypID - & /'pool','chain regrow','multi-bond','phi','theta','side chain', - & 'total'/ -c Conversion from poises to molecular unit and the gas constant - data cPoise /2.9361d0/, Rb /0.001986d0/ - end -c-------------------------------------------------------------------------- - subroutine initialize -C -C Define constants and zero out tables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MCM' - include 'COMMON.MINIM' - include 'COMMON.DERIV' - include 'COMMON.SPLITELE' -c Common blocks from the diagonalization routines - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - logical mask_r -c real*8 text1 /'initial_i'/ - - mask_r=.false. -#ifndef ISNAN -c NaNQ initialization - i=-1 - arg=100.0d0 - rr=dacos(arg) -#ifdef WINPGI - idumm=proc_proc(rr,i) -#else - call proc_proc(rr,i) -#endif -#endif - - kdiag=0 - icorfl=0 - iw=2 -C -C The following is just to define auxiliary variables used in angle conversion -C - pi=4.0D0*datan(1.0D0) - dwapi=2.0D0*pi - dwapi3=dwapi/3.0D0 - pipol=0.5D0*pi - deg2rad=pi/180.0D0 - rad2deg=1.0D0/deg2rad - angmin=10.0D0*deg2rad -C -C Define I/O units. -C - inp= 1 - iout= 2 - ipdbin= 3 - ipdb= 7 - icart = 30 - imol2= 4 - igeom= 8 - intin= 9 - ithep= 11 - ithep_pdb=51 - irotam=12 - irotam_pdb=52 - itorp= 13 - itordp= 23 - ielep= 14 - isidep=15 - iscpp=25 - icbase=16 - ifourier=20 - istat= 17 - irest1=55 - irest2=56 - iifrag=57 - ientin=18 - ientout=19 - ibond = 28 - isccor = 29 -crc for write_rmsbank1 - izs1=21 -cdr include secondary structure prediction bias - isecpred=27 -C -C CSA I/O units (separated from others especially for Jooyoung) -C - icsa_rbank=30 - icsa_seed=31 - icsa_history=32 - icsa_bank=33 - icsa_bank1=34 - icsa_alpha=35 - icsa_alpha1=36 - icsa_bankt=37 - icsa_int=39 - icsa_bank_reminimized=38 - icsa_native_int=41 - icsa_in=40 -crc for ifc error 118 - icsa_pdb=42 -C -C Set default weights of the energy terms. -C - wlong=1.0D0 - welec=1.0D0 - wtor =1.0D0 - wang =1.0D0 - wscloc=1.0D0 - wstrain=1.0D0 -C -C Zero out tables. -C - print '(a,$)','Inside initialize' -c call memmon_print_usage() - do i=1,maxres2 - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 - enddo - enddo - do i=1,maxres - do j=1,3 - xloc(j,i)=0.0D0 - enddo - enddo - do i=1,ntyp - do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - augm(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 - chi(i,j)=0.0D0 - enddo - do j=1,2 - bad(i,j)=0.0D0 - enddo - chip(i)=0.0D0 - alp(i)=0.0D0 - sigma0(i)=0.0D0 - sigii(i)=0.0D0 - rr0(i)=0.0D0 - a0thet(i)=0.0D0 - do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 - enddo - do j=0,3 - polthet(j,i)=0.0D0 - enddo - do j=1,3 - gthet(j,i)=0.0D0 - enddo - theta0(i)=0.0D0 - sig0(i)=0.0D0 - sigc0(i)=0.0D0 - do j=1,maxlob - bsc(j,i)=0.0D0 - do k=1,3 - censc(k,j,i)=0.0D0 - enddo - do k=1,3 - do l=1,3 - gaussc(l,k,j,i)=0.0D0 - enddo - enddo - nlob(i)=0 - enddo - enddo - nlob(ntyp1)=0 - dsc(ntyp1)=0.0D0 - do i=1,maxtor - itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 - enddo - enddo - enddo - do i=1,maxres - itype(i)=0 - itel(i)=0 - enddo -C Initialize the bridge arrays - ns=0 - nss=0 - nhpb=0 - do i=1,maxss - iss(i)=0 - enddo - do i=1,maxdim - dhpb(i)=0.0D0 - enddo - do i=1,maxres - ihpb(i)=0 - jhpb(i)=0 - enddo -C -C Initialize timing. -C - call set_timers -C -C Initialize variables used in minimization. -C -c maxfun=5000 -c maxit=2000 - maxfun=500 - maxit=200 - tolf=1.0D-2 - rtolf=5.0D-4 -C -C Initialize the variables responsible for the mode of gradient storage. -C - nfl=0 - icg=1 -C -C Initialize constants used to split the energy into long- and short-range -C components -C - r_cut=2.0d0 - rlamb=0.3d0 -#ifndef SPLITELE - nprint_ene=nprint_ene-1 -#endif - return - end -c------------------------------------------------------------------------- - block data nazwy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - data restyp / - &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ - data onelet / - &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ - data potname /'LJ','LJK','BP','GB','GBV'/ - data ename / - & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", - & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", - & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", - & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ", - & "Ehomology","DFA DIS","DFA TOR","DFA NEI","DFA BET"/ - data wname / - & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", - & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR", - & " "," ","EHOMO","WDFAD","WDFAT","WDFAN","WDFAB"/ - data nprint_ene /25/ - data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, - & 21,24,25,26,27,28,0,0,0/ - end -c--------------------------------------------------------------------------- - subroutine init_int_table - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer blocklengths(15),displs(15) -#endif - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.SBRIDGE' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1), - & ntask_cont_from_all(0:max_fg_procs-1), - & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), - & ntask_cont_to_all(0:max_fg_procs-1), - & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) - integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP - logical scheck,lprint,flag -#ifdef MPI - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - do i=0,nfgtasks-1 - itask_cont_from(i)=fg_rank - itask_cont_to(i)=fg_rank - enddo - lprint=.false. - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif -c lprint=.false. - do i=1,maxres - nint_gr(i)=0 - nscp_gr(i)=0 - do j=1,maxint_gr - istart(i,1)=0 - iend(i,1)=0 - ielstart(i)=0 - ielend(i)=0 - iscpstart(i,1)=0 - iscpend(i,1)=0 - enddo - enddo - ind_scint=0 - ind_scint_old=0 -cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', -cd & (ihpb(i),jhpb(i),i=1,nss) - do i=nnt,nct-1 - scheck=.false. - if (dyn_ss) goto 10 - do ii=1,nss - if (ihpb(ii).eq.i+nres) then - scheck=.true. - jj=jhpb(ii)-nres - goto 10 - endif - enddo - 10 continue -cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj - if (scheck) then - if (jj.eq.i+1) then -#ifdef MPI -c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+2 - iend(i,1)=nct -#endif - else if (jj.eq.nct) then -#ifdef MPI -c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct-1 -#endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else - nint_gr(i)=2 - istart(i,1)=i+1 - iend(i,1)=jj-1 - istart(i,2)=jj+1 - iend(i,2)=nct -#endif - endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct - ind_scint=ind_scint+nct-i -#endif - endif -#ifdef MPI - ind_scint_old=ind_scint -#endif - enddo - 12 continue -#ifndef MPI - iatsc_s=nnt - iatsc_e=nct-1 -#endif -#ifdef MPI - if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor, - & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e -#endif - if (lprint) then - write (iout,'(a)') 'Interaction array:' - do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') - & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) - enddo - endif - ispp=4 -#ifdef MPI -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue - if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 -c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) -c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, -c & " my_ele_inde_vdw",my_ele_inde_vdw - ind_eleint_vdw=0 - ind_eleint_vdw_old=0 - iatel_s_vdw=0 - iatel_e_vdw=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, - & my_ele_inde_vdw,i, - & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), - & ielend_vdw(i),*15) -c write (iout,*) i," ielstart_vdw",ielstart_vdw(i), -c & " ielend_vdw",ielend_vdw(i) - enddo ! i - if (iatel_s_vdw.eq.0) iatel_s_vdw=1 - 15 continue -#else - iatel_s=nnt - iatel_e=nct-5 - do i=iatel_s,iatel_e - ielstart(i)=i+4 - ielend(i)=nct-1 - enddo - iatel_s_vdw=nnt - iatel_e_vdw=nct-3 - do i=iatel_s_vdw,iatel_e_vdw - ielstart_vdw(i)=i+2 - ielend_vdw(i)=nct-1 - enddo -#endif - if (lprint) then - write (*,'(a)') 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank - write (iout,*) 'Electrostatic interaction array:' - do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) - enddo - endif ! lprint -c iscp=3 - iscp=2 -C Partition the SC-p interaction array -#ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else - iatscp_s=nnt - iatscp_e=nct-1 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=i+iscp - iscpend(i,1)=nct - elseif (i.gt.nct-iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - else - nscp_gr(i)=2 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - iscpstart(i,2)=i+iscp - iscpend(i,2)=nct - endif - enddo ! i -#endif - if (lprint) then - write (iout,'(a)') 'SC-p interaction array:' - do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') - & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) - enddo - endif ! lprint -C Partition local interactions -#ifdef MPI - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iturn3_start,iturn3_end) - iturn3_start=iturn3_start+nnt - iphi_start=iturn3_start+2 - iturn3_end=iturn3_end+nnt - iphi_end=iturn3_end+2 - iturn3_start=iturn3_start-1 - iturn3_end=iturn3_end-1 - call int_bounds(nres-3,itau_start,itau_end) - itau_start=itau_start+3 - itau_end=itau_end+3 - call int_bounds(nres-3,iphi1_start,iphi1_end) - iphi1_start=iphi1_start+3 - iphi1_end=iphi1_end+3 - call int_bounds(nct-nnt-3,iturn4_start,iturn4_end) - iturn4_start=iturn4_start+nnt - iphid_start=iturn4_start+2 - iturn4_end=iturn4_end+nnt - iphid_end=iturn4_end+2 - iturn4_start=iturn4_start-1 - iturn4_end=iturn4_end-1 - call int_bounds(nres-2,ibond_start,ibond_end) - ibond_start=ibond_start+1 - ibond_end=ibond_end+1 - call int_bounds(nct-nnt,ibondp_start,ibondp_end) - ibondp_start=ibondp_start+nnt - ibondp_end=ibondp_end+nnt - call int_bounds1(nres-1,ivec_start,ivec_end) - print *,"Processor",myrank,fg_rank,fg_rank1, - & " ivec_start",ivec_start," ivec_end",ivec_end - iset_start=loc_start+2 - iset_end=loc_end+2 - if (ndih_constr.eq.0) then - idihconstr_start=1 - idihconstr_end=0 - else - call int_bounds(ndih_constr,idihconstr_start,idihconstr_end) - endif - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo - if (lprint) then - write (*,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end, - & ' iphid_start',iphid_start,' iphid_end',iphid_end, - & ' ibond_start',ibond_start,' ibond_end',ibond_end, - & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end, - & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end, - & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end, - & ' ivec_start',ivec_start,' ivec_end',ivec_end, - & ' iset_start',iset_start,' iset_end',iset_end, - & ' idihconstr_start',idihconstr_start,' idihconstr_end', - & idihconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo - endif - if (nfgtasks.gt.1) then - call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - iaux=ivec_end-ivec_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iset_end-iset_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ibond_end-ibond_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ithet_end-ithet_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi_end-iphi_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi1_end-iphi1_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - do i=0,maxprocs-1 - do j=1,maxres - ielstart_all(j,i)=0 - ielend_all(j,i)=0 - enddo - enddo - call MPI_Allgather(iturn3_start,1,MPI_INTEGER, - & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_start,1,MPI_INTEGER, - & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn3_end,1,MPI_INTEGER, - & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_end,1,MPI_INTEGER, - & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_s,1,MPI_INTEGER, - & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_e,1,MPI_INTEGER, - & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER, - & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielend(1),maxres,MPI_INTEGER, - & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - if (lprint) then - write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks) - write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks) - write (iout,*) "iturn3_start_all", - & (iturn3_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn3_end_all", - & (iturn3_end_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_start_all", - & (iturn4_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_end_all", - & (iturn4_end_all(i),i=0,nfgtasks-1) - write (iout,*) "The ielstart_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1) - enddo - write (iout,*) "The ielend_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1) - enddo - call flush(iout) - endif - ntask_cont_from=0 - ntask_cont_to=0 - itask_cont_from(0)=fg_rank - itask_cont_to(0)=fg_rank - flag=.false. - do ii=iturn3_start,iturn3_end - call add_int(ii,ii+2,iturn3_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn4_start,iturn4_end - call add_int(ii,ii+3,iturn4_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn3_start,iturn3_end - call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from) - enddo - do ii=iturn4_start,iturn4_end - call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from) - enddo - if (lprint) then - write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - endif -c write (iout,*) "Loop forward" -c call flush(iout) - do i=iatel_s,iatel_e -c write (iout,*) "from loop i=",i -c call flush(iout) - do j=ielstart(i),ielend(i) - call add_int_from(i,j,ntask_cont_from,itask_cont_from) - enddo - enddo -c write (iout,*) "Loop backward iatel_e-1",iatel_e-1, -c & " iatel_e",iatel_e -c call flush(iout) - nat_sent=0 - do i=iatel_s,iatel_e -c write (iout,*) "i",i," ielstart",ielstart(i), -c & " ielend",ielend(i) -c call flush(iout) - flag=.false. - do j=ielstart(i),ielend(i) - call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to, - & itask_cont_to,flag) - enddo - if (flag) then - nat_sent=nat_sent+1 - iat_sent(nat_sent)=i - endif - enddo - if (lprint) then - write (iout,*)"After longrange ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - write (iout,*) "iint_sent" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - enddo - write (iout,*) "iturn3_sent iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Gather(ntask_cont_from,1,MPI_INTEGER, - & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_from ended" -c call flush(iout) - call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER, - & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king, - & FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_from ended" -c call flush(iout) - call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all, - & 1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_to ended" -c call flush(iout) - call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER, - & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_to ended" -c call flush(iout) - if (fg_rank.eq.king) then - write (iout,*)"Contact receive task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_from_all(i), - & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i)) - enddo - write (iout,*) - call flush(iout) - write (iout,*) "Contact send task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_to_all(i), - & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i)) - enddo - write (iout,*) - call flush(iout) -C Check if every send will have a matching receive - ncheck_to=0 - ncheck_from=0 - do i=0,nfgtasks-1 - ncheck_to=ncheck_to+ntask_cont_to_all(i) - ncheck_from=ncheck_from+ntask_cont_from_all(i) - enddo - write (iout,*) "Control sums",ncheck_from,ncheck_to - if (ncheck_from.ne.ncheck_to) then - write (iout,*) "Error: #receive differs from #send." - write (iout,*) "Terminating program...!" - call flush(iout) - flag=.false. - else - flag=.true. - do i=0,nfgtasks-1 - do j=1,ntask_cont_to_all(i) - ii=itask_cont_to_all(j,i) - do k=1,ntask_cont_from_all(ii) - if (itask_cont_from_all(k,ii).eq.i) then - if(lprint)write(iout,*)"Matching send/receive",i,ii - exit - endif - enddo - if (k.eq.ntask_cont_from_all(ii)+1) then - flag=.false. - write (iout,*) "Error: send by",j," to",ii, - & " would have no matching receive" - endif - enddo - enddo - endif - if (.not.flag) then - write (iout,*) "Unmatched sends; terminating program" - call flush(iout) - endif - endif - call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR) -c write (iout,*) "flag broadcast ended flag=",flag -c call flush(iout) - if (.not.flag) then - call MPI_Finalize(IERROR) - stop "Error in INIT_INT_TABLE: unmatched send/receive." - endif - call MPI_Comm_group(FG_COMM,fg_group,IERR) -c write (iout,*) "MPI_Comm_group ended" -c call flush(iout) - call MPI_Group_incl(fg_group,ntask_cont_from+1, - & itask_cont_from(0),CONT_FROM_GROUP,IERR) - call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0), - & CONT_TO_GROUP,IERR) - do i=1,nat_sent - ii=iat_sent(i) - iaux=4*(ielend(ii)-ielstart(ii)+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP, - & iint_sent_local(1,ielstart(ii),i),IERR ) -c write (iout,*) "Ranks translated i=",i -c call flush(iout) - enddo - iaux=4*(iturn3_end-iturn3_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn3_sent(1,iturn3_start),CONT_TO_GROUP, - & iturn3_sent_local(1,iturn3_start),IERR) - iaux=4*(iturn4_end-iturn4_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn4_sent(1,iturn4_start),CONT_TO_GROUP, - & iturn4_sent_local(1,iturn4_start),IERR) - if (lprint) then - write (iout,*) "iint_sent_local" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - call flush(iout) - enddo - write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Group_free(fg_group,ierr) - call MPI_Group_free(cont_from_group,ierr) - call MPI_Group_free(cont_to_group,ierr) - call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR) - call MPI_Type_commit(MPI_UYZ,IERROR) - call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD, - & IERROR) - call MPI_Type_commit(MPI_UYZGRAD,IERROR) - call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR) - call MPI_Type_commit(MPI_MU,IERROR) - call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR) - call MPI_Type_commit(MPI_MAT1,IERROR) - call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR) - call MPI_Type_commit(MPI_MAT2,IERROR) - call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR) - call MPI_Type_commit(MPI_THET,IERROR) - call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR) - call MPI_Type_commit(MPI_GAM,IERROR) -#ifndef MATGATHER -c 9/22/08 Derived types to send matrices which appear in correlation terms - do i=0,nfgtasks-1 - if (ivec_count(i).eq.ivec_count(0)) then - lentyp(i)=0 - else - lentyp(i)=1 - endif - enddo - do ind_typ=lentyp(0),lentyp(nfgtasks-1) - if (ind_typ.eq.0) then - ichunk=ivec_count(0) - else - ichunk=ivec_count(1) - endif -c do i=1,4 -c blocklengths(i)=4 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1 -c do i=1,4 -c blocklengths(i)=2 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 - do i=1,8 - blocklengths(i)=2 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR) - do i=1,8 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR) - do i=1,6 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,6 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,6 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(6,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR) - do i=1,2 - blocklengths(i)=8 - enddo - displs(1)=0 - do i=2,2 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,2 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(2,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR) - do i=1,4 - blocklengths(i)=1 - enddo - displs(1)=0 - do i=2,4 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,4 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(4,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR) - call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR) - enddo -#endif - endif - iint_start=ivec_start+1 - iint_end=ivec_end+1 - do i=0,nfgtasks-1 - iint_count(i)=ivec_count(i) - iint_displ(i)=ivec_displ(i) - ivec_displ(i)=ivec_displ(i)-1 - iset_displ(i)=iset_displ(i)-1 - ithet_displ(i)=ithet_displ(i)-1 - iphi_displ(i)=iphi_displ(i)-1 - iphi1_displ(i)=iphi1_displ(i)-1 - ibond_displ(i)=ibond_displ(i)-1 - enddo - if (nfgtasks.gt.1 .and. fg_rank.eq.king - & .and. (me.eq.0 .or. out1file)) then - write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT" - do i=0,nfgtasks-1 - write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i), - & iset_count(i) - enddo - write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end, - & " iphi1_start",iphi1_start," iphi1_end",iphi1_end - write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL" - do i=0,nfgtasks-1 - write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i), - & iphi1_displ(i) - enddo - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',nfgtasks, - & ' fine-grain processors.' - endif -#else - loc_start=2 - loc_end=nres-1 - ithet_start=3 - ithet_end=nres - iturn3_start=nnt - iturn3_end=nct-3 - iturn4_start=nnt - iturn4_end=nct-4 - iphi_start=nnt+3 - iphi_end=nct - iphi1_start=4 - iphi1_end=nres - idihconstr_start=1 - idihconstr_end=ndih_constr - iphid_start=iphi_start - iphid_end=iphi_end-1 - itau_start=4 - itau_end=nres - ibond_start=2 - ibond_end=nres-1 - ibondp_start=nnt+1 - ibondp_end=nct - ivec_start=1 - ivec_end=nres-1 - iset_start=3 - iset_end=nres+1 - iint_start=2 - iint_end=nres-1 -#endif - return - end -#ifdef MPI -c--------------------------------------------------------------------------- - subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(4), - & ntask_cont_to,itask_cont_to(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,isent,k,l -c Determines whether to send interaction ii,jj to other processors; a given -c interaction can be sent to at most 2 processors. -c Sets flag=.true. if interaction ii,jj needs to be sent to at least -c one processor, otherwise flag is unchanged from the input value. - isent=0 - itask(1)=fg_rank - itask(2)=fg_rank - itask(3)=fg_rank - itask(4)=fg_rank -c write (iout,*) "ii",ii," jj",jj -c Loop over processors to check if anybody could need interaction ii,jj - do iproc=0,fg_rank-1 -c Check if the interaction matches any turn3 at iproc - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo -C Check if the interaction matches any turn4 at iproc - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and. - & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then - if (ielstart_all(ii-1,iproc).le.jj-1.and. - & ielend_all(ii-1,iproc).ge.jj-1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - if (ielstart_all(ii-1,iproc).le.jj+1.and. - & ielend_all(ii-1,iproc).ge.jj+1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,k,l - do iproc=fg_rank+1,nfgtasks-1 - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then - if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc)) - & then - if (jj+1.ge.ielstart_all(ii+1,iproc).and. - & jj+1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj-1.ge.ielstart_all(ii+1,iproc).and. - & jj-1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc)) - & then - if (jj-1.ge.ielstart_all(ii-1,iproc).and. - & jj-1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj+1.ge.ielstart_all(ii-1,iproc).and. - & jj+1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_task(iproc,ntask_cont,itask_cont) - implicit none - include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) - integer ii - do ii=1,ntask_cont - if (itask_cont(ii).eq.iproc) return - enddo - ntask_cont=ntask_cont+1 - itask_cont(ntask_cont)=iproc - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks - do i=1,nfgtasks - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks - do i=1,nexcess - int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds1(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks1 - do i=1,nfgtasks1 - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks1 - do i=1,nexcess - int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank1-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank1) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_partition(int_index,lower_index,upper_index,atom, - & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer int_index,lower_index,upper_index,atom,at_start,at_end, - & first_atom,last_atom,int_gr,jat_start,jat_end - logical lprn - lprn=.false. - if (lprn) write (iout,*) 'int_index=',int_index - int_index_old=int_index - int_index=int_index+last_atom-first_atom+1 - if (lprn) - & write (iout,*) 'int_index=',int_index, - & ' int_index_old',int_index_old, - & ' lower_index=',lower_index, - & ' upper_index=',upper_index, - & ' atom=',atom,' first_atom=',first_atom, - & ' last_atom=',last_atom - if (int_index.ge.lower_index) then - int_gr=int_gr+1 - if (at_start.eq.0) then - at_start=atom - jat_start=first_atom-1+lower_index-int_index_old - else - jat_start=first_atom - endif - if (lprn) write (iout,*) 'jat_start',jat_start - if (int_index.ge.upper_index) then - at_end=atom - jat_end=first_atom-1+upper_index-int_index_old - return1 - else - jat_end=last_atom - endif - if (lprn) write (iout,*) 'jat_end',jat_end - endif - return - end -#endif -c------------------------------------------------------------------------------ - subroutine hpb_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' -c write(2,*)"hpb_partition: nhpb=",nhpb -#ifdef MPI - call int_bounds(nhpb,link_start,link_end) - if (.not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nhpb',nhpb,' link_start=',link_start, - & ' link_end',link_end -#else - link_start=1 - link_end=nhpb -#endif -c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end - return - end -c------------------------------------------------------------------------------ - subroutine homology_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.INTERACT' - write(iout,*)"homology_partition: lim_odl=",lim_odl, - & " lim_dih",lim_dih -#ifdef MPI - write (iout,*) "MPI" - call int_bounds(lim_odl,link_start_homo,link_end_homo) - call int_bounds(lim_dih-nnt+1,idihconstr_start_homo, - & idihconstr_end_homo) - idihconstr_start_homo=idihconstr_start_homo+nnt-1 - idihconstr_end_homo=idihconstr_end_homo+nnt-1 - if (me.eq.king .or. .not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' lim_odl',lim_odl,' link_start=',link_start_homo, - & ' link_end',link_end_homo,' lim_dih',lim_dih, - & ' idihconstr_start_homo',idihconstr_start_homo, - & ' idihconstr_end_homo',idihconstr_end_homo -#else - write (iout,*) "Not MPI" - link_start_homo=1 - link_end_homo=lim_odl - idihconstr_start_homo=nnt - idihconstr_end_homo=lim_dih - write (iout,*) - & ' lim_odl',lim_odl,' link_start=',link_start_homo, - & ' link_end',link_end_homo,' lim_dih',lim_dih, - & ' idihconstr_start_homo',idihconstr_start_homo, - & ' idihconstr_end_homo',idihconstr_end_homo -#endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/int_to_cart.f b/source/unres/src_MD-DFA-restraints/int_to_cart.f deleted file mode 100644 index 73e8384..0000000 --- a/source/unres/src_MD-DFA-restraints/int_to_cart.f +++ /dev/null @@ -1,278 +0,0 @@ - subroutine int_to_cart -c-------------------------------------------------------------- -c This subroutine converts the energy derivatives from internal -c coordinates to cartesian coordinates -c------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' -c calculating dE/ddc1 - if (nres.lt.3) goto 18 -c do i=1,nres -c c do intertyp=1,3 -c write (iout,*) "przed tosyjnymi",i,intertyp,gcart(intertyp,i) -c &,gloc_sc(1,i,icg),gloc(i,icg) -c enddo -c enddo - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) - & +gloc(nres-2,icg)*dtheta(j,1,3) - if(itype(2).ne.10) then - gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,1,2) - endif - enddo -c Calculating the remainder of dE/ddc2 - do j=1,3 - gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ - & gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4) - if(itype(2).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,2,2) - endif - if(itype(3).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+ - & gloc(ialph(3,1)+nside,icg)*domega(j,1,3) - endif - if(nres.gt.4) then - gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5) - endif - enddo -c If there are only five residues - if(nres.eq.5) then - do j=1,3 - gcart(j,3)=gcart(j,3)+gloc(1,icg)*dphi(j,3,4)+gloc(2,icg)* - & dphi(j,2,5)+gloc(nres-1,icg)*dtheta(j,2,4)+gloc(nres,icg)* - & dtheta(j,1,5) - if(itype(3).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(3,1),icg)* - & dalpha(j,2,3)+gloc(ialph(3,1)+nside,icg)*domega(j,2,3) - endif - if(itype(4).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(4,1),icg)* - & dalpha(j,1,4)+gloc(ialph(4,1)+nside,icg)*domega(j,1,4) - endif - enddo - endif -c If there are more than five residues - if(nres.gt.5) then - do i=3,nres-3 - do j=1,3 - gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1) - & +gloc(i-1,icg)*dphi(j,2,i+2)+ - & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+ - & gloc(nres+i-3,icg)*dtheta(j,1,i+2) - if(itype(i).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+ - & gloc(ialph(i,1)+nside,icg)*domega(j,2,i) - endif - if(itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1) - & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1) - endif - enddo - enddo - endif -c Setting dE/ddnres-2 - if(nres.gt.5) then - do j=1,3 - gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)* - & dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres) - & +gloc(2*nres-6,icg)* - & dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres) - if(itype(nres-2).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)* - & dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)* - & domega(j,2,nres-2) - endif - if(itype(nres-1).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,1,nres-1) - endif - enddo - endif -c Settind dE/ddnres-1 - do j=1,3 - gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+ - & gloc(2*nres-5,icg)*dtheta(j,2,nres) - if(itype(nres-1).ne.10) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,2,nres-1) - endif - enddo -c The side-chain vector derivatives - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) - & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) - enddo - endif - enddo -c---------------------------------------------------------------------- -C INTERTYP=1 SC...Ca...Ca...Ca -C INTERTYP=2 Ca...Ca...Ca...SC -C INTERTYP=3 SC...Ca...Ca...SC -c calculating dE/ddc1 - 18 continue -c do i=1,nres -c gloc(i,icg)=0.0D0 -c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) -c enddo - if (nres.lt.2) return - if ((nres.lt.3).and.(itype(1).eq.10)) return - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - do j=1,3 -cc Derviative was calculated for oposite vector of side chain therefore -c there is "-" sign before gloc_sc - gxcart(j,1)=gxcart(j,1)-gloc_sc(1,0,icg)* - & dtauangle(j,1,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* - & dtauangle(j,1,2,3) - if ((itype(2).ne.10).and.(itype(2).ne.21)) then - gxcart(j,1)= gxcart(j,1) - & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* - & dtauangle(j,3,2,3) - endif - enddo - endif - if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.21)) - & then - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4) - enddo - endif -c As potetnial DO NOT depend on omicron anlge their derivative is -c ommited -c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3) - -c Calculating the remainder of dE/ddc2 - do j=1,3 - if((itype(2).ne.10).and.(itype(2).ne.21)) then - if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+ - & gloc_sc(3,0,icg)*dtauangle(j,3,3,3) - if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.21)) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4) - endif - if (nres.gt.3) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4) -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart" -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx" - endif - endif - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3) -c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3) - endif - if ((itype(3).ne.10).and.(nres.ge.3)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4) -c write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4) - endif - if ((itype(4).ne.10).and.(nres.ge.4)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5) -c write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5) - endif - -c write(iout,*) gcart(j,2),itype(2),itype(1),itype(3), "gcart2" - enddo -c If there are more than five residues - if(nres.ge.5) then - do i=3,nres-2 - do j=1,3 -c write(iout,*) "before", gcart(j,i) - if (itype(i).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg) - & *dtauangle(j,2,3,i+1) - & -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-1,icg) - & *dtauangle(j,1,2,i+2) -c write(iout,*) "new",j,i, -c & gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2) - - if (itype(i-1).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg) - &*dtauangle(j,3,3,i+1) - endif - if (itype(i+1).ne.10) then - gxcart(j,i)=gxcart(j,i)-gloc_sc(3,i-1,icg) - &*dtauangle(j,3,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(3,i-1,icg) - &*dtauangle(j,3,2,i+2) - endif - endif - if (itype(i-1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-2,icg)* - & dtauangle(j,1,3,i+1) - endif - if (itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i-1,icg)* - & dtauangle(j,2,2,i+2) -c write(iout,*) "numer",i,gloc_sc(2,i-1,icg), -c & dtauangle(j,2,2,i+2) - endif - if (itype(i+2).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)* - & dtauangle(j,2,1,i+3) - endif - enddo - enddo - endif -c Setting dE/ddnres-1 - if(nres.ge.4) then - do j=1,3 - if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) - & *dtauangle(j,2,3,nres) -c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg), -c & dtauangle(j,2,3,nres), gxcart(j,nres-1) - if (itype(nres-2).ne.10) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) - & *dtauangle(j,3,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,1,nres+1) - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,2,nres+1) - endif - endif - if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* - & dtauangle(j,1,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* - & dtauangle(j,2,2,nres+1) -c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg), -c & dtauangle(j,2,2,nres+1), itype(nres-1),itype(nres) - endif - enddo - endif -c Settind dE/ddnres - if ((nres.ge.3).and.(itype(nres).ne.10))then - do j=1,3 - gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg) - & *dtauangle(j,2,3,nres+1) - enddo - endif -c The side-chain vector derivatives - return - end - - diff --git a/source/unres/src_MD-DFA-restraints/intcartderiv.F b/source/unres/src_MD-DFA-restraints/intcartderiv.F deleted file mode 100644 index c220540..0000000 --- a/source/unres/src_MD-DFA-restraints/intcartderiv.F +++ /dev/null @@ -1,725 +0,0 @@ - subroutine intcartderiv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.LOCAL' - include 'COMMON.SCCOR' - double precision dcostheta(3,2,maxres), - & dcosphi(3,3,maxres),dsinphi(3,3,maxres), - & dcosalpha(3,3,maxres),dcosomega(3,3,maxres), - & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3), - & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3) - -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1 .and. me.eq.king) - & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - pi4 = 0.5d0*pipol - pi34 = 3*pi4 - -c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end -c Derivatives of theta's -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) - do j=1,3 - dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ - & vbld(i-1) - dtheta(j,1,i)=-1/sint*dcostheta(j,1,i) - dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ - & vbld(i) - dtheta(j,2,i)=-1/sint*dcostheta(j,2,i) - enddo - enddo - -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then - cost1=dcos(omicron(1,i)) - sint1=sqrt(1-cost1*cost1) - cost2=dcos(omicron(2,i)) - sint2=sqrt(1-cost2*cost2) - do j=1,3 -CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) - dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ - & cost1*dc_norm(j,i-2))/ - & vbld(i-1) - domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i) - dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) - & +cost1*(dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) - domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i) -CC Calculate derivative over second omicron Sci-1,Cai-1 Cai -CC Looks messy but better than if in loop - dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) - & +cost2*dc_norm(j,i-1))/ - & vbld(i) - domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i) - dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) - & +cost2*(-dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) -c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres) - domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i) - enddo - endif - enddo - - - -c Derivatives of phi: -c If phi is 0 or 180 degrees, then the formulas -c have to be derived by power series expansion of the -c conventional formulas around 0 and 180. -#ifdef PARINTDER - do i=iphi1_start,iphi1_end -#else - do i=4,nres -#endif -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(theta(i-1)) - sing=dsin(phi(i)) - cost=dcos(theta(i)) - cost1=dcos(theta(i-1)) - cosg=dcos(phi(i)) - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. - & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) - dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) - dsinphi(j,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) -c Bug fixed 3/24/05 (AL) - dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dphi(j,1,i)=-1/sing*dcosphi(j,1,i) - dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcostheta(j,1,i) - dphi(j,2,i)=-1/sing*dcosphi(j,2,i) - dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1))/vbld(i) - dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - enddo - endif - enddo - -Calculate derivative of Tauangle -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=3,nres -#endif - if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle -cc dtauangle(j,intertyp,dervityp,residue number) -cc INTERTYP=1 SC...Ca...Ca..Ca -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(1,i)) - cost=dcos(theta(i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(1,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 -c Obtaining the gamma derivatives from sine derivative - if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. - & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. - & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) - & *vbld_inv(i-2+nres) - dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) - dsintau(j,1,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "dsintau", dsintau(j,1,2,i) - dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) - dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) - dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcostheta(j,1,i) - dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) - dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* - & dc_norm(j,i-1))/vbld(i) - dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) -c write (iout,*) "else",i - enddo - endif -c do k=1,3 -c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) -c enddo - enddo -CC Second case Ca...Ca...Ca...SC -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=4,nres -#endif - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle -c the conventional case - sint=dsin(omicron(1,i)) - sint1=dsin(theta(i-1)) - sing=dsin(tauangle(2,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(theta(i-1)) - cosg=dcos(tauangle(2,i)) -c do j=1,3 -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) -c enddo - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. - & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. - & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then - call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) -c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), -c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" - dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) - dsintau(j,2,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), -c & sing*ctgt*domicron(j,1,2,i), -c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) - dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) - dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) -c write(iout,*) i,j,"else", dtauangle(j,2,3,i) - enddo - endif - enddo - - -CCC third case SC...Ca...Ca...SC -#ifdef PARINTDER - - do i=itau_start,itau_end -#else - do i=3,nres -#endif -c the conventional case - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or. - &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle - sint=dsin(omicron(1,i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(3,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(3,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. - & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. - & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then - call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) - & *vbld_inv(i-2+nres) - dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) - dsintau(j,3,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) - & *vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm2(j,i-2+nres))/vbld(i-2+nres) - dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) - dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) - dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) -c write(iout,*) "else",i - enddo - endif - enddo -#ifdef CRYST_SC -c Derivatives of side-chain angles alpha and omega -#if defined(MPI) && defined(PARINTDER) - do i=ibond_start,ibond_end -#else - do i=2,nres-1 -#endif - if(itype(i).ne.10) then - fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) - fac6=fac5/vbld(i) - fac7=fac5*fac5 - fac8=fac5/vbld(i+1) - fac9=fac5/vbld(i+nres) - scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*( - & scalar(dC_norm(1,i),dC_norm(1,i+nres)) - & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) - sina=sqrt(1-cosa*cosa) - sino=dsin(omeg(i)) - do j=1,3 - dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- - & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) - dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) - dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- - & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) - dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) - dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- - & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ - & vbld(i+nres)) - dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) - enddo -c obtaining the derivatives of omega from sines - if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. - & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then - fac15=dcos(theta(i+1))/(dsin(theta(i+1))* - & dsin(theta(i+1))) - fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) - fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) - call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) - coso_inv=1.0d0/dcos(omeg(i)) - do j=1,3 - dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) - & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-( - & sino*dc_norm(j,i-1))/vbld(i) - domega(j,1,i)=coso_inv*dsinomega(j,1,i) - dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) - & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) - & -sino*dc_norm(j,i)/vbld(i+1) - domega(j,2,i)=coso_inv*dsinomega(j,2,i) - dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- - & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ - & vbld(i+nres) - domega(j,3,i)=coso_inv*dsinomega(j,3,i) - enddo - else -c obtaining the derivatives of omega from cosines - fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) - fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) - fac12=fac10*sina - fac13=fac12*fac12 - fac14=sina*sina - do j=1,3 - dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* - & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ - & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* - & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 - domega(j,1,i)=-1/sino*dcosomega(j,1,i) - dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* - & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* - & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ - & (scala2-fac11*cosa)*(0.25d0*sina/fac10* - & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i) - & ))/fac13 - domega(j,2,i)=-1/sino*dcosomega(j,2,i) - dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- - & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ - & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 - domega(j,3,i)=-1/sino*dcosomega(j,3,i) - enddo - endif - endif - enddo -#endif -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1) then -#ifdef DEBUG - write (iout,*) "Gather dtheta" -cd call flush(iout) -c write (iout,*) "dtheta before gather" -c do i=1,nres -c write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) -c enddo -#endif - call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank), - & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET, - & king,FG_COMM,IERROR) -#ifdef DEBUG -cd write (iout,*) "Gather dphi" -cd call flush(iout) - write (iout,*) "dphi before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) - enddo -#endif - call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank), - & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather dalpha" -cd call flush(iout) -#ifdef CRYST_SC - call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather domega" -cd call flush(iout) - call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -#endif - endif -#endif -#ifdef DEBUG - write (iout,*) "dtheta after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2) - enddo - write (iout,*) "dphi after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) - enddo -#endif - return - end - - subroutine checkintcartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - double precision dthetanum(3,2,maxres),dphinum(3,3,maxres) - & ,dalphanum(3,3,maxres), domeganum(3,3,maxres) - double precision theta_s(maxres),phi_s(maxres),alph_s(maxres), - & omeg_s(maxres),dc_norm_s(3) - double precision aincr /1.0d-5/ - - do i=1,nres - phi_s(i)=phi(i) - theta_s(i)=theta(i) - alph_s(i)=alph(i) - omeg_s(i)=omeg(i) - enddo -c Check theta gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of theta" - write (iout,*) - do i=3,nres - do j=1,3 - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - call int_from_cart1(.false.) - dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3), - & (dtheta(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3), - & (dthetanum(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') - & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3), - & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3) - write (iout,*) - enddo -c Check gamma gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of gamma" - do i=4,nres - do j=1,3 - dcji=dc(j,i-3) - dc(j,i-3)=dcji+aincr - call chainbuild_cart - dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3), - & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3), - & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dphinum(j,1,i)/dphi(j,1,i),j=1,3), - & (dphinum(j,2,i)/dphi(j,2,i),j=1,3), - & (dphinum(j,3,i)/dphi(j,3,i),j=1,3) - write (iout,*) - enddo -c Check alpha gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of alpha" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - dalphanum(j,1,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - dalphanum(j,2,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - dalphanum(j,3,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3), - & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3), - & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3), - & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3), - & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3) - write (iout,*) - enddo -c Check omega gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of omega" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - domeganum(j,1,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - domeganum(j,2,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - domeganum(j,3,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3), - & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3), - & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (domeganum(j,1,i)/domega(j,1,i),j=1,3), - & (domeganum(j,2,i)/domega(j,2,i),j=1,3), - & (domeganum(j,3,i)/domega(j,3,i),j=1,3) - write (iout,*) - enddo - return - end - - subroutine chainbuild_cart - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' - -#ifdef MPI - if (nfgtasks.gt.1) then -c write (iout,*) "BCAST in chainbuild_cart" -c call flush(iout) -c Broadcast the order to build the chain and compute internal coordinates -c to the slaves. The slaves receive the order in ERGASTULUM. - time00=MPI_Wtime() -c write (iout,*) "CHAINBUILD_CART: DC before BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo - if (fg_rank.eq.0) - & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_bcast7=time_bcast7+MPI_Wtime()-time00 - time01=MPI_Wtime() - call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "CHAINBUILD_CART: DC after BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo -c write (iout,*) "End BCAST in chainbuild_cart" -c call flush(iout) - time_bcast=time_bcast+MPI_Wtime()-time00 - time_bcastc=time_bcastc+MPI_Wtime()-time01 - endif -#endif - do j=1,3 - c(j,1)=dc(j,0) - enddo - do i=2,nres - do j=1,3 - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo - enddo - do i=1,nres - do j=1,3 - c(j,i+nres)=c(j,i)+dc(j,i+nres) - enddo - enddo -c write (iout,*) "CHAINBUILD_CART" -c call cartprint - call int_from_cart1(.false.) - return - end diff --git a/source/unres/src_MD-DFA-restraints/intcor.f b/source/unres/src_MD-DFA-restraints/intcor.f deleted file mode 100644 index a3cd5d0..0000000 --- a/source/unres/src_MD-DFA-restraints/intcor.f +++ /dev/null @@ -1,91 +0,0 @@ -C -C------------------------------------------------------------------------------ -C - double precision function alpha(i1,i2,i3) -c -c Calculates the planar angle between atoms (i1), (i2), and (i3). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - vnorm=dsqrt(x12*x12+y12*y12+z12*z12) - wnorm=dsqrt(x23*x23+y23*y23+z23*z23) - scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm) - alpha=arcos(scalar) - return - end -C -C------------------------------------------------------------------------------ -C - double precision function beta(i1,i2,i3,i4) -c -c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4) -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - x34=c(1,i4)-c(1,i3) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - y34=c(2,i4)-c(2,i3) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - z34=c(3,i4)-c(3,i3) -cd print '(2i3,3f10.5)',i1,i2,x12,y12,z12 -cd print '(2i3,3f10.5)',i2,i3,x23,y23,z23 -cd print '(2i3,3f10.5)',i3,i4,x34,y34,z34 - wx=-y23*z34+y34*z23 - wy=x23*z34-z23*x34 - wz=-x23*y34+y23*x34 - wnorm=dsqrt(wx*wx+wy*wy+wz*wz) - vx=y12*z23-z12*y23 - vy=-x12*z23+z12*x23 - vz=x12*y23-y12*x23 - vnorm=dsqrt(vx*vx+vy*vy+vz*vz) - if (vnorm.gt.1.0D-13 .and. wnorm.gt.1.0D-13) then - scalar=(vx*wx+vy*wy+vz*wz)/(vnorm*wnorm) - if (dabs(scalar).gt.1.0D0) - &scalar=0.99999999999999D0*scalar/dabs(scalar) - angle=dacos(scalar) -cd print '(2i4,10f7.3)',i2,i3,vx,vy,vz,wx,wy,wz,vnorm,wnorm, -cd &scalar,angle - else - angle=pi - endif -c if (angle.le.0.0D0) angle=pi+angle - tx=vy*wz-vz*wy - ty=-vx*wz+vz*wx - tz=vx*wy-vy*wx - scalar=tx*x23+ty*y23+tz*z23 - if (scalar.lt.0.0D0) angle=-angle - beta=angle - return - end -C -C------------------------------------------------------------------------------ -C - function dist(i1,i2) -c -c Calculates the distance between atoms (i1) and (i2). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - y12=c(2,i1)-c(2,i2) - z12=c(3,i1)-c(3,i2) - dist=dsqrt(x12*x12+y12*y12+z12*z12) - return - end -C diff --git a/source/unres/src_MD-DFA-restraints/intlocal.f b/source/unres/src_MD-DFA-restraints/intlocal.f deleted file mode 100644 index 2dbcc88..0000000 --- a/source/unres/src_MD-DFA-restraints/intlocal.f +++ /dev/null @@ -1,517 +0,0 @@ - subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2, - & si1,si2,si3,si4,transp,q) - implicit none - integer ity1,ity2 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4 - logical transp - double precision elocal,ele - double precision delta,delta2,sum,ene,sumene,boltz - double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=20 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum=0.0d0 - sumene=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - ene= - & -elocal(ity1,lambda1,lambda2,.false.)* - & elocal(ity2,lambda3,lambda4,transp)* - & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)* - & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2) -cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2), -cd & elocal(ity2,lambda3,gamma2-pi-lambda4), -cd & ele(lambda1,lambda2,a1,si1,si3), -cd & ele(lambda3,lambda4,a2,si2,si4) - sum=sum+ene - enddo - enddo - enddo - enddo - q=sum/(2*pi)**4*delta**4 - write (2,* )'sum',sum,' q',q - return - end -c--------------------------------------------------------------------------- - subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4, - & a1,koniec,q1,q2,q3,q4) - implicit none - integer ity1,ity2,ity3,ity4 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1, - & lambda2,lambda3,lambda4 - logical koniec - double precision elocal,ele - double precision delta,delta2,sum1,sum2,sum3,sum4, - & ene1,ene2,ene3,ene4,boltz - double precision q1,q2,q3,q4,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - if (.not.koniec) then - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda2,lambda4,a1) - else - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda2,-lambda4,a1) - endif - ene2= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda2,lambda3,a1) - if (.not.koniec) then - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda1,lambda4,a1) - else - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda1,-lambda4,a1) - endif - ene4= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda1,lambda3,a1) - sum1=sum1+ene1 - sum2=sum2+ene2 - sum3=sum3+ene3 - sum4=sum4+ene4 - enddo - enddo - enddo - enddo - q1=sum1/(2*pi)**4*delta**4 - q2=sum2/(2*pi)**4*delta**4 - q3=sum3/(2*pi)**4*delta**4 - q4=sum4/(2*pi)**4*delta**4 - write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4 - return - end -c------------------------------------------------------------------------- - subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4, - & a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - sum1=sum1+pom*eloc1 - endif - eloc3=elocal(ity3,lambda2,lambda5,.false.) - sum2=sum2+pom*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc4 - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda5,.false.) - sum4=sum4+pom*eloc6 - endif - enddo - enddo - enddo - enddo - enddo - pom=1.0d0/(2*pi)**5*delta**5 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom -c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4 - return - end -c------------------------------------------------------------------------- - subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2, - & ity3,ity4,ity5,ity6,a1,a2,ene_turn6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom,ene5 - double precision ene_turn6,sum5,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, - & ' gamma3=',gamma3,' gamma4=',gamma4 - write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 - write(2,*) 'a1=',a1 - write(2,*) 'a2=',a2 - - sum5=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - ele1=ele(lambda1,-lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.) - eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.) - sum5=sum5+pom*eloc3*eloc4 - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**5*delta**5 - ene_turn6=sum5*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4, - & ene5,ene6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - sum5=0.0d0 - sum6=0.0d0 - eloc1=0.0d0 - eloc6=0.0d0 - eloc61=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - do ilam6=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - lambda6=ilam6*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - endif - eloc3=elocal(ity3,lambda2,lambda6,.false.) - sum1=sum1+pom*eloc1*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda6,.false.) - eloc61=elocal(ity6,lambda4,lambda5,.false.) - endif - sum2=sum2+pom*eloc4*eloc6 - eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc1*eloc41 - sum4=sum4+pom*eloc1*eloc6 - sum5=sum5+pom*eloc3*eloc4 - sum6=sum6+pom*eloc3*eloc61 - enddo - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**6*delta**6 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom - ene5=sum5*pom - ene6=sum6*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2 -cd write(2,*) ity1,ity2 -cd write(2,*) 'a1=',a1 -cd write(2,*) si1, - - sum1=0.0d0 - eloc1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - ele1=ele(lambda1,si1*lambda3,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - if (si1.gt.0) then - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - else - eloc2=elocal(ity2,lambda2,lambda3,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2 - enddo - enddo - enddo - pom=1.0d0/(2*pi)**3*delta**3 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1, - & ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3 -cd write(2,*) ity1,ity2,ity3 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'si1=',si1 - sum1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - ele1=ele(lambda1,si1*lambda4,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - if (si1.gt.0) then - eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.) - else - eloc3=elocal(ity3,lambda3,lambda4,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2*eloc3 - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**4*delta**4 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - double precision function elocal(i,x,y,transp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TORSION' - integer i - double precision x,y,u(2),v(2),cu(2),dv(2),ev(2) - double precision scalar2 - logical transp - u(1)=dcos(x) - u(2)=dsin(x) - v(1)=dcos(y) - v(2)=dsin(y) - if (transp) then - call matvec2(cc(1,1,i),v,cu) - call matvec2(dd(1,1,i),u,dv) - call matvec2(ee(1,1,i),u,ev) - elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+ - & scalar2(dv,u)+scalar2(ev,v) - else - call matvec2(cc(1,1,i),u,cu) - call matvec2(dd(1,1,i),v,dv) - call matvec2(ee(1,1,i),v,ev) - elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+ - & scalar2(dv,v)+scalar2(ev,u) - endif - return - end -c------------------------------------------------------------------------- - double precision function ele(x,y,a) - implicit none - double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2) - double precision scalar2 - u(1)=-cos(x) - u(2)= sin(x) - v(1)=-cos(y) - v(2)= sin(y) - call matvec2(a,v,av) - ele=scalar2(u,av) - return - end diff --git a/source/unres/src_MD-DFA-restraints/kinetic_lesyng.f b/source/unres/src_MD-DFA-restraints/kinetic_lesyng.f deleted file mode 100644 index 8535f5d..0000000 --- a/source/unres/src_MD-DFA-restraints/kinetic_lesyng.f +++ /dev/null @@ -1,104 +0,0 @@ - subroutine kinetic(KE_total) -c---------------------------------------------------------------- -c This subroutine calculates the total kinetic energy of the chain -c----------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - double precision KE_total - - integer i,j,k - double precision KEt_p,KEt_sc,KEr_p,KEr_sc,incr(3), - & mag1,mag2,v(3) - - KEt_p=0.0d0 - KEt_sc=0.0d0 -c write (iout,*) "ISC",(isc(itype(i)),i=1,nres) -c The translational part for peptide virtual bonds - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 -c write (iout,*) "Kinetic trp:",i,(incr(j),j=1,3) - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - vtot(i)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - KEt_p=KEt_p+(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c write(iout,*) 'KEt_p', KEt_p -c The translational part for the side chain virtual bond -c Only now we can initialize incr with zeros. It must be equal -c to the velocities of the first Calpha. - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - if (itype(i).eq.10) then - do j=1,3 - v(j)=incr(j) - enddo - else - do j=1,3 - v(j)=incr(j)+d_t(j,nres+i) - enddo - endif -c write (iout,*) "Kinetic trsc:",i,(incr(j),j=1,3) -c write (iout,*) "i",i," msc",msc(iti)," v",(v(j),j=1,3) - KEt_sc=KEt_sc+msc(iti)*(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - vtot(i+nres)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c goto 111 -c write(iout,*) 'KEt_sc', KEt_sc -c The part due to stretching and rotation of the peptide groups - KEr_p=0.0D0 - do i=nnt,nct-1 -c write (iout,*) "i",i -c write (iout,*) "i",i," mag1",mag1," mag2",mag2 - do j=1,3 - incr(j)=d_t(j,i) - enddo -c write (iout,*) "Kinetic rotp:",i,(incr(j),j=1,3) - KEr_p=KEr_p+(incr(1)*incr(1)+incr(2)*incr(2) - & +incr(3)*incr(3)) - enddo -c goto 111 -c write(iout,*) 'KEr_p', KEr_p -c The rotational part of the side chain virtual bond - KEr_sc=0.0D0 - do i=nnt,nct - iti=itype(i) - if (itype(i).ne.10) then - do j=1,3 - incr(j)=d_t(j,nres+i) - enddo -c write (iout,*) "Kinetic rotsc:",i,(incr(j),j=1,3) - KEr_sc=KEr_sc+Isc(iti)*(incr(1)*incr(1)+incr(2)*incr(2)+ - & incr(3)*incr(3)) - endif - enddo -c The total kinetic energy - 111 continue -c write(iout,*) 'KEr_sc', KEr_sc - KE_total=0.5d0*(mp*KEt_p+KEt_sc+0.25d0*Ip*KEr_p+KEr_sc) -c write (iout,*) "KE_total",KE_total - return - end - - - - diff --git a/source/unres/src_MD-DFA-restraints/lagrangian_lesyng.F b/source/unres/src_MD-DFA-restraints/lagrangian_lesyng.F deleted file mode 100644 index 8a9163a..0000000 --- a/source/unres/src_MD-DFA-restraints/lagrangian_lesyng.F +++ /dev/null @@ -1,726 +0,0 @@ - subroutine lagrangian -c------------------------------------------------------------------------- -c This subroutine contains the total lagrangain from which the accelerations -c are obtained. For numerical gradient checking, the derivetive of the -c lagrangian in the velocities and coordinates are calculated seperately -c------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MUCA' - include 'COMMON.TIME1' - - integer i,j,ind - double precision zapas(MAXRES6),muca_factor - logical lprn /.false./ - common /cipiszcze/ itime - -#ifdef TIMING - time00=MPI_Wtime() -#endif - do j=1,3 - zapas(j)=-gcart(j,0) - enddo - ind=3 - if (lprn) then - write (iout,*) "Potential forces backbone" - endif - do i=nnt,nct-1 - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gcart(j,i) - enddo - enddo - if (lprn) write (iout,*) "Potential forces sidechain" - do i=nnt,nct - if (itype(i).ne.10) then - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gxcart(j,i) - enddo - endif - enddo - - call ginv_mult(zapas,d_a_work) - - do j=1,3 - d_a(j,0)=d_a_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_a(j,i)=d_a_work(ind) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_a(j,i+nres)=d_a_work(ind) - enddo - endif - enddo - - if(lmuca) then - imtime=imtime+1 - if(mucadyn.gt.0) call muca_update(potE) - factor=muca_factor(potE)*t_bath*Rb - -cd print *,'lmuca ',factor,potE - do j=1,3 - d_a(j,0)=d_a(j,0)*factor - enddo - do i=nnt,nct-1 - do j=1,3 - d_a(j,i)=d_a(j,i)*factor - enddo - enddo - do i=nnt,nct - do j=1,3 - d_a(j,i+nres)=d_a(j,i+nres)*factor - enddo - enddo - - endif - - if (lprn) then - write(iout,*) 'acceleration 3D' - write (iout,'(i3,3f10.5,3x,3f10.5)') 0,(d_a(j,0),j=1,3) - do i=nnt,nct-1 - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3) - enddo - do i=nnt,nct - write (iout,'(i3,3f10.5,3x,3f10.5)') - & i+nres,(d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef TIMING - time_lagrangian=time_lagrangian+MPI_Wtime()-time00 -#endif - return - end -c------------------------------------------------------------------ - subroutine setup_MD_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer i,j - logical lprn /.false./ - logical osob - double precision dtdi,massvec(maxres2),Gcopy(maxres2,maxres2), - & Ghalf(mmaxres2),sqreig(maxres2), invsqreig(maxres2), Gcopytmp, - & Gsqrptmp, Gsqrmtmp, Gvec2tmp,Gvectmp(maxres2,maxres2) - double precision work(8*maxres6) - integer iwork(maxres6) - common /przechowalnia/ Gcopy,Ghalf,invsqreig,Gvectmp -c -c Set up the matrix of the (dC,dX)-->(C,X) transformation (A), the -c inertia matrix (Gmat) and the inverse of the inertia matrix (Ginv) -c -c Determine the number of degrees of freedom (dimen) and the number of -c sites (dimen1) - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() - call MPI_Bcast(5,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - write (iout,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' igmult_start',igmult_start, - & ' igmult_end',igmult_end,' count',my_ng_count - write (iout,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) - write (iout,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - call flush(iout) - else -#endif - igmult_start=1 - igmult_end=dimen - my_ng_count=dimen -#ifdef MPI - endif -#endif -c write (iout,*) "dimen",dimen," dimen1",dimen1," dimen3",dimen3 -c Zeroing out A and fricmat - do i=1,dimen - do j=1,dimen - A(i,j)=0.0D0 - enddo - enddo -c Diagonal elements of the dC part of A and the respective friction coefficients - ind=1 - ind1=0 - do i=nnt,nct-1 - ind=ind+1 - ind1=ind1+1 - coeff=0.25d0*IP - massvec(ind1)=mp - Gmat(ind,ind)=coeff - A(ind1,ind)=0.5d0 - enddo - -c Off-diagonal elements of the dC part of A - k=3 - do i=1,nct-nnt - do j=1,i - A(i,j)=1.0d0 - enddo - enddo -c Diagonal elements of the dX part of A and the respective friction coefficients - m=nct-nnt - m1=nct-nnt+1 - ind=0 - ind1=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - massvec(ii)=msc(iti) - if (iti.ne.10) then - ind1=ind1+1 - ii1= ind1+m1 - A(ii,ii1)=1.0d0 - Gmat(ii1,ii1)=ISC(iti) - endif - enddo -c Off-diagonal elements of the dX part of A - ind=0 - k=nct-nnt - do i=nnt,nct - iti=itype(i) - ind=ind+1 - do j=nnt,i - ii = ind - jj = j-nnt+1 - A(k+ii,jj)=1.0d0 - enddo - enddo - if (lprn) then - write (iout,*) - write (iout,*) "Vector massvec" - do i=1,dimen1 - write (iout,*) i,massvec(i) - enddo - write (iout,'(//a)') "A" - call matout(dimen,dimen1,maxres2,maxres2,A) - endif - -c Calculate the G matrix (store in Gmat) - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*massvec(j) - enddo - Gmat(k,i)=Gmat(k,i)+dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Gmat" - call matout(dimen,dimen,maxres2,maxres2,Gmat) - endif - do i=1,dimen - do j=1,dimen - Ginv(i,j)=0.0d0 - Gcopy(i,j)=Gmat(i,j) - enddo - Ginv(i,i)=1.0d0 - enddo -c Invert the G matrix - call MATINVERT(dimen,maxres2,Gcopy,Ginv,osob) - if (lprn) then - write (iout,'(//a)') "Ginv" - call matout(dimen,dimen,maxres2,maxres2,Ginv) - endif -#ifdef MPI - if (nfgtasks.gt.1) then - myginv_ng_count=maxres2*my_ng_count - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) - if (lprn .and. (me.eq.king .or. .not. out1file) ) then - write (iout,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) - write (iout,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) - call flush(iout) - endif -c call MPI_Scatterv(ginv(1,1),nginv_counts(0), -c & nginv_start(0),MPI_DOUBLE_PRECISION,ginv, -c & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c call MPI_Barrier(FG_COMM,IERR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (iout,*) "Master's chunk of ginv" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,ginv) - endif -#endif - if (osob) then - write (iout,*) "The G matrix is singular." - stop - endif -c Compute G**(-1/2) and G**(1/2) - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Gmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,Geigen,Gvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//a)') - & "Eigenvectors and eigenvalues of the G matrix" - call eigout(dimen,dimen,maxres2,maxres2,Gvec,Geigen) - endif - - do i=1,dimen - sqreig(i)=dsqrt(Geigen(i)) - invsqreig(i)=1.d0/sqreig(i) - enddo - do i=1,dimen - do j=1,dimen - Gvectmp(i,j)=Gvec(j,i) - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gsqrptmp=0.0d0 - Gsqrmtmp=0.0d0 - Gcopytmp=0.0d0 - do k=1,dimen -c Gvec2tmp=Gvec(i,k)*Gvec(j,k) - Gvec2tmp=Gvec(k,i)*Gvec(k,j) - Gsqrptmp=Gsqrptmp+Gvec2tmp*sqreig(k) - Gsqrmtmp=Gsqrmtmp+Gvec2tmp*invsqreig(k) - Gcopytmp=Gcopytmp+Gvec2tmp*Geigen(k) - enddo - Gsqrp(i,j)=Gsqrptmp - Gsqrm(i,j)=Gsqrmtmp - Gcopy(i,j)=Gcopytmp - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gvec(i,j)=Gvectmp(j,i) - enddo - enddo - - if (lprn) then - write (iout,*) "Comparison of original and restored G" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,5f10.5)') i,j,Gmat(i,j),Gcopy(i,j), - & Gmat(i,j)-Gcopy(i,j),Gsqrp(i,j),Gsqrm(i,j) - enddo - enddo - endif - return - end -c------------------------------------------------------------------------------- - SUBROUTINE EIGOUT(NC,NR,LM2,LM3,A,B) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3),B(LM2) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,601) (B(I),I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (// 9H ROOT NO.,I4,9I11) - 601 FORMAT (/5X,10(1PE11.4)) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.5) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (//5x,9I11) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.3) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT1(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=21 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+21 - GO TO 1 - 600 FORMAT (//5x,7(3I5,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,7(3F5.1,2x)) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT2(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=12 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+12 - GO TO 1 - 600 FORMAT (//5x,4(3I9,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,4(3F9.3,2x)) - 604 FORMAT (1H1) - END -c--------------------------------------------------------------------------- - SUBROUTINE ginv_mult(z,d_a_tmp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierr -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.MD' - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(4,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in GINV_MULT" - endif -c write (2,*) "time00",time00 -c write (2,*) "Before Scatterv" -c call flush(2) -c write (2,*) "Whole z (for FG master)" -c do i=1,dimen -c write (2,*) i,z(i) -c enddo -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo -c write (2,*) "After SCATTERV" -c call flush(2) -c write (2,*) "MPI_Wtime",MPI_Wtime() - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_ginvmult=time_scatter_ginvmult+MPI_Wtime()-time00 -#endif -c write (2,*) "time_scatter",time_scatter -c write (2,*) "dimen",dimen," dimen3",dimen3," my_ng_count", -c & my_ng_count -c call flush(2) - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1, -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) -c temp(ind)=temp(ind)+Ginv(i,j)*z((j-1)*3+k+1) - temp(ind)=temp(ind)+Ginv(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c call flush(2) -c write (2,*) "z before reduce" -c do i=1,dimen -c write (2,*) i,temp(i) -c enddo - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1 -c call flush(2) -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) - d_a_tmp(ind)=d_a_tmp(ind) - & +Ginv(j,i)*z((j-1)*3+k+1) -c d_a_tmp(ind)=d_a_tmp(ind) -c & +Ginv(i,j)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif - return - end -c--------------------------------------------------------------------------- -#ifdef GINV_MULT - SUBROUTINE ginv_mult_test(z,d_a_tmp) - include 'DIMENSIONS' - integer dimen -c include 'COMMON.MD' - double precision z(dimen),d_a_tmp(dimen) - double precision ztmp(dimen/3),dtmp(dimen/3) - -c do i=1,dimen -c d_a_tmp(i)=0.0d0 -c do j=1,dimen -c d_a_tmp(i)=d_a_tmp(i)+Ginv(i,j)*z(j) -c enddo -c enddo -c -c return - -!ibm* unroll(3) - do k=0,2 - do j=1,dimen/3 - ztmp(j)=z((j-1)*3+k+1) - enddo - - call alignx(16,ztmp(1)) - call alignx(16,dtmp(1)) - call alignx(16,Ginv(1,1)) - - do i=1,dimen/3 - dtmp(i)=0.0d0 - do j=1,dimen/3 - dtmp(i)=dtmp(i)+Ginv(i,j)*ztmp(j) - enddo - enddo - do i=1,dimen/3 - ind=(i-1)*3+k+1 - d_a_tmp(ind)=dtmp(i) - enddo - enddo - return - end -#endif -c--------------------------------------------------------------------------- - SUBROUTINE fricmat_mult(z,d_a_tmp) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR -#endif - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(9,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in FRICMAT_MULT" - endif -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_fmatmult=time_scatter_fmatmult+MPI_Wtime()-time00 -#endif - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count - temp(ind)=temp(ind)-fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c write (2,*) "d_a_tmp before reduce" -c do i=1,dimen3 -c write (2,*) i,temp(i) -c enddo -c call flush(2) - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen - d_a_tmp(ind)=d_a_tmp(ind) - & -fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif -c write (iout,*) "Vector d_a" -c do i=1,dimen3 -c write (2,*) i,d_a_tmp(i) -c enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/local_move.f b/source/unres/src_MD-DFA-restraints/local_move.f deleted file mode 100644 index 7a7e125..0000000 --- a/source/unres/src_MD-DFA-restraints/local_move.f +++ /dev/null @@ -1,972 +0,0 @@ -c------------------------------------------------------------- - - subroutine local_move_init(debug) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' ! Needed by COMMON.LOCAL - include 'COMMON.GEO' ! For pi, deg2rad - include 'COMMON.LOCAL' ! For vbl - include 'COMMON.LOCMOVE' - -c INPUT arguments - logical debug - - -c Determine wheter to do some debugging output - locmove_output=debug - -c Set the init_called flag to 1 - init_called=1 - -c The following are never changed - min_theta=60.D0*deg2rad ! (0,PI) - max_theta=175.D0*deg2rad ! (0,PI) - dmin2=vbl*vbl*2.*(1.-cos(min_theta)) - dmax2=vbl*vbl*2.*(1.-cos(max_theta)) - flag=1.0D300 - small=1.0D-5 - small2=0.5*small*small - -c Not really necessary... - a_n=0 - b_n=0 - res_n=0 - - return - end - -c------------------------------------------------------------- - - subroutine local_move(n_start, n_end, PHImin, PHImax) -c Perform a local move between residues m and n (inclusive) -c PHImin and PHImax [0,PI] determine the size of the move -c Works on whatever structure is in the variables theta and phi, -c sidechain variables are left untouched -c The final structure is NOT minimized, but both the cartesian -c variables c and the angles are up-to-date at the end (no further -c chainbuild is required) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MINIM' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - double precision ran_number - external ran_number - -c INPUT arguments - integer n_start, n_end ! First and last residues to move - double precision PHImin, PHImax ! min/max angles [0,PI] - -c Local variables - integer i,j - double precision min,max - integer iretcode - - -c Check if local_move_init was called. This assumes that it -c would not be 1 if not explicitely initialized - if (init_called.ne.1) then - write(6,*)' *** local_move_init not called!!!' - stop - endif - -c Quick check for crazy range - if (n_start.gt.n_end .or. n_start.lt.1 .or. n_end.gt.nres) then - write(6,'(a,i3,a,i3)') - + ' *** Cannot make local move between n_start = ', - + n_start,' and n_end = ',n_end - return - endif - -c Take care of end residues first... - if (n_start.eq.1) then -c Move residue 1 (completely random) - theta(3)=ran_number(min_theta,max_theta) - phi(4)=ran_number(-PI,PI) - i=2 - else - i=n_start - endif - if (n_end.eq.nres) then -c Move residue nres (completely random) - theta(nres)=ran_number(min_theta,max_theta) - phi(nres)=ran_number(-PI,PI) - j=nres-1 - else - j=n_end - endif - -c ...then go through all other residues one by one -c Start from the two extremes and converge - call chainbuild - do while (i.le.j) - min=PHImin - max=PHImax -c$$$c Move the first two residues by less than the others -c$$$ if (i-n_start.lt.3) then -c$$$ if (i-n_start.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (i-n_start.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (i-n_start.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue i - iretcode=move_res(min,max,i) ! Discard iretcode - i=i+1 - - if (i.le.j) then - min=PHImin - max=PHImax -c$$$c Move the last two residues by less than the others -c$$$ if (n_end-j.lt.3) then -c$$$ if (n_end-j.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (n_end-j.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (n_end-j.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue j - iretcode=move_res(min,max,j) ! Discard iretcode - j=j-1 - endif - enddo - - call int_from_cart(.false.,.false.) - - return - end - -c------------------------------------------------------------- - - subroutine output_tabs -c Prints out the contents of a_..., b_..., res_... - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Local variables - integer i,j - - - write(6,*)'a_...' - write(6,'(8f7.1)')(a_ang(i)*rad2deg,i=0,a_n-1) - write(6,'(8(2x,3l1,2x))')((a_tab(i,j),i=0,2),j=0,a_n-1) - - write(6,*)'b_...' - write(6,'(4f7.1)')(b_ang(i)*rad2deg,i=0,b_n-1) - write(6,'(4(2x,3l1,2x))')((b_tab(i,j),i=0,2),j=0,b_n-1) - - write(6,*)'res_...' - write(6,'(12f7.1)')(res_ang(i)*rad2deg,i=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(0,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(1,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(2,i,j),i=0,2),j=0,res_n-1) - - return - end - -c------------------------------------------------------------- - - subroutine angles2tab(PHImin,PHImax,n,ang,tab) -c Only uses angles if [0,PI] (but PHImin cannot be 0., -c and PHImax cannot be PI) - implicit none - -c Includes - include 'COMMON.GEO' - -c INPUT arguments - double precision PHImin,PHImax - -c OUTPUT arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - - - if (PHImin .eq. PHImax) then -c Special case with two 010's - n = 2; - ang(0) = -PHImin; - ang(1) = PHImin; - tab(0,0) = .false. - tab(2,0) = .false. - tab(0,1) = .false. - tab(2,1) = .false. - tab(1,0) = .true. - tab(1,1) = .true. - else if (PHImin .eq. PI) then -c Special case with one 010 - n = 1 - ang(0) = PI - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else if (PHImax .eq. 0.) then -c Special case with one 010 - n = 1 - ang(0) = 0. - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else -c Standard cases - n = 0 - if (PHImin .gt. 0.) then -c Start of range (011) - ang(n) = PHImin - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = -PHImin - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - if (PHImax .lt. PI) then -c Start of range (011) - ang(n) = -PHImax - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = PHImax - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine minmax_angles(x,y,z,r,n,ang,tab) -c When solutions do not exist, assume all angles -c are acceptable - i.e., initial geometry must be correct - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Input arguments - double precision x,y,z,r - -c Output arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - -c Local variables - double precision num, denom, phi - double precision Kmin, Kmax - integer i - - - num = x*x + y*y + z*z - denom = x*x + y*y - n = 0 - if (denom .gt. 0.) then - phi = atan2(y,x) - denom = 2.*r*sqrt(denom) - num = num+r*r - Kmin = (num - dmin2)/denom - Kmax = (num - dmax2)/denom - -c Allowed values of K (else all angles are acceptable) -c -1 <= Kmin < 1 -c -1 < Kmax <= 1 - if (Kmin .gt. 1. .or. abs(Kmin-1.) .lt. small2) then - Kmin = -flag - else if (Kmin .lt. -1. .or. abs(Kmin+1.) .lt. small2) then - Kmin = PI - else - Kmin = acos(Kmin) - endif - - if (Kmax .lt. -1. .or. abs(Kmax+1.) .lt. small2) then - Kmax = flag - else if (Kmax .gt. 1. .or. abs(Kmax-1.) .lt. small2) then - Kmax = 0. - else - Kmax = acos(Kmax) - endif - - if (Kmax .lt. Kmin) Kmax = Kmin - - call angles2tab(Kmin, Kmax, n, ang, tab) - -c Add phi and check that angles are within range (-PI,PI] - do i=0,n-1 - ang(i) = ang(i)+phi - if (ang(i) .le. -PI) then - ang(i) = ang(i)+2.*PI - else if (ang(i) .gt. PI) then - ang(i) = ang(i)-2.*PI - endif - enddo - endif - - return - end - -c------------------------------------------------------------- - - subroutine construct_tab -c Take a_... and b_... values and produces the results res_... -c x_ang are assumed to be all different (diff > small) -c x_tab(1,i) must be 1 for all i (i.e., all x_ang are acceptable) - implicit none - -c Includes - include 'COMMON.LOCMOVE' - -c Local variables - integer n_max,i,j,index - logical done - double precision phi - - - n_max = a_n + b_n - if (n_max .eq. 0) then - res_n = 0 - return - endif - - do i=0,n_max-1 - do j=0,1 - res_tab(j,0,i) = .true. - res_tab(j,2,i) = .true. - res_tab(j,1,i) = .false. - enddo - enddo - - index = 0 - phi = -flag - done = .false. - do while (.not.done) - res_ang(index) = flag - -c Check a first... - do i=0,a_n-1 - if ((a_ang(i)-phi).gt.small .and. - + a_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = a_ang(i) -c Copy the values from a_tab into res_tab(0,,) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) -c Set default values for res_tab(1,,) - res_tab(1,0,index) = .true. - res_tab(1,1,index) = .false. - res_tab(1,2,index) = .true. - else if (abs(a_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to a b_ang) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) - endif - enddo -c ...then check b - do i=0,b_n-1 - if ((b_ang(i)-phi).gt.small .and. - + b_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = b_ang(i) -c Copy the values from b_tab into res_tab(1,,) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) -c Set default values for res_tab(0,,) - res_tab(0,0,index) = .true. - res_tab(0,1,index) = .false. - res_tab(0,2,index) = .true. - else if (abs(b_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to an a_ang) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) - endif - enddo - - if (res_ang(index) .eq. flag) then - res_n = index - done = .true. - else if (index .eq. n_max-1) then - res_n = n_max - done = .true. - else - phi = res_ang(index) ! Store previous angle - index = index+1 - endif - enddo - -c Fill the gaps -c First a... - index = 0 - if (a_n .gt. 0) then - do while (.not.res_tab(0,1,index)) - index=index+1 - enddo - done = res_tab(0,2,index) - do i=index+1,res_n-1 - if (res_tab(0,1,i)) then - done = res_tab(0,2,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - done = res_tab(0,0,index) - do i=index-1,0,-1 - if (res_tab(0,1,i)) then - done = res_tab(0,0,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(0,0,i) = .true. - res_tab(0,1,i) = .true. - res_tab(0,2,i) = .true. - enddo - endif -c ...then b - index = 0 - if (b_n .gt. 0) then - do while (.not.res_tab(1,1,index)) - index=index+1 - enddo - done = res_tab(1,2,index) - do i=index+1,res_n-1 - if (res_tab(1,1,i)) then - done = res_tab(1,2,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - done = res_tab(1,0,index) - do i=index-1,0,-1 - if (res_tab(1,1,i)) then - done = res_tab(1,0,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(1,0,i) = .true. - res_tab(1,1,i) = .true. - res_tab(1,2,i) = .true. - enddo - endif - -c Finally fill the last row with AND operation - do i=0,res_n-1 - do j=0,2 - res_tab(2,j,i) = (res_tab(0,j,i) .and. res_tab(1,j,i)) - enddo - enddo - - return - end - -c------------------------------------------------------------- - - subroutine construct_ranges(phi_n,phi_start,phi_end) -c Given the data in res_..., construct a table of -c min/max allowed angles - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - -c Local variables - logical done - integer index - - - if (res_n .eq. 0) then -c Any move is allowed - phi_n = 1 - phi_start(0) = -PI - phi_end(0) = PI - else - phi_n = 0 - index = 0 - done = .false. - do while (.not.done) -c Find start of range (01x) - done = .false. - do while (.not.done) - if (res_tab(2,0,index).or.(.not.res_tab(2,1,index))) then - index=index+1 - else - done = .true. - phi_start(phi_n) = res_ang(index) - endif - if (index .eq. res_n) done = .true. - enddo -c If a start was found (index < res_n), find the end of range (x10) -c It may not be found without wrapping around - if (index .lt. res_n) then - done = .false. - do while (.not.done) - if ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) then - index=index+1 - else - done = .true. - endif - if (index .eq. res_n) done = .true. - enddo - if (index .lt. res_n) then -c Found the end of the range - phi_end(phi_n) = res_ang(index) - phi_n=phi_n+1 - index=index+1 - if (index .eq. res_n) then - done = .true. - else - done = .false. - endif - else -c Need to wrap around - done = .true. - phi_end(phi_n) = flag - endif - endif - enddo -c Take care of the last one if need to wrap around - if (phi_end(phi_n) .eq. flag) then - index = 0 - do while ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) - index=index+1 - enddo - phi_end(phi_n) = res_ang(index) + 2.*PI - phi_n=phi_n+1 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine fix_no_moves(phi) - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - double precision phi - -c Local variables - integer index - double precision diff,temp - - -c Look for first 01x in gammas (there MUST be at least one) - diff = flag - index = 0 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index+1 - enddo - if (res_ang(index) .le. 0.D0) then ! Make sure it's from PHImax -c Try to increase PHImax - if (index .gt. 0) then - phi = res_ang(index-1) - diff = abs(res_ang(index) - res_ang(index-1)) - endif -c Look for last (corresponding) x10 - index = res_n - 1 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index-1 - enddo - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif - endif - -c If increasing PHImax didn't work, decreasing PHImin -c will (with one exception) -c Look for first x10 (there MUST be at least one) - index = 0 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index+1 - enddo - if (res_ang(index) .lt. 0.D0) then ! Make sure it's from PHImin -c Try to decrease PHImin - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (res_ang(index+1) .le. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif -c Look for last (corresponding) 01x - index = res_n - 1 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index-1 - enddo - if (index .gt. 0) then - temp = abs(res_ang(index) - res_ang(index-1)) - if (res_ang(index-1) .ge. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index-1) - diff = temp - endif - endif - endif - -c If it still didn't work, it must be PHImax == 0. or PHImin == PI - if (diff .eq. flag) then - index = 0 - if (res_tab(index,1,0) .or. (.not.res_tab(index,1,1)) .or. - + res_tab(index,1,2)) index = res_n - 1 -c This MUST work at this point - if (index .eq. 0) then - phi = res_ang(1) - else - phi = res_ang(index - 1) - endif - endif - - return - end - -c------------------------------------------------------------- - - integer function move_res(PHImin,PHImax,i_move) -c Moves residue i_move (in array c), leaving everything else fixed -c Starting geometry is not checked, it should be correct! -c R(,i_move) is the only residue that will move, but must have -c 1 < i_move < nres (i.e., cannot move ends) -c Whether any output is done is controlled by locmove_output -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c External functions - double precision ran_number - external ran_number - -c Input arguments - double precision PHImin,PHImax - integer i_move - -c RETURN VALUES: -c 0: move successfull -c 1: Dmin or Dmax had to be modified -c 2: move failed - check your input geometry - - -c Local variables - double precision X(0:2),Y(0:2),Z(0:2),Orig(0:2) - double precision P(0:2) - logical no_moves,done - integer index,i,j - double precision phi,temp,radius - double precision phi_start(0:11), phi_end(0:11) - integer phi_n - -c Set up the coordinate system - do i=0,2 - Orig(i)=0.5*(c(i+1,i_move-1)+c(i+1,i_move+1)) ! Position of origin - enddo - - do i=0,2 - Z(i)=c(i+1,i_move+1)-c(i+1,i_move-1) - enddo - temp=sqrt(Z(0)*Z(0)+Z(1)*Z(1)+Z(2)*Z(2)) - do i=0,2 - Z(i)=Z(i)/temp - enddo - - do i=0,2 - X(i)=c(i+1,i_move)-Orig(i) - enddo -c radius is the radius of the circle on which c(,i_move) can move - radius=sqrt(X(0)*X(0)+X(1)*X(1)+X(2)*X(2)) - do i=0,2 - X(i)=X(i)/radius - enddo - - Y(0)=Z(1)*X(2)-X(1)*Z(2) - Y(1)=X(0)*Z(2)-Z(0)*X(2) - Y(2)=Z(0)*X(1)-X(0)*Z(1) - -c Calculate min, max angles coming from dmin, dmax to c(,i_move-2) - if (i_move.gt.2) then - do i=0,2 - P(i)=c(i+1,i_move-2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,a_n,a_ang,a_tab) - else - a_n=0 - endif - -c Calculate min, max angles coming from dmin, dmax to c(,i_move+2) - if (i_move.lt.nres-2) then - do i=0,2 - P(i)=c(i+1,i_move+2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,b_n,b_ang,b_tab) - else - b_n=0 - endif - -c Construct the resulting table for alpha and beta - call construct_tab() - - if (locmove_output) then - print *,'ALPHAS & BETAS TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - if (no_moves) then - if (locmove_output) print *,' *** Cannot move anywhere' - move_res=2 - return - endif - -c Transfer res_... into a_... - a_n = 0 - do i=0,res_n-1 - if ( (res_tab(2,0,i).neqv.res_tab(2,1,i)) .or. - + (res_tab(2,0,i).neqv.res_tab(2,2,i)) ) then - a_ang(a_n) = res_ang(i) - do j=0,2 - a_tab(j,a_n) = res_tab(2,j,i) - enddo - a_n=a_n+1 - endif - enddo - -c Check that the PHI's are within [0,PI] - if (PHImin .lt. 0. .or. abs(PHImin) .lt. small) PHImin = -flag - if (PHImin .gt. PI .or. abs(PHImin-PI) .lt. small) PHImin = PI - if (PHImax .gt. PI .or. abs(PHImax-PI) .lt. small) PHImax = flag - if (PHImax .lt. 0. .or. abs(PHImax) .lt. small) PHImax = 0. - if (PHImax .lt. PHImin) PHImax = PHImin -c Calculate min and max angles coming from PHImin and PHImax, -c and put them in b_... - call angles2tab(PHImin, PHImax, b_n, b_ang, b_tab) -c Construct the final table - call construct_tab() - - if (locmove_output) then - print *,'FINAL TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - - if (no_moves) then -c Take care of the case where no solution exists... - call fix_no_moves(phi) - if (locmove_output) then - print *,' *** Had to modify PHImin or PHImax' - print *,'phi: ',phi*rad2deg - endif - move_res=1 - else -c ...or calculate the solution -c Construct phi_start/phi_end arrays - call construct_ranges(phi_n, phi_start, phi_end) -c Choose random angle phi in allowed range(s) - temp = 0. - do i=0,phi_n-1 - temp = temp + phi_end(i) - phi_start(i) - enddo - phi = ran_number(phi_start(0),phi_start(0)+temp) - index = 0 - done = .false. - do while (.not.done) - if (phi .lt. phi_end(index)) then - done = .true. - else - index=index+1 - endif - if (index .eq. phi_n) then - done = .true. - else if (.not.done) then - phi = phi + phi_start(index) - phi_end(index-1) - endif - enddo - if (index.eq.phi_n) phi=phi_end(phi_n-1) ! Fix numerical errors - if (phi .gt. PI) phi = phi-2.*PI - - if (locmove_output) then - print *,'ALLOWED RANGE(S)' - do i=0,phi_n-1 - print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg - enddo - print *,'phi: ',phi*rad2deg - endif - move_res=0 - endif - -c Re-use radius as temp variable - temp=radius*cos(phi) - radius=radius*sin(phi) - do i=0,2 - c(i+1,i_move)=Orig(i)+temp*X(i)+radius*Y(i) - enddo - - return - end - -c------------------------------------------------------------- - - subroutine loc_test -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - -c Local variables - integer i,j - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - double precision phi - double precision R(0:2,0:5) - - locmove_output=.true. - -c call angles2tab(30.*deg2rad,70.*deg2rad,a_n,a_ang,a_tab) -c call angles2tab(80.*deg2rad,130.*deg2rad,b_n,b_ang,b_tab) -c call minmax_angles(0.D0,3.8D0,0.D0,3.8D0,b_n,b_ang,b_tab) -c call construct_tab -c call output_tabs - -c call construct_ranges(phi_n,phi_start,phi_end) -c do i=0,phi_n-1 -c print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg -c enddo - -c call fix_no_moves(phi) -c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg - - R(0,0)=0.D0 - R(1,0)=0.D0 - R(2,0)=0.D0 - R(0,1)=0.D0 - R(1,1)=-cos(28.D0*deg2rad) - R(2,1)=-0.5D0-sin(28.D0*deg2rad) - R(0,2)=0.D0 - R(1,2)=0.D0 - R(2,2)=-0.5D0 - R(0,3)=cos(30.D0*deg2rad) - R(1,3)=0.D0 - R(2,3)=0.D0 - R(0,4)=0.D0 - R(1,4)=0.D0 - R(2,4)=0.5D0 - R(0,5)=0.D0 - R(1,5)=cos(26.D0*deg2rad) - R(2,5)=0.5D0+sin(26.D0*deg2rad) - do i=1,5 - do j=0,2 - R(j,i)=vbl*R(j,i) - enddo - enddo -c i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) - imov=nnt - i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov) - print *,'RETURNED ',i - print *,(R(i,3)/vbl,i=0,2) - - return - end - -c------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/map.f b/source/unres/src_MD-DFA-restraints/map.f deleted file mode 100644 index 9dbe64e..0000000 --- a/source/unres/src_MD-DFA-restraints/map.f +++ /dev/null @@ -1,90 +0,0 @@ - subroutine map - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.TORCNSTR' - double precision energia(0:n_ene) - character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/ - double precision ang_list(10) - double precision g(maxvar),x(maxvar) - integer nn(10) - write (iout,'(a,i3,a)')'Energy map constructed in the following ', - & nmap,' groups of variables:' - do i=1,nmap - write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ', - & res1(i),' to ',res2(i) - enddo - nmax=nstep(1) - do i=2,nmap - if (nmax.lt.nstep(i)) nmax=nstep(i) - enddo - ntot=nmax**nmap - iii=0 - write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap), - & (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM" - do i=0,ntot-1 - ii=i - do j=1,nmap - nn(j)=mod(ii,nmax)+1 - ii=ii/nmax - enddo - do j=1,nmap - if (nn(j).gt.nstep(j)) goto 10 - enddo - iii=iii+1 -Cd write (iout,*) i,iii,(nn(j),j=1,nmap) - do j=1,nmap - ang_list(j)=ang_from(j) - & +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j) - do k=res1(j),res2(j) - goto (1,2,3,4), kang(j) - 1 phi(k)=deg2rad*ang_list(j) - if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j) - goto 5 - 2 theta(k)=deg2rad*ang_list(j) - goto 5 - 3 alph(k)=deg2rad*ang_list(j) - goto 5 - 4 omeg(k)=deg2rad*ang_list(j) - 5 continue - enddo ! k - enddo ! j - call chainbuild - call int_from_cart1(.false.) - if (minim) then - call geom_to_var(nvar,x) - call minimize(etot,x,iretcode,nfun) - print *,'SUMSL return code is',iretcode,' eval ',nfun -c call intout - else - call zerograd - call geom_to_var(nvar,x) - endif - call etotal(energia(0)) - etot = energia(0) - nf=1 - nfl=3 - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - gnorm=0.0d0 - do k=1,nvar - gnorm=gnorm+g(k)**2 - enddo - etot=energia(0) - - gnorm=dsqrt(gnorm) -c write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm - write (istat,'(30e15.5)') (ang_list(k),k=1,nmap), - & (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm -c write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap) -c call intout -c call enerprint(energia) - 10 continue - enddo ! i - return - end diff --git a/source/unres/src_MD-DFA-restraints/matmult.f b/source/unres/src_MD-DFA-restraints/matmult.f deleted file mode 100644 index e9257cf..0000000 --- a/source/unres/src_MD-DFA-restraints/matmult.f +++ /dev/null @@ -1,18 +0,0 @@ - SUBROUTINE MATMULT(A1,A2,A3) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(3,3),A2(3,3),A3(3,3) - DIMENSION AI3(3,3) - DO 1 I=1,3 - DO 2 J=1,3 - A3IJ=0.0 - DO 3 K=1,3 - 3 A3IJ=A3IJ+A1(I,K)*A2(K,J) - AI3(I,J)=A3IJ - 2 CONTINUE - 1 CONTINUE - DO 4 I=1,3 - DO 4 J=1,3 - 4 A3(I,J)=AI3(I,J) - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/mc.F b/source/unres/src_MD-DFA-restraints/mc.F deleted file mode 100644 index 0f39d48..0000000 --- a/source/unres/src_MD-DFA-restraints/mc.F +++ /dev/null @@ -1,819 +0,0 @@ - subroutine monte_carlo -C Does Boltzmann and entropic sampling without energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond,nbins - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,elowest1, - & ehighest,ehighest1,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - integer moves1(-1:MaxMoveType+1,0:MaxProcs-1), - & moves_acc1(-1:MaxMoveType+1,0:MaxProcs-1) -#ifdef MPL - double precision etot_temp,etot_all(0:MaxProcs) - external d_vadd,d_vmin,d_vmax - double precision entropy1(-max_ene:max_ene), - & nhist1(-max_ene:max_ene) - integer nbond_move1(maxres*(MaxProcs+1)), - & nbond_acc1(maxres*(MaxProcs+1)),itemp(2) -#endif - double precision var_lowest(maxvar) - double precision energia(0:n_ene),energia_ave(0:n_ene) -C - write(iout,'(a,i8,2x,a,f10.5)') - & 'pool_read_freq=',pool_read_freq,' pool_fraction=',pool_fraction - open (istat,file=statname) - WhatsUp=0 - indminn=-max_ene - indmaxx=max_ene - facee=1.0D0/(maxacc*delte) -C Number of bins in energy histogram - nbins=e_up/delte-1 - write (iout,*) 'NBINS=',nbins - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool - elowest=1.0D+10 - ehighest=-1.0D+10 -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy; -C set NSWEEP=1 for Boltzmann sampling. -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C -C Initialize the IFINISH array. -C -#ifdef MPL - do i=1,nctasks - ifinish(i)=0 - enddo -#endif -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - nbond_acc(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=-1,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - rewind(istat) - write (iout,*) 'emin=',emin,' emax=',emax - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else if (isweep.gt.1) then - if (eold.lt.emax) then - do i=1,nvar - varia(i)=varold(i) - enddo - else - do i=1,nvar - varia(i)=var_lowest(i) - enddo - endif - call var_to_geom(nvar,varia) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call geom_to_var(nvar,varia) - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - write (istat,'(i10,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - write (istat,'(i10,14(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif -c close(istat) - neneval=neneval+1 - if (.not. ent_read) then -C Initialize the entropy array -#ifdef MPL -C Collect total energies from other processors. - etot_temp=etot - etot_all(0)=etot - call mp_gather(etot_temp,etot_all,8,MasterID,cgGroupID) - if (MyID.eq.MasterID) then -C Get the lowest and the highest energy. - print *,'MASTER: etot_temp: ',(etot_all(i),i=0,nprocs-1), - & ' emin=',emin,' emax=',emax - emin=1.0D10 - emax=-1.0D10 - do i=0,nprocs - if (emin.gt.etot_all(i)) emin=etot_all(i) - if (emax.lt.etot_all(i)) emax=etot_all(i) - enddo - emax=emin+e_up - endif ! MyID.eq.MasterID - etot_all(1)=emin - etot_all(2)=emax - print *,'Processor',MyID,' calls MP_BCAST to send/recv etot_all' - call mp_bcast(etot_all(1),16,MasterID,cgGroupID) - print *,'Processor',MyID,' MP_BCAST to send/recv etot_all ended' - if (MyID.ne.MasterID) then - print *,'Processor:',MyID,etot_all(1),etot_all(2), - & etot_all(1),etot_all(2) - emin=etot_all(1) - emax=etot_all(2) - endif ! MyID.ne.MasterID - write (iout,*) 'After MP_GATHER etot_temp=', - & etot_temp,' emin=',emin -#else - emin=etot - emax=emin+e_up - indminn=0 - indmin=0 -#endif - IF (MULTICAN) THEN -C Multicanonical sampling - start from Boltzmann distribution - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ELSE -C Entropic sampling - start from uniform distribution of the density of states - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - ENDIF ! MULTICAN - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - if (isweep.eq.1) then - emax=emin+e_up - indminn=0 - indmin=0 - indmaxx=indminn+nbins - indmax=indmaxx - endif ! isweep.eq.1 - endif ! .not. ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done=.true. -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - call entropia(eold,sold,indeold) -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -C Main loop. -c---------------------------------------------------------------------------- -C Zero out average energies - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo -C Initialize energy histogram - do i=-max_ene,max_ene - nhist(i)=0.0D0 - enddo ! i -C Zero out iteration counter. - it=0 - do j=1,nvar - varold(j)=varia(j) - enddo -C Begin MC iteration loop. - do while (not_done) - it=it+1 -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to take a conformation from the pool or generate/perturb one -C randomly - from_pool=ran_number(0.0D0,1.0D0) - if (npool.gt.0 .and. from_pool.lt.pool_fraction) then -C Throw a dice to choose the conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - call var_to_geom(nvar,varia) - call chainbuild -cd call intout -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i3,a,f10.5)') - & 'Try conformation',ii,' from the pool energy=',epool(ii) - MoveType=-1 - moves(-1)=moves(-1)+1 - else -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,0.1D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - endif ! pool -Cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+1 -cd call enerprint(energia(0)) -cd write(iout,*)'it=',it,' etot=',etot - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accept_mc(it,etot,eold,scur,sold,varia,varold,accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) then - elowest=etot - do i=1,nvar - var_lowest(i)=varia(i) - enddo - endif - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Compare with reference structure. - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - endif ! refstr -C -C Periodically save average energies and confs. -C - do i=0,n_ene - energia_ave(i)=energia_ave(i)+energia(i) - enddo - moves(MaxMoveType+1)=nmove - moves_acc(MaxMoveType+1)=nacc - IF ((it/save_frequency)*save_frequency.eq.it) THEN - do i=0,n_ene - energia_ave(i)=energia_ave(i)/save_frequency - enddo - etot_ave=energia_ave(0) -C#ifdef AIX -C open (istat,file=statname,position='append') -C#else -C open (istat,file=statname,access='append') -Cendif - if (print_mc.gt.0) - & write (iout,'(80(1h*)/20x,a,i20)') - & 'Iteration #',it - if (refstr .and. print_mc.gt.0) then - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif - if (print_stat) then - if (refstr) then - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave,rms_ave,frac_ave - else - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave - endif - endif -c close(istat) - if (print_mc.gt.0) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo - ENDIF ! ( (it/save_frequency)*save_frequency.eq.it) -C Update histogram - inde=icialosc((etot-emin)/delte) - nhist(inde)=nhist(inde)+1.0D0 -#ifdef MPL - if ( (it/message_frequency)*message_frequency.eq.it - & .and. (MyID.ne.MasterID) ) then - call recv_stop_sig(Kwita) - call send_MCM_info(message_frequency) - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif -C if ((ntrial.gt.maxtrial_iter -C & .or. (it/pool_read_freq)*pool_read_freq.eq.it) -C & .and. npool.gt.0) then -C Take a conformation from the pool -C ii=iran_num(1,npool) -C do i=1,nvar -C varold(i)=xpool(i,ii) -C enddo -C if (ntrial.gt.maxtrial_iter) -C & write (iout,*) 'Iteration',it,' max. # of trials exceeded.' -C write (iout,*) -C & 'Take conformation',ii,' from the pool energy=',epool(ii) -C if (print_mc.gt.2) -C & write (iout,'(10f8.3)') (rad2deg*varold(i),i=1,nvar) -C ntrial=0 -C eold=epool(ii) -C call entropia(eold,sold,indeold) -C accepted=.true. -C endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - if (MyID.ne.MasterID) call send_MCM_info(-1) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) - if (MyID.ne.MasterID) call send_MCM_info(-1) -#endif - 21 continue - write (iout,'(/a)') 'Energy histogram' - do i=-100,100 - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo -#ifdef MPL -C Wait until every processor has sent complete MC info. - if (MyID.eq.MasterID) then - not_done=.true. - do while (not_done) -C write (*,*) 'The IFINISH array:' -C write (*,*) (ifinish(i),i=1,nctasks) - not_done=.false. - do i=2,nctasks - not_done=not_done.or.(ifinish(i).ge.0) - enddo - if (not_done) call receive_MC_info - enddo - endif -C Make collective histogram from the work of all processors. - msglen=(2*max_ene+1)*8 - print *, - & 'Processor',MyID,' calls MP_REDUCE to send/receive histograms', - & ' msglen=',msglen - call mp_reduce(nhist,nhist1,msglen,MasterID,d_vadd, - & cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for histogr.' - do i=-max_ene,max_ene - nhist(i)=nhist1(i) - enddo -C Collect min. and max. energy - print *, - &'Processor',MyID,' calls MP_REDUCE to send/receive energy borders' - call mp_reduce(elowest,elowest1,8,MasterID,d_vmin,cgGroupID) - call mp_reduce(ehighest,ehighest1,8,MasterID,d_vmax,cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for energies.' - IF (MyID.eq.MasterID) THEN - elowest=elowest1 - ehighest=ehighest1 -#endif - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - indmin=icialosc((elowest-emin)/delte) - imdmax=icialosc((ehighest-emin)/delte) - if (indmin.lt.indminn) then - emax=emin+indmin*delte+e_up - indmaxx=indmin+nbins - indminn=indmin - endif - if (.not.ent_read) ent_read=.true. - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - ELSE - if (.not. ent_read) ent_read=.true. - ENDIF ! MyID .eq. MaterID - if (MyID.eq.MasterID) then - itemp(1)=indminn - itemp(2)=indmaxx - endif - print *,'before mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - call mp_bcast(itemp(1),8,MasterID,cgGroupID) - call mp_bcast(emax,8,MasterID,cgGroupID) - print *,'after mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - if (MyID .ne. MasterID) then - indminn=itemp(1) - indmaxx=itemp(2) - endif - msglen=(indmaxx-indminn+1)*8 - print *,'processor',MyID,' calling mp_bcast msglen=',msglen, - & ' indminn=',indminn,' indmaxx=',indmaxx,' isweep=',isweep - call mp_bcast(entropy(indminn),msglen,MasterID,cgGroupID) - IF(MyID.eq.MasterID .and. .not. ovrtim() .and. WhatsUp.ge.0)THEN - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - ELSE - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - ENDIF ! MyID.eq.MasterID - print *,'Processor',MyID,' calls MP_GATHER' - call mp_gather(nbond_move,nbond_move1,4*Nbm,MasterID, - & cgGroupID) - call mp_gather(nbond_acc,nbond_acc1,4*Nbm,MasterID, - & cgGroupID) - print *,'Processor',MyID,' MP_GATHER call accomplished' - if (MyID.eq.MasterID) then - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - - write (iout,'(a)') - & 'Statistics of multi-bond moves of respective processors:' - do iproc=1,Nprocs-1 - do i=1,Nbm - ind=iproc*nbm+i - nbond_move(i)=nbond_move(i)+nbond_move1(ind) - nbond_acc(i)=nbond_acc(i)+nbond_acc1(ind) - enddo - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' nbond_move:', - & (nbond_move1(iproc*nbm+i),i=1,Nbm), - & ' nbond_acc:',(nbond_acc1(iproc*nbm+i),i=1,Nbm) - enddo - endif - call mp_gather(moves,moves1,4*(MaxMoveType+3),MasterID, - & cgGroupID) - call mp_gather(moves_acc,moves_acc1,4*(MaxMoveType+3), - & MasterID,cgGroupID) - if (MyID.eq.MasterID) then - do iproc=1,Nprocs-1 - do i=-1,MaxMoveType+1 - moves(i)=moves(i)+moves1(i,iproc) - moves_acc(i)=moves_acc(i)+moves_acc1(i,iproc) - enddo - enddo - nmove=0 - do i=0,MaxMoveType+1 - nmove=nmove+moves(i) - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' moves', - & (moves1(i,iproc),i=0,MaxMoveType+1), - & ' moves_acc:',(moves_acc1(i,iproc),i=0,MaxMoveType+1) - enddo - endif -#else - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) -#endif - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - if (ovrtim() .or. WhatsUp.lt.0) return - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accept_mc(it,ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - call entropia(ecur,scur,indecur) -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) then - write(iout,*)'it=',it,'ecur=',ecur,' indecur=',indecur, - & ' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected.' - endif - endif - return - end -c-------------------------------------------------------------------------- - integer function icialosc(x) - double precision x - if (x.lt.0.0D0) then - icialosc=dint(x)-1 - else - icialosc=dint(x) - endif - return - end -c-------------------------------------------------------------------------- - subroutine entropia(ecur,scur,indecur) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - double precision ecur,scur - integer indecur - indecur=icialosc((ecur-emin)/delte) - if (iabs(indecur).gt.max_ene) then - if ((it/print_freq)*it.eq.it) write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.ge.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0 .and. (it/print_freq)*it.eq.it) - & write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/mcm.F b/source/unres/src_MD-DFA-restraints/mcm.F deleted file mode 100644 index d9ca9ad..0000000 --- a/source/unres/src_MD-DFA-restraints/mcm.F +++ /dev/null @@ -1,1481 +0,0 @@ - subroutine mcm_setup - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.CONTROL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.VAR' -C -C Set up variables used in MC/MCM. -C - write (iout,'(80(1h*)/20x,a/80(1h*))') 'MCM control parameters:' - write (iout,'(5(a,i7))') 'Maxacc:',maxacc,' MaxTrial:',MaxTrial, - & ' MaxRepm:',MaxRepm,' MaxGen:',MaxGen,' MaxOverlap:',MaxOverlap - write (iout,'(4(a,f8.1)/2(a,i3))') - & 'Tmin:',Tmin,' Tmax:',Tmax,' TstepH:',TstepH, - & ' TstepC:',TstepC,'NstepH:',NstepH,' NstepC:',NstepC - if (nwindow.gt.0) then - write (iout,'(a)') 'Perturbation windows:' - do i=1,nwindow - i1=winstart(i) - i2=winend(i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(a,i3,a,i3,a,i3)') restyp(it1),i1,restyp(it2),i2, - & ' length',winlen(i) - enddo - endif -C Rbolt=8.3143D-3*2.388459D-01 kcal/(mol*K) - RBol=1.9858D-3 -C Number of "end bonds". - koniecl=0 -c koniecl=nphi - print *,'koniecl=',koniecl - write (iout,'(a)') 'Probabilities of move types:' - write (*,'(a)') 'Probabilities of move types:' - do i=1,MaxMoveType - write (iout,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - write (*,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - enddo - write (iout,*) -C Maximum length of N-bond segment to be moved -c nbm=nres-1-(2*koniecl-1) - if (nwindow.gt.0) then - maxwinlen=winlen(1) - do i=2,nwindow - if (winlen(i).gt.maxwinlen) maxwinlen=winlen(i) - enddo - nbm=min0(maxwinlen,6) - write (iout,'(a,i3,a,i3)') 'Nbm=',Nbm,' Maxwinlen=',Maxwinlen - else - nbm=min0(6,nres-2) - endif - sumpro_bond(0)=0.0D0 - sumpro_bond(1)=0.0D0 - do i=2,nbm - sumpro_bond(i)=sumpro_bond(i-1)+1.0D0/dfloat(i) - enddo - write (iout,'(a)') 'The SumPro_Bond array:' - write (iout,'(8f10.5)') (sumpro_bond(i),i=1,nbm) - write (*,'(a)') 'The SumPro_Bond array:' - write (*,'(8f10.5)') (sumpro_bond(i),i=1,nbm) -C Maximum number of side chains moved simultaneously -c print *,'nnt=',nnt,' nct=',nct - ngly=0 - do i=nnt,nct - if (itype(i).eq.10) ngly=ngly+1 - enddo - mmm=nct-nnt-ngly+1 - if (mmm.gt.0) then - MaxSideMove=min0((nct-nnt+1)/2,mmm) - endif -c print *,'MaxSideMove=',MaxSideMove -C Max. number of generated confs (not used at present). - maxgen=10000 -C Set initial temperature - Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - write (iout,'(a,f8.1,a,f10.5)') 'Initial temperature:',Tcur, - & ' BetBol:',betbol - write (iout,*) 'RanFract=',ranfract - return - end -c------------------------------------------------------------------------------ -#ifndef MPI - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - serial code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,my_conf, - & enelower,non_conv - integer MoveType,nbond,conf_comp - integer ifeed(max_cache) - double precision varia(maxvar),varold(maxvar),elowest,eold, - & przes(3),obr(3,3) - double precision energia(0:n_ene) - double precision coord1(maxres,3) - -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 - - write (iout,*) 'RanFract=',RanFract - - WhatsUp=0 - Kwita=0 - -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - - call etotal(energia(0)) - etot = energia(0) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - if (print_stat) write (istat,'(i5,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - if (print_stat) close(istat) - neneval=neneval+nfun+1 - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_int) then - close(igeom) - call briefout(0,etot) - endif - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - - not_done = (iretcode.ne.11) - -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - do while (not_done) - it=it+1 - write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - accepted=.false. - do while (.not. accepted) - -C Retrieve the angles of previously accepted conformation - noverlap=0 ! # of overlapping confs. - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) goto 20 - MoveType=0 - nbond=0 - lprint=.true. -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - - call etotal(energia(0)) - etot=energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - if(iprint.gt.1.or.etot.lt.1d20) - & write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,*) 'etot from MINIMIZE:',etot -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+2 - endif -c call enerprint(energia(0)) - write (iout,'(a,i6,a,1pe16.6)') 'Conformation:',ngen, - & ' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - accepted=.false. - my_conf=.false. - - if (WhatsUp.eq.0 .and. Kwita.eq.0) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & my_conf,EneLower) - endif - write (iout,*) 'My_Conf=',My_Conf,' EneLower=',EneLower - if (accepted) then - - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (print_stat) then -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - endif - call statprint(nacc,nfun,iretcode,etot,elowest) - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - endif ! refstr - if (My_Conf) then - nout=nout+1 - write (iout,*) 'Writing new conformation',nout - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - if (print_stat) close(istat) -C Print internal coordinates. - if (print_int) call briefout(nout,etot) -C Accumulate the newly accepted conf in the coord1 array, if it is different -C from all confs that are already there. - call compare_s1(n_thr,max_thread2,etot,varia,ii, - & enetb1,coord1,rms_deform,.true.,iprint) - write (iout,*) 'After compare_ss: n_thr=',n_thr - if (ii.eq.1 .or. ii.eq.3) then - write (iout,'(8f10.4)') - & (rad2deg*coord1(i,n_thr),i=1,nvar) - endif - else - write (iout,*) 'Conformation from cache, not written.' - endif ! My_Conf - - if (nrepm.gt.maxrepm) then - write (iout,'(a)') 'Too many conformation repetitions.' - goto 20 - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - - else - - ntrial=ntrial+1 - endif ! accepted - endif ! overlap - - 30 continue - enddo ! accepted -C Check for time limit. - if (ovrtim()) WhatsUp=-1 - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) - - enddo ! not_done - goto 21 - 20 WhatsUp=-3 - - 21 continue - runtime=tcpu() - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - - return - end -#endif -#ifdef MPI -c------------------------------------------------------------------------------ - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - parallel code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.INFO' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.MINIM' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,similar, - & enelower,non_conv,flag,finish - integer MoveType,nbond,conf_comp - double precision varia(maxvar),varold(maxvar),elowest,eold, - & x1(maxvar), varold1(maxvar), przes(3),obr(3,3) - integer iparentx(max_threadss2) - integer iparentx1(max_threadss2) - integer imtasks(150),imtasks_n - double precision energia(0:n_ene) - - print *,'Master entered DO_MCM' - nodenum = nprocs - - finish=.false. - imtasks_n=0 - do i=1,nodenum-1 - imtasks(i)=0 - enddo -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won`t be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 -c write (iout,*) 'RanFract=',RanFract - WhatsUp=0 - Kwita=0 -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Request energy computation from slave processors. - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - neneval=0 - eneglobal=1.0d99 - if (print_mc .gt. 0) write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_mc .gt. 0) write (iout,'(i5,1pe14.5)' ) i_orig,etot - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) -c diagnostics - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energia(0)) - if (print_mc.gt.0) write (iout,*) 'Initial energy:',etot -c end diagnostics - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - not_done=.true. -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - LOOP1:do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - LOOP2:do while (.not. accepted) - - LOOP3:do while (imtasks_n.lt.nodenum-1.and..not.finish) - do i=1,nodenum-1 - if(imtasks(i).eq.0) then - is=i - exit - endif - enddo -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) then - finish=.true. - endif - MoveType=0 - nbond=0 -c write (iout,'(a)') 'Old variables:' -c write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) -c print *,'after perturb',error,finish - if (error) finish = .true. - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - finish=.true. - write (*,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - ngen=ngen+1 -c print *,'finish=',finish - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.1) write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - if(iprint.gt.1.or.etot.lt.1d19) print *, - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,*) 'Too many overlapping confs.', - & ' etot, elowest, overlap_cut', etot, elowest, overlap_cut - finish=.true. - endif - else if (.not. finish) then -C Distribute tasks to processors -c print *,'Master sending order' - call MPI_SEND(12, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) '12: tag=',tag -c print *,'Master sent order to processor',is - call MPI_SEND(it, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'it: tag=',tag - call MPI_SEND(eold, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'eold: tag=',tag - call MPI_SEND(varia(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varia: tag=',tag - call MPI_SEND(varold(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varold: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - imtasks(is)=1 - imtasks_n=imtasks_n+1 -C End distribution - endif ! overlap - enddo LOOP3 - - flag = .false. - LOOP_RECV:do while(.not.flag) - do is=1, nodenum-1 - call MPI_IPROBE(is,tag,CG_COMM,flag,status,ierr) - if(flag) then - call MPI_RECV(iitt, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(eold1, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(etot, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(varia(1), nvar, MPI_DOUBLE_PRECISION,is,tag, - & CG_COMM, status, ierr) - call MPI_RECV(varold1(1), nvar, MPI_DOUBLE_PRECISION, is, - & tag, CG_COMM, status, ierr) - call MPI_RECV(ii_grnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_ennum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_hesnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - i_grnum_d=i_grnum_d+ii_grnum_d - i_ennum_d=i_ennum_d+ii_ennum_d - neneval = neneval+ii_ennum_d - i_hesnum_d=i_hesnum_d+ii_hesnum_d - i_minimiz=i_minimiz+1 - imtasks(is)=0 - imtasks_n=imtasks_n-1 - exit - endif - enddo - enddo LOOP_RECV - - if(print_mc.gt.0) write (iout,'(a,i6,a,i6,a,i6,a,1pe16.6)') - & 'From Worker #',is,' iitt',iitt, - & ' Conformation:',ngen,' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - call metropolis(nvar,varia,varold1,etot,eold1,accepted, - & similar,EneLower) - if(iitt.ne.it.and..not.similar) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & similar,EneLower) - accepted=enelower - endif - if(etot.lt.eneglobal)eneglobal=etot -c if(mod(it,100).eq.0) - write(iout,*)'CHUJOJEB ',neneval,eneglobal - if (accepted) then -C Write the accepted conformation. - nout=nout+1 - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif ! refstr - if (print_mc.gt.0) - & write (iout,*) 'Writing new conformation',nout - if (print_stat) then - call var_to_geom(nvar,varia) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - close(istat) - endif ! print_stat -C Print internal coordinates. - if (print_int) call briefout(nout,etot) - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (nrepm.gt.maxrepm) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Too many conformation repetitions.' - finish=.true. - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - else - ntrial=ntrial+1 - endif ! accepted - 30 continue - if(finish.and.imtasks_n.eq.0)exit LOOP2 - enddo LOOP2 ! accepted -C Check for time limit. - not_done = (it.lt.max_mcm_it) .and. (nacc_tot.lt.maxacc) - if(.not.not_done .or. finish) then - if(imtasks_n.gt.0) then - not_done=.true. - else - not_done=.false. - endif - finish=.true. - endif - enddo LOOP1 ! not_done - runtime=tcpu() - if (print_mc.gt.0) then - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - do is=1,nodenum-1 - call MPI_SEND(999, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) - enddo - return - end -c------------------------------------------------------------------------------ - subroutine execute_slave(nodeinfo,iprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INFO' - include 'COMMON.MINIM' - character*10 nodeinfo - double precision x(maxvar),x1(maxvar) - nodeinfo='chujwdupe' -c print *,'Processor:',MyID,' Entering execute_slave' - tag=0 -c call MPI_SEND(nodeinfo, 10, MPI_CHARACTER, 0, tag, -c & CG_COMM, ierr) - -1001 call MPI_RECV(i_switch, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - if(iprint.ge.2)print *, MyID,' recv order ',i_switch - if (i_switch.eq.12) then - i_grnum_d=0 - i_ennum_d=0 - i_hesnum_d=0 - call MPI_RECV(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - call MPI_RECV(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'ener: tag=',tag - call MPI_RECV(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x: tag=',tag - call MPI_RECV(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x1: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif -c print *,'calling minimize' - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.0) - & write(iout,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - write(*,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - 100 format(a20,f10.5,a12,i5,a6,i2) - if(iretcode.eq.10) then - do iminrep=2,3 - if(iprint.gt.1) - & write(iout,*)' ... not converged - trying again ',iminrep - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.1) - & write(iout,*)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - if(iretcode.ne.10)go to 812 - enddo - if(iretcode.eq.10) then - if(iprint.gt.1) - & write(iout,*)' ... not converged again - giving up' - go to 812 - endif - endif -812 continue -c print *,'Sending results' - call MPI_SEND(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(energyx, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_grnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(nfun, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_hesnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) -c print *,'End sending' - go to 1001 - endif - - return - end -#endif -c------------------------------------------------------------------------------ - subroutine statprint(it,nfun,iretcode,etot,elowest) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - if (minim) then - write (iout, - & '(80(1h*)/a,i5,a,1pe14.5,a,1pe14.5/a,i3,a,i10,a,i5,a,i5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest, - & 'SUMSL return code:',iretcode, - & ' # of energy evaluations:',neneval, - & '# of temperature jumps:',ntherm, - & ' # of minima repetitions:',nrepm - else - write (iout,'(80(1h*)/a,i8,a,1pe14.5,a,1pe14.5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest - endif - write (iout,'(/4a)') - & 'Kind of move ',' total',' accepted', - & ' fraction' - write (iout,'(58(1h-))') - do i=-1,MaxMoveType - if (moves(i).eq.0) then - fr_mov_i=0.0d0 - else - fr_mov_i=dfloat(moves_acc(i))/dfloat(moves(i)) - endif - write(iout,'(a,2i15,f10.5)')MovTypID(i),moves(i),moves_acc(i), - & fr_mov_i - enddo - write (iout,'(a,2i15,f10.5)') 'total ',nmove,nacc_tot, - & dfloat(nacc_tot)/dfloat(nmove) - write (iout,'(58(1h-))') - write (iout,'(a,1pe12.4)') 'Elapsed time:',tcpu() - return - end -c------------------------------------------------------------------------------ - subroutine heat(over) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - logical over -C Check if there`s a need to increase temperature. - if (ntrial.gt.maxtrial) then - if (NstepH.gt.0) then - if (dabs(Tcur-TMax).lt.1.0D-7) then - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a/80(1h*))') - & 'Upper limit of temperature reached. Terminating.' - over=.true. - Tcur=Tmin - else - Tcur=Tcur*TstepH - if (Tcur.gt.Tmax) Tcur=Tmax - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System heated up to ',Tcur,' K; BetBol:',betbol - ntherm=ntherm+1 - ntrial=0 - over=.false. - endif - else - if (print_mc.gt.0) - & write (iout,'(a)') - & 'Maximum number of trials in a single MCM iteration exceeded.' - over=.true. - Tcur=Tmin - endif - else - over=.false. - endif - return - end -c------------------------------------------------------------------------------ - subroutine cool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - if (nstepC.gt.0 .and. dabs(Tcur-Tmin).gt.1.0D-7) then - Tcur=Tcur/TstepC - if (Tcur.lt.Tmin) Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System cooled down up to ',Tcur,' K; BetBol:',betbol - endif - return - end -C--------------------------------------------------------------------------- - subroutine zapis(varia,etot) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer itemp(maxsave) - double precision varia(maxvar) - logical lprint - lprint=.false. - if (lprint) then - write (iout,'(a,i5,a,i5)') 'Enter ZAPIS NSave=',Nsave, - & ' MaxSave=',MaxSave - write (iout,'(a)') 'Current energy and conformation:' - write (iout,'(1pe14.5)') etot - write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - endif -C Shift the contents of the esave and varsave arrays if filled up. - call add2cache(maxvar,maxsave,nsave,nvar,MyID,itemp, - & etot,varia,esave,varsave) - if (lprint) then - write (iout,'(a)') 'Energies and the VarSave array.' - do i=1,nsave - write (iout,'(i5,1pe14.5)') i,esave(i) - write (iout,'(10f8.3)') (rad2deg*varsave(j,i),j=1,nvar) - enddo - endif - return - end -C--------------------------------------------------------------------------- - subroutine perturb(error,lprint,MoveType,nbond,max_phi) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (MMaxSideMove=100) - include 'COMMON.MCM' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM1' - logical error,lprint,fail - integer MoveType,nbond,end_select,ind_side(MMaxSideMove) - double precision max_phi - double precision psi,gen_psi - external iran_num - integer iran_num - integer ifour - data ifour /4/ - error=.false. - lprint=.false. -C Perturb the conformation according to a randomly selected move. - call SelectMove(MoveType) -c write (iout,*) 'MoveType=',MoveType - itrial=0 - goto (100,200,300,400,500) MoveType -C------------------------------------------------------------------------------ -C Backbone N-bond move. -C Select the number of bonds (length of the segment to perturb). - 100 continue - if (itrial.gt.1000) then - write (iout,'(a)') 'Too many attempts at multiple-bond move.' - error=.true. - return - endif - bond_prob=ran_number(0.0D0,sumpro_bond(nbm)) -c print *,'sumpro_bond(nbm)=',sumpro_bond(nbm), -c & ' Bond_prob=',Bond_Prob - do i=1,nbm-1 -c print *,i,Bond_Prob,sumpro_bond(i),sumpro_bond(i+1) - if (bond_prob.ge.sumpro_bond(i) .and. - & bond_prob.le.sumpro_bond(i+1)) then - nbond=i+1 - goto 10 - endif - enddo - write (iout,'(2a)') 'In PERTURB: Error - number of bonds', - & ' to move out of range.' - error=.true. - return - 10 continue - if (nwindow.gt.0) then -C Select the first residue to perturb - iwindow=iran_num(1,nwindow) - print *,'iwindow=',iwindow - iiwin=1 - do while (winlen(iwindow).lt.nbond) - iwindow=iran_num(1,nwindow) - iiwin=iiwin+1 - if (iiwin.gt.1000) then - write (iout,'(a)') 'Cannot select moveable residues.' - error=.true. - return - endif - enddo - nstart=iran_num(winstart(iwindow),winend(iwindow)) - else - nstart = iran_num(koniecl+2,nres-nbond-koniecl) -cd print *,'nres=',nres,' nbond=',nbond,' koniecl=',koniecl, -cd & ' nstart=',nstart - endif - psi = gen_psi() - if (psi.eq.0.0) then - error=.true. - return - endif - if (print_mc.gt.1) write (iout,'(a,i4,a,i4,a,f8.3)') - & 'PERTURB: nbond=',nbond,' nstart=',nstart,' psi=',psi*rad2deg -cd print *,'nstart=',nstart - call bond_move(nbond,nstart,psi,.false.,error) - if (error) then - write (iout,'(2a)') - & 'Could not define reference system in bond_move, ', - & 'choosing ahother segment.' - itrial=itrial+1 - goto 100 - endif - nbond_move(nbond)=nbond_move(nbond)+1 - moves(1)=moves(1)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Backbone endmove. Perturb a SINGLE angle of a residue close to the end of -C the chain. - 200 continue - lprint=.true. -c end_select=iran_num(1,2*koniecl) -c if (end_select.gt.koniecl) then -c end_select=nphi-(end_select-koniecl) -c else -c end_select=koniecl+3 -c endif -c if (nwindow.gt.0) then -c iwin=iran_num(1,nwindow) -c i1=max0(4,winstart(iwin)) -c i2=min0(winend(imin)+2,nres) -c end_select=iran_num(i1,i2) -c else -c iselect = iran_num(1,nmov_var) -c jj = 0 -c do i=1,nphi -c if (isearch_tab(i).eq.1) jj = jj+1 -c if (jj.eq.iselect) then -c end_select=i+3 -c exit -c endif -c enddo -c endif - end_select = iran_num(4,nres) - psi=max_phi*gen_psi() - if (psi.eq.0.0D0) then - error=.true. - return - endif - phi(end_select)=pinorm(phi(end_select)+psi) - if (print_mc.gt.1) write (iout,'(a,i4,a,f8.3,a,f8.3)') - & 'End angle',end_select,' moved by ',psi*rad2deg,' new angle:', - & phi(end_select)*rad2deg -c if (end_select.gt.3) -c & theta(end_select-1)=gen_theta(itype(end_select-2), -c & phi(end_select-1),phi(end_select)) -c if (end_select.lt.nres) -c & theta(end_select)=gen_theta(itype(end_select-1), -c & phi(end_select),phi(end_select+1)) -cd print *,'nres=',nres,' end_select=',end_select -cd print *,'theta',end_select-1,theta(end_select-1) -cd print *,'theta',end_select,theta(end_select) - moves(2)=moves(2)+1 - nmove=nmove+1 - lprint=.false. - return -C------------------------------------------------------------------------------ -C Side chain move. -C Select the number of SCs to perturb. - 300 isctry=0 - 301 nside_move=iran_num(1,MaxSideMove) -c print *,'nside_move=',nside_move,' MaxSideMove',MaxSideMove -C Select the indices. - do i=1,nside_move - icount=0 - 111 inds=iran_num(nnt,nct) - icount=icount+1 - if (icount.gt.1000) then - write (iout,'(a)')'Error - cannot select side chains to move.' - error=.true. - return - endif - if (itype(inds).eq.10) goto 111 - do j=1,i-1 - if (inds.eq.ind_side(j)) goto 111 - enddo - do j=1,i-1 - if (inds.lt.ind_side(j)) then - indx=j - goto 112 - endif - enddo - indx=i - 112 do j=i,indx+1,-1 - ind_side(j)=ind_side(j-1) - enddo - 113 ind_side(indx)=inds - enddo -C Carry out perturbation. - do i=1,nside_move - ii=ind_side(i) - iti=itype(ii) - call gen_side(iti,theta(ii+1),alph(ii),omeg(ii),fail) - if (fail) then - isctry=isctry+1 - if (isctry.gt.1000) then - write (iout,'(a)') 'Too many errors in SC generation.' - error=.true. - return - endif - goto 301 - endif - if (print_mc.gt.1) write (iout,'(2a,i4,a,2f8.3)') - & 'Side chain ',restyp(iti),ii,' moved to ', - & alph(ii)*rad2deg,omeg(ii)*rad2deg - enddo - moves(3)=moves(3)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C THETA move - 400 end_select=iran_num(3,nres) - theta_new=gen_theta(itype(end_select),phi(end_select), - & phi(end_select+1)) - if (print_mc.gt.1) write (iout,'(a,i3,a,f8.3,a,f8.3)') - & 'Theta ',end_select,' moved from',theta(end_select)*rad2deg, - & ' to ',theta_new*rad2deg - theta(end_select)=theta_new - moves(4)=moves(4)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Error returned from SelectMove. - 500 error=.true. - return - end -C------------------------------------------------------------------------------ - subroutine SelectMove(MoveType) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - what_move=ran_number(0.0D0,sumpro_type(MaxMoveType)) - do i=1,MaxMoveType - if (what_move.ge.sumpro_type(i-1).and. - & what_move.lt.sumpro_type(i)) then - MoveType=i - return - endif - enddo - write (iout,'(a)') - & 'Fatal error in SelectMoveType: cannot select move.' - MoveType=MaxMoveType+1 - return - end -c---------------------------------------------------------------------------- - double precision function gen_psi() - implicit none - integer i - double precision x,ran_number - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - x=0.0D0 - do i=1,100 - x=ran_number(-pi,pi) - if (dabs(x).gt.angmin) then - gen_psi=x - return - endif - enddo - write (iout,'(a)')'From Gen_Psi: Cannot generate angle increment.' - gen_psi=0.0D0 - return - end -c---------------------------------------------------------------------------- - subroutine metropolis(n,xcur,xold,ecur,eold,accepted,similar, - & enelower) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' -crc include 'COMMON.DEFORM' - double precision ecur,eold,xx,ran_number,bol - double precision xcur(n),xold(n) - double precision ecut1 ,ecut2 ,tola - logical accepted,similar,not_done,enelower - logical lprn - data ecut1 /-1.0D-5/,ecut2 /5.0D-3/,tola/5.0D0/ -! ecut1=-5*enedif -! ecut2=50*enedif -! tola=5.0d0 -C Set lprn=.true. for debugging. - lprn=.false. - if (lprn) - &write(iout,*)'enedif',enedif,' ecut1',ecut1,' ecut2',ecut2 - similar=.false. - enelower=.false. - accepted=.false. -C Check if the conformation is similar. - difene=ecur-eold - reldife=difene/dmax1(dabs(eold),dabs(ecur),1.0D0) - if (lprn) then - write (iout,*) 'Metropolis' - write(iout,*)'ecur,eold,difene,reldife',ecur,eold,difene,reldife - endif -C If energy went down remarkably, we accept the new conformation -C unconditionally. -cjp if (reldife.lt.ecut1) then - if (difene.lt.ecut1) then - accepted=.true. - EneLower=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because energy has lowered remarkably.' -! elseif (reldife.lt.ecut2 .and. dif_ang(nphi,xcur,xold).lt.tola) -cjp elseif (reldife.lt.ecut2) - elseif (difene.lt.ecut2) - & then -C Reject the conf. if energy has changed insignificantly and there is not -C much change in conformation. - if (lprn) - & write (iout,'(2a)') 'Conformation rejected, because it is', - & ' similar to the preceding one.' - accepted=.false. - similar=.true. - else -C Else carry out Metropolis test. - EneLower=.false. - xx=ran_number(0.0D0,1.0D0) - xxh=betbol*difene - if (lprn) - & write (iout,*) 'betbol=',betbol,' difene=',difene,' xxh=',xxh - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (lprn) write (iout,*) 'bol=',bol,' xx=',xx - if (bol.gt.xx) then - accepted=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because it passed Metropolis test.' - else - accepted=.false. - if (lprn) write (iout,'(a)') - & 'Conformation rejected, because it did not pass Metropolis test.' - endif - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - return - end -c------------------------------------------------------------------------------ - integer function conf_comp(x,ene) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - double precision etol , angtol - double precision x(maxvar) - double precision dif_ang,difa - data etol /0.1D0/, angtol /20.0D0/ - do ii=nsave,1,-1 -c write (iout,*) 'ii=',ii,'ene=',ene,esave(ii),dabs(ene-esave(ii)) - if (dabs(ene-esave(ii)).lt.etol) then - difa=dif_ang(nphi,x,varsave(1,ii)) -c do i=1,nphi -c write(iout,'(i3,3f8.3)')i,rad2deg*x(i), -c & rad2deg*varsave(i,ii) -c enddo -c write(iout,*) 'ii=',ii,' difa=',difa,' angtol=',angtol - if (difa.le.angtol) then - if (print_mc.gt.0) then - write (iout,'(a,i5,2(a,1pe15.4))') - & 'Current conformation matches #',ii, - & ' in the store array ene=',ene,' esave=',esave(ii) -c write (*,'(a,i5,a)') 'Current conformation matches #',ii, -c & ' in the store array.' - endif ! print_mc.gt.0 - if (print_mc.gt.1) then - do i=1,nphi - write(iout,'(i3,3f8.3)')i,rad2deg*x(i), - & rad2deg*varsave(i,ii) - enddo - endif ! print_mc.gt.1 - nrepm=nrepm+1 - conf_comp=ii - return - endif - endif - enddo - conf_comp=0 - return - end -C---------------------------------------------------------------------------- - double precision function dif_ang(n,x,y) - implicit none - integer i,n - double precision x(n),y(n) - double precision w,wa,dif,difa - double precision pinorm - include 'COMMON.GEO' - wa=0.0D0 - difa=0.0D0 - do i=1,n - dif=dabs(pinorm(y(i)-x(i))) - if (dabs(dif-dwapi).lt.dif) dif=dabs(dif-dwapi) - w=1.0D0-(2.0D0*(i-1)/(n-1)-1.0D0)**2+1.0D0/n - wa=wa+w - difa=difa+dif*dif*w - enddo - dif_ang=rad2deg*dsqrt(difa/wa) - return - end -c-------------------------------------------------------------------------- - subroutine add2cache(n1,n2,ncache,nvar,SourceID,CachSrc, - & ecur,xcur,ecache,xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,SourceID,CachSrc(n2) - integer i,ii,j - double precision ecur,xcur(nvar),ecache(n2),xcache(n1,n2) -cd write (iout,*) 'Enter ADD2CACHE ncache=',ncache ,' ecur',ecur -cd write (iout,'(10f8.3)') (rad2deg*xcur(i),i=1,nvar) -cd write (iout,*) 'Old CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - - i=ncache - do while (i.gt.0 .and. ecur.lt.ecache(i)) - i=i-1 - enddo - i=i+1 -cd write (iout,*) 'i=',i,' ncache=',ncache - if (ncache.eq.n2) then - write (iout,*) 'Cache dimension exceeded',ncache,n2 - write (iout,*) 'Highest-energy conformation will be removed.' - ncache=ncache-1 - endif - do ii=ncache,i,-1 - ecache(ii+1)=ecache(ii) - CachSrc(ii+1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii+1)=xcache(j,ii) - enddo - enddo - ecache(i)=ecur - CachSrc(i)=SourceID - do j=1,nvar - xcache(j,i)=xcur(j) - enddo - ncache=ncache+1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end -c-------------------------------------------------------------------------- - subroutine rm_from_cache(i,n1,n2,ncache,nvar,CachSrc,ecache, - & xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,CachSrc(n2) - integer i,ii,j - double precision ecache(n2),xcache(n1,n2) - -cd write (iout,*) 'Enter RM_FROM_CACHE' -cd write (iout,*) 'Old CACHE array:' -cd do ii=1,ncache -cd write (iout,*)'i=',ii,' ecache=',ecache(ii),' CachSrc',CachSrc(ii) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,ii),j=1,nvar) -cd enddo - - do ii=i+1,ncache - ecache(ii-1)=ecache(ii) - CachSrc(ii-1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii-1)=xcache(j,ii) - enddo - enddo - ncache=ncache-1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/minim_mcmf.F b/source/unres/src_MD-DFA-restraints/minim_mcmf.F deleted file mode 100644 index beb3d4c..0000000 --- a/source/unres/src_MD-DFA-restraints/minim_mcmf.F +++ /dev/null @@ -1,121 +0,0 @@ -#ifdef MPI - subroutine minim_mcmf - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - dimension indx(6) - dimension iv(liv) - dimension idum(1),rdum(1) - double precision przes(3),obrot(3,3) - logical non_conv - data rad /1.745329252d-2/ - common /przechowalnia/ v - - ichuj=0 - 10 continue - ichuj = ichuj + 1 - call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - if (indx(1).eq.0) return -c print *, 'worker ',me,' received order ',n,ichuj - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene0,1,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -c print *, 'worker ',me,' var read ' - - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy - - call func(nvar,var,nf,eee,idum,rdum,fdum) - if(eee.gt.1.0d18) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - nf=1 - go to 201 - endif - - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -c find which conformation was returned from sumsl - nf=iv(7)+1 - 201 continue -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(4)=nf - indx(5)=iv(1) - eee=v(10) - - call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM, - * ierr) -c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10) - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) - call mpi_send(eee,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - go to 10 - - return - end -#endif diff --git a/source/unres/src_MD-DFA-restraints/minimize_p.F b/source/unres/src_MD-DFA-restraints/minimize_p.F deleted file mode 100644 index c7922c7..0000000 --- a/source/unres/src_MD-DFA-restraints/minimize_p.F +++ /dev/null @@ -1,641 +0,0 @@ - subroutine minimize(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -********************************************************************* -* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -* the calling subprogram. * -* when d(i)=1.0, then v(35) is the length of the initial step, * -* calculated in the usual pythagorean way. * -* absolute convergence occurs when the function is within v(31) of * -* zero. unless you know the minimum value in advance, abs convg * -* is probably not useful. * -* relative convergence is when the model predicts that the function * -* will decrease by less than v(32)*abs(fun). * -********************************************************************* - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr,grad_restr - logical not_done,change,reduce -c common /przechowalnia/ v - - icall = 1 - - NOT_DONE=.TRUE. - -c DO WHILE (NOT_DONE) - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -cd print *,'Calling SUMSL' -c call var_to_geom(nvar,x) -c call chainbuild -c call etotal(energia(0)) -c etot = energia(0) - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr,grad_restr, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) -cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot -cd write (iout,'(/a,i4/)') 'SUMSL return code:',iv(1) -c call intout -c change=reduce(x) - call var_to_geom(nvar,x) -c if (change) then -c write (iout,'(a)') 'Reduction worked, minimizing again...' -c else -c not_done=.false. -c endif - call chainbuild -c call etotal(energia(0)) -c etot=energia(0) -c call enerprint(energia(0)) - nfun=iv(6) - -c write (*,*) 'Processor',MyID,' leaves MINIMIZE.' - -c ENDDO ! NOT_DONE - - return - end -#ifdef MPI -c---------------------------------------------------------------------------- - subroutine ergastulum - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' - double precision z(maxres6),d_a_tmp(maxres6) - double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy - integer icall /0/ -C Workers wait for variables and NF, and NFL from the boss - iorder=0 - do while (iorder.ge.0) -c write (*,*) 'Processor',fg_rank,' CG group',kolor, -c & ' receives order from Master' - time00=MPI_Wtime() - call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - if (icall.gt.4 .and. iorder.ge.0) - & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00 - icall=icall+1 -c write (*,*) -c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder - if (iorder.eq.0) then - call zerograd - call etotal(edum) -c write (2,*) "After etotal" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.2) then - call zerograd - call etotal_short(edum) -c write (2,*) "After etotal_short" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.3) then - call zerograd - call etotal_long(edum) -c write (2,*) "After etotal_long" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.1) then - call sum_gradient -c write (2,*) "After sum_gradient" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.4) then - call ginv_mult(z,d_a_tmp) - else if (iorder.eq.5) then -c Setup MD things for a slave - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) -c write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - myginv_ng_count=maxres2*my_ng_count -c write (2,*) "igmult_start",igmult_start," igmult_end", -c & igmult_end," my_ng_count",my_ng_count -c call flush(2) - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) -c write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) -c call flush(2) -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (2,*) "dimen",dimen," dimen3",dimen3 -c write (2,*) "End MD setup" -c call flush(2) -c write (iout,*) "My chunk of ginv_block" -c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) - else if (iorder.eq.6) then - call int_from_cart1(.false.) - else if (iorder.eq.7) then - call chainbuild_cart - else if (iorder.eq.8) then - call intcartderiv - else if (iorder.eq.9) then - call fricmat_mult(z,d_a_tmp) - else if (iorder.eq.10) then - call setup_fricmat - endif - enddo - write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' leves ERGASTULUM.' - write(*,*)'Processor',fg_rank,' wait times for respective orders', - & (' order[',i,']',time_order(i),i=0,10) - return - end -#endif -************************************************************************ - subroutine func(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 -cd print *,'func',nf,nfl,icg - call var_to_geom(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -************************************************************************ - subroutine func_restr(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -c------------------------------------------------------- - subroutine x2xx(x,xx,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - varall(i)=x(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - endif - enddo - enddo - - n=ig - - return - end - - subroutine xx2x(x,xx) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - x(i)=varall(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - endif - enddo - enddo - - return - end - -c---------------------------------------------------------- - subroutine minim_dc(etot,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) -c common /przechowalnia/ v - - double precision energia(0:n_ene) - external func_dc,grad_dc,fdum - logical not_done,change,reduce - double precision g(maxvar),f1 - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,6*nres - d(i)=1.0D-1 - enddo - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - x(k)=dc(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - x(k)=dc(j,i+nres) - enddo - endif - enddo - - call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -cd call zerograd -cd nf=0 -cd call func_dc(k,x,nf,f,idum,rdum,fdum) -cd call grad_dc(k,x,nf,g,idum,rdum,fdum) -cd -cd do i=1,k -cd x(i)=x(i)+1.0D-5 -cd call func_dc(k,x,nf,f1,idum,rdum,fdum) -cd x(i)=x(i)-1.0D-5 -cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5 -cd enddo - - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - return - end - - subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - double precision energia(0:n_ene) - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf -cbad icg=mod(nf,2)+1 - icg=1 - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - - call zerograd - call etotal(energia(0)) - f=energia(0) - -cd print *,'func_dc ',nf,nfl,f - - return - end - - subroutine grad_dc(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1),k - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c -c -cbad icg=mod(nf,2)+1 - icg=1 -cd print *,'grad_dc ',nf,nfl,nf-nfl+1,icg - if (nf-nfl+1) 20,30,40 - 20 call func_dc(n,x,nf,f,uiparm,urparm,ufparm) -cd print *,20 - if (nf.eq.0) return - goto 40 - 30 continue -cd print *,30 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartgrad -cd print *,40 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - g(k)=gcart(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - g(k)=gxcart(j,i) - enddo - endif - enddo - - return - end diff --git a/source/unres/src_MD-DFA-restraints/misc.f b/source/unres/src_MD-DFA-restraints/misc.f deleted file mode 100644 index e189839..0000000 --- a/source/unres/src_MD-DFA-restraints/misc.f +++ /dev/null @@ -1,203 +0,0 @@ -C $Date: 1994/10/12 17:24:21 $ -C $Revision: 2.5 $ -C -C -C - logical function find_arg(ipos,line,errflag) - parameter (maxlen=80) - character*80 line - character*1 empty /' '/,equal /'='/ - logical errflag -* This function returns .TRUE., if an argument follows keyword keywd; if so -* IPOS will point to the first non-blank character of the argument. Returns -* .FALSE., if no argument follows the keyword; in this case IPOS points -* to the first non-blank character of the next keyword. - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - errflag=.false. - if (line(ipos:ipos).eq.equal) then - find_arg=.true. - ipos=ipos+1 - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen) errflag=.true. - else - find_arg=.false. - endif - return - end - logical function find_group(iunit,jout,key1) - character*(*) key1 - character*80 karta,ucase - integer ilen - external ilen - logical lcom - rewind (iunit) - karta=' ' - ll=ilen(key1) - do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta)) - read (iunit,'(a)',end=10) karta - enddo - write (jout,'(2a)') '> ',karta(1:78) - find_group=.true. - return - 10 find_group=.false. - return - end - logical function iblnk(charc) - character*1 charc - integer n - n = ichar(charc) - iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ') - return - end - integer function ilen(string) - character*(*) string - logical iblnk - - ilen = len(string) -1 if ( ilen .gt. 0 ) then - if ( iblnk( string(ilen:ilen) ) ) then - ilen = ilen - 1 - goto 1 - endif - endif - return - end - integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset) - character*16 keywd,keywdset(1:nkey,0:nkey) - character*16 ucase - do i=1,narg - if (ucase(keywd).eq.keywdset(i,ikey)) then -* Match found - in_keywd_set=i - return - endif - enddo -* No match to the allowed set of keywords if this point is reached. - in_keywd_set=0 - return - end - character*(*) function lcase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(lcase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - lcase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'A') .and. lle(c,'Z')) then - lcase(i:i) = char(ichar(c) + idiff) - endif - 99 continue - return - end - logical function lcom(ipos,karta) - character*80 karta - character koment(2) /'!','#'/ - lcom=.false. - do i=1,2 - if (karta(ipos:ipos).eq.koment(i)) lcom=.true. - enddo - return - end - logical function lower_case(ch) - character*(*) ch - lower_case=(ch.ge.'a' .and. ch.le.'z') - return - end - subroutine mykey(line,keywd,ipos,blankline,errflag) -* This subroutine seeks a non-empty substring keywd in the string LINE. -* The substring begins with the first character different from blank and -* "=" encountered right to the pointer IPOS (inclusively) and terminates -* at the character left to the first blank or "=". When the subroutine is -* exited, the pointer IPOS is moved to the position of the terminator in LINE. -* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains -* only separators or the maximum length of the data line (80) has been reached. -* The logical variable ERRFLAG is set at .TRUE. if the string -* consists only from a "=". - parameter (maxlen=80) - character*1 empty /' '/,equal /'='/,comma /','/ - character*(*) keywd - character*80 line - logical blankline,errflag,lcom - errflag=.false. - do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen)) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen .or. lcom(ipos,line) ) then -* At this point the rest of the input line turned out to contain only blanks -* or to be commented out. - blankline=.true. - return - endif - blankline=.false. - istart=ipos -* Checks whether the current char is a separator. - do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal - & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - iend=ipos-1 -* Error flag set to .true., if the length of the keyword was found less than 1. - if (iend.lt.istart) then - errflag=.true. - return - endif - keywd=line(istart:iend) - return - end - subroutine numstr(inum,numm) - character*10 huj /'0123456789'/ - character*(*) numm - inumm=inum - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(3:3)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(2:2)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(1:1)=huj(inum2+1:inum2+1) - return - end - character*(*) function ucase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(ucase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - ucase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'a') .and. lle(c,'z')) then - ucase(i:i) = char(ichar(c) - idiff) - endif - 99 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/moments.f b/source/unres/src_MD-DFA-restraints/moments.f deleted file mode 100644 index 5adbf21..0000000 --- a/source/unres/src_MD-DFA-restraints/moments.f +++ /dev/null @@ -1,328 +0,0 @@ - subroutine inertia_tensor -c Calculating the intertia tensor for the entire protein in order to -c remove the perpendicular components of velocity matrix which cause -c the molecule to rotate. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision Im(3,3),Imcp(3,3),cm(3),pr(3),M_SC, - & eigvec(3,3),Id(3,3),eigval(3),L(3),vp(3),vrot(3), - & vpp(3,0:MAXRES),vs_p(3),pr1(3,3), - & pr2(3,3),pp(3),incr(3),v(3),mag,mag2 - common /gucio/ cm - integer iti,inres - do i=1,3 - do j=1,3 - Im(i,j)=0.0d0 - pr1(i,j)=0.0d0 - pr2(i,j)=0.0d0 - enddo - L(i)=0.0d0 - cm(i)=0.0d0 - vrot(i)=0.0d0 - enddo -c calculating the center of the mass of the protein - do i=nnt,nct-1 - do j=1,3 - cm(j)=cm(j)+c(j,i)+0.5d0*dc(j,i) - enddo - enddo - do j=1,3 - cm(j)=mp*cm(j) - enddo - M_SC=0.0d0 - do i=nnt,nct - iti=itype(i) - M_SC=M_SC+msc(iti) - inres=i+nres - do j=1,3 - cm(j)=cm(j)+msc(iti)*c(j,inres) - enddo - enddo - do j=1,3 - cm(j)=cm(j)/(M_SC+(nct-nnt)*mp) - enddo - - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - Im(1,1)=Im(1,1)+mp*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-mp*pr(1)*pr(2) - Im(1,3)=Im(1,3)-mp*pr(1)*pr(3) - Im(2,3)=Im(2,3)-mp*pr(2)*pr(3) - Im(2,2)=Im(2,2)+mp*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+mp*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - Im(1,1)=Im(1,1)+msc(iti)*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-msc(iti)*pr(1)*pr(2) - Im(1,3)=Im(1,3)-msc(iti)*pr(1)*pr(3) - Im(2,3)=Im(2,3)-msc(iti)*pr(2)*pr(3) - Im(2,2)=Im(2,2)+msc(iti)*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+msc(iti)*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct-1 - Im(1,1)=Im(1,1)+Ip*(1-dc_norm(1,i)*dc_norm(1,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,2)=Im(1,2)+Ip*(-dc_norm(1,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,3)=Im(1,3)+Ip*(-dc_norm(1,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,3)=Im(2,3)+Ip*(-dc_norm(2,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,2)=Im(2,2)+Ip*(1-dc_norm(2,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(3,3)=Im(3,3)+Ip*(1-dc_norm(3,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - enddo - - - do i=nnt,nct - if (itype(i).ne.10) then - iti=itype(i) - inres=i+nres - Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)* - & dc_norm(1,inres))*vbld(inres)*vbld(inres) - Im(1,2)=Im(1,2)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(1,3)=Im(1,3)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,3)=Im(2,3)-Isc(iti)*(dc_norm(2,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,2)=Im(2,2)+Isc(iti)*(1-dc_norm(2,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(3,3)=Im(3,3)+Isc(iti)*(1-dc_norm(3,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - endif - enddo - - call angmom(cm,L) -c write(iout,*) "The angular momentum before adjustment:" -c write(iout,*) (L(j),j=1,3) - - Im(2,1)=Im(1,2) - Im(3,1)=Im(1,3) - Im(3,2)=Im(2,3) - -c Copying the Im matrix for the djacob subroutine - do i=1,3 - do j=1,3 - Imcp(i,j)=Im(i,j) - Id(i,j)=0.0d0 - enddo - enddo - -c Finding the eigenvectors and eignvalues of the inertia tensor - call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval) -c write (iout,*) "Eigenvalues & Eigenvectors" -c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3) -c write (iout,*) -c do i=1,3 -c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3) -c enddo -c Constructing the diagonalized matrix - do i=1,3 - if (dabs(eigval(i)).gt.1.0d-15) then - Id(i,i)=1.0d0/eigval(i) - else - Id(i,i)=0.0d0 - endif - enddo - do i=1,3 - do j=1,3 - Imcp(i,j)=eigvec(j,i) - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr1(i,j)=pr1(i,j)+Id(i,k)*Imcp(k,j) - enddo - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr2(i,j)=pr2(i,j)+eigvec(i,k)*pr1(k,j) - enddo - enddo - enddo -c Calculating the total rotational velocity of the molecule - do i=1,3 - do j=1,3 - vrot(i)=vrot(i)+pr2(i,j)*L(j) - enddo - enddo -c Resetting the velocities - do i=nnt,nct-1 - call vecpr(vrot(1),dc(1,i),vp) - do j=1,3 - d_t(j,i)=d_t(j,i)-vp(j) - enddo - enddo - do i=nnt,nct - if(itype(i).ne.10) then - inres=i+nres - call vecpr(vrot(1),dc(1,inres),vp) - do j=1,3 - d_t(j,inres)=d_t(j,inres)-vp(j) - enddo - endif - enddo - call angmom(cm,L) -c write(iout,*) "The angular momentum after adjustment:" -c write(iout,*) (L(j),j=1,3) - return - end -c---------------------------------------------------------------------------- - subroutine angmom(cm,L) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision L(3),cm(3),pr(3),vp(3),vrot(3),incr(3),v(3), - & pp(3) - integer iti,inres -c Calculate the angular momentum - do j=1,3 - L(j)=0.0d0 - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - call vecpr(pr(1),v(1),vp) - do j=1,3 - L(j)=L(j)+mp*vp(j) - enddo - do j=1,3 - pr(j)=0.5d0*dc(j,i) - pp(j)=0.5d0*d_t(j,i) - enddo - call vecpr(pr(1),pp(1),vp) - do j=1,3 - L(j)=L(j)+Ip*vp(j) - enddo - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - else - do j=1,3 - v(j)=incr(j) - enddo - endif - call vecpr(pr(1),v(1),vp) -c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3), -c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3) - do j=1,3 - L(j)=L(j)+msc(iti)*vp(j) - enddo -c write (iout,*) "L",(l(j),j=1,3) - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - call vecpr(dc(1,inres),d_t(1,inres),vp) - do j=1,3 - L(j)=L(j)+Isc(iti)*vp(j) - enddo - endif - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo - return - end -c------------------------------------------------------------------------------ - subroutine vcm_vel(vcm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision vcm(3),vv(3),summas,amas - do j=1,3 - vcm(j)=0.0d0 - vv(j)=d_t(j,0) - enddo - summas=0.0d0 - do i=nnt,nct - if (i.lt.nct) then - summas=summas+mp - do j=1,3 - vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i)) - enddo - endif - amas=msc(itype(i)) - summas=summas+amas - if (itype(i).ne.10) then - do j=1,3 - vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres)) - enddo - else - do j=1,3 - vcm(j)=vcm(j)+amas*vv(j) - enddo - endif - do j=1,3 - vv(j)=vv(j)+d_t(j,i) - enddo - enddo -c write (iout,*) "vcm",(vcm(j),j=1,3)," summas",summas - do j=1,3 - vcm(j)=vcm(j)/summas - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/muca_md.f b/source/unres/src_MD-DFA-restraints/muca_md.f deleted file mode 100644 index c10a6a7..0000000 --- a/source/unres/src_MD-DFA-restraints/muca_md.f +++ /dev/null @@ -1,334 +0,0 @@ - subroutine muca_delta(remd_t_bath,remd_ene,i,iex,delta) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision remd_t_bath(maxprocs) - double precision remd_ene(maxprocs) - double precision muca_ene - double precision betai,betaiex,delta - - betai=1.0/(Rb*remd_t_bath(i)) - betaiex=1.0/(Rb*remd_t_bath(iex)) - - delta=betai*(muca_ene(remd_ene(iex),i,remd_t_bath)- - & muca_ene(remd_ene(i),i,remd_t_bath)) - & -betaiex*(muca_ene(remd_ene(iex),iex,remd_t_bath)- - & muca_ene(remd_ene(i),iex,remd_t_bath)) - - return - end - - double precision function muca_ene(energy,i,remd_t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision y,yp,energy - double precision remd_t_bath(maxprocs) - integer i - - if (energy.lt.elowi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,elowi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-elowi(i))+y) - elseif (energy.gt.ehighi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,ehighi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-ehighi(i))+y) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - muca_ene=remd_t_bath(i)*Rb*y - endif - return - end - - subroutine read_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - imtime=0 - do i=1,4*maxres - hist(i)=0 - enddo - if (modecalc.eq.14.and..not.remd_tlist) then - print *,"MUCAREMD works only with TLIST" - stop - endif - open(89,file='muca.input') - read(89,*) - read(89,*) - if (modecalc.eq.14) then - read(89,*) (elowi(i),ehighi(i),i=1,nrep) - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - elow=elowi(i2rep(me)) - ehigh=ehighi(i2rep(me)) - elowi(me+1)=elow - ehighi(me+1)=ehigh - else - elow=elowi(me+1) - ehigh=ehighi(me+1) - endif - else - read(89,*) elow,ehigh - elowi(1)=elow - ehighi(1)=ehigh - endif - i=0 - do while(.true.) - i=i+1 - read(89,*,end=100) emuca(i),nemuca(i) -cd nemuca(i)=nemuca(i)*remd_t(me+1)*Rb - enddo - 100 continue - nmuca=i-1 - hbin=emuca(nmuca)-emuca(nmuca-1) - write (iout,*) 'hbin',hbin - write (iout,*) me,'elow,ehigh',elow,ehigh - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - factor_min=0.0d0 - factor_min=muca_factor(ehigh) - call print_muca - return - end - - - subroutine print_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - double precision dummy(maxprocs) - - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - endif - - do i=1,nmuca -c print *,'nemuca ',emuca(i),nemuca(i) - do j=0,4 - x=emuca(i)+hbin/5*j - if (modecalc.eq.14) then - if (remd_mlist) then - yp=muca_factor(x)*remd_t(i2rep(me))*Rb - dummy(me+1)=remd_t(i2rep(me)) - y=muca_ene(x,me+1,dummy) - else - yp=muca_factor(x)*remd_t(me+1)*Rb - y=muca_ene(x,me+1,remd_t) - endif - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - else - yp=muca_factor(x)*t_bath*Rb - dummy(1)=t_bath - y=muca_ene(x,1,dummy) - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - endif - enddo - enddo - if(mucadyn.gt.0) then - do i=1,nmuca - write(iout,'(a13,i8,2f12.5)') 'nemuca after ', - & imtime,emuca(i),nemuca(i) - enddo - endif - return - end - - subroutine muca_update(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energy - double precision yp1,ypn - integer k - logical lnotend - - k=int((energy-emuca(1))/hbin)+1 - - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN - if(energy.ge.ehigh) - & write (iout,*) 'MUCA reject',energy,emuca(k) - if(energy.ge.ehigh.and.(energy-ehigh).lt.hbin) then - write (iout,*) 'MUCA ehigh',energy,emuca(k) - do i=k,nmuca - hist(i)=hist(i)+1 - enddo - endif - if(k.gt.0.and.energy.lt.ehigh) hist(k)=hist(k)+1 - ELSE - if(k.gt.0.and.k.lt.4*maxres) hist(k)=hist(k)+1 - ENDIF - if(mod(imtime,mucadyn).eq.0) then - - do i=1,nmuca - IF(muca_smooth.eq.2.or.muca_smooth.eq.3) THEN - nemuca(i)=nemuca(i)+dlog(hist(i)+1) - ELSE - if (hist(i).gt.0) hist(i)=dlog(hist(i)) - nemuca(i)=nemuca(i)+hist(i) - ENDIF - hist(i)=0 - write(iout,'(a24,i8,2f12.5)')'nemuca before smoothing ', - & imtime,emuca(i),nemuca(i) - enddo - - - lnotend=.true. - ismooth=0 - ist=2 - ien=nmuca-1 - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN -c lnotend=.false. -c do i=1,nmuca-1 -c do j=i+1,nmuca -c if(nemuca(j).lt.nemuca(i)) lnotend=.true. -c enddo -c enddo - do while(lnotend) - ismooth=ismooth+1 - write (iout,*) 'MUCA update smoothing',ist,ien - do i=ist,ien - nemuca(i)=(nemuca(i-1)+nemuca(i)+nemuca(i+1))/3 - enddo - lnotend=.false. - ist=0 - ien=0 - do i=1,nmuca-1 - do j=i+1,nmuca - if(nemuca(j).lt.nemuca(i)) then - lnotend=.true. - if(ist.eq.0) ist=i-1 - if(ien.lt.j+1) ien=j+1 - endif - enddo - enddo - enddo - ENDIF - - write (iout,*) 'MUCA update ',imtime,' smooth= ',ismooth - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - call print_muca - - endif - return - end - - double precision function muca_factor(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - double precision y,yp,energy - - if (energy.lt.elow) then - call splint(emuca,nemuca,nemuca2,nmuca,elow,y,yp) - elseif (energy.gt.ehigh) then - call splint(emuca,nemuca,nemuca2,nmuca,ehigh,y,yp) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - endif - - if(yp.ge.factor_min) then - muca_factor=yp - else - muca_factor=factor_min - endif -cd print *,'energy, muca_factor',energy,muca_factor - return - end - - - SUBROUTINE spline(x,y,n,yp1,ypn,y2) - INTEGER n,NMAX - REAL*8 yp1,ypn,x(n),y(n),y2(n) - PARAMETER (NMAX=500) - INTEGER i,k - REAL*8 p,qn,sig,un,u(NMAX) - if (yp1.gt..99e30) then - y2(1)=0. - u(1)=0. - else - y2(1)=-0.5 - u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1) - endif - do i=2,n-1 - sig=(x(i)-x(i-1))/(x(i+1)-x(i-1)) - p=sig*y2(i-1)+2. - y2(i)=(sig-1.)/p - u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1)) - * /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p - enddo - if (ypn.gt..99e30) then - qn=0. - un=0. - else - qn=0.5 - un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1))) - endif - y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.) - do k=n-1,1,-1 - y2(k)=y2(k)*y2(k+1)+u(k) - enddo - return - END - - - SUBROUTINE splint(xa,ya,y2a,n,x,y,yp) - INTEGER n - REAL*8 x,y,xa(n),y2a(n),ya(n),yp - INTEGER k,khi,klo - REAL*8 a,b,h - klo=1 - khi=n - 1 if (khi-klo.gt.1) then - k=(khi+klo)/2 - if (xa(k).gt.x) then - khi=k - else - klo=k - endif - goto 1 - endif - h=xa(khi)-xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' - a=(xa(khi)-x)/h - b=(x-xa(klo))/h - y=a*ya(klo)+b*ya(khi)+ - * ((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6. - yp=-ya(klo)/h+ya(khi)/h-3*(a**2)*y2a(klo)*h/6. - + +(3*(b**2)-1)*y2a(khi)*h/6. - return - END diff --git a/source/unres/src_MD-DFA-restraints/parmread.F b/source/unres/src_MD-DFA-restraints/parmread.F deleted file mode 100644 index 030d64e..0000000 --- a/source/unres/src_MD-DFA-restraints/parmread.F +++ /dev/null @@ -1,1036 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - include 'COMMON.SETUP' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) - enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) - enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) - enddo -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 - write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - write (2,*) "Start reading THETA_PDB" - do i=1,ntyp - read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - write (2,*) "End reading THETA_PDB" - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) -#endif - close(irotam) - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) - si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j)=v0ij - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - endif -C -C 6/23/01 Read parameters for double torsionals -C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k), - & ntermd_2(i,j,k) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k), - & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k), - & m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - enddo - enddo - enddo - endif -#endif -C Read of Side-chain backbone correlation parameters -C Modified 11 May 2012 by Adasko -CCC -C - read (isccor,*,end=1113,err=1113) nsccortyp - read (isccor,*,end=1113,err=1113) (isccortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - maxinter=3 -cc maxinter is maximum interaction sites - do l=1,maxinter - do i=1,nsccortyp - do j=1,nsccortyp - read (isccor,*,end=1113,err=1113) nterm_sccor(i,j), - & nlor_sccor(i,j) - v0ijsccor=0.0d0 - si=-1.0d0 - - do k=1,nterm_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk,v1sccor(k,l,i,j) - & ,v2sccor(k,l,i,j) - v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) - si=-si - enddo - do k=1,nlor_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk,vlor1sccor(k,i,j), - & vlor2sccor(k,i,j),vlor3sccor(k,i,j) - v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ - &(1+vlor3sccor(k,i,j)**2) - enddo - v0sccor(i,j)=v0ijsccor - enddo - enddo - enddo - close (isccor) - - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,nsccortyp - do j=1,nsccortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm_sccor(i,j) - write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor_sccor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) - enddo - enddo - enddo - endif -C -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - if (lprint) then - write (iout,*) - write (iout,*) "Coefficients of the cumulants" - endif - read (ifourier,*) nloctyp - do i=1,nloctyp - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13) - endif - B1(1,i) = b(3) - B1(2,i) = b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 - B1tilde(1,i) = b(3) - B1tilde(2,i) =-b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 - B2(1,i) = b(2) - B2(2,i) = b(4) -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CC(1,1,i)= b(7) - CC(2,2,i)=-b(7) - CC(2,1,i)= b(9) - CC(1,2,i)= b(9) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 - Ctilde(1,1,i)=b(7) - Ctilde(1,2,i)=b(9) - Ctilde(2,1,i)=-b(9) - Ctilde(2,2,i)=b(7) -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DD(1,1,i)= b(6) - DD(2,2,i)=-b(6) - DD(2,1,i)= b(8) - DD(1,2,i)= b(8) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 - Dtilde(1,1,i)=b(6) - Dtilde(1,2,i)=b(8) - Dtilde(2,1,i)=-b(8) - Dtilde(2,2,i)=b(6) -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EE(1,1,i)= b(10)+b(11) - EE(2,2,i)=-b(10)+b(11) - EE(2,1,i)= b(12)-b(13) - EE(1,2,i)= b(12)+b(13) -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) - enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) - enddo - enddo - endif -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.5) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 50 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 50 -C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 50 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - 50 continue - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - enddo - enddo - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - rrij=sigma(i,j) - else - rrij=rr0(i)+rr0(j) - endif - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) - if (ipot.gt.2) then - sigt1sq=sigma0(i)**2 - sigt2sq=sigma0(j)**2 - sigii1=sigii(i) - sigii2=sigii(j) - ratsig1=sigt2sq/sigt1sq - ratsig2=1.0D0/ratsig1 - chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1) - if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - else - rsum_max=sigma(i,j) - endif -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - if (lprint) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - endif - enddo - enddo -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,20 -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo - - if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" - do i=1,20 - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -#endif -C -C Define the constants of the disulfide bridge -C - ebr=-5.50D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 1113 write (iout,*) - & "Error reading side-chain torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif - - return - end diff --git a/source/unres/src_MD-DFA-restraints/pinorm.f b/source/unres/src_MD-DFA-restraints/pinorm.f deleted file mode 100644 index 91392bf..0000000 --- a/source/unres/src_MD-DFA-restraints/pinorm.f +++ /dev/null @@ -1,17 +0,0 @@ - double precision function pinorm(x) - implicit real*8 (a-h,o-z) -c -c this function takes an angle (in radians) and puts it in the range of -c -pi to +pi. -c - integer n - include 'COMMON.GEO' - n = x / dwapi - pinorm = x - n * dwapi - if ( pinorm .gt. pi ) then - pinorm = pinorm - dwapi - else if ( pinorm .lt. - pi ) then - pinorm = pinorm + dwapi - end if - return - end diff --git a/source/unres/src_MD-DFA-restraints/printmat.f b/source/unres/src_MD-DFA-restraints/printmat.f deleted file mode 100644 index be2b38f..0000000 --- a/source/unres/src_MD-DFA-restraints/printmat.f +++ /dev/null @@ -1,16 +0,0 @@ - subroutine printmat(ldim,m,n,iout,key,a) - character*3 key(n) - double precision a(ldim,n) - do 1 i=1,n,8 - nlim=min0(i+7,n) - write (iout,1000) (key(k),k=i,nlim) - write (iout,1020) - 1000 format (/5x,8(6x,a3)) - 1020 format (/80(1h-)/) - do 2 j=1,n - write (iout,1010) key(j),(a(j,k),k=i,nlim) - 2 continue - 1 continue - 1010 format (a3,2x,8(f9.4)) - return - end diff --git a/source/unres/src_MD-DFA-restraints/prng.f b/source/unres/src_MD-DFA-restraints/prng.f deleted file mode 100644 index 73f6766..0000000 --- a/source/unres/src_MD-DFA-restraints/prng.f +++ /dev/null @@ -1,525 +0,0 @@ - real*8 function prng_next(me) - implicit none - integer me -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end diff --git a/source/unres/src_MD-DFA-restraints/prng_32.F b/source/unres/src_MD-DFA-restraints/prng_32.F deleted file mode 100644 index 9448f31..0000000 --- a/source/unres/src_MD-DFA-restraints/prng_32.F +++ /dev/null @@ -1,1077 +0,0 @@ -#if defined(AIX) || defined(AMD64) - real*8 function prng_next(mel) - implicit none - integer me,mel -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (mel, iseed) - implicit none - integer me,mel - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end -#else - real function prng_next(me) -crc logical prng_restart, prng_chkpnt -c -c Calling sequence: -c = prng_next ( ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses 4 16-bit packets, and uses a block data common -c area for the initial seeds and constants. A 64-bit floating point -c number is returned. -c -c The arrays "l" and "n" are full-word aligned, being padded by zeros -c That is, rows 1-4 in a given column are for real, rows 5-16 are bogus -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c - real tpm12 - integer iseed(4) - parameter(tpm12 = 1.d0/65536.d0) - parameter(nmax=1021) -c external prngblk - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - data m1,m2,m3,m4 / 0, 8037, 61950, 30779/ - if (me .lt. 0 .or. me .gt. nmax) then - prng_next=-1.0 - return - endif - l1=l(1,me) - l2=l(2,me) - l3=l(3,me) - l4=l(4,me) - i1=l1*m4+l2*m3+l3*m2+l4*m1 + n(1,me) - i2=l2*m4+l3*m3+l4*m2 + n(2,me) - i3=l3*m4+l4*m3 + n(3,me) - i4=l4*m4 + n(4,me) - l4=and(i4,65535) - i3=i3+ishft(i4,-16) - l3=and(i3,65535) - i2=i2+ishft(i3,-16) - l2=and(i2,65535) - l1=and(i1+ishft(i2,-16),65535) - prng_next=tpm12*(l1+tpm12*(l2+tpm12*(l3+tpm12*l4))) - l(1,me)=l1 - l(2,me)=l2 - l(3,me)=l3 - l(4,me)=l4 - return - end -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c -crc entry prng_chkpnt (me, iseed) - logical function prng_chkpnt (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed(1)=l(1,me) - iseed(2)=l(2,me) - iseed(3)=l(3,me) - iseed(4)=l(4,me) - endif - return - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c seed is an 4-element integer array containing the "l"-values -c -crc entry prng_restart (me, iseed) - logical function prng_restart (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - l(1,me)=iseed(1) - l(2,me)=iseed(2) - l(3,me)=iseed(3) - l(4,me)=iseed(4) - endif - return - end - - block data prngblk -c -c Sequence of prime numbers represented as pairs of 16-bit integers -c modulo 2**16, obtained from Mal Kalos August 28, 1992. Only 98 -c continuation cards are allowed by ksr Fortran, so several DATA -c statements are used to initialize 1022 generators. -c -c @cornell university, 1992 -c - parameter(nmax=1021,nmax1=2*nmax+2) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - -c High order quads in arrays "l" and "n" are initialized to zero : rows 1-2 -c Rows 5-16 remain uninitialized. They are just pads, never used. - DATA ((l(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - DATA ((n(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - -c The rest of array "l" and "n" are initialized to a 20-bit seed - DATA ((l(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180,51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((l(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((l(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181,1015,181,1021,181,1023,181,1041,181,1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - DATA ((n(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180, 51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((n(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((n(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181, 1015,181, 1021,181, 1023,181, 1041,181, 1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - end -#endif diff --git a/source/unres/src_MD-DFA-restraints/proc_proc.c b/source/unres/src_MD-DFA-restraints/proc_proc.c deleted file mode 100644 index d77c5a4..0000000 --- a/source/unres/src_MD-DFA-restraints/proc_proc.c +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include - -#ifdef CRAY -void PROC_PROC(long int *f, int *i) -#else -#ifdef LINUX -#ifdef PGI -void proc_proc_(long int *f, int *i) -#else -void proc_proc__(long int *f, int *i) -#endif -#endif -#ifdef SGI -void proc_proc_(long int *f, int *i) -#endif -#if defined(WIN) && !defined(WINIFL) -void _stdcall PROC_PROC(long int *f, int *i) -#endif -#ifdef WINIFL -void proc_proc(long int *f, int *i) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_proc(long int *f, int *i) -#endif -#endif - -{ -static long int NaNQ; -static long int NaNQm; - -if(*i==-1) - { - NaNQ=*f; - NaNQm=0xffffffff; - return; - } -*i=0; -if(*f==NaNQ) - *i=1; -if(*f==NaNQm) - *i=1; -} - -#ifdef CRAY -void PROC_CONV(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV(char *buf, int *i, int n) -#endif -{ -int j; - -sscanf(buf,"%d",&j); -*i=j; -return; -} - -#ifdef CRAY -void PROC_CONV_R(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv_r__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_r_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv_r(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV_R(char *buf, int *i, int n) -#endif - -{ - -/* sprintf(buf,"%d",*i); */ - -return; -} - - -#ifndef IMSL -#ifdef CRAY -void DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef LINUX -void dsvrgp__(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef SGI -void dsvrgp_(int *n, double *tab1, double *tab2, int *itab) -#endif -#if defined(AIX) || defined(WINPGI) -void dsvrgp(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef WIN -void _stdcall DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -{ -double t; -int i,j,k; - -if(tab1 != tab2) - { - for(i=0; i<*n; i++) - tab2[i]=tab1[i]; - } -k=0; -while(k<*n-1) - { - j=k; - t=tab2[k]; - for(i=k+1; i<*n; i++) - if(t>tab2[i]) - { - j=i; - t=tab2[i]; - } - if(j!=k) - { - tab2[j]=tab2[k]; - tab2[k]=t; - i=itab[j]; - itab[j]=itab[k]; - itab[k]=i; - } - k++; - } -} -#endif diff --git a/source/unres/src_MD-DFA-restraints/q_measure.F b/source/unres/src_MD-DFA-restraints/q_measure.F deleted file mode 100644 index 417cf35..0000000 --- a/source/unres/src_MD-DFA-restraints/q_measure.F +++ /dev/null @@ -1,487 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x - sigm(x)=0.25d0*x - qq = 0.0d0 - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - endif - qwolynes=1.0d0-qq - return - end -c------------------------------------------------------------------- - subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist - double precision dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x,sim,dd0,fac,ddqij - sigm(x)=0.25d0*x - - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim = sim*sim - dd0=dijCM-d0ijCM - fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim=sim*sim - dd0 = dijCM-d0ijCM - fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - endif - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-10/ - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=(q2-q1)/delta - c(j,i)=cdummy(j,i) - enddo - enddo - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo -c write(iout,*) "Numerical Q carteisan gradients backbone: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) -c enddo -c write(iout,*) "Numerical Q carteisan gradients side-chain: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) -c enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i), - & qinfrag(i,iset)) -c hm1=harmonic(qfrag(i,iset),qinfrag(i,iset)) -c hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset), -c & qinfrag(i,iset)) -c write(iout,*) "harmonicnum frag", hmnum -c Calculating the derivatives of Q with respect to cartesian coordinates - call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dU/dQi and dQi/dxi -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true. -c & ,idummy,idummy) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c hm1=harmonic(qpair(i),qinpair(i,iset)) -c hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i), -c & qinpair(i,iset)) -c write(iout,*) "harmonicnum pair ", hmnum -c Calculating dQ/dXi - call qwolynes_prim(kstart,kend,.false. - & ,lstart,lend) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients -c call qwol_num(kstart,kend,.false. -c & ,lstart,lend) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - duxcartan(j,i)=0.0d0 - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset), - & ifrag(2,ii,iset),.true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo -c write(iout,*) "Numerical dUconst/ddx side-chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) -c enddo - return - end -c--------------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/q_measure1.F b/source/unres/src_MD-DFA-restraints/q_measure1.F deleted file mode 100644 index 9c1546d..0000000 --- a/source/unres/src_MD-DFA-restraints/q_measure1.F +++ /dev/null @@ -1,470 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i),ifrag(2,i),.true.,idummy,idummy) - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - integer i,j,k,il,jl,il1,jl1,nd - double precision dist - external dist - double precision dij1,dij2,dij3,dij4,d0ij1,d0ij2,d0ij3,d0ij4,fac, - & fac1,ddave,ssij,ddqij - logical lprn /.false./ - d0ij1=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij1=dist(il,jl) - ddave=(dij1-d0ij1)**2 - nd=1 - if (jl1.ne.jl) then - d0ij2=dsqrt((cref(1,jl1)-cref(1,il))**2+ - & (cref(2,jl1)-cref(2,il))**2+ - & (cref(3,jl1)-cref(3,il))**2) - dij2=dist(il,jl1) - ddave=ddave+(dij2-d0ij2)**2 - nd=nd+1 - endif - if (il1.ne.il) then - d0ij3=dsqrt((cref(1,jl)-cref(1,il1))**2+ - & (cref(2,jl)-cref(2,il1))**2+ - & (cref(3,jl)-cref(3,il1))**2) - dij3=dist(il1,jl) - ddave=ddave+(dij3-d0ij3)**2 - nd=nd+1 - endif - if (il1.ne.il .and. jl1.ne.jl) then - d0ij4=dsqrt((cref(1,jl1)-cref(1,il1))**2+ - & (cref(2,jl1)-cref(2,il1))**2+ - & (cref(3,jl1)-cref(3,il1))**2) - dij4=dist(il1,jl1) - ddave=ddave+(dij4-d0ij4)**2 - nd=nd+1 - endif - ddave=ddave/nd - if (lprn) then - write (iout,*) "il",il," jl",jl, - & " itype",itype(il),itype(jl)," nd",nd - write (iout,*)"d0ij",d0ij1,d0ij2,d0ij3,d0ij4, - & " dij",dij1,dij2,dij3,dij4," ddave",ddave - call flush(iout) - endif -c ssij = (0.25d0*d0ij1)**2 - if (il.ne.il1 .and. jl.ne.jl1) then - ssij = 16.0d0/(d0ij1*d0ij4) - else - ssij = 16.0d0/(d0ij1*d0ij1) - endif - qcontrib = dexp(-0.5d0*ddave*ssij) -c Compute gradient - fac1 = qcontrib*ssij/nd - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (jl1.ne.jl) then - fac = fac1*(dij2-d0ij2)/dij2 - do k=1,3 - ddqij = (c(k,il)-c(k,jl1))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il) then - fac = fac1*(dij3-d0ij3)/dij3 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il .and. jl1.ne.jl) then - fac = fac1*(dij4-d0ij4)/dij4 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/q_measure3.F b/source/unres/src_MD-DFA-restraints/q_measure3.F deleted file mode 100644 index f0a030e..0000000 --- a/source/unres/src_MD-DFA-restraints/q_measure3.F +++ /dev/null @@ -1,529 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.,idummy,idummy) - enddo -c stop - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.LOCAL' - integer i,j,k,il,jl,il1,jl1,nd,itl,jtl - double precision dist - external dist - double precision dij,dij1,d0ij,d0ij1,om1,om2,om12,om10,om20,om120 - & ,fac,fac1,ddave,ssij,ddqij,d0ii1,d0jj1,rij,eom1,eom2,eom12 - double precision u(3),v(3),er(3),er0(3),dcosom1(3),dcosom2(3), - & aux1,aux2 - double precision scalar - external scalar - logical lprn /.false./ - if (lprn) write (iout,*) "il",il," jl",jl," il1",il1," jl1",jl1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - dij1=dist(il1,jl1) - do i=1,3 - er(i)=(c(i,jl1)-c(i,il1))/dij1 - enddo - do i=1,3 - er0(i)=cref(i,jl1)-cref(i,il1) - enddo - d0ij1=dsqrt(scalar(er0,er0)) - do i=1,3 - er0(i)=er0(i)/d0ij1 - enddo - if (il.ne.il1 .or. jl.ne.jl1) then - ddave=0.5d0*((dij-d0ij)**2+(dij1-d0ij1)**2) - nd=2 - else - ddave=(dij-d0ij)**2 - nd=1 - endif - if (il.ne.il1) then - do i=1,3 - u(i)=cref(i,il1)-cref(i,il) - enddo - d0ii1=dsqrt(scalar(u,u)) - do i=1,3 - u(i)=u(i)/d0ii1 - enddo - if (lprn) then - write (iout,*) "u",(u(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om10=scalar(er0,u) - om1=scalar(er,dc_norm(1,il1)) - write (iout,*) "om10",om10," om1",om1 - endif - else - om1=0.0d0 - om10=0.0d0 - endif - if (jl.ne.jl1) then - do i=1,3 - v(i)=cref(i,jl1)-cref(i,jl) - enddo - d0jj1=dsqrt(scalar(v,v)) - do i=1,3 - v(i)=v(i)/d0jj1 - enddo - if (lprn) then - write (iout,*) "v",(v(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om20=scalar(er,v) - om2=scalar(er,dc_norm(1,jl1)) - write (iout,*) "om20",om20," om2",om2 - endif - else - om2=0.0d0 - om20=0.0d0 - endif - if (il.ne.il1 .and. jl.ne.jl1) then - om120=scalar(u,v) - om12=scalar(dc_norm(1,il1),dc_norm(1,jl1)) - else - om12=0.0d0 - om120=0.0d0 - endif - if (lprn) then - write (iout,*) "il",il," jl",jl,itype(il),itype(jl) - write (iout,*)"d0ij",d0ij," om10",om10," om20",om20, - & " om120",om120, - & " dij",dij," om1",om1," om2",om2," om12",om12 - call flush(iout) - endif - ssij = 16.0d0/(d0ij*d0ij) - qcontrib = dexp(-0.5d0*(ddave*ssij+((om1-om10)**2 - & +(om2-om20)**2+(om12-om120)**2))) - if (lprn) write (iout,*) "ssij",ssij," qcontrib",qcontrib -c qcontrib = dexp(-0.5d0*(ddave*ssij)+(om1-om10)**2+(om2-om20)**2) -c qcontrib = dexp(-0.5d0*(ddave*ssij)) -c Compute gradient - radial component - fac1 = qcontrib*ssij/nd - fac = fac1*(dij-d0ij)/dij - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (il1.ne.il .or. jl1.ne.jl) then - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - if (il1.ne.il) then - dxqwol(k,il)=dxqwol(k,il)+ddqij - else - dqwol(k,il)=dqwol(k,il)+ddqij - endif - if (jl1.ne.jl) then - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - else - dqwol(k,jl)=dqwol(k,jl)-ddqij - endif - enddo - endif -c return -c Orientational contributions - rij=1.0d0/dij1 - eom1=qcontrib*(om1-om10) - eom2=qcontrib*(om2-om20) - eom12=qcontrib*(om12-om120) - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,il1)-om1*er(k)) - dcosom2(k)=rij*(dc_norm(k,jl1)-om2*er(k)) - enddo - do k=1,3 - ddqij=eom1*dcosom1(k)+eom2*dcosom2(k) - aux1=(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) - & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - aux2=(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) - & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - dqwol(k,il)=dqwol(k,il)-ddqij-aux1 - dqwol(k,jl)=dqwol(k,jl)+ddqij-aux2 - dxqwol(k,il)=dxqwol(k,il)-ddqij+aux1 -c & +(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) -c & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - dxqwol(k,jl)=dxqwol(k,jl)+ddqij+aux2 -c & +(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) -c & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/randgens.f b/source/unres/src_MD-DFA-restraints/randgens.f deleted file mode 100644 index 0daeb35..0000000 --- a/source/unres/src_MD-DFA-restraints/randgens.f +++ /dev/null @@ -1,99 +0,0 @@ -C $Date: 1994/10/04 16:19:52 $ -C $Revision: 2.1 $ -C -C -C See help for RANDOMV on the PSFSHARE disk to understand these -C subroutines. This is the VS Fortran version of this code. -C -C - SUBROUTINE VRND(VEC,N) - INTEGER A(250) - COMMON /VRANDD/ A, I, I147 - INTEGER LOOP,I,I147,VEC(N) - DO 23000 LOOP=1,N - I=I+1 - IF(.NOT.(I.GE.251))GOTO 23002 - I=1 -23002 CONTINUE - I147=I147+1 - IF(.NOT.(I147.GE.251))GOTO 23004 - I147=1 -23004 CONTINUE - A(I)=IEOR(A(I147),A(I)) - VEC(LOOP)=A(I) -23000 CONTINUE - RETURN - END -C -C - DOUBLE PRECISION FUNCTION RNDV(IDUM) - DOUBLE PRECISION RM1,RM2,R(99) - INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM - SAVE - DATA IA1,IC1,M1/1279,351762,1664557/ - DATA IA2,IC2,M2/2011,221592,1048583/ - DATA IA3,IC3,M3/15551,6150,29101/ - IF(.NOT.(IDUM.LT.0))GOTO 23006 - IX1 = MOD(-IDUM,M1) - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IX1,M2) - IX1 = MOD(IA1*IX1+IC1,M1) - IX3 = MOD(IX1,M3) - RM1 = 1./DBLE(M1) - RM2 = 1./DBLE(M2) - DO 23008 J = 1,99 - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 -23008 CONTINUE -23006 CONTINUE - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - IX3 = MOD(IA3*IX3+IC3,M3) - J = 1+(99*IX3)/M3 - RNDV = R(J) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 - IDUM = IX1 - RETURN - END -C -C - SUBROUTINE VRNDST(SEED) - INTEGER A(250),LOOP,IDUM,SEED - DOUBLE PRECISION RNDV - COMMON /VRANDD/ A, I, I147 - I=0 - I147=103 - IDUM=SEED - DO 23010 LOOP=1,250 - A(LOOP)=INT(RNDV(IDUM)*2147483647) -23010 CONTINUE - RETURN - END -C -C - SUBROUTINE VRNDIN(IODEV) - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - READ(IODEV) A, I, I147 - RETURN - END -C -C - SUBROUTINE VRNDOU(IODEV) -C This corresponds to VRNDOUT in the APFTN64 version - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - WRITE(IODEV) A, I, I147 - RETURN - END - FUNCTION RNUNF(N) - INTEGER IRAN1(2000) - DATA FCTOR /2147483647.0D0/ -C We get only one random number, here! DR 9/1/92 - CALL VRND(IRAN1,1) - RNUNF= DBLE( IRAN1(1) ) / FCTOR -C****************************** -C write(6,*) 'rnunf in rnunf = ',rnunf - RETURN - END diff --git a/source/unres/src_MD-DFA-restraints/rattle.F b/source/unres/src_MD-DFA-restraints/rattle.F deleted file mode 100644 index a2e5034..0000000 --- a/source/unres/src_MD-DFA-restraints/rattle.F +++ /dev/null @@ -1,706 +0,0 @@ - subroutine rattle1 -c RATTLE algorithm for velocity Verlet - step 1, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2),xcorr(3,MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE1" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i)=dC(j,i)-xx - d_t_new(j,i)=d_t_new(j,i)-xx/d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i+nres)=dC(j,i+nres)-xx - d_t_new(j,i+nres)=d_t_new(j,i+nres)-xx/d_time - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle2 -c RATTLE algorithm for velocity Verlet - step 2, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE2" - if (lprn) write (iout,*) "Velocity correction" -c Calculate the matrix G dC - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k+nres) - enddo - endif - enddo - enddo -c if (lprn) then -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo -c endif -c Calculate the matrix of the system of equations - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i)*gdc(k,ind,j) - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i+nres)*gdc(k,ind,j) - enddo - enddo - endif - enddo -c Calculate the scalar product dC o d_t_new - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - if (lprn) then - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind) - endif - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to velocities - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i)=d_t(j,i)-xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i+nres)=d_t(j,i+nres)-xx - enddo - endif - enddo - if (lprn) then - write (iout,*) - & "New velocities, Lagrange multipliers violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - if (lprn) write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind),scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind), - & scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - endif - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle_brown -c RATTLE/LINCS algorithm for Brownian dynamics, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.true./, lprn1 /.true./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE_BROWN" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1)GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),scalar(d_t(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3), - & scalar(d_t(1,i+nres),dC_old(1,i+nres)) - endif - enddo - write (iout,*) "gdc" - do i=1,nbond - write (iout,*) "i",i - do j=1,nbond - write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) - enddo - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i)=d_t(j,i)+xx/d_time - dC(j,i)=dC(j,i)+xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i+nres)=d_t(j,i+nres)+xx/d_time - dC(j,i+nres)=dC(j,i+nres)+xx - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end diff --git a/source/unres/src_MD-DFA-restraints/readpdb.F b/source/unres/src_MD-DFA-restraints/readpdb.F deleted file mode 100644 index 48e0abd..0000000 --- a/source/unres/src_MD-DFA-restraints/readpdb.F +++ /dev/null @@ -1,432 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - logical fail - integer rescode - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - - - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if(me.eq.king.or..not.out1file)then - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' - endif - endif - endif - do i=1,nres-1 - iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) -C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) - & di=dsc(itype(i)) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end diff --git a/source/unres/src_MD-DFA-restraints/readrtns.F b/source/unres/src_MD-DFA-restraints/readrtns.F deleted file mode 100644 index d21d3b9..0000000 --- a/source/unres/src_MD-DFA-restraints/readrtns.F +++ /dev/null @@ -1,2868 +0,0 @@ - subroutine readrtns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical file_exist -C Read force-field parameters except weights - call parmread -C Read job setup parameters - call read_control -C Read control parameters for energy minimzation if required - if (minim) call read_minim -C Read MCM control parameters if required - if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread -C Read MD control parameters if reqjuired - if (modecalc.eq.12) call read_MDpar -C Read MREMD control parameters if required - if (modecalc.eq.14) then - call read_MDpar - call read_REMDpar - endif -C Read MUCA control parameters if required - if (lmuca) call read_muca -C Read CSA control parameters if required (from fort.40 if exists -C otherwise from general input file) -csa if (modecalc.eq.8) then -csa inquire (file="fort.40",exist=file_exist) -csa if (.not.file_exist) call csaread -csa endif -cfmc if (modecalc.eq.10) call mcmfread -C Read molecule information, molecule geometry, energy-term weights, and -C restraints if requested - call molread -C Print restraint information -#ifdef MPI - if (.not. out1file .or. me.eq.king) then -#endif - if (nhpb.gt.nss) - &write (iout,'(a,i5,a)') "The following",nhpb-nss, - & " distance constraints have been imposed" - do i=nss+1,nhpb - write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i), - & ibecarb(i),dhpb(i),dhpb1(i),forcon(i) - enddo -#ifdef MPI - endif -#endif -c print *,"Processor",myrank," leaves READRTNS" - return - end -C------------------------------------------------------------------------------- - subroutine read_control -C -C Read contorl data -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/ - character*80 ucase - character*320 controlcard - - nglob_csa=0 - eglob_csa=1d99 - nmin_csa=0 - read (INP,'(a)') titel - call card_concat(controlcard) -c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0 -c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file - call reada(controlcard,'SEED',seed,0.0D0) - call random_init(seed) -C Set up the time limit (caution! The time must be input in minutes!) - read_cart=index(controlcard,'READ_CART').gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - call readi(controlcard,'CONSTR_HOMOL',constr_homology,0) - call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours - unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 - call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes - call reada(controlcard,'RMSDBC',rmsdbc,3.0D0) - call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0) - call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0) - call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0) - call reada(controlcard,'DRMS',drms,0.1D0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc - write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1 - write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max - write (iout,'(a,f10.1)')'DRMS = ',drms - write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm - write (iout,'(a,f10.1)') 'Time limit (min):',timlim - endif - call readi(controlcard,'NZ_START',nz_start,0) - call readi(controlcard,'NZ_END',nz_end,0) - call readi(controlcard,'IZ_SC',iz_sc,0) - timlim=60.0D0*timlim - safety = 60.0d0*safety - timem=timlim - modecalc=0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - minim=(index(controlcard,'MINIMIZE').gt.0) - dccart=(index(controlcard,'CART').gt.0) - overlapsc=(index(controlcard,'OVERLAP').gt.0) - overlapsc=.not.overlapsc - searchsc=(index(controlcard,'NOSEARCHSC').gt.0) - searchsc=.not.searchsc - sideadd=(index(controlcard,'SIDEADD').gt.0) - energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) - outpdb=(index(controlcard,'PDBOUT').gt.0) - outmol2=(index(controlcard,'MOL2OUT').gt.0) - pdbref=(index(controlcard,'PDBREF').gt.0) - refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) - indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) - call readi(controlcard,'IPRINT',iprint,0) - call readi(controlcard,'MAXGEN',maxgen,10000) - call readi(controlcard,'MAXOVERLAP',maxoverlap,1000) - call readi(controlcard,"KDIAG",kdiag,0) - call readi(controlcard,"RESCALE_MODE",rescale_mode,2) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) - & write (iout,*) "RESCALE_MODE",rescale_mode - split_ene=index(controlcard,'SPLIT_ENE').gt.0 - if (index(controlcard,'REGULAR').gt.0.0D0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - modecalc=1 - refstr=.true. - endif - if (index(controlcard,'CHECKGRAD').gt.0) then - modecalc=5 - if (index(controlcard,'CART').gt.0) then - icheckgrad=1 - elseif (index(controlcard,'CARINT').gt.0) then - icheckgrad=2 - else - icheckgrad=3 - endif - elseif (index(controlcard,'THREAD').gt.0) then - modecalc=2 - call readi(controlcard,'THREAD',nthread,0) - if (nthread.gt.0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - else - if (fg_rank.eq.0) - & write (iout,'(a)')'A number has to follow the THREAD keyword.' - stop 'Error termination in Read_Control.' - endif - else if (index(controlcard,'MCMA').gt.0) then - modecalc=3 - else if (index(controlcard,'MCEE').gt.0) then - modecalc=6 - else if (index(controlcard,'MULTCONF').gt.0) then - modecalc=4 - else if (index(controlcard,'MAP').gt.0) then - modecalc=7 - call readi(controlcard,'MAP',nmap,0) - else if (index(controlcard,'CSA').gt.0) then - write(*,*) "CSA not supported in this version" - stop -csa modecalc=8 -crc else if (index(controlcard,'ZSCORE').gt.0) then -crc -crc ZSCORE is rm from UNRES, modecalc=9 is available -crc -crc modecalc=9 -cfcm else if (index(controlcard,'MCMF').gt.0) then -cfmc modecalc=10 - else if (index(controlcard,'SOFTREG').gt.0) then - modecalc=11 - else if (index(controlcard,'CHECK_BOND').gt.0) then - modecalc=-1 - else if (index(controlcard,'TEST').gt.0) then - modecalc=-2 - else if (index(controlcard,'MD').gt.0) then - modecalc=12 - else if (index(controlcard,'RE ').gt.0) then - modecalc=14 - endif - - lmuca=index(controlcard,'MUCA').gt.0 - call readi(controlcard,'MUCADYN',mucadyn,0) - call readi(controlcard,'MUCASMOOTH',muca_smooth,0) - if (lmuca .and. (me.eq.king .or. .not.out1file )) - & then - write (iout,*) 'MUCADYN=',mucadyn - write (iout,*) 'MUCASMOOTH=',muca_smooth - endif - - iscode=index(controlcard,'ONE_LETTER') - indphi=index(controlcard,'PHI') - indback=index(controlcard,'BACK') - iranconf=index(controlcard,'RAND_CONF') - i2ndstr=index(controlcard,'USE_SEC_PRED') - gradout=index(controlcard,'GRADOUT').gt.0 - gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 - - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') diagmeth(kdiag), - & ' routine used to diagonalize matrices.' - return - end -c-------------------------------------------------------------------------- - subroutine read_REMDpar -C -C Read REMD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.REMD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*80 ucase - character*320 controlcard - character*3200 controlcard1 - integer iremd_m_total - - if(me.eq.king.or..not.out1file) - & write (iout,*) "REMD setup" - - call card_concat(controlcard) - call readi(controlcard,"NREP",nrep,3) - call readi(controlcard,"NSTEX",nstex,1000) - call reada(controlcard,"RETMIN",retmin,10.0d0) - call reada(controlcard,"RETMAX",retmax,1000.0d0) - mremdsync=(index(controlcard,'SYNC').gt.0) - call readi(controlcard,"NSYN",i_sync_step,100) - restart1file=(index(controlcard,'REST1FILE').gt.0) - traj1file=(index(controlcard,'TRAJ1FILE').gt.0) - call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1) - if(max_cache_traj_use.gt.max_cache_traj) - & max_cache_traj_use=max_cache_traj - if(me.eq.king.or..not.out1file) then -cd if (traj1file) then -crc caching is in testing - NTWX is not ignored -cd write (iout,*) "NTWX value is ignored" -cd write (iout,*) " trajectory is stored to one file by master" -cd write (iout,*) " before exchange at NSTEX intervals" -cd endif - write (iout,*) "NREP= ",nrep - write (iout,*) "NSTEX= ",nstex - write (iout,*) "SYNC= ",mremdsync - write (iout,*) "NSYN= ",i_sync_step - write (iout,*) "TRAJCACHE= ",max_cache_traj_use - endif - - t_exchange_only=(index(controlcard,'TONLY').gt.0) - call readi(controlcard,"HREMD",hremd,0) - if((me.eq.king.or..not.out1file).and.hremd.gt.0) then - write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights" - endif - if(usampl.and.hremd.gt.0) then - write (iout,'(//a)') - & "========== ERROR: USAMPL and HREMD cannot be used together" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop - endif - - - remd_tlist=.false. - if (index(controlcard,'TLIST').gt.0) then - remd_tlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_t(i),i=1,nrep) - if(me.eq.king.or..not.out1file) - & write (iout,*)'tlist',(remd_t(i),i=1,nrep) - endif - remd_mlist=.false. - if (index(controlcard,'MLIST').gt.0) then - remd_mlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_m(i),i=1,nrep) - if(me.eq.king.or..not.out1file) then - write (iout,*)'mlist',(remd_m(i),i=1,nrep) - iremd_m_total=0 - do i=1,nrep - iremd_m_total=iremd_m_total+remd_m(i) - enddo - if(hremd.gt.1)then - write (iout,*) 'Total number of replicas ', - & iremd_m_total*hremd - else - write (iout,*) 'Total number of replicas ',iremd_m_total - endif - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup " - return - end -c-------------------------------------------------------------------------- - subroutine read_MDpar -C -C Read MD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - character*80 ucase - character*320 controlcard - - call card_concat(controlcard) - call readi(controlcard,"NSTEP",n_timestep,1000000) - call readi(controlcard,"NTWE",ntwe,100) - call readi(controlcard,"NTWX",ntwx,1000) - call reada(controlcard,"DT",d_time,1.0d-1) - call reada(controlcard,"DVMAX",dvmax,2.0d1) - call reada(controlcard,"DAMAX",damax,1.0d1) - call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1) - call readi(controlcard,"LANG",lang,0) - RESPA = index(controlcard,"RESPA") .gt. 0 - call readi(controlcard,"NTIME_SPLIT",ntime_split,1) - ntime_split0=ntime_split - call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64) - ntime_split0=ntime_split - call reada(controlcard,"R_CUT",r_cut,2.0d0) - call reada(controlcard,"LAMBDA",rlamb,0.3d0) - rest = index(controlcard,"REST").gt.0 - tbf = index(controlcard,"TBF").gt.0 - call readi(controlcard,"HMC",hmc,0) - tnp = index(controlcard,"NOSEPOINCARE99").gt.0 - tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0 - tnh = index(controlcard,"NOSEHOOVER96").gt.0 - if (RESPA.and.tnh)then - xiresp = index(controlcard,"XIRESP").gt.0 - endif - call reada(controlcard,"Q_NP",Q_np,0.1d0) - usampl = index(controlcard,"USAMPL").gt.0 - - mdpdb = index(controlcard,"MDPDB").gt.0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1) - call reada(controlcard,"EQ_TIME",eq_time,1.0d+4) - call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000) - if (count_reset_moment.eq.0) count_reset_moment=1000000000 - call readi(controlcard,"RESET_VEL",count_reset_vel,1000) - reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0 - reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0 - if (count_reset_vel.eq.0) count_reset_vel=1000000000 - large = index(controlcard,"LARGE").gt.0 - print_compon = index(controlcard,"PRINT_COMPON").gt.0 - rattle = index(controlcard,"RATTLE").gt.0 -c if performing umbrella sampling, fragments constrained are read from the fragment file - nset=0 - if(usampl) then - call read_fragments - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) - write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run " - write (iout,*) - write (iout,'(a)') "The units are:" - write (iout,'(a)') "positions: angstrom, time: 48.9 fs" - write (iout,'(2a)') "velocity: angstrom/(48.9 fs),", - & " acceleration: angstrom/(48.9 fs)**2" - write (iout,'(a)') "energy: kcal/mol, temperature: K" - write (iout,*) - write (iout,'(a60,i10)') "Number of time steps:",n_timestep - write (iout,'(a60,f10.5,a)') - & "Initial time step of numerical integration:",d_time, - & " natural units" - write (iout,'(60x,f10.5,a)') d_time*48.9," fs" - if (RESPA) then - write (iout,'(2a,i4,a)') - & "A-MTS algorithm used; initial time step for fast-varying", - & " short-range forces split into",ntime_split," steps." - write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff", - & r_cut," lambda",rlamb - endif - write (iout,'(2a,f10.5)') - & "Maximum acceleration threshold to reduce the time step", - & "/increase split number:",damax - write (iout,'(2a,f10.5)') - & "Maximum predicted energy drift to reduce the timestep", - & "/increase split number:",edriftmax - write (iout,'(a60,f10.5)') - & "Maximum velocity threshold to reduce velocities:",dvmax - write (iout,'(a60,i10)') "Frequency of property output:",ntwe - write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx - if (rattle) write (iout,'(a60)') - & "Rattle algorithm used to constrain the virtual bonds" - endif - reset_fricmat=1000 - if (lang.gt.0) then - call reada(controlcard,"ETAWAT",etawat,0.8904d0) - call reada(controlcard,"RWAT",rwat,1.4d0) - call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2) - surfarea=index(controlcard,"SURFAREA").gt.0 - call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000) - if(me.eq.king.or..not.out1file)then - write (iout,'(/a,$)') "Langevin dynamics calculation" - if (lang.eq.1) then - write (iout,'(a/)') - & " with direct integration of Langevin equations" - else if (lang.eq.2) then - write (iout,'(a/)') " with TINKER stochasic MD integrator" - else if (lang.eq.3) then - write (iout,'(a/)') " with Ciccotti's stochasic MD integrator" - else if (lang.eq.4) then - write (iout,'(a/)') " in overdamped mode" - else - write (iout,'(//a,i5)') - & "=========== ERROR: Unknown Langevin dynamics mode:",lang - stop - endif - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat - write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat - write (iout,'(a60,f10.5)') - & "Scaling factor of the friction forces:",scal_fric - if (surfarea) write (iout,'(2a,i10,a)') - & "Friction coefficients will be scaled by solvent-accessible", - & " surface area every",reset_fricmat," steps." - endif -c Calculate friction coefficients and bounds of stochastic forces - eta=6*pi*cPoise*etawat - if(me.eq.king.or..not.out1file) - & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:" - & ,eta - gamp=scal_fric*(pstok+rwat)*eta - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - gamsc(i)=scal_fric*(restok(i)+rwat)*eta - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if(me.eq.king.or..not.out1file)then - write (iout,'(/2a/)') - & "Radii of site types and friction coefficients and std's of", - & " stochastic forces of fully exposed sites" - write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp) - do i=1,ntyp - write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i), - & gamsc(i),stdfsc(i)*dsqrt(gamsc(i)) - enddo - endif - else if (tbf) then - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') "Berendsen bath calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - endif - else if (tnp .or. tnp1 .or. tnh) then - if (tnp .or. tnp1) then - write (iout,'(a)') "Nose-Poincare bath calculation" - if (tnp) write (iout,'(a)') - & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird" - if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose" - else - write (iout,'(a)') "Nose-Hoover bath calculation" - write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al." - nresn=1 - nyosh=1 - nnos=1 - do i=1,nnos - qmass(i)=Q_np - xlogs(i)=1.0 - vlogs(i)=0.0 - enddo - do i=1,nyosh - WDTI(i) = 1.0*d_time/nresn - WDTI2(i)=WDTI(i)/2 - WDTI4(i)=WDTI(i)/4 - WDTI8(i)=WDTI(i)/8 - enddo - if (RESPA) then - if(xiresp) then - write (iout,'(a)') "NVT-XI-RESPA algorithm" - else - write (iout,'(a)') "NVT-XO-RESPA algorithm" - endif - do i=1,nyosh - WDTIi(i) = 1.0*d_time/nresn/ntime_split - WDTIi2(i)=WDTIi(i)/2 - WDTIi4(i)=WDTIi(i)/4 - WDTIi8(i)=WDTIi(i)/8 - enddo - endif - endif - - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Q =",Q_np - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - - else if (hmc.gt.0) then - write (iout,'(a)') "Hybrid Monte Carlo calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,i10)') - & "Number of MD steps between Metropolis tests:",hmc - - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a31)') "Microcanonical mode calculation" - endif - if(me.eq.king.or..not.out1file)then - if (rest) write (iout,'(/a/)') "===== Calculation restarted ====" - if (usampl) then - write(iout,*) "MD running with constraints." - write(iout,*) "Equilibration time ", eq_time, " mtus." - write(iout,*) "Constraining ", nfrag," fragments." - write(iout,*) "Length of each fragment, weight and q0:" - do iset=1,nset - write (iout,*) "Set of restraints #",iset - do i=1,nfrag - write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset), - & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset) - enddo - write(iout,*) "constraints between ", npair, "fragments." - write(iout,*) "constraint pairs, weights and q0:" - do i=1,npair - write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset), - & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset) - enddo - write(iout,*) "angle constraints within ", nfrag_back, - & "backbone fragments." - write(iout,*) "fragment, weights:" - do i=1,nfrag_back - write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset), - & ifrag_back(2,i,iset),wfrag_back(1,i,iset), - & wfrag_back(2,i,iset),wfrag_back(3,i,iset) - enddo - enddo - iset=mod(kolor,nset)+1 - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup " - return - end -c------------------------------------------------------------------------------ - subroutine molread -C -C Read molecular data. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer error_msg -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.CONTACTS' - include 'COMMON.TORCNSTR' - include 'COMMON.TIME1' - include 'COMMON.BOUNDS' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - character*4 sequence(maxres) - integer rescode - double precision x(maxvar) - character*256 pdbfile - character*320 weightcard - character*80 weightcard_t,ucase - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - logical seq_comp,fail - double precision energia(0:n_ene) - integer ilen - external ilen -C -C Body -C -C Read weights of the subsequent energy terms. - if(hremd.gt.0) then - - k=0 - do il=1,hremd - do i=1,nrep - do j=1,remd_m(i) - i2set(k)=il - k=k+1 - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write (iout,*) 'Reading ',hremd,' sets of weights for HREMD' - write (iout,*) 'Current weights for processor ', - & me,' set ',i2set(me) - endif - - do i=1,hremd - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - - hweights(i,1)=wsc - hweights(i,2)=wscp - hweights(i,3)=welec - hweights(i,4)=wcorr - hweights(i,5)=wcorr5 - hweights(i,6)=wcorr6 - hweights(i,7)=wel_loc - hweights(i,8)=wturn3 - hweights(i,9)=wturn4 - hweights(i,10)=wturn6 - hweights(i,11)=wang - hweights(i,12)=wscloc - hweights(i,13)=wtor - hweights(i,14)=wtor_d - hweights(i,15)=wstrain - hweights(i,16)=wvdwpp - hweights(i,17)=wbond - hweights(i,18)=scal14 - hweights(i,21)=wsccor - - enddo - - do i=1,n_ene - weights(i)=hweights(i2set(me),i) - enddo - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - - else - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'WDFAD',wdfa_dist,0.0d0) - call reada(weightcard,'WDFAT',wdfa_tor,0.0d0) - call reada(weightcard,'WDFAN',wdfa_nei,0.0d0) - call reada(weightcard,'WDFAB',wdfa_beta,0.0d0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - weights(1)=wsc - weights(2)=wscp - weights(3)=welec - weights(4)=wcorr - weights(5)=wcorr5 - weights(6)=wcorr6 - weights(7)=wel_loc - weights(8)=wturn3 - weights(9)=wturn4 - weights(10)=wturn6 - weights(11)=wang - weights(12)=wscloc - weights(13)=wtor - weights(14)=wtor_d - weights(15)=wstrain - weights(16)=wvdwpp - weights(17)=wbond - weights(18)=scal14 - weights(21)=wsccor - endif - weights(25)=wdfa_dist - weights(26)=wdfa_tor - weights(27)=wdfa_nei - weights(28)=wdfa_beta - - if(me.eq.king.or..not.out1file) - & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta - 10 format (/'Energy-term weights (unscaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)'/ - & 'WDFA_D= ',f10.6,' (DFA, distance)' / - & 'WDFA_T= ',f10.6,' (DFA, torsional)' / - & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' / - & 'WDFA_B= ',f10.6,' (DFA, beta formation)') - if(me.eq.king.or..not.out1file)then - if (wcorr4.gt.0.0d0) then - write (iout,'(/2a/)') 'Local-electrostatic type correlation ', - & 'between contact pairs of peptide groups' - write (iout,'(2(a,f5.3/))') - & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr, - & 'Range of quenching the correlation terms:',2*delt_corr - else if (wcorr.gt.0.0d0) then - write (iout,'(/2a/)') 'Hydrogen-bonding correlation ', - & 'between contact pairs of peptide groups' - endif - write (iout,'(a,f8.3)') - & 'Scaling factor of 1,4 SC-p interactions:',scal14 - write (iout,'(a,f8.3)') - & 'General scaling factor of SC-p interactions:',scalscp - endif - r0_corr=cutoff_corr-delt_corr - do i=1,20 - aad(i,1)=scalscp*aad(i,1) - aad(i,2)=scalscp*aad(i,2) - bad(i,1)=scalscp*bad(i,1) - bad(i,2)=scalscp*bad(i,2) - enddo - call rescale_weights(t_bath) - if(me.eq.king.or..not.out1file) - & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta - 22 format (/'Energy-term weights (scaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)'/ - & 'WDFA_D= ',f10.6,' (DFA, distance)' / - & 'WDFA_T= ',f10.6,' (DFA, torsional)' / - & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' / - & 'WDFA_B= ',f10.6,' (DFA, beta formation)') - if(me.eq.king.or..not.out1file) - & write (iout,*) "Reference temperature for weights calculation:", - & temp0 - call reada(weightcard,"D0CM",d0cm,3.78d0) - call reada(weightcard,"AKCM",akcm,15.1d0) - call reada(weightcard,"AKTH",akth,11.0d0) - call reada(weightcard,"AKCT",akct,12.0d0) - call reada(weightcard,"V1SS",v1ss,-1.08d0) - call reada(weightcard,"V2SS",v2ss,7.61d0) - call reada(weightcard,"V3SS",v3ss,13.7d0) - call reada(weightcard,"EBR",ebr,-5.50D0) - dyn_ss=(index(weightcard,'DYN_SS').gt.0) - do i=1,maxres - dyn_ss_mask(i)=.false. - enddo - do i=1,maxres-1 - do j=i+1,maxres - dyn_ssbond_ij(i,j)=1.0d300 - enddo - enddo - call reada(weightcard,"HT",Ht,0.0D0) - if (dyn_ss) then - ss_depth=ebr/wsc-0.25*eps(1,1) - Ht=Ht/wsc-0.25*eps(1,1) - akcm=akcm*wstrain/wsc - akth=akth*wstrain/wsc - akct=akct*wstrain/wsc - v1ss=v1ss*wstrain/wsc - v2ss=v2ss*wstrain/wsc - v3ss=v3ss*wstrain/wsc - else - ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) "Parameters of the SS-bond potential:" - write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, - & " AKCT",akct - write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth - write (iout,*)" HT",Ht - print *,'indpdb=',indpdb,' pdbref=',pdbref - endif - if (indpdb.gt.0 .or. pdbref) then - read(inp,'(a)') pdbfile - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') 'PDB data will be read from file ', - & pdbfile(:ilen(pdbfile)) - open(ipdbin,file=pdbfile,status='old',err=33) - goto 34 - 33 write (iout,'(a)') 'Error opening PDB file.' - stop - 34 continue -c print *,'Begin reading pdb data' - call readpdb -c print *,'Finished reading pdb data' - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3,a,i3)')'nsup=',nsup, - & ' nstart_sup=',nstart_sup - do i=1,nres - itype_pdb(i)=itype(i) - enddo - close (ipdbin) - nnt=nstart_sup - nct=nstart_sup+nsup-1 - call contact(.false.,ncont_ref,icont_ref,co) - - if (sideadd) then -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "Before sideadd" - call intout - if(me.eq.king.or..not.out1file) - & write(iout,*)'Adding sidechains' - maxsi=1000 - do i=2,nres-1 - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) write(iout,*)'Adding sidechain failed for res ', - & i,' after ',nsi,' trials' - endif - enddo -C 10/03/12 Adam: Recalculate coordinates with new side chain positions - call chainbuild - endif -C Following 2 lines for diagnostics; comment out if not needed -c write (iout,*) "After sideadd" -c call intout - endif - if (indpdb.eq.0) then -C Read sequence if not taken from the pdb file. - read (inp,*) nres -c print *,'nres=',nres - if (iscode.gt.0) then - read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres) - else - read (inp,'(20(1x,a3))') (sequence(i),i=1,nres) - endif -C Convert sequence to numeric code - do i=1,nres - itype(i)=rescode(i,sequence(i),iscode) - enddo -C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(itype(i)) - vbld_inv(i+nres)=dsc_inv(itype(i)) -c write (iout,*) "i",i," itype",itype(i), -c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo - endif -c print *,nres -c print '(20i4)',(itype(i),i=1,nres) - do i=1,nres -#ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then -#else - if (itype(i).eq.21) then -#endif - itel(i)=0 -#ifdef PROCOR - else if (itype(i+1).ne.20) then -#else - else if (itype(i).ne.20) then -#endif - itel(i)=1 - else - itel(i)=2 - endif - enddo - if(me.eq.king.or..not.out1file)then - write (iout,*) "ITEL" - do i=1,nres-1 - write (iout,*) i,itype(i),itel(i) - enddo - print *,'Call Read_Bridge.' - endif - call read_bridge -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - read (inp,*) ndih_constr - if (ndih_constr.gt.0) then - read (inp,*) ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) - if(me.eq.king.or..not.out1file)then - write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' - do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) - enddo - endif - do i=1,ndih_constr - phi0(i)=deg2rad*phi0(i) - drange(i)=deg2rad*drange(i) - enddo - if(me.eq.king.or..not.out1file) - & write (iout,*) 'FTORS',ftors - do i=1,ndih_constr - ii = idih_constr(i) - phibound(1,ii) = phi0(i)-drange(i) - phibound(2,ii) = phi0(i)+drange(i) - enddo - endif - nnt=1 -#ifdef MPI - if (me.eq.king) then -#endif - write (iout,'(a)') 'Boundaries in phi angle sampling:' - do i=1,nres - write (iout,'(a3,i5,2f10.1)') - & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg - enddo -#ifdef MP - endif -#endif - nct=nres -cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - -C Bartek:READ init_vars -C Initialize variables! -C Juyong:READ read_info -C READ fragment information!! -C both routines should be in dfa.F file!! - - if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. - & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then - call init_dfa_vars - print*, 'init_dfa_vars finished!' - call read_dfa_info - print*, 'read_dfa_info finished!' - endif -C - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3)') 'nsup=',nsup - nstart_seq=nnt - if (nsup.le.(nct-nnt+1)) then - do i=0,nct-nnt+1-nsup - if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then - nstart_seq=nnt+i - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - stop - else - do i=0,nsup-(nct-nnt+1) - if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1)) - & then - nstart_sup=nstart_sup+i - nsup=nct-nnt+1 - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - endif - 111 continue - if (nsup.eq.0) nsup=nct-nnt - if (nstart_sup.eq.0) nstart_sup=nnt - if (nstart_seq.eq.0) nstart_seq=nnt - if(me.eq.king.or..not.out1file) - & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, - & ' nstart_seq=',nstart_seq - endif -c--- Zscore rms ------- - if (nz_start.eq.0) nz_start=nnt - if (nz_end.eq.0 .and. nsup.gt.0) then - nz_end=nnt+nsup-1 - else if (nz_end.eq.0) then - nz_end=nct - endif - if(me.eq.king.or..not.out1file)then - write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end - write (iout,*) 'IZ_SC=',iz_sc - endif -c---------------------- - call init_int_table - if (refstr) then - if (.not.pdbref) then - call read_angles(inp,*38) - goto 39 - 38 write (iout,'(a)') 'Error reading reference structure.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) - stop 'Error reading reference structure' -#endif - 39 call chainbuild - call setup_var -czscore call geom_to_var(nvar,coord_exp_zs(1,1)) - nstart_sup=nnt - nstart_seq=nnt - nsup=nct-nnt+1 - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - call contact(.true.,ncont_ref,icont_ref,co) - endif - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Contact order:',co - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup - do i=1,ncont_ref - do j=1,2 - icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup - enddo - if(me.eq.king.or..not.out1file) - & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ', - & icont_ref(1,i),' ', - & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i) - enddo - endif - endif -c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup - if (constr_dist.gt.0) then - call read_dist_constr - endif - - - if (constr_homology.gt.0) then - call read_constr_homology - endif - - - if (nhpb.gt.0) call hpb_partition -c write (iout,*) "After read_dist_constr nhpb",nhpb -c call flush(iout) - if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 - & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. - & modecalc.ne.10) then -C If input structure hasn't been supplied from the PDB file read or generate -C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then - if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) - & write (iout,'(a)') 'Initial geometry will be read in.' - if (read_cart) then - read(inp,'(8f10.5)',end=36,err=36) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - return - else - call read_angles(inp,*36) - endif - goto 37 - 36 write (iout,'(a)') 'Error reading angle file.' -#ifdef MPI - call mpi_finalize( MPI_COMM_WORLD,IERR ) -#endif - stop 'Error reading angle file.' - 37 continue - else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - enddo - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a)') 'Random-generated initial geometry.' - - -#ifdef MPI - if (me.eq.king .or. fg_rank.eq.0 .and. ( - & modecalc.eq.12 .or. modecalc.eq.14) ) then -#endif - do itrial=1,100 - itmp=1 - call gen_rand_conf(itmp,*30) - goto 40 - 30 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Processor:',me, - & ' Failed to generate random conformation', - & ' itrial=',itrial - call intout - -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - call flush(iout) -#ifdef MPI - call MPI_Abort(mpi_comm_world,error_msg,ierrcode) - 40 continue - endif -#else - 40 continue -#endif - endif - elseif (modecalc.eq.4) then - read (inp,'(a)') intinname - open (intin,file=intinname,status='old',err=333) - if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0) - & write (iout,'(a)') 'intinname',intinname - write (*,'(a)') 'Processor',myrank,' intinname',intinname - goto 334 - 333 write (iout,'(2a)') 'Error opening angle file ',intinname -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERR) -#endif - stop 'Error opening angle file.' - 334 continue - - endif -C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif - call setup_var - if (me.eq.king .or. .not. out1file) - & call intout - if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then - write (iout,'(/a,i3,a)') - & 'The chain contains',ns,' disulfide-bridging cysteines.' - write (iout,'(20i4)') (iss(i),i=1,ns) - if (dyn_ss) then - write(iout,*)"Running with dynamic disulfide-bond formation" - else - write (iout,'(/a/)') 'Pre-formed links are:' - do i=1,nss - i1=ihpb(i)-nres - i2=jhpb(i)-nres - it1=itype(i1) - it2=itype(i2) - write (iout,'(2a,i3,3a,i3,a,3f10.3)') - & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), - & ebr,forcon(i) - enddo - write (iout,'(a)') - endif - endif - if (ns.gt.0.and.dyn_ss) then - do i=nss+1,nhpb - ihpb(i-nss)=ihpb(i) - jhpb(i-nss)=jhpb(i) - forcon(i-nss)=forcon(i) - dhpb(i-nss)=dhpb(i) - enddo - nhpb=nhpb-nss - nss=0 - call hpb_partition - do i=1,ns - dyn_ss_mask(iss(i))=.true. - enddo - endif - if (i2ndstr.gt.0) call secstrp2dihc -c call geom_to_var(nvar,x) -c call etotal(energia(0)) -c call enerprint(energia(0)) -c call briefout(0,etot) -c stop -cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT -cd write (iout,'(a)') 'Variable list:' -cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar) -#ifdef MPI - if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file)) - & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') - & 'Processor',myrank,': end reading molecular data.' -#endif - return - end -c-------------------------------------------------------------------------- - logical function seq_comp(itypea,itypeb,length) - implicit none - integer length,itypea(length),itypeb(length) - integer i - do i=1,length - if (itypea(i).ne.itypeb(i)) then - seq_comp=.false. - return - endif - enddo - seq_comp=.true. - return - end -c----------------------------------------------------------------------------- - subroutine read_bridge -C Read information about disulfide bridges. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -C Read bridging residues. - read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns - if(me.eq.king.or..not.out1file) - & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) -C Check whether the specified bridging residues are cystines. - do i=1,ns - if (itype(iss(i)).ne.1) then - if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' - write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo -C Read preformed bridges. - if (ns.gt.0) then - read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - if(fg_rank.eq.0) - & write(iout,*)'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) - if (nss.gt.0) then - nhpb=nss -C Check if the residues involved in bridges are in the specified list of -C bridging residues. - do i=1,nss - do j=1,i-1 - if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j) - & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then - write (iout,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' - write (*,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo - do j=1,ns - if (ihpb(i).eq.iss(j)) goto 10 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 10 continue - do j=1,ns - if (jhpb(i).eq.iss(j)) goto 20 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 20 continue - dhpb(i)=dbr - forcon(i)=fbr - enddo - do i=1,nss - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - enddo - endif - endif - return - end -c---------------------------------------------------------------------------- - subroutine read_x(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' -c Read coordinates from input -c - read(kanal,'(8f10.5)',end=10,err=10) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine read_threadbase - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Read pattern database for threading. - read (icbase,*) nseq - do i=1,nseq - read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), - & nres_base(2,i),nres_base(3,i) - read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, - & nres_base(1,i)) -c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), -c & nres_base(2,i),nres_base(3,i) -c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, -c & nres_base(1,i)) - enddo - close (icbase) - if (weidis.eq.0.0D0) weidis=0.1D0 - do i=nnt,nct - do j=i+2,nct - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=weidis - enddo - enddo - read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl) - write (iout,'(a,i5)') 'nexcl: ',nexcl - write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl) - return - end -c------------------------------------------------------------------------------ - subroutine setup_var - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Set up variable list. - ntheta=nres-2 - nphi=nres-3 - nvar=ntheta+nphi - nside=0 - do i=2,nres-1 - if (itype(i).ne.10) then - nside=nside+1 - ialph(i,1)=nvar+nside - ialph(nside,2)=i - endif - enddo - if (indphi.gt.0) then - nvar=nphi - else if (indback.gt.0) then - nvar=nphi+ntheta - else - nvar=nvar+2*nside - endif -cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1) - return - end -c---------------------------------------------------------------------------- - subroutine gen_dist_constr -C Generate CA distance constraints. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - character*2 iden -cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct -cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct, -cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq, -cd & ' nsup',nsup - do i=nstart_sup,nstart_sup+nsup-1 -cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), -cd & ' seq_pdb', restyp(itype_pdb(i)) - do j=i+2,nstart_sup+nsup-1 - nhpb=nhpb+1 - ihpb(nhpb)=i+nstart_seq-nstart_sup - jhpb(nhpb)=j+nstart_seq-nstart_sup - forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) - enddo - enddo -cd write (iout,'(a)') 'Distance constraints:' -cd do i=nss+1,nhpb -cd ii=ihpb(i) -cd jj=jhpb(i) -cd iden='CA' -cd if (ii.gt.nres) then -cd iden='SC' -cd ii=ii-nres -cd jj=jj-nres -cd endif -cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)') -cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, -cd & dhpb(i),forcon(i) -cd enddo - return - end -c---------------------------------------------------------------------------- - subroutine map_read - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.IOUNITS' - character*3 angid(4) /'THE','PHI','ALP','OME'/ - character*80 mapcard,ucase - do imap=1,nmap - read (inp,'(a)') mapcard - mapcard=ucase(mapcard) - if (index(mapcard,'PHI').gt.0) then - kang(imap)=1 - else if (index(mapcard,'THE').gt.0) then - kang(imap)=2 - else if (index(mapcard,'ALP').gt.0) then - kang(imap)=3 - else if (index(mapcard,'OME').gt.0) then - kang(imap)=4 - else - write(iout,'(a)')'Error - illegal variable spec in MAP card.' - stop 'Error - illegal variable spec in MAP card.' - endif - call readi (mapcard,'RES1',res1(imap),0) - call readi (mapcard,'RES2',res2(imap),0) - if (res1(imap).eq.0) then - res1(imap)=res2(imap) - else if (res2(imap).eq.0) then - res2(imap)=res1(imap) - endif - if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then - write (iout,'(a)') - & 'Error - illegal definition of variable group in MAP.' - stop 'Error - illegal definition of variable group in MAP.' - endif - call reada(mapcard,'FROM',ang_from(imap),0.0D0) - call reada(mapcard,'TO',ang_to(imap),0.0D0) - call readi(mapcard,'NSTEP',nstep(imap),0) - if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then - write (iout,'(a)') - & 'Illegal boundary and/or step size specification in MAP.' - stop 'Illegal boundary and/or step size specification in MAP.' - endif - enddo ! imap - return - end -c---------------------------------------------------------------------------- -csa subroutine csaread -csa implicit real*8 (a-h,o-z) -csa include 'DIMENSIONS' -csa include 'COMMON.IOUNITS' -csa include 'COMMON.GEO' -csa include 'COMMON.CSA' -csa include 'COMMON.BANK' -csa include 'COMMON.CONTROL' -csa character*80 ucase -csa character*620 mcmcard -csa call card_concat(mcmcard) -csa -csa call readi(mcmcard,'NCONF',nconf,50) -csa call readi(mcmcard,'NADD',nadd,0) -csa call readi(mcmcard,'JSTART',jstart,1) -csa call readi(mcmcard,'JEND',jend,1) -csa call readi(mcmcard,'NSTMAX',nstmax,500000) -csa call readi(mcmcard,'N0',n0,1) -csa call readi(mcmcard,'N1',n1,6) -csa call readi(mcmcard,'N2',n2,4) -csa call readi(mcmcard,'N3',n3,0) -csa call readi(mcmcard,'N4',n4,0) -csa call readi(mcmcard,'N5',n5,0) -csa call readi(mcmcard,'N6',n6,10) -csa call readi(mcmcard,'N7',n7,0) -csa call readi(mcmcard,'N8',n8,0) -csa call readi(mcmcard,'N9',n9,0) -csa call readi(mcmcard,'N14',n14,0) -csa call readi(mcmcard,'N15',n15,0) -csa call readi(mcmcard,'N16',n16,0) -csa call readi(mcmcard,'N17',n17,0) -csa call readi(mcmcard,'N18',n18,0) -csa -csa vdisulf=(index(mcmcard,'DYNSS').gt.0) -csa -csa call readi(mcmcard,'NDIFF',ndiff,2) -csa call reada(mcmcard,'DIFFCUT',diffcut,0.0d0) -csa call readi(mcmcard,'IS1',is1,1) -csa call readi(mcmcard,'IS2',is2,8) -csa call readi(mcmcard,'NRAN0',nran0,4) -csa call readi(mcmcard,'NRAN1',nran1,2) -csa call readi(mcmcard,'IRR',irr,1) -csa call readi(mcmcard,'NSEED',nseed,20) -csa call readi(mcmcard,'NTOTAL',ntotal,10000) -csa call reada(mcmcard,'CUT1',cut1,2.0d0) -csa call reada(mcmcard,'CUT2',cut2,5.0d0) -csa call reada(mcmcard,'ESTOP',estop,-3000.0d0) -csa call readi(mcmcard,'ICMAX',icmax,3) -csa call readi(mcmcard,'IRESTART',irestart,0) -csac!bankt call readi(mcmcard,'NBANKTM',ntbankm,0) -csa ntbankm=0 -csac!bankt -csa call reada(mcmcard,'DELE',dele,20.0d0) -csa call reada(mcmcard,'DIFCUT',difcut,720.0d0) -csa call readi(mcmcard,'IREF',iref,0) -csa call reada(mcmcard,'RMSCUT',rmscut,4.0d0) -csa call reada(mcmcard,'PNCCUT',pnccut,0.5d0) -csa call readi(mcmcard,'NCONF_IN',nconf_in,0) -csa call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0) -csa write (iout,*) "NCONF_IN",nconf_in -csa return -csa end -c---------------------------------------------------------------------------- -cfmc subroutine mcmfread -cfmc implicit real*8 (a-h,o-z) -cfmc include 'DIMENSIONS' -cfmc include 'COMMON.MCMF' -cfmc include 'COMMON.IOUNITS' -cfmc include 'COMMON.GEO' -cfmc character*80 ucase -cfmc character*620 mcmcard -cfmc call card_concat(mcmcard) -cfmc -cfmc call readi(mcmcard,'MAXRANT',maxrant,1000) -cfmc write(iout,*)'MAXRANT=',maxrant -cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p) -cfmc write(iout,*)'MAXFAM=',maxfam -cfmc call readi(mcmcard,'NNET1',nnet1,5) -cfmc write(iout,*)'NNET1=',nnet1 -cfmc call readi(mcmcard,'NNET2',nnet2,4) -cfmc write(iout,*)'NNET2=',nnet2 -cfmc call readi(mcmcard,'NNET3',nnet3,4) -cfmc write(iout,*)'NNET3=',nnet3 -cfmc call readi(mcmcard,'ILASTT',ilastt,0) -cfmc write(iout,*)'ILASTT=',ilastt -cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf) -cfmc write(iout,*)'MAXSTR=',maxstr -cfmc maxstr_f=maxstr/maxfam -cfmc write(iout,*)'MAXSTR_F=',maxstr_f -cfmc call readi(mcmcard,'NMCMF',nmcmf,10) -cfmc write(iout,*)'NMCMF=',nmcmf -cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf) -cfmc write(iout,*)'IFOCUS=',ifocus -cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000) -cfmc write(iout,*)'NLOCMCMF=',nlocmcmf -cfmc call readi(mcmcard,'INTPRT',intprt,1000) -cfmc write(iout,*)'INTPRT=',intprt -cfmc call readi(mcmcard,'IPRT',iprt,100) -cfmc write(iout,*)'IPRT=',iprt -cfmc call readi(mcmcard,'IMAXTR',imaxtr,100) -cfmc write(iout,*)'IMAXTR=',imaxtr -cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000) -cfmc write(iout,*)'MAXEVEN=',maxeven -cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3) -cfmc write(iout,*)'MAXEVEN1=',maxeven1 -cfmc call readi(mcmcard,'INIMIN',inimin,200) -cfmc write(iout,*)'INIMIN=',inimin -cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10) -cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf -cfmc call readi(mcmcard,'NTHREAD',nthread,5) -cfmc write(iout,*)'NTHREAD=',nthread -cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500) -cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf -cfmc call readi(mcmcard,'MAXPERT',maxpert,9) -cfmc write(iout,*)'MAXPERT=',maxpert -cfmc call readi(mcmcard,'IRMSD',irmsd,1) -cfmc write(iout,*)'IRMSD=',irmsd -cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0) -cfmc write(iout,*)'DENEMIN=',denemin -cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0) -cfmc write(iout,*)'RCUT1S=',rcut1s -cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0) -cfmc write(iout,*)'RCUT1E=',rcut1e -cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0) -cfmc write(iout,*)'RCUT2S=',rcut2s -cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0) -cfmc write(iout,*)'RCUT2E=',rcut2e -cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0) -cfmc write(iout,*)'DPERT1=',d_pert1 -cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0) -cfmc write(iout,*)'DPERT1A=',d_pert1a -cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0) -cfmc write(iout,*)'DPERT2=',d_pert2 -cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0) -cfmc write(iout,*)'DPERT2A=',d_pert2a -cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0) -cfmc write(iout,*)'DPERT2B=',d_pert2b -cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0) -cfmc write(iout,*)'DPERT2C=',d_pert2c -cfmc d_pert1=deg2rad*d_pert1 -cfmc d_pert1a=deg2rad*d_pert1a -cfmc d_pert2=deg2rad*d_pert2 -cfmc d_pert2a=deg2rad*d_pert2a -cfmc d_pert2b=deg2rad*d_pert2b -cfmc d_pert2c=deg2rad*d_pert2c -cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0) -cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1 -cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0) -cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2 -cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0) -cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1 -cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0) -cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2 -cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0) -cfmc write(iout,*)'RCUTINI=',rcutini -cfmc call reada(mcmcard,'GRAT',grat,0.5D0) -cfmc write(iout,*)'GRAT=',grat -cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0) -cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf -cfmc -cfmc return -cfmc end -c---------------------------------------------------------------------------- - subroutine mcmread - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 mcmcard - call card_concat(mcmcard) - call readi(mcmcard,'MAXACC',maxacc,100) - call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000) - call readi(mcmcard,'MAXTRIAL',maxtrial,100) - call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000) - call readi(mcmcard,'MAXREPM',maxrepm,200) - call reada(mcmcard,'RANFRACT',RanFract,0.5D0) - call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0) - call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3) - call reada(mcmcard,'E_UP',e_up,5.0D0) - call reada(mcmcard,'DELTE',delte,0.1D0) - call readi(mcmcard,'NSWEEP',nsweep,5) - call readi(mcmcard,'NSTEPH',nsteph,0) - call readi(mcmcard,'NSTEPC',nstepc,0) - call reada(mcmcard,'TMIN',tmin,298.0D0) - call reada(mcmcard,'TMAX',tmax,298.0D0) - call readi(mcmcard,'NWINDOW',nwindow,0) - call readi(mcmcard,'PRINT_MC',print_mc,0) - print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0) - print_int=(index(mcmcard,'NO_PRINT_INT').le.0) - ent_read=(index(mcmcard,'ENT_READ').gt.0) - call readi(mcmcard,'SAVE_FREQ',save_frequency,1000) - call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000) - call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000) - call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000) - call readi(mcmcard,'PRINT_FREQ',print_freq,1000) - if (nwindow.gt.0) then - read (inp,*) (winstart(i),winend(i),i=1,nwindow) - do i=1,nwindow - winlen(i)=winend(i)-winstart(i)+1 - enddo - endif - if (tmax.lt.tmin) tmax=tmin - if (tmax.eq.tmin) then - nstepc=0 - nsteph=0 - endif - if (nstepc.gt.0 .and. nsteph.gt.0) then - tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0)) - tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0)) - endif -C Probabilities of different move types - sumpro_type(0)=0.0D0 - call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0) - call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0) - sumpro_type(2)=sumpro_type(1)+sumpro_type(2) - call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0) - sumpro_type(3)=sumpro_type(2)+sumpro_type(3) - call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0) - sumpro_type(4)=sumpro_type(3)+sumpro_type(4) - do i=1,MaxMoveType - print *,'i',i,' sumprotype',sumpro_type(i) - sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType) - print *,'i',i,' sumprotype',sumpro_type(i) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine read_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MINIM' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 minimcard - call card_concat(minimcard) - call readi(minimcard,'MAXMIN',maxmin,2000) - call readi(minimcard,'MAXFUN',maxfun,5000) - call readi(minimcard,'MINMIN',minmin,maxmin) - call readi(minimcard,'MINFUN',minfun,maxmin) - call reada(minimcard,'TOLF',tolf,1.0D-2) - call reada(minimcard,'RTOLF',rtolf,1.0D-4) - print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1) - print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1) - print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1) - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Options in energy minimization:' - write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') - & 'MaxMin:',MaxMin,' MaxFun:',MaxFun, - & 'MinMin:',MinMin,' MinFun:',MinFun, - & ' TolF:',TolF,' RTolF:',RTolF - return - end -c---------------------------------------------------------------------------- - subroutine read_angles(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' -c Read angles from input -c - read (kanal,*,err=10,end=10) (theta(i),i=3,nres) - read (kanal,*,err=10,end=10) (phi(i),i=4,nres) - read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1) - read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1) - - do i=1,nres -c 9/7/01 avoid 180 deg valence angle - if (theta(i).gt.179.99d0) theta(i)=179.99d0 -c - theta(i)=deg2rad*theta(i) - phi(i)=deg2rad*phi(i) - alph(i)=deg2rad*alph(i) - omeg(i)=deg2rad*omeg(i) - enddo - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine openunits - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - character*16 form,nodename - integer nodelen -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - integer lenpre,lenpot,ilen,lentmp - external ilen - character*3 out1file_text,ucase - character*3 ll - external ucase -c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits" - call getenv_loc("PREFIX",prefix) - pref_orig = prefix - call getenv_loc("POT",pot) - call getenv_loc("DIRTMP",tmpdir) - call getenv_loc("CURDIR",curdir) - call getenv_loc("OUT1FILE",out1file_text) -c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV" - out1file_text=ucase(out1file_text) - if (out1file_text(1:1).eq."Y") then - out1file=.true. - else - out1file=fg_rank.gt.0 - endif - lenpre=ilen(prefix) - lenpot=ilen(pot) - lentmp=ilen(tmpdir) - if (lentmp.gt.0) then - write (*,'(80(1h!))') - write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!" - write (*,'(80(1h!))') - write (*,*)"All output files will be on node /tmp directory." -#ifdef MPI - call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR ) - if (me.eq.king) then - write (*,*) "The master node is ",nodename - else if (fg_rank.eq.0) then - write (*,*) "I am the CG slave node ",nodename - else - write (*,*) "I am the FG slave node ",nodename - endif -#endif - PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre) - lenpre = lentmp+lenpre+1 - endif - entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' -C Get the names and open the input files -#if defined(WINIFL) || defined(WINPGI) - open(1,file=pref_orig(:ilen(pref_orig))// - & '.inp',status='old',readonly,shared) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly,shared) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly,shared) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly,shared) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly,shared) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly,shared) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly,shared) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly,shared) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & action='read') -c print *,"Processor",myrank," opened file 1" - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -c print *,"Processor",myrank," opened file 9" -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') -c print *,"Processor",myrank," opened file IBOND" - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -c print *,"Processor",myrank," opened file ITHEP" -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',action='read') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -c print *,"Processor",myrank," opened file IROTAM" -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORP" - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORDP" - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') -c print *,"Processor",myrank," opened file ISCCOR" - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') -c print *,"Processor",myrank," opened file IFOURIER" - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') -c print *,"Processor",myrank," opened file IELEP" - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -c print *,"Processor",myrank," opened file ISIDEP" -c print *,"Processor",myrank," opened parameter files" -#elif (defined G77) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') -#else - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - &action='read') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - print *,"thetname_pdb ",thetname_pdb - open (ithep_pdb,file=thetname_pdb,status='old',action='read') - print *,ithep_pdb," opened" -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -#endif -#ifndef OLDSCP -C -C 8/9/01 In the newest version SCp interaction constants are read from a file -C Use -DOLDSCP to use hard-coded constants instead. -C - call getenv_loc('SCPPAR',scpname) -#if defined(WINIFL) || defined(WINPGI) - open (iscpp,file=scpname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (iscpp,file=scpname,status='old',action='read') -#elif (defined G77) - open (iscpp,file=scpname,status='old') -#else - open (iscpp,file=scpname,status='old',action='read') -#endif -#endif - call getenv_loc('PATTERN',patname) -#if defined(WINIFL) || defined(WINPGI) - open (icbase,file=patname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (icbase,file=patname,status='old',action='read') -#elif (defined G77) - open (icbase,file=patname,status='old') -#else - open (icbase,file=patname,status='old',action='read') -#endif -#ifdef MPI -C Open output file only for CG processes -c print *,"Processor",myrank," fg_rank",fg_rank - if (fg_rank.eq.0) then - - if (nodes.eq.1) then - npos=3 - else - npos = dlog10(dfloat(nodes-1))+1 - endif - if (npos.lt.3) npos=3 - write (liczba,'(i1)') npos - form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) - & //')' - write (liczba,form) me - outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// - & liczba(:ilen(liczba)) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //liczba(:ilen(liczba))//'.stat') - rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) - & //'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.const' - endif - - endif -#else - outname=prefix(:lenpre)//'.out_'//pot(:lenpot) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //'.stat') - rest2name=prefix(:ilen(prefix))//'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const' - endif -#endif -#if defined(AIX) || defined(PGI) - if (me.eq.king .or. .not. out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',position='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',position='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#else - if (me.eq.king .or. .not.out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - print "Processor",fg_rank," opening output file" - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',access='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',access='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#endif -csa csa_rbank=prefix(:lenpre)//'.CSA.rbank' -csa csa_seed=prefix(:lenpre)//'.CSA.seed' -csa csa_history=prefix(:lenpre)//'.CSA.history' -csa csa_bank=prefix(:lenpre)//'.CSA.bank' -csa csa_bank1=prefix(:lenpre)//'.CSA.bank1' -csa csa_alpha=prefix(:lenpre)//'.CSA.alpha' -csa csa_alpha1=prefix(:lenpre)//'.CSA.alpha1' -csac!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt' -csa csa_int=prefix(:lenpre)//'.int' -csa csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized' -csa csa_native_int=prefix(:lenpre)//'.CSA.native.int' -csa csa_in=prefix(:lenpre)//'.CSA.in' -c print *,"Processor",myrank,"fg_rank",fg_rank," opened files" -C Write file names - if (me.eq.king)then - write (iout,'(80(1h-))') - write (iout,'(30x,a)') "FILE ASSIGNMENT" - write (iout,'(80(1h-))') - write (iout,*) "Input file : ", - & pref_orig(:ilen(pref_orig))//'.inp' - write (iout,*) "Output file : ", - & outname(:ilen(outname)) - write (iout,*) - write (iout,*) "Sidechain potential file : ", - & sidename(:ilen(sidename)) -#ifndef OLDSCP - write (iout,*) "SCp potential file : ", - & scpname(:ilen(scpname)) -#endif - write (iout,*) "Electrostatic potential file : ", - & elename(:ilen(elename)) - write (iout,*) "Cumulant coefficient file : ", - & fouriername(:ilen(fouriername)) - write (iout,*) "Torsional parameter file : ", - & torname(:ilen(torname)) - write (iout,*) "Double torsional parameter file : ", - & tordname(:ilen(tordname)) - write (iout,*) "SCCOR parameter file : ", - & sccorname(:ilen(sccorname)) - write (iout,*) "Bond & inertia constant file : ", - & bondname(:ilen(bondname)) - write (iout,*) "Bending parameter file : ", - & thetname(:ilen(thetname)) - write (iout,*) "Rotamer parameter file : ", - & rotname(:ilen(rotname)) - write (iout,*) "Threading database : ", - & patname(:ilen(patname)) - if (lentmp.ne.0) - &write (iout,*)" DIRTMP : ", - & tmpdir(:lentmp) - write (iout,'(80(1h-))') - endif - return - end -c---------------------------------------------------------------------------- - subroutine card_concat(card) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*(*) card - character*80 karta,ucase - external ilen - read (inp,'(a)') karta - karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end -c---------------------------------------------------------------------------------- - subroutine readrst - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - open(irest2,file=rest2name,status='unknown') - read(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - read(irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl) then - read (irest2,*) iset - endif - close(irest2) - return - end -c--------------------------------------------------------------------------------- - subroutine read_fragments - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - read(inp,*) nset,nfrag,npair,nfrag_back - if(me.eq.king.or..not.out1file) - & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair, - & " nfrag_back",nfrag_back - do iset=1,nset - read(inp,*) mset(iset) - do i=1,nfrag - read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset), - & qinfrag(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset), - & ifrag(2,i,iset), qinfrag(i,iset) - enddo - do i=1,npair - read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset), - & qinpair(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset), - & ipair(2,i,iset), qinpair(i,iset) - enddo - do i=1,nfrag_back - read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset), - & ifrag_back(1,i,iset),ifrag_back(2,i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset) - enddo - enddo - return - end -c------------------------------------------------------------------------------- - subroutine read_dist_constr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - integer ifrag_(2,100),ipair_(2,100) - double precision wfrag_(100),wpair_(100) - character*500 controlcard -c write (iout,*) "Calling read_dist_constr" -c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup -c call flush(iout) - call card_concat(controlcard) - call readi(controlcard,"NFRAG",nfrag_,0) - call readi(controlcard,"NPAIR",npair_,0) - call readi(controlcard,"NDIST",ndist_,0) - call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) - call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) - call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) - call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) - call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) -c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ -c write (iout,*) "IFRAG" -c do i=1,nfrag_ -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) -c enddo -c write (iout,*) "IPAIR" -c do i=1,npair_ -c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) -c enddo - if (.not.refstr .and. nfrag.gt.0) then - write (iout,*) - & "ERROR: no reference structure to compute distance restraints" - write (iout,*) - & "Restraints must be specified explicitly (NDIST=number)" - stop - endif - if (nfrag.lt.2 .and. npair.gt.0) then - write (iout,*) "ERROR: Less than 2 fragments specified", - & " but distance restraints between pairs requested" - stop - endif - call flush(iout) - do i=1,nfrag_ - if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup - if (ifrag_(2,i).gt.nstart_sup+nsup-1) - & ifrag_(2,i)=nstart_sup+nsup-1 -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) - call flush(iout) - if (wfrag_(i).gt.0.0d0) then - do j=ifrag_(1,i),ifrag_(2,i)-1 - do k=j+1,ifrag_(2,i) -c write (iout,*) "j",j," k",k - ddjk=dist(j,k) - if (constr_dist.eq.1) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - else if (constr_dist.eq.2) then - if (ddjk.le.dist_cut) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - endif - else - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) - endif -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,npair_ - if (wpair_(i).gt.0.0d0) then - ii = ipair_(1,i) - jj = ipair_(2,i) - if (ii.gt.jj) then - itemp=ii - ii=jj - jj=itemp - endif - do j=ifrag_(1,ii),ifrag_(2,ii) - do k=ifrag_(1,jj),ifrag_(2,jj) - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - forcon(nhpb)=wpair_(i) - dhpb(nhpb)=dist(j,k) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,ndist_ - read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), - & ibecarb(i),forcon(nhpb+1) - if (forcon(nhpb+1).gt.0.0d0) then - nhpb=nhpb+1 - if (ibecarb(i).gt.0) then - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - endif - if (dhpb(nhpb).eq.0.0d0) - & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) - endif - enddo -#ifdef MPI - if (.not.out1file .or. me.eq.king) then -#endif - do i=1,nhpb - write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ", - & i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i) - enddo - call flush(iout) -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - - subroutine read_constr_homology - - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - double precision odl_temp,sigma_odl_temp - common /przechowalnia/ odl_temp(maxres,maxres,max_template), - & sigma_odl_temp(maxres,maxres,max_template) - character*2 kic2 - character*24 model_ki_dist, model_ki_angle - character*500 controlcard - integer ki, i, j, k, l - logical lprn /.true./ - - call card_concat(controlcard) - call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) - call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) - - write (iout,*) "nnt",nnt," nct",nct - call flush(iout) - lim_odl=0 - lim_dih=0 - do i=1,nres - do j=i+2,nres - do ki=1,constr_homology - sigma_odl_temp(i,j,ki)=0.0d0 - odl_temp(i,j,ki)=0.0d0 - enddo - enddo - enddo - do i=1,nres-3 - do ki=1,constr_homology - dih(ki,i)=0.0d0 - sigma_dih(ki,i)=0.0d0 - enddo - enddo - do ki=1,constr_homology - write(kic2,'(i2)') ki - if (ki.le.9) kic2="0"//kic2(2:2) - - model_ki_dist="model"//kic2//".dist" - model_ki_angle="model"//kic2//".angle" - open (ientin,file=model_ki_dist,status='old') - do irec=1,maxdim !petla do czytania wiezow na odleglosc - read (ientin,*,end=1401) i, j, odl_temp(i+nnt-1,j+nnt-1,ki), - & sigma_odl_temp(i+nnt-1,j+nnt-1,ki) - odl_temp(j+nnt-1,i+nnt-1,ki)=odl_temp(i+nnt-1,j+nnt-1,ki) - sigma_odl_temp(j+nnt-1,i+nnt-1,ki)= - & sigma_odl_temp(i+nnt-1,j+nnt-1,ki) - enddo - 1401 continue - close (ientin) - open (ientin,file=model_ki_angle,status='old') - do irec=1,maxres-3 !petla do czytania wiezow na katy torsyjne - read (ientin,*,end=1402) i, j, k,l,dih(ki,i+nnt-1), - & sigma_dih(ki,i+nnt-1) - if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 - sigma_dih(ki,i+nnt-1)=1.0d0/sigma_dih(ki,i+nnt-1)**2 - enddo - 1402 continue - close (ientin) - enddo - ii=0 - write (iout,*) "nnt",nnt," nct",nct - do i=nnt,nct-2 - do j=i+2,nct - ki=1 -c write (iout,*) "i",i," j",j," constr_homology",constr_homology - do while (ki.le.constr_homology .and. - & sigma_odl_temp(i,j,ki).le.0.0d0) -c write (iout,*) "ki",ki," sigma_odl",sigma_odl_temp(i,j,ki) - ki=ki+1 - enddo -c write (iout,*) "ki",ki - if (ki.gt.constr_homology) cycle - ii=ii+1 - ires_homo(ii)=i - jres_homo(ii)=j - do ki=1,constr_homology - odl(ki,ii)=odl_temp(i,j,ki) - sigma_odl(ki,ii)=1.0d0/sigma_odl_temp(i,j,ki)**2 - enddo - enddo - enddo - lim_odl=ii - if (constr_homology.gt.0) call homology_partition -c Print restraints - if (.not.lprn) return - write (iout,*) "Distance restraints from templates" - do ii=1,lim_odl - write(iout,'(3i5,10(2f8.2,4x))') ii,ires_homo(ii),jres_homo(ii), - & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),ki=1,constr_homology) - enddo - write (iout,*) "Dihedral angle restraints from templates" - do i=nnt,lim_dih - write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*dih(ki,i), - & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) - enddo -c write(iout,*) "TEST CZYTANIA1",odl(1,2,1),odl(1,3,1),odl(1,4,1) -c write(iout,*) "TEST CZYTANIA2",dih(1,1),dih(2,1),dih(3,1) - - - return - end -c---------------------------------------------------------------------- - -#ifdef WINIFL - subroutine flush(iu) - return - end -#endif -#ifdef AIX - subroutine flush(iu) - call flush_(iu) - return - end -#endif - -c------------------------------------------------------------------------------ - subroutine copy_to_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - character* 256 tmpfile - integer ilen - external ilen - logical ex - tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source)) - inquire(file=tmpfile,exist=ex) - if (ex) then - write (*,*) "Copying ",tmpfile(:ilen(tmpfile)), - & " to temporary directory..." - write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir - call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir) - endif - return - end -c------------------------------------------------------------------------------ - subroutine move_from_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - integer ilen - external ilen - write (*,*) "Moving ",source(:ilen(source)), - & " from temporary directory to working directory" - write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir - call system("/bin/mv "//source(:ilen(source))//" "//curdir) - return - end -c------------------------------------------------------------------------------ - subroutine random_init(seed) -C -C Initialize random number generator -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef AMD64 - integer*8 iseedi8 -#endif -#ifdef MPI - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 - integer iseed_array(4) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - iseed=-dint(dabs(seed)) - if (iseed.eq.0) then - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' - write (*,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' -#ifdef MPI - call mpi_finalize(mpi_comm_world,ierr) -#endif - stop 'Bad random seed.' - endif -#ifdef MPI - if (fg_rank.eq.0) then - seed=seed*(me+1)+1 -#ifdef AMD64 - iseedi8=dint(seed) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - OKRandom = prng_restart(me,iseedi8) -#else - do i=1,4 - tmp=65536.0d0**(4-i) - iseed_array(i) = dint(seed/tmp) - seed=seed-iseed_array(i)*tmp - enddo - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - write (*,*) 'MPI: node= ',me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - OKRandom = prng_restart(me,iseed_array) -#endif - if (OKRandom) then - r1=ran_number(0.0D0,1.0D0) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'ran_num',r1 - if (r1.lt.0.0d0) OKRandom=.false. - endif - if (.not.OKRandom) then - write (iout,*) 'PRNG IS NOT WORKING!!!' - print *,'PRNG IS NOT WORKING!!!' - if (me.eq.0) then - call flush(iout) - call mpi_abort(mpi_comm_world,error_msg,ierr) - stop - else - write (iout,*) 'too many processors for parallel prng' - write (*,*) 'too many processors for parallel prng' - call flush(iout) - stop - endif - endif - endif -#else - call vrndst(iseed) - write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0) -#endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/refsys.f b/source/unres/src_MD-DFA-restraints/refsys.f deleted file mode 100644 index b57c201..0000000 --- a/source/unres/src_MD-DFA-restraints/refsys.f +++ /dev/null @@ -1,60 +0,0 @@ - subroutine refsys(i2,i3,i4,e1,e2,e3,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c this subroutine calculates unity vectors of a local reference system -c defined by atoms (i2), (i3), and (i4). the x axis is the axis from -c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms -c (i2), (i3), and (i4). z axis is directed according to the sign of the -c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms -c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4) -c form a linear fragment. returns vectors e1, e2, and e3. - logical fail - double precision e1(3),e2(3),e3(3) - double precision u(3),z(3) - include 'COMMON.IOUNITS' - include "COMMON.CHAIN" - data coinc /1.0d-13/,align /1.0d-13/ - fail=.false. - s1=0.0d0 - s2=0.0d0 - do 1 i=1,3 - zi=c(i,i2)-c(i,i3) - ui=c(i,i4)-c(i,i3) - s1=s1+zi*zi - s2=s2+ui*ui - z(i)=zi - 1 u(i)=ui - s1=sqrt(s1) - s2=sqrt(s2) - if (s1.gt.coinc) goto 2 - write (iout,1000) i2,i3,i1 - fail=.true. - return - 2 if (s2.gt.coinc) goto 4 - write(iout,1000) i3,i4,i1 - fail=.true. - return - 4 s1=1.0/s1 - s2=1.0/s2 - v1=z(2)*u(3)-z(3)*u(2) - v2=z(3)*u(1)-z(1)*u(3) - v3=z(1)*u(2)-z(2)*u(1) - anorm=sqrt(v1*v1+v2*v2+v3*v3) - if (anorm.gt.align) goto 6 - write (iout,1010) i2,i3,i4,i1 - fail=.true. - return - 6 anorm=1.0/anorm - e3(1)=v1*anorm - e3(2)=v2*anorm - e3(3)=v3*anorm - e1(1)=z(1)*s1 - e1(2)=z(2)*s1 - e1(3)=z(3)*s1 - e2(1)=e1(3)*e3(2)-e1(2)*e3(3) - e2(2)=e1(1)*e3(3)-e1(3)*e3(1) - e2(3)=e1(2)*e3(1)-e1(1)*e3(2) - 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.') - 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear') - return - end diff --git a/source/unres/src_MD-DFA-restraints/regularize.F b/source/unres/src_MD-DFA-restraints/regularize.F deleted file mode 100644 index c506b8a..0000000 --- a/source/unres/src_MD-DFA-restraints/regularize.F +++ /dev/null @@ -1,76 +0,0 @@ - subroutine regularize(ncart,etot,rms,cref0,iretcode) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar) - double precision cref0(3,ncart) - double precision energia(0:n_ene) - logical non_conv - link_end0=link_end - do i=1,nhpb - fhpb0(i)=forcon(i) - enddo - maxit_reg=2 - print *,'Enter REGULARIZE: nnt=',nnt,' nct=',nct,' nsup=',nsup, - & ' nstart_seq=',nstart_seq,' nstart_sup',nstart_sup - write (iout,'(/a/)') 'Initial energies:' - call geom_to_var(nvar,varia) - call chainbuild - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - write (iout,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - write (*,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - maxit0=maxit - maxfun0=maxfun - rtolf0=rtolf - maxit=100 - maxfun=200 - rtolf=1.0D-2 - do it=1,maxit_reg - print *,'Regularization: pass:',it -C Minimize with distance constraints, gradually relieving the weight. - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - if (iretcode.eq.11) return - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,i2,a,f10.5,a,1pe14.5,a,i3/)') - & 'Finish pass',it,', RMS deviation:',rms,', energy',etot, - & ' SUMSL convergence',iretcode - do i=nss+1,nhpb - forcon(i)=0.1D0*forcon(i) - enddo - enddo -C Turn off the distance constraints and re-minimize energy. - print *,'Final minimization ... ' - maxit=maxit0 - maxfun=maxfun0 - rtolf=rtolf0 - link_end=min0(link_end,nss) - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),nsup, - & przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,f10.5,a,1pe14.5,a,i3/)') - & 'Final RMS deviation:',rms,' energy',etot,' SUMSL convergence', - & iretcode - link_end=link_end0 - do i=nss+1,nhpb - forcon(i)=fhpb0(i) - enddo - call var_to_geom(nvar,varia) - call chainbuild - return - end diff --git a/source/unres/src_MD-DFA-restraints/rescode.f b/source/unres/src_MD-DFA-restraints/rescode.f deleted file mode 100644 index 2973ef9..0000000 --- a/source/unres/src_MD-DFA-restraints/rescode.f +++ /dev/null @@ -1,32 +0,0 @@ - integer function rescode(iseq,nam,itype) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - character*3 nam,ucase - - if (itype.eq.0) then - - do i=1,ntyp1 - if (ucase(nam).eq.restyp(i)) then - rescode=i - return - endif - enddo - - else - - do i=1,ntyp1 - if (nam(1:1).eq.onelet(i)) then - rescode=i - return - endif - enddo - - endif - - write (iout,10) iseq,nam - stop - 10 format ('**** Error - residue',i4,' has an unresolved name ',a3) - end - diff --git a/source/unres/src_MD-DFA-restraints/rmdd.f b/source/unres/src_MD-DFA-restraints/rmdd.f deleted file mode 100644 index 799ab47..0000000 --- a/source/unres/src_MD-DFA-restraints/rmdd.f +++ /dev/null @@ -1,159 +0,0 @@ -c algorithm 611, collected algorithms from acm. -c algorithm appeared in acm-trans. math. software, vol.9, no. 4, -c dec., 1983, p. 503-524. - integer function imdcon(k) -c - integer k -c -c *** return integer machine-dependent constants *** -c -c *** k = 1 means return standard output unit number. *** -c *** k = 2 means return alternate output unit number. *** -c *** k = 3 means return input unit number. *** -c (note -- k = 2, 3 are used only by test programs.) -c -c +++ port version follows... -c external i1mach -c integer i1mach -c integer mdperm(3) -c data mdperm(1)/2/, mdperm(2)/4/, mdperm(3)/1/ -c imdcon = i1mach(mdperm(k)) -c +++ end of port version +++ -c -c +++ non-port version follows... - integer mdcon(3) - data mdcon(1)/6/, mdcon(2)/8/, mdcon(3)/5/ - imdcon = mdcon(k) -c +++ end of non-port version +++ -c - 999 return -c *** last card of imdcon follows *** - end - double precision function rmdcon(k) -c -c *** return machine dependent constants used by nl2sol *** -c -c +++ comments below contain data statements for various machines. +++ -c +++ to convert to another machine, place a c in column 1 of the +++ -c +++ data statement line(s) that correspond to the current machine +++ -c +++ and remove the c from column 1 of the data statement line(s) +++ -c +++ that correspond to the new machine. +++ -c - integer k -c -c *** the constant returned depends on k... -c -c *** k = 1... smallest pos. eta such that -eta exists. -c *** k = 2... square root of eta. -c *** k = 3... unit roundoff = smallest pos. no. machep such -c *** that 1 + machep .gt. 1 .and. 1 - machep .lt. 1. -c *** k = 4... square root of machep. -c *** k = 5... square root of big (see k = 6). -c *** k = 6... largest machine no. big such that -big exists. -c - double precision big, eta, machep - integer bigi(4), etai(4), machei(4) -c/+ - double precision dsqrt -c/ - equivalence (big,bigi(1)), (eta,etai(1)), (machep,machei(1)) -c -c +++ ibm 360, ibm 370, or xerox +++ -c -c data big/z7fffffffffffffff/, eta/z0010000000000000/, -c 1 machep/z3410000000000000/ -c -c +++ data general +++ -c -c data big/0.7237005577d+76/, eta/0.5397605347d-78/, -c 1 machep/2.22044605d-16/ -c -c +++ dec 11 +++ -c -c data big/1.7d+38/, eta/2.938735878d-39/, machep/2.775557562d-17/ -c -c +++ hp3000 +++ -c -c data big/1.157920892d+77/, eta/8.636168556d-78/, -c 1 machep/5.551115124d-17/ -c -c +++ honeywell +++ -c -c data big/1.69d+38/, eta/5.9d-39/, machep/2.1680435d-19/ -c -c +++ dec10 +++ -c -c data big/"377777100000000000000000/, -c 1 eta/"002400400000000000000000/, -c 2 machep/"104400000000000000000000/ -c -c +++ burroughs +++ -c -c data big/o0777777777777777,o7777777777777777/, -c 1 eta/o1771000000000000,o7770000000000000/, -c 2 machep/o1451000000000000,o0000000000000000/ -c -c +++ control data +++ -c -c data big/37767777777777777777b,37167777777777777777b/, -c 1 eta/00014000000000000000b,00000000000000000000b/, -c 2 machep/15614000000000000000b,15010000000000000000b/ -c -c +++ prime +++ -c -c data big/1.0d+9786/, eta/1.0d-9860/, machep/1.4210855d-14/ -c -c +++ univac +++ -c -c data big/8.988d+307/, eta/1.2d-308/, machep/1.734723476d-18/ -c -c +++ vax +++ -c - data big/1.7d+38/, eta/2.939d-39/, machep/1.3877788d-17/ -c -c +++ cray 1 +++ -c -c data bigi(1)/577767777777777777777b/, -c 1 bigi(2)/000007777777777777776b/, -c 2 etai(1)/200004000000000000000b/, -c 3 etai(2)/000000000000000000000b/, -c 4 machei(1)/377224000000000000000b/, -c 5 machei(2)/000000000000000000000b/ -c -c +++ port library -- requires more than just a data statement... +++ -c -c external d1mach -c double precision d1mach, zero -c data big/0.d+0/, eta/0.d+0/, machep/0.d+0/, zero/0.d+0/ -c if (big .gt. zero) go to 1 -c big = d1mach(2) -c eta = d1mach(1) -c machep = d1mach(4) -c1 continue -c -c +++ end of port +++ -c -c------------------------------- body -------------------------------- -c - go to (10, 20, 30, 40, 50, 60), k -c - 10 rmdcon = eta - go to 999 -c - 20 rmdcon = dsqrt(256.d+0*eta)/16.d+0 - go to 999 -c - 30 rmdcon = machep - go to 999 -c - 40 rmdcon = dsqrt(machep) - go to 999 -c - 50 rmdcon = dsqrt(big/256.d+0)*16.d+0 - go to 999 -c - 60 rmdcon = big -c - 999 return -c *** last card of rmdcon follows *** - end diff --git a/source/unres/src_MD-DFA-restraints/rmsd.F b/source/unres/src_MD-DFA-restraints/rmsd.F deleted file mode 100644 index 52e7b37..0000000 --- a/source/unres/src_MD-DFA-restraints/rmsd.F +++ /dev/null @@ -1,140 +0,0 @@ - subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - include 'COMMON.IOUNITS' - double precision przes(3),obr(3,3) - logical non_conv,lprn -c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, -c & obr,non_conv) -c rms=dsqrt(rms) - call rmsd(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref) - if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100, - & ' % of nonnative contacts:',frac_nn*100, - & ' contact order:',co - - return - end -c--------------------------------------------------------------------------- - subroutine rmsd(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 -c print *,"nz_start",nz_start," nz_end",nz_end - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,nres+i) - enddo - endif - enddo - -c ----- diagnostics -c write (iout,*) 'Ccopy and CREFcopy' -c print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c ----- end diagnostics - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd' - write (iout,*) 'Problems in FITSQ!!! rmsd' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI -c call mpi_abort(mpi_comm_world,ierror,ierrcode) - roznica=100.0 -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) -c ---- diagnostics -c write (iout,*) "rms",drms -c ---- end diagnostics - return - end - -c-------------------------------------------- - subroutine rmsd_csa(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i) - crefcopy(k,iatom)=crefjlee(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i) - crefcopy(k,iatom)=crefjlee(k,nres+i) - enddo - endif - enddo - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd_csa' - write (iout,*) 'Problems in FITSQ!!! rmsd_csa' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI - call mpi_abort(mpi_comm_world,ierror,ierrcode) -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) - return - end - diff --git a/source/unres/src_MD-DFA-restraints/sc_move.F b/source/unres/src_MD-DFA-restraints/sc_move.F deleted file mode 100644 index b6837fd..0000000 --- a/source/unres/src_MD-DFA-restraints/sc_move.F +++ /dev/null @@ -1,823 +0,0 @@ - subroutine sc_move(n_start,n_end,n_maxtry,e_drop, - + n_fun,etot) -c Perform a quick search over side-chain arrangments (over -c residues n_start to n_end) for a given (frozen) CA trace -c Only side-chains are minimized (at most n_maxtry times each), -c not CA positions -c Stops if energy drops by e_drop, otherwise tries all residues -c in the given range -c If there is an energy drop, full minimization may be useful -c n_start, n_end CAN be modified by this routine, but only if -c out of bounds (n_start <= 1, n_end >= nres, n_start < n_end) -c NOTE: this move should never increase the energy -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c External functions - integer iran_num - external iran_num - -c Input arguments - integer n_start,n_end,n_maxtry - double precision e_drop - -c Output arguments - integer n_fun - double precision etot - -c Local variables - double precision energy(0:n_ene) - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision orig_e,cur_e - integer n,n_steps,n_first,n_cur,n_tot,i - double precision orig_w(n_ene) - double precision wtime - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - orig_w(15)=wvdwpp - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - wvdwpp=0.D0 - -c Make sure n_start, n_end are within proper range - if (n_start.lt.2) n_start=2 - if (n_end.gt.nres-1) n_end=nres-1 -crc if (n_start.lt.n_end) then - if (n_start.gt.n_end) then - n_start=2 - n_end=nres-1 - endif - -c Save the initial values of energy and coordinates -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'start sc ene',energy(0) -cd call enerprint(energy(0)) -crc etot=energy(0) - n_fun=0 -crc orig_e=etot -crc cur_e=orig_e -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo - -ct wtime=MPI_WTIME() -c Try (one by one) all specified residues, starting from a -c random position in sequence -c Stop early if the energy has decreased by at least e_drop - n_tot=n_end-n_start+1 - n_first=iran_num(0,n_tot-1) - n_steps=0 - n=0 -crc do while (n.lt.n_tot .and. orig_e-etot.lt.e_drop) - do while (n.lt.n_tot) - n_cur=n_start+mod(n_first+n,n_tot) - call single_sc_move(n_cur,n_maxtry,e_drop, - + n_steps,n_fun,etot) -c If a lower energy was found, update the current structure... -crc if (etot.lt.cur_e) then -crc cur_e=etot -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo -crc else -c ...else revert to the previous one -crc etot=cur_e -crc do i=2,nres-1 -crc alph(i)=cur_alph(i) -crc omeg(i)=cur_omeg(i) -crc enddo -crc endif - n=n+1 -cd -cd call chainbuild -cd call etotal(energy) -cd print *,'running',n,energy(0) - enddo - -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'end sc ene',energy(0) - -c Put the original weights back to calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - wvdwpp=orig_w(15) - -crc n_fun=n_fun+1 -ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime - return - end - -c------------------------------------------------------------- - - subroutine single_sc_move(res_pick,n_maxtry,e_drop, - + n_steps,n_fun,e_sc) -c Perturb one side-chain (res_pick) and minimize the -c neighbouring region, keeping all CA's and non-neighbouring -c side-chains fixed -c Try until e_drop energy improvement is achieved, or n_maxtry -c attempts have been made -c At the start, e_sc should contain the side-chain-only energy(0) -c nsteps and nfun for this move are ADDED to n_steps and n_fun -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - -c External functions - double precision dist - external dist - -c Input arguments - integer res_pick,n_maxtry - double precision e_drop - -c Input/Output arguments - integer n_steps,n_fun - double precision e_sc - -c Local variables - logical fail - integer i,j - integer nres_moved - integer iretcode,loc_nfun,orig_maxfun,n_try - double precision sc_dist,sc_dist_cutoff - double precision energy(0:n_ene),orig_e,cur_e - double precision evdw,escloc - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision var(maxvar) - - double precision orig_theta(1:nres),orig_phi(1:nres), - + orig_alph(1:nres),orig_omeg(1:nres) - - -c Define what is meant by "neighbouring side-chain" - sc_dist_cutoff=5.0D0 - -c Don't do glycine or ends - i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return - -c Freeze everything (later will relax only selected side-chains) - mask_r=.true. - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=0 - enddo - -c Find the neighbours of the side-chain to move -c and save initial variables -crc orig_e=e_sc -crc cur_e=orig_e - nres_moved=0 - do i=2,nres-1 -c Don't do glycine (itype(j)==10) - if (itype(i).ne.10) then - sc_dist=dist(nres+i,nres+res_pick) - else - sc_dist=sc_dist_cutoff - endif - if (sc_dist.lt.sc_dist_cutoff) then - nres_moved=nres_moved+1 - mask_side(i)=1 - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - - call chainbuild - call egb1(evdw) - call esc(escloc) - e_sc=wsc*evdw+wscloc*escloc -cd call etotal(energy) -cd print *,'new ',(energy(k),k=0,n_ene) - orig_e=e_sc - cur_e=orig_e - - n_try=0 - do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop) -c Move the selected residue (don't worry if it fails) - call gen_side(itype(res_pick),theta(res_pick+1), - + alph(res_pick),omeg(res_pick),fail) - -c Minimize the side-chains starting from the new arrangement - call geom_to_var(nvar,var) - orig_maxfun=maxfun - maxfun=7 - -crc do i=1,nres -crc orig_theta(i)=theta(i) -crc orig_phi(i)=phi(i) -crc orig_alph(i)=alph(i) -crc orig_omeg(i)=omeg(i) -crc enddo - - call minimize_sc1(e_sc,var,iretcode,loc_nfun) - -cv write(*,'(2i3,2f12.5,2i3)') -cv & res_pick,nres_moved,orig_e,e_sc-cur_e, -cv & iretcode,loc_nfun - -c$$$ if (iretcode.eq.8) then -c$$$ write(iout,*)'Coordinates just after code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ do i=1,nres -c$$$ theta(i)=orig_theta(i) -c$$$ phi(i)=orig_phi(i) -c$$$ alph(i)=orig_alph(i) -c$$$ omeg(i)=orig_omeg(i) -c$$$ enddo -c$$$ write(iout,*)'Coordinates just before code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ endif - - n_fun=n_fun+loc_nfun - maxfun=orig_maxfun - call var_to_geom(nvar,var) - -c If a lower energy was found, update the current structure... - if (e_sc.lt.cur_e) then -cv call chainbuild -cv call etotal(energy) -cd call egb1(evdw) -cd call esc(escloc) -cd e_sc1=wsc*evdw+wscloc*escloc -cd print *,' new',e_sc1,energy(0) -cv print *,'new ',energy(0) -cd call enerprint(energy(0)) - cur_e=e_sc - do i=2,nres-1 - if (mask_side(i).eq.1) then - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - else -c ...else revert to the previous one - e_sc=cur_e - do i=2,nres-1 - if (mask_side(i).eq.1) then - alph(i)=cur_alph(i) - omeg(i)=cur_omeg(i) - endif - enddo - endif - n_try=n_try+1 - - enddo - n_steps=n_steps+n_try - -c Reset the minimization mask_r to false - mask_r=.false. - - return - end - -c------------------------------------------------------------- - - subroutine sc_minimize(etot,iretcode,nfun) -c Minimizes side-chains only, leaving backbone frozen -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c Output arguments - double precision etot - integer iretcode,nfun - -c Local variables - integer i - double precision orig_w(n_ene),energy(0:n_ene) - double precision var(maxvar) - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - -c Prepare to freeze backbone - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=1 - enddo - -c Minimize the side-chains - mask_r=.true. - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - call var_to_geom(nvar,var) - mask_r=.false. - -c Put the original weights back and calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - - call chainbuild - call etotal(energy) - etot=energy(0) - - return - end - -c------------------------------------------------------------- - subroutine minimize_sc1(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr1,grad_restr1 - logical not_done,change,reduce - common /przechowalnia/ v - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr1,grad_restr1, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - - return - end -************************************************************************ - subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.TIME1' - common /chuju/ jjj - double precision energia(0:n_ene),evdw,escloc - integer jjj - double precision ufparm,e1,e2 - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf - icg=mod(nf,2)+1 - -#ifdef OSF -c Intercept NaNs in the coordinates, before calling etotal - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - FOUND_NAN=.false. - if (x_sum.ne.x_sum) then - write(iout,*)" *** func_restr1 : Found NaN in coordinates" - f=1.0D+73 - FOUND_NAN=.true. - return - endif -#endif - - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call egb1(evdw) - call esc(escloc) - f=wsc*evdw+wscloc*escloc -cd call etotal(energia(0)) -cd f=wsc*energia(1)+wscloc*energia(12) -cd print *,f,evdw,escloc,energia(0) -C -C Sum up the components of the Cartesian gradient. -C - do i=1,nct - do j=1,3 - gradx(j,i,icg)=wsc*gvdwx(j,i) - enddo - enddo - - return - end -c------------------------------------------------------- - subroutine grad_restr1(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr1(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C----------------------------------------------------------------------------- - subroutine egb1(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - - - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) -C For diagnostics only!!! -c chi1=0.0D0 -c chi2=0.0D0 -c chi12=0.0D0 -c chip1=0.0D0 -c chip2=0.0D0 -c chip12=0.0D0 -c alf1=0.0D0 -c alf2=0.0D0 -c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -cd & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -cd & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad - ENDIF - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/sizes.i b/source/unres/src_MD-DFA-restraints/sizes.i deleted file mode 100644 index 45c44ff..0000000 --- a/source/unres/src_MD-DFA-restraints/sizes.i +++ /dev/null @@ -1,83 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1992 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ############################################################# -c ## ## -c ## sizes.i -- parameter values to set array dimensions ## -c ## ## -c ############################################################# -c -c -c "sizes.i" sets values for critical array dimensions used -c throughout the software; these parameters will fix the size -c of the largest systems that can be handled; values too large -c for the computer's memory and/or swap space to accomodate -c will result in poor performance or outright failure -c -c parameter: maximum allowed number of: -c -c maxatm atoms in the molecular system -c maxval atoms directly bonded to an atom -c maxgrp user-defined groups of atoms -c maxtyp force field atom type definitions -c maxclass force field atom class definitions -c maxkey lines in the keyword file -c maxrot bonds for torsional rotation -c maxvar optimization variables (vector storage) -c maxopt optimization variables (matrix storage) -c maxhess off-diagonal Hessian elements -c maxlight sites for method of lights neighbors -c maxvib vibrational frequencies -c maxgeo distance geometry points -c maxcell unit cells in replicated crystal -c maxring 3-, 4-, or 5-membered rings -c maxfix geometric restraints -c maxbio biopolymer atom definitions -c maxres residues in the macromolecule -c maxamino amino acid residue types -c maxnuc nucleic acid residue types -c maxbnd covalent bonds in molecular system -c maxang bond angles in molecular system -c maxtors torsional angles in molecular system -c maxpi atoms in conjugated pisystem -c maxpib covalent bonds involving pisystem -c maxpit torsional angles involving pisystem -c -c - integer maxatm,maxval,maxgrp - integer maxtyp,maxclass,maxkey - integer maxrot,maxopt - integer maxhess,maxlight,maxvib - integer maxgeo,maxcell,maxring - integer maxfix,maxbio - integer maxamino,maxnuc,maxbnd - integer maxang,maxtors,maxpi - integer maxpib,maxpit - parameter (maxatm=maxres2) - parameter (maxval=8) - parameter (maxgrp=1000) - parameter (maxtyp=3000) - parameter (maxclass=500) - parameter (maxkey=10000) - parameter (maxrot=1000) - parameter (maxopt=1000) - parameter (maxhess=1000000) - parameter (maxlight=8*maxatm) - parameter (maxvib=1000) - parameter (maxgeo=1000) - parameter (maxcell=10000) - parameter (maxring=10000) - parameter (maxfix=10000) - parameter (maxbio=10000) - parameter (maxamino=31) - parameter (maxnuc=12) - parameter (maxbnd=2*maxatm) - parameter (maxang=3*maxatm) - parameter (maxtors=4*maxatm) - parameter (maxpi=100) - parameter (maxpib=2*maxpi) - parameter (maxpit=4*maxpi) diff --git a/source/unres/src_MD-DFA-restraints/sort.f b/source/unres/src_MD-DFA-restraints/sort.f deleted file mode 100644 index 46b43d9..0000000 --- a/source/unres/src_MD-DFA-restraints/sort.f +++ /dev/null @@ -1,589 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1990 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ######################################################### -c ## ## -c ## subroutine sort -- heapsort of an integer array ## -c ## ## -c ######################################################### -c -c -c "sort" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm -c -c - subroutine sort (n,list) - implicit none - integer i,j,k,n - integer index,lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################## -c ## ## -c ## subroutine sort2 -- heapsort of real array with keys ## -c ## ## -c ############################################################## -c -c -c "sort2" takes an input list of reals and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort2 (n,list,key) - implicit none - integer i,j,k,n - integer index,keys - integer key(*) - real*8 lists - real*8 list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort3 -- heapsort of integer array with keys ## -c ## ## -c ################################################################# -c -c -c "sort3" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort3 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer lists - integer keys - integer list(*) - integer key(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort4 -- heapsort of integer absolute values ## -c ## ## -c ################################################################# -c -c -c "sort4" takes an input list of integers and sorts it into -c ascending absolute value using the Heapsort algorithm -c -c - subroutine sort4 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1 - end if - if (abs(lists) .lt. abs(list(j))) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort5 -- heapsort of integer array modulo m ## -c ## ## -c ################################################################ -c -c -c "sort5" takes an input list of integers and sorts it -c into ascending order based on each value modulo "m" -c -c - subroutine sort5 (n,list,m) - implicit none - integer i,j,k,m,n - integer index,smod - integer jmod,j1mod - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - jmod = mod(list(j),m) - j1mod = mod(list(j+1),m) - if (jmod .lt. j1mod) then - j = j + 1 - else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then - j = j + 1 - end if - end if - smod = mod(lists,m) - jmod = mod(list(j),m) - if (smod .lt. jmod) then - list(i) = list(j) - i = j - j = j + j - else if (smod.eq.jmod .and. lists.lt.list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort6 -- heapsort of a text string array ## -c ## ## -c ############################################################# -c -c -c "sort6" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm -c -c - subroutine sort6 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort7 -- heapsort of text strings with keys ## -c ## ## -c ################################################################ -c -c -c "sort7" takes an input list of character strings and sorts it -c into alphabetical order using the Heapsort algorithm; it also -c returns a key into the original ordering -c -c - subroutine sort7 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer keys - integer key(*) - character*256 lists - character*(*) list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ######################################################### -c ## ## -c ## subroutine sort8 -- heapsort to unique integers ## -c ## ## -c ######################################################### -c -c -c "sort8" takes an input list of integers and sorts it into -c ascending order using the Heapsort algorithm, duplicate -c values are removed from the final sorted list -c -c - subroutine sort8 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort9 -- heapsort to unique text strings ## -c ## ## -c ############################################################# -c -c -c "sort9" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm, -c duplicate values are removed from the final sorted list -c -c - subroutine sort9 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end diff --git a/source/unres/src_MD-DFA-restraints/ssMD.F b/source/unres/src_MD-DFA-restraints/ssMD.F deleted file mode 100644 index 15800ae..0000000 --- a/source/unres/src_MD-DFA-restraints/ssMD.F +++ /dev/null @@ -1,1951 +0,0 @@ -c---------------------------------------------------------------------------- - subroutine check_energies -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - -c External functions - double precision ran_number - external ran_number - -c Local variables - integer i,j,k,l,lmax,p,pmax - double precision rmin,rmax - double precision eij - - double precision d - double precision wi,rij,tj,pj - - -c return - - i=5 - j=14 - - d=dsc(1) - rmin=2.0D0 - rmax=12.0D0 - - lmax=10000 - pmax=1 - - do k=1,3 - c(k,i)=0.0D0 - c(k,j)=0.0D0 - c(k,nres+i)=0.0D0 - c(k,nres+j)=0.0D0 - enddo - - do l=1,lmax - -ct wi=ran_number(0.0D0,pi) -c wi=ran_number(0.0D0,pi/6.0D0) -c wi=0.0D0 -ct tj=ran_number(0.0D0,pi) -ct pj=ran_number(0.0D0,pi) -c pj=ran_number(0.0D0,pi/6.0D0) -c pj=0.0D0 - - do p=1,pmax -ct rij=ran_number(rmin,rmax) - - c(1,j)=d*sin(pj)*cos(tj) - c(2,j)=d*sin(pj)*sin(tj) - c(3,j)=d*cos(pj) - - c(3,nres+i)=-rij - - c(1,i)=d*sin(wi) - c(3,i)=-rij-d*cos(wi) - - do k=1,3 - dc(k,nres+i)=c(k,nres+i)-c(k,i) - dc_norm(k,nres+i)=dc(k,nres+i)/d - dc(k,nres+j)=c(k,nres+j)-c(k,j) - dc_norm(k,nres+j)=dc(k,nres+j)/d - enddo - - call dyn_ssbond_ene(i,j,eij) - enddo - enddo - - call exit(1) - - return - end - -C----------------------------------------------------------------------------- - - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c External functions - double precision h_base - external h_base - -c Input arguments - integer resi,resj - -c Output arguments - double precision eij - -c Local variables - logical havebond -c integer itypi,itypj,k,l - double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi - double precision sig0ij,ljd,sig,fac,e1,e2 - double precision dcosom1(3),dcosom2(3),ed - double precision pom1,pom2 - double precision ljA,ljB,ljXs - double precision d_ljB(1:3) - double precision ssA,ssB,ssC,ssXs - double precision ssxm,ljxm,ssm,ljm - double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3) - double precision f1,f2,h1,h2,hd1,hd2 - double precision omega,delta_inv,deltasq_inv,fac1,fac2 -c-------FIRST METHOD - double precision xm,d_xm(1:3) -c-------END FIRST METHOD -c-------SECOND METHOD -c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) -c-------END SECOND METHOD - -c-------TESTING CODE - logical checkstop,transgrad - common /sschecks/ checkstop,transgrad - - integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 -c-------END TESTING CODE - - - i=resi - j=resj - - itypi=itype(i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=vbld_inv(i+nres) - - itypj=itype(j) - xj=c(1,nres+j)-c(1,nres+i) - yj=c(2,nres+j)-c(2,nres+i) - zj=c(3,nres+j)-c(3,nres+i) - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - dscj_inv=vbld_inv(j+nres) - - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse -c The following are set in sc_angular -c erij(1)=xj*rij -c erij(2)=yj*rij -c erij(3)=zj*rij -c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) -c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) -c om12=dxi*dxj+dyi*dyj+dzi*dzj - call sc_angular - rij=1.0D0/rij ! Reset this so it makes sense - - sig0ij=sigma(itypi,itypj) - sig=sig0ij*dsqrt(1.0D0/sigsq) - - ljXs=sig-sig0ij - ljA=eps1*eps2rt**2*eps3rt**2 - ljB=ljA*bb(itypi,itypj) - ljA=ljA*aa(itypi,itypj) - ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - - ssXs=d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - ssA=akcm - ssB=akct*deltat12 - ssC=ss_depth - & +akth*(deltat1*deltat1+deltat2*deltat2) - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi - ssxm=ssXs-0.5D0*ssB/ssA - -c-------TESTING CODE -c$$$c Some extra output -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC -c$$$ if (ssx0.gt.0.0d0) then -c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA -c$$$ else -c$$$ ssx0=ssxm -c$$$ endif -c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ", -c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12 -c$$$ return -c-------END TESTING CODE - -c-------TESTING CODE -c Stop and plot energy and derivative as a function of distance - if (checkstop) then - ssm=ssC-0.25D0*ssB*ssB/ssA - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - if (ssm.lt.ljm .and. - & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then - nicheck=1000 - njcheck=1 - deps=0.5d-7 - else - checkstop=.false. - endif - endif - if (.not.checkstop) then - nicheck=0 - njcheck=-1 - endif - - do icheck=0,nicheck - do jcheck=-1,njcheck - if (checkstop) rij=(ssxm-1.0d0)+ - & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps -c-------END TESTING CODE - - if (rij.gt.ljxm) then - havebond=.false. - ljd=rij-ljXs - fac=(1.0D0/ljd)**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - eij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=eij*eps3rt - eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt - - sigder=-sig/sigsq - e1=e1*eps1*eps2rt**2*eps3rt**2 - ed=-expon*(e1+eij)/ljd - sigder=ed*sigder - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=eij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 - else if (rij.lt.ssxm) then - havebond=.true. - ssd=rij-ssXs - eij=ssA*ssd*ssd+ssB*ssd+ssC - - ed=2*akcm*ssd+akct*deltat12 - pom1=akct*ssd - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - else - omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi - - d_ssxm(1)=0.5D0*akct/ssA - d_ssxm(2)=-d_ssxm(1) - d_ssxm(3)=0.0D0 - - d_ljxm(1)=sig0ij/sqrt(sigsq**3) - d_ljxm(2)=d_ljxm(1)*sigsq_om2 - d_ljxm(3)=d_ljxm(1)*sigsq_om12 - d_ljxm(1)=d_ljxm(1)*sigsq_om1 - -c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - xm=0.5d0*(ssxm+ljxm) - do k=1,3 - d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k)) - enddo - if (rij.lt.xm) then - havebond=.true. - ssm=ssC-0.25D0*ssB*ssB/ssA - d_ssm(1)=0.5D0*akct*ssB/ssA - d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) - d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) - d_ssm(3)=omega - f1=(rij-xm)/(ssxm-xm) - f2=(rij-ssxm)/(xm-ssxm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=ssm*h1+Ht*h2 - delta_inv=1.0d0/(xm-ssxm) - deltasq_inv=delta_inv*delta_inv - fac=ssm*hd1-Ht*hd2 - fac1=deltasq_inv*fac*(xm-rij) - fac2=deltasq_inv*fac*(rij-ssxm) - ed=delta_inv*(Ht*hd2-ssm*hd1) - eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) - eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) - eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) - else - havebond=.false. - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB - d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt) - d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- - + alf12/eps3rt) - d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt) - f1=(rij-ljxm)/(xm-ljxm) - f2=(rij-xm)/(ljxm-xm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=Ht*h1+ljm*h2 - delta_inv=1.0d0/(ljxm-xm) - deltasq_inv=delta_inv*delta_inv - fac=Ht*hd1-ljm*hd2 - fac1=deltasq_inv*fac*(ljxm-rij) - fac2=deltasq_inv*fac*(rij-xm) - ed=delta_inv*(ljm*hd2-Ht*hd1) - eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) - eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) - eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) - endif -c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - -c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE -c$$$ ssd=rij-ssXs -c$$$ ljd=rij-ljXs -c$$$ fac1=rij-ljxm -c$$$ fac2=rij-ssxm -c$$$ -c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt) -c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt) -c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt) -c$$$ -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA -c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) -c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) -c$$$ d_ssm(3)=omega -c$$$ -c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ do k=1,3 -c$$$ d_ljm(k)=ljm*d_ljB(k) -c$$$ enddo -c$$$ ljm=ljm*ljB -c$$$ -c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC -c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB -c$$$ d_ss(2)=akct*ssd -c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega -c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega -c$$$ d_ss(3)=omega -c$$$ -c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0) -c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1 -c$$$ do k=1,3 -c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1- -c$$$ & 2.0d0*ljB*fac1*d_ljxm(k)) -c$$$ enddo -c$$$ ljf=ljm+ljf*ljB*fac1*fac1 -c$$$ -c$$$ f1=(rij-ljxm)/(ssxm-ljxm) -c$$$ f2=(rij-ssxm)/(ljxm-ssxm) -c$$$ h1=h_base(f1,hd1) -c$$$ h2=h_base(f2,hd2) -c$$$ eij=ss*h1+ljf*h2 -c$$$ delta_inv=1.0d0/(ljxm-ssxm) -c$$$ deltasq_inv=delta_inv*delta_inv -c$$$ fac=ljf*hd2-ss*hd1 -c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac -c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1))) -c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2))) -c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3))) -c$$$ -c$$$ havebond=.false. -c$$$ if (ed.gt.0.0d0) havebond=.true. -c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE - - endif - - if (havebond) then -#ifndef CLUST -#ifndef WHAM -c if (dyn_ssbond_ij(i,j).eq.1.0d300) then -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_FORM",totT,t_bath,i,j -c endif -#endif -#endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 -#ifndef CLUST -#ifndef WHAM -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_BREAK",totT,t_bath,i,j -#endif -#endif - endif - -c-------TESTING CODE - if (checkstop) then - if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') - & "CHECKSTOP",rij,eij,ed - echeck(jcheck)=eij - endif - enddo - if (checkstop) then - write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps - endif - enddo - if (checkstop) then - transgrad=.true. - checkstop=.false. - endif -c-------END TESTING CODE - - do k=1,3 - dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij - dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij - enddo - do k=1,3 - gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - - return - end - -C----------------------------------------------------------------------------- - - double precision function h_base(x,deriv) -c A smooth function going 0->1 in range [0,1] -c It should NOT be called outside range [0,1], it will not work there. - implicit none - -c Input arguments - double precision x - -c Output arguments - double precision deriv - -c Local variables - double precision xsq - - -c Two parabolas put together. First derivative zero at extrema -c$$$ if (x.lt.0.5D0) then -c$$$ h_base=2.0D0*x*x -c$$$ deriv=4.0D0*x -c$$$ else -c$$$ deriv=1.0D0-x -c$$$ h_base=1.0D0-2.0D0*deriv*deriv -c$$$ deriv=4.0D0*deriv -c$$$ endif - -c Third degree polynomial. First derivative zero at extrema - h_base=x*x*(3.0d0-2.0d0*x) - deriv=6.0d0*x*(1.0d0-x) - -c Fifth degree polynomial. First and second derivatives zero at extrema -c$$$ xsq=x*x -c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0) -c$$$ deriv=x-1.0d0 -c$$$ deriv=deriv*deriv -c$$$ deriv=30.0d0*xsq*deriv - - return - end - -c---------------------------------------------------------------------------- - - subroutine dyn_set_nss -c Adjust nss and other relevant variables based on dyn_ssbond_ij -c implicit none - -c Includes - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c Local variables - double precision emin - integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) - logical found - integer i_newnss(max_fg_procs),displ(0:max_fg_procs) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss - - allnss=0 - do i=1,nres-1 - do j=i+1,nres - if (dyn_ssbond_ij(i,j).lt.1.0d300) then - allnss=allnss+1 - allflag(allnss)=0 - allihpb(allnss)=i - alljhpb(allnss)=j - endif - enddo - enddo - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - 1 emin=1.0d300 - do i=1,allnss - if (allflag(i).eq.0 .and. - & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then - emin=dyn_ssbond_ij(allihpb(i),alljhpb(i)) - imin=i - endif - enddo - if (emin.lt.1.0d300) then - allflag(imin)=1 - do i=1,allnss - if (allflag(i).eq.0 .and. - & (allihpb(i).eq.allihpb(imin) .or. - & alljhpb(i).eq.allihpb(imin) .or. - & allihpb(i).eq.alljhpb(imin) .or. - & alljhpb(i).eq.alljhpb(imin))) then - allflag(i)=-1 - endif - enddo - goto 1 - endif - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - newnss=0 - do i=1,allnss - if (allflag(i).eq.1) then - newnss=newnss+1 - newihpb(newnss)=allihpb(i) - newjhpb(newnss)=alljhpb(i) - endif - enddo - -#ifdef MPI - if (nfgtasks.gt.1)then - - call MPI_Reduce(newnss,g_newnss,1, - & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - call MPI_Gather(newnss,1,MPI_INTEGER, - & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_newnss(i-1)+displ(i-1) - enddo - call MPI_Gatherv(newihpb,newnss,MPI_INTEGER, - & g_newihpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER, - & g_newjhpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - if(fg_rank.eq.0) then -c print *,'g_newnss',g_newnss -c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss) -c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss) - newnss=g_newnss - do i=1,newnss - newihpb(i)=g_newihpb(i) - newjhpb(i)=g_newjhpb(i) - enddo - endif - endif -#endif - - diff=newnss-nss - -cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss) - - do i=1,nss - found=.false. - do j=1,newnss - if (idssb(i).eq.newihpb(j) .and. - & jdssb(i).eq.newjhpb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i) -#endif -#endif - enddo - - do i=1,newnss - found=.false. - do j=1,nss - if (newihpb(i).eq.idssb(j) .and. - & newjhpb(i).eq.jdssb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) -#endif -#endif - enddo - - nss=newnss - do i=1,nss - idssb(i)=newihpb(i) - jdssb(i)=newjhpb(i) - enddo - - return - end - -c---------------------------------------------------------------------------- - -#ifdef WHAM - subroutine read_ssHist - implicit none - -c Includes - include 'DIMENSIONS' - include "DIMENSIONS.FREE" - include 'COMMON.FREE' - -c Local variables - integer i,j - character*80 controlcard - - do i=1,dyn_nssHist - call card_concat(controlcard,.true.) - read(controlcard,*) - & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) - enddo - - return - end -#endif - -c---------------------------------------------------------------------------- - - -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- - -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-DFA-restraints/stochfric.F b/source/unres/src_MD-DFA-restraints/stochfric.F deleted file mode 100644 index 74eda61..0000000 --- a/source/unres/src_MD-DFA-restraints/stochfric.F +++ /dev/null @@ -1,626 +0,0 @@ - subroutine friction_force - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - double precision gamvec(MAXRES6) - common /syfek/ gamvec - double precision vv(3),vvtot(3,maxres),v_work(MAXRES6), - & ginvfric(maxres2,maxres2) - common /przechowalnia/ ginvfric - - logical lprn /.false./, checkmode /.false./ - - do i=0,MAXRES2 - do j=1,3 - friction(j,i)=0.0d0 - enddo - enddo - - do j=1,3 - d_t_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t_work(ind+j)=d_t(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - d_t_work(ind+j)=d_t(j,i+nres) - enddo - ind=ind+3 - endif - enddo - - call fricmat_mult(d_t_work,fric_work) - - if (.not.checkmode) return - - if (lprn) then - write (iout,*) "d_t_work and fric_work" - do i=1,3*dimen - write (iout,'(i3,2e15.5)') i,d_t_work(i),fric_work(i) - enddo - endif - do j=1,3 - friction(j,0)=fric_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - friction(j,i)=fric_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - friction(j,i+nres)=fric_work(ind+j) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write(iout,*) "Friction backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i),j=1,3),(d_t(j,i),j=1,3) - enddo - write(iout,*) "Friction side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i+nres),j=1,3),(d_t(j,i+nres),j=1,3) - enddo - endif - if (lprn) then - do j=1,3 - vv(j)=d_t(j,0) - enddo - do i=nnt,nct - do j=1,3 - vvtot(j,i)=vv(j)+0.5d0*d_t(j,i) - vvtot(j,i+nres)=vv(j)+d_t(j,i+nres) - vv(j)=vv(j)+d_t(j,i) - enddo - enddo - write (iout,*) "vvtot backbone and sidechain" - do i=nnt,nct - write (iout,'(i5,3e15.5,5x,3e15.5)') i,(vvtot(j,i),j=1,3), - & (vvtot(j,i+nres),j=1,3) - enddo - ind=0 - do i=nnt,nct-1 - do j=1,3 - v_work(ind+j)=vvtot(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - v_work(ind+j)=vvtot(j,i+nres) - enddo - ind=ind+3 - enddo - write (iout,*) "v_work gamvec and site-based friction forces" - do i=1,dimen1 - write (iout,'(i5,3e15.5)') i,v_work(i),gamvec(i), - & gamvec(i)*v_work(i) - enddo -c do i=1,dimen -c fric_work1(i)=0.0d0 -c do j=1,dimen1 -c fric_work1(i)=fric_work1(i)-A(j,i)*gamvec(j)*v_work(j) -c enddo -c enddo -c write (iout,*) "fric_work and fric_work1" -c do i=1,dimen -c write (iout,'(i5,2e15.5)') i,fric_work(i),fric_work1(i) -c enddo - do i=1,dimen - do j=1,dimen - ginvfric(i,j)=0.0d0 - do k=1,dimen - ginvfric(i,j)=ginvfric(i,j)+ginv(i,k)*fricmat(k,j) - enddo - enddo - enddo - write (iout,*) "ginvfric" - do i=1,dimen - write (iout,'(i5,100f8.3)') i,(ginvfric(i,j),j=1,dimen) - enddo - write (iout,*) "symmetry check" - do i=1,dimen - do j=1,i-1 - write (iout,*) i,j,ginvfric(i,j)-ginvfric(j,i) - enddo - enddo - endif - return - end -c----------------------------------------------------- - subroutine stochastic_force(stochforcvec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - - double precision x,sig,lowb,highb, - & ff(3),force(3,0:MAXRES2),zeta2,lowb2, - & highb2,sig2,forcvec(MAXRES6),stochforcvec(MAXRES6) - logical lprn /.false./ - do i=0,MAXRES2 - do j=1,3 - stochforc(j,i)=0.0d0 - enddo - enddo - x=0.0d0 - -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Compute the stochastic forces acting on bodies. Store in force. - do i=nnt,nct-1 - sig=stdforcp(i) - lowb=-5*sig - highb=5*sig - do j=1,3 - force(j,i)=anorm_distr(x,sig,lowb,highb) - enddo - enddo - do i=nnt,nct - sig2=stdforcsc(i) - lowb2=-5*sig2 - highb2=5*sig2 - do j=1,3 - force(j,i+nres)=anorm_distr(x,sig2,lowb2,highb2) - enddo - enddo -#ifdef MPI - time_fsample=time_fsample+MPI_Wtime()-time00 -#else - time_fsample=time_fsample+tcpu()-time00 -#endif -c Compute the stochastic forces acting on virtual-bond vectors. - do j=1,3 - ff(j)=0.0d0 - enddo - do i=nct-1,nnt,-1 - do j=1,3 - stochforc(j,i)=ff(j)+0.5d0*force(j,i) - enddo - do j=1,3 - ff(j)=ff(j)+force(j,i) - enddo - if (itype(i+1).ne.21) then - do j=1,3 - stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1) - ff(j)=ff(j)+force(j,i+nres+1) - enddo - endif - enddo - do j=1,3 - stochforc(j,0)=ff(j)+force(j,nnt+nres) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforc(j,i+nres)=force(j,i+nres) - enddo - endif - enddo - - do j=1,3 - stochforcvec(j)=stochforc(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i+nres) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write (iout,*) "stochforcvec" - do i=1,3*dimen - write(iout,'(i5,e15.5)') i,stochforcvec(i) - enddo - write(iout,*) "Stochastic forces backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5)') i,(stochforc(j,i),j=1,3) - enddo - write(iout,*) "Stochastic forces side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5)') - & i,(stochforc(j,i+nres),j=1,3) - enddo - endif - - if (lprn) then - - ind=0 - do i=nnt,nct-1 - write (iout,*) i,ind - do j=1,3 - forcvec(ind+j)=force(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - write (iout,*) i,ind - do j=1,3 - forcvec(j+ind)=force(j,i+nres) - enddo - ind=ind+3 - enddo - - write (iout,*) "forcvec" - ind=0 - do i=nnt,nct-1 - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i+nres), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - - endif - - return - end -c------------------------------------------------------------------ - subroutine setup_fricmat - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -c integer licznik /0/ -c save licznik -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - integer IERROR - integer i,j,ind,ind1,m - logical lprn /.false./ - double precision dtdi,gamvec(MAXRES2), - & ginvfric(maxres2,maxres2),Ghalf(mmaxres2),fcopy(maxres2,maxres2) - common /syfek/ gamvec - double precision work(8*maxres2) - integer iwork(maxres2) - common /przechowalnia/ ginvfric,Ghalf,fcopy -#ifdef MPI - if (fg_rank.ne.king) goto 10 -#endif -c Zeroing out fricmat - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - enddo - enddo -c Load the friction coefficients corresponding to peptide groups - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - gamvec(ind1)=gamp - enddo -c Load the friction coefficients corresponding to side chains - m=nct-nnt - ind=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - gamvec(ii)=gamsc(iti) - enddo - if (surfarea) call sdarea(gamvec) -c if (lprn) then -c write (iout,*) "Matrix A and vector gamma" -c do i=1,dimen1 -c write (iout,'(i2,$)') i -c do j=1,dimen -c write (iout,'(f4.1,$)') A(i,j) -c enddo -c write (iout,'(f8.3)') gamvec(i) -c enddo -c endif - if (lprn) then - write (iout,*) "Vector gamvec" - do i=1,dimen1 - write (iout,'(i5,f10.5)') i, gamvec(i) - enddo - endif - -c The friction matrix - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*gamvec(j) - enddo - fricmat(k,i)=dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Matrix fricmat" - call matout2(dimen,dimen,maxres2,maxres2,fricmat) - endif - if (lang.eq.2 .or. lang.eq.3) then -c Mass-scale the friction matrix if non-direct integration will be performed - do i=1,dimen - do j=1,dimen - Ginvfric(i,j)=0.0d0 - do k=1,dimen - do l=1,dimen - Ginvfric(i,j)=Ginvfric(i,j)+ - & Gsqrm(i,k)*Gsqrm(l,j)*fricmat(k,l) - enddo - enddo - enddo - enddo -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Ginvfric(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " mass-scaled friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Precompute matrices for tinker stochastic integrator -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - mt1(i,j)=0.0d0 - mt2(i,j)=0.0d0 - do k=1,dimen - mt1(i,j)=mt1(i,j)+fricvec(k,i)*gsqrm(k,j) - mt2(i,j)=mt2(i,j)+fricvec(k,i)*gsqrp(k,j) - enddo - mt3(j,i)=mt1(i,j) - enddo - enddo -#endif - else if (lang.eq.4) then -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=fricmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Determine the number of zero eigenvalues of the friction matrix - nzero=max0(dimen-dimen1,0) -c do while (fricgam(nzero+1).le.1.0d-5 .and. nzero.lt.dimen) -c nzero=nzero+1 -c enddo - write (iout,*) "Number of zero eigenvalues:",nzero - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - do k=nzero+1,dimen - fricmat(i,j)=fricmat(i,j) - & +fricvec(i,k)*fricvec(j,k)/fricgam(k) - enddo - enddo - enddo - if (lprn) then - write (iout,'(//a)') "Generalized inverse of fricmat" - call matout(dimen,dimen,maxres6,maxres6,fricmat) - endif - endif -#ifdef MPI - 10 continue - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call MPI_Bcast(10,1,MPI_INTEGER,king,FG_COMM,IERROR) -#ifdef MPI - time_Bcast=time_Bcast+MPI_Wtime()-time00 -#else - time_Bcast=time_Bcast+tcpu()-time00 -#endif -c print *,"Processor",myrank, -c & " BROADCAST iorder in SETUP_FRICMAT" - endif -c licznik=licznik+1 -c write (iout,*) "setup_fricmat licznik",licznik -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Scatter the friction matrix - call MPI_Scatterv(fricmat(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,fcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) -#ifdef TIMING -#ifdef MPI - time_scatter=time_scatter+MPI_Wtime()-time00 - time_scatter_fmat=time_scatter_fmat+MPI_Wtime()-time00 -#else - time_scatter=time_scatter+tcpu()-time00 - time_scatter_fmat=time_scatter_fmat+tcpu()-time00 -#endif -#endif - do i=1,dimen - do j=1,2*my_ng_count - fricmat(j,i)=fcopy(i,j) - enddo - enddo -c write (iout,*) "My chunk of fricmat" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy) - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sdarea(gamvec) -c -c Scale the friction coefficients according to solvent accessible surface areas -c Code adapted from TINKER -c AL 9/3/04 -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision radius(maxres2),gamvec(maxres2) - parameter (twosix=1.122462048309372981d0) - logical lprn /.false./ -c -c determine new friction coefficients every few SD steps -c -c set the atomic radii to estimates of sigma values -c -c print *,"Entered sdarea" - probe = 0.0d0 - - do i=1,2*nres - radius(i)=0.0d0 - enddo -c Load peptide group radii - do i=nnt,nct-1 - radius(i)=pstok - enddo -c Load side chain radii - do i=nnt,nct - iti=itype(i) - radius(i+nres)=restok(iti) - enddo -c do i=1,2*nres -c write (iout,*) "i",i," radius",radius(i) -c enddo - do i = 1, 2*nres - radius(i) = radius(i) / twosix - if (radius(i) .ne. 0.0d0) radius(i) = radius(i) + probe - end do -c -c scale atomic friction coefficients by accessible area -c - if (lprn) write (iout,*) - & "Original gammas, surface areas, scaling factors, new gammas, ", - & "std's of stochastic forces" - ind=0 - do i=nnt,nct-1 - if (radius(i).gt.0.0d0) then - call surfatom (i,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcp(i)=stdfp*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcp(i) - endif - enddo - do i=nnt,nct - if (radius(i+nres).gt.0.0d0) then - call surfatom (i+nres,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i+nres)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcsc(i) - endif - enddo - - return - end diff --git a/source/unres/src_MD-DFA-restraints/sumsld.f b/source/unres/src_MD-DFA-restraints/sumsld.f deleted file mode 100644 index 1ce7b78..0000000 --- a/source/unres/src_MD-DFA-restraints/sumsld.f +++ /dev/null @@ -1,1446 +0,0 @@ - subroutine sumsl(n, d, x, calcf, calcg, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** analytic gradient and hessian approx. from secant update *** -c - integer n, liv, lv - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(71 + n*(n+15)/2), uiparm(*), urparm(*) - external calcf, calcg, ufparm -c -c *** purpose *** -c -c this routine interacts with subroutine sumit in an attempt -c to find an n-vector x* that minimizes the (unconstrained) -c objective function computed by calcf. (often the x* found is -c a local minimizer rather than a global one.) -c -c-------------------------- parameter usage -------------------------- -c -c n........ (input) the number of variables on which f depends, i.e., -c the number of components in x. -c d........ (input/output) a scale vector such that d(i)*x(i), -c i = 1,2,...,n, are all in comparable units. -c d can strongly affect the behavior of sumsl. -c finding the best choice of d is generally a trial- -c and-error process. choosing d so that d(i)*x(i) -c has about the same value for all i often works well. -c the defaults provided by subroutine deflt (see i -c below) require the caller to supply d. -c x........ (input/output) before (initially) calling sumsl, the call- -c er should set x to an initial guess at x*. when -c sumsl returns, x contains the best point so far -c found, i.e., the one that gives the least value so -c far seen for f(x). -c calcf.... (input) a subroutine that, given x, computes f(x). calcf -c must be declared external in the calling program. -c it is invoked by -c call calcf(n, x, nf, f, uiparm, urparm, ufparm) -c when calcf is called, nf is the invocation -c count for calcf. nf is included for possible use -c with calcg. if x is out of bounds (e.g., if it -c would cause overflow in computing f(x)), then calcf -c should set nf to 0. this will cause a shorter step -c to be attempted. (if x is in bounds, then calcf -c should not change nf.) the other parameters are as -c described above and below. calcf should not change -c n, p, or x. -c calcg.... (input) a subroutine that, given x, computes g(x), the gra- -c dient of f at x. calcg must be declared external in -c the calling program. it is invoked by -c call calcg(n, x, nf, g, uiparm, urparm, ufaprm) -c when calcg is called, nf is the invocation -c count for calcf at the time f(x) was evaluated. the -c x passed to calcg is usually the one passed to calcf -c on either its most recent invocation or the one -c prior to it. if calcf saves intermediate results -c for use by calcg, then it is possible to tell from -c nf whether they are valid for the current x (or -c which copy is valid if two copies are kept). if g -c cannot be computed at x, then calcg should set nf to -c 0. in this case, sumsl will return with iv(1) = 65. -c (if g can be computed at x, then calcg should not -c changed nf.) the other parameters to calcg are as -c described above and below. calcg should not change -c n or x. -c iv....... (input/output) an integer value array of length liv (see -c below) that helps control the sumsl algorithm and -c that is used to store various intermediate quanti- -c ties. of particular interest are the initialization/ -c return code iv(1) and the entries in iv that control -c printing and limit the number of iterations and func- -c tion evaluations. see the section on iv input -c values below. -c liv...... (input) length of iv array. must be at least 60. if li -c is too small, then sumsl returns with iv(1) = 15. -c when sumsl returns, the smallest allowed value of -c liv is stored in iv(lastiv) -- see the section on -c iv output values below. (this is intended for use -c with extensions of sumsl that handle constraints.) -c lv....... (input) length of v array. must be at least 71+n*(n+15)/2. -c (at least 77+n*(n+17)/2 for smsno, at least -c 78+n*(n+12) for humsl). if lv is too small, then -c sumsl returns with iv(1) = 16. when sumsl returns, -c the smallest allowed value of lv is stored in -c iv(lastv) -- see the section on iv output values -c below. -c v........ (input/output) a floating-point value array of length l -c (see below) that helps control the sumsl algorithm -c and that is used to store various intermediate -c quantities. of particular interest are the entries -c in v that limit the length of the first step -c attempted (lmax0) and specify convergence tolerances -c (afctol, lmaxs, rfctol, sctol, xctol, xftol). -c uiparm... (input) user integer parameter array passed without change -c to calcf and calcg. -c urparm... (input) user floating-point parameter array passed without -c change to calcf and calcg. -c ufparm... (input) user external subroutine or function passed without -c change to calcf and calcg. -c -c *** iv input values (from subroutine deflt) *** -c -c iv(1)... on input, iv(1) should have a value between 0 and 14...... -c 0 and 12 mean this is a fresh start. 0 means that -c deflt(2, iv, liv, lv, v) -c is to be called to provide all default values to iv and -c v. 12 (the value that deflt assigns to iv(1)) means the -c caller has already called deflt and has possibly changed -c some iv and/or v entries to non-default values. -c 13 means deflt has been called and that sumsl (and -c sumit) should only do their storage allocation. that is, -c they should set the output components of iv that tell -c where various subarrays arrays of v begin, such as iv(g) -c (and, for humsl and humit only, iv(dtol)), and return. -c 14 means that a storage has been allocated (by a call -c with iv(1) = 13) and that the algorithm should be -c started. when called with iv(1) = 13, sumsl returns -c iv(1) = 14 unless liv or lv is too small (or n is not -c positive). default = 12. -c iv(inith).... iv(25) tells whether the hessian approximation h should -c be initialized. 1 (the default) means sumit should -c initialize h to the diagonal matrix whose i-th diagonal -c element is d(i)**2. 0 means the caller has supplied a -c cholesky factor l of the initial hessian approximation -c h = l*(l**t) in v, starting at v(iv(lmat)) = v(iv(42)) -c (and stored compactly by rows). note that iv(lmat) may -c be initialized by calling sumsl with iv(1) = 13 (see -c the iv(1) discussion above). default = 1. -c iv(mxfcal)... iv(17) gives the maximum number of function evaluations -c (calls on calcf) allowed. if this number does not suf- -c fice, then sumsl returns with iv(1) = 9. default = 200. -c iv(mxiter)... iv(18) gives the maximum number of iterations allowed. -c it also indirectly limits the number of gradient evalua- -c tions (calls on calcg) to iv(mxiter) + 1. if iv(mxiter) -c iterations do not suffice, then sumsl returns with -c iv(1) = 10. default = 150. -c iv(outlev)... iv(19) controls the number and length of iteration sum- -c mary lines printed (by itsum). iv(outlev) = 0 means do -c not print any summary lines. otherwise, print a summary -c line after each abs(iv(outlev)) iterations. if iv(outlev) -c is positive, then summary lines of length 78 (plus carri- -c age control) are printed, including the following... the -c iteration and function evaluation counts, f = the current -c function value, relative difference in function values -c achieved by the latest step (i.e., reldf = (f0-v(f))/f01, -c where f01 is the maximum of abs(v(f)) and abs(v(f0)) and -c v(f0) is the function value from the previous itera- -c tion), the relative function reduction predicted for the -c step just taken (i.e., preldf = v(preduc) / f01, where -c v(preduc) is described below), the scaled relative change -c in x (see v(reldx) below), the step parameter for the -c step just taken (stppar = 0 means a full newton step, -c between 0 and 1 means a relaxed newton step, between 1 -c and 2 means a double dogleg step, greater than 2 means -c a scaled down cauchy step -- see subroutine dbldog), the -c 2-norm of the scale vector d times the step just taken -c (see v(dstnrm) below), and npreldf, i.e., -c v(nreduc)/f01, where v(nreduc) is described below -- if -c npreldf is positive, then it is the relative function -c reduction predicted for a newton step (one with -c stppar = 0). if npreldf is negative, then it is the -c negative of the relative function reduction predicted -c for a step computed with step bound v(lmaxs) for use in -c testing for singular convergence. -c if iv(outlev) is negative, then lines of length 50 -c are printed, including only the first 6 items listed -c above (through reldx). -c default = 1. -c iv(parprt)... iv(20) = 1 means print any nondefault v values on a -c fresh start or any changed v values on a restart. -c iv(parprt) = 0 means skip this printing. default = 1. -c iv(prunit)... iv(21) is the output unit number on which all printing -c is done. iv(prunit) = 0 means suppress all printing. -c default = standard output unit (unit 6 on most systems). -c iv(solprt)... iv(22) = 1 means print out the value of x returned (as -c well as the gradient and the scale vector d). -c iv(solprt) = 0 means skip this printing. default = 1. -c iv(statpr)... iv(23) = 1 means print summary statistics upon return- -c ing. these consist of the function value, the scaled -c relative change in x caused by the most recent step (see -c v(reldx) below), the number of function and gradient -c evaluations (calls on calcf and calcg), and the relative -c function reductions predicted for the last step taken and -c for a newton step (or perhaps a step bounded by v(lmaxs) -c -- see the descriptions of preldf and npreldf under -c iv(outlev) above). -c iv(statpr) = 0 means skip this printing. -c iv(statpr) = -1 means skip this printing as well as that -c of the one-line termination reason message. default = 1. -c iv(x0prt).... iv(24) = 1 means print the initial x and scale vector d -c (on a fresh start only). iv(x0prt) = 0 means skip this -c printing. default = 1. -c -c *** (selected) iv output values *** -c -c iv(1)........ on output, iv(1) is a return code.... -c 3 = x-convergence. the scaled relative difference (see -c v(reldx)) between the current parameter vector x and -c a locally optimal parameter vector is very likely at -c most v(xctol). -c 4 = relative function convergence. the relative differ- -c ence between the current function value and its lo- -c cally optimal value is very likely at most v(rfctol). -c 5 = both x- and relative function convergence (i.e., the -c conditions for iv(1) = 3 and iv(1) = 4 both hold). -c 6 = absolute function convergence. the current function -c value is at most v(afctol) in absolute value. -c 7 = singular convergence. the hessian near the current -c iterate appears to be singular or nearly so, and a -c step of length at most v(lmaxs) is unlikely to yield -c a relative function decrease of more than v(sctol). -c 8 = false convergence. the iterates appear to be converg- -c ing to a noncritical point. this may mean that the -c convergence tolerances (v(afctol), v(rfctol), -c v(xctol)) are too small for the accuracy to which -c the function and gradient are being computed, that -c there is an error in computing the gradient, or that -c the function or gradient is discontinuous near x. -c 9 = function evaluation limit reached without other con- -c vergence (see iv(mxfcal)). -c 10 = iteration limit reached without other convergence -c (see iv(mxiter)). -c 11 = stopx returned .true. (external interrupt). see the -c usage notes below. -c 14 = storage has been allocated (after a call with -c iv(1) = 13). -c 17 = restart attempted with n changed. -c 18 = d has a negative component and iv(dtype) .le. 0. -c 19...43 = v(iv(1)) is out of range. -c 63 = f(x) cannot be computed at the initial x. -c 64 = bad parameters passed to assess (which should not -c occur). -c 65 = the gradient could not be computed at x (see calcg -c above). -c 67 = bad first parameter to deflt. -c 80 = iv(1) was out of range. -c 81 = n is not positive. -c iv(g)........ iv(28) is the starting subscript in v of the current -c gradient vector (the one corresponding to x). -c iv(lastiv)... iv(44) is the least acceptable value of liv. (it is -c only set if liv is at least 44.) -c iv(lastv).... iv(45) is the least acceptable value of lv. (it is -c only set if liv is large enough, at least iv(lastiv).) -c iv(nfcall)... iv(6) is the number of calls so far made on calcf (i.e., -c function evaluations). -c iv(ngcall)... iv(30) is the number of gradient evaluations (calls on -c calcg). -c iv(niter).... iv(31) is the number of iterations performed. -c -c *** (selected) v input values (from subroutine deflt) *** -c -c v(bias)..... v(43) is the bias parameter used in subroutine dbldog -- -c see that subroutine for details. default = 0.8. -c v(afctol)... v(31) is the absolute function convergence tolerance. -c if sumsl finds a point where the function value is less -c than v(afctol) in absolute value, and if sumsl does not -c return with iv(1) = 3, 4, or 5, then it returns with -c iv(1) = 6. this test can be turned off by setting -c v(afctol) to zero. default = max(10**-20, machep**2), -c where machep is the unit roundoff. -c v(dinit).... v(38), if nonnegative, is the value to which the scale -c vector d is initialized. default = -1. -c v(lmax0).... v(35) gives the maximum 2-norm allowed for d times the -c very first step that sumsl attempts. this parameter can -c markedly affect the performance of sumsl. -c v(lmaxs).... v(36) is used in testing for singular convergence -- if -c the function reduction predicted for a step of length -c bounded by v(lmaxs) is at most v(sctol) * abs(f0), where -c f0 is the function value at the start of the current -c iteration, and if sumsl does not return with iv(1) = 3, -c 4, 5, or 6, then it returns with iv(1) = 7. default = 1. -c v(rfctol)... v(32) is the relative function convergence tolerance. -c if the current model predicts a maximum possible function -c reduction (see v(nreduc)) of at most v(rfctol)*abs(f0) -c at the start of the current iteration, where f0 is the -c then current function value, and if the last step attempt- -c ed achieved no more than twice the predicted function -c decrease, then sumsl returns with iv(1) = 4 (or 5). -c default = max(10**-10, machep**(2/3)), where machep is -c the unit roundoff. -c v(sctol).... v(37) is the singular convergence tolerance -- see the -c description of v(lmaxs) above. -c v(tuner1)... v(26) helps decide when to check for false convergence. -c this is done if the actual function decrease from the -c current step is no more than v(tuner1) times its predict- -c ed value. default = 0.1. -c v(xctol).... v(33) is the x-convergence tolerance. if a newton step -c (see v(nreduc)) is tried that has v(reldx) .le. v(xctol) -c and if this step yields at most twice the predicted func- -c tion decrease, then sumsl returns with iv(1) = 3 (or 5). -c (see the description of v(reldx) below.) -c default = machep**0.5, where machep is the unit roundoff. -c v(xftol).... v(34) is the false convergence tolerance. if a step is -c tried that gives no more than v(tuner1) times the predict- -c ed function decrease and that has v(reldx) .le. v(xftol), -c and if sumsl does not return with iv(1) = 3, 4, 5, 6, or -c 7, then it returns with iv(1) = 8. (see the description -c of v(reldx) below.) default = 100*machep, where -c machep is the unit roundoff. -c v(*)........ deflt supplies to v a number of tuning constants, with -c which it should ordinarily be unnecessary to tinker. see -c section 17 of version 2.2 of the nl2sol usage summary -c (i.e., the appendix to ref. 1) for details on v(i), -c i = decfac, incfac, phmnfc, phmxfc, rdfcmn, rdfcmx, -c tuner2, tuner3, tuner4, tuner5. -c -c *** (selected) v output values *** -c -c v(dgnorm)... v(1) is the 2-norm of (diag(d)**-1)*g, where g is the -c most recently computed gradient. -c v(dstnrm)... v(2) is the 2-norm of diag(d)*step, where step is the -c current step. -c v(f)........ v(10) is the current function value. -c v(f0)....... v(13) is the function value at the start of the current -c iteration. -c v(nreduc)... v(6), if positive, is the maximum function reduction -c possible according to the current model, i.e., the func- -c tion reduction predicted for a newton step (i.e., -c step = -h**-1 * g, where g is the current gradient and -c h is the current hessian approximation). -c if v(nreduc) is negative, then it is the negative of -c the function reduction predicted for a step computed with -c a step bound of v(lmaxs) for use in testing for singular -c convergence. -c v(preduc)... v(7) is the function reduction predicted (by the current -c quadratic model) for the current step. this (divided by -c v(f0)) is used in testing for relative function -c convergence. -c v(reldx).... v(17) is the scaled relative change in x caused by the -c current step, computed as -c max(abs(d(i)*(x(i)-x0(i)), 1 .le. i .le. p) / -c max(d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p), -c where x = x0 + step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c this routine uses a hessian approximation computed from the -c bfgs update (see ref 3). only a cholesky factor of the hessian -c approximation is stored, and this is updated using ideas from -c ref. 4. steps are computed by the double dogleg scheme described -c in ref. 2. the steps are assessed as in ref. 1. -c -c *** usage notes *** -c -c after a return with iv(1) .le. 11, it is possible to restart, -c i.e., to change some of the iv and v input values described above -c and continue the algorithm from the point where it was interrupt- -c ed. iv(1) should not be changed, nor should any entries of i -c and v other than the input values (those supplied by deflt). -c those who do not wish to write a calcg which computes the -c gradient analytically should call smsno rather than sumsl. -c smsno uses finite differences to compute an approximate gradient. -c those who would prefer to provide f and g (the function and -c gradient) by reverse communication rather than by writing subrou- -c tines calcf and calcg may call on sumit directly. see the com- -c ments at the beginning of sumit. -c those who use sumsl interactively may wish to supply their -c own stopx function, which should return .true. if the break key -c has been pressed since stopx was last invoked. this makes it -c possible to externally interrupt sumsl (which will return with -c iv(1) = 11 if stopx returns .true.). -c storage for g is allocated at the end of v. thus the caller -c may make v longer than specified above and may allow calcg to use -c elements of g beyond the first n as scratch storage. -c -c *** portability notes *** -c -c the sumsl distribution tape contains both single- and double- -c precision versions of the sumsl source code, so it should be un- -c necessary to change precisions. -c only the functions imdcon and rmdcon contain machine-dependent -c constants. to change from one machine to another, it should -c suffice to change the (few) relevant lines in these functions. -c intrinsic functions are explicitly declared. on certain com- -c puters (e.g. univac), it may be necessary to comment out these -c declarations. so that this may be done automatically by a simple -c program, such declarations are preceded by a comment having c/+ -c in columns 1-3 and blanks in columns 4-72 and are followed by -c a comment having c/ in columns 1 and 2 and blanks in columns 3-72. -c the sumsl source code is expressed in 1966 ansi standard -c fortran. it may be converted to fortran 77 by commenting out all -c lines that fall between a line having c/6 in columns 1-3 and a -c line having c/7 in columns 1-3 and by removing (i.e., replacing -c by a blank) the c in column 1 of the lines that follow the c/7 -c line and precede a line having c/ in columns 1-2 and blanks in -c columns 3-72. these changes convert some data statements into -c parameter statements, convert some variables from real to -c character*4, and make the data statements that initialize these -c variables use character strings delimited by primes instead -c of hollerith constants. (such variables and data statements -c appear only in modules itsum and parck. parameter statements -c appear nearly everywhere.) these changes also add save state- -c ments for variables given machine-dependent constants by rmdcon. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), algorithm 573 -- -c an adaptive nonlinear least-squares algorithm, acm trans. -c math. software 7, pp. 369-383. -c -c 2. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c -c 3. dennis, j.e., and more, j.j. (1977), quasi-newton methods, motiva- -c tion and theory, siam rev. 19, pp. 46-89. -c -c 4. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (winter 1980). revised summer 1982. -c this subroutine was written in connection with research -c supported in part by the national science foundation under -c grants mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, -c and mcs-7906671. -c. -c -c---------------------------- declarations --------------------------- -c - external deflt, sumit -c -c deflt... supplies default iv and v input components. -c sumit... reverse-communication routine that carries out sumsl algo- -c rithm. -c - integer g1, iv1, nf - double precision f -c -c *** subscripts for iv *** -c - integer nextv, nfcall, nfgcal, g, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, toobig/2/, vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, toobig=2, vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .eq. 12 .or. iv1 .eq. 13) iv(vneed) = iv(vneed) + n - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) -c - 20 call sumit(d, f, v(g1), iv, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcg(n, x, iv(nfgcal), v(g1), uiparm, urparm, ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(nextv) = iv(g) + n - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of sumsl follows *** - end - subroutine sumit(d, fx, g, iv, liv, lv, n, v, x) -c -c *** carry out sumsl (unconstrained minimization) iterations, using -c *** double-dogleg/bfgs steps. -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c iv... integer value array. -c liv.. length of iv (at least 60). -c lv... length of v (at least 71 + n*(n+13)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... vector of parameters to be optimized. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to sumsl (which see), except that v can be shorter (since -c the part of v that sumsl uses for storing g is not needed). -c moreover, compared with sumsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from sumsl (and smsno), is not referenced by -c sumit or the subroutines it calls. -c fx and g need not have been initialized when sumit is called -c with iv(1) = 12, 13, or 14. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call sumit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c (e.g. if overflow would occur), which may happen because -c of an oversized step. in this case the caller should set -c iv(toobig) = iv(2) to 1, which will cause sumit to ig- -c nore fx and try a smaller step. the parameter nf that -c sumsl passes to calcf (for possible use by calcg) is a -c copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient vector -c of f at x, and call sumit again, having changed none of -c the other parameters except possibly the scale vector d -c when iv(dtype) = 0. the parameter nf that sumsl passes -c to calcg is iv(nfgcal) = iv(7). if g(x) cannot be -c evaluated, then the caller may set iv(nfgcal) to 0, in -c which case sumit will return with iv(1) = 65. -c. -c *** general *** -c -c coded by david m. gay (december 1979). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, g01, i, k, l, lstgst, nwtst1, step1, - 1 temp1, w, x01, z - double precision t -c -c *** constants *** -c - double precision half, negone, one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, dbdog, deflt, dotprd, itsum, litvmu, livmul, - 1 ltvmul, lupdat, lvmul, parck, reldst, stopx, vaxpy, - 2 vcopy, vscopy, vvmulp, v2norm, wzbfgs - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c dbdog.... computes double-dogleg (candidate) step. -c deflt.... supplies default iv and v input components. -c dotprd... returns inner product of two vectors. -c itsum.... prints iteration summary and info on initial and final x. -c litvmu... multiplies inverse transpose of lower triangle times vector. -c livmul... multiplies inverse of lower triangle times vector. -c ltvmul... multiplies transpose of lower triangle times vector. -c lupdt.... updates cholesky factor of hessian approximation. -c lvmul.... multiplies lower triangle times vector. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c vvmulp... multiplies vector by vector raised to power (componentwise). -c v2norm... returns the 2-norm of a vector. -c wzbfgs... computes w and z for lupdat corresponding to bfgs update. -c -c *** subscripts for iv and v *** -c - integer afctol - integer cnvcod, dg, dgnorm, dinit, dstnrm, dst0, f, f0, fdif, - 1 gthg, gtstep, g0, incfac, inith, irc, kagqt, lmat, lmax0, - 2 lmaxs, mode, model, mxfcal, mxiter, nextv, nfcall, nfgcal, - 3 ngcall, niter, nreduc, nwtstp, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, toobig, - 5 tuner4, tuner5, vneed, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, g0/48/, inith/25/, irc/29/, kagqt/33/, -c 1 mode/35/, model/5/, mxfcal/17/, mxiter/18/, nfcall/6/, -c 2 nfgcal/7/, ngcall/30/, niter/31/, nwtstp/34/, radinc/8/, -c 3 restor/9/, step/40/, stglim/11/, stlstg/41/, toobig/2/, -c 4 vneed/4/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, g0=48, inith=25, irc=29, kagqt=33, - 1 mode=35, model=5, mxfcal=17, mxiter=18, nfcall=6, - 2 nfgcal=7, ngcall=30, niter=31, nwtstp=34, radinc=8, - 3 restor=9, step=40, stglim=11, stlstg=41, toobig=2, - 4 vneed=4, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/ -c data dgnorm/1/, dinit/38/, dstnrm/2/, dst0/3/, f/10/, f0/13/, -c 1 fdif/11/, gthg/44/, gtstep/4/, incfac/23/, lmat/42/, -c 2 lmax0/35/, lmaxs/36/, nextv/47/, nreduc/6/, preduc/7/, -c 3 radfac/16/, radius/8/, rad0/9/, reldx/17/, tuner4/29/, -c 4 tuner5/30/ -c/7 - parameter (afctol=31) - parameter (dgnorm=1, dinit=38, dstnrm=2, dst0=3, f=10, f0=13, - 1 fdif=11, gthg=44, gtstep=4, incfac=23, lmat=42, - 2 lmax0=35, lmaxs=36, nextv=47, nreduc=6, preduc=7, - 3 radfac=16, radius=8, rad0=9, reldx=17, tuner4=29, - 4 tuner5=30) -c/ -c -c/6 -c data half/0.5d+0/, negone/-1.d+0/, one/1.d+0/, onep2/1.2d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, negone=-1.d+0, one=1.d+0, onep2=1.2d+0, - 1 zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c -C Following SAVE statement inserted. - save l - i = iv(1) - if (i .eq. 1) go to 50 - if (i .eq. 2) go to 60 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+13)/2 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - go to (180, 180, 180, 180, 180, 180, 120, 90, 120, 10, 10, 20), i -c -c *** storage allocation *** -c -10 l = iv(lmat) - iv(x0) = l + n*(n+1)/2 - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(g0) = iv(stlstg) + n - iv(nwtstp) = iv(g0) + n - iv(dg) = iv(nwtstp) + n - iv(nextv) = iv(dg) + n - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - if (iv(inith) .ne. 1) go to 40 -c -c *** set the initial hessian approximation to diag(d)**-2 *** -c - l = iv(lmat) - call vscopy(n*(n+1)/2, v(l), zero) - k = l - 1 - do 30 i = 1, n - k = k + i - t = d(i) - if (t .le. zero) t = one - v(k) = t - 30 continue -c -c *** compute initial function value *** -c - 40 iv(1) = 1 - go to 999 -c - 50 v(f) = fx - if (iv(mode) .ge. 0) go to 180 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 300 -c -c *** make sure gradient could be computed *** -c - 60 if (iv(nfgcal) .ne. 0) go to 70 - iv(1) = 65 - go to 300 -c - 70 dg1 = iv(dg) - call vvmulp(n, v(dg1), g, d, -1) - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** test norm of gradient *** -c - if (v(dgnorm) .gt. v(afctol)) go to 75 - iv(irc) = 10 - iv(cnvcod) = iv(irc) - 4 -c - 75 if (iv(cnvcod) .ne. 0) go to 290 - if (iv(mode) .eq. 0) go to 250 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 80 call itsum(d, g, iv, liv, lv, n, v, x) - 90 k = iv(niter) - if (k .lt. iv(mxiter)) go to 100 - iv(1) = 10 - go to 300 -c -c *** update radius *** -c - 100 iv(niter) = k + 1 - if(k.gt.0)v(radius) = v(radfac) * v(dstnrm) -c -c *** initialize for start of next iteration *** -c - g01 = iv(g0) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0, g to g0 *** -c - call vcopy(n, v(x01), x) - call vcopy(n, v(g01), g) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 110 if (.not. stopx(dummy)) go to 130 - iv(1) = 11 - go to 140 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 120 if (v(f) .ge. v(f0)) go to 130 - v(radfac) = one - k = iv(niter) - go to 100 -c - 130 if (iv(nfcall) .lt. iv(mxfcal)) go to 150 - iv(1) = 9 - 140 if (v(f) .ge. v(f0)) go to 300 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 240 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 150 step1 = iv(step) - dg1 = iv(dg) - nwtst1 = iv(nwtstp) - if (iv(kagqt) .ge. 0) go to 160 - l = iv(lmat) - call livmul(n, v(nwtst1), v(l), g) - v(nreduc) = half * dotprd(n, v(nwtst1), v(nwtst1)) - call litvmu(n, v(nwtst1), v(l), v(nwtst1)) - call vvmulp(n, v(step1), v(nwtst1), d, 1) - v(dst0) = v2norm(n, v(step1)) - call vvmulp(n, v(dg1), v(dg1), d, -1) - call ltvmul(n, v(step1), v(l), v(dg1)) - v(gthg) = v2norm(n, v(step1)) - iv(kagqt) = 0 - 160 call dbdog(v(dg1), lv, n, v(nwtst1), v(step1), v) - if (iv(irc) .eq. 6) go to 180 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 180 - if (iv(irc) .ne. 5) go to 170 - if (v(radfac) .le. one) go to 170 - if (v(preduc) .le. onep2 * v(fdif)) go to 180 -c -c *** compute f(x0 + step) *** -c - 170 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 180 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 190 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 190 k = iv(irc) - go to (200,230,230,230,200,210,220,220,220,220,220,220,280,250), k -c -c *** recompute step with changed radius *** -c - 200 v(radius) = v(radfac) * v(dstnrm) - go to 110 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 210 v(radius) = v(lmaxs) - go to 150 -c -c *** convergence or false convergence *** -c - 220 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 290 - if (iv(xirc) .eq. 14) go to 290 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 230 if (iv(irc) .ne. 3) go to 240 - step1 = iv(step) - temp1 = iv(stlstg) -c -c *** set temp1 = hessian * step for use in gradient tests *** -c - l = iv(lmat) - call ltvmul(n, v(temp1), v(l), v(step1)) - call lvmul(n, v(temp1), v(l), v(temp1)) -c -c *** compute gradient *** -c - 240 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c -c *** initializations -- g0 = g - g0, etc. *** -c - 250 g01 = iv(g0) - call vaxpy(n, v(g01), negone, v(g01), g) - step1 = iv(step) - temp1 = iv(stlstg) - if (iv(irc) .ne. 3) go to 270 -c -c *** set v(radfac) by gradient tests *** -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - call vaxpy(n, v(temp1), negone, v(g01), v(temp1)) - call vvmulp(n, v(temp1), v(temp1), d, -1) -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) - 1 go to 260 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 270 - 260 v(radfac) = v(incfac) -c -c *** update h, loop *** -c - 270 w = iv(nwtstp) - z = iv(x0) - l = iv(lmat) - call wzbfgs(v(l), n, v(step1), v(w), v(g01), v(z)) -c -c ** use the n-vectors starting at v(step1) and v(g01) for scratch.. - call lupdat(v(temp1), v(step1), v(l), v(g01), v(l), n, v(w), v(z)) - iv(1) = 2 - go to 80 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 280 iv(1) = 64 - go to 300 -c -c *** print summary of final iteration and other requested items *** -c - 290 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 300 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last line of sumit follows *** - end - subroutine dbdog(dig, lv, n, nwtstp, step, v) -c -c *** compute double dogleg step *** -c -c *** parameter declarations *** -c - integer lv, n - double precision dig(n), nwtstp(n), step(n), v(lv) -c -c *** purpose *** -c -c this subroutine computes a candidate step (for use in an uncon- -c strained minimization code) by the double dogleg algorithm of -c dennis and mei (ref. 1), which is a variation on powell*s dogleg -c scheme (ref. 2, p. 95). -c -c-------------------------- parameter usage -------------------------- -c -c dig (input) diag(d)**-2 * g -- see algorithm notes. -c g (input) the current gradient vector. -c lv (input) length of v. -c n (input) number of components in dig, g, nwtstp, and step. -c nwtstp (input) negative newton step -- see algorithm notes. -c step (output) the computed step. -c v (i/o) values array, the following components of which are -c used here... -c v(bias) (input) bias for relaxed newton step, which is v(bias) of -c the way from the full newton to the fully relaxed newton -c step. recommended value = 0.8 . -c v(dgnorm) (input) 2-norm of diag(d)**-1 * g -- see algorithm notes. -c v(dstnrm) (output) 2-norm of diag(d) * step, which is v(radius) -c unless v(stppar) = 0 -- see algorithm notes. -c v(dst0) (input) 2-norm of diag(d) * nwtstp -- see algorithm notes. -c v(grdfac) (output) the coefficient of dig in the step returned -- -c step(i) = v(grdfac)*dig(i) + v(nwtfac)*nwtstp(i). -c v(gthg) (input) square-root of (dig**t) * (hessian) * dig -- see -c algorithm notes. -c v(gtstep) (output) inner product between g and step. -c v(nreduc) (output) function reduction predicted for the full newton -c step. -c v(nwtfac) (output) the coefficient of nwtstp in the step returned -- -c see v(grdfac) above. -c v(preduc) (output) function reduction predicted for the step returned. -c v(radius) (input) the trust region radius. d times the step returned -c has 2-norm v(radius) unless v(stppar) = 0. -c v(stppar) (output) code telling how step was computed... 0 means a -c full newton step. between 0 and 1 means v(stppar) of the -c way from the newton to the relaxed newton step. between -c 1 and 2 means a true double dogleg step, v(stppar) - 1 of -c the way from the relaxed newton to the cauchy step. -c greater than 2 means 1 / (v(stppar) - 1) times the cauchy -c step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c let g and h be the current gradient and hessian approxima- -c tion respectively and let d be the current scale vector. this -c routine assumes dig = diag(d)**-2 * g and nwtstp = h**-1 * g. -c the step computed is the same one would get by replacing g and h -c by diag(d)**-1 * g and diag(d)**-1 * h * diag(d)**-1, -c computing step, and translating step back to the original -c variables, i.e., premultiplying it by diag(d)**-1. -c -c *** references *** -c -c 1. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c 2. powell, m.j.d. (1970), a hybrid method for non-linear equations, -c in numerical methods for non-linear equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, v2norm - double precision dotprd, v2norm -c -c dotprd... returns inner product of two vectors. -c v2norm... returns 2-norm of a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cfact, cnorm, ctrnwt, ghinvg, femnsq, gnorm, - 1 nwtnrm, relax, rlambd, t, t1, t2 - double precision half, one, two, zero -c -c *** v subscripts *** -c - integer bias, dgnorm, dstnrm, dst0, grdfac, gthg, gtstep, - 1 nreduc, nwtfac, preduc, radius, stppar -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, two/2.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, two=2.d+0, zero=0.d+0) -c/ -c -c/6 -c data bias/43/, dgnorm/1/, dstnrm/2/, dst0/3/, grdfac/45/, -c 1 gthg/44/, gtstep/4/, nreduc/6/, nwtfac/46/, preduc/7/, -c 2 radius/8/, stppar/5/ -c/7 - parameter (bias=43, dgnorm=1, dstnrm=2, dst0=3, grdfac=45, - 1 gthg=44, gtstep=4, nreduc=6, nwtfac=46, preduc=7, - 2 radius=8, stppar=5) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nwtnrm = v(dst0) - rlambd = one - if (nwtnrm .gt. zero) rlambd = v(radius) / nwtnrm - gnorm = v(dgnorm) - ghinvg = two * v(nreduc) - v(grdfac) = zero - v(nwtfac) = zero - if (rlambd .lt. one) go to 30 -c -c *** the newton step is inside the trust region *** -c - v(stppar) = zero - v(dstnrm) = nwtnrm - v(gtstep) = -ghinvg - v(preduc) = v(nreduc) - v(nwtfac) = -one - do 20 i = 1, n - 20 step(i) = -nwtstp(i) - go to 999 -c - 30 v(dstnrm) = v(radius) - cfact = (gnorm / v(gthg))**2 -c *** cauchy step = -cfact * g. - cnorm = gnorm * cfact - relax = one - v(bias) * (one - gnorm*cnorm/ghinvg) - if (rlambd .lt. relax) go to 50 -c -c *** step is between relaxed newton and full newton steps *** -c - v(stppar) = one - (rlambd - relax) / (one - relax) - t = -rlambd - v(gtstep) = t * ghinvg - v(preduc) = rlambd * (one - half*rlambd) * ghinvg - v(nwtfac) = t - do 40 i = 1, n - 40 step(i) = t * nwtstp(i) - go to 999 -c - 50 if (cnorm .lt. v(radius)) go to 70 -c -c *** the cauchy step lies outside the trust region -- -c *** step = scaled cauchy step *** -c - t = -v(radius) / gnorm - v(grdfac) = t - v(stppar) = one + cnorm / v(radius) - v(gtstep) = -v(radius) * gnorm - v(preduc) = v(radius)*(gnorm - half*v(radius)*(v(gthg)/gnorm)**2) - do 60 i = 1, n - 60 step(i) = t * dig(i) - go to 999 -c -c *** compute dogleg step between cauchy and relaxed newton *** -c *** femur = relaxed newton step minus cauchy step *** -c - 70 ctrnwt = cfact * relax * ghinvg / gnorm -c *** ctrnwt = inner prod. of cauchy and relaxed newton steps, -c *** scaled by gnorm**-1. - t1 = ctrnwt - gnorm*cfact**2 -c *** t1 = inner prod. of femur and cauchy step, scaled by -c *** gnorm**-1. - t2 = v(radius)*(v(radius)/gnorm) - gnorm*cfact**2 - t = relax * nwtnrm - femnsq = (t/gnorm)*t - ctrnwt - t1 -c *** femnsq = square of 2-norm of femur, scaled by gnorm**-1. - t = t2 / (t1 + dsqrt(t1**2 + femnsq*t2)) -c *** dogleg step = cauchy step + t * femur. - t1 = (t - one) * cfact - v(grdfac) = t1 - t2 = -t * relax - v(nwtfac) = t2 - v(stppar) = two - t - v(gtstep) = t1*gnorm**2 + t2*ghinvg - v(preduc) = -t1*gnorm * ((t2 + one)*gnorm) - 1 - t2 * (one + half*t2)*ghinvg - 2 - half * (v(gthg)*t1)**2 - do 80 i = 1, n - 80 step(i) = t1*dig(i) + t2*nwtstp(i) -c - 999 return -c *** last line of dbdog follows *** - end - subroutine ltvmul(n, x, l, y) -c -c *** compute x = (l**t)*y, where l is an n x n lower -c *** triangular matrix stored compactly by rows. x and y may -c *** occupy the same storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ij, i0, j - double precision yi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - i0 = 0 - do 20 i = 1, n - yi = y(i) - x(i) = zero - do 10 j = 1, i - ij = i0 + j - x(j) = x(j) + yi*l(ij) - 10 continue - i0 = i0 + i - 20 continue - 999 return -c *** last card of ltvmul follows *** - end - subroutine lupdat(beta, gamma, l, lambda, lplus, n, w, z) -c -c *** compute lplus = secant update of l *** -c -c *** parameter declarations *** -c - integer n -cal double precision beta(n), gamma(n), l(1), lambda(n), lplus(1), - double precision beta(n), gamma(n), l(n*(n+1)/2), lambda(n), - 1 lplus(n*(n+1)/2),w(n), z(n) -c dimension l(n*(n+1)/2), lplus(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c beta = scratch vector. -c gamma = scratch vector. -c l (input) lower triangular matrix, stored rowwise. -c lambda = scratch vector. -c lplus (output) lower triangular matrix, stored rowwise, which may -c occupy the same storage as l. -c n (input) length of vector parameters and order of matrices. -c w (input, destroyed on output) right singular vector of rank 1 -c correction to l. -c z (input, destroyed on output) left singular vector of rank 1 -c correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine updates the cholesky factor l of a symmetric -c positive definite matrix to which a secant update is being -c applied -- it computes a cholesky factor lplus of -c l * (i + z*w**t) * (i + w*z**t) * l**t. it is assumed that w -c and z have been chosen so that the updated matrix is strictly -c positive definite. -c -c *** algorithm notes *** -c -c this code uses recurrence 3 of ref. 1 (with d(j) = 1 for all j) -c to compute lplus of the form l * (i + z*w**t) * q, where q -c is an orthogonal matrix that makes the result lower triangular. -c lplus may have some negative diagonal elements. -c -c *** references *** -c -c 1. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i, ij, j, jj, jp1, k, nm1, np1 - double precision a, b, bj, eta, gj, lj, lij, ljj, nu, s, theta, - 1 wj, zj - double precision one, zero -c -c *** data initializations *** -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nu = one - eta = zero - if (n .le. 1) go to 30 - nm1 = n - 1 -c -c *** temporarily store s(j) = sum over k = j+1 to n of w(k)**2 in -c *** lambda(j). -c - s = zero - do 10 i = 1, nm1 - j = n - i - s = s + w(j+1)**2 - lambda(j) = s - 10 continue -c -c *** compute lambda, gamma, and beta by goldfarb*s recurrence 3. -c - do 20 j = 1, nm1 - wj = w(j) - a = nu*z(j) - eta*wj - theta = one + a*wj - s = a*lambda(j) - lj = dsqrt(theta**2 + a*s) - if (theta .gt. zero) lj = -lj - lambda(j) = lj - b = theta*wj + s - gamma(j) = b * nu / lj - beta(j) = (a - b*eta) / lj - nu = -nu / lj - eta = -(eta + (a**2)/(theta - lj)) / lj - 20 continue - 30 lambda(n) = one + (nu*z(n) - eta*w(n))*w(n) -c -c *** update l, gradually overwriting w and z with l*w and l*z. -c - np1 = n + 1 - jj = n * (n + 1) / 2 - do 60 k = 1, n - j = np1 - k - lj = lambda(j) - ljj = l(jj) - lplus(jj) = lj * ljj - wj = w(j) - w(j) = ljj * wj - zj = z(j) - z(j) = ljj * zj - if (k .eq. 1) go to 50 - bj = beta(j) - gj = gamma(j) - ij = jj + j - jp1 = j + 1 - do 40 i = jp1, n - lij = l(ij) - lplus(ij) = lj*lij + bj*w(i) + gj*z(i) - w(i) = w(i) + lij*wj - z(i) = z(i) + lij*zj - ij = ij + i - 40 continue - 50 jj = jj - j - 60 continue -c - 999 return -c *** last card of lupdat follows *** - end - subroutine lvmul(n, x, l, y) -c -c *** compute x = l*y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ii, ij, i0, j, np1 - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - np1 = n + 1 - i0 = n*(n+1)/2 - do 20 ii = 1, n - i = np1 - ii - i0 = i0 - i - t = zero - do 10 j = 1, i - ij = i0 + j - t = t + l(ij)*y(j) - 10 continue - x(i) = t - 20 continue - 999 return -c *** last card of lvmul follows *** - end - subroutine vvmulp(n, x, y, z, k) -c -c *** set x(i) = y(i) * z(i)**k, 1 .le. i .le. n (for k = 1 or -1) *** -c - integer n, k - double precision x(n), y(n), z(n) - integer i -c - if (k .ge. 0) go to 20 - do 10 i = 1, n - 10 x(i) = y(i) / z(i) - go to 999 -c - 20 do 30 i = 1, n - 30 x(i) = y(i) * z(i) - 999 return -c *** last card of vvmulp follows *** - end - subroutine wzbfgs (l, n, s, w, y, z) -c -c *** compute y and z for lupdat corresponding to bfgs update. -c - integer n -cal double precision l(1), s(n), w(n), y(n), z(n) - double precision l(n*(n+1)/2), s(n), w(n), y(n), z(n) -c dimension l(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c l (i/o) cholesky factor of hessian, a lower triang. matrix stored -c compactly by rows. -c n (input) order of l and length of s, w, y, z. -c s (input) the step just taken. -c w (output) right singular vector of rank 1 correction to l. -c y (input) change in gradients corresponding to s. -c z (output) left singular vector of rank 1 correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c when s is computed in certain ways, e.g. by gqtstp or -c dbldog, it is possible to save n**2/2 operations since (l**t)*s -c or l*(l**t)*s is then known. -c if the bfgs update to l*(l**t) would reduce its determinant to -c less than eps times its old value, then this routine in effect -c replaces y by theta*y + (1 - theta)*l*(l**t)*s, where theta -c (between 0 and 1) is chosen to make the reduction factor = eps. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, livmul, ltvmul - double precision dotprd -c dotprd returns inner product of two vectors. -c livmul multiplies l**-1 times a vector. -c ltvmul multiplies l**t times a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cs, cy, eps, epsrt, one, shs, ys, theta -c -c *** data initializations *** -c -c/6 -c data eps/0.1d+0/, one/1.d+0/ -c/7 - parameter (eps=0.1d+0, one=1.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - call ltvmul(n, w, l, s) - shs = dotprd(n, w, w) - ys = dotprd(n, y, s) - if (ys .ge. eps*shs) go to 10 - theta = (one - eps) * shs / (shs - ys) - epsrt = dsqrt(eps) - cy = theta / (shs * epsrt) - cs = (one + (theta-one)/epsrt) / shs - go to 20 - 10 cy = one / (dsqrt(ys) * dsqrt(shs)) - cs = one / shs - 20 call livmul(n, z, l, y) - do 30 i = 1, n - 30 z(i) = cy * z(i) - cs * w(i) -c - 999 return -c *** last card of wzbfgs follows *** - end diff --git a/source/unres/src_MD-DFA-restraints/surfatom.f b/source/unres/src_MD-DFA-restraints/surfatom.f deleted file mode 100644 index 9974842..0000000 --- a/source/unres/src_MD-DFA-restraints/surfatom.f +++ /dev/null @@ -1,494 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1996 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ################################################################ -c ## ## -c ## subroutine surfatom -- exposed surface area of an atom ## -c ## ## -c ################################################################ -c -c -c "surfatom" performs an analytical computation of the surface -c area of a specified atom; a simplified version of "surface" -c -c literature references: -c -c T. J. Richmond, "Solvent Accessible Surface Area and -c Excluded Volume in Proteins", Journal of Molecular Biology, -c 178, 63-89 (1984) -c -c L. Wesson and D. Eisenberg, "Atomic Solvation Parameters -c Applied to Molecular Dynamics of Proteins in Solution", -c Protein Science, 1, 227-235 (1992) -c -c variables and parameters: -c -c ir number of atom for which area is desired -c area accessible surface area of the atom -c radius radii of each of the individual atoms -c -c - subroutine surfatom (ir,area,radius) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizes.i' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer nres,nsup,nstart_sup - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - integer maxarc - parameter (maxarc=300) - integer i,j,k,m - integer ii,ib,jb - integer io,ir - integer mi,ni,narc - integer key(maxarc) - integer intag(maxarc) - integer intag1(maxarc) - real*8 area,arcsum - real*8 arclen,exang - real*8 delta,delta2 - real*8 eps,rmove - real*8 xr,yr,zr - real*8 rr,rrsq - real*8 rplus,rminus - real*8 axx,axy,axz - real*8 ayx,ayy - real*8 azx,azy,azz - real*8 uxj,uyj,uzj - real*8 tx,ty,tz - real*8 txb,tyb,td - real*8 tr2,tr,txr,tyr - real*8 tk1,tk2 - real*8 thec,the,t,tb - real*8 txk,tyk,tzk - real*8 t1,ti,tf,tt - real*8 txj,tyj,tzj - real*8 ccsq,cc,xysq - real*8 bsqk,bk,cosine - real*8 dsqj,gi,pix2 - real*8 therk,dk,gk - real*8 risqk,rik - real*8 radius(maxatm) - real*8 ri(maxarc),risq(maxarc) - real*8 ux(maxarc),uy(maxarc),uz(maxarc) - real*8 xc(maxarc),yc(maxarc),zc(maxarc) - real*8 xc1(maxarc),yc1(maxarc),zc1(maxarc) - real*8 dsq(maxarc),bsq(maxarc) - real*8 dsq1(maxarc),bsq1(maxarc) - real*8 arci(maxarc),arcf(maxarc) - real*8 ex(maxarc),lt(maxarc),gr(maxarc) - real*8 b(maxarc),b1(maxarc),bg(maxarc) - real*8 kent(maxarc),kout(maxarc) - real*8 ther(maxarc) - logical moved,top - logical omit(maxarc) -c -c -c zero out the surface area for the sphere of interest -c - area = 0.0d0 -c write (2,*) "ir",ir," radius",radius(ir) - if (radius(ir) .eq. 0.0d0) return -c -c set the overlap significance and connectivity shift -c - pix2 = 2.0d0 * pi - delta = 1.0d-8 - delta2 = delta * delta - eps = 1.0d-8 - moved = .false. - rmove = 1.0d-8 -c -c store coordinates and radius of the sphere of interest -c - xr = c(1,ir) - yr = c(2,ir) - zr = c(3,ir) - rr = radius(ir) - rrsq = rr * rr -c -c initialize values of some counters and summations -c - 10 continue - io = 0 - jb = 0 - ib = 0 - arclen = 0.0d0 - exang = 0.0d0 -c -c test each sphere to see if it overlaps the sphere of interest -c - do i = 1, 2*nres - if (i.eq.ir .or. radius(i).eq.0.0d0) goto 30 - rplus = rr + radius(i) - tx = c(1,i) - xr - if (abs(tx) .ge. rplus) goto 30 - ty = c(2,i) - yr - if (abs(ty) .ge. rplus) goto 30 - tz = c(3,i) - zr - if (abs(tz) .ge. rplus) goto 30 -c -c check for sphere overlap by testing distance against radii -c - xysq = tx*tx + ty*ty - if (xysq .lt. delta2) then - tx = delta - ty = 0.0d0 - xysq = delta2 - end if - ccsq = xysq + tz*tz - cc = sqrt(ccsq) - if (rplus-cc .le. delta) goto 30 - rminus = rr - radius(i) -c -c check to see if sphere of interest is completely buried -c - if (cc-abs(rminus) .le. delta) then - if (rminus .le. 0.0d0) goto 170 - goto 30 - end if -c -c check for too many overlaps with sphere of interest -c - if (io .ge. maxarc) then - write (iout,20) - 20 format (/,' SURFATOM -- Increase the Value of MAXARC') - stop - end if -c -c get overlap between current sphere and sphere of interest -c - io = io + 1 - xc1(io) = tx - yc1(io) = ty - zc1(io) = tz - dsq1(io) = xysq - bsq1(io) = ccsq - b1(io) = cc - gr(io) = (ccsq+rplus*rminus) / (2.0d0*rr*b1(io)) - intag1(io) = i - omit(io) = .false. - 30 continue - end do -c -c case where no other spheres overlap the sphere of interest -c - if (io .eq. 0) then - area = 4.0d0 * pi * rrsq - return - end if -c -c case where only one sphere overlaps the sphere of interest -c - if (io .eq. 1) then - area = pix2 * (1.0d0 + gr(1)) - area = mod(area,4.0d0*pi) * rrsq - return - end if -c -c case where many spheres intersect the sphere of interest; -c sort the intersecting spheres by their degree of overlap -c - call sort2 (io,gr,key) - do i = 1, io - k = key(i) - intag(i) = intag1(k) - xc(i) = xc1(k) - yc(i) = yc1(k) - zc(i) = zc1(k) - dsq(i) = dsq1(k) - b(i) = b1(k) - bsq(i) = bsq1(k) - end do -c -c get radius of each overlap circle on surface of the sphere -c - do i = 1, io - gi = gr(i) * rr - bg(i) = b(i) * gi - risq(i) = rrsq - gi*gi - ri(i) = sqrt(risq(i)) - ther(i) = 0.5d0*pi - asin(min(1.0d0,max(-1.0d0,gr(i)))) - end do -c -c find boundary of inaccessible area on sphere of interest -c - do k = 1, io-1 - if (.not. omit(k)) then - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - bk = b(k) - therk = ther(k) -c -c check to see if J circle is intersecting K circle; -c get distance between circle centers and sum of radii -c - do j = k+1, io - if (omit(j)) goto 60 - cc = (txk*xc(j)+tyk*yc(j)+tzk*zc(j))/(bk*b(j)) - cc = acos(min(1.0d0,max(-1.0d0,cc))) - td = therk + ther(j) -c -c check to see if circles enclose separate regions -c - if (cc .ge. td) goto 60 -c -c check for circle J completely inside circle K -c - if (cc+ther(j) .lt. therk) goto 40 -c -c check for circles that are essentially parallel -c - if (cc .gt. delta) goto 50 - 40 continue - omit(j) = .true. - goto 60 -c -c check to see if sphere of interest is completely buried -c - 50 continue - if (pix2-cc .le. td) goto 170 - 60 continue - end do - end if - end do -c -c find T value of circle intersections -c - do k = 1, io - if (omit(k)) goto 110 - omit(k) = .true. - narc = 0 - top = .false. - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - dk = sqrt(dsq(k)) - bsqk = bsq(k) - bk = b(k) - gk = gr(k) * rr - risqk = risq(k) - rik = ri(k) - therk = ther(k) -c -c rotation matrix elements -c - t1 = tzk / (bk*dk) - axx = txk * t1 - axy = tyk * t1 - axz = dk / bk - ayx = tyk / dk - ayy = txk / dk - azx = txk / bk - azy = tyk / bk - azz = tzk / bk - do j = 1, io - if (.not. omit(j)) then - txj = xc(j) - tyj = yc(j) - tzj = zc(j) -c -c rotate spheres so K vector colinear with z-axis -c - uxj = txj*axx + tyj*axy - tzj*axz - uyj = tyj*ayy - txj*ayx - uzj = txj*azx + tyj*azy + tzj*azz - cosine = min(1.0d0,max(-1.0d0,uzj/b(j))) - if (acos(cosine) .lt. therk+ther(j)) then - dsqj = uxj*uxj + uyj*uyj - tb = uzj*gk - bg(j) - txb = uxj * tb - tyb = uyj * tb - td = rik * dsqj - tr2 = risqk*dsqj - tb*tb - tr2 = max(eps,tr2) - tr = sqrt(tr2) - txr = uxj * tr - tyr = uyj * tr -c -c get T values of intersection for K circle -c - tb = (txb+tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk1 = acos(tb) - if (tyb-txr .lt. 0.0d0) tk1 = pix2 - tk1 - tb = (txb-tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk2 = acos(tb) - if (tyb+txr .lt. 0.0d0) tk2 = pix2 - tk2 - thec = (rrsq*uzj-gk*bg(j)) / (rik*ri(j)*b(j)) - if (abs(thec) .lt. 1.0d0) then - the = -acos(thec) - else if (thec .ge. 1.0d0) then - the = 0.0d0 - else if (thec .le. -1.0d0) then - the = -pi - end if -c -c see if "tk1" is entry or exit point; check t=0 point; -c "ti" is exit point, "tf" is entry point -c - cosine = min(1.0d0,max(-1.0d0, - & (uzj*gk-uxj*rik)/(b(j)*rr))) - if ((acos(cosine)-ther(j))*(tk2-tk1) .le. 0.0d0) then - ti = tk2 - tf = tk1 - else - ti = tk2 - tf = tk1 - end if - narc = narc + 1 - if (narc .ge. maxarc) then - write (iout,70) - 70 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - if (tf .le. ti) then - arcf(narc) = tf - arci(narc) = 0.0d0 - tf = pix2 - lt(narc) = j - ex(narc) = the - top = .true. - narc = narc + 1 - end if - arcf(narc) = tf - arci(narc) = ti - lt(narc) = j - ex(narc) = the - ux(j) = uxj - uy(j) = uyj - uz(j) = uzj - end if - end if - end do - omit(k) = .false. -c -c special case; K circle without intersections -c - if (narc .le. 0) goto 90 -c -c general case; sum up arclength and set connectivity code -c - call sort2 (narc,arci,key) - arcsum = arci(1) - mi = key(1) - t = arcf(mi) - ni = mi - if (narc .gt. 1) then - do j = 2, narc - m = key(j) - if (t .lt. arci(j)) then - arcsum = arcsum + arci(j) - t - exang = exang + ex(ni) - jb = jb + 1 - if (jb .ge. maxarc) then - write (iout,80) - 80 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(m) - kout(jb) = maxarc*k + i - end if - tt = arcf(m) - if (tt .ge. t) then - t = tt - ni = m - end if - end do - end if - arcsum = arcsum + pix2 - t - if (.not. top) then - exang = exang + ex(ni) - jb = jb + 1 - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(mi) - kout(jb) = maxarc*k + i - end if - goto 100 - 90 continue - arcsum = pix2 - ib = ib + 1 - 100 continue - arclen = arclen + gr(k)*arcsum - 110 continue - end do - if (arclen .eq. 0.0d0) goto 170 - if (jb .eq. 0) goto 150 -c -c find number of independent boundaries and check connectivity -c - j = 0 - do k = 1, jb - if (kout(k) .ne. 0) then - i = k - 120 continue - m = kout(i) - kout(i) = 0 - j = j + 1 - do ii = 1, jb - if (m .eq. kent(ii)) then - if (ii .eq. k) then - ib = ib + 1 - if (j .eq. jb) goto 150 - goto 130 - end if - i = ii - goto 120 - end if - end do - 130 continue - end if - end do - ib = ib + 1 -c -c attempt to fix connectivity error by moving atom slightly -c - if (moved) then - write (iout,140) ir - 140 format (/,' SURFATOM -- Connectivity Error at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if -c -c compute the exposed surface area for the sphere of interest -c - 150 continue - area = ib*pix2 + exang + arclen - area = mod(area,4.0d0*pi) * rrsq -c -c attempt to fix negative area by moving atom slightly -c - if (area .lt. 0.0d0) then - if (moved) then - write (iout,160) ir - 160 format (/,' SURFATOM -- Negative Area at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if - end if - 170 continue - return - end diff --git a/source/unres/src_MD-DFA-restraints/test.F b/source/unres/src_MD-DFA-restraints/test.F deleted file mode 100644 index 0140ee5..0000000 --- a/source/unres/src_MD-DFA-restraints/test.F +++ /dev/null @@ -1,863 +0,0 @@ - subroutine test - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar),var1(maxvar) - integer j1,j2 - logical debug,accepted - debug=.true. - - - call geom_to_var(nvar,var1) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',0,etot,rms - call secondary2(.false.) - - call write_pdb(0,'first structure',etot) - - j1=13 - j2=21 - da=180.0*deg2rad - - - - temp=3000.0d0 - betbol=1.0D0/(1.9858D-3*temp) - jr=iran_num(j1,j2) - d=ran_number(-pi,pi) -c phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot0=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',1,etot0,rms - call write_pdb(1,'perturb structure',etot0) - - do i=2,500,2 - jr=iran_num(j1,j2) - d=ran_number(-da,da) - phiold=phi(jr) - phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - - if (etot.lt.etot0) then - accepted=.true. - else - accepted=.false. - xxr=ran_number(0.0D0,1.0D0) - xxh=betbol*(etot-etot0) - if (xxh.lt.50.0D0) then - xxh=dexp(-xxh) - if (xxh.gt.xxr) accepted=.true. - endif - endif - accepted=.true. -c print *,etot0,etot,accepted - if (accepted) then - etot0=etot - call rmsd(rms) - write(iout,*) 'etot=',i,etot,rms - call write_pdb(i,'MC structure',etot) -c minimize -c call geom_to_var(nvar,var1) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun - call var_to_geom(nvar,var) - call chainbuild - call rmsd(rms) - write(iout,*) 'etot mcm=',i,etot,rms - call write_pdb(i+1,'MCM structure',etot) - call var_to_geom(nvar,var1) -c -------- - else - phi(jr)=phiold - endif - enddo - -c minimize -c call sc_move(2,nres-1,1,10d0,nft_sc,etot) -c call geom_to_var(nvar,var) -c -c call chainbuild -c call write_pdb(998 ,'sc min',etot) -c -c call minimize(etot,var,iretcode,nfun) -c write(iout,*)'------------------------------------------------' -c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun -c -c call var_to_geom(nvar,var) -c call chainbuild -c call write_pdb(999,'full min',etot) - - - return - end - - - - - subroutine test_local - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling local_move' - call local_move_init(.false.) - call local_move(24,29,20d0,50d0) - call chainbuild - call write_pdb(3,'third structure',etot) - - write(iout,*) 'calling sc_move' - call sc_move(24,29,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'last structure',etot) - - - return - end - - subroutine test_sc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling sc_move 2nd time' - - call sc_move(nnt,nct,5,1d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(3,'last structure',etot) - return - end -c-------------------------------------------------------- - subroutine bgrow(bstrand,nbstrand,in,ind,new) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - integer bstrand(maxres/3,6) - - ishift=iabs(bstrand(in,ind+4)-new) - - print *,'bgrow',bstrand(in,ind+4),new,ishift - - bstrand(in,ind)=new - - if(ind.eq.1)then - bstrand(nbstrand,5)=bstrand(nbstrand,1) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,5).lt.bstrand(i,6)) then - bstrand(i,5)=bstrand(i,5)-ishift - else - bstrand(i,5)=bstrand(i,5)+ishift - endif - ENDIF - enddo - else - bstrand(nbstrand,6)=bstrand(nbstrand,2) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,6).lt.bstrand(i,5)) then - bstrand(i,6)=bstrand(i,6)-ishift - else - bstrand(i,6)=bstrand(i,6)+ishift - endif - ENDIF - enddo - endif - - - return - end - - -c------------------------------------------------- - - subroutine secondary(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) - logical lprint,not_done - real dcont(maxres*maxres/2),d - real rcomp /7.0/ - real rbeta /5.2/ - real ralfa /5.2/ - real r310 /6.6/ - double precision xpi(3),xpj(3) - - - - call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - isec(i,3)=0 - enddo - - do i=2,nres-3 - do k=1,3 - xpi(k)=0.5d0*(c(k,i-1)+c(k,i)) - enddo - do j=i+2,nres - do k=1,3 - xpj(k)=0.5d0*(c(k,j-1)+c(k,j)) - enddo -cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) + -cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) + -cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j)) -cd print *,'CA',i,j,d - d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) + - & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) + - & (xpi(3)-xpj(3))*(xpi(3)-xpj(3)) - if ( d.lt.rcomp*rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - dcont(ncont)=sqrt(d) - endif - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,'(a)') '#PP contact map distances:' - do i=1,ncont - write (iout,'(3i4,f10.5)') - & i,icont(1,i),icont(2,i),dcont(i) - enddo - endif - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) - & .and. dcont(j).le.rbeta .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=j1 - - do ij=ii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - do ij=jj1,j1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (dcont(i).le.rbeta.and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & .and. dcont(j).le.rbeta ) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - if(lprint)write (iout,*)'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=max0(ii1-1,1) - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=max0(j1-1,1) - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - - if (lprint) then - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+3.and.dcont(i).le.r310 - & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i) -cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i) - ii1=i1 - jj1=j1 - if (isec(ii1,1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - if (j1-ii1.gt.4) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=max0(j1-1,1) - - do ij=ii1,j1 - isec(ij,1)=-1 - enddo - if (lprint) then - write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - endif - - - return - end -c---------------------------------------------------------------------------- - - subroutine write_pdb(npdb,titelloc,ee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*50 titelloc1 - character*(*) titelloc - character*3 zahl - character*5 liczba5 - double precision ee - integer npdb,ilen - external ilen - - titelloc1=titelloc - lenpre=ilen(prefix) - if (npdb.lt.1000) then - call numstr(npdb,zahl) - open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb') - else - if (npdb.lt.10000) then - write(liczba5,'(i1,i4)') 0,npdb - else - write(liczba5,'(i5)') npdb - endif - open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb') - endif - call pdbout(ee,titelloc1,ipdb) - close(ipdb) - return - end - -c-------------------------------------------------------- - subroutine softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.INTERACT' -c - include 'COMMON.DISTFIT' - integer iff(maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - integer ieval -c - logical debug,ltest,fail - character*50 linia -c - linia='test' - debug=.true. - in_pdb=0 - - - -c------------------------ -c -c freeze sec.elements -c - do i=1,nres - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - iff(i)=0 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - enddo - mask_r=.true. - - - - nhpb0=nhpb -c -c store dist. constrains -c - do i=1,nres-3 - do j=i+3,nres - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=0.1 - dhpb(nhpb)=DIST(i,j) - endif - enddo - enddo - call hpb_partition - - if (debug) then - call chainbuild - call write_pdb(100+in_pdb,'input reg. structure',0d0) - endif - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - wang0=wang -c -c run soft pot. optimization -c - ipot=6 - wang=3.0 - maxmin=2000 - maxfun=4000 - call geom_to_var(nvar,var) -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, - & nfun/(time1-time0),' SOFT eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(300+in_pdb,'soft structure',etot) - endif -c -c run full UNRES optimization with constrains and frozen 2D -c the same variables as soft pot. optimizatio -c - ipot=ipot0 - wang=wang0 - maxmin=maxmin0 - maxfun=maxfun0 -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK DIST return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for mask dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(400+in_pdb,'mask & dist',etot) - endif -c -c switch off constrains and -c run full UNRES optimization with frozen 2D -c - -c -c reset constrains -c - nhpb_c=nhpb - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun - ieval=ieval+nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(500+in_pdb,'mask 2d frozen',etot) - endif - - mask_r=.false. - - -c -c run full UNRES optimization with constrains and NO frozen 2D -c - - nhpb=nhpb_c - link_start=1 - link_end=nhpb - maxfun=maxfun0/5 - - do ico=1,5 - - wstrain=wstrain0/ico -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(600+in_pdb+ico,'dist cons',etot) - endif - - enddo -c - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - maxfun=maxfun0 - - -c - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - return - end - - diff --git a/source/unres/src_MD-DFA-restraints/thread.F b/source/unres/src_MD-DFA-restraints/thread.F deleted file mode 100644 index 9f169a0..0000000 --- a/source/unres/src_MD-DFA-restraints/thread.F +++ /dev/null @@ -1,549 +0,0 @@ - subroutine thread_seq -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.CONTACTS' - include 'COMMON.MCM' - include 'COMMON.NAMES' -#ifdef MPI - include 'COMMON.INFO' - integer ThreadId,ThreadType,Kwita -#endif - double precision varia(maxvar) - double precision przes(3),obr(3,3) - double precision time_for_thread - logical found_pattern,non_conv - character*32 head_pdb - double precision energia(0:n_ene) - n_ene_comp=nprint_ene -C -C Body -C -#ifdef MPI - if (me.eq.king) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif - nacc_tot=0 -#endif - Kwita=0 - close(igeom) - close(ipdb) - close(istat) - do i=1,maxthread - do j=1,14 - ener0(j,i)=0.0D0 - ener(j,i)=0.0D0 - enddo - enddo - nres0=nct-nnt+1 - ave_time_for_thread=0.0D0 - max_time_for_thread=0.0D0 -cd print *,'nthread=',nthread,' nseq=',nseq,' nres0=',nres0 - nthread=nexcl+nthread - do ithread=1,nthread - found_pattern=.false. - itrial=0 - do while (.not.found_pattern) - itrial=itrial+1 - if (itrial.gt.1000) then - write (iout,'(/a/)') 'Too many attempts to find pattern.' - nthread=ithread-1 -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-3) -#endif - goto 777 - endif -C Find long enough chain in the database - ii=iran_num(1,nseq) - nres_t=nres_base(1,ii) -C Select the starting position to thread. - print *,'nseq',nseq,' ii=',ii,' nres_t=', - & nres_t,' nres0=',nres0 - if (nres_t.ge.nres0) then - ist=iran_num(0,nres_t-nres0) -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_receive -#endif - do i=1,nexcl - if (iexam(1,i).eq.ii .and. iexam(2,i).eq.ist) goto 10 - enddo - found_pattern=.true. - endif -C If this point is reached, the pattern has not yet been examined. - 10 continue -c print *,'found_pattern:',found_pattern - enddo - nexcl=nexcl+1 - iexam(1,nexcl)=ii - iexam(2,nexcl)=ist -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_send -#endif - ipatt(1,ithread)=ii - ipatt(2,ithread)=ist -#ifdef MPI - write (iout,'(/80(1h*)/a,i4,a,i5,2a,i3,a,i3,a,i3/)') - & 'Processor:',me,' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i4,a,i5,2a,i3,a,i3,a,i3)') 'Processor:',me, - & ' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#else - write (iout,'(/80(1h*)/a,i5,2a,i3,a,i3,a,i3/)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i5,2a,i3,a,i3,a,i3)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#endif - ipattern=ii -C Copy coordinates from the database. - ist=ist-(nnt-1) - do i=nnt,nct - do j=1,3 - c(j,i)=cart_base(j,i+ist,ii) -c cref(j,i)=c(j,i) - enddo -cd write (iout,'(a,i4,3f10.5)') restyp(itype(i)),i,(c(j,i),j=1,3) - enddo -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr, -cd non_conv) -cd write (iout,'(a,f10.5)') -cd & 'Initial RMS deviation from reference structure:',rms - if (itype(nres).eq.21) then - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - if (itype(1).eq.21) then - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - call int_from_cart(.false.,.false.) -cd print *,'Exit INT_FROM_CART.' -cd print *,'nhpb=',nhpb - do i=nss+1,nhpb - ii=ihpb(i) - jj=jhpb(i) - dhpb(i)=dist(ii,jj) -c write (iout,'(2i5,2f10.5)') ihpb(i),jhpb(i),dhpb(i),forcon(i) - enddo -c stop 'End generate' -C Generate SC conformations. - call sc_conf -c call intout -#ifdef MPI -cd print *,'Processor:',me,': exit GEN_SIDE.' -#else -cd print *,'Exit GEN_SIDE.' -#endif -C Calculate initial energy. - call chainbuild - call etotal(energia(0)) - etot=energia(0) - do i=1,n_ene_comp - ener0(i,ithread)=energia(i) - enddo - ener0(n_ene_comp+1,ithread)=energia(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener0(n_ene_comp+3,ithread)=contact_fract(ncont,ncont_ref, - & icont,icont_ref) - ener0(n_ene_comp+2,ithread)=rms - ener0(n_ene_comp+4,ithread)=frac - ener0(n_ene_comp+5,ithread)=frac_nn - endif - ener0(n_ene_comp+3,ithread)=0.0d0 -C Minimize energy. -#ifdef MPI - print*,'Processor:',me,' ithread=',ithread,' Start REGULARIZE.' -#else - print*,'ithread=',ithread,' Start REGULARIZE.' -#endif - curr_tim=tcpu() - call regularize(nct-nnt+1,etot,rms, - & cart_base(1,ist+nnt,ipattern),iretcode) - curr_tim1=tcpu() - time_for_thread=curr_tim1-curr_tim - ave_time_for_thread= - & ((ithread-1)*ave_time_for_thread+time_for_thread)/ithread - if (time_for_thread.gt.max_time_for_thread) - & max_time_for_thread=time_for_thread -#ifdef MPI - print *,'Processor',me,': Exit REGULARIZE.' - if (WhatsUp.eq.2) then - write (iout,*) - & 'Sufficient number of confs. collected. Terminating.' - nthread=ithread-1 - goto 777 - else if (WhatsUp.eq.-1) then - nthread=ithread-1 - write (iout,*) 'Time up in REGULARIZE. Call SEND_STOP_SIG.' - if (Kwita.eq.0) call recv_stop_sig(Kwita) - call send_stop_sig(-2) - goto 777 - else if (WhatsUp.eq.-2) then - nthread=ithread-1 - write (iout,*) 'Timeup signal received. Terminating.' - goto 777 - else if (WhatsUp.eq.-3) then - nthread=ithread-1 - write (iout,*) 'Error stop signal received. Terminating.' - goto 777 - endif -#else - print *,'Exit REGULARIZE.' - if (iretcode.eq.11) then - write (iout,'(/a/)') - &'******* Allocated time exceeded in SUMSL. The program will stop.' - nthread=ithread-1 - goto 777 - endif -#endif - head_pdb=titel(:24)//':'//str_nam(ipattern) - if (outpdb) call pdbout(etot,head_pdb,ipdb) - if (outmol2) call mol2out(etot,head_pdb) -c call intout - call briefout(ithread,etot) - link_end0=link_end - link_end=min0(link_end,nss) - write (iout,*) 'link_end=',link_end,' link_end0=',link_end0, - & ' nss=',nss - call etotal(energia(0)) -c call enerprint(energia(0)) - link_end=link_end0 -cd call chainbuild -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,non_conv) -cd write (iout,'(a,f10.5)') -cd & 'RMS deviation from reference structure:',dsqrt(rms) - do i=1,n_ene_comp - ener(i,ithread)=energia(i) - enddo - ener(n_ene_comp+1,ithread)=energia(0) - ener(n_ene_comp+3,ithread)=rms - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener(n_ene_comp+2,ithread)=rms - ener(n_ene_comp+4,ithread)=frac - ener(n_ene_comp+5,ithread)=frac_nn - endif - call write_stat_thread(ithread,ipattern,ist) -c write (istat,'(i4,2x,a8,i4,11(1pe14.5),2(0pf8.3),f8.5)') -c & ithread,str_nam(ipattern),ist+1,(ener(k,ithread),k=1,11), -c & (ener(k,ithread),k=12,14) -#ifdef MPI - if (me.eq.king) then - nacc_tot=nacc_tot+1 - call pattern_receive - call receive_MCM_info - if (nacc_tot.ge.nthread) then - write (iout,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - write (*,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - call recv_stop_sig(Kwita) - if (Kwita.eq.0) call send_stop_sig(-1) - nthread=ithread - goto 777 - endif - else - call send_MCM_info(2) - endif -#endif - if (timlim-curr_tim1-safety .lt. max_time_for_thread) then - write (iout,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (*,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (iout,'(a,1pe14.4/)') - & 'Elapsed time for last threading step: ',time_for_thread - nthread=ithread -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-2) -#endif - goto 777 - else - curr_tim=curr_tim1 - write (iout,'(a,1pe14.4)') - & 'Elapsed time for this threading step: ',time_for_thread - endif -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread - write (*,*) 'nthread=',nthread,' ithread=',ithread - goto 777 - endif -#endif - enddo -#ifdef MPI - call send_stop_sig(-1) -#endif - 777 continue -#ifdef MPI -C Any messages left for me? - call pattern_receive - if (Kwita.eq.0) call recv_stop_sig(Kwita) -#endif - call write_thread_summary -#ifdef MPI - if (king.eq.king) then - Kwita=1 - do while (Kwita.ne.0 .or. nacc_tot.ne.0) - Kwita=0 - nacc_tot=0 - call recv_stop_sig(Kwita) - call receive_MCM_info - enddo - do iproc=1,nprocs-1 - call receive_thread_results(iproc) - enddo - call write_thread_summary - else - call send_thread_results - endif -#endif - return - end -c-------------------------------------------------------------------------- - subroutine write_thread_summary -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -#ifdef MPI - include 'COMMON.INFO' -#endif - dimension ip(maxthread) - double precision energia(0:n_ene) - write (iout,'(30x,a/)') - & ' *********** Summary threading statistics ************' - write (iout,'(a)') 'Initial energies:' - write (iout,'(a4,2x,a12,14a14,3a8)') - & 'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' -C Energy sort patterns - do i=1,nthread - ip(i)=i - enddo - do i=1,nthread-1 - enet=ener(n_ene-1,ip(i)) - jj=i - do j=i+1,nthread - if (ener(n_ene-1,ip(j)).lt.enet) then - jj=j - enet=ener(n_ene-1,ip(j)) - endif - enddo - if (jj.ne.i) then - ipj=ip(jj) - ip(jj)=ip(i) - ip(i)=ipj - endif - enddo - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(i)=ener0(kk,i) - enddo - etot=ener0(n_ene_comp+1,i) - rmsnat=ener0(n_ene_comp+2,i) - rms=ener0(n_ene_comp+3,i) - frac=ener0(n_ene_comp+4,i) - frac_nn=ener0(n_ene_comp+5,i) - - if (refstr) then - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - else - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene),etot - endif - enddo - write (iout,'(//a)') 'Final energies:' - write (iout,'(a4,2x,a12,17a14,3a8)') - & 'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(kk)=ener(kk,ik) - enddo - etot=ener(n_ene_comp+1,i) - rmsnat=ener(n_ene_comp+2,i) - rms=ener(n_ene_comp+3,i) - frac=ener(n_ene_comp+4,i) - frac_nn=ener(n_ene_comp+5,i) - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - enddo - write (iout,'(/a/)') 'IEXAM array:' - write (iout,'(i5)') nexcl - do i=1,nexcl - write (iout,'(2i5)') iexam(1,i),iexam(2,i) - enddo - write (iout,'(/a,1pe14.4/a,1pe14.4/)') - & 'Max. time for threading step ',max_time_for_thread, - & 'Average time for threading step: ',ave_time_for_thread - return - end -c---------------------------------------------------------------------------- - subroutine sc_conf -C Sample (hopefully) optimal SC orientations given backcone conformation. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - double precision varia(maxvar) - common /srutu/ icall - double precision energia(0:n_ene) - logical glycine,fail - maxsample=10 - link_end0=link_end - link_end=min0(link_end,nss) - do i=nnt,nct - if (itype(i).ne.10) then -cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1) - call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail) - endif - enddo - call chainbuild - call etotal(energia(0)) - do isample=1,maxsample -C Choose a non-glycine side chain. - glycine=.true. - do while(glycine) - ind_sc=iran_num(nnt,nct) - glycine=(itype(ind_sc).eq.10) - enddo - alph0=alph(ind_sc) - omeg0=omeg(ind_sc) - call gen_side(itype(ind_sc),theta(ind_sc+1),alph(ind_sc), - & omeg(ind_sc),fail) - call chainbuild - call etotal(energia(0)) -cd write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))') -cd & 'Step:',isample,' SC',ind_sc,' alpha',alph(ind_sc)*rad2deg, -cd & ' omega',omeg(ind_sc)*rad2deg,' old energy',e0,' new energy',e1 - e1=0.0d0 - if (e0.le.e1) then - alph(ind_sc)=alph0 - omeg(ind_sc)=omeg0 - else - e0=e1 - endif - enddo - link_end=link_end0 - return - end -c--------------------------------------------------------------------------- - subroutine write_stat_thread(ithread,ipattern,ist) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.CONTROL" - include "COMMON.IOUNITS" - include "COMMON.THREAD" - include "COMMON.FFIELD" - include "COMMON.DBASE" - include "COMMON.NAMES" - double precision energia(0:n_ene) - -#if defined(AIX) || defined(PGI) - open(istat,file=statname,position='append') -#else - open(istat,file=statname,access='append') -#endif - do i=1,n_ene_comp - energia(i)=ener(i,ithread) - enddo - etot=ener(n_ene_comp+1,ithread) - rmsnat=ener(n_ene_comp+2,ithread) - rms=ener(n_ene_comp+3,ithread) - frac=ener(n_ene_comp+4,ithread) - frac_nn=ener(n_ene_comp+5,ithread) - write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & ithread,str_nam(ipattern),ist+1, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - close (istat) - return - end diff --git a/source/unres/src_MD-DFA-restraints/timing.F b/source/unres/src_MD-DFA-restraints/timing.F deleted file mode 100644 index 5a81655..0000000 --- a/source/unres/src_MD-DFA-restraints/timing.F +++ /dev/null @@ -1,344 +0,0 @@ -C $Date: 1994/10/05 16:41:52 $ -C $Revision: 2.2 $ -C -C -C - subroutine set_timers -c - implicit none - double precision tcpu - include 'COMMON.TIME1' -#ifdef MP - include 'mpif.h' -#endif -C Diminish the assigned time limit a little so that there is some time to -C end a batch job -c timlim=batime-150.0 -C Calculate the initial time, if it is not zero (e.g. for the SUN). - stime=tcpu() -#ifdef MPI - walltime=MPI_WTIME() - time_reduce=0.0d0 - time_allreduce=0.0d0 - time_bcast=0.0d0 - time_gather=0.0d0 - time_sendrecv=0.0d0 - time_scatter=0.0d0 - time_scatter_fmat=0.0d0 - time_scatter_ginv=0.0d0 - time_scatter_fmatmult=0.0d0 - time_scatter_ginvmult=0.0d0 - time_barrier_e=0.0d0 - time_barrier_g=0.0d0 - time_enecalc=0.0d0 - time_sumene=0.0d0 - time_lagrangian=0.0d0 - time_sumgradient=0.0d0 - time_intcartderiv=0.0d0 - time_inttocart=0.0d0 - time_ginvmult=0.0d0 - time_fricmatmult=0.0d0 - time_cartgrad=0.0d0 - time_bcastc=0.0d0 - time_bcast7=0.0d0 - time_bcastw=0.0d0 - time_intfcart=0.0d0 - time_vec=0.0d0 - time_mat=0.0d0 - time_fric=0.0d0 - time_stoch=0.0d0 - time_fricmatmult=0.0d0 - time_fsample=0.0d0 -#endif -cd print *,' in SET_TIMERS stime=',stime - return - end -C------------------------------------------------------------------------------ - logical function stopx(nf) -C This function returns .true. if one of the following reasons to exit SUMSL -C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: -C -C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false. -C... 1 - Time up in current node; -C... 2 - STOP signal was received from another node because the -C... node's task was accomplished (parallel only); -C... -1 - STOP signal was received from another node because of error; -C... -2 - STOP signal was received from another node, because -C... the node's time was up. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nf - logical ovrtim -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer Kwita - -cd print *,'Processor',MyID,' NF=',nf -#ifndef MPI - if (ovrtim()) then -C Finish if time is up. - stopx = .true. - WhatsUp=1 -#ifdef MPL - else if (mod(nf,100).eq.0) then -C Other processors might have finished. Check this every 100th function -C evaluation. -C Master checks if any other processor has sent accepted conformation(s) to it. - if (MyID.ne.MasterID) call receive_mcm_info - if (MyID.eq.MasterID) call receive_conf -cd print *,'Processor ',MyID,' is checking STOP: nf=',nf - call recv_stop_sig(Kwita) - if (Kwita.eq.-1) then - write (iout,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - write (*,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - stopx=.true. - WhatsUp=2 - elseif (Kwita.eq.-2) then - write (iout,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - WhatsUp=-2 - stopx=.true. - else if (Kwita.eq.-3) then - write (iout,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - WhatsUp=-1 - stopx=.true. - else - stopx=.false. - WhatsUp=0 - endif -#endif - else - stopx = .false. - WhatsUp=0 - endif -#else - stopx=.false. -#endif - -#ifdef OSF -c Check for FOUND_NAN flag - if (FOUND_NAN) then - write(iout,*)" *** stopx : Found a NaN" - stopx=.true. - endif -#endif - - return - end -C-------------------------------------------------------------------------- - logical function ovrtim() - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - real*8 tcpu -#ifdef MPI - include "mpif.h" - curtim = MPI_Wtime()-walltime -#else - curtim= tcpu() -#endif -C curtim is the current time in seconds. -c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety - if (curtim .ge. timlim - safety) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') - & "***************** Elapsed time (",curtim, - & " s) is within the safety limit (",safety, - & " s) of the allocated time (",timlim," s). Terminating." - ovrtim=.true. - else - ovrtim=.false. - endif - return - end -************************************************************************** - double precision function tcpu() - include 'COMMON.TIME1' -#ifdef ES9000 -**************************** -C Next definition for EAGLE (ibm-es9000) - real*8 micseconds - integer rcode - tcpu=cputime(micseconds,rcode) - tcpu=(micseconds/1.0E6) - stime -**************************** -#endif -#ifdef SUN -**************************** -C Next definitions for sun - REAL*8 ECPU,ETIME,ETCPU - dimension tarray(2) - tcpu=etime(tarray) - tcpu=tarray(1) -**************************** -#endif -#ifdef KSR -**************************** -C Next definitions for ksr -C this function uses the ksr timer ALL_SECONDS from the PMON library to -C return the elapsed time in seconds - tcpu= all_seconds() - stime -**************************** -#endif -#ifdef SGI -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - -#ifdef LINUX -c**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime - usrsec = timar(1) - syssec = timar(2) - tcpu=seconds - stime -c**************************** -#endif - - -#ifdef CRAY -**************************** -C Next definitions for Cray -C call date(curdat) -C curdat=curdat(1:9) -C call clock(curtim) -C curtim=curtim(1:8) - cpusec = second() - tcpu=cpusec - stime -**************************** -#endif -#ifdef AIX -**************************** -C Next definitions for RS6000 -c integer*4 i1,mclock - i1 = mclock() - tcpu = (i1+0.0D0)/100.0D0 -#endif -#ifdef WINPGI -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif -#ifdef WINIFL -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif - - return - end -C--------------------------------------------------------------------------- - subroutine dajczas(rntime,hrtime,mintime,sectime) - include 'COMMON.IOUNITS' - real*8 rntime,hrtime,mintime,sectime - hrtime=rntime/3600.0D0 - hrtime=aint(hrtime) - mintime=aint((rntime-3600.0D0*hrtime)/60.0D0) - sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0) - if (sectime.eq.60.0D0) then - sectime=0.0D0 - mintime=mintime+1.0D0 - endif - ihr=hrtime - imn=mintime - isc=sectime - write (iout,328) ihr,imn,isc - 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 , - 1 ' minutes ', I2 ,' seconds *****') - return - end -C--------------------------------------------------------------------------- - subroutine print_detailed_timing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -#ifdef MPI - time1=MPI_WTIME() - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g, - & "TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - write (*,*) fg_rank,myrank, - & ': Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",fg_rank,myrank, - & ": BROADCAST time",time_bcast," REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter, - & " SCATTER fmatmult",time_scatter_fmatmult, - & " SCATTER ginvmult",time_scatter_ginvmult, - & " SCATTER fmat",time_scatter_fmat, - & " SCATTER ginv",time_scatter_ginv, - & " SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e, - & " BARRIER GRAD",time_barrier_g, - & " BCAST7",time_bcast7," BCASTC",time_bcastc, - & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce, - & " TOTAL", - & time_bcast+time_reduce+time_gather+time_scatter+ - & time_sendrecv+time_barrier+time_bcastc -#else - time1=tcpu() -#endif - write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc - write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene - write (*,*) "Processor",fg_rank,myrank," intfromcart", - & time_intfcart - write (*,*) "Processor",fg_rank,myrank," vecandderiv", - & time_vec - write (*,*) "Processor",fg_rank,myrank," setmatrices", - & time_mat - write (*,*) "Processor",fg_rank,myrank," ginvmult", - & time_ginvmult - write (*,*) "Processor",fg_rank,myrank," fricmatmult", - & time_fricmatmult - write (*,*) "Processor",fg_rank,myrank," inttocart", - & time_inttocart - write (*,*) "Processor",fg_rank,myrank," sumgradient", - & time_sumgradient - write (*,*) "Processor",fg_rank,myrank," intcartderiv", - & time_intcartderiv - if (fg_rank.eq.0) then - write (*,*) "Processor",fg_rank,myrank," lagrangian", - & time_lagrangian - write (*,*) "Processor",fg_rank,myrank," cartgrad", - & time_cartgrad - endif - return - end diff --git a/source/unres/src_MD-DFA-restraints/unres.F b/source/unres/src_MD-DFA-restraints/unres.F deleted file mode 100644 index 632374b..0000000 --- a/source/unres/src_MD-DFA-restraints/unres.F +++ /dev/null @@ -1,796 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C U N R E S C -C C -C Program to carry out conformational search of proteins in an united-residue C -C approximation. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#endif - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision hrtime,mintime,sectime - character*64 text_mode_calc(-2:14) /'test', - & 'SC rotamer distribution', - & 'Energy evaluation or minimization', - & 'Regularization of PDB structure', - & 'Threading of a sequence on PDB structures', - & 'Monte Carlo (with minimization) ', - & 'Energy minimization of multiple conformations', - & 'Checking energy gradient', - & 'Entropic sampling Monte Carlo (with minimization)', - & 'Energy map', - & 'CSA calculations', - & 'Not used 9', - & 'Not used 10', - & 'Soft regularization of PDB structure', - & 'Mesoscopic molecular dynamics (MD) ', - & 'Not used 13', - & 'Replica exchange molecular dynamics (REMD)'/ - external ilen - -c call memmon_print_usage() - - call init_task - if (me.eq.king) - & write(iout,*)'### LAST MODIFIED 03/28/12 23:29 by czarek' - if (me.eq.king) call cinfo -C Read force field parameters and job setup data - call readrtns - if (me.eq.king .or. .not. out1file) then - write (iout,'(2a/)') - & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), - & ' calculation.' - if (minim) write (iout,'(a)') - & 'Conformations will be energy-minimized.' - write (iout,'(80(1h*)/)') - endif - call flush(iout) -C - if (modecalc.eq.-2) then - call test - stop - else if (modecalc.eq.-1) then - write(iout,*) "call check_sc_map next" - call check_bond - stop - endif -#ifdef MPI - if (fg_rank.gt.0) then -C Fine-grain slaves just do energy and gradient components. - call ergastulum ! slave workhouse in Latin - else -#endif - if (modecalc.eq.0) then - call exec_eeval_or_minim - else if (modecalc.eq.1) then - call exec_regularize - else if (modecalc.eq.2) then - call exec_thread - else if (modecalc.eq.3 .or. modecalc .eq.6) then - call exec_MC - else if (modecalc.eq.4) then - call exec_mult_eeval_or_minim - else if (modecalc.eq.5) then - call exec_checkgrad - else if (ModeCalc.eq.7) then - call exec_map - else if (ModeCalc.eq.8) then - call exec_CSA - else if (modecalc.eq.11) then - call exec_softreg - else if (modecalc.eq.12) then - call exec_MD - else if (modecalc.eq.14) then - call exec_MREMD - else - write (iout,'(a)') 'This calculation type is not supported', - & ModeCalc - endif -#ifdef MPI - endif -C Finish task. - if (fg_rank.eq.0) call finish_task -c call memmon_print_usage() -#ifdef TIMING - call print_detailed_timing -#endif - call MPI_Finalize(ierr) - stop 'Bye Bye...' -#else - call dajczas(tcpu(),hrtime,mintime,sectime) - stop '********** Program terminated normally.' -#endif - end -c-------------------------------------------------------------------------- - subroutine exec_MD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - call MD - return - end -c--------------------------------------------------------------------------- - subroutine exec_MREMD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling REMD" - if (remd_mlist) then - call MREMD - else - do i=1,nrep - remd_m(i)=1 - enddo - call MREMD - endif -#else - write (iout,*) "MREMD works on parallel machines only" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:n_ene) - double precision energy_long(0:n_ene),energy_short(0:n_ene) - double precision varia(maxvar) - if (indpdb.eq.0) call chainbuild -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call chainbuild_cart - if (split_ene) then - print *,"Processor",myrank," after chainbuild" - icall=1 - call etotal_long(energy_long(0)) - write (iout,*) "Printing long range energy" - call enerprint(energy_long(0)) - call etotal_short(energy_short(0)) - write (iout,*) "Printing short range energy" - call enerprint(energy_short(0)) - do i=0,n_ene - energy(i)=energy_long(i)+energy_short(i) - write (iout,*) i,energy_long(i),energy_short(i),energy(i) - enddo - write (iout,*) "Printing long+short range energy" - call enerprint(energy(0)) - endif - call etotal(energy(0)) -#ifdef MPI - time_ene=MPI_Wtime()-time00 -#else - time_ene=tcpu()-time00 -#endif - write (iout,*) "Time for energy evaluation",time_ene - print *,"after etotal" - etota = energy(0) - etot =etota - call enerprint(energy(0)) - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - if (minim) then -crc overlap test - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - write(iout,*) 'SC_move',nft_sc,etot - endif - - if (dccart) then - print *, 'Calling MINIM_DC' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minim_dc(etot,iretcode,nfun) - else - if (indpdb.ne.0) then - call bond_regular - call chainbuild - endif - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - endif - print *,'SUMSL return code is',iretcode,' eval ',nfun -#ifdef MPI - evals=nfun/(MPI_WTIME()-time1) -#else - evals=nfun/(tcpu()-time1) -#endif - print *,'# eval/s',evals - print *,'refstr=',refstr - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - - call intout - call briefout(0,etot) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 - write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals - else - print *,'refstr=',refstr - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call briefout(0,etot) - endif - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - return - end -c--------------------------------------------------------------------------- - subroutine exec_regularize - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision energy(0:n_ene) - - call gen_dist_constr - call sc_conf - call intout - call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode) - call etotal(energy(0)) - energy(0)=energy(0)-energy(14) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - return - end -c--------------------------------------------------------------------------- - subroutine exec_thread - include 'DIMENSIONS' -#ifdef MP - include "mpif.h" -#endif - include "COMMON.SETUP" - call thread_seq - return - end -c--------------------------------------------------------------------------- - subroutine exec_MC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - character*10 nodeinfo - double precision varia(maxvar) -#ifdef MPI - include "mpif.h" -#endif - include "COMMON.SETUP" - include 'COMMON.CONTROL' - call mcm_setup - if (minim) then -#ifdef MPI - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#else - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#endif - else - call monte_carlo - endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_mult_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - dimension muster(mpi_status_size) -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision varia(maxvar) - dimension ind(6) - double precision energy(0:n_ene) - logical eof - eof=.false. -#ifdef MPI - if(me.ne.king) then - call minim_mcmf - return - endif - - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,30a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact","cont.order" - else - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - - if (.not.minim) then - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - call etotal(energy(0)) - call briefout(iconf,energy(0)) - call enerprint(energy(0)) - etot=energy(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo -1100 continue - goto 1101 - endif - - mm=0 - imm=0 - nft=0 - ene0=0.0d0 - n=0 - iconf=0 -c do n=1,nzsc - do while (.not. eof) - mm=mm+1 - if (mm.lt.nodes) then - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - ene0=0.0d0 - call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) -c print *,'task ',n,' sent to worker ',mm,nvar - else - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) -c print *,'receiving result from worker ',man,' (',iii1,iii,')' - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -c print *,'result received from worker ',man,' sending now' - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) -c if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - - imm=imm-1 - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - nf_mcmf=nf_mcmf+ind(4) - nmin=nmin+1 - endif - enddo -11 continue - do j=1,imm - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - nmin=nmin+1 - enddo -1101 continue - do i=1, nodes-1 - ind(1)=0 - ind(2)=0 - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM, - * ierr) - enddo -#else - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,20a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - write (istat,'("# ",20(1pe12.4))') - & (weights(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,20a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact" - else - write (istat,'(a5,14a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - if (minim) call minimize(etot,varia,iretcode,nfun) - call etotal(energy(0)) - - etot=energy(0) - call enerprint(energy(0)) - if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,18(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,14(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo - 11 continue - 1100 continue -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_checkgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:max_ene) -c do i=2,nres -c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0) -c if (itype(i).ne.10) -c & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0) -c enddo - if (indpdb.eq.0) call chainbuild -c do i=0,nres -c do j=1,3 -c dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0) -c enddo -c enddo -c do i=1,nres-1 -c if (itype(i).ne.10) then -c do j=1,3 -c dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0) -c enddo -c endif -c enddo -c do j=1,3 -c dc(j,0)=ran_number(-0.2d0,0.2d0) -c enddo - usampl=.true. - totT=1.d0 - eq_time=0.0d0 - call read_fragments - read(inp,*) t_bath - call rescale_weights(t_bath) - call chainbuild_cart - call cartprint - call intout - icall=1 - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back - print *,'icheckgrad=',icheckgrad - goto (10,20,30) icheckgrad - 10 call check_ecartint - return - 20 call check_cartgrad - return - 30 call check_eint - return - end -c--------------------------------------------------------------------------- - subroutine exec_map -C Energy maps - call map_read - call map - return - end -c--------------------------------------------------------------------------- - subroutine exec_CSA -#ifdef MPI - include "mpif.h" -#endif - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -C Conformational Space Annealling programmed by Jooyoung Lee. -C This method works only with parallel machines! -#ifdef MPI -csa call together - write (iout,*) "CSA is not supported in this version" -#else -csa write (iout,*) "CSA works on parallel machines only" - write (iout,*) "CSA is not supported in this version" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - double precision energy(0:max_ene) - logical debug /.false./ - call chainbuild - call etotal(energy(0)) - call enerprint(energy(0)) - if (.not.lsecondary) then - write(iout,*) 'Calling secondary structure recognition' - call secondary2(debug) - else - write(iout,*) 'Using secondary structure supplied in pdb' - endif - - call softreg - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - call secondary2(.true.) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - return - end diff --git a/source/unres/src_MD-DFA-restraints/xdrf/CMakeLists.txt b/source/unres/src_MD-DFA-restraints/xdrf/CMakeLists.txt deleted file mode 100644 index 26baa36..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/CMakeLists.txt +++ /dev/null @@ -1,19 +0,0 @@ -# -# CMake project file for UNRESPACK -# - -# m4 macro processor -add_custom_command( - OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c - COMMAND m4 - ARGS ${CMAKE_CURRENT_SOURCE_DIR}/underscore.m4 ${CMAKE_CURRENT_SOURCE_DIR}/libxdrf.m4 > ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c - VERBATIM -) - -# add headers from current dir -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) -# compile the libxdrf library -add_library(xdrf STATIC ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c ftocstr.c) -set(UNRES_XDRFLIB ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.a PARENT_SCOPE) - -#add_dependencies( ${UNRES_BIN} xdrf ) diff --git a/source/unres/src_MD-DFA-restraints/xdrf/Makefile b/source/unres/src_MD-DFA-restraints/xdrf/Makefile deleted file mode 100644 index 02c29f6..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = gcc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/unres/src_MD-DFA-restraints/xdrf/Makefile_jubl b/source/unres/src_MD-DFA-restraints/xdrf/Makefile_jubl deleted file mode 100644 index 8dc35cf..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/Makefile_jubl +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc - -CFLAGS= -O2 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f *.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/unres/src_MD-DFA-restraints/xdrf/Makefile_linux b/source/unres/src_MD-DFA-restraints/xdrf/Makefile_linux deleted file mode 100644 index f03276e..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/Makefile_linux +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/unres/src_MD-DFA-restraints/xdrf/RS6K.m4 b/source/unres/src_MD-DFA-restraints/xdrf/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/unres/src_MD-DFA-restraints/xdrf/ftocstr.c b/source/unres/src_MD-DFA-restraints/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/unres/src_MD-DFA-restraints/xdrf/libxdrf.m4 b/source/unres/src_MD-DFA-restraints/xdrf/libxdrf.m4 deleted file mode 100644 index a6da458..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1238 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "w+"; - lmode = XDR_ENCODE; - } else if (*type == 'a' || *type == 'A') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/unres/src_MD-DFA-restraints/xdrf/types.h b/source/unres/src_MD-DFA-restraints/xdrf/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/unres/src_MD-DFA-restraints/xdrf/underscore.m4 b/source/unres/src_MD-DFA-restraints/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdr.c b/source/unres/src_MD-DFA-restraints/xdrf/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdr.h b/source/unres/src_MD-DFA-restraints/xdrf/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdr_array.c b/source/unres/src_MD-DFA-restraints/xdrf/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdr_float.c b/source/unres/src_MD-DFA-restraints/xdrf/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdr_stdio.c b/source/unres/src_MD-DFA-restraints/xdrf/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/unres/src_MD-DFA-restraints/xdrf/xdrf.h b/source/unres/src_MD-DFA-restraints/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/unres/src_MD-DFA-restraints/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/unres/src_MD-M-SAXS-homology/COMMON.CONTACTS_safe1 b/source/unres/src_MD-M-SAXS-homology/COMMON.CONTACTS_safe1 deleted file mode 100644 index 64e0761..0000000 --- a/source/unres/src_MD-M-SAXS-homology/COMMON.CONTACTS_safe1 +++ /dev/null @@ -1,82 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -c 7/25/08 Commented out; not needed when cumulants used -C Interactions of pseudo-dipoles generated by loc-el interactions. -c double precision dip,dipderg,dipderx -c common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), -c & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres), - & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres), - & Dtobr2(2,maxres),Dtobr2der(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres), - & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont -C 12/13/2008 (again Poland-Jaruzel war anniversary) -C RE: Parallelization of 4th and higher order loc-el correlations - integer ncont_sent,ncont_recv,iint_sent,iisent_local, - & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to, - & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local, - & iturn4_sent_local - common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres), - & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres), - & iturn3_sent(4,maxres),iturn4_sent(4,maxres), - & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres), - & nat_sent,iat_sent(maxres),itask_cont_from(0:MaxProcs-1), - & itask_cont_to(0:MaxProcs-1),ntask_cont_from,ntask_cont_to diff --git a/source/unres/src_MD-M-SAXS-homology/COMMON.DERIV_safe b/source/unres/src_MD-M-SAXS-homology/COMMON.DERIV_safe deleted file mode 100644 index 524d72a..0000000 --- a/source/unres/src_MD-M-SAXS-homology/COMMON.DERIV_safe +++ /dev/null @@ -1,35 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, - & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long - integer nfl,icg - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab - integer igrad_start,igrad_end,jgrad_start(maxres), - & jgrad_end(maxres) - common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/unres/src_MD-M-SAXS-homology/DIMENSIONS_safe1 b/source/unres/src_MD-M-SAXS-homology/DIMENSIONS_safe1 deleted file mode 100644 index 7e72823..0000000 --- a/source/unres/src_MD-M-SAXS-homology/DIMENSIONS_safe1 +++ /dev/null @@ -1,135 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - integer maxprocs - parameter (maxprocs=2048) -C Max. number of fine-grain processors - integer max_fg_procs - parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors - integer max_cg_procs - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=800) -C Appr. max. number of interaction sites - integer maxres2,maxres6,mmaxres2 - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) -C Max. number of variables - integer maxvar - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres/4) -c parameter (maxconts=50) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=3) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=10) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=20) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=20) -C Max. number of energy intervals - integer max_ene - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=10) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=10) -C Number of energy components - integer n_ene,n_ene2 - parameter (n_ene=21,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -C Maximum number of generated conformations - integer mxio - parameter (mxio=2) -C Maximum number of n7 generated conformations - integer mxio2 - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - integer mxmv - parameter (mxmv=18) -C Maximum number of seed - integer max_seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) -C Maximum number of backbone fragments in restraining - integer maxfrag_back - parameter (maxfrag_back=4) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) -C Maximum number of conformation stored in cache on each CPU before sending -C to master; depends on nstex / ntwx ratio - integer max_cache_traj - parameter (max_cache_traj=10) diff --git a/source/unres/src_MD-M-SAXS-homology/MD.F b/source/unres/src_MD-M-SAXS-homology/MD.F deleted file mode 100644 index 88ebb56..0000000 --- a/source/unres/src_MD-M-SAXS-homology/MD.F +++ /dev/null @@ -1,2566 +0,0 @@ - subroutine MD -c------------------------------------------------ -c The driver for molecular dynamics subroutines -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.HAIRPIN' - double precision cm(3),L(3),vcm(3) -#ifdef VOUT - double precision v_work(maxres6),v_transf(maxres6) -#endif - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -c -#ifdef MPI - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_" - & //liczba(:ilen(liczba))//'.rst') -#else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst') -#endif - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo -#endif - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - do itime=1,n_timestep - if (ovrtim()) goto 100 - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo -#endif - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) - write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else - call brown_step(itime) - endif - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) then - call statout(itime) - call returnbox - endif -#ifdef VOUT - do j=1,3 - v_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i+nres) - enddo - endif - enddo - - write (66,'(80f10.5)') - & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres) - do i=1,ind - v_transf(i)=0.0d0 - do j=1,ind - v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j) - enddo - v_transf(i)= v_transf(i)*dsqrt(geigen(i)) - enddo - write (67,'(80f10.5)') (v_transf(i),i=1,ind) -#endif - endif - if (mod(itime,ntwx).eq.0) then - write (tytul,'("time",f8.2)') totT - if(mdpdb) then - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - close(irest2) - rstcount=0 - endif - enddo - 100 continue -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - return - end -c------------------------------------------------------------------------------- - subroutine brown_step(itime) -c------------------------------------------------ -c Perform a single Euler integration step of Brownian dynamics -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision zapas(MAXRES6) - integer ilen,rstcount - external ilen - double precision stochforcvec(MAXRES6) - double precision Bmat(MAXRES6,MAXRES2),Cmat(maxres2,maxres2), - & Cinv(maxres2,maxres2),GBmat(MAXRES6,MAXRES2), - & Tmat(MAXRES6,MAXRES2),Pmat(maxres6,maxres6),Td(maxres6), - & ppvec(maxres2) - common /stochcalc/ stochforcvec - common /gucio/ cm - integer itime - logical lprn /.false./,lprn1 /.false./ - integer maxiter /5/ - double precision difftol /1.0d-5/ - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) nbond=nbond+1 - enddo -c - if (lprn1) then - write (iout,*) "Generalized inverse of fricmat" - call matout(dimen,dimen,MAXRES6,MAXRES6,fricmat) - endif - do i=1,dimen - do j=1,nbond - Bmat(i,j)=0.0d0 - enddo - enddo - ind=3 - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - Bmat(ind+j,ind1)=dC_norm(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - ind1=ind1+1 - do j=1,3 - Bmat(ind+j,ind1)=dC_norm(j,i+nres) - enddo - ind=ind+3 - endif - enddo - if (lprn1) then - write (iout,*) "Matrix Bmat" - call MATOUT(nbond,dimen,MAXRES6,MAXRES2,Bmat) - endif - do i=1,dimen - do j=1,nbond - GBmat(i,j)=0.0d0 - do k=1,dimen - GBmat(i,j)=GBmat(i,j)+fricmat(i,k)*Bmat(k,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix GBmat" - call MATOUT(nbond,dimen,MAXRES6,MAXRES2,Gbmat) - endif - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,dimen - Cmat(i,j)=Cmat(i,j)+Bmat(k,i)*GBmat(k,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call matinvert(nbond,MAXRES2,Cmat,Cinv) - if (lprn1) then - write (iout,*) "Matrix Cinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cinv) - endif - do i=1,dimen - do j=1,nbond - Tmat(i,j)=0.0d0 - do k=1,nbond - Tmat(i,j)=Tmat(i,j)+GBmat(i,k)*Cinv(k,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Tmat" - call MATOUT(nbond,dimen,MAXRES6,MAXRES2,Tmat) - endif - do i=1,dimen - do j=1,dimen - if (i.eq.j) then - Pmat(i,j)=1.0d0 - else - Pmat(i,j)=0.0d0 - endif - do k=1,nbond - Pmat(i,j)=Pmat(i,j)-Tmat(i,k)*Bmat(j,k) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Pmat" - call MATOUT(dimen,dimen,MAXRES6,MAXRES6,Pmat) - endif - do i=1,dimen - Td(i)=0.0d0 - ind=0 - do k=nnt,nct-1 - ind=ind+1 - Td(i)=Td(i)+vbl*Tmat(i,ind) - enddo - do k=nnt,nct - if (itype(k).ne.10 .and. itype(i).ne.ntyp1) then - ind=ind+1 - Td(i)=Td(i)+vbldsc0(1,itype(k))*Tmat(i,ind) - endif - enddo - enddo - if (lprn1) then - write (iout,*) "Vector Td" - do i=1,dimen - write (iout,'(i5,f10.5)') i,Td(i) - enddo - endif - call stochastic_force(stochforcvec) - if (lprn) then - write (iout,*) "stochforcvec" - do i=1,dimen - write (iout,*) i,stochforcvec(i) - enddo - endif - do j=1,3 - zapas(j)=-gcart(j,0)+stochforcvec(j) - d_t_work(j)=d_t(j,0) - dC_work(j)=dC_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - zapas(ind)=-gcart(j,i)+stochforcvec(ind) - dC_work(ind)=dC_old(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - ind=ind+1 - zapas(ind)=-gxcart(j,i)+stochforcvec(ind) - dC_work(ind)=dC_old(j,i+nres) - enddo - endif - enddo - - if (lprn) then - write (iout,*) "Initial d_t_work" - do i=1,dimen - write (iout,*) i,d_t_work(i) - enddo - endif - - do i=1,dimen - d_t_work(i)=0.0d0 - do j=1,dimen - d_t_work(i)=d_t_work(i)+fricmat(i,j)*zapas(j) - enddo - enddo - - do i=1,dimen - zapas(i)=Td(i) - do j=1,dimen - zapas(i)=zapas(i)+Pmat(i,j)*(dC_work(j)+d_t_work(j)*d_time) - enddo - enddo - if (lprn1) then - write (iout,*) "Final d_t_work and zapas" - do i=1,dimen - write (iout,*) i,d_t_work(i),zapas(i) - enddo - endif - - do j=1,3 - d_t(j,0)=d_t_work(j) - dc(j,0)=zapas(j) - dc_work(j)=dc(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(i) - dc(j,i)=zapas(ind+j) - dc_work(ind+j)=dc(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - d_t(j,i+nres)=d_t_work(ind+j) - dc(j,i+nres)=zapas(ind+j) - dc_work(ind+j)=dc(j,i+nres) - enddo - ind=ind+3 - enddo - if (lprn) then - call chainbuild_cart - write (iout,*) "Before correction for rotational lengthening" - write (iout,*) "New coordinates", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)-vbl - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),xx - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - ind=ind+1 - xx=vbld(i+nres)-vbldsc0(1,itype(i)) - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),xx - endif - enddo - endif -c Second correction (rotational lengthening) -c do iter=1,maxiter - diffmax=0.0d0 - ind=0 - do i=nnt,nct-1 - ind=ind+1 - blen2 = scalar(dc(1,i),dc(1,i)) - ppvec(ind)=2*vbl**2-blen2 - diffbond=dabs(vbl-dsqrt(blen2)) - if (diffbond.gt.diffmax) diffmax=diffbond - if (ppvec(ind).gt.0.0d0) then - ppvec(ind)=dsqrt(ppvec(ind)) - else - ppvec(ind)=0.0d0 - endif - if (lprn) then - write (iout,'(i5,3f10.5)') ind,diffbond,ppvec(ind) - endif - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - ind=ind+1 - blen2 = scalar(dc(1,i+nres),dc(1,i+nres)) - ppvec(ind)=2*vbldsc0(1,itype(i))**2-blen2 - diffbond=dabs(vbldsc0(1,itype(i))-dsqrt(blen2)) - if (diffbond.gt.diffmax) diffmax=diffbond - if (ppvec(ind).gt.0.0d0) then - ppvec(ind)=dsqrt(ppvec(ind)) - else - ppvec(ind)=0.0d0 - endif - if (lprn) then - write (iout,'(i5,3f10.5)') ind,diffbond,ppvec(ind) - endif - endif - enddo - if (lprn) write (iout,*) "iter",iter," diffmax",diffmax - if (diffmax.lt.difftol) goto 10 - do i=1,dimen - Td(i)=0.0d0 - do j=1,nbond - Td(i)=Td(i)+ppvec(j)*Tmat(i,j) - enddo - enddo - do i=1,dimen - zapas(i)=Td(i) - do j=1,dimen - zapas(i)=zapas(i)+Pmat(i,j)*dc_work(j) - enddo - enddo - do j=1,3 - dc(j,0)=zapas(j) - dc_work(j)=zapas(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=zapas(ind+j) - dc_work(ind+j)=zapas(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - dc(j,i+nres)=zapas(ind+j) - dc_work(ind+j)=zapas(ind+j) - enddo - ind=ind+3 - endif - enddo -c Building the chain from the newly calculated coordinates - call chainbuild_cart - if(ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,'(a)') "Potential forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(-gcart(j,i),j=1,3), - & (-gxcart(j,i),j=1,3) - enddo - write (iout,'(a)') "Stochastic forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(stochforc(j,i),j=1,3), - & (stochforc(j,i+nres),j=1,3) - enddo - write (iout,'(a)') "Velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - if (lprn) then - write (iout,*) "After correction for rotational lengthening" - write (iout,*) "New coordinates", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)-vbl - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),xx - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - ind=ind+1 - xx=vbld(i+nres)-vbldsc0(1,itype(i)) - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),xx - endif - enddo - endif -c ENDDO -c write (iout,*) "Too many attempts at correcting the bonds" -c stop - 10 continue -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) - potE=potEcomp(0)-potEcomp(20) - call cartgrad - totT=totT+d_time -c Calculate the kinetic and total energy and the kinetic temperature - call kinetic(EK) -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - totE=EK+potE - kinetic_T=2.0d0/(dimen*Rb)*EK - return - end -c------------------------------------------------------------------------------- - subroutine velverlet_step(itime) -c------------------------------------------------------------------------------- -c Perform a single velocity Verlet step; the time step can be rescaled if -c increments in accelerations exceed the threshold -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror,ierrcode -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.MUCA' - double precision vcm(3),incr(3) - double precision cm(3),L(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /20/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale -c - scale=.true. - icount_scale=0 - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then - call stochastic_force(stochforcvec) - endif - itime_scal=0 - do while (scale) - icount_scale=icount_scale+1 - if (icount_scale.gt.maxcount_scale) then - write (iout,*) - & "ERROR: too many attempts at scaling down the time step. ", - & "amax=",amax,"epdrift=",epdrift, - & "damax=",damax,"edriftmax=",edriftmax, - & "d_time=",d_time - call flush(iout) -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE) -#endif - stop - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then - call sd_verlet1 - else if (lang.eq.3) then - call sd_verlet1_ciccotti - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,*) "dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) - potE=potEcomp(0)-potEcomp(20) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - call predict_edrift(epdrift) - if (amax.gt.damax .or. epdrift.gt.edriftmax) then -c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step - scale=.true. - ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax)) - & /dlog(2.0d0)+1 - itime_scal=itime_scal+ifac_time -c fac_time=dmin1(damax/amax,0.5d0) - fac_time=0.5d0**ifac_time - d_time=d_time*fac_time - if (lang.eq.2 .or. lang.eq.3) then -c write (iout,*) "Calling sd_verlet_setup: 1" -c Rescale the stochastic forces and recalculate or restore -c the matrices of tinker integrator - if (itime_scal.gt.maxflag_stoch) then - if (large) write (iout,'(a,i5,a)') - & "Calculate matrices for stochastic step;", - & " itime_scal ",itime_scal - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - write (iout,'(2a,i3,a,i3,1h.)') - & "Warning: cannot store matrices for stochastic", - & " integration because the index",itime_scal, - & " is greater than",maxflag_stoch - write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct", - & " integration Langevin algorithm for better efficiency." - else if (flag_stoch(itime_scal)) then - if (large) write (iout,'(a,i5,a,l1)') - & "Restore matrices for stochastic step; itime_scal ", - & itime_scal," flag ",flag_stoch(itime_scal) -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,itime_scal) - afric_mat(i,j)=afric0_mat(i,j,itime_scal) - vfric_mat(i,j)=vfric0_mat(i,j,itime_scal) - prand_mat(i,j)=prand0_mat(i,j,itime_scal) - vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal) - vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal) - enddo - enddo -#endif - else - if (large) write (iout,'(2a,i5,a,l1)') - & "Calculate & store matrices for stochastic step;", - & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal) - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - flag_stoch(ifac_time)=.true. -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,itime_scal)=pfric_mat(i,j) - afric0_mat(i,j,itime_scal)=afric_mat(i,j) - vfric0_mat(i,j,itime_scal)=vfric_mat(i,j) - prand0_mat(i,j,itime_scal)=prand_mat(i,j) - vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j) - vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j) - enddo - enddo -#endif - endif - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - stochforcvec(i)=fac_time*stochforcvec(i) - enddo - else if (lang.eq.1) then -c Rescale the accelerations due to stochastic forces - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - d_as_work(i)=d_as_work(i)*fac_time - enddo - endif - if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)') - & "itime",itime," Timestep scaled down to ", - & d_time," ifac_time",ifac_time," itime_scal",itime_scal - else -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then - call sd_verlet2 - else if (lang.eq.3) then - call sd_verlet2_ciccotti - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 - totT=totT+d_time - if (d_time.ne.d_time0) then - d_time=d_time0 - if (lang.eq.2 .or. lang.eq.3) then - if (large) write (iout,'(a)') - & "Restore original matrices for stochastic step" -c write (iout,*) "Calling sd_verlet_setup: 2" -c Restore the matrices of tinker integrator if the time step has been restored -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,0) - afric_mat(i,j)=afric0_mat(i,j,0) - vfric_mat(i,j)=vfric0_mat(i,j,0) - prand_mat(i,j)=prand0_mat(i,j,0) - vrand_mat1(i,j)=vrand0_mat1(i,j,0) - vrand_mat2(i,j)=vrand0_mat2(i,j,0) - enddo - enddo -#endif - endif - endif - scale=.false. - endif - enddo -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c diagnostics -c call kinetic1(EK1) -c write (iout,*) "step",itime," EK",EK," EK1",EK1 -c end diagnostics -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen*Rb)*EK -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c------------------------------------------------------------------------------- - subroutine RESPA_step(itime) -c------------------------------------------------------------------------------- -c Perform a single RESPA step. -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision energia_short(0:n_ene), - & energia_long(0:n_ene) - double precision cm(3),L(3),vcm(3),incr(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /10/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - common /cipiszcze/ itt - itt=itime - large=(itime.gt.14600 .and. itime.lt.14700) - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***************** RESPA itime",itime - write (iout,*) "Cartesian and internal coordinates: step 0" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 0" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c -c Perform the initial RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA ini" - call RESPA_vel - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the short-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_short(energia_short) - if (large) write (iout,*) "energia_short",energia_short(0) - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - d_time0=d_time -c Split the time step - d_time=d_time/ntime_split -c Perform the short-range RESPSA steps (velocity Verlet increments of -c positions and velocities using short-range forces) -c write (iout,*) "*********************** RESPA split" - do itsplit=1,ntime_split - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then - call stochastic_force(stochforcvec) - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then - call sd_verlet1 - else if (lang.eq.3) then - call sd_verlet1_ciccotti - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) -c call cartprint - call intout - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal_short(energia_short) - if (large) write (iout,*) "energia_short",energia_short(0) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then - call sd_verlet2 - else if (lang.eq.3) then - call sd_verlet2_ciccotti - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - enddo -c Restore the time step - d_time=d_time0 -c Compute long-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - if (large) write (iout,*) "energia_long",energia_long(0) - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Compute accelerations from long-range forces - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 2" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the final RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA fin" - call RESPA_vel -c Compute the complete potential energy - do i=0,n_ene - potEcomp(i)=energia_short(i)+energia_long(i) - enddo - potE=potEcomp(0)-potEcomp(20) -c potE=energia_short(0)+energia_long(0) - totT=totT+d_time -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen*Rb)*EK -c Backup the coordinates, velocities, and accelerations - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c--------------------------------------------------------------------- - subroutine RESPA_vel -c First and last RESPA step (incrementing velocities using long-range -c forces). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine verlet1 -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2 - - do j=1,3 - adt=d_a_old(j,0)*d_time - adt2=0.5d0*adt - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+adt2 - d_t(j,0)=d_t_old(j,0)+adt - enddo - do i=nnt,nct-1 - do j=1,3 - adt=d_a_old(j,i)*d_time - adt2=0.5d0*adt - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+adt2 - d_t(j,i)=d_t_old(j,i)+adt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - adt=d_a_old(j,inres)*d_time - adt2=0.5d0*adt - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+adt2 - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine verlet2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine sddir_precalc -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute friction and stochastic forces -c - call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c -#ifdef OLD_GINV - do i=1,dimen - d_af_work(i)=0.0d0 - d_as_work(i)=0.0d0 - do j=1,dimen - d_af_work(i)=d_af_work(i)+Ginv(i,j)*fric_work(j) - d_as_work(i)=d_as_work(i)+Ginv(i,j)*stochforcvec(j) - enddo - enddo -#else - call ginv_mult(fric_work, d_af_work) - call ginv_mult(stochforcvec, d_as_work) -#endif - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet1 -c Applying velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. - double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3) - double precision adt,adt2 -c -c Add the contribution from BOTH friction and stochastic force to the -c coordinates, but ONLY the contribution from the friction forces to velocities -c - do j=1,3 - adt=(d_a_old(j,0)+d_af_work(j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt - d_t(j,0)=d_t_old(j,0)+adt - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt - d_t(j,i)=d_t_old(j,i)+adt - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6) - double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/ -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. -c The correlation coefficients are calculated at low-friction limit. -c Also, friction forces are now not calculated with new velocities. - -c call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c -#ifdef OLD_GINV - do i=1,dimen -c d_af_work(i)=0.0d0 - d_as_work1(i)=0.0d0 - do j=1,dimen -c d_af_work(i)=d_af_work(i)+Ginv(i,j)*fric_work(j) - d_as_work1(i)=d_as_work1(i)+Ginv(i,j)*stochforcvec(j) - enddo - enddo -#else - call ginv_mult(stochforcvec, d_as_work1) -#endif - -c -c Update velocities -c - do j=1,3 - d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j)) - & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j)) - & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) - & +d_af_work(ind+j))+sin60*d_as_work(ind+j) - & +cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine max_accel -c -c Find the maximum difference in the accelerations of the the sites -c at the beginning and the end of the time step. -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision aux(3),accel(3) - do j=1,3 - aux(j)=d_a(j,0)-d_a_old(j,0) - enddo - amax=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) - if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - enddo - endif -c Side chains - do j=1,3 - accel(j)=aux(j) - enddo - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) - enddo - endif - do j=1,3 - if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - enddo - do j=1,3 - aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i) - enddo - enddo - return - end -c--------------------------------------------------------------------- - subroutine predict_edrift(epdrift) -c -c Predict the drift of the potential energy -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MUCA' - double precision epdrift,epdriftij -c Drift of the potential energy - epdrift=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "back",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif -c Side chains - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - epdriftij= - & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "side",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif - enddo - epdrift=0.5d0*epdrift*d_time*d_time -c write (iout,*) "epdrift",epdrift - return - end -c----------------------------------------------------------------------- - subroutine verlet_bath -c -c Coupling to the thermostat by using the Berendsen algorithm -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision T_half,fact -c - T_half=2.0d0/(dimen*Rb)*EK - fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0)) -c write(iout,*) "T_half", T_half -c write(iout,*) "EK", EK -c write(iout,*) "fact", fact - do j=1,3 - d_t(j,0)=fact*d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=fact*d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=fact*d_t(j,inres) - enddo - endif - enddo - return - end -c--------------------------------------------------------- - subroutine init_MD -c Set up the initial conditions of a MD simulation - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - include 'COMMON.SETUP' - character*16 form -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.REMD' - real*8 energia_long(0:n_ene), - & energia_short(0:n_ene),vcm(3),incr(3) - double precision cm(3),L(3),xv,sigv,lowb,highb - double precision varia(maxvar) - character*256 qstr - integer ilen - external ilen - character*50 tytul - logical file_exist - common /gucio/ cm - d_time0=d_time -c write(iout,*) "d_time", d_time -c Compute the standard deviations of stochastic forces for Langevin dynamics -c if the friction coefficients do not depend on surface area - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - if (itype(i).ne.ntyp1) - & stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(iabs(itype(i)))) - enddo - endif -c Open the pdb file for snapshotshots -#ifdef MPI - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".pdb") - open(ipdb, - & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".pdb") - else -#ifdef NOXDR - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".x") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".x" -#else - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".cx") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".cx" -#endif - endif -#else - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb") - open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb") - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx") - cartname=prefix(:ilen(prefix))//"_MD.cx" - endif -#endif - if (usampl) then - write (qstr,'(256(1h ))') - ipos=1 - do i=1,nfrag - iq = qinfrag(i,iset)*10 - iw = wfrag(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo - do i=1,npair - iq = qinpair(i,iset)*10 - iw = wpair(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo -c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb' -#ifdef NOXDR -c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x' -#else -c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx' -#endif -c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' - endif - icg=1 - if (rest) then - if (restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) - write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) - write (*,*) me," After broadcast: file_exist",file_exist -c inquire(file=mremd_rst_name,exist=file_exist) - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state read by master and distributed" - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_' - & //liczba(:ilen(liczba))//'.rst') - inquire(file=rest2name,exist=file_exist) - endif - if(file_exist) then - if(.not.restart1file) then - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state will be read from file ", - & rest2name(:ilen(rest2name)) - call readrst - endif - call rescale_weights(t_bath) - else - if(me.eq.king.or..not.out1file)then - if (restart1file) then - write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), - & " does not exist" - else - write(iout,*) "File ",rest2name(:ilen(rest2name)), - & " does not exist" - endif - write(iout,*) "Initial velocities randomly generated" - endif - call random_vel - totT=0.0d0 - endif - else -c Generate initial velocities - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial velocities randomly generated" - call random_vel - totT=0.0d0 - endif -c rest2name = prefix(:ilen(prefix))//'.rst' - if(me.eq.king.or..not.out1file)then - write(iout,*) "Initial backbone velocities" - do i=nnt,nct-1 - write(iout,*) (d_t(j,i),j=1,3) - enddo - write(iout,*) "Initial side-chain velocities" - do i=nnt,nct - write(iout,*) (d_t(j,i+nres),j=1,3) - enddo -c Zeroing the total angular momentum of the system - write(iout,*) "Calling the zero-angular - & momentum subroutine" - endif - call inertia_tensor -c Getting the potential energy and forces and velocities and accelerations - call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo -c Removing the velocity of the center of mass - call vcm_vel(vcm) - if(me.eq.king.or..not.out1file)then - write (iout,*) "vcm right after adjustment:" - write (iout,*) (vcm(j),j=1,3) - endif - if (.not.rest) then - call chainbuild - if(iranconf.ne.0) then - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SC_move',nft_sc,etot - endif - - if(dccart)then - print *, 'Calling MINIM_DC' - call minim_dc(etot,iretcode,nfun) - else - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - endif - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun - endif - endif - call chainbuild_cart - call kinetic(EK) - if (tbf) then - call verlet_bath(EK) - endif - kinetic_T=2.0d0/(dimen*Rb)*EK - if(me.eq.king.or..not.out1file)then - call cartprint - call intout - endif - call zerograd - call etotal(potEcomp) - potE=potEcomp(0) - call cartgrad - call lagrangian - call max_accel - if (amax*d_time .gt. dvmax) d_time=d_time*dvmax/amax - if(me.eq.king.or..not.out1file)then - write(iout,*) "Potential energy and its components" - write(iout,*) (potEcomp(i),i=0,n_ene) - endif - potE=potEcomp(0)-potEcomp(20) - totE=EK+potE - itime=0 - if (ntwe.ne.0) call statout(itime) - if(me.eq.king.or..not.out1file) - & write (iout,*) "Initial:", - & " Kinetic energy",EK," potential energy",potE, - & " total energy",totE," maximum acceleration ", - & amax - if (large) then - write (iout,*) "Initial coordinates" - do i=1,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3), - & (c(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo -c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3) - enddo - if (RESPA) then -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - if (large) write (iout,*) "energia_long",energia_long(0) - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c call etotal_short(energia_short) -c write (iout,*) "energia_long",energia_long(0), -c & " energia_short",energia_short(0), -c & " total",energia_long(0)+energia_short(0) - endif - return - end -c----------------------------------------------------------- - subroutine random_vel - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb -c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m -c First generate velocities in the eigenspace of the G matrix -c write (iout,*) "Calling random_vel" - xv=0.0d0 - do i=1,dimen - sigv=dsqrt((Rb*t_bath)/geigen(i)) - lowb=-5*sigv - highb=5*sigv - d_t_work_new(i)=anorm_distr(xv,sigv,lowb,highb) - enddo -c Ek1=0.0d0 -c do i=1,dimen -c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(i)**2 -c enddo -c Transform velocities to UNRES coordinate space - do i=1,dimen - d_t_work(i)=0.0d0 - do j=1,dimen - d_t_work(i)=d_t_work(i)+Gvec(i,j)*d_t_work_new(j) - enddo - enddo -c Transfer to the d_t vector - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - if (itype(i).ne.ntyp1 .and. itype(i+1).ne.ntyp1) then - d_t(j,i)=d_t_work(ind) - else - d_t(j,i)=0.0d0 - endif - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - ind=ind+1 - d_t(j,i+nres)=d_t_work(ind) - enddo - endif - enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen*Rb)*EK,2.0d0/(dimen*Rb)*EK1 - return - end -c----------------------------------------------------------- - subroutine sd_verlet_p_setup -c Sets up the parameters of stochastic Verlet algorithm - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0 * d_time * d_time - prand_vec(i) = 0.0d0 - vrand_vec1(i) = 0.0d0 - vrand_vec2(i) = 0.0d0 -c -c Analytical expressions when friction coefficient is large -c - else - if (gdt .ge. gdt_radius) then - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = (1.0d0-egdt) / fricgam(i) - afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i) - pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt - vterm = 1.0d0 - egdt**2 - rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm) -c -c Use series expansions when friction coefficient is small -c - else - gdt2 = gdt * gdt - gdt3 = gdt * gdt2 - gdt4 = gdt2 * gdt2 - gdt5 = gdt2 * gdt3 - gdt6 = gdt3 * gdt3 - gdt7 = gdt3 * gdt4 - gdt8 = gdt4 * gdt4 - gdt9 = gdt4 * gdt5 - afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0 - & - gdt5/120.0d0 + gdt6/720.0d0 - & - gdt7/5040.0d0 + gdt8/40320.0d0 - & - gdt9/362880.0d0) / fricgam(i)**2 - vfric_vec(i) = d_time - fricgam(i)*afric_vec(i) - pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i) - pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0 - & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0 - & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0 - & + 127.0d0*gdt9/90720.0d0 - vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0 - & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0 - & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0 - & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0 - rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0 - & - 17.0d0*gdt2/1280.0d0 - & + 17.0d0*gdt3/6144.0d0 - & + 40967.0d0*gdt4/34406400.0d0 - & - 57203.0d0*gdt5/275251200.0d0 - & - 1429487.0d0*gdt6/13212057600.0d0) - end if -c -c Compute the scaling factors of random terms for the nonzero friction case -c - ktm = 0.5d0*d_time/fricgam(i) - psig = dsqrt(ktm*pterm) / fricgam(i) - vsig = dsqrt(ktm*vterm) - rhoc = dsqrt(1.0d0 - rho*rho) - prand_vec(i) = psig - vrand_vec1(i) = vsig * rho - vrand_vec2(i) = vsig * rhoc - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c -#ifndef LANG0 - call eigtransf(dimen,maxres6,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres6,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres6,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres6,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres6,mt3,mt1,vrand_vec1,vrand_mat1) - call eigtransf(dimen,maxres6,mt3,mt1,vrand_vec2,vrand_mat2) -#endif -c call eigtransf1(dimen,maxres6,mt3mt2,pfric_vec,pfric_mat) -c call eigtransf1(dimen,maxres6,mt3mt2,vfric_vec,vfric_mat) -c call eigtransf1(dimen,maxres6,mt3mt2,afric_vec,afric_mat) -c call eigtransf1(dimen,maxres6,mt3mt1,prand_vec,prand_mat) -c call eigtransf1(dimen,maxres6,mt3mt1,vrand_vec1,vrand_mat1) -c call eigtransf1(dimen,maxres6,mt3mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine eigtransf1(n,ndim,ab,d,c) - implicit none - integer n,ndim - double precision ab(ndim,ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+ab(k,j,i)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine eigtransf(n,ndim,a,b,d,c) - implicit none - integer n,ndim - double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine sd_verlet1 -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) - -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) - ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+ - & vrand_mat2(i,j)*stochforcvecV(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c----------------------------------------------------------- - subroutine sd_verlet_ciccotti_setup -c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's -c version - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - write (iout,*) "i",i," fricgam",fricgam(i) - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Analytical expressions when friction coefficient is large -c - else - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = dexp(-0.5d0*gdt)*d_time - afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Compute the scaling factors of random terms for the nonzero friction case -c -c ktm = 0.5d0*d_time/fricgam(i) -c psig = dsqrt(ktm*pterm) / fricgam(i) -c vsig = dsqrt(ktm*vterm) -c prand_vec(i) = psig*afric_vec(i) -c vrand_vec2(i) = vsig*vfric_vec(i) - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c - call eigtransf(dimen,maxres6,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres6,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres6,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres6,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres6,mt3,mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine sd_verlet1_ciccotti -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo - -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2_ciccotti -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) -c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) - ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end diff --git a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F b/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F index b65a7e9..4346d00 100644 --- a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F +++ b/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F @@ -417,7 +417,7 @@ c Calculate energy and forces t_etotal=t_etotal+tcpu()-tt0 #endif #endif - potE=potEcomp(0)-potEcomp(20) + potE=potEcomp(0)-potEcomp(27) call cartgrad c Get the new accelerations call lagrangian @@ -965,7 +965,7 @@ c Compute the complete potential energy do i=0,n_ene potEcomp(i)=energia_short(i)+energia_long(i) enddo - potE=potEcomp(0)-potEcomp(20) + potE=potEcomp(0)-potEcomp(27) if (ntwe.ne.0) then if (large.and. mod(itime,ntwe).eq.0) then call enerprint(potEcomp) @@ -1826,6 +1826,7 @@ C 8/22/17 AL Minimize initial structure #endif #endif potE=potEcomp(0) +c write (iout,*) "PotE-homology",potE-potEcomp(27) call cartgrad call lagrangian call max_accel @@ -1838,9 +1839,10 @@ C 8/22/17 AL Minimize initial structure if(me.eq.king.or..not.out1file)then write(iout,*) "Potential energy and its components" call enerprint(potEcomp) - write(iout,*) (potEcomp(i),i=0,n_ene) +c write(iout,*) (potEcomp(i),i=0,n_ene) endif - potE=potEcomp(0)-potEcomp(20) + potE=potEcomp(0)-potEcomp(27) +c write (iout,*) "PotE-homology",potE totE=EK+potE itime=0 if (ntwe.ne.0) call statout(itime) diff --git a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe b/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe deleted file mode 100644 index db8058f..0000000 --- a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe +++ /dev/null @@ -1,2327 +0,0 @@ - subroutine MD -c------------------------------------------------ -c The driver for molecular dynamics subroutines -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision cm(3),L(3),vcm(3) -#ifdef VOUT - double precision v_work(maxres6),v_transf(maxres6) -#endif - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -c -#ifdef MPI - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_" - & //liczba(:ilen(liczba))//'.rst') -#else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst') -#endif - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - do itime=1,n_timestep - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) - write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) -#ifdef VOUT - do j=1,3 - v_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i+nres) - enddo - endif - enddo - - write (66,'(80f10.5)') - & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres) - do i=1,ind - v_transf(i)=0.0d0 - do j=1,ind - v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j) - enddo - v_transf(i)= v_transf(i)*dsqrt(geigen(i)) - enddo - write (67,'(80f10.5)') (v_transf(i),i=1,ind) -#endif - endif - if (mod(itime,ntwx).eq.0) then - write (tytul,'("time",f8.2)') totT - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - close(irest2) - rstcount=0 - endif - enddo -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - return - end -c------------------------------------------------------------------------------- - subroutine velverlet_step(itime) -c------------------------------------------------------------------------------- -c Perform a single velocity Verlet step; the time step can be rescaled if -c increments in accelerations exceed the threshold -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror,ierrcode -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.MUCA' - double precision vcm(3),incr(3) - double precision cm(3),L(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /20/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale -c - scale=.true. - icount_scale=0 - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - itime_scal=0 - do while (scale) - icount_scale=icount_scale+1 - if (icount_scale.gt.maxcount_scale) then - write (iout,*) - & "ERROR: too many attempts at scaling down the time step. ", - & "amax=",amax,"epdrift=",epdrift, - & "damax=",damax,"edriftmax=",edriftmax, - & "d_time=",d_time - call flush(iout) -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE) -#endif - stop - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,*) "dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) - potE=potEcomp(0)-potEcomp(20) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/(itime_scal+1)**2 - call predict_edrift(epdrift) - if (amax/(itime_scal+1).gt.damax .or. epdrift.gt.edriftmax) then -c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step - scale=.true. - ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax)) - & /dlog(2.0d0)+1 - itime_scal=itime_scal+ifac_time -c fac_time=dmin1(damax/amax,0.5d0) - fac_time=0.5d0**ifac_time - d_time=d_time*fac_time - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 -c write (iout,*) "Calling sd_verlet_setup: 1" -c Rescale the stochastic forces and recalculate or restore -c the matrices of tinker integrator - if (itime_scal.gt.maxflag_stoch) then - if (large) write (iout,'(a,i5,a)') - & "Calculate matrices for stochastic step;", - & " itime_scal ",itime_scal - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - write (iout,'(2a,i3,a,i3,1h.)') - & "Warning: cannot store matrices for stochastic", - & " integration because the index",itime_scal, - & " is greater than",maxflag_stoch - write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct", - & " integration Langevin algorithm for better efficiency." - else if (flag_stoch(itime_scal)) then - if (large) write (iout,'(a,i5,a,l1)') - & "Restore matrices for stochastic step; itime_scal ", - & itime_scal," flag ",flag_stoch(itime_scal) - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,itime_scal) - afric_mat(i,j)=afric0_mat(i,j,itime_scal) - vfric_mat(i,j)=vfric0_mat(i,j,itime_scal) - prand_mat(i,j)=prand0_mat(i,j,itime_scal) - vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal) - vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal) - enddo - enddo - else - if (large) write (iout,'(2a,i5,a,l1)') - & "Calculate & store matrices for stochastic step;", - & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal) - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - flag_stoch(ifac_time)=.true. - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,itime_scal)=pfric_mat(i,j) - afric0_mat(i,j,itime_scal)=afric_mat(i,j) - vfric0_mat(i,j,itime_scal)=vfric_mat(i,j) - prand0_mat(i,j,itime_scal)=prand_mat(i,j) - vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j) - vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j) - enddo - enddo - endif - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - stochforcvec(i)=fac_time*stochforcvec(i) - enddo -#endif - else if (lang.eq.1) then -c Rescale the accelerations due to stochastic forces - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - d_as_work(i)=d_as_work(i)*fac_time - enddo - endif - if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)') - & "itime",itime," Timestep scaled down to ", - & d_time," ifac_time",ifac_time," itime_scal",itime_scal - else -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 - totT=totT+d_time - if (d_time.ne.d_time0) then - d_time=d_time0 -#ifndef LANG0 - if (lang.eq.2 .or. lang.eq.3) then - if (large) write (iout,'(a)') - & "Restore original matrices for stochastic step" -c write (iout,*) "Calling sd_verlet_setup: 2" -c Restore the matrices of tinker integrator if the time step has been restored - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,0) - afric_mat(i,j)=afric0_mat(i,j,0) - vfric_mat(i,j)=vfric0_mat(i,j,0) - prand_mat(i,j)=prand0_mat(i,j,0) - vrand_mat1(i,j)=vrand0_mat1(i,j,0) - vrand_mat2(i,j)=vrand0_mat2(i,j,0) - enddo - enddo - endif -#endif - endif - scale=.false. - endif - enddo -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c diagnostics -c call kinetic1(EK1) -c write (iout,*) "step",itime," EK",EK," EK1",EK1 -c end diagnostics -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c------------------------------------------------------------------------------- - subroutine RESPA_step(itime) -c------------------------------------------------------------------------------- -c Perform a single RESPA step. -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision energia_short(0:n_ene), - & energia_long(0:n_ene) - double precision cm(3),L(3),vcm(3),incr(3) - double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2), - & d_a_old0(3,0:maxres2) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /10/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - common /cipiszcze/ itt - itt=itime - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***************** RESPA itime",itime - write (iout,*) "Cartesian and internal coordinates: step 0" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 0" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c -c Perform the initial RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA ini" - call RESPA_vel - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the short-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_short(energia_short) - call cartgrad - call lagrangian - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo -c 6/30/08 A-MTS: attempt at increasing the split number - do i=0,2*nres - do j=1,3 - dc_old0(j,i)=dc_old(j,i) - d_t_old0(j,i)=d_t_old(j,i) - d_a_old0(j,i)=d_a_old(j,i) - enddo - enddo - if (ntime_split.gt.ntime_split0) ntime_split=ntime_split/2 - if (ntime_split.lt.ntime_split0) ntime_split=ntime_split0 -c - scale=.true. - d_time0=d_time - do while (scale) - - scale=.false. -c write (iout,*) "itime",itime," ntime_split",ntime_split -c Split the time step - d_time=d_time0/ntime_split -c Perform the short-range RESPA steps (velocity Verlet increments of -c positions and velocities using short-range forces) -c write (iout,*) "*********************** RESPA split" - do itsplit=1,ntime_split - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***** ITSPLIT",itsplit - write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) -c call cartprint - call intout - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal_short(energia_short) - call cartgrad -c Get the new accelerations - call lagrangian - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*)"energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -c 6/30/08 A-MTS -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/ntime_split**2 - call predict_edrift(epdrift) - if (ntwe.gt.0 .and. large .and. mod(itime,ntwe).eq.0) - & write (iout,*) "amax",amax," damax",damax, - & " epdrift",epdrift," epdriftmax",epdriftmax -c Exit loop and try with increased split number if the change of -c acceleration is too big - if (amax.gt.damax .or. epdrift.gt.edriftmax) then - if (ntime_split.lt.maxtime_split) then - scale=.true. - ntime_split=ntime_split*2 - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc_old0(j,i) - d_t_old(j,i)=d_t_old0(j,i) - d_a_old(j,i)=d_a_old0(j,i) - enddo - enddo - write (iout,*) "acceleration/energy drift too large",amax, - & epdrift," split increased to ",ntime_split," itime",itime, - & " itsplit",itsplit - exit - else - write (iout,*) - & "Uh-hu. Bumpy landscape. Maximum splitting number", - & maxtime_split, - & " already reached!!! Trying to carry on!" - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - enddo - - enddo ! while scale - -c Restore the time step - d_time=d_time0 -c Compute long-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Compute accelerations from long-range forces - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Cartesian and internal coordinates: step 2" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the final RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA fin" - call RESPA_vel -c Compute the complete potential energy - do i=0,n_ene - potEcomp(i)=energia_short(i)+energia_long(i) - enddo - potE=potEcomp(0)-potEcomp(20) -c potE=energia_short(0)+energia_long(0) - totT=totT+d_time -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c--------------------------------------------------------------------- - subroutine RESPA_vel -c First and last RESPA step (incrementing velocities using long-range -c forces). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine verlet1 -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2 - -#ifdef DEBUG - write (iout,*) "VELVERLET1 START: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - do j=1,3 - adt=d_a_old(j,0)*d_time - adt2=0.5d0*adt - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+adt2 - d_t(j,0)=d_t_old(j,0)+adt - enddo - do i=nnt,nct-1 - do j=1,3 - adt=d_a_old(j,i)*d_time - adt2=0.5d0*adt - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+adt2 - d_t(j,i)=d_t_old(j,i)+adt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=d_a_old(j,inres)*d_time - adt2=0.5d0*adt - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+adt2 - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - endif - enddo -#ifdef DEBUG - write (iout,*) "VELVERLET1 END: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - return - end -c--------------------------------------------------------------------- - subroutine verlet2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine sddir_precalc -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute friction and stochastic forces -c - call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(fric_work, d_af_work) - call ginv_mult(stochforcvec, d_as_work) - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet1 -c Applying velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. - double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3) - double precision adt,adt2 -c -c Add the contribution from BOTH friction and stochastic force to the -c coordinates, but ONLY the contribution from the friction forces to velocities -c - do j=1,3 - adt=(d_a_old(j,0)+d_af_work(j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt - d_t(j,0)=d_t_old(j,0)+adt - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt - d_t(j,i)=d_t_old(j,i)+adt - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6) - double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/ -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. -c The correlation coefficients are calculated at low-friction limit. -c Also, friction forces are now not calculated with new velocities. - -c call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(stochforcvec, d_as_work1) - -c -c Update velocities -c - do j=1,3 - d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j)) - & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j)) - & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) - & +d_af_work(ind+j))+sin60*d_as_work(ind+j) - & +cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine max_accel -c -c Find the maximum difference in the accelerations of the the sites -c at the beginning and the end of the time step. -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision aux(3),accel(3),accel_old(3),dacc - do j=1,3 -c aux(j)=d_a(j,0)-d_a_old(j,0) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - amax=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then -c 7/3/08 changed to asymmetric difference - do j=1,3 -c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) - accel_old(j)=accel_old(j)+0.5d0*d_a_old(j,i) - accel(j)=accel(j)+0.5d0*d_a(j,i) -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - endif - enddo -c Side chains - do j=1,3 -c accel(j)=aux(j) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - if (nnt.eq.2) then - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,1) - accel(j)=accel(j)+d_a(j,1) - enddo - endif - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 -c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) - accel_old(j)=accel_old(j)+d_a_old(j,i+nres) - accel(j)=accel(j)+d_a(j,i+nres) - enddo - endif - do j=1,3 -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,i) - accel(j)=accel(j)+d_a(j,i) -c aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i) - enddo - enddo - return - end -c--------------------------------------------------------------------- - subroutine predict_edrift(epdrift) -c -c Predict the drift of the potential energy -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MUCA' - double precision epdrift,epdriftij -c Drift of the potential energy - epdrift=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "back",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif -c Side chains - if (itype(i).ne.10) then - do j=1,3 - epdriftij= - & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "side",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif - enddo - epdrift=0.5d0*epdrift*d_time*d_time -c write (iout,*) "epdrift",epdrift - return - end -c----------------------------------------------------------------------- - subroutine verlet_bath -c -c Coupling to the thermostat by using the Berendsen algorithm -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision T_half,fact -c - T_half=2.0d0/(dimen3*Rb)*EK - fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0)) -c write(iout,*) "T_half", T_half -c write(iout,*) "EK", EK -c write(iout,*) "fact", fact - do j=1,3 - d_t(j,0)=fact*d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=fact*d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=fact*d_t(j,inres) - enddo - endif - enddo - return - end -c--------------------------------------------------------- - subroutine init_MD -c Set up the initial conditions of a MD simulation - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - character*16 form - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.REMD' - real*8 energia_long(0:n_ene), - & energia_short(0:n_ene),vcm(3),incr(3) - double precision cm(3),L(3),xv,sigv,lowb,highb - double precision varia(maxvar) - character*256 qstr - integer ilen - external ilen - character*50 tytul - logical file_exist - common /gucio/ cm - d_time0=d_time -c write(iout,*) "d_time", d_time -c Compute the standard deviations of stochastic forces for Langevin dynamics -c if the friction coefficients do not depend on surface area - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - endif -c Open the pdb file for snapshotshots -#ifdef MPI - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".pdb") - open(ipdb, - & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".pdb") - else -#ifdef NOXDR - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".x") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".x" -#else - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".cx") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".cx" -#endif - endif -#else - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb") - open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb") - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx") - cartname=prefix(:ilen(prefix))//"_MD.cx" - endif -#endif - if (usampl) then - write (qstr,'(256(1h ))') - ipos=1 - do i=1,nfrag - iq = qinfrag(i,iset)*10 - iw = wfrag(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo - do i=1,npair - iq = qinpair(i,iset)*10 - iw = wpair(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo -c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb' -#ifdef NOXDR -c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x' -#else -c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx' -#endif -c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' - endif - icg=1 - if (rest) then - if (restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) - write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) - write (*,*) me," After broadcast: file_exist",file_exist -c inquire(file=mremd_rst_name,exist=file_exist) - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state read by master and distributed" - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_' - & //liczba(:ilen(liczba))//'.rst') - inquire(file=rest2name,exist=file_exist) - endif - if(file_exist) then - if(.not.restart1file) then - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state will be read from file ", - & rest2name(:ilen(rest2name)) - call readrst - endif - call rescale_weights(t_bath) - else - if(me.eq.king.or..not.out1file)then - if (restart1file) then - write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), - & " does not exist" - else - write(iout,*) "File ",rest2name(:ilen(rest2name)), - & " does not exist" - endif - write(iout,*) "Initial velocities randomly generated" - endif - call random_vel - totT=0.0d0 - endif - else -c Generate initial velocities - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial velocities randomly generated" - call random_vel - totT=0.0d0 - endif -c rest2name = prefix(:ilen(prefix))//'.rst' - if(me.eq.king.or..not.out1file)then - write(iout,*) "Initial backbone velocities" - do i=nnt,nct-1 - write(iout,*) (d_t(j,i),j=1,3) - enddo - write(iout,*) "Initial side-chain velocities" - do i=nnt,nct - write(iout,*) (d_t(j,i+nres),j=1,3) - enddo -c Zeroing the total angular momentum of the system - write(iout,*) "Calling the zero-angular - & momentum subroutine" - endif - call inertia_tensor -c Getting the potential energy and forces and velocities and accelerations - call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo -c Removing the velocity of the center of mass - call vcm_vel(vcm) - if(me.eq.king.or..not.out1file)then - write (iout,*) "vcm right after adjustment:" - write (iout,*) (vcm(j),j=1,3) - endif - if (.not.rest) then - call chainbuild - if(iranconf.ne.0) then - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SC_move',nft_sc,etot - endif - - if(dccart)then - print *, 'Calling MINIM_DC' - call minim_dc(etot,iretcode,nfun) - else - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - endif - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun - endif - endif - call chainbuild_cart - call kinetic(EK) - if (tbf) then - call verlet_bath(EK) - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK - if(me.eq.king.or..not.out1file)then - call cartprint - call intout - endif - call zerograd - call etotal(potEcomp) - potE=potEcomp(0) - call cartgrad - call lagrangian - call max_accel - if (amax*d_time .gt. dvmax) then - d_time=d_time*dvmax/amax - if(me.eq.king.or..not.out1file) write (iout,*) - & "Time step reduced to",d_time, - & " because of too large initial acceleration." - endif - if(me.eq.king.or..not.out1file)then - write(iout,*) "Potential energy and its components" - write(iout,*) (potEcomp(i),i=0,n_ene) - endif - potE=potEcomp(0)-potEcomp(20) - totE=EK+potE - itime=0 - if (ntwe.ne.0) call statout(itime) - if(me.eq.king.or..not.out1file) - & write (iout,*) "Initial:", - & " Kinetic energy",EK," potential energy",potE, - & " total energy",totE," maximum acceleration ", - & amax - if (large) then - write (iout,*) "Initial coordinates" - do i=1,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3), - & (c(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial accelerations" - do i=0,nres -c write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - write (iout,'(i3,3f15.10,3x,3f15.10)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo -c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3) - enddo - if (RESPA) then -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Initial slow-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c call etotal_short(energia_short) -c write (iout,*) "energia_long",energia_long(0), -c & " energia_short",energia_short(0), -c & " total",energia_long(0)+energia_short(0) - endif - return - end -c----------------------------------------------------------- - subroutine random_vel - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb -c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m -c First generate velocities in the eigenspace of the G matrix -c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3 -c call flush(iout) - xv=0.0d0 - ii=0 - do i=1,dimen - do k=1,3 - ii=ii+1 - sigv=dsqrt((Rb*t_bath)/geigen(i)) - lowb=-5*sigv - highb=5*sigv - d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) -c write (iout,*) "ii",ii," d_t_work_new",d_t_work_new(ii) - enddo - enddo -c diagnostics -c Ek1=0.0d0 -c ii=0 -c do i=1,dimen -c do k=1,3 -c ii=ii+1 -c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(ii)**2 -c enddo -c enddo -c write (iout,*) "Ek from eigenvectors",Ek1 -c end diagnostics -c Transform velocities to UNRES coordinate space - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_t_work(ind)=0.0d0 - do j=1,dimen - d_t_work(ind)=d_t_work(ind) - & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1) - enddo -c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) -c call flush(iout) - enddo - enddo -c Transfer to the d_t vector - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_t(j,i)=d_t_work(ind) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_t(j,i+nres)=d_t_work(ind) - enddo - endif - enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 -c call flush(iout) - return - end -#ifndef LANG0 -c----------------------------------------------------------- - subroutine sd_verlet_p_setup -c Sets up the parameters of stochastic Verlet algorithm - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0 * d_time * d_time - prand_vec(i) = 0.0d0 - vrand_vec1(i) = 0.0d0 - vrand_vec2(i) = 0.0d0 -c -c Analytical expressions when friction coefficient is large -c - else - if (gdt .ge. gdt_radius) then - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = (1.0d0-egdt) / fricgam(i) - afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i) - pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt - vterm = 1.0d0 - egdt**2 - rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm) -c -c Use series expansions when friction coefficient is small -c - else - gdt2 = gdt * gdt - gdt3 = gdt * gdt2 - gdt4 = gdt2 * gdt2 - gdt5 = gdt2 * gdt3 - gdt6 = gdt3 * gdt3 - gdt7 = gdt3 * gdt4 - gdt8 = gdt4 * gdt4 - gdt9 = gdt4 * gdt5 - afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0 - & - gdt5/120.0d0 + gdt6/720.0d0 - & - gdt7/5040.0d0 + gdt8/40320.0d0 - & - gdt9/362880.0d0) / fricgam(i)**2 - vfric_vec(i) = d_time - fricgam(i)*afric_vec(i) - pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i) - pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0 - & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0 - & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0 - & + 127.0d0*gdt9/90720.0d0 - vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0 - & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0 - & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0 - & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0 - rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0 - & - 17.0d0*gdt2/1280.0d0 - & + 17.0d0*gdt3/6144.0d0 - & + 40967.0d0*gdt4/34406400.0d0 - & - 57203.0d0*gdt5/275251200.0d0 - & - 1429487.0d0*gdt6/13212057600.0d0) - end if -c -c Compute the scaling factors of random terms for the nonzero friction case -c - ktm = 0.5d0*d_time/fricgam(i) - psig = dsqrt(ktm*pterm) / fricgam(i) - vsig = dsqrt(ktm*vterm) - rhoc = dsqrt(1.0d0 - rho*rho) - prand_vec(i) = psig - vrand_vec1(i) = vsig * rho - vrand_vec2(i) = vsig * rhoc - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c -#ifndef LANG0 - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#endif -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine eigtransf1(n,ndim,ab,d,c) - implicit none - integer n,ndim - double precision ab(ndim,ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+ab(k,j,i)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine eigtransf(n,ndim,a,b,d,c) - implicit none - integer n,ndim - double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine sd_verlet1 -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) - -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) - ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+ - & vrand_mat2(i,j)*stochforcvecV(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c----------------------------------------------------------- - subroutine sd_verlet_ciccotti_setup -c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's -c version - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - write (iout,*) "i",i," fricgam",fricgam(i) - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Analytical expressions when friction coefficient is large -c - else - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = dexp(-0.5d0*gdt)*d_time - afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Compute the scaling factors of random terms for the nonzero friction case -c -c ktm = 0.5d0*d_time/fricgam(i) -c psig = dsqrt(ktm*pterm) / fricgam(i) -c vsig = dsqrt(ktm*vterm) -c prand_vec(i) = psig*afric_vec(i) -c vrand_vec2(i) = vsig*vfric_vec(i) - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine sd_verlet1_ciccotti -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo - -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2_ciccotti -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) -c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) - ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -#endif diff --git a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe1 b/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe1 deleted file mode 100644 index faa149f..0000000 --- a/source/unres/src_MD-M-SAXS-homology/MD_A-MTS.F_safe1 +++ /dev/null @@ -1,2356 +0,0 @@ - subroutine MD -c------------------------------------------------ -c The driver for molecular dynamics subroutines -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision cm(3),L(3),vcm(3) -#ifdef VOUT - double precision v_work(maxres6),v_transf(maxres6) -#endif - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -c -#ifdef MPI - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_" - & //liczba(:ilen(liczba))//'.rst') -#else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst') -#endif - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - do itime=1,n_timestep - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) - write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) -#ifdef VOUT - do j=1,3 - v_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i+nres) - enddo - endif - enddo - - write (66,'(80f10.5)') - & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres) - do i=1,ind - v_transf(i)=0.0d0 - do j=1,ind - v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j) - enddo - v_transf(i)= v_transf(i)*dsqrt(geigen(i)) - enddo - write (67,'(80f10.5)') (v_transf(i),i=1,ind) -#endif - endif - if (mod(itime,ntwx).eq.0) then - write (tytul,'("time",f8.2)') totT - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - close(irest2) - rstcount=0 - endif - enddo -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - return - end -c------------------------------------------------------------------------------- - subroutine velverlet_step(itime) -c------------------------------------------------------------------------------- -c Perform a single velocity Verlet step; the time step can be rescaled if -c increments in accelerations exceed the threshold -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror,ierrcode -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.MUCA' - double precision vcm(3),incr(3) - double precision cm(3),L(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /20/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale -c - scale=.true. - icount_scale=0 - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - itime_scal=0 - do while (scale) - icount_scale=icount_scale+1 - if (icount_scale.gt.maxcount_scale) then - write (iout,*) - & "ERROR: too many attempts at scaling down the time step. ", - & "amax=",amax,"epdrift=",epdrift, - & "damax=",damax,"edriftmax=",edriftmax, - & "d_time=",d_time - call flush(iout) -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE) -#endif - stop - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,*) "dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) - potE=potEcomp(0)-potEcomp(20) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/(itime_scal+1)**2 - call predict_edrift(epdrift) - if (amax/(itime_scal+1).gt.damax .or. epdrift.gt.edriftmax) then -c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step - scale=.true. - ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax)) - & /dlog(2.0d0)+1 - itime_scal=itime_scal+ifac_time -c fac_time=dmin1(damax/amax,0.5d0) - fac_time=0.5d0**ifac_time - d_time=d_time*fac_time - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 -c write (iout,*) "Calling sd_verlet_setup: 1" -c Rescale the stochastic forces and recalculate or restore -c the matrices of tinker integrator - if (itime_scal.gt.maxflag_stoch) then - if (large) write (iout,'(a,i5,a)') - & "Calculate matrices for stochastic step;", - & " itime_scal ",itime_scal - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - write (iout,'(2a,i3,a,i3,1h.)') - & "Warning: cannot store matrices for stochastic", - & " integration because the index",itime_scal, - & " is greater than",maxflag_stoch - write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct", - & " integration Langevin algorithm for better efficiency." - else if (flag_stoch(itime_scal)) then - if (large) write (iout,'(a,i5,a,l1)') - & "Restore matrices for stochastic step; itime_scal ", - & itime_scal," flag ",flag_stoch(itime_scal) - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,itime_scal) - afric_mat(i,j)=afric0_mat(i,j,itime_scal) - vfric_mat(i,j)=vfric0_mat(i,j,itime_scal) - prand_mat(i,j)=prand0_mat(i,j,itime_scal) - vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal) - vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal) - enddo - enddo - else - if (large) write (iout,'(2a,i5,a,l1)') - & "Calculate & store matrices for stochastic step;", - & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal) - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - flag_stoch(ifac_time)=.true. - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,itime_scal)=pfric_mat(i,j) - afric0_mat(i,j,itime_scal)=afric_mat(i,j) - vfric0_mat(i,j,itime_scal)=vfric_mat(i,j) - prand0_mat(i,j,itime_scal)=prand_mat(i,j) - vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j) - vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j) - enddo - enddo - endif - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - stochforcvec(i)=fac_time*stochforcvec(i) - enddo -#endif - else if (lang.eq.1) then -c Rescale the accelerations due to stochastic forces - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen - d_as_work(i)=d_as_work(i)*fac_time - enddo - endif - if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)') - & "itime",itime," Timestep scaled down to ", - & d_time," ifac_time",ifac_time," itime_scal",itime_scal - else -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 - totT=totT+d_time - if (d_time.ne.d_time0) then - d_time=d_time0 -#ifndef LANG0 - if (lang.eq.2 .or. lang.eq.3) then - if (large) write (iout,'(a)') - & "Restore original matrices for stochastic step" -c write (iout,*) "Calling sd_verlet_setup: 2" -c Restore the matrices of tinker integrator if the time step has been restored - do i=1,dimen - do j=1,dimen - pfric_mat(i,j)=pfric0_mat(i,j,0) - afric_mat(i,j)=afric0_mat(i,j,0) - vfric_mat(i,j)=vfric0_mat(i,j,0) - prand_mat(i,j)=prand0_mat(i,j,0) - vrand_mat1(i,j)=vrand0_mat1(i,j,0) - vrand_mat2(i,j)=vrand0_mat2(i,j,0) - enddo - enddo - endif -#endif - endif - scale=.false. - endif - enddo -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c diagnostics -c call kinetic1(EK1) -c write (iout,*) "step",itime," EK",EK," EK1",EK1 -c end diagnostics -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c------------------------------------------------------------------------------- - subroutine RESPA_step(itime) -c------------------------------------------------------------------------------- -c Perform a single RESPA step. -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision energia_short(0:n_ene), - & energia_long(0:n_ene) - double precision cm(3),L(3),vcm(3),incr(3) - double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2), - & d_a_old0(3,0:maxres2) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /10/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - common /cipiszcze/ itt - itt=itime - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***************** RESPA itime",itime - write (iout,*) "Cartesian and internal coordinates: step 0" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 0" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c -c Perform the initial RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA ini" - call RESPA_vel - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the short-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif -C 7/2/2009 commented out -c call zerograd -c call etotal_short(energia_short) -c call cartgrad -c call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces from previous MD step - do i=0,2*nres - do j=1,3 - d_a(j,i)=d_a_short(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo -c 6/30/08 A-MTS: attempt at increasing the split number - do i=0,2*nres - do j=1,3 - dc_old0(j,i)=dc_old(j,i) - d_t_old0(j,i)=d_t_old(j,i) - d_a_old0(j,i)=d_a_old(j,i) - enddo - enddo - if (ntime_split.gt.ntime_split0) ntime_split=ntime_split/2 - if (ntime_split.lt.ntime_split0) ntime_split=ntime_split0 -c - scale=.true. - d_time0=d_time - do while (scale) - - scale=.false. -c write (iout,*) "itime",itime," ntime_split",ntime_split -c Split the time step - d_time=d_time0/ntime_split -c Perform the short-range RESPA steps (velocity Verlet increments of -c positions and velocities using short-range forces) -c write (iout,*) "*********************** RESPA split" - do itsplit=1,ntime_split - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***** ITSPLIT",itsplit - write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) -c call cartprint - call intout - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal_short(energia_short) - call cartgrad -c Get the new accelerations - call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*)"energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -c 6/30/08 A-MTS -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/ntime_split**2 - call predict_edrift(epdrift) - if (ntwe.gt.0 .and. large .and. mod(itime,ntwe).eq.0) - & write (iout,*) "amax",amax," damax",damax, - & " epdrift",epdrift," epdriftmax",epdriftmax -c Exit loop and try with increased split number if the change of -c acceleration is too big - if (amax.gt.damax .or. epdrift.gt.edriftmax) then - if (ntime_split.lt.maxtime_split) then - scale=.true. - ntime_split=ntime_split*2 - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc_old0(j,i) - d_t_old(j,i)=d_t_old0(j,i) - d_a_old(j,i)=d_a_old0(j,i) - enddo - enddo - write (iout,*) "acceleration/energy drift too large",amax, - & epdrift," split increased to ",ntime_split," itime",itime, - & " itsplit",itsplit - exit - else - write (iout,*) - & "Uh-hu. Bumpy landscape. Maximum splitting number", - & maxtime_split, - & " already reached!!! Trying to carry on!" - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else - call verlet2 - endif - if (rattle) call rattle2 -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - enddo - - enddo ! while scale - -c Restore the time step - d_time=d_time0 -c Compute long-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Compute accelerations from long-range forces - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Cartesian and internal coordinates: step 2" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the final RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA fin" - call RESPA_vel -c Compute the complete potential energy - do i=0,n_ene - potEcomp(i)=energia_short(i)+energia_long(i) - enddo - potE=potEcomp(0)-potEcomp(20) -c potE=energia_short(0)+energia_long(0) - totT=totT+d_time -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - return - end -c--------------------------------------------------------------------- - subroutine RESPA_vel -c First and last RESPA step (incrementing velocities using long-range -c forces). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine verlet1 -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2 - -#ifdef DEBUG - write (iout,*) "VELVERLET1 START: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - do j=1,3 - adt=d_a_old(j,0)*d_time - adt2=0.5d0*adt - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+adt2 - d_t(j,0)=d_t_old(j,0)+adt - enddo - do i=nnt,nct-1 - do j=1,3 - adt=d_a_old(j,i)*d_time - adt2=0.5d0*adt - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+adt2 - d_t(j,i)=d_t_old(j,i)+adt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=d_a_old(j,inres)*d_time - adt2=0.5d0*adt - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+adt2 - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - endif - enddo -#ifdef DEBUG - write (iout,*) "VELVERLET1 END: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - return - end -c--------------------------------------------------------------------- - subroutine verlet2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine sddir_precalc -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute friction and stochastic forces -c - call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(fric_work, d_af_work) - call ginv_mult(stochforcvec, d_as_work) - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet1 -c Applying velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. - double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3) - double precision adt,adt2 -c -c Add the contribution from BOTH friction and stochastic force to the -c coordinates, but ONLY the contribution from the friction forces to velocities -c - do j=1,3 - adt=(d_a_old(j,0)+d_af_work(j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt - d_t(j,0)=d_t_old(j,0)+adt - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt - d_t(j,i)=d_t_old(j,i)+adt - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6) - double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/ -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. -c The correlation coefficients are calculated at low-friction limit. -c Also, friction forces are now not calculated with new velocities. - -c call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(stochforcvec, d_as_work1) - -c -c Update velocities -c - do j=1,3 - d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j)) - & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j)) - & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) - & +d_af_work(ind+j))+sin60*d_as_work(ind+j) - & +cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine max_accel -c -c Find the maximum difference in the accelerations of the the sites -c at the beginning and the end of the time step. -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision aux(3),accel(3),accel_old(3),dacc - do j=1,3 -c aux(j)=d_a(j,0)-d_a_old(j,0) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - amax=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then -c 7/3/08 changed to asymmetric difference - do j=1,3 -c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) - accel_old(j)=accel_old(j)+0.5d0*d_a_old(j,i) - accel(j)=accel(j)+0.5d0*d_a(j,i) -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - endif - enddo -c Side chains - do j=1,3 -c accel(j)=aux(j) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - if (nnt.eq.2) then - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,1) - accel(j)=accel(j)+d_a(j,1) - enddo - endif - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 -c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) - accel_old(j)=accel_old(j)+d_a_old(j,i+nres) - accel(j)=accel(j)+d_a(j,i+nres) - enddo - endif - do j=1,3 -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,i) - accel(j)=accel(j)+d_a(j,i) -c aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i) - enddo - enddo - return - end -c--------------------------------------------------------------------- - subroutine predict_edrift(epdrift) -c -c Predict the drift of the potential energy -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MUCA' - double precision epdrift,epdriftij -c Drift of the potential energy - epdrift=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "back",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif -c Side chains - if (itype(i).ne.10) then - do j=1,3 - epdriftij= - & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "side",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif - enddo - epdrift=0.5d0*epdrift*d_time*d_time -c write (iout,*) "epdrift",epdrift - return - end -c----------------------------------------------------------------------- - subroutine verlet_bath -c -c Coupling to the thermostat by using the Berendsen algorithm -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision T_half,fact -c - T_half=2.0d0/(dimen3*Rb)*EK - fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0)) -c write(iout,*) "T_half", T_half -c write(iout,*) "EK", EK -c write(iout,*) "fact", fact - do j=1,3 - d_t(j,0)=fact*d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=fact*d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=fact*d_t(j,inres) - enddo - endif - enddo - return - end -c--------------------------------------------------------- - subroutine init_MD -c Set up the initial conditions of a MD simulation - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - character*16 form - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.REMD' - real*8 energia_long(0:n_ene), - & energia_short(0:n_ene),vcm(3),incr(3) - double precision cm(3),L(3),xv,sigv,lowb,highb - double precision varia(maxvar) - character*256 qstr - integer ilen - external ilen - character*50 tytul - logical file_exist - common /gucio/ cm - d_time0=d_time -c write(iout,*) "d_time", d_time -c Compute the standard deviations of stochastic forces for Langevin dynamics -c if the friction coefficients do not depend on surface area - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - endif -c Open the pdb file for snapshotshots -#ifdef MPI - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".pdb") - open(ipdb, - & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".pdb") - else -#ifdef NOXDR - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".x") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".x" -#else - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".cx") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".cx" -#endif - endif -#else - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb") - open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb") - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx") - cartname=prefix(:ilen(prefix))//"_MD.cx" - endif -#endif - if (usampl) then - write (qstr,'(256(1h ))') - ipos=1 - do i=1,nfrag - iq = qinfrag(i,iset)*10 - iw = wfrag(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo - do i=1,npair - iq = qinpair(i,iset)*10 - iw = wpair(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo -c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb' -#ifdef NOXDR -c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x' -#else -c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx' -#endif -c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' - endif - icg=1 - if (rest) then - if (restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) - write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) - write (*,*) me," After broadcast: file_exist",file_exist -c inquire(file=mremd_rst_name,exist=file_exist) - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state read by master and distributed" - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_' - & //liczba(:ilen(liczba))//'.rst') - inquire(file=rest2name,exist=file_exist) - endif - if(file_exist) then - if(.not.restart1file) then - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state will be read from file ", - & rest2name(:ilen(rest2name)) - call readrst - endif - call rescale_weights(t_bath) - else - if(me.eq.king.or..not.out1file)then - if (restart1file) then - write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), - & " does not exist" - else - write(iout,*) "File ",rest2name(:ilen(rest2name)), - & " does not exist" - endif - write(iout,*) "Initial velocities randomly generated" - endif - call random_vel - totT=0.0d0 - endif - else -c Generate initial velocities - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial velocities randomly generated" - call random_vel - totT=0.0d0 - endif -c rest2name = prefix(:ilen(prefix))//'.rst' - if(me.eq.king.or..not.out1file)then - write(iout,*) "Initial backbone velocities" - do i=nnt,nct-1 - write(iout,*) (d_t(j,i),j=1,3) - enddo - write(iout,*) "Initial side-chain velocities" - do i=nnt,nct - write(iout,*) (d_t(j,i+nres),j=1,3) - enddo -c Zeroing the total angular momentum of the system - write(iout,*) "Calling the zero-angular - & momentum subroutine" - endif - call inertia_tensor -c Getting the potential energy and forces and velocities and accelerations - call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo -c Removing the velocity of the center of mass - call vcm_vel(vcm) - if(me.eq.king.or..not.out1file)then - write (iout,*) "vcm right after adjustment:" - write (iout,*) (vcm(j),j=1,3) - endif - if (.not.rest) then - call chainbuild - if(iranconf.ne.0) then - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SC_move',nft_sc,etot - endif - - if(dccart)then - print *, 'Calling MINIM_DC' - call minim_dc(etot,iretcode,nfun) - else - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - endif - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun - endif - endif - call chainbuild_cart - call kinetic(EK) - if (tbf) then - call verlet_bath(EK) - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK - if(me.eq.king.or..not.out1file)then - call cartprint - call intout - endif - call zerograd - call etotal(potEcomp) - potE=potEcomp(0) - call cartgrad - call lagrangian - call max_accel - if (amax*d_time .gt. dvmax) then - d_time=d_time*dvmax/amax - if(me.eq.king.or..not.out1file) write (iout,*) - & "Time step reduced to",d_time, - & " because of too large initial acceleration." - endif - if(me.eq.king.or..not.out1file)then - write(iout,*) "Potential energy and its components" - write(iout,*) (potEcomp(i),i=0,n_ene) - endif - potE=potEcomp(0)-potEcomp(20) - totE=EK+potE - itime=0 - if (ntwe.ne.0) call statout(itime) - if(me.eq.king.or..not.out1file) - & write (iout,*) "Initial:", - & " Kinetic energy",EK," potential energy",potE, - & " total energy",totE," maximum acceleration ", - & amax - if (large) then - write (iout,*) "Initial coordinates" - do i=1,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3), - & (c(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial accelerations" - do i=0,nres -c write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - write (iout,'(i3,3f15.10,3x,3f15.10)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo -c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3) - enddo - if (RESPA) then -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_short(energia_short) - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0), - & " energia_short",energia_short(0), - & " total",energia_long(0)+energia_short(0) - write (iout,*) "Initial fast-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo - call zerograd - call etotal_long(energia_long) - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Initial slow-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - endif - return - end -c----------------------------------------------------------- - subroutine random_vel - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb -c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m -c First generate velocities in the eigenspace of the G matrix -c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3 -c call flush(iout) - xv=0.0d0 - ii=0 - do i=1,dimen - do k=1,3 - ii=ii+1 - sigv=dsqrt((Rb*t_bath)/geigen(i)) - lowb=-5*sigv - highb=5*sigv - d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) -c write (iout,*) "ii",ii," d_t_work_new",d_t_work_new(ii) - enddo - enddo -c diagnostics -c Ek1=0.0d0 -c ii=0 -c do i=1,dimen -c do k=1,3 -c ii=ii+1 -c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(ii)**2 -c enddo -c enddo -c write (iout,*) "Ek from eigenvectors",Ek1 -c end diagnostics -c Transform velocities to UNRES coordinate space - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_t_work(ind)=0.0d0 - do j=1,dimen - d_t_work(ind)=d_t_work(ind) - & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1) - enddo -c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) -c call flush(iout) - enddo - enddo -c Transfer to the d_t vector - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_t(j,i)=d_t_work(ind) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_t(j,i+nres)=d_t_work(ind) - enddo - endif - enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 -c call flush(iout) - return - end -#ifndef LANG0 -c----------------------------------------------------------- - subroutine sd_verlet_p_setup -c Sets up the parameters of stochastic Verlet algorithm - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0 * d_time * d_time - prand_vec(i) = 0.0d0 - vrand_vec1(i) = 0.0d0 - vrand_vec2(i) = 0.0d0 -c -c Analytical expressions when friction coefficient is large -c - else - if (gdt .ge. gdt_radius) then - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = (1.0d0-egdt) / fricgam(i) - afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i) - pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt - vterm = 1.0d0 - egdt**2 - rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm) -c -c Use series expansions when friction coefficient is small -c - else - gdt2 = gdt * gdt - gdt3 = gdt * gdt2 - gdt4 = gdt2 * gdt2 - gdt5 = gdt2 * gdt3 - gdt6 = gdt3 * gdt3 - gdt7 = gdt3 * gdt4 - gdt8 = gdt4 * gdt4 - gdt9 = gdt4 * gdt5 - afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0 - & - gdt5/120.0d0 + gdt6/720.0d0 - & - gdt7/5040.0d0 + gdt8/40320.0d0 - & - gdt9/362880.0d0) / fricgam(i)**2 - vfric_vec(i) = d_time - fricgam(i)*afric_vec(i) - pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i) - pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0 - & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0 - & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0 - & + 127.0d0*gdt9/90720.0d0 - vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0 - & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0 - & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0 - & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0 - rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0 - & - 17.0d0*gdt2/1280.0d0 - & + 17.0d0*gdt3/6144.0d0 - & + 40967.0d0*gdt4/34406400.0d0 - & - 57203.0d0*gdt5/275251200.0d0 - & - 1429487.0d0*gdt6/13212057600.0d0) - end if -c -c Compute the scaling factors of random terms for the nonzero friction case -c - ktm = 0.5d0*d_time/fricgam(i) - psig = dsqrt(ktm*pterm) / fricgam(i) - vsig = dsqrt(ktm*vterm) - rhoc = dsqrt(1.0d0 - rho*rho) - prand_vec(i) = psig - vrand_vec1(i) = vsig * rho - vrand_vec2(i) = vsig * rhoc - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c -#ifndef LANG0 - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#endif -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine eigtransf1(n,ndim,ab,d,c) - implicit none - integer n,ndim - double precision ab(ndim,ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+ab(k,j,i)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine eigtransf(n,ndim,a,b,d,c) - implicit none - integer n,ndim - double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine sd_verlet1 -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) - -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) - ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+ - & vrand_mat2(i,j)*stochforcvecV(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c----------------------------------------------------------- - subroutine sd_verlet_ciccotti_setup -c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's -c version - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - write (iout,*) "i",i," fricgam",fricgam(i) - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Analytical expressions when friction coefficient is large -c - else - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = dexp(-0.5d0*gdt)*d_time - afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Compute the scaling factors of random terms for the nonzero friction case -c -c ktm = 0.5d0*d_time/fricgam(i) -c psig = dsqrt(ktm*pterm) / fricgam(i) -c vsig = dsqrt(ktm*vterm) -c prand_vec(i) = psig*afric_vec(i) -c vrand_vec2(i) = vsig*vfric_vec(i) - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine sd_verlet1_ciccotti -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo - -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2_ciccotti -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) -c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) - ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -#endif diff --git a/source/unres/src_MD-M-SAXS-homology/MREMD.F b/source/unres/src_MD-M-SAXS-homology/MREMD.F index afecaa5..087b9be 100644 --- a/source/unres/src_MD-M-SAXS-homology/MREMD.F +++ b/source/unres/src_MD-M-SAXS-homology/MREMD.F @@ -1082,7 +1082,7 @@ c 9/11/17 AL: Adaptive sampling (temperature dependent restraints potentials) endif cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 - call flush(iout) +c call flush(iout) c Swap temperatures between conformations i and iex with recalculating the free energies c following temperature changes. diff --git a/source/unres/src_MD-M-SAXS-homology/MREMD.F.safe b/source/unres/src_MD-M-SAXS-homology/MREMD.F.safe deleted file mode 100644 index 110dea3..0000000 --- a/source/unres/src_MD-M-SAXS-homology/MREMD.F.safe +++ /dev/null @@ -1,1756 +0,0 @@ - subroutine MREMD - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.MUCA' - double precision cm(3),L(3),vcm(3) - double precision energia(0:n_ene) - double precision remd_t_bath(maxprocs) - integer iremd_iset(maxprocs) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - double precision remd_ene(0:n_ene+4,maxprocs) - integer iremd_acc(maxprocs),iremd_tot(maxprocs) - integer iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs) - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -cold integer nup(0:maxprocs),ndown(0:maxprocs) - integer rep2i(0:maxprocs),ireqi(maxprocs) - integer icache_all(maxprocs) - integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - logical synflag,end_of_run,file_exist /.false./ - -cdeb imin_itime_old=0 - ntwx_cache=0 - time00=MPI_WTIME() - time01=time00 - if(me.eq.king.or..not.out1file) then - write (iout,*) 'MREMD',nodes,'time before',time00-walltime - write (iout,*) "NREP=",nrep - endif - - synflag=.false. - if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then - call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst") - endif - mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst" - -cd print *,'MREMD',nodes -cd print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep) -cde write (iout,*) "Start MREMD: me",me," t_bath",t_bath - k=0 - rep2i(k)=-1 - do il=1,max0(nset,1) - do il1=1,max0(mset(il),1) - do i=1,nrep - iremd_acc(i)=0 - iremd_acc_usa(i)=0 - iremd_tot(i)=0 - do j=1,remd_m(i) - i2rep(k)=i - i2set(k)=il - rep2i(i)=k - k=k+1 - i_index(i,j,il,il1)=k - enddo - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write(iout,*) (i2rep(i),i=0,nodes-1) - write(iout,*) (i2set(i),i=0,nodes-1) - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - -c print *,'i2rep',me,i2rep(me) -c print *,'rep2i',(rep2i(i),i=0,nrep) - -cold if (i2rep(me).eq.nrep) then -cold nup(0)=0 -cold else -cold nup(0)=remd_m(i2rep(me)+1) -cold k=rep2i(int(i2rep(me)))+1 -cold do i=1,nup(0) -cold nup(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0)) - -cold if (i2rep(me).eq.1) then -cold ndown(0)=0 -cold else -cold ndown(0)=remd_m(i2rep(me)-1) -cold k=rep2i(i2rep(me)-2)+1 -cold do i=1,ndown(0) -cold ndown(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) - - - write (*,*) "Processor",me," rest",rest," - & restart1fie",restart1file - if(rest.and.restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) -cd write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) -cd write (*,*) me," After broadcast: file_exist",file_exist - if(file_exist) then - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Master is reading restart1file' - call read1restart(i_index) - else - if(me.eq.king.or..not.out1file) - & write (iout,*) 'WARNING : no restart1file' - endif - - if(me.eq.king.or..not.out1file) then - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - endif - - if(me.eq.king) then - if (rest.and..not.restart1file) - & inquire(file=mremd_rst_name,exist=file_exist) - if(.not.file_exist.and.rest.and..not.restart1file) - & write(iout,*) 'WARNING : no restart file',mremd_rst_name - IF (rest.and.file_exist.and..not.restart1file) THEN - write (iout,*) 'Master is reading restart file', - & mremd_rst_name - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl) then - read (irest2,*) - read (irest2,*) nset - read (irest2,*) - read (irest2,*) (mset(i),i=1,nset) - read (irest2,*) - read (irest2,*) (i2set(i),i=0,nodes-1) - read (irest2,*) - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - read(irest2,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - - close(irest2) - - write (iout,'(a6,1000i5)') "i2rep",(i2rep(i),i=0,nodes-1) - write (iout,'(a6,1000i5)') "ifirst", - & (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", - & (nupa(i,il),i=1,nupa(0,il)) - write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - ELSE IF (.not.(rest.and.file_exist)) THEN - do il=1,remd_m(1) - ifirst(il)=il - enddo - - do il=1,nodes - if (i2rep(il-1).eq.nrep) then - nupa(0,il)=0 - else - nupa(0,il)=remd_m(i2rep(il-1)+1) - k=rep2i(int(i2rep(il-1)))+1 - do i=1,nupa(0,il) - nupa(i,il)=k+1 - k=k+1 - enddo - endif - if (i2rep(il-1).eq.1) then - ndowna(0,il)=0 - else - ndowna(0,il)=remd_m(i2rep(il-1)-1) - k=rep2i(i2rep(il-1)-2)+1 - do i=1,ndowna(0,il) - ndowna(i,il)=k+1 - k=k+1 - enddo - endif - enddo - -c write (iout,'(a6,100i4)') "ifirst", -c & (ifirst(i),i=1,remd_m(1)) -c do il=1,nodes -c write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", -c & (nupa(i,il),i=1,nupa(0,il)) -c write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", -c & (ndowna(i,il),i=1,ndowna(0,il)) -c enddo - - ENDIF - endif -c -c t_bath=retmin+(retmax-retmin)*me/(nodes-1) - if(.not.(rest.and.file_exist.and.restart1file)) then - if (me .eq. king) then - t_bath=retmin - else - t_bath=retmin+(retmax-retmin)*exp(float(i2rep(me)-nrep)) - endif -cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep) - if (remd_tlist) t_bath=remd_t(int(i2rep(me))) - - endif - if(usampl) then - iset=i2set(me) - if(me.eq.king.or..not.out1file) - & write(iout,*) me,"iset=",iset,"t_bath=",t_bath - endif -c - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - -c print *,'irep',me,t_bath - if (.not.rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD Temperature:",t_bath - call rescale_weights(t_bath) - endif - - -c------copy MD-------------- -c The driver for molecular dynamics subroutines -c------------------------------------------------ - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - if(me.eq.king.or..not.out1file) - & write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD - if (rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD restart Temperature:",t_bath - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - call rescale_weights(t_bath) - endif - -#ifdef MPI - t_MDsetup = MPI_Wtime() -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo -#endif - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - time00=MPI_WTIME() - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'Setup time',time00-walltime - call flush(iout) -#ifdef MPI - t_langsetup=MPI_Wtime() - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - itime=0 - end_of_run=.false. - do while(.not.end_of_run) - itime=itime+1 - if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true. - if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true. - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo -#endif - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - if (me.eq.king .or. .not. out1file) - & write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) -cd write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else - call brown_step(itime) - endif - if(ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) - endif - if (mod(itime,ntwx).eq.0.and..not.traj1file) then - write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (mod(itime,ntwx).eq.0.and.traj1file) then - if(ntwx_cache.lt.max_cache_traj_use) then - ntwx_cache=ntwx_cache+1 - else - if (max_cache_traj_use.ne.1) - & print *,itime,"processor ",me," over cache ",ntwx_cache - do i=1,ntwx_cache-1 - - totT_cache(i)=totT_cache(i+1) - EK_cache(i)=EK_cache(i+1) - potE_cache(i)=potE_cache(i+1) - t_bath_cache(i)=t_bath_cache(i+1) - Uconst_cache(i)=Uconst_cache(i+1) - iset_cache(i)=iset_cache(i+1) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,i+1) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,i+1) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,i+1) - ugamma_cache(ii,i)=ugamma_cache(ii,i+1) - uscdiff_cache(ii,i)=uscdiff_cache(ii,i+1) - enddo - - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,i+1) - enddo - enddo - enddo - endif - - totT_cache(ntwx_cache)=totT - EK_cache(ntwx_cache)=EK - potE_cache(ntwx_cache)=potE - t_bath_cache(ntwx_cache)=t_bath - Uconst_cache(ntwx_cache)=Uconst - iset_cache(ntwx_cache)=iset - - do i=1,nfrag - qfrag_cache(i,ntwx_cache)=qfrag(i) - enddo - do i=1,npair - qpair_cache(i,ntwx_cache)=qpair(i) - enddo - do i=1,nfrag_back - utheta_cache(i,ntwx_cache)=utheta(i) - ugamma_cache(i,ntwx_cache)=ugamma(i) - uscdiff_cache(i,ntwx_cache)=uscdiff(i) - enddo - - do i=1,nres*2 - do j=1,3 - c_cache(j,i,ntwx_cache)=c(j,i) - enddo - enddo - - endif - if ((rstcount.eq.1000.or.itime.eq.n_timestep) - & .and..not.restart1file) then - - if(me.eq.king) then - open(irest1,file=mremd_rst_name,status='unknown') - write (irest1,*) "i2rep" - write (irest1,*) (i2rep(i),i=0,nodes-1) - write (irest1,*) "ifirst" - write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (irest1,*) "nupa",il - write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - write (irest1,*) "ndowna",il - write (irest1,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl) then - write (irest1,*) "nset" - write (irest1,*) nset - write (irest1,*) "mset" - write (irest1,*) (mset(i),i=1,nset) - write (irest1,*) "i2set" - write (irest1,*) (i2set(i),i=0,nodes-1) - write (irest1,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - write(irest1,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - endif - close(irest1) - endif - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl) then - write (irest2,*) iset - endif - close(irest2) - rstcount=0 - endif - -c REMD - exchange -c forced synchronization - if (mod(itime,i_sync_step).eq.0 .and. me.ne.king - & .and. .not. mremdsync) then - synflag=.false. - call mpi_iprobe(0,101,CG_COMM,synflag,status,ierr) - if (synflag) then - call mpi_recv(itime_master, 1, MPI_INTEGER, - & 0,101,CG_COMM, status, ierr) - call mpi_barrier(CG_COMM, ierr) -cdeb if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) - if(traj1file) - & call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (.not.out1file) - & write(iout,*) 'REMD synchro at',itime_master,itime - if(itime_master.ge.n_timestep) end_of_run=.true. -ctime call flush(iout) - endif - endif - -c REMD - exchange - if ((mod(itime,nstex).eq.0.and.me.eq.king - & .or.end_of_run.and.me.eq.king ) - & .and. .not. mremdsync ) then - synflag=.true. - time00=MPI_WTIME() - do i=1,nodes-1 - call mpi_isend(itime,1,MPI_INTEGER,i,101, - & CG_COMM, ireqi(i), ierr) -cd write(iout,*) 'REMD synchro with',i -cd call flush(iout) - enddo - call mpi_waitall(nodes-1,ireqi,statusi,ierr) - call mpi_barrier(CG_COMM, ierr) - time01=MPI_WTIME() - write(iout,*) 'REMD synchro at',itime,'time=',time01-time00 - if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & itime_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' REMD synchro itime', -cdeb & (itime_all(i),i=1,nodes) - if(traj1file) then -cdeb imin_itime=itime_all(1) -cdeb do i=2,nodes -cdeb if(itime_all(i).lt.imin_itime) imin_itime=itime_all(i) -cdeb enddo -cdeb ii_write=(imin_itime-imin_itime_old)/ntwx -cdeb imin_itime_old=int(imin_itime/ntwx)*ntwx -cdeb write(iout,*) imin_itime,imin_itime_old,ii_write - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) -c write(iout,'(a19,8000i8)') ' ntwx_cache', -c & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo -c write(iout,*) "MIN ii_write=",ii_write - endif - endif -ctime call flush(iout) - endif - if(mremdsync .and. mod(itime,nstex).eq.0) then - synflag=.true. - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'REMD synchro at',itime - - if(traj1file) then - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (me.eq.king) then - write(iout,'(a19,8000i8)') ' ntwx_cache', - & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo - write(iout,*) "MIN ii_write=",ii_write - endif - endif - - call flush(iout) - endif - if(synflag.and..not.end_of_run) then - time02=MPI_WTIME() - synflag=.false. - -cd write(iout,*) 'REMD before',me,t_bath - -c call mpi_gather(t_bath,1,mpi_double_precision, -c & remd_t_bath,1,mpi_double_precision,king, -c & CG_COMM,ierr) - potEcomp(n_ene+1)=t_bath - if (usampl) then - potEcomp(n_ene+2)=iset - if (iset.lt.nset) then - i_set_temp=iset - iset=iset+1 - call EconstrQ - potEcomp(n_ene+3)=Uconst - iset=i_set_temp - endif - if (iset.gt.1) then - i_set_temp=iset - iset=iset-1 - call EconstrQ - potEcomp(n_ene+4)=Uconst - iset=i_set_temp - endif - endif - call mpi_gather(potEcomp(0),n_ene+5,mpi_double_precision, - & remd_ene(0,1),n_ene+5,mpi_double_precision,king, - & CG_COMM,ierr) - if(lmuca) then - call mpi_gather(elow,1,mpi_double_precision, - & elowi,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_gather(ehigh,1,mpi_double_precision, - & ehighi,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - - time03=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD gather times=',time03-time01 - & ,time03-time02 - endif - - if (restart1file) call write1rst(i_index) - - time04=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing rst time=',time04-time03 - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' ntwx_cache after traj1file', -cdeb & (icache_all(i),i=1,nodes) -cd end - - - time05=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing traj time=',time05-time04 - call flush(iout) - endif - - - if (me.eq.king) then - do i=1,nodes - remd_t_bath(i)=remd_ene(n_ene+1,i) - iremd_iset(i)=remd_ene(n_ene+2,i) - enddo - if(lmuca) then -co write(iout,*) 'REMD exchange temp,ene,elow,ehigh' - do i=1,nodes - write(iout,'(i4,4f12.5)') i,remd_t_bath(i),remd_ene(0,i), - & elowi(i),ehighi(i) - enddo - else -cd write(iout,*) 'REMD exchange temp,ene' -c do i=1,nodes -co write(iout,'(i4,2f12.5)') i,remd_t_bath(i),remd_ene(0,i) -c write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) -c enddo - endif -c------------------------------------- - IF(.not.usampl) THEN - write (iout,*) "Enter exchnge, remd_m",remd_m(1), - & " nodes",nodes - call flush(iout) - do irr=1,remd_m(1) - i=ifirst(iran_num(1,remd_m(1))) - call flush(iout) - - do ii=1,nodes-1 - - if(i.gt.0.and.nupa(0,i).gt.0) then - iex=nupa(iran_num(1,int(nupa(0,i))),i) - if (lmuca) then - call muca_delta(remd_t_bath,remd_ene,i,iex,delta) - else -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -cd write (iout,*) "rescaling weights with temperature", -cd & remd_t_bath(i) -cd call flush(iout) - call rescale_weights(remd_t_bath(i)) - -cd write (iout,*) "0,iex",remd_t_bath(i) -cd call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -cd write (iout,*) "ene_iex_i",remd_ene(0,iex) - -cd write (iout,*) "0,i",remd_t_bath(i) -cd call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_i",remd_ene(0,i) -cd call flush(iout) -cd write (iout,*) "rescaling weights with temperature", -cd & remd_t_bath(iex) - if (real(ene_i_i).ne.real(remd_ene(0,i))) then - write (iout,*) "ERROR: inconsistent energies:",i, - & ene_i_i,remd_ene(0,i) - endif - call rescale_weights(remd_t_bath(iex)) - -cd write (iout,*) "0,i",remd_t_bath(iex) -cd call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_iex",remd_ene(0,i) -cd call flush(iout) - ene_i_iex=remd_ene(0,i) - -cd write (iout,*) "0,iex",remd_t_bath(iex) -cd call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then - write (iout,*) "ERROR: inconsistent energies:",iex, - & ene_iex_iex,remd_ene(0,iex) - endif -cd write (iout,*) "ene_iex_iex",remd_ene(0,iex) -cd write (iout,*) "i",i," iex",iex -cd write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -cd & " ene_i_iex",ene_i_iex, -cd & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex -cd call flush(iout) - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -cd write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - endif - if (delta .gt. 50.0d0) then - delta=0.0d0 - else -#ifdef OSF - if(isnan(delta))then - delta=0.0d0 - else if (delta.lt.-50.0d0) then - delta=dexp(50.0d0) - else - delta=dexp(-delta) - endif -#else - delta=dexp(-delta) -#endif - endif - iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx -cd call flush(iout) - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - if(lmuca) then - tmp=elowi(i) - elowi(i)=elowi(iex) - elowi(iex)=tmp - tmp=ehighi(i) - ehighi(i)=ehighi(iex) - ehighi(iex)=tmp - endif - - - do k=0,nodes - itmp=nupa(k,i) - nupa(k,i)=nupa(k,iex) - nupa(k,iex)=itmp - itmp=ndowna(k,i) - ndowna(k,i)=ndowna(k,iex) - ndowna(k,iex)=itmp - enddo - do il=1,nodes - if (ifirst(il).eq.i) ifirst(il)=iex - do k=1,nupa(0,il) - if (nupa(k,il).eq.i) then - nupa(k,il)=iex - elseif (nupa(k,il).eq.iex) then - nupa(k,il)=i - endif - enddo - do k=1,ndowna(0,il) - if (ndowna(k,il).eq.i) then - ndowna(k,il)=iex - elseif (ndowna(k,il).eq.iex) then - ndowna(k,il)=i - endif - enddo - enddo - - iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - -cd write(iout,*) 'exchange',i,iex -cd write (iout,'(a8,100i4)') "@ ifirst", -cd & (ifirst(k),k=1,remd_m(1)) -cd do il=1,nodes -cd write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":", -cd & (nupa(k,il),k=1,nupa(0,il)) -cd write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":", -cd & (ndowna(k,il),k=1,ndowna(0,il)) -cd enddo - call flush(iout) - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - i=iex - endif - endif - enddo - enddo -cd write (iout,*) "exchange completed" -cd call flush(iout) - ELSE - do ii=1,nodes -cd write(iout,*) "########",ii - - i_temp=iran_num(1,nrep) - i_mult=iran_num(1,remd_m(i_temp)) - i_iset=iran_num(1,nset) - i_mset=iran_num(1,mset(i_iset)) - i=i_index(i_temp,i_mult,i_iset,i_mset) - -cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - - i_dir=iran_num(1,3) -cd write(iout,*) "i_dir=",i_dir - - if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then - - i_temp1=i_temp - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - elseif(remd_m(i_temp+1).gt.0.and.mset(i_iset+1).gt.0)then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - else - goto 444 - endif - -cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 - call flush(iout) - -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -co write (iout,*) "rescaling weights with temperature", -co & remd_t_bath(i) - call rescale_weights(remd_t_bath(i)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -cd write (iout,*) "ene_iex_i",remd_ene(0,iex) -c call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_i",remd_ene(0,i) -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(iex) -c if (real(ene_i_i).ne.real(remd_ene(0,i))) then -c write (iout,*) "ERROR: inconsistent energies:",i, -c & ene_i_i,remd_ene(0,i) -c endif - call rescale_weights(remd_t_bath(iex)) - call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_iex",remd_ene(0,i) - ene_i_iex=remd_ene(0,i) -c call sum_energy(remd_ene(0,iex),.false.) -c if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then -c write (iout,*) "ERROR: inconsistent energies:",iex, -c & ene_iex_iex,remd_ene(0,iex) -c endif -cd write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -cd write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -cd & " ene_i_iex",ene_i_iex, -cd & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -cd write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - if (delta .gt. 50.0d0) then - delta=0.0d0 - else - delta=dexp(-delta) - endif - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_tot_usa(int(i2set(i-1)))= - & iremd_tot_usa(int(i2set(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - - itmp=iremd_iset(i) - iremd_iset(i)=iremd_iset(iex) - iremd_iset(iex)=itmp - - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_acc_usa(int(i2set(i-1)))= - & iremd_acc_usa(int(i2set(i-1)))+1 - - itmp=i2set(i-1) - i2set(i-1)=i2set(iex-1) - i2set(iex-1)=itmp - - itmp=i_index(i_temp,i_mult,i_iset,i_mset) - i_index(i_temp,i_mult,i_iset,i_mset)= - & i_index(i_temp1,i_mult1,i_iset1,i_mset1) - i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - remd_ene(20,iex)=econstr_temp_iex - remd_ene(20,i)=econstr_temp_i - endif - -cd do il=1,nset -cd do il1=1,mset(il) -cd do i=1,nrep -cd do j=1,remd_m(i) -cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1) -cd enddo -cd enddo -cd enddo -cd enddo - - 444 continue - - enddo - - - ENDIF - -c------------------------------------- - write (iout,*) "NREP",nrep - do i=1,nrep - if(iremd_tot(i).ne.0) - & write(iout,'(a3,i4,2f12.5,i5)') 'ACC',i,remd_t(i) - & ,iremd_acc(i)/(1.0*iremd_tot(i)),iremd_tot(i) - enddo - - if(usampl) then - do i=1,nset - if(iremd_tot_usa(i).ne.0) - & write(iout,'(a10,i4,f12.5,i8)') 'ACC_usampl',i, - & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i) - enddo - endif - - call flush(iout) - -cd write (iout,'(a6,100i4)') "ifirst", -cd & (ifirst(i),i=1,remd_m(1)) -cd do il=1,nodes -cd write (iout,'(a5,i4,a1,100i4)') "nup",il,":", -cd & (nupa(i,il),i=1,nupa(0,il)) -cd write (iout,'(a5,i4,a1,100i4)') "ndown",il,":", -cd & (ndowna(i,il),i=1,ndowna(0,il)) -cd enddo - endif - - time06=MPI_WTIME() -cd write (iout,*) "Before scatter" -cd call flush(iout) - call mpi_scatter(remd_t_bath,1,mpi_double_precision, - & t_bath,1,mpi_double_precision,king, - & CG_COMM,ierr) -cd write (iout,*) "After scatter" -cd call flush(iout) - if(usampl) - & call mpi_scatter(iremd_iset,1,mpi_integer, - & iset,1,mpi_integer,king, - & CG_COMM,ierr) - - time07=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD scatter time=',time07-time06 - endif - - if(lmuca) then - call mpi_scatter(elowi,1,mpi_double_precision, - & elow,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_scatter(ehighi,1,mpi_double_precision, - & ehigh,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - call rescale_weights(t_bath) -co write (iout,*) "Processor",me, -co & " rescaling weights with temperature",t_bath - - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - -cde write(iout,*) 'REMD after',me,t_bath - time08=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD exchange time=',time08-time00 - call flush(iout) - endif - endif - enddo - - if (restart1file) then - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'writing restart at the end of run' - call write1rst(i_index) - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a40,8000i8)') -cdeb & ' ntwx_cache after traj1file at the end', -cdeb & (icache_all(i),i=1,nodes) -cd end - - -#ifdef MPI - t_MD=MPI_Wtime() -#else - t_MD=tcpu()-tt0 -#endif - if (me.eq.king .or. .not. out1file) then - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - endif - return - end - -c----------------------------------------------------------------------- - - subroutine write1rst_oldtxt - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & d_restart2(3,2*maxres*maxprocs) - real t5_restart1(5) - integer iret,itmp - - - t5_restart1(1)=totT - t5_restart1(2)=EK - t5_restart1(3)=potE - t5_restart1(4)=t_bath - t5_restart1(5)=Uconst - - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=d_t(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart1,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=dc(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart2,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then - open(irest1,file=mremd_rst_name,status='unknown') - write (irest1,*) (i2rep(i),i=0,nodes-1) - write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - write (irest1,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - - do il=1,nodes - write(irest1,*) (t_restart1(j,il),j=1,4) - enddo - - do il=0,nodes-1 - do i=1,2*nres - write(irest1,'(3e15.5)') (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres - write(irest1,'(3e15.5)') (d_restart2(j,i+2*nres*il),j=1,3) - enddo - enddo - close(irest1) - endif - - return - end - - subroutine write1rst(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & d_restart2(3,2*maxres*maxprocs) - real t5_restart1(5) - integer iret,itmp - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - - - t5_restart1(1)=totT - t5_restart1(2)=EK - t5_restart1(3)=potE - t5_restart1(4)=t_bath - t5_restart1(5)=Uconst - - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=d_t(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart1,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=dc(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart2,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then -c open(irest1,file=mremd_rst_name,status='unknown') - call xdrfopen(ixdrf,mremd_rst_name, "w", iret) -c write (irest1,*) (i2rep(i),i=0,nodes-1) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo -c write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes -c write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - do i=0,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - -c write (irest1,*) ndowna(0,il), -c & (ndowna(i,il),i=1,ndowna(0,il)) - do i=0,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes -c write(irest1,*) (t_restart1(j,il),j=1,4) - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres -c write(irest1,'(3e15.5)') (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres -c write(irest1,'(3e15.5)') (d_restart2(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo - - - if(usampl) then -c write (irest1,*) nset - call xdrfint(ixdrf, nset, iret) -c write (irest1,*) (mset(i),i=1,nset) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo -c write (irest1,*) (i2set(i),i=0,nodes-1) - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo -c write (irest1,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep -c write(irest1,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - do j=1,remd_m(i) - itmp=i_index(i,j,il,il1) - call xdrfint(ixdrf,itmp, iret) - enddo - enddo - enddo - enddo - - endif - -c close(irest1) - call xdrfclose(ixdrf, iret) - endif - - return - end - - - subroutine write1traj - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real t5_restart1(5) - integer iret,itmp - real xcoord(3,maxres2+2),prec - real r_qfrag(50),r_qpair(100) - real r_utheta(50),r_ugamma(100),r_uscdiff(100) - real p_qfrag(50*maxprocs),p_qpair(100*maxprocs) - real p_utheta(50*maxprocs),p_ugamma(100*maxprocs), - & p_uscdiff(100*maxprocs) - real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2) - - call mpi_bcast(ii_write,1,mpi_integer, - & king,CG_COMM,ierr) - -c debugging - print *,'traj1file',me,ii_write,ntwx_cache -c end debugging - - if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) - do ii=1,ii_write - t5_restart1(1)=totT_cache(ii) - t5_restart1(2)=EK_cache(ii) - t5_restart1(3)=potE_cache(ii) - t5_restart1(4)=t_bath_cache(ii) - t5_restart1(5)=Uconst_cache(ii) - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - call mpi_gather(iset_cache(ii),1,mpi_integer, - & iset_restart1,1,mpi_integer,king,CG_COMM,ierr) - - do i=1,nfrag - r_qfrag(i)=qfrag_cache(i,ii) - enddo - do i=1,npair - r_qpair(i)=qpair_cache(i,ii) - enddo - do i=1,nfrag_back - r_utheta(i)=utheta_cache(i,ii) - r_ugamma(i)=ugamma_cache(i,ii) - r_uscdiff(i)=uscdiff_cache(i,ii) - enddo - - call mpi_gather(r_qfrag,nfrag,mpi_real, - & p_qfrag,nfrag,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_qpair,npair,mpi_real, - & p_qpair,npair,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_utheta,nfrag_back,mpi_real, - & p_utheta,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_ugamma,nfrag_back,mpi_real, - & p_ugamma,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_uscdiff,nfrag_back,mpi_real, - & p_uscdiff,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - -#ifdef DEBUG - write (iout,*) "p_qfrag" - do i=1,nodes - write (iout,*) i,(p_qfrag((i-1)*nfrag+j),j=1,nfrag) - enddo - write (iout,*) "p_qpair" - do i=1,nodes - write (iout,*) i,(p_qpair((i-1)*npair+j),j=1,npair) - enddo - call flush(iout) -#endif - do i=1,nres*2 - do j=1,3 - r_c(j,i)=c_cache(j,i,ii) - enddo - enddo - - call mpi_gather(r_c,3*2*nres,mpi_real, - & p_c,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then - - do il=1,nodes - call xdrffloat(ixdrf, real(t_restart1(1,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(3,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(5,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - call xdrfint(ixdrf, iset_restart1(il), iret) - do i=1,nfrag - call xdrffloat(ixdrf, p_qfrag(i+(il-1)*nfrag), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, p_qpair(i+(il-1)*npair), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret) - enddo - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=p_c(j,i+(il-1)*nres*2) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2) - enddo - enddo - itmp=nres+nct-nnt+1 - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - enddo - endif - enddo - if(me.eq.king) call xdrfclose(ixdrf, iret) - do i=1,ntwx_cache-ii_write - - totT_cache(i)=totT_cache(ii_write+i) - EK_cache(i)=EK_cache(ii_write+i) - potE_cache(i)=potE_cache(ii_write+i) - t_bath_cache(i)=t_bath_cache(ii_write+i) - Uconst_cache(i)=Uconst_cache(ii_write+i) - iset_cache(i)=iset_cache(ii_write+i) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,ii_write+i) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,ii_write+i) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,ii_write+i) - ugamma_cache(ii,i)=ugamma_cache(ii,ii_write+i) - uscdiff_cache(ii,i)=uscdiff_cache(ii,ii_write+i) - enddo - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,ii_write+i) - enddo - enddo - enddo - ntwx_cache=ntwx_cache-ii_write - return - end - - - subroutine read1restart(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - write (*,*) "Processor",me," called read1restart" - - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read(irest2,*,err=334) i - write(iout,*) "Reading old rst in ASCI format" - close(irest2) - call read1restart_old - return - 334 continue - call xdrfopen(ixdrf,mremd_rst_name, "r", iret) - -c read (irest2,*) (i2rep(i),i=0,nodes-1) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo -c read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes -c read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - call xdrfint(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - -c read (irest2,*) ndowna(0,il), -c & (ndowna(i,il),i=1,ndowna(0,il)) - call xdrfint(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes -c read(irest2,*) (t_restart1(j,il),j=1,4) - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - - - if(usampl) then - if(me.eq.king)then - call xdrfint(ixdrf, nset, iret) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - call xdrfint(ixdrf,itmp, iret) - i_index(i,j,il,il1)=itmp - enddo - enddo - enddo - enddo - endif - - call mpi_scatter(i2set,1,mpi_integer, - & iset,1,mpi_integer,king, - & CG_COMM,ierr) - - endif - - - if(me.eq.king) close(irest2) - return - end - - subroutine read1restart_old - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - do il=1,nodes - read(irest2,*) (t_restart1(j,il),j=1,4) - enddo - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king) close(irest2) - return - end - diff --git a/source/unres/src_MD-M-SAXS-homology/Makefile_MPICH_ifort-okeanos b/source/unres/src_MD-M-SAXS-homology/Makefile_MPICH_ifort-okeanos index 23dea1f..4b51933 100644 --- a/source/unres/src_MD-M-SAXS-homology/Makefile_MPICH_ifort-okeanos +++ b/source/unres/src_MD-M-SAXS-homology/Makefile_MPICH_ifort-okeanos @@ -92,7 +92,7 @@ NEWCORR: ${object} xdrf/libxdrf.a NEWCORR_DFA: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA #-DMYGAUSS #-DTIMING -NEWCORR_DFA: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_NEWCORR-SAXS-homology-DFA.exe +NEWCORR_DFA: BIN = ~/bin/unres-mult-symetr_KCC_ifort_MPICH-okeanos_NEWCORR-SAXS-homology-DFA-D.exe NEWCORR_DFA: ${object} dfa.o xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo | true diff --git a/source/unres/src_MD-M-SAXS-homology/brown_step.F b/source/unres/src_MD-M-SAXS-homology/brown_step.F index 49652b8..8bab9c0 100644 --- a/source/unres/src_MD-M-SAXS-homology/brown_step.F +++ b/source/unres/src_MD-M-SAXS-homology/brown_step.F @@ -378,7 +378,7 @@ c stop c Calculate energy and forces call zerograd call etotal(potEcomp) - potE=potEcomp(0)-potEcomp(20) + potE=potEcomp(0)-potEcomp(27) call cartgrad totT=totT+d_time totTafm=totT diff --git a/source/unres/src_MD-M-SAXS-homology/chainbuild.F b/source/unres/src_MD-M-SAXS-homology/chainbuild.F index 8bb76a0..9f7e4ac 100644 --- a/source/unres/src_MD-M-SAXS-homology/chainbuild.F +++ b/source/unres/src_MD-M-SAXS-homology/chainbuild.F @@ -41,6 +41,7 @@ C include 'COMMON.INTERACT' double precision e1(3),e2(3),e3(3) logical lprn,perbox,fail + lprn=.false. c write (iout,*) "Calling chainbuild_extconf" call orig_frame diff --git a/source/unres/src_MD-M-SAXS-homology/checkder_p.F b/source/unres/src_MD-M-SAXS-homology/checkder_p.F index 0a0c1c6..03df287 100644 --- a/source/unres/src_MD-M-SAXS-homology/checkder_p.F +++ b/source/unres/src_MD-M-SAXS-homology/checkder_p.F @@ -297,12 +297,11 @@ c aincr=1.0D-7 call etotal(energia(0)) etot=energia(0) call enerprint(energia(0)) - call flush(iout) c write (iout,*) "enter cartgrad" - call flush(iout) +c call flush(iout) call cartgrad c write (iout,*) "exit cartgrad" - call flush(iout) +c call flush(iout) icall =1 write (iout,'(//27(1h*)," Checking energy gradient ",27(1h*))') write (iout,'(//4x,3a12,3x,3a12)')"gcart_x","gcart_y","gcart_z", diff --git a/source/unres/src_MD-M-SAXS-homology/cored.T b/source/unres/src_MD-M-SAXS-homology/cored.T index 772e343..067e7a6 100644 --- a/source/unres/src_MD-M-SAXS-homology/cored.T +++ b/source/unres/src_MD-M-SAXS-homology/cored.T @@ -1,14 +1,14 @@ -2cif418.4.504/19/1619:38:19ftn1LINUXLINUX +2cif419.0.202/25/2009:59:45ftn1LINUXLINUX 18120002000 -7/opt/cray/cce/8.4.5/cftn/x86-64/nls/En/ftn.cat1 ../../../opt/cray/cce/8.4.5/cftn/x86-64/nls/En/ftn.cat -380300000/tmp/pe_23705/cored_1.s/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.T07218/opt/cray/cce/8.4.5/craylibs/x86-64/include/usr/include/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include/opt/cray-hss-devel/7.2.0/include20/opt/cray/cce/8.4.5/craylibs/x86-64/libmodules.a/opt/cray/cce/8.4.5/craylibs/x86-64/libomp.a/opt/cray/cce/8.4.5/craylibs/x86-64/omp_lib.a/opt/cray/cce/8.4.5/craylibs/x86-64/libopenacc.a/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include/opt/cray-hss-devel/7.2.0/include0 +7/opt/cray/pe/cce/9.0.2/cce/x86_64/share/nls/En/ftn.cat1 ../../../opt/cray/pe/cce/9.0.2/cce/x86_64/share/nls/En/ftn.cat +380300000/tmp/pe_21777/cored_1.s/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.T07219/include/opt/cray/pe/cce/9.0.2/cce-clang/x86_64/lib/clang/9.0.0/include/opt/cray/pe/cce/9.0.2/cce/x86_64/include/craylibs/usr/include/usr/include/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include/opt/cray/pe/pmi/5.0.14/include/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include/opt/cray-hss-devel/9.0.0/include/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include20.//opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libmodules.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libomp.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/omp_lib.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libopenacc.a/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include/opt/cray/pe/pmi/5.0.14/include/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include/opt/cray-hss-devel/9.0.0/include/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libcraymp.a0 3x86-64haswellariesNo_Target -30ftn_driver.exe -hcpu=haswell -hstatic -D__CRAYXC -D__CRAY_HASWELL -D__CRAYXT_COMPUTE_LINUX_TARGET -hnetwork=aries -c -g -CA -CB -DPROCOR -DCRAY -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 -DNEWCORR -I/opt/cray/cce/8.4.5/craylibs/x86-64/include -I/usr/include -I/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include -I/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include -I/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include -I/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include -I/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include -I/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include -I/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include -I/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include -I/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include -I/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include -I/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include -I/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include -I/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include -I/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include -I/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include -I/opt/cray-hss-devel/7.2.0/include cored.f -30-O cache0,fp0,scalar0,thread0,vector0,mpi0,modinline,ipa0,noaggress -O autoprefetch,noautothread,fusion0,nomsgs,negmsgs,nooverindex -O nopattern,shortcircuit2,unroll0,nozeroinc -h noadd_paren,align_arrays,nobounds,caf,noconcurrent,nocontiguous -h nocontiguous_assumed_shape,fp_trap,nofunc_trace,nomessage -h noomp_analyze,noomp_trace,nopat_trace,safe_addr -h omp,noacc -h flex_mp=default -h cpu=x86-64,haswell -h network=aries -K trap=none -s default32 -eh -g -d abcdefgijnopvzBDEFIPQRSTZ0 -e mqswAC -7/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.f2cored.f../../../lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.f +30ftn_driver.exe -hcpu=haswell -hdynamic -D__CRAYXC -D__CRAY_HASWELL -D__CRAYXT_COMPUTE_LINUX_TARGET -hnetwork=aries -c -g -CA -CB -mcmodel=medium -shared-intel -I/include -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA cored.f -I/opt/cray/pe/cce/9.0.2/cce-clang/x86_64/lib/clang/9.0.0/include -I/opt/cray/pe/cce/9.0.2/cce/x86_64/include/craylibs -I/usr/include -I/usr/include -I/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include -I/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include -I/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include -I/opt/cray/pe/pmi/5.0.14/include -I/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include -I/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include -I/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include -I/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include -I/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include -I/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include -I/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include -I/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include -I/opt/cray-hss-devel/9.0.0/include -I/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include +30-h scalar0,vector0,unroll0,fusion0,cache0,noaggress -h ipa0,mpi0,nopattern,modinline -h fp2=approx,flex_mp=default,alias=default:standard_restrict -h nofma -h autoprefetch,noconcurrent,nooverindex,shortcircuit2 -h noadd_paren,zeroinc,noheap_allocate -h align_arrays,nocontiguous,nocontiguous_assumed_shape -h thread2,nothread_do_concurrent,noautothread,safe_addr -h noomp,caf,noacc -h nofunc_trace,noomp_analyze,noomp_trace,nopat_trace -h nobounds -h nomsgs,nonegmsgs,novector_classic -h dynamic (or -dynamic) -h cpu=x86-64,haswell,network=aries -h fp_trap -K trap=none -s default32 -g -d 0abcdefgijnopvxzBDEFGINPQSTZ (default) -e hmqwACKRX (default) +7/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.f2cored.f../../../lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.f 620 -11$MAIN0010 -9161623210112 102Cray Fortran : 2 errors found in command line. Compilation aborted. +11$MAIN2111 +9161623210114 10Cray Fortran : 4 errors found in command line. Compilation aborted. 5843211000 53$MAIN34000000 5942411 diff --git a/source/unres/src_MD-M-SAXS-homology/cored.Tfe b/source/unres/src_MD-M-SAXS-homology/cored.Tfe index 772e343..067e7a6 100644 --- a/source/unres/src_MD-M-SAXS-homology/cored.Tfe +++ b/source/unres/src_MD-M-SAXS-homology/cored.Tfe @@ -1,14 +1,14 @@ -2cif418.4.504/19/1619:38:19ftn1LINUXLINUX +2cif419.0.202/25/2009:59:45ftn1LINUXLINUX 18120002000 -7/opt/cray/cce/8.4.5/cftn/x86-64/nls/En/ftn.cat1 ../../../opt/cray/cce/8.4.5/cftn/x86-64/nls/En/ftn.cat -380300000/tmp/pe_23705/cored_1.s/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.T07218/opt/cray/cce/8.4.5/craylibs/x86-64/include/usr/include/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include/opt/cray-hss-devel/7.2.0/include20/opt/cray/cce/8.4.5/craylibs/x86-64/libmodules.a/opt/cray/cce/8.4.5/craylibs/x86-64/libomp.a/opt/cray/cce/8.4.5/craylibs/x86-64/omp_lib.a/opt/cray/cce/8.4.5/craylibs/x86-64/libopenacc.a/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include/opt/cray-hss-devel/7.2.0/include0 +7/opt/cray/pe/cce/9.0.2/cce/x86_64/share/nls/En/ftn.cat1 ../../../opt/cray/pe/cce/9.0.2/cce/x86_64/share/nls/En/ftn.cat +380300000/tmp/pe_21777/cored_1.s/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.T07219/include/opt/cray/pe/cce/9.0.2/cce-clang/x86_64/lib/clang/9.0.0/include/opt/cray/pe/cce/9.0.2/cce/x86_64/include/craylibs/usr/include/usr/include/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include/opt/cray/pe/pmi/5.0.14/include/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include/opt/cray-hss-devel/9.0.0/include/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include20.//opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libmodules.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libomp.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/omp_lib.a/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libopenacc.a/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include/opt/cray/pe/pmi/5.0.14/include/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include/opt/cray-hss-devel/9.0.0/include/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include/opt/cray/pe/cce/9.0.2/cce/x86_64/lib/libcraymp.a0 3x86-64haswellariesNo_Target -30ftn_driver.exe -hcpu=haswell -hstatic -D__CRAYXC -D__CRAY_HASWELL -D__CRAYXT_COMPUTE_LINUX_TARGET -hnetwork=aries -c -g -CA -CB -DPROCOR -DCRAY -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 -DNEWCORR -I/opt/cray/cce/8.4.5/craylibs/x86-64/include -I/usr/include -I/opt/cray/mpt/7.3.2/gni/mpich-cray/8.3/include -I/opt/cray/libsci/16.03.1/CRAY/8.3/x86_64/include -I/opt/cray/rca/1.0.0-2.0502.60530.1.62.ari/include -I/opt/cray/pmi/5.0.10-1.0000.11050.0.0.ari/include -I/opt/cray/xpmem/0.1-2.0502.64982.5.3.ari/include -I/opt/cray/dmapp/7.0.1-1.0502.11080.8.76.ari/include -I/opt/cray/gni-headers/4.0-1.0502.10859.7.8.ari/include -I/opt/cray/ugni/6.0-1.0502.10863.8.29.ari/include -I/opt/cray/udreg/2.3.2-1.0502.10518.2.17.ari/include -I/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/../include -I/opt/cray/cce/8.4.5/craylibs/x86-64/pkgconfig/..//include -I/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include -I/opt/cray/wlm_detect/1.0-1.0502.64649.2.1.ari/include -I/opt/cray/alps/5.2.4-2.0502.9774.31.11.ari/include -I/opt/cray/krca/1.0.0-2.0502.63139.4.31.ari/include -I/opt/cray-hss-devel/7.2.0/include cored.f -30-O cache0,fp0,scalar0,thread0,vector0,mpi0,modinline,ipa0,noaggress -O autoprefetch,noautothread,fusion0,nomsgs,negmsgs,nooverindex -O nopattern,shortcircuit2,unroll0,nozeroinc -h noadd_paren,align_arrays,nobounds,caf,noconcurrent,nocontiguous -h nocontiguous_assumed_shape,fp_trap,nofunc_trace,nomessage -h noomp_analyze,noomp_trace,nopat_trace,safe_addr -h omp,noacc -h flex_mp=default -h cpu=x86-64,haswell -h network=aries -K trap=none -s default32 -eh -g -d abcdefgijnopvzBDEFIPQRSTZ0 -e mqswAC -7/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.f2cored.f../../../lustre/tetyda/home/liwo/unres/source/unres/src_MD-M/cored.f +30ftn_driver.exe -hcpu=haswell -hdynamic -D__CRAYXC -D__CRAY_HASWELL -D__CRAYXT_COMPUTE_LINUX_TARGET -hnetwork=aries -c -g -CA -CB -mcmodel=medium -shared-intel -I/include -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 -DNEWCORR -DCORRCD -DDFA cored.f -I/opt/cray/pe/cce/9.0.2/cce-clang/x86_64/lib/clang/9.0.0/include -I/opt/cray/pe/cce/9.0.2/cce/x86_64/include/craylibs -I/usr/include -I/usr/include -I/opt/cray/pe/mpt/7.7.10/gni/mpich-cray/9.0/include -I/opt/cray/pe/libsci/19.06.1/CRAY/9.0/x86_64/include -I/opt/cray/rca/2.2.20-7.0.1.1_4.18__g8e3fb5b.ari/include -I/opt/cray/pe/pmi/5.0.14/include -I/opt/cray/xpmem/2.2.19-7.0.1.1_3.9__gdcf436c.ari/include -I/opt/cray/dmapp/7.1.1-7.0.1.1_4.19__g38cf134.ari/include -I/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include -I/opt/cray/wlm_detect/1.3.3-7.0.1.1_4.9__g7109084.ari/include -I/opt/cray/ugni/6.0.14.0-7.0.1.1_7.15__ge78e5b0.ari/include -I/opt/cray/gni-headers/5.0.12.0-7.0.1.1_6.12__g3b1768f.ari/include -I/opt/cray/alps/6.6.56-7.0.1.1_4.21__g2e60a7e4.ari/include -I/opt/cray/krca/2.2.6-7.0.1.1_5.14__gb641b12.ari/include -I/opt/cray-hss-devel/9.0.0/include -I/opt/cray/udreg/2.3.2-7.0.1.1_3.13__g8175d3d.ari/include +30-h scalar0,vector0,unroll0,fusion0,cache0,noaggress -h ipa0,mpi0,nopattern,modinline -h fp2=approx,flex_mp=default,alias=default:standard_restrict -h nofma -h autoprefetch,noconcurrent,nooverindex,shortcircuit2 -h noadd_paren,zeroinc,noheap_allocate -h align_arrays,nocontiguous,nocontiguous_assumed_shape -h thread2,nothread_do_concurrent,noautothread,safe_addr -h noomp,caf,noacc -h nofunc_trace,noomp_analyze,noomp_trace,nopat_trace -h nobounds -h nomsgs,nonegmsgs,novector_classic -h dynamic (or -dynamic) -h cpu=x86-64,haswell,network=aries -h fp_trap -K trap=none -s default32 -g -d 0abcdefgijnopvxzBDEFGINPQSTZ (default) -e hmqwACKRX (default) +7/lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.f2cored.f../../../lustre/tetyda/home/liwo/unres/source/unres/src_MD-M-SAXS-homology/cored.f 620 -11$MAIN0010 -9161623210112 102Cray Fortran : 2 errors found in command line. Compilation aborted. +11$MAIN2111 +9161623210114 10Cray Fortran : 4 errors found in command line. Compilation aborted. 5843211000 53$MAIN34000000 5942411 diff --git a/source/unres/src_MD-M-SAXS-homology/cored.f b/source/unres/src_MD-M-SAXS-homology/cored.f index 1cf25e5..87e13f6 100644 --- a/source/unres/src_MD-M-SAXS-homology/cored.f +++ b/source/unres/src_MD-M-SAXS-homology/cored.f @@ -1706,6 +1706,7 @@ c if (iv(1) - 2) 30, 40, 50 c 30 nf = iv(nfcall) + write (iout,*) "in humsl: before calling calcf x",x call calcf(n, x, nf, f, uiparm, urparm, ufparm) if (nf .le. 0) iv(toobig) = 1 go to 20 diff --git a/source/unres/src_MD-M-SAXS-homology/dfa.F b/source/unres/src_MD-M-SAXS-homology/dfa.F index 412943a..f69b81a 100644 --- a/source/unres/src_MD-M-SAXS-homology/dfa.F +++ b/source/unres/src_MD-M-SAXS-homology/dfa.F @@ -394,6 +394,7 @@ C DFA torsion angle double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) double precision cwidth, cwidth2 PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) + parameter (TENM20=1.0d-20) edfator= 0.0d0 enephi = 0.0d0 @@ -683,14 +684,13 @@ c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) scc=scc+sccthe(i,j) -C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), -C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) +c write(2,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), +c & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) enddo ethe=-ethe/scc*the_inc*wwangle tfthe1=tfthe1/scc*the_inc*wwangle tfthe2=tfthe2/scc*the_inc*wwangle - IF (ABS(ETHE).LT.TENM20) THEN ETHE=0.0D0 ENDIF @@ -801,7 +801,7 @@ C energy calculation ENDDO edfator = enephi + enethe - + RETURN END diff --git a/source/unres/src_MD-M-SAXS-homology/energy_p_new.F b/source/unres/src_MD-M-SAXS-homology/energy_p_new.F deleted file mode 100644 index 792804a..0000000 --- a/source/unres/src_MD-M-SAXS-homology/energy_p_new.F +++ /dev/null @@ -1,8385 +0,0 @@ - subroutine etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -c print *,"Processor",myrank," computed USCSC" - call vec_and_deriv -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0 - ecorr5=0 - ecorr6=0 - eturn6=0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) - else - ecorr=0 - ecorr5=0 - ecorr6=0 - eturn6=0 - endif -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - if (loc_qlike) then - call Econstr_back_qlike - else - call Econstr_back - endif - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -c print *,"Processor",myrank," computed Uconstr" -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) -c print *," Processor",myrank," left SUM_ENERGY" - return - end -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif - evdw=energia(1) -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef TIMING - time01=MPI_Wtime() -#endif -#ifdef DEBUG - write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" - do i=1,nres-1 - write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') - & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) - enddo - write (iout,*) "gcorr4_turn, gel_loc_turn4" - do i=1,nres-1 - write (iout,'(i5,3f10.5,2x,f10.5)') - & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) - enddo -#endif - do i=nnt,nres-1 - do k=1,3 - gvdwc(k,i)=0.0d0 - gvdwc_scp(k,i)=0.0d0 - enddo - do j=i+1,nres - do k=1,3 - gvdwc(k,i)=gvdwc(k,i)+gvdwc(k,j) - gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scp(k,j) - enddo - enddo - enddo - do i=nnt,nct-1 - do k=1,3 - gelc(k,i)=gelc(k,i)+0.5d0*gelc_long(k,i) - gvdwpp(k,i)=0.5d0*gvdwpp(k,i) - gvdwc_scp(k,i)=gvdwc_scp(k,i)+0.5d0*gvdwc_scpp(k,i) - enddo - do j=i+1,nct-1 - do k=1,3 - gelc(k,i)=gelc(k,i)+gelc_long(k,j) - gvdwpp(k,i)=gvdwpp(k,i)+gvdwpp(k,j) - gvdwc_scp(k,i)=gvdwc_scp(k,i)+gvdwc_scpp(k,j) - enddo - enddo - enddo - do i=nnt,nct-1 - do k=1,3 - gel_loc(k,i)=gel_loc(k,i)+0.5d0*gel_loc_long(k,i) - enddo - do j=i+1,nres-1 - do k=1,3 - gel_loc(k,i)=gel_loc(k,i)+gel_loc_long(k,j) - enddo - enddo - enddo - do k=1,3 - gvdwc_scp(k,nres)=0.0d0 - gvdwc(k,nres)=0.0d0 - gel_loc(k,nres)=0.0d0 - enddo -C -C Sum up the components of the Cartesian gradient. -C -#ifdef SPLITELE - do i=1,nct - do j=1,3 - gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ - & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ - & wbond*gradb(j,i)+ - & wstrain*ghpbc(j,i)+ - & wcorr*gradcorr(j,i)+ - & wel_loc*gel_loc(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ - & welec*gelc(j,i)+wstrain*ghpbc(j,i)+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wel_loc*gel_loc(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - & +wsccor*gsccor_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER, - & king,FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact - - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) - evdw=energia(1) - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ebr*nss, - & Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ebr*nss,Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (ri' - do k=1,3 - ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) - enddo - endif - do k=1,3 - gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) - enddo - kstart=min0(i+1,j) - kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) - do k=kstart,kend - do l=1,3 - gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) - enddo - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - dimension ggg(3) - ehpb=0.0D0 -cd print *,'edis: nhpb=',nhpb,' fbr=',fbr -cd print *,'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif - do j=iii,jjj-1 - do k=1,3 - ghpbc(k,j)=ghpbc(k,j)+ggg(k) - enddo - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo - do k=1,3 - ghpbx(k,i)=ghpbx(k,i)-gg(k) - & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+gg(k) - & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do k=i,j-1 - do l=1,3 - ghpbc(l,k)=ghpbc(l,k)+gg(l) - enddo - enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 -C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=iphi_start,iphi_end - esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) - phii=phi(i) - gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ -#ifdef MPI - subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,maxconts,maxres,8), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) - num_kont=num_cont_hb(atom) - do i=1,num_kont - do k=1,8 - do j=1,3 - buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k) - enddo ! j - enddo ! k - buffer(i,indx+25)=facont_hb(i,atom) - buffer(i,indx+26)=ees0p(i,atom) - buffer(i,indx+27)=ees0m(i,atom) - buffer(i,indx+28)=d_cont(i,atom) - buffer(i,indx+29)=dfloat(jcont_hb(i,atom)) - enddo ! i - buffer(1,indx+30)=dfloat(num_kont) - return - end -c------------------------------------------------------------------------------ - subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,maxconts,maxres,8), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) - num_kont=buffer(1,indx+30) - num_kont_old=num_cont_hb(atom) - num_cont_hb(atom)=num_kont+num_kont_old - do i=1,num_kont - ii=i+num_kont_old - do k=1,8 - do j=1,3 - zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j) - enddo ! j - enddo ! k - facont_hb(ii,atom)=buffer(i,indx+25) - ees0p(ii,atom)=buffer(i,indx+26) - ees0m(ii,atom)=buffer(i,indx+27) - d_cont(i,atom)=buffer(i,indx+28) - jcont_hb(ii,atom)=buffer(i,indx+29) - enddo ! i - return - end -c------------------------------------------------------------------------------ -#endif - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+6)) - parameter (msglen1=max_cont*max_dim) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) - integer status(MPI_STATUS_SIZE) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=fg_rank+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(fg_rank,2) -c write (*,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (fg_rank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -c write (*,*) 'The BUFFER array:' -c do i=1,nn -c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30) -c enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -c do i=1,nn -c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30) -c enddo - num_cont_hb(iatel_s)=0 - endif -cd write (iout,*) 'Processor ',fg_rank,MyRank, -cd & ' is sending correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen -c write (*,*) 'Processor ',fg_rank,MyRank, -c & ' is sending correlation contribution to processor',fg_rank-1, -c & ' msglen=',msglen,' CorrelType=',CorrelType - time00=MPI_Wtime() - call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, - & CorrelType,FG_COMM,IERROR) - time_sendrecv=time_sendrecv+MPI_Wtime()-time00 -cd write (iout,*) 'Processor ',fg_rank, -cd & ' has sent correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -c write (*,*) 'Processor ',fg_rank, -c & ' has sent correlation contribution to processor',fg_rank-1, -c & ' msglen=',msglen,' CorrelID=',CorrelID -c msglen=msglen1 - endif ! (fg_rank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (fg_rank.lt.nfgtasks-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',fg_rank, -cd & ' is receiving correlation contribution from processor',fg_rank+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -c write (*,*) 'Processor',fg_rank, -c &' is receiving correlation contribution from processor',fg_rank+1, -c & ' msglen=',msglen,' CorrelType=',CorrelType - time00=MPI_Wtime() - nbytes=-1 - do while (nbytes.le.0) - call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR) - call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR) - enddo -c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes - call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, - & fg_rank+1,CorrelType,FG_COMM,status,IERROR) - time_sendrecv=time_sendrecv+MPI_Wtime()-time00 -c write (*,*) 'Processor',fg_rank, -c &' has received correlation contribution from processor',fg_rank+1, -c & ' msglen=',msglen,' nbytes=',nbytes -c write (*,*) 'The received BUFFER array:' -c do i=1,max_cont -c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60) -c enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) - endif ! msglen.eq.msglen1 - endif ! fg_rank.lt.nfgtasks-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=iatel_s,iatel_e+1 - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1 .or. j1.eq.j-1) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include 'mpif.h' - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+6)) -c parameter (msglen1=max_cont*max_dim*4) - parameter (msglen1=max_cont*max_dim/2) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) - integer status(MPI_STATUS_SIZE) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - logical lprn,ldone -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - n_corr=0 - n_corr1=0 - if (fgProcs.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=MyID+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(MyRank,2) -cd write (iout,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -cd write (iout,*) 'The BUFFER array:' -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30) -cd enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30) -cd enddo - num_cont_hb(iatel_s)=0 - endif -cd write (*,*) 'Processor ',fg_rank,MyRank, -cd & ' is sending correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen -cd write (*,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - time00=MPI_Wtime() - call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, - & CorrelType,FG_COMM,IERROR) - time_sendrecv=time_sendrecv+MPI_Wtime()-time00 -cd write (*,*) 'Processor ',fg_rank,MyRank, -cd & ' has sent correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -cd write (*,*) 'Processor ',fg_rank, -cd & ' has sent correlation contribution to processor',fg_rank-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID - msglen=msglen1 - endif ! (MyRank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (fg_rank.lt.nfgtasks-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',fg_rank, -cd & ' is receiving correlation contribution from processor',fg_rank+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -cd write (*,*) 'Processor',fg_rank, -cd & ' is receiving correlation contribution from processor',fg_rank+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - time00=MPI_Wtime() - nbytes=-1 - do while (nbytes.le.0) - call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR) - call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR) - enddo -cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes - call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, - & fg_rank+1,CorrelType,status,IERROR) - time_sendrecv=time_sendrecv+MPI_Wtime()-time00 -cd write (iout,*) 'Processor',fg_rank, -cd & ' has received correlation contribution from processor',fg_rank+1, -cd & ' msglen=',msglen,' nbytes=',nbytes -cd write (iout,*) 'The received BUFFER array:' -cd do i=1,max_cont -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -cd enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) - endif ! msglen.eq.msglen1 - endif ! fg_rank.lt.nfgtasks-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms - do i=iatel_s,iatel_e+1 - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1 .or. j1.eq.j-1) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont - call calc_eello(i,j,i+1,j1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,2i5,0pf7.3)') - 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk) - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk) - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,2i5,0pf7.3)') - 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,j,i+1,j1 - if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,j,i+1,j1,jj,kk)), -cd & dabs(eello5(i,j,i+1,j1,jj,kk)), -cd & dabs(eello6(i,j,i+1,j1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (j.eq.i+4 .and. j1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - 1 'eturn6',i,j,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,*)'Contacts have occurred for peptide groups',i,j, -c & ' and',k,l -c write (iout,*)'Contacts have occurred for peptide groups', -c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees -C Calculate the multi-body contribution to energy. - ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - do ll=1,3 - ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb2(ll,jj,i)) - ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb2(ll,kk,k)) - enddo - do m=i+1,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) - enddo - enddo - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i) - ggg1(ll)=eel4*g_contij(ll,1) - ggg2(ll)=eel4*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) -cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) - enddo - enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont - do ll=1,3 - ggg1(ll)=eel5*g_contij(ll,1) - ggg2(ll)=eel5*g_contij(ll,2) -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) - enddo - enddo -c1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) - enddo - enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 - ggg1(ll)=eel6*g_contij(ll,1) - ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) - enddo - enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C \ /l\ /j\ / -C \ / \ / \ / -C o| o | | o |o -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C j|/k\| / |/k\|l / -C / \ / / \ / -C / o / o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o \ o \ -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 - ggg1(ll)=eel_turn6*g_contij(ll,1) - ggg2(ll)=eel_turn6*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) - enddo - enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F b/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F index 85a9d92..cd35d35 100644 --- a/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F +++ b/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F @@ -58,6 +58,10 @@ C FG slaves as WEIGHTS array. weights_(21)=wsccor weights_(22)=wtube weights_(26)=wsaxs + weights_(28)=wdfa_dist + weights_(29)=wdfa_tor + weights_(30)=wdfa_nei + weights_(31)=wdfa_beta C FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) @@ -86,6 +90,10 @@ C FG slaves receive the WEIGHTS array wsccor=weights(21) wtube=weights(22) wsaxs=weights(26) + wdfa_dist=weights_(28) + wdfa_tor=weights_(29) + wdfa_nei=weights_(30) + wdfa_beta=weights_(31) endif time_Bcast=time_Bcast+MPI_Wtime()-time00 time_Bcastw=time_Bcastw+MPI_Wtime()-time00 @@ -1273,33 +1281,33 @@ C Bartek & edfabet,wdfa_beta, & etot 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, + & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ + & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ + & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ + & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/ + & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ + & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ + & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ + & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ + & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ + & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6, & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ + & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ + & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ + & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ + & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ + & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ + & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/ + & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ + & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/ + & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/ & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/ @@ -1320,32 +1328,32 @@ C Bartek & edfabet,wdfa_beta, & etot 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, + & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ + & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ + & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ + & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ + & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ + & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ + & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ + & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ + & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6, & ' (SS bridges & dist. restr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ + & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ + & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ + & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ + & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ + & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ + & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/ + & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ + & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/ + & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/ & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/ diff --git a/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F.safe b/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F.safe deleted file mode 100644 index 67da3ed..0000000 --- a/source/unres/src_MD-M-SAXS-homology/energy_p_new_barrier.F.safe +++ /dev/null @@ -1,12561 +0,0 @@ - subroutine etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.SPLITELE' - include 'COMMON.TORCNSTR' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wtube - weights_(26)=wsaxs -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wtube=weights(22) - wsaxs=weights(26) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING - time00=MPI_Wtime() -#endif -C -C Compute the side-chain and electrostatic interaction energy -C -C print *,ipot - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw) -C print *,"bylem w egb" - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -cmc -cmc Sep-06: egb takes care of dynamic ss bonds too -cmc -c if (dyn_ss) call dyn_set_nss - -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING - time01=MPI_Wtime() -#endif - call vec_and_deriv -#ifdef TIMING - time_vec=time_vec+MPI_Wtime()-time01 -#endif -C Introduction of shielding effect first for each peptide group -C the shielding factor is set this factor is describing how each -C peptide group is shielded by side-chains -C the matrix - shield_fac(i) the i index describe the ith between i and i+1 -C write (iout,*) "shield_mode",shield_mode - if (shield_mode.eq.1) then - call set_shield_fac - else if (shield_mode.eq.2) then - call set_shield_fac2 - endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else - write (iout,*) "Soft-spheer ELEC potential" -c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, -c & eello_turn4) - endif -c#ifdef TIMING -c time_enecalc=time_enecalc+MPI_Wtime()-time00 -c#endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd write (iout,*) 'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - if (tor_mode.eq.0) then - call ebend(ebe) - else -C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the -C energy function - call ebend_kcc(ebe) - endif - else - ebe=0.0d0 - endif - ethetacnstr=0.0d0 - if (with_theta_constr) call etheta_constr(ethetacnstr) -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C -C print *,"TU DOCHODZE?" - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm -C print *,"tor",tor_mode - if (wtor.gt.0.0d0) then - if (tor_mode.eq.0) then - call etor(etors) - else -C etor kcc is Kubo cumulant clustered rigorous attemp to derive the -C energy function - call etor_kcc(etors) - endif - else - etors=0.0d0 - endif - edihcnstr=0.0d0 - if (ndih_constr.gt.0) call etor_constr(edihcnstr) -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -C print *,"PRZED MULIt" -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write(2,*)'MULTIBODY_EELLO n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 -c call flush(iout) - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then -c write (iout,*) "Before MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6, -c & n_corr,n_corr1 -c call flush(iout) - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -c write (iout,*) "MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6,n_corr, -c & n_corr1 -c call flush(iout) - endif -c print *,"Processor",myrank," computed Ucorr" -c write (iout,*) "nsaxs",nsaxs," saxs_mode",saxs_mode - if (nsaxs.gt.0 .and. saxs_mode.eq.0) then - call e_saxs(Esaxs_constr) -c write (iout,*) "From Esaxs: Esaxs_constr",Esaxs_constr - else if (nsaxs.gt.0 .and. saxs_mode.gt.0) then - call e_saxsC(Esaxs_constr) -c write (iout,*) "From EsaxsC: Esaxs_constr",Esaxs_constr - else - Esaxs_constr = 0.0d0 - endif -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time -c if(usampl.and.totT.gt.eq_time) then -c write (iout,*) "usampl",usampl - if(usampl) then - call EconstrQ - if (loc_qlike) then - call Econstr_back_qlike - else - call Econstr_back - endif - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -C 01/27/2015 added by adasko -C the energy component below is energy transfer into lipid environment -C based on partition function -C print *,"przed lipidami" - if (wliptran.gt.0) then - call Eliptransfer(eliptran) - endif -C print *,"za lipidami" - if (AFMlog.gt.0) then - call AFMforce(Eafmforce) - else if (selfguide.gt.0) then - call AFMvel(Eafmforce) - endif - if (TUBElog.eq.1) then -C print *,"just before call" - call calctube(Etube) - elseif (TUBElog.eq.2) then - call calctube2(Etube) - else - Etube=0.0d0 - endif - -#ifdef TIMING - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING - time00=MPI_Wtime() -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=eliptran - energia(23)=Eafmforce - energia(24)=ethetacnstr - energia(25)=Etube - energia(26)=Esaxs_constr -c write (iout,*) "esaxs_constr",energia(26) -c Here are the energies showed per procesor if the are more processors -c per molecule then we sum it up in sum_energy subroutine -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) -c write (iout,*) "After sum_energy: esaxs_constr",energia(26) - if (dyn_ss) call dyn_set_nss -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING - time_sumene=time_sumene+MPI_Wtime()-time00 -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif - evdw=energia(1) -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - eliptran=energia(22) - Eafmforce=energia(23) - ethetacnstr=energia(24) - Etube=energia(25) - esaxs_constr=energia(26) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+wumb*Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce - & +ethetacnstr+wtube*Etube+wsaxs*esaxs_constr -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+wumb*Uconst+wsccor*esccor+wliptran*eliptran - & +Eafmforce - & +ethetacnstr+wtube*Etube+wsaxs*esaxs_constr -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' -#endif - double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres), - & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres) - & ,gloc_scbuf(3,-1:maxres) - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' - include 'COMMON.SCCOR' -#ifdef TIMING - time01=MPI_Wtime() -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gsaxsc, gsaxsx" - do i=0,nres - write (iout,'(i3,3e15.5,5x,3e15.5)') - & i,(gsaxsc(j,i),j=1,3),(gsaxsx(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef DEBUG - write (iout,*) "gsaxsc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(wsaxs*gsaxsc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef SPLITELE - do i=0,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - & +wliptran*gliptranc(j,i) - & +gradafm(j,i) - & +welec*gshieldc(j,i) - & +wcorr*gshieldc_ec(j,i) - & +wturn3*gshieldc_t3(j,i) - & +wturn4*gshieldc_t4(j,i) - & +wel_loc*gshieldc_ll(j,i) - & +wtube*gg_tube(j,i) - & +wsaxs*gsaxsc(j,i) - - - - enddo - enddo -#else - do i=0,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - & +wliptran*gliptranc(j,i) - & +gradafm(j,i) - & +welec*gshieldc(j,i) - & +wcorr*gshieldc_ec(j,i) - & +wturn4*gshieldc_t4(j,i) - & +wel_loc*gshieldc_ll(j,i) - & +wtube*gg_tube(j,i) - & +wsaxs*gsaxsc(j,i) - - - - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gradc from gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradc(j,i,icg),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=0,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - enddo - enddo -c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG -c write (iout,*) "gradbufc_sum after allreduce" -c do i=1,nres -c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -c enddo -c call flush(iout) -#endif -#ifdef TIMING -c time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif -c -c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -c do not parallelize this part. -c -c do i=igrad_start,igrad_end -c do j=jgrad_start(i),jgrad_end(i) -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -c enddo -c enddo -c enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,-1,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=-1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - gradbufc(j,i)=0.0d0 - enddo - enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,-1,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -c do i=nnt,nres-1 -c do k=1,3 -c gradbufc(k,i)=0.0d0 -c enddo -c do j=i+1,nres -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -c enddo -c enddo -c enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=-1,nct - do j=1,3 -#ifdef SPLITELE -C print *,gradbufc(1,13) -C print *,welec*gelc(1,13) -C print *,wel_loc*gel_loc(1,13) -C print *,0.5d0*(wscp*gvdwc_scpp(1,13)) -C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13) -C print *,wel_loc*gel_loc_long(1,13) -C print *,gradafm(1,13),"AFM" - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) - & +wliptran*gliptranc(j,i) - & +gradafm(j,i) - & +welec*gshieldc(j,i) - & +welec*gshieldc_loc(j,i) - & +wcorr*gshieldc_ec(j,i) - & +wcorr*gshieldc_loc_ec(j,i) - & +wturn3*gshieldc_t3(j,i) - & +wturn3*gshieldc_loc_t3(j,i) - & +wturn4*gshieldc_t4(j,i) - & +wturn4*gshieldc_loc_t4(j,i) - & +wel_loc*gshieldc_ll(j,i) - & +wel_loc*gshieldc_loc_ll(j,i) - & +wtube*gg_tube(j,i) - -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) - & +wliptran*gliptranc(j,i) - & +gradafm(j,i) - & +welec*gshieldc(j,i) - & +welec*gshieldc_loc(j,i) - & +wcorr*gshieldc_ec(j,i) - & +wcorr*gshieldc_loc_ec(j,i) - & +wturn3*gshieldc_t3(j,i) - & +wturn3*gshieldc_loc_t3(j,i) - & +wturn4*gshieldc_t4(j,i) - & +wturn4*gshieldc_loc_t4(j,i) - & +wel_loc*gshieldc_ll(j,i) - & +wel_loc*gshieldc_loc_ll(j,i) - & +wtube*gg_tube(j,i) - - -#endif - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) - & +wliptran*gliptranx(j,i) - & +welec*gshieldx(j,i) - & +wcorr*gshieldx_ec(j,i) - & +wturn3*gshieldx_t3(j,i) - & +wturn4*gshieldx_t4(j,i) - & +wel_loc*gshieldx_ll(j,i) - & +wtube*gg_tube_sc(j,i) - & +wsaxs*gsaxsx(j,i) - - - - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradc gradx gloc after adding" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo -c#define DEBUG -#ifdef DEBUG - write (iout,*) "gloc_sc before reduce" - do i=1,nres - do j=1,1 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif -c#undef DEBUG - do i=1,nres - do j=1,3 - gloc_scbuf(j,i)=gloc_sc(j,i,icg) - enddo - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 - call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gradc after reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gradc(j,i,icg) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc_sc after reduce" - do i=1,nres - do j=1,1 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#if (defined AIX || defined CRAY) - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - if (shield_mode.gt.0) then - wscp=weights(2)*fact - wsc=weights(1)*fact - wvdwpp=weights(16)*fact - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact - if (scale_umb) wumb=t_bath/temp0 -c write (iout,*) "scale_umb",scale_umb -c write (iout,*) "t_bath",t_bath," temp0",temp0," wumb",wumb - - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) - evdw=energia(1) - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - eliptran=energia(22) - Eafmforce=energia(23) - ethetacnstr=energia(24) - etube=energia(25) - esaxs=energia(26) -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr, - & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc, - & etube,wtube,esaxs,wsaxs, - & etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ - & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ - & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ - & 'ETOT= ',1pE16.6,' (total)') - -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc, - & etube,wtube,esaxs,wsaxs, - & etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. restr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ - & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ - & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) - if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j)) - if (itypj.eq.ntyp1) cycle - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 -C have you changed here? - e1=fac*fac*aa - e2=fac*bb - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (ri' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i -C enddo !zshift -C enddo !yshift -C enddo !xshift - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - integer xshift,yshift,zshift - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -c print *,boxxsize,boxysize,boxzsize,'wymiary pudla' -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e -C do xshift=-1,1 -C do yshift=-1,1 -C do zshift=-1,1 - if (energy_dec) write (iout,*) "escp:",r_cut,rlamb - do i=iatscp_s,iatscp_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - xi=mod(xi,boxxsize) - if (xi.lt.0) xi=xi+boxxsize - yi=mod(yi,boxysize) - if (yi.lt.0) yi=yi+boxysize - zi=mod(zi,boxzsize) - if (zi.lt.0) zi=zi+boxzsize -c xi=xi+xshift*boxxsize -c yi=yi+yshift*boxysize -c zi=zi+zshift*boxzsize -c print *,xi,yi,zi,'polozenie i' -C Return atom into box, boxxsize is size of box in x dimension -c 134 continue -c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize -c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize -C Condition for being inside the proper box -c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or. -c & (xi.lt.((xshift-0.5d0)*boxxsize))) then -c go to 134 -c endif -c 135 continue -c print *,xi,boxxsize,"pierwszy" - -c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize -c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize -C Condition for being inside the proper box -c if ((yi.gt.((yshift+0.5d0)*boxysize)).or. -c & (yi.lt.((yshift-0.5d0)*boxysize))) then -c go to 135 -c endif -c 136 continue -c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize -c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize -C Condition for being inside the proper box -c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or. -c & (zi.lt.((zshift-0.5d0)*boxzsize))) then -c go to 136 -c endif - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=iabs(itype(j)) - if (itypj.eq.ntyp1) cycle -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j) - yj=c(2,j) - zj=c(3,j) - xj=mod(xj,boxxsize) - if (xj.lt.0) xj=xj+boxxsize - yj=mod(yj,boxysize) - if (yj.lt.0) yj=yj+boxysize - zj=mod(zj,boxzsize) - if (zj.lt.0) zj=zj+boxzsize -c 174 continue -c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize -c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize -C Condition for being inside the proper box -c if ((xj.gt.((0.5d0)*boxxsize)).or. -c & (xj.lt.((-0.5d0)*boxxsize))) then -c go to 174 -c endif -c 175 continue -c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize -c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize -cC Condition for being inside the proper box -c if ((yj.gt.((0.5d0)*boxysize)).or. -c & (yj.lt.((-0.5d0)*boxysize))) then -c go to 175 -c endif -c 176 continue -c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize -c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize -C Condition for being inside the proper box -c if ((zj.gt.((0.5d0)*boxzsize)).or. -c & (zj.lt.((-0.5d0)*boxzsize))) then -c go to 176 -c endif -CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE - dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - xj_safe=xj - yj_safe=yj - zj_safe=zj - subchap=0 - do xshift=-1,1 - do yshift=-1,1 - do zshift=-1,1 - xj=xj_safe+xshift*boxxsize - yj=yj_safe+yshift*boxysize - zj=zj_safe+zshift*boxzsize - dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - if(dist_temp.lt.dist_init) then - dist_init=dist_temp - xj_temp=xj - yj_temp=yj - zj_temp=zj - subchap=1 - endif - enddo - enddo - enddo - if (subchap.eq.1) then - xj=xj_temp-xi - yj=yj_temp-yi - zj=zj_temp-zi - else - xj=xj_safe-xi - yj=yj_safe-yi - zj=zj_safe-zi - endif -c print *,xj,yj,zj,'polozenie j' - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c print *,rrij - sss=sscale(1.0d0/(dsqrt(rrij))) -c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz' -c if (sss.eq.0) print *,'czasem jest OK' - if (sss.le.0.0d0) cycle - sssgrad=sscagrad(1.0d0/(dsqrt(rrij))) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*sss - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*sss - if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') - & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli), - & bad(itypj,iteli) -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*sss - fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo -c endif !endif for sscale cutoff - enddo ! j - - enddo ! iint - enddo ! i -c enddo !zshift -c enddo !yshift -c enddo !xshift - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - ehpb=0.0D0 - do i=1,3 - ggg(i)=0.0d0 - enddo -C write (iout,*) ,"link_end",link_end,constr_dist -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -c write(iout,*)'link_start=',link_start,' link_end=',link_end, -c & " constr_dist",constr_dist - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, -c & dhpb(i),dhpb1(i),forcon(i) -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. -C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. -C & iabs(itype(jjj)).eq.1) then -cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then -C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds - if (.not.dyn_ss .and. i.le.nss) then -C 15/02/13 CC dynamic SSbond - additional check - if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. - & iabs(itype(jjj)).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij - endif -cd write (iout,*) "eij",eij -cd & ' waga=',waga,' fac=',fac -! else if (ii.gt.nres .and. jj.gt.nres) then - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - if (irestr_type(i).eq.11) then - ehpb=ehpb+fordepth(i)!**4.0d0 - & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) - fac=fordepth(i)!**4.0d0 - & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd - if (energy_dec) write (iout,'(a6,2i5,6f10.3,i5)') - & "edisL",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i), - & ehpb,irestr_type(i) - else if (irestr_type(i).eq.10) then -c AL 6//19/2018 cross-link restraints - xdis = 0.5d0*(dd/forcon(i))**2 - expdis = dexp(-xdis) -c aux=(dhpb(i)+dhpb1(i)*xdis)*expdis+fordepth(i) - aux=(dhpb(i)+dhpb1(i)*xdis*xdis)*expdis+fordepth(i) -c write (iout,*)"HERE: xdis",xdis," expdis",expdis," aux",aux, -c & " wboltzd",wboltzd - ehpb=ehpb-wboltzd*xlscore(i)*dlog(aux) -c fac=-wboltzd*(dhpb1(i)*(1.0d0-xdis)-dhpb(i)) - fac=-wboltzd*xlscore(i)*(dhpb1(i)*(2.0d0-xdis)*xdis-dhpb(i)) - & *expdis/(aux*forcon(i)**2) - if (energy_dec) write(iout,'(a6,2i5,6f10.3,i5)') - & "edisX",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i), - & -wboltzd*xlscore(i)*dlog(aux),irestr_type(i) - else if (irestr_type(i).eq.2) then -c Quartic restraints - ehpb=ehpb+forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)') - & "edisQ",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i), - & forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)),irestr_type(i) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd - else -c Quadratic restraints - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+0.5d0*waga*rdis*rdis - if (energy_dec) write(iout,'(a6,2i5,5f10.3,i5)') - & "edisS",ii,jj,dd,dhpb(i),dhpb1(i),forcon(i), - & 0.5d0*waga*rdis*rdis,irestr_type(i) -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif -c Calculate Cartesian gradient - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=iabs(itype(i)) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=iabs(itype(j)) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - estr1=0.0d0 - do i=ibondp_start,ibondp_end - if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle -c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) -c do j=1,3 -c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) -c & *dc(j,i-1)/vbld(i) -c enddo -c if (energy_dec) write(iout,*) -c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) -c else -C Checking if it involves dummy (NH3+ or COO-) group - if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then -C YES vbldpDUM is the equlibrium length of spring for Dummy atom - diff = vbld(i)-vbldpDUM - if (energy_dec) write(iout,*) "dum_bond",i,diff - else -C NO vbldp0 is the equlibrium lenght of spring for peptide group - diff = vbld(i)-vbldp0 - endif - if (energy_dec) write (iout,'(a7,i5,4f7.3)') - & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) -c endif - enddo - - estr=0.5d0*AKP*estr+estr1 -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=iabs(itype(i)) - if (iti.ne.10 .and. iti.ne.ntyp1) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) - if (energy_dec) write (iout,*) - & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff, - & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.TORCNSTR' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end - if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 - & .or.itype(i).eq.ntyp1) cycle -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - ichir1=isign(1,itype(i-2)) - ichir2=isign(1,itype(i)) - if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) - if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) - if (itype(i-1).eq.10) then - itype1=isign(10,itype(i-2)) - ichir11=isign(1,itype(i-2)) - ichir12=isign(1,itype(i-2)) - itype2=isign(10,itype(i)) - ichir21=isign(1,itype(i)) - ichir22=isign(1,itype(i)) - endif - - if (i.gt.3 .and. itype(i-3).ne.ntyp1) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres .and. itype(i+1).ne.ntyp1) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) -#endif - z(1)=dcos(phii1) - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it,ichir1,ichir2) - bthetk=bthet(k,it,ichir1,ichir2) - if (it.eq.10) then - athetk=athet(k,itype1,ichir11,ichir12) - bthetk=bthet(k,itype2,ichir21,ichir22) - endif - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) -c write(iout,*) 'chuj tu', y(k),z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) - &+athet(2,it,ichir1,ichir2)*y(1))*ss - dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) - & +bthet(2,it,ichir1,ichir2)*z(1))*ss - if (it.eq.10) then - dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) - &+athet(2,itype1,ichir11,ichir12)*y(1))*ss - dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) - & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss - endif - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)') - & 'ebend',i,ethetai,theta(i),itype(i) - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg) - enddo - -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distributioni. -ccc write (iout,*) thetai,thet_pred_mean - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C write (iout,*) 'termexp',termexp,termm,termpre,i -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.TORCNSTR' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end -c print *,i,itype(i-1),itype(i),itype(i-2) - if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 - & .or.itype(i).eq.ntyp1) cycle -C print *,i,theta(i) - if (iabs(itype(i+1)).eq.20) iblock=2 - if (iabs(itype(i+1)).ne.20) iblock=1 - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp((itype(i-1))) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo -C print *,ethetai - if (i.gt.3 .and. itype(i-3).ne.ntyp1) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp((itype(i-2))) -C propagation of chirality for glycine type - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - do k=1,nsingle - ityp1=ithetyp((itype(i-2))) - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres .and. itype(i+1).ne.ntyp1) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp((itype(i))) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=ithetyp((itype(i))) - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3,iblock) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," - & aathet",aathet(k,ityp1,ityp2,ityp3,iblock), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif -C print *,ethetai - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai -C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - enddo -C print *,"cosph1", (cosph1(k), k=1,nsingle) -C print *,"cosph2", (cosph2(k), k=1,nsingle) -C print *,"sinph1", (sinph1(k), k=1,nsingle) -C print *,"sinph2", (sinph2(k), k=1,nsingle) - if (lprn) - & write(iout,*) "ethetai",ethetai -C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k) - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock), - & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock), - & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock), - & " ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue -c lprn1=.true. -C print *,ethetai - if (lprn1) - & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai -c lprn1=.false. - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai - enddo - - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.ntyp1) cycle - if (it.eq.10) goto 1 - nlobit=nlob(iabs(it)) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - if (itype(i).eq.ntyp1) cycle - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=iabs(itype(i)) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i))) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=iabs(itype(i)) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i) -c & ,zz,xx,yy -c#define DEBUG -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C -c zz=zz*dsign(1.0,dfloat(itype(i))) - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i) -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i) -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i) -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i) -#endif -c#undef DEBUG -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) - & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) - & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)* - & (z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 - & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo - return - end -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end -C ANY TWO ARE DUMMY ATOMS in row CYCLE -c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. -c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. -c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle - if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 - & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle -C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF -C For introducing the NH3+ and COO- group please check the etor_d for reference -C and guidance - etors_ii=0.0D0 - if (iabs(itype(i)).eq.20) then - iblock=2 - else - iblock=1 - endif - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1,iblock) - v1ij=v1(j,itori,itori1,iblock) - v2ij=v2(j,itori,itori1,iblock) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1,iblock) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1,iblock) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1,iblock) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1,iblock),j=1,6), - & (v2(j,itori,itori1,iblock),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 -c write(iout,*) "a tu??" - do i=iphid_start,iphid_end -C ANY TWO ARE DUMMY ATOMS in row CYCLE -C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. -C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or. -C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or. -C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle - if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or. - & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or. - & (itype(i+1).eq.ntyp1)) cycle -C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 - iblock=1 - if (iabs(itype(i+1)).eq.20) iblock=2 -C Iblock=2 Proline type -C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT -C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO- -C if (itype(i+1).eq.ntyp1) iblock=3 -C The problem of NH3+ group can be resolved by adding new parameters please note if there -C IS or IS NOT need for this -C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on -C is (itype(i-3).eq.ntyp1) ntblock=2 -C ntblock is N-terminal blocking group - -C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2,iblock) -C Example of changes for NH3+ blocking group -C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock) -C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock) - v1cij=v1c(1,j,itori,itori1,itori2,iblock) - v1sij=v1s(1,j,itori,itori1,itori2,iblock) - v2cij=v1c(2,j,itori,itori1,itori2,iblock) - v2sij=v1s(2,j,itori,itori1,itori2,iblock) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2,iblock) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2,iblock) - v2cdij = v2c(l,k,itori,itori1,itori2,iblock) - v1sdij = v2s(k,l,itori,itori1,itori2,iblock) - v2sdij = v2s(l,k,itori,itori1,itori2,iblock) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 - enddo - return - end -#endif -C---------------------------------------------------------------------------------- -C The rigorous attempt to derive energy function - subroutine etor_kcc(etors) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - double precision c1(0:maxval_kcc),c2(0:maxval_kcc) - logical lprn -c double precision thybt1(maxtermkcc),thybt2(maxtermkcc) -C Set lprn=.true. for debugging - lprn=energy_dec -c lprn=.true. -C print *,"wchodze kcc" - if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode - etors=0.0D0 - do i=iphi_start,iphi_end -C ANY TWO ARE DUMMY ATOMS in row CYCLE -c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. -c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. -c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle - if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 - & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - glocig=0.0D0 - glocit1=0.0d0 - glocit2=0.0d0 -C to avoid multiple devision by 2 -c theti22=0.5d0*theta(i) -C theta 12 is the theta_1 /2 -C theta 22 is theta_2 /2 -c theti12=0.5d0*theta(i-1) -C and appropriate sinus function - sinthet1=dsin(theta(i-1)) - sinthet2=dsin(theta(i)) - costhet1=dcos(theta(i-1)) - costhet2=dcos(theta(i)) -C to speed up lets store its mutliplication - sint1t2=sinthet2*sinthet1 - sint1t2n=1.0d0 -C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma) -C +d_n*sin(n*gamma)) * -C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2))) -C we have two sum 1) Non-Chebyshev which is with n and gamma - nval=nterm_kcc_Tb(itori,itori1) - c1(0)=0.0d0 - c2(0)=0.0d0 - c1(1)=1.0d0 - c2(1)=1.0d0 - do j=2,nval - c1(j)=c1(j-1)*costhet1 - c2(j)=c2(j-1)*costhet2 - enddo - etori=0.0d0 - do j=1,nterm_kcc(itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - sint1t2n1=sint1t2n - sint1t2n=sint1t2n*sint1t2 - sumvalc=0.0d0 - gradvalct1=0.0d0 - gradvalct2=0.0d0 - do k=1,nval - do l=1,nval - sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) - gradvalct1=gradvalct1+ - & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) - gradvalct2=gradvalct2+ - & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) - enddo - enddo - gradvalct1=-gradvalct1*sinthet1 - gradvalct2=-gradvalct2*sinthet2 - sumvals=0.0d0 - gradvalst1=0.0d0 - gradvalst2=0.0d0 - do k=1,nval - do l=1,nval - sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) - gradvalst1=gradvalst1+ - & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) - gradvalst2=gradvalst2+ - & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) - enddo - enddo - gradvalst1=-gradvalst1*sinthet1 - gradvalst2=-gradvalst2*sinthet2 - if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals - etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi) -C glocig is the gradient local i site in gamma - glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi) -C now gradient over theta_1 - glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi) - & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi) - glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi) - & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi) - enddo ! j - etors=etors+etori -C derivative over gamma - gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig -C derivative over theta1 - gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1 -C now derivative over theta2 - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2 - if (lprn) then - write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1, - & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori - write (iout,*) "c1",(c1(k),k=0,nval), - & " c2",(c2(k),k=0,nval) - endif - enddo - return - end -c--------------------------------------------------------------------------------------------- - subroutine etor_constr(edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.BOUNDS' - include 'COMMON.CONTROL' -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - if (raw_psipred) then - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - gaudih_i=vpsipred(1,i) - gauder_i=0.0d0 - do j=1,2 - s = sdihed(j,i) - cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2 - dexpcos_i=dexp(-cos_i*cos_i) - gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i - gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) - & *cos_i*dexpcos_i/s**2 - enddo - edihcnstr=edihcnstr-wdihc*dlog(gaudih_i) - gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i - if (energy_dec) - & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') - & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i), - & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i), - & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, - & -wdihc*dlog(gaudih_i) - enddo - else - - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 - else - difi=0.0 - endif - enddo - - endif - - return - end -c---------------------------------------------------------------------------- -C The rigorous attempt to derive energy function - subroutine ebend_kcc(etheta) - - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn - double precision thybt1(maxang_kcc) -C Set lprn=.true. for debugging - lprn=energy_dec -c lprn=.true. -C print *,"wchodze kcc" - if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode - etheta=0.0D0 - do i=ithet_start,ithet_end -c print *,i,itype(i-1),itype(i),itype(i-2) - if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 - & .or.itype(i).eq.ntyp1) cycle - iti=iabs(itortyp(itype(i-1))) - sinthet=dsin(theta(i)) - costhet=dcos(theta(i)) - do j=1,nbend_kcc_Tb(iti) - thybt1(j)=v1bend_chyb(j,iti) - enddo - sumth1thyb=v1bend_chyb(0,iti)+ - & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) - if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg, - & sumth1thyb - ihelp=nbend_kcc_Tb(iti)-1 - gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) - etheta=etheta+sumth1thyb -C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet - enddo - return - end -c------------------------------------------------------------------------------------- - subroutine etheta_constr(ethetacnstr) - - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - ethetacnstr=0.0d0 -C print *,ithetaconstr_start,ithetaconstr_end,"TU" - do i=ithetaconstr_start,ithetaconstr_end - itheta=itheta_constr(i) - thetiii=theta(itheta) - difi=pinorm(thetiii-theta_constr0(i)) - if (difi.gt.theta_drange(i)) then - difi=difi-theta_drange(i) - ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 - gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) - & +for_thet_constr(i)*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 - gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) - & +for_thet_constr(i)*difi**3 - else - difi=0.0 - endif - if (energy_dec) then - write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", - & i,itheta,rad2deg*thetiii, - & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), - & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, - & gloc(itheta+nphi-2,icg) - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",itau_start,itau_end - esccor=0.0D0 - do i=itau_start,itau_end - if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle - esccor_ii=0.0D0 - isccori=isccortyp(itype(i-2)) - isccori1=isccortyp(itype(i-1)) -c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1) - phii=phi(i) - do intertyp=1,3 !intertyp -cc Added 09 May 2012 (Adasko) -cc Intertyp means interaction type of backbone mainchain correlation: -c 1 = SC...Ca...Ca...Ca -c 2 = Ca...Ca...Ca...SC -c 3 = SC...Ca...Ca...SCi - gloci=0.0D0 - if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. - & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. - & (itype(i-1).eq.ntyp1))) - & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) - & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) - & .or.(itype(i).eq.ntyp1))) - & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. - & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. - & (itype(i-3).eq.ntyp1)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) - & cycle - do j=1,nterm_sccor(isccori,isccori1) - v1ij=v1sccor(j,intertyp,isccori,isccori1) - v2ij=v2sccor(j,intertyp,isccori,isccori1) - cosphi=dcos(j*tauangle(intertyp,i)) - sinphi=dsin(j*tauangle(intertyp,i)) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp - gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1, - & (v1sccor(j,intertyp,isccori,isccori1),j=1,6) - & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo !intertyp - enddo - - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.SHIELD' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" -c call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c call flush(iout) - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - include 'COMMON.SHIELD' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" -c call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) -CC & *fac_shield(i)**2*fac_shield(j)**2 - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.SHIELD' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. -C print *,"wchodze",fac_shield(i),shield_mode - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -C* -C & fac_shield(i)**2*fac_shield(j)**2 -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -C ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees -C print *,ekont,ees,i,k - ehbcorr=ekont*ees -C now gradient over shielding -C return - if (shield_mode.gt.0) then - j=ees0plist(jj,i) - l=ees0plist(kk,k) -C print *,i,j,fac_shield(i),fac_shield(j), -C &fac_shield(k),fac_shield(l) - if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. - & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then - do ilist=1,ishield_list(i) - iresshield=shield_list(ilist,i) - do m=1,3 - rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i) -C & *2.0 - gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ - & rlocshield - & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i) - gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) - &+rlocshield - enddo - enddo - do ilist=1,ishield_list(j) - iresshield=shield_list(ilist,j) - do m=1,3 - rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j) -C & *2.0 - gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ - & rlocshield - & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j) - gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) - & +rlocshield - enddo - enddo - - do ilist=1,ishield_list(k) - iresshield=shield_list(ilist,k) - do m=1,3 - rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k) -C & *2.0 - gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ - & rlocshield - & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k) - gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) - & +rlocshield - enddo - enddo - do ilist=1,ishield_list(l) - iresshield=shield_list(ilist,l) - do m=1,3 - rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l) -C & *2.0 - gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ - & rlocshield - & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l) - gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) - & +rlocshield - enddo - enddo -C print *,gshieldx(m,iresshield) - do m=1,3 - gshieldc_ec(m,i)=gshieldc_ec(m,i)+ - & grad_shield(m,i)*ehbcorr/fac_shield(i) - gshieldc_ec(m,j)=gshieldc_ec(m,j)+ - & grad_shield(m,j)*ehbcorr/fac_shield(j) - gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ - & grad_shield(m,i)*ehbcorr/fac_shield(i) - gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ - & grad_shield(m,j)*ehbcorr/fac_shield(j) - - gshieldc_ec(m,k)=gshieldc_ec(m,k)+ - & grad_shield(m,k)*ehbcorr/fac_shield(k) - gshieldc_ec(m,l)=gshieldc_ec(m,l)+ - & grad_shield(m,l)*ehbcorr/fac_shield(l) - gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ - & grad_shield(m,k)*ehbcorr/fac_shield(k) - gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ - & grad_shield(m,l)*ehbcorr/fac_shield(l) - - enddo - endif - endif - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itype2loc(itype(j+1)) - else - itj1=nloctyp - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,i+1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,j+1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itype2loc(itype(i)) - else - iti=nloctyp - endif - itk1=itype2loc(itype(k+1)) - itj=itype2loc(itype(j)) - if (l.lt.nres-1) then - itl1=itype2loc(itype(l+1)) - else - itl1=nloctyp - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) -C AL 4/16/16: Derivatives of the quantitied related to matrices C, D, and E -c in theta; to be sriten later. -c#ifdef NEWCORR -c call transpose2(gtEE(1,1,k),auxmat(1,1)) -c call matmat2(auxmat(1,1),AEA(1,1,1),EAEAdert(1,1,1,1)) -c call transpose2(EUg(1,1,k),auxmat(1,1)) -c call matmat2(auxmat(1,1),AEAdert(1,1,1),EAEAdert(1,1,2,1)) -c#endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itype2loc(itype(i)) - else - iti=nloctyp - endif - itk1=itype2loc(itype(k+1)) - itl=itype2loc(itype(l)) - itj=itype2loc(itype(j)) - if (j.lt.nres-1) then - itj1=itype2loc(itype(j+1)) - else - itj1=nloctyp - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) -C Al 4/16/16: Derivatives in theta, to be added later. -c#ifdef NEWCORR -c gcorr_loc(nphi+l-1)=gcorr_loc(nphi+l-1) -c & -ekont*(EAEAdert(1,1,2,1)+EAEAdert(2,2,2,1)) -c#endif - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) -c#ifdef NEWCORR -c gcorr_loc(nphi+j-1)=gcorr_loc(nphi+j-1) -c & -ekont*(EAEAdert(1,1,2,1)+EAEAdert(2,2,2,1)) -c#endif - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itype2loc(itype(k)) - itl=itype2loc(itype(l)) - itj=itype2loc(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ /j\ C -C / \ / \ C -C /| o | | o |\ C -C \ j|/k\| / \ |/k\|l / C -C \ / \ / \ / \ / C -C o o o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itype2loc(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) - vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) - vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(2),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C \ /l\ /j\ / C -C \ / \ / \ / C -C o| o | | o |o C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C j|/k\| / |/k\|l / C -C / \ / / \ / C -C / o / o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itype2loc(itype(j+1)) - else - itj1=nloctyp - endif - itk=itype2loc(itype(k)) - itk1=itype2loc(itype(k+1)) - if (l.lt.nres-1) then - itl1=itype2loc(itype(l+1)) - else - itl1=nloctyp - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - call transpose2(EE(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o \ o \ C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itype2loc(itype(i)) - itj=itype2loc(itype(j)) - if (j.lt.nres-1) then - itj1=itype2loc(itype(j+1)) - else - itj1=nloctyp - endif - itk=itype2loc(itype(k)) - if (k.lt.nres-1) then - itk1=itype2loc(itype(k+1)) - else - itk1=nloctyp - endif - itl=itype2loc(itype(l)) - if (l.lt.nres-1) then - itl1=itype2loc(itype(l+1)) - else - itl1=nloctyp - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,j+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,l+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itype2loc(itype(i)) - itk=itype2loc(itype(k)) - itk1=itype2loc(itype(k+1)) - itl=itype2loc(itype(l)) - itj=itype2loc(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,l)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,k),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,k),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,l),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end -CCC---------------------------------------------- - subroutine Eliptransfer(eliptran) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - include 'COMMON.SBRIDGE' -C this is done by Adasko -C print *,"wchodze" -C structure of box: -C water -C--bordliptop-- buffore starts -C--bufliptop--- here true lipid starts -C lipid -C--buflipbot--- lipid ends buffore starts -C--bordlipbot--buffore ends - eliptran=0.0 - do i=ilip_start,ilip_end -C do i=1,1 - if (itype(i).eq.ntyp1) cycle - - positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize)) - if (positi.le.0.0) positi=positi+boxzsize -C print *,i -C first for peptide groups -c for each residue check if it is in lipid or lipid water border area - if ((positi.gt.bordlipbot) - &.and.(positi.lt.bordliptop)) then -C the energy transfer exist - if (positi.lt.buflipbot) then -C what fraction I am in - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslip=sscalelip(fracinbuf) - ssgradlip=-sscagradlip(fracinbuf)/lipbufthick - eliptran=eliptran+sslip*pepliptran - gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 - gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 -C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran - -C print *,"doing sccale for lower part" -C print *,i,sslip,fracinbuf,ssgradlip - elseif (positi.gt.bufliptop) then - fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) - sslip=sscalelip(fracinbuf) - ssgradlip=sscagradlip(fracinbuf)/lipbufthick - eliptran=eliptran+sslip*pepliptran - gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 - gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 -C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran -C print *, "doing sscalefor top part" -C print *,i,sslip,fracinbuf,ssgradlip - else - eliptran=eliptran+pepliptran -C print *,"I am in true lipid" - endif -C else -C eliptran=elpitran+0.0 ! I am in water - endif - enddo -C print *, "nic nie bylo w lipidzie?" -C now multiply all by the peptide group transfer factor -C eliptran=eliptran*pepliptran -C now the same for side chains -CV do i=1,1 - do i=ilip_start,ilip_end - if (itype(i).eq.ntyp1) cycle - positi=(mod(c(3,i+nres),boxzsize)) - if (positi.le.0) positi=positi+boxzsize -C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop -c for each residue check if it is in lipid or lipid water border area -C respos=mod(c(3,i+nres),boxzsize) -C print *,positi,bordlipbot,buflipbot - if ((positi.gt.bordlipbot) - & .and.(positi.lt.bordliptop)) then -C the energy transfer exist - if (positi.lt.buflipbot) then - fracinbuf=1.0d0- - & ((positi-bordlipbot)/lipbufthick) -C lipbufthick is thickenes of lipid buffore - sslip=sscalelip(fracinbuf) - ssgradlip=-sscagradlip(fracinbuf)/lipbufthick - eliptran=eliptran+sslip*liptranene(itype(i)) - gliptranx(3,i)=gliptranx(3,i) - &+ssgradlip*liptranene(itype(i)) - gliptranc(3,i-1)= gliptranc(3,i-1) - &+ssgradlip*liptranene(itype(i)) -C print *,"doing sccale for lower part" - elseif (positi.gt.bufliptop) then - fracinbuf=1.0d0- - &((bordliptop-positi)/lipbufthick) - sslip=sscalelip(fracinbuf) - ssgradlip=sscagradlip(fracinbuf)/lipbufthick - eliptran=eliptran+sslip*liptranene(itype(i)) - gliptranx(3,i)=gliptranx(3,i) - &+ssgradlip*liptranene(itype(i)) - gliptranc(3,i-1)= gliptranc(3,i-1) - &+ssgradlip*liptranene(itype(i)) -C print *, "doing sscalefor top part",sslip,fracinbuf - else - eliptran=eliptran+liptranene(itype(i)) -C print *,"I am in true lipid" - endif - endif ! if in lipid or buffor -C else -C eliptran=elpitran+0.0 ! I am in water - enddo - return - end -C--------------------------------------------------------- -C AFM soubroutine for constant force - subroutine AFMforce(Eafmforce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - include 'COMMON.SBRIDGE' - real*8 diffafm(3) - dist=0.0d0 - Eafmforce=0.0d0 - do i=1,3 - diffafm(i)=c(i,afmend)-c(i,afmbeg) - dist=dist+diffafm(i)**2 - enddo - dist=dsqrt(dist) - Eafmforce=-forceAFMconst*(dist-distafminit) - do i=1,3 - gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist - gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist - enddo -C print *,'AFM',Eafmforce - return - end -C--------------------------------------------------------- -C AFM subroutine with pseudoconstant velocity - subroutine AFMvel(Eafmforce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - include 'COMMON.SBRIDGE' - real*8 diffafm(3) -C Only for check grad COMMENT if not used for checkgrad -C totT=3.0d0 -C-------------------------------------------------------- -C print *,"wchodze" - dist=0.0d0 - Eafmforce=0.0d0 - do i=1,3 - diffafm(i)=c(i,afmend)-c(i,afmbeg) - dist=dist+diffafm(i)**2 - enddo - dist=dsqrt(dist) - Eafmforce=0.5d0*forceAFMconst - & *(distafminit+totTafm*velAFMconst-dist)**2 -C Eafmforce=-forceAFMconst*(dist-distafminit) - do i=1,3 - gradafm(i,afmend-1)=-forceAFMconst* - &(distafminit+totTafm*velAFMconst-dist) - &*diffafm(i)/dist - gradafm(i,afmbeg-1)=forceAFMconst* - &(distafminit+totTafm*velAFMconst-dist) - &*diffafm(i)/dist - enddo -C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist - return - end -C----------------------------------------------------------- -C first for shielding is setting of function of side-chains - subroutine set_shield_fac - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SHIELD' - include 'COMMON.INTERACT' -C this is the squar root 77 devided by 81 the epislion in lipid (in protein) - double precision div77_81/0.974996043d0/, - &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) - -C the vector between center of side_chain and peptide group - double precision pep_side(3),long,side_calf(3), - &pept_group(3),costhet_grad(3),cosphi_grad_long(3), - &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) -C the line belowe needs to be changed for FGPROC>1 - do i=1,nres-1 - if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle - ishield_list(i)=0 -Cif there two consequtive dummy atoms there is no peptide group between them -C the line below has to be changed for FGPROC>1 - VolumeTotal=0.0 - do k=1,nres - if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle - dist_pep_side=0.0 - dist_side_calf=0.0 - do j=1,3 -C first lets set vector conecting the ithe side-chain with kth side-chain - pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 -C pep_side(j)=2.0d0 -C and vector conecting the side-chain with its proper calfa - side_calf(j)=c(j,k+nres)-c(j,k) -C side_calf(j)=2.0d0 - pept_group(j)=c(j,i)-c(j,i+1) -C lets have their lenght - dist_pep_side=pep_side(j)**2+dist_pep_side - dist_side_calf=dist_side_calf+side_calf(j)**2 - dist_pept_group=dist_pept_group+pept_group(j)**2 - enddo - dist_pep_side=dsqrt(dist_pep_side) - dist_pept_group=dsqrt(dist_pept_group) - dist_side_calf=dsqrt(dist_side_calf) - do j=1,3 - pep_side_norm(j)=pep_side(j)/dist_pep_side - side_calf_norm(j)=dist_side_calf - enddo -C now sscale fraction - sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield -C print *,buff_shield,"buff" -C now sscale - if (sh_frac_dist.le.0.0) cycle -C If we reach here it means that this side chain reaches the shielding sphere -C Lets add him to the list for gradient - ishield_list(i)=ishield_list(i)+1 -C ishield_list is a list of non 0 side-chain that contribute to factor gradient -C this list is essential otherwise problem would be O3 - shield_list(ishield_list(i),i)=k -C Lets have the sscale value - if (sh_frac_dist.gt.1.0) then - scale_fac_dist=1.0d0 - do j=1,3 - sh_frac_dist_grad(j)=0.0d0 - enddo - else - scale_fac_dist=-sh_frac_dist*sh_frac_dist - & *(2.0*sh_frac_dist-3.0d0) - fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2) - & /dist_pep_side/buff_shield*0.5 -C remember for the final gradient multiply sh_frac_dist_grad(j) -C for side_chain by factor -2 ! - do j=1,3 - sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) -C print *,"jestem",scale_fac_dist,fac_help_scale, -C & sh_frac_dist_grad(j) - enddo - endif -C if ((i.eq.3).and.(k.eq.2)) then -C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist -C & ,"TU" -C endif - -C this is what is now we have the distance scaling now volume... - short=short_r_sidechain(itype(k)) - long=long_r_sidechain(itype(k)) - costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2) -C now costhet_grad -C costhet=0.0d0 - costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4 -C costhet_fac=0.0d0 - do j=1,3 - costhet_grad(j)=costhet_fac*pep_side(j) - enddo -C remember for the final gradient multiply costhet_grad(j) -C for side_chain by factor -2 ! -C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 -C pep_side0pept_group is vector multiplication - pep_side0pept_group=0.0 - do j=1,3 - pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) - enddo - cosalfa=(pep_side0pept_group/ - & (dist_pep_side*dist_side_calf)) - fac_alfa_sin=1.0-cosalfa**2 - fac_alfa_sin=dsqrt(fac_alfa_sin) - rkprim=fac_alfa_sin*(long-short)+short -C now costhet_grad - cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2) - cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4 - - do j=1,3 - cosphi_grad_long(j)=cosphi_fac*pep_side(j) - &+cosphi**3*0.5/dist_pep_side**2*(-rkprim) - &*(long-short)/fac_alfa_sin*cosalfa/ - &((dist_pep_side*dist_side_calf))* - &((side_calf(j))-cosalfa* - &((pep_side(j)/dist_pep_side)*dist_side_calf)) - - cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim) - &*(long-short)/fac_alfa_sin*cosalfa - &/((dist_pep_side*dist_side_calf))* - &(pep_side(j)- - &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) - enddo - - VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi) - & /VSolvSphere_div - & *wshield -C now the gradient... -C grad_shield is gradient of Calfa for peptide groups -C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist, -C & costhet,cosphi -C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group, -C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k) - do j=1,3 - grad_shield(j,i)=grad_shield(j,i) -C gradient po skalowaniu - & +(sh_frac_dist_grad(j) -C gradient po costhet - &-scale_fac_dist*costhet_grad(j)/(1.0-costhet) - &-scale_fac_dist*(cosphi_grad_long(j)) - &/(1.0-cosphi) )*div77_81 - &*VofOverlap -C grad_shield_side is Cbeta sidechain gradient - grad_shield_side(j,ishield_list(i),i)= - & (sh_frac_dist_grad(j)*(-2.0d0) - & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet) - & +scale_fac_dist*(cosphi_grad_long(j)) - & *2.0d0/(1.0-cosphi)) - & *div77_81*VofOverlap - - grad_shield_loc(j,ishield_list(i),i)= - & scale_fac_dist*cosphi_grad_loc(j) - & *2.0d0/(1.0-cosphi) - & *div77_81*VofOverlap - enddo - VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist - enddo - fac_shield(i)=VolumeTotal*div77_81+div4_81 -c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i) - enddo - return - end -C-------------------------------------------------------------------------- - double precision function tschebyshev(m,n,x,y) - implicit none - include "DIMENSIONS" - integer i,m,n - double precision x(n),y,yy(0:maxvar),aux -c Tschebyshev polynomial. Note that the first term is omitted -c m=0: the constant term is included -c m=1: the constant term is not included - yy(0)=1.0d0 - yy(1)=y - do i=2,n - yy(i)=2*yy(1)*yy(i-1)-yy(i-2) - enddo - aux=0.0d0 - do i=m,n - aux=aux+x(i)*yy(i) - enddo - tschebyshev=aux - return - end -C-------------------------------------------------------------------------- - double precision function gradtschebyshev(m,n,x,y) - implicit none - include "DIMENSIONS" - integer i,m,n - double precision x(n+1),y,yy(0:maxvar),aux -c Tschebyshev polynomial. Note that the first term is omitted -c m=0: the constant term is included -c m=1: the constant term is not included - yy(0)=1.0d0 - yy(1)=2.0d0*y - do i=2,n - yy(i)=2*y*yy(i-1)-yy(i-2) - enddo - aux=0.0d0 - do i=m,n - aux=aux+x(i+1)*yy(i)*(i+1) -C print *, x(i+1),yy(i),i - enddo - gradtschebyshev=aux - return - end -C------------------------------------------------------------------------ -C first for shielding is setting of function of side-chains - subroutine set_shield_fac2 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SHIELD' - include 'COMMON.INTERACT' -C this is the squar root 77 devided by 81 the epislion in lipid (in protein) - double precision div77_81/0.974996043d0/, - &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) - -C the vector between center of side_chain and peptide group - double precision pep_side(3),long,side_calf(3), - &pept_group(3),costhet_grad(3),cosphi_grad_long(3), - &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) -C the line belowe needs to be changed for FGPROC>1 - do i=1,nres-1 - if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle - ishield_list(i)=0 -Cif there two consequtive dummy atoms there is no peptide group between them -C the line below has to be changed for FGPROC>1 - VolumeTotal=0.0 - do k=1,nres - if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle - dist_pep_side=0.0 - dist_side_calf=0.0 - do j=1,3 -C first lets set vector conecting the ithe side-chain with kth side-chain - pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 -C pep_side(j)=2.0d0 -C and vector conecting the side-chain with its proper calfa - side_calf(j)=c(j,k+nres)-c(j,k) -C side_calf(j)=2.0d0 - pept_group(j)=c(j,i)-c(j,i+1) -C lets have their lenght - dist_pep_side=pep_side(j)**2+dist_pep_side - dist_side_calf=dist_side_calf+side_calf(j)**2 - dist_pept_group=dist_pept_group+pept_group(j)**2 - enddo - dist_pep_side=dsqrt(dist_pep_side) - dist_pept_group=dsqrt(dist_pept_group) - dist_side_calf=dsqrt(dist_side_calf) - do j=1,3 - pep_side_norm(j)=pep_side(j)/dist_pep_side - side_calf_norm(j)=dist_side_calf - enddo -C now sscale fraction - sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield -C print *,buff_shield,"buff" -C now sscale - if (sh_frac_dist.le.0.0) cycle -C If we reach here it means that this side chain reaches the shielding sphere -C Lets add him to the list for gradient - ishield_list(i)=ishield_list(i)+1 -C ishield_list is a list of non 0 side-chain that contribute to factor gradient -C this list is essential otherwise problem would be O3 - shield_list(ishield_list(i),i)=k -C Lets have the sscale value - if (sh_frac_dist.gt.1.0) then - scale_fac_dist=1.0d0 - do j=1,3 - sh_frac_dist_grad(j)=0.0d0 - enddo - else - scale_fac_dist=-sh_frac_dist*sh_frac_dist - & *(2.0d0*sh_frac_dist-3.0d0) - fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) - & /dist_pep_side/buff_shield*0.5d0 -C remember for the final gradient multiply sh_frac_dist_grad(j) -C for side_chain by factor -2 ! - do j=1,3 - sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) -C sh_frac_dist_grad(j)=0.0d0 -C scale_fac_dist=1.0d0 -C print *,"jestem",scale_fac_dist,fac_help_scale, -C & sh_frac_dist_grad(j) - enddo - endif -C this is what is now we have the distance scaling now volume... - short=short_r_sidechain(itype(k)) - long=long_r_sidechain(itype(k)) - costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2) - sinthet=short/dist_pep_side*costhet -C now costhet_grad -C costhet=0.6d0 -C sinthet=0.8 - costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4 -C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet -C & -short/dist_pep_side**2/costhet) -C costhet_fac=0.0d0 - do j=1,3 - costhet_grad(j)=costhet_fac*pep_side(j) - enddo -C remember for the final gradient multiply costhet_grad(j) -C for side_chain by factor -2 ! -C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 -C pep_side0pept_group is vector multiplication - pep_side0pept_group=0.0d0 - do j=1,3 - pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) - enddo - cosalfa=(pep_side0pept_group/ - & (dist_pep_side*dist_side_calf)) - fac_alfa_sin=1.0d0-cosalfa**2 - fac_alfa_sin=dsqrt(fac_alfa_sin) - rkprim=fac_alfa_sin*(long-short)+short -C rkprim=short - -C now costhet_grad - cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2) -C cosphi=0.6 - cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4 - sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ - & dist_pep_side**2) -C sinphi=0.8 - do j=1,3 - cosphi_grad_long(j)=cosphi_fac*pep_side(j) - &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) - &*(long-short)/fac_alfa_sin*cosalfa/ - &((dist_pep_side*dist_side_calf))* - &((side_calf(j))-cosalfa* - &((pep_side(j)/dist_pep_side)*dist_side_calf)) -C cosphi_grad_long(j)=0.0d0 - cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) - &*(long-short)/fac_alfa_sin*cosalfa - &/((dist_pep_side*dist_side_calf))* - &(pep_side(j)- - &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) -C cosphi_grad_loc(j)=0.0d0 - enddo -C print *,sinphi,sinthet -c write (iout,*) "VSolvSphere",VSolvSphere," VSolvSphere_div", -c & VSolvSphere_div," sinphi",sinphi," sinthet",sinthet - VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) - & /VSolvSphere_div -C & *wshield -C now the gradient... - do j=1,3 - grad_shield(j,i)=grad_shield(j,i) -C gradient po skalowaniu - & +(sh_frac_dist_grad(j)*VofOverlap -C gradient po costhet - & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* - &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( - & sinphi/sinthet*costhet*costhet_grad(j) - & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) - & )*wshield -C grad_shield_side is Cbeta sidechain gradient - grad_shield_side(j,ishield_list(i),i)= - & (sh_frac_dist_grad(j)*(-2.0d0) - & *VofOverlap - & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* - &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( - & sinphi/sinthet*costhet*costhet_grad(j) - & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) - & )*wshield - - grad_shield_loc(j,ishield_list(i),i)= - & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* - &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*( - & sinthet/sinphi*cosphi*cosphi_grad_loc(j) - & )) - & *wshield - enddo -c write (iout,*) "VofOverlap",VofOverlap," scale_fac_dist", -c & scale_fac_dist - VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist - enddo - fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield) -c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i), -c & " wshield",wshield -c write(2,*) "TU",rpp(1,1),short,long,buff_shield - enddo - return - end -C----------------------------------------------------------------------- -C----------------------------------------------------------- -C This subroutine is to mimic the histone like structure but as well can be -C utilizet to nanostructures (infinit) small modification has to be used to -C make it finite (z gradient at the ends has to be changes as well as the x,y -C gradient has to be modified at the ends -C The energy function is Kihara potential -C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) -C 4eps is depth of well sigma is r_minimum r is distance from center of tube -C and r0 is the excluded size of nanotube (can be set to 0 if we want just a -C simple Kihara potential - subroutine calctube(Etube) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - include 'COMMON.SBRIDGE' - double precision tub_r,vectube(3),enetube(maxres*2) - Etube=0.0d0 - do i=1,2*nres - enetube(i)=0.0d0 - enddo -C first we calculate the distance from tube center -C first sugare-phosphate group for NARES this would be peptide group -C for UNRES - do i=1,nres -C lets ommit dummy atoms for now - if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle -C now calculate distance from center of tube and direction vectors - vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) - if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize - vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxxsize) - if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize - vectube(1)=vectube(1)-tubecenter(1) - vectube(2)=vectube(2)-tubecenter(2) - -C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) -C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) - -C as the tube is infinity we do not calculate the Z-vector use of Z -C as chosen axis - vectube(3)=0.0d0 -C now calculte the distance - tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) -C now normalize vector - vectube(1)=vectube(1)/tub_r - vectube(2)=vectube(2)/tub_r -C calculte rdiffrence between r and r0 - rdiff=tub_r-tubeR0 -C and its 6 power - rdiff6=rdiff**6.0d0 -C for vectorization reasons we will sumup at the end to avoid depenence of previous - enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6 -C write(iout,*) "TU13",i,rdiff6,enetube(i) -C print *,rdiff,rdiff6,pep_aa_tube -C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 -C now we calculate gradient - fac=(-12.0d0*pep_aa_tube/rdiff6+ - & 6.0d0*pep_bb_tube)/rdiff6/rdiff -C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), -C &rdiff,fac - -C now direction of gg_tube vector - do j=1,3 - gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 - gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 - enddo - enddo -C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) - do i=1,nres -C Lets not jump over memory as we use many times iti - iti=itype(i) -C lets ommit dummy atoms for now - if ((iti.eq.ntyp1) -C in UNRES uncomment the line below as GLY has no side-chain... -C .or.(iti.eq.10) - & ) cycle - vectube(1)=c(1,i+nres) - vectube(1)=mod(vectube(1),boxxsize) - if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize - vectube(2)=c(2,i+nres) - vectube(2)=mod(vectube(2),boxxsize) - if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize - - vectube(1)=vectube(1)-tubecenter(1) - vectube(2)=vectube(2)-tubecenter(2) - -C as the tube is infinity we do not calculate the Z-vector use of Z -C as chosen axis - vectube(3)=0.0d0 -C now calculte the distance - tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) -C now normalize vector - vectube(1)=vectube(1)/tub_r - vectube(2)=vectube(2)/tub_r -C calculte rdiffrence between r and r0 - rdiff=tub_r-tubeR0 -C and its 6 power - rdiff6=rdiff**6.0d0 -C for vectorization reasons we will sumup at the end to avoid depenence of previous - sc_aa_tube=sc_aa_tube_par(iti) - sc_bb_tube=sc_bb_tube_par(iti) - enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6 -C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 -C now we calculate gradient - fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+ - & 6.0d0*sc_bb_tube/rdiff6/rdiff -C now direction of gg_tube vector - do j=1,3 - gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac - gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac - enddo - enddo - do i=1,2*nres - Etube=Etube+enetube(i) - enddo -C print *,"ETUBE", etube - return - end -C TO DO 1) add to total energy -C 2) add to gradient summation -C 3) add reading parameters (AND of course oppening of PARAM file) -C 4) add reading the center of tube -C 5) add COMMONs -C 6) add to zerograd - -C----------------------------------------------------------------------- -C----------------------------------------------------------- -C This subroutine is to mimic the histone like structure but as well can be -C utilizet to nanostructures (infinit) small modification has to be used to -C make it finite (z gradient at the ends has to be changes as well as the x,y -C gradient has to be modified at the ends -C The energy function is Kihara potential -C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) -C 4eps is depth of well sigma is r_minimum r is distance from center of tube -C and r0 is the excluded size of nanotube (can be set to 0 if we want just a -C simple Kihara potential - subroutine calctube2(Etube) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - include 'COMMON.SBRIDGE' - double precision tub_r,vectube(3),enetube(maxres*2) - Etube=0.0d0 - do i=1,2*nres - enetube(i)=0.0d0 - enddo -C first we calculate the distance from tube center -C first sugare-phosphate group for NARES this would be peptide group -C for UNRES - do i=1,nres -C lets ommit dummy atoms for now - if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle -C now calculate distance from center of tube and direction vectors - vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) - if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize - vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxxsize) - if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize - vectube(1)=vectube(1)-tubecenter(1) - vectube(2)=vectube(2)-tubecenter(2) - -C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) -C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) - -C as the tube is infinity we do not calculate the Z-vector use of Z -C as chosen axis - vectube(3)=0.0d0 -C now calculte the distance - tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) -C now normalize vector - vectube(1)=vectube(1)/tub_r - vectube(2)=vectube(2)/tub_r -C calculte rdiffrence between r and r0 - rdiff=tub_r-tubeR0 -C and its 6 power - rdiff6=rdiff**6.0d0 -C for vectorization reasons we will sumup at the end to avoid depenence of previous - enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6 -C write(iout,*) "TU13",i,rdiff6,enetube(i) -C print *,rdiff,rdiff6,pep_aa_tube -C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 -C now we calculate gradient - fac=(-12.0d0*pep_aa_tube/rdiff6+ - & 6.0d0*pep_bb_tube)/rdiff6/rdiff -C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), -C &rdiff,fac - -C now direction of gg_tube vector - do j=1,3 - gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 - gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 - enddo - enddo -C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) - do i=1,nres -C Lets not jump over memory as we use many times iti - iti=itype(i) -C lets ommit dummy atoms for now - if ((iti.eq.ntyp1) -C in UNRES uncomment the line below as GLY has no side-chain... - & .or.(iti.eq.10) - & ) cycle - vectube(1)=c(1,i+nres) - vectube(1)=mod(vectube(1),boxxsize) - if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize - vectube(2)=c(2,i+nres) - vectube(2)=mod(vectube(2),boxxsize) - if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize - - vectube(1)=vectube(1)-tubecenter(1) - vectube(2)=vectube(2)-tubecenter(2) -C THIS FRAGMENT MAKES TUBE FINITE - positi=(mod(c(3,i+nres),boxzsize)) - if (positi.le.0) positi=positi+boxzsize -C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop -c for each residue check if it is in lipid or lipid water border area -C respos=mod(c(3,i+nres),boxzsize) - print *,positi,bordtubebot,buftubebot,bordtubetop - if ((positi.gt.bordtubebot) - & .and.(positi.lt.bordtubetop)) then -C the energy transfer exist - if (positi.lt.buftubebot) then - fracinbuf=1.0d0- - & ((positi-bordtubebot)/tubebufthick) -C lipbufthick is thickenes of lipid buffore - sstube=sscalelip(fracinbuf) - ssgradtube=-sscagradlip(fracinbuf)/tubebufthick - print *,ssgradtube, sstube,tubetranene(itype(i)) - enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) - gg_tube_SC(3,i)=gg_tube_SC(3,i) - &+ssgradtube*tubetranene(itype(i)) - gg_tube(3,i-1)= gg_tube(3,i-1) - &+ssgradtube*tubetranene(itype(i)) -C print *,"doing sccale for lower part" - elseif (positi.gt.buftubetop) then - fracinbuf=1.0d0- - &((bordtubetop-positi)/tubebufthick) - sstube=sscalelip(fracinbuf) - ssgradtube=sscagradlip(fracinbuf)/tubebufthick - enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) -C gg_tube_SC(3,i)=gg_tube_SC(3,i) -C &+ssgradtube*tubetranene(itype(i)) -C gg_tube(3,i-1)= gg_tube(3,i-1) -C &+ssgradtube*tubetranene(itype(i)) -C print *, "doing sscalefor top part",sslip,fracinbuf - else - sstube=1.0d0 - ssgradtube=0.0d0 - enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) -C print *,"I am in true lipid" - endif - else -C sstube=0.0d0 -C ssgradtube=0.0d0 - cycle - endif ! if in lipid or buffor -CEND OF FINITE FRAGMENT -C as the tube is infinity we do not calculate the Z-vector use of Z -C as chosen axis - vectube(3)=0.0d0 -C now calculte the distance - tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) -C now normalize vector - vectube(1)=vectube(1)/tub_r - vectube(2)=vectube(2)/tub_r -C calculte rdiffrence between r and r0 - rdiff=tub_r-tubeR0 -C and its 6 power - rdiff6=rdiff**6.0d0 -C for vectorization reasons we will sumup at the end to avoid depenence of previous - sc_aa_tube=sc_aa_tube_par(iti) - sc_bb_tube=sc_bb_tube_par(iti) - enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6) - & *sstube+enetube(i+nres) -C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 -C now we calculate gradient - fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+ - & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube -C now direction of gg_tube vector - do j=1,3 - gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac - gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac - enddo - gg_tube_SC(3,i)=gg_tube_SC(3,i) - &+ssgradtube*enetube(i+nres)/sstube - gg_tube(3,i-1)= gg_tube(3,i-1) - &+ssgradtube*enetube(i+nres)/sstube - - enddo - do i=1,2*nres - Etube=Etube+enetube(i) - enddo -C print *,"ETUBE", etube - return - end -C TO DO 1) add to total energy -C 2) add to gradient summation -C 3) add reading parameters (AND of course oppening of PARAM file) -C 4) add reading the center of tube -C 5) add COMMONs -C 6) add to zerograd -c---------------------------------------------------------------------------- - subroutine e_saxs(Esaxs_constr) - implicit none - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include "COMMON.SETUP" - integer IERR -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.FFIELD' -c - double precision Esaxs_constr - integer i,iint,j,k,l - double precision PgradC(maxSAXS,3,maxres), - & PgradX(maxSAXS,3,maxres),Pcalc(maxSAXS) -#ifdef MPI - double precision PgradC_(maxSAXS,3,maxres), - & PgradX_(maxSAXS,3,maxres),Pcalc_(maxSAXS) -#endif - double precision dk,dijCACA,dijCASC,dijSCCA,dijSCSC, - & sigma2CACA,sigma2CASC,sigma2SCCA,sigma2SCSC,expCACA,expCASC, - & expSCCA,expSCSC,CASCgrad,SCCAgrad,SCSCgrad,aux,auxC,auxC1, - & auxX,auxX1,CACAgrad,Cnorm,sigmaCACA,threesig - double precision sss2,ssgrad2,rrr,sscalgrad2,sscale2 - double precision dist,mygauss,mygaussder - external dist - integer llicz,lllicz - double precision time01 -c SAXS restraint penalty function -#ifdef DEBUG - write(iout,*) "------- SAXS penalty function start -------" - write (iout,*) "nsaxs",nsaxs - write (iout,*) "Esaxs: iatsc_s",iatsc_s," iatsc_e",iatsc_e - write (iout,*) "Psaxs" - do i=1,nsaxs - write (iout,'(i5,e15.5)') i, Psaxs(i) - enddo -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - Esaxs_constr = 0.0d0 - do k=1,nsaxs - Pcalc(k)=0.0d0 - do j=1,nres - do l=1,3 - PgradC(k,l,j)=0.0d0 - PgradX(k,l,j)=0.0d0 - enddo - enddo - enddo -c lllicz=0 - do i=iatsc_s,iatsc_e - if (itype(i).eq.ntyp1) cycle - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - if (itype(j).eq.ntyp1) cycle -#ifdef ALLSAXS - dijCACA=dist(i,j) - dijCASC=dist(i,j+nres) - dijSCCA=dist(i+nres,j) - dijSCSC=dist(i+nres,j+nres) - sigma2CACA=2.0d0/(pstok**2) - sigma2CASC=4.0d0/(pstok**2+restok(itype(j))**2) - sigma2SCCA=4.0d0/(pstok**2+restok(itype(i))**2) - sigma2SCSC=4.0d0/(restok(itype(j))**2+restok(itype(i))**2) - do k=1,nsaxs - dk = distsaxs(k) - expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2) - if (itype(j).ne.10) then - expCASC = dexp(-0.5d0*sigma2CASC*(dijCASC-dk)**2) - else - endif - expCASC = 0.0d0 - if (itype(i).ne.10) then - expSCCA = dexp(-0.5d0*sigma2SCCA*(dijSCCA-dk)**2) - else - expSCCA = 0.0d0 - endif - if (itype(i).ne.10 .and. itype(j).ne.10) then - expSCSC = dexp(-0.5d0*sigma2SCSC*(dijSCSC-dk)**2) - else - expSCSC = 0.0d0 - endif - Pcalc(k) = Pcalc(k)+expCACA+expCASC+expSCCA+expSCSC -#ifdef DEBUG - write(iout,*) "i j k Pcalc",i,j,Pcalc(k) -#endif - CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA - CASCgrad = sigma2CASC*(dijCASC-dk)*expCASC - SCCAgrad = sigma2SCCA*(dijSCCA-dk)*expSCCA - SCSCgrad = sigma2SCSC*(dijSCSC-dk)*expSCSC - do l=1,3 -c CA CA - aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux -c CA SC - if (itype(j).ne.10) then - aux = CASCgrad*(C(l,j+nres)-C(l,i))/dijCASC - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux - PgradX(k,l,j) = PgradX(k,l,j)+aux - endif -c SC CA - if (itype(i).ne.10) then - aux = SCCAgrad*(C(l,j)-C(l,i+nres))/dijSCCA - PgradX(k,l,i) = PgradX(k,l,i)-aux - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux - endif -c SC SC - if (itype(i).ne.10 .and. itype(j).ne.10) then - aux = SCSCgrad*(C(l,j+nres)-C(l,i+nres))/dijSCSC - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux - PgradX(k,l,i) = PgradX(k,l,i)-aux - PgradX(k,l,j) = PgradX(k,l,j)+aux - endif - enddo ! l - enddo ! k -#else - dijCACA=dist(i,j) - sigma2CACA=scal_rad**2*0.25d0/ - & (restok(itype(j))**2+restok(itype(i))**2) -c write (iout,*) "scal_rad",scal_rad," restok",restok(itype(j)) -c & ,restok(itype(i)),"sigma",1.0d0/dsqrt(sigma2CACA) -#ifdef MYGAUSS - sigmaCACA=dsqrt(sigma2CACA) - threesig=3.0d0/sigmaCACA -c llicz=0 - do k=1,nsaxs - dk = distsaxs(k) - if (dabs(dijCACA-dk).ge.threesig) cycle -c llicz=llicz+1 -c lllicz=lllicz+1 - aux = sigmaCACA*(dijCACA-dk) - expCACA = mygauss(aux) -c if (expcaca.eq.0.0d0) cycle - Pcalc(k) = Pcalc(k)+expCACA - CACAgrad = -sigmaCACA*mygaussder(aux) -c write (iout,*) "i,j,k,aux",i,j,k,CACAgrad - do l=1,3 - aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux - enddo ! l - enddo ! k -c write (iout,*) "i",i," j",j," llicz",llicz -#else - IF (saxs_cutoff.eq.0) THEN - do k=1,nsaxs - dk = distsaxs(k) - expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2) - Pcalc(k) = Pcalc(k)+expCACA - CACAgrad = sigma2CACA*(dijCACA-dk)*expCACA - do l=1,3 - aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA - PgradC(k,l,i) = PgradC(k,l,i)-aux - PgradC(k,l,j) = PgradC(k,l,j)+aux - enddo ! l - enddo ! k - ELSE - rrr = saxs_cutoff*2.0d0/dsqrt(sigma2CACA) - do k=1,nsaxs - dk = distsaxs(k) -c write (2,*) "ijk",i,j,k - sss2 = sscale2(dijCACA,rrr,dk,0.3d0) - if (sss2.eq.0.0d0) cycle - ssgrad2 = sscalgrad2(dijCACA,rrr,dk,0.3d0) - if (energy_dec) write(iout,'(a4,3i5,8f10.4)') - & 'saxs',i,j,k,dijCACA,restok(itype(i)),restok(itype(j)), - & 1.0d0/dsqrt(sigma2CACA),rrr,dk, - & sss2,ssgrad2 - expCACA = dexp(-0.5d0*sigma2CACA*(dijCACA-dk)**2)*sss2 - Pcalc(k) = Pcalc(k)+expCACA -#ifdef DEBUG - write(iout,*) "i j k Pcalc",i,j,Pcalc(k) -#endif - CACAgrad = -sigma2CACA*(dijCACA-dk)*expCACA+ - & ssgrad2*expCACA/sss2 - do l=1,3 -c CA CA - aux = CACAgrad*(C(l,j)-C(l,i))/dijCACA - PgradC(k,l,i) = PgradC(k,l,i)+aux - PgradC(k,l,j) = PgradC(k,l,j)-aux - enddo ! l - enddo ! k - ENDIF -#endif -#endif - enddo ! j - enddo ! iint - enddo ! i -c#ifdef TIMING -c time_SAXS=time_SAXS+MPI_Wtime()-time01 -c#endif -c write (iout,*) "lllicz",lllicz -c#ifdef TIMING -c time01=MPI_Wtime() -c#endif -#ifdef MPI - if (nfgtasks.gt.1) then - call MPI_AllReduce(Pcalc(1),Pcalc_(1),nsaxs,MPI_DOUBLE_PRECISION, - & MPI_SUM,FG_COMM,IERR) -c if (fg_rank.eq.king) then - do k=1,nsaxs - Pcalc(k) = Pcalc_(k) - enddo -c endif -c call MPI_AllReduce(PgradC(k,1,1),PgradC_(k,1,1),3*maxsaxs*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c if (fg_rank.eq.king) then -c do i=1,nres -c do l=1,3 -c do k=1,nsaxs -c PgradC(k,l,i) = PgradC_(k,l,i) -c enddo -c enddo -c enddo -c endif -#ifdef ALLSAXS -c call MPI_AllReduce(PgradX(k,1,1),PgradX_(k,1,1),3*maxsaxs*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c if (fg_rank.eq.king) then -c do i=1,nres -c do l=1,3 -c do k=1,nsaxs -c PgradX(k,l,i) = PgradX_(k,l,i) -c enddo -c enddo -c enddo -c endif -#endif - endif -#endif - Cnorm = 0.0d0 - do k=1,nsaxs - Cnorm = Cnorm + Pcalc(k) - enddo -#ifdef MPI - if (fg_rank.eq.king) then -#endif - Esaxs_constr = dlog(Cnorm)-wsaxs0 - do k=1,nsaxs - if (Pcalc(k).gt.0.0d0) - & Esaxs_constr = Esaxs_constr - Psaxs(k)*dlog(Pcalc(k)) -#ifdef DEBUG - write (iout,*) "k",k," Esaxs_constr",Esaxs_constr -#endif - enddo -#ifdef DEBUG - write (iout,*) "Cnorm",Cnorm," Esaxs_constr",Esaxs_constr -#endif -#ifdef MPI - endif -#endif - gsaxsC=0.0d0 - gsaxsX=0.0d0 - do i=nnt,nct - do l=1,3 - auxC=0.0d0 - auxC1=0.0d0 - auxX=0.0d0 - auxX1=0.d0 - do k=1,nsaxs - if (Pcalc(k).gt.0) - & auxC = auxC +Psaxs(k)*PgradC(k,l,i)/Pcalc(k) - auxC1 = auxC1+PgradC(k,l,i) -#ifdef ALLSAXS - auxX = auxX +Psaxs(k)*PgradX(k,l,i)/Pcalc(k) - auxX1 = auxX1+PgradX(k,l,i) -#endif - enddo - gsaxsC(l,i) = auxC - auxC1/Cnorm -#ifdef ALLSAXS - gsaxsX(l,i) = auxX - auxX1/Cnorm -#endif -c write (iout,*) "l i",l,i," gradC",wsaxs*(auxC - auxC1/Cnorm), -c * " gradX",wsaxs*(auxX - auxX1/Cnorm) -c write (iout,*) "l i",l,i," gradC",wsaxs*gsaxsC(l,i), -c * " gradX",wsaxs*gsaxsX(l,i) - enddo - enddo -#ifdef TIMING - time_SAXS=time_SAXS+MPI_Wtime()-time01 -#endif -#ifdef DEBUG - write (iout,*) "gsaxsc" - do i=nnt,nct - write (iout,'(i5,3e15.5)') i,(gsaxsc(j,i),j=1,3) - enddo -#endif -#ifdef MPI -c endif -#endif - return - end -c---------------------------------------------------------------------------- - subroutine e_saxsC(Esaxs_constr) - implicit none - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include "COMMON.SETUP" - integer IERR -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.FFIELD' -c - double precision Esaxs_constr - integer i,iint,j,k,l - double precision PgradC(3,maxres),PgradX(3,maxres),Pcalc,logPtot -#ifdef MPI - double precision gsaxsc_(3,maxres),gsaxsx_(3,maxres),logPtot_ -#endif - double precision dk,dijCASPH,dijSCSPH, - & sigma2CA,sigma2SC,expCASPH,expSCSPH, - & CASPHgrad,SCSPHgrad,aux,auxC,auxC1, - & auxX,auxX1,Cnorm -c SAXS restraint penalty function -#ifdef DEBUG - write(iout,*) "------- SAXS penalty function start -------" - write (iout,*) "nsaxs",nsaxs - - do i=nnt,nct - print *,MyRank,"C",i,(C(j,i),j=1,3) - enddo - do i=nnt,nct - print *,MyRank,"CSaxs",i,(Csaxs(j,i),j=1,3) - enddo -#endif - Esaxs_constr = 0.0d0 - logPtot=0.0d0 - do j=isaxs_start,isaxs_end - Pcalc=0.0d0 - do i=1,nres - do l=1,3 - PgradC(l,i)=0.0d0 - PgradX(l,i)=0.0d0 - enddo - enddo - do i=nnt,nct - if (itype(i).eq.ntyp1) cycle - dijCASPH=0.0d0 - dijSCSPH=0.0d0 - do l=1,3 - dijCASPH=dijCASPH+(C(l,i)-Csaxs(l,j))**2 - enddo - if (itype(i).ne.10) then - do l=1,3 - dijSCSPH=dijSCSPH+(C(l,i+nres)-Csaxs(l,j))**2 - enddo - endif - sigma2CA=2.0d0/pstok**2 - sigma2SC=4.0d0/restok(itype(i))**2 - expCASPH = dexp(-0.5d0*sigma2CA*dijCASPH) - expSCSPH = dexp(-0.5d0*sigma2SC*dijSCSPH) - Pcalc = Pcalc+expCASPH+expSCSPH -#ifdef DEBUG - write(*,*) "processor i j Pcalc", - & MyRank,i,j,dijCASPH,dijSCSPH, Pcalc -#endif - CASPHgrad = sigma2CA*expCASPH - SCSPHgrad = sigma2SC*expSCSPH - do l=1,3 - aux = (C(l,i+nres)-Csaxs(l,j))*SCSPHgrad - PgradX(l,i) = PgradX(l,i) + aux - PgradC(l,i) = PgradC(l,i)+(C(l,i)-Csaxs(l,j))*CASPHgrad+aux - enddo ! l - enddo ! i - do i=nnt,nct - do l=1,3 - gsaxsc(l,i)=gsaxsc(l,i)+PgradC(l,i)/Pcalc - gsaxsx(l,i)=gsaxsx(l,i)+PgradX(l,i)/Pcalc - enddo - enddo - logPtot = logPtot - dlog(Pcalc) -c print *,"me",me,MyRank," j",j," logPcalc",-dlog(Pcalc), -c & " logPtot",logPtot - enddo ! j -#ifdef MPI - if (nfgtasks.gt.1) then -c write (iout,*) "logPtot before reduction",logPtot - call MPI_Reduce(logPtot,logPtot_,1,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - logPtot = logPtot_ -c write (iout,*) "logPtot after reduction",logPtot - call MPI_Reduce(gsaxsC(1,1),gsaxsC_(1,1),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - if (fg_rank.eq.king) then - do i=1,nres - do l=1,3 - gsaxsC(l,i) = gsaxsC_(l,i) - enddo - enddo - endif - call MPI_Reduce(gsaxsX(1,1),gsaxsX_(1,1),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - if (fg_rank.eq.king) then - do i=1,nres - do l=1,3 - gsaxsX(l,i) = gsaxsX_(l,i) - enddo - enddo - endif - endif -#endif - Esaxs_constr = logPtot - return - end -c---------------------------------------------------------------------------- - double precision function sscale2(r,r_cut,r0,rlamb) - implicit none - double precision r,gamm,r_cut,r0,rlamb,rr - rr = dabs(r-r0) -c write (2,*) "r",r," r_cut",r_cut," r0",r0," rlamb",rlamb -c write (2,*) "rr",rr - if(rr.lt.r_cut-rlamb) then - sscale2=1.0d0 - else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then - gamm=(rr-(r_cut-rlamb))/rlamb - sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0) - else - sscale2=0d0 - endif - return - end -C----------------------------------------------------------------------- - double precision function sscalgrad2(r,r_cut,r0,rlamb) - implicit none - double precision r,gamm,r_cut,r0,rlamb,rr - rr = dabs(r-r0) - if(rr.lt.r_cut-rlamb) then - sscalgrad2=0.0d0 - else if(rr.le.r_cut.and.rr.ge.r_cut-rlamb) then - gamm=(rr-(r_cut-rlamb))/rlamb - if (r.ge.r0) then - sscalgrad2=gamm*(6*gamm-6.0d0)/rlamb - else - sscalgrad2=-gamm*(6*gamm-6.0d0)/rlamb - endif - else - sscalgrad2=0.0d0 - endif - return - end diff --git a/source/unres/src_MD-M-SAXS-homology/energy_split-sep.F b/source/unres/src_MD-M-SAXS-homology/energy_split-sep.F index b6da9a2..9abad39 100644 --- a/source/unres/src_MD-M-SAXS-homology/energy_split-sep.F +++ b/source/unres/src_MD-M-SAXS-homology/energy_split-sep.F @@ -27,12 +27,6 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.MD' include 'COMMON.CONTROL' c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot -#ifndef DFA - edfadis=0.0d0 - edfator=0.0d0 - edfanei=0.0d0 - edfabet=0.0d0 -#endif if (modecalc.eq.12.or.modecalc.eq.14) then #ifdef MPI c if (fg_rank.eq.0) call int_from_cart1(.false.) @@ -43,7 +37,7 @@ c if (fg_rank.eq.0) call int_from_cart1(.false.) #ifdef MPI c write(iout,*) "ETOTAL_LONG Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) +c call flush(iout) if (nfgtasks.gt.1) then time00=MPI_Wtime() C FG slaves call the following matching MPI_Bcast in ERGASTULUM @@ -140,33 +134,6 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue -#ifdef DFA -C BARTEK for dfa test! - if (wdfa_dist.gt.0) then - call edfad(edfadis) - else - edfadis=0.0 - endif -c print*, 'edfad is finished!', edfadis - if (wdfa_tor.gt.0) then - call edfat(edfator) - else - edfator=0.0 - endif -c print*, 'edfat is finished!', edfator - if (wdfa_nei.gt.0) then - call edfan(edfanei) - else - edfanei=0.0 - endif -c print*, 'edfan is finished!', edfanei - if (wdfa_beta.gt.0) then - call edfab(edfabet) - else - edfabet=0.0 - endif -c print*, 'edfab is finished!', edfabet -#endif call vec_and_deriv c write (iout,*) "etotal_long: shield_mode",shield_mode if (shield_mode.eq.1) then @@ -283,7 +250,7 @@ C energia(31)=edfabet call sum_energy(energia,.true.) c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) +c call flush(iout) return end c------------------------------------------------------------------------------ @@ -326,6 +293,12 @@ c call flush(iout) #endif endif #ifdef MPI +#ifndef DFA + edfadis=0.0d0 + edfator=0.0d0 + edfanei=0.0d0 + edfabet=0.0d0 +#endif c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, c & " absolute rank",myrank," nfgtasks",nfgtasks c call flush(iout) @@ -358,6 +331,9 @@ C FG slaves as WEIGHTS array. weights_(18)=scal14 weights_(21)=wsccor weights_(26)=wsaxs + weights_(29)=wdfa_tor + weights_(30)=wdfa_nei + weights_(31)=wdfa_beta C FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) @@ -513,6 +489,41 @@ C else etors_d=0 endif +c +c Homology restraints +c + if (constr_homology.ge.1) then + call e_modeller(ehomology_constr) + else + ehomology_constr=0.0d0 + endif +#ifdef DFA +C BARTEK for dfa test! + if (wdfa_dist.gt.0) then + call edfad(edfadis) + else + edfadis=0.0 + endif +c print*, 'edfad is finished!', edfadis + if (wdfa_tor.gt.0) then + call edfat(edfator) + else + edfator=0.0 + endif +c print*, 'edfat is finished!', edfator + if (wdfa_nei.gt.0) then + call edfan(edfanei) + else + edfanei=0.0 + endif +c print*, 'edfan is finished!', edfanei + if (wdfa_beta.gt.0) then + call edfab(edfabet) + else + edfabet=0.0 + endif +c print*, 'edfab is finished!', edfabet +#endif C C 21/5/07 Calculate local sicdechain correlation energy C @@ -558,7 +569,7 @@ C energia(7)=eel_loc energia(8)=eello_turn3 energia(9)=eello_turn4 - + energia(10)=eturn6 energia(11)=ebe energia(12)=escloc energia(13)=etors @@ -567,12 +578,19 @@ C energia(17)=estr energia(19)=edihcnstr energia(21)=esccor + energia(22)=eliptran energia(24)=ethetacnstr + energia(25)=Etube energia(26)=Esaxs_constr + energia(27)=ehomology_constr + energia(28)=edfadis + energia(29)=edfator + energia(30)=edfanei + energia(31)=edfabet c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) +c call flush(iout) call sum_energy(energia,.true.) c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) +c call flush(iout) return end diff --git a/source/unres/src_MD-M-SAXS-homology/energy_split.F b/source/unres/src_MD-M-SAXS-homology/energy_split.F deleted file mode 100644 index 1b496a1..0000000 --- a/source/unres/src_MD-M-SAXS-homology/energy_split.F +++ /dev/null @@ -1,447 +0,0 @@ - subroutine etotal_long(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the long-range slow-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' -c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_LONG Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" - call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) - call flush(iout) -cd print *,'nnt=',nnt,' nct=',nct -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -c print *,"Processor",myrank," computed USCSC" - call vec_and_deriv -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - call escp(evdw2,evdw2_14) - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) - endif -C -C Sum the energies -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(12)=escloc - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine etotal_short(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the short-range fast-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - -c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot -c call flush(iout) - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks -c call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. - call edis(ehpb) -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - if (tor_mode.eq.0) then - call ebend(ebe) - else -C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the -C energy function - call ebend_kcc(ebe) - endif - else - ebe=0.0d0 - endif - ethetacnstr=0.0d0 - if (with_theta_constr) call etheta_constr(ethetacnstr) -C -C Calculate the SC local energy. -C - call vec_and_deriv - call esc(escloc) -C -C Calculate the virtual-bond torsional energy. -C - if (wtor.gt.0.0d0) then - if (tor_mode.eq.0) then - call etor(etors) - else -C etor kcc is Kubo cumulant clustered rigorous attemp to derive the -C energy function - call etor_kcc(etors) - endif - else - etors=0.0d0 - endif - edihcnstr=0.0d0 - if (ndih_constr.gt.0) call etor_constr(edihcnstr) -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then - call etor_d(etors_d) - else - etors_d=0 - endif - - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(17)=estr -c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) - return - end diff --git a/source/unres/src_MD-M-SAXS-homology/gen_rand_conf.F b/source/unres/src_MD-M-SAXS-homology/gen_rand_conf.F index cf4c6d2..8f98ffc 100644 --- a/source/unres/src_MD-M-SAXS-homology/gen_rand_conf.F +++ b/source/unres/src_MD-M-SAXS-homology/gen_rand_conf.F @@ -846,6 +846,7 @@ c print *,'>>overlap_sc nnt=',nnt,' nct=',nct do i=iatsc_s,iatsc_e itypi=iabs(itype(i)) itypi1=iabs(itype(i+1)) + if (itypi.eq.ntyp1) cycle xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -858,6 +859,8 @@ c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle +c write (iout,*) "i,j",i,j," itypi,itypj",itypi,itypj dscj_inv=dsc_inv(itypj) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) diff --git a/source/unres/src_MD-M-SAXS-homology/geomout.F b/source/unres/src_MD-M-SAXS-homology/geomout.F index 5a87424..a5247e8 100644 --- a/source/unres/src_MD-M-SAXS-homology/geomout.F +++ b/source/unres/src_MD-M-SAXS-homology/geomout.F @@ -453,14 +453,14 @@ c----------------------------------------------------------------- if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), & potEcomp(23),me format1="a133" else C print *,'A CHUJ',potEcomp(23) write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & kinetic_T,t_bath,gyrate(), & potEcomp(23),me format1="a114" @@ -475,7 +475,7 @@ C print *,'A CHUJ',potEcomp(23) call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2, & f9.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), & distance,potEcomp(23),me format1="a133" @@ -483,7 +483,7 @@ C print *,"CHUJOWO" else C print *,'A CHUJ',potEcomp(23) write (line1,'(i10,f15.2,8f12.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & kinetic_T,t_bath,gyrate(), & distance,potEcomp(23),me format1="a114" @@ -492,12 +492,12 @@ C print *,'A CHUJ',potEcomp(23) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me format1="a133" else write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, + & itime,totT,EK,potE+potEcomp(27),totE+potEcomp(27), & amax,kinetic_T,t_bath,gyrate(),me format1="a114" endif diff --git a/source/unres/src_MD-M-SAXS-homology/gradient_p.F b/source/unres/src_MD-M-SAXS-homology/gradient_p.F index a9c0cc4..75192e9 100644 --- a/source/unres/src_MD-M-SAXS-homology/gradient_p.F +++ b/source/unres/src_MD-M-SAXS-homology/gradient_p.F @@ -11,7 +11,7 @@ external ufparm integer uiparm(1) double precision urparm(1) - dimension x(maxvar),g(maxvar) + dimension x(n),g(n) c c This subroutine calculates total internal coordinate gradient. c Depending on the number of function evaluations, either whole energy diff --git a/source/unres/src_MD-M-SAXS-homology/initialize_p.F b/source/unres/src_MD-M-SAXS-homology/initialize_p.F index 4d6113d..dd473ed 100644 --- a/source/unres/src_MD-M-SAXS-homology/initialize_p.F +++ b/source/unres/src_MD-M-SAXS-homology/initialize_p.F @@ -338,9 +338,9 @@ c------------------------------------------------------------------------- !  15 16 17 18 19 20 21 5 "WSTRAIN","WVDWPP","WBOND","SCAL14","WDIHC","WUMB","WSCCOR", ! 22 23 24 25 26 27 28 - 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFADIS", + 2 "WLT","WAFM","WTHETCNSR","WTUBE","WSAXS","WHOMO","WDFAD", ! 29 30 31 - 3 "WDFATOR","WDFANEI","WDFABET"/ + 3 "WDFAT","WDFAN","WDFAB"/ data ename / 1 "ESC-SC", 2 "ESC-p", diff --git a/source/unres/src_MD-M-SAXS-homology/minimize_p.F b/source/unres/src_MD-M-SAXS-homology/minimize_p.F index 3de233f..f9faf7c 100644 --- a/source/unres/src_MD-M-SAXS-homology/minimize_p.F +++ b/source/unres/src_MD-M-SAXS-homology/minimize_p.F @@ -24,7 +24,7 @@ external func,gradient,fdum external func_restr,grad_restr logical not_done,change,reduce - common /przechowalnia/ v +c common /przechowalnia/ v icall = 1 @@ -70,7 +70,7 @@ c v(25)=4.0D0 if (rtolf.eq.0.0D0) rtolf=1.0D-4 v(32)=rtolf * controls initial step size - v(35)=1.0D-1 + v(35)=1.0D-1 * large vals of d correspond to small components of step do i=1,nphi d(i)=1.0D-1 @@ -256,7 +256,8 @@ c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) real*8 urparm(1) dimension x(maxvar) c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) +c write (iout,*) "in func x" +c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) c endif nfl=nf icg=mod(nf,2)+1 @@ -269,8 +270,9 @@ cd write (iout,*) 'ETOTAL called from FUNC' call sum_gradient f=energia(0) c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot +c write (iout,*) "upon exit from func" +c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) +c write (iout,*) 'f=',f c jjj=0 c endif return diff --git a/source/unres/src_MD-M-SAXS-homology/parmread.F b/source/unres/src_MD-M-SAXS-homology/parmread.F index 37b450a..70d6336 100644 --- a/source/unres/src_MD-M-SAXS-homology/parmread.F +++ b/source/unres/src_MD-M-SAXS-homology/parmread.F @@ -226,8 +226,6 @@ C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 C read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, & ntheterm3,nsingle,ndouble - write (iout,*) "ithep",ithep - call flush(iout) nntheterm=max0(ntheterm,ntheterm2,ntheterm3) read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) do i=-ntyp1,-1 @@ -1968,8 +1966,7 @@ C 12/1/95 Added weight for the multi-body term WCORR if(me.eq.king.or..not.out1file) & write (iout,100) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6, - & wdfa_dist,wdfa_tor,wdfa_nei,wdfa_beta + & wturn4,wturn6 100 format (/'Energy-term weights (unscaled):'// & 'WSCC= ',f10.6,' (SC-SC)'/ & 'WSCP= ',f10.6,' (SC-p)'/ @@ -1988,11 +1985,7 @@ C 12/1/95 Added weight for the multi-body term WCORR & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)'/ - & 'WDFA_D= ',f10.6,' (DFA, distance)' / - & 'WDFA_T= ',f10.6,' (DFA, torsional)' / - & 'WDFA_N= ',f10.6,' (DFA, number of neighbor)' / - & 'WDFA_B= ',f10.6,' (DFA, beta formation)') + & 'WTURN6= ',f10.6,' (turns, 6th order)') if(me.eq.king.or..not.out1file)then if (wcorr4.gt.0.0d0) then write (iout,'(/2a/)') 'Local-electrostatic type correlation ', @@ -2038,6 +2031,14 @@ C 12/1/95 Added weight for the multi-body term WCORR if(me.eq.king.or..not.out1file) & write (iout,*) "Reference temperature for weights calculation:", & temp0 +#ifdef DFA + write (iout,'(/a/)') "DFA pseudopotential parameters:" + write (iout,'(a,f10.6,a)') + & "WDFAD= ",wdfa_dist," (distance)", + & "WDFAT= ",wdfa_tor," (backbone angles)", + & "WDFAN= ",wdfa_nei," (neighbors)", + & "WDFAB= ",wdfa_beta," (beta structure)" +#endif call reada(weightcard,"D0CM",d0cm,3.78d0) call reada(weightcard,"AKCM",akcm,15.1d0) call reada(weightcard,"AKTH",akth,11.0d0) @@ -2050,10 +2051,6 @@ C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,"BTRISS",btriss,0.021D0) call reada(weightcard,"CTRISS",ctriss,1.001D0) call reada(weightcard,"DTRISS",dtriss,1.001D0) - write (iout,*) "ATRISS=", atriss - write (iout,*) "BTRISS=", btriss - write (iout,*) "CTRISS=", ctriss - write (iout,*) "DTRISS=", dtriss dyn_ss=(index(weightcard,'DYN_SS').gt.0) do i=1,maxres dyn_ss_mask(i)=.false. @@ -2088,6 +2085,11 @@ C 12/1/95 Added weight for the multi-body term WCORR write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth write (iout,*)" HT",Ht + write (iout,*) "Parameters of the 'trisulfide' potential" + write (iout,*) "ATRISS=", atriss + write (iout,*) "BTRISS=", btriss + write (iout,*) "CTRISS=", ctriss + write (iout,*) "DTRISS=", dtriss print *,'indpdb=',indpdb,' pdbref=',pdbref endif return diff --git a/source/unres/src_MD-M-SAXS-homology/parmread.F.safe b/source/unres/src_MD-M-SAXS-homology/parmread.F.safe deleted file mode 100644 index bc6cf20..0000000 --- a/source/unres/src_MD-M-SAXS-homology/parmread.F.safe +++ /dev/null @@ -1,1727 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SHIELD' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - character*1 toronelet(-2:2) /"p","a","G","A","P"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - character*3 string -C dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,vbldpdum,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,vbldpdum,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -C reading lipid parameters - if (lprint) then - write (iout,*) "iliptranpar",iliptranpar - call flush(iout) - endif - read(iliptranpar,*) pepliptran - do i=1,ntyp - read(iliptranpar,*) liptranene(i) - enddo - close(iliptranpar) -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2), - & (bthet(j,i,1,1),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - do i=1,ntyp - athet(1,i,1,-1)=athet(1,i,1,1) - athet(2,i,1,-1)=athet(2,i,1,1) - bthet(1,i,1,-1)=-bthet(1,i,1,1) - bthet(2,i,1,-1)=-bthet(2,i,1,1) - athet(1,i,-1,1)=-athet(1,i,1,1) - athet(2,i,-1,1)=-athet(2,i,1,1) - bthet(1,i,-1,1)=bthet(1,i,1,1) - bthet(2,i,-1,1)=bthet(2,i,1,1) - enddo - do i=-ntyp,-1 - a0thet(i)=a0thet(-i) - athet(1,i,-1,-1)=athet(1,-i,1,1) - athet(2,i,-1,-1)=-athet(2,-i,1,1) - bthet(1,i,-1,-1)=bthet(1,-i,1,1) - bthet(2,i,-1,-1)=-bthet(2,-i,1,1) - athet(1,i,-1,1)=athet(1,-i,1,1) - athet(2,i,-1,1)=-athet(2,-i,1,1) - bthet(1,i,-1,1)=-bthet(1,-i,1,1) - bthet(2,i,-1,1)=bthet(2,-i,1,1) - athet(1,i,1,-1)=-athet(1,-i,1,1) - athet(2,i,1,-1)=athet(2,-i,1,1) - bthet(1,i,1,-1)=bthet(1,-i,1,1) - bthet(2,i,1,-1)=-bthet(2,-i,1,1) - theta0(i)=theta0(-i) - sig0(i)=sig0(-i) - sigc0(i)=sigc0(-i) - do j=0,3 - polthet(j,i)=polthet(j,-i) - enddo - do j=1,3 - gthet(j,i)=gthet(j,-i) - enddo - enddo - - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i,1,1),j=1,2), - & (10*bthet(j,i,1,1),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else - IF (tor_mode.eq.0) THEN -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - write (iout,*) "ithep",ithep - call flush(iout) - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=-ntyp1,-1 - ithetyp(i)=-ithetyp(-i) - enddo - do iblock=1,2 - do i=-maxthetyp,maxthetyp - do j=-maxthetyp,maxthetyp - do k=-maxthetyp,maxthetyp - aa0thet(i,j,k,iblock)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k,iblock)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k,iblock)=0.0d0 - ccthet(m,l,i,j,k,iblock)=0.0d0 - ddthet(m,l,i,j,k,iblock)=0.0d0 - eethet(m,l,i,j,k,iblock)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k,iblock)=0.0d0 - ggthet(mm,m,l,i,j,k,iblock)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - enddo -c VAR:iblock means terminally blocking group 1=non-proline 2=proline - do iblock=1,2 -c VAR:ntethtyp is type of theta potentials type currently 0=glycine -c VAR:1=non-glicyne non-proline 2=proline -c VAR:negative values for D-aminoacid - do i=0,nthetyp - do j=-nthetyp,nthetyp - do k=-nthetyp,nthetyp - read (ithep,'(6a)',end=111,err=111) res1 - read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock) -c VAR: aa0thet is variable describing the average value of Foureir -c VAR: expansion series -c VAR: aathet is foureir expansion in theta/2 angle for full formula -c VAR: look at the fitting equation in Kozlowska et al., J. Phys.: -Condens. Matter 19 (2007) 285203 and Sieradzan et al., unpublished - read (ithep,*,end=111,err=111) - &(aathet(l,i,j,k,iblock),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle), - & (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle), - & ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k,iblock), - & ffthet(lll,llll,ll,i,j,k,iblock), - & ggthet(llll,lll,ll,i,j,k,iblock), - & ggthet(lll,llll,ll,i,j,k,iblock), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C IF YOU WANT VALENCE POTENTIALS FOR DUMMY ATOM UNCOMENT BELOW (NOT -C RECOMENTDED AFTER VERSION 3.3) -c do i=1,nthetyp -c do j=1,nthetyp -c do l=1,ntheterm -c aathet(l,i,j,nthetyp+1,iblock)=aathet(l,i,j,1,iblock) -c aathet(l,nthetyp+1,i,j,iblock)=aathet(l,1,i,j,iblock) -c enddo -c aa0thet(i,j,nthetyp+1,iblock)=aa0thet(i,j,1,iblock) -c aa0thet(nthetyp+1,i,j,iblock)=aa0thet(1,i,j,iblock) -c enddo -c do l=1,ntheterm -c aathet(l,nthetyp+1,i,nthetyp+1,iblock)=aathet(l,1,i,1,iblock) -c enddo -c aa0thet(nthetyp+1,i,nthetyp+1,iblock)=aa0thet(1,i,1,iblock) -c enddo -c enddo -C AND COMMENT THE LOOPS BELOW - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1,iblock)=0.0d0 - aathet(l,nthetyp+1,i,j,iblock)=0.0d0 - enddo - aa0thet(i,j,nthetyp+1,iblock)=0.0d0 - aa0thet(nthetyp+1,i,j,iblock)=0.0d0 - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0 - enddo - aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0 - enddo - enddo -C TILL HERE -C Substitution for D aminoacids from symmetry. - do iblock=1,2 - do i=-nthetyp,0 - do j=-nthetyp,nthetyp - do k=-nthetyp,nthetyp - aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock) - do l=1,ntheterm - aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock) - enddo - do ll=1,ntheterm2 - do lll=1,nsingle - bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock) - ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock) - ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock) - eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock) - enddo - enddo - do ll=1,ntheterm3 - do lll=2,ndouble - do llll=1,lll-1 - ffthet(llll,lll,ll,i,j,k,iblock)= - & ffthet(llll,lll,ll,-i,-j,-k,iblock) - ffthet(lll,llll,ll,i,j,k,iblock)= - & ffthet(lll,llll,ll,-i,-j,-k,iblock) - ggthet(llll,lll,ll,i,j,k,iblock)= - & -ggthet(llll,lll,ll,-i,-j,-k,iblock) - ggthet(lll,llll,ll,i,j,k,iblock)= - & -ggthet(lll,llll,ll,-i,-j,-k,iblock) - enddo !ll - enddo !lll - enddo !llll - enddo !k - enddo !j - enddo !i - enddo !iblock -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do iblock=1,2 - do i=0,nthetyp - do j=-nthetyp,nthetyp - do k=-nthetyp,nthetyp - write (iout,'(//4a)') - & 'Type ',toronelet(i),toronelet(j),toronelet(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k,iblock),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock), - & ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k,iblock), - & ffthet(m,n,l,i,j,k,iblock), - & ggthet(n,m,l,i,j,k,iblock), - & ggthet(m,n,l,i,j,k,iblock) - enddo - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - - ELSE - -C here will be the apropriate recalibrating for D-aminoacid - read (ithep,*,end=121,err=121) nthetyp - do i=-nthetyp+1,nthetyp-1 - read (ithep,*,end=121,err=121) nbend_kcc_Tb(i) - do j=0,nbend_kcc_Tb(i) - read (ithep,*,end=121,err=121) ijunk,v1bend_chyb(j,i) - enddo - enddo - if (lprint) then - write (iout,'(a)') - & "Parameters of the valence-only potentials" - do i=-nthetyp+1,nthetyp-1 - write (iout,'(2a)') "Type ",toronelet(i) - do k=0,nbend_kcc_Tb(i) - write(iout,'(i5,f15.5)') k,v1bend_chyb(k,i) - enddo - enddo - endif - - ENDIF ! TOR_MODE - -c write (2,*) "Start reading THETA_PDB",ithep_pdb - do i=1,ntyp -c write (2,*) 'i=',i - read (ithep_pdb,*,err=111,end=111) - & a0thet(i),(athet(j,i,1,1),j=1,2), - & (bthet(j,i,1,1),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - do i=1,ntyp - athet(1,i,1,-1)=athet(1,i,1,1) - athet(2,i,1,-1)=athet(2,i,1,1) - bthet(1,i,1,-1)=-bthet(1,i,1,1) - bthet(2,i,1,-1)=-bthet(2,i,1,1) - athet(1,i,-1,1)=-athet(1,i,1,1) - athet(2,i,-1,1)=-athet(2,i,1,1) - bthet(1,i,-1,1)=bthet(1,i,1,1) - bthet(2,i,-1,1)=bthet(2,i,1,1) - enddo - do i=-ntyp,-1 - a0thet(i)=a0thet(-i) - athet(1,i,-1,-1)=athet(1,-i,1,1) - athet(2,i,-1,-1)=-athet(2,-i,1,1) - bthet(1,i,-1,-1)=bthet(1,-i,1,1) - bthet(2,i,-1,-1)=-bthet(2,-i,1,1) - athet(1,i,-1,1)=athet(1,-i,1,1) - athet(2,i,-1,1)=-athet(2,-i,1,1) - bthet(1,i,-1,1)=-bthet(1,-i,1,1) - bthet(2,i,-1,1)=bthet(2,-i,1,1) - athet(1,i,1,-1)=-athet(1,-i,1,1) - athet(2,i,1,-1)=athet(2,-i,1,1) - bthet(1,i,1,-1)=bthet(1,-i,1,1) - bthet(2,i,1,-1)=-bthet(2,-i,1,1) - theta0(i)=theta0(-i) - sig0(i)=sig0(-i) - sigc0(i)=sigc0(-i) - do j=0,3 - polthet(j,i)=polthet(j,-i) - enddo - do j=1,3 - gthet(j,i)=gthet(j,-i) - enddo - enddo -c write (2,*) "End reading THETA_PDB" - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - censc(1,1,-i)=censc(1,1,i) - censc(2,1,-i)=censc(2,1,i) - censc(3,1,-i)=-censc(3,1,i) - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - censc(1,j,-i)=censc(1,j,i) - censc(2,j,-i)=censc(2,j,i) - censc(3,j,-i)=-censc(3,j,i) -C BSC is amplitude of Gaussian - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - if (((k.eq.3).and.(l.ne.3)) - & .or.((l.eq.3).and.(k.ne.3))) then - gaussc(k,l,j,-i)=-akl - gaussc(l,k,j,-i)=-akl - else - gaussc(k,l,j,-i)=akl - gaussc(l,k,j,-i)=akl - endif - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - write (2,*) "Start reading ROTAM_PDB" - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) - write (2,*) "End reading ROTAM_PDB" -#endif - close(irotam) -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - read (ifourier,*) nloctyp -#ifdef NEWCORR - read (ifourier,*,end=115,err=115) (itype2loc(i),i=1,ntyp) - read (ifourier,*,end=115,err=115) (iloctyp(i),i=0,nloctyp-1) - itype2loc(ntyp1)=nloctyp - iloctyp(nloctyp)=ntyp1 - do i=1,ntyp1 - itype2loc(-i)=-itype2loc(i) - enddo -#else - iloctyp(0)=10 - iloctyp(1)=9 - iloctyp(2)=20 - iloctyp(3)=ntyp1 -#endif - do i=1,nloctyp - iloctyp(-i)=-iloctyp(i) - enddo -c write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1) -c write (iout,*) "nloctyp",nloctyp, -c & " iloctyp",(iloctyp(i),i=0,nloctyp) -#ifdef NEWCORR - do i=0,nloctyp-1 -c write (iout,*) "NEWCORR",i - read (ifourier,*,end=115,err=115) - do ii=1,3 - do j=1,2 - read (ifourier,*,end=115,err=115) bnew1(ii,j,i) - enddo - enddo -c write (iout,*) "NEWCORR BNEW1" -c write (iout,*) ((bnew1(ii,j,i),ii=1,3),j=1,2) - do ii=1,3 - do j=1,2 - read (ifourier,*,end=115,err=115) bnew2(ii,j,i) - enddo - enddo -c write (iout,*) "NEWCORR BNEW2" -c write (iout,*) ((bnew2(ii,j,i),ii=1,3),j=1,2) - do kk=1,3 - read (ifourier,*,end=115,err=115) ccnew(kk,1,i) - read (ifourier,*,end=115,err=115) ccnew(kk,2,i) - enddo -c write (iout,*) "NEWCORR CCNEW" -c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) - do kk=1,3 - read (ifourier,*,end=115,err=115) ddnew(kk,1,i) - read (ifourier,*,end=115,err=115) ddnew(kk,2,i) - enddo -c write (iout,*) "NEWCORR DDNEW" -c write (iout,*) ((ddnew(ii,j,i),ii=1,3),j=1,2) - do ii=1,2 - do jj=1,2 - do kk=1,2 - read (ifourier,*,end=115,err=115) eenew(ii,jj,kk,i) - enddo - enddo - enddo -c write (iout,*) "NEWCORR EENEW1" -c write(iout,*)(((eenew(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) - do ii=1,3 - read (ifourier,*,end=115,err=115) e0new(ii,i) - enddo -c write (iout,*) (e0new(ii,i),ii=1,3) - enddo -c write (iout,*) "NEWCORR EENEW" - do i=0,nloctyp-1 - do ii=1,3 - ccnew(ii,1,i)=ccnew(ii,1,i)/2 - ccnew(ii,2,i)=ccnew(ii,2,i)/2 - ddnew(ii,1,i)=ddnew(ii,1,i)/2 - ddnew(ii,2,i)=ddnew(ii,2,i)/2 - enddo - enddo - do i=1,nloctyp-1 - do ii=1,3 - bnew1(ii,1,-i)= bnew1(ii,1,i) - bnew1(ii,2,-i)=-bnew1(ii,2,i) - bnew2(ii,1,-i)= bnew2(ii,1,i) - bnew2(ii,2,-i)=-bnew2(ii,2,i) - enddo - do ii=1,3 -c ccnew(ii,1,i)=ccnew(ii,1,i)/2 -c ccnew(ii,2,i)=ccnew(ii,2,i)/2 -c ddnew(ii,1,i)=ddnew(ii,1,i)/2 -c ddnew(ii,2,i)=ddnew(ii,2,i)/2 - ccnew(ii,1,-i)=ccnew(ii,1,i) - ccnew(ii,2,-i)=-ccnew(ii,2,i) - ddnew(ii,1,-i)=ddnew(ii,1,i) - ddnew(ii,2,-i)=-ddnew(ii,2,i) - enddo - e0new(1,-i)= e0new(1,i) - e0new(2,-i)=-e0new(2,i) - e0new(3,-i)=-e0new(3,i) - do kk=1,2 - eenew(kk,1,1,-i)= eenew(kk,1,1,i) - eenew(kk,1,2,-i)=-eenew(kk,1,2,i) - eenew(kk,2,1,-i)=-eenew(kk,2,1,i) - eenew(kk,2,2,-i)= eenew(kk,2,2,i) - enddo - enddo - if (lprint) then - write (iout,'(a)') "Coefficients of the multibody terms" - do i=-nloctyp+1,nloctyp-1 - write (iout,*) "Type: ",onelet(iloctyp(i)) - write (iout,*) "Coefficients of the expansion of B1" - do j=1,2 - write (iout,'(3hB1(,i1,1h),3f10.5)') j,(bnew1(k,j,i),k=1,3) - enddo - write (iout,*) "Coefficients of the expansion of B2" - do j=1,2 - write (iout,'(3hB2(,i1,1h),3f10.5)') j,(bnew2(k,j,i),k=1,3) - enddo - write (iout,*) "Coefficients of the expansion of C" - write (iout,'(3hC11,3f10.5)') (ccnew(j,1,i),j=1,3) - write (iout,'(3hC12,3f10.5)') (ccnew(j,2,i),j=1,3) - write (iout,*) "Coefficients of the expansion of D" - write (iout,'(3hD11,3f10.5)') (ddnew(j,1,i),j=1,3) - write (iout,'(3hD12,3f10.5)') (ddnew(j,2,i),j=1,3) - write (iout,*) "Coefficients of the expansion of E" - write (iout,'(2hE0,3f10.5)') (e0new(j,i),j=1,3) - do j=1,2 - do k=1,2 - write (iout,'(1hE,2i1,2f10.5)') j,k,(eenew(l,j,k,i),l=1,2) - enddo - enddo - enddo - endif -#else - if (lprint) - & write (iout,*) "Coefficients of the expansion of Eloc(l1,l2)" - do i=0,nloctyp-1 - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13) - if (lprint) then - write (iout,*) 'Type ',onelet(iloctyp(i)) - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) - endif - if (i.gt.0) then - b(2,-i)= b(2,i) - b(3,-i)= b(3,i) - b(4,-i)=-b(4,i) - b(5,-i)=-b(5,i) - endif -c B1(1,i) = b(3) -c B1(2,i) = b(5) -c B1(1,-i) = b(3) -c B1(2,-i) = -b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 -c B1tilde(1,i) = b(3) -c B1tilde(2,i) =-b(5) -c B1tilde(1,-i) =-b(3) -c B1tilde(2,-i) =b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 -c B2(1,i) = b(2) -c B2(2,i) = b(4) -c B2(1,-i) =b(2) -c B2(2,-i) =-b(4) -cc B1tilde(1,i) = b(3,i) -cc B1tilde(2,i) =-b(5,i) -C B1tilde(1,-i) =-b(3,i) -C B1tilde(2,-i) =b(5,i) -cc b1tilde(1,i)=0.0d0 -cc b1tilde(2,i)=0.0d0 -cc B2(1,i) = b(2,i) -cc B2(2,i) = b(4,i) -C B2(1,-i) =b(2,i) -C B2(2,-i) =-b(4,i) - -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CCold(1,1,i)= b(7,i) - CCold(2,2,i)=-b(7,i) - CCold(2,1,i)= b(9,i) - CCold(1,2,i)= b(9,i) - CCold(1,1,-i)= b(7,i) - CCold(2,2,-i)=-b(7,i) - CCold(2,1,-i)=-b(9,i) - CCold(1,2,-i)=-b(9,i) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 -c Ctilde(1,1,i)= CCold(1,1,i) -c Ctilde(1,2,i)= CCold(1,2,i) -c Ctilde(2,1,i)=-CCold(2,1,i) -c Ctilde(2,2,i)=-CCold(2,2,i) - -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DDold(1,1,i)= b(6,i) - DDold(2,2,i)=-b(6,i) - DDold(2,1,i)= b(8,i) - DDold(1,2,i)= b(8,i) - DDold(1,1,-i)= b(6,i) - DDold(2,2,-i)=-b(6,i) - DDold(2,1,-i)=-b(8,i) - DDold(1,2,-i)=-b(8,i) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 -c Dtilde(1,1,i)= DD(1,1,i) -c Dtilde(1,2,i)= DD(1,2,i) -c Dtilde(2,1,i)=-DD(2,1,i) -c Dtilde(2,2,i)=-DD(2,2,i) - -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EEold(1,1,i)= b(10,i)+b(11,i) - EEold(2,2,i)=-b(10,i)+b(11,i) - EEold(2,1,i)= b(12,i)-b(13,i) - EEold(1,2,i)= b(12,i)+b(13,i) - EEold(1,1,-i)= b(10,i)+b(11,i) - EEold(2,2,-i)=-b(10,i)+b(11,i) - EEold(2,1,-i)=-b(12,i)+b(13,i) - EEold(1,2,-i)=-b(12,i)-b(13,i) - write(iout,*) "TU DOCHODZE" - print *,"JESTEM" -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) - enddo - if (lprint) then - write (iout,*) - write (iout,*) - &"Coefficients of the cumulants (independent of valence angles)" - do i=-nloctyp+1,nloctyp-1 - write (iout,*) 'Type ',onelet(iloctyp(i)) - write (iout,*) 'B1' - write(iout,'(2f10.5)') B(3,i),B(5,i) - write (iout,*) 'B2' - write(iout,'(2f10.5)') B(2,i),B(4,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CCold(j,1,i),CCold(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DDold(j,1,i),DDold(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i) - enddo - enddo - endif -#endif - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - IF (TOR_MODE.eq.0) THEN - - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntyp1 - itype2loc(i)=itortyp(i) - enddo - do i=1,ntyp1 - itype2loc(-i)=-itype2loc(i) - enddo - itortyp(ntyp1)=ntortyp - do iblock=1,2 - do i=-ntyp,-1 - itortyp(i)=-itortyp(-i) - enddo - write (iout,*) 'ntortyp',ntortyp - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - read (itorp,*,end=113,err=113) nterm(i,j,iblock), - & nlor(i,j,iblock) - nterm(-i,-j,iblock)=nterm(i,j,iblock) - nlor(-i,-j,iblock)=nlor(i,j,iblock) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j,iblock) - read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock), - & v2(k,i,j,iblock) - v1(k,-i,-j,iblock)=v1(k,i,j,iblock) - v2(k,-i,-j,iblock)=-v2(k,i,j,iblock) - v0ij=v0ij+si*v1(k,i,j,iblock) - si=-si -c write(iout,*) i,j,k,iblock,nterm(i,j,iblock) -c write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock), -c &v2(k,-i,-j,iblock),v2(k,i,j,iblock) - enddo - do k=1,nlor(i,j,iblock) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j,iblock)=v0ij - v0(-i,-j,iblock)=v0ij - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the SCCOR potentials:' - do iblock=1,2 - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j,iblock) - write (iout,'(2(1pe15.5))') v1(k,i,j,iblock), - & v2(k,i,j,iblock) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j,iblock) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - enddo - endif - -C -C 6/23/01 Read parameters for double torsionals -C - do iblock=1,2 - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - do k=-ntortyp+1,ntortyp-1 - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 -c write (iout,*) "OK onelett", -c & i,j,k,t1,t2,t3 - - if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) - & .or. t3.ne.toronelet(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock), - & ntermd_2(i,j,k,iblock) - ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock) - ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1, - & ntermd_1(i,j,k,iblock)) -C Martix of D parameters for one dimesional foureir series - do l=1,ntermd_1(i,j,k,iblock) - v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock) - v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock) - v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock) - v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock) -c write(iout,*) "whcodze" , -c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) - enddo - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock), - & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock), - & v2s(m,l,i,j,k,iblock), - & m=1,l-1),l=1,ntermd_2(i,j,k,iblock)) -C Martix of D parameters for two dimesional fourier series - do l=1,ntermd_2(i,j,k,iblock) - do m=1,l-1 - v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock) - v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock) - v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock) - v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock) - enddo!m - enddo!l - enddo!k - enddo!j - enddo!i - enddo!iblock - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do iblock=1,2 - do i=0,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - do k=-ntortyp+1,ntortyp-1 - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k,iblock), - & ' ndouble',ntermd_2(i,j,k,iblock) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k,iblock) - write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock), - & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock), - & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) - do l=1,ntermd_2(i,j,k,iblock) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) - do l=1,ntermd_2(i,j,k,iblock) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)), - & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock)) - enddo - write (iout,*) - enddo - enddo - enddo - enddo - endif - - ELSE IF (TOR_MODE.eq.1) THEN - -C read valence-torsional parameters - read (itorp,*,end=121,err=121) ntortyp - nkcctyp=ntortyp - write (iout,*) "Valence-torsional parameters read in ntortyp", - & ntortyp - read (itorp,*,end=121,err=121) (itortyp(i),i=1,ntyp) - write (iout,*) "itortyp_kcc",(itortyp(i),i=1,ntyp) -#ifndef NEWCORR - do i=1,ntyp1 - itype2loc(i)=itortyp(i) - enddo -#endif - do i=-ntyp,-1 - itortyp(i)=-itortyp(-i) - enddo - do i=-ntortyp+1,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 -C first we read the cos and sin gamma parameters - read (itorp,'(13x,a)',end=121,err=121) string - write (iout,*) i,j,string - read (itorp,*,end=121,err=121) - & nterm_kcc(j,i),nterm_kcc_Tb(j,i) -C read (itorkcc,*,end=121,err=121) nterm_kcc_Tb(j,i) - do k=1,nterm_kcc(j,i) - do l=1,nterm_kcc_Tb(j,i) - do ll=1,nterm_kcc_Tb(j,i) - read (itorp,*,end=121,err=121) ii,jj,kk, - & v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) - enddo - enddo - enddo - enddo - enddo - ELSE -#ifdef NEWCORR -c AL 4/8/16: Calculate coefficients from one-body parameters - ntortyp=nloctyp - do i=-ntyp1,ntyp1 - itortyp(i)=itype2loc(i) - enddo - write (iout,*) - &"Val-tor parameters calculated from cumulant coefficients ntortyp" - & ,ntortyp - do i=-ntortyp+1,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - nterm_kcc(j,i)=2 - nterm_kcc_Tb(j,i)=3 - do k=1,nterm_kcc_Tb(j,i) - do l=1,nterm_kcc_Tb(j,i) - v1_kcc(k,l,1,i,j)=bnew1(k,1,i)*bnew2(l,1,j) - & +bnew1(k,2,i)*bnew2(l,2,j) - v2_kcc(k,l,1,i,j)=bnew1(k,1,i)*bnew2(l,2,j) - & +bnew1(k,2,i)*bnew2(l,1,j) - enddo - enddo - do k=1,nterm_kcc_Tb(j,i) - do l=1,nterm_kcc_Tb(j,i) - v1_kcc(k,l,2,i,j)=-0.25*(ccnew(k,1,i)*ddnew(l,1,j) - & -ccnew(k,2,i)*ddnew(l,2,j)) - v2_kcc(k,l,2,i,j)=-0.25*(ccnew(k,2,i)*ddnew(l,1,j) - & +ccnew(k,1,i)*ddnew(l,2,j)) - enddo - enddo -c f(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(theta)*b11(theta)+b21(theta)*b12(theta))*sin(gamma)+(c11(theta)*d11(theta)-c12(theta)*d12(theta))*cos(2*gamma)+(c12(theta)*d11(theta)+c11(theta)*d12(theta))*sin(2*gamma) - enddo - enddo -#else - write (iout,*) "TOR_MODE>1 only with NEWCORR" - stop -#endif - ENDIF ! TOR_MODE - - if (tor_mode.gt.0 .and. lprint) then -c Print valence-torsional parameters - write (iout,'(a)') - & "Parameters of the valence-torsional potentials" - do i=-ntortyp+1,ntortyp-1 - do j=-ntortyp+1,ntortyp-1 - write (iout,'(3a)') "Type ",toronelet(i),toronelet(j) - write (iout,'(3a5,2a15)') "itor","ival","jval","v_kcc","v2_kcc" - do k=1,nterm_kcc(j,i) - do l=1,nterm_kcc_Tb(j,i) - do ll=1,nterm_kcc_Tb(j,i) - write (iout,'(3i5,2f15.4)') - & k,l-1,ll-1,v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) - enddo - enddo - enddo - enddo - enddo - endif - -#endif -C Read of Side-chain backbone correlation parameters -C Modified 11 May 2012 by Adasko -CCC -C - read (isccor,*,end=119,err=119) nsccortyp -#ifdef SCCORPDB - read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) - do i=-ntyp,-1 - isccortyp(i)=-isccortyp(-i) - enddo - iscprol=isccortyp(20) -c write (iout,*) 'ntortyp',ntortyp - maxinter=3 -cc maxinter is maximum interaction sites - do l=1,maxinter - do i=1,nsccortyp - do j=1,nsccortyp - read (isccor,*,end=119,err=119) - &nterm_sccor(i,j),nlor_sccor(i,j) - v0ijsccor=0.0d0 - v0ijsccor1=0.0d0 - v0ijsccor2=0.0d0 - v0ijsccor3=0.0d0 - si=-1.0d0 - nterm_sccor(-i,j)=nterm_sccor(i,j) - nterm_sccor(-i,-j)=nterm_sccor(i,j) - nterm_sccor(i,-j)=nterm_sccor(i,j) - do k=1,nterm_sccor(i,j) - read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) - & ,v2sccor(k,l,i,j) - if (j.eq.iscprol) then - if (i.eq.isccortyp(10)) then - v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) - v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) - else - v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0 - & +v2sccor(k,l,i,j)*dsqrt(0.75d0) - v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0 - & +v1sccor(k,l,i,j)*dsqrt(0.75d0) - v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) - v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) - v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) - v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) - endif - else - if (i.eq.isccortyp(10)) then - v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) - v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) - else - if (j.eq.isccortyp(10)) then - v1sccor(k,l,-i,j)=v1sccor(k,l,i,j) - v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j) - else - v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j) - v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) - v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) - v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) - v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) - v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) - endif - endif - endif - v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) - v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j) - v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j) - v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j) - si=-si - enddo - do k=1,nlor_sccor(i,j) - read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), - & vlor2sccor(k,i,j),vlor3sccor(k,i,j) - v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ - &(1+vlor3sccor(k,i,j)**2) - enddo - v0sccor(l,i,j)=v0ijsccor - v0sccor(l,-i,j)=v0ijsccor1 - v0sccor(l,i,-j)=v0ijsccor2 - v0sccor(l,-i,-j)=v0ijsccor3 - enddo - enddo - enddo - close (isccor) -#else - read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - maxinter=3 -cc maxinter is maximum interaction sites - do l=1,maxinter - do i=1,nsccortyp - do j=1,nsccortyp - read (isccor,*,end=119,err=119) - & nterm_sccor(i,j),nlor_sccor(i,j) - v0ijsccor=0.0d0 - si=-1.0d0 - - do k=1,nterm_sccor(i,j) - read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) - & ,v2sccor(k,l,i,j) - v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) - si=-si - enddo - do k=1,nlor_sccor(i,j) - read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), - & vlor2sccor(k,i,j),vlor3sccor(k,i,j) - v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ - &(1+vlor3sccor(k,i,j)**2) - enddo - v0sccor(l,i,j)=v0ijsccor - enddo - enddo - enddo - close (isccor) - -#endif - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do l=1,maxinter - do i=1,nsccortyp - do j=1,nsccortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm_sccor(i,j) - write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor_sccor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) - enddo - enddo - enddo - enddo - endif - -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 -c lprint=.true. - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) -c lprint=.false. - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.5) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 50 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 50 -C---------------------- GB or BP potential ----------------------------- - 30 do i=1,ntyp - read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) - enddo - read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) -C now we start reading lipid - do i=1,ntyp - read (isidep,*,end=1161,err=1161)(epslip(i,j),j=i,ntyp) - if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) - -C print *,"WARNING!!" -C do j=1,ntyp -C epslip(i,j)=epslip(i,j)+0.05d0 -C enddo - enddo - if (lprint) write(iout,*) epslip(1,1),"OK?" -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 50 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - 50 continue - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - epslip(i,j)=epslip(j,i) - enddo - enddo - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - rrij=sigma(i,j) - else - rrij=rr0(i)+rr0(j) - endif - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa_aq(i,j)=epsij*rrij*rrij - bb_aq(i,j)=-sigeps*epsij*rrij - aa_aq(j,i)=aa_aq(i,j) - bb_aq(j,i)=bb_aq(i,j) - epsijlip=epslip(i,j) - sigeps=dsign(1.0D0,epsijlip) - epsijlip=dabs(epsijlip) - aa_lip(i,j)=epsijlip*rrij*rrij - bb_lip(i,j)=-sigeps*epsijlip*rrij - aa_lip(j,i)=aa_lip(i,j) - bb_lip(j,i)=bb_lip(i,j) - if (ipot.gt.2) then - sigt1sq=sigma0(i)**2 - sigt2sq=sigma0(j)**2 - sigii1=sigii(i) - sigii2=sigii(j) - ratsig1=sigt2sq/sigt1sq - ratsig2=1.0D0/ratsig1 - chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1) - if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - else - rsum_max=sigma(i,j) - endif -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - if (lprint) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - endif - enddo - enddo -#ifdef TUBE - write(iout,*) "tube param" - read(itube,*) epspeptube,sigmapeptube - sigmapeptube=sigmapeptube**6 - sigeps=dsign(1.0D0,epspeptube) - epspeptube=dabs(epspeptube) - pep_aa_tube=4.0d0*epspeptube*sigmapeptube**2 - pep_bb_tube=-sigeps*4.0d0*epspeptube*sigmapeptube - write(iout,*) pep_aa_tube,pep_bb_tube,tubetranenepep - do i=1,ntyp - read(itube,*) epssctube,sigmasctube - sigmasctube=sigmasctube**6 - sigeps=dsign(1.0D0,epssctube) - epssctube=dabs(epssctube) - sc_aa_tube_par(i)=4.0d0*epssctube*sigmasctube**2 - sc_bb_tube_par(i)=-sigeps*4.0d0*epssctube*sigmasctube - write(iout,*) sc_aa_tube_par(i), sc_bb_tube_par(i),tubetranene(i) - enddo -#endif - -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,ntyp -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo -c lprint=.true. - if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" - do i=1,ntyp - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -c lprint=.false. -#endif -C -C Define the constants of the disulfide bridge -C -C ebr=-12.00D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c -C D0CM = 3.78d0 -C AKCM = 15.1d0 -C AKTH = 11.0d0 -C AKCT = 12.0d0 -C V1SS =-1.08d0 -C V2SS = 7.61d0 -C V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - -C if(me.eq.king) then -C write (iout,'(/a)') "Disulfide bridge parameters:" -C write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr -C write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm -C write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct -C write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, -C & ' v3ss:',v3ss -C endif - if (shield_mode.gt.0) then -C VSolvSphere the volume of solving sphere -C rpp(1,1) is the energy r0 for peptide group contact and will be used for it -C there will be no distinction between proline peptide group and normal peptide -C group in case of shielding parameters -c write (iout,*) "rpp(1,1)",rpp(1,1)," pi",pi - VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 - VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 - write (iout,*) "VSolvSphere",VSolvSphere,"VSolvSphere_div", - & VSolvSphere_div -C long axis of side chain - do i=1,ntyp - long_r_sidechain(i)=vbldsc0(1,i) - short_r_sidechain(i)=sigma0(i) - enddo - buff_shield=1.0d0 - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 1161 write (iout,*) "Error reading electrostatic energy parameters.Lip" - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - go to 999 - 121 write (iout,*) "Error in Czybyshev parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif -C set the variables used for shielding effect -C if (shield_mode.gt.0) then -C VSolvSphere the volume of solving sphere -C print *,pi,"pi" -C rpp(1,1) is the energy r0 for peptide group contact and will be used for it -C there will be no distinction between proline peptide group and normal peptide -C group in case of shielding parameters -C VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 -C VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 -C long axis of side chain -C do i=1,ntyp -C long_r_sidechain(i)=vbldsc0(1,i) -C short_r_sidechain(i)=sigma0(i) -C enddo -C lets set the buffor value -C buff_shield=1.0d0 -C endif - return - end diff --git a/source/unres/src_MD-M-SAXS-homology/readpdb.F b/source/unres/src_MD-M-SAXS-homology/readpdb.F index d4fc28f..68db17c 100644 --- a/source/unres/src_MD-M-SAXS-homology/readpdb.F +++ b/source/unres/src_MD-M-SAXS-homology/readpdb.F @@ -107,9 +107,9 @@ c write (2,*) "ires",ires," ishift",ishift endif read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) read(card(61:66),*) bfac(ires) - if(me.eq.king.or..not.out1file) - & write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) +c if(me.eq.king.or..not.out1file) +c & write (iout,'(2i3,2x,a,3f8.3)') +c & ires,itype(ires),res,(c(j,ires),j=1,3) iii=1 do j=1,3 sccor(j,iii)=c(j,ires) @@ -251,8 +251,8 @@ C Calculate internal coordinates. enddo endif call flush(iout) - write(iout,*)"before int_from_cart nres",nres - call int_from_cart(.true.,.true.) +c write(iout,*)"before int_from_cart nres",nres + call int_from_cart(.true.,.false.) do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) @@ -262,19 +262,19 @@ C Calculate internal coordinates. dc(j,i)=c(j,i+1)-c(j,i) dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) enddo - write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), - & vbld_inv(i+1) +c write (iout,*) i,(dc(j,i),j=1,3),(dc_norm(j,i),j=1,3), +c & vbld_inv(i+1) enddo do i=2,nres-1 do j=1,3 dc(j,i+nres)=c(j,i+nres)-c(j,i) dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) enddo - write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), - & vbld_inv(i+nres) +c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), +c & vbld_inv(i+nres) enddo - call sc_loc_geom(.true.) - call int_from_cart1(.true.) + call sc_loc_geom(.false.) + call int_from_cart1(.false.) c call chainbuild C Copy the coordinates to reference coordinates do i=1,nres @@ -350,6 +350,8 @@ ctest stop endif vbld(i+1)=dist(i,i+1) vbld_inv(i+1)=1.0d0/vbld(i+1) +c write (iout,*) "i",i+1," vbld",vbld(i+1)," vbld_inv", +c & vbld_inv(i+1) if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) enddo @@ -432,12 +434,16 @@ c------------------------------------------------------------------------------- do j=1,3 dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) enddo +c write (iout,*) "i",i," dc",(dc_norm(j,i),j=1,3), +c & " vbld",vbld_inv(i+1) enddo do i=2,nres-1 if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) enddo +c write (iout,*) "i",i," dc",(dc_norm(j,i+nres),j=1,3), +c & " vbld",vbld_inv(i+nres) else do j=1,3 dc_norm(j,i+nres)=0.0d0 @@ -499,17 +505,17 @@ c endif enddo if (lprn) then - do i=2,nres - iti=itype(i) #ifdef MPI - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) -#else - write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i), - & zzref(i) + if (me.eq.king.or..not.out1file) then #endif + write (iout,*) "xxref,yyref,zzref" + do i=2,nres + write (iout,'(a3,i4,3f10.5)') + & restyp(itype(i)),i,xxref(i),yyref(i),zzref(i) enddo +#ifdef MPI + endif +#endif endif return end @@ -539,11 +545,24 @@ c--------------------------------------------------------------------------- include 'COMMON.CHAIN' do i=1,nres-1 vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) + vbld_inv(i+1)=vblinv vbld(i+1+nres)=dsc(iabs(itype(i+1))) vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1))) c print *,vbld(i+1),vbld(i+1+nres) enddo +c Adam 2/26/20 Alter virtual bonds for non-blocking end groups of each chain + do i=1,nchain + i1=chain_border(1,i) + i2=chain_border(2,i) + if (i1.gt.1) then + vbld(i1)=vbld(i1)/2 + vbld_inv(i1)=vbld_inv(i1)*2 + endif + if (i2.lt.nres) then + vbld(i2+1)=vbld(i2+1)/2 + vbld_inv(i2+1)=vbld_inv(i2+1)*2 + endif + enddo return end c--------------------------------------------------------------------------- @@ -835,7 +854,7 @@ C Calculate internal coordinates. enddo endif C Calculate internal coordinates. - call int_from_cart(.true.,.false.) + call int_from_cart(.true.,.true.) call sc_loc_geom(.false.) do i=1,nres thetaref(i)=theta(i) diff --git a/source/unres/src_MD-M-SAXS-homology/readpdb.F.safe b/source/unres/src_MD-M-SAXS-homology/readpdb.F.safe deleted file mode 100644 index d9f74b8..0000000 --- a/source/unres/src_MD-M-SAXS-homology/readpdb.F.safe +++ /dev/null @@ -1,609 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - include 'COMMON.SBRIDGE' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - integer rescode,iterter(maxres),cou - logical fail - bfac=0.0d0 - do i=1,maxres - iterter(i)=0 - enddo - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END') then - goto 10 - else if (card(:3).eq.'TER') then -C End current chain - ires_old=ires+2 - itype(ires_old-1)=ntyp1 - iterter(ires_old-1)=1 - itype(ires_old)=ntyp1 - iterter(ires_old)=1 - ibeg=2 - write (iout,*) "Chain ended",ires,ishift,ires_old - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. -c write (iout,'(a80)') card - read (card(23:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=ntyp1 - endif -c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift - ibeg=0 - else if (ibeg.eq.2) then -c Start a new chain - ishift=-ires_old+ires-1 -c write (iout,*) "New chain started",ires,ishift - ibeg=0 - endif - ires=ires-ishift -c write (2,*) "ires",ires," ishift",ishift - if (res.eq.'ACE') then - itype(ires)=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) - read(card(61:66),*) bfac(ires) - if(me.eq.king.or..not.out1file) - & write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate dummy residue coordinates inside the "chain" of a multichain -C system - nres=ires - do i=2,nres-1 - write (iout,*) i,itype(i),itype(i+1) - if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then - if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then -C 16/01/2014 by Adasko: Adding to dummy atoms in the chain -C first is connected prevous chain (itype(i+1).eq.ntyp1)=true -C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - print *,i,'tu dochodze' - call refsys(i-3,i-2,i-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif !fail - print *,i,'a tu?' - do j=1,3 - c(j,i)=c(j,i-1)-1.9d0*e2(j) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i-2)-c(j,i-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i-1)+dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - else !itype(i+1).eq.ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(i+1,i+2,i+3,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,i)=c(j,i+1)-1.9d0*e2(j) - enddo - else !unres_pdb - do j=1,3 - dcj=(c(j,i+3)-c(j,i+2))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,i)=c(j,i+1)-dcj - c(j,nres+i)=c(j,i) - enddo - endif !unres_pdb - endif !itype(i+1).eq.ntyp1 - endif !itype.eq.ntyp1 - enddo -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=ntyp1 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-1.9d0*e2(j) - enddo - else - do j=1,3 - dcj=(c(j,nres-2)-c(j,nres-3))/2.0 - if (dcj.eq.0) dcj=1.23591524223 - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.ntyp1) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-1.9d0*e2(j) - enddo - else - do j=1,3 - dcj=(c(j,4)-c(j,3))/2.0 - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif -C print *,"before int_from_cart" - call int_from_cart(.true.,.false.) - call sc_loc_geom(.true.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates -C Splits to single chain if occurs - kkk=1 - lll=0 - cou=1 - do i=1,nres - lll=lll+1 -cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) - if (i.gt.1) then - if ((itype(i-1).eq.ntyp1).and.(i.gt.2)) then - chain_length=lll-1 - kkk=kkk+1 -c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) - lll=1 - endif - endif - do j=1,3 - cref(j,i,cou)=c(j,i) - cref(j,i+nres,cou)=c(j,i+nres) - if (i.le.nres) then - chain_rep(j,lll,kkk)=c(j,i) - chain_rep(j,lll+nres,kkk)=c(j,i+nres) - endif - enddo - enddo - write (iout,*) chain_length - if (chain_length.eq.0) chain_length=nres - do j=1,3 - chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1) - chain_rep(j,chain_length+nres,symetr) - &=chain_rep(j,chain_length+nres,1) - enddo -c diagnostic -c write (iout,*) "spraw lancuchy",chain_length,symetr -c do i=1,4 -c do kkk=1,chain_length -c write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3) -c enddo -c enddo -c enddiagnostic -C makes copy of chains - nperm=1 - write (iout,*) "symetr", symetr - - if (symetr.gt.1) then - call permut(symetr) - nperm=1 - do i=1,symetr - nperm=nperm*i - enddo - do i=1,nperm - write(iout,*) (tabperm(i,kkk),kkk=1,4) - enddo - do i=1,nperm - cou=0 - do kkk=1,symetr - icha=tabperm(i,kkk) -c write (iout,*) i,icha - do lll=1,chain_length - cou=cou+1 - if (cou.le.nres) then - do j=1,3 - kupa=mod(lll,chain_length) - iprzes=(kkk-1)*chain_length+lll - if (kupa.eq.0) kupa=chain_length -c write (iout,*) "kupa", kupa - cref(j,iprzes,i)=chain_rep(j,kupa,icha) - cref(j,iprzes+nres,i)=chain_rep(j,kupa+nres,icha) - enddo - endif - enddo - enddo - enddo - endif -C-koniec robienia kopii -c diag - do kkk=1,nperm - write (iout,*) "nowa struktura", nperm - do i=1,nres - write (iout,110) restyp(itype(i)),i,cref(1,i,kkk), - &cref(2,i,kkk), - &cref(3,i,kkk),cref(1,nres+i,kkk), - &cref(2,nres+i,kkk),cref(3,nres+i,kkk) - enddo - 100 format (//' alpha-carbon coordinates ', - & ' centroid coordinates'/ - 1 ' ', 6X,'X',11X,'Y',11X,'Z', - & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i3,')',6f12.5) - - enddo -cc enddiag - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn -#ifdef MPI - if(me.eq.king.or..not.out1file)then -#endif - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Phi',' Dsc_id',' Dsc',' Alpha', - & ' Omega' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Phi' - endif - endif -#ifdef MPI - endif -#endif - do i=1,nres-1 - iti=itype(i) - if (iti.ne.ntyp1 .and. itype(i+1).ne.ntyp1 .and. - & (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif -c print *,"A TU2" - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10 .and. itype(i).ne.ntyp1) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) -#ifdef MPI - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) -#else - write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i), - & zzref(i) -#endif - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(iabs(itype(i+1))) - vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1))) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end - diff --git a/source/unres/src_MD-M-SAXS-homology/readrtns_CSA.F b/source/unres/src_MD-M-SAXS-homology/readrtns_CSA.F index 0fd9c3e..66f7c17 100644 --- a/source/unres/src_MD-M-SAXS-homology/readrtns_CSA.F +++ b/source/unres/src_MD-M-SAXS-homology/readrtns_CSA.F @@ -720,6 +720,7 @@ C double precision secprob(3,maxdih_constr) integer ilen external ilen + integer tperm C C Read PDB structure if applicable C @@ -789,16 +790,24 @@ C Convert sequence to numeric code itype(i)=rescode(i,sequence(i),iscode) enddo C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(iabs(itype(i))) - vbld_inv(i+nres)=dsc_inv(iabs(itype(i))) +c do i=2,nres +c vbld(i)=vbl +c vbld_inv(i)=vblinv +c enddo +c if (itype(1).eq.ntyp1) then +c vbld(2)=vbld(2)/2 +c vbld_inv(2)=vbld_inv(2)*2 +c endif +c if (itype(nres).eq.ntyp1) then +c vbld(nres)=vbld(nres)/2 +c vbld_inv(nres)=vbld_inv(nres)*2 +c endif +c do i=2,nres-1 +c vbld(i+nres)=dsc(iabs(itype(i))) +c vbld_inv(i+nres)=dsc_inv(iabs(itype(i))) c write (iout,*) "i",i," itype",itype(i), c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo +c enddo endif c print *,nres c print '(20i4)',(itype(i),i=1,nres) @@ -838,10 +847,10 @@ cd print *,'NNT=',NNT,' NCT=',NCT enddo call chain_symmetry(nchain,nres,itype,chain_border, & chain_length,npermchain,tabpermchain) - do i=1,nres - write(iout,*) i,(tperm(ireschain(i),ii,tabpermchain), - & ii=1,npermchain) - enddo +c do i=1,nres +c write(iout,*) i,(tperm(ireschain(i),ii,tabpermchain), +c & ii=1,npermchain) +c enddo write(iout,*) "residue permutations" do i=1,nres write(iout,*) i,(iperm(i,ii),ii=1,npermchain) @@ -1057,6 +1066,7 @@ c---------------------- if (refstr) then if (.not.pdbref) then call read_angles(inp,*38) + call bond_regular goto 39 38 write (iout,'(a)') 'Error reading reference structure.' #ifdef MPI @@ -1196,6 +1206,7 @@ c call setup_var c return else call read_angles(inp,*36) + call bond_regular call chainbuild_extconf endif goto 37 @@ -1206,27 +1217,27 @@ c return stop 'Error reading angle file.' 37 continue else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - if (itype(i).le.0) omeg(i)=-omeg(i) - enddo - call chainbuild_extconf + if (me.eq.king.or..not.out1file .and. fg_rank.eq.0) + & write (iout,'(a)') 'Extended chain initial geometry.' + do i=3,nres + theta(i)=90d0*deg2rad + enddo + do i=4,nres + phi(i)=180d0*deg2rad + enddo + do i=2,nres-1 + alph(i)=110d0*deg2rad + enddo + do i=2,nres-1 + omeg(i)=-120d0*deg2rad + if (itype(i).le.0) omeg(i)=-omeg(i) + enddo + call bond_regular + call chainbuild_extconf else if(me.eq.king.or..not.out1file) & write (iout,'(a)') 'Random-generated initial geometry.' - - + call bond_regular #ifdef MPI if (me.eq.king .or. fg_rank.eq.0 .and. ( & modecalc.eq.12 .or. modecalc.eq.14) ) then @@ -3659,7 +3670,7 @@ c write (iout,*) "c(",j,i,") =",c(j,i) enddo enddo call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) + call sc_loc_geom(.true.) do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) @@ -3810,5 +3821,5 @@ c endif return - 10 stop "Error infragment file" + 10 stop "Error in fragment file" end diff --git a/source/unres/src_MD-M-SAXS-homology/rmscalc.F b/source/unres/src_MD-M-SAXS-homology/rmscalc.F index ca33c4d..b467d9c 100644 --- a/source/unres/src_MD-M-SAXS-homology/rmscalc.F +++ b/source/unres/src_MD-M-SAXS-homology/rmscalc.F @@ -117,7 +117,7 @@ c------------------------------------------------------------------------ indchain=tabpermchain(ichain,iperm) c write (iout,*) "ichain",ichain," iperm",iperm, c & " indchain",indchain - call flush(iout) +c call flush(iout) do k=3,chain_length(ichain) kchain1=chain_border(1,ichain)+k-1 kchain2=chain_border(1,indchain)+k-1 diff --git a/source/unres/src_MD-M-SAXS-homology/sc_move.F b/source/unres/src_MD-M-SAXS-homology/sc_move.F index c552ee0..f353589 100644 --- a/source/unres/src_MD-M-SAXS-homology/sc_move.F +++ b/source/unres/src_MD-M-SAXS-homology/sc_move.F @@ -720,6 +720,7 @@ c if (icall.eq.0) lprn=.true. itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) @@ -765,6 +766,7 @@ C IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN ind=ind+1 itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=dsc_inv(itypj) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) diff --git a/source/unres/src_MD-M-SAXS-homology/unres.F b/source/unres/src_MD-M-SAXS-homology/unres.F index b1478d7..5da3f8e 100644 --- a/source/unres/src_MD-M-SAXS-homology/unres.F +++ b/source/unres/src_MD-M-SAXS-homology/unres.F @@ -57,10 +57,11 @@ c call memmon_print_usage() C Read force field parameters and job setup data call readrtns C - write (iout,*) "After readrtns" +c write (iout,*) "After readrtns" call cartprint + call intout if (me.eq.king .or. .not. out1file) then - write (iout,'(2a/)') + write (iout,'(/2a/)') & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), & ' calculation.' if (minim) write (iout,'(a)') @@ -235,11 +236,11 @@ c write (iout,*) i,energy_long(i),energy_short(i),energy(i) write (iout,*) "Printing long+short range energy" call enerprint(energy(0)) endif - write(iout,*)"before etotal" - call flush(iout) +c write(iout,*)"before etotal" +c call flush(iout) call etotal(energy(0)) - write(iout,*)"after etotal" - call flush(iout) +c write(iout,*)"after etotal" +c call flush(iout) #ifdef MPI time_ene=MPI_Wtime()-time00 #else @@ -259,6 +260,7 @@ crc overlap test if (overlapsc) then print *, 'Calling OVERLAP_SC' call overlap_sc(fail) + print *,"After overlap_sc" endif if (searchsc) then @@ -278,7 +280,7 @@ crc overlap test else if (indpdb.ne.0) then call bond_regular - call chainbuild + call chainbuild_extconf endif call geom_to_var(nvar,varia) print *,'Calling MINIMIZE.' diff --git a/source/unres/src_MD-M-SAXS-homology/xdrf b/source/unres/src_MD-M-SAXS-homology/xdrf deleted file mode 120000 index 26825c5..0000000 --- a/source/unres/src_MD-M-SAXS-homology/xdrf +++ /dev/null @@ -1 +0,0 @@ -../../lib/xdrf \ No newline at end of file diff --git a/source/unres/src_MD-M-newcorr/CMakeLists.txt b/source/unres/src_MD-M-newcorr/CMakeLists.txt index b65d077..29291da 100644 --- a/source/unres/src_MD-M-newcorr/CMakeLists.txt +++ b/source/unres/src_MD-M-newcorr/CMakeLists.txt @@ -5,11 +5,6 @@ enable_language (Fortran) #================================ -# build the xdrf library -#================================ -#add_subdirectory(xdrf) - -#================================ # Set source file lists #================================ set(UNRES_MDM_SRC0 @@ -35,6 +30,7 @@ set(UNRES_MDM_SRC0 distfit.f djacob.f econstr_local.F + eigen.f elecont.f energy_split-sep.F entmcm.F @@ -70,6 +66,7 @@ set(UNRES_MDM_SRC0 permut.F pinorm.f printmat.f + prng_32.F q_measure.F ran.f randgens.f @@ -92,17 +89,9 @@ set(UNRES_MDM_SRC0 timing.F together.F unres.F + ssMD.F ) -if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng.f ) -else() - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - -set(UNRES_MDM_SRC2 eigen.f) set(UNRES_MDM_SRC3 energy_p_new_barrier.F energy_p_new-sep_barrier.F gradient_p.F ) set(UNRES_MDM_PP_SRC @@ -140,6 +129,7 @@ set(UNRES_MDM_PP_SRC newconf.f parmread.F permut.F + prng_32.F q_measure1.F q_measure3.F q_measure.F @@ -172,10 +162,10 @@ endif(NOT Fortran_COMPILER_NAME STREQUAL "ifort") # Set comipiler flags for different sourcefiles #================================================ if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-CB -g -ip -w" ) - set(FFLAGS1 "-w -g " ) + set(FFLAGS0 "-ip -w" ) + set(FFLAGS1 "-w -g -d2 -CA -CB" ) set(FFLAGS2 "-w -g -00 ") - set(FFLAGS3 "-CB -g -w -ipo " ) + set(FFLAGS3 "-w -ipo " ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") set(FFLAGS0 "-std=legacy -I. " ) set(FFLAGS1 "-std=legacy -g -I. " ) @@ -186,15 +176,15 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_MDM_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) -set_property(SOURCE ${UNRES_MD_SRC1} PROPERTY COMPILE_FLAGS ${FFLAGS1} ) -set_property(SOURCE ${UNRES_MD_SRC2} PROPERTY COMPILE_FLAGS ${FFLAGS2} ) +#set_property(SOURCE ${UNRES_MD_SRC1} PROPERTY COMPILE_FLAGS ${FFLAGS1} ) +#set_property(SOURCE ${UNRES_MD_SRC2} PROPERTY COMPILE_FLAGS ${FFLAGS2} ) set_property(SOURCE ${UNRES_MDM_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= @@ -202,7 +192,7 @@ set_property(SOURCE ${UNRES_MDM_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= if(UNRES_MD_FF STREQUAL "GAB" ) # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB -DNEWCORR" ) + set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB -DTIMING -DTIMING_ENE" ) #========================================= # Settings for E0LL2Y force field @@ -248,7 +238,9 @@ if (UNRES_WITH_MPI) endif(UNRES_WITH_MPI) +#========================================= # add 64-bit specific preprocessor flags +#========================================= if (architektura STREQUAL "64") set(CPPFLAGS "${CPPFLAGS} -DAMD64") endif (architektura STREQUAL "64") @@ -267,10 +259,10 @@ set_property(SOURCE proc_proc.c PROPERTY COMPILE_DEFINITIONS "SGI" ) #======================================== if(UNRES_WITH_MPI) # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_FF}.exe") + set(UNRES_BIN "unresMD-M_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") else(UNRES_WITH_MPI) # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_FF}.exe") + set(UNRES_BIN "unresMD-M_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") endif(UNRES_WITH_MPI) #========================================= @@ -308,15 +300,14 @@ set_property(SOURCE ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f PROPERTY COMPILE_FLAGS " #========================================= # Set full unres MD-M sources #========================================= -set(UNRES_MDM_SRCS ${UNRES_MDM_SRC0} ${UNRES_MDM_SRC2} ${UNRES_MDM_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f proc_proc.c ) +set(UNRES_MDM_SRCS ${UNRES_MDM_SRC0} ${UNRES_MDM_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f proc_proc.c ) #========================================= # Build the binary #========================================= add_executable(UNRES_BIN-MD-M ${UNRES_MDM_SRCS} ) set_target_properties(UNRES_BIN-MD-M PROPERTIES OUTPUT_NAME ${UNRES_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_BIN-MD-M PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= @@ -324,13 +315,18 @@ set_target_properties(UNRES_BIN-MD-M PROPERTIES OUTPUT_NAME ${UNRES_BIN}) #========================================= # link MPI library (libmpich.a) if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD-M ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_BIN-MD-M ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a #message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") target_link_libraries( UNRES_BIN-MD-M xdrf ) #========================================= +# Install Path +#========================================= +install(TARGETS UNRES_BIN-MD-M DESTINATION ${CMAKE_INSTALL_PREFIX}) + +#========================================= # TESTS #========================================= diff --git a/source/unres/src_MD-M-newcorr/COMMON.DERIV b/source/unres/src_MD-M-newcorr/COMMON.DERIV index 524d72a..d7c98bd 100644 --- a/source/unres/src_MD-M-newcorr/COMMON.DERIV +++ b/source/unres/src_MD-M-newcorr/COMMON.DERIV @@ -2,7 +2,7 @@ & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long + & gradcorr6_long,gcorr6_turn_long,gvdwx integer nfl,icg common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), diff --git a/source/unres/src_MD-M-newcorr/COMMON.SBRIDGE b/source/unres/src_MD-M-newcorr/COMMON.SBRIDGE index 4cc80c8..91dd2cd 100644 --- a/source/unres/src_MD-M-newcorr/COMMON.SBRIDGE +++ b/source/unres/src_MD-M-newcorr/COMMON.SBRIDGE @@ -1,12 +1,17 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss integer ns,nss,nfree,iss - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, & ns,nss,nfree,iss(maxss) - double precision dhpb,forcon - integer ihpb,jhpb,nhpb - common /links/ dhpb(maxdim),forcon(maxdim),ihpb(maxdim), - & jhpb(maxdim),nhpb + double precision dhpb,dhpb1,forcon + integer ihpb,jhpb,nhpb,idssb,jdssb + common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), + & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb double precision weidis common /restraints/ weidis integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim), + & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/unres/src_MD-M-newcorr/MREMD.F b/source/unres/src_MD-M-newcorr/MREMD.F index 1df3f0a..cac85aa 100644 --- a/source/unres/src_MD-M-newcorr/MREMD.F +++ b/source/unres/src_MD-M-newcorr/MREMD.F @@ -1500,8 +1500,15 @@ c end debugging call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) +C do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + endif + enddo enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint_(ixdrf, iset_restart1(il), iret) @@ -1538,8 +1545,13 @@ c end debugging call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint(ixdrf, iset_restart1(il), iret) @@ -1782,14 +1794,9 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) enddo endif #endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its -c own element -c call mpi_scatter(i2set,1,mpi_integer, -c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) - call mpi_bcast(i2set(0),nodes,mpi_integer,king, - & CG_COMM,ierr) - iset=i2set(me) + call mpi_scatter(i2set,1,mpi_integer, + & iset,1,mpi_integer,king, + & CG_COMM,ierr) endif diff --git a/source/unres/src_MD-M-newcorr/Makefile_MPICH_ifort b/source/unres/src_MD-M-newcorr/Makefile_MPICH_ifort index fbc0a98..708cf8f 100644 --- a/source/unres/src_MD-M-newcorr/Makefile_MPICH_ifort +++ b/source/unres/src_MD-M-newcorr/Makefile_MPICH_ifort @@ -70,7 +70,7 @@ E0LL2Y: ${object} xdrf/libxdrf.a ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} E0LL2YT: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DNEWCORR #-DMUOUT + -DSPLITELE -DLANG0 -DNEWCORR E0LL2YT: BIN = ../../../bin/unres/MD/unres_mchain_ifort_MPICH_E0LL2Y-NEWC.exe E0LL2YT: ${object} xdrf/libxdrf.a cc -o compinfo compinfo.c diff --git a/source/unres/src_MD-M-newcorr/energy_p_new-sep_barrier.F b/source/unres/src_MD-M-newcorr/energy_p_new-sep_barrier.F index 5f9a128..6592ace 100644 --- a/source/unres/src_MD-M-newcorr/energy_p_new-sep_barrier.F +++ b/source/unres/src_MD-M-newcorr/energy_p_new-sep_barrier.F @@ -1352,8 +1352,7 @@ C------------------------------------------------------------------------------- dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4), - & gmuij2(4),gmuji2(4) + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 @@ -1583,14 +1582,6 @@ C do l=1,2 kkk=kkk+1 muij(kkk)=mu(k,i)*mu(l,j) -#ifdef NEWCORR - gmuij1(kkk)=gtb1(k,i+1)*mu(l,j) -c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i - gmuij2(kkk)=gUb2(k,i)*mu(l,j) - gmuji1(kkk)=mu(k,i)*gtb1(l,j+1) -c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j - gmuji2(kkk)=mu(k,i)*gUb2(l,j) -#endif enddo enddo cd write (iout,*) 'EELEC: i',i,' j',j @@ -1757,40 +1748,7 @@ C Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij -C Calculate patrial derivative for theta angle -#ifdef NEWCORR - geel_loc_ij=a22*gmuij1(1) - & +a23*gmuij1(2) - & +a32*gmuij1(3) - & +a33*gmuij1(4) -c write(iout,*) "derivative over thatai" -c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), -c & a33*gmuij1(4) - gloc(nphi+i,icg)=gloc(nphi+i,icg)+ - & geel_loc_ij*wel_loc -c write(iout,*) "derivative over thatai-1" -c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3), -c & a33*gmuij2(4) - geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3) - & +a33*gmuij2(4) - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & geel_loc_ij*wel_loc - geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3) - & +a33*gmuji1(4) -c write(iout,*) "derivative over thataj" -c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3), -c & a33*gmuji1(4) - gloc(nphi+j,icg)=gloc(nphi+j,icg)+ - & geel_loc_ji*wel_loc - geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3) - & +a33*gmuji2(4) -c write(iout,*) "derivative over thataj-1" -c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), -c & a33*gmuji2(4) - gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ - & geel_loc_ji*wel_loc -#endif if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij diff --git a/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F b/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F index c9140a6..5e90c17 100644 --- a/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F +++ b/source/unres/src_MD-M-newcorr/energy_p_new_barrier.F @@ -121,6 +121,10 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +cmc +cmc Sep-06: egb takes care of dynamic ss bonds too +cmc +C if (dyn_ss) call dyn_set_nss c print *,"Processor",myrank," computed USCSC" #ifdef TIMING time01=MPI_Wtime() @@ -300,6 +304,7 @@ c Here are the energies showed per procesor if the are more processors c per molecule then we sum it up in sum_energy subroutine c print *," Processor",myrank," calls SUM_ENERGY" call sum_energy(energia,.true.) + if (dyn_ss) call dyn_set_nss c print *," Processor",myrank," left SUM_ENERGY" #ifdef TIMING time_sumene=time_sumene+MPI_Wtime()-time00 @@ -710,6 +715,7 @@ c enddo do i=1,4*nres glocbuf(i)=gloc(i,icg) enddo +#define DEBUG #ifdef DEBUG write (iout,*) "gloc_sc before reduce" do i=1,nres @@ -718,6 +724,7 @@ c enddo enddo enddo #endif +#undef DEBUG do i=1,nres do j=1,3 gloc_scbuf(j,i)=gloc_sc(j,i,icg) @@ -737,6 +744,7 @@ c enddo call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 +#define DEBUG #ifdef DEBUG write (iout,*) "gloc_sc after reduce" do i=1,nres @@ -745,6 +753,7 @@ c enddo enddo enddo #endif +#undef DEBUG #ifdef DEBUG write (iout,*) "gloc after reduce" do i=1,4*nres @@ -1408,6 +1417,7 @@ C include 'COMMON.IOUNITS' include 'COMMON.CALC' include 'COMMON.CONTROL' + include 'COMMON.SBRIDGE' logical lprn evdw=0.0D0 ccccc energy_dec=.false. @@ -1435,6 +1445,12 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,' ss' + ELSE ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -1529,6 +1545,7 @@ C Calculate the radial part of the gradient gg(3)=zj*fac C Calculate angular part of the gradient. call sc_grad + endif ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -2267,27 +2284,27 @@ c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then iti1=ntortyp+1 endif c write(iout,*),i - b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0d0) - & +bnew1(2,1,iti)*dsin(theta(i-1)) - & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0d0) - gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0 - & +bnew1(2,1,iti)*dcos(theta(i-1)) - & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0 -c & +bnew1(3,1,iti)*dsin(alpha(i))*cos(beta(i)) + b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0) + & +bnew1(2,1,iti)*sin(theta(i-1)) + & +bnew1(3,1,iti)*cos(theta(i-1)/2.0) + gtb1(1,i-2)=bnew1(1,1,iti)*cos(theta(i-1)/2.0)/2.0 + & +bnew1(2,1,iti)*cos(theta(i-1)) + & -bnew1(3,1,iti)*sin(theta(i-1)/2.0)/2.0 +c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i)) c &*(cos(theta(i)/2.0) - b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0d0) - & +bnew2(2,1,iti)*dsin(theta(i-1)) - & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0d0) -c & +bnew2(3,1,iti)*dsin(alpha(i))*dcos(beta(i)) + b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0) + & +bnew2(2,1,iti)*sin(theta(i-1)) + & +bnew2(3,1,iti)*cos(theta(i-1)/2.0) +c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i)) c &*(cos(theta(i)/2.0) - gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0 - & +bnew2(2,1,iti)*dcos(theta(i-1)) - & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0 + gtb2(1,i-2)=bnew2(1,1,iti)*cos(theta(i-1)/2.0)/2.0 + & +bnew2(2,1,iti)*cos(theta(i-1)) + & -bnew2(3,1,iti)*sin(theta(i-1)/2.0)/2.0 c if (ggb1(1,i).eq.0.0d0) then c write(iout,*) 'i=',i,ggb1(1,i), -c &bnew1(1,1,iti)*dcos(theta(i)/2.0d0)/2.0d0, -c &bnew1(2,1,iti)*dcos(theta(i)), -c &bnew1(3,1,iti)*dsin(theta(i)/2.0d0)/2.0d0 +c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0, +c &bnew1(2,1,iti)*cos(theta(i)), +c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0 c endif b1(2,i-2)=bnew1(1,2,iti) gtb1(2,i-2)=0.0 @@ -2304,8 +2321,8 @@ c endif c EE(2,2,iti)=0.0d0 c EE(1,2,iti)=0.5d0*eenew(1,iti) c EE(2,1,iti)=0.5d0*eenew(1,iti) -c b1(2,iti)=bnew1(1,2,iti)*dsin(alpha(i))*dsin(beta(i)) -c b2(2,iti)=bnew2(1,2,iti)*dsin(alpha(i))*dsin(beta(i)) +c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i)) +c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i)) b1tilde(1,i-2)=b1(1,i-2) b1tilde(2,i-2)=-b1(2,i-2) b2tilde(1,i-2)=b2(1,i-2) @@ -2319,17 +2336,6 @@ c write (iout,*) 'theta=', theta(i-1) do i=3,nres+1 #endif #endif - if (i.gt. nnt+2 .and. i.lt.nct+2) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif -c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif if (i .lt. nres+1) then sin1=dsin(phi(i)) cos1=dcos(phi(i)) @@ -2466,12 +2472,11 @@ c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) enddo #ifdef MUOUT - write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1), + write (iout,'(2hmu,i3,3f8.1,7f10.5)') i-2,rad2deg*theta(i-1), & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2), & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2), & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2) - & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2), - & ((ee(l,k,i-2),l=1,2),k=1,2),eenew(1,itortyp(iti)) + & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2) #endif cd write (iout,*) 'mu ',mu(:,i-2) cd write (iout,*) 'mu1',mu1(:,i-2) @@ -4288,10 +4293,20 @@ C iii and jjj point to the residues for which the distance is assigned. cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. - & iabs(itype(jjj)).eq.1) then - call ssbond_ene(iii,jjj,eij) +cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds +c if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond +C if (.not.dyn_ss.and. +C & ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then + + if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond - additional check + if (ii.gt.nres + & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then + call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij + endif cd write (iout,*) "eij",eij else C Calculate the distance between the two points and its difference from the @@ -5804,7 +5819,7 @@ c---------------------------------------------------------------------------- logical lprn C Set lprn=.true. for debugging lprn=.false. -c lprn=.true. +c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 @@ -5852,12 +5867,12 @@ C C Subtract the constant term etors=etors-v0(itori,itori1,iblock) if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii + & 'etor',i,etors_ii-v0(itori,itori1,iblock) if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,f10.2,6f8.3/36x,6f8.3/)') + & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & rad2deg*phii, - & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6) + & (v1(j,itori,itori1,iblock),j=1,6), + & (v2(j,itori,itori1,iblock),j=1,6) gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo diff --git a/source/unres/src_MD-M-newcorr/geomout.F b/source/unres/src_MD-M-newcorr/geomout.F index b5d8732..e869b4a 100644 --- a/source/unres/src_MD-M-newcorr/geomout.F +++ b/source/unres/src_MD-M-newcorr/geomout.F @@ -80,9 +80,15 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 if (nss.gt.0) then do i=1,nss + if (dyn_ss) then + write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') + & 'SSBOND',i,'CYS',idssb(i)-nnt+1, + & 'CYS',jdssb(i)-nnt+1 + else write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-1-nres, - & 'CYS',jhpb(i)-1-nres + & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, + & 'CYS',jhpb(i)-nnt+1-nres + endif enddo endif @@ -124,7 +130,14 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,30) ica(nct),ica(nct)+1 endif do i=1,nss +C write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 +c trzeba uporzdkowac +C write (iunit,30) ica(ihpb(i))+1,ica(jhpb(i))+1 + if (dyn_ss) then + write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 + else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 + endif enddo write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) @@ -206,7 +219,7 @@ c------------------------------------------------------------------------ & ' Phi',' Dsc',' Alpha',' Omega' do i=1,nres iti=itype(i) - write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i+1), + write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), & rad2deg*omeg(i) enddo @@ -279,8 +292,14 @@ c---------------------------------------------------------------- open(icart,file=cartname,access="append") #endif write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - write (icart,'(i4,$)') +C write (icart,'(i4,$)') + if (dyn_ss) then + write (icart,'(i4,$)') + & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) + else + write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) + endif write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) @@ -346,8 +365,13 @@ c----------------------------------------------------------------- call xdrffloat(ixdrf, real(t_bath), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag diff --git a/source/unres/src_MD-M-newcorr/initialize_p.F b/source/unres/src_MD-M-newcorr/initialize_p.F index a650241..d2474fc 100644 --- a/source/unres/src_MD-M-newcorr/initialize_p.F +++ b/source/unres/src_MD-M-newcorr/initialize_p.F @@ -377,6 +377,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) goto 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. diff --git a/source/unres/src_MD-M-newcorr/parmread.F b/source/unres/src_MD-M-newcorr/parmread.F index 54345a5..59c3e7c 100644 --- a/source/unres/src_MD-M-newcorr/parmread.F +++ b/source/unres/src_MD-M-newcorr/parmread.F @@ -56,7 +56,7 @@ C Assign virtual-bond length vblinv2=vblinv*vblinv c c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains +c and Stokes radii of the peptide group and side chains c #ifdef CRYST_BOND read (ibond,*) vbldp0,akp,mp,ip,pstok @@ -352,7 +352,6 @@ C Control printout of the coefficients of virtual-bond-angle potentials C if (lprint) then write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do iblock=1,2 do i=1,nthetyp+1 do j=1,nthetyp+1 do k=1,nthetyp+1 @@ -386,7 +385,6 @@ C enddo enddo enddo - enddo ! iblock enddo call flush(iout) endif @@ -654,7 +652,6 @@ c &v2(k,-i,-j,iblock),v2(k,i,j,iblock) close (itorp) if (lprint) then write (iout,'(/a/)') 'Torsional constants:' - do iblock=1,2 do i=1,ntortyp do j=1,ntortyp write (iout,*) 'ityp',i,' jtyp',j @@ -670,7 +667,6 @@ c &v2(k,-i,-j,iblock),v2(k,i,j,iblock) enddo enddo enddo - enddo endif C @@ -891,8 +887,7 @@ cc maxinter is maximum interaction sites write (iout,*) 'ityp',i,' jtyp',j write (iout,*) 'Fourier constants' do k=1,nterm_sccor(i,j) - write (iout,'(2(1pe15.5))') (v1sccor(k,l,i,j),v2sccor(k,l,i,j), - & l=1,maxinter) + write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) enddo write (iout,*) 'Lorenz constants' do k=1,nlor_sccor(i,j) @@ -917,11 +912,13 @@ C read (ifourier,*,end=115,err=115) read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) #ifdef NEWCORR + write (iout,*) "TUTUTU" read (ifourier,*,end=115,err=115) (bnew1(ii,1,i),ii=1,3) read (ifourier,*,end=115,err=115) (bnew2(ii,1,i),ii=1,3) read (ifourier,*,end=115,err=115) (bnew1(ii,2,i),ii=1,1) read (ifourier,*,end=115,err=115) (bnew2(ii,2,i),ii=1,1) read (ifourier,*,end=115,err=115) (eenew(ii,i),ii=1,1) + #endif if (lprint) then write (iout,*) 'Type',i @@ -1015,14 +1012,10 @@ c lprint=.true. if (lprint) then do i=1,nloctyp write (iout,*) 'Type',i - write (iout,*) 'BNEW1(1)' - write (iout,*) (BNEW1(ii,1,i),ii=1,3) - write (iout,*) 'BNEW1(2)' - write (iout,*) BNEW1(1,2,i) - write (iout,*) 'BNEW2(1)' - write (iout,*) (BNEW2(ii,1,i),ii=1,3) - write (iout,*) 'BNEW2(2)' - write (iout,*) BNEW2(1,2,i) + write (iout,*) 'B1' + write(iout,*) B1(1,i),B1(2,i) + write (iout,*) 'B2' + write(iout,*) B2(1,i),B2(2,i) write (iout,*) 'CC' do j=1,2 write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) @@ -1084,7 +1077,7 @@ C & ', exponents are ',expon,2*expon goto (10,20,30,30,40) ipot C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), + 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJ potential:' @@ -1096,7 +1089,7 @@ C----------------------- LJ potential --------------------------------- endif goto 50 C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), + 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJK potential:' @@ -1110,12 +1103,12 @@ C----------------------- LJK potential -------------------------------- goto 50 C---------------------- GB or BP potential ----------------------------- 30 do i=1,ntyp - read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + read (isidep,*,end=116,err=116)(eps(i,j),j=i,ntyp) enddo - read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) - read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) + read (isidep,*,end=116,err=116)(sigma0(i),i=1,ntyp) + read (isidep,*,end=116,err=116)(sigii(i),i=1,ntyp) + read (isidep,*,end=116,err=116)(chip(i),i=1,ntyp) + read (isidep,*,end=116,err=116)(alp(i),i=1,ntyp) C For the GB potential convert sigma'**2 into chi' if (ipot.eq.4) then do i=1,ntyp @@ -1134,7 +1127,7 @@ C For the GB potential convert sigma'**2 into chi' endif goto 50 C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), + 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) if (lprint) then @@ -1275,7 +1268,7 @@ c lprint=.false. C C Define the constants of the disulfide bridge C - ebr=-5.50D0 + ebr=-12.00D0 c c Old arbitrary potential - commented out. c diff --git a/source/unres/src_MD-M-newcorr/readrtns_CSA.F b/source/unres/src_MD-M-newcorr/readrtns_CSA.F index 265b705..078ff5e 100644 --- a/source/unres/src_MD-M-newcorr/readrtns_CSA.F +++ b/source/unres/src_MD-M-newcorr/readrtns_CSA.F @@ -679,12 +679,36 @@ C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,"V2SS",v2ss,7.61d0) call reada(weightcard,"V3SS",v3ss,13.7d0) call reada(weightcard,"EBR",ebr,-5.50D0) + dyn_ss=(index(weightcard,'DYN_SS').gt.0) + do i=1,maxres + dyn_ss_mask(i)=.false. + enddo + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo + enddo + call reada(weightcard,"HT",Ht,0.0D0) + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + endif + if(me.eq.king.or..not.out1file) then write (iout,*) "Parameters of the SS-bond potential:" write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, & " AKCT",akct write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr + write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth + write (iout,*)" HT",Ht c print *,'indpdb=',indpdb,' pdbref=',pdbref endif if (indpdb.gt.0 .or. pdbref) then @@ -1055,19 +1079,36 @@ C Generate distance constraints, if the PDB structure is to be regularized. write (iout,'(/a,i3,a)') & 'The chain contains',ns,' disulfide-bridging cysteines.' write (iout,'(20i4)') (iss(i),i=1,ns) + if (dyn_ss) then + write(iout,*)"Running with dynamic disulfide-bond formation" + else write (iout,'(/a/)') 'Pre-formed links are:' do i=1,nss i1=ihpb(i)-nres i2=jhpb(i)-nres it1=itype(i1) it2=itype(i2) - if (me.eq.king.or..not.out1file) - & write (iout,'(2a,i3,3a,i3,a,3f10.3)') + write (iout,'(2a,i3,3a,i3,a,3f10.3)') & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), & ebr,forcon(i) enddo write (iout,'(a)') endif + endif + if (ns.gt.0.and.dyn_ss) then + do i=nss+1,nhpb + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. + enddo + endif if (i2ndstr.gt.0) call secstrp2dihc c call geom_to_var(nvar,x) c call etotal(energia(0)) @@ -1130,10 +1171,12 @@ C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' #ifdef MPI call MPI_Finalize(MPI_COMM_WORLD,ierror) @@ -1144,7 +1187,8 @@ C Check whether the specified bridging residues are cystines. C Read preformed bridges. if (ns.gt.0) then read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) + if(fg_rank.eq.0) + &write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) if (nss.gt.0) then nhpb=nss C Check if the residues involved in bridges are in the specified list of diff --git a/source/unres/src_MD-M-newcorr/stochfric.F b/source/unres/src_MD-M-newcorr/stochfric.F index bc12f3e..13d02fb 100644 --- a/source/unres/src_MD-M-newcorr/stochfric.F +++ b/source/unres/src_MD-M-newcorr/stochfric.F @@ -39,7 +39,7 @@ ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10) then + if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then do j=1,3 d_t_work(ind+j)=d_t(j,i+nres) enddo @@ -68,7 +68,7 @@ ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10) then + if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then do j=1,3 friction(j,i+nres)=fric_work(ind+j) enddo @@ -234,7 +234,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. stochforc(j,0)=ff(j)+force(j,nnt+nres) enddo do i=nnt,nct - if (itype(i).ne.10) then + if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then do j=1,3 stochforc(j,i+nres)=force(j,i+nres) enddo @@ -252,7 +252,7 @@ c Compute the stochastic forces acting on virtual-bond vectors. ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10) then + if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then do j=1,3 stochforcvec(ind+j)=stochforc(j,i+nres) enddo diff --git a/source/unres/src_MD-M/CMakeCache.txt b/source/unres/src_MD-M/CMakeCache.txt deleted file mode 100644 index c27e7ad..0000000 --- a/source/unres/src_MD-M/CMakeCache.txt +++ /dev/null @@ -1,326 +0,0 @@ -# This is the CMakeCache file. -# For build in directory: /users/adam/unres/source/unres/src_MD-M -# It was generated by CMake: /usr/bin/cmake -# You can edit this file to change values found and used by cmake. -# If you do not want to change any of the values, simply exit the editor. -# If you do want to change a value, simply edit, save, and exit the editor. -# The syntax for the file is as follows: -# KEY:TYPE=VALUE -# KEY is the name of a variable in the cache. -# TYPE is a hint to GUI's for the type of VALUE, DO NOT EDIT TYPE!. -# VALUE is the current value for the KEY. - -######################## -# EXTERNAL cache entries -######################## - -//Path to a program. -CMAKE_AR:FILEPATH=/usr/bin/ar - -//For backwards compatibility, what version of CMake commands and -// syntax should this version of CMake try to support. -CMAKE_BACKWARDS_COMPATIBILITY:STRING=2.4 - -//Choose the type of build, options are: None(CMAKE_CXX_FLAGS or -// CMAKE_C_FLAGS used) Debug Release RelWithDebInfo MinSizeRel. -CMAKE_BUILD_TYPE:STRING= - -//Enable/Disable color output during build. -CMAKE_COLOR_MAKEFILE:BOOL=ON - -//CXX compiler. -CMAKE_CXX_COMPILER:FILEPATH=/usr/bin/c++ - -//Flags used by the compiler during all build types. -CMAKE_CXX_FLAGS:STRING= - -//Flags used by the compiler during debug builds. -CMAKE_CXX_FLAGS_DEBUG:STRING=-g - -//Flags used by the compiler during release minsize builds. -CMAKE_CXX_FLAGS_MINSIZEREL:STRING=-Os -DNDEBUG - -//Flags used by the compiler during release builds (/MD /Ob1 /Oi -// /Ot /Oy /Gs will produce slightly less optimized but smaller -// files). -CMAKE_CXX_FLAGS_RELEASE:STRING=-O3 -DNDEBUG - -//Flags used by the compiler during Release with Debug Info builds. -CMAKE_CXX_FLAGS_RELWITHDEBINFO:STRING=-O2 -g - -//C compiler. -CMAKE_C_COMPILER:FILEPATH=/usr/bin/gcc - -//Flags used by the compiler during all build types. -CMAKE_C_FLAGS:STRING= - -//Flags used by the compiler during debug builds. -CMAKE_C_FLAGS_DEBUG:STRING=-g - -//Flags used by the compiler during release minsize builds. -CMAKE_C_FLAGS_MINSIZEREL:STRING=-Os -DNDEBUG - -//Flags used by the compiler during release builds (/MD /Ob1 /Oi -// /Ot /Oy /Gs will produce slightly less optimized but smaller -// files). -CMAKE_C_FLAGS_RELEASE:STRING=-O3 -DNDEBUG - -//Flags used by the compiler during Release with Debug Info builds. -CMAKE_C_FLAGS_RELWITHDEBINFO:STRING=-O2 -g - -//Flags used by the linker. -CMAKE_EXE_LINKER_FLAGS:STRING= - -//Flags used by the linker during debug builds. -CMAKE_EXE_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during release minsize builds. -CMAKE_EXE_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during release builds. -CMAKE_EXE_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during Release with Debug Info builds. -CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//Fortran compiler. -CMAKE_Fortran_COMPILER:FILEPATH=/usr/bin/gfortran - -//Flags for Fortran compiler. -CMAKE_Fortran_FLAGS:STRING= - -//Flags used by the compiler during debug builds. -CMAKE_Fortran_FLAGS_DEBUG:STRING=-g - -//Flags used by the compiler during release minsize builds. -CMAKE_Fortran_FLAGS_MINSIZEREL:STRING=-Os - -//Flags used by the compiler during release builds (/MD /Ob1 /Oi -// /Ot /Oy /Gs will produce slightly less optimized but smaller -// files). -CMAKE_Fortran_FLAGS_RELEASE:STRING=-O3 - -//Flags used by the compiler during Release with Debug Info builds. -CMAKE_Fortran_FLAGS_RELWITHDEBINFO:STRING=-O2 -g - -//Install path prefix, prepended onto install directories. -CMAKE_INSTALL_PREFIX:PATH=/usr/local - -//Path to a program. -CMAKE_LINKER:FILEPATH=/usr/bin/ld - -//Path to a program. -CMAKE_MAKE_PROGRAM:FILEPATH=/usr/bin/gmake - -//Flags used by the linker during the creation of modules. -CMAKE_MODULE_LINKER_FLAGS:STRING= - -//Flags used by the linker during debug builds. -CMAKE_MODULE_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during release minsize builds. -CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during release builds. -CMAKE_MODULE_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during Release with Debug Info builds. -CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//Path to a program. -CMAKE_NM:FILEPATH=/usr/bin/nm - -//Path to a program. -CMAKE_OBJCOPY:FILEPATH=/usr/bin/objcopy - -//Path to a program. -CMAKE_OBJDUMP:FILEPATH=/usr/bin/objdump - -//Value Computed by CMake -CMAKE_PROJECT_NAME:STATIC=Project - -//Path to a program. -CMAKE_RANLIB:FILEPATH=/usr/bin/ranlib - -//Flags used by the linker during the creation of dll's. -CMAKE_SHARED_LINKER_FLAGS:STRING= - -//Flags used by the linker during debug builds. -CMAKE_SHARED_LINKER_FLAGS_DEBUG:STRING= - -//Flags used by the linker during release minsize builds. -CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL:STRING= - -//Flags used by the linker during release builds. -CMAKE_SHARED_LINKER_FLAGS_RELEASE:STRING= - -//Flags used by the linker during Release with Debug Info builds. -CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO:STRING= - -//If set, runtime paths are not added when using shared libraries. -CMAKE_SKIP_RPATH:BOOL=NO - -//Path to a program. -CMAKE_STRIP:FILEPATH=/usr/bin/strip - -//If true, cmake will use relative paths in makefiles and projects. -CMAKE_USE_RELATIVE_PATHS:BOOL=OFF - -//If this value is on, makefiles will be generated without the -// .SILENT directive, and all commands will be echoed to the console -// during the make. This is useful for debugging only. With Visual -// Studio IDE projects all commands are done without /nologo. -CMAKE_VERBOSE_MAKEFILE:BOOL=FALSE - -//Single output directory for building all executables. -EXECUTABLE_OUTPUT_PATH:PATH= - -//Single output directory for building all libraries. -LIBRARY_OUTPUT_PATH:PATH= - -//Value Computed by CMake -Project_BINARY_DIR:STATIC=/users/adam/unres/source/unres/src_MD-M - -//Value Computed by CMake -Project_SOURCE_DIR:STATIC=/users/adam/unres/source/unres/src_MD-M - - -######################## -# INTERNAL cache entries -######################## - -//ADVANCED property for variable: CMAKE_AR -CMAKE_AR-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_BUILD_TOOL -CMAKE_BUILD_TOOL-ADVANCED:INTERNAL=1 -//What is the target build tool cmake is generating for. -CMAKE_BUILD_TOOL:INTERNAL=/usr/bin/gmake -//This is the directory where this CMakeCache.txt was created -CMAKE_CACHEFILE_DIR:INTERNAL=/users/adam/unres/source/unres/src_MD-M -//Major version of cmake used to create the current loaded cache -CMAKE_CACHE_MAJOR_VERSION:INTERNAL=2 -//Minor version of cmake used to create the current loaded cache -CMAKE_CACHE_MINOR_VERSION:INTERNAL=8 -//Patch version of cmake used to create the current loaded cache -CMAKE_CACHE_PATCH_VERSION:INTERNAL=0 -//ADVANCED property for variable: CMAKE_COLOR_MAKEFILE -CMAKE_COLOR_MAKEFILE-ADVANCED:INTERNAL=1 -//Path to CMake executable. -CMAKE_COMMAND:INTERNAL=/usr/bin/cmake -//Path to cpack program executable. -CMAKE_CPACK_COMMAND:INTERNAL=/usr/bin/cpack -//Path to ctest program executable. -CMAKE_CTEST_COMMAND:INTERNAL=/usr/bin/ctest -//ADVANCED property for variable: CMAKE_CXX_COMPILER -CMAKE_CXX_COMPILER-ADVANCED:INTERNAL=1 -CMAKE_CXX_COMPILER_WORKS:INTERNAL=1 -//ADVANCED property for variable: CMAKE_CXX_FLAGS -CMAKE_CXX_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_CXX_FLAGS_DEBUG -CMAKE_CXX_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_CXX_FLAGS_MINSIZEREL -CMAKE_CXX_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_CXX_FLAGS_RELEASE -CMAKE_CXX_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_CXX_FLAGS_RELWITHDEBINFO -CMAKE_CXX_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_COMPILER -CMAKE_C_COMPILER-ADVANCED:INTERNAL=1 -CMAKE_C_COMPILER_WORKS:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS -CMAKE_C_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_DEBUG -CMAKE_C_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_MINSIZEREL -CMAKE_C_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_RELEASE -CMAKE_C_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_C_FLAGS_RELWITHDEBINFO -CMAKE_C_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//Result of TRY_COMPILE -CMAKE_DETERMINE_CXX_ABI_COMPILED:INTERNAL=TRUE -//Result of TRY_COMPILE -CMAKE_DETERMINE_C_ABI_COMPILED:INTERNAL=TRUE -//Result of TRY_COMPILE -CMAKE_DETERMINE_Fortran_ABI_COMPILED:INTERNAL=TRUE -//Path to cache edit program executable. -CMAKE_EDIT_COMMAND:INTERNAL=/usr/bin/ccmake -//Executable file format -CMAKE_EXECUTABLE_FORMAT:INTERNAL=ELF -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS -CMAKE_EXE_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_DEBUG -CMAKE_EXE_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_MINSIZEREL -CMAKE_EXE_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_RELEASE -CMAKE_EXE_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_EXE_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_COMPILER -CMAKE_Fortran_COMPILER-ADVANCED:INTERNAL=1 -CMAKE_Fortran_COMPILER_WORKS:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_FLAGS -CMAKE_Fortran_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_FLAGS_DEBUG -CMAKE_Fortran_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_FLAGS_MINSIZEREL -CMAKE_Fortran_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_FLAGS_RELEASE -CMAKE_Fortran_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_Fortran_FLAGS_RELWITHDEBINFO -CMAKE_Fortran_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//Name of generator. -CMAKE_GENERATOR:INTERNAL=Unix Makefiles -//Start directory with the top level CMakeLists.txt file for this -// project -CMAKE_HOME_DIRECTORY:INTERNAL=/users/adam/unres/source/unres/src_MD-M -//Install .so files without execute permission. -CMAKE_INSTALL_SO_NO_EXE:INTERNAL=0 -//ADVANCED property for variable: CMAKE_LINKER -CMAKE_LINKER-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MAKE_PROGRAM -CMAKE_MAKE_PROGRAM-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS -CMAKE_MODULE_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_DEBUG -CMAKE_MODULE_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL -CMAKE_MODULE_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_RELEASE -CMAKE_MODULE_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_MODULE_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_NM -CMAKE_NM-ADVANCED:INTERNAL=1 -//number of local generators -CMAKE_NUMBER_OF_LOCAL_GENERATORS:INTERNAL=1 -//ADVANCED property for variable: CMAKE_OBJCOPY -CMAKE_OBJCOPY-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_OBJDUMP -CMAKE_OBJDUMP-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_RANLIB -CMAKE_RANLIB-ADVANCED:INTERNAL=1 -//Path to CMake installation. -CMAKE_ROOT:INTERNAL=/usr/share/cmake -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS -CMAKE_SHARED_LINKER_FLAGS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_DEBUG -CMAKE_SHARED_LINKER_FLAGS_DEBUG-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL -CMAKE_SHARED_LINKER_FLAGS_MINSIZEREL-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_RELEASE -CMAKE_SHARED_LINKER_FLAGS_RELEASE-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO -CMAKE_SHARED_LINKER_FLAGS_RELWITHDEBINFO-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_SKIP_RPATH -CMAKE_SKIP_RPATH-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_STRIP -CMAKE_STRIP-ADVANCED:INTERNAL=1 -//uname command -CMAKE_UNAME:INTERNAL=/bin/uname -//ADVANCED property for variable: CMAKE_USE_RELATIVE_PATHS -CMAKE_USE_RELATIVE_PATHS-ADVANCED:INTERNAL=1 -//ADVANCED property for variable: CMAKE_VERBOSE_MAKEFILE -CMAKE_VERBOSE_MAKEFILE-ADVANCED:INTERNAL=1 - diff --git a/source/unres/src_MD-M/CMakeFiles/CMakeCCompiler.cmake b/source/unres/src_MD-M/CMakeFiles/CMakeCCompiler.cmake deleted file mode 100644 index 418c356..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CMakeCCompiler.cmake +++ /dev/null @@ -1,41 +0,0 @@ -SET(CMAKE_C_COMPILER "/usr/bin/gcc") -SET(CMAKE_C_COMPILER_ARG1 "") -SET(CMAKE_C_COMPILER_ID "GNU") -SET(CMAKE_C_PLATFORM_ID "Linux") -SET(CMAKE_AR "/usr/bin/ar") -SET(CMAKE_RANLIB "/usr/bin/ranlib") -SET(CMAKE_COMPILER_IS_GNUCC 1) -SET(CMAKE_C_COMPILER_LOADED 1) -SET(CMAKE_COMPILER_IS_MINGW ) -SET(CMAKE_COMPILER_IS_CYGWIN ) -IF(CMAKE_COMPILER_IS_CYGWIN) - SET(CYGWIN 1) - SET(UNIX 1) -ENDIF(CMAKE_COMPILER_IS_CYGWIN) - -SET(CMAKE_C_COMPILER_ENV_VAR "CC") - -IF(CMAKE_COMPILER_IS_MINGW) - SET(MINGW 1) -ENDIF(CMAKE_COMPILER_IS_MINGW) -SET(CMAKE_C_COMPILER_ID_RUN 1) -SET(CMAKE_C_SOURCE_FILE_EXTENSIONS c) -SET(CMAKE_C_IGNORE_EXTENSIONS h;H;o;O;obj;OBJ;def;DEF;rc;RC) -SET(CMAKE_C_LINKER_PREFERENCE 10) - -# Save compiler ABI information. -SET(CMAKE_C_SIZEOF_DATA_PTR "8") -SET(CMAKE_C_COMPILER_ABI "ELF") - -IF(CMAKE_C_SIZEOF_DATA_PTR) - SET(CMAKE_SIZEOF_VOID_P "${CMAKE_C_SIZEOF_DATA_PTR}") -ENDIF(CMAKE_C_SIZEOF_DATA_PTR) - -IF(CMAKE_C_COMPILER_ABI) - SET(CMAKE_INTERNAL_PLATFORM_ABI "${CMAKE_C_COMPILER_ABI}") -ENDIF(CMAKE_C_COMPILER_ABI) - -SET(CMAKE_C_HAS_ISYSROOT "") - -SET(CMAKE_C_IMPLICIT_LINK_LIBRARIES "c") -SET(CMAKE_C_IMPLICIT_LINK_DIRECTORIES "/usr/lib/gcc/x86_64-redhat-linux/4.4.5;/usr/lib64;/lib64;/usr/lib") diff --git a/source/unres/src_MD-M/CMakeFiles/CMakeCXXCompiler.cmake b/source/unres/src_MD-M/CMakeFiles/CMakeCXXCompiler.cmake deleted file mode 100644 index bb4e208..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CMakeCXXCompiler.cmake +++ /dev/null @@ -1,42 +0,0 @@ -SET(CMAKE_CXX_COMPILER "/usr/bin/c++") -SET(CMAKE_CXX_COMPILER_ARG1 "") -SET(CMAKE_CXX_COMPILER_ID "GNU") -SET(CMAKE_CXX_PLATFORM_ID "Linux") -SET(CMAKE_AR "/usr/bin/ar") -SET(CMAKE_RANLIB "/usr/bin/ranlib") -SET(CMAKE_COMPILER_IS_GNUCXX 1) -SET(CMAKE_CXX_COMPILER_LOADED 1) -SET(CMAKE_COMPILER_IS_MINGW ) -SET(CMAKE_COMPILER_IS_CYGWIN ) -IF(CMAKE_COMPILER_IS_CYGWIN) - SET(CYGWIN 1) - SET(UNIX 1) -ENDIF(CMAKE_COMPILER_IS_CYGWIN) - -SET(CMAKE_CXX_COMPILER_ENV_VAR "CXX") - -IF(CMAKE_COMPILER_IS_MINGW) - SET(MINGW 1) -ENDIF(CMAKE_COMPILER_IS_MINGW) -SET(CMAKE_CXX_COMPILER_ID_RUN 1) -SET(CMAKE_CXX_IGNORE_EXTENSIONS inl;h;H;o;O;obj;OBJ;def;DEF;rc;RC) -SET(CMAKE_CXX_SOURCE_FILE_EXTENSIONS C;M;c++;cc;cpp;cxx;m;mm) -SET(CMAKE_CXX_LINKER_PREFERENCE 30) -SET(CMAKE_CXX_LINKER_PREFERENCE_PROPAGATES 1) - -# Save compiler ABI information. -SET(CMAKE_CXX_SIZEOF_DATA_PTR "8") -SET(CMAKE_CXX_COMPILER_ABI "ELF") - -IF(CMAKE_CXX_SIZEOF_DATA_PTR) - SET(CMAKE_SIZEOF_VOID_P "${CMAKE_CXX_SIZEOF_DATA_PTR}") -ENDIF(CMAKE_CXX_SIZEOF_DATA_PTR) - -IF(CMAKE_CXX_COMPILER_ABI) - SET(CMAKE_INTERNAL_PLATFORM_ABI "${CMAKE_CXX_COMPILER_ABI}") -ENDIF(CMAKE_CXX_COMPILER_ABI) - -SET(CMAKE_CXX_HAS_ISYSROOT "") - -SET(CMAKE_CXX_IMPLICIT_LINK_LIBRARIES "stdc++;m;c") -SET(CMAKE_CXX_IMPLICIT_LINK_DIRECTORIES "/usr/lib/gcc/x86_64-redhat-linux/4.4.5;/usr/lib64;/lib64;/usr/lib") diff --git a/source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_C.bin b/source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_C.bin deleted file mode 100755 index a16edc4f2cb1a2dd6d91163aeca1f94f1b7e3cac..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6997 zcmcIoeQZkWOMy-=I1Vqx5D4kU1nr9xJF%%_XZAA+ z2-HlW9af-Cr)g!?#E`}&q;=D_KTx(xs}bu`q;+EL%Fv3Y49b*|u)L}hh_nl)u zzc}hNZP)TU_x$ep-E-f4_wzjK5475CHo?g*zARA7mMIc4oIw?cBA*2*`vS1- z*YuF&QbkUeA}v{Zh{uw7JAjAn{7)0N^U+wed)=BxW1+fOG@c%;8*Exvw{DF$mGCyo z_E$lL_==miJt?c^{-_2GeJ_DOeoHLx_{qh$zVoB&hcCXWFa6yw_D!8~{%tFNXXKT` zf3#}IB|i7Se3#R?@Q70=SO?-2@ZUSvckx$Ozje^(e|LJp`j_W7cE5My)h$=Ee}3!g ziA!JKRlE1uR}TL2*sY4OnzFG4ORk)ldglYAl}y-XcZm{wpHjFNaC|3g8UUb5)QBVV zx{8XvEAd;olNS60;YTfa5^#5kdiDWcEf(hI8>lh`;kiguiVNk6)cHFf0uAkN&N1+e zEEVDy$SQFwXZ5>*>`#$B>X^O>|7tN`4ADH7AUqWKqu&YgyOaucfJDC&R1Xbnv0LI5 zVvOv`TnJ6;>rceBlpaj#nkKX-_GumAzGzAhCw;MCDiux%7$c) zyf>kxq6fl>UM)1BC)uPYmDYNr@u<+++QB{)jce&tI0VI^pdK`8Fx!Hu4tjSg#bx0* zSclPCY!0+-@@b9UM(!{4Rma$AQe9mdppuxh0p?;d9U@Q_1V<$Q}=Lb<9&07zuf50+4eD zMs&~0z{o*QJ#<48yp~M){)Qf|fp)0FcXRr(*Kk{+ew}i`cN&5IzMD(mq8>E9vf^oXsvB3@I4)~vhDmQ|>3~~?1 zX^=WdT<0;_4s;0HV3lq8f^rw`d9{Gye-GHnwWYbD>Uq0w;hcS7066lnzCkGGH3L*R zhdMzH04~?C9Y@QapQBYM!{sm9UvM0A+ILm(9)(%Z1xdcL8b_Je=v&Al_q4S=awHx|8VWgjvoKLcbB(ImG=I45Z=0EoV+jGC-x`63H zLx>2i%ZzU)o%@9ObIG1{=uY`Q^<)qIBz0bkZjwHa%8CAe7kpl_I{K-p9h-f=_3o8$ zl33+l<6Yxj>u#)XsBdU!Xmqda2#4HiP&e?p##KUiQ~Ue%U^hrTX~+oYqH)+{281`B z(8J#5O>K30u#dF9c-q^Yj>2WLXABEeKdctiW+P@f@TvymnH!pT%L5ie3SC`*Q8 zK_pOaAf^ki+-AIbco6b(d-5g|a*OeXBU*1V*dNv+A>gtmyghm%nF5D~*xLhzP-n0| z+5-*~Pz^l1vTmau*uj95=Z-%WgL`w12YAcIY1KCds^iO=szD%|&s#Q0$g zpVzBM2|ljDR{jfsVW05&%Iouxg%2h&QMa-xaL+LFkJCDGocQj%rIBGipWD7|;b)1T zC4S)^Xz-cG)xKik^L{dhgBp_cV#5B7QXx)42HVg5&*%IL#9z&ZB(45WTljoGbW%rq zEPSi~GZy|zx@WE={y__$zaPU{;^Q2^#P?{vUt8O2<&Ogg-=Fz-V#G8?hM&g&J=mK0 zcwEHvCh@KQtol1(i(`-d^Zvy5e7?`~_+&n}>oRc7{`uVBMF#}72Q!&iXZcq^&3rx| zM2PP;X!$4eSYEgA`F?tY_}1@j)o%hH>*DtxrSr*A;`4iQ1K2O?w;_Y=uV;WH^S@}p z(H0ZSMUZFTvVb0A5i8z9+rw|7zuBS@yx>t-Z z61<)jrR&$l6eQ*UU*$G7dpgJhzFLke;|MVFSdVB@cb^uXU3JV+#!|; zo{z=$51Cb&H|D`YF-`jy8{qtMLOh6dmbH+vK_rLQYsSAI@tOV5B=MR3;0N3e@t~?X z3gik2<3To4`+45%CHy$8Gdv#$0mpiVEcMLR{=>4KYVk8m|Gy;hMdGAOfm|VdAF{R* z-|@$QOTXnx!5DI9;a{rX-UZwSaWRZ9VB-D#FOavvtMs*25w1y49(1Q>VPx# diff --git a/source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_CXX.bin b/source/unres/src_MD-M/CMakeFiles/CMakeDetermineCompilerABI_CXX.bin deleted file mode 100755 index 0ac3e129ea164d6d0046ca2027014a86bc1a3274..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7283 zcmcIoeQaA-6~BJYhqE*v?K;-2VKLxJ>9%-Innqr`qL(^ppEtM3(hPZY+p}Xkv0KMB z_H#+Pq7{-=Gg-HQCNT|G%ETX$m^6t$24e_ZG6?+xRH%TCR-&|2OWRaU1*i{AFH(T$hOFMb*S@!p;i33S~(ElB^4Yx9A!pPAx=^@roo1QRlsNx=NfeI|tAY z+p36ir7pm6;w_>bE^3ePLlyl}!Y?KKh|_x!r}x8m!#~yABFUhkE+b>T{8{9@F8~|3 zpoLMM5*1C^WNt~^!8OK+li!ozhwc1NiQ4%{JT~0j^+-J29*-rmU3bF6D?|h0^P5rS7G>p9({`f7ieEP%gi!aR|{ZY+Z(bl)#o|=puUH3Km&gfSQ z|C#24Hujm-b+)RihL@^X57vQrBmDQ&dH(p5^WQw+>HEXticR0D?;JjTT>)>)BGZED)U?;CKTI2z#0ihdAEI+@d|?w1MM{ zwbjT3=^VyYMhk}?dI-l-H&fNov1CHcXu-6ms!V-+pE?*Bjb*e*+7l0EGLa0LjE}3S zNIH{D1miJnLfz+LP|cWL14yHxkeWfQ1Mv{mjIyYCEEr2bMH~rbvg$}I5o4;iABw}V zgqqDn!cZIzYC+w>XbYwq=);)|l|>R@9YJg6@%wwWdesi+2DaVj-Re<0ot@5&^vV*< zk;*?D|44c%ej^+QjGcUEFDzqLb^>H1EDr$3a-{72F<5aVc3M}NON=L+;}(G-8xT0o zA&P~#-+)t{h%1wewuKA`3ldbba0?#FOJ1eZ~f@f2!3=-;5bh&u80JQEw z)G_qM6QE)NQpXi^606I zW2C9Im%&TqElRHXO)x5~{v|h>u6`9=9zB&l_p9pXL9}4F-N)xfMn;@Xty8@H%H)=S z1aUB~whCtvZ=3DsQHXQAaQ67z%nX+0zOty~vS;V}ZlcL_-=gw*)4K-)FdLeFmbdiX zBqVDo4@=Zh3Rpm1DQ8-rS!SHs3B3lozjPEgh%vJNa_|^yRMi=C1Y>R-aKO=b%q6r!Ohf z&p4o~S+}6J-6Wbq2j;P_3mfr1hKg&269FFaV z!^g8Qp4VD8+rb>i?@_1{J|{Z^9M_^n;I9F1fj^RE|G*%#j5pU^&25I$(q145@`7_Hk40;hHPK@$uMzwn!HMBFLUPv!IHx{yajn?TxE>+ht234t`wZc; zLZ?2Yc(CYkA|1M)zfV-yLl<+M;w}kY7UjbI|IXpV(QECIV^ia8TWE#idT zs9g(=3T-rzbq;4^aEyzEnG>~WFcW3Y@I(UY)47(`OZLGI8%rii6cx(Sk$4atgp`VF z%*pperxqCpneU~}bdv9f&PY@pNe9OwYBUVKq%mhmOQtgrP-lBWPzZGf$6_G}n1pKJ z;pBDe^}u!uPRX&cNJ7KT`Y&lM_~RU+@xde+G#~-cI--Ncc}V)_K)^9d{wBr@~8Rs1+c|APX4rR_(elM!paOp>lH!Ifq-+A{Apgw)w;!J zg`rTFTe9LS%}c(0lKW#KOi z{~M+cMt)S^8zz6+SKQ)7@t$TRici>45HJMwKiyvjgg@RFjAV{K3x!61y7$t3*kN=A z*&H7)ghu~aIFBLCium8*TJa&^Wgrg{`qMr~`2orsnA>aipEvpANfgO1HnxA~|68y% z#>ZnQQdIbx}CGa4f_+L%_ zbWU&!|2A?IocxGiGWpZJJ0Sec-`lJ&fj`zo?;ouXfW}x@_|toG5FQkl^p8Qn_jeH> zIQc(p!bNv-A1qo4e~N81oe}YG8$poCpJ3E!?huB&84s#JF7e?$4RR;^sr|Hm;V`Kb zU%np-fHs&aH^%k>cP*b!OY!pj2$ox6<)?MI)V@5AquZC~O?14N-zlx9 z8S;O!5#q8HMi;GT#zHG(cxas}#qWl7Ct!rQY=zqptt-YtE4v5soR#c9wVZz_wZC`y z9#D#x=gY9%%I;${A4~1U;52~xJZNC?8rgvA^Q#K-TqPhVE%3Kg=!XY6UfvIGj+ggC zAK((?%Vtb*cXRt<`)S_n5qL_hGc+H^MLn!m2B}E6K2&P|6yVtY0aO2fgX1fiTqlE6 zr0;@gsqh_t064av+2o=zNXOt`Dei}WTOiMfnG7Vl?_C8Mam;5R(Y}8ZWDDHtXkF)p z@K^;Mg7$t>+*Xd?%`k~$q=$J2u426=e9Im10bWn}_OV{^Lj`t@~__kKf>!NpV!~#c+sDvIlwFBbAJzbrTp?=cs=EL-mBccJkR@yz{kZn zq`0`5RLTq20*?7^bKbU%qO4p|qCKvXJo#K`zxZ)IX^Dyt{@l z<*W9VXpeggMd7468cz-f<0`*6s=@3ygG*s59?>FUXZMB;ZiWSFEIbZcmy79l&v15Z zY=YwS?d;`Ywhi{|=u=6tU61)OtQ!m>RnMPAPTWUeAZ?xp&Nv%d#?bKhBtTLcloln|_h#R_ z+gsmJq^fh;d++_`y?HaUGjC>R9_SAAxLq#6$t`XcDEYjqgsgudX6vO$SiA5FReW2l z7s~*thDVh-NG*pyLVksqqD6ozV4$uPavf(28yyA|xPo?ka{J)5JE;q62UzvF~>F-7bsf{#XMN`d$YQzDvxnKan5&{zCij9;%t2kDq+=rMKrU)MDOB zc+hS+JTt2&y`pv93U5_a?W0vf#k^X0z5&m^6`gOt^3hKYbawyc?5gX3TGKZC?k6wo z`Y8L(>mNO{@T0v=-nVbc?t9?r1HV6XzHZgJ51%>n)@OBKRyI8bDAv)L5c4@fkiSy_ z{{ZlExMw1m~N2x`TU~}d?(?i178QYuS_|O zfUki!!tP2>?Dj^Y=ePpz zB@#-d^^r(CBJ|!pkR6W1^>oSzLv}c51}y`-E~uIy52sR`XT-x|cSmm@_L6}{VrQUt zN2lJVv?<%f&YnF3g99CXdaKfcy=}b-4^aNOAcBlkAD1GqW zFGrJA!$=*y}9Ec<_4gex!0i$+SDJs$Mf4BTjmq_s~?B|`VA^@D377t z;;B5Os~zl$$Qc^}Hy@{iPS=n~K= zS(lcnejSwZ>;5Q}rmK&l$#o0K5C2sCJg_cwcjx@^k&zLle#67E{@T<{V;=B>e$6#6 zBZhVJ9_NIateaU+`$&$uz%+c z`hc61oF6#sGwqNBwai@ZS%64<1y{!-YoSQY*k8;*@fr~4k87E`{O7bx)PFJaC3H)p zHhr^}xsZ#YZsya>`?)Q^;3`Z znrLvXU$xvj0|nte7@t8XL#~+}bq$ZWJ8PG@?*k1h??%Xf5%T5Q8F<7!<>{*P?W==a ztK7SQo`8HD#GL%VnDD#?cm}~+AFqC7nO>((Eq~Jegy&F|d#_ah=0URar8}>a5$6ai584lpNPs zBJ6;yg!@l>!oZ2iM{%3`>^TcAyr<wO#Hi(!**tFl$u z=4)$dZE0<7ZS!p$Fv319Xj=H@woO7Psr@lCI1JQGT6B!LNF26C<3foiOhbWLyV(qm zk~A7mE5qpseAYz5LP2RPm>LsGcz+zqv#6Q0a_%*fDVXUcf)05}BN{{l;>M$(c3A9AaJ;JlYa3|XXbCcyKIV9^H*&ULoW zx>b;b$P%!TD8>tHJKOWT`~hGX3)r6HOO7ha@dQ+4a`qp7$KhONd!E1j6rdEct0u~N zOz#04V*|?^A129OB|8*RhwD$UxE~m-D%*2B%91^|ll`+j;}1LRIle8B{d439?J;IM z?VkV)`-IdB@qCg3B>MpsnW$S?6u2hY?GIBtIZXDG1x<@#d;Ffj^b|aHd;YHVQAH=X zW2AQRJA*{=w8NgiD-Y9xQpbu!*+0Xxz@UG2lU=ET1mlnFXQfp9^A%aiVgK6g`5b77 z7BD^sVl$`zmmKypHL6sdA^V@PAyIyR3}=Bs|GXaZc^RLhaX+)Z(|*ojk2`lvDlPE; z&HfG0wfo0yJEnfJclvY6Z-Fk3J+42mXMCQQ#lj)+_+)#o*L#p>_s`#(jr8JKUlsy? zEHnMUVbA*sAKCY_AyKwt`mw{F&wa+p-ub?r@;R`_vbg;dw4X7_p4&<83-xFD0x;PA z76yp2y>t9gcS;*nT@4TWCR0gf$^T_L2t3;}j55z1#*q4G!}T1!xNiZ5YYq1s#}(XX zmGl1^8bCVjDBS7a(klP&!P>gjC7F2k!Rw?w(*rf(^{*7KD(quR@oHG7R68Vj4~$k` zhwPaiSZR5EDaE~l*Nswqh2Zs|6kjPg&X?j#&*3oN1CgKOa;g5(b3{wO%=w%wr+B_t zT22F;hpTo-@*Wsn9M9~T9yl4~I8}1$~omIr&9eNmgTGw?T+{LV~MX88&|2o z71Pgwb(MLK&jXJ2A6lsvm4Q13Pq}`37jT!T7kCbY$tVAX_!y{5lzG39l2q6Z&X0F&vEQ@`F_mrY8h^jE+a)JS?ni z-?F7$V1^zEPk^+wMOfdw;dCsvpZ#?AbxAip10B1&b(YW#^F=T6>sWfJd>%*lE=r5i zy7jv4Lf;wKv!f%R@9F8et$R=(?AQ_L##V(>34JUW4@coD#cCqE!;f}7m`n!u>v)x+ z>o!1M{|LS7hkYHpdpkw>D-rAZgj9=nLUf}euWwYf*A+iu=EznX ignore - arg [--no-add-needed] ==> ignore - arg [--eh-frame-hdr] ==> ignore - arg [--build-id] ==> ignore - arg [-m] ==> ignore - arg [elf_x86_64] ==> ignore - arg [--hash-style=gnu] ==> ignore - arg [-export-dynamic] ==> ignore - arg [-dynamic-linker] ==> ignore - arg [/lib64/ld-linux-x86-64.so.2] ==> ignore - arg [-o] ==> ignore - arg [cmTryCompileExec] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o] ==> ignore - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] - arg [-L/lib/../lib64] ==> dir [/lib/../lib64] - arg [-L/usr/lib/../lib64] ==> dir [/usr/lib/../lib64] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] - arg [CMakeFiles/cmTryCompileExec.dir/CMakeCCompilerABI.c.o] ==> ignore - arg [-lgcc] ==> lib [gcc] - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--no-as-needed] ==> ignore - arg [-lc] ==> lib [c] - arg [-lgcc] ==> lib [gcc] - arg [--as-needed] ==> ignore - arg [-lgcc_s] ==> lib [gcc_s] - arg [--no-as-needed] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o] ==> ignore - remove lib [gcc] - remove lib [gcc_s] - remove lib [gcc] - remove lib [gcc_s] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> [/usr/lib64] - collapse dir [/lib/../lib64] ==> [/lib64] - collapse dir [/usr/lib/../lib64] ==> [/usr/lib64] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> [/usr/lib] - implicit libs: [c] - implicit dirs: [/usr/lib/gcc/x86_64-redhat-linux/4.4.5;/usr/lib64;/lib64;/usr/lib] - - -Determining if the CXX compiler works passed with the following output: -Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp - -Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast" -/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build -gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' -/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1 -Building CXX object CMakeFiles/cmTryCompileExec.dir/testCXXCompiler.cxx.o -/usr/bin/c++ -o CMakeFiles/cmTryCompileExec.dir/testCXXCompiler.cxx.o -c /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/testCXXCompiler.cxx -Linking CXX executable cmTryCompileExec -/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1 -/usr/bin/c++ CMakeFiles/cmTryCompileExec.dir/testCXXCompiler.cxx.o -o cmTryCompileExec -rdynamic -gmake[1]: Leaving directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' - - -Detecting CXX compiler ABI info compiled with the following output: -Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp - -Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast" -/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build -gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' -/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1 -Building CXX object CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -/usr/bin/c++ -o CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -c /usr/share/cmake/Modules/CMakeCXXCompilerABI.cpp -Linking CXX executable cmTryCompileExec -/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1 -/usr/bin/c++ -v CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -o cmTryCompileExec -rdynamic -Using built-in specs. -Target: x86_64-redhat-linux -Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=http://bugzilla.redhat.com/bugzilla --enable-bootstrap --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-gnu-unique-object --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-1.5.0.0/jre --enable-libgcj-multifile --enable-java-maintainer-mode --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --disable-libjava-multilib --with-ppl --with-cloog --with-tune=generic --with-arch_32=i686 --build=x86_64-redhat-linux -Thread model: posix -gcc version 4.4.5 20101112 (Red Hat 4.4.5-2) (GCC) -COMPILER_PATH=/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/ -LIBRARY_PATH=/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/:/lib/../lib64/:/usr/lib/../lib64/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../:/lib/:/usr/lib/ -COLLECT_GCC_OPTIONS='-v' '-o' 'cmTryCompileExec' '-rdynamic' '-shared-libgcc' '-mtune=generic' - /usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2 --no-add-needed --eh-frame-hdr --build-id -m elf_x86_64 --hash-style=gnu -export-dynamic -dynamic-linker /lib64/ld-linux-x86-64.so.2 -o cmTryCompileExec /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64 -L/lib/../lib64 -L/usr/lib/../lib64 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../.. CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -lstdc++ -lm -lgcc_s -lgcc -lc -lgcc_s -lgcc /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o -gmake[1]: Leaving directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' - - -Parsed CXX implicit link information from above output: - link line regex: [^( *|.*[/\])(ld|ld|collect2)[^/\]*( |$)] - ignore line: [Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp] - ignore line: [] - ignore line: [Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast"] - ignore line: [/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build] - ignore line: [gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp'] - ignore line: [/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1] - ignore line: [Building CXX object CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o] - ignore line: [/usr/bin/c++ -o CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -c /usr/share/cmake/Modules/CMakeCXXCompilerABI.cpp] - ignore line: [Linking CXX executable cmTryCompileExec] - ignore line: [/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1] - ignore line: [/usr/bin/c++ -v CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -o cmTryCompileExec -rdynamic ] - ignore line: [Using built-in specs.] - ignore line: [Target: x86_64-redhat-linux] - ignore line: [Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=http://bugzilla.redhat.com/bugzilla --enable-bootstrap --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-gnu-unique-object --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-1.5.0.0/jre --enable-libgcj-multifile --enable-java-maintainer-mode --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --disable-libjava-multilib --with-ppl --with-cloog --with-tune=generic --with-arch_32=i686 --build=x86_64-redhat-linux] - ignore line: [Thread model: posix] - ignore line: [gcc version 4.4.5 20101112 (Red Hat 4.4.5-2) (GCC) ] - ignore line: [COMPILER_PATH=/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/:/lib/../lib64/:/usr/lib/../lib64/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'cmTryCompileExec' '-rdynamic' '-shared-libgcc' '-mtune=generic'] - link line: [ /usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2 --no-add-needed --eh-frame-hdr --build-id -m elf_x86_64 --hash-style=gnu -export-dynamic -dynamic-linker /lib64/ld-linux-x86-64.so.2 -o cmTryCompileExec /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64 -L/lib/../lib64 -L/usr/lib/../lib64 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../.. CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o -lstdc++ -lm -lgcc_s -lgcc -lc -lgcc_s -lgcc /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o] - arg [/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2] ==> ignore - arg [--no-add-needed] ==> ignore - arg [--eh-frame-hdr] ==> ignore - arg [--build-id] ==> ignore - arg [-m] ==> ignore - arg [elf_x86_64] ==> ignore - arg [--hash-style=gnu] ==> ignore - arg [-export-dynamic] ==> ignore - arg [-dynamic-linker] ==> ignore - arg [/lib64/ld-linux-x86-64.so.2] ==> ignore - arg [-o] ==> ignore - arg [cmTryCompileExec] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o] ==> ignore - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] - arg [-L/lib/../lib64] ==> dir [/lib/../lib64] - arg [-L/usr/lib/../lib64] ==> dir [/usr/lib/../lib64] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] - arg [CMakeFiles/cmTryCompileExec.dir/CMakeCXXCompilerABI.cpp.o] ==> ignore - arg [-lstdc++] ==> lib [stdc++] - arg [-lm] ==> lib [m] - arg [-lgcc_s] ==> lib [gcc_s] - arg [-lgcc] ==> lib [gcc] - arg [-lc] ==> lib [c] - arg [-lgcc_s] ==> lib [gcc_s] - arg [-lgcc] ==> lib [gcc] - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o] ==> ignore - remove lib [gcc_s] - remove lib [gcc] - remove lib [gcc_s] - remove lib [gcc] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> [/usr/lib64] - collapse dir [/lib/../lib64] ==> [/lib64] - collapse dir [/usr/lib/../lib64] ==> [/usr/lib64] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> [/usr/lib] - implicit libs: [stdc++;m;c] - implicit dirs: [/usr/lib/gcc/x86_64-redhat-linux/4.4.5;/usr/lib64;/lib64;/usr/lib] - - -Compiling the Fortran compiler identification source file "CMakeFortranCompilerId.F" succeeded. -Compiler: /usr/bin/gfortran -Build flags: -Id flags: - -The output was: -0 - - -Compilation of the Fortran compiler identification source "CMakeFortranCompilerId.F" produced "a.out" - -The Fortran compiler identification is GNU, found in "/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/a.out" - -Determining if the Fortran compiler works passed with the following output: -Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp - -Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast" -/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build -gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' -/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1 -Building Fortran object CMakeFiles/cmTryCompileExec.dir/testFortranCompiler.f.o -/usr/bin/gfortran -o CMakeFiles/cmTryCompileExec.dir/testFortranCompiler.f.o -c /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/testFortranCompiler.f -Linking Fortran executable cmTryCompileExec -/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1 -/usr/bin/gfortran CMakeFiles/cmTryCompileExec.dir/testFortranCompiler.f.o -o cmTryCompileExec -rdynamic -gmake[1]: Leaving directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' - - -Detecting Fortran compiler ABI info compiled with the following output: -Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp - -Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast" -/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build -gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' -/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1 -Building Fortran object CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -/usr/bin/gfortran -o CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -c /usr/share/cmake/Modules/CMakeFortranCompilerABI.F -Linking Fortran executable cmTryCompileExec -/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1 -/usr/bin/gfortran -v CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -o cmTryCompileExec -rdynamic -Driving: /usr/bin/gfortran -v CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -o cmTryCompileExec -rdynamic -lgfortranbegin -lgfortran -lm -shared-libgcc -Using built-in specs. -Target: x86_64-redhat-linux -Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=http://bugzilla.redhat.com/bugzilla --enable-bootstrap --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-gnu-unique-object --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-1.5.0.0/jre --enable-libgcj-multifile --enable-java-maintainer-mode --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --disable-libjava-multilib --with-ppl --with-cloog --with-tune=generic --with-arch_32=i686 --build=x86_64-redhat-linux -Thread model: posix -gcc version 4.4.5 20101112 (Red Hat 4.4.5-2) (GCC) -COMPILER_PATH=/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/ -LIBRARY_PATH=/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/:/lib/../lib64/:/usr/lib/../lib64/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../:/lib/:/usr/lib/ -COLLECT_GCC_OPTIONS='-v' '-o' 'cmTryCompileExec' '-rdynamic' '-shared-libgcc' '-mtune=generic' - /usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2 --no-add-needed --eh-frame-hdr --build-id -m elf_x86_64 --hash-style=gnu -export-dynamic -dynamic-linker /lib64/ld-linux-x86-64.so.2 -o cmTryCompileExec /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64 -L/lib/../lib64 -L/usr/lib/../lib64 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../.. CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -lgfortranbegin -lgfortran -lm -lgcc_s -lgcc -lc -lgcc_s -lgcc /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o -gmake[1]: Leaving directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' - - -Parsed Fortran implicit link information from above output: - link line regex: [^( *|.*[/\])(ld|ld|collect2)[^/\]*( |$)] - ignore line: [Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp] - ignore line: [] - ignore line: [Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast"] - ignore line: [/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build] - ignore line: [gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp'] - ignore line: [/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1] - ignore line: [Building Fortran object CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o] - ignore line: [/usr/bin/gfortran -o CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -c /usr/share/cmake/Modules/CMakeFortranCompilerABI.F] - ignore line: [Linking Fortran executable cmTryCompileExec] - ignore line: [/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1] - ignore line: [/usr/bin/gfortran -v CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -o cmTryCompileExec -rdynamic ] - ignore line: [Driving: /usr/bin/gfortran -v CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -o cmTryCompileExec -rdynamic -lgfortranbegin -lgfortran -lm -shared-libgcc] - ignore line: [Using built-in specs.] - ignore line: [Target: x86_64-redhat-linux] - ignore line: [Configured with: ../configure --prefix=/usr --mandir=/usr/share/man --infodir=/usr/share/info --with-bugurl=http://bugzilla.redhat.com/bugzilla --enable-bootstrap --enable-shared --enable-threads=posix --enable-checking=release --with-system-zlib --enable-__cxa_atexit --disable-libunwind-exceptions --enable-gnu-unique-object --enable-languages=c,c++,objc,obj-c++,java,fortran,ada --enable-java-awt=gtk --disable-dssi --with-java-home=/usr/lib/jvm/java-1.5.0-gcj-1.5.0.0/jre --enable-libgcj-multifile --enable-java-maintainer-mode --with-ecj-jar=/usr/share/java/eclipse-ecj.jar --disable-libjava-multilib --with-ppl --with-cloog --with-tune=generic --with-arch_32=i686 --build=x86_64-redhat-linux] - ignore line: [Thread model: posix] - ignore line: [gcc version 4.4.5 20101112 (Red Hat 4.4.5-2) (GCC) ] - ignore line: [COMPILER_PATH=/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/:/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/:/usr/libexec/gcc/x86_64-redhat-linux/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/] - ignore line: [LIBRARY_PATH=/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/:/lib/../lib64/:/usr/lib/../lib64/:/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../:/lib/:/usr/lib/] - ignore line: [COLLECT_GCC_OPTIONS='-v' '-o' 'cmTryCompileExec' '-rdynamic' '-shared-libgcc' '-mtune=generic'] - link line: [ /usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2 --no-add-needed --eh-frame-hdr --build-id -m elf_x86_64 --hash-style=gnu -export-dynamic -dynamic-linker /lib64/ld-linux-x86-64.so.2 -o cmTryCompileExec /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64 -L/lib/../lib64 -L/usr/lib/../lib64 -L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../.. CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o -lgfortranbegin -lgfortran -lm -lgcc_s -lgcc -lc -lgcc_s -lgcc /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o] - arg [/usr/libexec/gcc/x86_64-redhat-linux/4.4.5/collect2] ==> ignore - arg [--no-add-needed] ==> ignore - arg [--eh-frame-hdr] ==> ignore - arg [--build-id] ==> ignore - arg [-m] ==> ignore - arg [elf_x86_64] ==> ignore - arg [--hash-style=gnu] ==> ignore - arg [-export-dynamic] ==> ignore - arg [-dynamic-linker] ==> ignore - arg [/lib64/ld-linux-x86-64.so.2] ==> ignore - arg [-o] ==> ignore - arg [cmTryCompileExec] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o] ==> ignore - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] - arg [-L/lib/../lib64] ==> dir [/lib/../lib64] - arg [-L/usr/lib/../lib64] ==> dir [/usr/lib/../lib64] - arg [-L/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] - arg [CMakeFiles/cmTryCompileExec.dir/CMakeFortranCompilerABI.F.o] ==> ignore - arg [-lgfortranbegin] ==> lib [gfortranbegin] - arg [-lgfortran] ==> lib [gfortran] - arg [-lm] ==> lib [m] - arg [-lgcc_s] ==> lib [gcc_s] - arg [-lgcc] ==> lib [gcc] - arg [-lc] ==> lib [c] - arg [-lgcc_s] ==> lib [gcc_s] - arg [-lgcc] ==> lib [gcc] - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o] ==> ignore - arg [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o] ==> ignore - remove lib [gcc_s] - remove lib [gcc] - remove lib [gcc_s] - remove lib [gcc] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] ==> [/usr/lib/gcc/x86_64-redhat-linux/4.4.5] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64] ==> [/usr/lib64] - collapse dir [/lib/../lib64] ==> [/lib64] - collapse dir [/usr/lib/../lib64] ==> [/usr/lib64] - collapse dir [/usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../..] ==> [/usr/lib] - implicit libs: [gfortranbegin;gfortran;m;c] - implicit dirs: [/usr/lib/gcc/x86_64-redhat-linux/4.4.5;/usr/lib64;/lib64;/usr/lib] - - -Determining if the Fortran compiler supports Fortran 90 passed with the following output: -Change Dir: /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp - -Run Build Command:/usr/bin/gmake "cmTryCompileExec/fast" -/usr/bin/gmake -f CMakeFiles/cmTryCompileExec.dir/build.make CMakeFiles/cmTryCompileExec.dir/build -gmake[1]: Entering directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' -/usr/bin/cmake -E cmake_progress_report /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/CMakeFiles 1 -Building Fortran object CMakeFiles/cmTryCompileExec.dir/testFortranCompilerF90.f90.o -/usr/bin/gfortran -o CMakeFiles/cmTryCompileExec.dir/testFortranCompilerF90.f90.o -c /users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp/testFortranCompilerF90.f90 -Linking Fortran executable cmTryCompileExec -/usr/bin/cmake -E cmake_link_script CMakeFiles/cmTryCompileExec.dir/link.txt --verbose=1 -/usr/bin/gfortran CMakeFiles/cmTryCompileExec.dir/testFortranCompilerF90.f90.o -o cmTryCompileExec -rdynamic -gmake[1]: Leaving directory `/scheraga/users/adam/unres/source/unres/src_MD-M/CMakeFiles/CMakeTmp' - - diff --git a/source/unres/src_MD-M/CMakeFiles/CMakeSystem.cmake b/source/unres/src_MD-M/CMakeFiles/CMakeSystem.cmake deleted file mode 100644 index 5b0ab32..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CMakeSystem.cmake +++ /dev/null @@ -1,15 +0,0 @@ - - -SET(CMAKE_SYSTEM "Linux-2.6.34.9-69.fc13.x86_64") -SET(CMAKE_SYSTEM_NAME "Linux") -SET(CMAKE_SYSTEM_VERSION "2.6.34.9-69.fc13.x86_64") -SET(CMAKE_SYSTEM_PROCESSOR "x86_64") - -SET(CMAKE_HOST_SYSTEM "Linux-2.6.34.9-69.fc13.x86_64") -SET(CMAKE_HOST_SYSTEM_NAME "Linux") -SET(CMAKE_HOST_SYSTEM_VERSION "2.6.34.9-69.fc13.x86_64") -SET(CMAKE_HOST_SYSTEM_PROCESSOR "x86_64") - -SET(CMAKE_CROSSCOMPILING "FALSE") - -SET(CMAKE_SYSTEM_LOADED 1) diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdC/CMakeCCompilerId.c b/source/unres/src_MD-M/CMakeFiles/CompilerIdC/CMakeCCompilerId.c deleted file mode 100644 index f262e30..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CompilerIdC/CMakeCCompilerId.c +++ /dev/null @@ -1,188 +0,0 @@ -#ifdef __cplusplus -# error "A C++ compiler has been selected for C." -#endif - -#if defined(__18CXX) -# define ID_VOID_MAIN -#endif - -#if defined(__INTEL_COMPILER) || defined(__ICC) -# define COMPILER_ID "Intel" - -#elif defined(__BORLANDC__) -# define COMPILER_ID "Borland" - -#elif defined(__WATCOMC__) -# define COMPILER_ID "Watcom" - -#elif defined(__SUNPRO_C) -# define COMPILER_ID "SunPro" - -#elif defined(__HP_cc) -# define COMPILER_ID "HP" - -#elif defined(__DECC) -# define COMPILER_ID "Compaq" - -#elif defined(__IBMC__) -# if defined(__COMPILER_VER__) -# define COMPILER_ID "zOS" -# elif __IBMC__ >= 800 -# define COMPILER_ID "XL" -# else -# define COMPILER_ID "VisualAge" -# endif - -#elif defined(__PGI) -# define COMPILER_ID "PGI" - -#elif defined(__GNUC__) -# define COMPILER_ID "GNU" - -#elif defined(_MSC_VER) -# define COMPILER_ID "MSVC" - -#elif defined(__ADSPBLACKFIN__) || defined(__ADSPTS__) || defined(__ADSP21000__) -/* Analog Devices C++ compiler for Blackfin, TigerSHARC and - SHARC (21000) DSPs */ -# define COMPILER_ID "ADSP" - -/* IAR Systems compiler for embedded systems. - http://www.iar.com - Not supported yet by CMake -#elif defined(__IAR_SYSTEMS_ICC__) -# define COMPILER_ID "IAR" */ - -/* sdcc, the small devices C compiler for embedded systems, - http://sdcc.sourceforge.net */ -#elif defined(SDCC) -# define COMPILER_ID "SDCC" - -#elif defined(_SGI_COMPILER_VERSION) || defined(_COMPILER_VERSION) -# define COMPILER_ID "MIPSpro" - -/* This compiler is either not known or is too old to define an - identification macro. Try to identify the platform and guess that - it is the native compiler. */ -#elif defined(__sgi) -# define COMPILER_ID "MIPSpro" - -#elif defined(__hpux) || defined(__hpua) -# define COMPILER_ID "HP" - -#else /* unknown compiler */ -# define COMPILER_ID "" - -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char* info_compiler = "INFO" ":" "compiler[" COMPILER_ID "]"; - -/* Identify known platforms by name. */ -#if defined(__linux) || defined(__linux__) || defined(linux) -# define PLATFORM_ID "Linux" - -#elif defined(__CYGWIN__) -# define PLATFORM_ID "Cygwin" - -#elif defined(__MINGW32__) -# define PLATFORM_ID "MinGW" - -#elif defined(__APPLE__) -# define PLATFORM_ID "Darwin" - -#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) -# define PLATFORM_ID "Windows" - -#elif defined(__FreeBSD__) || defined(__FreeBSD) -# define PLATFORM_ID "FreeBSD" - -#elif defined(__NetBSD__) || defined(__NetBSD) -# define PLATFORM_ID "NetBSD" - -#elif defined(__OpenBSD__) || defined(__OPENBSD) -# define PLATFORM_ID "OpenBSD" - -#elif defined(__sun) || defined(sun) -# define PLATFORM_ID "SunOS" - -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) -# define PLATFORM_ID "AIX" - -#elif defined(__sgi) || defined(__sgi__) || defined(_SGI) -# define PLATFORM_ID "IRIX" - -#elif defined(__hpux) || defined(__hpux__) -# define PLATFORM_ID "HP-UX" - -#elif defined(__HAIKU) || defined(__HAIKU__) || defined(_HAIKU) -# define PLATFORM_ID "Haiku" -/* Haiku also defines __BEOS__ so we must - put it prior to the check for __BEOS__ -*/ - -#elif defined(__BeOS) || defined(__BEOS__) || defined(_BEOS) -# define PLATFORM_ID "BeOS" - -#elif defined(__QNX__) || defined(__QNXNTO__) -# define PLATFORM_ID "QNX" - -#elif defined(__tru64) || defined(_tru64) || defined(__TRU64__) -# define PLATFORM_ID "Tru64" - -#elif defined(__riscos) || defined(__riscos__) -# define PLATFORM_ID "RISCos" - -#elif defined(__sinix) || defined(__sinix__) || defined(__SINIX__) -# define PLATFORM_ID "SINIX" - -#elif defined(__UNIX_SV__) -# define PLATFORM_ID "UNIX_SV" - -#elif defined(__bsdos__) -# define PLATFORM_ID "BSDOS" - -#elif defined(_MPRAS) || defined(MPRAS) -# define PLATFORM_ID "MP-RAS" - -#elif defined(__osf) || defined(__osf__) -# define PLATFORM_ID "OSF1" - -#elif defined(_SCO_SV) || defined(SCO_SV) || defined(sco_sv) -# define PLATFORM_ID "SCO_SV" - -#elif defined(__ultrix) || defined(__ultrix__) || defined(_ULTRIX) -# define PLATFORM_ID "ULTRIX" - -#elif defined(__XENIX__) || defined(_XENIX) || defined(XENIX) -# define PLATFORM_ID "Xenix" - -#else /* unknown platform */ -# define PLATFORM_ID "" - -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char* info_platform = "INFO" ":" "platform[" PLATFORM_ID "]"; - - -/*--------------------------------------------------------------------------*/ - -#ifdef ID_VOID_MAIN -void main() {} -#else -int main(int argc, char* argv[]) -{ - int require = 0; - require += info_compiler[argc]; - require += info_platform[argc]; - (void)argv; - return require; -} -#endif diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdC/a.out b/source/unres/src_MD-M/CMakeFiles/CompilerIdC/a.out deleted file mode 100755 index 6d52626c0b8ae4238890f65aa9dea580d74b1865..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6478 zcmcIoZ){sv6+eDXQg3UMv}V zX~e&-YKYn;q4V6d&;ZN%kv33SV?fjG0@F5|1EJy}QL!+Ju?tS40ZM}4Dz8@Jb{>BteU6M=q}*QkmGV*9UH z2`VpgCl?!aB`GwdH~^ud_Y~@}i!AZ)iTL?wIyKVM{b)MTo=#;7)9ur}J?%Z+;e0mS zrTlNjW~ht1_dcx}lz6N|j%=^TKYdH8Kf5+@uK(7a8?TqfuUz^5clSg2Z=WGu`D5|F zPNWm8BmFR9WP4dM&GE@>#>`vsoMoDT-5RA{^nhtnnJXsasSNCnMR!Hau5ed)yK08| zF!Z zzOwyK4MC_pavAfMEjpHnpCFyTFIFm*&iA9m-#lv+-!*3cdVT*;bYXtJK?h^u+}nyQ zSV)!@Q1C{%Og4;C<56tDczNE^DsL+jWoLTYC|)^8f-_H)Q4R`UeCv&-VL-K4NbRMo zbHtsy<2Pon`ivcy@}aSoE&YJb&ijmFV-kfb>wlqyN{wG8l^vII@BXqef<+&hJACo{ z*w|ROWy^8u1L{4oUqd@&*IM_cg3!0X&rYMAipR+I+rQd8xBkaeg1VmfpwR!oEzjZ^L4^93Px z>XB~~L3}Azv_jWo#bcq{M)61pqjjw}w(Uw^@uO(*mT~SQf3*0=rO3TX#d!IBtF80T z^nGH*f5wWp`imd*Rn}iNX3t}cuIAn|N=HH%`gEu@R!W36#jq5Nm8{U#Sm{`(1H;lw zzEP^iA0xgA{V-;4SFDHLqGgBUd^LdIt%UKvT`7FX5w*YV(ig}V8Z|WLoTCdMx_5Bj zr4+wA{b2t!PB^fhcwN4kh~80mGS(?}`N zJf`G(@c{UyTYZ~XuL{tb)`l4UV<;OXfxhO}6Ix_Vlh%(Cw%$&Jr?KAYA=wwv^SRs!L0|9iJ%d;Y`nc|8$dXJbkd5CAhmKfosd#0Vd zCDU&{lzmwt+U zZ~u>b^mV_E2;h3A2srg=ZT9NFiWvDN{gie4kVoHcjqeD;Af>&;sXxW`r#$@^6&XLW zU%ckgFSCA`^=s#Uy9Lpc_P*uOmwjfA1J*2pOvS#yZ(xD^m-wINb?`Lnd&iH&PxMcF z^yOY4_l1xMGWFU&>(LK1=}I!dALJP83Gv#W#|rYF!-e;$VdQG}DsQ~J`U@!Q)Tfgr zr8&0$pY(r?vQB+ER#H06`d)ip{&y%#qT;{oTXMgXdmJ}c9lzq&Wz==rmwSQEhP?KK z7y6DzU(O8%3k0#=nM6-0-6ov&C-~ek!2&Y>qz%y%{yG*2lm5@J{tOFBKSkcFe-kUn zeuoG!6@9rcNj1q*61o=4Vp~;k_9HfQ&k15#^aLhe=8j-QJE&nyoA|?h9Lr(+i~kZA zI#1QJZ}7pa$@{YQ5~ zs_dto)?W_~fb1JiB|qE;vLCqd`>W?wH~s*~`t8P7gRIMLd`voz6oUBy77lV=A#>@R}Xix=fN8IiRb&$G-!YiD{g7~4(F>AhfkxR50=M)_90)L zI1C`J!5Ucf*rlfqAJqIO|0q3&f5K1lIwSLO8gXi8e}j&tT3X5f<0wM@mp$?Sroz|4 z4DVyo((4Le{vCgaIN2TcjGuFe*NfZlRXfYSBdx>q5_R0;&z%+UW(GP=%RFOe5Fb z0rovJQJ9=ODs~3;_A4`k2m1C5n8J}6Dc7v18>zAq*%N<08HwK%48Uoh2e zxeB}9ZOtcNFb^chQ+d43N7C_pKA8uW_rBxmy7M8|jPAo06RC_@$S27um+3@4Yfi*7 tiF6WcRQx3tRj1T-K9w2En(~H*qId&mKUIx9xPjgAq`Ic7H)RzR_!nABGR*)0 diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/CMakeCXXCompilerId.cpp b/source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/CMakeCXXCompilerId.cpp deleted file mode 100644 index 85081a3..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/CMakeCXXCompilerId.cpp +++ /dev/null @@ -1,175 +0,0 @@ -/* This source file must have a .cpp extension so that all C++ compilers - recognize the extension without flags. Borland does not know .cxx for - example. */ -#ifndef __cplusplus -# error "A C compiler has been selected for C++." -#endif - -#if defined(__COMO__) -# define COMPILER_ID "Comeau" - -#elif defined(__INTEL_COMPILER) || defined(__ICC) -# define COMPILER_ID "Intel" - -#elif defined(__BORLANDC__) -# define COMPILER_ID "Borland" - -#elif defined(__WATCOMC__) -# define COMPILER_ID "Watcom" - -#elif defined(__SUNPRO_CC) -# define COMPILER_ID "SunPro" - -#elif defined(__HP_aCC) -# define COMPILER_ID "HP" - -#elif defined(__DECCXX) -# define COMPILER_ID "Compaq" - -#elif defined(__IBMCPP__) -# if defined(__COMPILER_VER__) -# define COMPILER_ID "zOS" -# elif __IBMCPP__ >= 800 -# define COMPILER_ID "XL" -# else -# define COMPILER_ID "VisualAge" -# endif - -#elif defined(__PGI) -# define COMPILER_ID "PGI" - -#elif defined(__GNUC__) -# define COMPILER_ID "GNU" - -#elif defined(_MSC_VER) -# define COMPILER_ID "MSVC" - -#elif defined(__ADSPBLACKFIN__) || defined(__ADSPTS__) || defined(__ADSP21000__) -/* Analog Devices C++ compiler for Blackfin, TigerSHARC and - SHARC (21000) DSPs */ -# define COMPILER_ID "ADSP" - -#elif defined(_SGI_COMPILER_VERSION) || defined(_COMPILER_VERSION) -# define COMPILER_ID "MIPSpro" - -/* This compiler is either not known or is too old to define an - identification macro. Try to identify the platform and guess that - it is the native compiler. */ -#elif defined(__sgi) -# define COMPILER_ID "MIPSpro" - -#elif defined(__hpux) || defined(__hpua) -# define COMPILER_ID "HP" - -#else /* unknown compiler */ -# define COMPILER_ID "" - -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char* info_compiler = "INFO" ":" "compiler[" COMPILER_ID "]"; - -/* Identify known platforms by name. */ -#if defined(__linux) || defined(__linux__) || defined(linux) -# define PLATFORM_ID "Linux" - -#elif defined(__CYGWIN__) -# define PLATFORM_ID "Cygwin" - -#elif defined(__MINGW32__) -# define PLATFORM_ID "MinGW" - -#elif defined(__APPLE__) -# define PLATFORM_ID "Darwin" - -#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) -# define PLATFORM_ID "Windows" - -#elif defined(__FreeBSD__) || defined(__FreeBSD) -# define PLATFORM_ID "FreeBSD" - -#elif defined(__NetBSD__) || defined(__NetBSD) -# define PLATFORM_ID "NetBSD" - -#elif defined(__OpenBSD__) || defined(__OPENBSD) -# define PLATFORM_ID "OpenBSD" - -#elif defined(__sun) || defined(sun) -# define PLATFORM_ID "SunOS" - -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) -# define PLATFORM_ID "AIX" - -#elif defined(__sgi) || defined(__sgi__) || defined(_SGI) -# define PLATFORM_ID "IRIX" - -#elif defined(__hpux) || defined(__hpux__) -# define PLATFORM_ID "HP-UX" - -#elif defined(__HAIKU) || defined(__HAIKU__) || defined(_HAIKU) -# define PLATFORM_ID "Haiku" -/* Haiku also defines __BEOS__ so we must - put it prior to the check for __BEOS__ -*/ - -#elif defined(__BeOS) || defined(__BEOS__) || defined(_BEOS) -# define PLATFORM_ID "BeOS" - -#elif defined(__QNX__) || defined(__QNXNTO__) -# define PLATFORM_ID "QNX" - -#elif defined(__tru64) || defined(_tru64) || defined(__TRU64__) -# define PLATFORM_ID "Tru64" - -#elif defined(__riscos) || defined(__riscos__) -# define PLATFORM_ID "RISCos" - -#elif defined(__sinix) || defined(__sinix__) || defined(__SINIX__) -# define PLATFORM_ID "SINIX" - -#elif defined(__UNIX_SV__) -# define PLATFORM_ID "UNIX_SV" - -#elif defined(__bsdos__) -# define PLATFORM_ID "BSDOS" - -#elif defined(_MPRAS) || defined(MPRAS) -# define PLATFORM_ID "MP-RAS" - -#elif defined(__osf) || defined(__osf__) -# define PLATFORM_ID "OSF1" - -#elif defined(_SCO_SV) || defined(SCO_SV) || defined(sco_sv) -# define PLATFORM_ID "SCO_SV" - -#elif defined(__ultrix) || defined(__ultrix__) || defined(_ULTRIX) -# define PLATFORM_ID "ULTRIX" - -#elif defined(__XENIX__) || defined(_XENIX) || defined(XENIX) -# define PLATFORM_ID "Xenix" - -#else /* unknown platform */ -# define PLATFORM_ID "" - -#endif - -/* Construct the string literal in pieces to prevent the source from - getting matched. Store it in a pointer rather than an array - because some compilers will just produce instructions to fill the - array rather than assigning a pointer to a static array. */ -char* info_platform = "INFO" ":" "platform[" PLATFORM_ID "]"; - - -/*--------------------------------------------------------------------------*/ - -int main(int argc, char* argv[]) -{ - int require = 0; - require += info_compiler[argc]; - require += info_platform[argc]; - (void)argv; - return require; -} diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/a.out b/source/unres/src_MD-M/CMakeFiles/CompilerIdCXX/a.out deleted file mode 100755 index da108299f42972fddd3e073fb77589191f6b3bcf..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6851 zcmcIoZ)_CT5r22*vkd`k97y=%mXmr^Ce#<(7}w!XyXI`zOOHP>PDDkL^>KH$5AL7t z_RyJ9mB^6#bR~6FK3Gkpy5Eo@HGE2uNZUiSr8H8TDj!0Xd~gv+PJosu4YDZVI`eks zZg+idK2&|u?#%q&%$s?$`)2pO9}EO{I~@+e%_+VmP)gS+5;E>W%q^87VZEYJDB`PP zy{HGo4VNN&kQyA*5)I9?k@Q?Z>yUR6;8YBTXsaO!rW_$s^jB>Pu?9WeV2DhG@JImd zFxE-xpKKVGIMWV_L*aPH4n?%PKz0|%jw#QJDbEk*hF2?%*XmS2LRmo~`sKY!Q5V~R zTY3cf5;~Psu~4s+gkZ{c&w(A8kj8%}9Ou*V*pZ&@r{j_Kcr2OAx959%+IzZv*_5wK z#@`IXVD9$pdtMI6`Dg(NeXoKGpC$Icdw1xA2kXB1y;q+2@K3!r|FS*tdh}|vrYv|uoqjSR|_))+yHhbFw0OG@SinR;opVcGb&6{z~Jwnq)6RD(@ z)k7Iw(}ecyacwX<8q4a@j6WXAW}{hD$>+6nG?PswL-CkCt{v|XFigT20l3j{Sj(c+ ziFlYtMxI7agknkIKXj;XS3v9ZZ4rBdfn9#B%h%=G%HcU>ULBA*%pK?9{kM+6>+cdL zNez34sUM--y4Vt2R6j%kT6)Q_r1);&INYWP$JZL4AGc`}&d&(@)QLNdbH{+0dw@4L zJXdw%ca2xdTerDAqP%ej+?zHiz@a>bCLhn1p>6C!8C`$;9*CWH1BJi7tQKyl6F2W2 z7z$i1&A1hzUcG!llB+{N=6(f=|C*XYpK8&4t@Xx;Ts*lu(E0CkxnNQT>i(W{5+}j*1M!ai+ zzV&y!%$sbGN5!kq>rRBiNirGS1$?2de?R@=;J$l z4u=Ce3-lDwdqAgwVrw;saGW?WC>;6bdKXrL^~)L>r{uE0ejKMCYyzm;x1#w~r+<09 zvmbPfI)||1gfw@sCDuQ*Jp^{<8Q@sma2)`=08~8pBloNI+6rZ&;m6L`T<{JYTER6K zyK$*tLmrzURb>OMu3=uwOmW`WSRORQiabp6GNNr%2bYtauU91Z`J-|QnPH~_chk4l zWyn}ZuuVD@Bx0$&3-ME;j}cu%bTv^X_?)oism^fDIt*BTPmsmBgzZU#hLIy*bNJZ*!~h(`_S2HxJaNeEwdJfVk<0M#=F9b+z*gfClK_>w6- z>VvOQyB-=PX*8Mh9m&Pu*B}-VK9t5n*)idZj3;3{gX$Th=Qw-~W2vM?(4a39jfc>H zxO7|>zF0B_cRiYi`v?fomx_e+knlyvw2@3G5!J>bV9S#5h4oY>3l0r(Gz^_EW+)L0 zgToXI12>->+Zg9a7PO&wB%(>36Zk*U^)NPGtk=#^6SX1DK$uKVz=v;SeI0tl{iNh<%7ZbO9s zdu!VVBCc(==k-5HK%UgGK46~Mp4Z_EfZ^I_d%^3C3If*;P>~JCFt?XMz_rWvyk5_d zJ=Yv?>2hS?8oReVr3pFeuK>R3e^{d?Abrt5G?;Y5j$tI=lx-t z6dO4)Gywjun%mDnF#G54O`ayS!mJED`)7Ct7_?_Mll2Nn@Es!iUMW>?oIgg+17o%? zk$s8my{t&o?jJWPX8Sp^pCkJ>Z1#5lC9VX(@O}6?;4Kj64CRN*QV-$$-@@_il;f~erNKq;VL8sibvGjMsy%aO0ADGp>#>eH z&H>(BBmQ5YzOzY8+4B5Li9ar8Y20cr(1`_Vsd$ z^v~P$KO_A=5>CU5`9;Pl177Q#)dLR#Nz+G z3&R1de`x=p77QF5!XsL(-y%KhH+4l)+Gsp=Box===1~jf@&Zql;!!;s@%3!k(krk- zi$(Gvb$1A3{~5_8665S=U|+vm_{$Hm4SmDjIPJzWX+<%gL~DWlFk&Q@)NciP%;va zLXUg~oR3OSa;qOpj-)g`w*yt!ol~5$hY$ILG4ZI}!q+-uR}|BMxjaCZSrh*O3Lkzn diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/CMakeFortranCompilerId.F b/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/CMakeFortranCompilerId.F deleted file mode 100644 index c92f127..0000000 --- a/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/CMakeFortranCompilerId.F +++ /dev/null @@ -1,108 +0,0 @@ - PROGRAM CMakeFortranCompilerId -#if 0 -! Identify the compiler -#endif -#if defined(__INTEL_COMPILER) || defined(__ICC) - PRINT *, 'INFO:compiler[Intel]' -#elif defined(__SUNPRO_F90) || defined(__SUNPRO_F95) - PRINT *, 'INFO:compiler[SunPro]' -#elif defined(__G95__) - PRINT *, 'INFO:compiler[G95]' -#elif defined(__GNUC__) - PRINT *, 'INFO:compiler[GNU]' -#elif defined(__IBMC__) -# if defined(__COMPILER_VER__) - PRINT *, 'INFO:compiler[zOS]' -# elif __IBMC__ >= 800 - PRINT *, 'INFO:compiler[XL]' -# else - PRINT *, 'INFO:compiler[VisualAge]' -# endif -#elif defined(__PGI) - PRINT *, 'INFO:compiler[PGI]' -#elif defined(_SGI_COMPILER_VERSION) || defined(_COMPILER_VERSION) - PRINT *, 'INFO:compiler[MIPSpro]' -# if 0 -! This compiler is either not known or is too old to define an -! identification macro. Try to identify the platform and guess that -! it is the native compiler. -# endif -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) - PRINT *, 'INFO:compiler[VisualAge]' -#elif defined(__sgi) || defined(__sgi__) || defined(_SGI) - PRINT *, 'INFO:compiler[MIPSpro]' -#elif defined(__hpux) || defined(__hpux__) - PRINT *, 'INFO:compiler[HP]' -#elif 1 -# if 0 -! The above 'elif 1' instead of 'else' is to work around a bug in the -! SGI preprocessor which produces both the __sgi and else blocks. -# endif - PRINT *, 'INFO:compiler[]' -#endif - -#if 0 -! Identify the platform -#endif -#if defined(__linux) || defined(__linux__) || defined(linux) - PRINT *, 'INFO:platform[Linux]' -#elif defined(__CYGWIN__) - PRINT *, 'INFO:platform[Cygwin]' -#elif defined(__MINGW32__) - PRINT *, 'INFO:platform[MinGW]' -#elif defined(__APPLE__) - PRINT *, 'INFO:platform[Darwin]' -#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) - PRINT *, 'INFO:platform[Windows]' -#elif defined(__FreeBSD__) || defined(__FreeBSD) - PRINT *, 'INFO:platform[FreeBSD]' -#elif defined(__NetBSD__) || defined(__NetBSD) - PRINT *, 'INFO:platform[NetBSD]' -#elif defined(__OpenBSD__) || defined(__OPENBSD) - PRINT *, 'INFO:platform[OpenBSD]' -#elif defined(__sun) || defined(sun) - PRINT *, 'INFO:platform[SunOS]' -#elif defined(_AIX) || defined(__AIX) || defined(__AIX__) || defined(__aix) || defined(__aix__) - PRINT *, 'INFO:platform[AIX]' -#elif defined(__sgi) || defined(__sgi__) || defined(_SGI) - PRINT *, 'INFO:platform[IRIX]' -#elif defined(__hpux) || defined(__hpux__) - PRINT *, 'INFO:platform[HP-UX]' -#elif defined(__HAIKU) || defined(__HAIKU__) || defined(_HAIKU) - PRINT *, 'INFO:platform[Haiku]' -# if 0 -! Haiku also defines __BEOS__ so we must -! put it prior to the check for __BEOS__ -# endif -#elif defined(__BeOS) || defined(__BEOS__) || defined(_BEOS) - PRINT *, 'INFO:platform[BeOS]' -#elif defined(__QNX__) || defined(__QNXNTO__) - PRINT *, 'INFO:platform[QNX]' -#elif defined(__tru64) || defined(_tru64) || defined(__TRU64__) - PRINT *, 'INFO:platform[Tru64]' -#elif defined(__riscos) || defined(__riscos__) - PRINT *, 'INFO:platform[RISCos]' -#elif defined(__sinix) || defined(__sinix__) || defined(__SINIX__) - PRINT *, 'INFO:platform[SINIX]' -#elif defined(__UNIX_SV__) - PRINT *, 'INFO:platform[UNIX_SV]' -#elif defined(__bsdos__) - PRINT *, 'INFO:platform[BSDOS]' -#elif defined(_MPRAS) || defined(MPRAS) - PRINT *, 'INFO:platform[MP-RAS]' -#elif defined(__osf) || defined(__osf__) - PRINT *, 'INFO:platform[OSF1]' -#elif defined(_SCO_SV) || defined(SCO_SV) || defined(sco_sv) - PRINT *, 'INFO:platform[SCO_SV]' -#elif defined(__ultrix) || defined(__ultrix__) || defined(_ULTRIX) - PRINT *, 'INFO:platform[ULTRIX]' -#elif defined(__XENIX__) || defined(_XENIX) || defined(XENIX) - PRINT *, 'INFO:platform[Xenix]' -#elif 1 -# if 0 -! The above 'elif 1' instead of 'else' is to work around a bug in the -! SGI preprocessor which produces both the __sgi and else blocks. -# endif - PRINT *, 'INFO:platform[]' -#endif - END diff --git a/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/a.out b/source/unres/src_MD-M/CMakeFiles/CompilerIdFortran/a.out deleted file mode 100755 index 63aa73f1e59ad9dca8aa09c8136ee9d2041a6297..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7916 zcmcIpeQX@n5r22*k4uO@5&|T|z_nbeB*hmyUnCIFI(D2jT%2G+6_mhwbGNoHIp0}# zYj9Ac9yLKZ+`#oiYJ^&0p;n6EpD3ag3Me=Vt(#UtuK0triKszDIukyOC{YSct}}0E z?snIAEmGAv?aiCtyqS5Qv%7D9xHa7A^>_r6SKKd9YN=5qWc>>iK|IVcAQ7SFsAjn=DB%=N2NzcqLM(Xz}=bOJpuYKmuro zZ5<;0(EMJBGw+~w?B@269g1jojO>n)9dqs%bM7DZ4X-Bh*W^_|LRmp3I^=(e%dr4# z=Or_WCH9ZG4F@~EE3%Eg$zf%GK0Pu2t)>ptEtbo5<0e`Xr{&)pkzGnq0p zW5m#gbaTM&!PK5i#Z03Nq(zenJC1Ek_ZcZIGN7mQ2s8*=KZwoVAo~%CXlayMQHof& zreT@7GpNTBVq3UtOS`rvv?jD(Z0p?7v#Y1ATWbxqzzA8J!v~yy9#}2!fdOEE%tEr@8(l(FHwmr!@ahTHQ^ z&W79f+c6uCF_^|}IPW>s9k=1M)uo9#`iVb(7K-^EXlA|{_Le&Ow*PEl{i&LOC@g;y z{u}O4poH=O+RRKBfR>*`8M`(!CFNI8#vz!Qkn+nY<5rzHA>|iQ#xBo{OZlfLV^?Q# zQhp9)?BYxYWZ;roKkdr?<#9Fpp*s4}?9N?XlM^j|MW~Z!6v-xMYZZ}Cg26v>IqZu% zR{ceFK&Xc&OmAUIb|q)0N7U@4hp}Sjz7-Hq3_tkB5lFFM_FWLwr!QwvI`fTB9lh*P zH=R!h`x@@(5HKhc9yMEi4SW|C|6W!atNt7#Z91R&@DJ4&py+1_O-0_TT zzdCx~F(1UixaOkQ5yQ6m-^xLpbA{=1XLC8!sZW104TE_)1NrwYoVffe*9!%8^6&~^ z3V@S`TcET6G?Rw|P|CQM=**~$FN0FihKGtucs!5S3@O9~WMq3HI%UwZwI z{K8=O_M@!-|$H!$o=)Uo^3>{t0ZtegET`}h32 zP%Zy8h^-Uq*xn#aU_96e1GxkS2Ixy1P5XF)tMlP(G&rpuZC>ULi15+ni;)4I4`Q`yz)|8_F7l=ihAanuPggr{sxGr9{$v9YQ2E#I-LDFoW0VK{k*NP z_@X*`7UukN>f=&N!ei0kk}$L>5FRswE5c)kf-TUxjaKWdxs&S&R#46Z%VG3t!Cd+V z-sWlDT=v5{9E0_AwJ`hztq^Oi=9AbK+-)$7L>@;LVYI~Cx9bOtPAi|cCkKaOaU<0g z4RwmH?#>=!DV9efbWFa z!JVH2egyb9@NwWsct1w+Jk=vSBaNPA3u^s2aD>lMcm=`7MXbfDcsXs9s+BY17$KqI2gispL(*q(DJ(vK07B^Ft<_RN} zh6gf-pn)!B#C0^F(oozKp;#gY|E4hl|9v2UE*aHLU4)DQtuLhy8rnbXe4l7{;#wQ9N?1YbtJqBNI(Q&PO%g3 zOUCYmLM>cu-{e(5!uKG_M8IOjf6Q}sY6Zb=zuBuu^=7ii{9`A#eFrG7z}n~dy|# zzXD{R0iB%!b^*#bzIOX@vgh*!e73NYJO1xLX}6yu`zeb5OS>_YdHxulfCAd{{gBUF z_#DPPUT*tImpwk|BW37@{NL=~fx7ni_?VBBBYSr|xBM>D#i{1@^Zks^gC@{95U)?R z=XPBLojpFkpYEmy6s|9wz#q%ZKXBRe^F%M%?_@*bY{&d#m;DKP9yvkw?)i4hvtWnX>h31mB08^=k#+U!1sK@O{IH&l7w zo7s@M8*|&kE~y6Kku9UgilbO;r%#5er8>MDz*O^>1UA` zagF~^B)(7#%vYdPqL-lPDKn3+0*>vU@++mvP&xxwxpDg&;2zN+GPK?TAS2Ddn| z*BbamBJOHuqa2XA_?>`z%B-uq01v?1p?jU&4frBxKc3Pdak|>ZxNAJSB`&Kv{!G9F z4#W~hE8xG7e&+7eUrBtfqc;Ix2;;{4w~DI#8Sut3{W@R4&%Y|*w?W4jdK<(FR~}d; z@f!smI@;-Oz;WF0SQ9BL|KZ(J;w0EussjEqz#CzIy+-SqOUIU;$`x1M32X9Um`>#Wv0zxIO&VP7mD^>J9@Nm z*TcK;1BKS%kRE8asiH}(Kc3vD$2IxFs_DZc0uRCBhG|4Y8`iGfC{Urrq9Y)!YZ2Bv zZ*+KY@F2(8+T9_;boR7u->R{MVYpn1BHxZ>l!^y&^tmL|5^7zyX@k(Vg?DUe3u`+% zJ0ISUAXo=WKlH6syq0`l98&^jLNZrk3~F7QR$`oICzibkgR=}CP@I$PZC%~C XG7NdrQ3{oIeCu*~k)NRC?23N_dw!+8 diff --git a/source/unres/src_MD-M/CMakeFiles/cmake.check_cache b/source/unres/src_MD-M/CMakeFiles/cmake.check_cache deleted file mode 100644 index 3dccd73..0000000 --- a/source/unres/src_MD-M/CMakeFiles/cmake.check_cache +++ /dev/null @@ -1 +0,0 @@ -# This file is generated by cmake for dependency checking of the CMakeCache.txt file diff --git a/source/unres/src_MD-M/CMakeLists.txt b/source/unres/src_MD-M/CMakeLists.txt index 63137a5..486a344 100644 --- a/source/unres/src_MD-M/CMakeLists.txt +++ b/source/unres/src_MD-M/CMakeLists.txt @@ -5,11 +5,6 @@ enable_language (Fortran) #================================ -# build the xdrf library -#================================ -#add_subdirectory(xdrf) - -#================================ # Set source file lists #================================ set(UNRES_MDM_SRC0 @@ -71,6 +66,7 @@ set(UNRES_MDM_SRC0 permut.F pinorm.f printmat.f + prng_32.F q_measure.F ran.f randgens.f @@ -85,6 +81,7 @@ set(UNRES_MDM_SRC0 sc_move.F shift.F sort.f + ssMD.F stochfric.F sumsld.f surfatom.f @@ -95,15 +92,6 @@ set(UNRES_MDM_SRC0 unres.F ) -if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng.f ) -else() - set(UNRES_MDM_SRC0 ${UNRES_MDM_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - set(UNRES_MDM_SRC3 energy_p_new_barrier.F energy_p_new-sep_barrier.F gradient_p.F ) set(UNRES_MDM_PP_SRC @@ -141,6 +129,7 @@ set(UNRES_MDM_PP_SRC newconf.f parmread.F permut.F + prng_32.F q_measure1.F q_measure3.F q_measure.F @@ -153,6 +142,7 @@ set(UNRES_MDM_PP_SRC rmsd.F sc_move.F shift.F + ssMD.F stochfric.F sumsld.f test.F @@ -187,10 +177,10 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_MDM_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -203,14 +193,14 @@ set_property(SOURCE ${UNRES_MDM_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= if(UNRES_MD_FF STREQUAL "GAB" ) # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB -DTIMING -DTIMING_ENE" ) #========================================= # Settings for E0LL2Y force field #========================================= elseif(UNRES_MD_FF STREQUAL "E0LL2Y") # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" ) + set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DSCCORPDB" ) endif(UNRES_MD_FF STREQUAL "GAB") @@ -235,6 +225,9 @@ elseif (Fortran_COMPILER_NAME STREQUAL "f95") elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") # Add old gfortran flags set(CPPFLAGS "${CPPFLAGS} -DG77") +else (Fortran_COMPILER_NAME STREQUAL "ifort") + # Default preprocessor flags + set(CPPFLAGS "${CPPFLAGS} -DPGI") endif (Fortran_COMPILER_NAME STREQUAL "ifort") @@ -246,7 +239,9 @@ if (UNRES_WITH_MPI) endif(UNRES_WITH_MPI) +#========================================= # add 64-bit specific preprocessor flags +#========================================= if (architektura STREQUAL "64") set(CPPFLAGS "${CPPFLAGS} -DAMD64") endif (architektura STREQUAL "64") @@ -265,10 +260,10 @@ set_property(SOURCE proc_proc.c PROPERTY COMPILE_DEFINITIONS "SGI" ) #======================================== if(UNRES_WITH_MPI) # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_FF}.exe") + set(UNRES_BIN "unresMD-M_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") else(UNRES_WITH_MPI) # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_FF}.exe") + set(UNRES_BIN "unresMD-M_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") endif(UNRES_WITH_MPI) #========================================= @@ -313,8 +308,7 @@ set(UNRES_MDM_SRCS ${UNRES_MDM_SRC0} ${UNRES_MDM_SRC3} ${CMAKE_CURRENT_BINARY_DI #========================================= add_executable(UNRES_BIN-MD-M ${UNRES_MDM_SRCS} ) set_target_properties(UNRES_BIN-MD-M PROPERTIES OUTPUT_NAME ${UNRES_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_BIN-MD-M PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= @@ -322,13 +316,18 @@ set_target_properties(UNRES_BIN-MD-M PROPERTIES OUTPUT_NAME ${UNRES_BIN}) #========================================= # link MPI library (libmpich.a) if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD-M ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_BIN-MD-M ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a #message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") target_link_libraries( UNRES_BIN-MD-M xdrf ) #========================================= +# Install Path +#========================================= +install(TARGETS UNRES_BIN-MD-M DESTINATION ${CMAKE_INSTALL_PREFIX}/unres/MD) + +#========================================= # TESTS #========================================= diff --git a/source/unres/src_MD-M/COMMON.CALC b/source/unres/src_MD-M/COMMON.CALC index 67b4bb9..bf255c9 100644 --- a/source/unres/src_MD-M/COMMON.CALC +++ b/source/unres/src_MD-M/COMMON.CALC @@ -5,11 +5,11 @@ & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg + & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j + & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j diff --git a/source/unres/src_MD-M/COMMON.CHAIN b/source/unres/src_MD-M/COMMON.CHAIN index c33eaee..372fa85 100644 --- a/source/unres/src_MD-M/COMMON.CHAIN +++ b/source/unres/src_MD-M/COMMON.CHAIN @@ -1,9 +1,12 @@ integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, - & nres0,nstart_seq,chain_length,iprzes,tabperm,nperm + & nres0,nstart_seq,chain_length,iprzes,tabperm,nperm,afmend, + & afmbeg double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, - & prod,rt,dc_work,cref,crefjlee,chain_rep + & prod,rt,dc_work,cref,crefjlee,chain_rep,dc_norm2,velAFMconst, + & totTafm common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), + & dc_norm2(3,0:maxres2), & dc_work(MAXRES6),nres,nres0 common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) @@ -13,3 +16,16 @@ & nsup,nstart_sup,nstart_seq, & chain_length,iprzes,tabperm(maxperm,maxsym),nperm common /from_zscore/ nz_start,nz_end,iz_sc + double precision boxxsize,boxysize,boxzsize,enecut,sscut, + & sss,sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick, + & tubecenter,tubeR0, + & buftubebot, buftubetop,bordtubebot,bordtubetop,tubebufthick + common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick + common /afm/ forceAFMconst, distafminit,afmend,afmbeg, + & velAFMconst, + & totTafm + common /tube/ tubecenter(3),tubeR0, + & buftubebot, buftubetop,bordtubebot,bordtubetop,tubebufthick + diff --git a/source/unres/src_MD-M/COMMON.CONTACTS b/source/unres/src_MD-M/COMMON.CONTACTS index 5b3a90d..45c578b 100644 --- a/source/unres/src_MD-M/COMMON.CONTACTS +++ b/source/unres/src_MD-M/COMMON.CONTACTS @@ -27,19 +27,21 @@ c & dipderx(3,5,4,maxconts,maxres) C 10/30/99 Added other pre-computed vectors and matrices needed C to calculate three - six-order el-loc correlation terms double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der + & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2 + & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der, + & gtEug common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), & obrot_der(2,maxres),obrot2_der(2,maxres) C This common block contains vectors and matrices dependent on a single C amino-acid residue. common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres), + & gmu(2,maxres),gUb2(2,maxres), & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres), & Dtobr2(2,maxres),Dtobr2der(2,maxres), & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres) + & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),gtEUg(2,2,maxres) C This common block contains vectors and matrices dependent on two C consecutive amino-acid residues. double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, diff --git a/source/unres/src_MD-M/COMMON.CONTROL b/source/unres/src_MD-M/COMMON.CONTROL index 40346c7..45fd502 100644 --- a/source/unres/src_MD-M/COMMON.CONTROL +++ b/source/unres/src_MD-M/COMMON.CONTROL @@ -1,13 +1,18 @@ integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad, - & inprint,i2ndstr,mucadyn,constr_dist,symetr + & inprint,i2ndstr,mucadyn,constr_dist,symetr,AFMlog,selfguide, + & shield_mode,tor_mode,tubelog logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec, - & sideadd,lsecondary,read_cart,unres_pdb, + & mremd_dec,sideadd,lsecondary,read_cart,unres_pdb, & vdisulf,searchsc,lmuca,dccart,extconf,out1file, - & gnorm_check,gradout,split_ene - common /cntrl/ modecalc,iscode,indpdb,indback,indphi,iranconf, + & gnorm_check,gradout,split_ene,with_theta_constr,with_dihed_constr + double precision aincr + common /cntrl/ aincr,modecalc,iscode,indpdb,indback,indphi, + & iranconf, & icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint, - & overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb - & ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file, - & constr_dist,gnorm_check,gradout,split_ene,symetr + & overlapsc,energy_dec,mremd_dec,sideadd,lsecondary,read_cart, + & unres_pdb,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file, + & selfguide,AFMlog,shield_mode,tor_mode,tubelog, + & constr_dist,gnorm_check,gradout,split_ene,with_theta_constr, + & with_dihed_constr,symetr C... minim = .true. means DO minimization. C... energy_dec = .true. means print energy decomposition matrix diff --git a/source/unres/src_MD-M/COMMON.DERIV b/source/unres/src_MD-M/COMMON.DERIV index 524d72a..a830225 100644 --- a/source/unres/src_MD-M/COMMON.DERIV +++ b/source/unres/src_MD-M/COMMON.DERIV @@ -1,27 +1,53 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, + double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long + & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,gliptranc,gliptranx, & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long + & gradcorr6_long,gcorr6_turn_long,gvdwx,gshieldx,gradafm, + & gg_tube,gg_tube_SC, + & gshieldc, gshieldc_loc, gshieldx_ec, gshieldc_ec, + & gshieldc_loc_ec, gshieldx_t3,gshieldc_t3,gshieldc_loc_t3, + & gshieldx_t4, gshieldc_t4,gshieldc_loc_t4,gshieldx_ll, + & gshieldc_ll, gshieldc_loc_ll integer nfl,icg common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg + & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), + & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), + & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), + & gliptranc(3,-1:maxres), + & gliptranx(3,-1:maxres), + & gshieldx(3,-1:maxres), gshieldc(3,-1:maxres), + & gshieldc_loc(3,-1:maxres), + & gshieldx_ec(3,-1:maxres), gshieldc_ec(3,-1:maxres), + & gshieldc_loc_ec(3,-1:maxres), + & gshieldx_t3(3,-1:maxres), gshieldc_t3(3,-1:maxres), + & gshieldc_loc_t3(3,-1:maxres), + & gshieldx_t4(3,-1:maxres), gshieldc_t4(3,-1:maxres), + & gshieldc_loc_t4(3,-1:maxres), + & gshieldx_ll(3,-1:maxres), gshieldc_ll(3,-1:maxres), + & gshieldc_loc_ll(3,-1:maxres), + & gradafm(3,-1:maxres),gg_tube(3,-1:maxres), + & gg_tube_sc(3,-1:maxres), + & gradx_scp(3,-1:maxres),gvdwc_scp(3,-1:maxres), + & ghpbx(3,-1:maxres), + & ghpbc(3,-1:maxres),gloc(maxvar,2),gradcorr(3,-1:maxres), + & gradcorr_long(3,-1:maxres),gradcorr5_long(3,-1:maxres), + & gradcorr6_long(3,-1:maxres),gcorr6_turn_long(3,-1:maxres), + & gradxorr(3,-1:maxres),gradcorr5(3,-1:maxres), + & gradcorr6(3,-1:maxres), + & gloc_x(maxvar,2),gel_loc(3,-1:maxres),gel_loc_long(3,-1:maxres), + & gcorr3_turn(3,-1:maxres), + & gcorr4_turn(3,-1:maxres),gcorr6_turn(3,-1:maxres), + & gradb(3,-1:maxres), + & gradbx(3,-1:maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), + & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar), + & gcorr_loc(maxvar), + & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,-1:maxres), + & gsccorx(3,-1:maxres),gsccor_loc(-1:maxres), + & dtheta(3,2,-1:maxres), + & gscloc(3,-1:maxres),gsclocx(3,-1:maxres), + & dphi(3,3,-1:maxres),dalpha(3,3,-1:maxres),domega(3,3,-1:maxres), + & nfl, + & icg double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), diff --git a/source/unres/src_MD-M/COMMON.FFIELD b/source/unres/src_MD-M/COMMON.FFIELD index d7d8cde..1911ad1 100644 --- a/source/unres/src_MD-M/COMMON.FFIELD +++ b/source/unres/src_MD-M/COMMON.FFIELD @@ -4,11 +4,13 @@ C calculations and defines weights of various energy terms. C 12/1/95 wcorr added C----------------------------------------------------------------------- integer n_ene_comp,rescale_mode + logical scale_umb common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang, + & wtube, & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,weights(n_ene),temp0, + & wturn6,wvdwpp,weights(n_ene),wliptran,wumb,temp0, & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode + & rescale_mode,scale_umb common /potentials/ potname(5) character*3 potname C----------------------------------------------------------------------- diff --git a/source/unres/src_MD-M/COMMON.INTERACT b/source/unres/src_MD-M/COMMON.INTERACT index 982ae4a..14d92ef 100644 --- a/source/unres/src_MD-M/COMMON.INTERACT +++ b/source/unres/src_MD-M/COMMON.INTERACT @@ -1,11 +1,18 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6 + double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6, + &aa_lip,bb_lip,aa_aq,bb_aq,sc_aa_tube_par,sc_bb_tube_par, + & pep_aa_tube,pep_bb_tube + integer expon,expon2 integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart, & iscpend,iatsc_s,iatsc_e, & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw, & ispp,iscp - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), + common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp), + & aa_lip(ntyp,ntyp),bb_lip(ntyp,ntyp), + & sc_aa_tube_par(ntyp),sc_bb_tube_par(ntyp), + & pep_aa_tube,pep_bb_tube, + & augm(ntyp,ntyp), & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, @@ -15,16 +22,27 @@ & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, & iatscp_s,iatscp_e,ispp,iscp C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii, + double precision eps,epslip,sigma,sigmaii,rs0,chi,chip,alp, + & sigma0,sigii, & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp - common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1), + common /body/eps(ntyp,ntyp),epslip(ntyp,ntyp), + & sigma(0:ntyp1,0:ntyp1), & sigmaii(ntyp,ntyp), & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp), & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2), - & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2) + & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(ntyp,2), + & rscp(ntyp,2) c 12/5/03 modified 09/18/03 Bond stretching parameters. - double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax + double precision vbldp0,vbldpDUM, + & vbldsc0,akp,aksc,abond0,distchainmax integer nbondterm - common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, + common /stretch/ vbldp0,vbldpDUM, + & vbldsc0(maxbondterm,ntyp),akp, & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp), & distchainmax,nbondterm(ntyp) +C 01/29/15 Lipidic parameters + double precision pepliptran,liptranene, + &tubetranene, tubetranenepep + common /lipid/ pepliptran,liptranene(ntyp) + common /tubepar/ tubetranene(ntyp), tubetranenepep + diff --git a/source/unres/src_MD-M/COMMON.IOUNITS b/source/unres/src_MD-M/COMMON.IOUNITS index a9ace0b..ef41da7 100644 --- a/source/unres/src_MD-M/COMMON.IOUNITS +++ b/source/unres/src_MD-M/COMMON.IOUNITS @@ -11,11 +11,13 @@ C General I/O units & files integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart, - & irest1,isccor + & irest1,isccor,ithep_pdb,irotam_pdb, + & iliptranpar,itube common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag, - & icart,irest1,isccor + & icart,irest1,isccor,ithep_pdb,irotam_pdb, + & iliptranpar,itube character*256 outname,intname,pdbname,mol2name,statname,intinname, & entname,prefix,secpred,rest2name,qname,cartname,tmpdir, & mremd_rst_name,curdir,pref_orig @@ -38,9 +40,12 @@ C CSA I/O units & files & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb C Parameter files character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & thetname_pdb,rotname_pdb,liptranname,tubename + common /parfiles/ bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & thetname_pdb,rotname_pdb,liptranname,tubename character*3 pot C----------------------------------------------------------------------- C INP - main input file diff --git a/source/unres/src_MD-M/COMMON.LOCAL b/source/unres/src_MD-M/COMMON.LOCAL index 837a7a3..5d1ced7 100644 --- a/source/unres/src_MD-M/COMMON.LOCAL +++ b/source/unres/src_MD-M/COMMON.LOCAL @@ -2,26 +2,34 @@ & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 integer nlob C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) + common /thetas/ a0thet(-ntyp:ntyp),athet(2,-ntyp:ntyp,-1:1,-1:1), + & bthet(2,-ntyp:ntyp,-1:1,-1:1),polthet(0:3,-ntyp:ntyp), + & gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp),sig0(-ntyp:ntyp), + & sigc0(-ntyp:ntyp) C Parameters of the side-chain probability distribution common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), + & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp), + & dsc0(ntyp1), & nlob(ntyp1) C Parameters of ab initio-derived potential of virtual-bond-angle bending integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) + & ithetyp(-ntyp1:ntyp1),nntheterm + double precision aa0thet(-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & aathet(maxtheterm,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & bbthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ccthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ddthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & eethet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ffthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2), + & ggthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2) common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, & ffthet, & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, @@ -32,7 +40,8 @@ C Virtual-bond lenghts & iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end, + & iint_end,iphi1_start,iphi1_end,itau_start,itau_end,ilip_start, + & ilip_end, & ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1), & ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1), & iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1), @@ -46,8 +55,8 @@ C Virtual-bond lenghts & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, & iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ, - & ivec_count,iset_displ, + & ivec_count,iset_displ,itau_start,itau_end, & iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count, - & iphi_displ,iphi_count,iphi1_displ,iphi1_count + & iphi_displ,iphi_count,iphi1_displ,iphi1_count,ilip_start,ilip_end C Inverses of the actual virtual bond lengths common /invlen/ vbld_inv(maxres2) diff --git a/source/unres/src_MD-M/COMMON.MD b/source/unres/src_MD-M/COMMON.MD index b17c722..24d8115 100644 --- a/source/unres/src_MD-M/COMMON.MD +++ b/source/unres/src_MD-M/COMMON.MD @@ -4,6 +4,7 @@ integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), & ipair(2,100,maxprocs/20),iset, & mset(maxprocs/20),nset + logical loc_qlike,adaptive double precision IP,ISC(ntyp+1),mp, & msc(ntyp+1),d_t_work(MAXRES6), & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), @@ -14,7 +15,7 @@ & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, + & EK,potE,potEcomp(0:n_ene+8),totE,totT,amax,kinetic_T,dvmax,damax, & edriftmax, & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), & qfrag(50),qpair(100), @@ -24,6 +25,8 @@ & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), + & qloc(3,maxfrag_back), + & qin_back(3,maxfrag_back,maxprocs/20), & uconst_back integer n_timestep,ntwx,ntwe,lang,count_reset_moment, & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, @@ -35,10 +38,10 @@ & nginv_start,nginv_counts,myginv_ng_count common /back_constr/ uconst_back,utheta,ugamma,uscdiff, & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back + & qin_back,qloc,wfrag_back,nfrag_back,ifrag_back common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag + & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag,loc_qlike,adaptive common /mdpar/ v_ini,d_time,d_time0,scal_fric, & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, & ntime_split,ntime_split0,maxtime_split, @@ -52,7 +55,7 @@ & vtot,dimen,dimen1,dimen3,lang, & reset_moment,reset_vel,count_reset_moment,count_reset_vel, & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC + common /inertia/ IP,ISC,mp,MSC double precision scal_fric,rwat,etawat,gamp, & gamsc(ntyp1),stdfp,stdfsc(ntyp),stdforcp(MAXRES), & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb diff --git a/source/unres/src_MD-M/COMMON.NAMES b/source/unres/src_MD-M/COMMON.NAMES index e6f926b..13dde91 100644 --- a/source/unres/src_MD-M/COMMON.NAMES +++ b/source/unres/src_MD-M/COMMON.NAMES @@ -1,6 +1,7 @@ character*3 restyp character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) + common /names/ restyp(-ntyp1:ntyp1), + & onelet(-ntyp1:ntyp1) character*10 ename,wname integer nprint_ene,print_order common /namterm/ ename(n_ene),wname(n_ene),nprint_ene, diff --git a/source/unres/src_MD-M/COMMON.REMD b/source/unres/src_MD-M/COMMON.REMD index 7d332e0..ca0d057 100644 --- a/source/unres/src_MD-M/COMMON.REMD +++ b/source/unres/src_MD-M/COMMON.REMD @@ -14,9 +14,9 @@ common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, & iset_restart1 real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache, + & qfrag_cache,qpair_cache,c_cache,uscdiff_cache, & ugamma_cache,utheta_cache - integer ntwx_cache,ii_write,max_cache_traj_use + integer ntwx_cache,ii_write,max_cache_traj_use,iset_cache common /traj1cache/ totT_cache(max_cache_traj), & EK_cache(max_cache_traj), & potE_cache(max_cache_traj), diff --git a/source/unres/src_MD-M/COMMON.SBRIDGE b/source/unres/src_MD-M/COMMON.SBRIDGE index 4cc80c8..3b0d7b6 100644 --- a/source/unres/src_MD-M/COMMON.SBRIDGE +++ b/source/unres/src_MD-M/COMMON.SBRIDGE @@ -1,12 +1,18 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss integer ns,nss,nfree,iss - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, & ns,nss,nfree,iss(maxss) - double precision dhpb,forcon - integer ihpb,jhpb,nhpb - common /links/ dhpb(maxdim),forcon(maxdim),ihpb(maxdim), - & jhpb(maxdim),nhpb + double precision dhpb,dhpb1,forcon,fordepth + integer ihpb,jhpb,nhpb,idssb,jdssb + common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), + & fordepth(maxdim), + & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb double precision weidis common /restraints/ weidis integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + & Ht,dtriss,atriss,btriss,ctriss,dyn_ss,dyn_ss_mask(maxres), + & idssb(maxdim),jdssb(maxdim) diff --git a/source/unres/src_MD-M/COMMON.SCCOR b/source/unres/src_MD-M/COMMON.SCCOR index 5217de7..b3e6a6d 100644 --- a/source/unres/src_MD-M/COMMON.SCCOR +++ b/source/unres/src_MD-M/COMMON.SCCOR @@ -1,6 +1,18 @@ -C Parameters of the SCCOR term - double precision v1sccor,v2sccor - integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), - & nterm_sccor +cc Parameters of the SCCOR term + double precision v1sccor,v2sccor,vlor1sccor, + & vlor2sccor,vlor3sccor,gloc_sc, + & dcostau,dsintau,dtauangle,dcosomicron, + & domicron,v0sccor + integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor + common/sccor/v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), + & nsccortyp, + & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp), + & vlor1sccor(maxterm_sccor,20,20), + & vlor2sccor(maxterm_sccor,20,20), + & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,-1:maxres2,10), + & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), + & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), + & domicron(3,3,3,maxres2) diff --git a/source/unres/src_MD-M/COMMON.SCROT b/source/unres/src_MD-M/COMMON.SCROT index 2da7b8f..a352775 100644 --- a/source/unres/src_MD-M/COMMON.SCROT +++ b/source/unres/src_MD-M/COMMON.SCROT @@ -1,3 +1,3 @@ C Parameters of the SC rotamers (local) term double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) + common/scrot/sc_parmin(maxsccoef,ntyp) diff --git a/source/unres/src_MD-M/COMMON.TORCNSTR b/source/unres/src_MD-M/COMMON.TORCNSTR index e4af17c..9476b50 100644 --- a/source/unres/src_MD-M/COMMON.TORCNSTR +++ b/source/unres/src_MD-M/COMMON.TORCNSTR @@ -1,6 +1,16 @@ - integer ndih_constr,idih_constr(maxdih_constr) + integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr, + & itheta_constr(maxdih_constr) integer ndih_nconstr,idih_nconstr(maxdih_constr) - integer idihconstr_start,idihconstr_end - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end + integer idihconstr_start,idihconstr_end,ithetaconstr_start, + & ithetaconstr_end + logical raw_psipred + double precision phi0(maxdih_constr),drange(maxdih_constr), + & ftors(maxdih_constr),theta_constr0(maxdih_constr), + & theta_drange(maxdih_constr),for_thet_constr(maxdih_constr), + & vpsipred(3,maxdih_constr),sdihed(2,maxdih_constr),wdihc + common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange, + & for_thet_constr,vpsipred,sdihed,wdihc, + & ndih_constr,idih_constr, + & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end, + & ntheta_constr,itheta_constr,ithetaconstr_start, + & ithetaconstr_end,raw_psipred diff --git a/source/unres/src_MD-M/COMMON.TORSION b/source/unres/src_MD-M/COMMON.TORSION index 6b6605f..cd576c8 100644 --- a/source/unres/src_MD-M/COMMON.TORSION +++ b/source/unres/src_MD-M/COMMON.TORSION @@ -1,23 +1,60 @@ C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), + double precision v1,v2,vlor1,vlor2,vlor3,v0,v1_kcc,v2_kcc, + & v11_chyb,v21_chyb,v12_chyb,v22_chyb,v1bend_chyb + integer itortyp,ntortyp,nterm,nlor,nterm_old,nterm_kcc_Tb, + & nterm_kcc,itortyp_kcc,nbend_kcc_Tb + common/torsion/v0(-maxtor:maxtor,-maxtor:maxtor,2), + & v1(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & v2(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & vlor1(maxlor,-maxtor:maxtor,-maxtor:maxtor), & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor) - & ,nterm_old + & v1_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v2_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v1bend_chyb(0:maxang_kcc,-maxtor:maxtor), + & itortyp(-ntyp1:ntyp1),ntortyp, + & itortyp_kcc(-ntyp1:ntyp1), + & nterm(-maxtor:maxtor,-maxtor:maxtor,2), + & nlor(-maxtor:maxtor,-maxtor:maxtor,2), + & nterm_kcc_Tb(-maxtor:maxtor,-maxtor:maxtor), + & nterm_kcc(-maxtor:maxtor,-maxtor:maxtor), + & nbend_kcc_Tb(-maxtor:maxtor), + & nterm_old C 6/23/01 - constants for double torsionals double precision v1c,v1s,v2c,v2s integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) + common /torsiond/ + &v1c(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v1s(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v2c(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + &v2s(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + & ntermd_1(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + & ntermd_2(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) C 9/18/99 - added Fourier coeffficients of the expansion of local energy C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp + double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde,b1tilde, + & b,bnew1,bnew2,ccold,ddold,ccnew,ddnew,eenew,e0new,gtb1,gtb2, + & eeold,gtcc,gtdd,gtee, + & bnew1tor,bnew2tor,ccnewtor,ddnewtor,eenewtor,e0newtor + integer nloctyp,iloctyp(-ntyp1:ntyp1),itype2loc(-ntyp1:ntyp1) + logical SPLIT_FOURIERTOR + common/fourier/ b1(2,maxres),b2(2,maxres),b(13,-ntyp:ntyp), + & bnew1(3,2,-ntyp:ntyp),bnew2(3,2,-ntyp:ntyp), + & ccnew(3,2,-ntyp:ntyp),ddnew(3,2,-ntyp:ntyp), + & bnew1tor(3,2,-ntyp:ntyp),bnew2tor(3,2,-ntyp:ntyp), + & ccnewtor(3,2,-ntyp:ntyp),ddnewtor(3,2,-ntyp:ntyp), + & ccold(2,2,-ntyp:ntyp),ddold(2,2,-ntyp:ntyp), + & cc(2,2,maxres), + & dd(2,2,maxres),eeold(2,2,-ntyp:ntyp), + & e0new(3,-ntyp:ntyp),eenew(2,2,2,-ntyp:ntyp), + & e0newtor(3,-ntyp:ntyp),eenewtor(2,2,2,-ntyp:ntyp), + & ee(2,2,maxres), + & ctilde(2,2,maxres), + & dtilde(2,2,maxres),b1tilde(2,maxres), + & b2tilde(2,maxres), + & gtb1(2,maxres),gtb2(2,maxres),gtCC(2,2,maxres), + & gtDD(2,2,maxres),gtEE(2,2,maxres), + & nloctyp,iloctyp,itype2loc,SPLIT_FOURIERTOR diff --git a/source/unres/src_MD-M/COMMON.VAR b/source/unres/src_MD-M/COMMON.VAR index 71158b8..1ab0a16 100644 --- a/source/unres/src_MD-M/COMMON.VAR +++ b/source/unres/src_MD-M/COMMON.VAR @@ -3,10 +3,12 @@ C Store the geometric variables in the following COMMON block. & mask_theta,mask_phi,mask_side double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, + & tauangle,omicron, & xxtab,yytab,zztab,xxref,yyref,zzref common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), & vbld(2*maxres),thetaref(maxres),phiref(maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), + & omicron(2,maxres),tauangle(3,maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar diff --git a/source/unres/src_MD-M/DIMENSIONS b/source/unres/src_MD-M/DIMENSIONS index d9992af..f02e029 100644 --- a/source/unres/src_MD-M/DIMENSIONS +++ b/source/unres/src_MD-M/DIMENSIONS @@ -9,14 +9,14 @@ C Max. number of processors. parameter (maxprocs=2048) C Max. number of fine-grain processors integer max_fg_procs -c parameter (max_fg_procs=maxprocs) - parameter (max_fg_procs=512) +c parameter (max_fg_procs=16) + parameter (max_fg_procs=256) C Max. number of coarse-grain processors integer max_cg_procs parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres - parameter (maxres=1200) + parameter (maxres=1500) C Appr. max. number of interaction sites integer maxres2,maxres6,mmaxres2 parameter (maxres2=2*maxres,maxres6=6*maxres) @@ -28,7 +28,7 @@ C Max number of symetric chains parameter (maxperm=120) C Max. number of variables integer maxvar - parameter (maxvar=4*maxres) + parameter (maxvar=6*maxres) C Max. number of groups of interactions that a given SC is involved in integer maxint_gr parameter (maxint_gr=2) @@ -41,15 +41,20 @@ C Max. number of SC contacts parameter (maxcont=12*maxres) C Max. number of contacts per residue integer maxconts - parameter (maxconts=maxres/4) + parameter (maxconts=maxres) c parameter (maxconts=50) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) + parameter (ntyp=24,ntyp1=ntyp+1) C Max. number of types of dihedral angles & multiplicity of torsional barriers C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 + integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2,maxtor_kcc, + & maxval_kcc parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) + parameter (maxtor_kcc=6,maxval_kcc=6) +c Max number of new valence-angle (only) terms + integer maxang_kcc + parameter (maxang_kcc=36) C Max. number of residue types and parameters in expressions for C virtual-bond angle bending potentials integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, @@ -59,7 +64,7 @@ C virtual-bond angle bending potentials & mmaxtheterm=maxtheterm) c Max number of torsional terms in SCCOR integer maxterm_sccor - parameter (maxterm_sccor=3) + parameter (maxterm_sccor=6) C Max. number of lobes in SC distribution integer maxlob parameter (maxlob=4) @@ -95,7 +100,7 @@ C Max. number of conformations in the pool parameter (max_pool=10) C Number of energy components integer n_ene,n_ene2 - parameter (n_ene=21,n_ene2=2*n_ene) + parameter (n_ene=25,n_ene2=2*n_ene) C Number of threads in deformation integer max_thread,max_thread2 parameter (max_thread=4,max_thread2=2*max_thread) diff --git a/source/unres/src_MD-M/MD.F b/source/unres/src_MD-M/MD.F index 704947a..0f12f9b 100644 --- a/source/unres/src_MD-M/MD.F +++ b/source/unres/src_MD-M/MD.F @@ -176,7 +176,10 @@ c Variable time step algorithm. call brown_step(itime) endif if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) + if (mod(itime,ntwe).eq.0) then + call statout(itime) + call returnbox + endif #ifdef VOUT do j=1,3 v_work(j)=d_t(j,0) @@ -189,7 +192,7 @@ c Variable time step algorithm. enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 v_work(ind)=d_t(j,i+nres) @@ -291,7 +294,7 @@ c------------------------------------------------ double precision difftol /1.0d-5/ nbond=nct-nnt do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) nbond=nbond+1 + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) nbond=nbond+1 enddo c if (lprn1) then @@ -313,7 +316,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind1=ind1+1 do j=1,3 Bmat(ind+j,ind1)=dC_norm(j,i+nres) @@ -390,7 +393,7 @@ c Td(i)=Td(i)+vbl*Tmat(i,ind) enddo do k=nnt,nct - if (itype(k).ne.10 .and. itype(i).ne.21) then + if (itype(k).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 Td(i)=Td(i)+vbldsc0(1,itype(k))*Tmat(i,ind) endif @@ -423,7 +426,7 @@ c enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 zapas(ind)=-gxcart(j,i)+stochforcvec(ind) @@ -494,7 +497,7 @@ c & i,(dC(j,i),j=1,3),xx enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 xx=vbld(i+nres)-vbldsc0(1,itype(i)) write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') @@ -522,7 +525,7 @@ c do iter=1,maxiter endif enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 blen2 = scalar(dc(1,i+nres),dc(1,i+nres)) ppvec(ind)=2*vbldsc0(1,itype(i))**2-blen2 @@ -565,7 +568,7 @@ c do iter=1,maxiter ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc(j,i+nres)=zapas(ind+j) dc_work(ind+j)=zapas(ind+j) @@ -609,7 +612,7 @@ c Building the chain from the newly calculated coordinates & i,(dC(j,i),j=1,3),xx enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then ind=ind+1 xx=vbld(i+nres)-vbldsc0(1,itype(i)) write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') @@ -1178,7 +1181,7 @@ c forces). enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1221,7 +1224,7 @@ c Applying velocity Verlet algorithm - step 1 to coordinates enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=d_a_old(j,inres)*d_time @@ -1258,7 +1261,7 @@ c Step 2 of the velocity Verlet algorithm: update velocities enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1360,7 +1363,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time @@ -1436,7 +1439,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) @@ -1482,7 +1485,7 @@ c Side chains do j=1,3 accel(j)=aux(j) enddo - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) enddo @@ -1527,7 +1530,7 @@ c write (iout,*) "back",i,j,epdriftij enddo endif c Side chains - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 epdriftij= & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) @@ -1574,7 +1577,7 @@ c write(iout,*) "fact", fact enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=fact*d_t(j,inres) @@ -1628,7 +1631,7 @@ c if the friction coefficients do not depend on surface area stdforcp(i)=stdfp*dsqrt(gamp) enddo do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) + stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(iabs(itype(i)))) enddo endif c Open the pdb file for snapshotshots @@ -1933,7 +1936,7 @@ c Transfer to the d_t vector do i=nnt,nct-1 do j=1,3 ind=ind+1 - if (itype(i).ne.21 .and. itype(i+1).ne.21) then + if (itype(i).ne.ntyp1 .and. itype(i+1).ne.ntyp1) then d_t(j,i)=d_t_work(ind) else d_t(j,i)=0.0d0 @@ -1941,7 +1944,7 @@ c Transfer to the d_t vector enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_t(j,i+nres)=d_t_work(ind) @@ -2174,7 +2177,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2222,7 +2225,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2283,7 +2286,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) @@ -2440,7 +2443,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2489,7 +2492,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2550,7 +2553,7 @@ c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) diff --git a/source/unres/src_MD-M/MD_A-MTS.F b/source/unres/src_MD-M/MD_A-MTS.F index 6c6fb14..acd4790 100644 --- a/source/unres/src_MD-M/MD_A-MTS.F +++ b/source/unres/src_MD-M/MD_A-MTS.F @@ -196,7 +196,11 @@ c Variable time step algorithm. #endif endif if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) + if (mod(itime,ntwe).eq.0) then + call statout(itime) +C call enerprint(potEcomp) +C print *,itime,'AFM',Eafmforc,etot + endif #ifdef VOUT do j=1,3 v_work(j)=d_t(j,0) @@ -209,7 +213,7 @@ c Variable time step algorithm. enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 v_work(ind)=d_t(j,i+nres) @@ -230,6 +234,9 @@ c Variable time step algorithm. #endif endif if (mod(itime,ntwx).eq.0) then +c write(iout,*) 'time=',itime +C call check_ecartint + call returnbox write (tytul,'("time",f8.2)') totT if(mdpdb) then call hairpin(.true.,nharp,iharp) @@ -395,6 +402,12 @@ c Build the chain from the newly calculated coordinates c Calculate energy and forces call zerograd call etotal(potEcomp) +! AL 4/17/17: Reduce the steps if NaNs occurred. + if (potEcomp(0).gt.0.99e20 .or. isnan(potEcomp(0)).gt.0) then + d_time=d_time/2 + cycle + endif +! end change if (large.and. mod(itime,ntwe).eq.0) & call enerprint(potEcomp) #ifdef TIMING_ENE @@ -513,6 +526,8 @@ c Second step of the velocity Verlet algorithm endif if (rattle) call rattle2 totT=totT+d_time + totTafm=totT +C print *,totTafm,"TU?" if (d_time.ne.d_time0) then d_time=d_time0 #ifndef LANG0 @@ -596,6 +611,8 @@ c------------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.NAMES' include 'COMMON.TIME1' + logical lprint_short + common /shortcheck/ lprint_short double precision energia_short(0:n_ene), & energia_long(0:n_ene) double precision cm(3),L(3),vcm(3),incr(3) @@ -618,7 +635,8 @@ c------------------------------------------------------------------------------- write (iout,*) "***************** RESPA itime",itime write (iout,*) "Cartesian and internal coordinates: step 0" c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) + call pdbout(0.0d0, + & "cipiszcze ",iout) call intout write (iout,*) "Accelerations from long-range forces" do i=0,nres @@ -742,7 +760,8 @@ c Build the chain from the newly calculated coordinates if (large.and. mod(itime,ntwe).eq.0) then write (iout,*) "***** ITSPLIT",itsplit write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) + call pdbout(0.0d0, + & "cipiszcze ",iout) c call cartprint call intout write (iout,*) "Velocities, step 1" @@ -758,8 +777,30 @@ c call cartprint tt0 = tcpu() #endif c Calculate energy and forces +c if (large.and. mod(itime,ntwe).eq.0) lprint_short=.true. call zerograd call etotal_short(energia_short) +! AL 4/17/17: Exit itime_split loop when energy goes infinite + if (energia_short(0).gt.0.99e20 .or. isnan(energia_short(0)) ) + & then + if (PRINT_AMTS_MSG) write (iout,*) + & "Infinities/NaNs in energia_short", + & energia_short(0),"; increasing ntime_split to",ntime_split + ntime_split=ntime_split*2 + if (ntime_split.gt.maxtime_split) then +#ifdef MPI + write (iout,*) "Cannot rescue the run; aborting job.", + & " Retry with a smaller time step" + call flush(iout) + call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) +#else + write (iout,*) "Cannot rescue the run; terminating.", + & " Retry with a smaller time step" +#endif + endif + exit + endif +! End change if (large.and. mod(itime,ntwe).eq.0) & call enerprint(energia_short) #ifdef TIMING_ENE @@ -864,6 +905,22 @@ c Compute long-range forces #endif call zerograd call etotal_long(energia_long) +! AL 4/17/2017 Handling NaNs + if (energia_long(0).gt.0.99e20 .or. isnan(energia_long(0))) then +#ifdef MPI + write (iout,*) + & "Infinitied/NaNs in energia_long, Aborting MPI job." + call enerprint(energia_long) + call flush(iout) + call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) +#else + write (iout,*) "Infinitied/NaNs in energia_long, terminating." + call enerprint(energia_long) + stop +#endif + endif +! end change +c lprint_short=.false. if (large.and. mod(itime,ntwe).eq.0) & call enerprint(energia_long) #ifdef TIMING_ENE @@ -886,7 +943,8 @@ c Compute accelerations from long-range forces write (iout,*) "energia_long",energia_long(0) write (iout,*) "Cartesian and internal coordinates: step 2" c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) + call pdbout(0.0d0, + & cipiszcze ,iout) call intout write (iout,*) "Accelerations from long-range forces" do i=0,nres @@ -908,8 +966,15 @@ c Compute the complete potential energy potEcomp(i)=energia_short(i)+energia_long(i) enddo potE=potEcomp(0)-potEcomp(20) + if (ntwe.ne.0) then + if (large.and. mod(itime,ntwe).eq.0) then + call enerprint(potEcomp) + write (iout,*) "potE",potD + endif + endif c potE=energia_short(0)+energia_long(0) totT=totT+d_time + totTafm=totT c Calculate the kinetic and the total energy and the kinetic temperature call kinetic(EK) totE=EK+potE @@ -955,7 +1020,7 @@ c forces). enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -996,6 +1061,8 @@ c Applying velocity Verlet algorithm - step 1 to coordinates d_t(j,0)=d_t_old(j,0)+adt enddo do i=nnt,nct-1 +C SPYTAC ADAMA +C do i=0,nres do j=1,3 adt=d_a_old(j,i)*d_time adt2=0.5d0*adt @@ -1005,7 +1072,8 @@ c Applying velocity Verlet algorithm - step 1 to coordinates enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then +C do i=0,nres + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=d_a_old(j,inres)*d_time @@ -1049,7 +1117,7 @@ c Step 2 of the velocity Verlet algorithm: update velocities enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time @@ -1087,12 +1155,25 @@ c Applying velocity Verlet algorithm - step 1 to coordinates c c Compute friction and stochastic forces c +#ifdef MPI time00=MPI_Wtime() +#else + time00=tcpu() +#endif call friction_force +#ifdef MPI time_fric=time_fric+MPI_Wtime()-time00 time00=MPI_Wtime() +#else + time_fric=time_fric+tcpu()-time00 + time00=tcpu() +#endif call stochastic_force(stochforcvec) +#ifdef MPI time_stoch=time_stoch+MPI_Wtime()-time00 +#else + time_stoch=time_stoch+tcpu()-time00 +#endif c c Compute the acceleration due to friction forces (d_af_work) and stochastic c forces (d_as_work) @@ -1148,7 +1229,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time @@ -1213,7 +1294,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) @@ -1260,6 +1341,7 @@ c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) if (dabs(accel(j)).gt.dabs(accel_old(j))) then dacc=dabs(accel(j)-accel_old(j)) +c write (iout,*) i,dacc if (dacc.gt.amax) amax=dacc endif enddo @@ -1278,7 +1360,7 @@ c accel(j)=aux(j) enddo endif do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) accel_old(j)=accel_old(j)+d_a_old(j,i+nres) @@ -1289,6 +1371,7 @@ c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) if (dabs(accel(j)).gt.dabs(accel_old(j))) then dacc=dabs(accel(j)-accel_old(j)) +c write (iout,*) "side-chain",i,dacc if (dacc.gt.amax) amax=dacc endif enddo @@ -1331,7 +1414,7 @@ c write (iout,*) "back",i,j,epdriftij enddo endif c Side chains - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 epdriftij= & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) @@ -1378,7 +1461,7 @@ c write(iout,*) "fact", fact enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=fact*d_t(j,inres) @@ -1433,7 +1516,8 @@ c if the friction coefficients do not depend on surface area stdforcp(i)=stdfp*dsqrt(gamp) enddo do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) + stdforcsc(i)=stdfsc(iabs(itype(i))) + & *dsqrt(gamsc(iabs(itype(i)))) enddo endif c Open the pdb file for snapshotshots @@ -1507,11 +1591,13 @@ c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' if (restart1file) then if (me.eq.king) & inquire(file=mremd_rst_name,exist=file_exist) +#ifdef MPI write (*,*) me," Before broadcast: file_exist",file_exist call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, & IERR) write (*,*) me," After broadcast: file_exist",file_exist c inquire(file=mremd_rst_name,exist=file_exist) +#endif if(me.eq.king.or..not.out1file) & write(iout,*) "Initial state read by master and distributed" else @@ -1529,6 +1615,7 @@ c inquire(file=mremd_rst_name,exist=file_exist) endif call rescale_weights(t_bath) else + rest=.false. if(me.eq.king.or..not.out1file)then if (restart1file) then write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), @@ -1541,6 +1628,7 @@ c inquire(file=mremd_rst_name,exist=file_exist) endif call random_vel totT=0.0d0 + totTafm=totT endif else c Generate initial velocities @@ -1548,6 +1636,8 @@ c Generate initial velocities & write(iout,*) "Initial velocities randomly generated" call random_vel totT=0.0d0 +CtotTafm is the variable for AFM time which eclipsed during + totTafm=totT endif c rest2name = prefix(:ilen(prefix))//'.rst' if(me.eq.king.or..not.out1file)then @@ -1559,24 +1649,40 @@ c rest2name = prefix(:ilen(prefix))//'.rst' c Zeroing the total angular momentum of the system write(iout,*) "Calling the zero-angular & momentum subroutine" + call flush(iout) endif call inertia_tensor +c write (iout,*) "After inertia" +c call flush(iout) c Getting the potential energy and forces and velocities and accelerations + if(me.eq.king.or..not.out1file)then + write(iout,*) "Calling the vcm_vel" + call flush(iout) + endif call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) + write (iout,*) "velocity of the center of the mass:" + write (iout,*) (vcm(j),j=1,3) + call flush(iout) do j=1,3 d_t(j,0)=d_t(j,0)-vcm(j) enddo c Removing the velocity of the center of mass + if(me.eq.king.or..not.out1file)then + write(iout,*) "Calling the vcm_vel" + call flush(iout) + endif call vcm_vel(vcm) if(me.eq.king.or..not.out1file)then write (iout,*) "vcm right after adjustment:" write (iout,*) (vcm(j),j=1,3) + call flush(iout) endif if (.not.rest) then - call chainbuild if(iranconf.ne.0) then +c 8/22/17 AL Loop to produce a low-energy random conformation + do iranmin=1,10 + write (iout,*) "iranmin",iranmin + call chainbuild if (overlapsc) then print *, 'Calling OVERLAP_SC' call overlap_sc(fail) @@ -1600,12 +1706,72 @@ c Removing the velocity of the center of mass endif if(me.eq.king.or..not.out1file) & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun + if (isnan(etot) .or. etot.gt.1.0d4) then + write (iout,*) "Energy too large",etot, + & " trying another random conformation" + do itrial=1,100 + itmp=1 + nrestmp=nres + call gen_rand_conf(itmp,nrestmp,*30) + goto 40 + 30 write (iout,*) 'Failed to generate random conformation', + & ', itrial=',itrial + write (*,*) 'Processor:',me, + & ' Failed to generate random conformation', + & ' itrial=',itrial + call intout + +#ifdef AIX + call flush_(iout) +#else + call flush(iout) +#endif + enddo + write (iout,'(a,i3,a)') 'Processor:',me, + & ' error in generating random conformation.' + write (*,'(a,i3,a)') 'Processor:',me, + & ' error in generating random conformation.' + call flush(iout) +#ifdef MPI + call MPI_Abort(mpi_comm_world,error_msg,ierrcode) +#else + stop +#endif + 40 continue + else + goto 44 + endif + enddo + write (iout,'(a,i3,a)') 'Processor:',me, + & ' failed to generate a low-energy random conformation.' + write (*,'(a,i3,a)') 'Processor:',me, + & ' failed to generate a low-energy random conformation.' + call flush(iout) +#ifdef MPI + call MPI_Abort(mpi_comm_world,error_msg,ierrcode) +#else + stop +#endif + 44 continue + else if (indpdb.gt.0) then +C 8/22/17 AL Minimize initial PDB structure + if(dccart)then + print *, 'Calling MINIM_DC' + call minim_dc(etot,iretcode,nfun) + else + call geom_to_var(nvar,varia) + print *,'Calling MINIMIZE.' + call minimize(etot,varia,iretcode,nfun) + call var_to_geom(nvar,varia) + endif + if(me.eq.king.or..not.out1file) + & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun endif endif call chainbuild_cart call kinetic(EK) if (tbf) then - call verlet_bath(EK) + call verlet_bath endif kinetic_T=2.0d0/(dimen3*Rb)*EK if(me.eq.king.or..not.out1file)then @@ -1640,7 +1806,7 @@ c Removing the velocity of the center of mass if(me.eq.king.or..not.out1file)then write(iout,*) "Potential energy and its components" call enerprint(potEcomp) -c write(iout,*) (potEcomp(i),i=0,n_ene) + write(iout,*) (potEcomp(i),i=0,n_ene) endif potE=potEcomp(0)-potEcomp(20) totE=EK+potE @@ -1770,7 +1936,7 @@ c----------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.NAMES' include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb + double precision xv,sigv,lowb,highb,vec_afm(3) c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m c First generate velocities in the eigenspace of the G matrix c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3 @@ -1784,10 +1950,27 @@ c call flush(iout) lowb=-5*sigv highb=5*sigv d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) + c write (iout,*) "i",i," ii",ii," geigen",geigen(i), c & " d_t_work_new",d_t_work_new(ii) enddo enddo +C if (SELFGUIDE.gt.0) then +C distance=0.0 +C do j=1,3 +C vec_afm(j)=c(j,afmend)-c(j,afmbeg) +C distance=distance+vec_afm(j)**2 +C enddo +C distance=dsqrt(distance) +C do j=1,3 +C d_t_work_new(j+(afmbeg-1)*3)=-velAFMconst*vec_afm(j)/distance +C d_t_work_new(j+(afmend-1)*3)=velAFMconst*vec_afm(j)/distance +C write(iout,*) "myvel",d_t_work_new(j+(afmbeg-1)*3), +C & d_t_work_new(j+(afmend-1)*3) +C enddo + +C endif + c diagnostics c Ek1=0.0d0 c ii=0 @@ -1824,7 +2007,7 @@ c Transfer to the d_t vector enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_t(j,i+nres)=d_t_work(ind) @@ -2053,7 +2236,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2162,7 +2345,7 @@ c ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) @@ -2319,7 +2502,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_work(ind+j)=dc_old(j,i+nres) d_t_work(ind+j)=d_t_old(j,i+nres) @@ -2368,7 +2551,7 @@ c enddo ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 dc(j,inres)=dc_work(ind+j) @@ -2429,7 +2612,7 @@ c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) ind=ind+3 enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres do j=1,3 d_t(j,inres)=d_t_work(ind+j) diff --git a/source/unres/src_MD-M/MP.F b/source/unres/src_MD-M/MP.F index 37bf5b9..debe2b1 100644 --- a/source/unres/src_MD-M/MP.F +++ b/source/unres/src_MD-M/MP.F @@ -11,7 +11,7 @@ c real*8 text1 /'group_i '/,text2/'group_f '/, c & text3/'initialb'/,text4/'initiale'/, c & text5/'openb'/,text6/'opene'/ integer cgtasks(0:max_cg_procs) - character*3 cfgprocs + character*3 cfgprocs /" 1"/ integer cg_size,fg_size,fg_size1 c start parallel processing c print *,'Initializing MPI' @@ -36,9 +36,11 @@ c determine # of nodes and current node MyRank=me C Determine the number of "fine-grain" tasks call getenv_loc("FGPROCS",cfgprocs) + print *,cfgprocs read (cfgprocs,'(i3)') nfgtasks if (nfgtasks.eq.0) nfgtasks=1 call getenv_loc("MAXGSPROCS",cfgprocs) + print *,cfgprocs read (cfgprocs,'(i3)') max_gs_size if (max_gs_size.eq.0) max_gs_size=2 if (lprn) diff --git a/source/unres/src_MD-M/MREMD.F b/source/unres/src_MD-M/MREMD.F index 1df3f0a..afecaa5 100644 --- a/source/unres/src_MD-M/MREMD.F +++ b/source/unres/src_MD-M/MREMD.F @@ -29,7 +29,7 @@ integer iremd_iset(maxprocs) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - double precision remd_ene(0:n_ene+4,maxprocs) + double precision remd_ene(0:n_ene+8,maxprocs) integer iremd_acc(maxprocs),iremd_tot(maxprocs) integer iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs) integer ilen,rstcount @@ -272,6 +272,7 @@ cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep) iset=i2set(me) if(me.eq.king.or..not.out1file) & write(iout,*) me,"iset=",iset,"t_bath=",t_bath + call flush(iout) endif c stdfp=dsqrt(2*Rb*t_bath/d_time) @@ -525,7 +526,9 @@ c Variable time step algorithm. ugamma_cache(i,ntwx_cache)=ugamma(i) uscdiff_cache(i,ntwx_cache)=uscdiff(i) enddo - +C print *,'przed returnbox' + call returnbox +C call enerprint(remd_ene(0,i)) do i=1,nres*2 do j=1,3 c_cache(j,i,ntwx_cache)=c(j,i) @@ -697,19 +700,78 @@ c & CG_COMM,ierr) i_set_temp=iset iset=iset+1 call EconstrQ - potEcomp(n_ene+3)=Uconst + if (loc_qlike) then + call Econstr_back_qlike + else + call Econstr_back + endif + potEcomp(n_ene+3)=Uconst+Uconst_back iset=i_set_temp endif if (iset.gt.1) then i_set_temp=iset iset=iset-1 call EconstrQ - potEcomp(n_ene+4)=Uconst + if (loc_qlike) then + call Econstr_back_qlike + else + call Econstr_back + endif + potEcomp(n_ene+4)=Uconst+Uconst_back iset=i_set_temp endif + if (adaptive) then +c 9/11/17 Adaptive US + itt=i2rep(me) +#ifdef DEBUG + write (iout,*) "me ",me," itt",itt +#endif + if (itt.lt.nrep) then + t_bath_temp=t_bath + t_bath=remd_t(itt+1) + call EconstrQ + potEcomp(n_ene+5)=Uconst +#ifdef DEBUG + write (iout,*) "t_bath",t_bath_temp,t_bath, + & " Uconst",Uconst +#endif + if (iset.lt.nset) then + i_set_temp=iset + iset=iset+1 + call EconstrQ + potEcomp(n_ene+7)=Uconst +#ifdef DEBUG + write (iout,*)"iset",i_set_temp,iset," Uconst",Uconst +#endif + iset=i_set_temp + endif + t_bath=t_bath_temp + endif + if (itt.gt.1) then + t_bath_temp=t_bath + t_bath=remd_t(itt-1) + call EconstrQ + potEcomp(n_ene+6)=Uconst +#ifdef DEBUG + write (iout,*) "t_bath",t_bath_temp,t_bath, + & " Uconst",Uconst +#endif + if (iset.gt.1) then + i_set_temp=iset + iset=iset-1 + call EconstrQ + potEcomp(n_ene+8)=Uconst +#ifdef DEBUG + write (iout,*)"iset",i_set_temp,iset," Uconst",Uconst +#endif + iset=i_set_temp + endif + t_bath=t_bath_temp + endif + endif endif - call mpi_gather(potEcomp(0),n_ene+5,mpi_double_precision, - & remd_ene(0,1),n_ene+5,mpi_double_precision,king, + call mpi_gather(potEcomp(0),n_ene+9,mpi_double_precision, + & remd_ene(0,1),n_ene+9,mpi_double_precision,king, & CG_COMM,ierr) if(lmuca) then call mpi_gather(elow,1,mpi_double_precision, @@ -755,6 +817,7 @@ cd end remd_t_bath(i)=remd_ene(n_ene+1,i) iremd_iset(i)=remd_ene(n_ene+2,i) enddo + if (mremd_dec) then if(lmuca) then co write(iout,*) 'REMD exchange temp,ene,elow,ehigh' do i=1,nodes @@ -768,20 +831,21 @@ co write(iout,*) 'REMD exchange temp,ene,elow,ehigh' write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) enddo endif + endif c------------------------------------- IF(.not.usampl) THEN + if (mremd_dec) then write (iout,*) "Enter exchnge, remd_m",remd_m(1), & " nodes",nodes - call flush(iout) write (iout,*) "remd_m(1)",remd_m(1) + endif do irr=1,remd_m(1) i=ifirst(iran_num(1,remd_m(1))) - write (iout,*) "i",i - call flush(iout) do ii=1,nodes-1 - write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i)) + if (mremd_dec) + & write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i)) if(i.gt.0.and.nupa(0,i).gt.0) then iex=i c if (i.eq.1 .and. int(nupa(0,i)).eq.1) then @@ -795,6 +859,11 @@ c write (iout,*) "upper",nupa(int(nupa(0,i)),i) iex=nupa(iran_num(1,int(nupa(0,i))),i) c enddo c write (iout,*) "nupa(0,i)",nupa(0,i)," iex",iex +#ifdef DEBUG +c 8/21/17 AL : debug + write (iout,*) "i",i,"iex",iex," temperatures", + & remd_t_bath(i),remd_t_bath(iex) +#endif if (lmuca) then call muca_delta(remd_t_bath,remd_ene,i,iex,delta) else @@ -846,12 +915,14 @@ c call enerprint(remd_ene(0,iex)) write (iout,*) "ERROR: inconsistent energies:",iex, & ene_iex_iex,remd_ene(0,iex) endif -c write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -c write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -c & " ene_i_iex",ene_i_iex, -c & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex -c call flush(iout) +#ifdef DEBUG + write (iout,*) "ene_iex_iex",remd_ene(0,iex) + write (iout,*) "i",i," iex",iex + write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, + & " ene_i_iex",ene_i_iex, + & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex + call flush(iout) +#endif delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) delta=-delta @@ -925,18 +996,18 @@ c call flush(iout) itmp=i2rep(i-1) i2rep(i-1)=i2rep(iex-1) i2rep(iex-1)=itmp - -c write(iout,*) 'exchange',i,iex -c write (iout,'(a8,100i4)') "@ ifirst", -c & (ifirst(k),k=1,remd_m(1)) -c do il=1,nodes -c write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":", -c & (nupa(k,il),k=1,nupa(0,il)) -c write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":", -c & (ndowna(k,il),k=1,ndowna(0,il)) -c enddo -c call flush(iout) - +#ifdef DEBUG + write(iout,*) 'exchange',i,iex + write (iout,'(a8,100i4)') "@ ifirst", + & (ifirst(k),k=1,remd_m(1)) + do il=1,nodes + write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":", + & (nupa(k,il),k=1,nupa(0,il)) + write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":", + & (ndowna(k,il),k=1,ndowna(0,il)) + enddo + call flush(iout) +#endif else remd_ene(0,iex)=ene_iex_iex remd_ene(0,i)=ene_i_i @@ -959,7 +1030,7 @@ cd write(iout,*) "########",ii cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - i_dir=iran_num(1,3) + i_dir=iran_num(1,3) cd write(iout,*) "i_dir=",i_dir if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then @@ -969,7 +1040,15 @@ cd write(iout,*) "i_dir=",i_dir i_iset1=i_iset i_mset1=iran_num(1,mset(i_iset1)) iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - +c 9/1/17 AL: Correction; otherwise the restraint energies are mis-assigned +c on failed replica exchange attempt + econstr_temp_i=remd_ene(20,i) + econstr_temp_iex=remd_ene(20,iex) +c 9/11/17 AL: Adaptive sampling (temperature dependent restraints potentials) + if (adaptive) then + remd_ene(20,i)=remd_ene(n_ene+5,i) + remd_ene(20,iex)=remd_ene(n_ene+6,iex) + endif elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then i_temp1=i_temp @@ -991,9 +1070,13 @@ cd write(iout,*) "i_dir=",i_dir iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) econstr_temp_i=remd_ene(20,i) econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - + if (adaptive) then + remd_ene(20,i)=remd_ene(n_ene+7,i) + remd_ene(20,iex)=remd_ene(n_ene+8,iex) + else + remd_ene(20,i)=remd_ene(n_ene+3,i) + remd_ene(20,iex)=remd_ene(n_ene+4,iex) + endif else goto 444 endif @@ -1003,6 +1086,10 @@ cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 c Swap temperatures between conformations i and iex with recalculating the free energies c following temperature changes. +#ifdef DEBUG + write (iout,*) "i_dir",i_dir," i",i," iex",iex, + & " t_bath",remd_t_bath(i),remd_t_bath(iex) +#endif ene_iex_iex=remd_ene(0,iex) ene_i_i=remd_ene(0,i) co write (iout,*) "rescaling weights with temperature", @@ -1170,7 +1257,7 @@ co & " rescaling weights with temperature",t_bath stdfp=dsqrt(2*Rb*t_bath/d_time) do i=1,ntyp stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo + enddo cde write(iout,*) 'REMD after',me,t_bath time08=MPI_WTIME() @@ -1422,7 +1509,7 @@ c----------------------------------------------------------------------- & king,CG_COMM,ierr) c debugging - print *,'traj1file',me,ii_write,ntwx_cache +c print *,'traj1file',me,ii_write,ntwx_cache c end debugging #ifdef AIX @@ -1500,8 +1587,13 @@ c end debugging call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint_(ixdrf, iset_restart1(il), iret) @@ -1538,8 +1630,13 @@ c end debugging call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint(ixdrf, iset_restart1(il), iret) @@ -1782,7 +1879,7 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) enddo endif #endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its +Corrected AL 8/19/2014: each processor needs whole iset array not only its c own element c call mpi_scatter(i2set,1,mpi_integer, c & iset,1,mpi_integer,king, @@ -1866,4 +1963,4 @@ c & CG_COMM,ierr) if(me.eq.king) close(irest2) return end - +c------------------------------------------ diff --git a/source/unres/src_MD-M/Makefile b/source/unres/src_MD-M/Makefile deleted file mode 100644 index fe77a61..0000000 --- a/source/unres/src_MD-M/Makefile +++ /dev/null @@ -1,140 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w - -CFLAGS = -DSGI -c - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../../../bin/unres/MD/unres_Tc_procor_oldparm_em64-D-symetr.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich ../../lib/xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich ../../lib/xdrf/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o permut.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} -#${FC} ${OPT} -Wl,-M ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -permut.o : permut.F - ${FC} ${FFLAGS2} ${CPPFLAGS} permut.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -add.o: add.f - ${FC} ${FFLAGS2} add.f - -blas.o: blas.f - ${FC} ${FFLAGS2} blas.f - -eigen.o: eigen.f - ${FC} ${FFLAGS2} eigen.f diff --git a/source/unres/src_MD-M/Makefile b/source/unres/src_MD-M/Makefile new file mode 120000 index 0000000..ee054bf --- /dev/null +++ b/source/unres/src_MD-M/Makefile @@ -0,0 +1 @@ +Makefile_MPICH_ifort-okeanos \ No newline at end of file diff --git a/source/unres/src_MD-M/Makefile-biosim b/source/unres/src_MD-M/Makefile-biosim deleted file mode 100644 index e8de82a..0000000 --- a/source/unres/src_MD-M/Makefile-biosim +++ /dev/null @@ -1,127 +0,0 @@ -#CPPFLAGS = -WF,-DOLD_GINV \ - -WF,-DUNRES -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DISNAN \ - -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -# -INSTALL_DIR = /opt/mpich-pgi -CC = cc -FC=mpif90 -PGI=/opt/pgi -#OPT = -fast -pc 64 -tp p6 \ -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 -OPT = -fast - -OPT1 = -fast -#OPT = -C -g -#OPT1 = -C -g - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} -FFLAGS2 = ${FFLAGS} - -BIN = /home/aliwo/UNRES/MD/bin/unres_MD_Tc-new-fg.exe -LIBS = ../src_Tc_cache/xdrf_new/libxdrf.a -#LIBS=-lmpichfsup -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DPROCOR -DOLD_GINV -DLANG0 -CFLAGS = -DLINUX -DPGI -c - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile-intrepid-with-tau b/source/unres/src_MD-M/Makefile-intrepid-with-tau deleted file mode 100644 index eae1cc5..0000000 --- a/source/unres/src_MD-M/Makefile-intrepid-with-tau +++ /dev/null @@ -1,154 +0,0 @@ -# -FC1=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -FC=tau_f90.sh -OPT = -O3 -qarch=450 -qtune=450 -qfixed -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT = -O -qarch=450 -qtune=450 -qfixed -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT = -O0 -C -g -qarch=450 -qtune=450 -qfixed -OPT1 = -O0 -g -qarch=450 -qtune=450 -qfixed -OPT2 = -O2 -qarch=450 -qtune=450 -qfixed -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT2 = ${OPT} -OPTE = -O4 -qarch=450 -qtune=450 -qfixed -#OPTE = -O4 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPTE=${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-O4-test.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} --print-map ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o; /bin/rm *.pp.* - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -compinfo: compinfo.o - ${CC} ${CFLAGS} compfinfo.c - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -prng_32.o: prng_32.F - ${FC} -qfixed -O0 prng_32.F - -prng.o: prng.f - ${FC1} ${FFLAGS} prng.f - -readrtns_CSA.o: readrtns_CSA.F - ${FC1} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC1} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F diff --git a/source/unres/src_MD-M/Makefile-matrix-intel b/source/unres/src_MD-M/Makefile-matrix-intel deleted file mode 100644 index c81649f..0000000 --- a/source/unres/src_MD-M/Makefile-matrix-intel +++ /dev/null @@ -1,124 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = unres_Tc_procor_new_em64-fg.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile-matrix3 b/source/unres/src_MD-M/Makefile-matrix3 deleted file mode 100644 index 3a50a21..0000000 --- a/source/unres/src_MD-M/Makefile-matrix3 +++ /dev/null @@ -1,141 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -CFLAGS = -DSGI -c - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -#FFLAGS = -c -C -g -I$(INSTALL_DIR)/include -#FFLAGS1 = -c -g -I$(INSTALL_DIR)/include -#FFLAGS2 = -c -C -g -I$(INSTALL_DIR)/include -#FFLAGSE = -c -C -g -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_em64-D-finegrain.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -eigen.o : eigen.f - ${FC} ${FFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS} add.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile-matrix3-oldparm b/source/unres/src_MD-M/Makefile-matrix3-oldparm deleted file mode 100644 index 9096f63..0000000 --- a/source/unres/src_MD-M/Makefile-matrix3-oldparm +++ /dev/null @@ -1,127 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w - -CFLAGS = -DSGI -c - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} -Wl,-M ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile-oldparm b/source/unres/src_MD-M/Makefile-oldparm deleted file mode 100644 index bf12898..0000000 --- a/source/unres/src_MD-M/Makefile-oldparm +++ /dev/null @@ -1,130 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -INSTALL_DIR = /opt/mpi/mvapich -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = unres_Tc_procor_new_em64-oldparm.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure3.o econstr_local.o gnmr1.o check_sc_map.o check_bond.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FCL} -static-libcxa ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - mv ${BIN} ../bin - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -readrtns_CSA.o : readrtns_CSA.F - ${FC} ${FFLAGS1} ${CPPFLAGS} readrtns_CSA.F - -MREMD.o : MREMD.F - ${FC} ${FFLAGS1} ${CPPFLAGS} MREMD.F - diff --git a/source/unres/src_MD-M/Makefile-rstconv b/source/unres/src_MD-M/Makefile-rstconv deleted file mode 100644 index 58d5e5f..0000000 --- a/source/unres/src_MD-M/Makefile-rstconv +++ /dev/null @@ -1,40 +0,0 @@ -# -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 -CC = cc - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/restbin2asc -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: restbin2asc - -obj: ${object} - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = restbin2asc.o - -restbin2asc: ${object} - ${FC} ${OPT} ${object} ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o diff --git a/source/unres/src_MD-M/Makefile-tau-temp b/source/unres/src_MD-M/Makefile-tau-temp deleted file mode 100644 index 6fd84a8..0000000 --- a/source/unres/src_MD-M/Makefile-tau-temp +++ /dev/null @@ -1,148 +0,0 @@ -# -#include TAU_MAKEFILE ${TAU_ROOT_DIR}/xt3/lib/Makefile.tau-mpi-pdt-pgi -TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi -FC=tau_f90.sh -OPT = -fast -pc 64 -tp p6 -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -OPT1 = -fast -pc 64 -tp p6 -OPT2 = -fast -pc 64 -tp p6 -OPTE = -fast -pc 64 -tp p6 - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-tau.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DAIX -DISNAN -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o; /bin/rm *.pp.* - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -compinfo: compinfo.o - ${CC} ${CFLAGS} compfinfo.c - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -prng_32.o: prng_32.F - ${FC} -qfixed -O0 prng_32.F - -prng.o: prng.f - ${FC} ${FFLAGS} prng.f - -readrtns_CSA.o: readrtns_CSA.F - ${FC} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F diff --git a/source/unres/src_MD-M/Makefile.tau-mpi-f77-pdt b/source/unres/src_MD-M/Makefile.tau-mpi-f77-pdt deleted file mode 100644 index c8dc5fe..0000000 --- a/source/unres/src_MD-M/Makefile.tau-mpi-f77-pdt +++ /dev/null @@ -1,860 +0,0 @@ -#**************************************************************************** -#* TAU Portable Profiling Package ** -#* http://www.cs.uoregon.edu/research/tau ** -#**************************************************************************** -#* Copyright 1997-2002 ** -#* Department of Computer and Information Science, University of Oregon ** -#* Advanced Computing Laboratory, Los Alamos National Laboratory ** -#**************************************************************************** -####################################################################### -## pC++/Sage++ Copyright (C) 1993,1995 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -####################################################################### -# This is a sample Makefile that contains the Profiling and Tracing -# options. Makefiles of other applications and libraries (not included -# in this distribution) should include this Makefile. -# It defines the following variables that should be added to CFLAGS -# TAU_INCLUDE - Include path for tau headers -# TAU_DEFS - Defines that are needed for tracing and profiling only. -# And for linking add to LIBS -# TAU_LIBS - TAU Tracing and Profiling library libprof.a -# -# When the user needs to turn off tracing and profiling and run the -# application without any runtime overhead of instrumentation, simply -# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep -# TAUINC. -####################################################################### - -########### Automatically modified by the configure script ############ -CONFIG_ARCH=bgp -TAU_ARCH=bgp -CONFIG_CC=bgxlc_r -CONFIG_CXX=bgxlC_r -TAU_CC_FE=$(CONFIG_CC) -TAU_CXX_FE=$(CONFIG_CXX) - -# Front end C/C++ Compilers -#BGL#TAU_CC_FE=xlc #ENDIF# -#BGL#TAU_CXX_FE=xlC #ENDIF# -TAU_CC_FE=xlc #ENDIF##BGP# -TAU_CXX_FE=xlC #ENDIF##BGP# -#CATAMOUNT#TAU_CC_FE=gcc #ENDIF# -#CATAMOUNT#TAU_CXX_FE=g++ #ENDIF# -#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF# -#SC_GFORTRAN#TAU_CXX_FE=g++ #ENDIF# -#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF# -#SC_PATHSCALE#TAU_CXX_FE=g++ #ENDIF# - -PCXX_OPT=-g -USER_OPT= -EXTRADIR=/opt/ibmcmp/xlf/bg/11.1/bin/.. -EXTRADIRCXX=/opt/ibmcmp/vacpp/bg/9.0/bin/.. -TAUROOT=/soft/apps/tau/tau_latest -TULIPDIR= -TAUEXTRASHLIBOPTS= -TAUGCCLIBOPTS= -TAUGCCLIBDIR= -TAUGFORTRANLIBDIR= -PCLDIR= -PAPIDIR= -PAPISUBDIR= -CHARMDIR= -PDTDIR=/soft/apps/tau/pdtoolkit-3.12 -PDTCOMPDIR= -DYNINSTDIR= -JDKDIR= -SLOG2DIR= -OPARIDIR= -TAU_OPARI_TOOL= -EPILOGDIR= -EPILOGBINDIR= -EPILOGINCDIR= -EPILOGLIBDIR= -EPILOGEXTRALINKCMD= -VAMPIRTRACEDIR= -KTAU_INCDIR= -KTAU_INCUSERDIR= -KTAU_LIB= -KTAU_KALLSYMS_PATH= -PYTHON_INCDIR= -PYTHON_LIBDIR= -PERFINCDIR= -PERFLIBDIR= -PERFLIBRARY= -TAU_SHMEM_INC= -TAU_SHMEM_LIB= -TAU_CONFIG=-mpi-pdt -TAU_MPI_INC=-I/bgsys/drivers/ppcfloor/comm/include -TAU_MPI_LIB=-L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_FLIB=-lfmpich.cnk -L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPILIB_DIR=/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_LIB= -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_FLIB=-lfmpich.cnk -L/bgsys/drivers/ppcfloor/comm/lib -FULL_CXX=mpixlcxx_r -FULL_CC=mpixlc_r -TAU_PREFIX_INSTALL_DIR=/soft/apps/tau/tau_latest - -TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin -TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include -TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib - -####################################################################### - -#OPARI#TAU_OPARI_TOOL=$(TAU_BIN_DIR)/opari #ENDIF# -#ENABLE64BIT#ABI = -64 #ENDIF# -#ENABLEN32BIT#ABI = -n32 #ENDIF# -#ENABLE32BIT#ABI = -32 #ENDIF# - -####################################################################### -#SP1#IBM_XLC_ABI = -q32 #ENDIF# -#SP1#IBM_GNU_ABI = -maix32 #ENDIF# -#IBM64#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64#IBM_GNU_ABI = -maix64 #ENDIF# -#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF# -#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF# -#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF# -#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF# -#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF# -#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF# -#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF# -#MIPS32#ABI = $(SC_ABI) #ENDIF# -#MIPS64#ABI = $(SC_ABI) #ENDIF# - -IBM_ABI = $(IBM_XLC_ABI) #ENDIF##USE_IBMXLC# -#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF# -#SP1# ABI = $(IBM_ABI) #ENDIF# -#PPC64# ABI = $(IBM_ABI) #ENDIF# -#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF# -#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF# -#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF# -#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF# -#SOL2#ABI = $(SUN_ABI) #ENDIF# -#SUNX86_64#ABI = $(SUN_ABI) #ENDIF# -#FORCEIA32#ABI = -m32#ENDIF# -####################################################################### -F90_ABI = $(ABI) -#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF# -####################################################################### - -############# Standard Defines ############## -TAU_CC = $(CONFIG_CC) $(ABI) $(ISA) -TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA) -TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA) -TAU_INSTALL = /bin/cp -TAU_SHELL = /bin/sh -LSX = .a -############################################# -# JAVA DEFAULT ARCH -############################################# -JDKARCH = linux -#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF# -#SOL2#JDKARCH = solaris #ENDIF# -#SGIMP#JDKARCH = irix #ENDIF# -#SP1#JDKARCH = aix #ENDIF# -#T3E#JDKARCH = cray #ENDIF# -############################################# -# JAVA OBJECTS -############################################# -#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF# -#JAVA#TAUJAPI = Profile.class #ENDIF# - - -############################################# -# OpenMP OBJECTS -############################################# -#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF# - -############################################# -# Opari OBJECTS -############################################# -#OPARI#OPARI_O = TauOpari.o #ENDIF# -#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF# -#EPILOG#OPARI_O = #ENDIF# -#VAMPIRTRACE#OPARI_O = #ENDIF# -#GNU#OPARI_O = #ENDIF# - -############################################# -# CallPath OBJECTS -############################################# -#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF# -#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF# - -############################################# -# Python Binding OBJECTS -############################################# -#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF# - -############################################# -# DYNINST DEFAULT ARCH -############################################# -DYNINST_PLATFORM = $(PLATFORM) - - -#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF# - -############# OpenMP Fortran Option ######## -#OPENMP#TAU_F90_OPT = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF# -#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF# -#GUIDE#TAU_F90_OPT = #ENDIF# -#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF# -#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF# -#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF# - -TAU_R =_r #ENDIF##THREADSAFE_COMPILERS# - -############# Fortran Compiler ############# -#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = xlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##IBM_FORTRAN# -TAU_F90 = mpixlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##BGP# -#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_FORTRAN#TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_CATAMOUNT#TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# - - -############# Portable F90 Options ############# -#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -TAU_F90_FIXED = -qfixed #ENDIF##IBM_FORTRAN# -TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF##IBM_FORTRAN# -#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF# -#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# - -############# Profiling Options ############# -PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE# -#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF# -#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF# -#PCL#PCL_O = PclLayer.o #ENDIF# -#PAPI#PAPI_O = PapiLayer.o #ENDIF# -#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF# -#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF# -#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF# -#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF# -PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB# -#CRAYX1CC#PROFILEOPT7 = #ENDIF# -#CRAYCC#PROFILEOPT7 = #ENDIF# -#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF# -#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF# -#RTTI#PROFILEOPT9 = -DRTTI #ENDIF# -#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF# -#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF# -#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF# -#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF# -#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF# -#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF# -#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF# -#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF# -#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF# -#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF# -#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF# -#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF# -#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF# -#TRACE#TRACEOPT = -DTRACING_ON #ENDIF# -#TRACE#EVENTS_O = Tracer.o #ENDIF# -#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF# -#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF# -#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF# -#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF# -#MPITRACE#EVENTS_O = Tracer.o #ENDIF# -#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF# -#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF# -#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF# -#TAU_SPROC#THR_O = SprocLayer.o #ENDIF# -#JAVA#THR_O = JavaThreadLayer.o #ENDIF# -#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF# -#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF# -#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF# -#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF# -#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF# -#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#PGI#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF# -#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF# -#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF# -#HPGNU#PROFILEOPT21 = -fPIC #ENDIF# -#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF# -#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF# -#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF# -#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF# -PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF##USE_IBMXLC# -#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF# -#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF# -#JAVA#PROFILEOPT23 = -DJAVA #ENDIF# -#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF# -#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF# -PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI# -PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED# -#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF# -#GNU#PROFILEOPT27 = #ENDIF# -#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF# -#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF# -#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF# -#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF# -#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF# -#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF# -#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF# -#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF# -#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF# -#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF# -#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -#BGPTIMERS#PROFILEOPT30 = -DBGP_TIMERS -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF# -#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF# -#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF# -#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF# -#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF# -#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF# -#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF# -#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF# -#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#SCALASCA#PROFILEOPT36 = -DTAU_SCALASCA -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF# -#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF# -#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF# -#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF# -#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF# -#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF# -#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF# -#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF# -#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF# -#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF# -#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF# -#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF# -# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore -#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF# -PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST# -#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF# -PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP# -PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER# -#CATAMOUNT#PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF# -#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF# -PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR# -PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX# -PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR# -#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF# - -#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF# -#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF# -#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF# -#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE -D__xlc__ #ENDIF##BGP# -# Omit the -D_LARGETFILE64_SOURCE till we can check the IBM crash -#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF# -#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF# -#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF# -#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF# -#WEAKMPIINIT#PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF# -#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF# -#MPICH_IGNORE_CXX_SEEK#PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF# -PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##BGP# -#MPICH2_MPI_INPLACE#PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF# - - -############# RENCI Scalable Trace Lib Options ############# -STFF_DIR= -SDDF_DIR= -#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF# -#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF# -#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF# - -############# KTAU (again) ############# -#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF# - -#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF# - -#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -PROFILEOPT72 = -DTAU_BGP -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF##BGP# - -#For F90 support for all platforms -FWRAPPER = TauFMpi.o -MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2# -MPI2EXTENSIONS = #ENDIF##BGP# -#CRAYX1CC#MPI2EXTENSIONS = #ENDIF# - -#SGICOUNTERS#LEXTRA = -lperfex #ENDIF# -#ALPHATIMERS#LEXTRA = -lrt #ENDIF# -#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF# -#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF# -#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# -#Due to some problems with older versions of libpfm, we are using the static lib -#IA64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#PAPIPFM##LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF# -#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF# -#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF# -#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF# -#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF# -#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF# -#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF# -#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF# - -TAU_PAPI_EXTRA_FLAGS = $(LEXTRA) -#IA64PAPI#TAU_PAPI_EXTRA_FLAGS = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# - - -# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis. -#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#PAPI##TAU_PAPI_RPATH = #ENDIF# -#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF# -#BGLPAPI#TAU_PAPI_RPATH = #ENDIF# -#BGPPAPI#TAU_PAPI_RPATH = #ENDIF# -#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF# -#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF# -#PGI#TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF# - -# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath -# because they are likely going to link with ifort -#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF# -#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF# -#IBMPAPI#TAU_PAPI_RPATH = #ENDIF# -#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF# -#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF# - -#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF# -#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF# -#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF# -#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF# - -TAU_GCCLIB = -lgcc_s -TAU_GCCLIB = #ENDIF##BGP# -#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF# -#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF# -#BGL#TAU_GCCLIB = -lgcc #ENDIF# -#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF# -#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF# -#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF# -#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF# -#GNU_GFORTRAN#TAU_FORTRANLIBS = -L$(TAUGFORTRANLIBDIR) -lgfortran -lgfortranbegin #ENDIF# -#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF# -TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF##IBM_FORTRAN# - -TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF# -#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF# -TAU_FORLIBDIR=lib #ENDIF##IBM_FORTRAN# -#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF# -TAU_FORLIBDIR=bglib #ENDIF##BGP# -#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF# -#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF# - -TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF##BGP# -#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF# -TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF##BGP# -TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF##BGP# - -#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#PGI_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF# -#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF# -#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF# -#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF# -#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF# -#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF# -#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF# -# LINKER OPTIONS -TAU_LINKER_OPT2 = $(LEXTRA) - - -#ACC#TAUHELPER = -AA #ENDIF# -#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF# -#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF# -#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF# -#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF# -#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF# -#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF# -#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF# -#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF# -#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF# -#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF# -#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF# - - -#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF# - -## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add -#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF# -#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF# -#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#PGI#TAU_CXXLIBS = -lstd -lC #ENDIF# -#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF# -#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF# - -TAU_SGI_INIT = /usr/lib32/c++init.o -#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF# -#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF# -#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF# - -#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF# -#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF# -#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF# -#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF# -#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF# -#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF# -#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF# -#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF# -TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF##BGP# -#SP1#TAU_XLCLIBS = -lC #ENDIF# -TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF##USE_IBMXLC# -#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF# -#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF# - -# EXTERNAL PACKAGES: VAMPIRTRACE -#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# - -# EXTERNAL PACKAGES: EPILOG -#SCALASCA#TAU_ELG_SERIAL_SUFFIX =.ser #ENDIF# -#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg$(TAU_ELG_SERIAL_SUFFIX) $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# - -# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up -#FORCESHARED#TAU_LINKER_OPT3=#ENDIF# - -TAU_LINKER_OPT4 = $(LEXTRA1) -#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF# -#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF# -#GNU#TAU_LINKER_OPT5 = #ENDIF# -#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF# -#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#GUIDE#TAU_LINKER_OPT5 = #ENDIF# -#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF# - -# MALLINFO needs -lmalloc on sgi, sun -#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SOL2#TAU_LINKER_OPT6 = #ENDIF# -#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF# - -# We need -lCio with SGI CC 7.4+ -#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF# - -# charm -#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF# - -# extra libs -#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF# - -#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF# - -TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF# -#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF# - -TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF# -#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF# - - -#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF# -#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF# -#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF# -#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF# -#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF# -#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF# - -TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI# -#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# -#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# - -############################################## -# Build TAU_LINKER_SHOPTS -#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF# -TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF##USE_IBMXLC# -#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF# -#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF# - -############################################## -# MPI _r suffix check (as in libmpi_r) -#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF# - -############################################## -# Flags to build a shared object: TAU_SHFLAGS -#GNU#AR_SHFLAGS = -shared #ENDIF# -#PGI#AR_SHFLAGS = -shared #ENDIF# -#SGICC#AR_SHFLAGS = -shared #ENDIF# -#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF# -#SOL2#AR_SHFLAGS = -G #ENDIF# -#SUN386I#AR_SHFLAGS = -G #ENDIF# -#SUNX86_64#AR_SHFLAGS = -G #ENDIF# -AR_SHFLAGS = -G #ENDIF##USE_IBMXLC# -#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF# -#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF# -#ACC#AR_SHFLAGS = -b #ENDIF# -TAU_SHFLAGS = $(AR_SHFLAGS) -o - -############# RANLIB Options ############# -TAU_RANLIB = echo "Built" -#APPLECXX#TAU_RANLIB = ranlib #ENDIF# -#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF# - -############################################## -TAU_AR = ar #ENDIF# -#SP1#TAU_AR = ar -X32 #ENDIF# -#IBM64#TAU_AR = ar -X64 #ENDIF# -#PPC64#TAU_AR = ar #ENDIF# -#IBM64LINUX#TAU_AR = ar #ENDIF# - - -############################################## -# PDT OPTIONS -# You can specify -pdtcompdir=intel -pdtarchdir=x86_64 -# If nothing is specified, PDTARCHDIR uses TAU_ARCH -PDTARCHDIRORIG=$(TAU_ARCH) -PDTARCHITECTURE=x86_64 -PDTARCHDIRFINAL=$(PDTARCHDIRORIG) -#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF# -PDTARCHDIR=$(PDTARCHDIRFINAL) -#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF# - - -############################################## - -PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \ - $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \ - $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \ - $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \ - $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \ - $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \ - $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \ - $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \ - $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \ - $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \ - $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \ - $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \ - $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \ - $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \ - $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \ - $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \ - $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \ - $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \ - $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \ - $(TRACEOPT) - -############################################## - -TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \ - $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \ - $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \ - $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12) - -############################################## - -############# TAU Fortran #################### -TAU_LINKER=$(TAU_CXX) -#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -# Intel efc compiler acts as a linker - NO. Let C++ be the linker. - -############################################## -############# TAU Options #################### -TAUDEFS = $(PROFILEOPTS) - -TAUINC = -I$(TAU_INC_DIR) - -TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAUMPILIBS = $(TAU_MPI_LIB) - -TAUMPIFLIBS = $(TAU_MPI_FLIB) - -### ACL S/W requirement -TAU_DEFS = $(TAUDEFS) - -TAU_INCLUDE = -I$(TAU_INC_DIR) -#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF# -#PERFLIB#TAU_DEFS = #ENDIF# -#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF# - -TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory -#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# -#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# - -TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) -#PERFLIB#TAU_LIBS = #ENDIF# - -TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) -#PERFLIB#TAU_SHLIBS = #ENDIF# -TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) - -TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable - -TAU_MPI_INCLUDE = $(TAU_MPI_INC) - -TAU_MPI_LIBS = $(TAU_MPI_LIB) - -TAU_MPI_FLIBS = $(TAU_MPI_FLIB) - -## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL) -TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG) - -## Don't include -lpthread or -lsmarts. Let app. do that. -############################################# -## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS -#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF# -TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI# -#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF# -#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF# -TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI# -TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI# -TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI# -TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI# - -#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF# -#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF# -############################################# -#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF# -#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF# -#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF# - -TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC) - -TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB) -############################################# -# TAU COMPILER SHELL SCRIPT OPTIONS -TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\ - -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \ - -optNoMpi \ - -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \ - -optTauCC="$(TAU_CC)" \ - -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \ - -optTauDefs="$(TAU_DEFS)" \ - -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\ - -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - $(TAU_COMPILER_EXTRA_OPTIONS) \ - -optIncludeMemory="$(TAU_INCLUDE_MEMORY)" -############################################# - -TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) -SHAREDEXTRAS= -#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF# -TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS) -############################################# -# These options could be included in the application Makefile as -#CFLAGS = $(TAUDEFS) $(TAUINC) -# -#LIBS = $(TAULIBS) -# -# To run the application without Profiling/Tracing use -#CFLAGS = $(TAUINC) -# Don't use TAUDEFS but do include TAUINC -# Also ignore TAULIBS when Profiling/Tracing is not used. -############################################# - diff --git a/source/unres/src_MD-M/Makefile.tau-mpi-pdt-pgi.org b/source/unres/src_MD-M/Makefile.tau-mpi-pdt-pgi.org deleted file mode 100755 index 5f0dd3a..0000000 --- a/source/unres/src_MD-M/Makefile.tau-mpi-pdt-pgi.org +++ /dev/null @@ -1,836 +0,0 @@ -#**************************************************************************** -#* TAU Portable Profiling Package ** -#* http://www.cs.uoregon.edu/research/tau ** -#**************************************************************************** -#* Copyright 1997-2002 ** -#* Department of Computer and Information Science, University of Oregon ** -#* Advanced Computing Laboratory, Los Alamos National Laboratory ** -#**************************************************************************** -####################################################################### -## pC++/Sage++ Copyright (C) 1993,1995 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -####################################################################### -# This is a sample Makefile that contains the Profiling and Tracing -# options. Makefiles of other applications and libraries (not included -# in this distribution) should include this Makefile. -# It defines the following variables that should be added to CFLAGS -# TAU_INCLUDE - Include path for tau headers -# TAU_DEFS - Defines that are needed for tracing and profiling only. -# And for linking add to LIBS -# TAU_LIBS - TAU Tracing and Profiling library libprof.a -# -# When the user needs to turn off tracing and profiling and run the -# application without any runtime overhead of instrumentation, simply -# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep -# TAUINC. -####################################################################### - -########### Automatically modified by the configure script ############ -CONFIG_ARCH=xt3 -TAU_ARCH=xt3 -CONFIG_CC=qk-pgcc -CONFIG_CXX=qk-pgCC -TAU_CC_FE=$(CONFIG_CC) -#BGL#TAU_CC_FE=xlc #ENDIF# -#BGP#TAU_CC_FE=xlc #ENDIF# -TAU_CC_FE=gcc #ENDIF##CATAMOUNT# -#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF# -#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF# -PCXX_OPT=-g -USER_OPT= -EXTRADIR=/opt/pgi/6.1.4/linux86-64/6.1/bin/.. -EXTRADIRCXX= -TAUROOT=/usr/local/packages/TAU-2.17/tau-2.17 -TULIPDIR= -TAUEXTRASHLIBOPTS= -TAUGCCLIBOPTS= -TAUGCCLIBDIR= -PCLDIR= -PAPIDIR= -PAPISUBDIR= -CHARMDIR= -PDTDIR=/usr/local/packages/TAU-2.17/tau-2.17/../pdtoolkit-3.12 -PDTCOMPDIR= -DYNINSTDIR= -JDKDIR= -SLOG2DIR= -OPARIDIR= -TAU_OPARI_TOOL= -EPILOGDIR= -EPILOGBINDIR= -EPILOGINCDIR= -EPILOGLIBDIR= -EPILOGEXTRALINKCMD= -VAMPIRTRACEDIR= -KTAU_INCDIR= -KTAU_INCUSERDIR= -KTAU_LIB= -KTAU_KALLSYMS_PATH= -PYTHON_INCDIR= -PYTHON_LIBDIR= -PERFINCDIR= -PERFLIBDIR= -PERFLIBRARY= -TAU_SHMEM_INC= -TAU_SHMEM_LIB= -TAU_CONFIG=-mpi-pdt-pgi -TAU_MPI_INC=-I/opt/xt-mpt/default/mpich2-64/P2/include -TAU_MPI_LIB=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/libTauMpi$(TAU_CONFIG).a -L/opt/xt-mpt/default/mpich2-64/P2/lib -lrt -lmpichcxx -lmpich -lrt -TAU_MPI_FLIB=-L/opt/xt-mpt/default/mpich2-64/P2/lib -L/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/libTauMpi$(TAU_CONFIG).a -lrt -lmpichcxx -lmpich -lrt -TAU_MPILIB_DIR=/opt/xt-mpt/default/mpich2-64/P2/lib -TAU_MPI_NOWRAP_LIB= -L/opt/xt-mpt/default/mpich2-64/P2/lib -lrt -lmpichcxx -lmpich -lrt -TAU_MPI_NOWRAP_FLIB=-L/opt/xt-mpt/default/mpich2-64/P2/lib -lrt -lmpichcxx -lmpich -lrt -FULL_CXX=/opt/xt-pe/1.5.47/bin/snos64/qk-pgCC -FULL_CC=/opt/xt-pe/1.5.47/bin/snos64/qk-pgcc -TAU_PREFIX_INSTALL_DIR=/usr/local/packages/TAU-2.17/tau-2.17 - -TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin -TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include -TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib - -####################################################################### - -#ENABLE64BIT#ABI = -64 #ENDIF# -#ENABLEN32BIT#ABI = -n32 #ENDIF# -#ENABLE32BIT#ABI = -32 #ENDIF# - -####################################################################### -#SP1#IBM_XLC_ABI = -q32 #ENDIF# -#SP1#IBM_GNU_ABI = -maix32 #ENDIF# -#IBM64#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64#IBM_GNU_ABI = -maix64 #ENDIF# -#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF# -#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF# -#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF# -#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF# -#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF# -#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF# -#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF# -#MIPS32#ABI = $(SC_ABI) #ENDIF# -#MIPS64#ABI = $(SC_ABI) #ENDIF# - -#USE_IBMXLC#IBM_ABI = $(IBM_XLC_ABI) #ENDIF# -#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF# -#SP1# ABI = $(IBM_ABI) #ENDIF# -#PPC64# ABI = $(IBM_ABI) #ENDIF# -#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF# -#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF# -#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF# -#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF# -#SOL2#ABI = $(SUN_ABI) #ENDIF# -#SUNX86_64#ABI = $(SUN_ABI) #ENDIF# -#FORCEIA32#ABI = -m32#ENDIF# -####################################################################### -F90_ABI = $(ABI) -#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF# -####################################################################### - -############# Standard Defines ############## -TAU_CC = $(CONFIG_CC) $(ABI) $(ISA) -TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA) -TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA) -TAU_INSTALL = /bin/cp -TAU_SHELL = /bin/sh -LSX = .a -############################################# -# JAVA DEFAULT ARCH -############################################# -JDKARCH = linux -#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF# -#SOL2#JDKARCH = solaris #ENDIF# -#SGIMP#JDKARCH = irix #ENDIF# -#SP1#JDKARCH = aix #ENDIF# -#T3E#JDKARCH = cray #ENDIF# -############################################# -# JAVA OBJECTS -############################################# -#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF# -#JAVA#TAUJAPI = Profile.class #ENDIF# - - -############################################# -# OpenMP OBJECTS -############################################# -#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF# - -############################################# -# Opari OBJECTS -############################################# -#OPARI#OPARI_O = TauOpari.o #ENDIF# -#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF# -#EPILOG#OPARI_O = #ENDIF# -#VAMPIRTRACE#OPARI_O = #ENDIF# -#GNU#OPARI_O = #ENDIF# - -############################################# -# CallPath OBJECTS -############################################# -#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF# -#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF# - -############################################# -# Python Binding OBJECTS -############################################# -#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF# - -############################################# -# DYNINST DEFAULT ARCH -############################################# -DYNINST_PLATFORM = $(PLATFORM) - - -#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF# - -############# OpenMP Fortran Option ######## -#OPENMP#TAU_F90_OPT = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF# -#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF# -#GUIDE#TAU_F90_OPT = #ENDIF# -#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF# -#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF# -#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF# - -#THREADSAFE_COMPILERS#TAU_R =_r #ENDIF# - -############# Fortran Compiler ############# -#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#BGP#TAU_F90 = bgxlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF##PGI_FORTRAN# -#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF##PGI_CATAMOUNT# -#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# - - -############# Portable F90 Options ############# -#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -#IBM_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -#IBM_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF# -#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# - -############# Profiling Options ############# -PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE# -#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF# -#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF# -#PCL#PCL_O = PclLayer.o #ENDIF# -#PAPI#PAPI_O = PapiLayer.o #ENDIF# -#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF# -#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF# -#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF# -#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF# -PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB# -#CRAYX1CC#PROFILEOPT7 = #ENDIF# -#CRAYCC#PROFILEOPT7 = #ENDIF# -#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF# -#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF# -#RTTI#PROFILEOPT9 = -DRTTI #ENDIF# -#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF# -#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF# -#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF# -#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF# -#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF# -#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF# -#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF# -#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF# -#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF# -#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF# -#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF# -#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF# -#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF# -#TRACE#TRACEOPT = -DTRACING_ON #ENDIF# -#TRACE#EVENTS_O = Tracer.o #ENDIF# -#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF# -#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF# -#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF# -#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF# -#MPITRACE#EVENTS_O = Tracer.o #ENDIF# -#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF# -#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF# -#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF# -#TAU_SPROC#THR_O = SprocLayer.o #ENDIF# -#JAVA#THR_O = JavaThreadLayer.o #ENDIF# -#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF# -#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF# -#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF# -#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF# -#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF# -#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF##PGI# -#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF# -#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF# -#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF# -#HPGNU#PROFILEOPT21 = -fPIC #ENDIF# -#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF# -#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF# -#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF# -#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF# -#USE_IBMXLC#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF# -#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF# -#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF# -#JAVA#PROFILEOPT23 = -DJAVA #ENDIF# -#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF# -#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF# -PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI# -PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED# -#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF# -#GNU#PROFILEOPT27 = #ENDIF# -#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF# -#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF# -#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF# -#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF# -#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF# -#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF# -#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF# -#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF# -#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF# -#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF# -#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF# -#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF# -#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF# -#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF# -#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF# -#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF# -#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF# -#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF# -#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF# -#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF# -#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF# -#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF# -#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF# -#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF# -#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF# -#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF# -#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF# -#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF# -#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF# -# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore -#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF# -PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST# -#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF# -PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP# -PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER# -PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF##CATAMOUNT# -#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF# -PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR# -PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX# -PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR# -#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF# - -#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF# -#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF# -#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF# -#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE# -#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF# -#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF# -#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF# -#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF# -PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF##WEAKMPIINIT# -#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF# -PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##MPICH_IGNORE_CXX_SEEK# -PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF##MPICH2_MPI_INPLACE# - - -############# RENCI Scalable Trace Lib Options ############# -STFF_DIR= -SDDF_DIR= -#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF# -#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF# -#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF# - -############# KTAU (again) ############# -#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF# - -#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF# - -#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# - -#For F90 support for all platforms -FWRAPPER = TauFMpi.o -MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2# -#CRAYX1CC#MPI2EXTENSIONS = #ENDIF# - -#SGICOUNTERS#LEXTRA = -lperfex #ENDIF# -#ALPHATIMERS#LEXTRA = -lrt #ENDIF# -#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF# -#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF# -#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# -#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF# -#PAPIPFM#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF# -#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF# -#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF# -#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF# -#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF# -#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF# -#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF# - - - -# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis. -#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#PAPI##TAU_PAPI_RPATH = #ENDIF# -#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF# -#BGLPAPI#TAU_PAPI_RPATH = #ENDIF# -#BGPPAPI#TAU_PAPI_RPATH = #ENDIF# -#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF# -#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF# -TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF##PGI# -#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF# - -# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath -# because they are likely going to link with ifort -#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF# -#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF# -#IBMPAPI#TAU_PAPI_RPATH = #ENDIF# -#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF# -#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF# - -#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF# -#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF# -#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF# -#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF# - -TAU_GCCLIB = -lgcc_s -#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF# -#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF# -#BGL#TAU_GCCLIB = -lgcc #ENDIF# -#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF# -#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF# -#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF# -#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF# -#GNU_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF# -#USE_IBMXLC#TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#IBM_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF# - -#USE_IBMXLC#TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF# -#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF# -#IBM_FORTRAN#TAU_FORLIBDIR=lib #ENDIF# -#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF# -#BGP#TAU_FORLIBDIR=bglib #ENDIF# -#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF# -#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#BGP#TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF# -#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF# -#BGP#TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF# -#BGP#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF# - -#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF##PGI_FORTRAN# -#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF# -#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF# -#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF# -#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF# -#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF# -#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF# -# LINKER OPTIONS -TAU_LINKER_OPT2 = $(LEXTRA) - - -#ACC#TAUHELPER = -AA #ENDIF# -#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF# -#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF# -#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF# -#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF# -#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF# -#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF# -#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF# -#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF# -#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF# -#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF# -#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF# - - -#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF# - -## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add -#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF# -#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF# -#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -TAU_CXXLIBS = -lstd -lC #ENDIF##PGI# -#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF# -#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF# - -TAU_SGI_INIT = /usr/lib32/c++init.o -#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF# -#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF# -#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF# - -#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF# -#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF# -#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF# -#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF# -#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF# -#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF# -#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF# -#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF# -#BGP#TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF# -#SP1#TAU_XLCLIBS = -lC #ENDIF# -#USE_IBMXLC#TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF# -#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF# -#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF# - -# EXTERNAL PACKAGES: VAMPIRTRACE -#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# - -# EXTERNAL PACKAGES: EPILOG -#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# - -# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up -#FORCESHARED#TAU_LINKER_OPT3=#ENDIF# - -TAU_LINKER_OPT4 = $(LEXTRA1) -#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF# -#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF# -#GNU#TAU_LINKER_OPT5 = #ENDIF# -#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF# -#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#GUIDE#TAU_LINKER_OPT5 = #ENDIF# -#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF# - -# MALLINFO needs -lmalloc on sgi, sun -#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SOL2#TAU_LINKER_OPT6 = #ENDIF# -#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF# - -# We need -lCio with SGI CC 7.4+ -#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF# - -# charm -#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF# - -# extra libs -#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF# - -#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF# - -#USE_IBMXLC#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF# -#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF# - -#USE_IBMXLC#TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF# -#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF# -#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF# - - -#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF# -#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF# -#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF# -#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF# -#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF# -#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF# - -TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI# -#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# -#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# - -############################################## -# Build TAU_LINKER_SHOPTS -#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF# -#USE_IBMXLC#TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF# -#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF# -#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF# - -############################################## -# MPI _r suffix check (as in libmpi_r) -#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF# - -############################################## -# Flags to build a shared object: TAU_SHFLAGS -#GNU#AR_SHFLAGS = -shared #ENDIF# -AR_SHFLAGS = -shared #ENDIF##PGI# -#SGICC#AR_SHFLAGS = -shared #ENDIF# -#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF# -#SOL2#AR_SHFLAGS = -G #ENDIF# -#SUN386I#AR_SHFLAGS = -G #ENDIF# -#SUNX86_64#AR_SHFLAGS = -G #ENDIF# -#USE_IBMXLC#AR_SHFLAGS = -G #ENDIF# -#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF# -#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF# -#ACC#AR_SHFLAGS = -b #ENDIF# -TAU_SHFLAGS = $(AR_SHFLAGS) -o - -############# RANLIB Options ############# -TAU_RANLIB = echo "Built" -#APPLECXX#TAU_RANLIB = ranlib #ENDIF# -#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF# - -############################################## -TAU_AR = ar #ENDIF# -#SP1#TAU_AR = ar -X32 #ENDIF# -#IBM64#TAU_AR = ar -X64 #ENDIF# -#PPC64#TAU_AR = ar #ENDIF# -#IBM64LINUX#TAU_AR = ar #ENDIF# - - -############################################## -# PDT OPTIONS -# You can specify -pdtcompdir=intel -pdtarchdir=x86_64 -# If nothing is specified, PDTARCHDIR uses TAU_ARCH -PDTARCHDIRORIG=$(TAU_ARCH) -PDTARCHITECTURE=x86_64 -PDTARCHDIRFINAL=$(PDTARCHDIRORIG) -#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF# -PDTARCHDIR=$(PDTARCHDIRFINAL) -#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF# - - -############################################## - -PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \ - $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \ - $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \ - $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \ - $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \ - $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \ - $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \ - $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \ - $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \ - $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \ - $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \ - $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \ - $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \ - $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \ - $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \ - $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \ - $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \ - $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \ - $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \ - $(TRACEOPT) - -############################################## - -TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \ - $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \ - $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \ - $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12) - -############################################## - -############# TAU Fortran #################### -TAU_LINKER=$(TAU_CXX) -#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -# Intel efc compiler acts as a linker - NO. Let C++ be the linker. - -############################################## -############# TAU Options #################### -TAUDEFS = $(PROFILEOPTS) - -TAUINC = -I$(TAU_INC_DIR) - -TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAUMPILIBS = $(TAU_MPI_LIB) - -TAUMPIFLIBS = $(TAU_MPI_FLIB) - -### ACL S/W requirement -TAU_DEFS = $(TAUDEFS) - -TAU_INCLUDE = -I$(TAU_INC_DIR) -#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF# -#PERFLIB#TAU_DEFS = #ENDIF# -#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF# - -TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory -#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# -#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# - -TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) -#PERFLIB#TAU_LIBS = #ENDIF# - -TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) -#PERFLIB#TAU_SHLIBS = #ENDIF# -TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) - -TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable - -TAU_MPI_INCLUDE = $(TAU_MPI_INC) - -TAU_MPI_LIBS = $(TAU_MPI_LIB) - -TAU_MPI_FLIBS = $(TAU_MPI_FLIB) - -## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL) -TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG) - -## Don't include -lpthread or -lsmarts. Let app. do that. -############################################# -## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS -#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF# -TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI# -#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF# -#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF# -TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI# -TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI# -TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI# -TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI# - -#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF# -#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF# -############################################# -#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF# -#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF# -#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF# - -TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC) - -TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB) -############################################# -# TAU COMPILER SHELL SCRIPT OPTIONS -TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\ - -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \ - -optNoMpi \ - -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \ - -optTauCC="$(TAU_CC)" \ - -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \ - -optTauDefs="$(TAU_DEFS)" \ - -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\ - -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - $(TAU_COMPILER_EXTRA_OPTIONS) \ - -optIncludeMemory="$(TAU_INCLUDE_MEMORY)" -############################################# - -TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) -SHAREDEXTRAS= -#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF# -TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS) -############################################# -# These options could be included in the application Makefile as -#CFLAGS = $(TAUDEFS) $(TAUINC) -# -#LIBS = $(TAULIBS) -# -# To run the application without Profiling/Tracing use -#CFLAGS = $(TAUINC) -# Don't use TAUDEFS but do include TAUINC -# Also ignore TAULIBS when Profiling/Tracing is not used. -############################################# - diff --git a/source/unres/src_MD-M/Makefile_aix_xlf b/source/unres/src_MD-M/Makefile_aix_xlf deleted file mode 100644 index 8fe4624..0000000 --- a/source/unres/src_MD-M/Makefile_aix_xlf +++ /dev/null @@ -1,112 +0,0 @@ -CPPFLAGS = -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DSPLITELE -WF,-DISNAN -WF,-DAIX -#-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -INSTALL_DIR = -# -FC= mpxlf90 -qfixed -w - -OPT = -q64 - -FFLAGS = -c ${OPT} -O3 -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_MD.exe -LIBS = -qipa - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o REMD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure.o gnmr1.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F diff --git a/source/unres/src_MD-M/Makefile_bigben b/source/unres/src_MD-M/Makefile_bigben deleted file mode 100644 index 8d961fa..0000000 --- a/source/unres/src_MD-M/Makefile_bigben +++ /dev/null @@ -1,138 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = ${OPT} -#OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \ -#-DTIMING \ -#-DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DPARVEC #-DPARINT -DPARINTDER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile_bigben-oldparm b/source/unres/src_MD-M/Makefile_bigben-oldparm deleted file mode 100644 index 14a4ab4..0000000 --- a/source/unres/src_MD-M/Makefile_bigben-oldparm +++ /dev/null @@ -1,136 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split-oldparm.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile_bigben-tau b/source/unres/src_MD-M/Makefile_bigben-tau deleted file mode 100644 index ee02905..0000000 --- a/source/unres/src_MD-M/Makefile_bigben-tau +++ /dev/null @@ -1,137 +0,0 @@ -# -#FC= ftn -TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi -FC=tau_f90.sh -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-noparint-barrier-tau.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.pp.[fF] *.pp.inst.[fF] - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile_intrepid b/source/unres/src_MD-M/Makefile_intrepid deleted file mode 100644 index 2b57f9e..0000000 --- a/source/unres/src_MD-M/Makefile_intrepid +++ /dev/null @@ -1,151 +0,0 @@ -# -FC=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -OPT = -O4 -qarch=450 -qtune=450 -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -#OPT = -O -qarch=450 -qtune=450 -#OPT = -O0 -C -g -qarch=450 -qtune=450 #-qdebug=function_trace -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT1 = -O -g -qarch=450 -qtune=450 -#OPT1 = -O -g -qarch=450 -qtune=450 -qdebug=function_trace -OPT1 = ${OPT} -#OPT2 = -O2 -qarch=450 -qtune=450 -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -OPT2 = ${OPT} -#OPTE = -O4 -qarch=450 -qtune=450 -#OPTE = -O4 -qarch=450 -qtune=450 -OPTE=${OPT} - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-O4-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-PARINT-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-parvecmatint-O4-notau1.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-notau1.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 -#-WF,-DPARINT -WF,-DPARINTDER -#-WF,-DPARVEC -WF,-DPARMAT -WF,-DMATGATHER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -obj: ${object} - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -compinfo: compinfo.c - ${CC} ${CFLAGS} compinfo.c diff --git a/source/unres/src_MD-M/Makefile_jubl b/source/unres/src_MD-M/Makefile_jubl deleted file mode 100644 index 9524cd6..0000000 --- a/source/unres/src_MD-M/Makefile_jubl +++ /dev/null @@ -1,132 +0,0 @@ -CPPFLAGS = -WF,-DOLD_GINV \ - -WF,-DUNRES -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DISNAN \ - -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -#-WF,-DNOXDR -#-WF,-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc -FC = /usr/bin/blrts_xlf90 -#-pg -g - -# try -qarch=440 first, then use -qarch=440d for 2nd FPU later on -# (SIMDization requires at least -O3) -# use -qlist -qsource with 440d and look for Parallel ASM instructions. -# -OPT= -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -qfixed -w -qnosave -CFLAGS= -O3 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -FFLAGS= -c -O3 ${OPT} -# -LIBS_MPI = -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts -LIBSF_MPI = -lmpich.rts -lfmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts - -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_Tc_procor_150aa.rts -#BIN = ${HOME}/UNRES/bin/unres_Tc_oldginv_noprocor.rts -LIBS = ${LIBSF_MPI} xdrf/libxdrf.a -#LIBS = ${LIBSF_MPI} - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure.o gnmr1.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - diff --git a/source/unres/src_MD-M/Makefile_jubl-debug b/source/unres/src_MD-M/Makefile_jubl-debug deleted file mode 100644 index d2d6c47..0000000 --- a/source/unres/src_MD-M/Makefile_jubl-debug +++ /dev/null @@ -1,141 +0,0 @@ -CPPFLAGS = -WF,-DOLD_GINV \ - -WF,-DUNRES -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DISNAN \ - -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -#-WF,-DNOXDR -#-WF,-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc -FC = /usr/bin/blrts_xlf90 -#-pg -g - -# try -qarch=440 first, then use -qarch=440d for 2nd FPU later on -# (SIMDization requires at least -O3) -# use -qlist -qsource with 440d and look for Parallel ASM instructions. -# -OPT= -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -qfixed -w -qnosave -CFLAGS= -O3 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -FFLAGS= -c -O3 ${OPT} -FFLAGS= -c -C -g ${OPT} -# -LIBS_MPI = -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts -LIBSF_MPI = -lmpich.rts -lfmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts - -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_Tc_procor_150aa_newparm.rts -LIBS = ${LIBSF_MPI} xdrf/libxdrf.a -#LIBS = ${LIBSF_MPI} - -ARCH = LINUX -PP = /lib/cpp -P - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -eigen.o : eigen.f - ${FC} ${FFLAGS2} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS2} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS2} ${CPPFLAGS} add.f diff --git a/source/unres/src_MD-M/Makefile_jubl-opt b/source/unres/src_MD-M/Makefile_jubl-opt deleted file mode 100644 index b89fe31..0000000 --- a/source/unres/src_MD-M/Makefile_jubl-opt +++ /dev/null @@ -1,117 +0,0 @@ -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 -#-WF,-DTIMING_ENE -WF,-DTIMING -# -WF,-DCRYST_BOND -WF,-DCRYST_THETA -WF,-DCRYST_SC - - -#FC= mpixlf77 -pg -FC= mpixlf77 -CC= bgcc - -OPT = -O3 -qarch=450d -qtune=450 - -FFLAGS = -c ${OPT} -FFLAGS1 = -c -g -O3 -qarch=450d -qtune=450 -FFLAGS2 = -c -g -O0 -qarch=450d -qtune=450 -FFLAGSE = -c -O4 -qipa -Q+scalar -qhot=simd -qarch=450d -qtune=450 - -BIN = ../bin/unres_Tc_procor_new800_jugene.exe -LIBS = xdrf/libxdrf.a -qipa - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -fitsq.o : fitsq.f - ${FC} ${FFLAGS2} fitsq.f diff --git a/source/unres/src_MD-M/Makefile_jubl-opt-oldparm b/source/unres/src_MD-M/Makefile_jubl-opt-oldparm deleted file mode 100644 index 4c883a9..0000000 --- a/source/unres/src_MD-M/Makefile_jubl-opt-oldparm +++ /dev/null @@ -1,116 +0,0 @@ -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 \ - -WF,-DCRYST_BOND -WF,-DCRYST_THETA -WF,-DCRYST_SC -WF,-DTIMING_ENE - - -#FC= mpixlf77 -pg -FC= mpixlf77 -CC= bgcc - -OPT = -O3 -qarch=450d -qtune=450 - -FFLAGS = -c ${OPT} -FFLAGS1 = -c -g -O3 -qarch=450d -qtune=450 -FFLAGS2 = -c -g -O0 -qarch=450d -qtune=450 -FFLAGSE = -c -O4 -qipa -Q+scalar -qhot=simd -qarch=450d -qtune=450 - -BIN = ../bin/unres_Tc_procor_new700_jugene-oldparm.exe -LIBS = xdrf/libxdrf.a -qipa - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -fitsq.o : fitsq.f - ${FC} ${FFLAGS2} fitsq.f diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc b/source/unres/src_MD-M/Makefile_lnx_ifc deleted file mode 100644 index fa4db65..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc +++ /dev/null @@ -1,104 +0,0 @@ -# mpich def -INSTALL_DIR = /usr/local/mpich-1.2.0 -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifc -OPT = -O3 -ip -w -pc64 -tpp6 - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -tpp6 -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -tpp6 -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -tpp6 -w -O3 -ipo -ipo_obj -pc64 -opt_report -I$(INSTALL_DIR)/include - -BIN = ${HOME}/UNRES/NEW/bin/unres_ifc8.exe -LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -openmp -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o entmcm.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o proc_proc.o mcmf.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o -#fputrap.o zscore.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -Wl,-Bstatic -o ${BIN} - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.f - ${FC} ${FFLAGS} ${CPPFLAGS} test.f - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64 b/source/unres/src_MD-M/Makefile_lnx_ifc10_em64 deleted file mode 100644 index f2b013d..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64 +++ /dev/null @@ -1,128 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = unres_Tc_procor_new_em64.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure3.o econstr_local.o gnmr1.o check_sc_map.o check_bond.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} -static-libcxa ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - mv ${BIN} ../bin - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -readrtns_CSA.o : readrtns_CSA.F - ${FC} ${FFLAGS1} ${CPPFLAGS} readrtns_CSA.F - -MREMD.o : MREMD.F - ${FC} ${FFLAGS1} ${CPPFLAGS} MREMD.F - diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera b/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera deleted file mode 100644 index cf0d3a5..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera +++ /dev/null @@ -1,130 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -INSTALL_DIR = /opt/mpi/mvapich -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 -CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_new_em64-lang-D-1000.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unresCSA: ${object} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -readrtns_CSA.o : readrtns_CSA.F - ${FC} ${FFLAGS1} ${CPPFLAGS} readrtns_CSA.F - -MREMD.o : MREMD.F - ${FC} ${FFLAGS1} ${CPPFLAGS} MREMD.F - -fitsq.o : fitsq.f - ${FC} ${FFLAGS2} fitsq.f diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera-oldparm b/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera-oldparm deleted file mode 100644 index 4efcbee..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_galera-oldparm +++ /dev/null @@ -1,131 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN -DAMD64 \ - -DPROCOR \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/ -INSTALL_DIR = /opt/mpi/mvapich -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort -FCL = ${INSTALL_DIR}/bin/mpif77 -CC = cc - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_Tc_procor_new_em64-lang-oldparm-D-1000.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpthread xdrf_em64/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unresCSA: ${object} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FCL} -static-libcxa ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -readrtns_CSA.o : readrtns_CSA.F - ${FC} ${FFLAGS1} ${CPPFLAGS} readrtns_CSA.F - -MREMD.o : MREMD.F - ${FC} ${FFLAGS1} ${CPPFLAGS} MREMD.F - -fitsq.o : fitsq.f - ${FC} ${FFLAGS2} fitsq.f diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_mpi2 b/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_mpi2 deleted file mode 100644 index c9228ca..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc10_em64_mpi2 +++ /dev/null @@ -1,146 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -#INSTALL_DIR = /users/software/mpich2.x86_64/ -INSTALL_DIR = /opt/mpi/mvapich2 - -FC= ifort -FCL= ${INSTALL_DIR}/bin/mpif77 - -OPT = -O3 -ip -w -xO - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -xO -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_mpich2-lang.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FCL} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-M/Makefile_lnx_ifc8 b/source/unres/src_MD-M/Makefile_lnx_ifc8 deleted file mode 100644 index 5b5eeee..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_ifc8 +++ /dev/null @@ -1,127 +0,0 @@ -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI \ - -DPGI -DSPLITELE -DISNAN \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -## -DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -#INSTALL_DIR = /usr/local/mpich-1.2.0 -INSTALL_DIR = /usr/local/mpich-1.2.7p1_intel-8.0_ssh -# -#FC= /usr/local/opt/intel/compiler60/ia32/bin/ifc -FC= ifort - -OPT = -O3 -ip -w -pc64 -tpp6 - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -tpp6 -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -tpp6 -w -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -tpp6 -w -O3 -ipo -ipo_obj -pc64 -opt_report -I$(INSTALL_DIR)/include - -BIN = unres_Tc_noprocor.exe -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_ifort -lmpich xdrf/libxdrf.a -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -g -d2 -CA -CB - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure3.o econstr_local.o gnmr1.o check_sc_map.o check_bond.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} -static-libcxa ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - mv ${BIN} ../bin - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -readrtns_CSA.o : readrtns_CSA.F - ${FC} ${FFLAGS1} ${CPPFLAGS} readrtns_CSA.F - -MREMD.o : MREMD.F - ${FC} ${FFLAGS1} ${CPPFLAGS} MREMD.F - diff --git a/source/unres/src_MD-M/Makefile_lnx_pgf90 b/source/unres/src_MD-M/Makefile_lnx_pgf90 deleted file mode 100644 index 844c8c6..0000000 --- a/source/unres/src_MD-M/Makefile_lnx_pgf90 +++ /dev/null @@ -1,120 +0,0 @@ -FC= mpif90 -OPT = -fast -pc 64 -tp p6 \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 -#OPT = -C -g -fast -pc 64 -tp p6 - -OPT1 = -C -g -fast -pc 64 -tp p6 -#OPT = -C -g - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -CFLAGS = -DSGI -FFLAGS = -c ${OPT} -FFLAGS1 = -c ${OPT1} - -BIN = /users/adam/MEY_MD/bin/unres_MD_Tc-fine-newmat.exe -LIBS = -Lxdrf -lxdrf -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC #-DPARINT -DPARINTDER -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -Wl,-Bstatic -o ${BIN} - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS1} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS1} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS1} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -fitsq.o: fitsq.f - ${FC} ${FFLAGS1} ${CPPFLAGS} fitsq.f - -rmsd.o: rmsd.F - ${FC} ${FFLAGS1} ${CPPFLAGS} rmsd.F - -contact.o: contact.f - ${FC} ${FFLAGS1} ${CPPFLAGS} contact.f - -minim_jlee.o: minim_jlee.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minim_jlee.F - -minimize_p.o: minimize_p.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minimize_p.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F - - -test.o: test.F - ${FC} ${FFLAGS1} ${CPPFLAGS} test.F - -elecont.o: elecont.f - ${FC} ${FFLAGS} ${CPPFLAGS} elecont.f - -eigen.o : eigen.f - ${FC} ${FFLAGS} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS} ${CPPFLAGS} add.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -compinfo: compinfo.c - ${CC} ${CFLAGS} compinfo.c diff --git a/source/unres/src_MD-M/Makefile_osf_f90 b/source/unres/src_MD-M/Makefile_osf_f90 deleted file mode 100644 index f9fa711..0000000 --- a/source/unres/src_MD-M/Makefile_osf_f90 +++ /dev/null @@ -1,79 +0,0 @@ -# -FC= f90 -OPT = -arch ev67 -tune ev67 -fast -fpe1 -f77 -OPT1 = -arch ev67 -tune ev67 -fast -fpe1 -f77 -#OPT1 = -fast -g3 -arch ev67 -fpe4 -f77 -C -#OPT = -g3 -arch ev67 -tune ev67 -C -fpe1 -f77 - -FFLAGS = -c ${OPT} -FFLAGS1 = -c ${OPT1} - -BIN = ${HOME}/UNRES/MD/bin/unres_MD_procor-Tc.exe -LIBS = -lmpi -lelan xdrf/libxdrf.a -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI -DOSF -DSPLITELE -DPROCOR -DISNAN -#CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI -DOSF -DISNAN -DSPLITELE -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F -.c.o: - ${CC} -c ${CPPFLAGS} $*.c - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split.o \ - q_measure.o gnmr1.o - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -together.o: together.F - ${FC} ${FFLAGS1} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS1} ${CPPFLAGS} test.F - -elecont.o: elecont.f - ${FC} ${FFLAGS} ${CPPFLAGS} elecont.f - -gen_rand_conf.o:gen_rand_conf.F - ${FC} ${FFLAGS1} ${CPPFLAGS} gen_rand_conf.F - -djacob.o: djacob.f - ${FC} ${FFLAGS1} ${CPPFLAGS} djacob.f - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS1} ${CPPFLAGS} chainbuild.F -cartder.o: cartder.F - ${FC} ${FFLAGS1} ${CPPFLAGS} cartder.F - diff --git a/source/unres/src_MD-M/Makefile_win_ifl b/source/unres/src_MD-M/Makefile_win_ifl deleted file mode 100644 index 309718c..0000000 --- a/source/unres/src_MD-M/Makefile_win_ifl +++ /dev/null @@ -1,53 +0,0 @@ -CC= icl.exe -FC= ifl.exe - -FFLAGS = /Qlowercase /c /Qip /Qfpp2 /Ox /G6 /w90 /w /cm /DUNRES /DMOMENT /DMP /DMPI /DPGI /DWINIFL -CCFLAGS = /c /Qlowercase /DUNRES /DMOMENT /DMP /DMPI /DPGI /DWIN /DWINIFL -LDFLAGS = /ounres_ifl.exe C:\\Progra~1\\MPIPro\\lib\\MPIPro.lib \ - C:\\Progra~1\\MPIPro\\lib\\MPIPro_abs.lib - -all: unresCSA - -.SUFFIXES: .f .c - -.f.o: - $(FC) $(FFLAGS) $*.f - touch $*.o -.F.o: - $(FC) $(FFLAGS) $*.F - touch $*.o -.c.o: - $(CC) $(CCFLAGS) $*.c - touch $*.o - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o entmcm.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o proc_proc.o mcmf.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o -#fputrap.o zscore.o - -objectCSAobj = unres_CSA.obj arcos.obj cartprint.obj chainbuild.obj convert.obj initialize_p.obj \ - matmult.obj readrtns_CSA.obj parmread.obj gen_rand_conf.obj printmat.obj map.obj \ - pinorm.obj randgens.obj rescode.obj intcor.obj timing.obj misc.obj intlocal.obj \ - cartder.obj checkder_p.obj energy_p_new.obj gradient_p.obj minimize_p.obj sumsld.obj \ - cored.obj rmdd.obj geomout.obj readpdb.obj regularize.obj thread.obj fitsq.obj mcm.obj \ - mc.obj bond_move.obj refsys.obj check_sc_distr.obj contact.obj djacob.obj entmcm.obj \ - together.obj csa.obj minim_jlee.obj shift.obj diff12.obj bank.obj newconf.obj ran.obj \ - indexx.obj MP.obj compare_s1.obj prng_32.obj proc_proc.obj mcmf.obj \ - test.obj banach.obj distfit.obj rmsd.obj elecont.obj dihed_cons.obj - -unresCSA: $(objectCSA) - $(FC) $(FFLAGS) cinfo.f - $(FC) $(LDFLAGS) $(objectCSAobj) cinfo.obj -link: - $(FC) $(LDFLAGS) $(objectCSAobj) cinfo.obj - -clean: - del *.obj - del *.o - diff --git a/source/unres/src_MD-M/Makefile_win_pgf90 b/source/unres/src_MD-M/Makefile_win_pgf90 deleted file mode 100644 index e5530ba..0000000 --- a/source/unres/src_MD-M/Makefile_win_pgf90 +++ /dev/null @@ -1,43 +0,0 @@ -CC= pgcc -FC= pgf90 -OPT = -fast -pc 64 -tp p6 \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 - -#FFLAGS = -c $(OPT) -Ic:/progra~1/mpipro/include -FFLAGS = -c $(OPT) -Ih:/users/czarek/mpipro/include - -LIBS = c:/progra~1/mpipro/lib/MPIPro_pgf.lib \ - c:/progra~1/mpipro/lib/MPIPro.lib - -CPPFLAGS = -DUNRES -DMP -DMPI -DPGI -DWINPGI -#-DMOMENT -#-DCRYST_TOR -#-DDEBUG - -all: unresCSA - -.SUFFIXES: .F -.F.o: - $(FC) $(FFLAGS) $(CPPFLAGS) $*.F -.c.o: - $(CC) -c $(CPPFLAGS) $*.c - - -objectCSA = unres_CSA.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o energy_p_new.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o contact.o djacob.o entmcm.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o proc_proc.o mcmf.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o -#fputrap.o - -unresCSA: $(objectCSA) - $(FC) $(FFLAGS) cinfo.f - $(FC) $(OPT) $(objectCSA) cinfo.o $(LIBS) -o unres_pg - -clean: - /bin/rm *.o - diff --git a/source/unres/src_MD-M/arcos.f b/source/unres/src_MD-M/arcos.f index f054118..1e355ec 100644 --- a/source/unres/src_MD-M/arcos.f +++ b/source/unres/src_MD-M/arcos.f @@ -1,4 +1,4 @@ - FUNCTION ARCOS(X) + double precision FUNCTION ARCOS(X) implicit real*8 (a-h,o-z) include 'COMMON.GEO' IF (DABS(X).LT.1.0D0) GOTO 1 diff --git a/source/unres/src_MD-M/bank.F b/source/unres/src_MD-M/bank.F index 5636ba0..906d355 100644 --- a/source/unres/src_MD-M/bank.F +++ b/source/unres/src_MD-M/bank.F @@ -612,7 +612,7 @@ c--------------------------------------- include 'COMMON.CHAIN' include 'COMMON.GEO' -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open(icsa_bank1,file=csa_bank1,position="append") #else open(icsa_bank1,file=csa_bank1,access="append") diff --git a/source/unres/src_MD-M/bigsymbols-lang0.txt b/source/unres/src_MD-M/bigsymbols-lang0.txt deleted file mode 100644 index 54c4d37..0000000 --- a/source/unres/src_MD-M/bigsymbols-lang0.txt +++ /dev/null @@ -1,7 +0,0 @@ -contacts_hb_ 0x4e483c0 unres.o -contdistrib_ 0x2c0944c unres.o -dipmat_ 0xafc8000 unres.o -lagrange_ 0x1085e2b8 unres.o -langforc_ 0x582a594 readrtns_CSA.o -links_ 0x107035c unres.o -przechowalnia_ 0x7080000 MREMD.o diff --git a/source/unres/src_MD-M/brown_step.F b/source/unres/src_MD-M/brown_step.F index 0be97f5..49652b8 100644 --- a/source/unres/src_MD-M/brown_step.F +++ b/source/unres/src_MD-M/brown_step.F @@ -381,6 +381,7 @@ c Calculate energy and forces potE=potEcomp(0)-potEcomp(20) call cartgrad totT=totT+d_time + totTafm=totT c Calculate the kinetic and total energy and the kinetic temperature call kinetic(EK) #ifdef MPI diff --git a/source/unres/src_MD-M/chainbuild.F b/source/unres/src_MD-M/chainbuild.F index 45a1a53..1261b4a 100644 --- a/source/unres/src_MD-M/chainbuild.F +++ b/source/unres/src_MD-M/chainbuild.F @@ -12,13 +12,37 @@ C include 'COMMON.IOUNITS' include 'COMMON.NAMES' include 'COMMON.INTERACT' - logical lprn + double precision e1(3),e2(3),e3(3) + logical lprn,perbox,fail C Set lprn=.true. for debugging lprn = .false. + perbox=.false. + fail=.false. + call chainbuild_cart + return + end +C#ifdef DEBUG +C if (perbox) then +C first three CAs and SC(2). C -C Define the origin and orientation of the coordinate system and locate the -C first three CA's and SC(2). + subroutine chainbuild_extconf +C +C Build the virtual polypeptide chain. Side-chain centroids are moveable. +C As of 2/17/95. C + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.LOCAL' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + double precision e1(3),e2(3),e3(3) + logical lprn /.false./,perbox,fail + +c write (iout,*) "Calling chainbuild_extconf" call orig_frame * * Build the alpha-carbon chain. @@ -43,6 +67,12 @@ C if (lprn) then call cartprint + write (iout,*) 'dc_norm' + do i=1,nres + write (iout,'(a3,1x,i3,3f10.5,5x,3f10.5)') + & restyp(itype(i)),i,(dc_norm(j,i),j=1,3), + & (dc_norm(j,i+nres),j=1,3) + enddo write (iout,'(/a)') 'Recalculated internal coordinates' do i=2,nres-1 do j=1,3 @@ -58,10 +88,11 @@ C enddo 1212 format (a3,'(',i3,')',2(f10.5,2f10.2)) +C endif endif - return end +C#endif c------------------------------------------------------------------------- subroutine orig_frame C @@ -126,13 +157,86 @@ C dc_norm(3,1)=0.0D0 do j=1,3 dc_norm(j,2)=prod(j,1,2) - dc(j,2)=vbld(3)*prod(j,1,2) - c(j,3)=c(j,2)+dc(j,2) + dc(j,2)=vbld(3)*prod(j,1,2) + c(j,3)=c(j,2)+dc(j,2) enddo call locate_side_chain(2) return end c----------------------------------------------------------------------------- + subroutine locate_prev_res(i) +C +C Locate CA(i) and SC(i-1) +C + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.LOCAL' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.IOUNITS' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' +C +C Define the rotation matrices corresponding to CA(i) +C +#ifdef OSF + theti=theta(i+2) + if (theti.ne.theti) theti=100.0 + phii=phi(i+3) + if (phii.ne.phii) phii=180.0 +#else + theti=theta(i+2) + phii=phi(i+3) +#endif + cost=dcos(theti) + sint=dsin(theti) + cosphi=dcos(phii) + sinphi=dsin(phii) +* Define the matrices of the rotation about the virtual-bond valence angles +* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this +* program), R(i,j,k), and, the cumulative matrices of rotation RT + t(1,1,i+2)=-cost + t(1,2,i+2)=-sint + t(1,3,i+2)= 0.0D0 + t(2,1,i+2)=-sint + t(2,2,i+2)= cost + t(2,3,i+2)= 0.0D0 + t(3,1,i+2)= 0.0D0 + t(3,2,i+2)= 0.0D0 + t(3,3,i+2)= 1.0D0 + r(1,1,i+2)= 1.0D0 + r(1,2,i+2)= 0.0D0 + r(1,3,i+2)= 0.0D0 + r(2,1,i+2)= 0.0D0 + r(2,2,i+2)=-cosphi + r(2,3,i+2)= sinphi + r(3,1,i+2)= 0.0D0 + r(3,2,i+2)= sinphi + r(3,3,i+2)= cosphi + rt(1,1,i+2)=-cost + rt(1,2,i+2)=-sint + rt(1,3,i+2)=0.0D0 + rt(2,1,i+2)=sint*cosphi + rt(2,2,i+2)=-cost*cosphi + rt(2,3,i+2)=sinphi + rt(3,1,i+2)=-sint*sinphi + rt(3,2,i+2)=cost*sinphi + rt(3,3,i+2)=cosphi + call matmult(prod(1,1,i+2),rt(1,1,i+2),prod(1,1,i+1)) + do j=1,3 + dc_norm(j,i)=-prod(j,1,i+1) + dc(j,i)=-vbld(i)*prod(j,1,i+1) + c(j,i)=c(j,i+1)+dc(j,i) + enddo +cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i+1),j=1,3),(c(j,i),j=1,3) +C +C Now calculate the coordinates of SC(i+1) +C + call locate_side_chain(i+1) + return + end +c----------------------------------------------------------------------------- subroutine locate_next_res(i) C C Locate CA(i) and SC(i-1) @@ -272,3 +376,255 @@ cd & xp,yp,zp,(xx(k),k=1,3) enddo return end +c------------------------------------------ + subroutine returnbox + include 'DIMENSIONS' +#ifdef MPI + include 'mpif.h' +#endif + include 'COMMON.CONTROL' + include 'COMMON.VAR' + include 'COMMON.MD' +#ifndef LANG0 + include 'COMMON.LANGEVIN' +#else + include 'COMMON.LANGEVIN.lang0' +#endif + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.NAMES' + include 'COMMON.TIME1' + include 'COMMON.REMD' + include 'COMMON.SETUP' + include 'COMMON.MUCA' + include 'COMMON.HAIRPIN' +C change suggested by Ana - begin + integer allareout +C change suggested by Ana - end + j=1 + chain_beg=1 +C do i=1,nres +C write(*,*) 'initial', i,j,c(j,i) +C enddo +C change suggested by Ana - begin + allareout=1 +C change suggested by Ana -end + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then + chain_end=i + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxxsize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,chain_end + c(j,k)=c(j,k)-ireturnval*boxxsize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxxsize + enddo +C Suggested by Ana + if (chain_beg.eq.1) + & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize +C Suggested by Ana -end + endif + chain_beg=i+1 + allareout=1 + else + if (int(c(j,i)/boxxsize).eq.0) allareout=0 + endif + enddo + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxxsize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,nres + c(j,k)=c(j,k)-ireturnval*boxxsize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxxsize + enddo + endif +C NO JUMP +C do i=1,nres +C write(*,*) 'befor no jump', i,j,c(j,i) +C enddo + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) +C print *,'diff', difference + if (difference.gt.boxxsize/2.0) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxxsize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxxsize + enddo + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) + if (difference.gt.boxxsize/2.0) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxxsize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxxsize + enddo + +C do i=1,nres +C write(*,*) 'after no jump', i,j,c(j,i) +C enddo + +C NOW Y dimension +C suggesed by Ana begins + allareout=1 +C suggested by Ana ends + j=2 + chain_beg=1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then + chain_end=i + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxysize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,chain_end + c(j,k)=c(j,k)-ireturnval*boxysize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxysize + enddo +C Suggested by Ana + if (chain_beg.eq.1) + & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize +C Suggested by Ana -end + endif + chain_beg=i+1 + allareout=1 + else + if (int(c(j,i)/boxysize).eq.0) allareout=0 + endif + enddo + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxysize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,nres + c(j,k)=c(j,k)-ireturnval*boxysize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxysize + enddo + endif + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) + if (difference.gt.boxysize/2.0) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxysize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxysize + enddo + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) + if (difference.gt.boxysize/2.0) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxysize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxysize + enddo +C Now Z dimension +C Suggested by Ana -begins + allareout=1 +C Suggested by Ana -ends + j=3 + chain_beg=1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1)) then + chain_end=i + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxysize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,chain_end + c(j,k)=c(j,k)-ireturnval*boxzsize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxzsize + enddo +C Suggested by Ana + if (chain_beg.eq.1) + & dc_old(1,0)=dc_old(1,0)-ireturnval*boxxsize +C Suggested by Ana -end + endif + chain_beg=i+1 + allareout=1 + else + if (int(c(j,i)/boxzsize).eq.0) allareout=0 + endif + enddo + if (allareout.eq.1) then + ireturnval=int(c(j,i)/boxzsize) + if (c(j,i).le.0) ireturnval=ireturnval-1 + do k=chain_beg,nres + c(j,k)=c(j,k)-ireturnval*boxzsize + c(j,k+nres)=c(j,k+nres)-ireturnval*boxzsize + enddo + endif + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) + if (difference.gt.(boxzsize/2.0)) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxzsize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxzsize + enddo + nojumpval=0 + do i=2,nres + if (itype(i).eq.ntyp1 .and. itype(i-1).eq.ntyp1) then + difference=abs(c(j,i-1)-c(j,i)) + if (difference.gt.boxzsize/2.0) then + if (c(j,i-1).gt.c(j,i)) then + nojumpval=1 + else + nojumpval=-1 + endif + else + nojumpval=0 + endif + endif + c(j,i)=c(j,i)+nojumpval*boxzsize + c(j,i+nres)=c(j,i+nres)+nojumpval*boxzsize + enddo + + return + end + diff --git a/source/unres/src_MD-M/change.awk b/source/unres/src_MD-M/change.awk deleted file mode 100644 index d192a6e..0000000 --- a/source/unres/src_MD-M/change.awk +++ /dev/null @@ -1,11 +0,0 @@ -{ - if($0==" include 'COMMON.LANGEVIN'") { - print "#ifndef LANG0" - print " include 'COMMON.LANGEVIN'" - print "#else" - print " include 'COMMON.LANGEVIN.lang0'" - print "#endif" - }else{ - print $0 - } -} diff --git a/source/unres/src_MD-M/checkder_p.F b/source/unres/src_MD-M/checkder_p.F index 26854e6..ebfd52b 100644 --- a/source/unres/src_MD-M/checkder_p.F +++ b/source/unres/src_MD-M/checkder_p.F @@ -2,6 +2,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.CONTROL' include 'COMMON.IOUNITS' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -14,8 +15,9 @@ C Check the gradient of Cartesian coordinates in internal coordinates. * Check the gradient of the virtual-bond and SC vectors in the internal * coordinates. * - aincr=1.0d-7 - aincr2=5.0d-8 + print '("Calling CHECK_ECART",1pd12.3)',aincr + write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr + aincr2=0.5d0*aincr call cartder write (iout,'(a)') '**************** dx/dalpha' write (iout,'(a)') @@ -25,7 +27,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. do k=1,3 temp(k,i)=dc(k,nres+i) enddo - call chainbuild + call chainbuild_extconf do k=1,3 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) @@ -34,7 +36,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3) write (iout,'(a)') alph(i)=alphi - call chainbuild + call chainbuild_extconf enddo write (iout,'(a)') write (iout,'(a)') '**************** dx/domega' @@ -45,7 +47,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. do k=1,3 temp(k,i)=dc(k,nres+i) enddo - call chainbuild + call chainbuild_extconf do k=1,3 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr xx(k)=dabs((gg(k)-dxds(k+3,i))/ @@ -55,7 +57,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3) write (iout,'(a)') omeg(i)=omegi - call chainbuild + call chainbuild_extconf enddo write (iout,'(a)') write (iout,'(a)') '**************** dx/dtheta' @@ -68,7 +70,7 @@ C Check the gradient of Cartesian coordinates in internal coordinates. temp(k,j)=dc(k,nres+j) enddo enddo - call chainbuild + call chainbuild_extconf do j=i-1,nres-1 ii = indmat(i-2,j) c print *,'i=',i-2,' j=',j-1,' ii=',ii @@ -83,7 +85,7 @@ c print *,'i=',i-2,' j=',j-1,' ii=',ii enddo write (iout,'(a)') theta(i)=theti - call chainbuild + call chainbuild_extconf enddo write (iout,'(a)') '***************** dx/dphi' write (iout,'(a)') @@ -94,7 +96,7 @@ c print *,'i=',i-2,' j=',j-1,' ii=',ii temp(k,j)=dc(k,nres+j) enddo enddo - call chainbuild + call chainbuild_extconf do j=i-1,nres-1 ii = indmat(i-2,j) c print *,'ii=',ii @@ -108,7 +110,7 @@ c print *,'ii=',ii write(iout,'(a)') enddo phi(i)=phi(i)-aincr - call chainbuild + call chainbuild_extconf enddo write (iout,'(a)') '****************** ddc/dtheta' do i=1,nres-2 @@ -119,7 +121,7 @@ c print *,'ii=',ii temp(k,j)=dc(k,j) enddo enddo - call chainbuild + call chainbuild_extconf do j=i+1,nres-1 ii = indmat(i,j) c print *,'ii=',ii @@ -148,7 +150,7 @@ c print *,'ii=',ii temp(k,j)=dc(k,j) enddo enddo - call chainbuild + call chainbuild_extconf do j=i+2,nres-1 ii = indmat(i+1,j) c print *,'ii=',ii @@ -175,6 +177,7 @@ C---------------------------------------------------------------------------- C Check the gradient of the energy in Cartesian coordinates. implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.IOUNITS' @@ -191,8 +194,8 @@ C Check the gradient of the energy in Cartesian coordinates. nf=0 nfl=0 call zerograd - aincr=1.0D-7 - print '(a)','CG processor',me,' calling CHECK_CART.' + print '("Calling CHECK_ECART",1pd12.3)',aincr + write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr nf=0 icall=0 call geom_to_var(nvar,x) @@ -272,17 +275,20 @@ C Check the gradient of the energy in Cartesian coordinates. integer uiparm(1) double precision urparm(1) external fdum - r_cut=2.0d0 - rlambd=0.3d0 +c r_cut=2.0d0 +c rlambd=0.3d0 icg=1 nf=0 nfl=0 + print *,"ATU 3" call intout c call intcartderiv c call checkintcartgrad call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' +c aincr=8.0D-7 +c aincr=1.0D-7 + print '("Calling CHECK_ECARTINT",1pd12.3)',aincr + write (iout,'("Calling CHECK_ECARTINT",1pd12.3)') aincr nf=0 icall=0 call geom_to_var(nvar,x) @@ -297,8 +303,10 @@ c call checkintcartgrad write (iout,*) "exit cartgrad" call flush(iout) icall =1 + write (iout,*) "gcard and gxcart" do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), + & (gxcart(j,i),j=1,3) enddo do j=1,3 grad_s(j,0)=gcart(j,0) @@ -362,6 +370,7 @@ c call checkintcartgrad endif write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' do i=0,nres + print *,i do j=1,3 xx(j)=c(j,i+nres) ddc(j)=dc(j,i) @@ -395,6 +404,7 @@ c write (iout,*) "etot11",etot11," etot12",etot12 c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 dc(j,i)=ddc(j)-aincr call chainbuild_cart +C print *,c(j,i) c call int_from_cart1(.false.) if (.not.split_ene) then call etotal(energia1(0)) @@ -506,20 +516,40 @@ c------------------------------------------------------------------------- #else do i=2,nres #endif +C print *,i dnorm1=dist(i-1,i) - dnorm2=dist(i,i+1) + dnorm2=dist(i,i+1) +C print *,i,dnorm1,dnorm2 do j=1,3 c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 & +(c(j,i+1)-c(j,i))/dnorm2) enddo be=0.0D0 - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + if (i.gt.2) then + if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1) + if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then + tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) + endif + if (itype(i-1).ne.10) then + tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) + omicron(1,i)=alpha(i-2,i-1,i-1+nres) + omicron(2,i)=alpha(i-1+nres,i-1,i) + endif + if (itype(i).ne.10) then + tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) + endif + endif omeg(i)=beta(nres+i,i,maxres2,i+1) +C print *,omeg(i) alph(i)=alpha(nres+i,i,maxres2) +C print *,alph(i) theta(i+1)=alpha(i-1,i,i+1) vbld(i)=dist(i-1,i) +C print *,vbld(i) vbld_inv(i)=1.0d0/vbld(i) vbld(nres+i)=dist(nres+i,i) +C print *,vbld(i+nres) + if (itype(i).ne.10) then vbld_inv(nres+i)=1.0d0/vbld(nres+i) else @@ -593,6 +623,11 @@ cd call flush(iout) &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), &rad2deg*alph(i),rad2deg*omeg(i) enddo + do i=1,nres + write (iout,'(i5,2(3f10.5,5x),f10.5,5x,f10.5)' ) + & i,(dc_norm(j,i),j=1,3), + & (dc_norm(j,nres+i),j=1,3),vbld_inv(i+1),vbld_inv(i+nres) + enddo endif 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) #ifdef TIMING @@ -605,6 +640,7 @@ c---------------------------------------------------------------------------- C Check the gradient of energy in internal coordinates. implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.IOUNITS' @@ -619,8 +655,9 @@ C Check the gradient of energy in internal coordinates. character*6 key external fdum call zerograd - aincr=1.0D-7 - print '(a)','Calling CHECK_INT.' +c aincr=1.0D-7 + print '("Calling CHECK_INT",1pd12.3)',aincr + write (iout,'("Calling CHECK_INT",1pd12.3)') aincr nf=0 nfl=0 icg=1 @@ -651,12 +688,12 @@ cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar) xi=x(i) x(i)=xi-0.5D0*aincr call var_to_geom(nvar,x) - call chainbuild + call chainbuild_extconf call etotal(energia1(0)) etot1=energia1(0) x(i)=xi+0.5D0*aincr call var_to_geom(nvar,x) - call chainbuild + call chainbuild_extconf call etotal(energia2(0)) etot2=energia2(0) gg(i)=(etot2-etot1)/aincr diff --git a/source/unres/src_MD-M/contact.f b/source/unres/src_MD-M/contact.f index a244d86..cc4e0b7 100644 --- a/source/unres/src_MD-M/contact.f +++ b/source/unres/src_MD-M/contact.f @@ -12,9 +12,9 @@ ncont=0 kkk=3 do i=nnt+kkk,nct - iti=itype(i) + iti=iabs(itype(i)) do j=nnt,i-kkk - itj=itype(j) + itj=iabs(itype(j)) if (ipot.ne.4) then c rcomp=sigmaii(iti,itj)+1.0D0 rcomp=facont*sigmaii(iti,itj) @@ -175,7 +175,7 @@ c do i=1,nharp c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4) c enddo if (lprint) then - write (iout,*) "Hairpins:" + write (iout,*) "Hairpins:",nharp do i=1,nharp i1=iharp(1,i) j1=iharp(2,i) diff --git a/source/unres/src_MD-M/csa.f b/source/unres/src_MD-M/csa.f index 3c2e8e9..49996be 100644 --- a/source/unres/src_MD-M/csa.f +++ b/source/unres/src_MD-M/csa.f @@ -72,7 +72,8 @@ c al m=0 do while(m.lt.n .and. itrial.le.10000) itrial=itrial+1 jeden=1 - call gen_rand_conf(jeden,*10) + nrestmp=nres + call gen_rand_conf(jeden,nrestmp,*10) ! call intout m=m+1 do j=2,nres-1 @@ -107,7 +108,8 @@ ccccccccccccccccccccccccccccccccccccccccccccccccc do while(m.lt.n .and. itrial.le.10000) itrial=itrial+1 jeden=1 - call gen_rand_conf(jeden,*10) + nrestmp=nres + call gen_rand_conf(jeden,nrestmp,*10) ! call intout m=m+1 do j=2,nres-1 diff --git a/source/unres/src_MD-M/dihed_cons.F b/source/unres/src_MD-M/dihed_cons.F index 1fb6c53..ddf198d 100644 --- a/source/unres/src_MD-M/dihed_cons.F +++ b/source/unres/src_MD-M/dihed_cons.F @@ -28,9 +28,9 @@ cdr call getenv_loc('SECPREDFIL',secpred) C read secondary structure prediction from JPRED here! ! read(isecpred,'(A80)',err=100,end=100) line ! read(line,'(f10.3)',err=110) ftors - read(isecpred,'(f10.3)',err=110) ftors + read(isecpred,'(f10.3)',err=110) ftors(1) - write (iout,*) 'FTORS factor =',ftors + write (iout,*) 'FTORS factor =',ftors(1) ! initialize secstruc to any do i=1,nres secstruc(i) ='-' @@ -52,6 +52,7 @@ C 8/13/98 Set limits to generating the dihedral angles ii=0 do i=1,nres + ftors(i)=ftors(1) if ( secstruc(i) .eq. 'H') then C Helix restraints for this residue ii=ii+1 diff --git a/source/unres/src_MD-M/elecont.f b/source/unres/src_MD-M/elecont.f index 634e908..73325f2 100644 --- a/source/unres/src_MD-M/elecont.f +++ b/source/unres/src_MD-M/elecont.f @@ -42,7 +42,7 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ ees=0.0 evdw=0.0 do 1 i=nnt,nct-2 - if (itype(i).eq.21 .or. itype(i+1).eq.21) goto 1 + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) goto 1 xi=c(1,i) yi=c(2,i) zi=c(3,i) @@ -52,8 +52,14 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ xmedi=xi+0.5*dxi ymedi=yi+0.5*dyi zmedi=zi+0.5*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize do 4 j=i+2,nct-1 - if (itype(j).eq.21 .or. itype(j+1).eq.21) goto 4 + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) goto 4 ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -66,9 +72,49 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ dxj=c(1,j+1)-c(1,j) dyj=c(2,j+1)-c(2,j) dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi + xj=c(1,j)+0.5*dxj + yj=c(2,j)+0.5*dyj + zj=c(3,j)+0.5*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) rrmij=1.0/(xj*xj+yj*yj+zj*zj) rmij=sqrt(rrmij) r3ij=rrmij*rmij @@ -94,7 +140,7 @@ c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ econt(ncont)=eesij endif ees=ees+eesij - evdw=evdw+evdwij + evdw=evdw+evdwij*sss 4 continue 1 continue if (lprint) then @@ -214,7 +260,7 @@ c-------------------------------------------- double precision p1,p2 external freeres - if(.not.dccart) call chainbuild +cc???? if(.not.dccart) call chainbuild cd call write_pdb(99,'sec structure',0d0) ncont=0 nbfrag=0 diff --git a/source/unres/src_MD-M/energy_p_new-sep.F b/source/unres/src_MD-M/energy_p_new-sep.F index 0b8f27b..a7f0bab 100644 --- a/source/unres/src_MD-M/energy_p_new-sep.F +++ b/source/unres/src_MD-M/energy_p_new-sep.F @@ -2,6 +2,7 @@ C----------------------------------------------------------------------- double precision function sscale(r) double precision r,gamm include "COMMON.SPLITELE" + include "COMMON.CHAIN" if(r.lt.r_cut-rlamb) then sscale=1.0d0 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then @@ -13,6 +14,23 @@ C----------------------------------------------------------------------- return end C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscagrad(r) + double precision r,gamm + include "COMMON.SPLITELE" + include "COMMON.CHAIN" + if(r.lt.r_cut-rlamb) then + sscagrad=0.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscagrad=gamm*(6*gamm-6.0d0)/rlamb + else + sscagrad=0.0d0 + endif + return + end +C----------------------------------------------------------------------- + subroutine elj_long(evdw) C C This subroutine calculates the interaction energy of nonbonded side chains @@ -2110,6 +2128,12 @@ c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxysize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) @@ -2125,13 +2149,50 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) sss=sscale(rij/rpp(iteli,itelj)) + sssgrad=sscagrad(sqrt(rij)) if (sss.lt.1.0d0) then rmij=1.0D0/rij r3ij=rrmij*rmij @@ -2150,9 +2211,9 @@ C C Calculate contributions to the Cartesian gradient. C facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj do k=1,3 ghalf=0.5D0*ggg(k) @@ -2198,6 +2259,7 @@ c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #else double precision scal_el /0.5d0/ #endif +c write (iout,*) "evdwpp_short" evdw1=0.0D0 do i=iatel_s,iatel_e dxi=dc(1,i) @@ -2209,6 +2271,12 @@ c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxysize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) @@ -2224,13 +2292,50 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) sss=sscale(rij/rpp(iteli,itelj)) + sssgrad=sscagrad(sqrt(rij)) if (sss.gt.0.0d0) then rmij=1.0D0/rij r3ij=rrmij*rmij @@ -2249,9 +2354,9 @@ C C Calculate contributions to the Cartesian gradient. C facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj do k=1,3 ghalf=0.5D0*ggg(k) @@ -2289,9 +2394,11 @@ C include 'COMMON.FFIELD' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' dimension ggg(3) evdw2=0.0D0 evdw2_14=0.0d0 + if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e @@ -2405,11 +2512,13 @@ C include 'COMMON.FFIELD' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' dimension ggg(3) evdw2=0.0D0 evdw2_14=0.0d0 cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e + if (energy_dec) write (iout,*) "escp_short:",r_cut,rlamb do i=iatscp_s,iatscp_e iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) diff --git a/source/unres/src_MD-M/energy_p_new-sep_barrier.F b/source/unres/src_MD-M/energy_p_new-sep_barrier.F index 815ca5a..1f00b2b 100644 --- a/source/unres/src_MD-M/energy_p_new-sep_barrier.F +++ b/source/unres/src_MD-M/energy_p_new-sep_barrier.F @@ -1,4 +1,33 @@ C----------------------------------------------------------------------- + double precision function sscalelip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscale=1.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscalelip=1.0d0+r*r*(2*r-3.0d0) +C else +C sscale=0d0 +C endif + return + end +C----------------------------------------------------------------------- + double precision function sscagradlip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscagrad=0.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscagradlip=r*(6*r-6.0d0) +C else +C sscagrad=0.0d0 +C endif + return + end + +C----------------------------------------------------------------------- double precision function sscale(r) double precision r,gamm include "COMMON.SPLITELE" @@ -13,6 +42,21 @@ C----------------------------------------------------------------------- return end C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscagrad(r) + double precision r,gamm + include "COMMON.SPLITELE" + if(r.lt.r_cut-rlamb) then + sscagrad=0.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscagrad=gamm*(6*gamm-6.0d0)/rlamb + else + sscagrad=0.0d0 + endif + return + end +C----------------------------------------------------------------------- subroutine elj_long(evdw) C C This subroutine calculates the interaction energy of nonbonded side chains @@ -37,7 +81,7 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -50,7 +94,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -60,8 +104,8 @@ cd & 'iend=',iend(i,iint) rrij=1.0D0/rij eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e1+e2 evdw=evdw+(1.0d0-sss)*evdwij C @@ -123,7 +167,7 @@ c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -138,7 +182,7 @@ cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -149,8 +193,8 @@ C Change 12/1/95 to calculate four-body interactions rrij=1.0D0/rij eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e1+e2 evdw=evdw+sss*evdwij C @@ -209,7 +253,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -220,7 +264,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -233,8 +277,8 @@ C if (sss.lt.1.0d0) then r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e_augm+e1+e2 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) @@ -292,7 +336,7 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -303,7 +347,7 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -316,8 +360,8 @@ C if (sss.gt.0.0d0) then r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e_augm+e1+e2 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) @@ -384,7 +428,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -401,7 +445,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -430,16 +474,16 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij*(1.0d0-sss) if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') cd & restyp(itypi),i,restyp(itypj),j, cd & epsi,sigm,chi1,chi2,chip1,chip2, @@ -497,7 +541,7 @@ c endif ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -514,7 +558,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -543,16 +587,16 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij*sss if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') cd & restyp(itypi),i,restyp(itypj),j, cd & epsi,sigm,chi1,chi2,chip1,chip2, @@ -598,6 +642,7 @@ C include 'COMMON.CALC' include 'COMMON.CONTROL' logical lprn + integer xshift,yshift,zshift evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -607,11 +652,17 @@ c if (icall.eq.0) lprn=.false. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -626,7 +677,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -642,16 +693,80 @@ c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) alf1=alp(itypi) alf2=alp(itypj) alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + &.and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - + sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj)) if (sss.lt.1.0d0) then C Calculate angle-dependent terms of energy and contributions to their @@ -674,8 +789,8 @@ cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -684,8 +799,8 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij*(1.0d0-sss) if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,chi1,chi2,chip1,chip2, @@ -702,11 +817,14 @@ C Calculate gradient components. fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij/(1.0-sss)*(-sssgrad)/sigmaii(itypi,itypj)*rij c fac=0.0d0 C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=ssgradlipi*evdwij + gg_lipj(3)=ssgradlipj*evdwij C Calculate angular part of the gradient. call sc_grad_scale(1.0d0-sss) endif @@ -736,6 +854,7 @@ C include 'COMMON.CALC' include 'COMMON.CONTROL' logical lprn + integer xshift,yshift,zshift evdw=0.0D0 ccccc energy_dec=.false. c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -745,11 +864,17 @@ c if (icall.eq.0) lprn=.false. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -764,7 +889,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -780,16 +905,79 @@ c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) alf1=alp(itypi) alf2=alp(itypj) alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + &.and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi+sslipj)/2.0d0 + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - + sssgrad=sscagrad((1.0d0/rij)/sigmaii(itypi,itypj)) if (sss.gt.0.0d0) then C Calculate angle-dependent terms of energy and contributions to their @@ -812,8 +1000,8 @@ cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -822,8 +1010,8 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij*sss if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,chi1,chi2,chip1,chip2, @@ -840,11 +1028,14 @@ C Calculate gradient components. fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij/sss*sssgrad/sigmaii(itypi,itypj)*rij c fac=0.0d0 C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac + gg_lipi(3)=ssgradlipi*evdwij + gg_lipj(3)=ssgradlipj*evdwij C Calculate angular part of the gradient. call sc_grad_scale(sss) endif @@ -882,7 +1073,7 @@ c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -899,7 +1090,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -941,8 +1132,8 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -951,8 +1142,8 @@ c--------------------------------------------------------------- evdwij=evdwij*eps2rt*eps3rt evdw=evdw+(evdwij+e_augm)*(1.0d0-sss) if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), @@ -1004,7 +1195,7 @@ c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e itypi=itype(i) - if (itypi.eq.21) cycle + if (itypi.eq.ntyp1) cycle itypi1=itype(i+1) xi=c(1,nres+i) yi=c(2,nres+i) @@ -1021,7 +1212,7 @@ C do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -1063,8 +1254,8 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -1073,8 +1264,8 @@ c--------------------------------------------------------------- evdwij=evdwij*eps2rt*eps3rt evdw=evdw+(evdwij+e_augm)*sss if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), @@ -1131,10 +1322,10 @@ c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 enddo c write (iout,*) "gg",(gg(k),k=1,3) do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwx(k,j)=gvdwx(k,j)+gg(k) + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) @@ -1146,8 +1337,8 @@ C C Calculate the components of the gradient in DC and X C do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return end @@ -1179,6 +1370,7 @@ C include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.TIME1' + include 'COMMON.SHIELD' dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), @@ -1208,6 +1400,7 @@ cd write(iout,*) 'EE',EE(:,:,i) cd enddo cd call check_vecgrad cd stop +C print *,"WCHODZE3" if (icheckgrad.eq.1) then do i=1,nres-1 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) @@ -1262,8 +1455,11 @@ C C Loop over i,i+2 and i,i+3 pairs of the peptide groups C do i=iturn3_start,iturn3_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle + if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 + & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1 +C & .or. itype(i-1).eq.ntyp1 +C & .or. itype(i+4).eq.ntyp1 + & ) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1273,15 +1469,24 @@ C xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 call eelecij_scale(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) num_cont_hb(i)=num_conti enddo do i=iturn4_start,iturn4_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+3).eq.21 - & .or. itype(i+4).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1 +C & .or. itype(i+5).eq.ntyp1 +C & .or. itype(i-1).eq.ntyp1 + & ) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1291,9 +1496,15 @@ C xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=num_cont_hb(i) call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & call eturn4(i,eello_turn4) num_cont_hb(i)=num_conti enddo ! i @@ -1301,7 +1512,10 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C & .or. itype(i+2).eq.ntyp1 +C & .or. itype(i-1).eq.ntyp1 + &) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1311,10 +1525,19 @@ c xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1 +C & .or.itype(j+2).eq.ntyp1 +C & .or.itype(j-1).eq.ntyp1 + &) cycle call eelecij_scale(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -1349,10 +1572,13 @@ C------------------------------------------------------------------------------- include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.TIME1' + include 'COMMON.SHIELD' + integer xshift,yshift,zshift dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4), + & gmuij2(4),gmuji2(4) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 @@ -1369,6 +1595,7 @@ C 13-go grudnia roku pamietnego... & 0.0d0,0.0d0,1.0d0/ c time00=MPI_Wtime() cd write (iout,*) "eelecij",i,j +C print *,"WCHODZE2" ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -1383,16 +1610,54 @@ cd write (iout,*) "eelecij",i,j dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) rmij=1.0D0/rij c For extracting the short-range part of Evdwpp sss=sscale(rij/rpp(iteli,itelj)) - + sssgrad=sscagrad(rij/rpp(iteli,itelj)) r3ij=rrmij*rmij r6ij=r3ij*r3ij cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj @@ -1406,8 +1671,14 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions fac3=ael6i*r6ij fac4=ael3i*r3ij evdwij=ev1+ev2 + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 + endif el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) el2=fac4*fac + el1=el1*fac_shield(i)**2*fac_shield(j)**2 + el2=el2*fac_shield(i)**2*fac_shield(j)**2 eesij=el1+el2 C 12/26/95 - for the evaluation of multi-body H-bonding interactions ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) @@ -1439,6 +1710,60 @@ C ggg(1)=facel*xj ggg(2)=facel*yj ggg(3)=facel*zj + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C if (iresshield.gt.i) then +C do ishi=i+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C else +C do ishi=iresshield,i +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C endif + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + enddo + enddo + + do k=1,3 + gshieldc(k,i)=gshieldc(k,i)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j)=gshieldc(k,j)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,i-1)=gshieldc(k,i-1)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j-1)=gshieldc(k,j-1)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + + enddo + endif + c do k=1,3 c ghalf=0.5D0*ggg(k) c gelc(k,i)=gelc(k,i)+ghalf @@ -1457,9 +1782,9 @@ cgrad do l=1,3 cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj) + ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj) + ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj) c do k=1,3 c ghalf=0.5D0*ggg(k) c gvdwpp(k,i)=gvdwpp(k,i)+ghalf @@ -1511,9 +1836,12 @@ cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj +C ggg(1)=facvdw*xj +C ggg(2)=facvdw*yj +C ggg(3)=facvdw*zj + ggg(1)=facvdw*xj-sssgrad*rmij*evdwij*xj/rpp(iteli,itelj) + ggg(2)=facvdw*yj-sssgrad*rmij*evdwij*yj/rpp(iteli,itelj) + ggg(3)=facvdw*zj-sssgrad*rmij*evdwij*zj/rpp(iteli,itelj) do k=1,3 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) @@ -1534,7 +1862,9 @@ c 9/28/08 AL Gradient compotents will be summed only at the end cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* + & fac_shield(i)**2*fac_shield(j)**2 + enddo c do k=1,3 c ghalf=0.5D0*ggg(k) @@ -1552,11 +1882,14 @@ cgrad enddo cgrad enddo do k=1,3 gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) + & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) + & *fac_shield(i)**2*fac_shield(j)**2 + gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) + & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) + & *fac_shield(i)**2*fac_shield(j)**2 gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo @@ -1582,6 +1915,14 @@ C do l=1,2 kkk=kkk+1 muij(kkk)=mu(k,i)*mu(l,j) +#ifdef NEWCORR + gmuij1(kkk)=gtb1(k,i+1)*mu(l,j) +c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j) + gmuij2(kkk)=gUb2(k,i)*mu(l,j) + gmuji1(kkk)=mu(k,i)*gtb1(l,j+1) +c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i) + gmuji2(kkk)=mu(k,i)*gUb2(l,j) +#endif enddo enddo cd write (iout,*) 'EELEC: i',i,' j',j @@ -1752,19 +2093,128 @@ cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij + + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif + eel_loc_ij=eel_loc_ij + & *fac_shield(i)*fac_shield(j) eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma + + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij + & /fac_shield(i) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij + & /fac_shield(j) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_ll(k,i)=gshieldc_ll(k,i)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j)=gshieldc_ll(k,j)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + enddo + endif + +#ifdef NEWCORR + geel_loc_ij=(a22*gmuij1(1) + & +a23*gmuij1(2) + & +a32*gmuij1(3) + & +a33*gmuij1(4)) + & *fac_shield(i)*fac_shield(j) +c write(iout,*) "derivative over thatai" +c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), +c & a33*gmuij1(4) + gloc(nphi+i,icg)=gloc(nphi+i,icg)+ + & geel_loc_ij*wel_loc +c write(iout,*) "derivative over thatai-1" +c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3), +c & a33*gmuij2(4) + geel_loc_ij= + & a22*gmuij2(1) + & +a23*gmuij2(2) + & +a32*gmuij2(3) + & +a33*gmuij2(4) + gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ + & geel_loc_ij*wel_loc + & *fac_shield(i)*fac_shield(j) + +c Derivative over j residue + geel_loc_ji=a22*gmuji1(1) + & +a23*gmuji1(2) + & +a32*gmuji1(3) + & +a33*gmuji1(4) +c write(iout,*) "derivative over thataj" +c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3), +c & a33*gmuji1(4) + + gloc(nphi+j,icg)=gloc(nphi+j,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) + + geel_loc_ji= + & +a22*gmuji2(1) + & +a23*gmuji2(2) + & +a32*gmuji2(3) + & +a33*gmuji2(4) +c write(iout,*) "derivative over thataj-1" +c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), +c & a33*gmuji2(4) + gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) +#endif +cC Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) + & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) + & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) + & *fac_shield(i)*fac_shield(j) + gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) + & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) + & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) + & *fac_shield(i)*fac_shield(j) + C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) + ggg(l)=(agg(l,1)*muij(1)+ + & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) cgrad ghalf=0.5d0*ggg(l) @@ -1778,14 +2228,22 @@ cgrad enddo cgrad enddo C Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ + & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ + & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ + & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ + & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + enddo ENDIF C Change 12/26/95 to calculate four-body contributions to H-bonding energy @@ -1864,8 +2322,19 @@ c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) ees0mij=0 endif c ees0mij=0.0D0 + if (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + else + ees0plist(num_conti,i)=j +C fac_shield(i)=0.4d0 +C fac_shield(j)=0.6d0 + endif ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) + & *fac_shield(i)*fac_shield(j) ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + & *fac_shield(i)*fac_shield(j) + C Diagnostics. Comment out or remove after debugging! c ees0p(num_conti,i)=0.5D0*fac3*ees0pij c ees0m(num_conti,i)=0.5D0*fac3*ees0mij @@ -1933,17 +2402,29 @@ cgrad ghalfm=0.5D0*gggm(k) gacontp_hb1(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb2(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb3(k,num_conti,i)=gggp(k) + & *fac_shield(i)*fac_shield(j) + gacontm_hb1(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb2(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb3(k,num_conti,i)=gggm(k) + & *fac_shield(i)*fac_shield(j) + enddo ENDIF ! wcorr endif ! num_conti.le.maxconts @@ -1989,18 +2470,21 @@ C include 'COMMON.VECTORS' include 'COMMON.FFIELD' dimension ggg(3) + integer xshift,yshift,zshift c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions #ifdef MOMENT double precision scal_el /1.0d0/ #else double precision scal_el /0.5d0/ #endif +c write (iout,*) "evdwpp_short" evdw1=0.0D0 +C print *,"WCHODZE" c write (iout,*) "iatel_s_vdw",iatel_s_vdw, c & " iatel_e_vdw",iatel_e_vdw - call flush(iout) +c call flush(iout) do i=iatel_s_vdw,iatel_e_vdw - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2010,12 +2494,18 @@ c & " iatel_e_vdw",iatel_e_vdw xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0.0d0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0.0d0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0.0d0) zmedi=zmedi+boxzsize num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), c & ' ielend',ielend_vdw(i) - call flush(iout) +c call flush(iout) do j=ielstart_vdw(i),ielend_vdw(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -2028,13 +2518,53 @@ c & ' ielend',ielend_vdw(i) dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) - sss=sscale(rij/rpp(iteli,itelj)) +c sss=sscale(rij/rpp(iteli,itelj)) +c sssgrad=sscagrad(rij/rpp(iteli,itelj)) + sss=sscale(rij) + sssgrad=sscagrad(rij) if (sss.gt.0.0d0) then rmij=1.0D0/rij r3ij=rrmij*rmij @@ -2048,13 +2578,18 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss endif evdw1=evdw1+evdwij*sss + if (energy_dec) write (iout,'(a10,2i5,0pf7.3)') + & 'evdw1_sum',i,j,evdw1 C C Calculate contributions to the Cartesian gradient. C facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj/rpp(iteli,itelj) + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj/rpp(iteli,itelj) + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj/rpp(iteli,itelj) +C ggg(1)=facvdw*xj +C ggg(2)=facvdw*yj +C ggg(3)=facvdw*zj do k=1,3 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) @@ -2082,37 +2617,90 @@ C include 'COMMON.FFIELD' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' + logical lprint_short + common /shortcheck/ lprint_short dimension ggg(3) + integer xshift,yshift,zshift + if (energy_dec) write (iout,*) "escp_long:",r_cut,rlamb evdw2=0.0D0 evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' +CD print '(a)','Enter ESCP KURWA' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e +c if (lprint_short) +c & write (iout,*) 'ESCP_LONG iatscp_s=',iatscp_s, +c & ' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) - + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) +c corrected by AL + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +c end correction + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - + sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) + if (energy_dec) write (iout,*) "rrij",1.0d0/dsqrt(rrij), + & " rscp",rscp(itypj,iteli)," subchap",subchap," sss",sss if (sss.lt.1.0d0) then - fac=rrij**expon2 e1=fac*fac*aad(itypj,iteli) e2=fac*bad(itypj,iteli) @@ -2128,7 +2716,9 @@ C Uncomment following three lines for Ca-p interactions C C Calculate contributions to the gradient in the virtual-bond and SC vectors. C + fac=-(evdwij+e1)*rrij*(1.0d0-sss) + fac=fac-(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli) ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -2183,35 +2773,101 @@ C include 'COMMON.FFIELD' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' + integer xshift,yshift,zshift + logical lprint_short + common /shortcheck/ lprint_short dimension ggg(3) evdw2=0.0D0 evdw2_14=0.0d0 cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e +c if (lprint_short) +c & write (iout,*) 'ESCP_SHORT iatscp_s=',iatscp_s, +c & ' iatscp_e=',iatscp_e + if (energy_dec) write (iout,*) "escp_short:",r_cut,rlamb do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize +c if (lprint_short) +c & write (iout,*) "i",i," itype",itype(i),itype(i+1), +c & " nscp_gr",nscp_gr(i) do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) itypj=itype(j) - if (itypj.eq.21) cycle +c if (lprint_short) +c & write (iout,*) "j",j," itypj",itypj + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) +c corrected by AL + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +c end correction + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 +c if (lprint_short) then +c write (iout,*) i,j,xi,yi,zi,xj,yj,zj +c write (iout,*) "dist_init",dsqrt(dist_init) +c endif + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo +c if (lprint_short) write (iout,*) "dist_temp",dsqrt(dist_temp) + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - +c sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) +c sssgrad=sscagrad(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) + sss=sscale(1.0d0/(dsqrt(rrij))) + sssgrad=sscagrad(1.0d0/(dsqrt(rrij))) + if (energy_dec) write (iout,*) "rrij",1.0d0/dsqrt(rrij), + & " rscp",rscp(itypj,iteli)," subchap",subchap," sss",sss +c if (lprint_short) write (iout,*) "rij",1.0/dsqrt(rrij), +c & " subchap",subchap," sss",sss if (sss.gt.0.0d0) then fac=rrij**expon2 @@ -2230,6 +2886,7 @@ C C Calculate contributions to the gradient in the virtual-bond and SC vectors. C fac=-(evdwij+e1)*rrij*sss + fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/rscp(itypj,iteli) ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac diff --git a/source/unres/src_MD-M/energy_p_new.F b/source/unres/src_MD-M/energy_p_new.F index 0b25cb2..792804a 100644 --- a/source/unres/src_MD-M/energy_p_new.F +++ b/source/unres/src_MD-M/energy_p_new.F @@ -240,7 +240,11 @@ C If performing constraint dynamics, call the constraint energy C after the equilibration time if(usampl.and.totT.gt.eq_time) then call EconstrQ - call Econstr_back + if (loc_qlike) then + call Econstr_back_qlike + else + call Econstr_back + endif else Uconst=0.0d0 Uconst_back=0.0d0 diff --git a/source/unres/src_MD-M/energy_p_new_barrier.F b/source/unres/src_MD-M/energy_p_new_barrier.F index fa4e531..a95d617 100644 --- a/source/unres/src_MD-M/energy_p_new_barrier.F +++ b/source/unres/src_MD-M/energy_p_new_barrier.F @@ -24,6 +24,8 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.MD' include 'COMMON.CONTROL' include 'COMMON.TIME1' + include 'COMMON.SPLITELE' + include 'COMMON.TORCNSTR' #ifdef MPI c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, c & " nfgtasks",nfgtasks @@ -54,6 +56,8 @@ C FG slaves as WEIGHTS array. weights_(17)=wbond weights_(18)=scal14 weights_(21)=wsccor + weights_(22)=wtube + C FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene, & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) @@ -80,6 +84,7 @@ C FG slaves receive the WEIGHTS array wbond=weights(17) scal14=weights(18) wsccor=weights(21) + wtube=weights(22) endif time_Bcast=time_Bcast+MPI_Wtime()-time00 time_Bcastw=time_Bcastw+MPI_Wtime()-time00 @@ -98,6 +103,7 @@ c endif C C Compute the side-chain and electrostatic interaction energy C +C print *,ipot goto (101,102,103,104,105,106) ipot C Lennard-Jones potential. 101 call elj(evdw) @@ -111,6 +117,7 @@ C Berne-Pechukas potential (dilated LJ, angular dependence). goto 107 C Gay-Berne potential (shifted LJ, angular dependence). 104 call egb(evdw) +C print *,"bylem w egb" goto 107 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). 105 call egbv(evdw) @@ -121,6 +128,11 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +cmc +cmc Sep-06: egb takes care of dynamic ss bonds too +cmc +c if (dyn_ss) call dyn_set_nss + c print *,"Processor",myrank," computed USCSC" #ifdef TIMING time01=MPI_Wtime() @@ -129,6 +141,16 @@ c print *,"Processor",myrank," computed USCSC" #ifdef TIMING time_vec=time_vec+MPI_Wtime()-time01 #endif +C Introduction of shielding effect first for each peptide group +C the shielding factor is set this factor is describing how each +C peptide group is shielded by side-chains +C the matrix - shield_fac(i) the i index describe the ith between i and i+1 +C write (iout,*) "shield_mode",shield_mode + if (shield_mode.eq.1) then + call set_shield_fac + else if (shield_mode.eq.2) then + call set_shield_fac2 + endif c print *,"Processor",myrank," left VEC_AND_DERIV" if (ipot.lt.6) then #ifdef SPLITELE @@ -151,9 +173,9 @@ c print *,"Processor",myrank," left VEC_AND_DERIV" eello_turn4=0.0d0 endif else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) + write (iout,*) "Soft-spheer ELEC potential" +c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, +c & eello_turn4) endif c print *,"Processor",myrank," computed UELEC" C @@ -185,34 +207,51 @@ C C Calculate the virtual-bond-angle energy. C if (wang.gt.0d0) then - call ebend(ebe) + if (tor_mode.eq.0) then + call ebend(ebe) + else +C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call ebend_kcc(ebe) + endif else - ebe=0 + ebe=0.0d0 endif + ethetacnstr=0.0d0 + if (with_theta_constr) call etheta_constr(ethetacnstr) c print *,"Processor",myrank," computed UB" C C Calculate the SC local energy. C +C print *,"TU DOCHODZE?" call esc(escloc) c print *,"Processor",myrank," computed USC" C C Calculate the virtual-bond torsional energy. C cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) +C print *,"tor",tor_mode + if (wtor.gt.0.0d0) then + if (tor_mode.eq.0) then + call etor(etors) + else +C etor kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call etor_kcc(etors) + endif else - etors=0 - edihcnstr=0 + etors=0.0d0 endif + edihcnstr=0.0d0 + if (ndih_constr.gt.0) call etor_constr(edihcnstr) c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C - if (wtor_d.gt.0) then - call etor_d(etors_d) + if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then + call etor_d(etors_d) else - etors_d=0 + etors_d=0 endif c print *,"Processor",myrank," computed Utord" C @@ -223,6 +262,7 @@ C else esccor=0.0d0 endif +C print *,"PRZED MULIt" c print *,"Processor",myrank," computed Usccorr" C C 12/1/95 Multi-body terms @@ -232,8 +272,9 @@ C if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 +c write(2,*)'MULTIBODY_EELLO n_corr=',n_corr,' n_corr1=',n_corr1, +c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 +c call flush(iout) else ecorr=0.0d0 ecorr5=0.0d0 @@ -241,20 +282,53 @@ cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 eturn6=0.0d0 endif if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then +c write (iout,*) "Before MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6, +c & n_corr,n_corr1 +c call flush(iout) call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr +c write (iout,*) "MULTIBODY_HB ecorr",ecorr,ecorr5,ecorr6,n_corr, +c & n_corr1 +c call flush(iout) endif c print *,"Processor",myrank," computed Ucorr" C C If performing constraint dynamics, call the constraint energy C after the equilibration time - if(usampl.and.totT.gt.eq_time) then +c if(usampl.and.totT.gt.eq_time) then +c write (iout,*) "usampl",usampl + if(usampl) then call EconstrQ - call Econstr_back + if (loc_qlike) then + call Econstr_back_qlike + else + call Econstr_back + endif else Uconst=0.0d0 Uconst_back=0.0d0 endif +C 01/27/2015 added by adasko +C the energy component below is energy transfer into lipid environment +C based on partition function +C print *,"przed lipidami" + if (wliptran.gt.0) then + call Eliptransfer(eliptran) + endif +C print *,"za lipidami" + if (AFMlog.gt.0) then + call AFMforce(Eafmforce) + else if (selfguide.gt.0) then + call AFMvel(Eafmforce) + endif + if (TUBElog.eq.1) then +C print *,"just before call" + call calctube(Etube) + elseif (TUBElog.eq.2) then + call calctube2(Etube) + else + Etube=0.0d0 + endif + #ifdef TIMING time_enecalc=time_enecalc+MPI_Wtime()-time00 #endif @@ -296,8 +370,15 @@ C energia(17)=estr energia(20)=Uconst+Uconst_back energia(21)=esccor + energia(22)=eliptran + energia(23)=Eafmforce + energia(24)=ethetacnstr + energia(25)=Etube +c Here are the energies showed per procesor if the are more processors +c per molecule then we sum it up in sum_energy subroutine c print *," Processor",myrank," calls SUM_ENERGY" call sum_energy(energia,.true.) + if (dyn_ss) call dyn_set_nss c print *," Processor",myrank," left SUM_ENERGY" #ifdef TIMING time_sumene=time_sumene+MPI_Wtime()-time00 @@ -384,20 +465,27 @@ cMS$ATTRIBUTES C :: proc_proc estr=energia(17) Uconst=energia(20) esccor=energia(21) + eliptran=energia(22) + Eafmforce=energia(23) + ethetacnstr=energia(24) + Etube=energia(25) #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 & +wang*ebe+wtor*etors+wscloc*escloc & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor + & +wbond*estr+wumb*Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce + & +ethetacnstr+wtube*Etube #else etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) & +wang*ebe+wtor*etors+wscloc*escloc & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor + & +wbond*estr+wumb*Uconst+wsccor*esccor+wliptran*eliptran + & +Eafmforce + & +ethetacnstr+wtube*Etube #endif energia(0)=etot c detecting NaNQ @@ -433,9 +521,10 @@ cMS$ATTRIBUTES C :: proc_proc #endif #ifdef MPI include 'mpif.h' - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres) #endif + double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres), + & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres) + & ,gloc_scbuf(3,-1:maxres) include 'COMMON.SETUP' include 'COMMON.IOUNITS' include 'COMMON.FFIELD' @@ -447,6 +536,7 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.CONTROL' include 'COMMON.TIME1' include 'COMMON.MAXGRAD' + include 'COMMON.SCCOR' #ifdef TIMING time01=MPI_Wtime() #endif @@ -487,7 +577,7 @@ c enddo call flush(iout) #endif #ifdef SPLITELE - do i=1,nct + do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(j,i)+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ @@ -498,10 +588,21 @@ c enddo & wcorr6*gradcorr6_long(j,i)+ & wturn6*gcorr6_turn_long(j,i)+ & wstrain*ghpbc(j,i) + & +wliptran*gliptranc(j,i) + & +gradafm(j,i) + & +welec*gshieldc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wtube*gg_tube(j,i) + + + enddo enddo #else - do i=1,nct + do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(j,i)+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ @@ -513,6 +614,16 @@ c enddo & wcorr6*gradcorr6_long(j,i)+ & wturn6*gcorr6_turn_long(j,i)+ & wstrain*ghpbc(j,i) + & +wliptran*gliptranc(j,i) + & +gradafm(j,i) + & +welec*gshieldc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wtube*gg_tube(j,i) + + + enddo enddo #endif @@ -526,7 +637,7 @@ c enddo enddo call flush(iout) #endif - do i=1,nres + do i=0,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) enddo @@ -569,7 +680,7 @@ c enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,nnt,-1 + do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -590,7 +701,7 @@ c enddo enddo call flush(iout) #endif - do i=1,nres + do i=-1,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) gradbufc(j,i)=0.0d0 @@ -599,7 +710,7 @@ c enddo do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,nnt,-1 + do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -627,9 +738,16 @@ c enddo do k=1,3 gradbufc(k,nres)=0.0d0 enddo - do i=1,nct + do i=-1,nct do j=1,3 #ifdef SPLITELE +C print *,gradbufc(1,13) +C print *,welec*gelc(1,13) +C print *,wel_loc*gel_loc(1,13) +C print *,0.5d0*(wscp*gvdwc_scpp(1,13)) +C print *,welec*gelc_long(1,13)+wvdwpp*gvdwpp(1,13) +C print *,wel_loc*gel_loc_long(1,13) +C print *,gradafm(1,13),"AFM" gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ & wel_loc*gel_loc(j,i)+ & 0.5d0*(wscp*gvdwc_scpp(j,i)+ @@ -648,11 +766,25 @@ c enddo & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & +wscloc*gscloc(j,i) + & +wliptran*gliptranc(j,i) + & +gradafm(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + & +wtube*gg_tube(j,i) + #else gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ & wel_loc*gel_loc(j,i)+ & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i) + & welec*gelc_long(j,i)+ & wel_loc*gel_loc_long(j,i)+ & wcorr*gcorr_long(j,i)+ & wcorr5*gradcorr5_long(j,i)+ @@ -667,12 +799,37 @@ c enddo & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & +wscloc*gscloc(j,i) + & +wliptran*gliptranc(j,i) + & +gradafm(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + & +wtube*gg_tube(j,i) + + #endif gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ & wsccor*gsccorx(j,i) & +wscloc*gsclocx(j,i) + & +wliptran*gliptranx(j,i) + & +welec*gshieldx(j,i) + & +wcorr*gshieldx_ec(j,i) + & +wturn3*gshieldx_t3(j,i) + & +wturn4*gshieldx_t4(j,i) + & +wel_loc*gshieldx_ll(j,i) + & +wtube*gg_tube_sc(j,i) + + + enddo enddo #ifdef DEBUG @@ -689,7 +846,6 @@ c enddo & +wturn3*gel_loc_turn3(i) & +wturn6*gel_loc_turn6(i) & +wel_loc*gel_loc_loc(i) - & +wsccor*gsccor_loc(i) enddo #ifdef DEBUG write (iout,*) "gloc after adding corr" @@ -708,6 +864,21 @@ c enddo do i=1,4*nres glocbuf(i)=gloc(i,icg) enddo +c#define DEBUG +#ifdef DEBUG + write (iout,*) "gloc_sc before reduce" + do i=1,nres + do j=1,1 + write (iout,*) i,j,gloc_sc(j,i,icg) + enddo + enddo +#endif +c#undef DEBUG + do i=1,nres + do j=1,3 + gloc_scbuf(j,i)=gloc_sc(j,i,icg) + enddo + enddo time00=MPI_Wtime() call MPI_Barrier(FG_COMM,IERR) time_barrier_g=time_barrier_g+MPI_Wtime()-time00 @@ -719,6 +890,19 @@ c enddo call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 + call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, + & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) + time_reduce=time_reduce+MPI_Wtime()-time00 +c#define DEBUG +#ifdef DEBUG + write (iout,*) "gloc_sc after reduce" + do i=1,nres + do j=1,1 + write (iout,*) i,j,gloc_sc(j,i,icg) + enddo + enddo +#endif +c#undef DEBUG #ifdef DEBUG write (iout,*) "gloc after reduce" do i=1,4*nres @@ -806,7 +990,7 @@ c if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm enddo if (gradout) then -#ifdef AIX +#if (defined AIX || defined CRAY) open(istat,file=statname,position="append") #else open(istat,file=statname,access="append") @@ -848,6 +1032,7 @@ c------------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' + include 'COMMON.CONTROL' double precision kfac /2.4d0/ double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ c facT=temp0/t_bath @@ -883,6 +1068,11 @@ c facT=2*temp0/(t_bath+temp0) #endif stop 555 endif + if (shield_mode.gt.0) then + wscp=weights(2)*fact + wsc=weights(1)*fact + wvdwpp=weights(16)*fact + endif welec=weights(3)*fact wcorr=weights(4)*fact3 wcorr5=weights(5)*fact4 @@ -894,6 +1084,9 @@ c facT=2*temp0/(t_bath+temp0) wtor=weights(13)*fact wtor_d=weights(14)*fact2 wsccor=weights(21)*fact + if (scale_umb) wumb=t_bath/temp0 +c write (iout,*) "scale_umb",scale_umb +c write (iout,*) "t_bath",t_bath," temp0",temp0," wumb",wumb return end @@ -934,15 +1127,20 @@ C------------------------------------------------------------------------ estr=energia(17) Uconst=energia(20) esccor=energia(21) + eliptran=energia(22) + Eafmforce=energia(23) + ethetacnstr=energia(24) + etube=energia(25) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, & estr,wbond,ebe,wang, & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, & ecorr,wcorr, & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ebr*nss, - & Uconst,etot + & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr, + & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, + & etube,wtube, + & etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -964,9 +1162,14 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ & 'UCONST= ',1pE16.6,' (Constraint energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ + & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ + & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ & 'ETOT= ',1pE16.6,' (total)') + #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, & estr,wbond,ebe,wang, @@ -974,7 +1177,9 @@ C------------------------------------------------------------------------ & ecorr,wcorr, & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ebr*nss,Uconst,etot + & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, + & etube,wtube, + & etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -995,8 +1200,12 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ & 'UCONST=',1pE16.6,' (Constraint energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ + & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ + & 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -1025,9 +1234,9 @@ C c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1040,8 +1249,8 @@ C cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1051,13 +1260,14 @@ C Change 12/1/95 to calculate four-body interactions c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) +C have you changed here? + e1=fac*fac*aa + e2=fac*bb evdwij=e1+e2 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), +cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj), cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, cd & (c(k,i),k=1,3),(c(k,j),k=1,3) evdw=evdw+evdwij @@ -1178,9 +1388,9 @@ C c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1189,8 +1399,8 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1201,8 +1411,9 @@ C rij=1.0D0/r_inv_ij r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) +C have you changed here? + e1=fac*fac*aa + e2=fac*bb evdwij=e_augm+e1+e2 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) @@ -1271,9 +1482,9 @@ c else c endif ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1288,8 +1499,8 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) @@ -1328,17 +1539,18 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. call sc_angular C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives +C have you changed here? fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') cd & restyp(itypi),i,restyp(itypj),j, cd & epsi,sigm,chi1,chi2,chip1,chip2, @@ -1382,21 +1594,94 @@ C include 'COMMON.IOUNITS' include 'COMMON.CALC' include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' logical lprn + integer xshift,yshift,zshift + evdw=0.0D0 ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon +C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 lprn=.false. c if (icall.eq.0) lprn=.false. ind=0 +C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0 +C we have the original box) +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +C Return atom into box, boxxsize is size of box in x dimension +c 134 continue +c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize +c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize +C Condition for being inside the proper box +c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 134 +c endif +c 135 continue +c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize +c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize +C Condition for being inside the proper box +c if ((yi.gt.((yshift+0.5d0)*boxysize)).or. +c & (yi.lt.((yshift-0.5d0)*boxysize))) then +c go to 135 +c endif +c 136 continue +c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize +c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize +C Condition for being inside the proper box +c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 136 +c endif + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize +C define scaling factor for lipids + +C if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + if ((zi.gt.bordlipbot) + &.and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + +C xi=xi+xshift*boxxsize +C yi=yi+yshift*boxysize +C zi=zi+zshift*boxzsize + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1409,9 +1694,41 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + +c write(iout,*) "PRZED ZWYKLE", evdwij + call dyn_ssbond_ene(i,j,evdwij) +c write(iout,*) "PO ZWYKLE", evdwij + + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,' ss' +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + +c write(iout,*) "PRZED TRI", evdwij + evdwij_przed_tri=evdwij + call triple_ssbond_ene(i,j,k,evdwij) +c if(evdwij_przed_tri.ne.evdwij) then +c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +c endif + +c write(iout,*) "PO TRI", evdwij +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,'tss' + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, @@ -1437,17 +1754,119 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +C Return atom J into box the original box +c 137 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 137 +c endif +c 138 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +C Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 138 +c endif +c 139 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 139 +c endif + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + &.and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C write(iout,*) "tu,", i,j,aa_lip(itypi,itypj),bb_lip(itypi,itypj) +C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)') +C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj)) +C if (ssgradlipj.gt.0.0d0) print *,"??WTF??" +C print *,sslipi,sslipj,bordlipbot,zi,zj + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) +C xj=xj-xi +C yj=yj-yi +C zj=zj-zi c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi c write (iout,*) "j",j," dc_norm", c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + +c write (iout,'(a7,4f8.3)') +c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb + if (sss.gt.0.0d0) then C Calculate angle-dependent terms of energy and contributions to their C derivatives. call sc_angular @@ -1468,18 +1887,24 @@ cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) +C here to start with +C if (c(i,3).gt. + faclip=fac + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt +C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij, +C &((sslipi+sslipj)/2.0d0+ +C &(2.0d0-sslipi-sslipj)/2.0d0) c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij + evdw=evdw+evdwij*sss if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,chi1,chi2,chip1,chip2, @@ -1496,16 +1921,32 @@ C Calculate gradient components. fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac +c print '(2i4,6f8.4)',i,j,sss,sssgrad* +c & evdwij,fac,sigma(itypi,itypj),expon + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij c fac=0.0d0 C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt) + &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip* + & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj)) + &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi +C gg_lipi(3)=0.0d0 +C gg_lipj(3)=0.0d0 gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac C Calculate angular part of the gradient. call sc_grad + endif + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i +C enddo ! zshift +C enddo ! yshift +C enddo ! xshift c write (iout,*) "Number of loop steps in EGB:",ind cccc energy_dec=.false. return @@ -1518,6 +1959,7 @@ C assuming the Gay-Berne-Vorobjev potential of interaction. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -1527,8 +1969,11 @@ C include 'COMMON.INTERACT' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' + integer xshift,yshift,zshift common /srutu/ icall - logical lprn + logical lprn evdw=0.0D0 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 @@ -1536,12 +1981,49 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.eq.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +c write (iout,*)"xi yi zi box",xi,yi,zi,boxxsize,boxysize,boxzsize + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize +c write (iout,*)"xi yi zi box",xi,yi,zi,boxxsize,boxysize,boxzsize +C define scaling factor for lipids + +C if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + if ((zi.gt.bordlipbot) + & .and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1552,9 +2034,38 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,' ss' +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + +c write(iout,*) "PRZED TRI", evdwij + evdwij_przed_tri=evdwij + call triple_ssbond_ene(i,j,k,evdwij) +c if(evdwij_przed_tri.ne.evdwij) then +c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +c endif + +c write(iout,*) "PO TRI", evdwij +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,'tss' + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) @@ -1578,14 +2089,88 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi +C xj=c(1,nres+j)-xi +C yj=c(2,nres+j)-yi +C zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +c write (iout,*)"xj yj zj box",xj,yj,zj,boxxsize,boxysize,boxzsize + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +c write (iout,*)"xj yj zj box",xj,yj,zj,boxxsize,boxysize,boxzsize + if ((zj.gt.bordlipbot) + & .and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 +c write (iout,*) "dist_init",dist_init + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + + if (sss.gt.0.0d0) then + C Calculate angle-dependent terms of energy and contributions to their C derivatives. call sc_angular @@ -1601,8 +2186,8 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -1610,9 +2195,11 @@ c--------------------------------------------------------------- e_augm=augm(itypi,itypj)*fac_augm evdwij=evdwij*eps2rt*eps3rt evdw=evdw+evdwij+e_augm + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'evdw',i,j,evdwij if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), @@ -1626,12 +2213,16 @@ C Calculate gradient components. fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac-2*expon*rrij*e_augm + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac +c write (iout,*) "sss",sss," fac",fac," gg",gg C Calculate angular part of the gradient. call sc_grad + endif + ENDIF enddo ! j enddo ! iint enddo ! i @@ -1713,6 +2304,7 @@ C---------------------------------------------------------------------------- include 'COMMON.CALC' include 'COMMON.IOUNITS' double precision dcosom1(3),dcosom2(3) +cc print *,'sss=',sss eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 @@ -1731,16 +2323,16 @@ c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) enddo do k=1,3 - gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) + gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss enddo c write (iout,*) "gg",(gg(k),k=1,3) do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) + gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) + & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) @@ -1755,8 +2347,8 @@ cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) cgrad enddo cgrad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return end @@ -1784,9 +2376,9 @@ C cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1797,8 +2389,8 @@ C cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -1858,7 +2450,8 @@ C include 'COMMON.VECTORS' include 'COMMON.FFIELD' dimension ggg(3) -cd write(iout,*) 'In EELEC_soft_sphere' + integer xshift,yshift,zshift +C write(iout,*) 'In EELEC_soft_sphere' ees=0.0D0 evdw1=0.0D0 eel_loc=0.0d0 @@ -1866,17 +2459,23 @@ cd write(iout,*) 'In EELEC_soft_sphere' eello_turn4=0.0d0 ind=0 do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle + if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -1886,10 +2485,49 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) dxj=dc(1,j) dyj=dc(2,j) dzj=dc(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif rij=xj*xj+yj*yj+zj*zj + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) if (rij.lt.r0ijsq) then evdw1ij=0.25d0*(rij-r0ijsq)**2 fac=rij-r0ijsq @@ -1897,13 +2535,13 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) evdw1ij=0.0d0 fac=0.0d0 endif - evdw1=evdw1+evdw1ij + evdw1=evdw1+evdw1ij*sss C C Calculate contributions to the Cartesian gradient. C - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj + ggg(1)=fac*xj*sssgrad + ggg(2)=fac*yj*sssgrad + ggg(3)=fac*zj*sssgrad do k=1,3 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) @@ -2102,13 +2740,15 @@ c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1) & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) time_gather=time_gather+MPI_Wtime()-time00 endif -c if (fg_rank.eq.0) then -c write (iout,*) "Arrays UY and UZ" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), -c & (uz(k,i),k=1,3) -c enddo -c endif +#endif +#ifdef DEBUG + if (fg_rank.eq.0) then + write (iout,*) "Arrays UY and UZ" + do i=1,nres-1 + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), + & (uz(k,i),k=1,3) + enddo + endif #endif return end @@ -2222,6 +2862,134 @@ C C Compute the virtual-bond-torsional-angle dependent quantities needed C to calculate the el-loc multibody terms of various order. C +c write(iout,*) 'nphi=',nphi,nres +c write(iout,*) "itype2loc",itype2loc +#ifdef PARMAT + do i=ivec_start+2,ivec_end+2 +#else + do i=3,nres+1 +#endif + if (i.gt. nnt+2 .and. i.lt.nct+2) then + iti = itype2loc(itype(i-2)) + else + iti=nloctyp + endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then + if (i.gt. nnt+1 .and. i.lt.nct+1) then + iti1 = itype2loc(itype(i-1)) + else + iti1=nloctyp + endif +c write(iout,*),i +#ifdef NEWCORR + cost1=dcos(theta(i-1)) + sint1=dsin(theta(i-1)) + sint1sq=sint1*sint1 + sint1cub=sint1sq*sint1 + sint1cost1=2*sint1*cost1 +c write (iout,*) "bnew1",i,iti +c write (iout,*) (bnew1(k,1,iti),k=1,3) +c write (iout,*) (bnew1(k,2,iti),k=1,3) +c write (iout,*) "bnew2",i,iti +c write (iout,*) (bnew2(k,1,iti),k=1,3) +c write (iout,*) (bnew2(k,2,iti),k=1,3) + do k=1,2 + b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1 + b1(k,i-2)=sint1*b1k + gtb1(k,i-2)=cost1*b1k-sint1sq* + & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1) + b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1 + b2(k,i-2)=sint1*b2k + gtb2(k,i-2)=cost1*b2k-sint1sq* + & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1) + enddo + do k=1,2 + aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1 + cc(1,k,i-2)=sint1sq*aux + gtcc(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1) + aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1 + dd(1,k,i-2)=sint1sq*aux + gtdd(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1) + enddo + cc(2,1,i-2)=cc(1,2,i-2) + cc(2,2,i-2)=-cc(1,1,i-2) + gtcc(2,1,i-2)=gtcc(1,2,i-2) + gtcc(2,2,i-2)=-gtcc(1,1,i-2) + dd(2,1,i-2)=dd(1,2,i-2) + dd(2,2,i-2)=-dd(1,1,i-2) + gtdd(2,1,i-2)=gtdd(1,2,i-2) + gtdd(2,2,i-2)=-gtdd(1,1,i-2) + do k=1,2 + do l=1,2 + aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1 + EE(l,k,i-2)=sint1sq*aux + gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti) + enddo + enddo + EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1 + EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1 + EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti) + EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti) + gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1 + gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1 + gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1 +c b1tilde(1,i-2)=b1(1,i-2) +c b1tilde(2,i-2)=-b1(2,i-2) +c b2tilde(1,i-2)=b2(1,i-2) +c b2tilde(2,i-2)=-b2(2,i-2) +#ifdef DEBUG + write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2) + write(iout,*) 'b1=',(b1(k,i-2),k=1,2) + write(iout,*) 'b2=',(b2(k,i-2),k=1,2) + write (iout,*) 'theta=', theta(i-1) +#endif +#else + if (i.gt. nnt+2 .and. i.lt.nct+2) then + iti = itype2loc(itype(i-2)) + else + iti=nloctyp + endif +c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then + if (i.gt. nnt+1 .and. i.lt.nct+1) then + iti1 = itype2loc(itype(i-1)) + else + iti1=nloctyp + endif + b1(1,i-2)=b(3,iti) + b1(2,i-2)=b(5,iti) + b2(1,i-2)=b(2,iti) + b2(2,i-2)=b(4,iti) + do k=1,2 + do l=1,2 + CC(k,l,i-2)=ccold(k,l,iti) + DD(k,l,i-2)=ddold(k,l,iti) + EE(k,l,i-2)=eeold(k,l,iti) + enddo + enddo +#endif + b1tilde(1,i-2)= b1(1,i-2) + b1tilde(2,i-2)=-b1(2,i-2) + b2tilde(1,i-2)= b2(1,i-2) + b2tilde(2,i-2)=-b2(2,i-2) +c + Ctilde(1,1,i-2)= CC(1,1,i-2) + Ctilde(1,2,i-2)= CC(1,2,i-2) + Ctilde(2,1,i-2)=-CC(2,1,i-2) + Ctilde(2,2,i-2)=-CC(2,2,i-2) +c + Dtilde(1,1,i-2)= DD(1,1,i-2) + Dtilde(1,2,i-2)= DD(1,2,i-2) + Dtilde(2,1,i-2)=-DD(2,1,i-2) + Dtilde(2,2,i-2)=-DD(2,2,i-2) +#ifdef DEBUG + write(iout,*) "i",i," iti",iti + write(iout,*) 'b1=',(b1(k,i-2),k=1,2) + write(iout,*) 'b2=',(b2(k,i-2),k=1,2) +#endif + enddo #ifdef PARMAT do i=ivec_start+2,ivec_end+2 #else @@ -2295,15 +3063,15 @@ C endif c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then if (i.gt. nnt+2 .and. i.lt.nct+2) then - iti = itortyp(itype(i-2)) + iti = itype2loc(itype(i-2)) else - iti=ntortyp+1 + iti=nloctyp endif c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) + iti1 = itype2loc(itype(i-1)) else - iti1=ntortyp+1 + iti1=nloctyp endif cd write (iout,*) '*******i',i,' iti1',iti cd write (iout,*) 'b1',b1(:,iti) @@ -2311,15 +3079,25 @@ cd write (iout,*) 'b2',b2(:,iti) cd write (iout,*) 'Ug',Ug(:,:,i-2) c if (i .gt. iatel_s+2) then if (i .gt. nnt+2) then - call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) - call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) + call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2)) +#ifdef NEWCORR + call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2)) +c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj" +#endif +c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i), +c & EE(1,2,iti),EE(2,2,i) + call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2)) + call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2)) +c write(iout,*) "Macierz EUG", +c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2), +c & eug(2,2,i-2) if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) & then - call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) - call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) + call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2)) endif else do k=1,2 @@ -2334,40 +3112,54 @@ c if (i .gt. iatel_s+2) then enddo enddo endif - call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) - call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) + call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2)) + call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2)) do k=1,2 muder(k,i-2)=Ub2der(k,i-2) enddo c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) + if (itype(i-1).le.ntyp) then + iti1 = itype2loc(itype(i-1)) + else + iti1=nloctyp + endif else - iti1=ntortyp+1 + iti1=nloctyp endif do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) + mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) +c mu(k,i-2)=b1(k,i-1) +c mu(k,i-2)=Ub2(k,i-2) enddo -cd write (iout,*) 'mu ',mu(:,i-2) +#ifdef MUOUT + write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1), + & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2), + & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2), + & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2) + & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2), + & ((ee(l,k,i-2),l=1,2),k=1,2) +#endif cd write (iout,*) 'mu1',mu1(:,i-2) cd write (iout,*) 'mu2',mu2(:,i-2) +cd write (iout,*) 'mu',i-2,mu(:,i-2) if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) & then - call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) - call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) + call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2)) C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) + call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1)) call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) - call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) - call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) + call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2)) + call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2)) + call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2)) + call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2)) + call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2)) + call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2)) endif enddo C Matrices dependent on two consecutive virtual-bond dihedrals. @@ -2635,11 +3427,11 @@ c endif #endif #endif cd do i=1,nres -cd iti = itortyp(itype(i)) +cd iti = itype2loc(itype(i)) cd write (iout,*) i cd do j=1,2 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') -cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) +cd & (EE(j,k,i),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) cd enddo cd enddo return @@ -2672,10 +3464,11 @@ C include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.TIME1' + include 'COMMON.SPLITELE' dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 @@ -2754,9 +3547,25 @@ c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms C C Loop over i,i+2 and i,i+3 pairs of the peptide groups C +C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition do i=iturn3_start,iturn3_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle +c if (i.le.1) cycle +C write(iout,*) "tu jest i",i + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +C Adam: Unnecessary: handled by iturn3_end and iturn3_start +c & .or.((i+4).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana + & .or. itype(i+2).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1) cycle +C Adam: Instructions below will switch off existing interactions +c if(i.gt.1)then +c if(itype(i-1).eq.ntyp1)cycle +c end if +c if(i.LT.nres-3)then +c if (itype(i+4).eq.ntyp1) cycle +c end if dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2766,15 +3575,30 @@ C xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 call eelecij(i,i+2,ees,evdw1,eel_loc) if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) num_cont_hb(i)=num_conti enddo do i=iturn4_start,iturn4_end - if (itype(i).eq.21 .or. itype(i+1).eq.21 - & .or. itype(i+3).eq.21 - & .or. itype(i+4).eq.21) cycle + if (i.lt.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+5).gt.nres) +c & .or.((i-1).le.0) +C end of changes suggested by Ana + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1 +c & .or. itype(i+5).eq.ntyp1 +c & .or. itype(i).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2784,17 +3608,64 @@ C xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi +C Return atom into box, boxxsize is size of box in x dimension +c 194 continue +c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((0.5d0)*boxxsize)).or. +c & (xmedi.lt.((-0.5d0)*boxxsize))) then +c go to 194 +c endif +c 195 continue +c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((0.5d0)*boxysize)).or. +c & (ymedi.lt.((-0.5d0)*boxysize))) then +c go to 195 +c endif +c 196 continue +c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +C Condition for being inside the proper box +c if ((zmedi.gt.((0.5d0)*boxzsize)).or. +c & (zmedi.lt.((-0.5d0)*boxzsize))) then +c go to 196 +c endif + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + num_conti=num_cont_hb(i) +c write(iout,*) "JESTEM W PETLI" call eelecij(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & call eturn4(i,eello_turn4) num_cont_hb(i)=num_conti enddo ! i +C Loop over all neighbouring boxes +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c +CTU KURWA do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle +C do i=75,75 +c if (i.le.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+2).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana +c & .or. itype(i+2).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2804,15 +3675,65 @@ c xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize +C xmedi=xmedi+xshift*boxxsize +C ymedi=ymedi+yshift*boxysize +C zmedi=zmedi+zshift*boxzsize + +C Return tom into box, boxxsize is size of box in x dimension +c 164 continue +c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 164 +c endif +c 165 continue +c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. +c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then +c go to 165 +c endif +c 166 continue +c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +cC Condition for being inside the proper box +c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 166 +c endif + c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) +C I TU KURWA do j=ielstart(i),ielend(i) -c write (iout,*) i,j,itype(i),itype(j) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle +C do j=16,17 +C write (iout,*) i,j +C if (j.le.1) cycle + if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((j+2).gt.nres) +c & .or.((j-1).le.0) +C end of changes by Ana +c & .or.itype(j+2).eq.ntyp1 +c & .or.itype(j-1).eq.ntyp1 + &) cycle call eelecij(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti enddo ! i +C enddo ! zshift +C enddo ! yshift +C enddo ! xshift + c write (iout,*) "Number of loop steps in EELEC:",ind cd do i=1,nres cd write (iout,'(i3,3f10.5,5x,3f10.5)') @@ -2843,10 +3764,13 @@ C------------------------------------------------------------------------------- include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.TIME1' + include 'COMMON.SPLITELE' + include 'COMMON.SHIELD' dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4), + & gmuij2(4),gmuji2(4) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, & num_conti,j1,j2 @@ -2861,6 +3785,7 @@ C 13-go grudnia roku pamietnego... double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, & 0.0d0,1.0d0,0.0d0, & 0.0d0,0.0d0,1.0d0/ + integer xshift,yshift,zshift c time00=MPI_Wtime() cd write (iout,*) "eelecij",i,j c ind=ind+1 @@ -2877,10 +3802,84 @@ c ind=ind+1 dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi +C xj=c(1,j)+0.5D0*dxj-xmedi +C yj=c(2,j)+0.5D0*dyj-ymedi +C zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif +C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC +c 174 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 174 +c endif +c 175 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +C Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 175 +c endif +c 176 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 176 +c endif +C endif !endPBC condintion +C xj=xj-xmedi +C yj=yj-ymedi +C zj=zj-zmedi rij=xj*xj+yj*yj+zj*zj + + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) +c if (sss.gt.0.0d0) then rrmij=1.0D0/rij rij=dsqrt(rij) rmij=1.0D0/rij @@ -2896,50 +3895,145 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions ev2=bbb*r6ij fac3=ael6i*r6ij fac4=ael3i*r3ij - evdwij=ev1+ev2 + evdwij=(ev1+ev2) el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) el2=fac4*fac - eesij=el1+el2 +C MARYSIA +C eesij=(el1+el2) C 12/26/95 - for the evaluation of multi-body H-bonding interactions ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) + if (shield_mode.gt.0) then +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + el1=el1*fac_shield(i)**2*fac_shield(j)**2 + el2=el2*fac_shield(i)**2*fac_shield(j)**2 + eesij=(el1+el2) + ees=ees+eesij + else + fac_shield(i)=1.0 + fac_shield(j)=1.0 + eesij=(el1+el2) ees=ees+eesij - evdw1=evdw1+evdwij + endif + evdw1=evdw1+evdwij*sss cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij + write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') + &'evdw1',i,j,evdwij + &,iteli,itelj,aaa,evdw1,sss + write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, + &fac_shield(i),fac_shield(j) endif C C Calculate contributions to the Cartesian gradient. C #ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) + facvdw=-6*rrmij*(ev1+evdwij)*sss facel=-3*rrmij*(el1+eesij) fac1=fac erij(1)=xj*rmij erij(2)=yj*rmij erij(3)=zj*rmij + * * Radial derivatives. First process both termini of the fragment (i,j) * ggg(1)=facel*xj ggg(2)=facel*yj ggg(3)=facel*zj + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C if (iresshield.gt.i) then +C do ishi=i+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C else +C do ishi=iresshield,i +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C endif + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C if (iresshield.gt.j) then +C do ishi=j+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C +C enddo +C else +C do ishi=iresshield,j +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C enddo +C endif + enddo + enddo + + do k=1,3 + gshieldc(k,i)=gshieldc(k,i)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j)=gshieldc(k,j)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,i-1)=gshieldc(k,i-1)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j-1)=gshieldc(k,j-1)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + + enddo + endif c do k=1,3 c ghalf=0.5D0*ggg(k) c gelc(k,i)=gelc(k,i)+ghalf c gelc(k,j)=gelc(k,j)+ghalf c enddo c 9/28/08 AL Gradient compotents will be summed only at the end +C print *,"before", gelc_long(1,i), gelc_long(1,j) do k=1,3 gelc_long(k,j)=gelc_long(k,j)+ggg(k) +C & +grad_shield(k,j)*eesij/fac_shield(j) gelc_long(k,i)=gelc_long(k,i)-ggg(k) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,i-1)=gelc_long(k,i-1) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,j-1)=gelc_long(k,j-1) +C & +grad_shield(k,j)*eesij/fac_shield(j) enddo +C print *,"bafter", gelc_long(1,i), gelc_long(1,j) + * * Loop over residues i+1 thru j-1. * @@ -2948,9 +4042,15 @@ cgrad do l=1,3 cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + if (sss.gt.0.0) then + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj + else + ggg(1)=0.0 + ggg(2)=0.0 + ggg(3)=0.0 + endif c do k=1,3 c ghalf=0.5D0*ggg(k) c gvdwpp(k,i)=gvdwpp(k,i)+ghalf @@ -2970,8 +4070,9 @@ cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) cgrad enddo cgrad enddo #else - facvdw=ev1+evdwij - facel=el1+eesij +C MARYSIA + facvdw=(ev1+evdwij)*sss + facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel) erij(1)=xj*rmij @@ -2981,8 +4082,11 @@ cgrad enddo * Radial derivatives. First process both termini of the fragment (i,j) * ggg(1)=fac*xj +C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j) ggg(2)=fac*yj +C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j) ggg(3)=fac*zj +C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j) c do k=1,3 c ghalf=0.5D0*ggg(k) c gelc(k,i)=gelc(k,i)+ghalf @@ -3002,9 +4106,9 @@ cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj do k=1,3 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) @@ -3025,7 +4129,8 @@ c 9/28/08 AL Gradient compotents will be summed only at the end cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* + & fac_shield(i)**2*fac_shield(j)**2 enddo c do k=1,3 c ghalf=0.5D0*ggg(k) @@ -3041,16 +4146,23 @@ cgrad do l=1,3 cgrad gelc(l,k)=gelc(l,k)+ggg(l) cgrad enddo cgrad enddo +C print *,"before22", gelc_long(1,i), gelc_long(1,j) do k=1,3 gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) + & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) + & *fac_shield(i)**2*fac_shield(j)**2 gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) + & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) + & *fac_shield(i)**2*fac_shield(j)**2 gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo +C print *,"before33", gelc_long(1,i), gelc_long(1,j) + +C MARYSIA +c endif !sscale IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN @@ -3061,6 +4173,7 @@ C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms C are computed for EVERY pair of non-contiguous peptide groups. C + if (j.lt.nres-1) then j1=j+1 j2=j-1 @@ -3069,15 +4182,27 @@ C j2=j-2 endif kkk=0 + lll=0 do k=1,2 do l=1,2 kkk=kkk+1 muij(kkk)=mu(k,i)*mu(l,j) +c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l +#ifdef NEWCORR + gmuij1(kkk)=gtb1(k,i+1)*mu(l,j) +c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j) + gmuij2(kkk)=gUb2(k,i)*mu(l,j) + gmuji1(kkk)=mu(k,i)*gtb1(l,j+1) +c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i) + gmuji2(kkk)=mu(k,i)*gUb2(l,j) +#endif enddo enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij +#ifdef DEBUG + write (iout,*) 'EELEC: i',i,' j',j + write (iout,*) 'j',j,' j1',j1,' j2',j2 + write(iout,*) 'muij',muij +#endif ury=scalar(uy(1,i),erij) urz=scalar(uz(1,i),erij) vry=scalar(uy(1,j),erij) @@ -3087,10 +4212,23 @@ cd write(iout,*) 'muij',muij a32=scalar(uz(1,i),uy(1,j))-3*urz*vry a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz fac=dsqrt(-ael6i)*r3ij +#ifdef DEBUG + write (iout,*) "ury",ury," urz",urz," vry",vry," vrz",vrz + write (iout,*) "uyvy",scalar(uy(1,i),uy(1,j)), + & "uyvz",scalar(uy(1,i),uz(1,j)), + & "uzvy",scalar(uz(1,i),uy(1,j)), + & "uzvz",scalar(uz(1,i),uz(1,j)) + write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33 + write (iout,*) "fac",fac +#endif a22=a22*fac a23=a23*fac a32=a32*fac a33=a33*fac +#ifdef DEBUG + write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33 +#endif +#undef DEBUG cd write (iout,'(4i5,4f10.5)') cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij @@ -3238,24 +4376,146 @@ cgrad endif C Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) +#ifdef DEBUG + write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32, + & " a33",a33 + write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij, + & " wel_loc",wel_loc +#endif + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif + eel_loc_ij=eel_loc_ij + & *fac_shield(i)*fac_shield(j) +c if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') +c & 'eelloc',i,j,eel_loc_ij +C Now derivative over eel_loc + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij + & /fac_shield(i) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij + & /fac_shield(j) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_ll(k,i)=gshieldc_ll(k,i)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j)=gshieldc_ll(k,j)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + enddo + endif + + +c write (iout,*) 'i',i,' j',j,itype(i),itype(j), +c & ' eel_loc_ij',eel_loc_ij +C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4) +C Calculate patrial derivative for theta angle +#ifdef NEWCORR + geel_loc_ij=(a22*gmuij1(1) + & +a23*gmuij1(2) + & +a32*gmuij1(3) + & +a33*gmuij1(4)) + & *fac_shield(i)*fac_shield(j) +c write(iout,*) "derivative over thatai" +c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), +c & a33*gmuij1(4) + gloc(nphi+i,icg)=gloc(nphi+i,icg)+ + & geel_loc_ij*wel_loc +c write(iout,*) "derivative over thatai-1" +c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3), +c & a33*gmuij2(4) + geel_loc_ij= + & a22*gmuij2(1) + & +a23*gmuij2(2) + & +a32*gmuij2(3) + & +a33*gmuij2(4) + gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ + & geel_loc_ij*wel_loc + & *fac_shield(i)*fac_shield(j) + +c Derivative over j residue + geel_loc_ji=a22*gmuji1(1) + & +a23*gmuji1(2) + & +a32*gmuji1(3) + & +a33*gmuji1(4) +c write(iout,*) "derivative over thataj" +c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3), +c & a33*gmuji1(4) + + gloc(nphi+j,icg)=gloc(nphi+j,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) + + geel_loc_ji= + & +a22*gmuji2(1) + & +a23*gmuji2(2) + & +a32*gmuji2(3) + & +a33*gmuji2(4) +c write(iout,*) "derivative over thataj-1" +c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), +c & a33*gmuji2(4) + gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) +#endif cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij +c if (eel_loc_ij.ne.0) +c & write (iout,'(a4,2i4,8f9.5)')'chuj', +c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4) eel_loc=eel_loc+eel_loc_ij C Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) + & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) + & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) + & *fac_shield(i)*fac_shield(j) + gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) + & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) + & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) + & *fac_shield(i)*fac_shield(j) C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) + ggg(l)=(agg(l,1)*muij(1)+ + & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) cgrad ghalf=0.5d0*ggg(l) @@ -3269,14 +4529,22 @@ cgrad enddo cgrad enddo C Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ + & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ + & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ + & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ + & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + enddo ENDIF C Change 12/26/95 to calculate four-body contributions to H-bonding energy @@ -3355,8 +4623,18 @@ c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) ees0mij=0 endif c ees0mij=0.0D0 + if (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + else + ees0plist(num_conti,i)=j +C fac_shield(i)=0.4d0 +C fac_shield(j)=0.6d0 + endif ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) + & *fac_shield(i)*fac_shield(j) ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + & *fac_shield(i)*fac_shield(j) C Diagnostics. Comment out or remove after debugging! c ees0p(num_conti,i)=0.5D0*fac3*ees0pij c ees0m(num_conti,i)=0.5D0*fac3*ees0mij @@ -3424,17 +4702,29 @@ cgrad ghalfm=0.5D0*gggm(k) gacontp_hb1(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb2(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb3(k,num_conti,i)=gggp(k) + & *fac_shield(i)*fac_shield(j) + gacontm_hb1(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb2(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb3(k,num_conti,i)=gggm(k) + & *fac_shield(i)*fac_shield(j) + enddo C Diagnostics. Comment out or remove after debugging! cdiag do k=1,3 @@ -3486,10 +4776,13 @@ C Third- and fourth-order contributions from turns include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.SHIELD' dimension ggg(3) double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2), + & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2), + & auxgmat2(2,2),auxgmatt2(2,2) double precision agg(3,4),aggi(3,4),aggi1(3,4), & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, @@ -3513,11 +4806,84 @@ C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn3(i,a_temp,eello_turn3_num) call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) +c auxalary matices for theta gradient +c auxalary matrix for i+1 and constant i+2 + call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1)) +c auxalary matrix for i+2 and constant i+1 + call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1)) call transpose2(auxmat(1,1),auxmat1(1,1)) + call transpose2(auxgmat1(1,1),auxgmatt1(1,1)) + call transpose2(auxgmat2(1,1),auxgmatt2(1,1)) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) + call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1)) + call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, + & eello_t3 +C#ifdef NEWCORR +C Derivatives in theta + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) + & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) +C#endif + +C Derivatives in shield mode + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t3(k,i)=gshieldc_t3(k,i)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j)=gshieldc_t3(k,j)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + enddo + endif + +C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') cd write (2,*) 'i,',i,' j',j,'eello_turn3', cd & 0.5d0*(pizda(1,1)+pizda(2,2)), cd & ' eello_turn3_num',4*eello_turn3_num @@ -3526,12 +4892,14 @@ C Derivatives in gamma(i) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) call transpose2(auxmat2(1,1),auxmat3(1,1)) call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Cartesian derivatives do l=1,3 c ghalf1=0.5d0*agg(l,1) @@ -3545,6 +4913,8 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i)=gcorr3_turn(l,i) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + a_temp(1,1)=aggi1(l,1)!+agg(l,1) a_temp(1,2)=aggi1(l,2)!+agg(l,2) a_temp(2,1)=aggi1(l,3)!+agg(l,3) @@ -3552,6 +4922,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj(l,1)!+ghalf1 a_temp(1,2)=aggj(l,2)!+ghalf2 a_temp(2,1)=aggj(l,3)!+ghalf3 @@ -3559,6 +4930,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j)=gcorr3_turn(l,j) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3566,6 +4938,7 @@ c ghalf4=0.5d0*agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) enddo return end @@ -3586,10 +4959,15 @@ C Third- and fourth-order contributions from turns include 'COMMON.VECTORS' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.SHIELD' dimension ggg(3) double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2), + & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2), + & gte1t(2,2),gte2t(2,2),gte3t(2,2), + & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2), + & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2) double precision agg(3,4),aggi(3,4),aggi1(3,4), & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, @@ -3609,58 +4987,192 @@ C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn4(i,a_temp,eello_turn4_num) c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 +c write(iout,*)"WCHODZE W PROGRAM" a_temp(1,1)=a22 a_temp(1,2)=a23 a_temp(2,1)=a32 a_temp(2,2)=a33 - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) + iti1=itype2loc(itype(i+1)) + iti2=itype2loc(itype(i+2)) + iti3=itype2loc(itype(i+3)) c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 call transpose2(EUg(1,1,i+1),e1t(1,1)) call transpose2(Eug(1,1,i+2),e2t(1,1)) call transpose2(Eug(1,1,i+3),e3t(1,1)) +C Ematrix derivative in theta + call transpose2(gtEUg(1,1,i+1),gte1t(1,1)) + call transpose2(gtEug(1,1,i+2),gte2t(1,1)) + call transpose2(gtEug(1,1,i+3),gte3t(1,1)) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) +c eta1 in derivative theta + call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) +c auxgvec is derivative of Ub2 so i+3 theta + call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1)) +c auxalary matrix of E i+1 + call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1)) +c s1=0.0 +c gs1=0.0 + s1=scalar2(b1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+3 + gs23=scalar2(gtb1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+2 + gs32=scalar2(b1(1,i+2),auxgvec(1)) +c derivative of E matix in theta of i+1 + gsE13=scalar2(b1(1,i+2),auxgEvec1(1)) + call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) +c ea31 in derivative theta + call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) +c auxilary matrix auxgvec of Ub2 with constant E matirx + call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1)) +c auxilary matrix auxgEvec1 of E matix with Ub2 constant + call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1)) + +c s2=0.0 +c gs2=0.0 + s2=scalar2(b1(1,i+1),auxvec(1)) +c derivative of theta i+1 with constant i+3 + gs13=scalar2(gtb1(1,i+1),auxvec(1)) +c derivative of theta i+2 with constant i+1 + gs21=scalar2(b1(1,i+1),auxgvec(1)) +c derivative of theta i+3 with constant i+1 + gsE31=scalar2(b1(1,i+1),auxgEvec3(1)) +c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2), +c & gtb1(1,i+1) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) +c two derivatives over diffetent matrices +c gtae3e2 is derivative over i+3 + call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1)) +c ae3gte2 is derivative over i+2 + call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) +c three possible derivative over theta E matices +c i+1 + call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1)) +c i+2 + call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1)) +c i+3 + call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) + + gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2)) + gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2)) + gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.6 +C fac_shield(j)=0.4 + endif eello_turn4=eello_turn4-(s1+s2+s3) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn4',i,j,-(s1+s2+s3) -cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), -cd & ' eello_turn4_num',8*eello_turn4_num + & *fac_shield(i)*fac_shield(j) + eello_t4=-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) +c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)') + & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3 +C Now derivative over shield: + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t4(k,i)=gshieldc_t4(k,i)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j)=gshieldc_t4(k,j)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + enddo + endif + + + + + + +cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), +cd & ' eello_turn4_num',8*eello_turn4_num +#ifdef NEWCORR + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & -(gs13+gsE13+gsEE1)*wturn4 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg) + & -(gs23+gs21+gsEE2)*wturn4 + & *fac_shield(i)*fac_shield(j) + + gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg) + & -(gs32+gsE31+gsEE3)*wturn4 + & *fac_shield(i)*fac_shield(j) + +c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)- +c & gs2 +#endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'eturn4',i,j,-(s1+s2+s3) +c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), +c & ' eello_turn4_num',8*eello_turn4_num C Derivatives in gamma(i) call transpose2(EUgder(1,1,i+1),e1tder(1,1)) call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call transpose2(EUgder(1,1,i+2),e2tder(1,1)) call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+2) call transpose2(EUgder(1,1,i+3),e3tder(1,1)) call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) if (j.lt.nres-1) then @@ -3671,15 +5183,16 @@ C Derivatives of this turn contributions in DC(i+2) a_temp(2,2)=agg(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) ggg(l)=-(s1+s2+s3) gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo endif C Remaining derivatives of this turn contribution @@ -3690,57 +5203,61 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggi(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) a_temp(2,2)=aggi1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) a_temp(2,2)=aggj(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) a_temp(2,2)=aggj1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo return end @@ -3796,32 +5313,134 @@ C include 'COMMON.IOUNITS' include 'COMMON.CONTROL' dimension ggg(3) + integer xshift,yshift,zshift evdw2=0.0D0 evdw2_14=0.0d0 r0_scp=4.5d0 cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) - +C Return atom into box, boxxsize is size of box in x dimension +c 134 continue +c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize +c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize +C Condition for being inside the proper box +c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 134 +c endif +c 135 continue +c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize +c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize +C Condition for being inside the proper box +c if ((yi.gt.((yshift+0.5d0)*boxysize)).or. +c & (yi.lt.((yshift-0.5d0)*boxysize))) then +c go to 135 +c c endif +c 136 continue +c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize +c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize +cC Condition for being inside the proper box +c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 136 +c endif + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize +C xi=xi+xshift*boxxsize +C yi=yi+yshift*boxysize +C zi=zi+zshift*boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - if (itype(j).eq.21) cycle - itypj=itype(j) + if (itype(j).eq.ntyp1) cycle + itypj=iabs(itype(j)) C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) +c 174 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 174 +c endif +c 175 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +cC Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 175 +c endif +c 176 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 176 + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif +c c endif +C xj=xj-xi +C yj=yj-yi +C zj=zj-zi rij=xj*xj+yj*yj+zj*zj + r0ij=r0_scp r0ijsq=r0ij*r0ij if (rij.lt.r0ijsq) then @@ -3872,6 +5491,9 @@ cgrad enddo enddo ! iint enddo ! i +C enddo !zshift +C enddo !yshift +C enddo !xshift return end C----------------------------------------------------------------------------- @@ -3892,48 +5514,167 @@ C include 'COMMON.FFIELD' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + integer xshift,yshift,zshift dimension ggg(3) evdw2=0.0D0 evdw2_14=0.0d0 +c print *,boxxsize,boxysize,boxzsize,'wymiary pudla' cd print '(a)','Enter ESCP' cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 +c write (iout,*) "INIgvdwc_scp" +c do i=1,nres +c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gvdwc_scp(j,i),j=1,3), +c & (gvdwc_scpp(j,i),j=1,3) +c enddo + if (energy_dec) write (iout,*) "escp:",r_cut,rlamb do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize +c xi=xi+xshift*boxxsize +c yi=yi+yshift*boxysize +c zi=zi+zshift*boxzsize +c print *,xi,yi,zi,'polozenie i' +C Return atom into box, boxxsize is size of box in x dimension +c 134 continue +c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize +c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize +C Condition for being inside the proper box +c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 134 +c endif +c 135 continue +c print *,xi,boxxsize,"pierwszy" +c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize +c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize +C Condition for being inside the proper box +c if ((yi.gt.((yshift+0.5d0)*boxysize)).or. +c & (yi.lt.((yshift-0.5d0)*boxysize))) then +c go to 135 +c endif +c 136 continue +c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize +c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize +C Condition for being inside the proper box +c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 136 +c endif do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +c 174 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 174 +c endif +c 175 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +cC Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 175 +c endif +c 176 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 176 +c endif +CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif +c print *,xj,yj,zj,'polozenie j' rrij=1.0D0/(xj*xj+yj*yj+zj*zj) +c print *,rrij + sss=sscale(1.0d0/(dsqrt(rrij))) +c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz' +c if (sss.eq.0) print *,'czasem jest OK' + if (sss.le.0.0d0) cycle + sssgrad=sscagrad(1.0d0/(dsqrt(rrij))) fac=rrij**expon2 e1=fac*fac*aad(itypj,iteli) e2=fac*bad(itypj,iteli) if (iabs(j-i) .le. 2) then e1=scal14*e1 e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 + evdw2_14=evdw2_14+(e1+e2)*sss endif evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij + evdw2=evdw2+evdwij*sss + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') + & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli), + & bad(itypj,iteli) C C Calculate contributions to the gradient in the virtual-bond and SC vectors. C - fac=-(evdwij+e1)*rrij + fac=-(evdwij+e1)*rrij*sss + fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -3968,10 +5709,14 @@ cgrad enddo gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo - enddo +c endif !endif for sscale cutoff + enddo ! j enddo ! iint enddo ! i +c enddo !zshift +c enddo !yshift +c enddo !xshift do i=1,nct do j=1,3 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) @@ -3988,6 +5733,12 @@ C of GVDWC and GRADX. Remember to multiply them by this factor before further C use! C C****************************************************************************** +c write (iout,*) "gvdwc_scp" +c do i=1,nres +c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gvdwc_scp(j,i),j=1,3), +c & (gvdwc_scpp(j,i),j=1,3) +c enddo + return end C-------------------------------------------------------------------------- @@ -4003,8 +5754,13 @@ C include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' dimension ggg(3) ehpb=0.0D0 + do i=1,3 + ggg(i)=0.0d0 + enddo +C write (iout,*) ,"link_end",link_end,constr_dist cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr cd write(iout,*)'link_start=',link_start,' link_end=',link_end if (link_end.eq.0) return @@ -4021,52 +5777,118 @@ C iii and jjj point to the residues for which the distance is assigned. iii=ii jjj=jj endif -cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj +c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, +c & dhpb(i),dhpb1(i),forcon(i) C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. +C & iabs(itype(jjj)).eq.1) then +cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds + if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond - additional check + if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. + & iabs(itype(jjj)).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij + endif cd write (iout,*) "eij",eij +cd & ' waga=',waga,' fac=',fac + else if (ii.gt.nres .and. jj.gt.nres) then +c Restraints from contact prediction + dd=dist(ii,jj) + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj, + & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "beta nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + dd=dist(ii,jj) + rdis=dd-dhpb(i) +C Get the force constant corresponding to this distance. + waga=forcon(i) +C Calculate the contribution to energy. + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "beta reg",dd,waga*rdis*rdis +C +C Evaluate gradient. +C + fac=waga*rdis/dd + endif + endif + do j=1,3 + ggg(j)=fac*(c(j,jj)-c(j,ii)) + enddo + do j=1,3 + ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) + ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) + enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo else C Calculate the distance between the two points and its difference from the C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) + dd=dist(ii,jj) + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj, + & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "alph nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + rdis=dd-dhpb(i) C Get the force constant corresponding to this distance. - waga=forcon(i) + waga=forcon(i) C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "alpha reg",dd,waga*rdis*rdis C C Evaluate gradient. C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo + fac=waga*rdis/dd + endif + endif + do j=1,3 + ggg(j)=fac*(c(j,jj)-c(j,ii)) + enddo cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) C If this is a SC-SC distance, we need to calculate the contributions to the C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then + if (iii.lt.ii) then do j=1,3 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) enddo - endif + endif cgrad do j=iii,jjj-1 cgrad do k=1,3 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) cgrad enddo cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo endif enddo - ehpb=0.5D0*ehpb + if (constr_dist.ne.11) ehpb=0.5D0*ehpb return end C-------------------------------------------------------------------------- @@ -4088,7 +5910,7 @@ C include 'COMMON.VAR' include 'COMMON.IOUNITS' double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) + itypi=iabs(itype(i)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -4097,7 +5919,7 @@ C dzi=dc_norm(3,nres+i) c dsci_inv=dsc_inv(itypi) dsci_inv=vbld_inv(nres+i) - itypj=itype(j) + itypj=iabs(itype(j)) c dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(nres+j) xj=c(1,nres+j)-xi @@ -4179,36 +6001,45 @@ c estr=0.0d0 estr1=0.0d0 do i=ibondp_start,ibondp_end - if (itype(i-1).eq.21 .or. itype(i).eq.21) then - estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) - do j=1,3 - gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) - & *dc(j,i-1)/vbld(i) - enddo - if (energy_dec) write(iout,*) - & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) - else + if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle +c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) +c do j=1,3 +c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) +c & *dc(j,i-1)/vbld(i) +c enddo +c if (energy_dec) write(iout,*) +c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) +c else +C Checking if it involves dummy (NH3+ or COO-) group + if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then +C YES vbldpDUM is the equlibrium length of spring for Dummy atom + diff = vbld(i)-vbldpDUM + if (energy_dec) write(iout,*) "dum_bond",i,diff + else +C NO vbldp0 is the equlibrium lenght of spring for peptide group diff = vbld(i)-vbldp0 - if (energy_dec) write (iout,*) + endif + if (energy_dec) write (iout,'(a7,i5,4f7.3)') & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff estr=estr+diff*diff do j=1,3 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) enddo c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - endif +c endif enddo + estr=0.5d0*AKP*estr+estr1 c c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included c do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10 .and. iti.ne.21) then + iti=iabs(itype(i)) + if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) - if (energy_dec) write (iout,*) + if (energy_dec) write (iout,*) & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff, & AKSC(1,iti),AKSC(1,iti)*diff*diff estr=estr+0.5d0*AKSC(1,iti)*diff*diff @@ -4267,6 +6098,7 @@ C include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' common /calcthet/ term1,term2,termm,diffak,ratak, & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, & delthe0,sig0inv,sigtc,sigsqtc,delthec,it @@ -4277,11 +6109,25 @@ c time12=1.0d0 etheta=0.0D0 c write (*,'(a,i2)') 'EBEND ICG=',icg do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle C Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) it=itype(i-1) - if (i.gt.3 .and. itype(i-2).ne.21) then + ichir1=isign(1,itype(i-2)) + ichir2=isign(1,itype(i)) + if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) + if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) + if (itype(i-1).eq.10) then + itype1=isign(10,itype(i-2)) + ichir11=isign(1,itype(i-2)) + ichir12=isign(1,itype(i-2)) + itype2=isign(10,itype(i)) + ichir21=isign(1,itype(i)) + ichir22=isign(1,itype(i)) + endif + + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -4294,7 +6140,7 @@ C Zero the energy function and its derivative at 0 or pi. y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4302,8 +6148,8 @@ C Zero the energy function and its derivative at 0 or pi. z(1)=cos(phii1) #else phii1=phi(i+1) - z(1)=dcos(phii1) #endif + z(1)=dcos(phii1) z(2)=dsin(phii1) else z(1)=0.0D0 @@ -4314,15 +6160,28 @@ C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). C In following comments this theta will be referred to as t_c. thet_pred_mean=0.0d0 do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) + athetk=athet(k,it,ichir1,ichir2) + bthetk=bthet(k,it,ichir1,ichir2) + if (it.eq.10) then + athetk=athet(k,itype1,ichir11,ichir12) + bthetk=bthet(k,itype2,ichir21,ichir22) + endif + thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) +c write(iout,*) 'chuj tu', y(k),z(k) enddo dthett=thet_pred_mean*ssd thet_pred_mean=thet_pred_mean*ss+a0thet(it) C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss + dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) + &+athet(2,it,ichir1,ichir2)*y(1))*ss + dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) + & +bthet(2,it,ichir1,ichir2)*z(1))*ss + if (it.eq.10) then + dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) + &+athet(2,itype1,ichir11,ichir12)*y(1))*ss + dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) + & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss + endif if (theta(i).gt.pi-delta) then call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, & E_tc0) @@ -4345,12 +6204,13 @@ C Derivatives of the "mean" values in gamma1 and gamma2. & E_theta,E_tc) endif etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai + if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)') + & 'ebend',i,ethetai,theta(i),itype(i) if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) + gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg) enddo + C Ufff.... We've done all this!!! return end @@ -4367,7 +6227,8 @@ C--------------------------------------------------------------------------- C Calculate the contributions to both Gaussian lobes. C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) C The "polynomial part" of the "standard deviation" of this part of -C the distribution. +C the distributioni. +ccc write (iout,*) thetai,thet_pred_mean sig=polthet(3,it) do j=2,0,-1 sig=sig*thet_pred_mean+polthet(j,it) @@ -4397,6 +6258,7 @@ C Following variable is sigma(t_c)**(-2) delthe0=thetai-theta0i term1=-0.5D0*sigcsq*delthec*delthec term2=-0.5D0*sig0inv*delthe0*delthe0 +C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and C NaNs in taking the logarithm. We extract the largest exponent which is added C to the energy (this being the log of the distribution) at the end of energy @@ -4424,6 +6286,7 @@ C Contribution of the bending energy from this theta is just the -log of C the sum of the contributions from the two lobes and the pre-exponential C factor. Simple enough, isn't it? ethetai=(-dlog(termexp)-termm+dlog(termpre)) +C write (iout,*) 'termexp',termexp,termm,termpre,i C NOW the derivatives!!! C 6/6/97 Take into account the deformation. E_theta=(delthec*sigcsq*term1 @@ -4483,6 +6346,7 @@ C include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), @@ -4490,37 +6354,44 @@ C logical lprn /.false./, lprn1 /.false./ etheta=0.0D0 do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle +c print *,i,itype(i-1),itype(i),itype(i-2) + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle +C print *,i,theta(i) + if (iabs(itype(i+1)).eq.20) iblock=2 + if (iabs(itype(i+1)).ne.20) iblock=1 dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) + ityp2=ithetyp((itype(i-1))) do k=1,nntheterm coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.21) then +C print *,ethetai + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) #endif - ityp1=ithetyp(itype(i-2)) + ityp1=ithetyp((itype(i-2))) +C propagation of chirality for glycine type do k=1,nsingle cosph1(k)=dcos(k*phii) sinph1(k)=dsin(k*phii) enddo else phii=0.0d0 - ityp1=nthetyp+1 do k=1,nsingle + ityp1=ithetyp((itype(i-2))) cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.21) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4528,20 +6399,20 @@ C #else phii1=phi(i+1) #endif - ityp3=ithetyp(itype(i)) + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=dcos(k*phii1) sinph2(k)=dsin(k*phii1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 enddo endif - ethetai=aa0thet(ityp1,ityp2,ityp3) + ethetai=aa0thet(ityp1,ityp2,ityp3,iblock) do k=1,ndouble do l=1,k-1 ccl=cosph1(l)*cosph2(k-l) @@ -4563,11 +6434,12 @@ C enddo endif do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) + ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k) + dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) & *coskt(k) if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), + & write (iout,*) "k",k," + & aathet",aathet(k,ityp1,ityp2,ityp3,iblock), & " ethetai",ethetai enddo if (lprn) then @@ -4584,55 +6456,63 @@ C enddo write(iout,*) "ethetai",ethetai endif +C print *,ethetai do m=1,ntheterm2 do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) + aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) + & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) + & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) + & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*aux*coskt(m) dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)) dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) + & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)) if (lprn) & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", + & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai +C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k) enddo enddo +C print *,"cosph1", (cosph1(k), k=1,nsingle) +C print *,"cosph2", (cosph2(k), k=1,nsingle) +C print *,"sinph1", (sinph1(k), k=1,nsingle) +C print *,"sinph2", (sinph2(k), k=1,nsingle) if (lprn) & write(iout,*) "ethetai",ethetai +C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k) do m=1,ntheterm3 do k=2,ndouble do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) + aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*coskt(m)*aux dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) if (lprn) then write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet", + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock), + & " ethetai",ethetai write (iout,*) cosph1ph2(l,k)*sinkt(m), & cosph1ph2(k,l)*sinkt(m), & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) @@ -4641,14 +6521,19 @@ C enddo enddo 10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') +c lprn1=.true. +C print *,ethetai + if (lprn1) + & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') & i,theta(i)*rad2deg,phii*rad2deg, & phii1*rad2deg,ethetai +c lprn1=.false. etheta=etheta+ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai enddo + return end #endif @@ -4678,9 +6563,9 @@ C ALPHA and OMEGA. c write (iout,'(a)') 'ESC' do i=loc_start,loc_end it=itype(i) - if (it.eq.21) cycle + if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 - nlobit=nlob(it) + nlobit=nlob(iabs(it)) c print *,'i=',i,' it=',it,' nlobit=',nlobit c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad theti=theta(i+1)-pipol @@ -4837,11 +6722,11 @@ C Compute the contribution to SC energy and derivatives do j=1,nlobit #ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin + adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin if(adexp.ne.adexp) adexp=1.0 expfac=dexp(adexp) #else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin) #endif cd print *,'j=',j,' expfac=',expfac escloc_i=escloc_i+expfac @@ -4923,7 +6808,7 @@ C Compute the contribution to SC energy and derivatives dersc12=0.0d0 do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin) escloc_i=escloc_i+expfac do k=1,2 dersc(k)=dersc(k)+Ax(k,j)*expfac @@ -4977,7 +6862,7 @@ C delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.21) cycle + if (itype(i).eq.ntyp1) cycle costtab(i+1) =dcos(theta(i+1)) sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) @@ -4986,7 +6871,7 @@ C cosfac=dsqrt(cosfac2) sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) - it=itype(i) + it=iabs(itype(i)) if (it.eq.10) goto 1 c C Compute the axes of tghe local cartesian coordinates system; store in @@ -5004,7 +6889,7 @@ C & dc_norm(3,i+nres) y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac enddo do j = 1,3 - z_prime(j) = -uz(j,i-1) + z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i))) enddo c write (2,*) "i",i c write (2,*) "x_prime",(x_prime(j),j=1,3) @@ -5036,7 +6921,7 @@ C C Compute the energy of the ith side cbain C c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) + it=iabs(itype(i)) do j = 1,65 x(j) = sc_parmin(j,it) enddo @@ -5044,7 +6929,7 @@ c write (2,*) "xx",xx," yy",yy," zz",zz Cc diagnostics - remove later xx1 = dcos(alph(2)) yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) + zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2)) write(2,'(3f8.1,3f9.3,1x,3f9.3)') & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, & xx1,yy1,zz1 @@ -5086,7 +6971,9 @@ c & sumene4, c & dscp1,dscp2,sumene c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc +c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i) +c & ,zz,xx,yy +c#define DEBUG #ifdef DEBUG C C This section to check the numerical derivatives of the energy of ith side @@ -5130,6 +7017,7 @@ C End of diagnostics section. C C Compute the gradient of esc C +c zz=zz*dsign(1.0,dfloat(itype(i))) pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 @@ -5154,7 +7042,7 @@ C & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) & +(pom1+pom2)*pom_dx #ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num + write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i) #endif C sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz @@ -5169,7 +7057,7 @@ C & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) & +(pom1-pom2)*pom_dy #ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num + write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i) #endif C de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy @@ -5181,15 +7069,16 @@ C & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) #ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num + write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i) #endif C de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) & +pom1*pom_dt1+pom2*pom_dt2 #ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num + write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i) #endif +c#undef DEBUG c C cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) @@ -5214,13 +7103,16 @@ c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) dZZ_Ci1(k)=0.0d0 dZZ_Ci(k)=0.0d0 do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) + dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) + dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) enddo dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) + dZZ_XYZ(k)=vbld_inv(i+nres)* + & (z_prime(k)-zz*dC_norm(k,i+nres)) c dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) @@ -5383,7 +7275,7 @@ c------------------------------------------------------------------------------ C----------------------------------------------------------------------------- #ifdef CRYST_TOR C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) + subroutine etor(etors) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.VAR' @@ -5405,10 +7297,10 @@ c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end etors_ii=0.0D0 - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle + itori=itortyp(itype(i-2)) + itori1=itortyp(itype(i-1)) phii=phi(i) gloci=0.0D0 C Proline-Proline pair is a special case... @@ -5453,25 +7345,6 @@ C Proline-Proline pair is a special case... gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr return end c------------------------------------------------------------------------------ @@ -5481,7 +7354,7 @@ c------------------------------------------------------------------------------ end c---------------------------------------------------------------------------- #else - subroutine etor(etors,edihcnstr) + subroutine etor(etors) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.VAR' @@ -5502,17 +7375,29 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle +C ANY TWO ARE DUMMY ATOMS in row CYCLE +c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. +c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. +c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle +C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF +C For introducing the NH3+ and COO- group please check the etor_d for reference +C and guidance etors_ii=0.0D0 + if (iabs(itype(i)).eq.20) then + iblock=2 + else + iblock=1 + endif itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) gloci=0.0D0 C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) + do j=1,nterm(itori,itori1,iblock) + v1ij=v1(j,itori,itori1,iblock) + v2ij=v2(j,itori,itori1,iblock) cosphi=dcos(j*phii) sinphi=dsin(j*phii) etors=etors+v1ij*cosphi+v2ij*sinphi @@ -5527,7 +7412,7 @@ C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 C cosphi=dcos(0.5d0*phii) sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) + do j=1,nlor(itori,itori1,iblock) vl1ij=vlor1(j,itori,itori1) vl2ij=vlor2(j,itori,itori1) vl3ij=vlor3(j,itori,itori1) @@ -5540,39 +7425,17 @@ C gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom enddo C Subtract the constant term - etors=etors-v0(itori,itori1) + etors=etors-v0(itori,itori1,iblock) if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) + & 'etor',i,etors_ii-v0(itori,itori1,iblock) if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) + & (v1(j,itori,itori1,iblock),j=1,6), + & (v2(j,itori,itori1,iblock),j=1,6) gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr return end c---------------------------------------------------------------------------- @@ -5596,9 +7459,17 @@ C Set lprn=.true. for debugging lprn=.false. c lprn=.true. etors_d=0.0D0 +c write(iout,*) "a tu??" do i=iphid_start,iphid_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle +C ANY TWO ARE DUMMY ATOMS in row CYCLE +C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. +C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or. +C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or. +C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle + if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or. + & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or. + & (itype(i+1).eq.ntyp1)) cycle +C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) itori2=itortyp(itype(i)) @@ -5606,12 +7477,27 @@ c lprn=.true. phii1=phi(i+1) gloci1=0.0D0 gloci2=0.0D0 + iblock=1 + if (iabs(itype(i+1)).eq.20) iblock=2 +C Iblock=2 Proline type +C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT +C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO- +C if (itype(i+1).eq.ntyp1) iblock=3 +C The problem of NH3+ group can be resolved by adding new parameters please note if there +C IS or IS NOT need for this +C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on +C is (itype(i-3).eq.ntyp1) ntblock=2 +C ntblock is N-terminal blocking group + C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) + do j=1,ntermd_1(itori,itori1,itori2,iblock) +C Example of changes for NH3+ blocking group +C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock) +C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock) + v1cij=v1c(1,j,itori,itori1,itori2,iblock) + v1sij=v1s(1,j,itori,itori1,itori2,iblock) + v2cij=v1c(2,j,itori,itori1,itori2,iblock) + v2sij=v1s(2,j,itori,itori1,itori2,iblock) cosphi1=dcos(j*phii) sinphi1=dsin(j*phii) cosphi2=dcos(j*phii1) @@ -5621,12 +7507,12 @@ C Regular cosine and sine terms gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) enddo - do k=2,ntermd_2(itori,itori1,itori2) + do k=2,ntermd_2(itori,itori1,itori2,iblock) do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) + v1cdij = v2c(k,l,itori,itori1,itori2,iblock) + v2cdij = v2c(l,k,itori,itori1,itori2,iblock) + v1sdij = v2s(k,l,itori,itori1,itori2,iblock) + v2sdij = v2s(l,k,itori,itori1,itori2,iblock) cosphi1p2=dcos(l*phii+(k-l)*phii1) cosphi1m2=dcos(l*phii-(k-l)*phii1) sinphi1p2=dsin(l*phii+(k-l)*phii1) @@ -5645,6 +7531,291 @@ C Regular cosine and sine terms return end #endif +C---------------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine etor_kcc(etors) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + double precision c1(0:maxval_kcc),c2(0:maxval_kcc) + logical lprn +c double precision thybt1(maxtermkcc),thybt2(maxtermkcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode + etors=0.0D0 + do i=iphi_start,iphi_end +C ANY TWO ARE DUMMY ATOMS in row CYCLE +c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. +c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. +c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle + itori=itortyp(itype(i-2)) + itori1=itortyp(itype(i-1)) + phii=phi(i) + glocig=0.0D0 + glocit1=0.0d0 + glocit2=0.0d0 +C to avoid multiple devision by 2 +c theti22=0.5d0*theta(i) +C theta 12 is the theta_1 /2 +C theta 22 is theta_2 /2 +c theti12=0.5d0*theta(i-1) +C and appropriate sinus function + sinthet1=dsin(theta(i-1)) + sinthet2=dsin(theta(i)) + costhet1=dcos(theta(i-1)) + costhet2=dcos(theta(i)) +C to speed up lets store its mutliplication + sint1t2=sinthet2*sinthet1 + sint1t2n=1.0d0 +C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma) +C +d_n*sin(n*gamma)) * +C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2))) +C we have two sum 1) Non-Chebyshev which is with n and gamma + nval=nterm_kcc_Tb(itori,itori1) + c1(0)=0.0d0 + c2(0)=0.0d0 + c1(1)=1.0d0 + c2(1)=1.0d0 + do j=2,nval + c1(j)=c1(j-1)*costhet1 + c2(j)=c2(j-1)*costhet2 + enddo + etori=0.0d0 + do j=1,nterm_kcc(itori,itori1) + cosphi=dcos(j*phii) + sinphi=dsin(j*phii) + sint1t2n1=sint1t2n + sint1t2n=sint1t2n*sint1t2 + sumvalc=0.0d0 + gradvalct1=0.0d0 + gradvalct2=0.0d0 + do k=1,nval + do l=1,nval + sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalct1=gradvalct1+ + & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalct2=gradvalct2+ + & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalct1=-gradvalct1*sinthet1 + gradvalct2=-gradvalct2*sinthet2 + sumvals=0.0d0 + gradvalst1=0.0d0 + gradvalst2=0.0d0 + do k=1,nval + do l=1,nval + sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalst1=gradvalst1+ + & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalst2=gradvalst2+ + & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalst1=-gradvalst1*sinthet1 + gradvalst2=-gradvalst2*sinthet2 + if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals + etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi) +C glocig is the gradient local i site in gamma + glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi) +C now gradient over theta_1 + glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi) + & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi) + glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi) + & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi) + enddo ! j + etors=etors+etori +C derivative over gamma + gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig +C derivative over theta1 + gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1 +C now derivative over theta2 + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2 + if (lprn) then + write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1, + & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori + write (iout,*) "c1",(c1(k),k=0,nval), + & " c2",(c2(k),k=0,nval) + endif + enddo + return + end +c--------------------------------------------------------------------------------------------- + subroutine etor_constr(edihcnstr) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.BOUNDS' + include 'COMMON.CONTROL' +! 6/20/98 - dihedral angle constraints + edihcnstr=0.0d0 +c do i=1,ndih_constr + if (raw_psipred) then + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + gaudih_i=vpsipred(1,i) + gauder_i=0.0d0 + do j=1,2 + s = sdihed(j,i) + cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2 + dexpcos_i=dexp(-cos_i*cos_i) + gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i + gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) + & *cos_i*dexpcos_i/s**2 + enddo + edihcnstr=edihcnstr-wdihc*dlog(gaudih_i) + gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i + if (energy_dec) + & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') + & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i), + & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i), + & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, + & -wdihc*dlog(gaudih_i) + enddo + else + + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + difi=pinorm(phii-phi0(i)) + if (difi.gt.drange(i)) then + difi=difi-drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else + difi=0.0 + endif + enddo + + endif + + return + end +c---------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine ebend_kcc(etheta) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + logical lprn + double precision thybt1(maxang_kcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode + etheta=0.0D0 + do i=ithet_start,ithet_end +c print *,i,itype(i-1),itype(i),itype(i-2) + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle + iti=iabs(itortyp(itype(i-1))) + sinthet=dsin(theta(i)) + costhet=dcos(theta(i)) + do j=1,nbend_kcc_Tb(iti) + thybt1(j)=v1bend_chyb(j,iti) + enddo + sumth1thyb=v1bend_chyb(0,iti)+ + & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) + if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg, + & sumth1thyb + ihelp=nbend_kcc_Tb(iti)-1 + gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) + etheta=etheta+sumth1thyb +C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet + enddo + return + end +c------------------------------------------------------------------------------------- + subroutine etheta_constr(ethetacnstr) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + ethetacnstr=0.0d0 +C print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=ithetaconstr_start,ithetaconstr_end + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif + if (energy_dec) then + write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", + & i,itheta,rad2deg*thetiii, + & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), + & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, + & gloc(itheta+nphi-2,icg) + endif + enddo + return + end c------------------------------------------------------------------------------ subroutine eback_sc_corr(esccor) c 7/21/2007 Correlations between the backbone-local and side-chain-local @@ -5671,29 +7842,53 @@ c amino-acid residues. C Set lprn=.true. for debugging lprn=.false. c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor +c write (iout,*) "EBACK_SC_COR",itau_start,itau_end esccor=0.0D0 - do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle + do i=itau_start,itau_end + if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) + isccori=isccortyp(itype(i-2)) + isccori1=isccortyp(itype(i-1)) +c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1) phii=phi(i) + do intertyp=1,3 !intertyp +cc Added 09 May 2012 (Adasko) +cc Intertyp means interaction type of backbone mainchain correlation: +c 1 = SC...Ca...Ca...Ca +c 2 = Ca...Ca...Ca...SC +c 3 = SC...Ca...Ca...SCi gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) + if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. + & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-1).eq.ntyp1))) + & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) + & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) + & .or.(itype(i).eq.ntyp1))) + & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. + & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-3).eq.ntyp1)))) cycle + if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle + if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) + & cycle + do j=1,nterm_sccor(isccori,isccori1) + v1ij=v1sccor(j,intertyp,isccori,isccori1) + v2ij=v2sccor(j,intertyp,isccori,isccori1) + cosphi=dcos(j*tauangle(intertyp,i)) + sinphi=dsin(j*tauangle(intertyp,i)) esccor=esccor+v1ij*cosphi+v2ij*sinphi gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo +c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp + gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) + & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1, + & (v1sccor(j,intertyp,isccori,isccori1),j=1,6) + & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6) gsccor_loc(i-3)=gsccor_loc(i-3)+gloci + enddo !intertyp enddo + return end c---------------------------------------------------------------------------- @@ -5762,6 +7957,7 @@ c------------------------------------------------------------------------------ include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' + include 'COMMON.SHIELD' double precision gx(3),gx1(3) logical lprn lprn=.false. @@ -5833,8 +8029,8 @@ C Set lprn=.true. for debugging & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), & j=1,num_cont_hb(i)) enddo + call flush(iout) endif - call flush(iout) do i=1,ntask_cont_from ncont_recv(i)=0 enddo @@ -5937,7 +8133,7 @@ C Send the number of contacts needed by other processors enddo c write (iout,*) "ISEND ended" c write (iout,*) "number of requests (nn)",ireq - call flush(iout) +c call flush(iout) if (ireq.gt.0) & call MPI_Waitall(ireq,req,status_array,ierr) c write (iout,*) @@ -5951,7 +8147,7 @@ C Receive contacts nn=ncont_recv(ii) c write (iout,*) "Receiving",nn," contacts from processor",iproc, c & " of CONT_TO_COMM group" - call flush(iout) +c call flush(iout) if (nn.gt.0) then ireq=ireq+1 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, @@ -6027,7 +8223,6 @@ c call flush(iout) gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) enddo enddo - call flush(iout) if (lprn) then write (iout,'(a)') 'Contact function values after receive:' do i=nnt,nct-2 @@ -6046,6 +8241,7 @@ c call flush(iout) & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), & j=1,num_cont_hb(i)) enddo + call flush(iout) endif ecorr=0.0D0 C Remove the loop below after debugging !!! @@ -6068,6 +8264,7 @@ C Calculate the local-electrostatic correlation terms jp1=iabs(j1) c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, c & ' jj=',jj,' kk=',kk +c call flush(iout) if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 & .or. j.lt.0 .and. j1.gt.0) .and. & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then @@ -6180,6 +8377,7 @@ C This subroutine calculates multi-body contributions to hydrogen-bonding include 'COMMON.CONTACTS' include 'COMMON.CHAIN' include 'COMMON.CONTROL' + include 'COMMON.SHIELD' double precision gx(3),gx1(3) integer num_cont_hb_old(maxres) logical lprn,ldone @@ -6203,7 +8401,6 @@ C Set lprn=.true. for debugging & j=1,num_cont_hb(i)) enddo endif - call flush(iout) do i=1,ntask_cont_from ncont_recv(i)=0 enddo @@ -6302,7 +8499,7 @@ C Send the number of contacts needed by other processors enddo c write (iout,*) "ISEND ended" c write (iout,*) "number of requests (nn)",ireq - call flush(iout) +c call flush(iout) if (ireq.gt.0) & call MPI_Waitall(ireq,req,status_array,ierr) c write (iout,*) @@ -6316,7 +8513,7 @@ C Receive contacts nn=ncont_recv(ii) c write (iout,*) "Receiving",nn," contacts from processor",iproc, c & " of CONT_TO_COMM group" - call flush(iout) +c call flush(iout) if (nn.gt.0) then ireq=ireq+1 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, @@ -6390,7 +8587,6 @@ c call flush(iout) enddo enddo enddo - call flush(iout) if (lprn) then write (iout,'(a)') 'Contact function values after receive:' do i=nnt,nct-2 @@ -6482,6 +8678,7 @@ cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) call calc_eello(i,jp,i+1,jp1,jj,kk) if (wcorr4.gt.0.0d0) & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) +CC & *fac_shield(i)**2*fac_shield(j)**2 if (energy_dec.and.wcorr4.gt.0.0d0) 1 write (iout,'(a6,4i5,0pf7.3)') 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) @@ -6601,9 +8798,12 @@ c------------------------------------------------------------------------------ include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' double precision gx(3),gx1(3) logical lprn lprn=.false. +C print *,"wchodze",fac_shield(i),shield_mode eij=facont_hb(jj,i) ekl=facont_hb(kk,k) ees0pij=ees0p(jj,i) @@ -6612,6 +8812,8 @@ c------------------------------------------------------------------------------ ees0mkl=ees0m(kk,k) ekont=eij*ekl ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) +C* +C & fac_shield(i)**2*fac_shield(j)**2 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) C Following 4 lines for diagnostics. cd ees0pkl=0.0D0 @@ -6624,7 +8826,7 @@ c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, c & 'gradcorr_long' C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees +C ecorr=ecorr+ekont*ees C Calculate multi-body contributions to the gradient. coeffpees0pij=coeffp*ees0pij coeffmees0mij=coeffm*ees0mij @@ -6675,7 +8877,89 @@ cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) cgrad enddo cgrad enddo c write (iout,*) "ehbcorr",ekont*ees +C print *,ekont,ees,i,k ehbcorr=ekont*ees +C now gradient over shielding +C return + if (shield_mode.gt.0) then + j=ees0plist(jj,i) + l=ees0plist(kk,k) +C print *,i,j,fac_shield(i),fac_shield(j), +C &fac_shield(k),fac_shield(l) + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + &+rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + + do ilist=1,ishield_list(k) + iresshield=shield_list(ilist,k) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(l) + iresshield=shield_list(ilist,l) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo +C print *,gshieldx(m,iresshield) + do m=1,3 + gshieldc_ec(m,i)=gshieldc_ec(m,i)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j)=gshieldc_ec(m,j)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + + gshieldc_ec(m,k)=gshieldc_ec(m,k)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l)=gshieldc_ec(m,l)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + + enddo + endif + endif return end #ifdef MOMENT @@ -6696,17 +8980,17 @@ C--------------------------------------------------------------------------- & auxmat(2,2) iti1 = itortyp(itype(i+1)) if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) + itj1 = itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif do iii=1,2 dipi(iii,1)=Ub2(iii,i) dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) + dipi(iii,2)=b1(iii,i+1) dipj(iii,1)=Ub2(iii,j) dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) + dipj(iii,2)=b1(iii,j+1) enddo kkk=0 do iii=1,2 @@ -6786,16 +9070,16 @@ cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) if (l.eq.j+1) then C parallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) + itk1=itype2loc(itype(k+1)) + itj=itype2loc(itype(j)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif C A1 kernel(j+1) A2T cd do iii=1,2 @@ -6840,6 +9124,14 @@ cd endif call transpose2(EUg(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) +C AL 4/16/16: Derivatives of the quantitied related to matrices C, D, and E +c in theta; to be sriten later. +c#ifdef NEWCORR +c call transpose2(gtEE(1,1,k),auxmat(1,1)) +c call matmat2(auxmat(1,1),AEA(1,1,1),EAEAdert(1,1,1,1)) +c call transpose2(EUg(1,1,k),auxmat(1,1)) +c call matmat2(auxmat(1,1),AEAdert(1,1,1),EAEAdert(1,1,2,1)) +c#endif do iii=1,2 do kkk=1,5 do lll=1,3 @@ -6886,26 +9178,26 @@ C They are needed only when the fifth- or the sixth-order cumulants are C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) @@ -6914,20 +9206,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), + call matvec2(auxmat(1,1),b1(1,j), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -6939,17 +9231,17 @@ C End vectors else C Antiparallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif C A2 kernel(j-1)T A1T call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), @@ -7024,26 +9316,26 @@ C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) @@ -7052,20 +9344,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), + call matvec2(auxmat(1,1),b1(1,l), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,l), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -7153,9 +9445,18 @@ cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) if (l.eq.j+1) then gcorr_loc(l-1)=gcorr_loc(l-1) & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) +C Al 4/16/16: Derivatives in theta, to be added later. +c#ifdef NEWCORR +c gcorr_loc(nphi+l-1)=gcorr_loc(nphi+l-1) +c & -ekont*(EAEAdert(1,1,2,1)+EAEAdert(2,2,2,1)) +c#endif else gcorr_loc(j-1)=gcorr_loc(j-1) & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) +c#ifdef NEWCORR +c gcorr_loc(nphi+j-1)=gcorr_loc(nphi+j-1) +c & -ekont*(EAEAdert(1,1,2,1)+EAEAdert(2,2,2,1)) +c#endif endif do iii=1,2 do kkk=1,5 @@ -7287,9 +9588,9 @@ cd endif cd write (iout,*) cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk=itype2loc(itype(k)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) eello5_1=0.0d0 eello5_2=0.0d0 eello5_3=0.0d0 @@ -7358,11 +9659,11 @@ C Cartesian gradient c goto 1112 c1111 continue C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) + eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) C Explicit gradient in virtual-dihedral angles. g_corr5_loc(k-1)=g_corr5_loc(k-1) @@ -7372,11 +9673,11 @@ C Explicit gradient in virtual-dihedral angles. vv(2)=pizda(2,1)-pizda(1,2) if (l.eq.j+1) then g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) else g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) endif C Cartesian gradient @@ -7388,7 +9689,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) enddo enddo @@ -7439,11 +9740,11 @@ C Cartesian gradient cd goto 1112 C Contribution from graph IV cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) + call transpose2(EE(1,1,l),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) C Explicit gradient in virtual-dihedral angles. g_corr5_loc(l-1)=g_corr5_loc(l-1) @@ -7452,7 +9753,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l))) C Cartesian gradient do iii=1,2 @@ -7463,7 +9764,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) enddo enddo @@ -7512,11 +9813,11 @@ C Cartesian gradient cd goto 1112 C Contribution from graph IV 1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) + call transpose2(EE(1,1,j),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) C Explicit gradient in virtual-dihedral angles. g_corr5_loc(j-1)=g_corr5_loc(j-1) @@ -7525,7 +9826,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j))) C Cartesian gradient do iii=1,2 @@ -7536,7 +9837,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) enddo enddo @@ -7600,9 +9901,9 @@ cd ghalf=0.0d0 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) cgrad ghalf=0.5d0*ggg2(ll) cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2) gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2) gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl @@ -7809,7 +10110,7 @@ C o o o o C C i i C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) + itk=itype2loc(itype(k)) s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) @@ -7818,8 +10119,8 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) + vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) + vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) @@ -7832,8 +10133,8 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) + vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) + vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) if (l.eq.j+1) then g_corr6_loc(l-1)=g_corr6_loc(l-1) & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) @@ -7872,10 +10173,10 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) + vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) + & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) + vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) + & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) enddo @@ -7897,7 +10198,7 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -7907,12 +10208,12 @@ C C C o o C C \ /l\ /j\ / C C \ / \ / \ / C -C o| o | | o |o C +C o| o | | o |o C C \ j|/k\| \ |/k\|l C C \ / \ \ / \ C C o o C -C i i C -C C +C i i C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l C AL 7/4/01 s1 would occur in the sixth-order moment, @@ -8083,10 +10384,10 @@ c---------------------------------------------------------------------------- double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) logical swap CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C -C o o C +C o o C C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C @@ -8101,25 +10402,25 @@ C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. iti=itortyp(itype(i)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif #ifdef MOMENT s1=dip(4,jj,i)*dip(4,kk,k) #endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) + call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) @@ -8133,13 +10434,13 @@ cd & "sum",-(s2+s3+s4) #endif c eello6_graph3=-s4 C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) + call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) @@ -8156,12 +10457,12 @@ C Cartesian derivatives. s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) endif #endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), & pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) @@ -8200,7 +10501,7 @@ c---------------------------------------------------------------------------- & auxvec1(2),auxmat1(2,2) logical swap CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C @@ -8208,33 +10509,33 @@ C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C +C \ / \ \ / \ C C o \ o \ C C i i C -C C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) + iti=itype2loc(itype(i)) + itj=itype2loc(itype(j)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) + itk=itype2loc(itype(k)) if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) + itk1=itype2loc(itype(k+1)) else - itk1=ntortyp+1 + itk1=nloctyp endif - itl=itortyp(itype(l)) + itl=itype2loc(itype(l)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, @@ -8249,11 +10550,11 @@ cd & ' itl',itl,' itl1',itl1 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUg(1,1,k),auxmat(1,1)) call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) @@ -8277,11 +10578,11 @@ C Derivatives in gamma(i-1) #endif s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then @@ -8310,11 +10611,11 @@ C Derivatives in gamma(k-1) call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUgder(1,1,k),auxmat1(1,1)) call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) @@ -8380,12 +10681,12 @@ C Cartesian derivatives. s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) + & b1(1,j+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) else call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) + & b1(1,l+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) endif call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), & pizda(1,1)) @@ -8454,11 +10755,11 @@ c j=i+4 k=i+1 l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + iti=itype2loc(itype(i)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj cd write (2,*) 'i',i,' k',k,' j',j,' l',l cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then @@ -8485,17 +10786,17 @@ cd write (2,*) 'eello6_5',eello6_5 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmat(1,1)) call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) + ss1=scalar2(Ub2(1,i+2),b1(1,l)) s1 = (auxmat(1,1)+auxmat(2,2))*ss1 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) + s2 = scalar2(b1(1,k),vtemp1(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atemp(1,1)) call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) + call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1)) + s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) @@ -8505,7 +10806,7 @@ cd write (2,*) 'eello6_5',eello6_5 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) + ss13 = scalar2(b1(1,k),vtemp4(1)) s13 = (gtemp(1,1)+gtemp(2,2))*ss13 #endif c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 @@ -8524,7 +10825,7 @@ C Derivatives in gamma(i+2) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 call transpose2(AEAderg(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) @@ -8539,15 +10840,15 @@ C Derivatives in gamma(i+3) #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) + ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d #endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) + call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1)) + s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1)) #endif s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) #ifdef MOMENT @@ -8592,19 +10893,19 @@ C Derivatives in gamma(i+5) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) #ifdef MOMENT call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d #endif c s1d=0.0d0 @@ -8628,15 +10929,15 @@ C Cartesian derivatives call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) + & scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), & auxmatd(1,1)) @@ -8675,7 +10976,7 @@ c s13d=0.0d0 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d enddo @@ -8911,4 +11212,905 @@ crc print *,((prod(i,j),i=1,2),j=1,2) return end +CCC---------------------------------------------- + subroutine Eliptransfer(eliptran) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' +C this is done by Adasko +C print *,"wchodze" +C structure of box: +C water +C--bordliptop-- buffore starts +C--bufliptop--- here true lipid starts +C lipid +C--buflipbot--- lipid ends buffore starts +C--bordlipbot--buffore ends + eliptran=0.0 + do i=ilip_start,ilip_end +C do i=1,1 + if (itype(i).eq.ntyp1) cycle + + positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize)) + if (positi.le.0.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + if ((positi.gt.bordlipbot) + &.and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran + +C print *,"doing sccale for lower part" +C print *,i,sslip,fracinbuf,ssgradlip + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran +C print *, "doing sscalefor top part" +C print *,i,sslip,fracinbuf,ssgradlip + else + eliptran=eliptran+pepliptran +C print *,"I am in true lipid" + endif +C else +C eliptran=elpitran+0.0 ! I am in water + endif + enddo +C print *, "nic nie bylo w lipidzie?" +C now multiply all by the peptide group transfer factor +C eliptran=eliptran*pepliptran +C now the same for side chains +CV do i=1,1 + do i=ilip_start,ilip_end + if (itype(i).eq.ntyp1) cycle + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +c for each residue check if it is in lipid or lipid water border area +C respos=mod(c(3,i+nres),boxzsize) +C print *,positi,bordlipbot,buflipbot + if ((positi.gt.bordlipbot) + & .and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *,"doing sccale for lower part" + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0- + &((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *, "doing sscalefor top part",sslip,fracinbuf + else + eliptran=eliptran+liptranene(itype(i)) +C print *,"I am in true lipid" + endif + endif ! if in lipid or buffor +C else +C eliptran=elpitran+0.0 ! I am in water + enddo + return + end +C--------------------------------------------------------- +C AFM soubroutine for constant force + subroutine AFMforce(Eafmforce) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' + real*8 diffafm(3) + dist=0.0d0 + Eafmforce=0.0d0 + do i=1,3 + diffafm(i)=c(i,afmend)-c(i,afmbeg) + dist=dist+diffafm(i)**2 + enddo + dist=dsqrt(dist) + Eafmforce=-forceAFMconst*(dist-distafminit) + do i=1,3 + gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist + gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist + enddo +C print *,'AFM',Eafmforce + return + end +C--------------------------------------------------------- +C AFM subroutine with pseudoconstant velocity + subroutine AFMvel(Eafmforce) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' + real*8 diffafm(3) +C Only for check grad COMMENT if not used for checkgrad +C totT=3.0d0 +C-------------------------------------------------------- +C print *,"wchodze" + dist=0.0d0 + Eafmforce=0.0d0 + do i=1,3 + diffafm(i)=c(i,afmend)-c(i,afmbeg) + dist=dist+diffafm(i)**2 + enddo + dist=dsqrt(dist) + Eafmforce=0.5d0*forceAFMconst + & *(distafminit+totTafm*velAFMconst-dist)**2 +C Eafmforce=-forceAFMconst*(dist-distafminit) + do i=1,3 + gradafm(i,afmend-1)=-forceAFMconst* + &(distafminit+totTafm*velAFMconst-dist) + &*diffafm(i)/dist + gradafm(i,afmbeg-1)=forceAFMconst* + &(distafminit+totTafm*velAFMconst-dist) + &*diffafm(i)/dist + enddo +C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist + return + end +C----------------------------------------------------------- +C first for shielding is setting of function of side-chains + subroutine set_shield_fac + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0*sh_frac_dist-3.0d0) + fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C if ((i.eq.3).and.(k.eq.2)) then +C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist +C & ,"TU" +C endif + +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2) +C now costhet_grad +C costhet=0.0d0 + costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4 +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2) + cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4 + + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) + + cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) + enddo + + VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi) + & /VSolvSphere_div + & *wshield +C now the gradient... +C grad_shield is gradient of Calfa for peptide groups +C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist, +C & costhet,cosphi +C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group, +C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k) + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j) +C gradient po costhet + &-scale_fac_dist*costhet_grad(j)/(1.0-costhet) + &-scale_fac_dist*(cosphi_grad_long(j)) + &/(1.0-cosphi) )*div77_81 + &*VofOverlap +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet) + & +scale_fac_dist*(cosphi_grad_long(j)) + & *2.0d0/(1.0-cosphi)) + & *div77_81*VofOverlap + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*cosphi_grad_loc(j) + & *2.0d0/(1.0-cosphi) + & *div77_81*VofOverlap + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*div77_81+div4_81 +c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i) + enddo + return + end +C-------------------------------------------------------------------------- + double precision function tschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=y + do i=2,n + yy(i)=2*yy(1)*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i)*yy(i) + enddo + tschebyshev=aux + return + end +C-------------------------------------------------------------------------- + double precision function gradtschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n+1),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=2.0d0*y + do i=2,n + yy(i)=2*y*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i+1)*yy(i)*(i+1) +C print *, x(i+1),yy(i),i + enddo + gradtschebyshev=aux + return + end +C------------------------------------------------------------------------ +C first for shielding is setting of function of side-chains + subroutine set_shield_fac2 + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0d0*sh_frac_dist-3.0d0) + fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5d0 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C sh_frac_dist_grad(j)=0.0d0 +C scale_fac_dist=1.0d0 +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2) + sinthet=short/dist_pep_side*costhet +C now costhet_grad +C costhet=0.6d0 +C sinthet=0.8 + costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4 +C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet +C & -short/dist_pep_side**2/costhet) +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0d0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0d0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C rkprim=short + +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2) +C cosphi=0.6 + cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4 + sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ + & dist_pep_side**2) +C sinphi=0.8 + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) +C cosphi_grad_long(j)=0.0d0 + cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) +C cosphi_grad_loc(j)=0.0d0 + enddo +C print *,sinphi,sinthet +c write (iout,*) "VSolvSphere",VSolvSphere," VSolvSphere_div", +c & VSolvSphere_div," sinphi",sinphi," sinthet",sinthet + VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) + & /VSolvSphere_div +C & *wshield +C now the gradient... + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j)*VofOverlap +C gradient po costhet + & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & *VofOverlap + & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*( + & sinthet/sinphi*cosphi*cosphi_grad_loc(j) + & )) + & *wshield + enddo +c write (iout,*) "VofOverlap",VofOverlap," scale_fac_dist", +c & scale_fac_dist + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield) +c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i), +c & " wshield",wshield +c write(2,*) "TU",rpp(1,1),short,long,buff_shield + enddo + return + end +C----------------------------------------------------------------------- +C----------------------------------------------------------- +C This subroutine is to mimic the histone like structure but as well can be +C utilizet to nanostructures (infinit) small modification has to be used to +C make it finite (z gradient at the ends has to be changes as well as the x,y +C gradient has to be modified at the ends +C The energy function is Kihara potential +C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) +C 4eps is depth of well sigma is r_minimum r is distance from center of tube +C and r0 is the excluded size of nanotube (can be set to 0 if we want just a +C simple Kihara potential + subroutine calctube(Etube) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' + double precision tub_r,vectube(3),enetube(maxres*2) + Etube=0.0d0 + do i=1,2*nres + enetube(i)=0.0d0 + enddo +C first we calculate the distance from tube center +C first sugare-phosphate group for NARES this would be peptide group +C for UNRES + do i=1,nres +C lets ommit dummy atoms for now + if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle +C now calculate distance from center of tube and direction vectors + vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) + if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize + vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxxsize) + if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) +C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) + +C as the tube is infinity we do not calculate the Z-vector use of Z +C as chosen axis + vectube(3)=0.0d0 +C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +C and its 6 power + rdiff6=rdiff**6.0d0 +C for vectorization reasons we will sumup at the end to avoid depenence of previous + enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6 +C write(iout,*) "TU13",i,rdiff6,enetube(i) +C print *,rdiff,rdiff6,pep_aa_tube +C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +C now we calculate gradient + fac=(-12.0d0*pep_aa_tube/rdiff6+ + & 6.0d0*pep_bb_tube)/rdiff6/rdiff +C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), +C &rdiff,fac + +C now direction of gg_tube vector + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 + gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 + enddo + enddo +C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) + do i=1,nres +C Lets not jump over memory as we use many times iti + iti=itype(i) +C lets ommit dummy atoms for now + if ((iti.eq.ntyp1) +C in UNRES uncomment the line below as GLY has no side-chain... +C .or.(iti.eq.10) + & ) cycle + vectube(1)=c(1,i+nres) + vectube(1)=mod(vectube(1),boxxsize) + if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize + vectube(2)=c(2,i+nres) + vectube(2)=mod(vectube(2),boxxsize) + if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize + + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +C as the tube is infinity we do not calculate the Z-vector use of Z +C as chosen axis + vectube(3)=0.0d0 +C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +C and its 6 power + rdiff6=rdiff**6.0d0 +C for vectorization reasons we will sumup at the end to avoid depenence of previous + sc_aa_tube=sc_aa_tube_par(iti) + sc_bb_tube=sc_bb_tube_par(iti) + enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6 +C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +C now we calculate gradient + fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+ + & 6.0d0*sc_bb_tube/rdiff6/rdiff +C now direction of gg_tube vector + do j=1,3 + gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + enddo + do i=1,2*nres + Etube=Etube+enetube(i) + enddo +C print *,"ETUBE", etube + return + end +C TO DO 1) add to total energy +C 2) add to gradient summation +C 3) add reading parameters (AND of course oppening of PARAM file) +C 4) add reading the center of tube +C 5) add COMMONs +C 6) add to zerograd + +C----------------------------------------------------------------------- +C----------------------------------------------------------- +C This subroutine is to mimic the histone like structure but as well can be +C utilizet to nanostructures (infinit) small modification has to be used to +C make it finite (z gradient at the ends has to be changes as well as the x,y +C gradient has to be modified at the ends +C The energy function is Kihara potential +C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) +C 4eps is depth of well sigma is r_minimum r is distance from center of tube +C and r0 is the excluded size of nanotube (can be set to 0 if we want just a +C simple Kihara potential + subroutine calctube2(Etube) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.NAMES' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' + double precision tub_r,vectube(3),enetube(maxres*2) + Etube=0.0d0 + do i=1,2*nres + enetube(i)=0.0d0 + enddo +C first we calculate the distance from tube center +C first sugare-phosphate group for NARES this would be peptide group +C for UNRES + do i=1,nres +C lets ommit dummy atoms for now + if ((itype(i).eq.ntyp1).or.(itype(i+1).eq.ntyp1)) cycle +C now calculate distance from center of tube and direction vectors + vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) + if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize + vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxxsize) + if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) +C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) + +C as the tube is infinity we do not calculate the Z-vector use of Z +C as chosen axis + vectube(3)=0.0d0 +C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +C and its 6 power + rdiff6=rdiff**6.0d0 +C for vectorization reasons we will sumup at the end to avoid depenence of previous + enetube(i)=pep_aa_tube/rdiff6**2.0d0-pep_bb_tube/rdiff6 +C write(iout,*) "TU13",i,rdiff6,enetube(i) +C print *,rdiff,rdiff6,pep_aa_tube +C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +C now we calculate gradient + fac=(-12.0d0*pep_aa_tube/rdiff6+ + & 6.0d0*pep_bb_tube)/rdiff6/rdiff +C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), +C &rdiff,fac + +C now direction of gg_tube vector + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 + gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 + enddo + enddo +C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) + do i=1,nres +C Lets not jump over memory as we use many times iti + iti=itype(i) +C lets ommit dummy atoms for now + if ((iti.eq.ntyp1) +C in UNRES uncomment the line below as GLY has no side-chain... + & .or.(iti.eq.10) + & ) cycle + vectube(1)=c(1,i+nres) + vectube(1)=mod(vectube(1),boxxsize) + if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize + vectube(2)=c(2,i+nres) + vectube(2)=mod(vectube(2),boxxsize) + if (vectube(2).lt.0) vectube(2)=vectube(2)+boxxsize + + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) +C THIS FRAGMENT MAKES TUBE FINITE + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +c for each residue check if it is in lipid or lipid water border area +C respos=mod(c(3,i+nres),boxzsize) + print *,positi,bordtubebot,buftubebot,bordtubetop + if ((positi.gt.bordtubebot) + & .and.(positi.lt.bordtubetop)) then +C the energy transfer exist + if (positi.lt.buftubebot) then + fracinbuf=1.0d0- + & ((positi-bordtubebot)/tubebufthick) +C lipbufthick is thickenes of lipid buffore + sstube=sscalelip(fracinbuf) + ssgradtube=-sscagradlip(fracinbuf)/tubebufthick + print *,ssgradtube, sstube,tubetranene(itype(i)) + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) + gg_tube_SC(3,i)=gg_tube_SC(3,i) + &+ssgradtube*tubetranene(itype(i)) + gg_tube(3,i-1)= gg_tube(3,i-1) + &+ssgradtube*tubetranene(itype(i)) +C print *,"doing sccale for lower part" + elseif (positi.gt.buftubetop) then + fracinbuf=1.0d0- + &((bordtubetop-positi)/tubebufthick) + sstube=sscalelip(fracinbuf) + ssgradtube=sscagradlip(fracinbuf)/tubebufthick + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) +C gg_tube_SC(3,i)=gg_tube_SC(3,i) +C &+ssgradtube*tubetranene(itype(i)) +C gg_tube(3,i-1)= gg_tube(3,i-1) +C &+ssgradtube*tubetranene(itype(i)) +C print *, "doing sscalefor top part",sslip,fracinbuf + else + sstube=1.0d0 + ssgradtube=0.0d0 + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i)) +C print *,"I am in true lipid" + endif + else +C sstube=0.0d0 +C ssgradtube=0.0d0 + cycle + endif ! if in lipid or buffor +CEND OF FINITE FRAGMENT +C as the tube is infinity we do not calculate the Z-vector use of Z +C as chosen axis + vectube(3)=0.0d0 +C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +C and its 6 power + rdiff6=rdiff**6.0d0 +C for vectorization reasons we will sumup at the end to avoid depenence of previous + sc_aa_tube=sc_aa_tube_par(iti) + sc_bb_tube=sc_bb_tube_par(iti) + enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0-sc_bb_tube/rdiff6) + & *sstube+enetube(i+nres) +C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +C now we calculate gradient + fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff+ + & 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube +C now direction of gg_tube vector + do j=1,3 + gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + gg_tube_SC(3,i)=gg_tube_SC(3,i) + &+ssgradtube*enetube(i+nres)/sstube + gg_tube(3,i-1)= gg_tube(3,i-1) + &+ssgradtube*enetube(i+nres)/sstube + + enddo + do i=1,2*nres + Etube=Etube+enetube(i) + enddo +C print *,"ETUBE", etube + return + end +C TO DO 1) add to total energy +C 2) add to gradient summation +C 3) add reading parameters (AND of course oppening of PARAM file) +C 4) add reading the center of tube +C 5) add COMMONs +C 6) add to zerograd diff --git a/source/unres/src_MD-M/energy_split-sep.F b/source/unres/src_MD-M/energy_split-sep.F index 24ab8dd..d8ee63d 100644 --- a/source/unres/src_MD-M/energy_split-sep.F +++ b/source/unres/src_MD-M/energy_split-sep.F @@ -25,6 +25,7 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.MD' + include 'COMMON.CONTROL' c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot if (modecalc.eq.12.or.modecalc.eq.14) then #ifdef MPI @@ -132,6 +133,13 @@ C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue call vec_and_deriv +c write (iout,*) "etotal_long: shield_mode",shield_mode + if (shield_mode.eq.1) then + call set_shield_fac + else if (shield_mode.eq.2) then + call set_shield_fac2 + endif + if (ipot.lt.6) then #ifdef SPLITELE if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. @@ -195,7 +203,11 @@ C If performing constraint dynamics, call the constraint energy C after the equilibration time if(usampl.and.totT.gt.eq_time) then call EconstrQ - call Econstr_back + if (loc_qlike) then + call Econstr_back_qlike + else + call Econstr_back + endif else Uconst=0.0d0 Uconst_back=0.0d0 @@ -261,6 +273,8 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.LOCAL' + include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot c call flush(iout) @@ -414,7 +428,19 @@ C from other distance constraints. C C Calculate the virtual-bond-angle energy. C - call ebend(ebe) + if (wang.gt.0d0) then + if (tor_mode.eq.0) then + call ebend(ebe) + else +C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call ebend_kcc(ebe) + endif + else + ebe=0.0d0 + endif + ethetacnstr=0.0d0 + if (with_theta_constr) call etheta_constr(ethetacnstr) C C Calculate the SC local energy. C @@ -423,11 +449,28 @@ C C C Calculate the virtual-bond torsional energy. C - call etor(etors,edihcnstr) + if (wtor.gt.0.0d0) then + if (tor_mode.eq.0) then + call etor(etors) + else +C etor kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call etor_kcc(etors) + endif + else + etors=0.0d0 + endif + edihcnstr=0.0d0 + if (ndih_constr.gt.0) call etor_constr(edihcnstr) +c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C - call etor_d(etors_d) + if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then + call etor_d(etors_d) + else + etors_d=0 + endif C C 21/5/07 Calculate local sicdechain correlation energy C @@ -451,10 +494,19 @@ C energia(18)=0.0d0 #endif #ifdef SPLITELE + energia(3)=ees energia(16)=evdw1 #else - energia(3)=evdw1 + energia(3)=ees+evdw1 + energia(16)=0.0d0 #endif + energia(4)=ecorr + energia(5)=ecorr5 + energia(6)=ecorr6 + energia(7)=eel_loc + energia(8)=eello_turn3 + energia(9)=eello_turn4 + energia(11)=ebe energia(12)=escloc energia(13)=etors @@ -463,6 +515,7 @@ C energia(17)=estr energia(19)=edihcnstr energia(21)=esccor + energia(24)=ethetacnstr c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" call flush(iout) call sum_energy(energia,.true.) diff --git a/source/unres/src_MD-M/energy_split.F b/source/unres/src_MD-M/energy_split.F index 4a09d29..1b496a1 100644 --- a/source/unres/src_MD-M/energy_split.F +++ b/source/unres/src_MD-M/energy_split.F @@ -370,7 +370,7 @@ c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" endif c write (iout,*) 'Processor',myrank, c & ' calling etotal_short ipot=',ipot - call flush(iout) +c call flush(iout) c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct #endif c call int_from_cart1(.false.) @@ -385,7 +385,19 @@ C from other distance constraints. C C Calculate the virtual-bond-angle energy. C - call ebend(ebe) + if (wang.gt.0d0) then + if (tor_mode.eq.0) then + call ebend(ebe) + else +C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call ebend_kcc(ebe) + endif + else + ebe=0.0d0 + endif + ethetacnstr=0.0d0 + if (with_theta_constr) call etheta_constr(ethetacnstr) C C Calculate the SC local energy. C @@ -394,11 +406,29 @@ C C C Calculate the virtual-bond torsional energy. C - call etor(etors,edihcnstr) + if (wtor.gt.0.0d0) then + if (tor_mode.eq.0) then + call etor(etors) + else +C etor kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call etor_kcc(etors) + endif + else + etors=0.0d0 + endif + edihcnstr=0.0d0 + if (ndih_constr.gt.0) call etor_constr(edihcnstr) +c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C - call etor_d(etors_d) + if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then + call etor_d(etors_d) + else + etors_d=0 + endif + do i=1,n_ene energia(i)=0.0d0 enddo diff --git a/source/unres/src_MD-M/entmcm.F b/source/unres/src_MD-M/entmcm.F index 14576d5..e912ec5 100644 --- a/source/unres/src_MD-M/entmcm.F +++ b/source/unres/src_MD-M/entmcm.F @@ -95,7 +95,9 @@ C---------------------------------------------------------------------------- C Print internal coordinates of the initial conformation call intout else - call gen_rand_conf(1,*20) + jeden=1 + nrestmp=nres + call gen_rand_conf(jeden,nrestmp,*20) endif C---------------------------------------------------------------------------- C Compute and print initial energies. @@ -263,7 +265,8 @@ C Decide whether to generate a random conformation or perturb the old one if (print_mc.gt.0) & write (iout,'(2a,i3)') 'Random-generated conformation', & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) + nrestmp=nres + call gen_rand_conf(nstart_grow,nrestmp,*30) endif call geom_to_var(nvar,varia) cd write (iout,'(a)') 'New variables:' @@ -321,7 +324,7 @@ C-------------------------------------------------------------------------- endif C Check against conformation repetitions. irep=conf_comp(varia,etot) -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open (istat,file=statname,position='append') #else open (istat,file=statname,access='append') diff --git a/source/unres/src_MD-M/fitsq.f b/source/unres/src_MD-M/fitsq.f index 1c97e6d..bcadcae 100644 --- a/source/unres/src_MD-M/fitsq.f +++ b/source/unres/src_MD-M/fitsq.f @@ -44,7 +44,7 @@ c enddo enddo rms=dabs(rms/fn) - + c write(iout,*)'xav = ',(xav(j),j=1,3) c write(iout,*)'yav = ',(yav(j),j=1,3) c write(iout,*)'t = ',(t(j),j=1,3) diff --git a/source/unres/src_MD-M/gen_rand_conf.F b/source/unres/src_MD-M/gen_rand_conf.F index d870f55..6bb4f1a 100644 --- a/source/unres/src_MD-M/gen_rand_conf.F +++ b/source/unres/src_MD-M/gen_rand_conf.F @@ -1,4 +1,4 @@ - subroutine gen_rand_conf(nstart,*) + subroutine gen_rand_conf(nstart,nend,*) C Generate random conformation or chain cut and regrowth. implicit real*8 (a-h,o-z) include 'DIMENSIONS' @@ -10,15 +10,21 @@ C Generate random conformation or chain cut and regrowth. include 'COMMON.MCM' include 'COMMON.GEO' include 'COMMON.CONTROL' - logical overlap,back,fail -cd print *,' CG Processor',me,' maxgen=',maxgen + logical overlap,back,fail,ldir + maxgen=10000 + write (iout,*) ' CG Processor',me,' maxgen=',maxgen maxsi=100 -cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart + ldir = nstart.le.nend + write (iout,*) 'Gen_Rand_conf: nstart=',nstart,' nend',nend, + & ' ldir',ldir + + if (ldir) then + if (nstart.lt.5) then - it1=itype(2) - phi(4)=gen_phi(4,itype(2),itype(3)) + it1=iabs(itype(2)) + phi(4)=gen_phi(4,iabs(itype(2)),iabs(itype(3))) c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) + if (nstart.lt.3) theta(3)=gen_theta(iabs(itype(2)),pi,phi(4)) c write(iout,*)'theta(3)=',rad2deg*theta(3) if (it1.ne.10) then nsi=0 @@ -42,7 +48,7 @@ c write(iout,*)'theta(3)=',rad2deg*theta(3) nit=0 niter=0 back=.false. - do while (i.le.nres .and. niter.lt.maxgen) + do while (i.le.nend .and. niter.lt.maxgen) if (i.lt.nstart) then if(iprint.gt.1) then write (iout,'(/80(1h*)/2a/80(1h*))') @@ -54,9 +60,9 @@ c write(iout,*)'theta(3)=',rad2deg*theta(3) endif return1 endif - it1=itype(i-1) - it2=itype(i-2) - it=itype(i) + it1=iabs(itype(i-1)) + it2=iabs(itype(i-2)) + it=iabs(itype(i)) c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen phi(i+1)=gen_phi(i+1,it1,it) @@ -64,7 +70,7 @@ c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen phi(i)=gen_phi(i+1,it2,it1) c print *,'phi(',i,')=',phi(i) theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) - if (it2.ne.10) then + if (it2.ne.10 .and. it2.ne.ntyp1) then nsi=0 fail=.true. do while (fail.and.nsi.le.maxsi) @@ -76,7 +82,7 @@ c print *,'phi(',i,')=',phi(i) call locate_next_res(i-1) endif theta(i)=gen_theta(it1,phi(i),phi(i+1)) - if (it1.ne.10) then + if (it1.ne.10 .and. it1.ne.ntyp1) then nsi=0 fail=.true. do while (fail.and.nsi.le.maxsi) @@ -86,7 +92,7 @@ c print *,'phi(',i,')=',phi(i) if (nsi.gt.maxsi) return1 endif call locate_next_res(i) - if (overlap(i-1)) then + if (overlap(i-1,ldir)) then if (nit.lt.maxnit) then back=.true. nit=nit+1 @@ -121,23 +127,134 @@ c print *,'phi(',i,')=',phi(i) c(j,nres+1)=c(j,1) c(j,nres+nres)=c(j,nres) enddo + + else + + maxnit=100 + + i=nstart + nit=0 + niter=0 + back=.false. + do while (i.ge.nend .and. niter.lt.maxgen) + if (i.gt.nstart) then + if(iprint.gt.1) then + write (iout,'(/80(1h*)/2a/80(1h*))') + & 'Generation procedure went down to ', + & 'chain beginning. Cannot continue...' + write (*,'(/80(1h*)/2a/80(1h*))') + & 'Generation procedure went down to ', + & 'chain beginning. Cannot continue...' + endif + return1 + endif + it1=iabs(itype(i+1)) + it2=iabs(itype(i+2)) + it3=iabs(itype(i+3)) +c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, +c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen + phi(i+2)=gen_phi(i+2,it1,it2) + if (back) then + phi(i+3)=gen_phi(i+3,it2,it3) + phi(i+4)=gen_phi(i+3,it2,it3) +c print *,'phi(',i+3,')=',phi(i+3) + theta(i+3)=gen_theta(it2,phi(i+3),phi(i+4)) + if (it2.ne.10 .and. it2.ne.ntyp1) then + nsi=0 + fail=.true. + do while (fail.and.nsi.le.maxsi) + call gen_side(it2,theta(i+3),alph(i+2),omeg(i+2),fail) + nsi=nsi+1 + enddo + if (nsi.gt.maxsi) return1 + endif + call locate_prev_res(i+1) + endif + theta(i+2)=gen_theta(it1,phi(i+2),phi(i+3)) + write (iout,*) "i"," theta",theta(i+2)," phi",phi(i+2),phi(i+3) + if (it1.ne.10 .and. it1.ne.ntyp1) then + nsi=0 + fail=.true. + do while (fail.and.nsi.le.maxsi) + call gen_side(it1,theta(i+2),alph(i+1),omeg(i+1),fail) + nsi=nsi+1 + enddo + write (iout,*) "i",i," alpha",alph(i+1)," omeg",omeg(i+1), + & " fail",fail + if (nsi.gt.maxsi) return1 + endif + call locate_prev_res(i) + write (iout,*) "After locate_prev_res i=",i + write (iout,'(3f10.5,5x,3f10.5)') (c(l,i),l=1,3), + & (c(l,i+nres),l=1,3) + write (iout,'(3f10.5,5x,3f10.5)') (c(l,i+1),l=1,3), + & (c(l,i+1+nres),l=1,3) + call flush(iout) + if (overlap(i+1,ldir)) then + write (iout,*) "OVERLAP",nit + call flush(iout) + if (nit.lt.maxnit) then + back=.true. + nit=nit+1 + else + nit=0 + if (i.gt.3) then + back=.true. + i=i+1 + else + write (iout,'(a)') + & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' + write (*,'(a)') + & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' + return1 + endif + endif + else + write (iout,*) "================>> NO OVERLAP",i + call flush(iout) + back=.false. + nit=0 + i=i-1 + endif + niter=niter+1 + write (iout,*) "iter",niter + enddo + if (niter.ge.maxgen) then + write (iout,'(a,2i5)') + &'Too many trials in backward conformation generation',niter,maxgen + write (*,'(a,2i5)') + &'Too many trials in backward conformation generation',niter,maxgen + return1 + endif + + endif + + write (iout,*) "HERE!!!!" + return end c------------------------------------------------------------------------- - logical function overlap(i) + logical function overlap(i,ldir) implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.FFIELD' data redfac /0.5D0/ + logical ldir + logical lprn /.false./ overlap=.false. - iti=itype(i) + iti=iabs(itype(i)) if (iti.gt.ntyp) return C Check for SC-SC overlaps. cd print *,'nnt=',nnt,' nct=',nct +c write (iout,*) "overlap i",i," ldir",ldir + + if (ldir) then + do j=nnt,i-1 - itj=itype(j) + itj=iabs(itype(j)) if (j.lt.i-1 .or. ipot.ne.4) then rcomp=sigmaii(iti,itj) else @@ -146,9 +263,9 @@ cd print *,'nnt=',nnt,' nct=',nct cd print *,'j=',j if (dist(nres+i,nres+j).lt.redfac*rcomp) then overlap=.true. -c print *,'overlap, SC-SC: i=',i,' j=',j, -c & ' dist=',dist(nres+i,nres+j),' rcomp=', -c & rcomp + if (lprn) write (iout,*) 'overlap, SC-SC: i=',i,' j=',j, + & ' dist=',dist(nres+i,nres+j),' rcomp=', + & rcomp return endif enddo @@ -159,10 +276,10 @@ C SCs. c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) enddo do j=nnt,i-2 - itj=itype(j) -cd print *,'overlap, p-Sc: i=',i,' j=',j, -cd & ' dist=',dist(nres+j,maxres2+1) + itj=iabs(itype(j)) if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then + if (lprn) write (iout,*) 'overlap, p-Sc: i=',i,' j=',j, + & ' dist=',dist(nres+j,maxres2+1) overlap=.true. return endif @@ -173,9 +290,9 @@ C groups. do k=1,3 c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) enddo -cd print *,'overlap, SC-p: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,maxres2+1) if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then + if (lprn) write (iout,*) 'overlap, SC-p: i=',i,' j=',j, + & ' dist=',dist(nres+i,maxres2+1) overlap=.true. return endif @@ -189,26 +306,104 @@ C Check for p-p overlaps do k=1,3 c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) enddo -cd print *,'overlap, p-p: i=',i,' j=',j, -cd & ' dist=',dist(maxres2+1,maxres2+2) if(iteli.ne.0.and.itelj.ne.0)then if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then + if (lprn) write (iout,*) 'overlap, p-p: i=',i,' j=',j, + & ' dist=',dist(maxres2+1,maxres2+2) + overlap=.true. + return + endif + endif + enddo + + else + + if (lprn) write (iout,*) "start",i+1," end",nres_start+nsup + do j=i+1,nres_start+nsup + itj=iabs(itype(j)) + if (j.gt.i+1 .or. ipot.ne.4) then + rcomp=sigmaii(iti,itj) + else + rcomp=sigma(iti,itj) + endif +cd print *,'j=',j +c write (iout,*) "SCSC j",j," dist",dist(nres+i,nres+j), +c & " radfac",redfac*rcomp + if (dist(nres+i,nres+j).lt.redfac*rcomp) then + overlap=.true. + if (lprn) write (iout,*) 'overlap, SC-SC: i=',i,' j=',j, + & ' dist=',dist(nres+i,nres+j),' rcomp=', + & rcomp + return + endif + enddo +C Check for overlaps between the added peptide group and the succeeding +C SCs. + iteli=itel(i) + do j=1,3 + c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) + enddo + do j=i+2,nstart_res+nsup + itj=iabs(itype(j)) +cd write (iout,*) "pSC j",j," dist",dist(nres+j,maxres2+1) + if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then + if (lprn) write (iout,*) 'overlap, p-Sc: i=',i,' j=',j, + & ' dist=',dist(nres+j,maxres2+1) + overlap=.true. + return + endif + enddo +C Check for overlaps between the added side chain and the succeeding peptide +C groups. + do j=i+2,nstart_seq+nsup + do k=1,3 + c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) + enddo +cd write (iout,*) "SCp j",j," dist",dist(nres+i,maxres2+1) + if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then + if (lprn) write (iout,*) 'overlap, SC-p: i=',i,' j=',j, + & ' dist=',dist(nres+i,maxres2+1) + overlap=.true. + return + endif + enddo +C Check for p-p overlaps + do j=1,3 + c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1)) + enddo + do j=i+2,nres_start+nsup + itelj=itel(j) + do k=1,3 + c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) + enddo + if(iteli.ne.0.and.itelj.ne.0)then +cd write (iout,*) "pp j",j," dist",dist(maxres2+1,maxres2+2) + if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then + if (lprn) write (iout,*) 'overlap, p-p: i=',i,' j=',j, + & ' dist=',dist(maxres2+1,maxres2+2) overlap=.true. return endif endif enddo + + endif + return end c-------------------------------------------------------------------------- double precision function gen_phi(i,it1,it2) implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include "COMMON.TORCNSTR" include 'COMMON.GEO' include 'COMMON.BOUNDS' -c gen_phi=ran_number(-pi,pi) + if (raw_psipred .or. ndih_constr.eq.0) then + gen_phi=ran_number(-pi,pi) + else C 8/13/98 Generate phi using pre-defined boundaries - gen_phi=ran_number(phibound(1,i),phibound(2,i)) + gen_phi=ran_number(phibound(1,i),phibound(2,i)) + endif return end c--------------------------------------------------------------------------- @@ -238,7 +433,8 @@ c print *,'gen_theta: it=',it endif thet_pred_mean=a0thet(it) do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k) + thet_pred_mean=thet_pred_mean+athet(k,it,1,1)*y(k) + & +bthet(k,it,1,1)*z(k) enddo sig=polthet(3,it) do j=2,0,-1 @@ -779,7 +975,7 @@ c overlapping residues left, or false otherwise (success) do ires=1,ioverlap_last i=ioverlap(ires) - iti=itype(i) + iti=iabs(itype(i)) if (iti.ne.10) then nsi=0 fail=.true. @@ -791,7 +987,7 @@ c overlapping residues left, or false otherwise (success) endif enddo - call chainbuild + call chainbuild_extconf call overlap_sc_list(ioverlap,ioverlap_last) c write (iout,*) 'Overlaping residues ',ioverlap_last, c & (ioverlap(j),j=1,ioverlap_last) @@ -839,8 +1035,8 @@ C Check for SC-SC overlaps and mark residues c print *,'>>overlap_sc nnt=',nnt,' nct=',nct ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) + itypi=iabs(itype(i)) + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -852,7 +1048,7 @@ c do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) ind=ind+1 - itypj=itype(j) + itypj=iabs(itype(j)) dscj_inv=dsc_inv(itypj) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) diff --git a/source/unres/src_MD-M/geomout.F b/source/unres/src_MD-M/geomout.F index 47e8c7e..6cb9968 100644 --- a/source/unres/src_MD-M/geomout.F +++ b/source/unres/src_MD-M/geomout.F @@ -80,9 +80,15 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 if (nss.gt.0) then do i=1,nss + if (dyn_ss) then write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-1-nres, - & 'CYS',jhpb(i)-1-nres + & 'SSBOND',i,'CYS',idssb(i)-nnt+1, + & 'CYS',jdssb(i)-nnt+1 + else + write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') + & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, + & 'CYS',jhpb(i)-nnt+1-nres + endif enddo endif @@ -91,7 +97,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 ires=0 do i=nnt,nct iti=itype(i) - if (iti.eq.21) then + if ((iti.eq.ntyp1).and.((itype(i+1)).eq.ntyp1)) then ichain=ichain+1 ires=0 write (iunit,'(a)') 'TER' @@ -99,6 +105,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 ires=ires+1 iatom=iatom+1 ica(i)=iatom + if (iti.ne.ntyp1) then write (iunit,10) iatom,restyp(iti),chainid(ichain), & ires,(c(j,i),j=1,3),vtot(i) if (iti.ne.10) then @@ -106,17 +113,18 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,20) iatom,restyp(iti),chainid(ichain), & ires,(c(j,nres+i),j=1,3), & vtot(i+nres) + endif endif endif enddo write (iunit,'(a)') 'TER' do i=nnt,nct-1 - if (itype(i).eq.21) cycle - if (itype(i).eq.10 .and. itype(i+1).ne.21) then + if (itype(i).eq.ntyp1) cycle + if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1) - else if (itype(i).ne.10 .and. itype(i+1).ne.21) then + else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (iunit,30) ica(i),ica(i+1),ica(i)+1 - else if (itype(i).ne.10 .and. itype(i+1).eq.21) then + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (iunit,30) ica(i),ica(i)+1 endif enddo @@ -124,7 +132,11 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,30) ica(nct),ica(nct)+1 endif do i=1,nss + if (dyn_ss) then + write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 + else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 + endif enddo write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) @@ -200,6 +212,7 @@ c------------------------------------------------------------------------ include 'COMMON.INTERACT' include 'COMMON.NAMES' include 'COMMON.GEO' + include 'COMMON.TORSION' write (iout,'(/a)') 'Geometry of the virtual chain.' write (iout,'(7a)') ' Res ',' d',' Theta', & ' Phi',' Dsc',' Alpha',' Omega' @@ -224,7 +237,7 @@ c--------------------------------------------------------------------------- include 'COMMON.GEO' include 'COMMON.SBRIDGE' c print '(a,i5)',intname,igeom -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open (igeom,file=intname,position='append') #else open (igeom,file=intname,access='append') @@ -272,14 +285,19 @@ c---------------------------------------------------------------- include 'COMMON.DISTFIT' include 'COMMON.MD' double precision time -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open(icart,file=cartname,position="append") #else open(icart,file=cartname,access="append") #endif write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - write (icart,'(i4,$)') + if (dyn_ss) then + write (icart,'(i4,$)') + & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) + else + write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) + endif write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) @@ -321,8 +339,13 @@ c----------------------------------------------------------------- call xdrffloat_(ixdrf, real(t_bath), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss + if (dyn_ss) then + call xdrfint_(ixdrf, idssb(j)+nres, iret) + call xdrfint_(ixdrf, jdssb(j)+nres, iret) + else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag @@ -338,6 +361,9 @@ c----------------------------------------------------------------- enddo #else call xdrfopen(ixdrf,cartname, "a", iret) + write (iout,*) "Writing conformation: time",time," potE",potE, + & " uconst",uconst," uconst_back",uconst_back," t_bath",t_bath, + & " nss",nss call xdrffloat(ixdrf, real(time), iret) call xdrffloat(ixdrf, real(potE), iret) call xdrffloat(ixdrf, real(uconst), iret) @@ -345,8 +371,13 @@ c----------------------------------------------------------------- call xdrffloat(ixdrf, real(t_bath), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag @@ -397,6 +428,7 @@ c----------------------------------------------------------------- include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' + include 'COMMON.REMD' include 'COMMON.SETUP' integer itime double precision energia(0:n_ene) @@ -411,12 +443,52 @@ c----------------------------------------------------------------- open(istat,file=statname,position="append") endif #else -#ifdef PGI +#if defined(PGI) || defined(CRAY) open(istat,file=statname,position="append") #else open(istat,file=statname,access="append") #endif #endif + if (AFMlog.gt.0) then + if (refstr) then + call rms_nac_nnc(rms,frac,frac_nn,co,.false.) + write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,4f12.3,i5,$)') + & itime,totT,EK,potE,totE, + & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), + & potEcomp(23),me + format1="a133" + else +C print *,'A CHUJ',potEcomp(23) + write (line1,'(i10,f15.2,7f12.3,i5,$)') + & itime,totT,EK,potE,totE, + & kinetic_T,t_bath,gyrate(), + & potEcomp(23),me + format1="a114" + endif + else if (selfguide.gt.0) then + distance=0.0 + do j=1,3 + distance=distance+(c(j,afmend)-c(j,afmbeg))**2 + enddo + distance=dsqrt(distance) + if (refstr) then + call rms_nac_nnc(rms,frac,frac_nn,co,.false.) + write (line1,'(i10,f15.2,3f12.3,f7.2,2f6.3,f12.3,f10.1,2f8.2, + & f9.3,i5,$)') + & itime,totT,EK,potE,totE, + & rms,frac,frac_nn,kinetic_T,t_bath,gyrate(), + & distance,potEcomp(23),me + format1="a133" +C print *,"CHUJOWO" + else +C print *,'A CHUJ',potEcomp(23) + write (line1,'(i10,f15.2,8f12.3,i5,$)') + & itime,totT,EK,potE,totE, + & kinetic_T,t_bath,gyrate(), + & distance,potEcomp(23),me + format1="a114" + endif + else if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.false.) write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') @@ -429,17 +501,33 @@ c----------------------------------------------------------------- & amax,kinetic_T,t_bath,gyrate(),me format1="a114" endif + endif if(usampl.and.totT.gt.eq_time) then + if (loc_qlike) then + write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, + & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), + & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back), + & ((qloc(j,i),j=1,3),i=1,nfrag_back) + write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair + & +42*nfrag_back + else write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair & +21*nfrag_back + endif else format2="a001" line2=' ' endif if (print_compon) then + if(itime.eq.0) then + write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, + & ",20a12)" + write (istat,format) "#","", + & (ename(print_order(i)),i=1,nprint_ene) + endif write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",20f12.3)" write (istat,format) line1,line2, diff --git a/source/unres/src_MD-M/gnmr1.f b/source/unres/src_MD-M/gnmr1.f index 905e746..8bfc43a 100644 --- a/source/unres/src_MD-M/gnmr1.f +++ b/source/unres/src_MD-M/gnmr1.f @@ -41,3 +41,33 @@ c------------------------------------------------------------------------------- return end c--------------------------------------------------------------------------------- + double precision function rlornmr1(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl) + else if (y.gt.ymax) then + rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl) + else + rlornmr1=0.0d0 + endif + return + end +c------------------------------------------------------------------------------ + double precision function rlornmr1prim(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ + & ((ymin-y)**wykl+sigma**wykl)**2 + else if (y.gt.ymax) then + rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ + & ((y-ymax)**wykl+sigma**wykl)**2 + else + rlornmr1prim=0.0d0 + endif + return + end + diff --git a/source/unres/src_MD-M/gradient_p.F b/source/unres/src_MD-M/gradient_p.F index effd955..e79f6b0 100644 --- a/source/unres/src_MD-M/gradient_p.F +++ b/source/unres/src_MD-M/gradient_p.F @@ -88,6 +88,15 @@ C C Add the components corresponding to local energy terms. C 10 continue +c Add the usampl contributions + if (usampl) then + do i=1,nres-3 + gloc(i,icg)=gloc(i,icg)+dugamma(i) + enddo + do i=1,nres-2 + gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) + enddo + endif do i=1,nvar cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg) g(i)=g(i)+gloc(i,icg) @@ -271,29 +280,45 @@ c time00=MPI_Wtime() #endif icg=1 - call sum_gradient -#ifdef TIMING +#ifdef DEBUG + write (iout,*) "gradc, gradx, gloc before sum_gradient" + do i=1,nres-1 + write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gradc(j,i,icg),j=1,3), + & (gradx(j,i,icg),j=1,3),gloc(i,icg) + enddo #endif + call sum_gradient #ifdef DEBUG - write (iout,*) "After sum_gradient" + write (iout,*) "gradc, gradx, gloc after sum_gradient" do i=1,nres-1 - write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) - write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) + write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gradc(j,i,icg),j=1,3), + & (gradx(j,i,icg),j=1,3),gloc(i,icg) enddo #endif c If performing constraint dynamics, add the gradients of the constraint energy if(usampl.and.totT.gt.eq_time) then +#ifdef DEBUG + write (iout,*) "dudconst, duscdiff, dugamma,dutheta" + write (iout,*) "wumb",wumb + do i=1,nct + write (iout,'(i5,3f10.5,5x,3f10.5,5x,2f10.5)') + & i,(dudconst(j,i),j=1,3),(duscdiff(j,i),j=1,3), + & dugamma(i),dutheta(i) + enddo +#endif do i=1,nct do j=1,3 - gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i) - gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i) + gradc(j,i,icg)=gradc(j,i,icg)+ + & wumb*(dudconst(j,i)+duscdiff(j,i)) + gradx(j,i,icg)=gradx(j,i,icg)+ + & wumb*(dudxconst(j,i)+duscdiffx(j,i)) enddo enddo do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+dugamma(i) + gloc(i,icg)=gloc(i,icg)+wumb*dugamma(i) enddo do i=1,nres-2 - gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) + gloc(nphi+i,icg)=gloc(nphi+i,icg)+wumb*dutheta(i) enddo endif #ifdef TIMING @@ -314,8 +339,9 @@ cd write(iout,*) 'calling int_to_cart' gxcart(j,i)=gradx(j,i,icg) enddo #ifdef DEBUG - write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3),gloc(i,icg) + write (iout,'(i5,2(3f10.5,5x),2f10.5)') i,(gcart(j,i),j=1,3), + & (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg) + call flush(iout) #endif enddo #ifdef TIMING @@ -345,10 +371,13 @@ C------------------------------------------------------------------------- include 'COMMON.CHAIN' include 'COMMON.VAR' include 'COMMON.MD' + include 'COMMON.SCCOR' + include 'COMMON.SHIELD' + maxshieldlist=0 C C Initialize Cartesian-coordinate gradient C - do i=1,nres + do i=-1,nres do j=1,3 gvdwx(j,i)=0.0D0 gradx_scp(j,i)=0.0D0 @@ -356,6 +385,24 @@ C gvdwc_scp(j,i)=0.0D0 gvdwc_scpp(j,i)=0.0d0 gelc (j,i)=0.0D0 +C below is zero grad for shielding in order: ees (p-p) +C ecorr4, eturn3, eturn4, eel_loc, c denotes calfa,x is side-chain + gshieldx(j,i)=0.0d0 + gshieldc(j,i)=0.0d0 + gshieldc_loc(j,i)=0.0d0 + gshieldx_ec(j,i)=0.0d0 + gshieldc_ec(j,i)=0.0d0 + gshieldc_loc_ec(j,i)=0.0d0 + gshieldx_t3(j,i)=0.0d0 + gshieldc_t3(j,i)=0.0d0 + gshieldc_loc_t3(j,i)=0.0d0 + gshieldx_t4(j,i)=0.0d0 + gshieldc_t4(j,i)=0.0d0 + gshieldc_loc_t4(j,i)=0.0d0 + gshieldx_ll(j,i)=0.0d0 + gshieldc_ll(j,i)=0.0d0 + gshieldc_loc_ll(j,i)=0.0d0 +C end of zero grad for shielding gelc_long(j,i)=0.0D0 gradb(j,i)=0.0d0 gradbx(j,i)=0.0d0 @@ -380,6 +427,25 @@ C gradx(j,i,icg)=0.0d0 gscloc(j,i)=0.0d0 gsclocx(j,i)=0.0d0 + gliptranc(j,i)=0.0d0 + gliptranx(j,i)=0.0d0 + gradafm(j,i)=0.0d0 + grad_shield(j,i)=0.0d0 + gg_tube(j,i)=0.0d0 + gg_tube_sc(j,i)=0.0d0 +C grad_shield_side is Cbeta sidechain gradient + do kk=1,maxshieldlist + grad_shield_side(j,kk,i)=0.0d0 + grad_shield_loc(j,kk,i)=0.0d0 + +C grad_shield_side_ca is Calfa sidechain gradient + + +C grad_shield_side_ca(j,kk,i)=0.0d0 + enddo + do intertyp=1,3 + gloc_sc(intertyp,i,icg)=0.0d0 + enddo enddo enddo C diff --git a/source/unres/src_MD-M/initialize_p.F b/source/unres/src_MD-M/initialize_p.F index b781a75..bf07a8b 100644 --- a/source/unres/src_MD-M/initialize_p.F +++ b/source/unres/src_MD-M/initialize_p.F @@ -80,7 +80,9 @@ C igeom= 8 intin= 9 ithep= 11 + ithep_pdb=51 irotam=12 + irotam_pdb=52 itorp= 13 itordp= 23 ielep= 14 @@ -117,6 +119,15 @@ C icsa_in=40 crc for ifc error 118 icsa_pdb=42 + itube=45 +C Lipidic input file for parameters range 60-79 + iliptranpar=60 +C input file for transfer sidechain and peptide group inside the +C lipidic environment if lipid is implicite + +C DNA input files for parameters range 80-99 +C Suger input files for parameters range 100-119 +C All-atom input files for parameters range 120-149 C C Set default weights of the energy terms. C @@ -144,8 +155,10 @@ c call memmon_print_usage() enddo do i=1,ntyp do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 + aa_aq(i,j)=0.0D0 + bb_aq(i,j)=0.0D0 + aa_lip(i,j)=0.0D0 + bb_lip(i,j)=0.0D0 augm(i,j)=0.0D0 sigma(i,j)=0.0D0 r0(i,j)=0.0D0 @@ -161,10 +174,14 @@ c call memmon_print_usage() rr0(i)=0.0D0 a0thet(i)=0.0D0 do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 + do ichir1=-1,1 + do ichir2=-1,1 + athet(j,i,ichir1,ichir2)=0.0D0 + bthet(j,i,ichir1,ichir2)=0.0D0 + enddo + enddo enddo - do j=0,3 + do j=0,3 polthet(j,i)=0.0D0 enddo do j=1,3 @@ -188,15 +205,39 @@ c call memmon_print_usage() enddo nlob(ntyp1)=0 dsc(ntyp1)=0.0D0 - do i=1,maxtor - itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 + do i=-maxtor,maxtor + itortyp(i)=0 +cc write (iout,*) "TU DOCHODZE",i,itortyp(i) + do iblock=1,2 + do j=-maxtor,maxtor + do k=1,maxterm + v1(k,j,i,iblock)=0.0D0 + v2(k,j,i,iblock)=0.0D0 enddo enddo + enddo enddo + do iblock=1,2 + do i=-maxtor,maxtor + do j=-maxtor,maxtor + do k=-maxtor,maxtor + do l=1,maxtermd_1 + v1c(1,l,i,j,k,iblock)=0.0D0 + v1s(1,l,i,j,k,iblock)=0.0D0 + v1c(2,l,i,j,k,iblock)=0.0D0 + v1s(2,l,i,j,k,iblock)=0.0D0 + enddo !l + do l=1,maxtermd_2 + do m=1,maxtermd_2 + v2c(m,l,i,j,k,iblock)=0.0D0 + v2s(m,l,i,j,k,iblock)=0.0D0 + enddo !m + enddo !l + enddo !k + enddo !j + enddo !i + enddo !iblock + do i=1,maxres itype(i)=0 itel(i)=0 @@ -215,6 +256,32 @@ C Initialize the bridge arrays ihpb(i)=0 jhpb(i)=0 enddo +C Initialize correlation arrays + do i=1,maxres + do k=1,2 + b1(k,i)=0.0 + b2(k,i)=0.0 + b1tilde(k,i)=0.0 +c b2tilde(k,i)=0.0 + do j=1,2 +C CC(j,k,i)=0.0 +C Ctilde(j,k,i)=0.0 +C DD(j,k,i)=0.0 +C Dtilde(j,k,i)=0.0 + EE(j,k,i)=0.0 + enddo + enddo + enddo + do i=1,maxres + do k=1,2 + do j=1,2 + CC(j,k,i)=0.0 + Ctilde(j,k,i)=0.0 + DD(j,k,i)=0.0 + Dtilde(j,k,i)=0.0 + enddo + enddo + enddo C C Initialize timing. C @@ -237,8 +304,8 @@ C C Initialize constants used to split the energy into long- and short-range C components C - r_cut=2.0d0 - rlamb=0.3d0 +C r_cut=2.0d0 +C rlamb=0.3d0 #ifndef SPLITELE nprint_ene=nprint_ene-1 #endif @@ -251,24 +318,32 @@ c------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.FFIELD' data restyp / + &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL', + & 'DSG','DGN','DSN','DTH', + &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER', &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ + &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ', + &'AIB','ABU','D'/ data onelet / + &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g', + &'a','y','w','v','l','i','f','m','c','x', &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ + &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/ data potname /'LJ','LJK','BP','GB','GBV'/ data ename / & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", - & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"/ + & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR", + & "ELIPTRAN", "EAFM", "ETHETCNSTR", " "/ data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR"/ + & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR", + & "WLT", "WAFM", "WTHETCNSR", " "/ data nprint_ene /20/ data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, - & 21,0/ + & 21,0,22,23,24,25/ end c--------------------------------------------------------------------------- subroutine init_int_table @@ -288,11 +363,11 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.DERIV' include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1), + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1), & ntask_cont_from_all(0:max_fg_procs-1), & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), & ntask_cont_to_all(0:max_fg_procs-1), @@ -341,6 +416,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) goto 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. @@ -562,6 +638,9 @@ C Partition local interactions iphi_end=iturn3_end+2 iturn3_start=iturn3_start-1 iturn3_end=iturn3_end-1 + call int_bounds(nres-3,itau_start,itau_end) + itau_start=itau_start+3 + itau_end=itau_end+3 call int_bounds(nres-3,iphi1_start,iphi1_end) iphi1_start=iphi1_start+3 iphi1_end=iphi1_end+3 @@ -578,6 +657,8 @@ C Partition local interactions call int_bounds(nct-nnt,ibondp_start,ibondp_end) ibondp_start=ibondp_start+nnt ibondp_end=ibondp_end+nnt + call int_bounds(nres,ilip_start,ilip_end) + ilip_start=ilip_start call int_bounds1(nres-1,ivec_start,ivec_end) c print *,"Processor",myrank,fg_rank,fg_rank1, c & " ivec_start",ivec_start," ivec_end",ivec_end @@ -589,6 +670,13 @@ c & " ivec_start",ivec_start," ivec_end",ivec_end else call int_bounds(ndih_constr,idihconstr_start,idihconstr_end) endif + if (ntheta_constr.eq.0) then + ithetaconstr_start=1 + ithetaconstr_end=0 + else + call int_bounds + & (ntheta_constr,ithetaconstr_start,ithetaconstr_end) + endif c nsumgrad=(nres-nnt)*(nres-nnt+1)/2 c nlen=nres-nnt+1 nsumgrad=(nres-nnt)*(nres-nnt+1)/2 @@ -623,7 +711,10 @@ c nlen=nres-nnt+1 & ' ivec_start',ivec_start,' ivec_end',ivec_end, & ' iset_start',iset_start,' iset_end',iset_end, & ' idihconstr_start',idihconstr_start,' idihconstr_end', - & idihconstr_end + & idihconstr_end, + & ' ithetaconstr_start',ithetaconstr_start,' ithetaconstr_end', + & ithetaconstr_end + write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, & ' ngrad_end',ngrad_end @@ -663,7 +754,7 @@ c nlen=nres-nnt+1 iaux=iphi1_end-iphi1_start+1 call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1, & MPI_INTEGER,FG_COMM,IERROR) - do i=0,maxprocs-1 + do i=0,max_fg_procs-1 do j=1,maxres ielstart_all(j,i)=0 ielend_all(j,i)=0 @@ -1088,18 +1179,25 @@ c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 iphi1_end=nres idihconstr_start=1 idihconstr_end=ndih_constr + ithetaconstr_start=1 + ithetaconstr_end=ntheta_constr iphid_start=iphi_start iphid_end=iphi_end-1 + itau_start=4 + itau_end=nres ibond_start=2 ibond_end=nres-1 ibondp_start=nnt - ibondp_end=nct-1 +C ibondp_end=nct-1 + ibondp_end=nct ivec_start=1 ivec_end=nres-1 iset_start=3 iset_end=nres+1 iint_start=2 iint_end=nres-1 + ilip_start=1 + ilip_end=nres #endif return end @@ -1111,15 +1209,16 @@ c--------------------------------------------------------------------------- include "COMMON.INTERACT" include "COMMON.SETUP" include "COMMON.IOUNITS" - integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1) + integer ii,jj,itask(4),ntask_cont_to, + &itask_cont_to(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,isent,k,l c Determines whether to send interaction ii,jj to other processors; a given c interaction can be sent to at most 2 processors. @@ -1201,15 +1300,15 @@ c--------------------------------------------------------------------------- include "COMMON.SETUP" include "COMMON.IOUNITS" integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:MaxProcs-1) + & itask_cont_from(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,k,l do iproc=fg_rank+1,nfgtasks-1 do k=iturn3_start_all(iproc),iturn3_end_all(iproc) @@ -1261,7 +1360,7 @@ c--------------------------------------------------------------------------- subroutine add_task(iproc,ntask_cont,itask_cont) implicit none include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:MaxProcs-1) + integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) integer ii do ii=1,ntask_cont if (itask_cont(ii).eq.iproc) return diff --git a/source/unres/src_MD-M/int_to_cart.f b/source/unres/src_MD-M/int_to_cart.f index 55997f4..d3a8a92 100644 --- a/source/unres/src_MD-M/int_to_cart.f +++ b/source/unres/src_MD-M/int_to_cart.f @@ -13,9 +13,11 @@ c------------------------------------------------------------- include 'COMMON.INTERACT' include 'COMMON.MD' include 'COMMON.IOUNITS' - -c calculating dE/ddc1 - if (nres.lt.3) return + include 'COMMON.SCCOR' + include 'COMMON.CONTROL' +c calculating dE/ddc1 +C print *,"wchodze22",ialph(2,1) + if (nres.lt.3) go to 18 do j=1,3 gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) & +gloc(nres-2,icg)*dtheta(j,1,3) @@ -24,6 +26,7 @@ c calculating dE/ddc1 & gloc(ialph(2,1)+nside,icg)*domega(j,1,2) endif enddo +C print *,"wchodze22",ialph(2,1) c Calculating the remainder of dE/ddc2 do j=1,3 gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ @@ -40,6 +43,7 @@ c Calculating the remainder of dE/ddc2 gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5) endif enddo +C print *,"wchodze22",ialph(2,1) c If there are only five residues if(nres.eq.5) then do j=1,3 @@ -58,23 +62,27 @@ c If there are only five residues endif c If there are more than five residues if(nres.gt.5) then +C print *,"wchodze22",ialph(2,1) do i=3,nres-3 +C print *,i,ialph(i,1)+nside do j=1,3 gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1) & +gloc(i-1,icg)*dphi(j,2,i+2)+ & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+ & gloc(nres+i-3,icg)*dtheta(j,1,i+2) - if(itype(i).ne.10) then + if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+ & gloc(ialph(i,1)+nside,icg)*domega(j,2,i) endif - if(itype(i+1).ne.10) then + if((itype(i+1).ne.10).and.(itype(i+1).ne.ntyp1)) then gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1) & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1) endif enddo enddo endif +C print *,"wchodze22",ialph(2,1) + c Setting dE/ddnres-2 if(nres.gt.5) then do j=1,3 @@ -106,13 +114,175 @@ c Settind dE/ddnres-1 enddo c The side-chain vector derivatives do i=2,nres-1 - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) enddo endif enddo +c---------------------------------------------------------------------- +C INTERTYP=1 SC...Ca...Ca...Ca +C INTERTYP=2 Ca...Ca...Ca...SC +C INTERTYP=3 SC...Ca...Ca...SC +c calculating dE/ddc1 + 18 continue +c do i=1,nres +c gloc(i,icg)=0.0D0 +c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) +c enddo +C print *,"tu dochodze??" + if (nres.lt.2) return + if ((nres.lt.3).and.(itype(1).eq.10)) return + if ((itype(1).ne.10).and.(itype(1).ne.ntyp1)) then + do j=1,3 +cc Derviative was calculated for oposite vector of side chain therefore +c there is "-" sign before gloc_sc + gxcart(j,1)=gxcart(j,1)-gloc_sc(1,0,icg)* + & dtauangle(j,1,1,3) + gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* + & dtauangle(j,1,2,3) + if ((itype(2).ne.10).and.(itype(2).ne.ntyp1)) then + gxcart(j,1)= gxcart(j,1) + & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3) + gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* + & dtauangle(j,3,2,3) + endif + enddo + endif + if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.ntyp1)) + & then + do j=1,3 + gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4) + enddo + endif +c As potetnial DO NOT depend on omicron anlge their derivative is +c ommited +c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3) + +c Calculating the remainder of dE/ddc2 + do j=1,3 + if((itype(2).ne.10).and.(itype(2).ne.ntyp1)) then + if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+ + & gloc_sc(3,0,icg)*dtauangle(j,3,3,3) + if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.ntyp1)) + & then + gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4) +cc the - above is due to different vector direction + gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4) + endif + if (nres.gt.3) then + gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4) +cc the - above is due to different vector direction + gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4) +c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart" +c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx" + endif + endif + if ((itype(1).ne.10).and.(itype(1).ne.ntyp1)) then + gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3) +c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3) + endif + if ((itype(3).ne.10).and.(nres.ge.3)) then + gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4) +c write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4) + endif + if ((itype(4).ne.10).and.(nres.ge.4)) then + gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5) +c write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5) + endif + +c write(iout,*) gcart(j,2),itype(2),itype(1),itype(3), "gcart2" + enddo +c If there are more than five residues + if(nres.ge.5) then + do i=3,nres-2 + do j=1,3 +c write(iout,*) "before", gcart(j,i) + if ((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then + gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg) + & *dtauangle(j,2,3,i+1) + & -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2) + gcart(j,i)=gcart(j,i)+gloc_sc(1,i-1,icg) + & *dtauangle(j,1,2,i+2) +c write(iout,*) "new",j,i, +c & gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2) + if (itype(i-1).ne.10) then + gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg) + &*dtauangle(j,3,3,i+1) + endif + if (itype(i+1).ne.10) then + gxcart(j,i)=gxcart(j,i)-gloc_sc(3,i-1,icg) + &*dtauangle(j,3,1,i+2) + gcart(j,i)=gcart(j,i)+gloc_sc(3,i-1,icg) + &*dtauangle(j,3,2,i+2) + endif + endif + if (itype(i-1).ne.10) then + gcart(j,i)=gcart(j,i)+gloc_sc(1,i-2,icg)* + & dtauangle(j,1,3,i+1) + endif + if (itype(i+1).ne.10) then + gcart(j,i)=gcart(j,i)+gloc_sc(2,i-1,icg)* + & dtauangle(j,2,2,i+2) +c write(iout,*) "numer",i,gloc_sc(2,i-1,icg), +c & dtauangle(j,2,2,i+2) + endif + if (itype(i+2).ne.10) then + gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)* + & dtauangle(j,2,1,i+3) + endif + enddo + enddo + endif +c Setting dE/ddnres-1 + if(nres.ge.4) then + do j=1,3 + if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.ntyp1)) then + gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) + & *dtauangle(j,2,3,nres) +c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg), +c & dtauangle(j,2,3,nres), gxcart(j,nres-1) + if (itype(nres-2).ne.10) then + gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) + & *dtauangle(j,3,3,nres) + endif + if ((itype(nres).ne.10).and.(itype(nres).ne.ntyp1)) then + gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) + & *dtauangle(j,3,1,nres+1) + gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) + & *dtauangle(j,3,2,nres+1) + endif + endif + if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.ntyp1)) then + gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* + & dtauangle(j,1,3,nres) + endif + if ((itype(nres).ne.10).and.(itype(nres).ne.ntyp1)) then + gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* + & dtauangle(j,2,2,nres+1) +c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg), +c & dtauangle(j,2,2,nres+1), itype(nres-1),itype(nres) + endif + enddo + endif +c Settind dE/ddnres + if ((nres.ge.3).and.(itype(nres).ne.10).and. + & (itype(nres).ne.ntyp1))then + do j=1,3 + gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg) + & *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg) + & *dtauangle(j,2,3,nres+1) + enddo + endif +c The side-chain vector derivatives +C if (SELFGUIDE.gt.0) then +C do j=1,3 +C gcart(j,afmbeg)=gcart(j,afmbeg)+gcart(j,afmend) +C gcart(j,afmbeg)=0.0d0 +C gcart(j,afmend)=0.0d0 +C enddo +C endif return end diff --git a/source/unres/src_MD-M/intcartderiv.F b/source/unres/src_MD-M/intcartderiv.F index 61a423b..227a119 100644 --- a/source/unres/src_MD-M/intcartderiv.F +++ b/source/unres/src_MD-M/intcartderiv.F @@ -12,6 +12,7 @@ include 'COMMON.DERIV' include 'COMMON.IOUNITS' include 'COMMON.LOCAL' + include 'COMMON.SCCOR' double precision dcostheta(3,2,maxres), & dcosphi(3,3,maxres),dsinphi(3,3,maxres), & dcosalpha(3,3,maxres),dcosomega(3,3,maxres), @@ -47,13 +48,50 @@ c We need dtheta(:,:,i-1) to compute dphi(:,:,i) do j=1,3 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ & vbld(i-1) - if (itype(i-1).ne.21) dtheta(j,1,i)=-dcostheta(j,1,i)/sint +c if (itype(i-1).ne.ntyp1) + dtheta(j,1,i)=-dcostheta(j,1,i)/sint dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ & vbld(i) - if (itype(i-1).ne.21) dtheta(j,2,i)=-dcostheta(j,2,i)/sint +c if (itype(i-1).ne.ntyp1) + dtheta(j,2,i)=-dcostheta(j,2,i)/sint enddo enddo - +#if defined(MPI) && defined(PARINTDER) +c We need dtheta(:,:,i-1) to compute dphi(:,:,i) + do i=max0(ithet_start-1,3),ithet_end +#else + do i=3,nres +#endif + if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then + cost1=dcos(omicron(1,i)) + sint1=sqrt(1-cost1*cost1) + cost2=dcos(omicron(2,i)) + sint2=sqrt(1-cost2*cost2) + do j=1,3 +CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) + dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ + & cost1*dc_norm(j,i-2))/ + & vbld(i-1) + domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i) + dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) + & +cost1*(dc_norm(j,i-1+nres)))/ + & vbld(i-1+nres) + domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i) +CC Calculate derivative over second omicron Sci-1,Cai-1 Cai +CC Looks messy but better than if in loop + dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) + & +cost2*dc_norm(j,i-1))/ + & vbld(i) + domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i) + dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) + & +cost2*(-dc_norm(j,i-1+nres)))/ + & vbld(i-1+nres) +c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres) + domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i) + enddo + endif + enddo + c Derivatives of phi: c If phi is 0 or 180 degrees, then the formulas c have to be derived by power series expansion of the @@ -63,7 +101,8 @@ c conventional formulas around 0 and 180. #else do i=4,nres #endif -c if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle +c if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 +c & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle c the conventional case sint=dsin(theta(i)) sint1=dsin(theta(i-1)) @@ -80,7 +119,7 @@ c the conventional case c Obtaining the gamma derivatives from sine derivative if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then + & phi(i).ge.-pi.and.phi(i).le.-pi34) then call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) @@ -88,8 +127,8 @@ c Obtaining the gamma derivatives from sine derivative ctgt=cost/sint ctgt1=cost1/sint1 cosg_inv=1.0d0/cosg - if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) +c if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then + dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) dsinphi(j,2,i)= @@ -100,13 +139,13 @@ c Obtaining the gamma derivatives from sine derivative & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - endif +c endif c Bug fixed 3/24/05 (AL) enddo c Obtaining the gamma derivatives from cosine derivative else do j=1,3 - if (itype(i-1).ne.21 .and. itype(i-2).ne.21) then +c if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* & dc_norm(j,i-3))/vbld(i-2) @@ -119,10 +158,237 @@ c Obtaining the gamma derivatives from cosine derivative & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* & dc_norm(j,i-1))/vbld(i) dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - endif +c endif enddo endif enddo +Calculate derivative of Tauangle + do i=1,nres-1 + do j=1,3 + dc_norm2(j,i+nres)=-dc_norm(j,i+nres) + enddo + enddo +#ifdef PARINTDER + do i=itau_start,itau_end +#else + do i=3,nres +#endif + if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle +c if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or. +c & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle +cc dtauangle(j,intertyp,dervityp,residue number) +cc INTERTYP=1 SC...Ca...Ca..Ca +c the conventional case + sint=dsin(theta(i)) + sint1=dsin(omicron(2,i-1)) + sing=dsin(tauangle(1,i)) + cost=dcos(theta(i)) + cost1=dcos(omicron(2,i-1)) + cosg=dcos(tauangle(1,i)) + do j=1,3 + dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) +cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) +cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 +c Obtaining the gamma derivatives from sine derivative + if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. + & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. + & tauangle(1,i).ge.-pi.and.tauangle(1,i).le.-pi34) then + call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) + &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) + & *vbld_inv(i-2+nres) + dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) + dsintau(j,1,2,i)= + & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) + & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) +c write(iout,*) "dsintau", dsintau(j,1,2,i) + dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) +c Bug fixed 3/24/05 (AL) + dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) + & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) +c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) + enddo +c Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* + & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* + & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) + dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) + dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* + & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* + & dcostheta(j,1,i) + dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) + dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* + & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* + & dc_norm(j,i-1))/vbld(i) + dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) +c write (iout,*) "else",i + enddo + endif +c do k=1,3 +c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) +c enddo + enddo +CC Second case Ca...Ca...Ca...SC +#ifdef PARINTDER + do i=itau_start,itau_end +#else + do i=4,nres +#endif + if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. + & (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle +c the conventional case + sint=dsin(omicron(1,i)) + sint1=dsin(theta(i-1)) + sing=dsin(tauangle(2,i)) + cost=dcos(omicron(1,i)) + cost1=dcos(theta(i-1)) + cosg=dcos(tauangle(2,i)) +c do j=1,3 +c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) +c enddo + scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) +c Obtaining the gamma derivatives from sine derivative + if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. + & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. + & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then + call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) + & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) +c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), +c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" + dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) + dsintau(j,2,2,i)= + & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) + & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) +c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), +c & sing*ctgt*domicron(j,1,2,i), +c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) +c Bug fixed 3/24/05 (AL) + dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) + & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) +c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) + enddo +c Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* + & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* + & dc_norm(j,i-3))/vbld(i-2) + dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) + dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* + & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* + & dcosomicron(j,1,1,i) + dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) + dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* + & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* + & dc_norm(j,i-1+nres))/vbld(i-1+nres) + dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) +c write(iout,*) i,j,"else", dtauangle(j,2,3,i) + enddo + endif + enddo + +CCC third case SC...Ca...Ca...SC +#ifdef PARINTDER + + do i=itau_start,itau_end +#else + do i=3,nres +#endif +c the conventional case + if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. + &(itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle + sint=dsin(omicron(1,i)) + sint1=dsin(omicron(2,i-1)) + sing=dsin(tauangle(3,i)) + cost=dcos(omicron(1,i)) + cost1=dcos(omicron(2,i-1)) + cosg=dcos(tauangle(3,i)) + do j=1,3 + dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) +c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) +c Obtaining the gamma derivatives from sine derivative + if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. + & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. + & tauangle(3,i).ge.-pi.and.tauangle(3,i).le.-pi34) then + call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) + & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) + & *vbld_inv(i-2+nres) + dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) + dsintau(j,3,2,i)= + & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) + & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) +c Bug fixed 3/24/05 (AL) + dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) + & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) + & *vbld_inv(i-1+nres) +c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) + enddo +c Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* + & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* + & dc_norm2(j,i-2+nres))/vbld(i-2+nres) + dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) + dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* + & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* + & dcosomicron(j,1,1,i) + dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) + dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* + & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* + & dc_norm(j,i-1+nres))/vbld(i-1+nres) + dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) +c write(iout,*) "else",i + enddo + endif + enddo + #ifdef CRYST_SC c Derivatives of side-chain angles alpha and omega #if defined(MPI) && defined(PARINTDER) @@ -130,7 +396,7 @@ c Derivatives of side-chain angles alpha and omega #else do i=2,nres-1 #endif - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) fac6=fac5/vbld(i) fac7=fac5*fac5 @@ -159,7 +425,7 @@ c write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino c obtaining the derivatives of omega from sines if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then + & omeg(i).ge.-pi.and.omeg(i).le.-pi34) then fac15=dcos(theta(i+1))/(dsin(theta(i+1))* & dsin(theta(i+1))) fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) @@ -434,7 +700,7 @@ c Check omega gradient enddo return end - +c------------------------------------------------------------ subroutine chainbuild_cart implicit real*8 (a-h,o-z) include 'DIMENSIONS' @@ -478,6 +744,7 @@ c call flush(iout) #endif do j=1,3 c(j,1)=dc(j,0) +c c(j,1)=c(j,1) enddo do i=2,nres do j=1,3 @@ -489,6 +756,7 @@ c call flush(iout) c(j,i+nres)=c(j,i)+dc(j,i+nres) enddo enddo +C print *,'tutu' c write (iout,*) "CHAINBUILD_CART" c call cartprint call int_from_cart1(.false.) diff --git a/source/unres/src_MD-M/intcor.f b/source/unres/src_MD-M/intcor.f index a3cd5d0..9195f8a 100644 --- a/source/unres/src_MD-M/intcor.f +++ b/source/unres/src_MD-M/intcor.f @@ -17,7 +17,11 @@ c z23=c(3,i3)-c(3,i2) vnorm=dsqrt(x12*x12+y12*y12+z12*z12) wnorm=dsqrt(x23*x23+y23*y23+z23*z23) + if ((vnorm.eq.0.0).or.(wnorm.eq.0.0)) then + scalar=1.0 + else scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm) + endif alpha=arcos(scalar) return end diff --git a/source/unres/src_MD-M/kinetic_lesyng.f b/source/unres/src_MD-M/kinetic_lesyng.f index 8535f5d..db959b3 100644 --- a/source/unres/src_MD-M/kinetic_lesyng.f +++ b/source/unres/src_MD-M/kinetic_lesyng.f @@ -44,7 +44,7 @@ c to the velocities of the first Calpha. incr(j)=d_t(j,0) enddo do i=nnt,nct - iti=itype(i) + iti=iabs(itype(i)) if (itype(i).eq.10) then do j=1,3 v(j)=incr(j) @@ -81,7 +81,7 @@ c write(iout,*) 'KEr_p', KEr_p c The rotational part of the side chain virtual bond KEr_sc=0.0D0 do i=nnt,nct - iti=itype(i) + iti=iabs(itype(i)) if (itype(i).ne.10) then do j=1,3 incr(j)=d_t(j,nres+i) diff --git a/source/unres/src_MD-M/lagrangian_lesyng.F b/source/unres/src_MD-M/lagrangian_lesyng.F index f9a48fc..024c6d1 100644 --- a/source/unres/src_MD-M/lagrangian_lesyng.F +++ b/source/unres/src_MD-M/lagrangian_lesyng.F @@ -46,7 +46,7 @@ c------------------------------------------------------------------------- enddo if (lprn) write (iout,*) "Potential forces sidechain" do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') & i,(-gcart(j,i),j=1,3) do j=1,3 @@ -69,7 +69,7 @@ c------------------------------------------------------------------------- enddo enddo do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 ind=ind+1 d_a(j,i+nres)=d_a_work(ind) @@ -212,17 +212,17 @@ c Diagonal elements of the dX part of A and the respective friction coefficient m1=nct-nnt+1 ind=0 ind1=0 - msc(21)=1.0d0 + msc(ntyp1)=1.0d0 do i=nnt,nct ind=ind+1 ii = ind+m iti=itype(i) - massvec(ii)=msc(iti) - if (iti.ne.10 .and. iti.ne.21) then + massvec(ii)=msc(iabs(iti)) + if (iti.ne.10 .and. iti.ne.ntyp1) then ind1=ind1+1 ii1= ind1+m1 A(ii,ii1)=1.0d0 - Gmat(ii1,ii1)=ISC(iti) + Gmat(ii1,ii1)=ISC(iabs(iti)) endif enddo c Off-diagonal elements of the dX part of A @@ -476,7 +476,7 @@ c--------------------------------------------------------------------------- include 'COMMON.TIME1' include 'COMMON.MD' double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 + &,time01,zcopy(dimen3) #ifdef MPI if (nfgtasks.gt.1) then if (fg_rank.eq.0) then @@ -497,11 +497,12 @@ c call MPI_Barrier(FG_COMM,IERROR) time00=MPI_Wtime() call MPI_Scatterv(z,ng_counts(0),ng_start(0), & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + & zcopy,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count + do i=1,3*my_ng_count + z(i)=zcopy(i) c write (2,*) i,z(i) -c enddo + enddo c write (2,*) "After SCATTERV" c call flush(2) c write (2,*) "MPI_Wtime",MPI_Wtime() @@ -628,7 +629,7 @@ c--------------------------------------------------------------------------- include 'COMMON.LANGEVIN.lang0' #endif double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 + &,time01,zcopy(dimen3) #ifdef MPI if (nfgtasks.gt.1) then if (fg_rank.eq.0) then @@ -642,11 +643,12 @@ c call MPI_Barrier(FG_COMM,IERROR) time00=MPI_Wtime() call MPI_Scatterv(z,ng_counts(0),ng_start(0), & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + & zcopy,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count + do i=1,3*my_ng_count + z(i)=zcopy(i) c write (2,*) i,z(i) -c enddo + enddo time_scatter=time_scatter+MPI_Wtime()-time00 #ifdef TIMING time_scatter_fmatmult=time_scatter_fmatmult+MPI_Wtime()-time00 diff --git a/source/unres/src_MD-M/load.map b/source/unres/src_MD-M/load.map deleted file mode 100644 index 929cdb6..0000000 --- a/source/unres/src_MD-M/load.map +++ /dev/null @@ -1,8080 +0,0 @@ -cc -o compinfo compinfo.c -./compinfo | true -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include cinfo.f -ifort -O3 -ip -w -Wl,-M unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o eigen.o blas.o add.o entmcm.o minim_mcmf.o together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o indexx.o MP.o compare_s1.o prng_32.o test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o sc_move.o local_move.o intcartderiv.o lagrangian_lesyng.o stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o q_measure.o gnmr1.o proc_proc.o cinfo.o -L/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB -o ../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe -Archive member included because of file (symbol) - -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - readrtns_CSA.o (mpi_abort_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - initialize_p.o (mpi_allgather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - energy_p_new_barrier.o (mpi_barrier_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - unres.o (mpi_bcast_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - MP.o (mpi_comm_create_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - initialize_p.o (mpi_comm_group_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - MP.o (mpi_comm_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - MP.o (mpi_comm_size_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - MP.o (mpi_comm_split_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - unres.o (mpi_dup_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - unres.o (mpi_finalize_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - initialize_p.o (mpi_gather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - MP.o (mpi_get_count_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - readrtns_CSA.o (mpi_get_processor_name_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - initialize_p.o (mpi_group_free_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - initialize_p.o (mpi_group_incl_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - MP.o (mpi_group_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - initialize_p.o (mpi_group_translate_ranks_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - MP.o (mpi_init_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - together.o (mpi_iprobe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - energy_p_new_barrier.o (mpi_irecv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - energy_p_new_barrier.o (mpi_isend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - together.o (mpi_issend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - unres.o (mpi_null_copy_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - unres.o (mpi_null_delete_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - MP.o (mpi_probe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - unres.o (mpi_recv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - energy_p_new_barrier.o (mpi_reduce_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - MREMD.o (mpi_scatter_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - minimize_p.o (mpi_scatterv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - unres.o (mpi_send_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Status_f2c) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - together.o (mpi_test_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - initialize_p.o (mpi_type_commit_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - initialize_p.o (mpi_type_contiguous_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - initialize_p.o (mpi_type_indexed_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - energy_p_new_barrier.o (mpi_waitall_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - unres.o (mpi_wtime_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (mpir_getarg_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_F_TRUE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (mpir_init_fcm_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPID_Node_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) (MPI_Isend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Irecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) (MPI_Test) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPIR_Error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) (MPI_Probe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) (MPI_Waitall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) (MPI_Send) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) (MPI_Recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) (PMPI_Testall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Get_count) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) (MPI_Issend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) (MPI_Type_commit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) (MPI_Type_contiguous) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) (MPI_Type_indexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) (MPIR_Type_dup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) (MPI_Abort) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPI_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) (MPIR_COMM_WORLD) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) (MPI_Finalize) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) (MPI_Error_string) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Init_dtes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Errhandler_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) (MPI_Wtime) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) (MPIR_Err_setmsg) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Msg_queue_export) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_HBT_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_PointerPerm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPIR_BsendRelease) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Keyval_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_get) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Attr_create_tree) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_put) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Group_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) (MPI_Group_incl) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) (MPI_Group_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_CreateGroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) (MPI_Comm_group) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) (MPI_Comm_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPI_Comm_set_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Comm_make_coll) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) (MPI_Comm_split) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) (MPIR_Context_alloc) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) (MPI_Group_translate_ranks) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_dup_fn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Barrier) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Bcast) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) (MPI_Gather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) (MPI_Scatter) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) (MPI_Scatterv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) (MPI_Allgather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) (MPI_Reduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) (PMPI_Allreduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_MAXF) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Op_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Op_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_inter_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_intra_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (MPIR_intra_Scan) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Topology_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Request_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Status_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPIR_cstr2fstr) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (p4_proc_info) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (bm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (rm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (net_setup_anon_listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (create_remote_processes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (handle_connection_interrupt) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (socket_close_conn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) (start_prog_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (usc_MD_rollover_val) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) (MPID_RecvComplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) (MPID_SendIcomplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_devset) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) (MPID_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) (MPID_SendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) (MPID_RecvDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_Msg_rep) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_PackMessage) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) (MPID_IssendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_Type_swap_copy) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_DEBUG_FILE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) (MPID_CH_InitMsgPass) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_procinfo) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_P4_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPID_Dump_queues) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_ArgSqueeze) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_SBinit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (MPID_Process_group_init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_PacketFlowSetup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_FinishCancelPackets) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Wait) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Cancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Sendrecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_extent) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) (PMPI_Type_hindexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_lb) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) (MPI_Type_struct) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_proctable) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPI_Errhandler_set) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPIR_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) (PMPI_Keyval_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_global) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (MD_initmem) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (process_args) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (alloc_local_bm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_dprintf) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) (p4_alloc_procgroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) (p4_moninit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_broadcastx) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) (MPID_SsendContig) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) (MPID_SendCancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Eagerb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Rndvb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Check_incoming) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Short_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) (MPID_DebugFlow) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) (MPIR_Pack_Hvector) -xdrf_em64/libxdrf.a(libxdrf.o) - geomout.o (xdrfint_) -xdrf_em64/libxdrf.a(ftocstr.o) - xdrf_em64/libxdrf.a(libxdrf.o) (ftocstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - timing.o (etime_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - geomout.o (fdate_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - unres.o (flush_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - parmread.o (getenv_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - readrtns_CSA.o (system_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) (allocCstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (CstrToFstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - unres.o (for_close) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__close_proc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__key_desc_ret_item) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__io_return) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) (for_errsns_load) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__exit_handler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) (for_iargc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__l_excpt_info) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - readrtns_CSA.o (for_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for_check_env_name) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__create_lub) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__rm_from_lf_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - unres.o (for_open) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - indexx.o (for_pause) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__write_output) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - unres.o (for_set_reentrancy) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - misc.o (for_rewind) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - readpdb.o (for_read_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - readrtns_CSA.o (for_read_int_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - randgens.o (for_read_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - unres.o (for_read_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - readrtns_CSA.o (for_read_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - unres.o (for_stop_core) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) (for__set_signal_ops_during_vm) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - readrtns_CSA.o (for_write_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - randgens.o (for_write_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - unres.o (for_write_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - unres.o (for_write_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - readrtns_CSA.o (for_f90_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - energy_p_new_barrier.o (for_is_nan_t_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - readrtns_CSA.o (for_cpystr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) (flushqq_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - readrtns_CSA.o (d_int_val) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (tbk_stack_trace) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (for__aio_lub_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__compute_filename) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) (for__aio_pthread_self) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (cvt_text_to_integer) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_f_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_d_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_g_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_cray_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_short_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_long_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_double_to_cray) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_single_to_ibm_short) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__common_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) (for_exit) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__format_compiler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) (for__format_value) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) (for__get_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) (for_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__interp_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (for__wfs_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) (vax_c) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_integer_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_data_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_boolean_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_data) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_boolean) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_t_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_s_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_x_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_a_to_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_a_to_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_s_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_t_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_string_to_nan_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_string_to_nan_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_a_to_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_x_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) (cvtas_string_to_nan_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_word) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_pten_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_64) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) (cvtas_pten_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - arcos.o (acos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - surfatom.o (asin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - local_move.o (atan2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - cored.o (cbrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - energy_p_new_barrier.o (cos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - parmread.o (exp2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - MREMD.o (expf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - readrtns_CSA.o (exp) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - convert.o (fmod) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - map.o (__powi4i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - parmread.o (__powr8i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) (__libm_error_support) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - chainbuild.o (__libm_sse2_sincos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - readrtns_CSA.o (log10) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - gen_rand_conf.o (logf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - energy_p_new_barrier.o (log) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrl) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherr) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - readrtns_CSA.o (pow) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - intcartderiv.o (sin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - cored.o (sqrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - gen_rand_conf.o (tan) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (truncf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (trunc) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) (__libm_exp_table_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) (__libm_reduce_pio2d) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_logf_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_rcp_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - energy_p_new_barrier.o (__svml_cos2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - energy_p_new_barrier.o (__svml_sin2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtoj) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtod) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) (tbk_string_stack_signal) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) (tbk_getPC) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) (_intel_fast_memcmp) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (__intel_cpu_indicator_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - convert.o (_intel_fast_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - initialize_p.o (_intel_fast_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o (__intel_new_proc_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) (__mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) (__divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (__intel_sse2_strlen) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) (__intel_new_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) (__intel_new_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) (irc__get_msg) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) (__intel_memcpy_mem_ops_method) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) (__intel_get_new_mem_ops_cpuid) -/usr/lib64/libc_nonshared.a(elf-init.oS) - /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o (__libc_csu_fini) - -Allocating common symbols -Common symbol size file - -bm_outfile 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_LONG_LONG_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frag_ 0xa0 geomout.o -calcthet_ 0x9c energy_p_new_barrier.o -wagi_ 0x10 geomout.o -cache_ 0x5dcd0 mcm.o -rm_outfile_head 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -header_ 0x50 unres.o -mvstat_ 0x250 readrtns_CSA.o -timing_ 0x140 unres.o -MPIR_I_COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_LONG_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -ffield_ 0x174 unres.o -chuju_ 0x4 minimize_p.o -deriv_loc_ 0x1e0 initialize_p.o -splitele_ 0x10 initialize_p.o -cipiszcze_ 0x4 /tmp/ipo_ifortx3jrsv.o -MPIR_I_DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_SHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPI_LONG_DOUBLE_INT_var - 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_dtes 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_UB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -refstruct_ 0x1c26c unres.o -dih_control_ 0xc readrtns_CSA.o -MPIR_I_FLOAT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_SHORT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frozen_ 0x12c0 geomout.o -sumsl_flag_ 0x4 unres.o -execer_pg 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -links_split_ 0x8 unres.o -precomp1_ 0x70800 unres.o -bounds_ 0x4b00 readrtns_CSA.o -MPIR_I_2DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -alphaa_ 0x1e788 readrtns_CSA.o -MPIR_errhandlers 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -chain_ 0x54680 unres.o -parfiles_ 0xb00 unres.o -globmemsize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotat_old_ 0x9600 unres.o -bank_ 0x25920 readrtns_CSA.o -p4_rm_rank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts1_ 0xc5d3c0 unres.o -mce_ 0x230 readrtns_CSA.o -diploc_ 0x3938 unres.o -mucarem_ 0x8000 readrtns_CSA.o -mdpmpi_ 0x8014 unres.o -iounits_ 0x6c unres.o -MPI_DOUBLE_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mapp_ 0x25804 readrtns_CSA.o -MPIR_real8_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -p4_brdcst_info 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -langforc_ 0x26782534 readrtns_CSA.o -MPIR_I_2INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -minvar_ 0x12d78 readrtns_CSA.o -torsion_ 0x5adc parmread.o -struct_ 0xa2c readrtns_CSA.o -procgroup_file 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -mdpar_ 0x6c unres.o -MPID_MyWorldSize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -spinka_ 0x384c newconf.o -thetas_ 0x960 chainbuild.o -__P4FROM 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -MPIR_int1_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_debug_q 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_debug_sq 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPID_MyWorldRank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -remdrestart_ 0x411808 unres.o -for__pthread_mutex_unlock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -restr_ 0xce44 unres.o -locel_ 0x274 energy_p_new_barrier.o -MPIR_I_REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -fourier_ 0x344 initialize_p.o -precomp2_ 0x70800 unres.o -torsiond_ 0x14200 initialize_p.o -for__a_argv 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -MPIR_debug_rh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -pool_ 0x5dc5c readrtns_CSA.o -maxgrad_ 0xa8 energy_p_new_barrier.o -double_muca_ 0x25828 readrtns_CSA.o -links_ 0x107035c unres.o -MPID_byte_order 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) -p4_global 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_2REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -mdgrad_ 0x1c230 unres.o -execer_mastport 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -from_zscore_ 0xc unres.o -csa_input_ 0x98 readrtns_CSA.o -for__pthread_mutex_init_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -machsw_ 0xc initialize_p.o -types_ 0x54 unres.o -MPIR_I_USHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -sccalc_ 0x28 energy_p_new_barrier.o -pochodne_ 0xb01310 geomout.o -loc_work_ 0x30c local_move.o -peptbond_ 0x28 chainbuild.o -MPIR_I_UINT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -calc_ 0x1f0 gen_rand_conf.o -execer_id 0x84 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPI_FLOAT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -execer_numtotnodes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -derivat_ 0x436dbe8 initialize_p.o -MPIR_I_BYTE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_CHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -deriv_scloc_ 0x3f480 initialize_p.o -listener_info 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -przechowalnia_ 0x7080000 MREMD.o -MPIR_All_communicators - 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -diffcuta_ 0x8 readrtns_CSA.o -vectors_ 0x62700 energy_p_new_barrier.o -thread_ 0x148 readrtns_CSA.o -back_constr_ 0x165cc unres.o -MPIR_I_PACKED 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_local 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -logging_flag 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -pizda_ 0x12c0 readrtns_CSA.o -execer_myhost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_rhandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -MPIR_topo_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -par_ 0x20 eigen.o -info_ 0x4010 timing.o -MPIR_I_INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -tty_orig 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) -MPIR_I_DOUBLE_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mpgrad_ 0x2588 initialize_p.o -info1_ 0x2824 timing.o -setup_ 0x6040 unres.o -p4_wd 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_Op_errno 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) -restraints_ 0x8 unres.o -MPIR_I_LONG_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -torcnstr_ 0x7098 initialize_p.o -stochcalc_ 0xe100 MD_A-MTS.o -MPIR_I_2FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_real4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -indices_ 0x7060 chainbuild.o -qmeas_ 0x7633c unres.o -MPID_recvs 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) -mpipriv_ 0x24 unres.o -p4_remote_debug_level - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_shandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -total_pack_unacked 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -kutas_ 0x4 energy_p_new_barrier.o -cntrl_ 0x7c unres.o -sserver_port 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotmat_ 0x54600 unres.o -varin_ 0x12d48 readrtns_CSA.o -p4_myname_in_procgroup - 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -lagrange_ 0x1085e2b8 unres.o -message_catalog 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) -MPIR_I_UCHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -fnames_ 0x1007 unres.o -loc_const_ 0x40 local_move.o -stoptim_ 0x4 unres.o -sclocal_ 0x22cc chainbuild.o -time1_ 0x30 unres.o -MPIR_I_2DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -bank_disulfid_ 0x1f0 readrtns_CSA.o -MPID_pack_info 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_debug_qh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -mdcalc_ 0x108 unres.o -dipmat_ 0xafc8000 unres.o -hand_start_remotes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -execer_starting_remotes - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -remdcommon_ 0x6030 unres.o -sbridge_ 0x9c unres.o -refer_ 0x98 bond_move.o -csafiles_ 0xc00 unres.o -MPIR_tid 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -thread1_ 0x1cd0 readrtns_CSA.o -langmat_ 0x83d6000 readrtns_CSA.o -__P4GLOBALTYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -integer_muca_ 0xc readrtns_CSA.o -MPI_SHORT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -inertia_ 0x160 unres.o -mcm_ 0x20a4 initialize_p.o -MPIR_I_2DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -for__pthread_mutex_lock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -mce_counters_ 0x14 readrtns_CSA.o -aaaa_ 0x8 MP.o -store0_ 0x4 geomout.o -MPIR_I_2INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -banii_ 0xe100 banach.o -scrot_ 0x28a0 parmread.o -c_frag_ 0x2588 geomout.o -move_ 0x4b78 initialize_p.o -MPIR_fdtels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -MPIR_I_LONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -vrandd_ 0x3f0 randgens.o -syfek_ 0xe100 stochfric.o -whoami_p4 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -windows_ 0x3844 initialize_p.o -contacts_hb_ 0x4e483c0 unres.o -MPIR_debug_s 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_ULONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_hbt_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -srutu_ 0x4 unres.o -contdistrib_ 0x2c0944c unres.o -expect_ack 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_hbts 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -__P4TYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -traj1cache_ 0x480dc unres.o -accept_stats_ 0x2008 initialize_p.o -execer_masthost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -for__l_argc 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -invlen_ 0x4b00 chainbuild.o -MPIR_I_LONG_DOUBLE_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_debug_c 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPI_LONG_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_LB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_debug_level 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -stretch_ 0x608 unres.o -for__aio_lub_table 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -iofile_ 0x65c initialize_p.o -MPIR_qels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -__P4LEN 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -local_domain 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -minimm_ 0x20 initialize_p.o -MPIR_debug_qel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -send2_ 0x151b0 readrtns_CSA.o -MPIR_debug_sqel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_2COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -gucio_ 0x18 MD_A-MTS.o -ch_debug_buf 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -execer_mynumprocs 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts_ 0x38408 unres.o -__BLNK__ 0xc djacob.o -MPIR_I_LOGICAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_int2_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -geo_ 0x40 unres.o -execer_mynodenum 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_int4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -csaunits_ 0x34 unres.o -body_ 0x6180 unres.o -interact_ 0x154bc unres.o -theta_abinitio_ 0x24a70 chainbuild.o -oldgeo_ 0xbb8f4 unres.o -rotat_ 0x38400 unres.o -var_ 0x35e90 unres.o -secondarys_ 0x4b0 dihed_cons.o -MPIR_debug_cl 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -Discarded input sections - - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .note.GNU-stack - 0x0000000000000000 0x0 unres.o - .note.GNU-stack - 0x0000000000000000 0x0 arcos.o - .note.GNU-stack - 0x0000000000000000 0x0 cartprint.o - .note.GNU-stack - 0x0000000000000000 0x0 chainbuild.o - .note.GNU-stack - 0x0000000000000000 0x0 convert.o - .note.GNU-stack - 0x0000000000000000 0x0 initialize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 matmult.o - .note.GNU-stack - 0x0000000000000000 0x0 readrtns_CSA.o - .note.GNU-stack - 0x0000000000000000 0x0 parmread.o - .note.GNU-stack - 0x0000000000000000 0x0 gen_rand_conf.o - .note.GNU-stack - 0x0000000000000000 0x0 printmat.o - .note.GNU-stack - 0x0000000000000000 0x0 map.o - .note.GNU-stack - 0x0000000000000000 0x0 pinorm.o - .note.GNU-stack - 0x0000000000000000 0x0 randgens.o - .note.GNU-stack - 0x0000000000000000 0x0 rescode.o - .note.GNU-stack - 0x0000000000000000 0x0 intcor.o - .note.GNU-stack - 0x0000000000000000 0x0 timing.o - .note.GNU-stack - 0x0000000000000000 0x0 misc.o - .note.GNU-stack - 0x0000000000000000 0x0 intlocal.o - .note.GNU-stack - 0x0000000000000000 0x0 cartder.o - .note.GNU-stack - 0x0000000000000000 0x0 checkder_p.o - .note.GNU-stack - 0x0000000000000000 0x0 econstr_local.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 gradient_p.o - .note.GNU-stack - 0x0000000000000000 0x0 minimize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 sumsld.o - .note.GNU-stack - 0x0000000000000000 0x0 cored.o - .note.GNU-stack - 0x0000000000000000 0x0 rmdd.o - .note.GNU-stack - 0x0000000000000000 0x0 geomout.o - .note.GNU-stack - 0x0000000000000000 0x0 readpdb.o - .note.GNU-stack - 0x0000000000000000 0x0 regularize.o - .note.GNU-stack - 0x0000000000000000 0x0 thread.o - .note.GNU-stack - 0x0000000000000000 0x0 fitsq.o - .note.GNU-stack - 0x0000000000000000 0x0 mcm.o - .note.GNU-stack - 0x0000000000000000 0x0 mc.o - .note.GNU-stack - 0x0000000000000000 0x0 bond_move.o - .note.GNU-stack - 0x0000000000000000 0x0 refsys.o - .note.GNU-stack - 0x0000000000000000 0x0 check_sc_distr.o - .note.GNU-stack - 0x0000000000000000 0x0 check_bond.o - .note.GNU-stack - 0x0000000000000000 0x0 contact.o - .note.GNU-stack - 0x0000000000000000 0x0 djacob.o - .note.GNU-stack - 0x0000000000000000 0x0 eigen.o - .note.GNU-stack - 0x0000000000000000 0x0 blas.o - .note.GNU-stack - 0x0000000000000000 0x0 add.o - .note.GNU-stack - 0x0000000000000000 0x0 entmcm.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_mcmf.o - .note.GNU-stack - 0x0000000000000000 0x0 together.o - .note.GNU-stack - 0x0000000000000000 0x0 csa.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_jlee.o - .note.GNU-stack - 0x0000000000000000 0x0 shift.o - .note.GNU-stack - 0x0000000000000000 0x0 diff12.o - .note.GNU-stack - 0x0000000000000000 0x0 bank.o - .note.GNU-stack - 0x0000000000000000 0x0 newconf.o - .note.GNU-stack - 0x0000000000000000 0x0 ran.o - .note.GNU-stack - 0x0000000000000000 0x0 indexx.o - .note.GNU-stack - 0x0000000000000000 0x0 MP.o - .note.GNU-stack - 0x0000000000000000 0x0 compare_s1.o - .note.GNU-stack - 0x0000000000000000 0x0 prng_32.o - .note.GNU-stack - 0x0000000000000000 0x0 test.o - .note.GNU-stack - 0x0000000000000000 0x0 banach.o - .note.GNU-stack - 0x0000000000000000 0x0 distfit.o - .note.GNU-stack - 0x0000000000000000 0x0 rmsd.o - .note.GNU-stack - 0x0000000000000000 0x0 elecont.o - .note.GNU-stack - 0x0000000000000000 0x0 dihed_cons.o - .note.GNU-stack - 0x0000000000000000 0x0 sc_move.o - .note.GNU-stack - 0x0000000000000000 0x0 local_move.o - .note.GNU-stack - 0x0000000000000000 0x0 intcartderiv.o - .note.GNU-stack - 0x0000000000000000 0x0 /tmp/ipo_ifortx3jrsv.o - .note.GNU-stack - 0x0000000000000000 0x0 stochfric.o - .note.GNU-stack - 0x0000000000000000 0x0 kinetic_lesyng.o - .note.GNU-stack - 0x0000000000000000 0x0 MD_A-MTS.o - .note.GNU-stack - 0x0000000000000000 0x0 moments.o - .note.GNU-stack - 0x0000000000000000 0x0 int_to_cart.o - .note.GNU-stack - 0x0000000000000000 0x0 surfatom.o - .note.GNU-stack - 0x0000000000000000 0x0 sort.o - .note.GNU-stack - 0x0000000000000000 0x0 muca_md.o - .note.GNU-stack - 0x0000000000000000 0x0 MREMD.o - .note.GNU-stack - 0x0000000000000000 0x0 rattle.o - .note.GNU-stack - 0x0000000000000000 0x0 gauss.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_split-sep.o - .note.GNU-stack - 0x0000000000000000 0x0 q_measure.o - .note.GNU-stack - 0x0000000000000000 0x0 gnmr1.o - .note.GNU-stack - 0x0000000000000000 0x0 proc_proc.o - .note.GNU-stack - 0x0000000000000000 0x0 cinfo.o - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -Memory Configuration - -Name Origin Length Attributes -*default* 0x0000000000000000 0xffffffffffffffff - -Linker script and memory map - -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o -LOAD unres.o -LOAD arcos.o -LOAD cartprint.o -LOAD chainbuild.o -LOAD convert.o -LOAD initialize_p.o -LOAD matmult.o -LOAD readrtns_CSA.o -LOAD parmread.o -LOAD gen_rand_conf.o -LOAD printmat.o -LOAD map.o -LOAD pinorm.o -LOAD randgens.o -LOAD rescode.o -LOAD intcor.o -LOAD timing.o -LOAD misc.o -LOAD intlocal.o -LOAD cartder.o -LOAD checkder_p.o -LOAD econstr_local.o -LOAD energy_p_new_barrier.o -LOAD energy_p_new-sep_barrier.o -LOAD gradient_p.o -LOAD minimize_p.o -LOAD sumsld.o -LOAD cored.o -LOAD rmdd.o -LOAD geomout.o -LOAD readpdb.o -LOAD regularize.o -LOAD thread.o -LOAD fitsq.o -LOAD mcm.o -LOAD mc.o -LOAD bond_move.o -LOAD refsys.o -LOAD check_sc_distr.o -LOAD check_bond.o -LOAD contact.o -LOAD djacob.o -LOAD eigen.o -LOAD blas.o -LOAD add.o -LOAD entmcm.o -LOAD minim_mcmf.o -LOAD together.o -LOAD csa.o -LOAD minim_jlee.o -LOAD shift.o -LOAD diff12.o -LOAD bank.o -LOAD newconf.o -LOAD ran.o -LOAD indexx.o -LOAD MP.o -LOAD compare_s1.o -LOAD prng_32.o -LOAD test.o -LOAD banach.o -LOAD distfit.o -LOAD rmsd.o -LOAD elecont.o -LOAD dihed_cons.o -LOAD sc_move.o -LOAD local_move.o -LOAD intcartderiv.o -LOAD /tmp/ipo_ifortx3jrsv.o -LOAD stochfric.o -LOAD kinetic_lesyng.o -LOAD MD_A-MTS.o -LOAD moments.o -LOAD int_to_cart.o -LOAD surfatom.o -LOAD sort.o -LOAD muca_md.o -LOAD MREMD.o -LOAD rattle.o -LOAD gauss.o -LOAD energy_split-sep.o -LOAD q_measure.o -LOAD gnmr1.o -LOAD proc_proc.o -LOAD cinfo.o -LOAD /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a -LOAD xdrf_em64/libxdrf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libm.so -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libipgo.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libpthread.so -START GROUP -LOAD /lib64/libpthread.so.0 -LOAD /usr/lib64/libpthread_nonshared.a -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc_s.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc_s.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libdl.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x0000000000400000 PROVIDE (__executable_start, 0x400000) - 0x0000000000400200 . = (0x400000 + SIZEOF_HEADERS) - -.interp 0x0000000000400200 0x1c - *(.interp) - .interp 0x0000000000400200 0x1c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.ABI-tag 0x000000000040021c 0x20 - .note.ABI-tag 0x000000000040021c 0x20 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.gnu.build-id - *(.note.gnu.build-id) - -.hash 0x0000000000400240 0x71c - *(.hash) - .hash 0x0000000000400240 0x71c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.hash - *(.gnu.hash) - -.dynsym 0x0000000000400960 0x1800 - *(.dynsym) - .dynsym 0x0000000000400960 0x1800 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.dynstr 0x0000000000402160 0xa61 - *(.dynstr) - .dynstr 0x0000000000402160 0xa61 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version 0x0000000000402bc2 0x200 - *(.gnu.version) - .gnu.version 0x0000000000402bc2 0x200 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_d 0x0000000000402dc8 0x0 load address 0x0000000000402dc2 - *(.gnu.version_d) - .gnu.version_d - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_r 0x0000000000402dc8 0x90 - *(.gnu.version_r) - .gnu.version_r - 0x0000000000402dc8 0x90 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.rela.dyn 0x0000000000402e58 0x5b8 - *(.rela.init) - *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) - .rela.text 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.fini) - *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) - .rela.rodata 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) - .rela.data 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) - *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) - *(.rela.ctors) - *(.rela.dtors) - *(.rela.got) - .rela.got 0x0000000000402e58 0x558 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.sharable_data .rela.sharable_data.* .rela.gnu.linkonce.shrd.*) - *(.rela.sharable_bss .rela.sharable_bss.* .rela.gnu.linkonce.shrb.*) - .rela.sharable_bss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) - .rela.bss 0x00000000004033b0 0x60 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.ldata .rela.ldata.* .rela.gnu.linkonce.l.*) - *(.rela.lbss .rela.lbss.* .rela.gnu.linkonce.lb.*) - *(.rela.lrodata .rela.lrodata.* .rela.gnu.linkonce.lr.*) - *(.rela.ifunc) - -.rela.plt 0x0000000000403410 0x1008 - *(.rela.plt) - .rela.plt 0x0000000000403410 0x1008 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_start, .) - *(.rela.iplt) - .rela.iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_end, .) - -.init 0x0000000000404418 0x18 - *(.init) - .init 0x0000000000404418 0x9 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x0000000000404418 _init - .init 0x0000000000404421 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .init 0x0000000000404426 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .init 0x000000000040442b 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.plt 0x0000000000404430 0xac0 - *(.plt) - .plt 0x0000000000404430 0xac0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404440 ctime@@GLIBC_2.2.5 - 0x0000000000404450 xdr_double@@GLIBC_2.2.5 - 0x0000000000404460 tcsetattr@@GLIBC_2.2.5 - 0x0000000000404470 chdir@@GLIBC_2.2.5 - 0x0000000000404480 fileno@@GLIBC_2.2.5 - 0x0000000000404490 dup2@@GLIBC_2.2.5 - 0x00000000004044a0 printf@@GLIBC_2.2.5 - 0x00000000004044b0 pause@@GLIBC_2.2.5 - 0x00000000004044c0 _Unwind_GetRegionStart@@GCC_3.0 - 0x00000000004044d0 memset@@GLIBC_2.2.5 - 0x00000000004044e0 ftell@@GLIBC_2.2.5 - 0x00000000004044f0 snprintf@@GLIBC_2.2.5 - 0x0000000000404500 setsid@@GLIBC_2.2.5 - 0x0000000000404510 shutdown@@GLIBC_2.2.5 - 0x0000000000404520 posix_memalign@@GLIBC_2.2.5 - 0x0000000000404530 xdr_u_short@@GLIBC_2.2.5 - 0x0000000000404540 close@@GLIBC_2.2.5 - 0x0000000000404550 wait@@GLIBC_2.2.5 - 0x0000000000404560 ioctl@@GLIBC_2.2.5 - 0x0000000000404570 abort@@GLIBC_2.2.5 - 0x0000000000404580 ttyname@@GLIBC_2.2.5 - 0x0000000000404590 memchr@@GLIBC_2.2.5 - 0x00000000004045a0 xdr_int@@GLIBC_2.2.5 - 0x00000000004045b0 getlogin@@GLIBC_2.2.5 - 0x00000000004045c0 strncat@@GLIBC_2.2.5 - 0x00000000004045d0 isatty@@GLIBC_2.2.5 - 0x00000000004045e0 gethostbyname@@GLIBC_2.2.5 - 0x00000000004045f0 xdr_bool@@GLIBC_2.2.5 - 0x0000000000404600 puts@@GLIBC_2.2.5 - 0x0000000000404610 uname@@GLIBC_2.2.5 - 0x0000000000404620 fseek@@GLIBC_2.2.5 - 0x0000000000404630 htons@@GLIBC_2.2.5 - 0x0000000000404640 select@@GLIBC_2.2.5 - 0x0000000000404650 getpeername@@GLIBC_2.2.5 - 0x0000000000404660 exit@@GLIBC_2.2.5 - 0x0000000000404670 gettimeofday@@GLIBC_2.2.5 - 0x0000000000404680 putchar@@GLIBC_2.2.5 - 0x0000000000404690 xdrmem_create@@GLIBC_2.2.5 - 0x00000000004046a0 read@@GLIBC_2.2.5 - 0x00000000004046b0 strncmp@@GLIBC_2.2.5 - 0x00000000004046c0 malloc@@GLIBC_2.2.5 - 0x00000000004046d0 fopen@@GLIBC_2.2.5 - 0x00000000004046e0 __libc_start_main@@GLIBC_2.2.5 - 0x00000000004046f0 recv@@GLIBC_2.2.5 - 0x0000000000404700 setitimer@@GLIBC_2.2.5 - 0x0000000000404710 system@@GLIBC_2.2.5 - 0x0000000000404720 execlp@@GLIBC_2.2.5 - 0x0000000000404730 unlink@@GLIBC_2.2.5 - 0x0000000000404740 sched_yield@@GLIBC_2.2.5 - 0x0000000000404750 siglongjmp@@GLIBC_2.2.5 - 0x0000000000404760 catgets@@GLIBC_2.2.5 - 0x0000000000404770 setsockopt@@GLIBC_2.2.5 - 0x0000000000404780 sysconf@@GLIBC_2.2.5 - 0x0000000000404790 getpid@@GLIBC_2.2.5 - 0x00000000004047a0 catclose@@GLIBC_2.2.5 - 0x00000000004047b0 xdr_opaque@@GLIBC_2.2.5 - 0x00000000004047c0 fgets@@GLIBC_2.2.5 - 0x00000000004047d0 xdr_u_int@@GLIBC_2.2.5 - 0x00000000004047e0 __fxstat64@@GLIBC_2.2.5 - 0x00000000004047f0 freopen64@@GLIBC_2.2.5 - 0x0000000000404800 getpwuid@@GLIBC_2.2.5 - 0x0000000000404810 geteuid@@GLIBC_2.2.5 - 0x0000000000404820 rindex@@GLIBC_2.2.5 - 0x0000000000404830 xdr_float@@GLIBC_2.2.5 - 0x0000000000404840 fputc@@GLIBC_2.2.5 - 0x0000000000404850 times@@GLIBC_2.2.5 - 0x0000000000404860 free@@GLIBC_2.2.5 - 0x0000000000404870 _IO_getc@@GLIBC_2.2.5 - 0x0000000000404880 strlen@@GLIBC_2.2.5 - 0x0000000000404890 vsprintf@@GLIBC_2.2.5 - 0x00000000004048a0 __sysconf@@GLIBC_2.2.5 - 0x00000000004048b0 bcopy@@GLIBC_2.2.5 - 0x00000000004048c0 nice@@GLIBC_2.2.5 - 0x00000000004048d0 opendir@@GLIBC_2.2.5 - 0x00000000004048e0 __xpg_basename@@GLIBC_2.2.5 - 0x00000000004048f0 mkstemp64@@GLIBC_2.2.5 - 0x0000000000404900 listen@@GLIBC_2.2.5 - 0x0000000000404910 __ctype_b_loc@@GLIBC_2.3 - 0x0000000000404920 xdr_char@@GLIBC_2.2.5 - 0x0000000000404930 sprintf@@GLIBC_2.2.5 - 0x0000000000404940 ntohs@@GLIBC_2.2.5 - 0x0000000000404950 ntohl@@GLIBC_2.2.5 - 0x0000000000404960 strrchr@@GLIBC_2.2.5 - 0x0000000000404970 _Unwind_GetIP@@GCC_3.0 - 0x0000000000404980 sscanf@@GLIBC_2.2.5 - 0x0000000000404990 sleep@@GLIBC_2.2.5 - 0x00000000004049a0 fsync@@GLIBC_2.2.5 - 0x00000000004049b0 xdr_u_char@@GLIBC_2.2.5 - 0x00000000004049c0 kill@@GLIBC_2.2.5 - 0x00000000004049d0 strerror@@GLIBC_2.2.5 - 0x00000000004049e0 open64@@GLIBC_2.2.5 - 0x00000000004049f0 strstr@@GLIBC_2.2.5 - 0x0000000000404a00 sigprocmask@@GLIBC_2.2.5 - 0x0000000000404a10 sigaction@@GLIBC_2.2.5 - 0x0000000000404a20 xdr_array@@GLIBC_2.2.5 - 0x0000000000404a30 socketpair@@GLIBC_2.2.5 - 0x0000000000404a40 strcat@@GLIBC_2.2.5 - 0x0000000000404a50 getsockopt@@GLIBC_2.2.5 - 0x0000000000404a60 vprintf@@GLIBC_2.2.5 - 0x0000000000404a70 fputs@@GLIBC_2.2.5 - 0x0000000000404a80 _Unwind_ForcedUnwind@@GCC_3.0 - 0x0000000000404a90 strtol@@GLIBC_2.2.5 - 0x0000000000404aa0 ftruncate64@@GLIBC_2.2.5 - 0x0000000000404ab0 readlink@@GLIBC_2.2.5 - 0x0000000000404ac0 getsockname@@GLIBC_2.2.5 - 0x0000000000404ad0 atoi@@GLIBC_2.2.5 - 0x0000000000404ae0 connect@@GLIBC_2.2.5 - 0x0000000000404af0 gethostname@@GLIBC_2.2.5 - 0x0000000000404b00 tcgetattr@@GLIBC_2.2.5 - 0x0000000000404b10 memcpy@@GLIBC_2.2.5 - 0x0000000000404b20 raise@@GLIBC_2.2.5 - 0x0000000000404b30 signal@@GLIBC_2.2.5 - 0x0000000000404b40 memmove@@GLIBC_2.2.5 - 0x0000000000404b50 strchr@@GLIBC_2.2.5 - 0x0000000000404b60 waitpid@@GLIBC_2.2.5 - 0x0000000000404b70 getchar@@GLIBC_2.2.5 - 0x0000000000404b80 socket@@GLIBC_2.2.5 - 0x0000000000404b90 fread@@GLIBC_2.2.5 - 0x0000000000404ba0 setenv@@GLIBC_2.2.5 - 0x0000000000404bb0 inet_ntoa@@GLIBC_2.2.5 - 0x0000000000404bc0 xdrstdio_create@@GLIBC_2.2.5 - 0x0000000000404bd0 catopen@@GLIBC_2.2.5 - 0x0000000000404be0 getenv@@GLIBC_2.2.5 - 0x0000000000404bf0 __errno_location@@GLIBC_2.2.5 - 0x0000000000404c00 xdr_vector@@GLIBC_2.2.5 - 0x0000000000404c10 clock@@GLIBC_2.2.5 - 0x0000000000404c20 sigaddset@@GLIBC_2.2.5 - 0x0000000000404c30 getdtablesize@@GLIBC_2.2.5 - 0x0000000000404c40 strcmp@@GLIBC_2.2.5 - 0x0000000000404c50 getcwd@@GLIBC_2.2.5 - 0x0000000000404c60 index@@GLIBC_2.2.5 - 0x0000000000404c70 strcpy@@GLIBC_2.2.5 - 0x0000000000404c80 strtok@@GLIBC_2.2.5 - 0x0000000000404c90 nanosleep@@GLIBC_2.2.5 - 0x0000000000404ca0 getuid@@GLIBC_2.2.5 - 0x0000000000404cb0 xdr_long@@GLIBC_2.2.5 - 0x0000000000404cc0 xdr_short@@GLIBC_2.2.5 - 0x0000000000404cd0 dladdr@@GLIBC_2.2.5 - 0x0000000000404ce0 __ctype_tolower_loc@@GLIBC_2.3 - 0x0000000000404cf0 memcmp@@GLIBC_2.2.5 - 0x0000000000404d00 xdr_string@@GLIBC_2.2.5 - 0x0000000000404d10 calloc@@GLIBC_2.2.5 - 0x0000000000404d20 feof@@GLIBC_2.2.5 - 0x0000000000404d30 writev@@GLIBC_2.2.5 - 0x0000000000404d40 fclose@@GLIBC_2.2.5 - 0x0000000000404d50 freopen@@GLIBC_2.2.5 - 0x0000000000404d60 strncpy@@GLIBC_2.2.5 - 0x0000000000404d70 __xstat64@@GLIBC_2.2.5 - 0x0000000000404d80 lseek64@@GLIBC_2.2.5 - 0x0000000000404d90 dlsym@@GLIBC_2.2.5 - 0x0000000000404da0 closedir@@GLIBC_2.2.5 - 0x0000000000404db0 fork@@GLIBC_2.2.5 - 0x0000000000404dc0 sigemptyset@@GLIBC_2.2.5 - 0x0000000000404dd0 getppid@@GLIBC_2.2.5 - 0x0000000000404de0 fopen64@@GLIBC_2.2.5 - 0x0000000000404df0 sendto@@GLIBC_2.2.5 - 0x0000000000404e00 bind@@GLIBC_2.2.5 - 0x0000000000404e10 fwrite@@GLIBC_2.2.5 - 0x0000000000404e20 htonl@@GLIBC_2.2.5 - 0x0000000000404e30 realloc@@GLIBC_2.2.5 - 0x0000000000404e40 setlocale@@GLIBC_2.2.5 - 0x0000000000404e50 perror@@GLIBC_2.2.5 - 0x0000000000404e60 __sigsetjmp@@GLIBC_2.2.5 - 0x0000000000404e70 fprintf@@GLIBC_2.2.5 - 0x0000000000404e80 xdr_u_long@@GLIBC_2.2.5 - 0x0000000000404e90 write@@GLIBC_2.2.5 - 0x0000000000404ea0 accept@@GLIBC_2.2.5 - 0x0000000000404eb0 fcntl@@GLIBC_2.2.5 - 0x0000000000404ec0 _IO_putc@@GLIBC_2.2.5 - 0x0000000000404ed0 time@@GLIBC_2.2.5 - 0x0000000000404ee0 fflush@@GLIBC_2.2.5 - *(.iplt) - .iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.text 0x0000000000404ef0 0x29d408 - *(.text.unlikely .text.*_unlikely) - *(.text .stub .text.* .gnu.linkonce.t.*) - .text 0x0000000000404ef0 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404ef0 _start - .text 0x0000000000404f1c 0x17 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - *fill* 0x0000000000404f33 0xd 90909090 - .text 0x0000000000404f40 0x92 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x0000000000404fd2 0xe 90909090 - .text 0x0000000000404fe0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - 0x0000000000404fe0 main - .text 0x0000000000405030 0x46c0 unres.o - 0x0000000000405030 MAIN__ - 0x00000000004068b0 exec_mult_eeval_or_minim_ - 0x0000000000408390 exec_mremd_ - 0x00000000004084e0 exec_md_ - 0x0000000000408550 exec_softreg_ - 0x0000000000408690 exec_csa_ - 0x00000000004086a0 exec_map_ - 0x00000000004086c0 exec_checkgrad_ - 0x0000000000408890 exec_mc_ - 0x00000000004088d0 exec_thread_ - 0x00000000004088e0 exec_regularize_ - 0x0000000000408a70 exec_eeval_or_minim_ - .text 0x00000000004096f0 0x60 arcos.o - 0x00000000004096f0 arcos_ - .text 0x0000000000409750 0x240 cartprint.o - 0x0000000000409750 cartprint_ - .text 0x0000000000409990 0x1780 chainbuild.o - 0x0000000000409990 chainbuild_ - 0x000000000040a470 locate_next_res_ - 0x000000000040a9f0 orig_frame_ - 0x000000000040ae50 locate_side_chain_ - .text 0x000000000040b110 0x1820 convert.o - 0x000000000040b110 geom_to_var_ - 0x000000000040b1f0 var_to_geom_ - 0x000000000040bb20 reduce_ - 0x000000000040c090 convert_side_ - 0x000000000040c0f0 thetnorm_ - 0x000000000040c140 var_to_geom_restr_ - .text 0x000000000040c930 0x6e10 initialize_p.o - 0x000000000040c930 data$ifortigjemi_ - 0x000000000040c940 nazwy_ - 0x000000000040c950 int_bounds1_ - 0x000000000040cbe0 int_partition_ - 0x000000000040cc60 int_bounds_ - 0x000000000040cef0 add_task_ - 0x000000000040cf20 hpb_partition_ - 0x000000000040d3a0 add_int_from_ - 0x000000000040d690 add_int_ - 0x000000000040d9f0 init_int_table_ - 0x0000000000412e50 initialize_ - .text 0x0000000000413740 0x210 matmult.o - 0x0000000000413740 matmult_ - .text 0x0000000000413950 0x1c240 readrtns_CSA.o - 0x0000000000413950 readrtns_ - 0x00000000004157f0 read_mdpar_ - 0x0000000000419880 read_control_ - 0x000000000041c120 mcmread_ - 0x000000000041dc70 molread_ - 0x0000000000424300 read_bridge_ - 0x0000000000424ec0 read_dist_constr_ - 0x00000000004263c0 read_angles_ - 0x00000000004266f0 read_threadbase_ - 0x0000000000426bf0 csaread_ - 0x0000000000428b10 card_concat_ - 0x0000000000428d30 readi_ - 0x0000000000428e00 read_remdpar_ - 0x000000000042a0b0 read_minim_ - 0x000000000042a9f0 reada_ - 0x000000000042aac0 read_fragments_ - 0x000000000042b670 setup_var_ - 0x000000000042b720 seq_comp_ - 0x000000000042b750 read_x_ - 0x000000000042bbd0 gen_dist_constr_ - 0x000000000042bcc0 map_read_ - 0x000000000042c3f0 multreadi_ - 0x000000000042c600 multreada_ - 0x000000000042c820 openunits_ - 0x000000000042ee50 copy_to_tmp_ - 0x000000000042f1b0 readrst_ - 0x000000000042f490 move_from_tmp_ - 0x000000000042f710 random_init_ - .text 0x000000000042fb90 0x9380 parmread.o - 0x000000000042fb90 parmread_ - 0x0000000000438f00 getenv_loc_ - .text 0x0000000000438f10 0x43d0 gen_rand_conf.o - 0x0000000000438f10 gen_rand_conf_ - 0x0000000000439b40 gen_side_ - 0x000000000043a8d0 gen_theta_ - 0x000000000043ad90 gen_phi_ - 0x000000000043add0 overlap_ - 0x000000000043b390 ran_number_ - 0x000000000043b3d0 binorm_ - 0x000000000043b6b0 mult_norm1_ - 0x000000000043b9b0 iran_num_ - 0x000000000043ba00 anorm_distr_ - 0x000000000043bb50 mult_norm_ - 0x000000000043bf90 overlap_sc_ - 0x000000000043cd30 overlap_sc_list_ - .text 0x000000000043d2e0 0x330 printmat.o - 0x000000000043d2e0 printmat_ - .text 0x000000000043d610 0xb10 map.o - 0x000000000043d610 map_ - .text 0x000000000043e120 0x50 pinorm.o - 0x000000000043e120 pinorm_ - .text 0x000000000043e170 0x760 randgens.o - 0x000000000043e170 vrnd_ - 0x000000000043e200 rndv_ - 0x000000000043e480 vrndst_ - 0x000000000043e730 vrndin_ - 0x000000000043e7c0 vrndou_ - 0x000000000043e850 rnunf_ - .text 0x000000000043e8d0 0x190 rescode.o - 0x000000000043e8d0 rescode_ - .text 0x000000000043ea60 0x450 intcor.o - 0x000000000043ea60 alpha_ - 0x000000000043eb70 beta_ - 0x000000000043ee50 dist_ - .text 0x000000000043eeb0 0x1a30 timing.o - 0x000000000043eeb0 set_timers_ - 0x000000000043efc0 tcpu_ - 0x000000000043eff0 ovrtim_ - 0x000000000043f2b0 dajczas_ - 0x000000000043f410 print_detailed_timing_ - 0x00000000004408d0 stopx_ - .text 0x00000000004408e0 0x9e0 misc.o - 0x00000000004408e0 find_arg_ - 0x0000000000440970 find_group_ - 0x0000000000440c30 lcom_ - 0x0000000000440c60 ilen_ - 0x0000000000440cd0 ucase_ - 0x0000000000440dd0 iblnk_ - 0x0000000000440e10 in_keywd_set_ - 0x0000000000440f70 lcase_ - 0x0000000000441070 lower_case_ - 0x00000000004410d0 mykey_ - 0x00000000004411b0 numstr_ - .text 0x00000000004412c0 0x6300 intlocal.o - 0x00000000004412c0 integral_ - 0x0000000000441ad0 ele_ - 0x0000000000441b50 elocal_ - 0x0000000000441dc0 integral3_ - 0x0000000000443860 integral5_ - 0x0000000000444710 integral_turn6_ - 0x0000000000445430 integral6_ - 0x00000000004466e0 integral3a_ - 0x0000000000446d60 integral4a_ - .text 0x00000000004475c0 0x1680 cartder.o - 0x00000000004475c0 cartder_ - .text 0x0000000000448c40 0x4720 checkder_p.o - 0x0000000000448c40 check_cartgrad_ - 0x000000000044a930 check_ecart_ - 0x000000000044b410 check_ecartint_ - 0x000000000044c5f0 int_from_cart1_ - 0x000000000044ccf0 check_eint_ - .text 0x000000000044d360 0x880 econstr_local.o - 0x000000000044d360 econstr_back_ - .text 0x000000000044dbe0 0x4afb0 energy_p_new_barrier.o - 0x000000000044dbe0 etotal_ - 0x00000000004516f0 ssbond_ene_ - 0x0000000000451d00 egbv_ - 0x0000000000452dd0 egb_ - 0x0000000000453ff0 ebp_ - 0x0000000000454f70 eelec_ - 0x00000000004556f0 eturn3_ - 0x00000000004560b0 eturn4_ - 0x0000000000458ec0 eelecij_ - 0x000000000045dbe0 set_matrices_ - 0x000000000045f010 ebond_ - 0x000000000045fbe0 ebend_ - 0x0000000000461bf0 esc_ - 0x0000000000463b80 enesc_ - 0x0000000000464130 etor_ - 0x0000000000464980 multibody_eello_ - 0x0000000000466a70 eello6_ - 0x000000000046c090 eello6_graph3_ - 0x000000000046c770 eello6_graph4_ - 0x0000000000472320 eello6_graph2_ - 0x0000000000473210 eello6_graph1_ - 0x0000000000473b10 eello_turn6_ - 0x0000000000476b80 eello4_ - 0x0000000000477400 eello5_ - 0x00000000004797b0 calc_eello_ - 0x0000000000489ae0 kernel_ - 0x000000000048a8d0 multibody_hb_ - 0x000000000048c590 add_hb_contact_ - 0x000000000048c830 sum_energy_ - 0x000000000048cac0 eback_sc_corr_ - 0x000000000048ce40 etor_d_ - 0x000000000048dae0 edis_ - 0x000000000048e470 escp_soft_sphere_ - 0x000000000048e780 escp_ - 0x000000000048ee80 eelec_soft_sphere_ - 0x000000000048f1c0 e_softsphere_ - 0x000000000048f520 eljk_ - 0x000000000048fb60 elj_ - 0x0000000000490350 sum_gradient_ - 0x0000000000492eb0 scalar_ - 0x0000000000492ee0 rescale_weights_ - 0x00000000004933e0 enerprint_ - 0x0000000000493ab0 gcont_ - 0x0000000000493b80 sc_grad_ - 0x0000000000494020 sc_angular_ - 0x00000000004943f0 unormderiv_ - 0x0000000000494580 vecpr_ - 0x00000000004945e0 check_vecgrad_ - 0x00000000004949d0 vec_and_deriv_ - 0x0000000000496900 transpose2_ - 0x0000000000496920 matmat2_ - 0x00000000004969a0 matvec2_ - 0x00000000004969e0 scalar2_ - 0x0000000000496a00 spline2_ - 0x0000000000496a90 spline1_ - 0x0000000000496b40 mixder_ - 0x0000000000496c60 theteng_ - 0x0000000000497080 splinthet_ - 0x0000000000497260 enesc_bound_ - 0x00000000004976b0 multibody_ - 0x0000000000497dd0 esccorr_ - 0x0000000000498090 ehbcorr_ - 0x00000000004986e0 add_hb_contact_eello_ - 0x0000000000498920 prodmat3_ - 0x0000000000498aa0 transpose_ - .text 0x0000000000498b90 0xc010 energy_p_new-sep_barrier.o - 0x0000000000498b90 sscale_ - 0x0000000000498c00 elj_long_ - 0x0000000000499290 elj_short_ - 0x0000000000499920 eljk_long_ - 0x000000000049a0d0 eljk_short_ - 0x000000000049a880 ebp_long_ - 0x000000000049b280 sc_grad_scale_ - 0x000000000049b740 ebp_short_ - 0x000000000049c130 egb_long_ - 0x000000000049cdb0 egb_short_ - 0x000000000049da20 egbv_long_ - 0x000000000049e600 egbv_short_ - 0x000000000049f1e0 eelec_scale_ - 0x000000000049f950 eelecij_scale_ - 0x00000000004a3400 evdwpp_short_ - 0x00000000004a3aa0 escp_long_ - 0x00000000004a4320 escp_short_ - .text 0x00000000004a4ba0 0x1d40 gradient_p.o - 0x00000000004a4ba0 gradient_ - 0x00000000004a5110 grad_restr_ - 0x00000000004a56d0 cartgrad_ - 0x00000000004a5e90 zerograd_ - 0x00000000004a68d0 fdum_ - .text 0x00000000004a68e0 0x1650 minimize_p.o - 0x00000000004a68e0 minimize_ - 0x00000000004a6e10 xx2x_ - 0x00000000004a6ef0 x2xx_ - 0x00000000004a6fe0 func_restr_ - 0x00000000004a7040 func_ - 0x00000000004a70a0 ergastulum_ - 0x00000000004a77e0 minim_dc_ - 0x00000000004a7ba0 grad_dc_ - 0x00000000004a7e40 func_dc_ - .text 0x00000000004a7f30 0x3770 sumsld.o - 0x00000000004a7f30 sumsl_ - 0x00000000004a81d0 sumit_ - 0x00000000004a9d90 wzbfgs_ - 0x00000000004aa2b0 vvmulp_ - 0x00000000004aa5f0 lvmul_ - 0x00000000004aa830 lupdat_ - 0x00000000004aab70 ltvmul_ - 0x00000000004aad90 dbdog_ - .text 0x00000000004ab6a0 0x25c68 cored.o - 0x00000000004ab6a0 assst_ - 0x00000000004b1a3a deflt_ - 0x00000000004b2dba dotprd_ - 0x00000000004b3000 itsum_ - 0x00000000004b72fa litvmu_ - 0x00000000004b7c22 livmul_ - 0x00000000004b864a parck_ - 0x00000000004bc446 reldst_ - 0x00000000004bca86 vaxpy_ - 0x00000000004bcd94 vcopy_ - 0x00000000004bcfa0 vdflt_ - 0x00000000004be1de vscopy_ - 0x00000000004be314 v2norm_ - 0x00000000004be854 humsl_ - 0x00000000004bf79e humit_ - 0x00000000004c6b22 dupdu_ - 0x00000000004c7342 gqtst_ - 0x00000000004ce374 lsqrt_ - 0x00000000004cef5e lsvmin_ - 0x00000000004d0bbe slvmul_ - *fill* 0x00000000004d1308 0x8 90909090 - .text 0x00000000004d1310 0x90 rmdd.o - 0x00000000004d1310 imdcon_ - 0x00000000004d1320 rmdcon_ - .text 0x00000000004d13a0 0x4610 geomout.o - 0x00000000004d13a0 pdbout_ - 0x00000000004d2ac0 mol2out_ - 0x00000000004d3570 intout_ - 0x00000000004d3970 briefout_ - 0x00000000004d3f60 cartoutx_ - 0x00000000004d44e0 cartout_ - 0x00000000004d4a10 statout_ - 0x00000000004d58c0 gyrate_ - .text 0x00000000004d59b0 0x3004 readpdb.o - 0x00000000004d59b0 readpdb_ - 0x00000000004d71b4 int_from_cart_ - 0x00000000004d7fb0 sc_loc_geom_ - 0x00000000004d8800 sccenter_ - 0x00000000004d88b0 bond_regular_ - *fill* 0x00000000004d89b4 0xc 90909090 - .text 0x00000000004d89c0 0xaa0 regularize.o - 0x00000000004d89c0 regularize_ - .text 0x00000000004d9460 0x3880 thread.o - 0x00000000004d9460 thread_seq_ - 0x00000000004db7e0 write_thread_summary_ - 0x00000000004dc7c0 write_stat_thread_ - 0x00000000004dca90 sc_conf_ - .text 0x00000000004dcce0 0x2770 fitsq.o - 0x00000000004dcce0 fitsq_ - 0x00000000004dd440 sivade_ - 0x00000000004dee10 mvvad_ - 0x00000000004deeb0 det_ - 0x00000000004def10 switch_ - 0x00000000004defb0 givns_ - 0x00000000004df190 mmmul_ - 0x00000000004df320 matvec_ - .text 0x00000000004df450 0x4de0 mcm.o - 0x00000000004df450 mcm_setup_ - 0x00000000004e0500 do_mcm_ - 0x00000000004e0cf0 statprint_ - 0x00000000004e14a0 cool_ - 0x00000000004e15e0 metropolis_ - 0x00000000004e16c0 perturb_ - 0x00000000004e2570 heat_ - 0x00000000004e27c0 zapis_ - 0x00000000004e2b80 conf_comp_ - 0x00000000004e2f50 execute_slave_ - 0x00000000004e37e0 add2cache_ - 0x00000000004e3ca0 selectmove_ - 0x00000000004e3d50 gen_psi_ - 0x00000000004e3df0 dif_ang_ - 0x00000000004e3f50 rm_from_cache_ - .text 0x00000000004e4230 0x46f0 mc.o - 0x00000000004e4230 monte_carlo_ - 0x00000000004e7fe0 icialosc_ - 0x00000000004e8010 accept_mc_ - 0x00000000004e8710 entropia_ - .text 0x00000000004e8920 0xf20 bond_move.o - 0x00000000004e8920 bond_move_ - .text 0x00000000004e9840 0x420 refsys.o - 0x00000000004e9840 refsys_ - .text 0x00000000004e9c60 0x1c0 check_sc_distr.o - 0x00000000004e9c60 check_sc_distr_ - .text 0x00000000004e9e20 0xe0 check_bond.o - 0x00000000004e9e20 check_bond_ - .text 0x00000000004e9f00 0xd10 contact.o - 0x00000000004e9f00 contact_ - 0x00000000004ea280 contact_fract_ - 0x00000000004ea380 contact_fract_nn_ - 0x00000000004ea480 hairpin_ - .text 0x00000000004eac10 0xb00 djacob.o - 0x00000000004eac10 djacob_ - .text 0x00000000004eb710 0xf350 eigen.o - 0x00000000004eb710 einvit_ - 0x00000000004ed3a0 estpi1_ - 0x00000000004edb60 epslon_ - 0x00000000004edb80 elau_ - 0x00000000004ee290 eqlrat_ - 0x00000000004eea90 etrbk3_ - 0x00000000004eec10 etred3_ - 0x00000000004efb40 freda_ - 0x00000000004efe60 trbk3b_ - 0x00000000004effe0 tql2_ - 0x00000000004f08b0 tinvtb_ - 0x00000000004f1d10 imtqlv_ - 0x00000000004f22d0 tred3b_ - 0x00000000004f3120 gldiag_ - 0x00000000004f3800 jacdia_ - 0x00000000004f4530 evvrsp_ - 0x00000000004f7370 giveis_ - 0x00000000004fa1d0 jacdg_ - 0x00000000004fa720 jacord_ - .text 0x00000000004faa60 0x2760 blas.o - 0x00000000004faa60 dasum_ - 0x00000000004facf0 daxpy_ - 0x00000000004faf50 dcopy_ - 0x00000000004fb170 ddot_ - 0x00000000004fb400 dnrm2_ - 0x00000000004fb570 drot_ - 0x00000000004fb970 drotg_ - 0x00000000004fba50 dscal_ - 0x00000000004fbce0 dswap_ - 0x00000000004fbf60 idamax_ - 0x00000000004fc0e0 dgemv_ - .text 0x00000000004fd1c0 0xc0 add.o - 0x00000000004fd1c0 abrt_ - 0x00000000004fd1f0 vclr_ - .text 0x00000000004fd280 0x5100 entmcm.o - 0x00000000004fd280 entmcm_ - 0x00000000005018b0 accepting_ - 0x0000000000501f40 read_pool_ - .text 0x0000000000502380 0x4c0 minim_mcmf.o - 0x0000000000502380 minim_mcmf_ - .text 0x0000000000502840 0xbc60 together.o - 0x0000000000502840 together_ - 0x000000000050a190 feedin_ - 0x000000000050b290 reminimize_ - 0x000000000050cc00 getx_ - 0x000000000050d0d0 send_ - 0x000000000050d9d0 recv_ - 0x000000000050dcf0 history_append_ - 0x000000000050dd60 prune_bank_ - 0x000000000050e1e0 putx_ - 0x000000000050e320 putx2_ - .text 0x000000000050e4a0 0x2960 csa.o - 0x000000000050e4a0 make_array_ - 0x000000000050e840 make_ranvar_ - 0x000000000050ed80 make_ranvar_reg_ - 0x000000000050f610 from_pdb_ - 0x000000000050fee0 from_int_ - 0x0000000000510b90 dihang_to_c_ - .text 0x0000000000510e00 0x30c0 minim_jlee.o - 0x0000000000510e00 minim_jlee_ - 0x0000000000512e80 check_var_ - .text 0x0000000000513ec0 0x1570 shift.o - 0x0000000000513ec0 csa_read_ - 0x00000000005144c0 restart_write_ - 0x0000000000514c40 initial_write_ - .text 0x0000000000515430 0x140 diff12.o - 0x0000000000515430 get_diff12_ - .text 0x0000000000515570 0x90b0 bank.o - 0x0000000000515570 refresh_bank_ - 0x0000000000517540 replace_bvar_ - 0x0000000000517960 find_max_ - 0x0000000000517a30 write_rbank_ - 0x0000000000517e30 read_rbank_ - 0x0000000000518810 write_bank_ - 0x0000000000519e20 write_bank_reminimized_ - 0x000000000051a9f0 read_bank_ - 0x000000000051b520 write_bank1_ - 0x000000000051b930 save_is_ - 0x000000000051bbb0 select_is_ - 0x000000000051c350 get_is_ - 0x000000000051d1d0 get_is_ran_ - 0x000000000051d590 select_iseed_far_ - 0x000000000051d690 select_iseed_min_ - 0x000000000051d810 select_iseed_max_ - 0x000000000051d990 find_min_ - 0x000000000051da60 write_csa_pdb_ - 0x000000000051df40 get_diff_ - 0x000000000051e170 estimate_cutdif_ - 0x000000000051e220 get_is_max_ - .text 0x000000000051e620 0xdfa0 newconf.o - 0x000000000051e620 make_var_ - 0x00000000005288f0 newconf_residue_hairpin_ - 0x00000000005290a0 newconf_residue_ - 0x0000000000529500 newconf1abr_ - 0x00000000005299e0 newconf1abb_ - 0x0000000000529ec0 newconf1br_ - 0x000000000052a5a0 select_frag_ - 0x000000000052b140 newconf1bb_ - 0x000000000052b5d0 newconf1rr_ - 0x000000000052ba60 newconf1arr_ - 0x000000000052bef0 gen_hairpin_ - 0x000000000052c200 check_old_ - 0x000000000052c3b0 newconf_copy_ - .text 0x000000000052c5c0 0x470 ran.o - 0x000000000052c5c0 ran0_ - 0x000000000052c620 ran1_ - 0x000000000052c720 ran2_ - 0x000000000052c880 ran3_ - .text 0x000000000052ca30 0x320 indexx.o - 0x000000000052ca30 indexx_ - .text 0x000000000052cd50 0x3750 MP.o - 0x000000000052cd50 finish_task_ - 0x000000000052d960 pattern_receive_ - 0x000000000052dd10 pattern_send_ - 0x000000000052dd20 send_mcm_info_ - 0x000000000052df90 receive_mcm_info_ - 0x000000000052e260 send_thread_results_ - 0x000000000052e920 receive_thread_results_ - 0x000000000052f490 recv_stop_sig_ - 0x000000000052f770 send_stop_sig_ - 0x000000000052f7d0 init_task_ - .text 0x00000000005304a0 0x12e0 compare_s1.o - 0x00000000005304a0 compare_s1_ - .text 0x0000000000531780 0x260 prng_32.o - 0x0000000000531780 prng_next_ - 0x0000000000531810 vprng_ - 0x0000000000531940 prng_chkpnt_ - 0x0000000000531970 prng_restart_ - 0x00000000005319d0 prngblk_ - .text 0x00000000005319e0 0x17090 test.o - 0x00000000005319e0 test_ - 0x0000000000532940 write_pdb_ - 0x0000000000532c70 test_n16_ - 0x0000000000533e70 beta_slide_ - 0x0000000000534720 test_local_ - 0x0000000000534fe0 test_sc_ - 0x00000000005356c0 test11_ - 0x000000000053b090 bgrow_ - 0x000000000053b250 contact_cp_min_ - 0x000000000053ce80 test3_ - 0x000000000053e5a0 test___ - 0x00000000005407c0 secondary_ - 0x0000000000543150 contact_cp_ - 0x0000000000545ac0 contact_cp2_ - 0x0000000000546080 softreg_ - 0x0000000000548830 beta_zip_ - .text 0x0000000000548a70 0x1960 banach.o - 0x0000000000548a70 banach_ - 0x00000000005492a0 banaii_ - 0x00000000005495e0 matinvert_ - .text 0x000000000054a3d0 0x1bf0 distfit.o - 0x000000000054a3d0 distfit_ - 0x000000000054b620 heval_ - 0x000000000054ba60 rderiv_ - 0x000000000054be10 rdif_ - 0x000000000054bf00 transfer_ - 0x000000000054bf20 vec_ - .text 0x000000000054bfc0 0x1360 rmsd.o - 0x000000000054bfc0 rms_nac_nnc_ - 0x000000000054c7f0 rmsd_ - 0x000000000054cd80 rmsd_csa_ - .text 0x000000000054d320 0x57e0 elecont.o - 0x000000000054d320 elecont_ - 0x000000000054e9a0 secondary2_ - 0x0000000000552a50 freeres_ - .text 0x0000000000552b00 0x19f0 dihed_cons.o - 0x0000000000552b00 secstrp2dihc_ - 0x0000000000553ab0 read_secstr_pred_ - .text 0x00000000005544f0 0x34e0 sc_move.o - 0x00000000005544f0 sc_move_ - 0x0000000000554ff0 egb1_ - 0x00000000005556b0 single_sc_move_ - 0x0000000000555ea0 minimize_sc1_ - 0x0000000000556200 sc_minimize_ - 0x0000000000556550 grad_restr1_ - 0x0000000000557210 func_restr1_ - .text 0x00000000005579d0 0x5100 local_move.o - 0x00000000005579d0 local_move_ - 0x0000000000557ca0 move_res_ - 0x0000000000559740 construct_tab_ - 0x0000000000559d70 output_tabs_ - 0x000000000055a330 angles2tab_ - 0x000000000055a470 minmax_angles_ - 0x000000000055a8e0 construct_ranges_ - 0x000000000055aa80 fix_no_moves_ - 0x000000000055ac80 loc_test_ - 0x000000000055c9d0 local_move_init_ - .text 0x000000000055cad0 0x52f0 intcartderiv.o - 0x000000000055cad0 intcartderiv_ - 0x000000000055e8a0 checkintcartgrad_ - 0x0000000000561b30 chainbuild_cart_ - .text 0x0000000000561dc0 0x37d0 /tmp/ipo_ifortx3jrsv.o - 0x0000000000561dc0 fricmat_mult_ - 0x0000000000562270 ginv_mult_ - 0x0000000000562740 setup_md_matrices_ - 0x0000000000564cc0 lagrangian_ - .text 0x0000000000565590 0x5080 stochfric.o - 0x0000000000565590 friction_force_ - 0x00000000005656e0 stochastic_force_ - 0x0000000000565c40 setup_fricmat_ - 0x0000000000569ce0 sdarea_ - .text 0x000000000056a610 0x400 kinetic_lesyng.o - 0x000000000056a610 kinetic_ - .text 0x000000000056aa10 0x1def0 MD_A-MTS.o - 0x000000000056aa10 md_ - 0x000000000056c220 respa_step_ - 0x00000000005703d0 sd_verlet1_ - 0x0000000000570a60 sd_verlet1_ciccotti_ - 0x00000000005710f0 velverlet_step_ - 0x00000000005750c0 sd_verlet_p_setup_ - 0x000000000057ab90 sd_verlet_ciccotti_setup_ - 0x000000000057f410 random_vel_ - 0x000000000057f810 verlet_bath_ - 0x000000000057f990 verlet2_ - 0x000000000057fb10 sddir_verlet2_ - 0x000000000057fe60 sd_verlet2_ciccotti_ - 0x0000000000580300 sd_verlet2_ - 0x0000000000580890 predict_edrift_ - 0x0000000000580ac0 max_accel_ - 0x0000000000580ed0 verlet1_ - 0x0000000000581230 sddir_verlet1_ - 0x00000000005816c0 sddir_precalc_ - 0x0000000000581760 respa_vel_ - 0x00000000005818e0 eigtransf_ - 0x00000000005832d0 eigtransf1_ - 0x0000000000584eb0 init_md_ - .text 0x0000000000588900 0x1a10 moments.o - 0x0000000000588900 inertia_tensor_ - 0x0000000000589b50 angmom_ - 0x000000000058a0d0 vcm_vel_ - .text 0x000000000058a310 0x1330 int_to_cart.o - 0x000000000058a310 int_to_cart_ - .text 0x000000000058b640 0x1790 surfatom.o - 0x000000000058b640 surfatom_ - .text 0x000000000058cdd0 0x1040 sort.o - 0x000000000058cdd0 sort_ - 0x000000000058ce70 sort2_ - 0x000000000058d030 sort3_ - 0x000000000058d200 sort4_ - 0x000000000058d310 sort5_ - 0x000000000058d440 sort6_ - 0x000000000058d6b0 sort7_ - 0x000000000058da20 sort8_ - 0x000000000058db20 sort9_ - .text 0x000000000058de10 0x5ce0 muca_md.o - 0x000000000058de10 muca_delta_ - 0x000000000058f760 muca_ene_ - 0x000000000058fcd0 read_muca_ - 0x0000000000590840 print_muca_ - 0x0000000000592770 splint_ - 0x0000000000592940 spline_ - 0x0000000000592bb0 muca_factor_ - 0x0000000000592fa0 muca_update_ - .text 0x0000000000593af0 0xd110 MREMD.o - 0x0000000000593af0 mremd_ - 0x000000000059cf90 write1traj_ - 0x000000000059e770 write1rst_ - 0x000000000059efa0 read1restart_ - 0x00000000005a0300 read1restart_old_ - .text 0x00000000005a0c00 0x150 rattle.o - 0x00000000005a0c00 rattle1_ - 0x00000000005a0c70 rattle2_ - 0x00000000005a0ce0 rattle_brown_ - .text 0x00000000005a0d50 0xde0 gauss.o - 0x00000000005a0d50 gauss_ - .text 0x00000000005a1b30 0xd70 energy_split-sep.o - 0x00000000005a1b30 etotal_long_ - 0x00000000005a2250 etotal_short_ - .text 0x00000000005a28a0 0x21d0 q_measure.o - 0x00000000005a28a0 qwol_num_ - 0x00000000005a2ad0 econstrq_ - 0x00000000005a3070 qwolynes_prim_ - 0x00000000005a3bf0 deconstrq_num_ - 0x00000000005a4550 qwolynes_ - .text 0x00000000005a4a70 0xf0 gnmr1.o - 0x00000000005a4a70 gnmr1_ - 0x00000000005a4ad0 gnmr1prim_ - 0x00000000005a4b20 harmonic_ - 0x00000000005a4b40 harmonicprim_ - .text 0x00000000005a4b60 0x236 proc_proc.o - 0x00000000005a4b60 proc_proc_ - 0x00000000005a4be1 proc_conv_ - 0x00000000005a4c1a proc_conv_r_ - 0x00000000005a4c2c dsvrgp_ - *fill* 0x00000000005a4d96 0xa 90909090 - .text 0x00000000005a4da0 0x700 cinfo.o - 0x00000000005a4da0 cinfo_ - .text 0x00000000005a54a0 0x2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - 0x00000000005a54a0 mpi_abort_ - 0x00000000005a54a0 pmpi_abort_ - *fill* 0x00000000005a54cf 0x1 90909090 - .text 0x00000000005a54d0 0x67 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x00000000005a54d0 mpi_allgather_ - 0x00000000005a54d0 pmpi_allgather_ - *fill* 0x00000000005a5537 0x1 90909090 - .text 0x00000000005a5538 0x25 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x00000000005a5538 mpi_barrier_ - 0x00000000005a5538 pmpi_barrier_ - *fill* 0x00000000005a555d 0x3 90909090 - .text 0x00000000005a5560 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x00000000005a5560 pmpi_bcast_ - 0x00000000005a5560 mpi_bcast_ - *fill* 0x00000000005a55b2 0x2 90909090 - .text 0x00000000005a55b4 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x00000000005a55b4 mpi_comm_create_ - 0x00000000005a55b4 pmpi_comm_create_ - *fill* 0x00000000005a55fe 0x2 90909090 - .text 0x00000000005a5600 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x00000000005a5600 pmpi_comm_group_ - 0x00000000005a5600 mpi_comm_group_ - .text 0x00000000005a5640 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x00000000005a5640 mpi_comm_rank_ - 0x00000000005a5640 pmpi_comm_rank_ - *fill* 0x00000000005a5676 0x2 90909090 - .text 0x00000000005a5678 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x00000000005a5678 pmpi_comm_size_ - 0x00000000005a5678 mpi_comm_size_ - *fill* 0x00000000005a56ae 0x2 90909090 - .text 0x00000000005a56b0 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x00000000005a56b0 mpi_comm_split_ - 0x00000000005a56b0 pmpi_comm_split_ - .text 0x00000000005a5704 0x7f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x00000000005a5704 mpi_dup_fn_ - 0x00000000005a5704 pmpi_dup_fn_ - *fill* 0x00000000005a5783 0x1 90909090 - .text 0x00000000005a5784 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x00000000005a5784 mpi_finalize_ - 0x00000000005a5784 pmpi_finalize_ - *fill* 0x00000000005a579f 0x1 90909090 - .text 0x00000000005a57a0 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x00000000005a57a0 pmpi_gather_ - 0x00000000005a57a0 mpi_gather_ - *fill* 0x00000000005a5811 0x3 90909090 - .text 0x00000000005a5814 0x4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x00000000005a5814 mpi_get_count_ - 0x00000000005a5814 pmpi_get_count_ - *fill* 0x00000000005a585f 0x1 90909090 - .text 0x00000000005a5860 0xf4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x00000000005a5860 pmpi_get_processor_name_ - 0x00000000005a5860 mpi_get_processor_name_ - .text 0x00000000005a5954 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x00000000005a5954 mpi_group_free_ - 0x00000000005a5954 pmpi_group_free_ - *fill* 0x00000000005a5993 0x1 90909090 - .text 0x00000000005a5994 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x00000000005a5994 pmpi_group_incl_ - 0x00000000005a5994 mpi_group_incl_ - *fill* 0x00000000005a59e6 0x2 90909090 - .text 0x00000000005a59e8 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x00000000005a59e8 mpi_group_rank_ - 0x00000000005a59e8 pmpi_group_rank_ - *fill* 0x00000000005a5a1e 0x2 90909090 - .text 0x00000000005a5a20 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x00000000005a5a20 mpi_group_translate_ranks_ - 0x00000000005a5a20 pmpi_group_translate_ranks_ - .text 0x00000000005a5a6c 0x22f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x00000000005a5a6c pmpi_init_ - 0x00000000005a5a6c mpi_init_ - *fill* 0x00000000005a5c9b 0x1 90909090 - .text 0x00000000005a5c9c 0x87 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x00000000005a5c9c mpi_iprobe_ - 0x00000000005a5c9c pmpi_iprobe_ - *fill* 0x00000000005a5d23 0x1 90909090 - .text 0x00000000005a5d24 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x00000000005a5d24 mpi_irecv_ - 0x00000000005a5d24 pmpi_irecv_ - .text 0x00000000005a5da0 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x00000000005a5da0 pmpi_isend_ - 0x00000000005a5da0 mpi_isend_ - .text 0x00000000005a5e1c 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x00000000005a5e1c mpi_issend_ - 0x00000000005a5e1c pmpi_issend_ - .text 0x00000000005a5e98 0x33 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x00000000005a5e98 mpi_null_copy_fn_ - 0x00000000005a5e98 pmpi_null_copy_fn_ - *fill* 0x00000000005a5ecb 0x1 90909090 - .text 0x00000000005a5ecc 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x00000000005a5ecc mpi_null_delete_fn_ - 0x00000000005a5ecc pmpi_null_delete_fn_ - .text 0x00000000005a5ef0 0x58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x00000000005a5ef0 mpi_probe_ - 0x00000000005a5ef0 pmpi_probe_ - .text 0x00000000005a5f48 0x78 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x00000000005a5f48 pmpi_recv_ - 0x00000000005a5f48 mpi_recv_ - .text 0x00000000005a5fc0 0x6a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x00000000005a5fc0 mpi_reduce_ - 0x00000000005a5fc0 pmpi_reduce_ - *fill* 0x00000000005a602a 0x2 90909090 - .text 0x00000000005a602c 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x00000000005a602c mpi_scatter_ - 0x00000000005a602c pmpi_scatter_ - *fill* 0x00000000005a609d 0x3 90909090 - .text 0x00000000005a60a0 0x7d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x00000000005a60a0 mpi_scatterv_ - 0x00000000005a60a0 pmpi_scatterv_ - *fill* 0x00000000005a611d 0x3 90909090 - .text 0x00000000005a6120 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x00000000005a6120 pmpi_send_ - 0x00000000005a6120 mpi_send_ - .text 0x00000000005a6180 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x00000000005a6180 PMPI_Status_f2c - 0x00000000005a6180 MPI_Status_f2c - .text 0x00000000005a6220 0x95 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x00000000005a6220 pmpi_test_ - 0x00000000005a6220 mpi_test_ - *fill* 0x00000000005a62b5 0x3 90909090 - .text 0x00000000005a62b8 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x00000000005a62b8 mpi_type_commit_ - 0x00000000005a62b8 pmpi_type_commit_ - *fill* 0x00000000005a62f7 0x1 90909090 - .text 0x00000000005a62f8 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x00000000005a62f8 pmpi_type_contiguous_ - 0x00000000005a62f8 mpi_type_contiguous_ - *fill* 0x00000000005a6342 0x2 90909090 - .text 0x00000000005a6344 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x00000000005a6344 mpi_type_indexed_ - 0x00000000005a6344 pmpi_type_indexed_ - *fill* 0x00000000005a653f 0x1 90909090 - .text 0x00000000005a6540 0x261 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x00000000005a6540 mpi_waitall_ - 0x00000000005a6540 pmpi_waitall_ - *fill* 0x00000000005a67a1 0x3 90909090 - .text 0x00000000005a67a4 0x21 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x00000000005a67a4 mpi_wtime_ - 0x00000000005a67a4 pmpi_wtime_ - *fill* 0x00000000005a67c5 0x3 90909090 - .text 0x00000000005a67c8 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x00000000005a67c8 mpir_getarg_ - 0x00000000005a67d2 mpir_iargc_ - .text 0x00000000005a67dc 0x589 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x00000000005a67dc MPIR_InitFortran - 0x00000000005a6984 MPIR_Free_Fortran_keyvals - 0x00000000005a69ce mpir_init_bottom_ - 0x00000000005a6a01 MPIR_InitFortranDatatypes - 0x00000000005a6cdb MPIR_Free_Fortran_dtes - 0x00000000005a6d4f mpir_init_fsize_ - *fill* 0x00000000005a6d65 0x3 90909090 - .text 0x00000000005a6d68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x00000000005a6d68 mpir_init_fcm_ - 0x00000000005a6d78 mpir_init_flog_ - .text 0x00000000005a6d88 0xbd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x00000000005a6d88 MPID_Node_name - *fill* 0x00000000005a6e45 0x3 90909090 - .text 0x00000000005a6e48 0x39f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x00000000005a6e48 MPI_Isend - 0x00000000005a6e48 PMPI_Isend - *fill* 0x00000000005a71e7 0x1 90909090 - .text 0x00000000005a71e8 0x399 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x00000000005a71e8 MPI_Irecv - 0x00000000005a71e8 PMPI_Irecv - *fill* 0x00000000005a7581 0x3 90909090 - .text 0x00000000005a7584 0xcb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x00000000005a7584 MPI_Test - 0x00000000005a7584 PMPI_Test - *fill* 0x00000000005a764f 0x1 90909090 - .text 0x00000000005a7650 0x881 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0x00000000005a7650 MPIR_Errors_are_fatal - 0x00000000005a790a MPIR_Errors_return - 0x00000000005a7996 MPIR_Errors_warn - 0x00000000005a7c28 MPIR_Error - 0x00000000005a7d80 MPIR_Set_Status_error_array - *fill* 0x00000000005a7ed1 0x3 90909090 - .text 0x00000000005a7ed4 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x00000000005a7ed4 PMPI_Probe - 0x00000000005a7ed4 MPI_Probe - *fill* 0x00000000005a80cf 0x1 90909090 - .text 0x00000000005a80d0 0x686 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x00000000005a80d0 MPI_Waitall - 0x00000000005a80d0 PMPI_Waitall - *fill* 0x00000000005a8756 0x2 90909090 - .text 0x00000000005a8758 0x2f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x00000000005a8758 MPI_Send - 0x00000000005a8758 PMPI_Send - .text 0x00000000005a8a50 0x2ff /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x00000000005a8a50 PMPI_Recv - 0x00000000005a8a50 MPI_Recv - *fill* 0x00000000005a8d4f 0x1 90909090 - .text 0x00000000005a8d50 0x20b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x00000000005a8d50 MPI_Iprobe - 0x00000000005a8d50 PMPI_Iprobe - *fill* 0x00000000005a8f5b 0x1 90909090 - .text 0x00000000005a8f5c 0x68a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x00000000005a8f5c PMPI_Testall - 0x00000000005a8f5c MPI_Testall - *fill* 0x00000000005a95e6 0x2 90909090 - .text 0x00000000005a95e8 0x16f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x00000000005a95e8 PMPI_Get_count - 0x00000000005a95e8 MPI_Get_count - *fill* 0x00000000005a9757 0x1 90909090 - .text 0x00000000005a9758 0x39c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x00000000005a9758 MPI_Issend - 0x00000000005a9758 PMPI_Issend - .text 0x00000000005a9af4 0x2ab /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x00000000005a9af4 MPI_Type_commit - 0x00000000005a9af4 PMPI_Type_commit - *fill* 0x00000000005a9d9f 0x1 90909090 - .text 0x00000000005a9da0 0x53a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x00000000005a9da0 PMPI_Type_contiguous - 0x00000000005a9da0 MPI_Type_contiguous - *fill* 0x00000000005aa2da 0x2 90909090 - .text 0x00000000005aa2dc 0x30d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x00000000005aa2dc PMPI_Type_indexed - 0x00000000005aa2dc MPI_Type_indexed - *fill* 0x00000000005aa5e9 0x3 90909090 - .text 0x00000000005aa5ec 0x3c4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0x00000000005aa5ec MPIR_Type_dup - 0x00000000005aa60b MPIR_Type_permanent - 0x00000000005aa62c MPIR_Type_free - 0x00000000005aa89b MPIR_Type_get_limits - 0x00000000005aa8cb MPIR_Free_perm_type - 0x00000000005aa90c MPIR_Free_struct_internals - 0x00000000005aa986 MPIR_Datatype_iscontig - .text 0x00000000005aa9b0 0xce /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x00000000005aa9b0 PMPI_Abort - 0x00000000005aa9b0 MPI_Abort - *fill* 0x00000000005aaa7e 0x2 90909090 - .text 0x00000000005aaa80 0x1f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x00000000005aaa80 MPI_Init - 0x00000000005aaa80 PMPI_Init - *fill* 0x00000000005aaa9f 0x1 90909090 - .text 0x00000000005aaaa0 0xff8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000005aaaa0 MPIR_Init - 0x00000000005ab9bc MPIR_Errhandler_create - 0x00000000005aba4b MPIR_Errhandler_mark - .text 0x00000000005aba98 0x26f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x00000000005aba98 PMPI_Finalize - 0x00000000005aba98 MPI_Finalize - *fill* 0x00000000005abd07 0x1 90909090 - .text 0x00000000005abd08 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x00000000005abd08 PMPI_Error_string - 0x00000000005abd08 MPI_Error_string - *fill* 0x00000000005abd81 0x3 90909090 - .text 0x00000000005abd84 0x62d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x00000000005abd84 MPIR_Init_dtes - 0x00000000005ac120 MPIR_Free_dtes - 0x00000000005ac202 MPIR_Setup_base_datatype - 0x00000000005ac2fe MPIR_Setup_complex_datatype - 0x00000000005ac37c MPIR_Type_contiguous - *fill* 0x00000000005ac3b1 0x3 90909090 - .text 0x00000000005ac3b4 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x00000000005ac3b4 PMPI_Errhandler_free - 0x00000000005ac3b4 MPI_Errhandler_free - .text 0x00000000005ac4d4 0x29 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x00000000005ac4d4 PMPI_Wtime - 0x00000000005ac4d4 MPI_Wtime - *fill* 0x00000000005ac4fd 0x3 90909090 - .text 0x00000000005ac500 0xa44 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0x00000000005ac5a0 MPIR_Err_setmsg - 0x00000000005ac89e MPIR_Err_map_code_to_string - 0x00000000005ac9b1 MPIR_GetErrorMessage - 0x00000000005aca9e MPIR_Get_error_string - 0x00000000005acc09 MPIR_GetNLSMsg - .text 0x00000000005acf44 0x6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x00000000005acf44 MPIR_Msg_queue_export - *fill* 0x00000000005acf4a 0x2 90909090 - .text 0x00000000005acf4c 0xe55 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x00000000005acf4c MPIR_HBT_Init - 0x00000000005acf88 MPIR_HBT_Free - 0x00000000005acfac MPIR_HBT_new_tree - 0x00000000005ad01a MPIR_HBT_new_node - 0x00000000005ad0b7 MPIR_HBT_free_node - 0x00000000005ad0e4 MPIR_HBT_free_subtree - 0x00000000005ad121 MPIR_HBT_free_tree - 0x00000000005ad168 MPIR_HBT_lookup - 0x00000000005ad1f2 MPIR_HBT_insert - 0x00000000005ad65b MPIR_HBT_delete - *fill* 0x00000000005adda1 0x3 90909090 - .text 0x00000000005adda4 0xd53 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x00000000005adda4 MPIR_PointerPerm - 0x00000000005addb6 MPIR_PointerOpts - 0x00000000005adeb2 MPIR_DestroyPointer - 0x00000000005adf07 MPIR_ToPointer - 0x00000000005ae09a MPIR_FromPointer - 0x00000000005ae378 MPIR_RmPointer - 0x00000000005ae562 MPIR_UsePointer - 0x00000000005ae659 MPIR_RegPointerIdx - 0x00000000005ae882 MPIR_DumpPointers - *fill* 0x00000000005aeaf7 0x1 90909090 - .text 0x00000000005aeaf8 0xa5b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0x00000000005aeaf8 MPIR_BsendInitBuffer - 0x00000000005aebd4 MPIR_BsendRelease - 0x00000000005af3eb MPIR_IbsendDatatype - *fill* 0x00000000005af553 0x1 90909090 - .text 0x00000000005af554 0x1d0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x00000000005af554 PMPI_Keyval_free - 0x00000000005af554 MPI_Keyval_free - .text 0x00000000005af724 0x142 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x00000000005af724 PMPI_Attr_get - 0x00000000005af724 MPI_Attr_get - *fill* 0x00000000005af866 0x2 90909090 - .text 0x00000000005af868 0x784 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x00000000005af868 MPIR_Attr_copy_node - 0x00000000005afa7c MPIR_Attr_copy_subtree - 0x00000000005afb17 MPIR_Attr_copy - 0x00000000005afb80 MPIR_Attr_free_node - 0x00000000005afd21 MPIR_Attr_free_subtree - 0x00000000005afda0 MPIR_Attr_free_tree - 0x00000000005afe44 MPIR_Attr_dup_tree - 0x00000000005afe85 MPIR_Attr_create_tree - 0x00000000005afeb4 MPIR_Keyval_create - 0x00000000005affc8 MPIR_Attr_make_perm - .text 0x00000000005affec 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x00000000005affec PMPI_Attr_put - 0x00000000005affec MPI_Attr_put - *fill* 0x00000000005b02ad 0x3 90909090 - .text 0x00000000005b02b0 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x00000000005b02b0 PMPI_Group_free - 0x00000000005b02b0 MPI_Group_free - *fill* 0x00000000005b0445 0x3 90909090 - .text 0x00000000005b0448 0x452 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x00000000005b0448 MPI_Group_incl - 0x00000000005b0448 PMPI_Group_incl - *fill* 0x00000000005b089a 0x2 90909090 - .text 0x00000000005b089c 0xc4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x00000000005b089c MPI_Group_rank - 0x00000000005b089c PMPI_Group_rank - .text 0x00000000005b0960 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x00000000005b0960 MPIR_CreateGroup - 0x00000000005b0a72 MPIR_FreeGroup - 0x00000000005b0adb MPIR_SetToIdentity - 0x00000000005b0b41 MPIR_Dump_group - 0x00000000005b0c0b MPIR_Dump_ranks - 0x00000000005b0c73 MPIR_Dump_ranges - 0x00000000005b0d2a MPIR_Powers_of_2 - 0x00000000005b0dd1 MPIR_Group_N2_prev - *fill* 0x00000000005b0df1 0x3 90909090 - .text 0x00000000005b0df4 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x00000000005b0df4 MPI_Comm_free - 0x00000000005b0df4 PMPI_Comm_free - *fill* 0x00000000005b10b5 0x3 90909090 - .text 0x00000000005b10b8 0xf5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x00000000005b10b8 PMPI_Comm_group - 0x00000000005b10b8 MPI_Comm_group - *fill* 0x00000000005b11ad 0x3 90909090 - .text 0x00000000005b11b0 0x2f9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x00000000005b11b0 MPI_Comm_create - 0x00000000005b11b0 PMPI_Comm_create - *fill* 0x00000000005b14a9 0x3 90909090 - .text 0x00000000005b14ac 0xc5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x00000000005b14ac MPI_Comm_rank - 0x00000000005b14ac PMPI_Comm_rank - *fill* 0x00000000005b1571 0x3 90909090 - .text 0x00000000005b1574 0x20c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x00000000005b1574 PMPI_Comm_set_name - 0x00000000005b1574 MPI_Comm_set_name - .text 0x00000000005b1780 0x107 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x00000000005b1780 MPI_Comm_size - 0x00000000005b1780 PMPI_Comm_size - *fill* 0x00000000005b1887 0x1 90909090 - .text 0x00000000005b1888 0x75b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x00000000005b1888 MPIR_Comm_make_coll - 0x00000000005b1abb MPIR_Comm_N2_prev - 0x00000000005b1adf MPIR_Dump_comm - 0x00000000005b1bf2 MPIR_Intercomm_high - 0x00000000005b1d13 MPIR_Comm_init - 0x00000000005b1dc8 MPIR_Comm_remember - 0x00000000005b1dfe MPIR_Comm_forget - 0x00000000005b1e5d MPIR_Comm_collops_init - 0x00000000005b1ea5 MPIR_Sort_split_table - *fill* 0x00000000005b1fe3 0x1 90909090 - .text 0x00000000005b1fe4 0x5ad /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x00000000005b1fe4 MPI_Comm_split - 0x00000000005b1fe4 PMPI_Comm_split - *fill* 0x00000000005b2591 0x3 90909090 - .text 0x00000000005b2594 0x159 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x00000000005b2594 MPIR_Context_alloc - 0x00000000005b26d8 MPIR_Context_dealloc - *fill* 0x00000000005b26ed 0x3 90909090 - .text 0x00000000005b26f0 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x00000000005b26f0 MPI_Group_translate_ranks - 0x00000000005b26f0 PMPI_Group_translate_ranks - *fill* 0x00000000005b2979 0x3 90909090 - .text 0x00000000005b297c 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x00000000005b297c MPIR_dup_fn - *fill* 0x00000000005b29b2 0x2 90909090 - .text 0x00000000005b29b4 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x00000000005b29b4 MPI_Barrier - 0x00000000005b29b4 PMPI_Barrier - *fill* 0x00000000005b2acd 0x3 90909090 - .text 0x00000000005b2ad0 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x00000000005b2ad0 MPI_Bcast - 0x00000000005b2ad0 PMPI_Bcast - *fill* 0x00000000005b2d59 0x3 90909090 - .text 0x00000000005b2d5c 0x309 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x00000000005b2d5c MPI_Gather - 0x00000000005b2d5c PMPI_Gather - *fill* 0x00000000005b3065 0x3 90909090 - .text 0x00000000005b3068 0x2bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x00000000005b3068 PMPI_Scatter - 0x00000000005b3068 MPI_Scatter - .text 0x00000000005b3324 0x362 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x00000000005b3324 PMPI_Scatterv - 0x00000000005b3324 MPI_Scatterv - *fill* 0x00000000005b3686 0x2 90909090 - .text 0x00000000005b3688 0x335 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x00000000005b3688 PMPI_Allgather - 0x00000000005b3688 MPI_Allgather - *fill* 0x00000000005b39bd 0x3 90909090 - .text 0x00000000005b39c0 0x296 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x00000000005b39c0 PMPI_Reduce - 0x00000000005b39c0 MPI_Reduce - *fill* 0x00000000005b3c56 0x2 90909090 - .text 0x00000000005b3c58 0x287 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x00000000005b3c58 MPI_Allreduce - 0x00000000005b3c58 PMPI_Allreduce - *fill* 0x00000000005b3edf 0x1 90909090 - .text 0x00000000005b3ee0 0x8081 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x00000000005b3ee0 MPIR_MAXF - 0x00000000005b466b MPIR_MINF - 0x00000000005b4df6 MPIR_SUM - 0x00000000005b5632 MPIR_PROD - 0x00000000005b5f3e MPIR_LAND - 0x00000000005b6976 MPIR_BAND - 0x00000000005b6f4f MPIR_LOR - 0x00000000005b794f MPIR_BOR - 0x00000000005b7f28 MPIR_LXOR - 0x00000000005b8c46 MPIR_BXOR - 0x00000000005b921f MPIR_MAXLOC - 0x00000000005ba8be MPIR_MINLOC - *fill* 0x00000000005bbf61 0x3 90909090 - .text 0x00000000005bbf64 0x136 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x00000000005bbf64 PMPI_Op_free - 0x00000000005bbf64 MPI_Op_free - *fill* 0x00000000005bc09a 0x2 90909090 - .text 0x00000000005bc09c 0x99 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x00000000005bc09c MPIR_Op_setup - *fill* 0x00000000005bc135 0x3 90909090 - .text 0x00000000005bc138 0x39d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - *fill* 0x00000000005bc4d5 0x3 90909090 - .text 0x00000000005bc4d8 0xa1bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .text 0x00000000005c6694 0x53b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x00000000005c6694 MPIR_intra_Scan - *fill* 0x00000000005c6bcf 0x1 90909090 - .text 0x00000000005c6bd0 0x426 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x00000000005c6bd0 MPIR_Topology_Init - 0x00000000005c6bf1 MPIR_Topology_Free - 0x00000000005c6c06 MPIR_Topology_copy_fn - 0x00000000005c6f2f MPIR_Topology_delete_fn - 0x00000000005c6fc7 MPIR_Topology_init - 0x00000000005c6fe6 MPIR_Topology_finalize - *fill* 0x00000000005c6ff6 0x2 90909090 - .text 0x00000000005c6ff8 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x00000000005c6ff8 PMPI_Request_c2f - 0x00000000005c6ff8 MPI_Request_c2f - .text 0x00000000005c704c 0x8c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x00000000005c704c PMPI_Status_c2f - 0x00000000005c704c MPI_Status_c2f - .text 0x00000000005c70d8 0x19f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x00000000005c70d8 MPIR_fstr2cstr - 0x00000000005c71d1 MPIR_cstr2fstr - *fill* 0x00000000005c7277 0x1 90909090 - .text 0x00000000005c7278 0x1bbb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x00000000005c7278 p4_post_init - 0x00000000005c727e p4_version - 0x00000000005c729a p4_machine_type - 0x00000000005c72b8 p4_initenv - 0x00000000005c74cb p4_shmalloc - 0x00000000005c7507 p4_shfree - 0x00000000005c751e p4_num_cluster_ids - 0x00000000005c7534 p4_num_total_ids - 0x00000000005c7547 p4_num_total_slaves - 0x00000000005c755d p4_global_barrier - 0x00000000005c7593 p4_get_cluster_masters - 0x00000000005c7611 p4_get_cluster_ids - 0x00000000005c7645 p4_get_my_id_from_proc - 0x00000000005c7b8e p4_get_my_id - 0x00000000005c7b9e p4_get_my_cluster_id - 0x00000000005c7be0 p4_am_i_cluster_master - 0x00000000005c7c2a in_same_cluster - 0x00000000005c7c76 p4_cluster_shmem_sync - 0x00000000005c7cdc get_pipe - 0x00000000005c7d2b setup_conntab - 0x00000000005c7f6a p4_accept_wait_timeout - 0x00000000005c7f93 p4_wait_for_end - 0x00000000005c8534 fork_p4 - 0x00000000005c85ed zap_p4_processes - 0x00000000005c867c zap_remote_p4_processes - 0x00000000005c8973 get_qualified_hostname - 0x00000000005c8a2c same_data_representation - 0x00000000005c8aa8 p4_proc_info - 0x00000000005c8b45 put_execer_port - 0x00000000005c8c1b p4_clean_execer_port - 0x00000000005c8c21 init_usclock - 0x00000000005c8c57 p4_usclock - *fill* 0x00000000005c8e33 0x1 90909090 - .text 0x00000000005c8e34 0x10e2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0x00000000005c8e34 bm_start - 0x00000000005c8ff7 p4_create_procgroup - 0x00000000005c909d p4_startup - 0x00000000005c92fc create_bm_processes - 0x00000000005c9909 procgroup_to_proctable - 0x00000000005c9bba sync_with_remotes - 0x00000000005c9ce3 send_proc_table - *fill* 0x00000000005c9f16 0x2 90909090 - .text 0x00000000005c9f18 0xf3d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x00000000005c9f18 rm_start - 0x00000000005ca5ec create_rm_processes - 0x00000000005cacb9 receive_proc_table - *fill* 0x00000000005cae55 0x3 90909090 - .text 0x00000000005cae58 0x1ed3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x00000000005caee4 p4_socket_control - 0x00000000005cb347 net_set_sockbuf_size - 0x00000000005cb49f net_setup_listener - 0x00000000005cb5f2 net_setup_anon_listener - 0x00000000005cb774 net_accept - 0x00000000005cbab8 net_conn_to_listener - 0x00000000005cbd2a net_recv - 0x00000000005cc046 net_send - 0x00000000005cc1d4 net_send_w - 0x00000000005cc3ad net_send2 - 0x00000000005cc538 p4_socket_stat - 0x00000000005cc5f8 p4_timein_hostbyname - 0x00000000005cc621 gethostbyname_p4 - 0x00000000005cc776 gethostname_p4 - 0x00000000005cc795 get_inet_addr - 0x00000000005cc7e0 get_inet_addr_str - 0x00000000005cc80b p4_print_sock_params - 0x00000000005cca28 dump_sockaddr - 0x00000000005ccada dump_sockinfo - 0x00000000005ccb50 mpiexec_reopen_stdin - 0x00000000005ccce2 p4_make_socket_nonblocking - *fill* 0x00000000005ccd2b 0x1 90909090 - .text 0x00000000005ccd2c 0x154d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0x00000000005ccd2c create_remote_processes - 0x00000000005ccf1d net_slave_info - 0x00000000005cd3c4 p4_accept_timeout - 0x00000000005cd44f p4_accept_sigchild - 0x00000000005cd4e0 net_create_slave - *fill* 0x00000000005ce279 0x3 90909090 - .text 0x00000000005ce27c 0xa5a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0x00000000005ce27c p4_has_timedout - 0x00000000005ce2dc p4_establish_all_conns - 0x00000000005ce367 establish_connection - 0x00000000005ce447 request_connection - 0x00000000005ce814 handle_connection_interrupt - *fill* 0x00000000005cecd6 0x2 90909090 - .text 0x00000000005cecd8 0x1860 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x00000000005cecd8 xdr_send - 0x00000000005cf052 socket_send - 0x00000000005cf1f9 socket_close_conn - 0x00000000005cf2d4 socket_recv - 0x00000000005cf612 socket_recv_on_fd - 0x00000000005cf856 socket_msgs_available - 0x00000000005cf909 sock_msg_avail_on_fd - 0x00000000005cfa9e xdr_recv - 0x00000000005cfcfe wait_for_ack - 0x00000000005cfd8a send_ack - 0x00000000005cfe1f shutdown_p4_socks - 0x00000000005cfed7 p4_sockets_ready - 0x00000000005d02b9 p4_look_for_close - 0x00000000005d037d p4_wait_for_socket_msg - .text 0x00000000005d0538 0xd41 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x00000000005d0538 listener - 0x00000000005d0fed net_recv_timeout - *fill* 0x00000000005d1279 0x3 90909090 - .text 0x00000000005d127c 0xc02 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x00000000005d127c start_slave - 0x00000000005d1dec getpw_ss - *fill* 0x00000000005d1e7e 0x2 90909090 - .text 0x00000000005d1e80 0xb0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x00000000005d1e80 usc_init - 0x00000000005d1edc usc_MD_clock - .text 0x00000000005d1f30 0x7fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0x00000000005d1f30 MPID_RecvContig - 0x00000000005d1ffd MPID_IrecvContig - 0x00000000005d22d3 MPID_RecvIcomplete - 0x00000000005d24ec MPID_RecvComplete - 0x00000000005d2718 MPID_Status_set_bytes - *fill* 0x00000000005d272e 0x2 90909090 - .text 0x00000000005d2730 0x68d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0x00000000005d2730 MPID_SendContig - 0x00000000005d2870 MPID_IsendContig - 0x00000000005d29cb MPID_BsendContig - 0x00000000005d2ad4 MPID_SendIcomplete - 0x00000000005d2bd6 MPID_SendComplete - *fill* 0x00000000005d2dbd 0x3 90909090 - .text 0x00000000005d2dc0 0xa4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x00000000005d2dc0 MPID_Init - 0x00000000005d30fa MPID_Abort - 0x00000000005d32b1 MPID_End - 0x00000000005d33a7 MPID_DeviceCheck - 0x00000000005d35f4 MPID_Complete_pending - 0x00000000005d376c MPID_SetPktSize - 0x00000000005d377e MPID_WaitForCompleteSend - 0x00000000005d37a8 MPID_WaitForCompleteRecv - 0x00000000005d37d2 MPID_Version_name - *fill* 0x00000000005d380b 0x1 90909090 - .text 0x00000000005d380c 0x47b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x00000000005d380c MPID_Iprobe - 0x00000000005d3a9e MPID_Probe - *fill* 0x00000000005d3c87 0x1 90909090 - .text 0x00000000005d3c88 0x349 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x00000000005d3c88 MPID_SendDatatype - 0x00000000005d3e04 MPID_IsendDatatype - *fill* 0x00000000005d3fd1 0x3 90909090 - .text 0x00000000005d3fd4 0x4df /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x00000000005d3fd4 MPID_RecvDatatype - 0x00000000005d40a3 MPID_IrecvDatatype - *fill* 0x00000000005d44b3 0x1 90909090 - .text 0x00000000005d44b4 0x50d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0x00000000005d44b4 MPID_Msg_rep - 0x00000000005d4676 MPID_Msg_act - 0x00000000005d4768 MPID_Pack_size - 0x00000000005d47ea MPID_Pack - 0x00000000005d4907 MPID_Unpack - *fill* 0x00000000005d49c1 0x3 90909090 - .text 0x00000000005d49c4 0x2fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x00000000005d49c4 MPID_PackMessage - 0x00000000005d4ab2 MPID_PackMessageFree - 0x00000000005d4afa MPID_UnpackMessageSetup - 0x00000000005d4b7d MPID_UnpackMessageComplete - *fill* 0x00000000005d4cc2 0x2 90909090 - .text 0x00000000005d4cc4 0x33a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x00000000005d4cc4 MPID_SsendDatatype - 0x00000000005d4e40 MPID_IssendDatatype - *fill* 0x00000000005d4ffe 0x2 90909090 - .text 0x00000000005d5000 0x1360 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x00000000005d5000 MPID_BSwap_N_inplace - 0x00000000005d5113 MPID_BSwap_N_copy - 0x00000000005d5182 MPID_Type_swap_copy - 0x00000000005d5323 MPID_Type_swap_inplace - 0x00000000005d5436 MPID_Mem_convert_len - 0x00000000005d5474 MPID_Mem_XDR_Len - 0x00000000005d5495 MPID_Mem_XDR_Init - 0x00000000005d54c0 MPID_Mem_XDR_Free - 0x00000000005d54f1 MPID_Mem_XDR_Encode - 0x00000000005d55be MPID_Mem_XDR_ByteEncode - 0x00000000005d5669 MPID_Mem_XDR_Encode_Logical - 0x00000000005d5750 MPID_Mem_XDR_Decode - 0x00000000005d585b MPID_Mem_XDR_ByteDecode - 0x00000000005d5922 MPID_Mem_XDR_Decode_Logical - 0x00000000005d5a55 MPID_Type_XDR_encode - 0x00000000005d5d95 MPID_Type_XDR_decode - .text 0x00000000005d6360 0xa13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x00000000005d6360 MPID_Rndv_print_pkt - 0x00000000005d648d MPID_Cancel_print_pkt - 0x00000000005d6532 MPID_Print_packet - 0x00000000005d67ac MPID_Get_print_pkt - 0x00000000005d67ba MPID_Print_mode - 0x00000000005d691f MPID_Print_pkt_data - 0x00000000005d69c7 MPID_Print_Send_Handle - 0x00000000005d6a04 MPID_SetDebugFile - 0x00000000005d6afa MPID_Set_tracefile - 0x00000000005d6bf0 MPID_SetSpaceDebugFlag - 0x00000000005d6bf9 MPID_SetDebugFlag - 0x00000000005d6c14 MPID_SetMsgDebugFlag - 0x00000000005d6c26 MPID_GetMsgDebugFlag - 0x00000000005d6c32 MPID_PrintMsgDebug - 0x00000000005d6c38 MPID_Print_rhandle - 0x00000000005d6c84 MPID_Print_shandle - 0x00000000005d6ce0 MPID_Print_Short_data - *fill* 0x00000000005d6d73 0x1 90909090 - .text 0x00000000005d6d74 0x3e6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x00000000005d6d74 MPID_CH_InitMsgPass - 0x00000000005d6f58 MPID_CH_Abort - 0x00000000005d6fdc MPID_CH_End - 0x00000000005d7121 MPID_CH_Version_name - *fill* 0x00000000005d715a 0x2 90909090 - .text 0x00000000005d715c 0xb2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x00000000005d715c MPID_CH_Init_hetero - 0x00000000005d7927 MPID_CH_Comm_msgrep - 0x00000000005d7a06 MPID_CH_Pkt_pack - 0x00000000005d7ae6 MPID_CH_Pkt_unpack - 0x00000000005d7ba7 MPID_CH_Hetero_free - 0x00000000005d7bca MPID_GetByteOrder - 0x00000000005d7c03 MPID_ByteSwapInt - *fill* 0x00000000005d7c8b 0x1 90909090 - .text 0x00000000005d7c8c 0x4fa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x00000000005d7c8c MPID_P4_Init - 0x00000000005d814b MPID_P4_End - *fill* 0x00000000005d8186 0x2 90909090 - .text 0x00000000005d8188 0x90f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x00000000005d8188 MPID_Dump_queues - 0x00000000005d8198 MPID_Dump_queue - 0x00000000005d8504 MPID_Dequeue - 0x00000000005d869f MPID_Search_unexpected_for_request - 0x00000000005d8783 MPID_Search_unexpected_queue - 0x00000000005d88a6 MPID_Msg_arrived - 0x00000000005d89ef MPID_Search_unexpected_queue_and_post - 0x00000000005d8a4a MPID_InitQueue - *fill* 0x00000000005d8a97 0x1 90909090 - .text 0x00000000005d8a98 0xa18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x00000000005d8a98 MPID_GetIntParameter - 0x00000000005d8ad4 MPID_ArgSqueeze - 0x00000000005d8b81 MPID_ProcessArgs - .text 0x00000000005d94b0 0x4f2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x00000000005d94b0 MPID_SBinit - 0x00000000005d9568 MPID_SBfree - 0x00000000005d95b3 MPID_SBiAllocate - 0x00000000005d96bf MPID_SBalloc - 0x00000000005d9754 MPID_SBPrealloc - 0x00000000005d9791 MPID_SBdestroy - 0x00000000005d97d8 MPID_SBrelease - 0x00000000005d9855 MPID_SBFlush - 0x00000000005d98e6 MPID_SBDump - 0x00000000005d9942 MPID_SBReleaseAvail - *fill* 0x00000000005d99a2 0x2 90909090 - .text 0x00000000005d99a4 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x00000000005d99a4 MPID_Process_group_init - *fill* 0x00000000005d9a1d 0x3 90909090 - .text 0x00000000005d9a20 0x954 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x00000000005d9a20 MPID_PacketFlowSetup - 0x00000000005d9abe MPID_SendProtoAck - 0x00000000005d9cc4 MPID_RecvProtoAck - 0x00000000005da0f4 MPID_FinishRecvPackets - 0x00000000005da356 MPID_PackDelete - .text 0x00000000005da374 0x809 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x00000000005da374 MPID_SendCancelPacket - 0x00000000005da559 MPID_SendCancelOkPacket - 0x00000000005da7fb MPID_RecvCancelOkPacket - 0x00000000005da9e9 MPID_FinishCancelPackets - *fill* 0x00000000005dab7d 0x3 90909090 - .text 0x00000000005dab80 0x92 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x00000000005dab80 MPI_Wait - 0x00000000005dab80 PMPI_Wait - *fill* 0x00000000005dac12 0x2 90909090 - .text 0x00000000005dac14 0x1f5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x00000000005dac14 PMPI_Cancel - 0x00000000005dac14 MPI_Cancel - *fill* 0x00000000005dae09 0x3 90909090 - .text 0x00000000005dae0c 0x232 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x00000000005dae0c PMPI_Sendrecv - 0x00000000005dae0c MPI_Sendrecv - *fill* 0x00000000005db03e 0x2 90909090 - .text 0x00000000005db040 0xd2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x00000000005db040 MPI_Type_extent - 0x00000000005db040 PMPI_Type_extent - *fill* 0x00000000005db112 0x2 90909090 - .text 0x00000000005db114 0x187 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x00000000005db114 MPI_Type_free - 0x00000000005db114 PMPI_Type_free - *fill* 0x00000000005db29b 0x1 90909090 - .text 0x00000000005db29c 0x84c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x00000000005db29c MPI_Type_hindexed - 0x00000000005db29c PMPI_Type_hindexed - .text 0x00000000005dbae8 0x10d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x00000000005dbae8 PMPI_Type_lb - 0x00000000005dbae8 MPI_Type_lb - *fill* 0x00000000005dbbf5 0x3 90909090 - .text 0x00000000005dbbf8 0x10b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x00000000005dbbf8 PMPI_Type_size - 0x00000000005dbbf8 MPI_Type_size - *fill* 0x00000000005dbd03 0x1 90909090 - .text 0x00000000005dbd04 0xbaf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x00000000005dbd04 PMPI_Type_struct - 0x00000000005dbd04 MPI_Type_struct - *fill* 0x00000000005dc8b3 0x1 90909090 - .text 0x00000000005dc8b4 0x229 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x00000000005dc8b4 MPI_Pack_size - 0x00000000005dc8b4 PMPI_Pack_size - *fill* 0x00000000005dcadd 0x3 90909090 - .text 0x00000000005dcae0 0x339 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x00000000005dcae0 PMPI_Pack - 0x00000000005dcae0 MPI_Pack - *fill* 0x00000000005dce19 0x3 90909090 - .text 0x00000000005dce1c 0x30f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x00000000005dce1c PMPI_Unpack - 0x00000000005dce1c MPI_Unpack - *fill* 0x00000000005dd12b 0x1 90909090 - .text 0x00000000005dd12c 0xd1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x00000000005dd12c MPIR_Breakpoint - *fill* 0x00000000005dd1fd 0x3 90909090 - .text 0x00000000005dd200 0x198 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x00000000005dd200 PMPI_Errhandler_set - 0x00000000005dd200 MPI_Errhandler_set - .text 0x00000000005dd398 0xf9f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x00000000005dd398 MPIR_Unpack - 0x00000000005dd46d MPIR_Pack2 - 0x00000000005dd9ae MPIR_Unpack2 - 0x00000000005ddf36 MPIR_Elementcnt - 0x00000000005ddff0 MPIR_Printcontig - 0x00000000005de059 MPIR_Printcontig2 - 0x00000000005de0c5 MPIR_Printcontig2a - 0x00000000005de145 MPIR_PrintDatatypePack - 0x00000000005de229 MPIR_PrintDatatypeUnpack - *fill* 0x00000000005de337 0x1 90909090 - .text 0x00000000005de338 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x00000000005de338 PMPI_Keyval_create - 0x00000000005de338 MPI_Keyval_create - *fill* 0x00000000005de377 0x1 90909090 - .text 0x00000000005de378 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .text 0x00000000005de378 0xc35 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x00000000005de378 MD_initmem - 0x00000000005de381 MD_initenv - 0x00000000005de38c MD_malloc_hint - 0x00000000005de398 MD_shmalloc - 0x00000000005de3b8 MD_shfree - 0x00000000005de3cf MD_set_reference_time - 0x00000000005de3f8 MD_clock - 0x00000000005de472 data_representation - *fill* 0x00000000005defad 0x3 90909090 - .text 0x00000000005defb0 0xb3c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x00000000005defb0 p4_soft_errors - 0x00000000005deff5 p4_error - 0x00000000005df398 trap_sig_errs - 0x00000000005dfada p4_set_hard_errors - .text 0x00000000005dfaec 0xf51 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x00000000005dfaec process_args - *fill* 0x00000000005e0a3d 0x3 90909090 - .text 0x00000000005e0a40 0xb00 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x00000000005e0a40 alloc_local_bm - 0x00000000005e0b69 alloc_local_rm - 0x00000000005e0c84 alloc_local_listener - 0x00000000005e0cfb alloc_local_slave - 0x00000000005e0dfc p4_set_avail_buff - 0x00000000005e0e48 init_avail_buffs - 0x00000000005e0eaa p4_print_avail_buffs - 0x00000000005e0f43 alloc_p4_msg - 0x00000000005e1106 free_p4_msg - 0x00000000005e1285 free_avail_buffs - 0x00000000005e1307 alloc_global - 0x00000000005e1488 alloc_listener_info - .text 0x00000000005e1540 0x7cb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x00000000005e1540 p4_get_dbg_level - 0x00000000005e154c p4_set_dbg_level - 0x00000000005e155e p4_dprintf - 0x00000000005e16ab p4_dprint_last - 0x00000000005e16b5 p4_dprintfl - 0x00000000005e1819 dump_global - 0x00000000005e1948 dump_local - 0x00000000005e1a50 print_conn_type - 0x00000000005e1aed dump_listener - 0x00000000005e1b3f dump_procgroup - 0x00000000005e1be7 dump_tmsg - 0x00000000005e1c3f dump_conntab - *fill* 0x00000000005e1d0b 0x1 90909090 - .text 0x00000000005e1d0c 0x5a7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x00000000005e1d0c p4_alloc_procgroup - 0x00000000005e1d65 read_procgroup - 0x00000000005e2116 install_in_proctable - *fill* 0x00000000005e22b3 0x1 90909090 - .text 0x00000000005e22b4 0xcac /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x00000000005e22b4 search_p4_queue - 0x00000000005e252f p4_recv - 0x00000000005e2782 recv_message - 0x00000000005e27be p4_any_messages_available - 0x00000000005e2877 p4_messages_available - 0x00000000005e29c4 queue_p4_message - 0x00000000005e2a2d send_message - 0x00000000005e2c50 get_tmsg - 0x00000000005e2d11 p4_msg_alloc - 0x00000000005e2d3e p4_msg_free - 0x00000000005e2d6c initialize_msg_queue - 0x00000000005e2da0 alloc_quel - 0x00000000005e2e53 free_quel - 0x00000000005e2ea1 free_avail_quels - 0x00000000005e2efb p4_yield - 0x00000000005e2f06 p4_waitformsg - .text 0x00000000005e2f60 0x512 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x00000000005e2f60 p4_moninit - 0x00000000005e3007 p4_menter - 0x00000000005e3011 p4_mexit - 0x00000000005e301b p4_mdelay - 0x00000000005e3050 p4_mcontinue - 0x00000000005e308f num_in_mon_queue - 0x00000000005e30bb p4_getsub_init - 0x00000000005e30e2 p4_getsubs - 0x00000000005e318b p4_barrier_init - 0x00000000005e31a7 p4_barrier - 0x00000000005e31f7 p4_askfor_init - 0x00000000005e3229 p4_askfor - 0x00000000005e3378 p4_update - 0x00000000005e33be p4_probend - 0x00000000005e33eb p4_progend - 0x00000000005e341b p4_create - *fill* 0x00000000005e3472 0x2 90909090 - .text 0x00000000005e3474 0x124b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x00000000005e3474 p4_broadcastx - 0x00000000005e3522 subtree_broadcast_p4 - 0x00000000005e3991 p4_global_op - 0x00000000005e3c27 p4_dbl_sum_op - 0x00000000005e3c76 p4_dbl_mult_op - 0x00000000005e3cc5 p4_dbl_max_op - 0x00000000005e3d31 p4_dbl_min_op - 0x00000000005e3d9d p4_dbl_absmax_op - 0x00000000005e3f14 p4_dbl_absmin_op - 0x00000000005e408b p4_flt_sum_op - 0x00000000005e40da p4_flt_mult_op - 0x00000000005e4129 p4_flt_max_op - 0x00000000005e4194 p4_flt_min_op - 0x00000000005e41ff p4_flt_absmax_op - 0x00000000005e4365 p4_flt_absmin_op - 0x00000000005e44cb p4_int_sum_op - 0x00000000005e4513 p4_int_mult_op - 0x00000000005e455b p4_int_max_op - 0x00000000005e45a9 p4_int_min_op - 0x00000000005e45f7 p4_int_absmax_op - 0x00000000005e465b p4_int_absmin_op - *fill* 0x00000000005e46bf 0x1 90909090 - .text 0x00000000005e46c0 0x12e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x00000000005e46c0 MPID_SsendContig - 0x00000000005e4752 MPID_IssendContig - *fill* 0x00000000005e47ee 0x2 90909090 - .text 0x00000000005e47f0 0x365 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x00000000005e47f0 MPID_SendCancel - 0x00000000005e4a0f MPID_RecvCancel - *fill* 0x00000000005e4b55 0x3 90909090 - .text 0x00000000005e4b58 0x169b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x00000000005e4b58 MPID_CH_Eagerb_send - 0x00000000005e5066 MPID_CH_Eagerb_recv - 0x00000000005e5342 MPID_CH_Eagerb_unxrecv_start - 0x00000000005e556b MPID_CH_Eagerb_save - 0x00000000005e5897 MPID_CH_Eagerb_isend - 0x00000000005e5de6 MPID_CH_Eagerb_cancel_send - 0x00000000005e5df5 MPID_CH_Eagerb_irecv - 0x00000000005e6109 MPID_CH_Eagerb_delete - 0x00000000005e6120 MPID_CH_Eagerb_setup - *fill* 0x00000000005e61f3 0x1 90909090 - .text 0x00000000005e61f4 0x2169 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x00000000005e61f4 MPID_CH_Rndvb_isend - 0x00000000005e665f MPID_CH_Rndvb_send - 0x00000000005e6781 MPID_CH_Rndvb_irecv - 0x00000000005e6e76 MPID_CH_Rndvb_save - 0x00000000005e7094 MPID_CH_Rndvb_ok_to_send - 0x00000000005e7246 MPID_CH_Rndvb_unxrecv_start - 0x00000000005e751c MPID_CH_Rndvb_unxrecv_end - 0x00000000005e7859 MPID_CH_Rndvb_unxrecv_test_end - 0x00000000005e7ad1 MPID_CH_Rndvb_ack - 0x00000000005e7edf MPID_CH_Rndvb_save_self - 0x00000000005e7fef MPID_CH_Rndvb_unxrecv_start_self - 0x00000000005e8273 MPID_CH_Rndvb_delete - 0x00000000005e828a MPID_CH_Rndvb_setup - *fill* 0x00000000005e835d 0x3 90909090 - .text 0x00000000005e8360 0xbe2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x00000000005e8360 MPID_CH_Check_incoming - *fill* 0x00000000005e8f42 0x2 90909090 - .text 0x00000000005e8f44 0x160b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0x00000000005e8f44 MPID_CH_Eagerb_send_short - 0x00000000005e9601 MPID_CH_Eagerb_isend_short - 0x00000000005e9ce6 MPID_CH_Eagerb_recv_short - 0x00000000005e9f85 MPID_CH_Eagerb_unxrecv_start_short - 0x00000000005ea1ae MPID_CH_Eagerb_save_short - 0x00000000005ea465 MPID_CH_Eagerb_short_delete - 0x00000000005ea47c MPID_CH_Short_setup - *fill* 0x00000000005ea54f 0x1 90909090 - .text 0x00000000005ea550 0x427 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x00000000005ea550 MPID_FlowDebug - 0x00000000005ea562 MPID_SendFlowPacket - 0x00000000005ea6b7 MPID_RecvFlowPacket - 0x00000000005ea724 MPID_FlowSetup - 0x00000000005ea818 MPID_FlowDelete - 0x00000000005ea82a MPID_FlowDump - *fill* 0x00000000005ea977 0x1 90909090 - .text 0x00000000005ea978 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x00000000005ea978 MPIR_Pack_Hvector - 0x00000000005eabbf MPIR_UnPack_Hvector - 0x00000000005eadf1 MPIR_HvectorLen - *fill* 0x00000000005eae09 0x7 90909090 - .text 0x00000000005eae10 0x1ea9 xdrf_em64/libxdrf.a(libxdrf.o) - 0x00000000005eae10 xdrfsetpos_ - 0x00000000005eae2c xdrf_ - 0x00000000005eae46 xdrfvector_ - 0x00000000005eb267 xdrfint_ - 0x00000000005eb286 xdrffloat_ - 0x00000000005eb2a5 xdrfopaque_ - 0x00000000005eb47a xdr3dfcoord - 0x00000000005ec770 xdrf3dfcoord_ - 0x00000000005ec788 xdrclose - 0x00000000005ec82a xdrfclose_ - 0x00000000005ec84c xdropen - 0x00000000005ec982 xdrfopen_ - 0x00000000005eca2c xdrfwrapstring_ - 0x00000000005ecaf2 xdrfstring_ - 0x00000000005ecbc3 xdrfushort_ - 0x00000000005ecbe2 xdrfulong_ - 0x00000000005ecc01 xdrfuchar_ - 0x00000000005ecc1f xdrfshort_ - 0x00000000005ecc3e xdrflong_ - 0x00000000005ecc5d xdrfdouble_ - 0x00000000005ecc7c xdrfchar_ - 0x00000000005ecc9a xdrfbool_ - *fill* 0x00000000005eccb9 0x3 90909090 - .text 0x00000000005eccbc 0x9d xdrf_em64/libxdrf.a(ftocstr.o) - 0x00000000005eccbc ftocstr - 0x00000000005ecd1f ctofstr - *fill* 0x00000000005ecd59 0x7 90909090 - .text 0x00000000005ecd60 0x430 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0x00000000005ecd60 etime_ - 0x00000000005ece30 dtime_ - 0x00000000005ecff0 dtimer8_ - .text 0x00000000005ed190 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x00000000005ed190 fdate_ - .text 0x00000000005ed230 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x00000000005ed230 flush_ - .text 0x00000000005ed240 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x00000000005ed240 getenv_ - .text 0x00000000005ed3c0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x00000000005ed3c0 system_ - .text 0x00000000005ed400 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x00000000005ed400 allocCstr - 0x00000000005ed4b0 deallocCstr - .text 0x00000000005ed4c0 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x00000000005ed4c0 CstrToFstr - .text 0x00000000005ed610 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x00000000005ed610 for_close - 0x00000000005edc80 for__close_args - 0x00000000005eddb0 for__close_default - .text 0x00000000005edf60 0x740 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x00000000005edf60 for__close_proc - .text 0x00000000005ee6a0 0xc90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000005ee6a0 for__desc_ret_item - 0x00000000005ee9d0 for__key_desc_ret_item - 0x00000000005eecf0 for__desc_test_item - 0x00000000005eef70 for__desc_zero_length_item - .text 0x00000000005ef330 0x3550 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x00000000005ef330 for__io_return - 0x00000000005efe70 for__issue_diagnostic - 0x00000000005f0540 for__get_msg - 0x00000000005f0740 for_emit_diagnostic - 0x00000000005f08c0 for__message_catalog_close - 0x00000000005f0c60 for_errmsg - 0x00000000005f0e40 for__rtc_uninit_use - 0x00000000005f0e60 TRACEBACKQQ - 0x00000000005f1080 tracebackqq_ - 0x00000000005f12b0 for_perror_ - 0x00000000005f1f90 for_gerror_ - .text 0x00000000005f2880 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0x00000000005f2880 for_errsns_load - 0x00000000005f28c0 for_errsns_w - 0x00000000005f29b0 for_errsns - .text 0x00000000005f2aa0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x00000000005f2aa0 for__fpe_exit_handler - 0x00000000005f2b80 for__exit_handler - .text 0x00000000005f2d80 0x610 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x00000000005f2d80 for_nargs - 0x00000000005f2d90 for_iargc - 0x00000000005f2db0 for_getarg - 0x00000000005f2ef0 for_getarg_i2 - 0x00000000005f3030 nargs_ - 0x00000000005f3040 iargc_ - 0x00000000005f3060 iarg_ - 0x00000000005f3080 numarg_ - 0x00000000005f30a0 getarg_ - 0x00000000005f31a0 for_getcmd_arg - .text 0x00000000005f3390 0x2310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x00000000005f3390 for_setup_mxcsr - 0x00000000005f3450 for__signal_handler - 0x00000000005f4240 for_enable_underflow - 0x00000000005f4260 for_get_fpe_ - 0x00000000005f4270 for_set_fpe_ - 0x00000000005f4520 for_get_fpe_counts_ - 0x00000000005f4570 for_rtl_finish_ - 0x00000000005f4590 dump_dfil_exception_info - 0x00000000005f5470 for_rtl_init_ - .text 0x00000000005f56a0 0x5eb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x00000000005f56a0 for_inquire - .text 0x00000000005fb550 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x00000000005fb550 for__adjust_buffer - 0x00000000005fb7e0 for__lower_bound_index - 0x00000000005fb830 for__cvt_foreign_read - 0x00000000005fb9f0 for__cvt_foreign_write - 0x00000000005fbe20 for__cvt_foreign_check - 0x00000000005fbeb0 for_check_env_name - .text 0x00000000005fbf80 0x1ea0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x00000000005fbf80 for__create_lub - 0x00000000005fc100 for__release_lun - 0x00000000005fc440 for__deallocate_lub - 0x00000000005fc490 for__acquire_lun - 0x00000000005fd3c0 for__get_next_lub - 0x00000000005fd990 for__preconnected_units_create - 0x00000000005fdbe0 for__default_io_sizes_env_init - .text 0x00000000005fde20 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x00000000005fde20 for__add_to_lf_table - 0x00000000005fe0f0 for__rm_from_lf_table - .text 0x00000000005fe180 0x5960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x00000000005fe180 SetEndian - 0x00000000005fe4e0 CheckStreamRecortType - 0x00000000005fe920 CheckEndian - 0x00000000005fecd0 for_open - 0x00000000006001c0 for__update_reopen_keywords - 0x00000000006013c0 for__set_foreign_bits - 0x0000000000602370 for__open_key - 0x0000000000602620 for__open_args - 0x0000000000602d50 for__find_iomsg - 0x0000000000602e00 for__set_terminator_option - 0x0000000000603240 for__set_conversion_option - 0x0000000000603550 for__is_special_device - 0x0000000000603700 for__open_default - .text 0x0000000000603ae0 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x0000000000603ae0 for_pause - .text 0x0000000000603e00 0x2090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x0000000000603e00 for__put_su - 0x00000000006044c0 for__write_output - 0x0000000000604810 for__put_sf - 0x0000000000605a20 for__put_d - 0x0000000000605d50 for__flush_readahead - .text 0x0000000000605e90 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x0000000000605e90 for_set_reentrancy - 0x0000000000605ee0 for__reentrancy_cleanup - 0x0000000000605f40 for__disable_asynch_deliv_private - 0x0000000000605f60 for__enable_asynch_deliv_private - 0x0000000000605f80 for__once_private - 0x0000000000605fe0 for__reentrancy_init - .text 0x0000000000606170 0x1350 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x0000000000606170 for_rewind - .text 0x00000000006074c0 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x00000000006074c0 for_read_int_fmt - 0x0000000000608b90 for_read_int_fmt_xmit - .text 0x000000000060a7c0 0x4000 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x000000000060a7c0 for_read_int_lis - 0x000000000060bce0 for_read_int_lis_xmit - 0x000000000060e480 for_ri_cvt_2step - .text 0x000000000060e7c0 0x4010 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x000000000060e7c0 for_read_seq - 0x0000000000610830 for_read_seq_xmit - .text 0x00000000006127d0 0x40f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x00000000006127d0 for_read_seq_fmt - 0x0000000000614730 for_read_seq_fmt_xmit - 0x00000000006166c0 for__read_args - .text 0x00000000006168c0 0x5250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x00000000006168c0 for_read_seq_lis - 0x0000000000618510 for_read_seq_lis_xmit - 0x000000000061b8d0 for__swallow_imaginary_part - .text 0x000000000061bb10 0x1f40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x000000000061bb10 for_abort - 0x000000000061c500 for_stop_core - 0x000000000061d0e0 for_stop - .text 0x000000000061da50 0xdc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x000000000061da50 for__set_signal_ops_during_vm - 0x000000000061da80 for__get_vm - 0x000000000061db90 for__realloc_vm - 0x000000000061dc80 for__free_vm - 0x000000000061dcf0 for_allocate - 0x000000000061df60 for_alloc_allocatable - 0x000000000061e1e0 for_deallocate - 0x000000000061e340 for_dealloc_allocatable - 0x000000000061e4d0 for_check_mult_overflow - 0x000000000061e5f0 for_check_mult_overflow64 - 0x000000000061e7b0 for__spec_align_alloc - 0x000000000061e800 for__spec_align_free - .text 0x000000000061e810 0x33e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x000000000061e810 for_write_int_fmt - 0x000000000061ff20 for_write_int_fmt_xmit - .text 0x0000000000621bf0 0x7c30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x0000000000621bf0 for_write_seq - 0x0000000000623b50 for_write_seq_xmit - 0x0000000000629350 for__finish_ufseq_write - .text 0x0000000000629820 0x4940 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x0000000000629820 for_write_seq_fmt - 0x000000000062b9d0 for_write_seq_fmt_xmit - 0x000000000062dfe0 for__write_args - .text 0x000000000062e160 0x6b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x000000000062e160 for_write_seq_lis - 0x00000000006301b0 for_write_seq_lis_xmit - .text 0x0000000000634cd0 0x330 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x0000000000634cd0 for_index_back - 0x0000000000634e60 for_f90_index - .text 0x0000000000635000 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x0000000000635000 for_fp_class_s_ - 0x00000000006350c0 for_is_nan_s_ - 0x00000000006350f0 for_fp_class_t_ - 0x00000000006351b0 for_is_nan_t_ - 0x00000000006351f0 for_fp_class_x_ - 0x00000000006352c0 for_is_nan_x_ - .text 0x0000000000635300 0xf90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x0000000000635300 for_cpystr - 0x0000000000635390 for_cpstr_gt - 0x00000000006355a0 for_cpstr_lt - 0x00000000006357b0 for_cpstr_eq - 0x0000000000635930 for_cpstr_ne - 0x0000000000635ac0 for_cpstr_ge - 0x0000000000635cd0 for_cpstr_le - 0x0000000000635ee0 for_cpstr - 0x00000000006360a0 for_concat - .text 0x0000000000636290 0x2190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x0000000000636290 __msportlib_d_gethandle - 0x0000000000636510 __msportlib_set_posix_io_flag - 0x0000000000636520 __msportlib_d_curpos - 0x0000000000636610 __msportlib_d_curpos_i8 - 0x00000000006366f0 __msportlib_d_fseek - 0x00000000006368a0 __msportlib_d_fseek_i8 - 0x0000000000636a90 __msportlib_d_readchar - 0x0000000000637080 __msportlib_d_writechar - 0x0000000000637fb0 commitqq_ - 0x0000000000638080 flushqq_ - 0x0000000000638110 set_keypress - 0x00000000006381a0 reset_keypress - 0x00000000006381c0 getstrqq_ - 0x0000000000638290 getcharqq_ - 0x0000000000638320 peekcharqq_ - .text 0x0000000000638420 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x0000000000638420 r_int - 0x0000000000638440 r_int_val - 0x0000000000638450 d_int - 0x0000000000638470 d_int_val - 0x0000000000638480 h_nint - 0x00000000006384a0 i_nint - 0x00000000006384c0 k_nint - 0x00000000006384e0 r_nint - 0x0000000000638560 f_lanint_val - 0x00000000006385e0 b_nint - 0x0000000000638600 i_dnnt - 0x0000000000638620 h_dnnt - 0x0000000000638640 b_dnnt - 0x0000000000638660 k_dnnt - 0x0000000000638680 d_nint - 0x0000000000638700 f_ldnint_val - .text 0x0000000000638780 0x1400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x0000000000639960 tbk_stack_trace - .text 0x0000000000639b80 0x5540 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x0000000000639b80 for__aio_acquire_lun_fname - 0x0000000000639e80 for__aio_release_lun - 0x000000000063a3a0 for__aio_release - 0x000000000063a700 for__aio_acquire_lun - 0x000000000063af30 for__aio_destroy - 0x000000000063b370 for_asynchronous - 0x000000000063c0b0 for_waitid - 0x000000000063d540 for_wait - 0x000000000063e750 for__aio_error_handling - 0x000000000063ef10 for__aio_init - .text 0x000000000063f0c0 0x63b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x000000000063f0c0 for__compute_filename - 0x0000000000640b00 for__open_proc - 0x0000000000644790 for__reopen_file - 0x0000000000645460 for__decl_exit_hand - .text 0x0000000000645470 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x0000000000645470 for__aio_pthread_self - 0x0000000000645480 for__aio_pthread_create - 0x00000000006454a0 for__aio_pthread_cancel - 0x00000000006454b0 for__aio_pthread_mutex_lock - 0x00000000006454c0 for__aio_pthread_mutex_unlock - 0x00000000006454d0 for__aio_pthread_cond_wait - 0x00000000006454e0 for__aio_pthread_cond_signal - 0x00000000006454f0 for__aio_pthread_mutex_init - 0x0000000000645500 for__aio_pthread_exit - .text 0x0000000000645510 0x630 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x0000000000645510 cvt_text_to_integer - 0x00000000006456c0 cvt_text_to_unsigned64 - 0x0000000000645960 cvt_text_to_unsigned - 0x00000000006459c0 cvt_text_to_integer64 - .text 0x0000000000645b40 0xe30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x0000000000645b40 cvt_vax_f_to_ieee_single_ - 0x0000000000645ff0 CVT_VAX_F_TO_IEEE_SINGLE - 0x00000000006464a0 cvt_vax_f_to_ieee_single - .text 0x0000000000646970 0x1080 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x0000000000646970 cvt_vax_d_to_ieee_double_ - 0x0000000000646ee0 CVT_VAX_D_TO_IEEE_DOUBLE - 0x0000000000647450 cvt_vax_d_to_ieee_double - .text 0x00000000006479f0 0x1090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x00000000006479f0 cvt_vax_g_to_ieee_double_ - 0x0000000000647f60 CVT_VAX_G_TO_IEEE_DOUBLE - 0x00000000006484d0 cvt_vax_g_to_ieee_double - .text 0x0000000000648a80 0x21a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x0000000000648a80 cvt_cray_to_ieee_single_ - 0x0000000000648fb0 CVT_CRAY_TO_IEEE_SINGLE - 0x00000000006494e0 cvt_cray_to_ieee_single - 0x0000000000649a50 cvt_cray_to_ieee_double_ - 0x000000000064a020 CVT_CRAY_TO_IEEE_DOUBLE - 0x000000000064a5f0 cvt_cray_to_ieee_double - .text 0x000000000064ac20 0xf00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x000000000064ac20 cvt_ibm_short_to_ieee_single_ - 0x000000000064b110 CVT_IBM_SHORT_TO_IEEE_SINGLE - 0x000000000064b600 cvt_ibm_short_to_ieee_single - .text 0x000000000064bb20 0x11d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x000000000064bb20 cvt_ibm_long_to_ieee_double_ - 0x000000000064c0e0 CVT_IBM_LONG_TO_IEEE_DOUBLE - 0x000000000064c6a0 cvt_ibm_long_to_ieee_double - .text 0x000000000064ccf0 0x4760 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0x000000000064ccf0 cvt_ieee_double_to_cray_ - 0x000000000064d1d0 CVT_IEEE_DOUBLE_TO_CRAY - 0x000000000064d6b0 cvt_ieee_double_to_cray - 0x000000000064dbd0 cvt_ieee_double_to_ibm_long_ - 0x000000000064e120 CVT_IEEE_DOUBLE_TO_IBM_LONG - 0x000000000064e670 cvt_ieee_double_to_ibm_long - 0x000000000064ebe0 cvt_ieee_double_to_vax_d_ - 0x000000000064f010 CVT_IEEE_DOUBLE_TO_VAX_D - 0x000000000064f440 cvt_ieee_double_to_vax_d - 0x000000000064f8e0 cvt_ieee_double_to_vax_g_ - 0x000000000064fd10 CVT_IEEE_DOUBLE_TO_VAX_G - 0x0000000000650140 cvt_ieee_double_to_vax_g - 0x00000000006505e0 cvt_ieee_double_to_vax_h_ - 0x0000000000650a90 CVT_IEEE_DOUBLE_TO_VAX_H - 0x0000000000650f40 cvt_ieee_double_to_vax_h - .text 0x0000000000651450 0x2360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x0000000000651450 cvt_ieee_single_to_cray_ - 0x0000000000651870 CVT_IEEE_SINGLE_TO_CRAY - 0x0000000000651c90 cvt_ieee_single_to_cray - 0x00000000006520e0 cvt_ieee_single_to_ibm_short_ - 0x0000000000652500 CVT_IEEE_SINGLE_TO_IBM_SHORT - 0x0000000000652920 cvt_ieee_single_to_ibm_short - 0x0000000000652d80 cvt_ieee_single_to_vax_f_ - 0x00000000006530c0 CVT_IEEE_SINGLE_TO_VAX_F - 0x0000000000653400 cvt_ieee_single_to_vax_f - .text 0x00000000006537b0 0x1d30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x00000000006537b0 for__common_inquire - 0x0000000000654d20 for__inquire_args - .text 0x00000000006554e0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x00000000006554e0 for_exit - .text 0x0000000000655500 0x2dd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x0000000000655500 for__format_compiler - .text 0x00000000006582d0 0x1660 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x00000000006582d0 for__format_value - 0x0000000000658e60 for__cvt_value - .text 0x0000000000659930 0x1840 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x0000000000659930 for__get_s - 0x000000000065aca0 for__read_input - 0x000000000065adb0 for__get_d - .text 0x000000000065b170 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x000000000065b170 for_index - 0x000000000065b1f0 for_string_index - 0x000000000065b270 for_index_ssll - .text 0x000000000065b2f0 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x000000000065b2f0 for__interp_fmt - .text 0x000000000065c170 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .text 0x000000000065c170 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .text 0x000000000065c170 0xa60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x000000000065c170 cvt_integer_to_text - 0x000000000065c420 cvt_unsigned_to_text - 0x000000000065c690 cvt_integer64_to_text - 0x000000000065c950 cvt_unsigned64_to_text - .text 0x000000000065cbd0 0x8e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x000000000065cbd0 cvt_data_to_text - 0x000000000065d040 cvt_data64_to_text - .text 0x000000000065d4b0 0xb50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x000000000065d4b0 cvt_boolean_to_text - 0x000000000065d870 cvt_boolean_to_text_ex - 0x000000000065dc50 cvt_boolean64_to_text - .text 0x000000000065e000 0x5c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x000000000065e000 cvt_text_to_data - 0x000000000065e320 cvt_text_to_data64 - .text 0x000000000065e5c0 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x000000000065e5c0 cvt_text_to_boolean - 0x000000000065e6e0 cvt_text_to_boolean64 - .text 0x000000000065e810 0x25c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x000000000065e810 cvt_ieee_t_to_text_ex - 0x000000000065fb80 cvt_ieee_t_to_text - 0x0000000000660d30 cvt_text_to_ieee_t_ex - .text 0x0000000000660dd0 0x2530 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x0000000000660dd0 cvt_ieee_s_to_text_ex - 0x00000000006620f0 cvt_ieee_s_to_text - 0x0000000000663260 cvt_text_to_ieee_s_ex - .text 0x0000000000663300 0x14e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x0000000000663300 cvt_ieee_x_to_text - 0x0000000000663350 cvt_ieee_x_to_text_ex - 0x0000000000664740 cvt_text_to_ieee_x_ex - .text 0x00000000006647e0 0x15a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x00000000006647e0 cvtas_a_to_s - .text 0x0000000000665d80 0x2f00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x0000000000665d80 cvtas_a_to_t - .text 0x0000000000668c80 0x5bb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x0000000000668c80 cvtas_s_to_a - .text 0x000000000066e830 0x5d00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0x000000000066e830 cvtas_t_to_a - .text 0x0000000000674530 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x0000000000674530 cvtas_string_to_nan_s - .text 0x00000000006745b0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x00000000006745b0 cvtas_string_to_nan_t - .text 0x0000000000674620 0x5ed0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x0000000000674620 cvtas_a_to_x - .text 0x000000000067a4f0 0x5f80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0x000000000067a4f0 cvtas_x_to_a - .text 0x0000000000680470 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x0000000000680470 cvtas_string_to_nan_x - .text 0x0000000000680530 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .text 0x0000000000680530 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .text 0x0000000000680530 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .text 0x0000000000680530 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .text 0x0000000000680530 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x0000000000680530 acos - .text 0x0000000000680a10 0x510 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x0000000000680a10 asin - .text 0x0000000000680f20 0x570 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x0000000000680f20 atan2 - .text 0x0000000000681490 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - 0x0000000000681490 cbrt - .text 0x00000000006814c0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - 0x00000000006814c0 cos - .text 0x0000000000681500 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - 0x0000000000681500 exp2 - .text 0x0000000000681530 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - 0x0000000000681530 expf - .text 0x0000000000681560 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - 0x0000000000681560 exp - .text 0x0000000000681590 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - 0x0000000000681590 fmod - .text 0x00000000006815c0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x00000000006815c0 __powi4i4 - .text 0x0000000000681630 0xb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x0000000000681630 __powr8i4 - .text 0x00000000006816e0 0x66c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x0000000000681830 __libm_error_support - 0x0000000000687d40 __libm_setusermatherrl - 0x0000000000687d60 __libm_setusermatherr - 0x0000000000687d80 __libm_setusermatherrf - .text 0x0000000000687da0 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x0000000000687da0 __libm_sse2_sincos - .text 0x0000000000688120 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - 0x0000000000688120 llroundf - .text 0x0000000000688150 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - 0x0000000000688150 llround - .text 0x0000000000688180 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - 0x0000000000688180 log10 - .text 0x00000000006881b0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - 0x00000000006881b0 logf - .text 0x00000000006881e0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - 0x00000000006881e0 log - .text 0x0000000000688210 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - 0x0000000000688210 lroundf - .text 0x0000000000688240 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - 0x0000000000688240 lround - .text 0x0000000000688270 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x0000000000688270 matherrf - .text 0x0000000000688280 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x0000000000688280 matherrl - .text 0x0000000000688290 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x0000000000688290 matherr - .text 0x00000000006882a0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - 0x00000000006882a0 pow - .text 0x00000000006882d0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - 0x00000000006882d0 sin - .text 0x0000000000688310 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x0000000000688310 sqrt - .text 0x0000000000688360 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - 0x0000000000688360 tan - .text 0x0000000000688390 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x0000000000688390 truncf - .text 0x00000000006883f0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - 0x00000000006883f0 trunc - .text 0x0000000000688430 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x0000000000688430 cbrt.L - .text 0x0000000000688690 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x0000000000688690 cbrt.A - .text 0x0000000000688870 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x0000000000688870 cos.L - .text 0x0000000000688eb0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x0000000000688eb0 cos.A - .text 0x00000000006894f0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x00000000006894f0 cos.N - .text 0x0000000000689b30 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x0000000000689b30 exp2.L - .text 0x0000000000689e20 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0x0000000000689e20 exp2.A - .text 0x000000000068a3a0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x000000000068a3a0 exp.L - .text 0x000000000068a680 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x000000000068a680 expf.L - .text 0x000000000068a880 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x000000000068a880 expf.A - .text 0x000000000068aa80 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x000000000068aa80 exp.A - .text 0x000000000068ad60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .text 0x000000000068ad60 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x000000000068ad60 fmod.L - .text 0x000000000068b280 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0x000000000068b280 fmod.A - .text 0x000000000068b440 0x500 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x000000000068b440 __libm_reduce_pio2d - .text 0x000000000068b940 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x000000000068b940 llround.L - .text 0x000000000068ba90 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x000000000068ba90 llroundf.L - .text 0x000000000068bba0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x000000000068bba0 llroundf.A - .text 0x000000000068bc80 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x000000000068bc80 llround.A - .text 0x000000000068bd60 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x000000000068bd60 log10.L - .text 0x000000000068c010 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x000000000068c010 log10.A - .text 0x000000000068c2c0 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x000000000068c2c0 log.L - .text 0x000000000068c520 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x000000000068c520 logf.L - .text 0x000000000068c6e0 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0x000000000068c6e0 logf.A - .text 0x000000000068c900 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .text 0x000000000068c900 0x270 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x000000000068c900 log.A - .text 0x000000000068cb70 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x000000000068cb70 lround.L - .text 0x000000000068ccc0 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x000000000068ccc0 lroundf.L - .text 0x000000000068cdd0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x000000000068cdd0 lroundf.A - .text 0x000000000068ceb0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x000000000068ceb0 lround.A - .text 0x000000000068cf90 0x1010 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x000000000068cf90 pow.L - .text 0x000000000068dfa0 0xbb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x000000000068dfa0 pow.A - .text 0x000000000068eb50 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .text 0x000000000068eb50 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x000000000068eb50 sin.L - .text 0x000000000068f1a0 0x660 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x000000000068f1a0 sin.A - .text 0x000000000068f800 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x000000000068f800 sin.N - .text 0x000000000068fe50 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x000000000068fe50 tan.L - .text 0x0000000000690640 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x0000000000690640 tan.A - .text 0x0000000000690e30 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x0000000000690e30 trunc.L - .text 0x0000000000690e90 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x0000000000690e90 trunc.A - .text 0x0000000000690f20 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x0000000000690f20 trunc.N - .text 0x0000000000690f30 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x0000000000690f30 vmldCos2 - 0x0000000000690f40 __svml_cos2 - 0x0000000000690f90 vmldCos2Mask - 0x0000000000690fa0 __svml_cos2_mask - .text 0x0000000000690fc0 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x0000000000690fc0 vmldSin2 - 0x0000000000690fd0 __svml_sin2 - 0x0000000000691020 vmldSin2Mask - 0x0000000000691030 __svml_sin2_mask - .text 0x0000000000691050 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0x0000000000691050 __svml_cos2.R - .text 0x00000000006919b0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0x00000000006919b0 __svml_sin2.R - .text 0x0000000000692310 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0x0000000000692310 __svml_cos2.N - .text 0x0000000000692c70 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0x0000000000692c70 __svml_sin2.N - .text 0x00000000006935d0 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0x00000000006935d0 __svml_cos2.L - .text 0x0000000000693f20 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0x0000000000693f20 __svml_sin2.L - .text 0x0000000000694880 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0x0000000000694880 __svml_cos2.A - .text 0x00000000006951d0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0x00000000006951d0 __svml_sin2.A - .text 0x0000000000695b30 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x0000000000695b30 __qtoj - 0x0000000000695cd0 __qtok - 0x0000000000695df0 __qtoi - 0x0000000000695f30 __qtou - .text 0x0000000000696010 0x7c0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x0000000000696010 __qtod - 0x0000000000696300 __qtol - 0x0000000000696530 __qtof - .text 0x00000000006967d0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x00000000006967d0 a_divq - .text 0x00000000006967e0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x00000000006967e0 a_mulq - .text 0x00000000006967f0 0x4a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x00000000006967f0 tbk_string_stack_signal - .text 0x0000000000696c90 0x1210 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x0000000000696c90 tbk_getPC - 0x0000000000696ca0 tbk_getRetAddr - 0x0000000000696cb0 tbk_getFramePtr - 0x0000000000696cc0 tbk_getModuleName - 0x0000000000696ff0 tbk_get_pc_info - 0x0000000000697aa0 tbk_geterrorstring - 0x0000000000697bb0 tbk_trace_stack - .text 0x0000000000697ea0 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x0000000000697ea0 _intel_fast_memcmp - .text 0x0000000000697ff0 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x0000000000697ff0 __intel_cpu_indicator_init - .text 0x0000000000698180 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x0000000000698180 _intel_fast_memcpy.A - 0x0000000000698190 _intel_fast_memcpy.J - 0x00000000006981a0 _intel_fast_memcpy - .text 0x00000000006981d0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x00000000006981d0 _intel_fast_memset.A - 0x00000000006981e0 _intel_fast_memset.J - 0x00000000006981f0 _intel_fast_memset - .text 0x0000000000698220 0x1780 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x0000000000698310 __intel_new_proc_init - 0x0000000000698340 __intel_new_proc_init.H - 0x0000000000698420 __intel_new_proc_init.A - 0x0000000000698430 __intel_proc_init - 0x0000000000698460 __intel_proc_init.H - 0x00000000006984e0 __intel_proc_init.A - 0x00000000006984f0 __intel_new_proc_init_G - 0x0000000000698520 __intel_new_proc_init_G.R - 0x0000000000698590 __intel_new_proc_init_G.A - 0x0000000000698610 __intel_new_proc_init_H - 0x0000000000698640 __intel_new_proc_init_H.P - 0x00000000006986a0 __intel_new_proc_init_H.A - 0x0000000000698720 __intel_new_proc_init_L - 0x0000000000698760 __intel_new_proc_init_L.O - 0x0000000000698830 __intel_new_proc_init_L.M - 0x00000000006988e0 __intel_new_proc_init_L.A - 0x0000000000698960 __intel_new_proc_init_S - 0x0000000000698990 __intel_new_proc_init_S.N - 0x0000000000698a60 __intel_new_proc_init_S.A - 0x0000000000698ae0 __intel_new_proc_init_T - 0x0000000000698b10 __intel_new_proc_init_T.M - 0x0000000000698be0 __intel_new_proc_init_T.A - 0x0000000000698c60 __intel_proc_init_T - 0x0000000000698c90 __intel_proc_init_T.M - 0x0000000000698cc0 __intel_proc_init_T.A - 0x0000000000698d40 __intel_new_proc_init_P - 0x0000000000698d70 __intel_new_proc_init_P.L - 0x0000000000698e40 __intel_new_proc_init_P.A - 0x0000000000698ec0 __intel_proc_init_P - 0x0000000000698ef0 __intel_proc_init_P.L - 0x0000000000698f20 __intel_proc_init_P.A - 0x0000000000698fa0 __intel_new_proc_init_B - 0x0000000000698ff0 __intel_new_proc_init_B.L - 0x00000000006990c0 __intel_new_proc_init_B.K - 0x0000000000699190 __intel_new_proc_init_B.J - 0x0000000000699270 __intel_new_proc_init_B.A - 0x00000000006992f0 __intel_proc_init_B - 0x0000000000699340 __intel_proc_init_B.L - 0x0000000000699370 __intel_proc_init_B.K - 0x00000000006993a0 __intel_proc_init_B.J - 0x0000000000699420 __intel_proc_init_B.A - 0x00000000006994a0 __intel_new_proc_init_N - 0x00000000006994f0 __intel_new_proc_init_N.L - 0x00000000006995c0 __intel_new_proc_init_N.K - 0x0000000000699690 __intel_new_proc_init_N.J - 0x0000000000699770 __intel_new_proc_init_N.A - 0x00000000006997f0 __intel_proc_init_N - 0x0000000000699840 __intel_proc_init_N.L - 0x0000000000699870 __intel_proc_init_N.K - 0x00000000006998a0 __intel_proc_init_N.J - 0x0000000000699920 __intel_proc_init_N.A - .text 0x00000000006999a0 0x1590 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x00000000006999a0 __mulq.L - 0x000000000069a450 __mulq.A - 0x000000000069af00 __mulq - .text 0x000000000069af30 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0x000000000069af30 __divq.L - 0x000000000069bd10 __divq.A - 0x000000000069caf0 __divq - .text 0x000000000069cb20 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x000000000069cb20 __intel_sse2_strlen - 0x000000000069cb50 __intel_sse4_strlen - .text 0x000000000069cb70 0x23e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - 0x000000000069cb70 __intel_new_memcpy - .text 0x000000000069ef50 0x1220 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - 0x000000000069ef50 __intel_new_memset - .text 0x00000000006a0170 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x00000000006a0170 irc__get_msg - 0x00000000006a0360 irc__print - .text 0x00000000006a05b0 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x00000000006a05b0 __intel_get_mem_ops_method - 0x00000000006a0990 __intel_set_memcpy_largest_cache_size - 0x00000000006a0da0 __intel_set_memcpy_largest_cachelinesize - 0x00000000006a11c0 __intel_get_memcpy_largest_cache_size - 0x00000000006a15c0 __intel_get_memcpy_largest_cachelinesize - 0x00000000006a19d0 __intel_init_mem_ops_method - 0x00000000006a1da0 __intel_override_mem_ops_method - .text 0x00000000006a21a0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - 0x00000000006a21a0 __intel_get_new_mem_ops_cpuid - 0x00000000006a21d0 __intel_get_new_mem_ops_cpuid4 - .text 0x00000000006a2220 0x99 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x00000000006a2220 __libc_csu_fini - 0x00000000006a2230 __libc_csu_init - *fill* 0x00000000006a22b9 0x7 90909090 - .text 0x00000000006a22c0 0x36 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - *fill* 0x00000000006a22f6 0x2 90909090 - .text 0x00000000006a22f8 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(.gnu.warning) - -.fini 0x00000000006a22f8 0xe - *(.fini) - .fini 0x00000000006a22f8 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x00000000006a22f8 _fini - .fini 0x00000000006a22fc 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .fini 0x00000000006a2301 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x00000000006a2306 PROVIDE (__etext, .) - 0x00000000006a2306 PROVIDE (_etext, .) - 0x00000000006a2306 PROVIDE (etext, .) - -.rodata 0x00000000006a2320 0x5b8e0 - *(.rodata .rodata.* .gnu.linkonce.r.*) - .rodata.cst4 0x00000000006a2320 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x00000000006a2320 _IO_stdin_used - *fill* 0x00000000006a2324 0x4 00 - .rodata 0x00000000006a2328 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - 0x00000000006a2328 __dso_handle - *fill* 0x00000000006a2330 0x10 00 - .rodata 0x00000000006a2340 0x500 unres.o - .rodata.str1.32 - 0x00000000006a2840 0xf3 unres.o - 0xf4 (size before relaxing) - *fill* 0x00000000006a2933 0x1 00 - .rodata.str1.4 - 0x00000000006a2934 0x20f unres.o - 0x29c (size before relaxing) - *fill* 0x00000000006a2b43 0xd 00 - .rodata 0x00000000006a2b50 0x30 arcos.o - .rodata 0x00000000006a2b80 0x180 cartprint.o - .rodata 0x00000000006a2d00 0x38 chainbuild.o - .rodata 0x00000000006a2d38 0x30 convert.o - *fill* 0x00000000006a2d68 0x8 00 - .rodata 0x00000000006a2d70 0x340 initialize_p.o - .rodata.str1.4 - 0x00000000006a30b0 0x13a initialize_p.o - 0x154 (size before relaxing) - *fill* 0x00000000006a31ea 0x2 00 - .rodata.str1.32 - 0x00000000006a31ec 0x15d initialize_p.o - 0x160 (size before relaxing) - *fill* 0x00000000006a3349 0x7 00 - .rodata 0x00000000006a3350 0x1760 readrtns_CSA.o - .rodata.str1.4 - 0x00000000006a4ab0 0x1141 readrtns_CSA.o - 0x142c (size before relaxing) - *fill* 0x00000000006a5bf1 0x3 00 - .rodata.str1.32 - 0x00000000006a5bf4 0xbef readrtns_CSA.o - 0xde4 (size before relaxing) - *fill* 0x00000000006a67e3 0x1 00 - .rodata.str1.4 - 0x00000000006a67e4 0x517 parmread.o - 0x65c (size before relaxing) - *fill* 0x00000000006a6cfb 0x5 00 - .rodata 0x00000000006a6d00 0xdb0 parmread.o - .rodata.str1.32 - 0x00000000006a7ab0 0x3f5 parmread.o - 0x4ac (size before relaxing) - *fill* 0x00000000006a7ea5 0xb 00 - .rodata 0x00000000006a7eb0 0x2a0 gen_rand_conf.o - .rodata.str1.32 - 0x00000000006a8150 0x125 gen_rand_conf.o - 0x23c (size before relaxing) - *fill* 0x00000000006a8275 0x3 00 - .rodata.str1.4 - 0x00000000006a8278 0x9f gen_rand_conf.o - 0xd4 (size before relaxing) - *fill* 0x00000000006a8317 0x9 00 - .rodata 0x00000000006a8320 0xc0 printmat.o - .rodata 0x00000000006a83e0 0xac map.o - .rodata.str1.32 - 0x00000000006a848c 0x29 map.o - 0x2c (size before relaxing) - *fill* 0x00000000006a84b5 0x3 00 - .rodata.str1.4 - 0x00000000006a84b8 0x36 map.o - 0x64 (size before relaxing) - *fill* 0x00000000006a84ee 0x2 00 - .rodata 0x00000000006a84f0 0x68 randgens.o - .rodata 0x00000000006a8558 0x10 rescode.o - .rodata.str1.4 - 0x0000000000000000 0x4 rescode.o - *fill* 0x00000000006a8568 0x8 00 - .rodata 0x00000000006a8570 0x30 intcor.o - .rodata 0x00000000006a85a0 0x448 timing.o - .rodata.str1.4 - 0x00000000006a89e8 0x230 timing.o - 0x2e4 (size before relaxing) - .rodata.str1.32 - 0x00000000006a8c18 0x69 timing.o - 0x6c (size before relaxing) - *fill* 0x00000000006a8c81 0x3 00 - .rodata.str1.4 - 0x00000000006a8c84 0x6 misc.o - 0x18 (size before relaxing) - *fill* 0x00000000006a8c8a 0x2 00 - .rodata 0x00000000006a8c8c 0x24 misc.o - .rodata 0x00000000006a8cb0 0x228 intlocal.o - .rodata.str1.4 - 0x00000000006a8ed8 0x38 intlocal.o - 0x44 (size before relaxing) - .rodata 0x00000000006a8f10 0x10 cartder.o - .rodata 0x00000000006a8f20 0x450 checkder_p.o - .rodata.str1.4 - 0x00000000006a9370 0x15f checkder_p.o - 0x1c0 (size before relaxing) - *fill* 0x00000000006a94cf 0x1 00 - .rodata.str1.32 - 0x00000000006a94d0 0x78 checkder_p.o - 0xa0 (size before relaxing) - *fill* 0x00000000006a9548 0x8 00 - .rodata 0x00000000006a9550 0x20 econstr_local.o - .rodata 0x00000000006a9570 0xb70 energy_p_new_barrier.o - .rodata.str1.4 - 0x00000000006aa0e0 0xf0 energy_p_new_barrier.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x00000000006aa1d0 0x50 energy_p_new_barrier.o - .rodata 0x00000000006aa220 0x2e8 energy_p_new-sep_barrier.o - .rodata.str1.4 - 0x0000000000000000 0x3c energy_p_new-sep_barrier.o - .rodata.str1.32 - 0x0000000000000000 0x50 energy_p_new-sep_barrier.o - *fill* 0x00000000006aa508 0x18 00 - .rodata 0x00000000006aa520 0x180 minimize_p.o - .rodata.str1.4 - 0x00000000006aa6a0 0x1e minimize_p.o - 0x54 (size before relaxing) - *fill* 0x00000000006aa6be 0x2 00 - .rodata.str1.32 - 0x00000000006aa6c0 0x22 minimize_p.o - 0x24 (size before relaxing) - *fill* 0x00000000006aa6e2 0x1e 00 - .rodata 0x00000000006aa700 0x1a0 sumsld.o - .rodata 0x00000000006aa8a0 0x33a0 cored.o - .rodata 0x00000000006adc40 0x60 rmdd.o - .rodata 0x00000000006adca0 0x7ec geomout.o - .rodata.str1.4 - 0x00000000006ae48c 0x136 geomout.o - 0x1b4 (size before relaxing) - *fill* 0x00000000006ae5c2 0x2 00 - .rodata.str1.32 - 0x00000000006ae5c4 0x59 geomout.o - 0x5c (size before relaxing) - *fill* 0x00000000006ae61d 0x3 00 - .rodata 0x00000000006ae620 0x370 readpdb.o - .rodata 0x00000000006ae990 0x150 regularize.o - .rodata.str1.4 - 0x00000000006aeae0 0xd5 regularize.o - 0x10c (size before relaxing) - *fill* 0x00000000006aebb5 0x3 00 - .rodata.str1.32 - 0x00000000006aebb8 0x29 regularize.o - 0x58 (size before relaxing) - *fill* 0x00000000006aebe1 0xf 00 - .rodata 0x00000000006aebf0 0x4d0 thread.o - .rodata.str1.4 - 0x00000000006af0c0 0x13e thread.o - 0x230 (size before relaxing) - *fill* 0x00000000006af1fe 0x2 00 - .rodata.str1.32 - 0x00000000006af200 0x24e thread.o - 0x388 (size before relaxing) - *fill* 0x00000000006af44e 0x12 00 - .rodata 0x00000000006af460 0x100 fitsq.o - .rodata.str1.32 - 0x00000000006af560 0x2a fitsq.o - 0x58 (size before relaxing) - *fill* 0x00000000006af58a 0x6 00 - .rodata 0x00000000006af590 0x700 mcm.o - .rodata.str1.4 - 0x00000000006afc90 0x41f mcm.o - 0x518 (size before relaxing) - *fill* 0x00000000006b00af 0x1 00 - .rodata.str1.32 - 0x00000000006b00b0 0x249 mcm.o - 0x24c (size before relaxing) - *fill* 0x00000000006b02f9 0x7 00 - .rodata 0x00000000006b0300 0x648 mc.o - .rodata.str1.4 - 0x00000000006b0948 0x30d mc.o - 0x428 (size before relaxing) - *fill* 0x00000000006b0c55 0x3 00 - .rodata.str1.32 - 0x00000000006b0c58 0xe8 mc.o - 0x114 (size before relaxing) - .rodata 0x00000000006b0d40 0x110 bond_move.o - .rodata.str1.4 - 0x00000000006b0e50 0x73 bond_move.o - 0x7c (size before relaxing) - *fill* 0x00000000006b0ec3 0x1 00 - .rodata.str1.32 - 0x00000000006b0ec4 0x6f bond_move.o - 0x70 (size before relaxing) - *fill* 0x00000000006b0f33 0xd 00 - .rodata 0x00000000006b0f40 0x1c0 refsys.o - .rodata 0x00000000006b1100 0x38 check_sc_distr.o - .rodata.str1.4 - 0x00000000006b1138 0xf check_sc_distr.o - 0x18 (size before relaxing) - *fill* 0x00000000006b1147 0x1 00 - .rodata 0x00000000006b1148 0x20 check_bond.o - *fill* 0x00000000006b1168 0x8 00 - .rodata 0x00000000006b1170 0xd0 contact.o - .rodata.str1.4 - 0x00000000006b1240 0x2a contact.o - 0x2c (size before relaxing) - *fill* 0x00000000006b126a 0x16 00 - .rodata 0x00000000006b1280 0xe0 djacob.o - .rodata 0x00000000006b1360 0x3c0 eigen.o - .rodata.str1.32 - 0x00000000006b1720 0x29 eigen.o - 0x2c (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x4 eigen.o - *fill* 0x00000000006b1749 0x7 00 - .rodata 0x00000000006b1750 0x80 blas.o - .rodata.str1.4 - 0x00000000006b17d0 0x8 add.o - *fill* 0x00000000006b17d8 0x8 00 - .rodata 0x00000000006b17e0 0x730 entmcm.o - .rodata.str1.4 - 0x00000000006b1f10 0x11e entmcm.o - 0x538 (size before relaxing) - *fill* 0x00000000006b202e 0x2 00 - .rodata.str1.32 - 0x00000000006b2030 0x51 entmcm.o - 0x168 (size before relaxing) - *fill* 0x00000000006b2081 0xf 00 - .rodata 0x00000000006b2090 0x70 minim_mcmf.o - .rodata 0x00000000006b2100 0xb70 together.o - .rodata.str1.4 - 0x00000000006b2c70 0x316 together.o - 0x58c (size before relaxing) - *fill* 0x00000000006b2f86 0x2 00 - .rodata.str1.32 - 0x00000000006b2f88 0x16c together.o - 0x224 (size before relaxing) - *fill* 0x00000000006b30f4 0xc 00 - .rodata 0x00000000006b3100 0x240 csa.o - .rodata.str1.4 - 0x00000000006b3340 0x5a csa.o - 0xc4 (size before relaxing) - *fill* 0x00000000006b339a 0x2 00 - .rodata.str1.32 - 0x00000000006b339c 0x58 csa.o - 0x7c (size before relaxing) - *fill* 0x00000000006b33f4 0xc 00 - .rodata 0x00000000006b3400 0x380 minim_jlee.o - .rodata.str1.4 - 0x00000000006b3780 0xfd minim_jlee.o - 0x1fc (size before relaxing) - *fill* 0x00000000006b387d 0x3 00 - .rodata.str1.32 - 0x00000000006b3880 0x89 minim_jlee.o - 0x230 (size before relaxing) - *fill* 0x00000000006b3909 0x3 00 - .rodata 0x00000000006b390c 0x3a4 shift.o - .rodata.str1.4 - 0x00000000006b3cb0 0x25 shift.o - 0x54 (size before relaxing) - *fill* 0x00000000006b3cd5 0xb 00 - .rodata 0x00000000006b3ce0 0x20 diff12.o - .rodata 0x00000000006b3d00 0xbe8 bank.o - .rodata.str1.4 - 0x00000000006b48e8 0x114 bank.o - 0x2ac (size before relaxing) - .rodata.str1.32 - 0x00000000006b49fc 0x4a bank.o - 0x4c (size before relaxing) - *fill* 0x00000000006b4a46 0xa 00 - .rodata 0x00000000006b4a50 0x3f0 newconf.o - .rodata.str1.4 - 0x00000000006b4e40 0xaf newconf.o - 0xf8 (size before relaxing) - *fill* 0x00000000006b4eef 0x1 00 - .rodata.str1.32 - 0x00000000006b4ef0 0x7c newconf.o - 0xf0 (size before relaxing) - .rodata 0x00000000006b4f6c 0x18 ran.o - .rodata.str1.4 - 0x00000000006b4f84 0x1b indexx.o - 0x1c (size before relaxing) - *fill* 0x00000000006b4f9f 0x1 00 - .rodata 0x00000000006b4fa0 0x730 MP.o - .rodata.str1.4 - 0x00000000006b56d0 0x27d MP.o - 0x5e8 (size before relaxing) - *fill* 0x00000000006b594d 0x3 00 - .rodata.str1.32 - 0x00000000006b5950 0x31b MP.o - 0x470 (size before relaxing) - *fill* 0x00000000006b5c6b 0x5 00 - .rodata 0x00000000006b5c70 0x170 compare_s1.o - .rodata.str1.4 - 0x00000000006b5de0 0x71 compare_s1.o - 0x78 (size before relaxing) - *fill* 0x00000000006b5e51 0x3 00 - .rodata.str1.32 - 0x00000000006b5e54 0x14c compare_s1.o - .rodata 0x00000000006b5fa0 0x30 prng_32.o - .rodata 0x00000000006b5fd0 0xf50 test.o - .rodata.str1.4 - 0x00000000006b6f20 0x46a test.o - 0xa00 (size before relaxing) - *fill* 0x00000000006b738a 0x2 00 - .rodata.str1.32 - 0x00000000006b738c 0x5a test.o - 0x12c (size before relaxing) - *fill* 0x00000000006b73e6 0xa 00 - .rodata 0x00000000006b73f0 0x40 banach.o - .rodata 0x00000000006b7430 0xf0 distfit.o - .rodata.str1.32 - 0x00000000006b7520 0x75 distfit.o - 0x78 (size before relaxing) - *fill* 0x00000000006b7595 0x3 00 - .rodata.str1.4 - 0x00000000006b7598 0x25 distfit.o - 0x3c (size before relaxing) - *fill* 0x00000000006b75bd 0x3 00 - .rodata 0x00000000006b75c0 0x150 rmsd.o - .rodata.str1.4 - 0x00000000006b7710 0x6a rmsd.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x0000000000000000 0x2c rmsd.o - *fill* 0x00000000006b777a 0x6 00 - .rodata 0x00000000006b7780 0x580 elecont.o - .rodata.str1.32 - 0x00000000006b7d00 0xdf elecont.o - 0x108 (size before relaxing) - *fill* 0x00000000006b7ddf 0x1 00 - .rodata.str1.4 - 0x00000000006b7de0 0x1b elecont.o - 0x278 (size before relaxing) - *fill* 0x00000000006b7dfb 0x1 00 - .rodata.str1.4 - 0x00000000006b7dfc 0x6c dihed_cons.o - 0x90 (size before relaxing) - .rodata 0x00000000006b7e68 0x118 dihed_cons.o - .rodata.str1.32 - 0x00000000006b7f80 0xc3 dihed_cons.o - 0xc4 (size before relaxing) - *fill* 0x00000000006b8043 0xd 00 - .rodata 0x00000000006b8050 0x130 sc_move.o - .rodata.str1.4 - 0x0000000000000000 0x8 sc_move.o - .rodata 0x00000000006b8180 0x3a0 local_move.o - .rodata.str1.32 - 0x00000000006b8520 0x84 local_move.o - .rodata.str1.4 - 0x00000000006b85a4 0x92 local_move.o - 0xa0 (size before relaxing) - *fill* 0x00000000006b8636 0x2 00 - .rodata 0x00000000006b8638 0x1e8 intcartderiv.o - .rodata.str1.32 - 0x00000000006b8820 0xef intcartderiv.o - 0xf0 (size before relaxing) - *fill* 0x00000000006b890f 0x1 00 - .rodata 0x00000000006b8910 0x130 /tmp/ipo_ifortx3jrsv.o - .rodata.str1.4 - 0x00000000006b8a40 0x72 /tmp/ipo_ifortx3jrsv.o - 0xa0 (size before relaxing) - *fill* 0x00000000006b8ab2 0xe 00 - .rodata 0x00000000006b8ac0 0x110 stochfric.o - .rodata.str1.4 - 0x00000000006b8bd0 0x38 stochfric.o - .rodata.str1.32 - 0x00000000006b8c08 0x3e stochfric.o - 0x40 (size before relaxing) - *fill* 0x00000000006b8c46 0xa 00 - .rodata 0x00000000006b8c50 0x20 kinetic_lesyng.o - .rodata.str1.4 - 0x00000000006b8c70 0x3f3 MD_A-MTS.o - 0x5a8 (size before relaxing) - *fill* 0x00000000006b9063 0xd 00 - .rodata 0x00000000006b9070 0xcb0 MD_A-MTS.o - .rodata.str1.32 - 0x00000000006b9d20 0x47d MD_A-MTS.o - 0x524 (size before relaxing) - *fill* 0x00000000006ba19d 0x3 00 - .rodata 0x00000000006ba1a0 0xa0 moments.o - .rodata 0x00000000006ba240 0x60 surfatom.o - .rodata.str1.4 - 0x0000000000000000 0xc surfatom.o - .rodata 0x00000000006ba2a0 0x3e0 muca_md.o - .rodata.str1.4 - 0x00000000006ba680 0xea muca_md.o - 0x10c (size before relaxing) - *fill* 0x00000000006ba76a 0x6 00 - .rodata 0x00000000006ba770 0x8a0 MREMD.o - .rodata.str1.4 - 0x00000000006bb010 0x2ea MREMD.o - 0x4dc (size before relaxing) - *fill* 0x00000000006bb2fa 0x2 00 - .rodata.str1.32 - 0x00000000006bb2fc 0x22 MREMD.o - 0x80 (size before relaxing) - *fill* 0x00000000006bb31e 0x2 00 - .rodata 0x00000000006bb320 0x18 rattle.o - .rodata.str1.32 - 0x00000000006bb338 0xa5 rattle.o - 0xa8 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0xc rattle.o - *fill* 0x00000000006bb3dd 0x3 00 - .rodata 0x00000000006bb3e0 0x30 gauss.o - .rodata 0x00000000006bb410 0xa0 energy_split-sep.o - .rodata 0x00000000006bb4b0 0x68 q_measure.o - .rodata.str1.32 - 0x00000000006bb518 0x20 q_measure.o - .rodata 0x00000000006bb538 0x20 gnmr1.o - .rodata 0x00000000006bb558 0x3 proc_proc.o - *fill* 0x00000000006bb55b 0x1 00 - .rodata 0x00000000006bb55c 0xd0 cinfo.o - .rodata.str1.4 - 0x00000000006bb62c 0xda cinfo.o - 0xdc (size before relaxing) - *fill* 0x00000000006bb706 0x2 00 - .rodata.str1.32 - 0x00000000006bb708 0x2c3 cinfo.o - 0x2c4 (size before relaxing) - .rodata 0x00000000006bb9cb 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .rodata 0x00000000006bb9dc 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .rodata 0x00000000006bb9f7 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .rodata 0x00000000006bba03 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .rodata 0x00000000006bba1a 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .rodata 0x00000000006bba22 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .rodata 0x00000000006bba2a 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - *fill* 0x00000000006bba3a 0x6 00 - .rodata 0x00000000006bba40 0xa9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .rodata 0x00000000006bbae9 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .rodata 0x00000000006bbaf1 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .rodata 0x00000000006bbafb 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .rodata 0x00000000006bbb02 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .rodata 0x00000000006bbb09 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .rodata 0x00000000006bbb12 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .rodata 0x00000000006bbb1c 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .rodata 0x00000000006bbb27 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .rodata 0x00000000006bbb30 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .rodata 0x00000000006bbb3e 0x22 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .rodata 0x00000000006bbb60 0x15 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .rodata 0x00000000006bbb75 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .rodata 0x00000000006bbb81 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x00000000006bbb9b 0x5 00 - .rodata 0x00000000006bbba0 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000006bbba0 MPIR_Version_patches - 0x00000000006bbba4 MPIR_Version_major - 0x00000000006bbba8 MPIR_Version_minor - 0x00000000006bbbac MPIR_Version_subminor - 0x00000000006bbbb0 MPIR_Version_string - 0x00000000006bbbc0 MPIR_Version_date - 0x00000000006bbbe0 MPIR_Version_configure - 0x00000000006bbbf3 MPIR_Version_device - .rodata 0x00000000006bbd35 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - *fill* 0x00000000006bbd3f 0x1 00 - .rodata 0x00000000006bbd40 0x2d40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .rodata 0x00000000006bea80 0x225 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - *fill* 0x00000000006beca5 0x3 00 - .rodata 0x00000000006beca8 0xde /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .rodata 0x00000000006bed86 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .rodata 0x00000000006bed94 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x00000000006beda2 0x6 00 - .rodata 0x00000000006beda8 0xa3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .rodata 0x00000000006bee4b 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .rodata 0x00000000006bee59 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .rodata 0x00000000006bee66 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .rodata 0x00000000006bee73 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .rodata 0x00000000006bee80 0x121 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .rodata 0x00000000006befa1 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .rodata 0x00000000006befad 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .rodata 0x00000000006befba 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .rodata 0x00000000006befd8 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .rodata 0x00000000006befe4 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .rodata 0x00000000006bf012 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x00000000006bf01e 0x2 00 - .rodata 0x00000000006bf020 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .rodata 0x00000000006bf117 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .rodata 0x00000000006bf133 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .rodata 0x00000000006bf144 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .rodata 0x00000000006bf14e 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .rodata 0x00000000006bf156 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .rodata 0x00000000006bf15f 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .rodata 0x00000000006bf169 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .rodata 0x00000000006bf174 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .rodata 0x00000000006bf180 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .rodata 0x00000000006bf189 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x00000000006bf195 0x3 00 - .rodata 0x00000000006bf198 0xb58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .rodata 0x00000000006bfcf0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .rodata 0x00000000006bfcf9 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .rodata 0x00000000006bfd10 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .rodata 0x00000000006bfdd0 0x69 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .rodata 0x00000000006bfe39 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .rodata 0x00000000006bfe46 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - *fill* 0x00000000006bfe61 0x7 00 - .rodata 0x00000000006bfe68 0xa48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .rodata 0x00000000006c08b0 0x3d7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - *fill* 0x00000000006c0c87 0x1 00 - .rodata 0x00000000006c0c88 0x469 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - *fill* 0x00000000006c10f1 0x7 00 - .rodata 0x00000000006c10f8 0x9aa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x00000000006c1aa2 0x6 00 - .rodata 0x00000000006c1aa8 0x5ba /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - *fill* 0x00000000006c2062 0x6 00 - .rodata 0x00000000006c2068 0x664 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - *fill* 0x00000000006c26cc 0x4 00 - .rodata 0x00000000006c26d0 0x5de /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x00000000006c2cae 0x2 00 - .rodata 0x00000000006c2cb0 0x501 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x00000000006c31b1 0x7 00 - .rodata 0x00000000006c31b8 0x1a9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - *fill* 0x00000000006c3361 0x7 00 - .rodata 0x00000000006c3368 0x16c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - *fill* 0x00000000006c34d4 0x4 00 - .rodata 0x00000000006c34d8 0xec /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - *fill* 0x00000000006c35c4 0x4 00 - .rodata 0x00000000006c35c8 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - *fill* 0x00000000006c36e1 0x7 00 - .rodata 0x00000000006c36e8 0xe7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - *fill* 0x00000000006c37cf 0x1 00 - .rodata 0x00000000006c37d0 0xf9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - *fill* 0x00000000006c38c9 0x7 00 - .rodata 0x00000000006c38d0 0xbf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - *fill* 0x00000000006c398f 0x1 00 - .rodata 0x00000000006c3990 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - *fill* 0x00000000006c39cf 0x1 00 - .rodata 0x00000000006c39d0 0x440 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .rodata 0x00000000006c3e10 0x506 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - *fill* 0x00000000006c4316 0x2 00 - .rodata 0x00000000006c4318 0xb9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x00000000006c43d1 0x7 00 - .rodata 0x00000000006c43d8 0x4e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - *fill* 0x00000000006c4426 0x2 00 - .rodata 0x00000000006c4428 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - *fill* 0x00000000006c451f 0x1 00 - .rodata 0x00000000006c4520 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - *fill* 0x00000000006c4637 0x1 00 - .rodata 0x00000000006c4638 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .rodata 0x00000000006c47f8 0x2d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .rodata 0x00000000006c4825 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - *fill* 0x00000000006c483d 0x3 00 - .rodata 0x00000000006c4840 0x1ef /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - *fill* 0x00000000006c4a2f 0x1 00 - .rodata 0x00000000006c4a30 0x1a1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .rodata 0x00000000006c4bd1 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .rodata 0x00000000006c4be1 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .rodata 0x00000000006c4bea 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .rodata 0x00000000006c4bf5 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .rodata 0x00000000006c4c03 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .rodata 0x00000000006c4c0f 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .rodata 0x00000000006c4c2d 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .rodata 0x00000000006c4c37 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .rodata 0x00000000006c4c43 0x32 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .rodata 0x00000000006c4c75 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x00000000006c4c81 0x7 00 - .rodata 0x00000000006c4c88 0x5e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .rodata 0x00000000006c4ce6 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .rodata 0x00000000006c4cef 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .rodata 0x00000000006c4cf8 0xbe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x00000000006c4db6 0x2 00 - .rodata 0x00000000006c4db8 0x152 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x00000000006c4f0a 0x6 00 - .rodata 0x00000000006c4f10 0x250 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .rodata 0x00000000006c5160 0x415 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x00000000006c5575 0x3 00 - .rodata 0x00000000006c5578 0x373 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x00000000006c58eb 0x5 00 - .rodata 0x00000000006c58f0 0x39b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - *fill* 0x00000000006c5c8b 0x5 00 - .rodata 0x00000000006c5c90 0x1f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .rodata 0x00000000006c5e88 0x3c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .rodata 0x00000000006c6248 0x6d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - *fill* 0x00000000006c62b5 0xb 00 - .rodata 0x00000000006c62c0 0x280 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .rodata 0x00000000006c6540 0xd0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .rodata 0x00000000006c6610 0x2da /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - *fill* 0x00000000006c68ea 0x6 00 - .rodata 0x00000000006c68f0 0x4b0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .rodata 0x00000000006c6da0 0x300 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .rodata 0x00000000006c70a0 0x2db /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - *fill* 0x00000000006c737b 0x5 00 - .rodata 0x00000000006c7380 0x13f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - *fill* 0x00000000006c74bf 0x1 00 - .rodata.str1.8 - 0x00000000006c74c0 0xf0 xdrf_em64/libxdrf.a(libxdrf.o) - 0xe9 (size before relaxing) - .rodata.str1.1 - 0x00000000006c75b0 0x17 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006c75c7 0x1 00 - .rodata.cst8 0x00000000006c75c8 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - .rodata.cst4 0x00000000006c75d8 0xc xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006c75e4 0xc 00 - .rodata.cst16 0x00000000006c75f0 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - .rodata 0x00000000006c7600 0x124 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006c7724 0x4 00 - .rodata 0x00000000006c7728 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .rodata 0x00000000006c7740 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .rodata 0x00000000006c7750 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .rodata.str1.4 - 0x0000000000000000 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .rodata 0x00000000006c7760 0x48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .rodata.str1.4 - 0x00000000006c77a8 0x68 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - *fill* 0x00000000006c7810 0x10 00 - .rodata 0x00000000006c7820 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000006c79a0 for__dsc_itm_table - .rodata.str1.4 - 0x00000000006c7a20 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .rodata.str1.4 - 0x00000000006c7a30 0xec9 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0xee8 (size before relaxing) - *fill* 0x00000000006c88f9 0x7 00 - .rodata 0x00000000006c8900 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .rodata.str1.32 - 0x00000000006c8980 0x3bda /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x3c00 (size before relaxing) - *fill* 0x00000000006cc55a 0x2 00 - .rodata.str1.4 - 0x00000000006cc55c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x14 (size before relaxing) - *fill* 0x00000000006cc56f 0x1 00 - .rodata 0x00000000006cc570 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .rodata.str1.4 - 0x00000000006cc5a0 0x98 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0xa4 (size before relaxing) - *fill* 0x00000000006cc638 0x8 00 - .rodata 0x00000000006cc640 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .rodata.str1.32 - 0x00000000006cc7c0 0x1eea /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x1f00 (size before relaxing) - *fill* 0x00000000006ce6aa 0x2 00 - .rodata.str1.4 - 0x00000000006ce6ac 0x176 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x1a0 (size before relaxing) - *fill* 0x00000000006ce822 0x1e 00 - .rodata 0x00000000006ce840 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .rodata 0x00000000006cede0 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .rodata.str1.4 - 0x00000000006cf1a0 0x3 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x4 (size before relaxing) - *fill* 0x00000000006cf1a3 0x1 00 - .rodata.str1.4 - 0x00000000006cf1a4 0x5b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x5c (size before relaxing) - *fill* 0x00000000006cf1ff 0x1 00 - .rodata 0x00000000006cf200 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .rodata 0x00000000006cf780 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .rodata.str1.4 - 0x00000000006cf7e0 0x271 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x400 (size before relaxing) - *fill* 0x00000000006cfa51 0xf 00 - .rodata 0x00000000006cfa60 0x1980 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .rodata 0x00000000006d13e0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .rodata.str1.4 - 0x00000000006d13f0 0x2a /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x2c (size before relaxing) - *fill* 0x00000000006d141a 0x2 00 - .rodata.str1.32 - 0x00000000006d141c 0x34 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - *fill* 0x00000000006d1450 0x10 00 - .rodata 0x00000000006d1460 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .rodata.str1.4 - 0x00000000006d1680 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0xc (size before relaxing) - *fill* 0x00000000006d168a 0x16 00 - .rodata 0x00000000006d16a0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .rodata.str1.4 - 0x00000000006d1720 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x18 (size before relaxing) - *fill* 0x00000000006d172d 0x3 00 - .rodata.str1.4 - 0x00000000006d1730 0x2f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x38 (size before relaxing) - *fill* 0x00000000006d175f 0x1 00 - .rodata.str1.32 - 0x00000000006d1760 0x22 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006d1782 0x1e 00 - .rodata 0x00000000006d17a0 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .rodata.str1.4 - 0x00000000006d1a40 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x34 (size before relaxing) - *fill* 0x00000000006d1a6c 0x14 00 - .rodata 0x00000000006d1a80 0xa80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .rodata.str1.4 - 0x00000000006d2500 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006d250b 0x1 00 - .rodata.str1.4 - 0x00000000006d250c 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006d251b 0x5 00 - .rodata 0x00000000006d2520 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .rodata.str1.4 - 0x00000000006d2920 0x1d /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x28 (size before relaxing) - *fill* 0x00000000006d293d 0x3 00 - .rodata 0x00000000006d2940 0xd80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .rodata.str1.4 - 0x00000000006d36c0 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x14 (size before relaxing) - *fill* 0x00000000006d36cb 0x15 00 - .rodata 0x00000000006d36e0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .rodata.str1.4 - 0x00000000006d3860 0x29 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x3c (size before relaxing) - *fill* 0x00000000006d3889 0x3 00 - .rodata.str1.32 - 0x00000000006d388c 0x23 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006d38af 0x11 00 - .rodata 0x00000000006d38c0 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .rodata.str1.4 - 0x00000000006d3b00 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006d3b0b 0x15 00 - .rodata 0x00000000006d3b20 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .rodata.str1.4 - 0x00000000006d3dc0 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006d3dcf 0x11 00 - .rodata 0x00000000006d3de0 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .rodata.str1.4 - 0x00000000006d40e0 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x18 (size before relaxing) - *fill* 0x00000000006d40ef 0x11 00 - .rodata 0x00000000006d4100 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .rodata 0x00000000006d4420 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .rodata.str1.4 - 0x00000000006d4458 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x10 (size before relaxing) - *fill* 0x00000000006d4465 0x1b 00 - .rodata 0x00000000006d4480 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .rodata.str1.4 - 0x00000000006d4560 0xe /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x10 (size before relaxing) - *fill* 0x00000000006d456e 0x2 00 - .rodata 0x00000000006d4570 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - *fill* 0x00000000006d45d0 0x10 00 - .rodata.str1.32 - 0x00000000006d45e0 0xbdb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0xbe0 (size before relaxing) - *fill* 0x00000000006d51bb 0x1 00 - .rodata.str1.4 - 0x00000000006d51bc 0x16b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x198 (size before relaxing) - *fill* 0x00000000006d5327 0x1 00 - .rodata.str1.4 - 0x00000000006d5328 0xb2 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0xc4 (size before relaxing) - *fill* 0x00000000006d53da 0x6 00 - .rodata 0x00000000006d53e0 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .rodata.str1.4 - 0x00000000006d5500 0x6e /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006d556e 0x12 00 - .rodata 0x00000000006d5580 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .rodata 0x00000000006d59a0 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .rodata 0x00000000006d5ca0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .rodata 0x00000000006d5e80 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .rodata 0x00000000006d6060 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .rodata 0x00000000006d6240 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .rodata 0x00000000006d6600 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .rodata 0x00000000006d67e0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .rodata 0x00000000006d69c0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .rodata 0x00000000006d7320 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .rodata 0x00000000006d78c0 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .rodata.str1.4 - 0x00000000006d7ea0 0x1f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006d7ebf 0x1 00 - .rodata 0x00000000006d7ec0 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .rodata.str1.4 - 0x00000000006d81e0 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x10 (size before relaxing) - *fill* 0x00000000006d81ef 0x11 00 - .rodata 0x00000000006d8200 0x11a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .rodata 0x00000000006d93a0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .rodata.str1.4 - 0x00000000006d93e0 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0xc (size before relaxing) - *fill* 0x00000000006d93ea 0x16 00 - .rodata 0x00000000006d9400 0xb40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x00000000006d9960 for__b_fmt_table - 0x00000000006d99e0 for__fedg_fmt_table - 0x00000000006d9ac0 for__coerce_data_types - 0x00000000006d9ee0 for__i_fmt_table - 0x00000000006d9ef0 for__oz_fmt_table - .rodata.str1.4 - 0x00000000006d9f40 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - *fill* 0x00000000006d9f50 0x10 00 - .rodata 0x00000000006d9f60 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - 0x00000000006d9f60 for__wfs_table - 0x00000000006da060 for__wfs_msf_table - .rodata 0x00000000006da160 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - 0x00000000006da160 vax_c - 0x00000000006da1a0 ieee_t - 0x00000000006da210 ieee_s - 0x00000000006da248 ibm_s - 0x00000000006da264 ibm_l - 0x00000000006da29c cray - 0x00000000006da2d4 int_c - .rodata 0x00000000006da320 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .rodata.str1.4 - 0x00000000006da3a0 0x11 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x14 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x14 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - *fill* 0x00000000006da3b1 0xf 00 - .rodata 0x00000000006da3c0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .rodata 0x00000000006da400 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - *fill* 0x00000000006da450 0x10 00 - .rodata 0x00000000006da460 0x600 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .rodata 0x00000000006daa60 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .rodata 0x00000000006daad0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .rodata 0x00000000006dab50 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .rodata.str1.4 - 0x00000000006dab60 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata 0x00000000006dab70 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata 0x00000000006dab90 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata.str1.4 - 0x00000000006daba0 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x30 (size before relaxing) - *fill* 0x00000000006dabad 0x3 00 - .rodata 0x00000000006dabb0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata 0x00000000006dabc0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006dabd0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006dabe0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - 0x00000000006dabe0 cvtas_pten_word - 0x00000000006dac80 cvtas_globals_t - 0x00000000006dace0 cvtas_globals_x - 0x00000000006dad40 cvtas_globals_s - .rodata 0x00000000006dad60 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - 0x00000000006dad60 cvtas_pten_t - 0x00000000006db060 cvtas_tiny_pten_t - 0x00000000006db100 cvtas_tiny_pten_t_map - 0x00000000006db160 cvtas_huge_pten_t - 0x00000000006db1e0 cvtas_huge_pten_t_map - .rodata 0x00000000006db240 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - 0x00000000006db240 cvtas_pten_64 - 0x00000000006db540 cvtas_pten_64_bexp - 0x00000000006db600 cvtas_tiny_pten_64 - 0x00000000006db680 cvtas_tiny_pten_64_map - 0x00000000006db700 cvtas_huge_pten_64 - 0x00000000006db780 cvtas_huge_pten_64_map - 0x00000000006db7dc cvtas_tiny_pten_64_bexp - 0x00000000006db7fc cvtas_huge_pten_64_bexp - .rodata 0x00000000006db820 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - 0x00000000006db820 cvtas_pten_128 - 0x00000000006db9e0 cvtas_tiny_tiny_pten_128 - 0x00000000006dba20 cvtas_tiny_pten_128 - 0x00000000006dbac0 cvtas_tiny_pten_128_map - 0x00000000006dbb60 cvtas_huge_huge_pten_128 - 0x00000000006dbba0 cvtas_huge_pten_128 - 0x00000000006dbc40 cvtas_huge_pten_128_map - 0x00000000006dbcc8 cvtas_pten_128_bexp - 0x00000000006dbd00 cvtas_tiny_tiny_pten_128_bexp - 0x00000000006dbd08 cvtas_tiny_pten_128_bexp - 0x00000000006dbd1c cvtas_huge_huge_pten_128_bexp - 0x00000000006dbd24 cvtas_huge_pten_128_bexp - .rodata 0x00000000006dbd40 0x17e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .rodata 0x00000000006dd520 0x17c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .rodata 0x00000000006dece0 0xbc0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .rodata 0x00000000006df8a0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .rodata 0x00000000006df8b0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .rodata.str1.4 - 0x00000000006df8c0 0xcbb /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0xcc4 (size before relaxing) - *fill* 0x00000000006e057b 0x1 00 - .rodata.str1.32 - 0x00000000006e057c 0x10c /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .rodata 0x00000000006e0688 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x00000000006e0688 __libm_float_zero - 0x00000000006e0690 __libm_float_one - 0x00000000006e0698 __libm_float_inf - 0x00000000006e06a0 __libm_float_huge - 0x00000000006e06a8 __libm_double_zero - 0x00000000006e06b8 __libm_double_one - 0x00000000006e06c8 __libm_double_inf - 0x00000000006e06d8 __libm_double_huge - 0x00000000006e06e8 __libm_ldouble_zero - 0x00000000006e06f8 __libm_ldouble_neg_zero - 0x00000000006e0708 __libm_ldouble_one - 0x00000000006e0718 __libm_ldouble_neg_one - 0x00000000006e0728 __libm_ldouble_inf - 0x00000000006e0738 __libm_ldouble_neg_inf - 0x00000000006e0748 __libm_ldouble_huge - 0x00000000006e0758 __libm_ldouble_neg_huge - *fill* 0x00000000006e0768 0x18 00 - .rodata 0x00000000006e0780 0x11c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .rodata 0x00000000006e1940 0x780 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .rodata 0x00000000006e20c0 0xc80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .rodata 0x00000000006e2d40 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .rodata 0x00000000006e3680 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .rodata 0x00000000006e3fc0 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .rodata 0x00000000006e4900 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .rodata 0x00000000006e5160 0xd0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - *fill* 0x00000000006e5230 0x10 00 - .rodata 0x00000000006e5240 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .rodata 0x00000000006e5720 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .rodata 0x00000000006e5f40 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .rodata 0x00000000006e6760 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .rodata 0x00000000006e6c40 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - 0x00000000006e6c40 __libm_exp_hi_table_64 - 0x00000000006e6e60 __libm_exp_mi_table_64 - 0x00000000006e7080 __libm_exp_lo_table_64 - 0x00000000006e72a0 __libm_exp_table_128 - .rodata 0x00000000006e7ac0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .rodata 0x00000000006e7af8 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - *fill* 0x00000000006e7b08 0x18 00 - .rodata 0x00000000006e7b20 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .rodata 0x00000000006e7d60 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .rodata 0x00000000006e7d80 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .rodata 0x00000000006e7da0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .rodata 0x00000000006e7dc0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .rodata 0x00000000006e7de0 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .rodata 0x00000000006e8660 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .rodata 0x00000000006e8ee0 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .rodata 0x00000000006e9740 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .rodata 0x00000000006e9f60 0x58 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - *fill* 0x00000000006e9fb8 0x8 00 - .rodata 0x00000000006e9fc0 0x800 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - 0x00000000006e9fc0 __libm_logf_table_256 - .rodata 0x00000000006ea7c0 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .rodata 0x00000000006eb020 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .rodata 0x00000000006eb040 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .rodata 0x00000000006eb060 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .rodata 0x00000000006eb080 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .rodata 0x00000000006eb0a0 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .rodata 0x00000000006ee3a0 0x3a60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .rodata 0x00000000006f1e00 0xc00 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - 0x00000000006f1e00 __libm_rcp_table_256 - 0x00000000006f2200 __libm_double_rcp_table_256 - .rodata 0x00000000006f2a00 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .rodata 0x00000000006f3360 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .rodata 0x00000000006f3cc0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .rodata 0x00000000006f4620 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .rodata 0x00000000006f5dc0 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .rodata 0x00000000006f7560 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .rodata 0x00000000006f7580 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .rodata 0x00000000006f75a0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .rodata 0x00000000006f8100 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .rodata 0x00000000006f8c60 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .rodata 0x00000000006f97c0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .rodata 0x00000000006fa320 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .rodata 0x00000000006fae80 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .rodata 0x00000000006fb9e0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .rodata 0x00000000006fc540 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .rodata 0x00000000006fd0a0 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .rodata 0x00000000006fd0b8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .rodata.str1.32 - 0x00000000006fd0e0 0x158 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x160 (size before relaxing) - .rodata.str1.4 - 0x00000000006fd238 0x1e /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x28 (size before relaxing) - *fill* 0x00000000006fd256 0x2 00 - .rodata.str1.4 - 0x00000000006fd258 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x3c (size before relaxing) - .rodata 0x00000000006fd284 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - *fill* 0x00000000006fd28c 0x4 00 - .rodata 0x00000000006fd290 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .rodata 0x00000000006fd320 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .rodata.str1.4 - 0x00000000006fd3b0 0x18c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x1b0 (size before relaxing) - *fill* 0x00000000006fd53c 0x4 00 - .rodata.str1.32 - 0x00000000006fd540 0x6a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .rodata 0x00000000006fdbe0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.rodata1 - *(.rodata1) - -.eh_frame_hdr 0x00000000006fdc00 0x34c4 - *(.eh_frame_hdr) - .eh_frame_hdr 0x00000000006fdc00 0x34c4 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - -.eh_frame 0x00000000007010c8 0x4086c - *(.eh_frame) - .eh_frame 0x00000000007010c8 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .eh_frame 0x0000000000701138 0x5a8 unres.o - .eh_frame 0x00000000007016e0 0x38 arcos.o - 0x50 (size before relaxing) - .eh_frame 0x0000000000701718 0x90 cartprint.o - 0xa8 (size before relaxing) - .eh_frame 0x00000000007017a8 0x1b0 chainbuild.o - 0x1c8 (size before relaxing) - .eh_frame 0x0000000000701958 0x2f8 convert.o - 0x310 (size before relaxing) - .eh_frame 0x0000000000701c50 0x5e8 initialize_p.o - 0x600 (size before relaxing) - .eh_frame 0x0000000000702238 0x18 matmult.o - 0x30 (size before relaxing) - .eh_frame 0x0000000000702250 0xfa8 readrtns_CSA.o - 0xfc0 (size before relaxing) - .eh_frame 0x00000000007031f8 0x148 parmread.o - 0x160 (size before relaxing) - .eh_frame 0x0000000000703340 0xbc8 gen_rand_conf.o - 0xbe0 (size before relaxing) - .eh_frame 0x0000000000703f08 0xa0 printmat.o - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703fa8 0xc0 map.o - 0xd8 (size before relaxing) - .eh_frame 0x0000000000704068 0x18 pinorm.o - 0x30 (size before relaxing) - .eh_frame 0x0000000000704080 0xb0 randgens.o - 0xc8 (size before relaxing) - .eh_frame 0x0000000000704130 0xa0 rescode.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000007041d0 0x68 intcor.o - 0x80 (size before relaxing) - .eh_frame 0x0000000000704238 0x198 timing.o - 0x1b0 (size before relaxing) - .eh_frame 0x00000000007043d0 0x488 misc.o - 0x4a0 (size before relaxing) - .eh_frame 0x0000000000704858 0x5a0 intlocal.o - 0x5b8 (size before relaxing) - .eh_frame 0x0000000000704df8 0xa8 cartder.o - 0xc0 (size before relaxing) - .eh_frame 0x0000000000704ea0 0x388 checkder_p.o - 0x3a0 (size before relaxing) - .eh_frame 0x0000000000705228 0xb0 econstr_local.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000007052d8 0x2388 energy_p_new_barrier.o - 0x23a0 (size before relaxing) - .eh_frame 0x0000000000707660 0xa60 energy_p_new-sep_barrier.o - 0xa78 (size before relaxing) - .eh_frame 0x00000000007080c0 0x258 gradient_p.o - 0x270 (size before relaxing) - .eh_frame 0x0000000000708318 0x488 minimize_p.o - 0x4a0 (size before relaxing) - .eh_frame 0x00000000007087a0 0x658 sumsld.o - 0x670 (size before relaxing) - .eh_frame 0x0000000000708df8 0x480 cored.o - 0x498 (size before relaxing) - .eh_frame 0x0000000000709278 0x30 rmdd.o - 0x48 (size before relaxing) - .eh_frame 0x00000000007092a8 0x408 geomout.o - 0x420 (size before relaxing) - .eh_frame 0x00000000007096b0 0x120 readpdb.o - 0x138 (size before relaxing) - .eh_frame 0x00000000007097d0 0xc0 regularize.o - 0xd8 (size before relaxing) - .eh_frame 0x0000000000709890 0x4b0 thread.o - 0x4c8 (size before relaxing) - .eh_frame 0x0000000000709d40 0x318 fitsq.o - 0x330 (size before relaxing) - .eh_frame 0x000000000070a058 0x8c0 mcm.o - 0x8d8 (size before relaxing) - .eh_frame 0x000000000070a918 0x3c8 mc.o - 0x3e0 (size before relaxing) - .eh_frame 0x000000000070ace0 0xa8 bond_move.o - 0xc0 (size before relaxing) - .eh_frame 0x000000000070ad88 0x110 refsys.o - 0x128 (size before relaxing) - .eh_frame 0x000000000070ae98 0x40 check_sc_distr.o - 0x58 (size before relaxing) - .eh_frame 0x000000000070aed8 0x68 check_bond.o - 0x80 (size before relaxing) - .eh_frame 0x000000000070af40 0x250 contact.o - 0x268 (size before relaxing) - .eh_frame 0x000000000070b190 0xc0 djacob.o - 0xd8 (size before relaxing) - .eh_frame 0x000000000070b250 0xea8 eigen.o - 0xec0 (size before relaxing) - .eh_frame 0x000000000070c0f8 0x520 blas.o - 0x538 (size before relaxing) - .eh_frame 0x000000000070c618 0x60 add.o - 0x78 (size before relaxing) - .eh_frame 0x000000000070c678 0x380 entmcm.o - 0x398 (size before relaxing) - .eh_frame 0x000000000070c9f8 0xe0 minim_mcmf.o - 0xf8 (size before relaxing) - .eh_frame 0x000000000070cad8 0xb90 together.o - 0xba8 (size before relaxing) - .eh_frame 0x000000000070d668 0x3d0 csa.o - 0x3e8 (size before relaxing) - .eh_frame 0x000000000070da38 0x310 minim_jlee.o - 0x328 (size before relaxing) - .eh_frame 0x000000000070dd48 0xd8 shift.o - 0xf0 (size before relaxing) - .eh_frame 0x000000000070de20 0x78 diff12.o - 0x90 (size before relaxing) - .eh_frame 0x000000000070de98 0xa50 bank.o - 0xa68 (size before relaxing) - .eh_frame 0x000000000070e8e8 0x790 newconf.o - 0x7a8 (size before relaxing) - .eh_frame 0x000000000070f078 0x60 ran.o - 0x78 (size before relaxing) - .eh_frame 0x000000000070f0d8 0xb0 indexx.o - 0xc8 (size before relaxing) - .eh_frame 0x000000000070f188 0x480 MP.o - 0x498 (size before relaxing) - .eh_frame 0x000000000070f608 0x358 compare_s1.o - 0x370 (size before relaxing) - .eh_frame 0x000000000070f960 0x128 prng_32.o - 0x140 (size before relaxing) - .eh_frame 0x000000000070fa88 0x928 test.o - 0x940 (size before relaxing) - .eh_frame 0x00000000007103b0 0x2a0 banach.o - 0x2b8 (size before relaxing) - .eh_frame 0x0000000000710650 0x3a0 distfit.o - 0x3b8 (size before relaxing) - .eh_frame 0x00000000007109f0 0x248 rmsd.o - 0x260 (size before relaxing) - .eh_frame 0x0000000000710c38 0x1b8 elecont.o - 0x1d0 (size before relaxing) - .eh_frame 0x0000000000710df0 0x268 dihed_cons.o - 0x280 (size before relaxing) - .eh_frame 0x0000000000711058 0x4c0 sc_move.o - 0x4d8 (size before relaxing) - .eh_frame 0x0000000000711518 0x538 local_move.o - 0x550 (size before relaxing) - .eh_frame 0x0000000000711a50 0x190 intcartderiv.o - 0x1a8 (size before relaxing) - .eh_frame 0x0000000000711be0 0x288 /tmp/ipo_ifortx3jrsv.o - 0x2a0 (size before relaxing) - .eh_frame 0x0000000000711e68 0x298 stochfric.o - 0x2b0 (size before relaxing) - .eh_frame 0x0000000000712100 0x68 kinetic_lesyng.o - 0x80 (size before relaxing) - .eh_frame 0x0000000000712168 0x9f8 MD_A-MTS.o - 0xa10 (size before relaxing) - .eh_frame 0x0000000000712b60 0x1b0 moments.o - 0x1c8 (size before relaxing) - .eh_frame 0x0000000000712d10 0xb0 int_to_cart.o - 0xc8 (size before relaxing) - .eh_frame 0x0000000000712dc0 0x140 surfatom.o - 0x158 (size before relaxing) - .eh_frame 0x0000000000712f00 0x4b0 sort.o - 0x4c8 (size before relaxing) - .eh_frame 0x00000000007133b0 0x598 muca_md.o - 0x5b0 (size before relaxing) - .eh_frame 0x0000000000713948 0x420 MREMD.o - 0x438 (size before relaxing) - .eh_frame 0x0000000000713d68 0x78 rattle.o - 0x90 (size before relaxing) - .eh_frame 0x0000000000713de0 0x1c8 gauss.o - 0x1e0 (size before relaxing) - .eh_frame 0x0000000000713fa8 0xa0 energy_split-sep.o - 0xb8 (size before relaxing) - .eh_frame 0x0000000000714048 0x3c0 q_measure.o - 0x3d8 (size before relaxing) - .eh_frame 0x0000000000714408 0xa0 gnmr1.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000007144a8 0x80 proc_proc.o - 0x98 (size before relaxing) - .eh_frame 0x0000000000714528 0x40 cinfo.o - 0x58 (size before relaxing) - .eh_frame 0x0000000000714568 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .eh_frame 0x00000000007145a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007145c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007145e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714600 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714620 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714640 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714660 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714680 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007146a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007146c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007146e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714700 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714720 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714740 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714760 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714780 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007147a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007147c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007147e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714800 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714820 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714840 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714860 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714880 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007148a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007148c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007148e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714900 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714920 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714940 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714960 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714980 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007149a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007149c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007149e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714a00 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714a20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714a40 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000714aa0 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000714b60 0x48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x60 (size before relaxing) - .eh_frame 0x0000000000714ba8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714bc8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714be8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714c08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714c28 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000714cc8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714ce8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714d08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714d28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714d48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714d68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714d88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714da8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714dc8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714de8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714e08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714e28 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000714f08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714f28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714f48 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000714fa8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714fc8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000714fe8 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000715088 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007150a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007150c8 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0xf8 (size before relaxing) - .eh_frame 0x00000000007151a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007151c8 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000715308 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000715448 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000715508 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715528 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715548 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000715688 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007156a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007156c8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007156e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715708 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000715808 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715828 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715848 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715868 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715888 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007158c8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007158e8 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000715a08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715a28 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000715a68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715a88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715aa8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715ac8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715ae8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715b08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715b28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715b48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715b68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715b88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715ba8 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000715d28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715d48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000715d68 0x1e0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x1f8 (size before relaxing) - .eh_frame 0x0000000000715f48 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x1b8 (size before relaxing) - .eh_frame 0x00000000007160e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000716108 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0xd8 (size before relaxing) - .eh_frame 0x00000000007161c8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007161e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000716208 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000716248 0x400 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x418 (size before relaxing) - .eh_frame 0x0000000000716648 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000716728 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000716788 0x2e8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x300 (size before relaxing) - .eh_frame 0x0000000000716a70 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000716b10 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000716bb0 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x1d8 (size before relaxing) - .eh_frame 0x0000000000716d70 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000716e70 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000716f50 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000716f90 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000717030 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0xb8 (size before relaxing) - .eh_frame 0x00000000007170d0 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x138 (size before relaxing) - .eh_frame 0x00000000007171f0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000717230 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000717270 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007172b0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000717350 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x98 (size before relaxing) - .eh_frame 0x00000000007173d0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000717410 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000717610 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x238 (size before relaxing) - .eh_frame 0x0000000000717830 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x98 (size before relaxing) - .eh_frame 0x00000000007178b0 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000717990 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007179d0 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000717b10 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000717b70 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000717cb0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717cd0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000717d70 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000717df0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717e10 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717e30 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717e50 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717e70 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717e90 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717eb0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717ed0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717ef0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717f10 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717f30 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717f50 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717f70 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717f90 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000717fb0 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x138 (size before relaxing) - .eh_frame 0x00000000007180d0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007180f0 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x118 (size before relaxing) - .eh_frame 0x00000000007181f0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000718290 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000718310 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000718490 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000718610 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000718670 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000718870 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000718a70 0x2c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x2d8 (size before relaxing) - .eh_frame 0x0000000000718d30 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000718d70 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000718db0 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000718ed0 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x1b8 (size before relaxing) - .eh_frame 0x0000000000719070 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000719090 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000719170 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000719230 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000719290 0x358 xdrf_em64/libxdrf.a(libxdrf.o) - 0x370 (size before relaxing) - .eh_frame 0x00000000007195e8 0x30 xdrf_em64/libxdrf.a(ftocstr.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000719618 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0xf0 (size before relaxing) - .eh_frame 0x00000000007196f0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x68 (size before relaxing) - .eh_frame 0x0000000000719740 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000719768 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000719888 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x68 (size before relaxing) - .eh_frame 0x00000000007198d8 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x100 (size before relaxing) - .eh_frame 0x00000000007199c0 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x90 (size before relaxing) - .eh_frame 0x0000000000719a38 0x5f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x608 (size before relaxing) - .eh_frame 0x000000000071a028 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x138 (size before relaxing) - .eh_frame 0x000000000071a148 0x458 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x470 (size before relaxing) - .eh_frame 0x000000000071a5a0 0x788 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x7a0 (size before relaxing) - .eh_frame 0x000000000071ad28 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0xa8 (size before relaxing) - .eh_frame 0x000000000071adb8 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x88 (size before relaxing) - .eh_frame 0x000000000071ae28 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x268 (size before relaxing) - .eh_frame 0x000000000071b078 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x300 (size before relaxing) - .eh_frame 0x000000000071b360 0x9d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x9e8 (size before relaxing) - .eh_frame 0x000000000071bd30 0x340 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x358 (size before relaxing) - .eh_frame 0x000000000071c070 0x620 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x638 (size before relaxing) - .eh_frame 0x000000000071c690 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x168 (size before relaxing) - .eh_frame 0x000000000071c7e0 0x1cd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x1ce8 (size before relaxing) - .eh_frame 0x000000000071e4b0 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x100 (size before relaxing) - .eh_frame 0x000000000071e598 0x4d8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x4f0 (size before relaxing) - .eh_frame 0x000000000071ea70 0x258 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x270 (size before relaxing) - .eh_frame 0x000000000071ecc8 0xa48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0xa60 (size before relaxing) - .eh_frame 0x000000000071f710 0x1680 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x1698 (size before relaxing) - .eh_frame 0x0000000000720d90 0x1200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x1218 (size before relaxing) - .eh_frame 0x0000000000721f90 0x19f8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x1a10 (size before relaxing) - .eh_frame 0x0000000000723988 0x2028 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x2040 (size before relaxing) - .eh_frame 0x00000000007259b0 0x1880 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x1898 (size before relaxing) - .eh_frame 0x0000000000727230 0x568 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x580 (size before relaxing) - .eh_frame 0x0000000000727798 0x668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x680 (size before relaxing) - .eh_frame 0x0000000000727e00 0x1668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x1680 (size before relaxing) - .eh_frame 0x0000000000729468 0x24e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x2500 (size before relaxing) - .eh_frame 0x000000000072b950 0x2150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x2168 (size before relaxing) - .eh_frame 0x000000000072daa0 0x2a08 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x2a20 (size before relaxing) - .eh_frame 0x00000000007304a8 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x1d8 (size before relaxing) - .eh_frame 0x0000000000730668 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x300 (size before relaxing) - .eh_frame 0x0000000000730950 0x470 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x488 (size before relaxing) - .eh_frame 0x0000000000730dc0 0xc60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0xc78 (size before relaxing) - .eh_frame 0x0000000000731a20 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x318 (size before relaxing) - .eh_frame 0x0000000000731d20 0xf8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x110 (size before relaxing) - .eh_frame 0x0000000000731e18 0x1700 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x1718 (size before relaxing) - .eh_frame 0x0000000000733518 0x1b20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x1b38 (size before relaxing) - .eh_frame 0x0000000000735038 0x1b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x1c8 (size before relaxing) - .eh_frame 0x00000000007351e8 0x3c8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x3e0 (size before relaxing) - .eh_frame 0x00000000007355b0 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000735718 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000735880 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x180 (size before relaxing) - .eh_frame 0x00000000007359e8 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x398 (size before relaxing) - .eh_frame 0x0000000000735d68 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x1a8 (size before relaxing) - .eh_frame 0x0000000000735ef8 0x1e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x200 (size before relaxing) - .eh_frame 0x00000000007360e0 0xa18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0xa30 (size before relaxing) - .eh_frame 0x0000000000736af8 0x518 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x530 (size before relaxing) - .eh_frame 0x0000000000737010 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000737118 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000737148 0x1b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x1b88 (size before relaxing) - .eh_frame 0x0000000000738cb8 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x308 (size before relaxing) - .eh_frame 0x0000000000738fa8 0x6d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x6e8 (size before relaxing) - .eh_frame 0x0000000000739678 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000739780 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x318 (size before relaxing) - .eh_frame 0x0000000000739a80 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000739c80 0x310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x328 (size before relaxing) - .eh_frame 0x0000000000739f90 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x2a0 (size before relaxing) - .eh_frame 0x000000000073a218 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x2a0 (size before relaxing) - .eh_frame 0x000000000073a4a0 0x130 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x148 (size before relaxing) - .eh_frame 0x000000000073a5d0 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x590 (size before relaxing) - .eh_frame 0x000000000073ab48 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x590 (size before relaxing) - .eh_frame 0x000000000073b0c0 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x538 (size before relaxing) - .eh_frame 0x000000000073b5e0 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x150 (size before relaxing) - .eh_frame 0x000000000073b718 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x150 (size before relaxing) - .eh_frame 0x000000000073b850 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x000000000073b928 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x000000000073ba00 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x48 (size before relaxing) - .eh_frame 0x000000000073ba30 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073ba48 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x150 (size before relaxing) - .eh_frame 0x000000000073bb80 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x000000000073bc58 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x48 (size before relaxing) - .eh_frame 0x000000000073bc88 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073bcb0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073bcd8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073bd00 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073bd18 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x48 (size before relaxing) - .eh_frame 0x000000000073bd48 0x1fa8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x1fc0 (size before relaxing) - .eh_frame 0x000000000073dcf0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073dd18 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073dd30 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073dd48 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073dd60 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073dd88 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073dda0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073ddc8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073dde0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073de18 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073de50 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073de88 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073deb0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073df68 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073df90 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073dfb8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073dfe0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e008 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e030 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073e0e8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073e100 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e128 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e150 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000073e1b0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000073e210 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e238 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e260 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e288 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e2b0 0x88 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0xa0 (size before relaxing) - .eh_frame 0x000000000073e338 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e360 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e388 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e3b0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000073e410 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000073e470 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e498 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073e4c0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073e4f8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073e530 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073e568 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073e5a0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000073e5d8 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000073e5f8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073e610 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000073e630 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000073e6a8 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000073e720 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073e7d8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073e890 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073e948 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073ea00 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073eab8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073eb70 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073ec28 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000073ece0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000073ed40 0x100 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x118 (size before relaxing) - .eh_frame 0x000000000073ee40 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073ee68 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000073ee90 0x328 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x340 (size before relaxing) - .eh_frame 0x000000000073f1b8 0x830 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x848 (size before relaxing) - .eh_frame 0x000000000073f9e8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000073fa00 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000073fa20 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000073fa70 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000073fac0 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x878 (size before relaxing) - .eh_frame 0x0000000000740320 0x680 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x698 (size before relaxing) - .eh_frame 0x00000000007409a0 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0xa48 (size before relaxing) - .eh_frame 0x00000000007413d0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000741400 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x178 (size before relaxing) - .eh_frame 0x0000000000741560 0x390 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x3a8 (size before relaxing) - .eh_frame 0x00000000007418f0 0x40 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x58 (size before relaxing) - .eh_frame 0x0000000000741930 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - 0x0000000000741934 . = (ALIGN (0x200000) - ((0x200000 - .) & 0x1fffff)) - 0x0000000000942000 . = (0x200000 DATA_SEGMENT_ALIGN 0x1000) - -.eh_frame - *(.eh_frame) - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - -.tdata - *(.tdata .tdata.* .gnu.linkonce.td.*) - -.tbss - *(.tbss .tbss.* .gnu.linkonce.tb.*) - *(.tcommon) - -.preinit_array 0x0000000000942000 0x0 - 0x0000000000942000 PROVIDE (__preinit_array_start, .) - *(.preinit_array) - 0x0000000000942000 PROVIDE (__preinit_array_end, .) - -.init_array 0x0000000000942000 0x0 - 0x0000000000942000 PROVIDE (__init_array_start, .) - *(SORT(.init_array.*)) - *(.init_array) - 0x0000000000942000 PROVIDE (__init_array_end, .) - -.fini_array 0x0000000000942000 0x0 - 0x0000000000942000 PROVIDE (__fini_array_start, .) - *(.fini_array) - *(SORT(.fini_array.*)) - 0x0000000000942000 PROVIDE (__fini_array_end, .) - -.ctors 0x0000000000942000 0x10 - *crtbegin.o(.ctors) - .ctors 0x0000000000942000 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.ctors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .ctors) - *(SORT(.ctors.*)) - *(.ctors) - .ctors 0x0000000000942008 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.dtors 0x0000000000942010 0x10 - *crtbegin.o(.dtors) - .dtors 0x0000000000942010 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.dtors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .dtors) - *(SORT(.dtors.*)) - *(.dtors) - .dtors 0x0000000000942018 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - 0x0000000000942018 __DTOR_END__ - -.jcr 0x0000000000942020 0x8 - *(.jcr) - .jcr 0x0000000000942020 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .jcr 0x0000000000942020 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.data.rel.ro - *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) - *(.data.rel.ro* .gnu.linkonce.d.rel.ro.*) - -.dynamic 0x0000000000942028 0x1d0 - *(.dynamic) - .dynamic 0x0000000000942028 0x1d0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000942028 _DYNAMIC - -.got 0x00000000009421f8 0x1c8 - *(.got) - .got 0x00000000009421f8 0x1c8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.igot) - 0x00000000009423c0 . = (. DATA_SEGMENT_RELRO_END 0x18) - -.got.plt 0x00000000009423c0 0x570 - *(.got.plt) - .got.plt 0x00000000009423c0 0x570 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x00000000009423c0 _GLOBAL_OFFSET_TABLE_ - *(.igot.plt) - .igot.plt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.data 0x0000000000942940 0x1a360 - *(.data .data.* .gnu.linkonce.d.*) - .data 0x0000000000942940 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000942940 data_start - 0x0000000000942940 __data_start - .data 0x0000000000942944 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .data 0x0000000000942944 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x0000000000942944 0x1c 00 - .data 0x0000000000942960 0x760 unres.o - .data 0x00000000009430c0 0x5220 initialize_p.o - 0x00000000009432c0 moveid_ - 0x0000000000943340 langevin_ - 0x0000000000948070 potentials_ - 0x0000000000948080 names_ - 0x00000000009480e0 namterm_ - .data 0x00000000009482e0 0x1540 readrtns_CSA.o - .data 0x0000000000949820 0xbc0 parmread.o - .data 0x000000000094a3e0 0x460 gen_rand_conf.o - .data 0x000000000094a840 0xa0 map.o - .data 0x000000000094a8e0 0x60 rescode.o - .data 0x000000000094a940 0x180 timing.o - .data 0x000000000094aac0 0x18 misc.o - *fill* 0x000000000094aad8 0x8 00 - .data 0x000000000094aae0 0x6a0 checkder_p.o - .data 0x000000000094b180 0xf80 energy_p_new_barrier.o - .data 0x000000000094c100 0x340 energy_p_new-sep_barrier.o - .data 0x000000000094c440 0x11a0 cored.o - .data 0x000000000094d5e0 0x30 rmdd.o - *fill* 0x000000000094d610 0x10 00 - .data 0x000000000094d620 0xae0 geomout.o - .data 0x000000000094e100 0x1e0 readpdb.o - .data 0x000000000094e2e0 0x100 regularize.o - .data 0x000000000094e3e0 0x500 thread.o - .data 0x000000000094e8e0 0x9c0 mcm.o - .data 0x000000000094f2a0 0x660 mc.o - .data 0x000000000094f900 0x160 bond_move.o - .data 0x000000000094fa60 0x120 contact.o - .data 0x000000000094fb80 0x4a0 eigen.o - .data 0x0000000000950020 0x740 entmcm.o - .data 0x0000000000950760 0x580 together.o - .data 0x0000000000950ce0 0x34 csa.o - *fill* 0x0000000000950d14 0xc 00 - .data 0x0000000000950d20 0x380 minim_jlee.o - .data 0x00000000009510a0 0x1220 bank.o - .data 0x00000000009522c0 0xe0 newconf.o - .data 0x00000000009523a0 0x4 ran.o - *fill* 0x00000000009523a4 0x1c 00 - .data 0x00000000009523c0 0x1c0 MP.o - .data 0x0000000000952580 0x100 compare_s1.o - .data 0x0000000000952680 0x3fe0 prng_32.o - 0x0000000000952680 ksrprng_ - .data 0x0000000000956660 0xce0 test.o - .data 0x0000000000957340 0x160 rmsd.o - .data 0x00000000009574a0 0x640 elecont.o - .data 0x0000000000957ae0 0x1a0 dihed_cons.o - .data 0x0000000000957c80 0x38 sc_move.o - .data 0x0000000000957cb8 0x28 local_move.o - .data 0x0000000000957ce0 0x280 intcartderiv.o - .data 0x0000000000957f60 0x80 stochfric.o - .data 0x0000000000957fe0 0x820 MD_A-MTS.o - .data 0x0000000000958800 0x160 surfatom.o - .data 0x0000000000958960 0x400 MREMD.o - .data 0x0000000000958d60 0x20 q_measure.o - .data 0x0000000000958d80 0x0 proc_proc.o - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .data 0x0000000000958d80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .data 0x0000000000958d80 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - *fill* 0x0000000000958d91 0x3 00 - .data 0x0000000000958d94 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .data 0x0000000000958d94 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .data 0x0000000000958d94 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000000958d94 MPIR_F_TRUE - .data 0x0000000000958da0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .data 0x0000000000958da0 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - *fill* 0x0000000000958daa 0x2 00 - .data 0x0000000000958dac 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - *fill* 0x0000000000958db6 0x2 00 - .data 0x0000000000958db8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .data 0x0000000000958db8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .data 0x0000000000958db8 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - *fill* 0x0000000000958dc2 0x2 00 - .data 0x0000000000958dc4 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .data 0x0000000000958dd0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - *fill* 0x0000000000958dd9 0x3 00 - .data 0x0000000000958ddc 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - *fill* 0x0000000000958de5 0x3 00 - .data 0x0000000000958de8 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - *fill* 0x0000000000958df3 0x1 00 - .data 0x0000000000958df4 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .data 0x0000000000958e00 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - *fill* 0x0000000000958e0e 0x2 00 - .data 0x0000000000958e10 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - *fill* 0x0000000000958e1b 0x5 00 - .data 0x0000000000958e20 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .data 0x0000000000958e30 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - *fill* 0x0000000000958e44 0xc 00 - .data 0x0000000000958e50 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - *fill* 0x0000000000958e61 0x3 00 - .data 0x0000000000958e64 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - *fill* 0x0000000000958e72 0x2 00 - .data 0x0000000000958e74 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x0000000000958e7e 0x2 00 - .data 0x0000000000958e80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .data 0x0000000000958e80 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - *fill* 0x0000000000958e89 0x3 00 - .data 0x0000000000958e8c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .data 0x0000000000958e8c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .data 0x0000000000958e8c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - *fill* 0x0000000000958e8c 0x4 00 - .data 0x0000000000958e90 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .data 0x0000000000958ea4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x0000000000958ea4 0x1c 00 - .data 0x0000000000958ec0 0xce4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .data 0x0000000000959ba4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .data 0x0000000000959ba4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - *fill* 0x0000000000959ba4 0x1c 00 - .data 0x0000000000959bc0 0xf8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .data 0x0000000000959cb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - *fill* 0x0000000000959cb8 0x8 00 - .data 0x0000000000959cc0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .data 0x0000000000959cd0 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x0000000000959cdd 0x3 00 - .data 0x0000000000959ce0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .data 0x0000000000959ce0 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - *fill* 0x0000000000959ced 0x3 00 - .data 0x0000000000959cf0 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - *fill* 0x0000000000959cff 0x1 00 - .data 0x0000000000959d00 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - *fill* 0x0000000000959d0f 0x1 00 - .data 0x0000000000959d10 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - *fill* 0x0000000000959d1f 0x1 00 - .data 0x0000000000959d20 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .data 0x0000000000959d20 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - *fill* 0x0000000000959d2e 0x2 00 - .data 0x0000000000959d30 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - *fill* 0x0000000000959d3f 0x1 00 - .data 0x0000000000959d40 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .data 0x0000000000959d50 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - *fill* 0x0000000000959d5e 0x2 00 - .data 0x0000000000959d60 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .data 0x0000000000959d60 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x0000000000959d6e 0x2 00 - .data 0x0000000000959d70 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .data 0x0000000000959d70 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - *fill* 0x0000000000959d7f 0x1 00 - .data 0x0000000000959d80 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - *fill* 0x0000000000959d84 0xc 00 - .data 0x0000000000959d90 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - *fill* 0x0000000000959daa 0x2 00 - .data 0x0000000000959dac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .data 0x0000000000959dac 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .data 0x0000000000959db8 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - *fill* 0x0000000000959dc2 0x2 00 - .data 0x0000000000959dc4 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - *fill* 0x0000000000959dcf 0x1 00 - .data 0x0000000000959dd0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .data 0x0000000000959ddc 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - *fill* 0x0000000000959de9 0x3 00 - .data 0x0000000000959dec 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - *fill* 0x0000000000959dfa 0x2 00 - .data 0x0000000000959dfc 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - *fill* 0x0000000000959e07 0x1 00 - .data 0x0000000000959e08 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x0000000000959e16 0x2 00 - .data 0x0000000000959e18 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .data 0x0000000000959e18 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .data 0x0000000000959e24 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - *fill* 0x0000000000959e24 0x1c 00 - .data 0x0000000000959e40 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x0000000000959ec0 MPIR_inter_collops - *fill* 0x0000000000959ec8 0x18 00 - .data 0x0000000000959ee0 0x103 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x0000000000959f60 MPIR_intra_collops - *fill* 0x0000000000959fe3 0x1 00 - .data 0x0000000000959fe4 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - *fill* 0x0000000000959fed 0x3 00 - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .data 0x0000000000959ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .data 0x0000000000959ff0 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .data 0x000000000095a004 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .data 0x000000000095a008 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .data 0x000000000095a00c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .data 0x000000000095a00c 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .data 0x000000000095a010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .data 0x000000000095a010 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .data 0x000000000095a014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .data 0x000000000095a014 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - *fill* 0x000000000095a01f 0x1 00 - .data 0x000000000095a020 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - *fill* 0x000000000095a02d 0x3 00 - .data 0x000000000095a030 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .data 0x000000000095a040 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - *fill* 0x000000000095a04e 0x2 00 - .data 0x000000000095a050 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - *fill* 0x000000000095a062 0x2 00 - .data 0x000000000095a064 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .data 0x000000000095a070 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - *fill* 0x000000000095a07e 0x2 00 - .data 0x000000000095a080 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .data 0x000000000095a090 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x000000000095a09e 0x2 00 - .data 0x000000000095a0a0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - *fill* 0x000000000095a0a9 0x3 00 - .data 0x000000000095a0ac 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x000000000095a0b7 0x1 00 - .data 0x000000000095a0b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - *fill* 0x000000000095a0b8 0x8 00 - .data 0x000000000095a0c0 0x13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - *fill* 0x000000000095a0d3 0x1 00 - .data 0x000000000095a0d4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .data 0x000000000095a0d4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .data 0x000000000095a0d4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .data 0x000000000095a0d4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .data 0x000000000095a0d4 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x000000000095a0d4 p4_hard_errors - .data 0x000000000095a0d8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x000000000095a0d8 0x8 00 - .data 0x000000000095a0e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .data 0x000000000095a100 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .data 0x000000000095a100 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .data 0x000000000095a100 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .data 0x000000000095a104 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .data 0x000000000095a104 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .data 0x000000000095a104 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .data 0x000000000095a104 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .data 0x000000000095a104 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .data 0x000000000095a104 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .data 0x000000000095a108 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .data 0x000000000095a108 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .data 0x000000000095a108 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .data 0x000000000095a108 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .data 0x000000000095a108 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .data 0x000000000095a108 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .data 0x000000000095a108 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x000000000095a110 0x10 00 - .data 0x000000000095a120 0x1c20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .data 0x000000000095bd40 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .data 0x000000000095bd40 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x000000000095bd40 for__segv_default_msg - 0x000000000095bd48 for__l_current_arg - .data 0x000000000095bd50 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .data 0x000000000095bd50 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - *fill* 0x000000000095bd50 0x10 00 - .data 0x000000000095bd60 0x140 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x000000000095bd60 for__static_threadstor_private - .data 0x000000000095bea0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .data 0x000000000095bea4 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - *fill* 0x000000000095bea8 0x18 00 - .data 0x000000000095bec0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .data 0x000000000095bf40 0x460 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x000000000095c368 __libm_pmatherrf - 0x000000000095c370 __libm_pmatherr - 0x000000000095c378 __libm_pmatherrl - 0x000000000095c384 _LIB_VERSIONIMF - .data 0x000000000095c3a0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .data 0x000000000095c3c8 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data 0x000000000095c3c8 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x000000000095c3c8 __xxref - .data 0x000000000095c3d0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .data 0x000000000095c400 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .data 0x000000000095c430 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .data 0x000000000095c430 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - .data 0x000000000095c430 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - *fill* 0x000000000095c450 0x10 00 - .data 0x000000000095c460 0x840 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000095cc94 __intel_memcpy_mem_ops_method - .data 0x000000000095cca0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .data 0x000000000095cca0 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .data 0x000000000095cca0 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .data 0x000000000095cca0 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.data1 0x000000000095cca0 0x3ba0 - *(.data1) - .data1 0x000000000095cca0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .data1 0x000000000095d2e0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .data1 0x000000000095d920 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .data1 0x000000000095dcc0 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .data1 0x000000000095e060 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .data1 0x000000000095e6a0 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .data1 0x000000000095ea40 0x1a40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .data1 0x0000000000960480 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - *fill* 0x0000000000960490 0x10 00 - .data1 0x00000000009604a0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data1 0x0000000000960520 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - -.sharable_data 0x0000000000a00000 0x0 - 0x0000000000a00000 PROVIDE (__sharable_data_start, .) - *(.sharable_data .sharable_data.* .gnu.linkonce.shrd.*) - 0x0000000000a00000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x0000000000a00000 PROVIDE (__sharable_data_end, .) - 0x0000000000a00000 _edata = . - 0x0000000000a00000 PROVIDE (edata, .) - 0x0000000000a00000 __bss_start = . - -.bss 0x0000000000960840 0x6a87e620 - *(.dynbss) - .dynbss 0x0000000000960840 0x28 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000960840 environ@@GLIBC_2.2.5 - 0x0000000000960840 __environ@@GLIBC_2.2.5 - 0x0000000000960840 _environ@@GLIBC_2.2.5 - 0x0000000000960848 stdin@@GLIBC_2.2.5 - 0x0000000000960850 stderr@@GLIBC_2.2.5 - 0x0000000000960860 stdout@@GLIBC_2.2.5 - *(.bss .bss.* .gnu.linkonce.b.*) - .bss 0x0000000000960868 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .bss 0x0000000000960868 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .bss 0x0000000000960868 0x10 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x0000000000960878 0x8 00 - .bss 0x0000000000960880 0x9a60 unres.o - .bss 0x000000000096a2e0 0x20 chainbuild.o - .bss 0x000000000096a300 0x9600 convert.o - .bss 0x0000000000973900 0x10c0 initialize_p.o - .bss 0x00000000009749c0 0x60 matmult.o - .bss 0x0000000000974a20 0x3aa0 readrtns_CSA.o - .bss 0x00000000009784c0 0x1a0 parmread.o - *fill* 0x0000000000978660 0x20 00 - .bss 0x0000000000978680 0x1c00 gen_rand_conf.o - .bss 0x000000000097a280 0x12d60 map.o - .bss 0x000000000098cfe0 0x2440 randgens.o - .bss 0x000000000098f420 0x10 timing.o - *fill* 0x000000000098f430 0x10 00 - .bss 0x000000000098f440 0xc0 misc.o - .bss 0x000000000098f500 0x80 intlocal.o - .bss 0x000000000098f580 0x54700 cartder.o - .bss 0x00000000009e3c80 0x75a60 checkder_p.o - *fill* 0x0000000000a596e0 0x20 00 - .bss 0x0000000000a59700 0x7110880 energy_p_new_barrier.o - .bss 0x0000000007b69f80 0x3e0 energy_p_new-sep_barrier.o - .bss 0x0000000007b6a360 0x41f60 minimize_p.o - .bss 0x0000000007bac2c0 0xc8 cored.o - *fill* 0x0000000007bac388 0x18 00 - .bss 0x0000000007bac3a0 0x8660 geomout.o - .bss 0x0000000007bb4a00 0x2c0 readpdb.o - .bss 0x0000000007bb4cc0 0x584320 regularize.o - .bss 0x0000000008138fe0 0x380 thread.o - *fill* 0x0000000008139360 0x20 00 - .bss 0x0000000008139380 0x2c0 fitsq.o - .bss 0x0000000008139640 0x1c4e0 mcm.o - .bss 0x0000000008155b20 0x1c400 mc.o - .bss 0x0000000008171f20 0x140 bond_move.o - .bss 0x0000000008172060 0xc0 check_bond.o - .bss 0x0000000008172120 0x1c200 contact.o - .bss 0x000000000818e320 0x4c0 djacob.o - .bss 0x000000000818e7e0 0x12d40 entmcm.o - .bss 0x00000000081a1520 0x12d60 minim_mcmf.o - .bss 0x00000000081b4280 0x30220 together.o - .bss 0x00000000081e44a0 0xc0 csa.o - .bss 0x00000000081e4560 0x598320 minim_jlee.o - .bss 0x000000000877c880 0x1a0 bank.o - .bss 0x000000000877ca20 0x7f60 newconf.o - .bss 0x0000000008784980 0x240 ran.o - .bss 0x0000000008784bc0 0x7e0 indexx.o - .bss 0x00000000087853a0 0x2180 MP.o - .bss 0x0000000008787520 0x9680 compare_s1.o - .bss 0x0000000008790ba0 0x1407ec0 test.o - .bss 0x0000000009b98a60 0x7100 distfit.o - .bss 0x0000000009b9fb60 0x38600 rmsd.o - .bss 0x0000000009bd8160 0x3e240 elecont.o - .bss 0x0000000009c163a0 0xc0 dihed_cons.o - .bss 0x0000000009c16460 0x25b40 sc_move.o - .bss 0x0000000009c3bfa0 0x200 local_move.o - .bss 0x0000000009c3c1a0 0xce4c0 intcartderiv.o - .bss 0x0000000009d0a660 0xab200 /tmp/ipo_ifortx3jrsv.o - .bss 0x0000000009db5860 0x3f4c0 stochfric.o - .bss 0x0000000009df4d20 0x40 kinetic_lesyng.o - .bss 0x0000000009df4d60 0x114e20 MD_A-MTS.o - .bss 0x0000000009f09b80 0x3c0 moments.o - .bss 0x0000000009f09f40 0xce60 surfatom.o - .bss 0x0000000009f16da0 0x300 sort.o - .bss 0x0000000009f170a0 0x50a0 muca_md.o - .bss 0x0000000009f1c140 0xdbeda0 MREMD.o - .bss 0x000000000acdaee0 0x180 energy_split-sep.o - .bss 0x000000000acdb060 0x35f80 q_measure.o - .bss 0x000000000ad10fe0 0x10 proc_proc.o - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .bss 0x000000000ad10ff0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .bss 0x000000000ad10ff0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x000000000ad10ff0 MPIR_F_FALSE - 0x000000000ad10ff8 MPIR_F_MPI_BOTTOM - 0x000000000ad11000 MPIR_F_STATUS_IGNORE - 0x000000000ad11008 MPIR_F_STATUSES_IGNORE - .bss 0x000000000ad11010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .bss 0x000000000ad11010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .bss 0x000000000ad11010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .bss 0x000000000ad11010 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .bss 0x000000000ad11010 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .bss 0x000000000ad11014 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - *fill* 0x000000000ad11014 0x4 00 - .bss 0x000000000ad11018 0x50 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x000000000ad11018 MPIR_Infotable - 0x000000000ad11020 MPIR_Infotable_ptr - 0x000000000ad11024 MPIR_Infotable_max - 0x000000000ad11028 MPIR_COMM_WORLD - 0x000000000ad11030 MPIR_COMM_SELF - 0x000000000ad11038 MPIR_GROUP_EMPTY - 0x000000000ad11040 MPIR_Has_been_initialized - 0x000000000ad11044 MPIR_Print_queues - 0x000000000ad11048 MPIR_Dump_Mem - 0x000000000ad1104c MPIR_Dump_Ptrs - 0x000000000ad11050 MPICHX_QOS_BANDWIDTH - 0x000000000ad11054 MPICHX_QOS_PARAMETERS - .bss 0x000000000ad11068 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .bss 0x000000000ad11068 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .bss 0x000000000ad11068 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x000000000ad11068 MPIR_PACKED_PTR - .bss 0x000000000ad11070 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .bss 0x000000000ad11070 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x000000000ad11070 0x10 00 - .bss 0x000000000ad11080 0x2100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .bss 0x000000000ad13180 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .bss 0x000000000ad13180 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .bss 0x000000000ad13180 0x6820 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .bss 0x000000000ad199a0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .bss 0x000000000ad199ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .bss 0x000000000ad199ac 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x000000000ad199ac MPIR_TOPOLOGY_KEYVAL - .bss 0x000000000ad199b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .bss 0x000000000ad199b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .bss 0x000000000ad199b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - *fill* 0x000000000ad199b0 0x10 00 - .bss 0x000000000ad199c0 0x1058 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .bss 0x000000000ad1aa18 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .bss 0x000000000ad1aa18 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .bss 0x000000000ad1aa20 0x5c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x000000000ad1aa7c 0x4 00 - .bss 0x000000000ad1aa80 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .bss 0x000000000ad1aca0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .bss 0x000000000ad1acac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x000000000ad1acac 0x4 00 - .bss 0x000000000ad1acb0 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x000000000ad1acb8 0x8 00 - .bss 0x000000000ad1acc0 0x520 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x000000000ad1acc0 start_prog_error - .bss 0x000000000ad1b1e0 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x000000000ad1b1e0 usc_MD_rollover_val - .bss 0x000000000ad1b1e8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .bss 0x000000000ad1b1e8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .bss 0x000000000ad1b1e8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x000000000ad1b1e8 MPID_Print_queues - 0x000000000ad1b1ec MPID_n_pending - 0x000000000ad1b1f0 MPID_devset - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .bss 0x000000000ad1b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .bss 0x000000000ad1b1f8 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x000000000ad1b1f8 MPID_TRACE_FILE - 0x000000000ad1b200 MPID_DEBUG_FILE - 0x000000000ad1b208 MPID_UseDebugFile - 0x000000000ad1b20c MPID_DebugFlag - .bss 0x000000000ad1b214 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x000000000ad1b214 0x4 00 - .bss 0x000000000ad1b218 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x000000000ad1b218 MPID_procinfo - 0x000000000ad1b220 MPID_IS_HETERO - *fill* 0x000000000ad1b224 0x4 00 - .bss 0x000000000ad1b228 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .bss 0x000000000ad1b238 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .bss 0x000000000ad1b240 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .bss 0x000000000ad1b240 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .bss 0x000000000ad1b240 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .bss 0x000000000ad1b240 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .bss 0x000000000ad1b240 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x000000000ad1b240 expect_cancel_ack - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .bss 0x000000000ad1b244 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x000000000ad1b244 0x1c 00 - .bss 0x000000000ad1b260 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x000000000ad1b260 MPIR_proctable - 0x000000000ad1b268 MPIR_proctable_size - 0x000000000ad1b26c MPIR_debug_state - 0x000000000ad1b270 MPIR_debug_gate - 0x000000000ad1b278 MPIR_debug_abort_string - 0x000000000ad1b280 MPIR_being_debugged - .bss 0x000000000ad1b2e8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .bss 0x000000000ad1b2e8 0x19 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x000000000ad1b301 0x3 00 - .bss 0x000000000ad1b304 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .bss 0x000000000ad1b304 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .bss 0x000000000ad1b304 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x000000000ad1b304 0x4 00 - .bss 0x000000000ad1b308 0x70 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - *fill* 0x000000000ad1b378 0x8 00 - .bss 0x000000000ad1b380 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .bss 0x000000000ad1b3e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x000000000ad1b3e4 0xc 00 - .bss 0x000000000ad1b3f0 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .bss 0x000000000ad1b404 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - *fill* 0x000000000ad1b404 0x4 00 - .bss 0x000000000ad1b408 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .bss 0x000000000ad1b418 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .bss 0x000000000ad1b418 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .bss 0x000000000ad1b418 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .bss 0x000000000ad1b418 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .bss 0x000000000ad1b418 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .bss 0x000000000ad1b418 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .bss 0x000000000ad1b41c 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .bss 0x000000000ad1b420 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .bss 0x000000000ad1b420 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x000000000ad1b420 MPID_flow_info - 0x000000000ad1b428 MPID_DebugFlow - .bss 0x000000000ad1b42c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - *fill* 0x000000000ad1b42c 0x14 00 - .bss 0x000000000ad1b440 0x178 xdrf_em64/libxdrf.a(libxdrf.o) - .bss 0x000000000ad1b5b8 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .bss 0x000000000ad1b5b8 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x000000000ad1b5d8 0x8 00 - .bss 0x000000000ad1b5e0 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x000000000ad1b7e8 for__user_iomsg_buf - 0x000000000ad1b7f0 for__user_iomsg_len - .bss 0x000000000ad1b820 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x000000000ad1b820 for__l_exit_termination - *fill* 0x000000000ad1b824 0x4 00 - .bss 0x000000000ad1b828 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x000000000ad1b830 for__l_excpt_info - 0x000000000ad1b838 for__l_fpe_mask - 0x000000000ad1b83c for__l_undcnt - 0x000000000ad1b840 for__l_ovfcnt - 0x000000000ad1b844 for__l_div0cnt - 0x000000000ad1b848 for__l_invcnt - 0x000000000ad1b84c for__l_inecnt - 0x000000000ad1b850 for__l_fmtrecl - 0x000000000ad1b854 for__l_ufmtrecl - 0x000000000ad1b858 for__l_blocksize - 0x000000000ad1b85c for__l_buffercount - .bss 0x000000000ad1b860 0x3b40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x000000000ad1cc80 for__lub_table - .bss 0x000000000ad1f3a0 0x20a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x000000000ad1f3a0 for__file_info_hash_table - .bss 0x000000000ad21440 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x000000000ad21860 for__l_exit_hand_decl - .bss 0x000000000ad21880 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x000000000ad21890 for__reentrancy_mode - 0x000000000ad21894 for__reentrancy_initialized - .bss 0x000000000ad21898 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .bss 0x000000000ad218a0 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - *fill* 0x000000000ad218ac 0x4 00 - .bss 0x000000000ad218b0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .bss 0x000000000ad218f0 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x000000000ad21980 for__aio_global_mutex - .bss 0x000000000ad219b0 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - *fill* 0x000000000ad219b8 0x8 00 - .bss 0x000000000ad219c0 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x000000000ad21a40 tbk__jmp_env - .bss 0x000000000ad21b20 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x000000000ad21b20 __intel_cpu_indicator - .bss 0x000000000ad21b24 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .bss 0x000000000ad21b24 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - *fill* 0x000000000ad21b24 0x1c 00 - .bss 0x000000000ad21b40 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .bss 0x000000000ad21f60 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000ad21f60 __intel_memcpy_largest_cache_size - 0x000000000ad21f64 __intel_memcpy_largest_cachelinesize - .bss 0x000000000ad21f68 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .bss 0x000000000ad21f68 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .bss 0x000000000ad21f68 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .bss 0x000000000ad21f68 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(COMMON) - *fill* 0x000000000ad21f68 0x18 00 - COMMON 0x000000000ad21f80 0x2579c050 unres.o - 0x000000000ad21f80 header_ - 0x000000000ad21fe0 timing_ - 0x000000000ad22120 ffield_ - 0x000000000ad222a0 refstruct_ - 0x000000000ad3e510 sumsl_flag_ - 0x000000000ad3e520 links_split_ - 0x000000000ad3e540 precomp1_ - 0x000000000adaed40 chain_ - 0x000000000ae033c0 parfiles_ - 0x000000000ae03ec0 rotat_old_ - 0x000000000ae0d4c0 contacts1_ - 0x000000000ba6a880 diploc_ - 0x000000000ba6e1c0 mdpmpi_ - 0x000000000ba761e0 iounits_ - 0x000000000ba76260 mdpar_ - 0x000000000ba762e0 remdrestart_ - 0x000000000be87b00 restr_ - 0x000000000be94960 precomp2_ - 0x000000000bf05160 links_ - 0x000000000cf754c0 mdgrad_ - 0x000000000cf916f0 from_zscore_ - 0x000000000cf91700 types_ - 0x000000000cf91760 back_constr_ - 0x000000000cfa7d40 setup_ - 0x000000000cfadd80 restraints_ - 0x000000000cfadda0 qmeas_ - 0x000000000d0240e0 mpipriv_ - 0x000000000d024120 cntrl_ - 0x000000000d0241a0 rotmat_ - 0x000000000d0787a0 lagrange_ - 0x000000001d8d6a60 fnames_ - 0x000000001d8d7a70 stoptim_ - 0x000000001d8d7a80 time1_ - 0x000000001d8d7ac0 mdcalc_ - 0x000000001d8d7be0 dipmat_ - 0x000000002889fbe0 remdcommon_ - 0x00000000288a5c20 sbridge_ - 0x00000000288a5cc0 csafiles_ - 0x00000000288a68c0 inertia_ - 0x00000000288a6a20 contacts_hb_ - 0x000000002d6eede0 srutu_ - 0x000000002d6eee00 contdistrib_ - 0x00000000302f8260 traj1cache_ - 0x0000000030340340 stretch_ - 0x0000000030340960 contacts_ - 0x0000000030378d80 geo_ - 0x0000000030378dc0 csaunits_ - 0x0000000030378e00 body_ - 0x000000003037ef80 interact_ - 0x0000000030394440 oldgeo_ - 0x000000003044fd40 rotat_ - 0x0000000030488140 var_ - *fill* 0x00000000304bdfd0 0x10 00 - COMMON 0x00000000304bdfe0 0x33250 chainbuild.o - 0x00000000304bdfe0 thetas_ - 0x00000000304be940 peptbond_ - 0x00000000304be980 indices_ - 0x00000000304c59e0 sclocal_ - 0x00000000304c7cc0 invlen_ - 0x00000000304cc7c0 theta_abinitio_ - *fill* 0x00000000304f1230 0x10 00 - COMMON 0x00000000304f1240 0x43d7980 initialize_p.o - 0x00000000304f1240 deriv_loc_ - 0x00000000304f1420 splitele_ - 0x00000000304f1440 fourier_ - 0x00000000304f17a0 torsiond_ - 0x00000000305059a0 machsw_ - 0x00000000305059c0 derivat_ - 0x00000000348735c0 deriv_scloc_ - 0x00000000348b2a40 mpgrad_ - 0x00000000348b4fe0 torcnstr_ - 0x00000000348bc080 mcm_ - 0x00000000348be140 move_ - 0x00000000348c2cc0 windows_ - 0x00000000348c6520 accept_stats_ - 0x00000000348c8540 iofile_ - 0x00000000348c8ba0 minimm_ - COMMON 0x00000000348c8bc0 0x2ec90d30 readrtns_CSA.o - 0x00000000348c8bc0 mvstat_ - 0x00000000348c8e10 dih_control_ - 0x00000000348c8e20 bounds_ - 0x00000000348cd920 alphaa_ - 0x00000000348ec0c0 bank_ - 0x00000000349119e0 mce_ - 0x0000000034911c20 mucarem_ - 0x0000000034919c20 mapp_ - 0x000000003493f440 langforc_ - 0x000000005b0c1980 minvar_ - 0x000000005b0d4700 struct_ - 0x000000005b0d5140 pool_ - 0x000000005b132da0 double_muca_ - 0x000000005b1585e0 csa_input_ - 0x000000005b158680 diffcuta_ - 0x000000005b1586a0 thread_ - 0x000000005b158800 pizda_ - 0x000000005b159ac0 varin_ - 0x000000005b16c820 bank_disulfid_ - 0x000000005b16ca20 thread1_ - 0x000000005b16e700 langmat_ - 0x0000000063544700 integer_muca_ - 0x0000000063544710 mce_counters_ - 0x0000000063544740 send2_ - *fill* 0x00000000635598f0 0x10 00 - COMMON 0x0000000063559900 0x8380 parmread.o - 0x0000000063559900 torsion_ - 0x000000006355f3e0 scrot_ - COMMON 0x0000000063561c80 0x1f0 gen_rand_conf.o - 0x0000000063561c80 calc_ - *fill* 0x0000000063561e70 0x10 00 - COMMON 0x0000000063561e80 0x3f0 randgens.o - 0x0000000063561e80 vrandd_ - *fill* 0x0000000063562270 0x10 00 - COMMON 0x0000000063562280 0x6844 timing.o - 0x0000000063562280 info_ - 0x00000000635662a0 info1_ - COMMON 0x0000000063568ac4 0x0 cartder.o - *fill* 0x0000000063568ac4 0x1c 00 - COMMON 0x0000000063568ae0 0x62b04 energy_p_new_barrier.o - 0x0000000063568ae0 calcthet_ - 0x0000000063568b80 locel_ - 0x0000000063568e00 maxgrad_ - 0x0000000063568eb0 sccalc_ - 0x0000000063568ee0 vectors_ - 0x00000000635cb5e0 kutas_ - *fill* 0x00000000635cb5e4 0xc 00 - COMMON 0x00000000635cb5f0 0x4 minimize_p.o - 0x00000000635cb5f0 chuju_ - *fill* 0x00000000635cb5f4 0xc 00 - COMMON 0x00000000635cb600 0xb04c28 geomout.o - 0x00000000635cb600 frag_ - 0x00000000635cb6a0 wagi_ - 0x00000000635cb6c0 frozen_ - 0x00000000635cc980 pochodne_ - 0x00000000640cdc90 store0_ - 0x00000000640cdca0 c_frag_ - *fill* 0x00000000640d0228 0x18 00 - COMMON 0x00000000640d0240 0x5dcd0 mcm.o - 0x00000000640d0240 cache_ - *fill* 0x000000006412df10 0x10 00 - COMMON 0x000000006412df20 0x98 bond_move.o - 0x000000006412df20 refer_ - *fill* 0x000000006412dfb8 0x8 00 - COMMON 0x000000006412dfc0 0xc djacob.o - 0x000000006412dfc0 __BLNK__ - *fill* 0x000000006412dfcc 0x4 00 - COMMON 0x000000006412dfd0 0x20 eigen.o - 0x000000006412dfd0 par_ - COMMON 0x000000006412dff0 0x0 minim_mcmf.o - *fill* 0x000000006412dff0 0x10 00 - COMMON 0x000000006412e000 0x384c newconf.o - 0x000000006412e000 spinka_ - *fill* 0x000000006413184c 0x4 00 - COMMON 0x0000000064131850 0x8 MP.o - 0x0000000064131850 aaaa_ - *fill* 0x0000000064131858 0x8 00 - COMMON 0x0000000064131860 0xe100 banach.o - 0x0000000064131860 banii_ - COMMON 0x000000006413f960 0x4b0 dihed_cons.o - 0x000000006413f960 secondarys_ - *fill* 0x000000006413fe10 0x10 00 - COMMON 0x000000006413fe20 0x360 local_move.o - 0x000000006413fe20 loc_work_ - 0x0000000064140140 loc_const_ - COMMON 0x0000000064140180 0x4 /tmp/ipo_ifortx3jrsv.o - 0x0000000064140180 cipiszcze_ - *fill* 0x0000000064140184 0x1c 00 - COMMON 0x00000000641401a0 0xe100 stochfric.o - 0x00000000641401a0 syfek_ - COMMON 0x000000006414e2a0 0xe118 MD_A-MTS.o - 0x000000006414e2a0 stochcalc_ - 0x000000006415c3a0 gucio_ - *fill* 0x000000006415c3b8 0x8 00 - COMMON 0x000000006415c3c0 0x7080000 MREMD.o - 0x000000006415c3c0 przechowalnia_ - COMMON 0x000000006b1dc3c0 0xbe8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x000000006b1dc3c0 MPIR_I_COMPLEX - 0x000000006b1dc480 MPIR_I_DOUBLE_PRECISION - 0x000000006b1dc540 MPIR_I_2DCOMPLEX - 0x000000006b1dc600 MPIR_real8_dte - 0x000000006b1dc6c0 MPIR_int1_dte - 0x000000006b1dc780 MPIR_I_REAL - 0x000000006b1dc840 MPIR_I_2REAL - 0x000000006b1dc900 MPIR_I_DCOMPLEX - 0x000000006b1dc9c0 MPIR_I_INTEGER - 0x000000006b1dca80 MPIR_real4_dte - 0x000000006b1dcb40 MPIR_I_2DOUBLE_PRECISION - 0x000000006b1dcc00 MPIR_I_2INTEGER - 0x000000006b1dccc0 MPIR_I_2COMPLEX - 0x000000006b1dcd80 MPIR_I_LOGICAL - 0x000000006b1dce40 MPIR_int2_dte - 0x000000006b1dcf00 MPIR_int4_dte - COMMON 0x000000006b1dcfa8 0x28 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x000000006b1dcfa8 MPIR_errhandlers - 0x000000006b1dcfb0 MPIR_topo_els - 0x000000006b1dcfb8 MPIR_tid - 0x000000006b1dcfc0 MPIR_fdtels - 0x000000006b1dcfc8 MPIR_qels - *fill* 0x000000006b1dcfd0 0x10 00 - COMMON 0x000000006b1dcfe0 0x1228 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x000000006b1dcfe0 MPIR_I_LONG_LONG_INT - 0x000000006b1dd0a0 MPIR_I_LONG_INT - 0x000000006b1dd160 MPIR_I_SHORT - 0x000000006b1dd220 MPI_LONG_DOUBLE_INT_var - 0x000000006b1dd240 MPIR_dtes - 0x000000006b1dd260 MPIR_I_UB - 0x000000006b1dd320 MPIR_I_FLOAT_INT - 0x000000006b1dd3e0 MPIR_I_SHORT_INT - 0x000000006b1dd490 MPI_DOUBLE_INT_var - 0x000000006b1dd4a0 MPIR_I_2INT - 0x000000006b1dd560 MPIR_I_USHORT - 0x000000006b1dd620 MPIR_I_FLOAT - 0x000000006b1dd6e0 MPIR_I_UINT - 0x000000006b1dd788 MPI_FLOAT_INT_var - 0x000000006b1dd7a0 MPIR_I_BYTE - 0x000000006b1dd860 MPIR_I_CHAR - 0x000000006b1dd920 MPIR_I_PACKED - 0x000000006b1dd9e0 MPIR_I_INT - 0x000000006b1ddaa0 MPIR_I_DOUBLE_INT - 0x000000006b1ddb60 MPIR_I_LONG_DOUBLE - 0x000000006b1ddc20 MPIR_I_2FLOAT - 0x000000006b1ddce0 MPIR_I_UCHAR - 0x000000006b1ddda0 MPIR_I_2DOUBLE - 0x000000006b1dde48 MPI_SHORT_INT_var - 0x000000006b1dde60 MPIR_I_LONG - 0x000000006b1ddf20 MPIR_I_ULONG - 0x000000006b1ddfe0 MPIR_I_LONG_DOUBLE_INT - 0x000000006b1de090 MPI_LONG_INT_var - 0x000000006b1de0a0 MPIR_I_LB - 0x000000006b1de160 MPIR_I_DOUBLE - COMMON 0x000000006b1de208 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x000000006b1de208 MPIR_hbt_els - 0x000000006b1de210 MPIR_hbts - COMMON 0x000000006b1de218 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x000000006b1de218 MPIR_Op_errno - *fill* 0x000000006b1de21c 0x4 00 - COMMON 0x000000006b1de220 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x000000006b1de220 tty_orig - *fill* 0x000000006b1de232 0xe 00 - COMMON 0x000000006b1de240 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x000000006b1de240 MPID_MyWorldSize - 0x000000006b1de244 MPID_MyWorldRank - 0x000000006b1de248 MPIR_rhandles - 0x000000006b1de250 MPIR_shandles - 0x000000006b1de260 ch_debug_buf - COMMON 0x000000006b1de2e0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x000000006b1de2e0 MPID_byte_order - COMMON 0x000000006b1de2e4 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x000000006b1de2e4 __P4FROM - 0x000000006b1de2e8 __P4GLOBALTYPE - 0x000000006b1de2ec __P4TYPE - 0x000000006b1de2f0 __P4LEN - *fill* 0x000000006b1de2f4 0xc 00 - COMMON 0x000000006b1de300 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x000000006b1de300 MPID_recvs - COMMON 0x000000006b1de320 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x000000006b1de320 total_pack_unacked - 0x000000006b1de330 MPID_pack_info - 0x000000006b1de340 expect_ack - *fill* 0x000000006b1de344 0xc 00 - COMMON 0x000000006b1de350 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x000000006b1de350 MPIR_debug_q - 0x000000006b1de358 MPIR_debug_sq - 0x000000006b1de360 MPIR_debug_rh - 0x000000006b1de370 MPIR_All_communicators - 0x000000006b1de380 MPIR_debug_qh - 0x000000006b1de388 MPIR_debug_s - 0x000000006b1de390 MPIR_debug_c - 0x000000006b1de398 MPIR_debug_qel - 0x000000006b1de3a0 MPIR_debug_sqel - 0x000000006b1de3a8 MPIR_debug_cl - *fill* 0x000000006b1de3b0 0x10 00 - COMMON 0x000000006b1de3c0 0x64c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - 0x000000006b1de3c0 bm_outfile - 0x000000006b1de440 rm_outfile_head - 0x000000006b1de4a8 execer_pg - 0x000000006b1de4b0 globmemsize - 0x000000006b1de4b4 p4_rm_rank - 0x000000006b1de4c0 p4_brdcst_info - 0x000000006b1de4e0 procgroup_file - 0x000000006b1de5e0 p4_global - 0x000000006b1de5e8 execer_mastport - 0x000000006b1de600 execer_id - 0x000000006b1de684 execer_numtotnodes - 0x000000006b1de688 listener_info - 0x000000006b1de690 p4_local - 0x000000006b1de698 logging_flag - 0x000000006b1de6a0 execer_myhost - 0x000000006b1de720 p4_wd - 0x000000006b1de820 p4_remote_debug_level - 0x000000006b1de824 sserver_port - 0x000000006b1de840 p4_myname_in_procgroup - 0x000000006b1de880 hand_start_remotes - 0x000000006b1de884 execer_starting_remotes - 0x000000006b1de8a0 whoami_p4 - 0x000000006b1de920 execer_masthost - 0x000000006b1de984 p4_debug_level - 0x000000006b1de9a0 local_domain - 0x000000006b1dea04 execer_mynumprocs - 0x000000006b1dea08 execer_mynodenum - *fill* 0x000000006b1dea0c 0x4 00 - COMMON 0x000000006b1dea10 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x000000006b1dea10 message_catalog - COMMON 0x000000006b1dea18 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x000000006b1dea18 for__a_argv - 0x000000006b1dea20 for__l_argc - *fill* 0x000000006b1dea24 0x1c 00 - COMMON 0x000000006b1dea40 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x000000006b1dea40 for__pthread_mutex_unlock_ptr - 0x000000006b1dea48 for__pthread_mutex_init_ptr - 0x000000006b1dea50 for__pthread_mutex_lock_ptr - 0x000000006b1dea60 for__aio_lub_table - 0x000000006b1dee60 . = ALIGN ((. != 0x0)?0x8:0x1) - -.lbss - *(.dynlbss) - *(.lbss .lbss.* .gnu.linkonce.lb.*) - *(LARGE_COMMON) - -.sharable_bss 0x000000006b200000 0x0 - 0x000000006b200000 PROVIDE (__sharable_bss_start, .) - *(.dynsharablebss) - .dynsharablebss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.sharable_bss .sharable_bss.* .gnu.linkonce.shrb.*) - *(SHARABLE_COMMON) - 0x000000006b200000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x000000006b200000 PROVIDE (__sharable_bss_end, .) - 0x000000006b200000 . = ALIGN (0x8) - -.lrodata - *(.lrodata .lrodata.* .gnu.linkonce.lr.*) - -.ldata 0x000000006b5dee60 0x0 - *(.ldata .ldata.* .gnu.linkonce.l.*) - 0x000000006b5dee60 . = ALIGN ((. != 0x0)?0x8:0x1) - 0x000000006b5dee60 . = ALIGN (0x8) - 0x000000006b5dee60 _end = . - 0x000000006b5dee60 PROVIDE (end, .) - 0x000000006b5dee60 . = DATA_SEGMENT_END (.) - -.stab - *(.stab) - -.stabstr - *(.stabstr) - -.stab.excl - *(.stab.excl) - -.stab.exclstr - *(.stab.exclstr) - -.stab.index - *(.stab.index) - -.stab.indexstr - *(.stab.indexstr) - -.comment 0x0000000000000000 0x2143 - *(.comment) - .comment 0x0000000000000000 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x2d (size before relaxing) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .comment 0x000000000000002c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .comment 0x000000000000003f 0x13 unres.o - .comment 0x0000000000000052 0x29 energy_p_new_barrier.o - .comment 0x0000000000000000 0x2d proc_proc.o - .comment 0x000000000000007b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .comment 0x00000000000000a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .comment 0x00000000000000d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .comment 0x0000000000000105 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .comment 0x0000000000000133 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .comment 0x0000000000000161 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .comment 0x000000000000018f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .comment 0x00000000000001bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .comment 0x00000000000001eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .comment 0x0000000000000219 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .comment 0x0000000000000247 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .comment 0x0000000000000275 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .comment 0x00000000000002a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .comment 0x00000000000002d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .comment 0x00000000000002ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .comment 0x000000000000032d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .comment 0x000000000000035b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .comment 0x0000000000000389 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .comment 0x00000000000003b7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .comment 0x00000000000003e5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .comment 0x0000000000000413 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .comment 0x0000000000000441 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .comment 0x000000000000046f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .comment 0x000000000000049d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .comment 0x00000000000004cb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .comment 0x00000000000004f9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .comment 0x0000000000000527 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .comment 0x0000000000000555 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .comment 0x0000000000000583 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .comment 0x00000000000005b1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .comment 0x00000000000005df 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .comment 0x000000000000060d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .comment 0x000000000000063b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .comment 0x0000000000000669 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .comment 0x0000000000000697 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .comment 0x00000000000006c5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .comment 0x00000000000006f3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .comment 0x0000000000000721 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .comment 0x000000000000074f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .comment 0x000000000000077d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .comment 0x00000000000007ab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .comment 0x00000000000007d9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .comment 0x0000000000000807 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .comment 0x0000000000000835 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .comment 0x0000000000000863 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .comment 0x0000000000000891 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .comment 0x00000000000008bf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .comment 0x00000000000008ed 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .comment 0x000000000000091b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .comment 0x0000000000000949 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .comment 0x0000000000000977 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .comment 0x00000000000009a5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .comment 0x00000000000009d3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .comment 0x0000000000000a01 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .comment 0x0000000000000a2f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .comment 0x0000000000000a5d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .comment 0x0000000000000a8b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .comment 0x0000000000000ab9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .comment 0x0000000000000ae7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .comment 0x0000000000000b15 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .comment 0x0000000000000b43 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .comment 0x0000000000000b71 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .comment 0x0000000000000b9f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .comment 0x0000000000000bcd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .comment 0x0000000000000bfb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .comment 0x0000000000000c29 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .comment 0x0000000000000c57 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .comment 0x0000000000000c85 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .comment 0x0000000000000cb3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .comment 0x0000000000000ce1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .comment 0x0000000000000d0f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .comment 0x0000000000000d3d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .comment 0x0000000000000d6b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .comment 0x0000000000000d99 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .comment 0x0000000000000dc7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .comment 0x0000000000000df5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .comment 0x0000000000000e23 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .comment 0x0000000000000e51 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .comment 0x0000000000000e7f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .comment 0x0000000000000ead 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .comment 0x0000000000000edb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .comment 0x0000000000000f09 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .comment 0x0000000000000f37 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .comment 0x0000000000000f65 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .comment 0x0000000000000f93 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .comment 0x0000000000000fc1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .comment 0x0000000000000fef 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .comment 0x000000000000101d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .comment 0x000000000000104b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .comment 0x0000000000001079 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .comment 0x00000000000010a7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .comment 0x00000000000010d5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .comment 0x0000000000001103 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .comment 0x0000000000001131 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .comment 0x000000000000115f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .comment 0x000000000000118d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .comment 0x00000000000011bb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .comment 0x00000000000011e9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .comment 0x0000000000001217 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .comment 0x0000000000001245 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .comment 0x0000000000001273 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .comment 0x00000000000012a1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .comment 0x00000000000012cf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .comment 0x00000000000012fd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .comment 0x000000000000132b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .comment 0x0000000000001359 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .comment 0x0000000000001387 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .comment 0x00000000000013b5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .comment 0x00000000000013e3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .comment 0x0000000000001411 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .comment 0x000000000000143f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .comment 0x000000000000146d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .comment 0x000000000000149b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .comment 0x00000000000014c9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .comment 0x00000000000014f7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .comment 0x0000000000001525 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .comment 0x0000000000001553 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .comment 0x0000000000001581 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .comment 0x00000000000015af 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .comment 0x00000000000015dd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .comment 0x000000000000160b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .comment 0x0000000000001639 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .comment 0x0000000000001667 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .comment 0x0000000000001695 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .comment 0x00000000000016c3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .comment 0x00000000000016f1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .comment 0x000000000000171f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .comment 0x000000000000174d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .comment 0x000000000000177b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .comment 0x00000000000017a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .comment 0x00000000000017d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .comment 0x0000000000001805 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .comment 0x0000000000001833 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .comment 0x0000000000001861 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .comment 0x000000000000188f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .comment 0x00000000000018bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .comment 0x00000000000018eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .comment 0x0000000000001919 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .comment 0x0000000000001947 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .comment 0x0000000000001975 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .comment 0x00000000000019a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .comment 0x00000000000019d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .comment 0x00000000000019ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .comment 0x0000000000001a2d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .comment 0x0000000000001a5b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .comment 0x0000000000001a89 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .comment 0x0000000000001ab7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .comment 0x0000000000001ae5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .comment 0x0000000000001b13 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .comment 0x0000000000001b41 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .comment 0x0000000000001b6f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .comment 0x0000000000001b9d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .comment 0x0000000000001bcb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .comment 0x0000000000001bf9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .comment 0x0000000000001c27 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .comment 0x0000000000001c55 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .comment 0x0000000000001c83 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .comment 0x0000000000001cb1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .comment 0x0000000000001cdf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .comment 0x0000000000001d0d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .comment 0x0000000000001d3b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .comment 0x0000000000001d69 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .comment 0x0000000000001d97 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .comment 0x0000000000001dc5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .comment 0x0000000000001df3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .comment 0x0000000000001e21 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .comment 0x0000000000001e4f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .comment 0x0000000000001e7d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .comment 0x0000000000001eab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .comment 0x0000000000001ed9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .comment 0x0000000000001f07 0x3a xdrf_em64/libxdrf.a(libxdrf.o) - .comment 0x0000000000001f41 0x3a xdrf_em64/libxdrf.a(ftocstr.o) - .comment 0x0000000000001f7b 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .comment 0x0000000000001f8e 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .comment 0x0000000000001fa1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .comment 0x0000000000001fb4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .comment 0x0000000000001fc7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .comment 0x0000000000001fda 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .comment 0x0000000000001fed 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .comment 0x0000000000002000 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .comment 0x0000000000002013 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .comment 0x0000000000002026 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .comment 0x0000000000002039 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .comment 0x000000000000204c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .comment 0x000000000000205f 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .comment 0x0000000000002072 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .comment 0x0000000000002085 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .comment 0x0000000000002098 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .comment 0x00000000000020ab 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .comment 0x00000000000020be 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .comment 0x00000000000020d1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .comment 0x00000000000020e4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .comment 0x00000000000020f7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .comment 0x000000000000210a 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .comment 0x000000000000211d 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .comment 0x0000000000002130 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .comment 0x0000000000000000 0x2d /usr/lib64/libc_nonshared.a(elf-init.oS) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.debug - *(.debug) - -.line - *(.line) - -.debug_srcinfo - *(.debug_srcinfo) - -.debug_sfnames - *(.debug_sfnames) - -.debug_aranges 0x0000000000000000 0x30 - *(.debug_aranges) - .debug_aranges - 0x0000000000000000 0x30 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_pubnames - 0x0000000000000000 0x16b - *(.debug_pubnames) - .debug_pubnames - 0x0000000000000000 0x16b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_info 0x0000000000000000 0x3147 - *(.debug_info .gnu.linkonce.wi.*) - .debug_info 0x0000000000000000 0x1d94 cored.o - .debug_info 0x0000000000001d94 0x13b3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_abbrev 0x0000000000000000 0x204 - *(.debug_abbrev) - .debug_abbrev 0x0000000000000000 0xed cored.o - .debug_abbrev 0x00000000000000ed 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_line 0x0000000000000000 0x16bf - *(.debug_line) - .debug_line 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .debug_line 0x0000000000000000 0x0 unres.o - .debug_line 0x0000000000000000 0x0 arcos.o - .debug_line 0x0000000000000000 0x0 cartprint.o - .debug_line 0x0000000000000000 0x0 chainbuild.o - .debug_line 0x0000000000000000 0x0 convert.o - .debug_line 0x0000000000000000 0x0 initialize_p.o - .debug_line 0x0000000000000000 0x0 matmult.o - .debug_line 0x0000000000000000 0x0 readrtns_CSA.o - .debug_line 0x0000000000000000 0x0 parmread.o - .debug_line 0x0000000000000000 0x0 gen_rand_conf.o - .debug_line 0x0000000000000000 0x0 printmat.o - .debug_line 0x0000000000000000 0x0 map.o - .debug_line 0x0000000000000000 0x0 pinorm.o - .debug_line 0x0000000000000000 0x0 randgens.o - .debug_line 0x0000000000000000 0x0 rescode.o - .debug_line 0x0000000000000000 0x0 intcor.o - .debug_line 0x0000000000000000 0x0 timing.o - .debug_line 0x0000000000000000 0x0 misc.o - .debug_line 0x0000000000000000 0x0 intlocal.o - .debug_line 0x0000000000000000 0x0 cartder.o - .debug_line 0x0000000000000000 0x0 checkder_p.o - .debug_line 0x0000000000000000 0x0 econstr_local.o - .debug_line 0x0000000000000000 0x0 energy_p_new_barrier.o - .debug_line 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .debug_line 0x0000000000000000 0x0 gradient_p.o - .debug_line 0x0000000000000000 0x0 minimize_p.o - .debug_line 0x0000000000000000 0x0 sumsld.o - .debug_line 0x0000000000000000 0x1543 cored.o - .debug_line 0x0000000000001543 0x0 rmdd.o - .debug_line 0x0000000000001543 0x0 geomout.o - .debug_line 0x0000000000001543 0x0 readpdb.o - .debug_line 0x0000000000001543 0x0 regularize.o - .debug_line 0x0000000000001543 0x0 thread.o - .debug_line 0x0000000000001543 0x0 fitsq.o - .debug_line 0x0000000000001543 0x0 mcm.o - .debug_line 0x0000000000001543 0x0 mc.o - .debug_line 0x0000000000001543 0x0 bond_move.o - .debug_line 0x0000000000001543 0x0 refsys.o - .debug_line 0x0000000000001543 0x0 check_sc_distr.o - .debug_line 0x0000000000001543 0x0 check_bond.o - .debug_line 0x0000000000001543 0x0 contact.o - .debug_line 0x0000000000001543 0x0 djacob.o - .debug_line 0x0000000000001543 0x0 eigen.o - .debug_line 0x0000000000001543 0x0 blas.o - .debug_line 0x0000000000001543 0x0 add.o - .debug_line 0x0000000000001543 0x0 entmcm.o - .debug_line 0x0000000000001543 0x0 minim_mcmf.o - .debug_line 0x0000000000001543 0x0 together.o - .debug_line 0x0000000000001543 0x0 csa.o - .debug_line 0x0000000000001543 0x0 minim_jlee.o - .debug_line 0x0000000000001543 0x0 shift.o - .debug_line 0x0000000000001543 0x0 diff12.o - .debug_line 0x0000000000001543 0x0 bank.o - .debug_line 0x0000000000001543 0x0 newconf.o - .debug_line 0x0000000000001543 0x0 ran.o - .debug_line 0x0000000000001543 0x0 indexx.o - .debug_line 0x0000000000001543 0x0 MP.o - .debug_line 0x0000000000001543 0x0 compare_s1.o - .debug_line 0x0000000000001543 0x0 prng_32.o - .debug_line 0x0000000000001543 0x0 test.o - .debug_line 0x0000000000001543 0x0 banach.o - .debug_line 0x0000000000001543 0x0 distfit.o - .debug_line 0x0000000000001543 0x0 rmsd.o - .debug_line 0x0000000000001543 0x0 elecont.o - .debug_line 0x0000000000001543 0x0 dihed_cons.o - .debug_line 0x0000000000001543 0x0 sc_move.o - .debug_line 0x0000000000001543 0x0 local_move.o - .debug_line 0x0000000000001543 0x0 intcartderiv.o - .debug_line 0x0000000000001543 0x0 /tmp/ipo_ifortx3jrsv.o - .debug_line 0x0000000000001543 0x0 stochfric.o - .debug_line 0x0000000000001543 0x0 kinetic_lesyng.o - .debug_line 0x0000000000001543 0x0 MD_A-MTS.o - .debug_line 0x0000000000001543 0x0 moments.o - .debug_line 0x0000000000001543 0x0 int_to_cart.o - .debug_line 0x0000000000001543 0x0 surfatom.o - .debug_line 0x0000000000001543 0x0 sort.o - .debug_line 0x0000000000001543 0x0 muca_md.o - .debug_line 0x0000000000001543 0x0 MREMD.o - .debug_line 0x0000000000001543 0x0 rattle.o - .debug_line 0x0000000000001543 0x0 gauss.o - .debug_line 0x0000000000001543 0x0 energy_split-sep.o - .debug_line 0x0000000000001543 0x0 q_measure.o - .debug_line 0x0000000000001543 0x0 gnmr1.o - .debug_line 0x0000000000001543 0x0 cinfo.o - .debug_line 0x0000000000001543 0x17c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.debug_frame 0x0000000000000000 0x770 - *(.debug_frame) - .debug_frame 0x0000000000000000 0x498 cored.o - .debug_frame 0x0000000000000498 0x2a0 /tmp/ipo_ifortx3jrsv.o - .debug_frame 0x0000000000000738 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_str 0x0000000000000000 0x96 - *(.debug_str) - .debug_str 0x0000000000000000 0x96 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_loc 0x0000000000000000 0x4c - *(.debug_loc) - .debug_loc 0x0000000000000000 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_macinfo - *(.debug_macinfo) - -.debug_weaknames - *(.debug_weaknames) - -.debug_funcnames - *(.debug_funcnames) - -.debug_typenames - *(.debug_typenames) - -.debug_varnames - *(.debug_varnames) - -.debug_pubtypes - *(.debug_pubtypes) - -.debug_ranges - *(.debug_ranges) - -.gnu.attributes - *(.gnu.attributes) - -/DISCARD/ - *(.note.GNU-stack) - *(.gnu_debuglink) - *(.gnu.lto_*) -OUTPUT(../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe elf64-x86-64) diff --git a/source/unres/src_MD-M/load.map-lang0 b/source/unres/src_MD-M/load.map-lang0 deleted file mode 100644 index a09f6c8..0000000 --- a/source/unres/src_MD-M/load.map-lang0 +++ /dev/null @@ -1,8158 +0,0 @@ -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC unres.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o arcos.o arcos.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o cartprint.o cartprint.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC chainbuild.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o convert.o convert.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC initialize_p.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC matmult.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC readrtns_CSA.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC parmread.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC gen_rand_conf.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o printmat.o printmat.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o map.o map.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o pinorm.o pinorm.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o randgens.o randgens.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o rescode.o rescode.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC intcor.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC timing.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o misc.o misc.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o intlocal.o intlocal.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC cartder.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC checkder_p.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC econstr_local.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC energy_p_new_barrier.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC energy_p_new-sep_barrier.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC gradient_p.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC minimize_p.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC sumsld.f -ifort -c -w -g -d2 -CA -CB -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC cored.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC rmdd.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC geomout.F -ifort -c -w -O0 -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC readpdb.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC regularize.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC thread.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o fitsq.o fitsq.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC mcm.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC mc.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o bond_move.o bond_move.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o refsys.o refsys.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o check_sc_distr.o check_sc_distr.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o check_bond.o check_bond.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o contact.o contact.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o djacob.o djacob.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o eigen.o eigen.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o blas.o blas.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o add.o add.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC entmcm.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC minim_mcmf.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC together.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC csa.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC minim_jlee.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC shift.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC diff12.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC bank.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC newconf.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC ran.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o indexx.o indexx.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC MP.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC compare_s1.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC prng_32.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC test.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o banach.o banach.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o distfit.o distfit.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC rmsd.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o elecont.o elecont.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC dihed_cons.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC sc_move.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o local_move.o local_move.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC intcartderiv.F -ifort -c -w -O3 -ipo -ipo_obj -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC lagrangian_lesyng.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC stochfric.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o kinetic_lesyng.o kinetic_lesyng.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC MD_A-MTS.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o moments.o moments.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o int_to_cart.o int_to_cart.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o surfatom.o surfatom.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o sort.o sort.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o muca_md.o muca_md.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC MREMD.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC rattle.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o gauss.o gauss.f -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC energy_split-sep.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DLINUX -DUNRES -DMP -DMPI -DPGI -DSPLITELE -DISNAN -DAMD64 -DPROCOR -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC q_measure.F -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o gnmr1.o gnmr1.f -cc -DSGI -c proc_proc.c -cc -o compinfo compinfo.c -./compinfo | true -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include cinfo.f -ifort -O3 -ip -w -Wl,-M unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o eigen.o blas.o add.o entmcm.o minim_mcmf.o together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o indexx.o MP.o compare_s1.o prng_32.o test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o sc_move.o local_move.o intcartderiv.o lagrangian_lesyng.o stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o q_measure.o gnmr1.o proc_proc.o cinfo.o -L/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB -o ../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe -Archive member included because of file (symbol) - -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - readrtns_CSA.o (mpi_abort_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - initialize_p.o (mpi_allgather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - energy_p_new_barrier.o (mpi_barrier_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - unres.o (mpi_bcast_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - MP.o (mpi_comm_create_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - initialize_p.o (mpi_comm_group_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - MP.o (mpi_comm_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - MP.o (mpi_comm_size_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - MP.o (mpi_comm_split_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - unres.o (mpi_dup_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - unres.o (mpi_finalize_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - initialize_p.o (mpi_gather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - MP.o (mpi_get_count_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - readrtns_CSA.o (mpi_get_processor_name_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - initialize_p.o (mpi_group_free_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - initialize_p.o (mpi_group_incl_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - MP.o (mpi_group_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - initialize_p.o (mpi_group_translate_ranks_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - MP.o (mpi_init_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - together.o (mpi_iprobe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - energy_p_new_barrier.o (mpi_irecv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - energy_p_new_barrier.o (mpi_isend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - together.o (mpi_issend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - unres.o (mpi_null_copy_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - unres.o (mpi_null_delete_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - MP.o (mpi_probe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - unres.o (mpi_recv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - energy_p_new_barrier.o (mpi_reduce_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - MREMD.o (mpi_scatter_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - minimize_p.o (mpi_scatterv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - unres.o (mpi_send_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Status_f2c) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - together.o (mpi_test_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - initialize_p.o (mpi_type_commit_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - initialize_p.o (mpi_type_contiguous_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - initialize_p.o (mpi_type_indexed_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - energy_p_new_barrier.o (mpi_waitall_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - unres.o (mpi_wtime_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (mpir_getarg_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_F_TRUE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (mpir_init_fcm_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPID_Node_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) (MPI_Isend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Irecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) (MPI_Test) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPIR_Error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) (MPI_Probe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) (MPI_Waitall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) (MPI_Send) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) (MPI_Recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) (PMPI_Testall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Get_count) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) (MPI_Issend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) (MPI_Type_commit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) (MPI_Type_contiguous) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) (MPI_Type_indexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) (MPIR_Type_dup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) (MPI_Abort) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPI_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) (MPIR_COMM_WORLD) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) (MPI_Finalize) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) (MPI_Error_string) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Init_dtes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Errhandler_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) (MPI_Wtime) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) (MPIR_Err_setmsg) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Msg_queue_export) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_HBT_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_PointerPerm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPIR_BsendRelease) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Keyval_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_get) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Attr_create_tree) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_put) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Group_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) (MPI_Group_incl) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) (MPI_Group_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_CreateGroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) (MPI_Comm_group) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) (MPI_Comm_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPI_Comm_set_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Comm_make_coll) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) (MPI_Comm_split) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) (MPIR_Context_alloc) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) (MPI_Group_translate_ranks) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_dup_fn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Barrier) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Bcast) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) (MPI_Gather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) (MPI_Scatter) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) (MPI_Scatterv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) (MPI_Allgather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) (MPI_Reduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) (PMPI_Allreduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_MAXF) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Op_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Op_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_inter_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_intra_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (MPIR_intra_Scan) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Topology_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Request_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Status_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPIR_cstr2fstr) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (p4_proc_info) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (bm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (rm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (net_setup_anon_listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (create_remote_processes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (handle_connection_interrupt) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (socket_close_conn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) (start_prog_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (usc_MD_rollover_val) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) (MPID_RecvComplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) (MPID_SendIcomplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_devset) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) (MPID_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) (MPID_SendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) (MPID_RecvDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_Msg_rep) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_PackMessage) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) (MPID_IssendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_Type_swap_copy) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_DEBUG_FILE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) (MPID_CH_InitMsgPass) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_procinfo) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_P4_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPID_Dump_queues) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_ArgSqueeze) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_SBinit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (MPID_Process_group_init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_PacketFlowSetup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_FinishCancelPackets) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Wait) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Cancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Sendrecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_extent) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) (PMPI_Type_hindexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_lb) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) (MPI_Type_struct) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_proctable) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPI_Errhandler_set) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPIR_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) (PMPI_Keyval_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_global) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (MD_initmem) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (process_args) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (alloc_local_bm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_dprintf) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) (p4_alloc_procgroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) (p4_moninit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_broadcastx) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) (MPID_SsendContig) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) (MPID_SendCancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Eagerb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Rndvb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Check_incoming) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Short_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) (MPID_DebugFlow) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) (MPIR_Pack_Hvector) -xdrf_em64/libxdrf.a(libxdrf.o) - geomout.o (xdrfint_) -xdrf_em64/libxdrf.a(ftocstr.o) - xdrf_em64/libxdrf.a(libxdrf.o) (ftocstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - timing.o (etime_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - geomout.o (fdate_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - unres.o (flush_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - parmread.o (getenv_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - readrtns_CSA.o (system_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) (allocCstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (CstrToFstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - unres.o (for_close) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__close_proc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__key_desc_ret_item) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__io_return) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) (for_errsns_load) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__exit_handler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) (for_iargc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__l_excpt_info) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - readrtns_CSA.o (for_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for_check_env_name) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__create_lub) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__rm_from_lf_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - unres.o (for_open) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - indexx.o (for_pause) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__write_output) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - unres.o (for_set_reentrancy) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - misc.o (for_rewind) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - readpdb.o (for_read_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - readrtns_CSA.o (for_read_int_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - randgens.o (for_read_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - unres.o (for_read_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - readrtns_CSA.o (for_read_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - unres.o (for_stop_core) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) (for__set_signal_ops_during_vm) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - readrtns_CSA.o (for_write_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - randgens.o (for_write_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - unres.o (for_write_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - unres.o (for_write_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - readrtns_CSA.o (for_f90_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - energy_p_new_barrier.o (for_is_nan_t_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - readrtns_CSA.o (for_cpystr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) (flushqq_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - readrtns_CSA.o (d_int_val) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (tbk_stack_trace) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (for__aio_lub_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__compute_filename) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) (for__aio_pthread_self) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (cvt_text_to_integer) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_f_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_d_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_g_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_cray_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_short_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_long_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_double_to_cray) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_single_to_ibm_short) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__common_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) (for_exit) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__format_compiler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) (for__format_value) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) (for__get_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) (for_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__interp_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (for__wfs_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) (vax_c) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_integer_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_data_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_boolean_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_data) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_boolean) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_t_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_s_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_x_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_a_to_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_a_to_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_s_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_t_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_string_to_nan_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_string_to_nan_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_a_to_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_x_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) (cvtas_string_to_nan_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_word) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_pten_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_64) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) (cvtas_pten_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - arcos.o (acos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - surfatom.o (asin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - local_move.o (atan2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - cored.o (cbrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - energy_p_new_barrier.o (cos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - parmread.o (exp2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - MREMD.o (expf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - readrtns_CSA.o (exp) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - convert.o (fmod) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - map.o (__powi4i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - parmread.o (__powr8i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) (__libm_error_support) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - chainbuild.o (__libm_sse2_sincos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - readrtns_CSA.o (log10) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - gen_rand_conf.o (logf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - energy_p_new_barrier.o (log) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrl) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherr) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - readrtns_CSA.o (pow) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - intcartderiv.o (sin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - cored.o (sqrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - gen_rand_conf.o (tan) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (truncf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (trunc) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) (__libm_exp_table_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) (__libm_reduce_pio2d) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_logf_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_rcp_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - energy_p_new_barrier.o (__svml_cos2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - energy_p_new_barrier.o (__svml_sin2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtoj) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtod) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) (tbk_string_stack_signal) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) (tbk_getPC) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) (_intel_fast_memcmp) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (__intel_cpu_indicator_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - convert.o (_intel_fast_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - initialize_p.o (_intel_fast_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o (__intel_new_proc_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) (__mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) (__divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (__intel_sse2_strlen) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) (__intel_new_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) (__intel_new_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) (irc__get_msg) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) (__intel_memcpy_mem_ops_method) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) (__intel_get_new_mem_ops_cpuid) -/usr/lib64/libc_nonshared.a(elf-init.oS) - /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o (__libc_csu_fini) - -Allocating common symbols -Common symbol size file - -bm_outfile 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_LONG_LONG_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frag_ 0xa0 geomout.o -calcthet_ 0x9c energy_p_new_barrier.o -wagi_ 0x10 geomout.o -cache_ 0x5dcd0 mcm.o -rm_outfile_head 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -header_ 0x50 unres.o -mvstat_ 0x250 readrtns_CSA.o -timing_ 0x140 unres.o -MPIR_I_COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_LONG_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -ffield_ 0x174 unres.o -chuju_ 0x4 minimize_p.o -deriv_loc_ 0x1e0 initialize_p.o -splitele_ 0x10 initialize_p.o -cipiszcze_ 0x4 /tmp/ipo_ifortB4EXK9.o -MPIR_I_DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_SHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPI_LONG_DOUBLE_INT_var - 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_dtes 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_UB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -refstruct_ 0x1c26c unres.o -dih_control_ 0xc readrtns_CSA.o -MPIR_I_FLOAT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_SHORT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frozen_ 0x12c0 geomout.o -sumsl_flag_ 0x4 unres.o -execer_pg 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -links_split_ 0x8 unres.o -precomp1_ 0x70800 unres.o -bounds_ 0x4b00 readrtns_CSA.o -MPIR_I_2DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -alphaa_ 0x1e788 readrtns_CSA.o -MPIR_errhandlers 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -chain_ 0x54680 unres.o -parfiles_ 0xb00 unres.o -globmemsize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotat_old_ 0x9600 unres.o -bank_ 0x25920 readrtns_CSA.o -p4_rm_rank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts1_ 0xc5d3c0 unres.o -mce_ 0x230 readrtns_CSA.o -diploc_ 0x3938 unres.o -mucarem_ 0x8000 readrtns_CSA.o -mdpmpi_ 0x8014 unres.o -iounits_ 0x6c unres.o -MPI_DOUBLE_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mapp_ 0x25804 readrtns_CSA.o -MPIR_real8_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -p4_brdcst_info 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -langforc_ 0x582a594 readrtns_CSA.o -MPIR_I_2INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -minvar_ 0x12d78 readrtns_CSA.o -torsion_ 0x5adc parmread.o -struct_ 0xa2c readrtns_CSA.o -procgroup_file 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -mdpar_ 0x6c unres.o -MPID_MyWorldSize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -spinka_ 0x384c newconf.o -thetas_ 0x960 chainbuild.o -__P4FROM 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -MPIR_int1_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_debug_q 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_debug_sq 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPID_MyWorldRank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -remdrestart_ 0x411808 unres.o -for__pthread_mutex_unlock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -restr_ 0xce44 unres.o -locel_ 0x274 energy_p_new_barrier.o -MPIR_I_REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -fourier_ 0x344 initialize_p.o -precomp2_ 0x70800 unres.o -torsiond_ 0x14200 initialize_p.o -for__a_argv 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -MPIR_debug_rh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -pool_ 0x5dc5c readrtns_CSA.o -maxgrad_ 0xa8 energy_p_new_barrier.o -double_muca_ 0x25828 readrtns_CSA.o -links_ 0x107035c unres.o -MPID_byte_order 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) -p4_global 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_2REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -mdgrad_ 0x1c230 unres.o -execer_mastport 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -from_zscore_ 0xc unres.o -csa_input_ 0x98 readrtns_CSA.o -for__pthread_mutex_init_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -machsw_ 0xc initialize_p.o -types_ 0x54 unres.o -MPIR_I_USHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -sccalc_ 0x28 energy_p_new_barrier.o -pochodne_ 0xb01310 geomout.o -loc_work_ 0x30c local_move.o -peptbond_ 0x28 chainbuild.o -MPIR_I_UINT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -calc_ 0x1f0 gen_rand_conf.o -execer_id 0x84 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPI_FLOAT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -execer_numtotnodes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -derivat_ 0x436dbe8 initialize_p.o -MPIR_I_BYTE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_CHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -deriv_scloc_ 0x3f480 initialize_p.o -listener_info 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -przechowalnia_ 0x7080000 MREMD.o -MPIR_All_communicators - 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -diffcuta_ 0x8 readrtns_CSA.o -vectors_ 0x62700 energy_p_new_barrier.o -thread_ 0x148 readrtns_CSA.o -back_constr_ 0x165cc unres.o -MPIR_I_PACKED 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_local 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -logging_flag 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -pizda_ 0x12c0 readrtns_CSA.o -execer_myhost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_rhandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -MPIR_topo_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -par_ 0x20 eigen.o -info_ 0x4010 timing.o -MPIR_I_INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -tty_orig 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) -MPIR_I_DOUBLE_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mpgrad_ 0x2588 initialize_p.o -info1_ 0x2824 timing.o -setup_ 0x6040 unres.o -p4_wd 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_Op_errno 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) -restraints_ 0x8 unres.o -MPIR_I_LONG_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -torcnstr_ 0x7098 initialize_p.o -stochcalc_ 0xe100 MD_A-MTS.o -MPIR_I_2FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_real4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -indices_ 0x7060 chainbuild.o -qmeas_ 0x7633c unres.o -MPID_recvs 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) -mpipriv_ 0x24 unres.o -p4_remote_debug_level - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_shandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -total_pack_unacked 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -kutas_ 0x4 energy_p_new_barrier.o -cntrl_ 0x7c unres.o -sserver_port 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotmat_ 0x54600 unres.o -varin_ 0x12d48 readrtns_CSA.o -p4_myname_in_procgroup - 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -lagrange_ 0x1085e2b8 unres.o -message_catalog 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) -MPIR_I_UCHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -fnames_ 0x1007 unres.o -loc_const_ 0x40 local_move.o -stoptim_ 0x4 unres.o -sclocal_ 0x22cc chainbuild.o -time1_ 0x30 unres.o -MPIR_I_2DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -bank_disulfid_ 0x1f0 readrtns_CSA.o -MPID_pack_info 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_debug_qh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -mdcalc_ 0x108 unres.o -dipmat_ 0xafc8000 unres.o -hand_start_remotes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -execer_starting_remotes - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -remdcommon_ 0x6030 unres.o -sbridge_ 0x9c unres.o -refer_ 0x98 bond_move.o -csafiles_ 0xc00 unres.o -MPIR_tid 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -thread1_ 0x1cd0 readrtns_CSA.o -langmat_ 0xc readrtns_CSA.o -__P4GLOBALTYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -integer_muca_ 0xc readrtns_CSA.o -MPI_SHORT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -inertia_ 0x160 unres.o -mcm_ 0x20a4 initialize_p.o -MPIR_I_2DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -for__pthread_mutex_lock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -mce_counters_ 0x14 readrtns_CSA.o -aaaa_ 0x8 MP.o -store0_ 0x4 geomout.o -MPIR_I_2INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -banii_ 0xe100 banach.o -scrot_ 0x28a0 parmread.o -c_frag_ 0x2588 geomout.o -move_ 0x4b78 initialize_p.o -MPIR_fdtels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -MPIR_I_LONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -vrandd_ 0x3f0 randgens.o -syfek_ 0xe100 stochfric.o -whoami_p4 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -windows_ 0x3844 initialize_p.o -contacts_hb_ 0x4e483c0 unres.o -MPIR_debug_s 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_ULONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_hbt_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -srutu_ 0x4 unres.o -contdistrib_ 0x2c0944c unres.o -expect_ack 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_hbts 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -__P4TYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -traj1cache_ 0x480dc unres.o -accept_stats_ 0x2008 initialize_p.o -execer_masthost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -for__l_argc 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -invlen_ 0x4b00 chainbuild.o -MPIR_I_LONG_DOUBLE_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_debug_c 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPI_LONG_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_LB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_debug_level 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -stretch_ 0x608 unres.o -for__aio_lub_table 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -iofile_ 0x65c initialize_p.o -MPIR_qels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -__P4LEN 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -local_domain 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -minimm_ 0x20 initialize_p.o -MPIR_debug_qel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -send2_ 0x151b0 readrtns_CSA.o -MPIR_debug_sqel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_2COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -gucio_ 0x18 MD_A-MTS.o -ch_debug_buf 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -execer_mynumprocs 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts_ 0x38408 unres.o -__BLNK__ 0xc djacob.o -MPIR_I_LOGICAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_int2_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -geo_ 0x40 unres.o -execer_mynodenum 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_int4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -csaunits_ 0x34 unres.o -body_ 0x6180 unres.o -interact_ 0x154bc unres.o -theta_abinitio_ 0x24a70 chainbuild.o -oldgeo_ 0xbb8f4 unres.o -rotat_ 0x38400 unres.o -var_ 0x35e90 unres.o -secondarys_ 0x4b0 dihed_cons.o -MPIR_debug_cl 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -Discarded input sections - - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .note.GNU-stack - 0x0000000000000000 0x0 unres.o - .note.GNU-stack - 0x0000000000000000 0x0 arcos.o - .note.GNU-stack - 0x0000000000000000 0x0 cartprint.o - .note.GNU-stack - 0x0000000000000000 0x0 chainbuild.o - .note.GNU-stack - 0x0000000000000000 0x0 convert.o - .note.GNU-stack - 0x0000000000000000 0x0 initialize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 matmult.o - .note.GNU-stack - 0x0000000000000000 0x0 readrtns_CSA.o - .note.GNU-stack - 0x0000000000000000 0x0 parmread.o - .note.GNU-stack - 0x0000000000000000 0x0 gen_rand_conf.o - .note.GNU-stack - 0x0000000000000000 0x0 printmat.o - .note.GNU-stack - 0x0000000000000000 0x0 map.o - .note.GNU-stack - 0x0000000000000000 0x0 pinorm.o - .note.GNU-stack - 0x0000000000000000 0x0 randgens.o - .note.GNU-stack - 0x0000000000000000 0x0 rescode.o - .note.GNU-stack - 0x0000000000000000 0x0 intcor.o - .note.GNU-stack - 0x0000000000000000 0x0 timing.o - .note.GNU-stack - 0x0000000000000000 0x0 misc.o - .note.GNU-stack - 0x0000000000000000 0x0 intlocal.o - .note.GNU-stack - 0x0000000000000000 0x0 cartder.o - .note.GNU-stack - 0x0000000000000000 0x0 checkder_p.o - .note.GNU-stack - 0x0000000000000000 0x0 econstr_local.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 gradient_p.o - .note.GNU-stack - 0x0000000000000000 0x0 minimize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 sumsld.o - .note.GNU-stack - 0x0000000000000000 0x0 cored.o - .note.GNU-stack - 0x0000000000000000 0x0 rmdd.o - .note.GNU-stack - 0x0000000000000000 0x0 geomout.o - .note.GNU-stack - 0x0000000000000000 0x0 readpdb.o - .note.GNU-stack - 0x0000000000000000 0x0 regularize.o - .note.GNU-stack - 0x0000000000000000 0x0 thread.o - .note.GNU-stack - 0x0000000000000000 0x0 fitsq.o - .note.GNU-stack - 0x0000000000000000 0x0 mcm.o - .note.GNU-stack - 0x0000000000000000 0x0 mc.o - .note.GNU-stack - 0x0000000000000000 0x0 bond_move.o - .note.GNU-stack - 0x0000000000000000 0x0 refsys.o - .note.GNU-stack - 0x0000000000000000 0x0 check_sc_distr.o - .note.GNU-stack - 0x0000000000000000 0x0 check_bond.o - .note.GNU-stack - 0x0000000000000000 0x0 contact.o - .note.GNU-stack - 0x0000000000000000 0x0 djacob.o - .note.GNU-stack - 0x0000000000000000 0x0 eigen.o - .note.GNU-stack - 0x0000000000000000 0x0 blas.o - .note.GNU-stack - 0x0000000000000000 0x0 add.o - .note.GNU-stack - 0x0000000000000000 0x0 entmcm.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_mcmf.o - .note.GNU-stack - 0x0000000000000000 0x0 together.o - .note.GNU-stack - 0x0000000000000000 0x0 csa.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_jlee.o - .note.GNU-stack - 0x0000000000000000 0x0 shift.o - .note.GNU-stack - 0x0000000000000000 0x0 diff12.o - .note.GNU-stack - 0x0000000000000000 0x0 bank.o - .note.GNU-stack - 0x0000000000000000 0x0 newconf.o - .note.GNU-stack - 0x0000000000000000 0x0 ran.o - .note.GNU-stack - 0x0000000000000000 0x0 indexx.o - .note.GNU-stack - 0x0000000000000000 0x0 MP.o - .note.GNU-stack - 0x0000000000000000 0x0 compare_s1.o - .note.GNU-stack - 0x0000000000000000 0x0 prng_32.o - .note.GNU-stack - 0x0000000000000000 0x0 test.o - .note.GNU-stack - 0x0000000000000000 0x0 banach.o - .note.GNU-stack - 0x0000000000000000 0x0 distfit.o - .note.GNU-stack - 0x0000000000000000 0x0 rmsd.o - .note.GNU-stack - 0x0000000000000000 0x0 elecont.o - .note.GNU-stack - 0x0000000000000000 0x0 dihed_cons.o - .note.GNU-stack - 0x0000000000000000 0x0 sc_move.o - .note.GNU-stack - 0x0000000000000000 0x0 local_move.o - .note.GNU-stack - 0x0000000000000000 0x0 intcartderiv.o - .note.GNU-stack - 0x0000000000000000 0x0 /tmp/ipo_ifortB4EXK9.o - .note.GNU-stack - 0x0000000000000000 0x0 stochfric.o - .note.GNU-stack - 0x0000000000000000 0x0 kinetic_lesyng.o - .note.GNU-stack - 0x0000000000000000 0x0 MD_A-MTS.o - .note.GNU-stack - 0x0000000000000000 0x0 moments.o - .note.GNU-stack - 0x0000000000000000 0x0 int_to_cart.o - .note.GNU-stack - 0x0000000000000000 0x0 surfatom.o - .note.GNU-stack - 0x0000000000000000 0x0 sort.o - .note.GNU-stack - 0x0000000000000000 0x0 muca_md.o - .note.GNU-stack - 0x0000000000000000 0x0 MREMD.o - .note.GNU-stack - 0x0000000000000000 0x0 rattle.o - .note.GNU-stack - 0x0000000000000000 0x0 gauss.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_split-sep.o - .note.GNU-stack - 0x0000000000000000 0x0 q_measure.o - .note.GNU-stack - 0x0000000000000000 0x0 gnmr1.o - .note.GNU-stack - 0x0000000000000000 0x0 proc_proc.o - .note.GNU-stack - 0x0000000000000000 0x0 cinfo.o - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -Memory Configuration - -Name Origin Length Attributes -*default* 0x0000000000000000 0xffffffffffffffff - -Linker script and memory map - -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o -LOAD unres.o -LOAD arcos.o -LOAD cartprint.o -LOAD chainbuild.o -LOAD convert.o -LOAD initialize_p.o -LOAD matmult.o -LOAD readrtns_CSA.o -LOAD parmread.o -LOAD gen_rand_conf.o -LOAD printmat.o -LOAD map.o -LOAD pinorm.o -LOAD randgens.o -LOAD rescode.o -LOAD intcor.o -LOAD timing.o -LOAD misc.o -LOAD intlocal.o -LOAD cartder.o -LOAD checkder_p.o -LOAD econstr_local.o -LOAD energy_p_new_barrier.o -LOAD energy_p_new-sep_barrier.o -LOAD gradient_p.o -LOAD minimize_p.o -LOAD sumsld.o -LOAD cored.o -LOAD rmdd.o -LOAD geomout.o -LOAD readpdb.o -LOAD regularize.o -LOAD thread.o -LOAD fitsq.o -LOAD mcm.o -LOAD mc.o -LOAD bond_move.o -LOAD refsys.o -LOAD check_sc_distr.o -LOAD check_bond.o -LOAD contact.o -LOAD djacob.o -LOAD eigen.o -LOAD blas.o -LOAD add.o -LOAD entmcm.o -LOAD minim_mcmf.o -LOAD together.o -LOAD csa.o -LOAD minim_jlee.o -LOAD shift.o -LOAD diff12.o -LOAD bank.o -LOAD newconf.o -LOAD ran.o -LOAD indexx.o -LOAD MP.o -LOAD compare_s1.o -LOAD prng_32.o -LOAD test.o -LOAD banach.o -LOAD distfit.o -LOAD rmsd.o -LOAD elecont.o -LOAD dihed_cons.o -LOAD sc_move.o -LOAD local_move.o -LOAD intcartderiv.o -LOAD /tmp/ipo_ifortB4EXK9.o -LOAD stochfric.o -LOAD kinetic_lesyng.o -LOAD MD_A-MTS.o -LOAD moments.o -LOAD int_to_cart.o -LOAD surfatom.o -LOAD sort.o -LOAD muca_md.o -LOAD MREMD.o -LOAD rattle.o -LOAD gauss.o -LOAD energy_split-sep.o -LOAD q_measure.o -LOAD gnmr1.o -LOAD proc_proc.o -LOAD cinfo.o -LOAD /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a -LOAD xdrf_em64/libxdrf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libm.so -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libipgo.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libpthread.so -START GROUP -LOAD /lib64/libpthread.so.0 -LOAD /usr/lib64/libpthread_nonshared.a -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc_s.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc_s.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libdl.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x0000000000400000 PROVIDE (__executable_start, 0x400000) - 0x0000000000400200 . = (0x400000 + SIZEOF_HEADERS) - -.interp 0x0000000000400200 0x1c - *(.interp) - .interp 0x0000000000400200 0x1c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.ABI-tag 0x000000000040021c 0x20 - .note.ABI-tag 0x000000000040021c 0x20 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.gnu.build-id - *(.note.gnu.build-id) - -.hash 0x0000000000400240 0x71c - *(.hash) - .hash 0x0000000000400240 0x71c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.hash - *(.gnu.hash) - -.dynsym 0x0000000000400960 0x1800 - *(.dynsym) - .dynsym 0x0000000000400960 0x1800 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.dynstr 0x0000000000402160 0xa61 - *(.dynstr) - .dynstr 0x0000000000402160 0xa61 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version 0x0000000000402bc2 0x200 - *(.gnu.version) - .gnu.version 0x0000000000402bc2 0x200 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_d 0x0000000000402dc8 0x0 load address 0x0000000000402dc2 - *(.gnu.version_d) - .gnu.version_d - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_r 0x0000000000402dc8 0x90 - *(.gnu.version_r) - .gnu.version_r - 0x0000000000402dc8 0x90 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.rela.dyn 0x0000000000402e58 0x5b8 - *(.rela.init) - *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) - .rela.text 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.fini) - *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) - .rela.rodata 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) - .rela.data 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) - *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) - *(.rela.ctors) - *(.rela.dtors) - *(.rela.got) - .rela.got 0x0000000000402e58 0x558 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.sharable_data .rela.sharable_data.* .rela.gnu.linkonce.shrd.*) - *(.rela.sharable_bss .rela.sharable_bss.* .rela.gnu.linkonce.shrb.*) - .rela.sharable_bss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) - .rela.bss 0x00000000004033b0 0x60 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.ldata .rela.ldata.* .rela.gnu.linkonce.l.*) - *(.rela.lbss .rela.lbss.* .rela.gnu.linkonce.lb.*) - *(.rela.lrodata .rela.lrodata.* .rela.gnu.linkonce.lr.*) - *(.rela.ifunc) - -.rela.plt 0x0000000000403410 0x1008 - *(.rela.plt) - .rela.plt 0x0000000000403410 0x1008 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_start, .) - *(.rela.iplt) - .rela.iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_end, .) - -.init 0x0000000000404418 0x18 - *(.init) - .init 0x0000000000404418 0x9 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x0000000000404418 _init - .init 0x0000000000404421 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .init 0x0000000000404426 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .init 0x000000000040442b 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.plt 0x0000000000404430 0xac0 - *(.plt) - .plt 0x0000000000404430 0xac0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404440 ctime@@GLIBC_2.2.5 - 0x0000000000404450 xdr_double@@GLIBC_2.2.5 - 0x0000000000404460 tcsetattr@@GLIBC_2.2.5 - 0x0000000000404470 chdir@@GLIBC_2.2.5 - 0x0000000000404480 fileno@@GLIBC_2.2.5 - 0x0000000000404490 dup2@@GLIBC_2.2.5 - 0x00000000004044a0 printf@@GLIBC_2.2.5 - 0x00000000004044b0 pause@@GLIBC_2.2.5 - 0x00000000004044c0 _Unwind_GetRegionStart@@GCC_3.0 - 0x00000000004044d0 memset@@GLIBC_2.2.5 - 0x00000000004044e0 ftell@@GLIBC_2.2.5 - 0x00000000004044f0 snprintf@@GLIBC_2.2.5 - 0x0000000000404500 setsid@@GLIBC_2.2.5 - 0x0000000000404510 shutdown@@GLIBC_2.2.5 - 0x0000000000404520 posix_memalign@@GLIBC_2.2.5 - 0x0000000000404530 xdr_u_short@@GLIBC_2.2.5 - 0x0000000000404540 close@@GLIBC_2.2.5 - 0x0000000000404550 wait@@GLIBC_2.2.5 - 0x0000000000404560 ioctl@@GLIBC_2.2.5 - 0x0000000000404570 abort@@GLIBC_2.2.5 - 0x0000000000404580 ttyname@@GLIBC_2.2.5 - 0x0000000000404590 memchr@@GLIBC_2.2.5 - 0x00000000004045a0 xdr_int@@GLIBC_2.2.5 - 0x00000000004045b0 getlogin@@GLIBC_2.2.5 - 0x00000000004045c0 strncat@@GLIBC_2.2.5 - 0x00000000004045d0 isatty@@GLIBC_2.2.5 - 0x00000000004045e0 gethostbyname@@GLIBC_2.2.5 - 0x00000000004045f0 xdr_bool@@GLIBC_2.2.5 - 0x0000000000404600 puts@@GLIBC_2.2.5 - 0x0000000000404610 uname@@GLIBC_2.2.5 - 0x0000000000404620 fseek@@GLIBC_2.2.5 - 0x0000000000404630 htons@@GLIBC_2.2.5 - 0x0000000000404640 select@@GLIBC_2.2.5 - 0x0000000000404650 getpeername@@GLIBC_2.2.5 - 0x0000000000404660 exit@@GLIBC_2.2.5 - 0x0000000000404670 gettimeofday@@GLIBC_2.2.5 - 0x0000000000404680 putchar@@GLIBC_2.2.5 - 0x0000000000404690 xdrmem_create@@GLIBC_2.2.5 - 0x00000000004046a0 read@@GLIBC_2.2.5 - 0x00000000004046b0 strncmp@@GLIBC_2.2.5 - 0x00000000004046c0 malloc@@GLIBC_2.2.5 - 0x00000000004046d0 fopen@@GLIBC_2.2.5 - 0x00000000004046e0 __libc_start_main@@GLIBC_2.2.5 - 0x00000000004046f0 recv@@GLIBC_2.2.5 - 0x0000000000404700 setitimer@@GLIBC_2.2.5 - 0x0000000000404710 system@@GLIBC_2.2.5 - 0x0000000000404720 execlp@@GLIBC_2.2.5 - 0x0000000000404730 unlink@@GLIBC_2.2.5 - 0x0000000000404740 sched_yield@@GLIBC_2.2.5 - 0x0000000000404750 siglongjmp@@GLIBC_2.2.5 - 0x0000000000404760 catgets@@GLIBC_2.2.5 - 0x0000000000404770 setsockopt@@GLIBC_2.2.5 - 0x0000000000404780 sysconf@@GLIBC_2.2.5 - 0x0000000000404790 getpid@@GLIBC_2.2.5 - 0x00000000004047a0 catclose@@GLIBC_2.2.5 - 0x00000000004047b0 xdr_opaque@@GLIBC_2.2.5 - 0x00000000004047c0 fgets@@GLIBC_2.2.5 - 0x00000000004047d0 xdr_u_int@@GLIBC_2.2.5 - 0x00000000004047e0 __fxstat64@@GLIBC_2.2.5 - 0x00000000004047f0 freopen64@@GLIBC_2.2.5 - 0x0000000000404800 getpwuid@@GLIBC_2.2.5 - 0x0000000000404810 geteuid@@GLIBC_2.2.5 - 0x0000000000404820 rindex@@GLIBC_2.2.5 - 0x0000000000404830 xdr_float@@GLIBC_2.2.5 - 0x0000000000404840 fputc@@GLIBC_2.2.5 - 0x0000000000404850 times@@GLIBC_2.2.5 - 0x0000000000404860 free@@GLIBC_2.2.5 - 0x0000000000404870 _IO_getc@@GLIBC_2.2.5 - 0x0000000000404880 strlen@@GLIBC_2.2.5 - 0x0000000000404890 vsprintf@@GLIBC_2.2.5 - 0x00000000004048a0 __sysconf@@GLIBC_2.2.5 - 0x00000000004048b0 bcopy@@GLIBC_2.2.5 - 0x00000000004048c0 nice@@GLIBC_2.2.5 - 0x00000000004048d0 opendir@@GLIBC_2.2.5 - 0x00000000004048e0 __xpg_basename@@GLIBC_2.2.5 - 0x00000000004048f0 mkstemp64@@GLIBC_2.2.5 - 0x0000000000404900 listen@@GLIBC_2.2.5 - 0x0000000000404910 __ctype_b_loc@@GLIBC_2.3 - 0x0000000000404920 xdr_char@@GLIBC_2.2.5 - 0x0000000000404930 sprintf@@GLIBC_2.2.5 - 0x0000000000404940 ntohs@@GLIBC_2.2.5 - 0x0000000000404950 ntohl@@GLIBC_2.2.5 - 0x0000000000404960 strrchr@@GLIBC_2.2.5 - 0x0000000000404970 _Unwind_GetIP@@GCC_3.0 - 0x0000000000404980 sscanf@@GLIBC_2.2.5 - 0x0000000000404990 sleep@@GLIBC_2.2.5 - 0x00000000004049a0 fsync@@GLIBC_2.2.5 - 0x00000000004049b0 xdr_u_char@@GLIBC_2.2.5 - 0x00000000004049c0 kill@@GLIBC_2.2.5 - 0x00000000004049d0 strerror@@GLIBC_2.2.5 - 0x00000000004049e0 open64@@GLIBC_2.2.5 - 0x00000000004049f0 strstr@@GLIBC_2.2.5 - 0x0000000000404a00 sigprocmask@@GLIBC_2.2.5 - 0x0000000000404a10 sigaction@@GLIBC_2.2.5 - 0x0000000000404a20 xdr_array@@GLIBC_2.2.5 - 0x0000000000404a30 socketpair@@GLIBC_2.2.5 - 0x0000000000404a40 strcat@@GLIBC_2.2.5 - 0x0000000000404a50 getsockopt@@GLIBC_2.2.5 - 0x0000000000404a60 vprintf@@GLIBC_2.2.5 - 0x0000000000404a70 fputs@@GLIBC_2.2.5 - 0x0000000000404a80 _Unwind_ForcedUnwind@@GCC_3.0 - 0x0000000000404a90 strtol@@GLIBC_2.2.5 - 0x0000000000404aa0 ftruncate64@@GLIBC_2.2.5 - 0x0000000000404ab0 readlink@@GLIBC_2.2.5 - 0x0000000000404ac0 getsockname@@GLIBC_2.2.5 - 0x0000000000404ad0 atoi@@GLIBC_2.2.5 - 0x0000000000404ae0 connect@@GLIBC_2.2.5 - 0x0000000000404af0 gethostname@@GLIBC_2.2.5 - 0x0000000000404b00 tcgetattr@@GLIBC_2.2.5 - 0x0000000000404b10 memcpy@@GLIBC_2.2.5 - 0x0000000000404b20 raise@@GLIBC_2.2.5 - 0x0000000000404b30 signal@@GLIBC_2.2.5 - 0x0000000000404b40 memmove@@GLIBC_2.2.5 - 0x0000000000404b50 strchr@@GLIBC_2.2.5 - 0x0000000000404b60 waitpid@@GLIBC_2.2.5 - 0x0000000000404b70 getchar@@GLIBC_2.2.5 - 0x0000000000404b80 socket@@GLIBC_2.2.5 - 0x0000000000404b90 fread@@GLIBC_2.2.5 - 0x0000000000404ba0 setenv@@GLIBC_2.2.5 - 0x0000000000404bb0 inet_ntoa@@GLIBC_2.2.5 - 0x0000000000404bc0 xdrstdio_create@@GLIBC_2.2.5 - 0x0000000000404bd0 catopen@@GLIBC_2.2.5 - 0x0000000000404be0 getenv@@GLIBC_2.2.5 - 0x0000000000404bf0 __errno_location@@GLIBC_2.2.5 - 0x0000000000404c00 xdr_vector@@GLIBC_2.2.5 - 0x0000000000404c10 clock@@GLIBC_2.2.5 - 0x0000000000404c20 sigaddset@@GLIBC_2.2.5 - 0x0000000000404c30 getdtablesize@@GLIBC_2.2.5 - 0x0000000000404c40 strcmp@@GLIBC_2.2.5 - 0x0000000000404c50 getcwd@@GLIBC_2.2.5 - 0x0000000000404c60 index@@GLIBC_2.2.5 - 0x0000000000404c70 strcpy@@GLIBC_2.2.5 - 0x0000000000404c80 strtok@@GLIBC_2.2.5 - 0x0000000000404c90 nanosleep@@GLIBC_2.2.5 - 0x0000000000404ca0 getuid@@GLIBC_2.2.5 - 0x0000000000404cb0 xdr_long@@GLIBC_2.2.5 - 0x0000000000404cc0 xdr_short@@GLIBC_2.2.5 - 0x0000000000404cd0 dladdr@@GLIBC_2.2.5 - 0x0000000000404ce0 __ctype_tolower_loc@@GLIBC_2.3 - 0x0000000000404cf0 memcmp@@GLIBC_2.2.5 - 0x0000000000404d00 xdr_string@@GLIBC_2.2.5 - 0x0000000000404d10 calloc@@GLIBC_2.2.5 - 0x0000000000404d20 feof@@GLIBC_2.2.5 - 0x0000000000404d30 writev@@GLIBC_2.2.5 - 0x0000000000404d40 fclose@@GLIBC_2.2.5 - 0x0000000000404d50 freopen@@GLIBC_2.2.5 - 0x0000000000404d60 strncpy@@GLIBC_2.2.5 - 0x0000000000404d70 __xstat64@@GLIBC_2.2.5 - 0x0000000000404d80 lseek64@@GLIBC_2.2.5 - 0x0000000000404d90 dlsym@@GLIBC_2.2.5 - 0x0000000000404da0 closedir@@GLIBC_2.2.5 - 0x0000000000404db0 fork@@GLIBC_2.2.5 - 0x0000000000404dc0 sigemptyset@@GLIBC_2.2.5 - 0x0000000000404dd0 getppid@@GLIBC_2.2.5 - 0x0000000000404de0 fopen64@@GLIBC_2.2.5 - 0x0000000000404df0 sendto@@GLIBC_2.2.5 - 0x0000000000404e00 bind@@GLIBC_2.2.5 - 0x0000000000404e10 fwrite@@GLIBC_2.2.5 - 0x0000000000404e20 htonl@@GLIBC_2.2.5 - 0x0000000000404e30 realloc@@GLIBC_2.2.5 - 0x0000000000404e40 setlocale@@GLIBC_2.2.5 - 0x0000000000404e50 perror@@GLIBC_2.2.5 - 0x0000000000404e60 __sigsetjmp@@GLIBC_2.2.5 - 0x0000000000404e70 fprintf@@GLIBC_2.2.5 - 0x0000000000404e80 xdr_u_long@@GLIBC_2.2.5 - 0x0000000000404e90 write@@GLIBC_2.2.5 - 0x0000000000404ea0 accept@@GLIBC_2.2.5 - 0x0000000000404eb0 fcntl@@GLIBC_2.2.5 - 0x0000000000404ec0 _IO_putc@@GLIBC_2.2.5 - 0x0000000000404ed0 time@@GLIBC_2.2.5 - 0x0000000000404ee0 fflush@@GLIBC_2.2.5 - *(.iplt) - .iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.text 0x0000000000404ef0 0x289c38 - *(.text.unlikely .text.*_unlikely) - *(.text .stub .text.* .gnu.linkonce.t.*) - .text 0x0000000000404ef0 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404ef0 _start - .text 0x0000000000404f1c 0x17 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - *fill* 0x0000000000404f33 0xd 90909090 - .text 0x0000000000404f40 0x92 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x0000000000404fd2 0xe 90909090 - .text 0x0000000000404fe0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - 0x0000000000404fe0 main - .text 0x0000000000405030 0x46c0 unres.o - 0x0000000000405030 MAIN__ - 0x00000000004068b0 exec_mult_eeval_or_minim_ - 0x0000000000408390 exec_mremd_ - 0x00000000004084e0 exec_md_ - 0x0000000000408550 exec_softreg_ - 0x0000000000408690 exec_csa_ - 0x00000000004086a0 exec_map_ - 0x00000000004086c0 exec_checkgrad_ - 0x0000000000408890 exec_mc_ - 0x00000000004088d0 exec_thread_ - 0x00000000004088e0 exec_regularize_ - 0x0000000000408a70 exec_eeval_or_minim_ - .text 0x00000000004096f0 0x60 arcos.o - 0x00000000004096f0 arcos_ - .text 0x0000000000409750 0x240 cartprint.o - 0x0000000000409750 cartprint_ - .text 0x0000000000409990 0x1780 chainbuild.o - 0x0000000000409990 chainbuild_ - 0x000000000040a470 locate_next_res_ - 0x000000000040a9f0 orig_frame_ - 0x000000000040ae50 locate_side_chain_ - .text 0x000000000040b110 0x1820 convert.o - 0x000000000040b110 geom_to_var_ - 0x000000000040b1f0 var_to_geom_ - 0x000000000040bb20 reduce_ - 0x000000000040c090 convert_side_ - 0x000000000040c0f0 thetnorm_ - 0x000000000040c140 var_to_geom_restr_ - .text 0x000000000040c930 0x6e10 initialize_p.o - 0x000000000040c930 data$ifort6hfr7u_ - 0x000000000040c940 nazwy_ - 0x000000000040c950 int_bounds1_ - 0x000000000040cbe0 int_partition_ - 0x000000000040cc60 int_bounds_ - 0x000000000040cef0 add_task_ - 0x000000000040cf20 hpb_partition_ - 0x000000000040d3a0 add_int_from_ - 0x000000000040d690 add_int_ - 0x000000000040d9f0 init_int_table_ - 0x0000000000412e50 initialize_ - .text 0x0000000000413740 0x210 matmult.o - 0x0000000000413740 matmult_ - .text 0x0000000000413950 0x1c240 readrtns_CSA.o - 0x0000000000413950 readrtns_ - 0x00000000004157f0 read_mdpar_ - 0x0000000000419880 read_control_ - 0x000000000041c120 mcmread_ - 0x000000000041dc70 molread_ - 0x0000000000424300 read_bridge_ - 0x0000000000424ec0 read_dist_constr_ - 0x00000000004263c0 read_angles_ - 0x00000000004266f0 read_threadbase_ - 0x0000000000426bf0 csaread_ - 0x0000000000428b10 card_concat_ - 0x0000000000428d30 readi_ - 0x0000000000428e00 read_remdpar_ - 0x000000000042a0b0 read_minim_ - 0x000000000042a9f0 reada_ - 0x000000000042aac0 read_fragments_ - 0x000000000042b670 setup_var_ - 0x000000000042b720 seq_comp_ - 0x000000000042b750 read_x_ - 0x000000000042bbd0 gen_dist_constr_ - 0x000000000042bcc0 map_read_ - 0x000000000042c3f0 multreadi_ - 0x000000000042c600 multreada_ - 0x000000000042c820 openunits_ - 0x000000000042ee50 copy_to_tmp_ - 0x000000000042f1b0 readrst_ - 0x000000000042f490 move_from_tmp_ - 0x000000000042f710 random_init_ - .text 0x000000000042fb90 0x9380 parmread.o - 0x000000000042fb90 parmread_ - 0x0000000000438f00 getenv_loc_ - .text 0x0000000000438f10 0x43d0 gen_rand_conf.o - 0x0000000000438f10 gen_rand_conf_ - 0x0000000000439b40 gen_side_ - 0x000000000043a8d0 gen_theta_ - 0x000000000043ad90 gen_phi_ - 0x000000000043add0 overlap_ - 0x000000000043b390 ran_number_ - 0x000000000043b3d0 binorm_ - 0x000000000043b6b0 mult_norm1_ - 0x000000000043b9b0 iran_num_ - 0x000000000043ba00 anorm_distr_ - 0x000000000043bb50 mult_norm_ - 0x000000000043bf90 overlap_sc_ - 0x000000000043cd30 overlap_sc_list_ - .text 0x000000000043d2e0 0x330 printmat.o - 0x000000000043d2e0 printmat_ - .text 0x000000000043d610 0xb10 map.o - 0x000000000043d610 map_ - .text 0x000000000043e120 0x50 pinorm.o - 0x000000000043e120 pinorm_ - .text 0x000000000043e170 0x760 randgens.o - 0x000000000043e170 vrnd_ - 0x000000000043e200 rndv_ - 0x000000000043e480 vrndst_ - 0x000000000043e730 vrndin_ - 0x000000000043e7c0 vrndou_ - 0x000000000043e850 rnunf_ - .text 0x000000000043e8d0 0x190 rescode.o - 0x000000000043e8d0 rescode_ - .text 0x000000000043ea60 0x450 intcor.o - 0x000000000043ea60 alpha_ - 0x000000000043eb70 beta_ - 0x000000000043ee50 dist_ - .text 0x000000000043eeb0 0x1a30 timing.o - 0x000000000043eeb0 set_timers_ - 0x000000000043efc0 tcpu_ - 0x000000000043eff0 ovrtim_ - 0x000000000043f2b0 dajczas_ - 0x000000000043f410 print_detailed_timing_ - 0x00000000004408d0 stopx_ - .text 0x00000000004408e0 0x9e0 misc.o - 0x00000000004408e0 find_arg_ - 0x0000000000440970 find_group_ - 0x0000000000440c30 lcom_ - 0x0000000000440c60 ilen_ - 0x0000000000440cd0 ucase_ - 0x0000000000440dd0 iblnk_ - 0x0000000000440e10 in_keywd_set_ - 0x0000000000440f70 lcase_ - 0x0000000000441070 lower_case_ - 0x00000000004410d0 mykey_ - 0x00000000004411b0 numstr_ - .text 0x00000000004412c0 0x6300 intlocal.o - 0x00000000004412c0 integral_ - 0x0000000000441ad0 ele_ - 0x0000000000441b50 elocal_ - 0x0000000000441dc0 integral3_ - 0x0000000000443860 integral5_ - 0x0000000000444710 integral_turn6_ - 0x0000000000445430 integral6_ - 0x00000000004466e0 integral3a_ - 0x0000000000446d60 integral4a_ - .text 0x00000000004475c0 0x1680 cartder.o - 0x00000000004475c0 cartder_ - .text 0x0000000000448c40 0x4720 checkder_p.o - 0x0000000000448c40 check_cartgrad_ - 0x000000000044a930 check_ecart_ - 0x000000000044b410 check_ecartint_ - 0x000000000044c5f0 int_from_cart1_ - 0x000000000044ccf0 check_eint_ - .text 0x000000000044d360 0x880 econstr_local.o - 0x000000000044d360 econstr_back_ - .text 0x000000000044dbe0 0x4afb0 energy_p_new_barrier.o - 0x000000000044dbe0 etotal_ - 0x00000000004516f0 ssbond_ene_ - 0x0000000000451d00 egbv_ - 0x0000000000452dd0 egb_ - 0x0000000000453ff0 ebp_ - 0x0000000000454f70 eelec_ - 0x00000000004556f0 eturn3_ - 0x00000000004560b0 eturn4_ - 0x0000000000458ec0 eelecij_ - 0x000000000045dbe0 set_matrices_ - 0x000000000045f010 ebond_ - 0x000000000045fbe0 ebend_ - 0x0000000000461bf0 esc_ - 0x0000000000463b80 enesc_ - 0x0000000000464130 etor_ - 0x0000000000464980 multibody_eello_ - 0x0000000000466a70 eello6_ - 0x000000000046c090 eello6_graph3_ - 0x000000000046c770 eello6_graph4_ - 0x0000000000472320 eello6_graph2_ - 0x0000000000473210 eello6_graph1_ - 0x0000000000473b10 eello_turn6_ - 0x0000000000476b80 eello4_ - 0x0000000000477400 eello5_ - 0x00000000004797b0 calc_eello_ - 0x0000000000489ae0 kernel_ - 0x000000000048a8d0 multibody_hb_ - 0x000000000048c590 add_hb_contact_ - 0x000000000048c830 sum_energy_ - 0x000000000048cac0 eback_sc_corr_ - 0x000000000048ce40 etor_d_ - 0x000000000048dae0 edis_ - 0x000000000048e470 escp_soft_sphere_ - 0x000000000048e780 escp_ - 0x000000000048ee80 eelec_soft_sphere_ - 0x000000000048f1c0 e_softsphere_ - 0x000000000048f520 eljk_ - 0x000000000048fb60 elj_ - 0x0000000000490350 sum_gradient_ - 0x0000000000492eb0 scalar_ - 0x0000000000492ee0 rescale_weights_ - 0x00000000004933e0 enerprint_ - 0x0000000000493ab0 gcont_ - 0x0000000000493b80 sc_grad_ - 0x0000000000494020 sc_angular_ - 0x00000000004943f0 unormderiv_ - 0x0000000000494580 vecpr_ - 0x00000000004945e0 check_vecgrad_ - 0x00000000004949d0 vec_and_deriv_ - 0x0000000000496900 transpose2_ - 0x0000000000496920 matmat2_ - 0x00000000004969a0 matvec2_ - 0x00000000004969e0 scalar2_ - 0x0000000000496a00 spline2_ - 0x0000000000496a90 spline1_ - 0x0000000000496b40 mixder_ - 0x0000000000496c60 theteng_ - 0x0000000000497080 splinthet_ - 0x0000000000497260 enesc_bound_ - 0x00000000004976b0 multibody_ - 0x0000000000497dd0 esccorr_ - 0x0000000000498090 ehbcorr_ - 0x00000000004986e0 add_hb_contact_eello_ - 0x0000000000498920 prodmat3_ - 0x0000000000498aa0 transpose_ - .text 0x0000000000498b90 0xc010 energy_p_new-sep_barrier.o - 0x0000000000498b90 sscale_ - 0x0000000000498c00 elj_long_ - 0x0000000000499290 elj_short_ - 0x0000000000499920 eljk_long_ - 0x000000000049a0d0 eljk_short_ - 0x000000000049a880 ebp_long_ - 0x000000000049b280 sc_grad_scale_ - 0x000000000049b740 ebp_short_ - 0x000000000049c130 egb_long_ - 0x000000000049cdb0 egb_short_ - 0x000000000049da20 egbv_long_ - 0x000000000049e600 egbv_short_ - 0x000000000049f1e0 eelec_scale_ - 0x000000000049f950 eelecij_scale_ - 0x00000000004a3400 evdwpp_short_ - 0x00000000004a3aa0 escp_long_ - 0x00000000004a4320 escp_short_ - .text 0x00000000004a4ba0 0x1d40 gradient_p.o - 0x00000000004a4ba0 gradient_ - 0x00000000004a5110 grad_restr_ - 0x00000000004a56d0 cartgrad_ - 0x00000000004a5e90 zerograd_ - 0x00000000004a68d0 fdum_ - .text 0x00000000004a68e0 0x1650 minimize_p.o - 0x00000000004a68e0 minimize_ - 0x00000000004a6e10 xx2x_ - 0x00000000004a6ef0 x2xx_ - 0x00000000004a6fe0 func_restr_ - 0x00000000004a7040 func_ - 0x00000000004a70a0 ergastulum_ - 0x00000000004a77e0 minim_dc_ - 0x00000000004a7ba0 grad_dc_ - 0x00000000004a7e40 func_dc_ - .text 0x00000000004a7f30 0x3770 sumsld.o - 0x00000000004a7f30 sumsl_ - 0x00000000004a81d0 sumit_ - 0x00000000004a9d90 wzbfgs_ - 0x00000000004aa2b0 vvmulp_ - 0x00000000004aa5f0 lvmul_ - 0x00000000004aa830 lupdat_ - 0x00000000004aab70 ltvmul_ - 0x00000000004aad90 dbdog_ - .text 0x00000000004ab6a0 0x25c68 cored.o - 0x00000000004ab6a0 assst_ - 0x00000000004b1a3a deflt_ - 0x00000000004b2dba dotprd_ - 0x00000000004b3000 itsum_ - 0x00000000004b72fa litvmu_ - 0x00000000004b7c22 livmul_ - 0x00000000004b864a parck_ - 0x00000000004bc446 reldst_ - 0x00000000004bca86 vaxpy_ - 0x00000000004bcd94 vcopy_ - 0x00000000004bcfa0 vdflt_ - 0x00000000004be1de vscopy_ - 0x00000000004be314 v2norm_ - 0x00000000004be854 humsl_ - 0x00000000004bf79e humit_ - 0x00000000004c6b22 dupdu_ - 0x00000000004c7342 gqtst_ - 0x00000000004ce374 lsqrt_ - 0x00000000004cef5e lsvmin_ - 0x00000000004d0bbe slvmul_ - *fill* 0x00000000004d1308 0x8 90909090 - .text 0x00000000004d1310 0x90 rmdd.o - 0x00000000004d1310 imdcon_ - 0x00000000004d1320 rmdcon_ - .text 0x00000000004d13a0 0x4610 geomout.o - 0x00000000004d13a0 pdbout_ - 0x00000000004d2ac0 mol2out_ - 0x00000000004d3570 intout_ - 0x00000000004d3970 briefout_ - 0x00000000004d3f60 cartoutx_ - 0x00000000004d44e0 cartout_ - 0x00000000004d4a10 statout_ - 0x00000000004d58c0 gyrate_ - .text 0x00000000004d59b0 0x3004 readpdb.o - 0x00000000004d59b0 readpdb_ - 0x00000000004d71b4 int_from_cart_ - 0x00000000004d7fb0 sc_loc_geom_ - 0x00000000004d8800 sccenter_ - 0x00000000004d88b0 bond_regular_ - *fill* 0x00000000004d89b4 0xc 90909090 - .text 0x00000000004d89c0 0xaa0 regularize.o - 0x00000000004d89c0 regularize_ - .text 0x00000000004d9460 0x3880 thread.o - 0x00000000004d9460 thread_seq_ - 0x00000000004db7e0 write_thread_summary_ - 0x00000000004dc7c0 write_stat_thread_ - 0x00000000004dca90 sc_conf_ - .text 0x00000000004dcce0 0x2770 fitsq.o - 0x00000000004dcce0 fitsq_ - 0x00000000004dd440 sivade_ - 0x00000000004dee10 mvvad_ - 0x00000000004deeb0 det_ - 0x00000000004def10 switch_ - 0x00000000004defb0 givns_ - 0x00000000004df190 mmmul_ - 0x00000000004df320 matvec_ - .text 0x00000000004df450 0x4de0 mcm.o - 0x00000000004df450 mcm_setup_ - 0x00000000004e0500 do_mcm_ - 0x00000000004e0cf0 statprint_ - 0x00000000004e14a0 cool_ - 0x00000000004e15e0 metropolis_ - 0x00000000004e16c0 perturb_ - 0x00000000004e2570 heat_ - 0x00000000004e27c0 zapis_ - 0x00000000004e2b80 conf_comp_ - 0x00000000004e2f50 execute_slave_ - 0x00000000004e37e0 add2cache_ - 0x00000000004e3ca0 selectmove_ - 0x00000000004e3d50 gen_psi_ - 0x00000000004e3df0 dif_ang_ - 0x00000000004e3f50 rm_from_cache_ - .text 0x00000000004e4230 0x46f0 mc.o - 0x00000000004e4230 monte_carlo_ - 0x00000000004e7fe0 icialosc_ - 0x00000000004e8010 accept_mc_ - 0x00000000004e8710 entropia_ - .text 0x00000000004e8920 0xf20 bond_move.o - 0x00000000004e8920 bond_move_ - .text 0x00000000004e9840 0x420 refsys.o - 0x00000000004e9840 refsys_ - .text 0x00000000004e9c60 0x1c0 check_sc_distr.o - 0x00000000004e9c60 check_sc_distr_ - .text 0x00000000004e9e20 0xe0 check_bond.o - 0x00000000004e9e20 check_bond_ - .text 0x00000000004e9f00 0xd10 contact.o - 0x00000000004e9f00 contact_ - 0x00000000004ea280 contact_fract_ - 0x00000000004ea380 contact_fract_nn_ - 0x00000000004ea480 hairpin_ - .text 0x00000000004eac10 0xb00 djacob.o - 0x00000000004eac10 djacob_ - .text 0x00000000004eb710 0xf350 eigen.o - 0x00000000004eb710 einvit_ - 0x00000000004ed3a0 estpi1_ - 0x00000000004edb60 epslon_ - 0x00000000004edb80 elau_ - 0x00000000004ee290 eqlrat_ - 0x00000000004eea90 etrbk3_ - 0x00000000004eec10 etred3_ - 0x00000000004efb40 freda_ - 0x00000000004efe60 trbk3b_ - 0x00000000004effe0 tql2_ - 0x00000000004f08b0 tinvtb_ - 0x00000000004f1d10 imtqlv_ - 0x00000000004f22d0 tred3b_ - 0x00000000004f3120 gldiag_ - 0x00000000004f3800 jacdia_ - 0x00000000004f4530 evvrsp_ - 0x00000000004f7370 giveis_ - 0x00000000004fa1d0 jacdg_ - 0x00000000004fa720 jacord_ - .text 0x00000000004faa60 0x2760 blas.o - 0x00000000004faa60 dasum_ - 0x00000000004facf0 daxpy_ - 0x00000000004faf50 dcopy_ - 0x00000000004fb170 ddot_ - 0x00000000004fb400 dnrm2_ - 0x00000000004fb570 drot_ - 0x00000000004fb970 drotg_ - 0x00000000004fba50 dscal_ - 0x00000000004fbce0 dswap_ - 0x00000000004fbf60 idamax_ - 0x00000000004fc0e0 dgemv_ - .text 0x00000000004fd1c0 0xc0 add.o - 0x00000000004fd1c0 abrt_ - 0x00000000004fd1f0 vclr_ - .text 0x00000000004fd280 0x5100 entmcm.o - 0x00000000004fd280 entmcm_ - 0x00000000005018b0 accepting_ - 0x0000000000501f40 read_pool_ - .text 0x0000000000502380 0x4c0 minim_mcmf.o - 0x0000000000502380 minim_mcmf_ - .text 0x0000000000502840 0xbc60 together.o - 0x0000000000502840 together_ - 0x000000000050a190 feedin_ - 0x000000000050b290 reminimize_ - 0x000000000050cc00 getx_ - 0x000000000050d0d0 send_ - 0x000000000050d9d0 recv_ - 0x000000000050dcf0 history_append_ - 0x000000000050dd60 prune_bank_ - 0x000000000050e1e0 putx_ - 0x000000000050e320 putx2_ - .text 0x000000000050e4a0 0x2960 csa.o - 0x000000000050e4a0 make_array_ - 0x000000000050e840 make_ranvar_ - 0x000000000050ed80 make_ranvar_reg_ - 0x000000000050f610 from_pdb_ - 0x000000000050fee0 from_int_ - 0x0000000000510b90 dihang_to_c_ - .text 0x0000000000510e00 0x30c0 minim_jlee.o - 0x0000000000510e00 minim_jlee_ - 0x0000000000512e80 check_var_ - .text 0x0000000000513ec0 0x1570 shift.o - 0x0000000000513ec0 csa_read_ - 0x00000000005144c0 restart_write_ - 0x0000000000514c40 initial_write_ - .text 0x0000000000515430 0x140 diff12.o - 0x0000000000515430 get_diff12_ - .text 0x0000000000515570 0x90b0 bank.o - 0x0000000000515570 refresh_bank_ - 0x0000000000517540 replace_bvar_ - 0x0000000000517960 find_max_ - 0x0000000000517a30 write_rbank_ - 0x0000000000517e30 read_rbank_ - 0x0000000000518810 write_bank_ - 0x0000000000519e20 write_bank_reminimized_ - 0x000000000051a9f0 read_bank_ - 0x000000000051b520 write_bank1_ - 0x000000000051b930 save_is_ - 0x000000000051bbb0 select_is_ - 0x000000000051c350 get_is_ - 0x000000000051d1d0 get_is_ran_ - 0x000000000051d590 select_iseed_far_ - 0x000000000051d690 select_iseed_min_ - 0x000000000051d810 select_iseed_max_ - 0x000000000051d990 find_min_ - 0x000000000051da60 write_csa_pdb_ - 0x000000000051df40 get_diff_ - 0x000000000051e170 estimate_cutdif_ - 0x000000000051e220 get_is_max_ - .text 0x000000000051e620 0xdfa0 newconf.o - 0x000000000051e620 make_var_ - 0x00000000005288f0 newconf_residue_hairpin_ - 0x00000000005290a0 newconf_residue_ - 0x0000000000529500 newconf1abr_ - 0x00000000005299e0 newconf1abb_ - 0x0000000000529ec0 newconf1br_ - 0x000000000052a5a0 select_frag_ - 0x000000000052b140 newconf1bb_ - 0x000000000052b5d0 newconf1rr_ - 0x000000000052ba60 newconf1arr_ - 0x000000000052bef0 gen_hairpin_ - 0x000000000052c200 check_old_ - 0x000000000052c3b0 newconf_copy_ - .text 0x000000000052c5c0 0x470 ran.o - 0x000000000052c5c0 ran0_ - 0x000000000052c620 ran1_ - 0x000000000052c720 ran2_ - 0x000000000052c880 ran3_ - .text 0x000000000052ca30 0x320 indexx.o - 0x000000000052ca30 indexx_ - .text 0x000000000052cd50 0x3750 MP.o - 0x000000000052cd50 finish_task_ - 0x000000000052d960 pattern_receive_ - 0x000000000052dd10 pattern_send_ - 0x000000000052dd20 send_mcm_info_ - 0x000000000052df90 receive_mcm_info_ - 0x000000000052e260 send_thread_results_ - 0x000000000052e920 receive_thread_results_ - 0x000000000052f490 recv_stop_sig_ - 0x000000000052f770 send_stop_sig_ - 0x000000000052f7d0 init_task_ - .text 0x00000000005304a0 0x12e0 compare_s1.o - 0x00000000005304a0 compare_s1_ - .text 0x0000000000531780 0x260 prng_32.o - 0x0000000000531780 prng_next_ - 0x0000000000531810 vprng_ - 0x0000000000531940 prng_chkpnt_ - 0x0000000000531970 prng_restart_ - 0x00000000005319d0 prngblk_ - .text 0x00000000005319e0 0x17090 test.o - 0x00000000005319e0 test_ - 0x0000000000532940 write_pdb_ - 0x0000000000532c70 test_n16_ - 0x0000000000533e70 beta_slide_ - 0x0000000000534720 test_local_ - 0x0000000000534fe0 test_sc_ - 0x00000000005356c0 test11_ - 0x000000000053b090 bgrow_ - 0x000000000053b250 contact_cp_min_ - 0x000000000053ce80 test3_ - 0x000000000053e5a0 test___ - 0x00000000005407c0 secondary_ - 0x0000000000543150 contact_cp_ - 0x0000000000545ac0 contact_cp2_ - 0x0000000000546080 softreg_ - 0x0000000000548830 beta_zip_ - .text 0x0000000000548a70 0x1960 banach.o - 0x0000000000548a70 banach_ - 0x00000000005492a0 banaii_ - 0x00000000005495e0 matinvert_ - .text 0x000000000054a3d0 0x1bf0 distfit.o - 0x000000000054a3d0 distfit_ - 0x000000000054b620 heval_ - 0x000000000054ba60 rderiv_ - 0x000000000054be10 rdif_ - 0x000000000054bf00 transfer_ - 0x000000000054bf20 vec_ - .text 0x000000000054bfc0 0x1360 rmsd.o - 0x000000000054bfc0 rms_nac_nnc_ - 0x000000000054c7f0 rmsd_ - 0x000000000054cd80 rmsd_csa_ - .text 0x000000000054d320 0x57e0 elecont.o - 0x000000000054d320 elecont_ - 0x000000000054e9a0 secondary2_ - 0x0000000000552a50 freeres_ - .text 0x0000000000552b00 0x19f0 dihed_cons.o - 0x0000000000552b00 secstrp2dihc_ - 0x0000000000553ab0 read_secstr_pred_ - .text 0x00000000005544f0 0x34e0 sc_move.o - 0x00000000005544f0 sc_move_ - 0x0000000000554ff0 egb1_ - 0x00000000005556b0 single_sc_move_ - 0x0000000000555ea0 minimize_sc1_ - 0x0000000000556200 sc_minimize_ - 0x0000000000556550 grad_restr1_ - 0x0000000000557210 func_restr1_ - .text 0x00000000005579d0 0x5100 local_move.o - 0x00000000005579d0 local_move_ - 0x0000000000557ca0 move_res_ - 0x0000000000559740 construct_tab_ - 0x0000000000559d70 output_tabs_ - 0x000000000055a330 angles2tab_ - 0x000000000055a470 minmax_angles_ - 0x000000000055a8e0 construct_ranges_ - 0x000000000055aa80 fix_no_moves_ - 0x000000000055ac80 loc_test_ - 0x000000000055c9d0 local_move_init_ - .text 0x000000000055cad0 0x52f0 intcartderiv.o - 0x000000000055cad0 intcartderiv_ - 0x000000000055e8a0 checkintcartgrad_ - 0x0000000000561b30 chainbuild_cart_ - .text 0x0000000000561dc0 0x37d0 /tmp/ipo_ifortB4EXK9.o - 0x0000000000561dc0 fricmat_mult_ - 0x0000000000562270 ginv_mult_ - 0x0000000000562740 setup_md_matrices_ - 0x0000000000564cc0 lagrangian_ - .text 0x0000000000565590 0x33a0 stochfric.o - 0x0000000000565590 friction_force_ - 0x00000000005656e0 stochastic_force_ - 0x0000000000565c40 setup_fricmat_ - 0x0000000000568000 sdarea_ - .text 0x0000000000568930 0x400 kinetic_lesyng.o - 0x0000000000568930 kinetic_ - .text 0x0000000000568d30 0xc900 MD_A-MTS.o - 0x0000000000568d30 md_ - 0x0000000000569f20 respa_step_ - 0x000000000056d970 velverlet_step_ - 0x0000000000570140 random_vel_ - 0x0000000000570540 verlet_bath_ - 0x00000000005706c0 verlet2_ - 0x0000000000570840 sddir_verlet2_ - 0x0000000000570b90 predict_edrift_ - 0x0000000000570dc0 max_accel_ - 0x00000000005711d0 verlet1_ - 0x0000000000571530 sddir_verlet1_ - 0x00000000005719c0 sddir_precalc_ - 0x0000000000571a60 respa_vel_ - 0x0000000000571be0 init_md_ - .text 0x0000000000575630 0x1a10 moments.o - 0x0000000000575630 inertia_tensor_ - 0x0000000000576880 angmom_ - 0x0000000000576e00 vcm_vel_ - .text 0x0000000000577040 0x1330 int_to_cart.o - 0x0000000000577040 int_to_cart_ - .text 0x0000000000578370 0x1790 surfatom.o - 0x0000000000578370 surfatom_ - .text 0x0000000000579b00 0x1040 sort.o - 0x0000000000579b00 sort_ - 0x0000000000579ba0 sort2_ - 0x0000000000579d60 sort3_ - 0x0000000000579f30 sort4_ - 0x000000000057a040 sort5_ - 0x000000000057a170 sort6_ - 0x000000000057a3e0 sort7_ - 0x000000000057a750 sort8_ - 0x000000000057a850 sort9_ - .text 0x000000000057ab40 0x5ce0 muca_md.o - 0x000000000057ab40 muca_delta_ - 0x000000000057c490 muca_ene_ - 0x000000000057ca00 read_muca_ - 0x000000000057d570 print_muca_ - 0x000000000057f4a0 splint_ - 0x000000000057f670 spline_ - 0x000000000057f8e0 muca_factor_ - 0x000000000057fcd0 muca_update_ - .text 0x0000000000580820 0xcc10 MREMD.o - 0x0000000000580820 mremd_ - 0x00000000005897c0 write1traj_ - 0x000000000058afa0 write1rst_ - 0x000000000058b7d0 read1restart_ - 0x000000000058cb30 read1restart_old_ - .text 0x000000000058d430 0x150 rattle.o - 0x000000000058d430 rattle1_ - 0x000000000058d4a0 rattle2_ - 0x000000000058d510 rattle_brown_ - .text 0x000000000058d580 0xde0 gauss.o - 0x000000000058d580 gauss_ - .text 0x000000000058e360 0xd70 energy_split-sep.o - 0x000000000058e360 etotal_long_ - 0x000000000058ea80 etotal_short_ - .text 0x000000000058f0d0 0x21d0 q_measure.o - 0x000000000058f0d0 qwol_num_ - 0x000000000058f300 econstrq_ - 0x000000000058f8a0 qwolynes_prim_ - 0x0000000000590420 deconstrq_num_ - 0x0000000000590d80 qwolynes_ - .text 0x00000000005912a0 0xf0 gnmr1.o - 0x00000000005912a0 gnmr1_ - 0x0000000000591300 gnmr1prim_ - 0x0000000000591350 harmonic_ - 0x0000000000591370 harmonicprim_ - .text 0x0000000000591390 0x236 proc_proc.o - 0x0000000000591390 proc_proc_ - 0x0000000000591411 proc_conv_ - 0x000000000059144a proc_conv_r_ - 0x000000000059145c dsvrgp_ - *fill* 0x00000000005915c6 0xa 90909090 - .text 0x00000000005915d0 0x700 cinfo.o - 0x00000000005915d0 cinfo_ - .text 0x0000000000591cd0 0x2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - 0x0000000000591cd0 mpi_abort_ - 0x0000000000591cd0 pmpi_abort_ - *fill* 0x0000000000591cff 0x1 90909090 - .text 0x0000000000591d00 0x67 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x0000000000591d00 mpi_allgather_ - 0x0000000000591d00 pmpi_allgather_ - *fill* 0x0000000000591d67 0x1 90909090 - .text 0x0000000000591d68 0x25 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x0000000000591d68 mpi_barrier_ - 0x0000000000591d68 pmpi_barrier_ - *fill* 0x0000000000591d8d 0x3 90909090 - .text 0x0000000000591d90 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x0000000000591d90 pmpi_bcast_ - 0x0000000000591d90 mpi_bcast_ - *fill* 0x0000000000591de2 0x2 90909090 - .text 0x0000000000591de4 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x0000000000591de4 mpi_comm_create_ - 0x0000000000591de4 pmpi_comm_create_ - *fill* 0x0000000000591e2e 0x2 90909090 - .text 0x0000000000591e30 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x0000000000591e30 pmpi_comm_group_ - 0x0000000000591e30 mpi_comm_group_ - .text 0x0000000000591e70 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x0000000000591e70 mpi_comm_rank_ - 0x0000000000591e70 pmpi_comm_rank_ - *fill* 0x0000000000591ea6 0x2 90909090 - .text 0x0000000000591ea8 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x0000000000591ea8 pmpi_comm_size_ - 0x0000000000591ea8 mpi_comm_size_ - *fill* 0x0000000000591ede 0x2 90909090 - .text 0x0000000000591ee0 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x0000000000591ee0 mpi_comm_split_ - 0x0000000000591ee0 pmpi_comm_split_ - .text 0x0000000000591f34 0x7f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x0000000000591f34 mpi_dup_fn_ - 0x0000000000591f34 pmpi_dup_fn_ - *fill* 0x0000000000591fb3 0x1 90909090 - .text 0x0000000000591fb4 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x0000000000591fb4 mpi_finalize_ - 0x0000000000591fb4 pmpi_finalize_ - *fill* 0x0000000000591fcf 0x1 90909090 - .text 0x0000000000591fd0 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x0000000000591fd0 pmpi_gather_ - 0x0000000000591fd0 mpi_gather_ - *fill* 0x0000000000592041 0x3 90909090 - .text 0x0000000000592044 0x4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x0000000000592044 mpi_get_count_ - 0x0000000000592044 pmpi_get_count_ - *fill* 0x000000000059208f 0x1 90909090 - .text 0x0000000000592090 0xf4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x0000000000592090 pmpi_get_processor_name_ - 0x0000000000592090 mpi_get_processor_name_ - .text 0x0000000000592184 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x0000000000592184 mpi_group_free_ - 0x0000000000592184 pmpi_group_free_ - *fill* 0x00000000005921c3 0x1 90909090 - .text 0x00000000005921c4 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x00000000005921c4 pmpi_group_incl_ - 0x00000000005921c4 mpi_group_incl_ - *fill* 0x0000000000592216 0x2 90909090 - .text 0x0000000000592218 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x0000000000592218 mpi_group_rank_ - 0x0000000000592218 pmpi_group_rank_ - *fill* 0x000000000059224e 0x2 90909090 - .text 0x0000000000592250 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x0000000000592250 mpi_group_translate_ranks_ - 0x0000000000592250 pmpi_group_translate_ranks_ - .text 0x000000000059229c 0x22f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x000000000059229c pmpi_init_ - 0x000000000059229c mpi_init_ - *fill* 0x00000000005924cb 0x1 90909090 - .text 0x00000000005924cc 0x87 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x00000000005924cc mpi_iprobe_ - 0x00000000005924cc pmpi_iprobe_ - *fill* 0x0000000000592553 0x1 90909090 - .text 0x0000000000592554 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x0000000000592554 mpi_irecv_ - 0x0000000000592554 pmpi_irecv_ - .text 0x00000000005925d0 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x00000000005925d0 pmpi_isend_ - 0x00000000005925d0 mpi_isend_ - .text 0x000000000059264c 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x000000000059264c mpi_issend_ - 0x000000000059264c pmpi_issend_ - .text 0x00000000005926c8 0x33 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x00000000005926c8 mpi_null_copy_fn_ - 0x00000000005926c8 pmpi_null_copy_fn_ - *fill* 0x00000000005926fb 0x1 90909090 - .text 0x00000000005926fc 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x00000000005926fc mpi_null_delete_fn_ - 0x00000000005926fc pmpi_null_delete_fn_ - .text 0x0000000000592720 0x58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x0000000000592720 mpi_probe_ - 0x0000000000592720 pmpi_probe_ - .text 0x0000000000592778 0x78 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x0000000000592778 pmpi_recv_ - 0x0000000000592778 mpi_recv_ - .text 0x00000000005927f0 0x6a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x00000000005927f0 mpi_reduce_ - 0x00000000005927f0 pmpi_reduce_ - *fill* 0x000000000059285a 0x2 90909090 - .text 0x000000000059285c 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x000000000059285c mpi_scatter_ - 0x000000000059285c pmpi_scatter_ - *fill* 0x00000000005928cd 0x3 90909090 - .text 0x00000000005928d0 0x7d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x00000000005928d0 mpi_scatterv_ - 0x00000000005928d0 pmpi_scatterv_ - *fill* 0x000000000059294d 0x3 90909090 - .text 0x0000000000592950 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x0000000000592950 pmpi_send_ - 0x0000000000592950 mpi_send_ - .text 0x00000000005929b0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x00000000005929b0 PMPI_Status_f2c - 0x00000000005929b0 MPI_Status_f2c - .text 0x0000000000592a50 0x95 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x0000000000592a50 pmpi_test_ - 0x0000000000592a50 mpi_test_ - *fill* 0x0000000000592ae5 0x3 90909090 - .text 0x0000000000592ae8 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x0000000000592ae8 mpi_type_commit_ - 0x0000000000592ae8 pmpi_type_commit_ - *fill* 0x0000000000592b27 0x1 90909090 - .text 0x0000000000592b28 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x0000000000592b28 pmpi_type_contiguous_ - 0x0000000000592b28 mpi_type_contiguous_ - *fill* 0x0000000000592b72 0x2 90909090 - .text 0x0000000000592b74 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x0000000000592b74 mpi_type_indexed_ - 0x0000000000592b74 pmpi_type_indexed_ - *fill* 0x0000000000592d6f 0x1 90909090 - .text 0x0000000000592d70 0x261 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x0000000000592d70 mpi_waitall_ - 0x0000000000592d70 pmpi_waitall_ - *fill* 0x0000000000592fd1 0x3 90909090 - .text 0x0000000000592fd4 0x21 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x0000000000592fd4 mpi_wtime_ - 0x0000000000592fd4 pmpi_wtime_ - *fill* 0x0000000000592ff5 0x3 90909090 - .text 0x0000000000592ff8 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x0000000000592ff8 mpir_getarg_ - 0x0000000000593002 mpir_iargc_ - .text 0x000000000059300c 0x589 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x000000000059300c MPIR_InitFortran - 0x00000000005931b4 MPIR_Free_Fortran_keyvals - 0x00000000005931fe mpir_init_bottom_ - 0x0000000000593231 MPIR_InitFortranDatatypes - 0x000000000059350b MPIR_Free_Fortran_dtes - 0x000000000059357f mpir_init_fsize_ - *fill* 0x0000000000593595 0x3 90909090 - .text 0x0000000000593598 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x0000000000593598 mpir_init_fcm_ - 0x00000000005935a8 mpir_init_flog_ - .text 0x00000000005935b8 0xbd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x00000000005935b8 MPID_Node_name - *fill* 0x0000000000593675 0x3 90909090 - .text 0x0000000000593678 0x39f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x0000000000593678 MPI_Isend - 0x0000000000593678 PMPI_Isend - *fill* 0x0000000000593a17 0x1 90909090 - .text 0x0000000000593a18 0x399 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x0000000000593a18 MPI_Irecv - 0x0000000000593a18 PMPI_Irecv - *fill* 0x0000000000593db1 0x3 90909090 - .text 0x0000000000593db4 0xcb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x0000000000593db4 MPI_Test - 0x0000000000593db4 PMPI_Test - *fill* 0x0000000000593e7f 0x1 90909090 - .text 0x0000000000593e80 0x881 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0x0000000000593e80 MPIR_Errors_are_fatal - 0x000000000059413a MPIR_Errors_return - 0x00000000005941c6 MPIR_Errors_warn - 0x0000000000594458 MPIR_Error - 0x00000000005945b0 MPIR_Set_Status_error_array - *fill* 0x0000000000594701 0x3 90909090 - .text 0x0000000000594704 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x0000000000594704 PMPI_Probe - 0x0000000000594704 MPI_Probe - *fill* 0x00000000005948ff 0x1 90909090 - .text 0x0000000000594900 0x686 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x0000000000594900 MPI_Waitall - 0x0000000000594900 PMPI_Waitall - *fill* 0x0000000000594f86 0x2 90909090 - .text 0x0000000000594f88 0x2f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x0000000000594f88 MPI_Send - 0x0000000000594f88 PMPI_Send - .text 0x0000000000595280 0x2ff /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x0000000000595280 PMPI_Recv - 0x0000000000595280 MPI_Recv - *fill* 0x000000000059557f 0x1 90909090 - .text 0x0000000000595580 0x20b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x0000000000595580 MPI_Iprobe - 0x0000000000595580 PMPI_Iprobe - *fill* 0x000000000059578b 0x1 90909090 - .text 0x000000000059578c 0x68a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x000000000059578c PMPI_Testall - 0x000000000059578c MPI_Testall - *fill* 0x0000000000595e16 0x2 90909090 - .text 0x0000000000595e18 0x16f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x0000000000595e18 PMPI_Get_count - 0x0000000000595e18 MPI_Get_count - *fill* 0x0000000000595f87 0x1 90909090 - .text 0x0000000000595f88 0x39c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x0000000000595f88 MPI_Issend - 0x0000000000595f88 PMPI_Issend - .text 0x0000000000596324 0x2ab /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x0000000000596324 MPI_Type_commit - 0x0000000000596324 PMPI_Type_commit - *fill* 0x00000000005965cf 0x1 90909090 - .text 0x00000000005965d0 0x53a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x00000000005965d0 PMPI_Type_contiguous - 0x00000000005965d0 MPI_Type_contiguous - *fill* 0x0000000000596b0a 0x2 90909090 - .text 0x0000000000596b0c 0x30d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x0000000000596b0c PMPI_Type_indexed - 0x0000000000596b0c MPI_Type_indexed - *fill* 0x0000000000596e19 0x3 90909090 - .text 0x0000000000596e1c 0x3c4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0x0000000000596e1c MPIR_Type_dup - 0x0000000000596e3b MPIR_Type_permanent - 0x0000000000596e5c MPIR_Type_free - 0x00000000005970cb MPIR_Type_get_limits - 0x00000000005970fb MPIR_Free_perm_type - 0x000000000059713c MPIR_Free_struct_internals - 0x00000000005971b6 MPIR_Datatype_iscontig - .text 0x00000000005971e0 0xce /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x00000000005971e0 PMPI_Abort - 0x00000000005971e0 MPI_Abort - *fill* 0x00000000005972ae 0x2 90909090 - .text 0x00000000005972b0 0x1f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x00000000005972b0 MPI_Init - 0x00000000005972b0 PMPI_Init - *fill* 0x00000000005972cf 0x1 90909090 - .text 0x00000000005972d0 0xff8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000005972d0 MPIR_Init - 0x00000000005981ec MPIR_Errhandler_create - 0x000000000059827b MPIR_Errhandler_mark - .text 0x00000000005982c8 0x26f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x00000000005982c8 PMPI_Finalize - 0x00000000005982c8 MPI_Finalize - *fill* 0x0000000000598537 0x1 90909090 - .text 0x0000000000598538 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x0000000000598538 PMPI_Error_string - 0x0000000000598538 MPI_Error_string - *fill* 0x00000000005985b1 0x3 90909090 - .text 0x00000000005985b4 0x62d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x00000000005985b4 MPIR_Init_dtes - 0x0000000000598950 MPIR_Free_dtes - 0x0000000000598a32 MPIR_Setup_base_datatype - 0x0000000000598b2e MPIR_Setup_complex_datatype - 0x0000000000598bac MPIR_Type_contiguous - *fill* 0x0000000000598be1 0x3 90909090 - .text 0x0000000000598be4 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x0000000000598be4 PMPI_Errhandler_free - 0x0000000000598be4 MPI_Errhandler_free - .text 0x0000000000598d04 0x29 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x0000000000598d04 PMPI_Wtime - 0x0000000000598d04 MPI_Wtime - *fill* 0x0000000000598d2d 0x3 90909090 - .text 0x0000000000598d30 0xa44 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0x0000000000598dd0 MPIR_Err_setmsg - 0x00000000005990ce MPIR_Err_map_code_to_string - 0x00000000005991e1 MPIR_GetErrorMessage - 0x00000000005992ce MPIR_Get_error_string - 0x0000000000599439 MPIR_GetNLSMsg - .text 0x0000000000599774 0x6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x0000000000599774 MPIR_Msg_queue_export - *fill* 0x000000000059977a 0x2 90909090 - .text 0x000000000059977c 0xe55 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x000000000059977c MPIR_HBT_Init - 0x00000000005997b8 MPIR_HBT_Free - 0x00000000005997dc MPIR_HBT_new_tree - 0x000000000059984a MPIR_HBT_new_node - 0x00000000005998e7 MPIR_HBT_free_node - 0x0000000000599914 MPIR_HBT_free_subtree - 0x0000000000599951 MPIR_HBT_free_tree - 0x0000000000599998 MPIR_HBT_lookup - 0x0000000000599a22 MPIR_HBT_insert - 0x0000000000599e8b MPIR_HBT_delete - *fill* 0x000000000059a5d1 0x3 90909090 - .text 0x000000000059a5d4 0xd53 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x000000000059a5d4 MPIR_PointerPerm - 0x000000000059a5e6 MPIR_PointerOpts - 0x000000000059a6e2 MPIR_DestroyPointer - 0x000000000059a737 MPIR_ToPointer - 0x000000000059a8ca MPIR_FromPointer - 0x000000000059aba8 MPIR_RmPointer - 0x000000000059ad92 MPIR_UsePointer - 0x000000000059ae89 MPIR_RegPointerIdx - 0x000000000059b0b2 MPIR_DumpPointers - *fill* 0x000000000059b327 0x1 90909090 - .text 0x000000000059b328 0xa5b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0x000000000059b328 MPIR_BsendInitBuffer - 0x000000000059b404 MPIR_BsendRelease - 0x000000000059bc1b MPIR_IbsendDatatype - *fill* 0x000000000059bd83 0x1 90909090 - .text 0x000000000059bd84 0x1d0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x000000000059bd84 PMPI_Keyval_free - 0x000000000059bd84 MPI_Keyval_free - .text 0x000000000059bf54 0x142 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x000000000059bf54 PMPI_Attr_get - 0x000000000059bf54 MPI_Attr_get - *fill* 0x000000000059c096 0x2 90909090 - .text 0x000000000059c098 0x784 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x000000000059c098 MPIR_Attr_copy_node - 0x000000000059c2ac MPIR_Attr_copy_subtree - 0x000000000059c347 MPIR_Attr_copy - 0x000000000059c3b0 MPIR_Attr_free_node - 0x000000000059c551 MPIR_Attr_free_subtree - 0x000000000059c5d0 MPIR_Attr_free_tree - 0x000000000059c674 MPIR_Attr_dup_tree - 0x000000000059c6b5 MPIR_Attr_create_tree - 0x000000000059c6e4 MPIR_Keyval_create - 0x000000000059c7f8 MPIR_Attr_make_perm - .text 0x000000000059c81c 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x000000000059c81c PMPI_Attr_put - 0x000000000059c81c MPI_Attr_put - *fill* 0x000000000059cadd 0x3 90909090 - .text 0x000000000059cae0 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x000000000059cae0 PMPI_Group_free - 0x000000000059cae0 MPI_Group_free - *fill* 0x000000000059cc75 0x3 90909090 - .text 0x000000000059cc78 0x452 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x000000000059cc78 MPI_Group_incl - 0x000000000059cc78 PMPI_Group_incl - *fill* 0x000000000059d0ca 0x2 90909090 - .text 0x000000000059d0cc 0xc4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x000000000059d0cc MPI_Group_rank - 0x000000000059d0cc PMPI_Group_rank - .text 0x000000000059d190 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x000000000059d190 MPIR_CreateGroup - 0x000000000059d2a2 MPIR_FreeGroup - 0x000000000059d30b MPIR_SetToIdentity - 0x000000000059d371 MPIR_Dump_group - 0x000000000059d43b MPIR_Dump_ranks - 0x000000000059d4a3 MPIR_Dump_ranges - 0x000000000059d55a MPIR_Powers_of_2 - 0x000000000059d601 MPIR_Group_N2_prev - *fill* 0x000000000059d621 0x3 90909090 - .text 0x000000000059d624 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x000000000059d624 MPI_Comm_free - 0x000000000059d624 PMPI_Comm_free - *fill* 0x000000000059d8e5 0x3 90909090 - .text 0x000000000059d8e8 0xf5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x000000000059d8e8 PMPI_Comm_group - 0x000000000059d8e8 MPI_Comm_group - *fill* 0x000000000059d9dd 0x3 90909090 - .text 0x000000000059d9e0 0x2f9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x000000000059d9e0 MPI_Comm_create - 0x000000000059d9e0 PMPI_Comm_create - *fill* 0x000000000059dcd9 0x3 90909090 - .text 0x000000000059dcdc 0xc5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x000000000059dcdc MPI_Comm_rank - 0x000000000059dcdc PMPI_Comm_rank - *fill* 0x000000000059dda1 0x3 90909090 - .text 0x000000000059dda4 0x20c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x000000000059dda4 PMPI_Comm_set_name - 0x000000000059dda4 MPI_Comm_set_name - .text 0x000000000059dfb0 0x107 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x000000000059dfb0 MPI_Comm_size - 0x000000000059dfb0 PMPI_Comm_size - *fill* 0x000000000059e0b7 0x1 90909090 - .text 0x000000000059e0b8 0x75b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x000000000059e0b8 MPIR_Comm_make_coll - 0x000000000059e2eb MPIR_Comm_N2_prev - 0x000000000059e30f MPIR_Dump_comm - 0x000000000059e422 MPIR_Intercomm_high - 0x000000000059e543 MPIR_Comm_init - 0x000000000059e5f8 MPIR_Comm_remember - 0x000000000059e62e MPIR_Comm_forget - 0x000000000059e68d MPIR_Comm_collops_init - 0x000000000059e6d5 MPIR_Sort_split_table - *fill* 0x000000000059e813 0x1 90909090 - .text 0x000000000059e814 0x5ad /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x000000000059e814 MPI_Comm_split - 0x000000000059e814 PMPI_Comm_split - *fill* 0x000000000059edc1 0x3 90909090 - .text 0x000000000059edc4 0x159 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x000000000059edc4 MPIR_Context_alloc - 0x000000000059ef08 MPIR_Context_dealloc - *fill* 0x000000000059ef1d 0x3 90909090 - .text 0x000000000059ef20 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x000000000059ef20 MPI_Group_translate_ranks - 0x000000000059ef20 PMPI_Group_translate_ranks - *fill* 0x000000000059f1a9 0x3 90909090 - .text 0x000000000059f1ac 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x000000000059f1ac MPIR_dup_fn - *fill* 0x000000000059f1e2 0x2 90909090 - .text 0x000000000059f1e4 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x000000000059f1e4 MPI_Barrier - 0x000000000059f1e4 PMPI_Barrier - *fill* 0x000000000059f2fd 0x3 90909090 - .text 0x000000000059f300 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x000000000059f300 MPI_Bcast - 0x000000000059f300 PMPI_Bcast - *fill* 0x000000000059f589 0x3 90909090 - .text 0x000000000059f58c 0x309 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x000000000059f58c MPI_Gather - 0x000000000059f58c PMPI_Gather - *fill* 0x000000000059f895 0x3 90909090 - .text 0x000000000059f898 0x2bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x000000000059f898 PMPI_Scatter - 0x000000000059f898 MPI_Scatter - .text 0x000000000059fb54 0x362 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x000000000059fb54 PMPI_Scatterv - 0x000000000059fb54 MPI_Scatterv - *fill* 0x000000000059feb6 0x2 90909090 - .text 0x000000000059feb8 0x335 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x000000000059feb8 PMPI_Allgather - 0x000000000059feb8 MPI_Allgather - *fill* 0x00000000005a01ed 0x3 90909090 - .text 0x00000000005a01f0 0x296 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x00000000005a01f0 PMPI_Reduce - 0x00000000005a01f0 MPI_Reduce - *fill* 0x00000000005a0486 0x2 90909090 - .text 0x00000000005a0488 0x287 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x00000000005a0488 MPI_Allreduce - 0x00000000005a0488 PMPI_Allreduce - *fill* 0x00000000005a070f 0x1 90909090 - .text 0x00000000005a0710 0x8081 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x00000000005a0710 MPIR_MAXF - 0x00000000005a0e9b MPIR_MINF - 0x00000000005a1626 MPIR_SUM - 0x00000000005a1e62 MPIR_PROD - 0x00000000005a276e MPIR_LAND - 0x00000000005a31a6 MPIR_BAND - 0x00000000005a377f MPIR_LOR - 0x00000000005a417f MPIR_BOR - 0x00000000005a4758 MPIR_LXOR - 0x00000000005a5476 MPIR_BXOR - 0x00000000005a5a4f MPIR_MAXLOC - 0x00000000005a70ee MPIR_MINLOC - *fill* 0x00000000005a8791 0x3 90909090 - .text 0x00000000005a8794 0x136 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x00000000005a8794 PMPI_Op_free - 0x00000000005a8794 MPI_Op_free - *fill* 0x00000000005a88ca 0x2 90909090 - .text 0x00000000005a88cc 0x99 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x00000000005a88cc MPIR_Op_setup - *fill* 0x00000000005a8965 0x3 90909090 - .text 0x00000000005a8968 0x39d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - *fill* 0x00000000005a8d05 0x3 90909090 - .text 0x00000000005a8d08 0xa1bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .text 0x00000000005b2ec4 0x53b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x00000000005b2ec4 MPIR_intra_Scan - *fill* 0x00000000005b33ff 0x1 90909090 - .text 0x00000000005b3400 0x426 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x00000000005b3400 MPIR_Topology_Init - 0x00000000005b3421 MPIR_Topology_Free - 0x00000000005b3436 MPIR_Topology_copy_fn - 0x00000000005b375f MPIR_Topology_delete_fn - 0x00000000005b37f7 MPIR_Topology_init - 0x00000000005b3816 MPIR_Topology_finalize - *fill* 0x00000000005b3826 0x2 90909090 - .text 0x00000000005b3828 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x00000000005b3828 PMPI_Request_c2f - 0x00000000005b3828 MPI_Request_c2f - .text 0x00000000005b387c 0x8c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x00000000005b387c PMPI_Status_c2f - 0x00000000005b387c MPI_Status_c2f - .text 0x00000000005b3908 0x19f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x00000000005b3908 MPIR_fstr2cstr - 0x00000000005b3a01 MPIR_cstr2fstr - *fill* 0x00000000005b3aa7 0x1 90909090 - .text 0x00000000005b3aa8 0x1bbb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x00000000005b3aa8 p4_post_init - 0x00000000005b3aae p4_version - 0x00000000005b3aca p4_machine_type - 0x00000000005b3ae8 p4_initenv - 0x00000000005b3cfb p4_shmalloc - 0x00000000005b3d37 p4_shfree - 0x00000000005b3d4e p4_num_cluster_ids - 0x00000000005b3d64 p4_num_total_ids - 0x00000000005b3d77 p4_num_total_slaves - 0x00000000005b3d8d p4_global_barrier - 0x00000000005b3dc3 p4_get_cluster_masters - 0x00000000005b3e41 p4_get_cluster_ids - 0x00000000005b3e75 p4_get_my_id_from_proc - 0x00000000005b43be p4_get_my_id - 0x00000000005b43ce p4_get_my_cluster_id - 0x00000000005b4410 p4_am_i_cluster_master - 0x00000000005b445a in_same_cluster - 0x00000000005b44a6 p4_cluster_shmem_sync - 0x00000000005b450c get_pipe - 0x00000000005b455b setup_conntab - 0x00000000005b479a p4_accept_wait_timeout - 0x00000000005b47c3 p4_wait_for_end - 0x00000000005b4d64 fork_p4 - 0x00000000005b4e1d zap_p4_processes - 0x00000000005b4eac zap_remote_p4_processes - 0x00000000005b51a3 get_qualified_hostname - 0x00000000005b525c same_data_representation - 0x00000000005b52d8 p4_proc_info - 0x00000000005b5375 put_execer_port - 0x00000000005b544b p4_clean_execer_port - 0x00000000005b5451 init_usclock - 0x00000000005b5487 p4_usclock - *fill* 0x00000000005b5663 0x1 90909090 - .text 0x00000000005b5664 0x10e2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0x00000000005b5664 bm_start - 0x00000000005b5827 p4_create_procgroup - 0x00000000005b58cd p4_startup - 0x00000000005b5b2c create_bm_processes - 0x00000000005b6139 procgroup_to_proctable - 0x00000000005b63ea sync_with_remotes - 0x00000000005b6513 send_proc_table - *fill* 0x00000000005b6746 0x2 90909090 - .text 0x00000000005b6748 0xf3d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x00000000005b6748 rm_start - 0x00000000005b6e1c create_rm_processes - 0x00000000005b74e9 receive_proc_table - *fill* 0x00000000005b7685 0x3 90909090 - .text 0x00000000005b7688 0x1ed3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x00000000005b7714 p4_socket_control - 0x00000000005b7b77 net_set_sockbuf_size - 0x00000000005b7ccf net_setup_listener - 0x00000000005b7e22 net_setup_anon_listener - 0x00000000005b7fa4 net_accept - 0x00000000005b82e8 net_conn_to_listener - 0x00000000005b855a net_recv - 0x00000000005b8876 net_send - 0x00000000005b8a04 net_send_w - 0x00000000005b8bdd net_send2 - 0x00000000005b8d68 p4_socket_stat - 0x00000000005b8e28 p4_timein_hostbyname - 0x00000000005b8e51 gethostbyname_p4 - 0x00000000005b8fa6 gethostname_p4 - 0x00000000005b8fc5 get_inet_addr - 0x00000000005b9010 get_inet_addr_str - 0x00000000005b903b p4_print_sock_params - 0x00000000005b9258 dump_sockaddr - 0x00000000005b930a dump_sockinfo - 0x00000000005b9380 mpiexec_reopen_stdin - 0x00000000005b9512 p4_make_socket_nonblocking - *fill* 0x00000000005b955b 0x1 90909090 - .text 0x00000000005b955c 0x154d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0x00000000005b955c create_remote_processes - 0x00000000005b974d net_slave_info - 0x00000000005b9bf4 p4_accept_timeout - 0x00000000005b9c7f p4_accept_sigchild - 0x00000000005b9d10 net_create_slave - *fill* 0x00000000005baaa9 0x3 90909090 - .text 0x00000000005baaac 0xa5a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0x00000000005baaac p4_has_timedout - 0x00000000005bab0c p4_establish_all_conns - 0x00000000005bab97 establish_connection - 0x00000000005bac77 request_connection - 0x00000000005bb044 handle_connection_interrupt - *fill* 0x00000000005bb506 0x2 90909090 - .text 0x00000000005bb508 0x1860 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x00000000005bb508 xdr_send - 0x00000000005bb882 socket_send - 0x00000000005bba29 socket_close_conn - 0x00000000005bbb04 socket_recv - 0x00000000005bbe42 socket_recv_on_fd - 0x00000000005bc086 socket_msgs_available - 0x00000000005bc139 sock_msg_avail_on_fd - 0x00000000005bc2ce xdr_recv - 0x00000000005bc52e wait_for_ack - 0x00000000005bc5ba send_ack - 0x00000000005bc64f shutdown_p4_socks - 0x00000000005bc707 p4_sockets_ready - 0x00000000005bcae9 p4_look_for_close - 0x00000000005bcbad p4_wait_for_socket_msg - .text 0x00000000005bcd68 0xd41 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x00000000005bcd68 listener - 0x00000000005bd81d net_recv_timeout - *fill* 0x00000000005bdaa9 0x3 90909090 - .text 0x00000000005bdaac 0xc02 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x00000000005bdaac start_slave - 0x00000000005be61c getpw_ss - *fill* 0x00000000005be6ae 0x2 90909090 - .text 0x00000000005be6b0 0xb0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x00000000005be6b0 usc_init - 0x00000000005be70c usc_MD_clock - .text 0x00000000005be760 0x7fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0x00000000005be760 MPID_RecvContig - 0x00000000005be82d MPID_IrecvContig - 0x00000000005beb03 MPID_RecvIcomplete - 0x00000000005bed1c MPID_RecvComplete - 0x00000000005bef48 MPID_Status_set_bytes - *fill* 0x00000000005bef5e 0x2 90909090 - .text 0x00000000005bef60 0x68d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0x00000000005bef60 MPID_SendContig - 0x00000000005bf0a0 MPID_IsendContig - 0x00000000005bf1fb MPID_BsendContig - 0x00000000005bf304 MPID_SendIcomplete - 0x00000000005bf406 MPID_SendComplete - *fill* 0x00000000005bf5ed 0x3 90909090 - .text 0x00000000005bf5f0 0xa4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x00000000005bf5f0 MPID_Init - 0x00000000005bf92a MPID_Abort - 0x00000000005bfae1 MPID_End - 0x00000000005bfbd7 MPID_DeviceCheck - 0x00000000005bfe24 MPID_Complete_pending - 0x00000000005bff9c MPID_SetPktSize - 0x00000000005bffae MPID_WaitForCompleteSend - 0x00000000005bffd8 MPID_WaitForCompleteRecv - 0x00000000005c0002 MPID_Version_name - *fill* 0x00000000005c003b 0x1 90909090 - .text 0x00000000005c003c 0x47b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x00000000005c003c MPID_Iprobe - 0x00000000005c02ce MPID_Probe - *fill* 0x00000000005c04b7 0x1 90909090 - .text 0x00000000005c04b8 0x349 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x00000000005c04b8 MPID_SendDatatype - 0x00000000005c0634 MPID_IsendDatatype - *fill* 0x00000000005c0801 0x3 90909090 - .text 0x00000000005c0804 0x4df /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x00000000005c0804 MPID_RecvDatatype - 0x00000000005c08d3 MPID_IrecvDatatype - *fill* 0x00000000005c0ce3 0x1 90909090 - .text 0x00000000005c0ce4 0x50d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0x00000000005c0ce4 MPID_Msg_rep - 0x00000000005c0ea6 MPID_Msg_act - 0x00000000005c0f98 MPID_Pack_size - 0x00000000005c101a MPID_Pack - 0x00000000005c1137 MPID_Unpack - *fill* 0x00000000005c11f1 0x3 90909090 - .text 0x00000000005c11f4 0x2fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x00000000005c11f4 MPID_PackMessage - 0x00000000005c12e2 MPID_PackMessageFree - 0x00000000005c132a MPID_UnpackMessageSetup - 0x00000000005c13ad MPID_UnpackMessageComplete - *fill* 0x00000000005c14f2 0x2 90909090 - .text 0x00000000005c14f4 0x33a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x00000000005c14f4 MPID_SsendDatatype - 0x00000000005c1670 MPID_IssendDatatype - *fill* 0x00000000005c182e 0x2 90909090 - .text 0x00000000005c1830 0x1360 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x00000000005c1830 MPID_BSwap_N_inplace - 0x00000000005c1943 MPID_BSwap_N_copy - 0x00000000005c19b2 MPID_Type_swap_copy - 0x00000000005c1b53 MPID_Type_swap_inplace - 0x00000000005c1c66 MPID_Mem_convert_len - 0x00000000005c1ca4 MPID_Mem_XDR_Len - 0x00000000005c1cc5 MPID_Mem_XDR_Init - 0x00000000005c1cf0 MPID_Mem_XDR_Free - 0x00000000005c1d21 MPID_Mem_XDR_Encode - 0x00000000005c1dee MPID_Mem_XDR_ByteEncode - 0x00000000005c1e99 MPID_Mem_XDR_Encode_Logical - 0x00000000005c1f80 MPID_Mem_XDR_Decode - 0x00000000005c208b MPID_Mem_XDR_ByteDecode - 0x00000000005c2152 MPID_Mem_XDR_Decode_Logical - 0x00000000005c2285 MPID_Type_XDR_encode - 0x00000000005c25c5 MPID_Type_XDR_decode - .text 0x00000000005c2b90 0xa13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x00000000005c2b90 MPID_Rndv_print_pkt - 0x00000000005c2cbd MPID_Cancel_print_pkt - 0x00000000005c2d62 MPID_Print_packet - 0x00000000005c2fdc MPID_Get_print_pkt - 0x00000000005c2fea MPID_Print_mode - 0x00000000005c314f MPID_Print_pkt_data - 0x00000000005c31f7 MPID_Print_Send_Handle - 0x00000000005c3234 MPID_SetDebugFile - 0x00000000005c332a MPID_Set_tracefile - 0x00000000005c3420 MPID_SetSpaceDebugFlag - 0x00000000005c3429 MPID_SetDebugFlag - 0x00000000005c3444 MPID_SetMsgDebugFlag - 0x00000000005c3456 MPID_GetMsgDebugFlag - 0x00000000005c3462 MPID_PrintMsgDebug - 0x00000000005c3468 MPID_Print_rhandle - 0x00000000005c34b4 MPID_Print_shandle - 0x00000000005c3510 MPID_Print_Short_data - *fill* 0x00000000005c35a3 0x1 90909090 - .text 0x00000000005c35a4 0x3e6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x00000000005c35a4 MPID_CH_InitMsgPass - 0x00000000005c3788 MPID_CH_Abort - 0x00000000005c380c MPID_CH_End - 0x00000000005c3951 MPID_CH_Version_name - *fill* 0x00000000005c398a 0x2 90909090 - .text 0x00000000005c398c 0xb2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x00000000005c398c MPID_CH_Init_hetero - 0x00000000005c4157 MPID_CH_Comm_msgrep - 0x00000000005c4236 MPID_CH_Pkt_pack - 0x00000000005c4316 MPID_CH_Pkt_unpack - 0x00000000005c43d7 MPID_CH_Hetero_free - 0x00000000005c43fa MPID_GetByteOrder - 0x00000000005c4433 MPID_ByteSwapInt - *fill* 0x00000000005c44bb 0x1 90909090 - .text 0x00000000005c44bc 0x4fa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x00000000005c44bc MPID_P4_Init - 0x00000000005c497b MPID_P4_End - *fill* 0x00000000005c49b6 0x2 90909090 - .text 0x00000000005c49b8 0x90f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x00000000005c49b8 MPID_Dump_queues - 0x00000000005c49c8 MPID_Dump_queue - 0x00000000005c4d34 MPID_Dequeue - 0x00000000005c4ecf MPID_Search_unexpected_for_request - 0x00000000005c4fb3 MPID_Search_unexpected_queue - 0x00000000005c50d6 MPID_Msg_arrived - 0x00000000005c521f MPID_Search_unexpected_queue_and_post - 0x00000000005c527a MPID_InitQueue - *fill* 0x00000000005c52c7 0x1 90909090 - .text 0x00000000005c52c8 0xa18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x00000000005c52c8 MPID_GetIntParameter - 0x00000000005c5304 MPID_ArgSqueeze - 0x00000000005c53b1 MPID_ProcessArgs - .text 0x00000000005c5ce0 0x4f2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x00000000005c5ce0 MPID_SBinit - 0x00000000005c5d98 MPID_SBfree - 0x00000000005c5de3 MPID_SBiAllocate - 0x00000000005c5eef MPID_SBalloc - 0x00000000005c5f84 MPID_SBPrealloc - 0x00000000005c5fc1 MPID_SBdestroy - 0x00000000005c6008 MPID_SBrelease - 0x00000000005c6085 MPID_SBFlush - 0x00000000005c6116 MPID_SBDump - 0x00000000005c6172 MPID_SBReleaseAvail - *fill* 0x00000000005c61d2 0x2 90909090 - .text 0x00000000005c61d4 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x00000000005c61d4 MPID_Process_group_init - *fill* 0x00000000005c624d 0x3 90909090 - .text 0x00000000005c6250 0x954 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x00000000005c6250 MPID_PacketFlowSetup - 0x00000000005c62ee MPID_SendProtoAck - 0x00000000005c64f4 MPID_RecvProtoAck - 0x00000000005c6924 MPID_FinishRecvPackets - 0x00000000005c6b86 MPID_PackDelete - .text 0x00000000005c6ba4 0x809 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x00000000005c6ba4 MPID_SendCancelPacket - 0x00000000005c6d89 MPID_SendCancelOkPacket - 0x00000000005c702b MPID_RecvCancelOkPacket - 0x00000000005c7219 MPID_FinishCancelPackets - *fill* 0x00000000005c73ad 0x3 90909090 - .text 0x00000000005c73b0 0x92 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x00000000005c73b0 MPI_Wait - 0x00000000005c73b0 PMPI_Wait - *fill* 0x00000000005c7442 0x2 90909090 - .text 0x00000000005c7444 0x1f5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x00000000005c7444 PMPI_Cancel - 0x00000000005c7444 MPI_Cancel - *fill* 0x00000000005c7639 0x3 90909090 - .text 0x00000000005c763c 0x232 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x00000000005c763c PMPI_Sendrecv - 0x00000000005c763c MPI_Sendrecv - *fill* 0x00000000005c786e 0x2 90909090 - .text 0x00000000005c7870 0xd2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x00000000005c7870 MPI_Type_extent - 0x00000000005c7870 PMPI_Type_extent - *fill* 0x00000000005c7942 0x2 90909090 - .text 0x00000000005c7944 0x187 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x00000000005c7944 MPI_Type_free - 0x00000000005c7944 PMPI_Type_free - *fill* 0x00000000005c7acb 0x1 90909090 - .text 0x00000000005c7acc 0x84c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x00000000005c7acc MPI_Type_hindexed - 0x00000000005c7acc PMPI_Type_hindexed - .text 0x00000000005c8318 0x10d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x00000000005c8318 PMPI_Type_lb - 0x00000000005c8318 MPI_Type_lb - *fill* 0x00000000005c8425 0x3 90909090 - .text 0x00000000005c8428 0x10b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x00000000005c8428 PMPI_Type_size - 0x00000000005c8428 MPI_Type_size - *fill* 0x00000000005c8533 0x1 90909090 - .text 0x00000000005c8534 0xbaf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x00000000005c8534 PMPI_Type_struct - 0x00000000005c8534 MPI_Type_struct - *fill* 0x00000000005c90e3 0x1 90909090 - .text 0x00000000005c90e4 0x229 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x00000000005c90e4 MPI_Pack_size - 0x00000000005c90e4 PMPI_Pack_size - *fill* 0x00000000005c930d 0x3 90909090 - .text 0x00000000005c9310 0x339 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x00000000005c9310 PMPI_Pack - 0x00000000005c9310 MPI_Pack - *fill* 0x00000000005c9649 0x3 90909090 - .text 0x00000000005c964c 0x30f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x00000000005c964c PMPI_Unpack - 0x00000000005c964c MPI_Unpack - *fill* 0x00000000005c995b 0x1 90909090 - .text 0x00000000005c995c 0xd1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x00000000005c995c MPIR_Breakpoint - *fill* 0x00000000005c9a2d 0x3 90909090 - .text 0x00000000005c9a30 0x198 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x00000000005c9a30 PMPI_Errhandler_set - 0x00000000005c9a30 MPI_Errhandler_set - .text 0x00000000005c9bc8 0xf9f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x00000000005c9bc8 MPIR_Unpack - 0x00000000005c9c9d MPIR_Pack2 - 0x00000000005ca1de MPIR_Unpack2 - 0x00000000005ca766 MPIR_Elementcnt - 0x00000000005ca820 MPIR_Printcontig - 0x00000000005ca889 MPIR_Printcontig2 - 0x00000000005ca8f5 MPIR_Printcontig2a - 0x00000000005ca975 MPIR_PrintDatatypePack - 0x00000000005caa59 MPIR_PrintDatatypeUnpack - *fill* 0x00000000005cab67 0x1 90909090 - .text 0x00000000005cab68 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x00000000005cab68 PMPI_Keyval_create - 0x00000000005cab68 MPI_Keyval_create - *fill* 0x00000000005caba7 0x1 90909090 - .text 0x00000000005caba8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .text 0x00000000005caba8 0xc35 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x00000000005caba8 MD_initmem - 0x00000000005cabb1 MD_initenv - 0x00000000005cabbc MD_malloc_hint - 0x00000000005cabc8 MD_shmalloc - 0x00000000005cabe8 MD_shfree - 0x00000000005cabff MD_set_reference_time - 0x00000000005cac28 MD_clock - 0x00000000005caca2 data_representation - *fill* 0x00000000005cb7dd 0x3 90909090 - .text 0x00000000005cb7e0 0xb3c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x00000000005cb7e0 p4_soft_errors - 0x00000000005cb825 p4_error - 0x00000000005cbbc8 trap_sig_errs - 0x00000000005cc30a p4_set_hard_errors - .text 0x00000000005cc31c 0xf51 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x00000000005cc31c process_args - *fill* 0x00000000005cd26d 0x3 90909090 - .text 0x00000000005cd270 0xb00 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x00000000005cd270 alloc_local_bm - 0x00000000005cd399 alloc_local_rm - 0x00000000005cd4b4 alloc_local_listener - 0x00000000005cd52b alloc_local_slave - 0x00000000005cd62c p4_set_avail_buff - 0x00000000005cd678 init_avail_buffs - 0x00000000005cd6da p4_print_avail_buffs - 0x00000000005cd773 alloc_p4_msg - 0x00000000005cd936 free_p4_msg - 0x00000000005cdab5 free_avail_buffs - 0x00000000005cdb37 alloc_global - 0x00000000005cdcb8 alloc_listener_info - .text 0x00000000005cdd70 0x7cb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x00000000005cdd70 p4_get_dbg_level - 0x00000000005cdd7c p4_set_dbg_level - 0x00000000005cdd8e p4_dprintf - 0x00000000005cdedb p4_dprint_last - 0x00000000005cdee5 p4_dprintfl - 0x00000000005ce049 dump_global - 0x00000000005ce178 dump_local - 0x00000000005ce280 print_conn_type - 0x00000000005ce31d dump_listener - 0x00000000005ce36f dump_procgroup - 0x00000000005ce417 dump_tmsg - 0x00000000005ce46f dump_conntab - *fill* 0x00000000005ce53b 0x1 90909090 - .text 0x00000000005ce53c 0x5a7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x00000000005ce53c p4_alloc_procgroup - 0x00000000005ce595 read_procgroup - 0x00000000005ce946 install_in_proctable - *fill* 0x00000000005ceae3 0x1 90909090 - .text 0x00000000005ceae4 0xcac /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x00000000005ceae4 search_p4_queue - 0x00000000005ced5f p4_recv - 0x00000000005cefb2 recv_message - 0x00000000005cefee p4_any_messages_available - 0x00000000005cf0a7 p4_messages_available - 0x00000000005cf1f4 queue_p4_message - 0x00000000005cf25d send_message - 0x00000000005cf480 get_tmsg - 0x00000000005cf541 p4_msg_alloc - 0x00000000005cf56e p4_msg_free - 0x00000000005cf59c initialize_msg_queue - 0x00000000005cf5d0 alloc_quel - 0x00000000005cf683 free_quel - 0x00000000005cf6d1 free_avail_quels - 0x00000000005cf72b p4_yield - 0x00000000005cf736 p4_waitformsg - .text 0x00000000005cf790 0x512 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x00000000005cf790 p4_moninit - 0x00000000005cf837 p4_menter - 0x00000000005cf841 p4_mexit - 0x00000000005cf84b p4_mdelay - 0x00000000005cf880 p4_mcontinue - 0x00000000005cf8bf num_in_mon_queue - 0x00000000005cf8eb p4_getsub_init - 0x00000000005cf912 p4_getsubs - 0x00000000005cf9bb p4_barrier_init - 0x00000000005cf9d7 p4_barrier - 0x00000000005cfa27 p4_askfor_init - 0x00000000005cfa59 p4_askfor - 0x00000000005cfba8 p4_update - 0x00000000005cfbee p4_probend - 0x00000000005cfc1b p4_progend - 0x00000000005cfc4b p4_create - *fill* 0x00000000005cfca2 0x2 90909090 - .text 0x00000000005cfca4 0x124b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x00000000005cfca4 p4_broadcastx - 0x00000000005cfd52 subtree_broadcast_p4 - 0x00000000005d01c1 p4_global_op - 0x00000000005d0457 p4_dbl_sum_op - 0x00000000005d04a6 p4_dbl_mult_op - 0x00000000005d04f5 p4_dbl_max_op - 0x00000000005d0561 p4_dbl_min_op - 0x00000000005d05cd p4_dbl_absmax_op - 0x00000000005d0744 p4_dbl_absmin_op - 0x00000000005d08bb p4_flt_sum_op - 0x00000000005d090a p4_flt_mult_op - 0x00000000005d0959 p4_flt_max_op - 0x00000000005d09c4 p4_flt_min_op - 0x00000000005d0a2f p4_flt_absmax_op - 0x00000000005d0b95 p4_flt_absmin_op - 0x00000000005d0cfb p4_int_sum_op - 0x00000000005d0d43 p4_int_mult_op - 0x00000000005d0d8b p4_int_max_op - 0x00000000005d0dd9 p4_int_min_op - 0x00000000005d0e27 p4_int_absmax_op - 0x00000000005d0e8b p4_int_absmin_op - *fill* 0x00000000005d0eef 0x1 90909090 - .text 0x00000000005d0ef0 0x12e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x00000000005d0ef0 MPID_SsendContig - 0x00000000005d0f82 MPID_IssendContig - *fill* 0x00000000005d101e 0x2 90909090 - .text 0x00000000005d1020 0x365 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x00000000005d1020 MPID_SendCancel - 0x00000000005d123f MPID_RecvCancel - *fill* 0x00000000005d1385 0x3 90909090 - .text 0x00000000005d1388 0x169b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x00000000005d1388 MPID_CH_Eagerb_send - 0x00000000005d1896 MPID_CH_Eagerb_recv - 0x00000000005d1b72 MPID_CH_Eagerb_unxrecv_start - 0x00000000005d1d9b MPID_CH_Eagerb_save - 0x00000000005d20c7 MPID_CH_Eagerb_isend - 0x00000000005d2616 MPID_CH_Eagerb_cancel_send - 0x00000000005d2625 MPID_CH_Eagerb_irecv - 0x00000000005d2939 MPID_CH_Eagerb_delete - 0x00000000005d2950 MPID_CH_Eagerb_setup - *fill* 0x00000000005d2a23 0x1 90909090 - .text 0x00000000005d2a24 0x2169 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x00000000005d2a24 MPID_CH_Rndvb_isend - 0x00000000005d2e8f MPID_CH_Rndvb_send - 0x00000000005d2fb1 MPID_CH_Rndvb_irecv - 0x00000000005d36a6 MPID_CH_Rndvb_save - 0x00000000005d38c4 MPID_CH_Rndvb_ok_to_send - 0x00000000005d3a76 MPID_CH_Rndvb_unxrecv_start - 0x00000000005d3d4c MPID_CH_Rndvb_unxrecv_end - 0x00000000005d4089 MPID_CH_Rndvb_unxrecv_test_end - 0x00000000005d4301 MPID_CH_Rndvb_ack - 0x00000000005d470f MPID_CH_Rndvb_save_self - 0x00000000005d481f MPID_CH_Rndvb_unxrecv_start_self - 0x00000000005d4aa3 MPID_CH_Rndvb_delete - 0x00000000005d4aba MPID_CH_Rndvb_setup - *fill* 0x00000000005d4b8d 0x3 90909090 - .text 0x00000000005d4b90 0xbe2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x00000000005d4b90 MPID_CH_Check_incoming - *fill* 0x00000000005d5772 0x2 90909090 - .text 0x00000000005d5774 0x160b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0x00000000005d5774 MPID_CH_Eagerb_send_short - 0x00000000005d5e31 MPID_CH_Eagerb_isend_short - 0x00000000005d6516 MPID_CH_Eagerb_recv_short - 0x00000000005d67b5 MPID_CH_Eagerb_unxrecv_start_short - 0x00000000005d69de MPID_CH_Eagerb_save_short - 0x00000000005d6c95 MPID_CH_Eagerb_short_delete - 0x00000000005d6cac MPID_CH_Short_setup - *fill* 0x00000000005d6d7f 0x1 90909090 - .text 0x00000000005d6d80 0x427 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x00000000005d6d80 MPID_FlowDebug - 0x00000000005d6d92 MPID_SendFlowPacket - 0x00000000005d6ee7 MPID_RecvFlowPacket - 0x00000000005d6f54 MPID_FlowSetup - 0x00000000005d7048 MPID_FlowDelete - 0x00000000005d705a MPID_FlowDump - *fill* 0x00000000005d71a7 0x1 90909090 - .text 0x00000000005d71a8 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x00000000005d71a8 MPIR_Pack_Hvector - 0x00000000005d73ef MPIR_UnPack_Hvector - 0x00000000005d7621 MPIR_HvectorLen - *fill* 0x00000000005d7639 0x7 90909090 - .text 0x00000000005d7640 0x1ea9 xdrf_em64/libxdrf.a(libxdrf.o) - 0x00000000005d7640 xdrfsetpos_ - 0x00000000005d765c xdrf_ - 0x00000000005d7676 xdrfvector_ - 0x00000000005d7a97 xdrfint_ - 0x00000000005d7ab6 xdrffloat_ - 0x00000000005d7ad5 xdrfopaque_ - 0x00000000005d7caa xdr3dfcoord - 0x00000000005d8fa0 xdrf3dfcoord_ - 0x00000000005d8fb8 xdrclose - 0x00000000005d905a xdrfclose_ - 0x00000000005d907c xdropen - 0x00000000005d91b2 xdrfopen_ - 0x00000000005d925c xdrfwrapstring_ - 0x00000000005d9322 xdrfstring_ - 0x00000000005d93f3 xdrfushort_ - 0x00000000005d9412 xdrfulong_ - 0x00000000005d9431 xdrfuchar_ - 0x00000000005d944f xdrfshort_ - 0x00000000005d946e xdrflong_ - 0x00000000005d948d xdrfdouble_ - 0x00000000005d94ac xdrfchar_ - 0x00000000005d94ca xdrfbool_ - *fill* 0x00000000005d94e9 0x3 90909090 - .text 0x00000000005d94ec 0x9d xdrf_em64/libxdrf.a(ftocstr.o) - 0x00000000005d94ec ftocstr - 0x00000000005d954f ctofstr - *fill* 0x00000000005d9589 0x7 90909090 - .text 0x00000000005d9590 0x430 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0x00000000005d9590 etime_ - 0x00000000005d9660 dtime_ - 0x00000000005d9820 dtimer8_ - .text 0x00000000005d99c0 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x00000000005d99c0 fdate_ - .text 0x00000000005d9a60 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x00000000005d9a60 flush_ - .text 0x00000000005d9a70 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x00000000005d9a70 getenv_ - .text 0x00000000005d9bf0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x00000000005d9bf0 system_ - .text 0x00000000005d9c30 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x00000000005d9c30 allocCstr - 0x00000000005d9ce0 deallocCstr - .text 0x00000000005d9cf0 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x00000000005d9cf0 CstrToFstr - .text 0x00000000005d9e40 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x00000000005d9e40 for_close - 0x00000000005da4b0 for__close_args - 0x00000000005da5e0 for__close_default - .text 0x00000000005da790 0x740 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x00000000005da790 for__close_proc - .text 0x00000000005daed0 0xc90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000005daed0 for__desc_ret_item - 0x00000000005db200 for__key_desc_ret_item - 0x00000000005db520 for__desc_test_item - 0x00000000005db7a0 for__desc_zero_length_item - .text 0x00000000005dbb60 0x3550 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x00000000005dbb60 for__io_return - 0x00000000005dc6a0 for__issue_diagnostic - 0x00000000005dcd70 for__get_msg - 0x00000000005dcf70 for_emit_diagnostic - 0x00000000005dd0f0 for__message_catalog_close - 0x00000000005dd490 for_errmsg - 0x00000000005dd670 for__rtc_uninit_use - 0x00000000005dd690 TRACEBACKQQ - 0x00000000005dd8b0 tracebackqq_ - 0x00000000005ddae0 for_perror_ - 0x00000000005de7c0 for_gerror_ - .text 0x00000000005df0b0 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0x00000000005df0b0 for_errsns_load - 0x00000000005df0f0 for_errsns_w - 0x00000000005df1e0 for_errsns - .text 0x00000000005df2d0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x00000000005df2d0 for__fpe_exit_handler - 0x00000000005df3b0 for__exit_handler - .text 0x00000000005df5b0 0x610 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x00000000005df5b0 for_nargs - 0x00000000005df5c0 for_iargc - 0x00000000005df5e0 for_getarg - 0x00000000005df720 for_getarg_i2 - 0x00000000005df860 nargs_ - 0x00000000005df870 iargc_ - 0x00000000005df890 iarg_ - 0x00000000005df8b0 numarg_ - 0x00000000005df8d0 getarg_ - 0x00000000005df9d0 for_getcmd_arg - .text 0x00000000005dfbc0 0x2310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x00000000005dfbc0 for_setup_mxcsr - 0x00000000005dfc80 for__signal_handler - 0x00000000005e0a70 for_enable_underflow - 0x00000000005e0a90 for_get_fpe_ - 0x00000000005e0aa0 for_set_fpe_ - 0x00000000005e0d50 for_get_fpe_counts_ - 0x00000000005e0da0 for_rtl_finish_ - 0x00000000005e0dc0 dump_dfil_exception_info - 0x00000000005e1ca0 for_rtl_init_ - .text 0x00000000005e1ed0 0x5eb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x00000000005e1ed0 for_inquire - .text 0x00000000005e7d80 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x00000000005e7d80 for__adjust_buffer - 0x00000000005e8010 for__lower_bound_index - 0x00000000005e8060 for__cvt_foreign_read - 0x00000000005e8220 for__cvt_foreign_write - 0x00000000005e8650 for__cvt_foreign_check - 0x00000000005e86e0 for_check_env_name - .text 0x00000000005e87b0 0x1ea0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x00000000005e87b0 for__create_lub - 0x00000000005e8930 for__release_lun - 0x00000000005e8c70 for__deallocate_lub - 0x00000000005e8cc0 for__acquire_lun - 0x00000000005e9bf0 for__get_next_lub - 0x00000000005ea1c0 for__preconnected_units_create - 0x00000000005ea410 for__default_io_sizes_env_init - .text 0x00000000005ea650 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x00000000005ea650 for__add_to_lf_table - 0x00000000005ea920 for__rm_from_lf_table - .text 0x00000000005ea9b0 0x5960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x00000000005ea9b0 SetEndian - 0x00000000005ead10 CheckStreamRecortType - 0x00000000005eb150 CheckEndian - 0x00000000005eb500 for_open - 0x00000000005ec9f0 for__update_reopen_keywords - 0x00000000005edbf0 for__set_foreign_bits - 0x00000000005eeba0 for__open_key - 0x00000000005eee50 for__open_args - 0x00000000005ef580 for__find_iomsg - 0x00000000005ef630 for__set_terminator_option - 0x00000000005efa70 for__set_conversion_option - 0x00000000005efd80 for__is_special_device - 0x00000000005eff30 for__open_default - .text 0x00000000005f0310 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x00000000005f0310 for_pause - .text 0x00000000005f0630 0x2090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x00000000005f0630 for__put_su - 0x00000000005f0cf0 for__write_output - 0x00000000005f1040 for__put_sf - 0x00000000005f2250 for__put_d - 0x00000000005f2580 for__flush_readahead - .text 0x00000000005f26c0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x00000000005f26c0 for_set_reentrancy - 0x00000000005f2710 for__reentrancy_cleanup - 0x00000000005f2770 for__disable_asynch_deliv_private - 0x00000000005f2790 for__enable_asynch_deliv_private - 0x00000000005f27b0 for__once_private - 0x00000000005f2810 for__reentrancy_init - .text 0x00000000005f29a0 0x1350 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x00000000005f29a0 for_rewind - .text 0x00000000005f3cf0 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x00000000005f3cf0 for_read_int_fmt - 0x00000000005f53c0 for_read_int_fmt_xmit - .text 0x00000000005f6ff0 0x4000 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x00000000005f6ff0 for_read_int_lis - 0x00000000005f8510 for_read_int_lis_xmit - 0x00000000005facb0 for_ri_cvt_2step - .text 0x00000000005faff0 0x4010 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x00000000005faff0 for_read_seq - 0x00000000005fd060 for_read_seq_xmit - .text 0x00000000005ff000 0x40f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x00000000005ff000 for_read_seq_fmt - 0x0000000000600f60 for_read_seq_fmt_xmit - 0x0000000000602ef0 for__read_args - .text 0x00000000006030f0 0x5250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x00000000006030f0 for_read_seq_lis - 0x0000000000604d40 for_read_seq_lis_xmit - 0x0000000000608100 for__swallow_imaginary_part - .text 0x0000000000608340 0x1f40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x0000000000608340 for_abort - 0x0000000000608d30 for_stop_core - 0x0000000000609910 for_stop - .text 0x000000000060a280 0xdc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x000000000060a280 for__set_signal_ops_during_vm - 0x000000000060a2b0 for__get_vm - 0x000000000060a3c0 for__realloc_vm - 0x000000000060a4b0 for__free_vm - 0x000000000060a520 for_allocate - 0x000000000060a790 for_alloc_allocatable - 0x000000000060aa10 for_deallocate - 0x000000000060ab70 for_dealloc_allocatable - 0x000000000060ad00 for_check_mult_overflow - 0x000000000060ae20 for_check_mult_overflow64 - 0x000000000060afe0 for__spec_align_alloc - 0x000000000060b030 for__spec_align_free - .text 0x000000000060b040 0x33e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x000000000060b040 for_write_int_fmt - 0x000000000060c750 for_write_int_fmt_xmit - .text 0x000000000060e420 0x7c30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x000000000060e420 for_write_seq - 0x0000000000610380 for_write_seq_xmit - 0x0000000000615b80 for__finish_ufseq_write - .text 0x0000000000616050 0x4940 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x0000000000616050 for_write_seq_fmt - 0x0000000000618200 for_write_seq_fmt_xmit - 0x000000000061a810 for__write_args - .text 0x000000000061a990 0x6b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x000000000061a990 for_write_seq_lis - 0x000000000061c9e0 for_write_seq_lis_xmit - .text 0x0000000000621500 0x330 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x0000000000621500 for_index_back - 0x0000000000621690 for_f90_index - .text 0x0000000000621830 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x0000000000621830 for_fp_class_s_ - 0x00000000006218f0 for_is_nan_s_ - 0x0000000000621920 for_fp_class_t_ - 0x00000000006219e0 for_is_nan_t_ - 0x0000000000621a20 for_fp_class_x_ - 0x0000000000621af0 for_is_nan_x_ - .text 0x0000000000621b30 0xf90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x0000000000621b30 for_cpystr - 0x0000000000621bc0 for_cpstr_gt - 0x0000000000621dd0 for_cpstr_lt - 0x0000000000621fe0 for_cpstr_eq - 0x0000000000622160 for_cpstr_ne - 0x00000000006222f0 for_cpstr_ge - 0x0000000000622500 for_cpstr_le - 0x0000000000622710 for_cpstr - 0x00000000006228d0 for_concat - .text 0x0000000000622ac0 0x2190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x0000000000622ac0 __msportlib_d_gethandle - 0x0000000000622d40 __msportlib_set_posix_io_flag - 0x0000000000622d50 __msportlib_d_curpos - 0x0000000000622e40 __msportlib_d_curpos_i8 - 0x0000000000622f20 __msportlib_d_fseek - 0x00000000006230d0 __msportlib_d_fseek_i8 - 0x00000000006232c0 __msportlib_d_readchar - 0x00000000006238b0 __msportlib_d_writechar - 0x00000000006247e0 commitqq_ - 0x00000000006248b0 flushqq_ - 0x0000000000624940 set_keypress - 0x00000000006249d0 reset_keypress - 0x00000000006249f0 getstrqq_ - 0x0000000000624ac0 getcharqq_ - 0x0000000000624b50 peekcharqq_ - .text 0x0000000000624c50 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x0000000000624c50 r_int - 0x0000000000624c70 r_int_val - 0x0000000000624c80 d_int - 0x0000000000624ca0 d_int_val - 0x0000000000624cb0 h_nint - 0x0000000000624cd0 i_nint - 0x0000000000624cf0 k_nint - 0x0000000000624d10 r_nint - 0x0000000000624d90 f_lanint_val - 0x0000000000624e10 b_nint - 0x0000000000624e30 i_dnnt - 0x0000000000624e50 h_dnnt - 0x0000000000624e70 b_dnnt - 0x0000000000624e90 k_dnnt - 0x0000000000624eb0 d_nint - 0x0000000000624f30 f_ldnint_val - .text 0x0000000000624fb0 0x1400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x0000000000626190 tbk_stack_trace - .text 0x00000000006263b0 0x5540 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x00000000006263b0 for__aio_acquire_lun_fname - 0x00000000006266b0 for__aio_release_lun - 0x0000000000626bd0 for__aio_release - 0x0000000000626f30 for__aio_acquire_lun - 0x0000000000627760 for__aio_destroy - 0x0000000000627ba0 for_asynchronous - 0x00000000006288e0 for_waitid - 0x0000000000629d70 for_wait - 0x000000000062af80 for__aio_error_handling - 0x000000000062b740 for__aio_init - .text 0x000000000062b8f0 0x63b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x000000000062b8f0 for__compute_filename - 0x000000000062d330 for__open_proc - 0x0000000000630fc0 for__reopen_file - 0x0000000000631c90 for__decl_exit_hand - .text 0x0000000000631ca0 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x0000000000631ca0 for__aio_pthread_self - 0x0000000000631cb0 for__aio_pthread_create - 0x0000000000631cd0 for__aio_pthread_cancel - 0x0000000000631ce0 for__aio_pthread_mutex_lock - 0x0000000000631cf0 for__aio_pthread_mutex_unlock - 0x0000000000631d00 for__aio_pthread_cond_wait - 0x0000000000631d10 for__aio_pthread_cond_signal - 0x0000000000631d20 for__aio_pthread_mutex_init - 0x0000000000631d30 for__aio_pthread_exit - .text 0x0000000000631d40 0x630 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x0000000000631d40 cvt_text_to_integer - 0x0000000000631ef0 cvt_text_to_unsigned64 - 0x0000000000632190 cvt_text_to_unsigned - 0x00000000006321f0 cvt_text_to_integer64 - .text 0x0000000000632370 0xe30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x0000000000632370 cvt_vax_f_to_ieee_single_ - 0x0000000000632820 CVT_VAX_F_TO_IEEE_SINGLE - 0x0000000000632cd0 cvt_vax_f_to_ieee_single - .text 0x00000000006331a0 0x1080 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x00000000006331a0 cvt_vax_d_to_ieee_double_ - 0x0000000000633710 CVT_VAX_D_TO_IEEE_DOUBLE - 0x0000000000633c80 cvt_vax_d_to_ieee_double - .text 0x0000000000634220 0x1090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x0000000000634220 cvt_vax_g_to_ieee_double_ - 0x0000000000634790 CVT_VAX_G_TO_IEEE_DOUBLE - 0x0000000000634d00 cvt_vax_g_to_ieee_double - .text 0x00000000006352b0 0x21a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x00000000006352b0 cvt_cray_to_ieee_single_ - 0x00000000006357e0 CVT_CRAY_TO_IEEE_SINGLE - 0x0000000000635d10 cvt_cray_to_ieee_single - 0x0000000000636280 cvt_cray_to_ieee_double_ - 0x0000000000636850 CVT_CRAY_TO_IEEE_DOUBLE - 0x0000000000636e20 cvt_cray_to_ieee_double - .text 0x0000000000637450 0xf00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x0000000000637450 cvt_ibm_short_to_ieee_single_ - 0x0000000000637940 CVT_IBM_SHORT_TO_IEEE_SINGLE - 0x0000000000637e30 cvt_ibm_short_to_ieee_single - .text 0x0000000000638350 0x11d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x0000000000638350 cvt_ibm_long_to_ieee_double_ - 0x0000000000638910 CVT_IBM_LONG_TO_IEEE_DOUBLE - 0x0000000000638ed0 cvt_ibm_long_to_ieee_double - .text 0x0000000000639520 0x4760 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0x0000000000639520 cvt_ieee_double_to_cray_ - 0x0000000000639a00 CVT_IEEE_DOUBLE_TO_CRAY - 0x0000000000639ee0 cvt_ieee_double_to_cray - 0x000000000063a400 cvt_ieee_double_to_ibm_long_ - 0x000000000063a950 CVT_IEEE_DOUBLE_TO_IBM_LONG - 0x000000000063aea0 cvt_ieee_double_to_ibm_long - 0x000000000063b410 cvt_ieee_double_to_vax_d_ - 0x000000000063b840 CVT_IEEE_DOUBLE_TO_VAX_D - 0x000000000063bc70 cvt_ieee_double_to_vax_d - 0x000000000063c110 cvt_ieee_double_to_vax_g_ - 0x000000000063c540 CVT_IEEE_DOUBLE_TO_VAX_G - 0x000000000063c970 cvt_ieee_double_to_vax_g - 0x000000000063ce10 cvt_ieee_double_to_vax_h_ - 0x000000000063d2c0 CVT_IEEE_DOUBLE_TO_VAX_H - 0x000000000063d770 cvt_ieee_double_to_vax_h - .text 0x000000000063dc80 0x2360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x000000000063dc80 cvt_ieee_single_to_cray_ - 0x000000000063e0a0 CVT_IEEE_SINGLE_TO_CRAY - 0x000000000063e4c0 cvt_ieee_single_to_cray - 0x000000000063e910 cvt_ieee_single_to_ibm_short_ - 0x000000000063ed30 CVT_IEEE_SINGLE_TO_IBM_SHORT - 0x000000000063f150 cvt_ieee_single_to_ibm_short - 0x000000000063f5b0 cvt_ieee_single_to_vax_f_ - 0x000000000063f8f0 CVT_IEEE_SINGLE_TO_VAX_F - 0x000000000063fc30 cvt_ieee_single_to_vax_f - .text 0x000000000063ffe0 0x1d30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x000000000063ffe0 for__common_inquire - 0x0000000000641550 for__inquire_args - .text 0x0000000000641d10 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x0000000000641d10 for_exit - .text 0x0000000000641d30 0x2dd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x0000000000641d30 for__format_compiler - .text 0x0000000000644b00 0x1660 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x0000000000644b00 for__format_value - 0x0000000000645690 for__cvt_value - .text 0x0000000000646160 0x1840 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x0000000000646160 for__get_s - 0x00000000006474d0 for__read_input - 0x00000000006475e0 for__get_d - .text 0x00000000006479a0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x00000000006479a0 for_index - 0x0000000000647a20 for_string_index - 0x0000000000647aa0 for_index_ssll - .text 0x0000000000647b20 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x0000000000647b20 for__interp_fmt - .text 0x00000000006489a0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .text 0x00000000006489a0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .text 0x00000000006489a0 0xa60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x00000000006489a0 cvt_integer_to_text - 0x0000000000648c50 cvt_unsigned_to_text - 0x0000000000648ec0 cvt_integer64_to_text - 0x0000000000649180 cvt_unsigned64_to_text - .text 0x0000000000649400 0x8e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x0000000000649400 cvt_data_to_text - 0x0000000000649870 cvt_data64_to_text - .text 0x0000000000649ce0 0xb50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x0000000000649ce0 cvt_boolean_to_text - 0x000000000064a0a0 cvt_boolean_to_text_ex - 0x000000000064a480 cvt_boolean64_to_text - .text 0x000000000064a830 0x5c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x000000000064a830 cvt_text_to_data - 0x000000000064ab50 cvt_text_to_data64 - .text 0x000000000064adf0 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x000000000064adf0 cvt_text_to_boolean - 0x000000000064af10 cvt_text_to_boolean64 - .text 0x000000000064b040 0x25c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x000000000064b040 cvt_ieee_t_to_text_ex - 0x000000000064c3b0 cvt_ieee_t_to_text - 0x000000000064d560 cvt_text_to_ieee_t_ex - .text 0x000000000064d600 0x2530 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x000000000064d600 cvt_ieee_s_to_text_ex - 0x000000000064e920 cvt_ieee_s_to_text - 0x000000000064fa90 cvt_text_to_ieee_s_ex - .text 0x000000000064fb30 0x14e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x000000000064fb30 cvt_ieee_x_to_text - 0x000000000064fb80 cvt_ieee_x_to_text_ex - 0x0000000000650f70 cvt_text_to_ieee_x_ex - .text 0x0000000000651010 0x15a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x0000000000651010 cvtas_a_to_s - .text 0x00000000006525b0 0x2f00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x00000000006525b0 cvtas_a_to_t - .text 0x00000000006554b0 0x5bb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x00000000006554b0 cvtas_s_to_a - .text 0x000000000065b060 0x5d00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0x000000000065b060 cvtas_t_to_a - .text 0x0000000000660d60 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x0000000000660d60 cvtas_string_to_nan_s - .text 0x0000000000660de0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x0000000000660de0 cvtas_string_to_nan_t - .text 0x0000000000660e50 0x5ed0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x0000000000660e50 cvtas_a_to_x - .text 0x0000000000666d20 0x5f80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0x0000000000666d20 cvtas_x_to_a - .text 0x000000000066cca0 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x000000000066cca0 cvtas_string_to_nan_x - .text 0x000000000066cd60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .text 0x000000000066cd60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .text 0x000000000066cd60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .text 0x000000000066cd60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .text 0x000000000066cd60 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x000000000066cd60 acos - .text 0x000000000066d240 0x510 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x000000000066d240 asin - .text 0x000000000066d750 0x570 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x000000000066d750 atan2 - .text 0x000000000066dcc0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - 0x000000000066dcc0 cbrt - .text 0x000000000066dcf0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - 0x000000000066dcf0 cos - .text 0x000000000066dd30 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - 0x000000000066dd30 exp2 - .text 0x000000000066dd60 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - 0x000000000066dd60 expf - .text 0x000000000066dd90 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - 0x000000000066dd90 exp - .text 0x000000000066ddc0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - 0x000000000066ddc0 fmod - .text 0x000000000066ddf0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x000000000066ddf0 __powi4i4 - .text 0x000000000066de60 0xb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x000000000066de60 __powr8i4 - .text 0x000000000066df10 0x66c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x000000000066e060 __libm_error_support - 0x0000000000674570 __libm_setusermatherrl - 0x0000000000674590 __libm_setusermatherr - 0x00000000006745b0 __libm_setusermatherrf - .text 0x00000000006745d0 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x00000000006745d0 __libm_sse2_sincos - .text 0x0000000000674950 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - 0x0000000000674950 llroundf - .text 0x0000000000674980 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - 0x0000000000674980 llround - .text 0x00000000006749b0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - 0x00000000006749b0 log10 - .text 0x00000000006749e0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - 0x00000000006749e0 logf - .text 0x0000000000674a10 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - 0x0000000000674a10 log - .text 0x0000000000674a40 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - 0x0000000000674a40 lroundf - .text 0x0000000000674a70 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - 0x0000000000674a70 lround - .text 0x0000000000674aa0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x0000000000674aa0 matherrf - .text 0x0000000000674ab0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x0000000000674ab0 matherrl - .text 0x0000000000674ac0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x0000000000674ac0 matherr - .text 0x0000000000674ad0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - 0x0000000000674ad0 pow - .text 0x0000000000674b00 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - 0x0000000000674b00 sin - .text 0x0000000000674b40 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x0000000000674b40 sqrt - .text 0x0000000000674b90 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - 0x0000000000674b90 tan - .text 0x0000000000674bc0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x0000000000674bc0 truncf - .text 0x0000000000674c20 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - 0x0000000000674c20 trunc - .text 0x0000000000674c60 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x0000000000674c60 cbrt.L - .text 0x0000000000674ec0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x0000000000674ec0 cbrt.A - .text 0x00000000006750a0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x00000000006750a0 cos.L - .text 0x00000000006756e0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x00000000006756e0 cos.A - .text 0x0000000000675d20 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x0000000000675d20 cos.N - .text 0x0000000000676360 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x0000000000676360 exp2.L - .text 0x0000000000676650 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0x0000000000676650 exp2.A - .text 0x0000000000676bd0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x0000000000676bd0 exp.L - .text 0x0000000000676eb0 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x0000000000676eb0 expf.L - .text 0x00000000006770b0 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x00000000006770b0 expf.A - .text 0x00000000006772b0 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x00000000006772b0 exp.A - .text 0x0000000000677590 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .text 0x0000000000677590 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x0000000000677590 fmod.L - .text 0x0000000000677ab0 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0x0000000000677ab0 fmod.A - .text 0x0000000000677c70 0x500 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x0000000000677c70 __libm_reduce_pio2d - .text 0x0000000000678170 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x0000000000678170 llround.L - .text 0x00000000006782c0 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x00000000006782c0 llroundf.L - .text 0x00000000006783d0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x00000000006783d0 llroundf.A - .text 0x00000000006784b0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x00000000006784b0 llround.A - .text 0x0000000000678590 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x0000000000678590 log10.L - .text 0x0000000000678840 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x0000000000678840 log10.A - .text 0x0000000000678af0 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x0000000000678af0 log.L - .text 0x0000000000678d50 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x0000000000678d50 logf.L - .text 0x0000000000678f10 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0x0000000000678f10 logf.A - .text 0x0000000000679130 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .text 0x0000000000679130 0x270 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x0000000000679130 log.A - .text 0x00000000006793a0 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x00000000006793a0 lround.L - .text 0x00000000006794f0 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x00000000006794f0 lroundf.L - .text 0x0000000000679600 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x0000000000679600 lroundf.A - .text 0x00000000006796e0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x00000000006796e0 lround.A - .text 0x00000000006797c0 0x1010 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x00000000006797c0 pow.L - .text 0x000000000067a7d0 0xbb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x000000000067a7d0 pow.A - .text 0x000000000067b380 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .text 0x000000000067b380 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x000000000067b380 sin.L - .text 0x000000000067b9d0 0x660 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x000000000067b9d0 sin.A - .text 0x000000000067c030 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x000000000067c030 sin.N - .text 0x000000000067c680 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x000000000067c680 tan.L - .text 0x000000000067ce70 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x000000000067ce70 tan.A - .text 0x000000000067d660 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x000000000067d660 trunc.L - .text 0x000000000067d6c0 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x000000000067d6c0 trunc.A - .text 0x000000000067d750 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x000000000067d750 trunc.N - .text 0x000000000067d760 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x000000000067d760 vmldCos2 - 0x000000000067d770 __svml_cos2 - 0x000000000067d7c0 vmldCos2Mask - 0x000000000067d7d0 __svml_cos2_mask - .text 0x000000000067d7f0 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x000000000067d7f0 vmldSin2 - 0x000000000067d800 __svml_sin2 - 0x000000000067d850 vmldSin2Mask - 0x000000000067d860 __svml_sin2_mask - .text 0x000000000067d880 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0x000000000067d880 __svml_cos2.R - .text 0x000000000067e1e0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0x000000000067e1e0 __svml_sin2.R - .text 0x000000000067eb40 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0x000000000067eb40 __svml_cos2.N - .text 0x000000000067f4a0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0x000000000067f4a0 __svml_sin2.N - .text 0x000000000067fe00 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0x000000000067fe00 __svml_cos2.L - .text 0x0000000000680750 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0x0000000000680750 __svml_sin2.L - .text 0x00000000006810b0 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0x00000000006810b0 __svml_cos2.A - .text 0x0000000000681a00 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0x0000000000681a00 __svml_sin2.A - .text 0x0000000000682360 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x0000000000682360 __qtoj - 0x0000000000682500 __qtok - 0x0000000000682620 __qtoi - 0x0000000000682760 __qtou - .text 0x0000000000682840 0x7c0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x0000000000682840 __qtod - 0x0000000000682b30 __qtol - 0x0000000000682d60 __qtof - .text 0x0000000000683000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x0000000000683000 a_divq - .text 0x0000000000683010 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x0000000000683010 a_mulq - .text 0x0000000000683020 0x4a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x0000000000683020 tbk_string_stack_signal - .text 0x00000000006834c0 0x1210 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x00000000006834c0 tbk_getPC - 0x00000000006834d0 tbk_getRetAddr - 0x00000000006834e0 tbk_getFramePtr - 0x00000000006834f0 tbk_getModuleName - 0x0000000000683820 tbk_get_pc_info - 0x00000000006842d0 tbk_geterrorstring - 0x00000000006843e0 tbk_trace_stack - .text 0x00000000006846d0 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x00000000006846d0 _intel_fast_memcmp - .text 0x0000000000684820 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x0000000000684820 __intel_cpu_indicator_init - .text 0x00000000006849b0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x00000000006849b0 _intel_fast_memcpy.A - 0x00000000006849c0 _intel_fast_memcpy.J - 0x00000000006849d0 _intel_fast_memcpy - .text 0x0000000000684a00 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x0000000000684a00 _intel_fast_memset.A - 0x0000000000684a10 _intel_fast_memset.J - 0x0000000000684a20 _intel_fast_memset - .text 0x0000000000684a50 0x1780 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x0000000000684b40 __intel_new_proc_init - 0x0000000000684b70 __intel_new_proc_init.H - 0x0000000000684c50 __intel_new_proc_init.A - 0x0000000000684c60 __intel_proc_init - 0x0000000000684c90 __intel_proc_init.H - 0x0000000000684d10 __intel_proc_init.A - 0x0000000000684d20 __intel_new_proc_init_G - 0x0000000000684d50 __intel_new_proc_init_G.R - 0x0000000000684dc0 __intel_new_proc_init_G.A - 0x0000000000684e40 __intel_new_proc_init_H - 0x0000000000684e70 __intel_new_proc_init_H.P - 0x0000000000684ed0 __intel_new_proc_init_H.A - 0x0000000000684f50 __intel_new_proc_init_L - 0x0000000000684f90 __intel_new_proc_init_L.O - 0x0000000000685060 __intel_new_proc_init_L.M - 0x0000000000685110 __intel_new_proc_init_L.A - 0x0000000000685190 __intel_new_proc_init_S - 0x00000000006851c0 __intel_new_proc_init_S.N - 0x0000000000685290 __intel_new_proc_init_S.A - 0x0000000000685310 __intel_new_proc_init_T - 0x0000000000685340 __intel_new_proc_init_T.M - 0x0000000000685410 __intel_new_proc_init_T.A - 0x0000000000685490 __intel_proc_init_T - 0x00000000006854c0 __intel_proc_init_T.M - 0x00000000006854f0 __intel_proc_init_T.A - 0x0000000000685570 __intel_new_proc_init_P - 0x00000000006855a0 __intel_new_proc_init_P.L - 0x0000000000685670 __intel_new_proc_init_P.A - 0x00000000006856f0 __intel_proc_init_P - 0x0000000000685720 __intel_proc_init_P.L - 0x0000000000685750 __intel_proc_init_P.A - 0x00000000006857d0 __intel_new_proc_init_B - 0x0000000000685820 __intel_new_proc_init_B.L - 0x00000000006858f0 __intel_new_proc_init_B.K - 0x00000000006859c0 __intel_new_proc_init_B.J - 0x0000000000685aa0 __intel_new_proc_init_B.A - 0x0000000000685b20 __intel_proc_init_B - 0x0000000000685b70 __intel_proc_init_B.L - 0x0000000000685ba0 __intel_proc_init_B.K - 0x0000000000685bd0 __intel_proc_init_B.J - 0x0000000000685c50 __intel_proc_init_B.A - 0x0000000000685cd0 __intel_new_proc_init_N - 0x0000000000685d20 __intel_new_proc_init_N.L - 0x0000000000685df0 __intel_new_proc_init_N.K - 0x0000000000685ec0 __intel_new_proc_init_N.J - 0x0000000000685fa0 __intel_new_proc_init_N.A - 0x0000000000686020 __intel_proc_init_N - 0x0000000000686070 __intel_proc_init_N.L - 0x00000000006860a0 __intel_proc_init_N.K - 0x00000000006860d0 __intel_proc_init_N.J - 0x0000000000686150 __intel_proc_init_N.A - .text 0x00000000006861d0 0x1590 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x00000000006861d0 __mulq.L - 0x0000000000686c80 __mulq.A - 0x0000000000687730 __mulq - .text 0x0000000000687760 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0x0000000000687760 __divq.L - 0x0000000000688540 __divq.A - 0x0000000000689320 __divq - .text 0x0000000000689350 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x0000000000689350 __intel_sse2_strlen - 0x0000000000689380 __intel_sse4_strlen - .text 0x00000000006893a0 0x23e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - 0x00000000006893a0 __intel_new_memcpy - .text 0x000000000068b780 0x1220 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - 0x000000000068b780 __intel_new_memset - .text 0x000000000068c9a0 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x000000000068c9a0 irc__get_msg - 0x000000000068cb90 irc__print - .text 0x000000000068cde0 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000068cde0 __intel_get_mem_ops_method - 0x000000000068d1c0 __intel_set_memcpy_largest_cache_size - 0x000000000068d5d0 __intel_set_memcpy_largest_cachelinesize - 0x000000000068d9f0 __intel_get_memcpy_largest_cache_size - 0x000000000068ddf0 __intel_get_memcpy_largest_cachelinesize - 0x000000000068e200 __intel_init_mem_ops_method - 0x000000000068e5d0 __intel_override_mem_ops_method - .text 0x000000000068e9d0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - 0x000000000068e9d0 __intel_get_new_mem_ops_cpuid - 0x000000000068ea00 __intel_get_new_mem_ops_cpuid4 - .text 0x000000000068ea50 0x99 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x000000000068ea50 __libc_csu_fini - 0x000000000068ea60 __libc_csu_init - *fill* 0x000000000068eae9 0x7 90909090 - .text 0x000000000068eaf0 0x36 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - *fill* 0x000000000068eb26 0x2 90909090 - .text 0x000000000068eb28 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(.gnu.warning) - -.fini 0x000000000068eb28 0xe - *(.fini) - .fini 0x000000000068eb28 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x000000000068eb28 _fini - .fini 0x000000000068eb2c 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .fini 0x000000000068eb31 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x000000000068eb36 PROVIDE (__etext, .) - 0x000000000068eb36 PROVIDE (_etext, .) - 0x000000000068eb36 PROVIDE (etext, .) - -.rodata 0x000000000068eb40 0x5b580 - *(.rodata .rodata.* .gnu.linkonce.r.*) - .rodata.cst4 0x000000000068eb40 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000068eb40 _IO_stdin_used - *fill* 0x000000000068eb44 0x4 00 - .rodata 0x000000000068eb48 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - 0x000000000068eb48 __dso_handle - *fill* 0x000000000068eb50 0x10 00 - .rodata 0x000000000068eb60 0x500 unres.o - .rodata.str1.32 - 0x000000000068f060 0xf3 unres.o - 0xf4 (size before relaxing) - *fill* 0x000000000068f153 0x1 00 - .rodata.str1.4 - 0x000000000068f154 0x20f unres.o - 0x29c (size before relaxing) - *fill* 0x000000000068f363 0xd 00 - .rodata 0x000000000068f370 0x30 arcos.o - .rodata 0x000000000068f3a0 0x180 cartprint.o - .rodata 0x000000000068f520 0x38 chainbuild.o - .rodata 0x000000000068f558 0x30 convert.o - *fill* 0x000000000068f588 0x8 00 - .rodata 0x000000000068f590 0x340 initialize_p.o - .rodata.str1.4 - 0x000000000068f8d0 0x13a initialize_p.o - 0x154 (size before relaxing) - *fill* 0x000000000068fa0a 0x2 00 - .rodata.str1.32 - 0x000000000068fa0c 0x15d initialize_p.o - 0x160 (size before relaxing) - *fill* 0x000000000068fb69 0x7 00 - .rodata 0x000000000068fb70 0x1760 readrtns_CSA.o - .rodata.str1.4 - 0x00000000006912d0 0x1141 readrtns_CSA.o - 0x142c (size before relaxing) - *fill* 0x0000000000692411 0x3 00 - .rodata.str1.32 - 0x0000000000692414 0xbef readrtns_CSA.o - 0xde4 (size before relaxing) - *fill* 0x0000000000693003 0x1 00 - .rodata.str1.4 - 0x0000000000693004 0x517 parmread.o - 0x65c (size before relaxing) - *fill* 0x000000000069351b 0x5 00 - .rodata 0x0000000000693520 0xdb0 parmread.o - .rodata.str1.32 - 0x00000000006942d0 0x3f5 parmread.o - 0x4ac (size before relaxing) - *fill* 0x00000000006946c5 0xb 00 - .rodata 0x00000000006946d0 0x2a0 gen_rand_conf.o - .rodata.str1.32 - 0x0000000000694970 0x125 gen_rand_conf.o - 0x23c (size before relaxing) - *fill* 0x0000000000694a95 0x3 00 - .rodata.str1.4 - 0x0000000000694a98 0x9f gen_rand_conf.o - 0xd4 (size before relaxing) - *fill* 0x0000000000694b37 0x9 00 - .rodata 0x0000000000694b40 0xc0 printmat.o - .rodata 0x0000000000694c00 0xac map.o - .rodata.str1.32 - 0x0000000000694cac 0x29 map.o - 0x2c (size before relaxing) - *fill* 0x0000000000694cd5 0x3 00 - .rodata.str1.4 - 0x0000000000694cd8 0x36 map.o - 0x64 (size before relaxing) - *fill* 0x0000000000694d0e 0x2 00 - .rodata 0x0000000000694d10 0x68 randgens.o - .rodata 0x0000000000694d78 0x10 rescode.o - .rodata.str1.4 - 0x0000000000000000 0x4 rescode.o - *fill* 0x0000000000694d88 0x8 00 - .rodata 0x0000000000694d90 0x30 intcor.o - .rodata 0x0000000000694dc0 0x448 timing.o - .rodata.str1.4 - 0x0000000000695208 0x230 timing.o - 0x2e4 (size before relaxing) - .rodata.str1.32 - 0x0000000000695438 0x69 timing.o - 0x6c (size before relaxing) - *fill* 0x00000000006954a1 0x3 00 - .rodata.str1.4 - 0x00000000006954a4 0x6 misc.o - 0x18 (size before relaxing) - *fill* 0x00000000006954aa 0x2 00 - .rodata 0x00000000006954ac 0x24 misc.o - .rodata 0x00000000006954d0 0x228 intlocal.o - .rodata.str1.4 - 0x00000000006956f8 0x38 intlocal.o - 0x44 (size before relaxing) - .rodata 0x0000000000695730 0x10 cartder.o - .rodata 0x0000000000695740 0x450 checkder_p.o - .rodata.str1.4 - 0x0000000000695b90 0x15f checkder_p.o - 0x1c0 (size before relaxing) - *fill* 0x0000000000695cef 0x1 00 - .rodata.str1.32 - 0x0000000000695cf0 0x78 checkder_p.o - 0xa0 (size before relaxing) - *fill* 0x0000000000695d68 0x8 00 - .rodata 0x0000000000695d70 0x20 econstr_local.o - .rodata 0x0000000000695d90 0xb70 energy_p_new_barrier.o - .rodata.str1.4 - 0x0000000000696900 0xf0 energy_p_new_barrier.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x00000000006969f0 0x50 energy_p_new_barrier.o - .rodata 0x0000000000696a40 0x2e8 energy_p_new-sep_barrier.o - .rodata.str1.4 - 0x0000000000000000 0x3c energy_p_new-sep_barrier.o - .rodata.str1.32 - 0x0000000000000000 0x50 energy_p_new-sep_barrier.o - *fill* 0x0000000000696d28 0x18 00 - .rodata 0x0000000000696d40 0x180 minimize_p.o - .rodata.str1.4 - 0x0000000000696ec0 0x1e minimize_p.o - 0x54 (size before relaxing) - *fill* 0x0000000000696ede 0x2 00 - .rodata.str1.32 - 0x0000000000696ee0 0x22 minimize_p.o - 0x24 (size before relaxing) - *fill* 0x0000000000696f02 0x1e 00 - .rodata 0x0000000000696f20 0x1a0 sumsld.o - .rodata 0x00000000006970c0 0x33a0 cored.o - .rodata 0x000000000069a460 0x60 rmdd.o - .rodata 0x000000000069a4c0 0x7ec geomout.o - .rodata.str1.4 - 0x000000000069acac 0x136 geomout.o - 0x1b4 (size before relaxing) - *fill* 0x000000000069ade2 0x2 00 - .rodata.str1.32 - 0x000000000069ade4 0x59 geomout.o - 0x5c (size before relaxing) - *fill* 0x000000000069ae3d 0x3 00 - .rodata 0x000000000069ae40 0x370 readpdb.o - .rodata 0x000000000069b1b0 0x150 regularize.o - .rodata.str1.4 - 0x000000000069b300 0xd5 regularize.o - 0x10c (size before relaxing) - *fill* 0x000000000069b3d5 0x3 00 - .rodata.str1.32 - 0x000000000069b3d8 0x29 regularize.o - 0x58 (size before relaxing) - *fill* 0x000000000069b401 0xf 00 - .rodata 0x000000000069b410 0x4d0 thread.o - .rodata.str1.4 - 0x000000000069b8e0 0x13e thread.o - 0x230 (size before relaxing) - *fill* 0x000000000069ba1e 0x2 00 - .rodata.str1.32 - 0x000000000069ba20 0x24e thread.o - 0x388 (size before relaxing) - *fill* 0x000000000069bc6e 0x12 00 - .rodata 0x000000000069bc80 0x100 fitsq.o - .rodata.str1.32 - 0x000000000069bd80 0x2a fitsq.o - 0x58 (size before relaxing) - *fill* 0x000000000069bdaa 0x6 00 - .rodata 0x000000000069bdb0 0x700 mcm.o - .rodata.str1.4 - 0x000000000069c4b0 0x41f mcm.o - 0x518 (size before relaxing) - *fill* 0x000000000069c8cf 0x1 00 - .rodata.str1.32 - 0x000000000069c8d0 0x249 mcm.o - 0x24c (size before relaxing) - *fill* 0x000000000069cb19 0x7 00 - .rodata 0x000000000069cb20 0x648 mc.o - .rodata.str1.4 - 0x000000000069d168 0x30d mc.o - 0x428 (size before relaxing) - *fill* 0x000000000069d475 0x3 00 - .rodata.str1.32 - 0x000000000069d478 0xe8 mc.o - 0x114 (size before relaxing) - .rodata 0x000000000069d560 0x110 bond_move.o - .rodata.str1.4 - 0x000000000069d670 0x73 bond_move.o - 0x7c (size before relaxing) - *fill* 0x000000000069d6e3 0x1 00 - .rodata.str1.32 - 0x000000000069d6e4 0x6f bond_move.o - 0x70 (size before relaxing) - *fill* 0x000000000069d753 0xd 00 - .rodata 0x000000000069d760 0x1c0 refsys.o - .rodata 0x000000000069d920 0x38 check_sc_distr.o - .rodata.str1.4 - 0x000000000069d958 0xf check_sc_distr.o - 0x18 (size before relaxing) - *fill* 0x000000000069d967 0x1 00 - .rodata 0x000000000069d968 0x20 check_bond.o - *fill* 0x000000000069d988 0x8 00 - .rodata 0x000000000069d990 0xd0 contact.o - .rodata.str1.4 - 0x000000000069da60 0x2a contact.o - 0x2c (size before relaxing) - *fill* 0x000000000069da8a 0x16 00 - .rodata 0x000000000069daa0 0xe0 djacob.o - .rodata 0x000000000069db80 0x3c0 eigen.o - .rodata.str1.32 - 0x000000000069df40 0x29 eigen.o - 0x2c (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x4 eigen.o - *fill* 0x000000000069df69 0x7 00 - .rodata 0x000000000069df70 0x80 blas.o - .rodata.str1.4 - 0x000000000069dff0 0x8 add.o - *fill* 0x000000000069dff8 0x8 00 - .rodata 0x000000000069e000 0x730 entmcm.o - .rodata.str1.4 - 0x000000000069e730 0x11e entmcm.o - 0x538 (size before relaxing) - *fill* 0x000000000069e84e 0x2 00 - .rodata.str1.32 - 0x000000000069e850 0x51 entmcm.o - 0x168 (size before relaxing) - *fill* 0x000000000069e8a1 0xf 00 - .rodata 0x000000000069e8b0 0x70 minim_mcmf.o - .rodata 0x000000000069e920 0xb70 together.o - .rodata.str1.4 - 0x000000000069f490 0x316 together.o - 0x58c (size before relaxing) - *fill* 0x000000000069f7a6 0x2 00 - .rodata.str1.32 - 0x000000000069f7a8 0x16c together.o - 0x224 (size before relaxing) - *fill* 0x000000000069f914 0xc 00 - .rodata 0x000000000069f920 0x240 csa.o - .rodata.str1.4 - 0x000000000069fb60 0x5a csa.o - 0xc4 (size before relaxing) - *fill* 0x000000000069fbba 0x2 00 - .rodata.str1.32 - 0x000000000069fbbc 0x58 csa.o - 0x7c (size before relaxing) - *fill* 0x000000000069fc14 0xc 00 - .rodata 0x000000000069fc20 0x380 minim_jlee.o - .rodata.str1.4 - 0x000000000069ffa0 0xfd minim_jlee.o - 0x1fc (size before relaxing) - *fill* 0x00000000006a009d 0x3 00 - .rodata.str1.32 - 0x00000000006a00a0 0x89 minim_jlee.o - 0x230 (size before relaxing) - *fill* 0x00000000006a0129 0x3 00 - .rodata 0x00000000006a012c 0x3a4 shift.o - .rodata.str1.4 - 0x00000000006a04d0 0x25 shift.o - 0x54 (size before relaxing) - *fill* 0x00000000006a04f5 0xb 00 - .rodata 0x00000000006a0500 0x20 diff12.o - .rodata 0x00000000006a0520 0xbe8 bank.o - .rodata.str1.4 - 0x00000000006a1108 0x114 bank.o - 0x2ac (size before relaxing) - .rodata.str1.32 - 0x00000000006a121c 0x4a bank.o - 0x4c (size before relaxing) - *fill* 0x00000000006a1266 0xa 00 - .rodata 0x00000000006a1270 0x3f0 newconf.o - .rodata.str1.4 - 0x00000000006a1660 0xaf newconf.o - 0xf8 (size before relaxing) - *fill* 0x00000000006a170f 0x1 00 - .rodata.str1.32 - 0x00000000006a1710 0x7c newconf.o - 0xf0 (size before relaxing) - .rodata 0x00000000006a178c 0x18 ran.o - .rodata.str1.4 - 0x00000000006a17a4 0x1b indexx.o - 0x1c (size before relaxing) - *fill* 0x00000000006a17bf 0x1 00 - .rodata 0x00000000006a17c0 0x730 MP.o - .rodata.str1.4 - 0x00000000006a1ef0 0x27d MP.o - 0x5e8 (size before relaxing) - *fill* 0x00000000006a216d 0x3 00 - .rodata.str1.32 - 0x00000000006a2170 0x31b MP.o - 0x470 (size before relaxing) - *fill* 0x00000000006a248b 0x5 00 - .rodata 0x00000000006a2490 0x170 compare_s1.o - .rodata.str1.4 - 0x00000000006a2600 0x71 compare_s1.o - 0x78 (size before relaxing) - *fill* 0x00000000006a2671 0x3 00 - .rodata.str1.32 - 0x00000000006a2674 0x14c compare_s1.o - .rodata 0x00000000006a27c0 0x30 prng_32.o - .rodata 0x00000000006a27f0 0xf50 test.o - .rodata.str1.4 - 0x00000000006a3740 0x46a test.o - 0xa00 (size before relaxing) - *fill* 0x00000000006a3baa 0x2 00 - .rodata.str1.32 - 0x00000000006a3bac 0x5a test.o - 0x12c (size before relaxing) - *fill* 0x00000000006a3c06 0xa 00 - .rodata 0x00000000006a3c10 0x40 banach.o - .rodata 0x00000000006a3c50 0xf0 distfit.o - .rodata.str1.32 - 0x00000000006a3d40 0x75 distfit.o - 0x78 (size before relaxing) - *fill* 0x00000000006a3db5 0x3 00 - .rodata.str1.4 - 0x00000000006a3db8 0x25 distfit.o - 0x3c (size before relaxing) - *fill* 0x00000000006a3ddd 0x3 00 - .rodata 0x00000000006a3de0 0x150 rmsd.o - .rodata.str1.4 - 0x00000000006a3f30 0x6a rmsd.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x0000000000000000 0x2c rmsd.o - *fill* 0x00000000006a3f9a 0x6 00 - .rodata 0x00000000006a3fa0 0x580 elecont.o - .rodata.str1.32 - 0x00000000006a4520 0xdf elecont.o - 0x108 (size before relaxing) - *fill* 0x00000000006a45ff 0x1 00 - .rodata.str1.4 - 0x00000000006a4600 0x1b elecont.o - 0x278 (size before relaxing) - *fill* 0x00000000006a461b 0x1 00 - .rodata.str1.4 - 0x00000000006a461c 0x6c dihed_cons.o - 0x90 (size before relaxing) - .rodata 0x00000000006a4688 0x118 dihed_cons.o - .rodata.str1.32 - 0x00000000006a47a0 0xc3 dihed_cons.o - 0xc4 (size before relaxing) - *fill* 0x00000000006a4863 0xd 00 - .rodata 0x00000000006a4870 0x130 sc_move.o - .rodata.str1.4 - 0x0000000000000000 0x8 sc_move.o - .rodata 0x00000000006a49a0 0x3a0 local_move.o - .rodata.str1.32 - 0x00000000006a4d40 0x84 local_move.o - .rodata.str1.4 - 0x00000000006a4dc4 0x92 local_move.o - 0xa0 (size before relaxing) - *fill* 0x00000000006a4e56 0x2 00 - .rodata 0x00000000006a4e58 0x1e8 intcartderiv.o - .rodata.str1.32 - 0x00000000006a5040 0xef intcartderiv.o - 0xf0 (size before relaxing) - *fill* 0x00000000006a512f 0x1 00 - .rodata 0x00000000006a5130 0x130 /tmp/ipo_ifortB4EXK9.o - .rodata.str1.4 - 0x00000000006a5260 0x72 /tmp/ipo_ifortB4EXK9.o - 0xa0 (size before relaxing) - *fill* 0x00000000006a52d2 0xe 00 - .rodata 0x00000000006a52e0 0x110 stochfric.o - .rodata.str1.4 - 0x00000000006a53f0 0x38 stochfric.o - .rodata.str1.32 - 0x00000000006a5428 0x3e stochfric.o - 0x40 (size before relaxing) - *fill* 0x00000000006a5466 0xa 00 - .rodata 0x00000000006a5470 0x20 kinetic_lesyng.o - .rodata.str1.4 - 0x00000000006a5490 0x39b MD_A-MTS.o - 0x540 (size before relaxing) - *fill* 0x00000000006a582b 0x5 00 - .rodata 0x00000000006a5830 0xa90 MD_A-MTS.o - .rodata.str1.32 - 0x00000000006a62c0 0x369 MD_A-MTS.o - 0x480 (size before relaxing) - *fill* 0x00000000006a6629 0x7 00 - .rodata 0x00000000006a6630 0xa0 moments.o - .rodata 0x00000000006a66d0 0x60 surfatom.o - .rodata.str1.4 - 0x0000000000000000 0xc surfatom.o - *fill* 0x00000000006a6730 0x10 00 - .rodata 0x00000000006a6740 0x3e0 muca_md.o - .rodata.str1.4 - 0x00000000006a6b20 0xea muca_md.o - 0x10c (size before relaxing) - *fill* 0x00000000006a6c0a 0x6 00 - .rodata 0x00000000006a6c10 0x8a0 MREMD.o - .rodata.str1.4 - 0x00000000006a74b0 0x2ea MREMD.o - 0x4e0 (size before relaxing) - *fill* 0x00000000006a779a 0x2 00 - .rodata.str1.32 - 0x00000000006a779c 0x22 MREMD.o - 0xb8 (size before relaxing) - *fill* 0x00000000006a77be 0x2 00 - .rodata 0x00000000006a77c0 0x18 rattle.o - .rodata.str1.32 - 0x00000000006a77d8 0xa5 rattle.o - 0xa8 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0xc rattle.o - *fill* 0x00000000006a787d 0x3 00 - .rodata 0x00000000006a7880 0x30 gauss.o - .rodata 0x00000000006a78b0 0xa0 energy_split-sep.o - .rodata 0x00000000006a7950 0x68 q_measure.o - .rodata.str1.32 - 0x00000000006a79b8 0x20 q_measure.o - .rodata 0x00000000006a79d8 0x20 gnmr1.o - .rodata 0x00000000006a79f8 0x3 proc_proc.o - *fill* 0x00000000006a79fb 0x1 00 - .rodata 0x00000000006a79fc 0xd0 cinfo.o - .rodata.str1.4 - 0x00000000006a7acc 0xe2 cinfo.o - 0xe4 (size before relaxing) - *fill* 0x00000000006a7bae 0x2 00 - .rodata.str1.32 - 0x00000000006a7bb0 0x2c3 cinfo.o - 0x2c4 (size before relaxing) - .rodata 0x00000000006a7e73 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .rodata 0x00000000006a7e84 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .rodata 0x00000000006a7e9f 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .rodata 0x00000000006a7eab 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .rodata 0x00000000006a7ec2 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .rodata 0x00000000006a7eca 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .rodata 0x00000000006a7ed2 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - *fill* 0x00000000006a7ee2 0x6 00 - .rodata 0x00000000006a7ee8 0xa9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .rodata 0x00000000006a7f91 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .rodata 0x00000000006a7f99 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .rodata 0x00000000006a7fa3 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .rodata 0x00000000006a7faa 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .rodata 0x00000000006a7fb1 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .rodata 0x00000000006a7fba 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .rodata 0x00000000006a7fc4 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .rodata 0x00000000006a7fcf 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .rodata 0x00000000006a7fd8 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .rodata 0x00000000006a7fe6 0x22 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .rodata 0x00000000006a8008 0x15 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .rodata 0x00000000006a801d 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .rodata 0x00000000006a8029 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x00000000006a8043 0xd 00 - .rodata 0x00000000006a8050 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000006a8050 MPIR_Version_patches - 0x00000000006a8054 MPIR_Version_major - 0x00000000006a8058 MPIR_Version_minor - 0x00000000006a805c MPIR_Version_subminor - 0x00000000006a8060 MPIR_Version_string - 0x00000000006a8070 MPIR_Version_date - 0x00000000006a8090 MPIR_Version_configure - 0x00000000006a80a3 MPIR_Version_device - .rodata 0x00000000006a81e5 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - *fill* 0x00000000006a81ef 0x1 00 - .rodata 0x00000000006a81f0 0x2d40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .rodata 0x00000000006aaf30 0x225 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - *fill* 0x00000000006ab155 0x3 00 - .rodata 0x00000000006ab158 0xde /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .rodata 0x00000000006ab236 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .rodata 0x00000000006ab244 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x00000000006ab252 0x6 00 - .rodata 0x00000000006ab258 0xa3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .rodata 0x00000000006ab2fb 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .rodata 0x00000000006ab309 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .rodata 0x00000000006ab316 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .rodata 0x00000000006ab323 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .rodata 0x00000000006ab330 0x121 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .rodata 0x00000000006ab451 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .rodata 0x00000000006ab45d 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .rodata 0x00000000006ab46a 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .rodata 0x00000000006ab488 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .rodata 0x00000000006ab494 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .rodata 0x00000000006ab4c2 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x00000000006ab4ce 0x2 00 - .rodata 0x00000000006ab4d0 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .rodata 0x00000000006ab5c7 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .rodata 0x00000000006ab5e3 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .rodata 0x00000000006ab5f4 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .rodata 0x00000000006ab5fe 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .rodata 0x00000000006ab606 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .rodata 0x00000000006ab60f 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .rodata 0x00000000006ab619 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .rodata 0x00000000006ab624 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .rodata 0x00000000006ab630 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .rodata 0x00000000006ab639 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x00000000006ab645 0x3 00 - .rodata 0x00000000006ab648 0xb58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .rodata 0x00000000006ac1a0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .rodata 0x00000000006ac1a9 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .rodata 0x00000000006ac1c0 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .rodata 0x00000000006ac280 0x69 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .rodata 0x00000000006ac2e9 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .rodata 0x00000000006ac2f6 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - *fill* 0x00000000006ac311 0x7 00 - .rodata 0x00000000006ac318 0xa48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .rodata 0x00000000006acd60 0x3d7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - *fill* 0x00000000006ad137 0x1 00 - .rodata 0x00000000006ad138 0x469 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - *fill* 0x00000000006ad5a1 0x7 00 - .rodata 0x00000000006ad5a8 0x9aa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x00000000006adf52 0x6 00 - .rodata 0x00000000006adf58 0x5ba /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - *fill* 0x00000000006ae512 0x6 00 - .rodata 0x00000000006ae518 0x664 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - *fill* 0x00000000006aeb7c 0x4 00 - .rodata 0x00000000006aeb80 0x5de /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x00000000006af15e 0x2 00 - .rodata 0x00000000006af160 0x501 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x00000000006af661 0x7 00 - .rodata 0x00000000006af668 0x1a9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - *fill* 0x00000000006af811 0x7 00 - .rodata 0x00000000006af818 0x16c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - *fill* 0x00000000006af984 0x4 00 - .rodata 0x00000000006af988 0xec /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - *fill* 0x00000000006afa74 0x4 00 - .rodata 0x00000000006afa78 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - *fill* 0x00000000006afb91 0x7 00 - .rodata 0x00000000006afb98 0xe7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - *fill* 0x00000000006afc7f 0x1 00 - .rodata 0x00000000006afc80 0xf9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - *fill* 0x00000000006afd79 0x7 00 - .rodata 0x00000000006afd80 0xbf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - *fill* 0x00000000006afe3f 0x1 00 - .rodata 0x00000000006afe40 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - *fill* 0x00000000006afe7f 0x1 00 - .rodata 0x00000000006afe80 0x440 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .rodata 0x00000000006b02c0 0x506 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - *fill* 0x00000000006b07c6 0x2 00 - .rodata 0x00000000006b07c8 0xb9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x00000000006b0881 0x7 00 - .rodata 0x00000000006b0888 0x4e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - *fill* 0x00000000006b08d6 0x2 00 - .rodata 0x00000000006b08d8 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - *fill* 0x00000000006b09cf 0x1 00 - .rodata 0x00000000006b09d0 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - *fill* 0x00000000006b0ae7 0x1 00 - .rodata 0x00000000006b0ae8 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .rodata 0x00000000006b0ca8 0x2d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .rodata 0x00000000006b0cd5 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - *fill* 0x00000000006b0ced 0x3 00 - .rodata 0x00000000006b0cf0 0x1ef /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - *fill* 0x00000000006b0edf 0x1 00 - .rodata 0x00000000006b0ee0 0x1a1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .rodata 0x00000000006b1081 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .rodata 0x00000000006b1091 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .rodata 0x00000000006b109a 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .rodata 0x00000000006b10a5 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .rodata 0x00000000006b10b3 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .rodata 0x00000000006b10bf 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .rodata 0x00000000006b10dd 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .rodata 0x00000000006b10e7 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .rodata 0x00000000006b10f3 0x32 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .rodata 0x00000000006b1125 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x00000000006b1131 0x7 00 - .rodata 0x00000000006b1138 0x5e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .rodata 0x00000000006b1196 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .rodata 0x00000000006b119f 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .rodata 0x00000000006b11a8 0xbe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x00000000006b1266 0x2 00 - .rodata 0x00000000006b1268 0x152 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x00000000006b13ba 0x6 00 - .rodata 0x00000000006b13c0 0x250 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .rodata 0x00000000006b1610 0x415 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x00000000006b1a25 0x3 00 - .rodata 0x00000000006b1a28 0x373 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x00000000006b1d9b 0x5 00 - .rodata 0x00000000006b1da0 0x39b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - *fill* 0x00000000006b213b 0x5 00 - .rodata 0x00000000006b2140 0x1f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .rodata 0x00000000006b2338 0x3c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .rodata 0x00000000006b26f8 0x6d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - *fill* 0x00000000006b2765 0xb 00 - .rodata 0x00000000006b2770 0x280 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .rodata 0x00000000006b29f0 0xd0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .rodata 0x00000000006b2ac0 0x2da /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - *fill* 0x00000000006b2d9a 0x6 00 - .rodata 0x00000000006b2da0 0x4b0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .rodata 0x00000000006b3250 0x300 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .rodata 0x00000000006b3550 0x2db /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - *fill* 0x00000000006b382b 0x5 00 - .rodata 0x00000000006b3830 0x13f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - *fill* 0x00000000006b396f 0x1 00 - .rodata.str1.8 - 0x00000000006b3970 0xf0 xdrf_em64/libxdrf.a(libxdrf.o) - 0xe9 (size before relaxing) - .rodata.str1.1 - 0x00000000006b3a60 0x17 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b3a77 0x1 00 - .rodata.cst8 0x00000000006b3a78 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - .rodata.cst4 0x00000000006b3a88 0xc xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b3a94 0xc 00 - .rodata.cst16 0x00000000006b3aa0 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b3ab0 0x10 00 - .rodata 0x00000000006b3ac0 0x124 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b3be4 0x4 00 - .rodata 0x00000000006b3be8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .rodata 0x00000000006b3c00 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .rodata 0x00000000006b3c10 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .rodata.str1.4 - 0x0000000000000000 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .rodata 0x00000000006b3c20 0x48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .rodata.str1.4 - 0x00000000006b3c68 0x68 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - *fill* 0x00000000006b3cd0 0x10 00 - .rodata 0x00000000006b3ce0 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000006b3e60 for__dsc_itm_table - .rodata.str1.4 - 0x00000000006b3ee0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .rodata.str1.4 - 0x00000000006b3ef0 0xec9 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0xee8 (size before relaxing) - *fill* 0x00000000006b4db9 0x7 00 - .rodata 0x00000000006b4dc0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .rodata.str1.32 - 0x00000000006b4e40 0x3bda /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x3c00 (size before relaxing) - *fill* 0x00000000006b8a1a 0x2 00 - .rodata.str1.4 - 0x00000000006b8a1c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x14 (size before relaxing) - *fill* 0x00000000006b8a2f 0x1 00 - .rodata 0x00000000006b8a30 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .rodata.str1.4 - 0x00000000006b8a60 0x98 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0xa4 (size before relaxing) - *fill* 0x00000000006b8af8 0x8 00 - .rodata 0x00000000006b8b00 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .rodata.str1.32 - 0x00000000006b8c80 0x1eea /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x1f00 (size before relaxing) - *fill* 0x00000000006bab6a 0x2 00 - .rodata.str1.4 - 0x00000000006bab6c 0x176 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x1a0 (size before relaxing) - *fill* 0x00000000006bace2 0x1e 00 - .rodata 0x00000000006bad00 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .rodata 0x00000000006bb2a0 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .rodata.str1.4 - 0x00000000006bb660 0x3 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x4 (size before relaxing) - *fill* 0x00000000006bb663 0x1 00 - .rodata.str1.4 - 0x00000000006bb664 0x5b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x5c (size before relaxing) - *fill* 0x00000000006bb6bf 0x1 00 - .rodata 0x00000000006bb6c0 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .rodata 0x00000000006bbc40 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .rodata.str1.4 - 0x00000000006bbca0 0x271 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x400 (size before relaxing) - *fill* 0x00000000006bbf11 0xf 00 - .rodata 0x00000000006bbf20 0x1980 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .rodata 0x00000000006bd8a0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .rodata.str1.4 - 0x00000000006bd8b0 0x2a /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x2c (size before relaxing) - *fill* 0x00000000006bd8da 0x2 00 - .rodata.str1.32 - 0x00000000006bd8dc 0x34 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - *fill* 0x00000000006bd910 0x10 00 - .rodata 0x00000000006bd920 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .rodata.str1.4 - 0x00000000006bdb40 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0xc (size before relaxing) - *fill* 0x00000000006bdb4a 0x16 00 - .rodata 0x00000000006bdb60 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .rodata.str1.4 - 0x00000000006bdbe0 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x18 (size before relaxing) - *fill* 0x00000000006bdbed 0x3 00 - .rodata.str1.4 - 0x00000000006bdbf0 0x2f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x38 (size before relaxing) - *fill* 0x00000000006bdc1f 0x1 00 - .rodata.str1.32 - 0x00000000006bdc20 0x22 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006bdc42 0x1e 00 - .rodata 0x00000000006bdc60 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .rodata.str1.4 - 0x00000000006bdf00 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x34 (size before relaxing) - *fill* 0x00000000006bdf2c 0x14 00 - .rodata 0x00000000006bdf40 0xa80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .rodata.str1.4 - 0x00000000006be9c0 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006be9cb 0x1 00 - .rodata.str1.4 - 0x00000000006be9cc 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006be9db 0x5 00 - .rodata 0x00000000006be9e0 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .rodata.str1.4 - 0x00000000006bede0 0x1d /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x28 (size before relaxing) - *fill* 0x00000000006bedfd 0x3 00 - .rodata 0x00000000006bee00 0xd80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .rodata.str1.4 - 0x00000000006bfb80 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x14 (size before relaxing) - *fill* 0x00000000006bfb8b 0x15 00 - .rodata 0x00000000006bfba0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .rodata.str1.4 - 0x00000000006bfd20 0x29 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x3c (size before relaxing) - *fill* 0x00000000006bfd49 0x3 00 - .rodata.str1.32 - 0x00000000006bfd4c 0x23 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006bfd6f 0x11 00 - .rodata 0x00000000006bfd80 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .rodata.str1.4 - 0x00000000006bffc0 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006bffcb 0x15 00 - .rodata 0x00000000006bffe0 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .rodata.str1.4 - 0x00000000006c0280 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006c028f 0x11 00 - .rodata 0x00000000006c02a0 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .rodata.str1.4 - 0x00000000006c05a0 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x18 (size before relaxing) - *fill* 0x00000000006c05af 0x11 00 - .rodata 0x00000000006c05c0 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .rodata 0x00000000006c08e0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .rodata.str1.4 - 0x00000000006c0918 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c0925 0x1b 00 - .rodata 0x00000000006c0940 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .rodata.str1.4 - 0x00000000006c0a20 0xe /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c0a2e 0x2 00 - .rodata 0x00000000006c0a30 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - *fill* 0x00000000006c0a90 0x10 00 - .rodata.str1.32 - 0x00000000006c0aa0 0xbdb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0xbe0 (size before relaxing) - *fill* 0x00000000006c167b 0x1 00 - .rodata.str1.4 - 0x00000000006c167c 0x16b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x198 (size before relaxing) - *fill* 0x00000000006c17e7 0x1 00 - .rodata.str1.4 - 0x00000000006c17e8 0xb2 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0xc4 (size before relaxing) - *fill* 0x00000000006c189a 0x6 00 - .rodata 0x00000000006c18a0 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .rodata.str1.4 - 0x00000000006c19c0 0x6e /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006c1a2e 0x12 00 - .rodata 0x00000000006c1a40 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .rodata 0x00000000006c1e60 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .rodata 0x00000000006c2160 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .rodata 0x00000000006c2340 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .rodata 0x00000000006c2520 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .rodata 0x00000000006c2700 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .rodata 0x00000000006c2ac0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .rodata 0x00000000006c2ca0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .rodata 0x00000000006c2e80 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .rodata 0x00000000006c37e0 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .rodata 0x00000000006c3d80 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .rodata.str1.4 - 0x00000000006c4360 0x1f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006c437f 0x1 00 - .rodata 0x00000000006c4380 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .rodata.str1.4 - 0x00000000006c46a0 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c46af 0x11 00 - .rodata 0x00000000006c46c0 0x11a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .rodata 0x00000000006c5860 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .rodata.str1.4 - 0x00000000006c58a0 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0xc (size before relaxing) - *fill* 0x00000000006c58aa 0x16 00 - .rodata 0x00000000006c58c0 0xb40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x00000000006c5e20 for__b_fmt_table - 0x00000000006c5ea0 for__fedg_fmt_table - 0x00000000006c5f80 for__coerce_data_types - 0x00000000006c63a0 for__i_fmt_table - 0x00000000006c63b0 for__oz_fmt_table - .rodata.str1.4 - 0x00000000006c6400 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - *fill* 0x00000000006c6410 0x10 00 - .rodata 0x00000000006c6420 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - 0x00000000006c6420 for__wfs_table - 0x00000000006c6520 for__wfs_msf_table - .rodata 0x00000000006c6620 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - 0x00000000006c6620 vax_c - 0x00000000006c6660 ieee_t - 0x00000000006c66d0 ieee_s - 0x00000000006c6708 ibm_s - 0x00000000006c6724 ibm_l - 0x00000000006c675c cray - 0x00000000006c6794 int_c - .rodata 0x00000000006c67e0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .rodata.str1.4 - 0x00000000006c6860 0x11 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x14 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x14 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - *fill* 0x00000000006c6871 0xf 00 - .rodata 0x00000000006c6880 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .rodata 0x00000000006c68c0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - *fill* 0x00000000006c6910 0x10 00 - .rodata 0x00000000006c6920 0x600 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .rodata 0x00000000006c6f20 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .rodata 0x00000000006c6f90 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .rodata 0x00000000006c7010 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .rodata.str1.4 - 0x00000000006c7020 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata 0x00000000006c7030 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata 0x00000000006c7050 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata.str1.4 - 0x00000000006c7060 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x30 (size before relaxing) - *fill* 0x00000000006c706d 0x3 00 - .rodata 0x00000000006c7070 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata 0x00000000006c7080 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006c7090 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006c70a0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - 0x00000000006c70a0 cvtas_pten_word - 0x00000000006c7140 cvtas_globals_t - 0x00000000006c71a0 cvtas_globals_x - 0x00000000006c7200 cvtas_globals_s - .rodata 0x00000000006c7220 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - 0x00000000006c7220 cvtas_pten_t - 0x00000000006c7520 cvtas_tiny_pten_t - 0x00000000006c75c0 cvtas_tiny_pten_t_map - 0x00000000006c7620 cvtas_huge_pten_t - 0x00000000006c76a0 cvtas_huge_pten_t_map - .rodata 0x00000000006c7700 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - 0x00000000006c7700 cvtas_pten_64 - 0x00000000006c7a00 cvtas_pten_64_bexp - 0x00000000006c7ac0 cvtas_tiny_pten_64 - 0x00000000006c7b40 cvtas_tiny_pten_64_map - 0x00000000006c7bc0 cvtas_huge_pten_64 - 0x00000000006c7c40 cvtas_huge_pten_64_map - 0x00000000006c7c9c cvtas_tiny_pten_64_bexp - 0x00000000006c7cbc cvtas_huge_pten_64_bexp - .rodata 0x00000000006c7ce0 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - 0x00000000006c7ce0 cvtas_pten_128 - 0x00000000006c7ea0 cvtas_tiny_tiny_pten_128 - 0x00000000006c7ee0 cvtas_tiny_pten_128 - 0x00000000006c7f80 cvtas_tiny_pten_128_map - 0x00000000006c8020 cvtas_huge_huge_pten_128 - 0x00000000006c8060 cvtas_huge_pten_128 - 0x00000000006c8100 cvtas_huge_pten_128_map - 0x00000000006c8188 cvtas_pten_128_bexp - 0x00000000006c81c0 cvtas_tiny_tiny_pten_128_bexp - 0x00000000006c81c8 cvtas_tiny_pten_128_bexp - 0x00000000006c81dc cvtas_huge_huge_pten_128_bexp - 0x00000000006c81e4 cvtas_huge_pten_128_bexp - .rodata 0x00000000006c8200 0x17e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .rodata 0x00000000006c99e0 0x17c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .rodata 0x00000000006cb1a0 0xbc0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .rodata 0x00000000006cbd60 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .rodata 0x00000000006cbd70 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .rodata.str1.4 - 0x00000000006cbd80 0xcbb /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0xcc4 (size before relaxing) - *fill* 0x00000000006cca3b 0x1 00 - .rodata.str1.32 - 0x00000000006cca3c 0x10c /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .rodata 0x00000000006ccb48 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x00000000006ccb48 __libm_float_zero - 0x00000000006ccb50 __libm_float_one - 0x00000000006ccb58 __libm_float_inf - 0x00000000006ccb60 __libm_float_huge - 0x00000000006ccb68 __libm_double_zero - 0x00000000006ccb78 __libm_double_one - 0x00000000006ccb88 __libm_double_inf - 0x00000000006ccb98 __libm_double_huge - 0x00000000006ccba8 __libm_ldouble_zero - 0x00000000006ccbb8 __libm_ldouble_neg_zero - 0x00000000006ccbc8 __libm_ldouble_one - 0x00000000006ccbd8 __libm_ldouble_neg_one - 0x00000000006ccbe8 __libm_ldouble_inf - 0x00000000006ccbf8 __libm_ldouble_neg_inf - 0x00000000006ccc08 __libm_ldouble_huge - 0x00000000006ccc18 __libm_ldouble_neg_huge - *fill* 0x00000000006ccc28 0x18 00 - .rodata 0x00000000006ccc40 0x11c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .rodata 0x00000000006cde00 0x780 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .rodata 0x00000000006ce580 0xc80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .rodata 0x00000000006cf200 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .rodata 0x00000000006cfb40 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .rodata 0x00000000006d0480 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .rodata 0x00000000006d0dc0 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .rodata 0x00000000006d1620 0xd0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - *fill* 0x00000000006d16f0 0x10 00 - .rodata 0x00000000006d1700 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .rodata 0x00000000006d1be0 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .rodata 0x00000000006d2400 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .rodata 0x00000000006d2c20 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .rodata 0x00000000006d3100 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - 0x00000000006d3100 __libm_exp_hi_table_64 - 0x00000000006d3320 __libm_exp_mi_table_64 - 0x00000000006d3540 __libm_exp_lo_table_64 - 0x00000000006d3760 __libm_exp_table_128 - .rodata 0x00000000006d3f80 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .rodata 0x00000000006d3fb8 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - *fill* 0x00000000006d3fc8 0x18 00 - .rodata 0x00000000006d3fe0 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .rodata 0x00000000006d4220 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .rodata 0x00000000006d4240 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .rodata 0x00000000006d4260 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .rodata 0x00000000006d4280 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .rodata 0x00000000006d42a0 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .rodata 0x00000000006d4b20 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .rodata 0x00000000006d53a0 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .rodata 0x00000000006d5c00 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .rodata 0x00000000006d6420 0x58 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - *fill* 0x00000000006d6478 0x8 00 - .rodata 0x00000000006d6480 0x800 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - 0x00000000006d6480 __libm_logf_table_256 - .rodata 0x00000000006d6c80 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .rodata 0x00000000006d74e0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .rodata 0x00000000006d7500 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .rodata 0x00000000006d7520 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .rodata 0x00000000006d7540 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .rodata 0x00000000006d7560 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .rodata 0x00000000006da860 0x3a60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .rodata 0x00000000006de2c0 0xc00 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - 0x00000000006de2c0 __libm_rcp_table_256 - 0x00000000006de6c0 __libm_double_rcp_table_256 - .rodata 0x00000000006deec0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .rodata 0x00000000006df820 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .rodata 0x00000000006e0180 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .rodata 0x00000000006e0ae0 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .rodata 0x00000000006e2280 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .rodata 0x00000000006e3a20 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .rodata 0x00000000006e3a40 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .rodata 0x00000000006e3a60 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .rodata 0x00000000006e45c0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .rodata 0x00000000006e5120 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .rodata 0x00000000006e5c80 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .rodata 0x00000000006e67e0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .rodata 0x00000000006e7340 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .rodata 0x00000000006e7ea0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .rodata 0x00000000006e8a00 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .rodata 0x00000000006e9560 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .rodata 0x00000000006e9578 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .rodata.str1.32 - 0x00000000006e95a0 0x158 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x160 (size before relaxing) - .rodata.str1.4 - 0x00000000006e96f8 0x1e /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x28 (size before relaxing) - *fill* 0x00000000006e9716 0x2 00 - .rodata.str1.4 - 0x00000000006e9718 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x3c (size before relaxing) - .rodata 0x00000000006e9744 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - *fill* 0x00000000006e974c 0x4 00 - .rodata 0x00000000006e9750 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .rodata 0x00000000006e97e0 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .rodata.str1.4 - 0x00000000006e9870 0x18c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x1b0 (size before relaxing) - *fill* 0x00000000006e99fc 0x4 00 - .rodata.str1.32 - 0x00000000006e9a00 0x6a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .rodata 0x00000000006ea0a0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.rodata1 - *(.rodata1) - -.eh_frame_hdr 0x00000000006ea0c0 0x3484 - *(.eh_frame_hdr) - .eh_frame_hdr 0x00000000006ea0c0 0x3484 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - -.eh_frame 0x00000000006ed548 0x40404 - *(.eh_frame) - .eh_frame 0x00000000006ed548 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .eh_frame 0x00000000006ed5b8 0x5a8 unres.o - .eh_frame 0x00000000006edb60 0x38 arcos.o - 0x50 (size before relaxing) - .eh_frame 0x00000000006edb98 0x90 cartprint.o - 0xa8 (size before relaxing) - .eh_frame 0x00000000006edc28 0x1b0 chainbuild.o - 0x1c8 (size before relaxing) - .eh_frame 0x00000000006eddd8 0x2f8 convert.o - 0x310 (size before relaxing) - .eh_frame 0x00000000006ee0d0 0x5e8 initialize_p.o - 0x600 (size before relaxing) - .eh_frame 0x00000000006ee6b8 0x18 matmult.o - 0x30 (size before relaxing) - .eh_frame 0x00000000006ee6d0 0xfa8 readrtns_CSA.o - 0xfc0 (size before relaxing) - .eh_frame 0x00000000006ef678 0x148 parmread.o - 0x160 (size before relaxing) - .eh_frame 0x00000000006ef7c0 0xbc8 gen_rand_conf.o - 0xbe0 (size before relaxing) - .eh_frame 0x00000000006f0388 0xa0 printmat.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000006f0428 0xc0 map.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f04e8 0x18 pinorm.o - 0x30 (size before relaxing) - .eh_frame 0x00000000006f0500 0xb0 randgens.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006f05b0 0xa0 rescode.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000006f0650 0x68 intcor.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006f06b8 0x198 timing.o - 0x1b0 (size before relaxing) - .eh_frame 0x00000000006f0850 0x488 misc.o - 0x4a0 (size before relaxing) - .eh_frame 0x00000000006f0cd8 0x5a0 intlocal.o - 0x5b8 (size before relaxing) - .eh_frame 0x00000000006f1278 0xa8 cartder.o - 0xc0 (size before relaxing) - .eh_frame 0x00000000006f1320 0x388 checkder_p.o - 0x3a0 (size before relaxing) - .eh_frame 0x00000000006f16a8 0xb0 econstr_local.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006f1758 0x2388 energy_p_new_barrier.o - 0x23a0 (size before relaxing) - .eh_frame 0x00000000006f3ae0 0xa60 energy_p_new-sep_barrier.o - 0xa78 (size before relaxing) - .eh_frame 0x00000000006f4540 0x258 gradient_p.o - 0x270 (size before relaxing) - .eh_frame 0x00000000006f4798 0x488 minimize_p.o - 0x4a0 (size before relaxing) - .eh_frame 0x00000000006f4c20 0x658 sumsld.o - 0x670 (size before relaxing) - .eh_frame 0x00000000006f5278 0x480 cored.o - 0x498 (size before relaxing) - .eh_frame 0x00000000006f56f8 0x30 rmdd.o - 0x48 (size before relaxing) - .eh_frame 0x00000000006f5728 0x408 geomout.o - 0x420 (size before relaxing) - .eh_frame 0x00000000006f5b30 0x120 readpdb.o - 0x138 (size before relaxing) - .eh_frame 0x00000000006f5c50 0xc0 regularize.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f5d10 0x4b0 thread.o - 0x4c8 (size before relaxing) - .eh_frame 0x00000000006f61c0 0x318 fitsq.o - 0x330 (size before relaxing) - .eh_frame 0x00000000006f64d8 0x8c0 mcm.o - 0x8d8 (size before relaxing) - .eh_frame 0x00000000006f6d98 0x3c8 mc.o - 0x3e0 (size before relaxing) - .eh_frame 0x00000000006f7160 0xa8 bond_move.o - 0xc0 (size before relaxing) - .eh_frame 0x00000000006f7208 0x110 refsys.o - 0x128 (size before relaxing) - .eh_frame 0x00000000006f7318 0x40 check_sc_distr.o - 0x58 (size before relaxing) - .eh_frame 0x00000000006f7358 0x68 check_bond.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006f73c0 0x250 contact.o - 0x268 (size before relaxing) - .eh_frame 0x00000000006f7610 0xc0 djacob.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f76d0 0xea8 eigen.o - 0xec0 (size before relaxing) - .eh_frame 0x00000000006f8578 0x520 blas.o - 0x538 (size before relaxing) - .eh_frame 0x00000000006f8a98 0x60 add.o - 0x78 (size before relaxing) - .eh_frame 0x00000000006f8af8 0x380 entmcm.o - 0x398 (size before relaxing) - .eh_frame 0x00000000006f8e78 0xe0 minim_mcmf.o - 0xf8 (size before relaxing) - .eh_frame 0x00000000006f8f58 0xb90 together.o - 0xba8 (size before relaxing) - .eh_frame 0x00000000006f9ae8 0x3d0 csa.o - 0x3e8 (size before relaxing) - .eh_frame 0x00000000006f9eb8 0x310 minim_jlee.o - 0x328 (size before relaxing) - .eh_frame 0x00000000006fa1c8 0xd8 shift.o - 0xf0 (size before relaxing) - .eh_frame 0x00000000006fa2a0 0x78 diff12.o - 0x90 (size before relaxing) - .eh_frame 0x00000000006fa318 0xa50 bank.o - 0xa68 (size before relaxing) - .eh_frame 0x00000000006fad68 0x790 newconf.o - 0x7a8 (size before relaxing) - .eh_frame 0x00000000006fb4f8 0x60 ran.o - 0x78 (size before relaxing) - .eh_frame 0x00000000006fb558 0xb0 indexx.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006fb608 0x480 MP.o - 0x498 (size before relaxing) - .eh_frame 0x00000000006fba88 0x358 compare_s1.o - 0x370 (size before relaxing) - .eh_frame 0x00000000006fbde0 0x128 prng_32.o - 0x140 (size before relaxing) - .eh_frame 0x00000000006fbf08 0x928 test.o - 0x940 (size before relaxing) - .eh_frame 0x00000000006fc830 0x2a0 banach.o - 0x2b8 (size before relaxing) - .eh_frame 0x00000000006fcad0 0x3a0 distfit.o - 0x3b8 (size before relaxing) - .eh_frame 0x00000000006fce70 0x248 rmsd.o - 0x260 (size before relaxing) - .eh_frame 0x00000000006fd0b8 0x1b8 elecont.o - 0x1d0 (size before relaxing) - .eh_frame 0x00000000006fd270 0x268 dihed_cons.o - 0x280 (size before relaxing) - .eh_frame 0x00000000006fd4d8 0x4c0 sc_move.o - 0x4d8 (size before relaxing) - .eh_frame 0x00000000006fd998 0x538 local_move.o - 0x550 (size before relaxing) - .eh_frame 0x00000000006fded0 0x190 intcartderiv.o - 0x1a8 (size before relaxing) - .eh_frame 0x00000000006fe060 0x288 /tmp/ipo_ifortB4EXK9.o - 0x2a0 (size before relaxing) - .eh_frame 0x00000000006fe2e8 0x298 stochfric.o - 0x2b0 (size before relaxing) - .eh_frame 0x00000000006fe580 0x68 kinetic_lesyng.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006fe5e8 0x590 MD_A-MTS.o - 0x5a8 (size before relaxing) - .eh_frame 0x00000000006feb78 0x1b0 moments.o - 0x1c8 (size before relaxing) - .eh_frame 0x00000000006fed28 0xb0 int_to_cart.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006fedd8 0x140 surfatom.o - 0x158 (size before relaxing) - .eh_frame 0x00000000006fef18 0x4b0 sort.o - 0x4c8 (size before relaxing) - .eh_frame 0x00000000006ff3c8 0x598 muca_md.o - 0x5b0 (size before relaxing) - .eh_frame 0x00000000006ff960 0x420 MREMD.o - 0x438 (size before relaxing) - .eh_frame 0x00000000006ffd80 0x78 rattle.o - 0x90 (size before relaxing) - .eh_frame 0x00000000006ffdf8 0x1c8 gauss.o - 0x1e0 (size before relaxing) - .eh_frame 0x00000000006fffc0 0xa0 energy_split-sep.o - 0xb8 (size before relaxing) - .eh_frame 0x0000000000700060 0x3c0 q_measure.o - 0x3d8 (size before relaxing) - .eh_frame 0x0000000000700420 0xa0 gnmr1.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000007004c0 0x80 proc_proc.o - 0x98 (size before relaxing) - .eh_frame 0x0000000000700540 0x40 cinfo.o - 0x58 (size before relaxing) - .eh_frame 0x0000000000700580 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .eh_frame 0x00000000007005b8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007005d8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007005f8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700618 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700638 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700658 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700678 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700698 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007006b8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007006d8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007006f8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700718 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700738 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700758 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700778 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700798 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007007b8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007007d8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007007f8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700818 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700838 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700858 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700878 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700898 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007008b8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007008d8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007008f8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700918 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700938 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700958 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700978 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700998 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007009b8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007009d8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007009f8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700a18 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700a38 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700a58 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000700ab8 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000700b78 0x48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x60 (size before relaxing) - .eh_frame 0x0000000000700bc0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700be0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700c00 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700c20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700c40 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000700ce0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700d00 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700d20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700d40 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700d60 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700d80 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700da0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700dc0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700de0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700e00 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700e20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700e40 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000700f20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700f40 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700f60 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000700fc0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000700fe0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701000 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0xb8 (size before relaxing) - .eh_frame 0x00000000007010a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007010c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007010e0 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0xf8 (size before relaxing) - .eh_frame 0x00000000007011c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007011e0 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000701320 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000701460 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000701520 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701540 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701560 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x158 (size before relaxing) - .eh_frame 0x00000000007016a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007016c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007016e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701700 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701720 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000701820 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701840 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701860 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701880 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007018a0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007018e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701900 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000701a20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701a40 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000701a80 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701aa0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ac0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ae0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b00 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b40 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b60 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b80 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ba0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701bc0 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000701d40 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701d60 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701d80 0x1e0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x1f8 (size before relaxing) - .eh_frame 0x0000000000701f60 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x1b8 (size before relaxing) - .eh_frame 0x0000000000702100 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702120 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0xd8 (size before relaxing) - .eh_frame 0x00000000007021e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702200 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702220 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000702260 0x400 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x418 (size before relaxing) - .eh_frame 0x0000000000702660 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000702740 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x78 (size before relaxing) - .eh_frame 0x00000000007027a0 0x2e8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x300 (size before relaxing) - .eh_frame 0x0000000000702a88 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000702b28 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000702bc8 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x1d8 (size before relaxing) - .eh_frame 0x0000000000702d88 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000702e88 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000702f68 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000702fa8 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703048 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0xb8 (size before relaxing) - .eh_frame 0x00000000007030e8 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000703208 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703248 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703288 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007032c8 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703368 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x98 (size before relaxing) - .eh_frame 0x00000000007033e8 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703428 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000703628 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x238 (size before relaxing) - .eh_frame 0x0000000000703848 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x98 (size before relaxing) - .eh_frame 0x00000000007038c8 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0xf8 (size before relaxing) - .eh_frame 0x00000000007039a8 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007039e8 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000703b28 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000703b88 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000703cc8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703ce8 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703d88 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000703e08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703e28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703e48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703e68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703e88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703ea8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703ec8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703ee8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703f08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703f28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703f48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703f68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703f88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703fa8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000703fc8 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x138 (size before relaxing) - .eh_frame 0x00000000007040e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704108 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000704208 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0xb8 (size before relaxing) - .eh_frame 0x00000000007042a8 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000704328 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x198 (size before relaxing) - .eh_frame 0x00000000007044a8 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000704628 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000704688 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000704888 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000704a88 0x2c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x2d8 (size before relaxing) - .eh_frame 0x0000000000704d48 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000704d88 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000704dc8 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000704ee8 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x1b8 (size before relaxing) - .eh_frame 0x0000000000705088 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007050a8 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000705188 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000705248 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x78 (size before relaxing) - .eh_frame 0x00000000007052a8 0x358 xdrf_em64/libxdrf.a(libxdrf.o) - 0x370 (size before relaxing) - .eh_frame 0x0000000000705600 0x30 xdrf_em64/libxdrf.a(ftocstr.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000705630 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000705708 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x68 (size before relaxing) - .eh_frame 0x0000000000705758 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000705780 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x138 (size before relaxing) - .eh_frame 0x00000000007058a0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x68 (size before relaxing) - .eh_frame 0x00000000007058f0 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x100 (size before relaxing) - .eh_frame 0x00000000007059d8 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x90 (size before relaxing) - .eh_frame 0x0000000000705a50 0x5f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x608 (size before relaxing) - .eh_frame 0x0000000000706040 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000706160 0x458 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x470 (size before relaxing) - .eh_frame 0x00000000007065b8 0x788 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x7a0 (size before relaxing) - .eh_frame 0x0000000000706d40 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0xa8 (size before relaxing) - .eh_frame 0x0000000000706dd0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x88 (size before relaxing) - .eh_frame 0x0000000000706e40 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x268 (size before relaxing) - .eh_frame 0x0000000000707090 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x300 (size before relaxing) - .eh_frame 0x0000000000707378 0x9d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x9e8 (size before relaxing) - .eh_frame 0x0000000000707d48 0x340 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x358 (size before relaxing) - .eh_frame 0x0000000000708088 0x620 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x638 (size before relaxing) - .eh_frame 0x00000000007086a8 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x168 (size before relaxing) - .eh_frame 0x00000000007087f8 0x1cd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x1ce8 (size before relaxing) - .eh_frame 0x000000000070a4c8 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x100 (size before relaxing) - .eh_frame 0x000000000070a5b0 0x4d8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x4f0 (size before relaxing) - .eh_frame 0x000000000070aa88 0x258 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x270 (size before relaxing) - .eh_frame 0x000000000070ace0 0xa48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0xa60 (size before relaxing) - .eh_frame 0x000000000070b728 0x1680 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x1698 (size before relaxing) - .eh_frame 0x000000000070cda8 0x1200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x1218 (size before relaxing) - .eh_frame 0x000000000070dfa8 0x19f8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x1a10 (size before relaxing) - .eh_frame 0x000000000070f9a0 0x2028 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x2040 (size before relaxing) - .eh_frame 0x00000000007119c8 0x1880 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x1898 (size before relaxing) - .eh_frame 0x0000000000713248 0x568 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x580 (size before relaxing) - .eh_frame 0x00000000007137b0 0x668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x680 (size before relaxing) - .eh_frame 0x0000000000713e18 0x1668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x1680 (size before relaxing) - .eh_frame 0x0000000000715480 0x24e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x2500 (size before relaxing) - .eh_frame 0x0000000000717968 0x2150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x2168 (size before relaxing) - .eh_frame 0x0000000000719ab8 0x2a08 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x2a20 (size before relaxing) - .eh_frame 0x000000000071c4c0 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x1d8 (size before relaxing) - .eh_frame 0x000000000071c680 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x300 (size before relaxing) - .eh_frame 0x000000000071c968 0x470 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x488 (size before relaxing) - .eh_frame 0x000000000071cdd8 0xc60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0xc78 (size before relaxing) - .eh_frame 0x000000000071da38 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x318 (size before relaxing) - .eh_frame 0x000000000071dd38 0xf8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x110 (size before relaxing) - .eh_frame 0x000000000071de30 0x1700 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x1718 (size before relaxing) - .eh_frame 0x000000000071f530 0x1b20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x1b38 (size before relaxing) - .eh_frame 0x0000000000721050 0x1b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x1c8 (size before relaxing) - .eh_frame 0x0000000000721200 0x3c8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x3e0 (size before relaxing) - .eh_frame 0x00000000007215c8 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000721730 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000721898 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000721a00 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x398 (size before relaxing) - .eh_frame 0x0000000000721d80 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x1a8 (size before relaxing) - .eh_frame 0x0000000000721f10 0x1e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x200 (size before relaxing) - .eh_frame 0x00000000007220f8 0xa18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0xa30 (size before relaxing) - .eh_frame 0x0000000000722b10 0x518 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x530 (size before relaxing) - .eh_frame 0x0000000000723028 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000723130 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000723160 0x1b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x1b88 (size before relaxing) - .eh_frame 0x0000000000724cd0 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x308 (size before relaxing) - .eh_frame 0x0000000000724fc0 0x6d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x6e8 (size before relaxing) - .eh_frame 0x0000000000725690 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000725798 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x318 (size before relaxing) - .eh_frame 0x0000000000725a98 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000725c98 0x310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x328 (size before relaxing) - .eh_frame 0x0000000000725fa8 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x2a0 (size before relaxing) - .eh_frame 0x0000000000726230 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x2a0 (size before relaxing) - .eh_frame 0x00000000007264b8 0x130 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x148 (size before relaxing) - .eh_frame 0x00000000007265e8 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x590 (size before relaxing) - .eh_frame 0x0000000000726b60 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x590 (size before relaxing) - .eh_frame 0x00000000007270d8 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x538 (size before relaxing) - .eh_frame 0x00000000007275f8 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x150 (size before relaxing) - .eh_frame 0x0000000000727730 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x150 (size before relaxing) - .eh_frame 0x0000000000727868 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000727940 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000727a18 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000727a48 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000727a60 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x150 (size before relaxing) - .eh_frame 0x0000000000727b98 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000727c70 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000727ca0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000727cc8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000727cf0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000727d18 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000727d30 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000727d60 0x1fa8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x1fc0 (size before relaxing) - .eh_frame 0x0000000000729d08 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729d30 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000729d48 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000729d60 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000729d78 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729da0 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000729db8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729de0 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000729df8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x0000000000729e30 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x0000000000729e68 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x0000000000729ea0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729ec8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x0000000000729f80 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729fa8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729fd0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000729ff8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a020 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a048 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072a100 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072a118 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a140 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a168 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072a1c8 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072a228 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a250 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a278 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a2a0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a2c8 0x88 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0xa0 (size before relaxing) - .eh_frame 0x000000000072a350 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a378 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a3a0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a3c8 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072a428 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072a488 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a4b0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072a4d8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072a510 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072a548 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072a580 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072a5b8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072a5f0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072a610 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072a628 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072a648 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000072a6c0 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000072a738 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072a7f0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072a8a8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072a960 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072aa18 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072aad0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072ab88 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072ac40 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072acf8 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072ad58 0x100 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x118 (size before relaxing) - .eh_frame 0x000000000072ae58 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ae80 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072aea8 0x328 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x340 (size before relaxing) - .eh_frame 0x000000000072b1d0 0x830 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x848 (size before relaxing) - .eh_frame 0x000000000072ba00 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072ba18 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072ba38 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000072ba88 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000072bad8 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x878 (size before relaxing) - .eh_frame 0x000000000072c338 0x680 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x698 (size before relaxing) - .eh_frame 0x000000000072c9b8 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0xa48 (size before relaxing) - .eh_frame 0x000000000072d3e8 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x48 (size before relaxing) - .eh_frame 0x000000000072d418 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x178 (size before relaxing) - .eh_frame 0x000000000072d578 0x390 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x3a8 (size before relaxing) - .eh_frame 0x000000000072d908 0x40 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x58 (size before relaxing) - .eh_frame 0x000000000072d948 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - 0x000000000072d94c . = (ALIGN (0x200000) - ((0x200000 - .) & 0x1fffff)) - 0x000000000092d94c . = (0x200000 DATA_SEGMENT_ALIGN 0x1000) - -.eh_frame - *(.eh_frame) - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - -.tdata - *(.tdata .tdata.* .gnu.linkonce.td.*) - -.tbss - *(.tbss .tbss.* .gnu.linkonce.tb.*) - *(.tcommon) - -.preinit_array 0x000000000092d94c 0x0 - 0x000000000092d94c PROVIDE (__preinit_array_start, .) - *(.preinit_array) - 0x000000000092d94c PROVIDE (__preinit_array_end, .) - -.init_array 0x000000000092d94c 0x0 - 0x000000000092d94c PROVIDE (__init_array_start, .) - *(SORT(.init_array.*)) - *(.init_array) - 0x000000000092d94c PROVIDE (__init_array_end, .) - -.fini_array 0x000000000092d94c 0x0 - 0x000000000092d94c PROVIDE (__fini_array_start, .) - *(.fini_array) - *(SORT(.fini_array.*)) - 0x000000000092d94c PROVIDE (__fini_array_end, .) - -.ctors 0x000000000092d950 0x10 - *crtbegin.o(.ctors) - .ctors 0x000000000092d950 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.ctors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .ctors) - *(SORT(.ctors.*)) - *(.ctors) - .ctors 0x000000000092d958 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.dtors 0x000000000092d960 0x10 - *crtbegin.o(.dtors) - .dtors 0x000000000092d960 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.dtors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .dtors) - *(SORT(.dtors.*)) - *(.dtors) - .dtors 0x000000000092d968 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - 0x000000000092d968 __DTOR_END__ - -.jcr 0x000000000092d970 0x8 - *(.jcr) - .jcr 0x000000000092d970 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .jcr 0x000000000092d970 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.data.rel.ro - *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) - *(.data.rel.ro* .gnu.linkonce.d.rel.ro.*) - -.dynamic 0x000000000092d978 0x1d0 - *(.dynamic) - .dynamic 0x000000000092d978 0x1d0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092d978 _DYNAMIC - -.got 0x000000000092db48 0x1c8 - *(.got) - .got 0x000000000092db48 0x1c8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.igot) - 0x000000000092dd10 . = (. DATA_SEGMENT_RELRO_END 0x18) - -.got.plt 0x000000000092dd10 0x570 - *(.got.plt) - .got.plt 0x000000000092dd10 0x570 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092dd10 _GLOBAL_OFFSET_TABLE_ - *(.igot.plt) - .igot.plt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.data 0x000000000092e280 0x1a2c0 - *(.data .data.* .gnu.linkonce.d.*) - .data 0x000000000092e280 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092e280 data_start - 0x000000000092e280 __data_start - .data 0x000000000092e284 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .data 0x000000000092e284 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x000000000092e284 0x1c 00 - .data 0x000000000092e2a0 0x760 unres.o - .data 0x000000000092ea00 0x5220 initialize_p.o - 0x000000000092ec00 moveid_ - 0x000000000092ec80 langevin_ - 0x00000000009339b0 potentials_ - 0x00000000009339c0 names_ - 0x0000000000933a20 namterm_ - .data 0x0000000000933c20 0x1540 readrtns_CSA.o - .data 0x0000000000935160 0xbc0 parmread.o - .data 0x0000000000935d20 0x460 gen_rand_conf.o - .data 0x0000000000936180 0xa0 map.o - .data 0x0000000000936220 0x60 rescode.o - .data 0x0000000000936280 0x180 timing.o - .data 0x0000000000936400 0x18 misc.o - *fill* 0x0000000000936418 0x8 00 - .data 0x0000000000936420 0x6a0 checkder_p.o - .data 0x0000000000936ac0 0xf80 energy_p_new_barrier.o - .data 0x0000000000937a40 0x340 energy_p_new-sep_barrier.o - .data 0x0000000000937d80 0x11a0 cored.o - .data 0x0000000000938f20 0x30 rmdd.o - *fill* 0x0000000000938f50 0x10 00 - .data 0x0000000000938f60 0xae0 geomout.o - .data 0x0000000000939a40 0x1e0 readpdb.o - .data 0x0000000000939c20 0x100 regularize.o - .data 0x0000000000939d20 0x500 thread.o - .data 0x000000000093a220 0x9c0 mcm.o - .data 0x000000000093abe0 0x660 mc.o - .data 0x000000000093b240 0x160 bond_move.o - .data 0x000000000093b3a0 0x120 contact.o - .data 0x000000000093b4c0 0x4a0 eigen.o - .data 0x000000000093b960 0x740 entmcm.o - .data 0x000000000093c0a0 0x580 together.o - .data 0x000000000093c620 0x34 csa.o - *fill* 0x000000000093c654 0xc 00 - .data 0x000000000093c660 0x380 minim_jlee.o - .data 0x000000000093c9e0 0x1220 bank.o - .data 0x000000000093dc00 0xe0 newconf.o - .data 0x000000000093dce0 0x4 ran.o - *fill* 0x000000000093dce4 0x1c 00 - .data 0x000000000093dd00 0x1c0 MP.o - .data 0x000000000093dec0 0x100 compare_s1.o - .data 0x000000000093dfc0 0x3fe0 prng_32.o - 0x000000000093dfc0 ksrprng_ - .data 0x0000000000941fa0 0xce0 test.o - .data 0x0000000000942c80 0x160 rmsd.o - .data 0x0000000000942de0 0x640 elecont.o - .data 0x0000000000943420 0x1a0 dihed_cons.o - .data 0x00000000009435c0 0x38 sc_move.o - .data 0x00000000009435f8 0x28 local_move.o - .data 0x0000000000943620 0x280 intcartderiv.o - .data 0x00000000009438a0 0x80 stochfric.o - .data 0x0000000000943920 0x780 MD_A-MTS.o - .data 0x00000000009440a0 0x160 surfatom.o - .data 0x0000000000944200 0x400 MREMD.o - .data 0x0000000000944600 0x20 q_measure.o - .data 0x0000000000944620 0x0 proc_proc.o - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .data 0x0000000000944620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .data 0x0000000000944620 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - *fill* 0x0000000000944631 0x3 00 - .data 0x0000000000944634 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .data 0x0000000000944634 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .data 0x0000000000944634 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000000944634 MPIR_F_TRUE - .data 0x0000000000944640 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .data 0x0000000000944640 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - *fill* 0x000000000094464a 0x2 00 - .data 0x000000000094464c 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - *fill* 0x0000000000944656 0x2 00 - .data 0x0000000000944658 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .data 0x0000000000944658 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .data 0x0000000000944658 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - *fill* 0x0000000000944662 0x2 00 - .data 0x0000000000944664 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .data 0x0000000000944670 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - *fill* 0x0000000000944679 0x3 00 - .data 0x000000000094467c 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - *fill* 0x0000000000944685 0x3 00 - .data 0x0000000000944688 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - *fill* 0x0000000000944693 0x1 00 - .data 0x0000000000944694 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .data 0x00000000009446a0 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - *fill* 0x00000000009446ae 0x2 00 - .data 0x00000000009446b0 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - *fill* 0x00000000009446bb 0x5 00 - .data 0x00000000009446c0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .data 0x00000000009446d0 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - *fill* 0x00000000009446e4 0xc 00 - .data 0x00000000009446f0 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - *fill* 0x0000000000944701 0x3 00 - .data 0x0000000000944704 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - *fill* 0x0000000000944712 0x2 00 - .data 0x0000000000944714 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x000000000094471e 0x2 00 - .data 0x0000000000944720 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .data 0x0000000000944720 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - *fill* 0x0000000000944729 0x3 00 - .data 0x000000000094472c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .data 0x000000000094472c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .data 0x000000000094472c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - *fill* 0x000000000094472c 0x4 00 - .data 0x0000000000944730 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .data 0x0000000000944744 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x0000000000944744 0x1c 00 - .data 0x0000000000944760 0xce4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .data 0x0000000000945444 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .data 0x0000000000945444 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - *fill* 0x0000000000945444 0x1c 00 - .data 0x0000000000945460 0xf8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .data 0x0000000000945558 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - *fill* 0x0000000000945558 0x8 00 - .data 0x0000000000945560 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .data 0x0000000000945570 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x000000000094557d 0x3 00 - .data 0x0000000000945580 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .data 0x0000000000945580 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - *fill* 0x000000000094558d 0x3 00 - .data 0x0000000000945590 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - *fill* 0x000000000094559f 0x1 00 - .data 0x00000000009455a0 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - *fill* 0x00000000009455af 0x1 00 - .data 0x00000000009455b0 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - *fill* 0x00000000009455bf 0x1 00 - .data 0x00000000009455c0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .data 0x00000000009455c0 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - *fill* 0x00000000009455ce 0x2 00 - .data 0x00000000009455d0 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - *fill* 0x00000000009455df 0x1 00 - .data 0x00000000009455e0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .data 0x00000000009455f0 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - *fill* 0x00000000009455fe 0x2 00 - .data 0x0000000000945600 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .data 0x0000000000945600 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x000000000094560e 0x2 00 - .data 0x0000000000945610 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .data 0x0000000000945610 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - *fill* 0x000000000094561f 0x1 00 - .data 0x0000000000945620 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - *fill* 0x0000000000945624 0xc 00 - .data 0x0000000000945630 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - *fill* 0x000000000094564a 0x2 00 - .data 0x000000000094564c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .data 0x000000000094564c 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .data 0x0000000000945658 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - *fill* 0x0000000000945662 0x2 00 - .data 0x0000000000945664 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - *fill* 0x000000000094566f 0x1 00 - .data 0x0000000000945670 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .data 0x000000000094567c 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - *fill* 0x0000000000945689 0x3 00 - .data 0x000000000094568c 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - *fill* 0x000000000094569a 0x2 00 - .data 0x000000000094569c 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - *fill* 0x00000000009456a7 0x1 00 - .data 0x00000000009456a8 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x00000000009456b6 0x2 00 - .data 0x00000000009456b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .data 0x00000000009456b8 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .data 0x00000000009456c4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - *fill* 0x00000000009456c4 0x1c 00 - .data 0x00000000009456e0 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x0000000000945760 MPIR_inter_collops - *fill* 0x0000000000945768 0x18 00 - .data 0x0000000000945780 0x103 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x0000000000945800 MPIR_intra_collops - *fill* 0x0000000000945883 0x1 00 - .data 0x0000000000945884 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - *fill* 0x000000000094588d 0x3 00 - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .data 0x0000000000945890 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .data 0x0000000000945890 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .data 0x00000000009458a4 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .data 0x00000000009458a8 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .data 0x00000000009458ac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .data 0x00000000009458ac 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .data 0x00000000009458b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .data 0x00000000009458b0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .data 0x00000000009458b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .data 0x00000000009458b4 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - *fill* 0x00000000009458bf 0x1 00 - .data 0x00000000009458c0 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - *fill* 0x00000000009458cd 0x3 00 - .data 0x00000000009458d0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .data 0x00000000009458e0 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - *fill* 0x00000000009458ee 0x2 00 - .data 0x00000000009458f0 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - *fill* 0x0000000000945902 0x2 00 - .data 0x0000000000945904 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .data 0x0000000000945910 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - *fill* 0x000000000094591e 0x2 00 - .data 0x0000000000945920 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .data 0x0000000000945930 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x000000000094593e 0x2 00 - .data 0x0000000000945940 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - *fill* 0x0000000000945949 0x3 00 - .data 0x000000000094594c 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x0000000000945957 0x1 00 - .data 0x0000000000945958 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - *fill* 0x0000000000945958 0x8 00 - .data 0x0000000000945960 0x13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - *fill* 0x0000000000945973 0x1 00 - .data 0x0000000000945974 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .data 0x0000000000945974 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .data 0x0000000000945974 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .data 0x0000000000945974 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .data 0x0000000000945974 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x0000000000945974 p4_hard_errors - .data 0x0000000000945978 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x0000000000945978 0x8 00 - .data 0x0000000000945980 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .data 0x00000000009459a0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .data 0x00000000009459a0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .data 0x00000000009459a0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .data 0x00000000009459a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .data 0x00000000009459a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .data 0x00000000009459a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .data 0x00000000009459a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .data 0x00000000009459a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .data 0x00000000009459a4 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .data 0x00000000009459a8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .data 0x00000000009459a8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .data 0x00000000009459a8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .data 0x00000000009459a8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .data 0x00000000009459a8 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .data 0x00000000009459a8 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .data 0x00000000009459a8 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x00000000009459b0 0x10 00 - .data 0x00000000009459c0 0x1c20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .data 0x00000000009475e0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .data 0x00000000009475e0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x00000000009475e0 for__segv_default_msg - 0x00000000009475e8 for__l_current_arg - .data 0x00000000009475f0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .data 0x00000000009475f0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - *fill* 0x00000000009475f0 0x10 00 - .data 0x0000000000947600 0x140 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x0000000000947600 for__static_threadstor_private - .data 0x0000000000947740 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .data 0x0000000000947744 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - *fill* 0x0000000000947748 0x18 00 - .data 0x0000000000947760 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .data 0x00000000009477e0 0x460 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x0000000000947c08 __libm_pmatherrf - 0x0000000000947c10 __libm_pmatherr - 0x0000000000947c18 __libm_pmatherrl - 0x0000000000947c24 _LIB_VERSIONIMF - .data 0x0000000000947c40 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .data 0x0000000000947c68 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data 0x0000000000947c68 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x0000000000947c68 __xxref - .data 0x0000000000947c70 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .data 0x0000000000947ca0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .data 0x0000000000947cd0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .data 0x0000000000947cd0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - .data 0x0000000000947cd0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - *fill* 0x0000000000947cf0 0x10 00 - .data 0x0000000000947d00 0x840 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x0000000000948534 __intel_memcpy_mem_ops_method - .data 0x0000000000948540 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .data 0x0000000000948540 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .data 0x0000000000948540 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .data 0x0000000000948540 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.data1 0x0000000000948540 0x3ba0 - *(.data1) - .data1 0x0000000000948540 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .data1 0x0000000000948b80 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .data1 0x00000000009491c0 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .data1 0x0000000000949560 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .data1 0x0000000000949900 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .data1 0x0000000000949f40 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .data1 0x000000000094a2e0 0x1a40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .data1 0x000000000094bd20 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - *fill* 0x000000000094bd30 0x10 00 - .data1 0x000000000094bd40 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data1 0x000000000094bdc0 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - -.sharable_data 0x0000000000a00000 0x0 - 0x0000000000a00000 PROVIDE (__sharable_data_start, .) - *(.sharable_data .sharable_data.* .gnu.linkonce.shrd.*) - 0x0000000000a00000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x0000000000a00000 PROVIDE (__sharable_data_end, .) - 0x0000000000a00000 _edata = . - 0x0000000000a00000 PROVIDE (edata, .) - 0x0000000000a00000 __bss_start = . - -.bss 0x000000000094c100 0x41499980 - *(.dynbss) - .dynbss 0x000000000094c100 0x28 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000094c100 environ@@GLIBC_2.2.5 - 0x000000000094c100 __environ@@GLIBC_2.2.5 - 0x000000000094c100 _environ@@GLIBC_2.2.5 - 0x000000000094c108 stdin@@GLIBC_2.2.5 - 0x000000000094c110 stderr@@GLIBC_2.2.5 - 0x000000000094c120 stdout@@GLIBC_2.2.5 - *(.bss .bss.* .gnu.linkonce.b.*) - .bss 0x000000000094c128 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .bss 0x000000000094c128 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .bss 0x000000000094c128 0x10 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x000000000094c138 0x8 00 - .bss 0x000000000094c140 0x9a60 unres.o - .bss 0x0000000000955ba0 0x20 chainbuild.o - .bss 0x0000000000955bc0 0x9600 convert.o - .bss 0x000000000095f1c0 0x10c0 initialize_p.o - .bss 0x0000000000960280 0x60 matmult.o - .bss 0x00000000009602e0 0x3aa0 readrtns_CSA.o - .bss 0x0000000000963d80 0x1a0 parmread.o - *fill* 0x0000000000963f20 0x20 00 - .bss 0x0000000000963f40 0x1c00 gen_rand_conf.o - .bss 0x0000000000965b40 0x12d60 map.o - .bss 0x00000000009788a0 0x2440 randgens.o - .bss 0x000000000097ace0 0x10 timing.o - *fill* 0x000000000097acf0 0x10 00 - .bss 0x000000000097ad00 0xc0 misc.o - .bss 0x000000000097adc0 0x80 intlocal.o - .bss 0x000000000097ae40 0x54700 cartder.o - .bss 0x00000000009cf540 0x75a60 checkder_p.o - *fill* 0x0000000000a44fa0 0x20 00 - .bss 0x0000000000a44fc0 0x7110880 energy_p_new_barrier.o - .bss 0x0000000007b55840 0x3e0 energy_p_new-sep_barrier.o - .bss 0x0000000007b55c20 0x41f60 minimize_p.o - .bss 0x0000000007b97b80 0xc8 cored.o - *fill* 0x0000000007b97c48 0x18 00 - .bss 0x0000000007b97c60 0x8660 geomout.o - .bss 0x0000000007ba02c0 0x2c0 readpdb.o - .bss 0x0000000007ba0580 0x584320 regularize.o - .bss 0x00000000081248a0 0x380 thread.o - *fill* 0x0000000008124c20 0x20 00 - .bss 0x0000000008124c40 0x2c0 fitsq.o - .bss 0x0000000008124f00 0x1c4e0 mcm.o - .bss 0x00000000081413e0 0x1c400 mc.o - .bss 0x000000000815d7e0 0x140 bond_move.o - .bss 0x000000000815d920 0xc0 check_bond.o - .bss 0x000000000815d9e0 0x1c200 contact.o - .bss 0x0000000008179be0 0x4c0 djacob.o - .bss 0x000000000817a0a0 0x12d40 entmcm.o - .bss 0x000000000818cde0 0x12d60 minim_mcmf.o - .bss 0x000000000819fb40 0x30220 together.o - .bss 0x00000000081cfd60 0xc0 csa.o - .bss 0x00000000081cfe20 0x598320 minim_jlee.o - .bss 0x0000000008768140 0x1a0 bank.o - .bss 0x00000000087682e0 0x7f60 newconf.o - .bss 0x0000000008770240 0x240 ran.o - .bss 0x0000000008770480 0x7e0 indexx.o - .bss 0x0000000008770c60 0x2180 MP.o - .bss 0x0000000008772de0 0x9680 compare_s1.o - .bss 0x000000000877c460 0x1407ec0 test.o - .bss 0x0000000009b84320 0x7100 distfit.o - .bss 0x0000000009b8b420 0x38600 rmsd.o - .bss 0x0000000009bc3a20 0x3e240 elecont.o - .bss 0x0000000009c01c60 0xc0 dihed_cons.o - .bss 0x0000000009c01d20 0x25b40 sc_move.o - .bss 0x0000000009c27860 0x200 local_move.o - .bss 0x0000000009c27a60 0xce4c0 intcartderiv.o - .bss 0x0000000009cf5f20 0xab200 /tmp/ipo_ifortB4EXK9.o - .bss 0x0000000009da1120 0x3f4c0 stochfric.o - .bss 0x0000000009de05e0 0x40 kinetic_lesyng.o - .bss 0x0000000009de0620 0x5e120 MD_A-MTS.o - .bss 0x0000000009e3e740 0x3c0 moments.o - .bss 0x0000000009e3eb00 0xce60 surfatom.o - .bss 0x0000000009e4b960 0x300 sort.o - .bss 0x0000000009e4bc60 0x50a0 muca_md.o - .bss 0x0000000009e50d00 0xdbeda0 MREMD.o - .bss 0x000000000ac0faa0 0x180 energy_split-sep.o - .bss 0x000000000ac0fc20 0x35f80 q_measure.o - .bss 0x000000000ac45ba0 0x10 proc_proc.o - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .bss 0x000000000ac45bb0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .bss 0x000000000ac45bb0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x000000000ac45bb0 MPIR_F_FALSE - 0x000000000ac45bb8 MPIR_F_MPI_BOTTOM - 0x000000000ac45bc0 MPIR_F_STATUS_IGNORE - 0x000000000ac45bc8 MPIR_F_STATUSES_IGNORE - .bss 0x000000000ac45bd0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .bss 0x000000000ac45bd0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .bss 0x000000000ac45bd0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .bss 0x000000000ac45bd0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .bss 0x000000000ac45bd0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .bss 0x000000000ac45bd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - *fill* 0x000000000ac45bd4 0x4 00 - .bss 0x000000000ac45bd8 0x50 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x000000000ac45bd8 MPIR_Infotable - 0x000000000ac45be0 MPIR_Infotable_ptr - 0x000000000ac45be4 MPIR_Infotable_max - 0x000000000ac45be8 MPIR_COMM_WORLD - 0x000000000ac45bf0 MPIR_COMM_SELF - 0x000000000ac45bf8 MPIR_GROUP_EMPTY - 0x000000000ac45c00 MPIR_Has_been_initialized - 0x000000000ac45c04 MPIR_Print_queues - 0x000000000ac45c08 MPIR_Dump_Mem - 0x000000000ac45c0c MPIR_Dump_Ptrs - 0x000000000ac45c10 MPICHX_QOS_BANDWIDTH - 0x000000000ac45c14 MPICHX_QOS_PARAMETERS - .bss 0x000000000ac45c28 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .bss 0x000000000ac45c28 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .bss 0x000000000ac45c28 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x000000000ac45c28 MPIR_PACKED_PTR - .bss 0x000000000ac45c30 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .bss 0x000000000ac45c30 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x000000000ac45c30 0x10 00 - .bss 0x000000000ac45c40 0x2100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .bss 0x000000000ac47d40 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .bss 0x000000000ac47d40 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .bss 0x000000000ac47d40 0x6820 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .bss 0x000000000ac4e560 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .bss 0x000000000ac4e56c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .bss 0x000000000ac4e56c 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x000000000ac4e56c MPIR_TOPOLOGY_KEYVAL - .bss 0x000000000ac4e570 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .bss 0x000000000ac4e570 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .bss 0x000000000ac4e570 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - *fill* 0x000000000ac4e570 0x10 00 - .bss 0x000000000ac4e580 0x1058 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .bss 0x000000000ac4f5d8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .bss 0x000000000ac4f5d8 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .bss 0x000000000ac4f5e0 0x5c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x000000000ac4f63c 0x4 00 - .bss 0x000000000ac4f640 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .bss 0x000000000ac4f860 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .bss 0x000000000ac4f86c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x000000000ac4f86c 0x4 00 - .bss 0x000000000ac4f870 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x000000000ac4f878 0x8 00 - .bss 0x000000000ac4f880 0x520 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x000000000ac4f880 start_prog_error - .bss 0x000000000ac4fda0 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x000000000ac4fda0 usc_MD_rollover_val - .bss 0x000000000ac4fda8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .bss 0x000000000ac4fda8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .bss 0x000000000ac4fda8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x000000000ac4fda8 MPID_Print_queues - 0x000000000ac4fdac MPID_n_pending - 0x000000000ac4fdb0 MPID_devset - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .bss 0x000000000ac4fdb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .bss 0x000000000ac4fdb8 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x000000000ac4fdb8 MPID_TRACE_FILE - 0x000000000ac4fdc0 MPID_DEBUG_FILE - 0x000000000ac4fdc8 MPID_UseDebugFile - 0x000000000ac4fdcc MPID_DebugFlag - .bss 0x000000000ac4fdd4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x000000000ac4fdd4 0x4 00 - .bss 0x000000000ac4fdd8 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x000000000ac4fdd8 MPID_procinfo - 0x000000000ac4fde0 MPID_IS_HETERO - *fill* 0x000000000ac4fde4 0x4 00 - .bss 0x000000000ac4fde8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .bss 0x000000000ac4fdf8 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .bss 0x000000000ac4fe00 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .bss 0x000000000ac4fe00 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .bss 0x000000000ac4fe00 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .bss 0x000000000ac4fe00 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .bss 0x000000000ac4fe00 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x000000000ac4fe00 expect_cancel_ack - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .bss 0x000000000ac4fe04 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x000000000ac4fe04 0x1c 00 - .bss 0x000000000ac4fe20 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x000000000ac4fe20 MPIR_proctable - 0x000000000ac4fe28 MPIR_proctable_size - 0x000000000ac4fe2c MPIR_debug_state - 0x000000000ac4fe30 MPIR_debug_gate - 0x000000000ac4fe38 MPIR_debug_abort_string - 0x000000000ac4fe40 MPIR_being_debugged - .bss 0x000000000ac4fea8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .bss 0x000000000ac4fea8 0x19 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x000000000ac4fec1 0x3 00 - .bss 0x000000000ac4fec4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .bss 0x000000000ac4fec4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .bss 0x000000000ac4fec4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x000000000ac4fec4 0x4 00 - .bss 0x000000000ac4fec8 0x70 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - *fill* 0x000000000ac4ff38 0x8 00 - .bss 0x000000000ac4ff40 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .bss 0x000000000ac4ffa4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x000000000ac4ffa4 0xc 00 - .bss 0x000000000ac4ffb0 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .bss 0x000000000ac4ffc4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - *fill* 0x000000000ac4ffc4 0x4 00 - .bss 0x000000000ac4ffc8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .bss 0x000000000ac4ffd8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .bss 0x000000000ac4ffd8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .bss 0x000000000ac4ffd8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .bss 0x000000000ac4ffd8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .bss 0x000000000ac4ffd8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .bss 0x000000000ac4ffd8 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .bss 0x000000000ac4ffdc 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .bss 0x000000000ac4ffe0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .bss 0x000000000ac4ffe0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x000000000ac4ffe0 MPID_flow_info - 0x000000000ac4ffe8 MPID_DebugFlow - .bss 0x000000000ac4ffec 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - *fill* 0x000000000ac4ffec 0x14 00 - .bss 0x000000000ac50000 0x178 xdrf_em64/libxdrf.a(libxdrf.o) - .bss 0x000000000ac50178 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .bss 0x000000000ac50178 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x000000000ac50198 0x8 00 - .bss 0x000000000ac501a0 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x000000000ac503a8 for__user_iomsg_buf - 0x000000000ac503b0 for__user_iomsg_len - .bss 0x000000000ac503e0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x000000000ac503e0 for__l_exit_termination - *fill* 0x000000000ac503e4 0x4 00 - .bss 0x000000000ac503e8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x000000000ac503f0 for__l_excpt_info - 0x000000000ac503f8 for__l_fpe_mask - 0x000000000ac503fc for__l_undcnt - 0x000000000ac50400 for__l_ovfcnt - 0x000000000ac50404 for__l_div0cnt - 0x000000000ac50408 for__l_invcnt - 0x000000000ac5040c for__l_inecnt - 0x000000000ac50410 for__l_fmtrecl - 0x000000000ac50414 for__l_ufmtrecl - 0x000000000ac50418 for__l_blocksize - 0x000000000ac5041c for__l_buffercount - .bss 0x000000000ac50420 0x3b40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x000000000ac51840 for__lub_table - .bss 0x000000000ac53f60 0x20a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x000000000ac53f60 for__file_info_hash_table - .bss 0x000000000ac56000 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x000000000ac56420 for__l_exit_hand_decl - .bss 0x000000000ac56440 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x000000000ac56450 for__reentrancy_mode - 0x000000000ac56454 for__reentrancy_initialized - .bss 0x000000000ac56458 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .bss 0x000000000ac56460 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - *fill* 0x000000000ac5646c 0x4 00 - .bss 0x000000000ac56470 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .bss 0x000000000ac564b0 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x000000000ac56540 for__aio_global_mutex - .bss 0x000000000ac56570 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - *fill* 0x000000000ac56578 0x8 00 - .bss 0x000000000ac56580 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x000000000ac56600 tbk__jmp_env - .bss 0x000000000ac566e0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x000000000ac566e0 __intel_cpu_indicator - .bss 0x000000000ac566e4 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .bss 0x000000000ac566e4 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - *fill* 0x000000000ac566e4 0x1c 00 - .bss 0x000000000ac56700 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .bss 0x000000000ac56b20 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000ac56b20 __intel_memcpy_largest_cache_size - 0x000000000ac56b24 __intel_memcpy_largest_cachelinesize - .bss 0x000000000ac56b28 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .bss 0x000000000ac56b28 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .bss 0x000000000ac56b28 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .bss 0x000000000ac56b28 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(COMMON) - *fill* 0x000000000ac56b28 0x18 00 - COMMON 0x000000000ac56b40 0x2579c050 unres.o - 0x000000000ac56b40 header_ - 0x000000000ac56ba0 timing_ - 0x000000000ac56ce0 ffield_ - 0x000000000ac56e60 refstruct_ - 0x000000000ac730d0 sumsl_flag_ - 0x000000000ac730e0 links_split_ - 0x000000000ac73100 precomp1_ - 0x000000000ace3900 chain_ - 0x000000000ad37f80 parfiles_ - 0x000000000ad38a80 rotat_old_ - 0x000000000ad42080 contacts1_ - 0x000000000b99f440 diploc_ - 0x000000000b9a2d80 mdpmpi_ - 0x000000000b9aada0 iounits_ - 0x000000000b9aae20 mdpar_ - 0x000000000b9aaea0 remdrestart_ - 0x000000000bdbc6c0 restr_ - 0x000000000bdc9520 precomp2_ - 0x000000000be39d20 links_ - 0x000000000ceaa080 mdgrad_ - 0x000000000cec62b0 from_zscore_ - 0x000000000cec62c0 types_ - 0x000000000cec6320 back_constr_ - 0x000000000cedc900 setup_ - 0x000000000cee2940 restraints_ - 0x000000000cee2960 qmeas_ - 0x000000000cf58ca0 mpipriv_ - 0x000000000cf58ce0 cntrl_ - 0x000000000cf58d60 rotmat_ - 0x000000000cfad360 lagrange_ - 0x000000001d80b620 fnames_ - 0x000000001d80c630 stoptim_ - 0x000000001d80c640 time1_ - 0x000000001d80c680 mdcalc_ - 0x000000001d80c7a0 dipmat_ - 0x00000000287d47a0 remdcommon_ - 0x00000000287da7e0 sbridge_ - 0x00000000287da880 csafiles_ - 0x00000000287db480 inertia_ - 0x00000000287db5e0 contacts_hb_ - 0x000000002d6239a0 srutu_ - 0x000000002d6239c0 contdistrib_ - 0x000000003022ce20 traj1cache_ - 0x0000000030274f00 stretch_ - 0x0000000030275520 contacts_ - 0x00000000302ad940 geo_ - 0x00000000302ad980 csaunits_ - 0x00000000302ad9c0 body_ - 0x00000000302b3b40 interact_ - 0x00000000302c9000 oldgeo_ - 0x0000000030384900 rotat_ - 0x00000000303bcd00 var_ - *fill* 0x00000000303f2b90 0x10 00 - COMMON 0x00000000303f2ba0 0x33250 chainbuild.o - 0x00000000303f2ba0 thetas_ - 0x00000000303f3500 peptbond_ - 0x00000000303f3540 indices_ - 0x00000000303fa5a0 sclocal_ - 0x00000000303fc880 invlen_ - 0x0000000030401380 theta_abinitio_ - *fill* 0x0000000030425df0 0x10 00 - COMMON 0x0000000030425e00 0x43d7980 initialize_p.o - 0x0000000030425e00 deriv_loc_ - 0x0000000030425fe0 splitele_ - 0x0000000030426000 fourier_ - 0x0000000030426360 torsiond_ - 0x000000003043a560 machsw_ - 0x000000003043a580 derivat_ - 0x00000000347a8180 deriv_scloc_ - 0x00000000347e7600 mpgrad_ - 0x00000000347e9ba0 torcnstr_ - 0x00000000347f0c40 mcm_ - 0x00000000347f2d00 move_ - 0x00000000347f7880 windows_ - 0x00000000347fb0e0 accept_stats_ - 0x00000000347fd100 iofile_ - 0x00000000347fd760 minimm_ - COMMON 0x00000000347fd780 0x5962d90 readrtns_CSA.o - 0x00000000347fd780 mvstat_ - 0x00000000347fd9d0 dih_control_ - 0x00000000347fd9e0 bounds_ - 0x00000000348024e0 alphaa_ - 0x0000000034820c80 bank_ - 0x00000000348465a0 mce_ - 0x00000000348467e0 mucarem_ - 0x000000003484e7e0 mapp_ - 0x0000000034874000 langforc_ - 0x000000003a09e5a0 minvar_ - 0x000000003a0b1320 struct_ - 0x000000003a0b1d60 pool_ - 0x000000003a10f9c0 double_muca_ - 0x000000003a135200 csa_input_ - 0x000000003a1352a0 diffcuta_ - 0x000000003a1352c0 thread_ - 0x000000003a135420 pizda_ - 0x000000003a1366e0 varin_ - 0x000000003a149440 bank_disulfid_ - 0x000000003a149640 thread1_ - 0x000000003a14b310 langmat_ - 0x000000003a14b320 integer_muca_ - 0x000000003a14b330 mce_counters_ - 0x000000003a14b360 send2_ - *fill* 0x000000003a160510 0x10 00 - COMMON 0x000000003a160520 0x8380 parmread.o - 0x000000003a160520 torsion_ - 0x000000003a166000 scrot_ - COMMON 0x000000003a1688a0 0x1f0 gen_rand_conf.o - 0x000000003a1688a0 calc_ - *fill* 0x000000003a168a90 0x10 00 - COMMON 0x000000003a168aa0 0x3f0 randgens.o - 0x000000003a168aa0 vrandd_ - *fill* 0x000000003a168e90 0x10 00 - COMMON 0x000000003a168ea0 0x6844 timing.o - 0x000000003a168ea0 info_ - 0x000000003a16cec0 info1_ - COMMON 0x000000003a16f6e4 0x0 cartder.o - *fill* 0x000000003a16f6e4 0x1c 00 - COMMON 0x000000003a16f700 0x62b04 energy_p_new_barrier.o - 0x000000003a16f700 calcthet_ - 0x000000003a16f7a0 locel_ - 0x000000003a16fa20 maxgrad_ - 0x000000003a16fad0 sccalc_ - 0x000000003a16fb00 vectors_ - 0x000000003a1d2200 kutas_ - *fill* 0x000000003a1d2204 0xc 00 - COMMON 0x000000003a1d2210 0x4 minimize_p.o - 0x000000003a1d2210 chuju_ - *fill* 0x000000003a1d2214 0xc 00 - COMMON 0x000000003a1d2220 0xb04c28 geomout.o - 0x000000003a1d2220 frag_ - 0x000000003a1d22c0 wagi_ - 0x000000003a1d22e0 frozen_ - 0x000000003a1d35a0 pochodne_ - 0x000000003acd48b0 store0_ - 0x000000003acd48c0 c_frag_ - *fill* 0x000000003acd6e48 0x18 00 - COMMON 0x000000003acd6e60 0x5dcd0 mcm.o - 0x000000003acd6e60 cache_ - *fill* 0x000000003ad34b30 0x10 00 - COMMON 0x000000003ad34b40 0x98 bond_move.o - 0x000000003ad34b40 refer_ - *fill* 0x000000003ad34bd8 0x8 00 - COMMON 0x000000003ad34be0 0xc djacob.o - 0x000000003ad34be0 __BLNK__ - *fill* 0x000000003ad34bec 0x4 00 - COMMON 0x000000003ad34bf0 0x20 eigen.o - 0x000000003ad34bf0 par_ - COMMON 0x000000003ad34c10 0x0 minim_mcmf.o - *fill* 0x000000003ad34c10 0x10 00 - COMMON 0x000000003ad34c20 0x384c newconf.o - 0x000000003ad34c20 spinka_ - *fill* 0x000000003ad3846c 0x4 00 - COMMON 0x000000003ad38470 0x8 MP.o - 0x000000003ad38470 aaaa_ - *fill* 0x000000003ad38478 0x8 00 - COMMON 0x000000003ad38480 0xe100 banach.o - 0x000000003ad38480 banii_ - COMMON 0x000000003ad46580 0x4b0 dihed_cons.o - 0x000000003ad46580 secondarys_ - *fill* 0x000000003ad46a30 0x10 00 - COMMON 0x000000003ad46a40 0x360 local_move.o - 0x000000003ad46a40 loc_work_ - 0x000000003ad46d60 loc_const_ - COMMON 0x000000003ad46da0 0x4 /tmp/ipo_ifortB4EXK9.o - 0x000000003ad46da0 cipiszcze_ - *fill* 0x000000003ad46da4 0x1c 00 - COMMON 0x000000003ad46dc0 0xe100 stochfric.o - 0x000000003ad46dc0 syfek_ - COMMON 0x000000003ad54ec0 0xe118 MD_A-MTS.o - 0x000000003ad54ec0 stochcalc_ - 0x000000003ad62fc0 gucio_ - *fill* 0x000000003ad62fd8 0x8 00 - COMMON 0x000000003ad62fe0 0x7080000 MREMD.o - 0x000000003ad62fe0 przechowalnia_ - COMMON 0x0000000041de2fe0 0xbe8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000041de2fe0 MPIR_I_COMPLEX - 0x0000000041de30a0 MPIR_I_DOUBLE_PRECISION - 0x0000000041de3160 MPIR_I_2DCOMPLEX - 0x0000000041de3220 MPIR_real8_dte - 0x0000000041de32e0 MPIR_int1_dte - 0x0000000041de33a0 MPIR_I_REAL - 0x0000000041de3460 MPIR_I_2REAL - 0x0000000041de3520 MPIR_I_DCOMPLEX - 0x0000000041de35e0 MPIR_I_INTEGER - 0x0000000041de36a0 MPIR_real4_dte - 0x0000000041de3760 MPIR_I_2DOUBLE_PRECISION - 0x0000000041de3820 MPIR_I_2INTEGER - 0x0000000041de38e0 MPIR_I_2COMPLEX - 0x0000000041de39a0 MPIR_I_LOGICAL - 0x0000000041de3a60 MPIR_int2_dte - 0x0000000041de3b20 MPIR_int4_dte - COMMON 0x0000000041de3bc8 0x28 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x0000000041de3bc8 MPIR_errhandlers - 0x0000000041de3bd0 MPIR_topo_els - 0x0000000041de3bd8 MPIR_tid - 0x0000000041de3be0 MPIR_fdtels - 0x0000000041de3be8 MPIR_qels - *fill* 0x0000000041de3bf0 0x10 00 - COMMON 0x0000000041de3c00 0x1228 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x0000000041de3c00 MPIR_I_LONG_LONG_INT - 0x0000000041de3cc0 MPIR_I_LONG_INT - 0x0000000041de3d80 MPIR_I_SHORT - 0x0000000041de3e40 MPI_LONG_DOUBLE_INT_var - 0x0000000041de3e60 MPIR_dtes - 0x0000000041de3e80 MPIR_I_UB - 0x0000000041de3f40 MPIR_I_FLOAT_INT - 0x0000000041de4000 MPIR_I_SHORT_INT - 0x0000000041de40b0 MPI_DOUBLE_INT_var - 0x0000000041de40c0 MPIR_I_2INT - 0x0000000041de4180 MPIR_I_USHORT - 0x0000000041de4240 MPIR_I_FLOAT - 0x0000000041de4300 MPIR_I_UINT - 0x0000000041de43a8 MPI_FLOAT_INT_var - 0x0000000041de43c0 MPIR_I_BYTE - 0x0000000041de4480 MPIR_I_CHAR - 0x0000000041de4540 MPIR_I_PACKED - 0x0000000041de4600 MPIR_I_INT - 0x0000000041de46c0 MPIR_I_DOUBLE_INT - 0x0000000041de4780 MPIR_I_LONG_DOUBLE - 0x0000000041de4840 MPIR_I_2FLOAT - 0x0000000041de4900 MPIR_I_UCHAR - 0x0000000041de49c0 MPIR_I_2DOUBLE - 0x0000000041de4a68 MPI_SHORT_INT_var - 0x0000000041de4a80 MPIR_I_LONG - 0x0000000041de4b40 MPIR_I_ULONG - 0x0000000041de4c00 MPIR_I_LONG_DOUBLE_INT - 0x0000000041de4cb0 MPI_LONG_INT_var - 0x0000000041de4cc0 MPIR_I_LB - 0x0000000041de4d80 MPIR_I_DOUBLE - COMMON 0x0000000041de4e28 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x0000000041de4e28 MPIR_hbt_els - 0x0000000041de4e30 MPIR_hbts - COMMON 0x0000000041de4e38 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x0000000041de4e38 MPIR_Op_errno - *fill* 0x0000000041de4e3c 0x4 00 - COMMON 0x0000000041de4e40 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x0000000041de4e40 tty_orig - *fill* 0x0000000041de4e52 0xe 00 - COMMON 0x0000000041de4e60 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x0000000041de4e60 MPID_MyWorldSize - 0x0000000041de4e64 MPID_MyWorldRank - 0x0000000041de4e68 MPIR_rhandles - 0x0000000041de4e70 MPIR_shandles - 0x0000000041de4e80 ch_debug_buf - COMMON 0x0000000041de4f00 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x0000000041de4f00 MPID_byte_order - COMMON 0x0000000041de4f04 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x0000000041de4f04 __P4FROM - 0x0000000041de4f08 __P4GLOBALTYPE - 0x0000000041de4f0c __P4TYPE - 0x0000000041de4f10 __P4LEN - *fill* 0x0000000041de4f14 0xc 00 - COMMON 0x0000000041de4f20 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x0000000041de4f20 MPID_recvs - COMMON 0x0000000041de4f40 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x0000000041de4f40 total_pack_unacked - 0x0000000041de4f50 MPID_pack_info - 0x0000000041de4f60 expect_ack - *fill* 0x0000000041de4f64 0xc 00 - COMMON 0x0000000041de4f70 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x0000000041de4f70 MPIR_debug_q - 0x0000000041de4f78 MPIR_debug_sq - 0x0000000041de4f80 MPIR_debug_rh - 0x0000000041de4f90 MPIR_All_communicators - 0x0000000041de4fa0 MPIR_debug_qh - 0x0000000041de4fa8 MPIR_debug_s - 0x0000000041de4fb0 MPIR_debug_c - 0x0000000041de4fb8 MPIR_debug_qel - 0x0000000041de4fc0 MPIR_debug_sqel - 0x0000000041de4fc8 MPIR_debug_cl - *fill* 0x0000000041de4fd0 0x10 00 - COMMON 0x0000000041de4fe0 0x64c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - 0x0000000041de4fe0 bm_outfile - 0x0000000041de5060 rm_outfile_head - 0x0000000041de50c8 execer_pg - 0x0000000041de50d0 globmemsize - 0x0000000041de50d4 p4_rm_rank - 0x0000000041de50e0 p4_brdcst_info - 0x0000000041de5100 procgroup_file - 0x0000000041de5200 p4_global - 0x0000000041de5208 execer_mastport - 0x0000000041de5220 execer_id - 0x0000000041de52a4 execer_numtotnodes - 0x0000000041de52a8 listener_info - 0x0000000041de52b0 p4_local - 0x0000000041de52b8 logging_flag - 0x0000000041de52c0 execer_myhost - 0x0000000041de5340 p4_wd - 0x0000000041de5440 p4_remote_debug_level - 0x0000000041de5444 sserver_port - 0x0000000041de5460 p4_myname_in_procgroup - 0x0000000041de54a0 hand_start_remotes - 0x0000000041de54a4 execer_starting_remotes - 0x0000000041de54c0 whoami_p4 - 0x0000000041de5540 execer_masthost - 0x0000000041de55a4 p4_debug_level - 0x0000000041de55c0 local_domain - 0x0000000041de5624 execer_mynumprocs - 0x0000000041de5628 execer_mynodenum - *fill* 0x0000000041de562c 0x4 00 - COMMON 0x0000000041de5630 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x0000000041de5630 message_catalog - COMMON 0x0000000041de5638 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x0000000041de5638 for__a_argv - 0x0000000041de5640 for__l_argc - *fill* 0x0000000041de5644 0x1c 00 - COMMON 0x0000000041de5660 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x0000000041de5660 for__pthread_mutex_unlock_ptr - 0x0000000041de5668 for__pthread_mutex_init_ptr - 0x0000000041de5670 for__pthread_mutex_lock_ptr - 0x0000000041de5680 for__aio_lub_table - 0x0000000041de5a80 . = ALIGN ((. != 0x0)?0x8:0x1) - -.lbss - *(.dynlbss) - *(.lbss .lbss.* .gnu.linkonce.lb.*) - *(LARGE_COMMON) - -.sharable_bss 0x0000000041e00000 0x0 - 0x0000000041e00000 PROVIDE (__sharable_bss_start, .) - *(.dynsharablebss) - .dynsharablebss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.sharable_bss .sharable_bss.* .gnu.linkonce.shrb.*) - *(SHARABLE_COMMON) - 0x0000000041e00000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x0000000041e00000 PROVIDE (__sharable_bss_end, .) - 0x0000000041e00000 . = ALIGN (0x8) - -.lrodata - *(.lrodata .lrodata.* .gnu.linkonce.lr.*) - -.ldata 0x00000000421e5a80 0x0 - *(.ldata .ldata.* .gnu.linkonce.l.*) - 0x00000000421e5a80 . = ALIGN ((. != 0x0)?0x8:0x1) - 0x00000000421e5a80 . = ALIGN (0x8) - 0x00000000421e5a80 _end = . - 0x00000000421e5a80 PROVIDE (end, .) - 0x00000000421e5a80 . = DATA_SEGMENT_END (.) - -.stab - *(.stab) - -.stabstr - *(.stabstr) - -.stab.excl - *(.stab.excl) - -.stab.exclstr - *(.stab.exclstr) - -.stab.index - *(.stab.index) - -.stab.indexstr - *(.stab.indexstr) - -.comment 0x0000000000000000 0x2143 - *(.comment) - .comment 0x0000000000000000 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x2d (size before relaxing) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .comment 0x000000000000002c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .comment 0x000000000000003f 0x13 unres.o - .comment 0x0000000000000052 0x29 energy_p_new_barrier.o - .comment 0x0000000000000000 0x2d proc_proc.o - .comment 0x000000000000007b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .comment 0x00000000000000a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .comment 0x00000000000000d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .comment 0x0000000000000105 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .comment 0x0000000000000133 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .comment 0x0000000000000161 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .comment 0x000000000000018f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .comment 0x00000000000001bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .comment 0x00000000000001eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .comment 0x0000000000000219 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .comment 0x0000000000000247 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .comment 0x0000000000000275 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .comment 0x00000000000002a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .comment 0x00000000000002d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .comment 0x00000000000002ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .comment 0x000000000000032d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .comment 0x000000000000035b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .comment 0x0000000000000389 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .comment 0x00000000000003b7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .comment 0x00000000000003e5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .comment 0x0000000000000413 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .comment 0x0000000000000441 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .comment 0x000000000000046f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .comment 0x000000000000049d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .comment 0x00000000000004cb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .comment 0x00000000000004f9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .comment 0x0000000000000527 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .comment 0x0000000000000555 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .comment 0x0000000000000583 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .comment 0x00000000000005b1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .comment 0x00000000000005df 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .comment 0x000000000000060d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .comment 0x000000000000063b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .comment 0x0000000000000669 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .comment 0x0000000000000697 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .comment 0x00000000000006c5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .comment 0x00000000000006f3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .comment 0x0000000000000721 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .comment 0x000000000000074f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .comment 0x000000000000077d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .comment 0x00000000000007ab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .comment 0x00000000000007d9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .comment 0x0000000000000807 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .comment 0x0000000000000835 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .comment 0x0000000000000863 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .comment 0x0000000000000891 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .comment 0x00000000000008bf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .comment 0x00000000000008ed 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .comment 0x000000000000091b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .comment 0x0000000000000949 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .comment 0x0000000000000977 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .comment 0x00000000000009a5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .comment 0x00000000000009d3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .comment 0x0000000000000a01 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .comment 0x0000000000000a2f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .comment 0x0000000000000a5d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .comment 0x0000000000000a8b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .comment 0x0000000000000ab9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .comment 0x0000000000000ae7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .comment 0x0000000000000b15 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .comment 0x0000000000000b43 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .comment 0x0000000000000b71 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .comment 0x0000000000000b9f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .comment 0x0000000000000bcd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .comment 0x0000000000000bfb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .comment 0x0000000000000c29 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .comment 0x0000000000000c57 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .comment 0x0000000000000c85 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .comment 0x0000000000000cb3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .comment 0x0000000000000ce1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .comment 0x0000000000000d0f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .comment 0x0000000000000d3d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .comment 0x0000000000000d6b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .comment 0x0000000000000d99 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .comment 0x0000000000000dc7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .comment 0x0000000000000df5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .comment 0x0000000000000e23 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .comment 0x0000000000000e51 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .comment 0x0000000000000e7f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .comment 0x0000000000000ead 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .comment 0x0000000000000edb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .comment 0x0000000000000f09 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .comment 0x0000000000000f37 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .comment 0x0000000000000f65 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .comment 0x0000000000000f93 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .comment 0x0000000000000fc1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .comment 0x0000000000000fef 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .comment 0x000000000000101d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .comment 0x000000000000104b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .comment 0x0000000000001079 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .comment 0x00000000000010a7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .comment 0x00000000000010d5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .comment 0x0000000000001103 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .comment 0x0000000000001131 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .comment 0x000000000000115f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .comment 0x000000000000118d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .comment 0x00000000000011bb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .comment 0x00000000000011e9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .comment 0x0000000000001217 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .comment 0x0000000000001245 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .comment 0x0000000000001273 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .comment 0x00000000000012a1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .comment 0x00000000000012cf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .comment 0x00000000000012fd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .comment 0x000000000000132b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .comment 0x0000000000001359 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .comment 0x0000000000001387 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .comment 0x00000000000013b5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .comment 0x00000000000013e3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .comment 0x0000000000001411 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .comment 0x000000000000143f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .comment 0x000000000000146d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .comment 0x000000000000149b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .comment 0x00000000000014c9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .comment 0x00000000000014f7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .comment 0x0000000000001525 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .comment 0x0000000000001553 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .comment 0x0000000000001581 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .comment 0x00000000000015af 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .comment 0x00000000000015dd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .comment 0x000000000000160b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .comment 0x0000000000001639 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .comment 0x0000000000001667 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .comment 0x0000000000001695 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .comment 0x00000000000016c3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .comment 0x00000000000016f1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .comment 0x000000000000171f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .comment 0x000000000000174d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .comment 0x000000000000177b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .comment 0x00000000000017a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .comment 0x00000000000017d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .comment 0x0000000000001805 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .comment 0x0000000000001833 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .comment 0x0000000000001861 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .comment 0x000000000000188f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .comment 0x00000000000018bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .comment 0x00000000000018eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .comment 0x0000000000001919 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .comment 0x0000000000001947 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .comment 0x0000000000001975 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .comment 0x00000000000019a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .comment 0x00000000000019d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .comment 0x00000000000019ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .comment 0x0000000000001a2d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .comment 0x0000000000001a5b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .comment 0x0000000000001a89 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .comment 0x0000000000001ab7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .comment 0x0000000000001ae5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .comment 0x0000000000001b13 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .comment 0x0000000000001b41 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .comment 0x0000000000001b6f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .comment 0x0000000000001b9d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .comment 0x0000000000001bcb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .comment 0x0000000000001bf9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .comment 0x0000000000001c27 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .comment 0x0000000000001c55 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .comment 0x0000000000001c83 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .comment 0x0000000000001cb1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .comment 0x0000000000001cdf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .comment 0x0000000000001d0d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .comment 0x0000000000001d3b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .comment 0x0000000000001d69 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .comment 0x0000000000001d97 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .comment 0x0000000000001dc5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .comment 0x0000000000001df3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .comment 0x0000000000001e21 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .comment 0x0000000000001e4f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .comment 0x0000000000001e7d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .comment 0x0000000000001eab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .comment 0x0000000000001ed9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .comment 0x0000000000001f07 0x3a xdrf_em64/libxdrf.a(libxdrf.o) - .comment 0x0000000000001f41 0x3a xdrf_em64/libxdrf.a(ftocstr.o) - .comment 0x0000000000001f7b 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .comment 0x0000000000001f8e 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .comment 0x0000000000001fa1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .comment 0x0000000000001fb4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .comment 0x0000000000001fc7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .comment 0x0000000000001fda 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .comment 0x0000000000001fed 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .comment 0x0000000000002000 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .comment 0x0000000000002013 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .comment 0x0000000000002026 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .comment 0x0000000000002039 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .comment 0x000000000000204c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .comment 0x000000000000205f 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .comment 0x0000000000002072 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .comment 0x0000000000002085 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .comment 0x0000000000002098 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .comment 0x00000000000020ab 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .comment 0x00000000000020be 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .comment 0x00000000000020d1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .comment 0x00000000000020e4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .comment 0x00000000000020f7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .comment 0x000000000000210a 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .comment 0x000000000000211d 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .comment 0x0000000000002130 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .comment 0x0000000000000000 0x2d /usr/lib64/libc_nonshared.a(elf-init.oS) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.debug - *(.debug) - -.line - *(.line) - -.debug_srcinfo - *(.debug_srcinfo) - -.debug_sfnames - *(.debug_sfnames) - -.debug_aranges 0x0000000000000000 0x30 - *(.debug_aranges) - .debug_aranges - 0x0000000000000000 0x30 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_pubnames - 0x0000000000000000 0x16b - *(.debug_pubnames) - .debug_pubnames - 0x0000000000000000 0x16b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_info 0x0000000000000000 0x3147 - *(.debug_info .gnu.linkonce.wi.*) - .debug_info 0x0000000000000000 0x1d94 cored.o - .debug_info 0x0000000000001d94 0x13b3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_abbrev 0x0000000000000000 0x204 - *(.debug_abbrev) - .debug_abbrev 0x0000000000000000 0xed cored.o - .debug_abbrev 0x00000000000000ed 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_line 0x0000000000000000 0x16bf - *(.debug_line) - .debug_line 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .debug_line 0x0000000000000000 0x0 unres.o - .debug_line 0x0000000000000000 0x0 arcos.o - .debug_line 0x0000000000000000 0x0 cartprint.o - .debug_line 0x0000000000000000 0x0 chainbuild.o - .debug_line 0x0000000000000000 0x0 convert.o - .debug_line 0x0000000000000000 0x0 initialize_p.o - .debug_line 0x0000000000000000 0x0 matmult.o - .debug_line 0x0000000000000000 0x0 readrtns_CSA.o - .debug_line 0x0000000000000000 0x0 parmread.o - .debug_line 0x0000000000000000 0x0 gen_rand_conf.o - .debug_line 0x0000000000000000 0x0 printmat.o - .debug_line 0x0000000000000000 0x0 map.o - .debug_line 0x0000000000000000 0x0 pinorm.o - .debug_line 0x0000000000000000 0x0 randgens.o - .debug_line 0x0000000000000000 0x0 rescode.o - .debug_line 0x0000000000000000 0x0 intcor.o - .debug_line 0x0000000000000000 0x0 timing.o - .debug_line 0x0000000000000000 0x0 misc.o - .debug_line 0x0000000000000000 0x0 intlocal.o - .debug_line 0x0000000000000000 0x0 cartder.o - .debug_line 0x0000000000000000 0x0 checkder_p.o - .debug_line 0x0000000000000000 0x0 econstr_local.o - .debug_line 0x0000000000000000 0x0 energy_p_new_barrier.o - .debug_line 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .debug_line 0x0000000000000000 0x0 gradient_p.o - .debug_line 0x0000000000000000 0x0 minimize_p.o - .debug_line 0x0000000000000000 0x0 sumsld.o - .debug_line 0x0000000000000000 0x1543 cored.o - .debug_line 0x0000000000001543 0x0 rmdd.o - .debug_line 0x0000000000001543 0x0 geomout.o - .debug_line 0x0000000000001543 0x0 readpdb.o - .debug_line 0x0000000000001543 0x0 regularize.o - .debug_line 0x0000000000001543 0x0 thread.o - .debug_line 0x0000000000001543 0x0 fitsq.o - .debug_line 0x0000000000001543 0x0 mcm.o - .debug_line 0x0000000000001543 0x0 mc.o - .debug_line 0x0000000000001543 0x0 bond_move.o - .debug_line 0x0000000000001543 0x0 refsys.o - .debug_line 0x0000000000001543 0x0 check_sc_distr.o - .debug_line 0x0000000000001543 0x0 check_bond.o - .debug_line 0x0000000000001543 0x0 contact.o - .debug_line 0x0000000000001543 0x0 djacob.o - .debug_line 0x0000000000001543 0x0 eigen.o - .debug_line 0x0000000000001543 0x0 blas.o - .debug_line 0x0000000000001543 0x0 add.o - .debug_line 0x0000000000001543 0x0 entmcm.o - .debug_line 0x0000000000001543 0x0 minim_mcmf.o - .debug_line 0x0000000000001543 0x0 together.o - .debug_line 0x0000000000001543 0x0 csa.o - .debug_line 0x0000000000001543 0x0 minim_jlee.o - .debug_line 0x0000000000001543 0x0 shift.o - .debug_line 0x0000000000001543 0x0 diff12.o - .debug_line 0x0000000000001543 0x0 bank.o - .debug_line 0x0000000000001543 0x0 newconf.o - .debug_line 0x0000000000001543 0x0 ran.o - .debug_line 0x0000000000001543 0x0 indexx.o - .debug_line 0x0000000000001543 0x0 MP.o - .debug_line 0x0000000000001543 0x0 compare_s1.o - .debug_line 0x0000000000001543 0x0 prng_32.o - .debug_line 0x0000000000001543 0x0 test.o - .debug_line 0x0000000000001543 0x0 banach.o - .debug_line 0x0000000000001543 0x0 distfit.o - .debug_line 0x0000000000001543 0x0 rmsd.o - .debug_line 0x0000000000001543 0x0 elecont.o - .debug_line 0x0000000000001543 0x0 dihed_cons.o - .debug_line 0x0000000000001543 0x0 sc_move.o - .debug_line 0x0000000000001543 0x0 local_move.o - .debug_line 0x0000000000001543 0x0 intcartderiv.o - .debug_line 0x0000000000001543 0x0 /tmp/ipo_ifortB4EXK9.o - .debug_line 0x0000000000001543 0x0 stochfric.o - .debug_line 0x0000000000001543 0x0 kinetic_lesyng.o - .debug_line 0x0000000000001543 0x0 MD_A-MTS.o - .debug_line 0x0000000000001543 0x0 moments.o - .debug_line 0x0000000000001543 0x0 int_to_cart.o - .debug_line 0x0000000000001543 0x0 surfatom.o - .debug_line 0x0000000000001543 0x0 sort.o - .debug_line 0x0000000000001543 0x0 muca_md.o - .debug_line 0x0000000000001543 0x0 MREMD.o - .debug_line 0x0000000000001543 0x0 rattle.o - .debug_line 0x0000000000001543 0x0 gauss.o - .debug_line 0x0000000000001543 0x0 energy_split-sep.o - .debug_line 0x0000000000001543 0x0 q_measure.o - .debug_line 0x0000000000001543 0x0 gnmr1.o - .debug_line 0x0000000000001543 0x0 cinfo.o - .debug_line 0x0000000000001543 0x17c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.debug_frame 0x0000000000000000 0x770 - *(.debug_frame) - .debug_frame 0x0000000000000000 0x498 cored.o - .debug_frame 0x0000000000000498 0x2a0 /tmp/ipo_ifortB4EXK9.o - .debug_frame 0x0000000000000738 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_str 0x0000000000000000 0x96 - *(.debug_str) - .debug_str 0x0000000000000000 0x96 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_loc 0x0000000000000000 0x4c - *(.debug_loc) - .debug_loc 0x0000000000000000 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_macinfo - *(.debug_macinfo) - -.debug_weaknames - *(.debug_weaknames) - -.debug_funcnames - *(.debug_funcnames) - -.debug_typenames - *(.debug_typenames) - -.debug_varnames - *(.debug_varnames) - -.debug_pubtypes - *(.debug_pubtypes) - -.debug_ranges - *(.debug_ranges) - -.gnu.attributes - *(.gnu.attributes) - -/DISCARD/ - *(.note.GNU-stack) - *(.gnu_debuglink) - *(.gnu.lto_*) -OUTPUT(../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe elf64-x86-64) diff --git a/source/unres/src_MD-M/loadmap.2400 b/source/unres/src_MD-M/loadmap.2400 deleted file mode 100644 index 533d612..0000000 --- a/source/unres/src_MD-M/loadmap.2400 +++ /dev/null @@ -1,8072 +0,0 @@ -cc -o compinfo compinfo.c -./compinfo | true -ifort -c -O3 -ip -w -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include cinfo.f -ifort -O3 -ip -w -Wl,-M unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o eigen.o blas.o add.o entmcm.o minim_mcmf.o together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o indexx.o MP.o compare_s1.o prng_32.o test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o sc_move.o local_move.o intcartderiv.o lagrangian_lesyng.o stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o q_measure.o gnmr1.o proc_proc.o cinfo.o -L/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib -lmpich xdrf_em64/libxdrf.a -g -d2 -CA -CB -o ../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe -Archive member included because of file (symbol) - -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - readrtns_CSA.o (mpi_abort_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - initialize_p.o (mpi_allgather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - energy_p_new_barrier.o (mpi_barrier_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - unres.o (mpi_bcast_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - MP.o (mpi_comm_create_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - initialize_p.o (mpi_comm_group_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - MP.o (mpi_comm_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - MP.o (mpi_comm_size_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - MP.o (mpi_comm_split_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - unres.o (mpi_dup_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - unres.o (mpi_finalize_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - initialize_p.o (mpi_gather_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - MP.o (mpi_get_count_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - readrtns_CSA.o (mpi_get_processor_name_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - initialize_p.o (mpi_group_free_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - initialize_p.o (mpi_group_incl_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - MP.o (mpi_group_rank_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - initialize_p.o (mpi_group_translate_ranks_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - MP.o (mpi_init_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - together.o (mpi_iprobe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - energy_p_new_barrier.o (mpi_irecv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - energy_p_new_barrier.o (mpi_isend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - together.o (mpi_issend_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - unres.o (mpi_null_copy_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - unres.o (mpi_null_delete_fn_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - MP.o (mpi_probe_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - unres.o (mpi_recv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - energy_p_new_barrier.o (mpi_reduce_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - MREMD.o (mpi_scatter_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - minimize_p.o (mpi_scatterv_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - unres.o (mpi_send_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Status_f2c) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - together.o (mpi_test_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - initialize_p.o (mpi_type_commit_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - initialize_p.o (mpi_type_contiguous_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - initialize_p.o (mpi_type_indexed_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - energy_p_new_barrier.o (mpi_waitall_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - unres.o (mpi_wtime_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (mpir_getarg_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_F_TRUE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (mpir_init_fcm_) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPID_Node_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) (MPI_Isend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Irecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) (MPI_Test) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPIR_Error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) (MPI_Probe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) (MPI_Waitall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) (MPI_Send) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) (MPI_Recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) (PMPI_Testall) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) (MPI_Get_count) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) (MPI_Issend) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) (MPI_Type_commit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) (MPI_Type_contiguous) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) (MPI_Type_indexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) (MPIR_Type_dup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) (MPI_Abort) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) (MPI_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) (MPIR_COMM_WORLD) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) (MPI_Finalize) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) (MPI_Error_string) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Init_dtes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Errhandler_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) (MPI_Wtime) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) (MPIR_Err_setmsg) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Msg_queue_export) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_HBT_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_PointerPerm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPIR_BsendRelease) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Keyval_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_get) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Attr_create_tree) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) (PMPI_Attr_put) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Group_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) (MPI_Group_incl) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) (MPI_Group_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_CreateGroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) (MPI_Comm_group) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) (MPI_Comm_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_rank) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPI_Comm_set_name) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Comm_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Comm_make_coll) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) (MPI_Comm_split) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) (MPIR_Context_alloc) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) (MPI_Group_translate_ranks) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) (MPIR_dup_fn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Barrier) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Bcast) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) (MPI_Gather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) (MPI_Scatter) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) (MPI_Scatterv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) (MPI_Allgather) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) (MPI_Reduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) (PMPI_Allreduce) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_MAXF) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (PMPI_Op_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Op_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_inter_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPIR_intra_collops) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (MPIR_intra_Scan) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_Topology_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) (MPI_Request_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) (MPI_Status_c2f) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) (MPIR_cstr2fstr) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (p4_proc_info) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (bm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (rm_start) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (net_setup_anon_listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (create_remote_processes) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (handle_connection_interrupt) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (socket_close_conn) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (listener) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) (start_prog_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (usc_MD_rollover_val) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) (MPID_RecvComplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) (MPID_SendIcomplete) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_devset) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) (MPID_Iprobe) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) (MPID_SendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) (MPID_RecvDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_Msg_rep) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) (MPID_PackMessage) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) (MPID_IssendDatatype) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_Type_swap_copy) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) (MPID_DEBUG_FILE) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) (MPID_CH_InitMsgPass) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPID_procinfo) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_P4_Init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) (MPID_Dump_queues) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_ArgSqueeze) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPID_SBinit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (MPID_Process_group_init) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_PacketFlowSetup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_FinishCancelPackets) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Wait) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Cancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) (PMPI_Sendrecv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_extent) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_free) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) (PMPI_Type_hindexed) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_lb) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Type_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) (MPI_Type_struct) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack_size) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Pack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) (PMPI_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) (MPIR_proctable) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) (MPI_Errhandler_set) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) (MPIR_Unpack) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) (PMPI_Keyval_create) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_global) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (MD_initmem) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_error) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (process_args) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) (alloc_local_bm) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) (p4_dprintf) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) (p4_alloc_procgroup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_recv) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) (p4_moninit) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) (p4_broadcastx) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) (MPID_SsendContig) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) (MPID_SendCancel) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Eagerb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Rndvb_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Check_incoming) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) (MPID_CH_Short_setup) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) (MPID_DebugFlow) -/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) (MPIR_Pack_Hvector) -xdrf_em64/libxdrf.a(libxdrf.o) - geomout.o (xdrfint_) -xdrf_em64/libxdrf.a(ftocstr.o) - xdrf_em64/libxdrf.a(libxdrf.o) (ftocstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - timing.o (etime_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - geomout.o (fdate_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - unres.o (flush_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - parmread.o (getenv_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - readrtns_CSA.o (system_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) (allocCstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (CstrToFstr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - unres.o (for_close) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__close_proc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__key_desc_ret_item) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__io_return) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) (for_errsns_load) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__exit_handler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) (for_iargc) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for__l_excpt_info) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - readrtns_CSA.o (for_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (for_check_env_name) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) (for__create_lub) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__rm_from_lf_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - unres.o (for_open) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - indexx.o (for_pause) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) (for__write_output) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - unres.o (for_set_reentrancy) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - misc.o (for_rewind) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - readpdb.o (for_read_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - readrtns_CSA.o (for_read_int_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - randgens.o (for_read_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - unres.o (for_read_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - readrtns_CSA.o (for_read_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - unres.o (for_stop_core) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) (for__set_signal_ops_during_vm) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - readrtns_CSA.o (for_write_int_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - randgens.o (for_write_seq) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - unres.o (for_write_seq_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - unres.o (for_write_seq_lis) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - readrtns_CSA.o (for_f90_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - energy_p_new_barrier.o (for_is_nan_t_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - readrtns_CSA.o (for_cpystr) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) (flushqq_) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - readrtns_CSA.o (d_int_val) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) (tbk_stack_trace) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (for__aio_lub_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__compute_filename) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) (for__aio_pthread_self) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) (cvt_text_to_integer) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_f_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_d_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_vax_g_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_cray_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_short_to_ieee_single) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ibm_long_to_ieee_double) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_double_to_cray) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) (cvt_ieee_single_to_ibm_short) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) (for__common_inquire) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) (for_exit) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__format_compiler) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) (for__format_value) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) (for__get_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) (for_index) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) (for__interp_fmt) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (for__wfs_table) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) (vax_c) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_integer_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_data_to_text) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_boolean_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_data) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_text_to_boolean) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_t_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_s_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) (cvt_ieee_x_to_text_ex) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_a_to_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_a_to_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) (cvtas_s_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) (cvtas_t_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_string_to_nan_s) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_string_to_nan_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_a_to_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (cvtas_x_to_a) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) (cvtas_string_to_nan_x) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_word) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) (cvtas_pten_t) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) (cvtas_pten_64) -/opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) (cvtas_pten_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - arcos.o (acos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - surfatom.o (asin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - local_move.o (atan2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - cored.o (cbrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - energy_p_new_barrier.o (cos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - parmread.o (exp2) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - MREMD.o (expf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - readrtns_CSA.o (exp) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - convert.o (fmod) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - map.o (__powi4i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - parmread.o (__powr8i4) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) (__libm_error_support) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - chainbuild.o (__libm_sse2_sincos) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (llround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - readrtns_CSA.o (log10) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - gen_rand_conf.o (logf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - energy_p_new_barrier.o (log) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lroundf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (lround) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherrl) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) (matherr) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - readrtns_CSA.o (pow) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - intcartderiv.o (sin) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - cored.o (sqrt) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - gen_rand_conf.o (tan) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (truncf) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) (trunc) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (cbrt.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) (cos.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) (exp2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) (expf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) (exp.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) (__libm_exp_table_128) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) (fmod.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) (__libm_reduce_pio2d) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) (llroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) (llround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) (log10.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) (logf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_logf_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) (log.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) (lroundf.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) (lround.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) (pow.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) (__libm_rcp_table_256) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) (sin.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) (tan.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) (trunc.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - energy_p_new_barrier.o (__svml_cos2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - energy_p_new_barrier.o (__svml_sin2) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.R) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.N) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.L) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) (__svml_cos2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) (__svml_sin2.A) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtoj) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) (__qtod) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) (a_mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) (tbk_string_stack_signal) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) (tbk_getPC) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) (_intel_fast_memcmp) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) (__intel_cpu_indicator_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - convert.o (_intel_fast_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - initialize_p.o (_intel_fast_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o (__intel_new_proc_init) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) (__mulq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) (__divq) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) (__intel_sse2_strlen) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) (__intel_new_memcpy) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) (__intel_new_memset) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) (irc__get_msg) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) (__intel_memcpy_mem_ops_method) -/opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) (__intel_get_new_mem_ops_cpuid) -/usr/lib64/libc_nonshared.a(elf-init.oS) - /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o (__libc_csu_fini) - -Allocating common symbols -Common symbol size file - -bm_outfile 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_LONG_LONG_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frag_ 0xa0 geomout.o -calcthet_ 0x9c energy_p_new_barrier.o -wagi_ 0x10 geomout.o -cache_ 0xbb8d0 mcm.o -rm_outfile_head 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -header_ 0x50 unres.o -mvstat_ 0x250 readrtns_CSA.o -timing_ 0x140 unres.o -MPIR_I_COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_LONG_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -ffield_ 0x174 unres.o -chuju_ 0x4 minimize_p.o -deriv_loc_ 0x1e0 initialize_p.o -splitele_ 0x10 initialize_p.o -cipiszcze_ 0x4 /tmp/ipo_ifortScZxT8.o -MPIR_I_DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_SHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPI_LONG_DOUBLE_INT_var - 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_dtes 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_UB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -refstruct_ 0x3846c unres.o -dih_control_ 0xc readrtns_CSA.o -MPIR_I_FLOAT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_SHORT_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -frozen_ 0x2580 geomout.o -sumsl_flag_ 0x4 unres.o -execer_pg 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -links_split_ 0x8 unres.o -precomp1_ 0xe1000 unres.o -bounds_ 0x9600 readrtns_CSA.o -MPIR_I_2DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -alphaa_ 0x3cf08 readrtns_CSA.o -MPIR_errhandlers 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -chain_ 0xa8c80 unres.o -parfiles_ 0xb00 unres.o -globmemsize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotat_old_ 0x12c00 unres.o -bank_ 0x4b120 readrtns_CSA.o -p4_rm_rank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts1_ 0x3172980 unres.o -mce_ 0x230 readrtns_CSA.o -diploc_ 0x3938 unres.o -mucarem_ 0x8000 readrtns_CSA.o -mdpmpi_ 0x8014 unres.o -iounits_ 0x6c unres.o -MPI_DOUBLE_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mapp_ 0x4b004 readrtns_CSA.o -MPIR_real8_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -p4_brdcst_info 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -langforc_ 0x1601ca94 readrtns_CSA.o -MPIR_I_2INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -minvar_ 0x25978 readrtns_CSA.o -torsion_ 0x5adc parmread.o -struct_ 0xa2c readrtns_CSA.o -procgroup_file 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -mdpar_ 0x6c unres.o -MPID_MyWorldSize 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -spinka_ 0x708c newconf.o -thetas_ 0x960 chainbuild.o -__P4FROM 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -MPIR_int1_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_debug_q 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_debug_sq 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPID_MyWorldRank 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -remdrestart_ 0x411808 unres.o -for__pthread_mutex_unlock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -restr_ 0x19c84 unres.o -locel_ 0x274 energy_p_new_barrier.o -MPIR_I_REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -fourier_ 0x344 initialize_p.o -precomp2_ 0xe1000 unres.o -torsiond_ 0x14200 initialize_p.o -for__a_argv 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -MPIR_debug_rh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -pool_ 0xbb85c readrtns_CSA.o -maxgrad_ 0xa8 energy_p_new_barrier.o -double_muca_ 0x4b028 readrtns_CSA.o -links_ 0x41d5e9c unres.o -MPID_byte_order 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) -p4_global 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_2REAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -mdgrad_ 0x38430 unres.o -execer_mastport 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -from_zscore_ 0xc unres.o -csa_input_ 0x98 readrtns_CSA.o -for__pthread_mutex_init_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -machsw_ 0xc initialize_p.o -types_ 0x54 unres.o -MPIR_I_USHORT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -sccalc_ 0x28 energy_p_new_barrier.o -pochodne_ 0x2bfb610 geomout.o -loc_work_ 0x30c local_move.o -peptbond_ 0x28 chainbuild.o -MPIR_I_UINT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -calc_ 0x1f0 gen_rand_conf.o -execer_id 0x84 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPI_FLOAT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -execer_numtotnodes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -derivat_ 0x10ab1768 initialize_p.o -MPIR_I_BYTE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_CHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -deriv_scloc_ 0x7e900 initialize_p.o -listener_info 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -przechowalnia_ 0x1b778b00 stochfric.o -MPIR_All_communicators - 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -diffcuta_ 0x8 readrtns_CSA.o -vectors_ 0xc4e00 energy_p_new_barrier.o -thread_ 0x148 readrtns_CSA.o -back_constr_ 0x291cc unres.o -MPIR_I_PACKED 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_local 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_I_DCOMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -logging_flag 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -pizda_ 0x2580 readrtns_CSA.o -execer_myhost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_rhandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -MPIR_topo_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -par_ 0x20 eigen.o -info_ 0x4010 timing.o -MPIR_I_INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -tty_orig 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) -MPIR_I_DOUBLE_INT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -mpgrad_ 0x4b08 initialize_p.o -info1_ 0x2824 timing.o -setup_ 0x6040 unres.o -p4_wd 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_Op_errno 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) -restraints_ 0x8 unres.o -MPIR_I_LONG_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -torcnstr_ 0xe118 initialize_p.o -stochcalc_ 0x1c200 MD_A-MTS.o -MPIR_I_2FLOAT 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_real4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -indices_ 0x7060 chainbuild.o -qmeas_ 0x9253c unres.o -MPID_recvs 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) -mpipriv_ 0x24 unres.o -p4_remote_debug_level - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_shandles 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -total_pack_unacked 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -kutas_ 0x4 energy_p_new_barrier.o -cntrl_ 0x7c unres.o -sserver_port 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -rotmat_ 0xa8c00 unres.o -varin_ 0x25948 readrtns_CSA.o -p4_myname_in_procgroup - 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -lagrange_ 0x420144b8 unres.o -message_catalog 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) -MPIR_I_UCHAR 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -fnames_ 0x1007 unres.o -loc_const_ 0x40 local_move.o -stoptim_ 0x4 unres.o -sclocal_ 0x22cc chainbuild.o -time1_ 0x30 unres.o -MPIR_I_2DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -bank_disulfid_ 0x1f0 readrtns_CSA.o -MPID_pack_info 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_debug_qh 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -mdcalc_ 0x108 unres.o -dipmat_ 0x2bf20000 unres.o -hand_start_remotes 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -execer_starting_remotes - 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -remdcommon_ 0x6030 unres.o -sbridge_ 0x9c unres.o -refer_ 0x98 bond_move.o -csafiles_ 0xc00 unres.o -MPIR_tid 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -thread1_ 0x1cd0 readrtns_CSA.o -langmat_ 0xc readrtns_CSA.o -__P4GLOBALTYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -integer_muca_ 0xc readrtns_CSA.o -MPI_SHORT_INT_var 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -inertia_ 0x160 unres.o -mcm_ 0x20a4 initialize_p.o -MPIR_I_2DOUBLE_PRECISION - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -for__pthread_mutex_lock_ptr - 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -mce_counters_ 0x14 readrtns_CSA.o -aaaa_ 0x8 MP.o -store0_ 0x4 geomout.o -MPIR_I_2INTEGER 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -banii_ 0x1c200 banach.o -scrot_ 0x28a0 parmread.o -c_frag_ 0x4b08 geomout.o -move_ 0x9678 initialize_p.o -MPIR_fdtels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -MPIR_I_LONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -vrandd_ 0x3f0 randgens.o -syfek_ 0x1c200 stochfric.o -whoami_p4 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -windows_ 0x7084 initialize_p.o -contacts_hb_ 0x1391e980 unres.o -MPIR_debug_s 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_ULONG 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_hbt_els 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -srutu_ 0x4 unres.o -contdistrib_ 0xaff588c unres.o -expect_ack 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) -MPIR_hbts 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) -__P4TYPE 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -traj1cache_ 0x8e5dc unres.o -accept_stats_ 0x2008 initialize_p.o -execer_masthost 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -for__l_argc 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) -invlen_ 0x9600 chainbuild.o -MPIR_I_LONG_DOUBLE_INT - 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_debug_c 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPI_LONG_INT_var 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -MPIR_I_LB 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -p4_debug_level 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -stretch_ 0x608 unres.o -for__aio_lub_table 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) -iofile_ 0x65c initialize_p.o -MPIR_qels 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) -__P4LEN 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) -local_domain 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -minimm_ 0x20 initialize_p.o -MPIR_debug_qel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -send2_ 0x2a330 readrtns_CSA.o -MPIR_debug_sqel 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) -MPIR_I_2COMPLEX 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -gucio_ 0x18 MD_A-MTS.o -ch_debug_buf 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) -execer_mynumprocs 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -contacts_ 0x70808 unres.o -__BLNK__ 0xc djacob.o -MPIR_I_LOGICAL 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_int2_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -geo_ 0x40 unres.o -execer_mynodenum 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) -MPIR_int4_dte 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) -MPIR_I_DOUBLE 0xa8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) -csaunits_ 0x34 unres.o -body_ 0x6180 unres.o -interact_ 0x280bc unres.o -theta_abinitio_ 0x24a70 chainbuild.o -oldgeo_ 0x1770f4 unres.o -rotat_ 0x70800 unres.o -var_ 0x6bd10 unres.o -secondarys_ 0x960 dihed_cons.o -MPIR_debug_cl 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -Discarded input sections - - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .note.GNU-stack - 0x0000000000000000 0x0 unres.o - .note.GNU-stack - 0x0000000000000000 0x0 arcos.o - .note.GNU-stack - 0x0000000000000000 0x0 cartprint.o - .note.GNU-stack - 0x0000000000000000 0x0 chainbuild.o - .note.GNU-stack - 0x0000000000000000 0x0 convert.o - .note.GNU-stack - 0x0000000000000000 0x0 initialize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 matmult.o - .note.GNU-stack - 0x0000000000000000 0x0 readrtns_CSA.o - .note.GNU-stack - 0x0000000000000000 0x0 parmread.o - .note.GNU-stack - 0x0000000000000000 0x0 gen_rand_conf.o - .note.GNU-stack - 0x0000000000000000 0x0 printmat.o - .note.GNU-stack - 0x0000000000000000 0x0 map.o - .note.GNU-stack - 0x0000000000000000 0x0 pinorm.o - .note.GNU-stack - 0x0000000000000000 0x0 randgens.o - .note.GNU-stack - 0x0000000000000000 0x0 rescode.o - .note.GNU-stack - 0x0000000000000000 0x0 intcor.o - .note.GNU-stack - 0x0000000000000000 0x0 timing.o - .note.GNU-stack - 0x0000000000000000 0x0 misc.o - .note.GNU-stack - 0x0000000000000000 0x0 intlocal.o - .note.GNU-stack - 0x0000000000000000 0x0 cartder.o - .note.GNU-stack - 0x0000000000000000 0x0 checkder_p.o - .note.GNU-stack - 0x0000000000000000 0x0 econstr_local.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .note.GNU-stack - 0x0000000000000000 0x0 gradient_p.o - .note.GNU-stack - 0x0000000000000000 0x0 minimize_p.o - .note.GNU-stack - 0x0000000000000000 0x0 sumsld.o - .note.GNU-stack - 0x0000000000000000 0x0 cored.o - .note.GNU-stack - 0x0000000000000000 0x0 rmdd.o - .note.GNU-stack - 0x0000000000000000 0x0 geomout.o - .note.GNU-stack - 0x0000000000000000 0x0 readpdb.o - .note.GNU-stack - 0x0000000000000000 0x0 regularize.o - .note.GNU-stack - 0x0000000000000000 0x0 thread.o - .note.GNU-stack - 0x0000000000000000 0x0 fitsq.o - .note.GNU-stack - 0x0000000000000000 0x0 mcm.o - .note.GNU-stack - 0x0000000000000000 0x0 mc.o - .note.GNU-stack - 0x0000000000000000 0x0 bond_move.o - .note.GNU-stack - 0x0000000000000000 0x0 refsys.o - .note.GNU-stack - 0x0000000000000000 0x0 check_sc_distr.o - .note.GNU-stack - 0x0000000000000000 0x0 check_bond.o - .note.GNU-stack - 0x0000000000000000 0x0 contact.o - .note.GNU-stack - 0x0000000000000000 0x0 djacob.o - .note.GNU-stack - 0x0000000000000000 0x0 eigen.o - .note.GNU-stack - 0x0000000000000000 0x0 blas.o - .note.GNU-stack - 0x0000000000000000 0x0 add.o - .note.GNU-stack - 0x0000000000000000 0x0 entmcm.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_mcmf.o - .note.GNU-stack - 0x0000000000000000 0x0 together.o - .note.GNU-stack - 0x0000000000000000 0x0 csa.o - .note.GNU-stack - 0x0000000000000000 0x0 minim_jlee.o - .note.GNU-stack - 0x0000000000000000 0x0 shift.o - .note.GNU-stack - 0x0000000000000000 0x0 diff12.o - .note.GNU-stack - 0x0000000000000000 0x0 bank.o - .note.GNU-stack - 0x0000000000000000 0x0 newconf.o - .note.GNU-stack - 0x0000000000000000 0x0 ran.o - .note.GNU-stack - 0x0000000000000000 0x0 indexx.o - .note.GNU-stack - 0x0000000000000000 0x0 MP.o - .note.GNU-stack - 0x0000000000000000 0x0 compare_s1.o - .note.GNU-stack - 0x0000000000000000 0x0 prng_32.o - .note.GNU-stack - 0x0000000000000000 0x0 test.o - .note.GNU-stack - 0x0000000000000000 0x0 banach.o - .note.GNU-stack - 0x0000000000000000 0x0 distfit.o - .note.GNU-stack - 0x0000000000000000 0x0 rmsd.o - .note.GNU-stack - 0x0000000000000000 0x0 elecont.o - .note.GNU-stack - 0x0000000000000000 0x0 dihed_cons.o - .note.GNU-stack - 0x0000000000000000 0x0 sc_move.o - .note.GNU-stack - 0x0000000000000000 0x0 local_move.o - .note.GNU-stack - 0x0000000000000000 0x0 intcartderiv.o - .note.GNU-stack - 0x0000000000000000 0x0 /tmp/ipo_ifortScZxT8.o - .note.GNU-stack - 0x0000000000000000 0x0 stochfric.o - .note.GNU-stack - 0x0000000000000000 0x0 kinetic_lesyng.o - .note.GNU-stack - 0x0000000000000000 0x0 MD_A-MTS.o - .note.GNU-stack - 0x0000000000000000 0x0 moments.o - .note.GNU-stack - 0x0000000000000000 0x0 int_to_cart.o - .note.GNU-stack - 0x0000000000000000 0x0 surfatom.o - .note.GNU-stack - 0x0000000000000000 0x0 sort.o - .note.GNU-stack - 0x0000000000000000 0x0 muca_md.o - .note.GNU-stack - 0x0000000000000000 0x0 MREMD.o - .note.GNU-stack - 0x0000000000000000 0x0 rattle.o - .note.GNU-stack - 0x0000000000000000 0x0 gauss.o - .note.GNU-stack - 0x0000000000000000 0x0 energy_split-sep.o - .note.GNU-stack - 0x0000000000000000 0x0 q_measure.o - .note.GNU-stack - 0x0000000000000000 0x0 gnmr1.o - .note.GNU-stack - 0x0000000000000000 0x0 proc_proc.o - .note.GNU-stack - 0x0000000000000000 0x0 cinfo.o - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .note.GNU-stack - 0x0000000000000000 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .note.GNU-stack - 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .note.GNU-stack - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -Memory Configuration - -Name Origin Length Attributes -*default* 0x0000000000000000 0xffffffffffffffff - -Linker script and memory map - -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o -LOAD unres.o -LOAD arcos.o -LOAD cartprint.o -LOAD chainbuild.o -LOAD convert.o -LOAD initialize_p.o -LOAD matmult.o -LOAD readrtns_CSA.o -LOAD parmread.o -LOAD gen_rand_conf.o -LOAD printmat.o -LOAD map.o -LOAD pinorm.o -LOAD randgens.o -LOAD rescode.o -LOAD intcor.o -LOAD timing.o -LOAD misc.o -LOAD intlocal.o -LOAD cartder.o -LOAD checkder_p.o -LOAD econstr_local.o -LOAD energy_p_new_barrier.o -LOAD energy_p_new-sep_barrier.o -LOAD gradient_p.o -LOAD minimize_p.o -LOAD sumsld.o -LOAD cored.o -LOAD rmdd.o -LOAD geomout.o -LOAD readpdb.o -LOAD regularize.o -LOAD thread.o -LOAD fitsq.o -LOAD mcm.o -LOAD mc.o -LOAD bond_move.o -LOAD refsys.o -LOAD check_sc_distr.o -LOAD check_bond.o -LOAD contact.o -LOAD djacob.o -LOAD eigen.o -LOAD blas.o -LOAD add.o -LOAD entmcm.o -LOAD minim_mcmf.o -LOAD together.o -LOAD csa.o -LOAD minim_jlee.o -LOAD shift.o -LOAD diff12.o -LOAD bank.o -LOAD newconf.o -LOAD ran.o -LOAD indexx.o -LOAD MP.o -LOAD compare_s1.o -LOAD prng_32.o -LOAD test.o -LOAD banach.o -LOAD distfit.o -LOAD rmsd.o -LOAD elecont.o -LOAD dihed_cons.o -LOAD sc_move.o -LOAD local_move.o -LOAD intcartderiv.o -LOAD /tmp/ipo_ifortScZxT8.o -LOAD stochfric.o -LOAD kinetic_lesyng.o -LOAD MD_A-MTS.o -LOAD moments.o -LOAD int_to_cart.o -LOAD surfatom.o -LOAD sort.o -LOAD muca_md.o -LOAD MREMD.o -LOAD rattle.o -LOAD gauss.o -LOAD energy_split-sep.o -LOAD q_measure.o -LOAD gnmr1.o -LOAD proc_proc.o -LOAD cinfo.o -LOAD /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a -LOAD xdrf_em64/libxdrf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libm.so -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libipgo.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libpthread.so -START GROUP -LOAD /lib64/libpthread.so.0 -LOAD /usr/lib64/libpthread_nonshared.a -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc_s.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/libgcc.a -LOAD /opt/intel/Compiler/11.1/046/lib/intel64/libirc_s.a -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libdl.so -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/libc.so -START GROUP -LOAD /lib64/libc.so.6 -LOAD /usr/lib64/libc_nonshared.a -LOAD /lib64/ld-linux-x86-64.so.2 -END GROUP -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o -LOAD /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x0000000000400000 PROVIDE (__executable_start, 0x400000) - 0x0000000000400200 . = (0x400000 + SIZEOF_HEADERS) - -.interp 0x0000000000400200 0x1c - *(.interp) - .interp 0x0000000000400200 0x1c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.ABI-tag 0x000000000040021c 0x20 - .note.ABI-tag 0x000000000040021c 0x20 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.note.gnu.build-id - *(.note.gnu.build-id) - -.hash 0x0000000000400240 0x71c - *(.hash) - .hash 0x0000000000400240 0x71c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.hash - *(.gnu.hash) - -.dynsym 0x0000000000400960 0x1800 - *(.dynsym) - .dynsym 0x0000000000400960 0x1800 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.dynstr 0x0000000000402160 0xa61 - *(.dynstr) - .dynstr 0x0000000000402160 0xa61 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version 0x0000000000402bc2 0x200 - *(.gnu.version) - .gnu.version 0x0000000000402bc2 0x200 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_d 0x0000000000402dc8 0x0 load address 0x0000000000402dc2 - *(.gnu.version_d) - .gnu.version_d - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.gnu.version_r 0x0000000000402dc8 0x90 - *(.gnu.version_r) - .gnu.version_r - 0x0000000000402dc8 0x90 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.rela.dyn 0x0000000000402e58 0x5b8 - *(.rela.init) - *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) - .rela.text 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.fini) - *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) - .rela.rodata 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) - .rela.data 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) - *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) - *(.rela.ctors) - *(.rela.dtors) - *(.rela.got) - .rela.got 0x0000000000402e58 0x558 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.sharable_data .rela.sharable_data.* .rela.gnu.linkonce.shrd.*) - *(.rela.sharable_bss .rela.sharable_bss.* .rela.gnu.linkonce.shrb.*) - .rela.sharable_bss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) - .rela.bss 0x00000000004033b0 0x60 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.rela.ldata .rela.ldata.* .rela.gnu.linkonce.l.*) - *(.rela.lbss .rela.lbss.* .rela.gnu.linkonce.lb.*) - *(.rela.lrodata .rela.lrodata.* .rela.gnu.linkonce.lr.*) - *(.rela.ifunc) - -.rela.plt 0x0000000000403410 0x1008 - *(.rela.plt) - .rela.plt 0x0000000000403410 0x1008 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_start, .) - *(.rela.iplt) - .rela.iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404418 PROVIDE (__rela_iplt_end, .) - -.init 0x0000000000404418 0x18 - *(.init) - .init 0x0000000000404418 0x9 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x0000000000404418 _init - .init 0x0000000000404421 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .init 0x0000000000404426 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .init 0x000000000040442b 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.plt 0x0000000000404430 0xac0 - *(.plt) - .plt 0x0000000000404430 0xac0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404440 ctime@@GLIBC_2.2.5 - 0x0000000000404450 xdr_double@@GLIBC_2.2.5 - 0x0000000000404460 tcsetattr@@GLIBC_2.2.5 - 0x0000000000404470 chdir@@GLIBC_2.2.5 - 0x0000000000404480 fileno@@GLIBC_2.2.5 - 0x0000000000404490 dup2@@GLIBC_2.2.5 - 0x00000000004044a0 printf@@GLIBC_2.2.5 - 0x00000000004044b0 pause@@GLIBC_2.2.5 - 0x00000000004044c0 _Unwind_GetRegionStart@@GCC_3.0 - 0x00000000004044d0 memset@@GLIBC_2.2.5 - 0x00000000004044e0 ftell@@GLIBC_2.2.5 - 0x00000000004044f0 snprintf@@GLIBC_2.2.5 - 0x0000000000404500 setsid@@GLIBC_2.2.5 - 0x0000000000404510 shutdown@@GLIBC_2.2.5 - 0x0000000000404520 posix_memalign@@GLIBC_2.2.5 - 0x0000000000404530 xdr_u_short@@GLIBC_2.2.5 - 0x0000000000404540 close@@GLIBC_2.2.5 - 0x0000000000404550 wait@@GLIBC_2.2.5 - 0x0000000000404560 ioctl@@GLIBC_2.2.5 - 0x0000000000404570 abort@@GLIBC_2.2.5 - 0x0000000000404580 ttyname@@GLIBC_2.2.5 - 0x0000000000404590 memchr@@GLIBC_2.2.5 - 0x00000000004045a0 xdr_int@@GLIBC_2.2.5 - 0x00000000004045b0 getlogin@@GLIBC_2.2.5 - 0x00000000004045c0 strncat@@GLIBC_2.2.5 - 0x00000000004045d0 isatty@@GLIBC_2.2.5 - 0x00000000004045e0 gethostbyname@@GLIBC_2.2.5 - 0x00000000004045f0 xdr_bool@@GLIBC_2.2.5 - 0x0000000000404600 puts@@GLIBC_2.2.5 - 0x0000000000404610 uname@@GLIBC_2.2.5 - 0x0000000000404620 fseek@@GLIBC_2.2.5 - 0x0000000000404630 htons@@GLIBC_2.2.5 - 0x0000000000404640 select@@GLIBC_2.2.5 - 0x0000000000404650 getpeername@@GLIBC_2.2.5 - 0x0000000000404660 exit@@GLIBC_2.2.5 - 0x0000000000404670 gettimeofday@@GLIBC_2.2.5 - 0x0000000000404680 putchar@@GLIBC_2.2.5 - 0x0000000000404690 xdrmem_create@@GLIBC_2.2.5 - 0x00000000004046a0 read@@GLIBC_2.2.5 - 0x00000000004046b0 strncmp@@GLIBC_2.2.5 - 0x00000000004046c0 malloc@@GLIBC_2.2.5 - 0x00000000004046d0 fopen@@GLIBC_2.2.5 - 0x00000000004046e0 __libc_start_main@@GLIBC_2.2.5 - 0x00000000004046f0 recv@@GLIBC_2.2.5 - 0x0000000000404700 setitimer@@GLIBC_2.2.5 - 0x0000000000404710 system@@GLIBC_2.2.5 - 0x0000000000404720 execlp@@GLIBC_2.2.5 - 0x0000000000404730 unlink@@GLIBC_2.2.5 - 0x0000000000404740 sched_yield@@GLIBC_2.2.5 - 0x0000000000404750 siglongjmp@@GLIBC_2.2.5 - 0x0000000000404760 catgets@@GLIBC_2.2.5 - 0x0000000000404770 setsockopt@@GLIBC_2.2.5 - 0x0000000000404780 sysconf@@GLIBC_2.2.5 - 0x0000000000404790 getpid@@GLIBC_2.2.5 - 0x00000000004047a0 catclose@@GLIBC_2.2.5 - 0x00000000004047b0 xdr_opaque@@GLIBC_2.2.5 - 0x00000000004047c0 fgets@@GLIBC_2.2.5 - 0x00000000004047d0 xdr_u_int@@GLIBC_2.2.5 - 0x00000000004047e0 __fxstat64@@GLIBC_2.2.5 - 0x00000000004047f0 freopen64@@GLIBC_2.2.5 - 0x0000000000404800 getpwuid@@GLIBC_2.2.5 - 0x0000000000404810 geteuid@@GLIBC_2.2.5 - 0x0000000000404820 rindex@@GLIBC_2.2.5 - 0x0000000000404830 xdr_float@@GLIBC_2.2.5 - 0x0000000000404840 fputc@@GLIBC_2.2.5 - 0x0000000000404850 times@@GLIBC_2.2.5 - 0x0000000000404860 free@@GLIBC_2.2.5 - 0x0000000000404870 _IO_getc@@GLIBC_2.2.5 - 0x0000000000404880 strlen@@GLIBC_2.2.5 - 0x0000000000404890 vsprintf@@GLIBC_2.2.5 - 0x00000000004048a0 __sysconf@@GLIBC_2.2.5 - 0x00000000004048b0 bcopy@@GLIBC_2.2.5 - 0x00000000004048c0 nice@@GLIBC_2.2.5 - 0x00000000004048d0 opendir@@GLIBC_2.2.5 - 0x00000000004048e0 __xpg_basename@@GLIBC_2.2.5 - 0x00000000004048f0 mkstemp64@@GLIBC_2.2.5 - 0x0000000000404900 listen@@GLIBC_2.2.5 - 0x0000000000404910 __ctype_b_loc@@GLIBC_2.3 - 0x0000000000404920 xdr_char@@GLIBC_2.2.5 - 0x0000000000404930 sprintf@@GLIBC_2.2.5 - 0x0000000000404940 ntohs@@GLIBC_2.2.5 - 0x0000000000404950 ntohl@@GLIBC_2.2.5 - 0x0000000000404960 strrchr@@GLIBC_2.2.5 - 0x0000000000404970 _Unwind_GetIP@@GCC_3.0 - 0x0000000000404980 sscanf@@GLIBC_2.2.5 - 0x0000000000404990 sleep@@GLIBC_2.2.5 - 0x00000000004049a0 fsync@@GLIBC_2.2.5 - 0x00000000004049b0 xdr_u_char@@GLIBC_2.2.5 - 0x00000000004049c0 kill@@GLIBC_2.2.5 - 0x00000000004049d0 strerror@@GLIBC_2.2.5 - 0x00000000004049e0 open64@@GLIBC_2.2.5 - 0x00000000004049f0 strstr@@GLIBC_2.2.5 - 0x0000000000404a00 sigprocmask@@GLIBC_2.2.5 - 0x0000000000404a10 sigaction@@GLIBC_2.2.5 - 0x0000000000404a20 xdr_array@@GLIBC_2.2.5 - 0x0000000000404a30 socketpair@@GLIBC_2.2.5 - 0x0000000000404a40 strcat@@GLIBC_2.2.5 - 0x0000000000404a50 getsockopt@@GLIBC_2.2.5 - 0x0000000000404a60 vprintf@@GLIBC_2.2.5 - 0x0000000000404a70 fputs@@GLIBC_2.2.5 - 0x0000000000404a80 _Unwind_ForcedUnwind@@GCC_3.0 - 0x0000000000404a90 strtol@@GLIBC_2.2.5 - 0x0000000000404aa0 ftruncate64@@GLIBC_2.2.5 - 0x0000000000404ab0 readlink@@GLIBC_2.2.5 - 0x0000000000404ac0 getsockname@@GLIBC_2.2.5 - 0x0000000000404ad0 atoi@@GLIBC_2.2.5 - 0x0000000000404ae0 connect@@GLIBC_2.2.5 - 0x0000000000404af0 gethostname@@GLIBC_2.2.5 - 0x0000000000404b00 tcgetattr@@GLIBC_2.2.5 - 0x0000000000404b10 memcpy@@GLIBC_2.2.5 - 0x0000000000404b20 raise@@GLIBC_2.2.5 - 0x0000000000404b30 signal@@GLIBC_2.2.5 - 0x0000000000404b40 memmove@@GLIBC_2.2.5 - 0x0000000000404b50 strchr@@GLIBC_2.2.5 - 0x0000000000404b60 waitpid@@GLIBC_2.2.5 - 0x0000000000404b70 getchar@@GLIBC_2.2.5 - 0x0000000000404b80 socket@@GLIBC_2.2.5 - 0x0000000000404b90 fread@@GLIBC_2.2.5 - 0x0000000000404ba0 setenv@@GLIBC_2.2.5 - 0x0000000000404bb0 inet_ntoa@@GLIBC_2.2.5 - 0x0000000000404bc0 xdrstdio_create@@GLIBC_2.2.5 - 0x0000000000404bd0 catopen@@GLIBC_2.2.5 - 0x0000000000404be0 getenv@@GLIBC_2.2.5 - 0x0000000000404bf0 __errno_location@@GLIBC_2.2.5 - 0x0000000000404c00 xdr_vector@@GLIBC_2.2.5 - 0x0000000000404c10 clock@@GLIBC_2.2.5 - 0x0000000000404c20 sigaddset@@GLIBC_2.2.5 - 0x0000000000404c30 getdtablesize@@GLIBC_2.2.5 - 0x0000000000404c40 strcmp@@GLIBC_2.2.5 - 0x0000000000404c50 getcwd@@GLIBC_2.2.5 - 0x0000000000404c60 index@@GLIBC_2.2.5 - 0x0000000000404c70 strcpy@@GLIBC_2.2.5 - 0x0000000000404c80 strtok@@GLIBC_2.2.5 - 0x0000000000404c90 nanosleep@@GLIBC_2.2.5 - 0x0000000000404ca0 getuid@@GLIBC_2.2.5 - 0x0000000000404cb0 xdr_long@@GLIBC_2.2.5 - 0x0000000000404cc0 xdr_short@@GLIBC_2.2.5 - 0x0000000000404cd0 dladdr@@GLIBC_2.2.5 - 0x0000000000404ce0 __ctype_tolower_loc@@GLIBC_2.3 - 0x0000000000404cf0 memcmp@@GLIBC_2.2.5 - 0x0000000000404d00 xdr_string@@GLIBC_2.2.5 - 0x0000000000404d10 calloc@@GLIBC_2.2.5 - 0x0000000000404d20 feof@@GLIBC_2.2.5 - 0x0000000000404d30 writev@@GLIBC_2.2.5 - 0x0000000000404d40 fclose@@GLIBC_2.2.5 - 0x0000000000404d50 freopen@@GLIBC_2.2.5 - 0x0000000000404d60 strncpy@@GLIBC_2.2.5 - 0x0000000000404d70 __xstat64@@GLIBC_2.2.5 - 0x0000000000404d80 lseek64@@GLIBC_2.2.5 - 0x0000000000404d90 dlsym@@GLIBC_2.2.5 - 0x0000000000404da0 closedir@@GLIBC_2.2.5 - 0x0000000000404db0 fork@@GLIBC_2.2.5 - 0x0000000000404dc0 sigemptyset@@GLIBC_2.2.5 - 0x0000000000404dd0 getppid@@GLIBC_2.2.5 - 0x0000000000404de0 fopen64@@GLIBC_2.2.5 - 0x0000000000404df0 sendto@@GLIBC_2.2.5 - 0x0000000000404e00 bind@@GLIBC_2.2.5 - 0x0000000000404e10 fwrite@@GLIBC_2.2.5 - 0x0000000000404e20 htonl@@GLIBC_2.2.5 - 0x0000000000404e30 realloc@@GLIBC_2.2.5 - 0x0000000000404e40 setlocale@@GLIBC_2.2.5 - 0x0000000000404e50 perror@@GLIBC_2.2.5 - 0x0000000000404e60 __sigsetjmp@@GLIBC_2.2.5 - 0x0000000000404e70 fprintf@@GLIBC_2.2.5 - 0x0000000000404e80 xdr_u_long@@GLIBC_2.2.5 - 0x0000000000404e90 write@@GLIBC_2.2.5 - 0x0000000000404ea0 accept@@GLIBC_2.2.5 - 0x0000000000404eb0 fcntl@@GLIBC_2.2.5 - 0x0000000000404ec0 _IO_putc@@GLIBC_2.2.5 - 0x0000000000404ed0 time@@GLIBC_2.2.5 - 0x0000000000404ee0 fflush@@GLIBC_2.2.5 - *(.iplt) - .iplt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.text 0x0000000000404ef0 0x28a8d8 - *(.text.unlikely .text.*_unlikely) - *(.text .stub .text.* .gnu.linkonce.t.*) - .text 0x0000000000404ef0 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000404ef0 _start - .text 0x0000000000404f1c 0x17 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - *fill* 0x0000000000404f33 0xd 90909090 - .text 0x0000000000404f40 0x92 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x0000000000404fd2 0xe 90909090 - .text 0x0000000000404fe0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - 0x0000000000404fe0 main - .text 0x0000000000405030 0x46c0 unres.o - 0x0000000000405030 MAIN__ - 0x00000000004068b0 exec_mult_eeval_or_minim_ - 0x0000000000408390 exec_mremd_ - 0x00000000004084e0 exec_md_ - 0x0000000000408550 exec_softreg_ - 0x0000000000408690 exec_csa_ - 0x00000000004086a0 exec_map_ - 0x00000000004086c0 exec_checkgrad_ - 0x0000000000408890 exec_mc_ - 0x00000000004088d0 exec_thread_ - 0x00000000004088e0 exec_regularize_ - 0x0000000000408a70 exec_eeval_or_minim_ - .text 0x00000000004096f0 0x60 arcos.o - 0x00000000004096f0 arcos_ - .text 0x0000000000409750 0x240 cartprint.o - 0x0000000000409750 cartprint_ - .text 0x0000000000409990 0x1780 chainbuild.o - 0x0000000000409990 chainbuild_ - 0x000000000040a470 locate_next_res_ - 0x000000000040a9f0 orig_frame_ - 0x000000000040ae50 locate_side_chain_ - .text 0x000000000040b110 0x1820 convert.o - 0x000000000040b110 geom_to_var_ - 0x000000000040b1f0 var_to_geom_ - 0x000000000040bb20 reduce_ - 0x000000000040c090 convert_side_ - 0x000000000040c0f0 thetnorm_ - 0x000000000040c140 var_to_geom_restr_ - .text 0x000000000040c930 0x6e40 initialize_p.o - 0x000000000040c930 data$ifortosxlb7_ - 0x000000000040c940 nazwy_ - 0x000000000040c950 int_bounds1_ - 0x000000000040cbe0 int_partition_ - 0x000000000040cc60 int_bounds_ - 0x000000000040cef0 add_task_ - 0x000000000040cf20 hpb_partition_ - 0x000000000040d3a0 add_int_from_ - 0x000000000040d690 add_int_ - 0x000000000040d9f0 init_int_table_ - 0x0000000000412e90 initialize_ - .text 0x0000000000413770 0x210 matmult.o - 0x0000000000413770 matmult_ - .text 0x0000000000413980 0x1c390 readrtns_CSA.o - 0x0000000000413980 readrtns_ - 0x0000000000415830 read_mdpar_ - 0x00000000004198c0 read_control_ - 0x000000000041c160 mcmread_ - 0x000000000041dcb0 molread_ - 0x0000000000424360 read_bridge_ - 0x0000000000424f60 read_dist_constr_ - 0x00000000004264f0 read_angles_ - 0x0000000000426820 read_threadbase_ - 0x0000000000426d40 csaread_ - 0x0000000000428c60 card_concat_ - 0x0000000000428e80 readi_ - 0x0000000000428f50 read_remdpar_ - 0x000000000042a200 read_minim_ - 0x000000000042ab40 reada_ - 0x000000000042ac10 read_fragments_ - 0x000000000042b7c0 setup_var_ - 0x000000000042b870 seq_comp_ - 0x000000000042b8a0 read_x_ - 0x000000000042bd20 gen_dist_constr_ - 0x000000000042be40 map_read_ - 0x000000000042c570 multreadi_ - 0x000000000042c780 multreada_ - 0x000000000042c9a0 openunits_ - 0x000000000042efd0 copy_to_tmp_ - 0x000000000042f330 readrst_ - 0x000000000042f610 move_from_tmp_ - 0x000000000042f890 random_init_ - .text 0x000000000042fd10 0x9380 parmread.o - 0x000000000042fd10 parmread_ - 0x0000000000439080 getenv_loc_ - .text 0x0000000000439090 0x4400 gen_rand_conf.o - 0x0000000000439090 gen_rand_conf_ - 0x0000000000439d00 gen_side_ - 0x000000000043aa90 gen_theta_ - 0x000000000043af50 gen_phi_ - 0x000000000043af90 overlap_ - 0x000000000043b550 ran_number_ - 0x000000000043b590 binorm_ - 0x000000000043b870 mult_norm1_ - 0x000000000043bb70 iran_num_ - 0x000000000043bbc0 anorm_distr_ - 0x000000000043bd10 mult_norm_ - 0x000000000043c150 overlap_sc_ - 0x000000000043cef0 overlap_sc_list_ - .text 0x000000000043d490 0x330 printmat.o - 0x000000000043d490 printmat_ - .text 0x000000000043d7c0 0xb00 map.o - 0x000000000043d7c0 map_ - .text 0x000000000043e2c0 0x50 pinorm.o - 0x000000000043e2c0 pinorm_ - .text 0x000000000043e310 0x760 randgens.o - 0x000000000043e310 vrnd_ - 0x000000000043e3a0 rndv_ - 0x000000000043e620 vrndst_ - 0x000000000043e8d0 vrndin_ - 0x000000000043e960 vrndou_ - 0x000000000043e9f0 rnunf_ - .text 0x000000000043ea70 0x190 rescode.o - 0x000000000043ea70 rescode_ - .text 0x000000000043ec00 0x450 intcor.o - 0x000000000043ec00 alpha_ - 0x000000000043ed10 beta_ - 0x000000000043eff0 dist_ - .text 0x000000000043f050 0x1a30 timing.o - 0x000000000043f050 set_timers_ - 0x000000000043f160 tcpu_ - 0x000000000043f190 ovrtim_ - 0x000000000043f450 dajczas_ - 0x000000000043f5b0 print_detailed_timing_ - 0x0000000000440a70 stopx_ - .text 0x0000000000440a80 0x9e0 misc.o - 0x0000000000440a80 find_arg_ - 0x0000000000440b10 find_group_ - 0x0000000000440dd0 lcom_ - 0x0000000000440e00 ilen_ - 0x0000000000440e70 ucase_ - 0x0000000000440f70 iblnk_ - 0x0000000000440fb0 in_keywd_set_ - 0x0000000000441110 lcase_ - 0x0000000000441210 lower_case_ - 0x0000000000441270 mykey_ - 0x0000000000441350 numstr_ - .text 0x0000000000441460 0x6300 intlocal.o - 0x0000000000441460 integral_ - 0x0000000000441c70 ele_ - 0x0000000000441cf0 elocal_ - 0x0000000000441f60 integral3_ - 0x0000000000443a00 integral5_ - 0x00000000004448b0 integral_turn6_ - 0x00000000004455d0 integral6_ - 0x0000000000446880 integral3a_ - 0x0000000000446f00 integral4a_ - .text 0x0000000000447760 0x1680 cartder.o - 0x0000000000447760 cartder_ - .text 0x0000000000448de0 0x4730 checkder_p.o - 0x0000000000448de0 check_cartgrad_ - 0x000000000044aad0 check_ecart_ - 0x000000000044b5c0 check_ecartint_ - 0x000000000044c7a0 int_from_cart1_ - 0x000000000044cea0 check_eint_ - .text 0x000000000044d510 0x880 econstr_local.o - 0x000000000044d510 econstr_back_ - .text 0x000000000044dd90 0x4b350 energy_p_new_barrier.o - 0x000000000044dd90 etotal_ - 0x0000000000451910 ssbond_ene_ - 0x0000000000451f20 egbv_ - 0x0000000000452ff0 egb_ - 0x0000000000454210 ebp_ - 0x0000000000455190 eelec_ - 0x0000000000455910 eturn3_ - 0x00000000004562d0 eturn4_ - 0x00000000004590e0 eelecij_ - 0x000000000045de10 set_matrices_ - 0x000000000045f240 ebond_ - 0x000000000045fe10 ebend_ - 0x0000000000461e20 esc_ - 0x0000000000463db0 enesc_ - 0x0000000000464360 etor_ - 0x0000000000464bb0 multibody_eello_ - 0x0000000000466d70 eello6_ - 0x000000000046c390 eello6_graph3_ - 0x000000000046ca70 eello6_graph4_ - 0x0000000000472620 eello6_graph2_ - 0x0000000000473510 eello6_graph1_ - 0x0000000000473e10 eello_turn6_ - 0x0000000000476e80 eello4_ - 0x0000000000477700 eello5_ - 0x0000000000479ab0 calc_eello_ - 0x0000000000489f00 kernel_ - 0x000000000048acf0 multibody_hb_ - 0x000000000048c9f0 add_hb_contact_ - 0x000000000048cca0 sum_energy_ - 0x000000000048cf30 eback_sc_corr_ - 0x000000000048d2b0 etor_d_ - 0x000000000048df50 edis_ - 0x000000000048e900 escp_soft_sphere_ - 0x000000000048ec10 escp_ - 0x000000000048f310 eelec_soft_sphere_ - 0x000000000048f650 e_softsphere_ - 0x000000000048f9b0 eljk_ - 0x000000000048fff0 elj_ - 0x0000000000490800 sum_gradient_ - 0x0000000000493340 scalar_ - 0x0000000000493370 rescale_weights_ - 0x0000000000493870 enerprint_ - 0x0000000000493f40 gcont_ - 0x0000000000494010 sc_grad_ - 0x00000000004944b0 sc_angular_ - 0x0000000000494880 unormderiv_ - 0x0000000000494a10 vecpr_ - 0x0000000000494a70 check_vecgrad_ - 0x0000000000494e60 vec_and_deriv_ - 0x0000000000496d90 transpose2_ - 0x0000000000496db0 matmat2_ - 0x0000000000496e30 matvec2_ - 0x0000000000496e70 scalar2_ - 0x0000000000496e90 spline2_ - 0x0000000000496f20 spline1_ - 0x0000000000496fd0 mixder_ - 0x00000000004970f0 theteng_ - 0x0000000000497510 splinthet_ - 0x00000000004976f0 enesc_bound_ - 0x0000000000497b40 multibody_ - 0x00000000004982f0 esccorr_ - 0x00000000004985b0 ehbcorr_ - 0x0000000000498c10 add_hb_contact_eello_ - 0x0000000000498e70 prodmat3_ - 0x0000000000498ff0 transpose_ - .text 0x00000000004990e0 0xc040 energy_p_new-sep_barrier.o - 0x00000000004990e0 sscale_ - 0x0000000000499150 elj_long_ - 0x00000000004997e0 elj_short_ - 0x0000000000499e70 eljk_long_ - 0x000000000049a620 eljk_short_ - 0x000000000049add0 ebp_long_ - 0x000000000049b7d0 sc_grad_scale_ - 0x000000000049bc90 ebp_short_ - 0x000000000049c680 egb_long_ - 0x000000000049d300 egb_short_ - 0x000000000049df70 egbv_long_ - 0x000000000049eb50 egbv_short_ - 0x000000000049f730 eelec_scale_ - 0x000000000049fea0 eelecij_scale_ - 0x00000000004a3970 evdwpp_short_ - 0x00000000004a4020 escp_long_ - 0x00000000004a48a0 escp_short_ - .text 0x00000000004a5120 0x1d40 gradient_p.o - 0x00000000004a5120 gradient_ - 0x00000000004a5690 grad_restr_ - 0x00000000004a5c50 cartgrad_ - 0x00000000004a6410 zerograd_ - 0x00000000004a6e50 fdum_ - .text 0x00000000004a6e60 0x1660 minimize_p.o - 0x00000000004a6e60 minimize_ - 0x00000000004a7390 xx2x_ - 0x00000000004a7470 x2xx_ - 0x00000000004a7560 func_restr_ - 0x00000000004a75c0 func_ - 0x00000000004a7620 ergastulum_ - 0x00000000004a7d60 minim_dc_ - 0x00000000004a8120 grad_dc_ - 0x00000000004a83d0 func_dc_ - .text 0x00000000004a84c0 0x3770 sumsld.o - 0x00000000004a84c0 sumsl_ - 0x00000000004a8760 sumit_ - 0x00000000004aa320 wzbfgs_ - 0x00000000004aa840 vvmulp_ - 0x00000000004aab80 lvmul_ - 0x00000000004aadc0 lupdat_ - 0x00000000004ab100 ltvmul_ - 0x00000000004ab320 dbdog_ - .text 0x00000000004abc30 0x25c68 cored.o - 0x00000000004abc30 assst_ - 0x00000000004b1fca deflt_ - 0x00000000004b334a dotprd_ - 0x00000000004b3590 itsum_ - 0x00000000004b788a litvmu_ - 0x00000000004b81b2 livmul_ - 0x00000000004b8bda parck_ - 0x00000000004bc9d6 reldst_ - 0x00000000004bd016 vaxpy_ - 0x00000000004bd324 vcopy_ - 0x00000000004bd530 vdflt_ - 0x00000000004be76e vscopy_ - 0x00000000004be8a4 v2norm_ - 0x00000000004bede4 humsl_ - 0x00000000004bfd2e humit_ - 0x00000000004c70b2 dupdu_ - 0x00000000004c78d2 gqtst_ - 0x00000000004ce904 lsqrt_ - 0x00000000004cf4ee lsvmin_ - 0x00000000004d114e slvmul_ - *fill* 0x00000000004d1898 0x8 90909090 - .text 0x00000000004d18a0 0x90 rmdd.o - 0x00000000004d18a0 imdcon_ - 0x00000000004d18b0 rmdcon_ - .text 0x00000000004d1930 0x4720 geomout.o - 0x00000000004d1930 pdbout_ - 0x00000000004d30b0 mol2out_ - 0x00000000004d3ba0 intout_ - 0x00000000004d3fa0 briefout_ - 0x00000000004d45b0 cartoutx_ - 0x00000000004d4b40 cartout_ - 0x00000000004d50b0 statout_ - 0x00000000004d5f60 gyrate_ - .text 0x00000000004d6050 0x3004 readpdb.o - 0x00000000004d6050 readpdb_ - 0x00000000004d7854 int_from_cart_ - 0x00000000004d8650 sc_loc_geom_ - 0x00000000004d8ea0 sccenter_ - 0x00000000004d8f50 bond_regular_ - *fill* 0x00000000004d9054 0xc 90909090 - .text 0x00000000004d9060 0xb30 regularize.o - 0x00000000004d9060 regularize_ - .text 0x00000000004d9b90 0x3910 thread.o - 0x00000000004d9b90 thread_seq_ - 0x00000000004dbfa0 write_thread_summary_ - 0x00000000004dcf80 write_stat_thread_ - 0x00000000004dd250 sc_conf_ - .text 0x00000000004dd4a0 0x2770 fitsq.o - 0x00000000004dd4a0 fitsq_ - 0x00000000004ddc00 sivade_ - 0x00000000004df5d0 mvvad_ - 0x00000000004df670 det_ - 0x00000000004df6d0 switch_ - 0x00000000004df770 givns_ - 0x00000000004df950 mmmul_ - 0x00000000004dfae0 matvec_ - .text 0x00000000004dfc10 0x4de0 mcm.o - 0x00000000004dfc10 mcm_setup_ - 0x00000000004e0cc0 do_mcm_ - 0x00000000004e14b0 statprint_ - 0x00000000004e1c60 cool_ - 0x00000000004e1da0 metropolis_ - 0x00000000004e1e80 perturb_ - 0x00000000004e2d30 heat_ - 0x00000000004e2f80 zapis_ - 0x00000000004e3340 conf_comp_ - 0x00000000004e3710 execute_slave_ - 0x00000000004e3fa0 add2cache_ - 0x00000000004e4460 selectmove_ - 0x00000000004e4510 gen_psi_ - 0x00000000004e45b0 dif_ang_ - 0x00000000004e4710 rm_from_cache_ - .text 0x00000000004e49f0 0x46f0 mc.o - 0x00000000004e49f0 monte_carlo_ - 0x00000000004e87a0 icialosc_ - 0x00000000004e87d0 accept_mc_ - 0x00000000004e8ed0 entropia_ - .text 0x00000000004e90e0 0xf20 bond_move.o - 0x00000000004e90e0 bond_move_ - .text 0x00000000004ea000 0x420 refsys.o - 0x00000000004ea000 refsys_ - .text 0x00000000004ea420 0x1c0 check_sc_distr.o - 0x00000000004ea420 check_sc_distr_ - .text 0x00000000004ea5e0 0xe0 check_bond.o - 0x00000000004ea5e0 check_bond_ - .text 0x00000000004ea6c0 0xd10 contact.o - 0x00000000004ea6c0 contact_ - 0x00000000004eaa40 contact_fract_ - 0x00000000004eab40 contact_fract_nn_ - 0x00000000004eac40 hairpin_ - .text 0x00000000004eb3d0 0xb00 djacob.o - 0x00000000004eb3d0 djacob_ - .text 0x00000000004ebed0 0xf350 eigen.o - 0x00000000004ebed0 einvit_ - 0x00000000004edb60 estpi1_ - 0x00000000004ee320 epslon_ - 0x00000000004ee340 elau_ - 0x00000000004eea50 eqlrat_ - 0x00000000004ef250 etrbk3_ - 0x00000000004ef3d0 etred3_ - 0x00000000004f0300 freda_ - 0x00000000004f0620 trbk3b_ - 0x00000000004f07a0 tql2_ - 0x00000000004f1070 tinvtb_ - 0x00000000004f24d0 imtqlv_ - 0x00000000004f2a90 tred3b_ - 0x00000000004f38e0 gldiag_ - 0x00000000004f3fc0 jacdia_ - 0x00000000004f4cf0 evvrsp_ - 0x00000000004f7b30 giveis_ - 0x00000000004fa990 jacdg_ - 0x00000000004faee0 jacord_ - .text 0x00000000004fb220 0x2760 blas.o - 0x00000000004fb220 dasum_ - 0x00000000004fb4b0 daxpy_ - 0x00000000004fb710 dcopy_ - 0x00000000004fb930 ddot_ - 0x00000000004fbbc0 dnrm2_ - 0x00000000004fbd30 drot_ - 0x00000000004fc130 drotg_ - 0x00000000004fc210 dscal_ - 0x00000000004fc4a0 dswap_ - 0x00000000004fc720 idamax_ - 0x00000000004fc8a0 dgemv_ - .text 0x00000000004fd980 0xc0 add.o - 0x00000000004fd980 abrt_ - 0x00000000004fd9b0 vclr_ - .text 0x00000000004fda40 0x5100 entmcm.o - 0x00000000004fda40 entmcm_ - 0x0000000000502070 accepting_ - 0x0000000000502700 read_pool_ - .text 0x0000000000502b40 0x4c0 minim_mcmf.o - 0x0000000000502b40 minim_mcmf_ - .text 0x0000000000503000 0xbd20 together.o - 0x0000000000503000 together_ - 0x000000000050aa00 feedin_ - 0x000000000050bb00 reminimize_ - 0x000000000050d470 getx_ - 0x000000000050d940 send_ - 0x000000000050e240 recv_ - 0x000000000050e570 history_append_ - 0x000000000050e5e0 prune_bank_ - 0x000000000050ea60 putx_ - 0x000000000050eba0 putx2_ - .text 0x000000000050ed20 0x2940 csa.o - 0x000000000050ed20 make_array_ - 0x000000000050f0a0 make_ranvar_ - 0x000000000050f5e0 make_ranvar_reg_ - 0x000000000050fe70 from_pdb_ - 0x0000000000510740 from_int_ - 0x00000000005113f0 dihang_to_c_ - .text 0x0000000000511660 0x30f0 minim_jlee.o - 0x0000000000511660 minim_jlee_ - 0x0000000000513710 check_var_ - .text 0x0000000000514750 0x1570 shift.o - 0x0000000000514750 csa_read_ - 0x0000000000514d50 restart_write_ - 0x00000000005154d0 initial_write_ - .text 0x0000000000515cc0 0x140 diff12.o - 0x0000000000515cc0 get_diff12_ - .text 0x0000000000515e00 0x9210 bank.o - 0x0000000000515e00 refresh_bank_ - 0x0000000000517dd0 replace_bvar_ - 0x00000000005181f0 find_max_ - 0x00000000005182c0 write_rbank_ - 0x00000000005186c0 read_rbank_ - 0x00000000005190a0 write_bank_ - 0x000000000051a6b0 write_bank_reminimized_ - 0x000000000051b3e0 read_bank_ - 0x000000000051bf10 write_bank1_ - 0x000000000051c320 save_is_ - 0x000000000051c5a0 select_is_ - 0x000000000051cd40 get_is_ - 0x000000000051dbc0 get_is_ran_ - 0x000000000051df80 select_iseed_far_ - 0x000000000051e080 select_iseed_min_ - 0x000000000051e200 select_iseed_max_ - 0x000000000051e380 find_min_ - 0x000000000051e450 write_csa_pdb_ - 0x000000000051e930 get_diff_ - 0x000000000051eb60 estimate_cutdif_ - 0x000000000051ec10 get_is_max_ - .text 0x000000000051f010 0xdf90 newconf.o - 0x000000000051f010 make_var_ - 0x00000000005292d0 newconf_residue_hairpin_ - 0x0000000000529a80 newconf_residue_ - 0x0000000000529ee0 newconf1abr_ - 0x000000000052a3c0 newconf1abb_ - 0x000000000052a8a0 newconf1br_ - 0x000000000052af80 select_frag_ - 0x000000000052bb20 newconf1bb_ - 0x000000000052bfb0 newconf1rr_ - 0x000000000052c440 newconf1arr_ - 0x000000000052c8d0 gen_hairpin_ - 0x000000000052cbe0 check_old_ - 0x000000000052cd90 newconf_copy_ - .text 0x000000000052cfa0 0x470 ran.o - 0x000000000052cfa0 ran0_ - 0x000000000052d000 ran1_ - 0x000000000052d100 ran2_ - 0x000000000052d260 ran3_ - .text 0x000000000052d410 0x320 indexx.o - 0x000000000052d410 indexx_ - .text 0x000000000052d730 0x3750 MP.o - 0x000000000052d730 finish_task_ - 0x000000000052e340 pattern_receive_ - 0x000000000052e6f0 pattern_send_ - 0x000000000052e700 send_mcm_info_ - 0x000000000052e970 receive_mcm_info_ - 0x000000000052ec40 send_thread_results_ - 0x000000000052f300 receive_thread_results_ - 0x000000000052fe70 recv_stop_sig_ - 0x0000000000530150 send_stop_sig_ - 0x00000000005301b0 init_task_ - .text 0x0000000000530e80 0x12e0 compare_s1.o - 0x0000000000530e80 compare_s1_ - .text 0x0000000000532160 0x260 prng_32.o - 0x0000000000532160 prng_next_ - 0x00000000005321f0 vprng_ - 0x0000000000532320 prng_chkpnt_ - 0x0000000000532350 prng_restart_ - 0x00000000005323b0 prngblk_ - .text 0x00000000005323c0 0x17280 test.o - 0x00000000005323c0 test_ - 0x0000000000533320 write_pdb_ - 0x0000000000533650 test_n16_ - 0x00000000005348d0 beta_slide_ - 0x00000000005351e0 test_local_ - 0x0000000000535aa0 test_sc_ - 0x0000000000536180 test11_ - 0x000000000053bb00 bgrow_ - 0x000000000053bcc0 contact_cp_min_ - 0x000000000053d8f0 test3_ - 0x000000000053f070 test___ - 0x00000000005412b0 secondary_ - 0x0000000000543cc0 contact_cp_ - 0x0000000000546640 contact_cp2_ - 0x0000000000546c20 softreg_ - 0x00000000005493e0 beta_zip_ - .text 0x0000000000549640 0x1960 banach.o - 0x0000000000549640 banach_ - 0x0000000000549e70 banaii_ - 0x000000000054a1b0 matinvert_ - .text 0x000000000054afa0 0x1c20 distfit.o - 0x000000000054afa0 distfit_ - 0x000000000054c200 heval_ - 0x000000000054c660 rderiv_ - 0x000000000054ca10 rdif_ - 0x000000000054cb00 transfer_ - 0x000000000054cb20 vec_ - .text 0x000000000054cbc0 0x1360 rmsd.o - 0x000000000054cbc0 rms_nac_nnc_ - 0x000000000054d3f0 rmsd_ - 0x000000000054d980 rmsd_csa_ - .text 0x000000000054df20 0x5840 elecont.o - 0x000000000054df20 elecont_ - 0x000000000054f590 secondary2_ - 0x00000000005536b0 freeres_ - .text 0x0000000000553760 0x19f0 dihed_cons.o - 0x0000000000553760 secstrp2dihc_ - 0x0000000000554710 read_secstr_pred_ - .text 0x0000000000555150 0x34d0 sc_move.o - 0x0000000000555150 sc_move_ - 0x0000000000555c60 egb1_ - 0x0000000000556310 single_sc_move_ - 0x0000000000556b00 minimize_sc1_ - 0x0000000000556e60 sc_minimize_ - 0x00000000005571b0 grad_restr1_ - 0x0000000000557e60 func_restr1_ - .text 0x0000000000558620 0x5100 local_move.o - 0x0000000000558620 local_move_ - 0x00000000005588f0 move_res_ - 0x000000000055a390 construct_tab_ - 0x000000000055a9c0 output_tabs_ - 0x000000000055af80 angles2tab_ - 0x000000000055b0c0 minmax_angles_ - 0x000000000055b530 construct_ranges_ - 0x000000000055b6d0 fix_no_moves_ - 0x000000000055b8d0 loc_test_ - 0x000000000055d620 local_move_init_ - .text 0x000000000055d720 0x52f0 intcartderiv.o - 0x000000000055d720 intcartderiv_ - 0x000000000055f4f0 checkintcartgrad_ - 0x0000000000562780 chainbuild_cart_ - .text 0x0000000000562a10 0x37d0 /tmp/ipo_ifortScZxT8.o - 0x0000000000562a10 fricmat_mult_ - 0x0000000000562ec0 ginv_mult_ - 0x0000000000563390 setup_md_matrices_ - 0x0000000000565910 lagrangian_ - .text 0x00000000005661e0 0x3370 stochfric.o - 0x00000000005661e0 friction_force_ - 0x0000000000566330 stochastic_force_ - 0x0000000000566890 setup_fricmat_ - 0x0000000000568c20 sdarea_ - .text 0x0000000000569550 0x400 kinetic_lesyng.o - 0x0000000000569550 kinetic_ - .text 0x0000000000569950 0xc920 MD_A-MTS.o - 0x0000000000569950 md_ - 0x000000000056ab50 respa_step_ - 0x000000000056e5a0 velverlet_step_ - 0x0000000000570d80 random_vel_ - 0x0000000000571180 verlet_bath_ - 0x0000000000571300 verlet2_ - 0x0000000000571480 sddir_verlet2_ - 0x00000000005717d0 predict_edrift_ - 0x0000000000571a00 max_accel_ - 0x0000000000571e10 verlet1_ - 0x0000000000572170 sddir_verlet1_ - 0x0000000000572600 sddir_precalc_ - 0x00000000005726a0 respa_vel_ - 0x0000000000572820 init_md_ - .text 0x0000000000576270 0x1a10 moments.o - 0x0000000000576270 inertia_tensor_ - 0x00000000005774c0 angmom_ - 0x0000000000577a40 vcm_vel_ - .text 0x0000000000577c80 0x1330 int_to_cart.o - 0x0000000000577c80 int_to_cart_ - .text 0x0000000000578fb0 0x1790 surfatom.o - 0x0000000000578fb0 surfatom_ - .text 0x000000000057a740 0x1040 sort.o - 0x000000000057a740 sort_ - 0x000000000057a7e0 sort2_ - 0x000000000057a9a0 sort3_ - 0x000000000057ab70 sort4_ - 0x000000000057ac80 sort5_ - 0x000000000057adb0 sort6_ - 0x000000000057b020 sort7_ - 0x000000000057b390 sort8_ - 0x000000000057b490 sort9_ - .text 0x000000000057b780 0x5ce0 muca_md.o - 0x000000000057b780 muca_delta_ - 0x000000000057d0d0 muca_ene_ - 0x000000000057d640 read_muca_ - 0x000000000057e1b0 print_muca_ - 0x00000000005800e0 splint_ - 0x00000000005802b0 spline_ - 0x0000000000580520 muca_factor_ - 0x0000000000580910 muca_update_ - .text 0x0000000000581460 0xcc70 MREMD.o - 0x0000000000581460 mremd_ - 0x000000000058a420 write1traj_ - 0x000000000058bc40 write1rst_ - 0x000000000058c470 read1restart_ - 0x000000000058d7d0 read1restart_old_ - .text 0x000000000058e0d0 0x150 rattle.o - 0x000000000058e0d0 rattle1_ - 0x000000000058e140 rattle2_ - 0x000000000058e1b0 rattle_brown_ - .text 0x000000000058e220 0xde0 gauss.o - 0x000000000058e220 gauss_ - .text 0x000000000058f000 0xd70 energy_split-sep.o - 0x000000000058f000 etotal_long_ - 0x000000000058f720 etotal_short_ - .text 0x000000000058fd70 0x21d0 q_measure.o - 0x000000000058fd70 qwol_num_ - 0x000000000058ffa0 econstrq_ - 0x0000000000590540 qwolynes_prim_ - 0x00000000005910c0 deconstrq_num_ - 0x0000000000591a20 qwolynes_ - .text 0x0000000000591f40 0xf0 gnmr1.o - 0x0000000000591f40 gnmr1_ - 0x0000000000591fa0 gnmr1prim_ - 0x0000000000591ff0 harmonic_ - 0x0000000000592010 harmonicprim_ - .text 0x0000000000592030 0x236 proc_proc.o - 0x0000000000592030 proc_proc_ - 0x00000000005920b1 proc_conv_ - 0x00000000005920ea proc_conv_r_ - 0x00000000005920fc dsvrgp_ - *fill* 0x0000000000592266 0xa 90909090 - .text 0x0000000000592270 0x700 cinfo.o - 0x0000000000592270 cinfo_ - .text 0x0000000000592970 0x2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - 0x0000000000592970 mpi_abort_ - 0x0000000000592970 pmpi_abort_ - *fill* 0x000000000059299f 0x1 90909090 - .text 0x00000000005929a0 0x67 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x00000000005929a0 mpi_allgather_ - 0x00000000005929a0 pmpi_allgather_ - *fill* 0x0000000000592a07 0x1 90909090 - .text 0x0000000000592a08 0x25 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x0000000000592a08 mpi_barrier_ - 0x0000000000592a08 pmpi_barrier_ - *fill* 0x0000000000592a2d 0x3 90909090 - .text 0x0000000000592a30 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x0000000000592a30 pmpi_bcast_ - 0x0000000000592a30 mpi_bcast_ - *fill* 0x0000000000592a82 0x2 90909090 - .text 0x0000000000592a84 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x0000000000592a84 mpi_comm_create_ - 0x0000000000592a84 pmpi_comm_create_ - *fill* 0x0000000000592ace 0x2 90909090 - .text 0x0000000000592ad0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x0000000000592ad0 pmpi_comm_group_ - 0x0000000000592ad0 mpi_comm_group_ - .text 0x0000000000592b10 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x0000000000592b10 mpi_comm_rank_ - 0x0000000000592b10 pmpi_comm_rank_ - *fill* 0x0000000000592b46 0x2 90909090 - .text 0x0000000000592b48 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x0000000000592b48 pmpi_comm_size_ - 0x0000000000592b48 mpi_comm_size_ - *fill* 0x0000000000592b7e 0x2 90909090 - .text 0x0000000000592b80 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x0000000000592b80 mpi_comm_split_ - 0x0000000000592b80 pmpi_comm_split_ - .text 0x0000000000592bd4 0x7f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x0000000000592bd4 mpi_dup_fn_ - 0x0000000000592bd4 pmpi_dup_fn_ - *fill* 0x0000000000592c53 0x1 90909090 - .text 0x0000000000592c54 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x0000000000592c54 mpi_finalize_ - 0x0000000000592c54 pmpi_finalize_ - *fill* 0x0000000000592c6f 0x1 90909090 - .text 0x0000000000592c70 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x0000000000592c70 pmpi_gather_ - 0x0000000000592c70 mpi_gather_ - *fill* 0x0000000000592ce1 0x3 90909090 - .text 0x0000000000592ce4 0x4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x0000000000592ce4 mpi_get_count_ - 0x0000000000592ce4 pmpi_get_count_ - *fill* 0x0000000000592d2f 0x1 90909090 - .text 0x0000000000592d30 0xf4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x0000000000592d30 pmpi_get_processor_name_ - 0x0000000000592d30 mpi_get_processor_name_ - .text 0x0000000000592e24 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x0000000000592e24 mpi_group_free_ - 0x0000000000592e24 pmpi_group_free_ - *fill* 0x0000000000592e63 0x1 90909090 - .text 0x0000000000592e64 0x52 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x0000000000592e64 pmpi_group_incl_ - 0x0000000000592e64 mpi_group_incl_ - *fill* 0x0000000000592eb6 0x2 90909090 - .text 0x0000000000592eb8 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x0000000000592eb8 mpi_group_rank_ - 0x0000000000592eb8 pmpi_group_rank_ - *fill* 0x0000000000592eee 0x2 90909090 - .text 0x0000000000592ef0 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x0000000000592ef0 mpi_group_translate_ranks_ - 0x0000000000592ef0 pmpi_group_translate_ranks_ - .text 0x0000000000592f3c 0x22f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x0000000000592f3c pmpi_init_ - 0x0000000000592f3c mpi_init_ - *fill* 0x000000000059316b 0x1 90909090 - .text 0x000000000059316c 0x87 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x000000000059316c mpi_iprobe_ - 0x000000000059316c pmpi_iprobe_ - *fill* 0x00000000005931f3 0x1 90909090 - .text 0x00000000005931f4 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x00000000005931f4 mpi_irecv_ - 0x00000000005931f4 pmpi_irecv_ - .text 0x0000000000593270 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x0000000000593270 pmpi_isend_ - 0x0000000000593270 mpi_isend_ - .text 0x00000000005932ec 0x7c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x00000000005932ec mpi_issend_ - 0x00000000005932ec pmpi_issend_ - .text 0x0000000000593368 0x33 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x0000000000593368 mpi_null_copy_fn_ - 0x0000000000593368 pmpi_null_copy_fn_ - *fill* 0x000000000059339b 0x1 90909090 - .text 0x000000000059339c 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x000000000059339c mpi_null_delete_fn_ - 0x000000000059339c pmpi_null_delete_fn_ - .text 0x00000000005933c0 0x58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x00000000005933c0 mpi_probe_ - 0x00000000005933c0 pmpi_probe_ - .text 0x0000000000593418 0x78 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x0000000000593418 pmpi_recv_ - 0x0000000000593418 mpi_recv_ - .text 0x0000000000593490 0x6a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x0000000000593490 mpi_reduce_ - 0x0000000000593490 pmpi_reduce_ - *fill* 0x00000000005934fa 0x2 90909090 - .text 0x00000000005934fc 0x71 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x00000000005934fc mpi_scatter_ - 0x00000000005934fc pmpi_scatter_ - *fill* 0x000000000059356d 0x3 90909090 - .text 0x0000000000593570 0x7d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x0000000000593570 mpi_scatterv_ - 0x0000000000593570 pmpi_scatterv_ - *fill* 0x00000000005935ed 0x3 90909090 - .text 0x00000000005935f0 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x00000000005935f0 pmpi_send_ - 0x00000000005935f0 mpi_send_ - .text 0x0000000000593650 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x0000000000593650 PMPI_Status_f2c - 0x0000000000593650 MPI_Status_f2c - .text 0x00000000005936f0 0x95 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x00000000005936f0 pmpi_test_ - 0x00000000005936f0 mpi_test_ - *fill* 0x0000000000593785 0x3 90909090 - .text 0x0000000000593788 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x0000000000593788 mpi_type_commit_ - 0x0000000000593788 pmpi_type_commit_ - *fill* 0x00000000005937c7 0x1 90909090 - .text 0x00000000005937c8 0x4a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x00000000005937c8 pmpi_type_contiguous_ - 0x00000000005937c8 mpi_type_contiguous_ - *fill* 0x0000000000593812 0x2 90909090 - .text 0x0000000000593814 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x0000000000593814 mpi_type_indexed_ - 0x0000000000593814 pmpi_type_indexed_ - *fill* 0x0000000000593a0f 0x1 90909090 - .text 0x0000000000593a10 0x261 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x0000000000593a10 mpi_waitall_ - 0x0000000000593a10 pmpi_waitall_ - *fill* 0x0000000000593c71 0x3 90909090 - .text 0x0000000000593c74 0x21 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x0000000000593c74 mpi_wtime_ - 0x0000000000593c74 pmpi_wtime_ - *fill* 0x0000000000593c95 0x3 90909090 - .text 0x0000000000593c98 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x0000000000593c98 mpir_getarg_ - 0x0000000000593ca2 mpir_iargc_ - .text 0x0000000000593cac 0x589 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000000593cac MPIR_InitFortran - 0x0000000000593e54 MPIR_Free_Fortran_keyvals - 0x0000000000593e9e mpir_init_bottom_ - 0x0000000000593ed1 MPIR_InitFortranDatatypes - 0x00000000005941ab MPIR_Free_Fortran_dtes - 0x000000000059421f mpir_init_fsize_ - *fill* 0x0000000000594235 0x3 90909090 - .text 0x0000000000594238 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x0000000000594238 mpir_init_fcm_ - 0x0000000000594248 mpir_init_flog_ - .text 0x0000000000594258 0xbd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x0000000000594258 MPID_Node_name - *fill* 0x0000000000594315 0x3 90909090 - .text 0x0000000000594318 0x39f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x0000000000594318 MPI_Isend - 0x0000000000594318 PMPI_Isend - *fill* 0x00000000005946b7 0x1 90909090 - .text 0x00000000005946b8 0x399 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x00000000005946b8 MPI_Irecv - 0x00000000005946b8 PMPI_Irecv - *fill* 0x0000000000594a51 0x3 90909090 - .text 0x0000000000594a54 0xcb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x0000000000594a54 MPI_Test - 0x0000000000594a54 PMPI_Test - *fill* 0x0000000000594b1f 0x1 90909090 - .text 0x0000000000594b20 0x881 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0x0000000000594b20 MPIR_Errors_are_fatal - 0x0000000000594dda MPIR_Errors_return - 0x0000000000594e66 MPIR_Errors_warn - 0x00000000005950f8 MPIR_Error - 0x0000000000595250 MPIR_Set_Status_error_array - *fill* 0x00000000005953a1 0x3 90909090 - .text 0x00000000005953a4 0x1fb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x00000000005953a4 PMPI_Probe - 0x00000000005953a4 MPI_Probe - *fill* 0x000000000059559f 0x1 90909090 - .text 0x00000000005955a0 0x686 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x00000000005955a0 MPI_Waitall - 0x00000000005955a0 PMPI_Waitall - *fill* 0x0000000000595c26 0x2 90909090 - .text 0x0000000000595c28 0x2f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x0000000000595c28 MPI_Send - 0x0000000000595c28 PMPI_Send - .text 0x0000000000595f20 0x2ff /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x0000000000595f20 PMPI_Recv - 0x0000000000595f20 MPI_Recv - *fill* 0x000000000059621f 0x1 90909090 - .text 0x0000000000596220 0x20b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x0000000000596220 MPI_Iprobe - 0x0000000000596220 PMPI_Iprobe - *fill* 0x000000000059642b 0x1 90909090 - .text 0x000000000059642c 0x68a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x000000000059642c PMPI_Testall - 0x000000000059642c MPI_Testall - *fill* 0x0000000000596ab6 0x2 90909090 - .text 0x0000000000596ab8 0x16f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x0000000000596ab8 PMPI_Get_count - 0x0000000000596ab8 MPI_Get_count - *fill* 0x0000000000596c27 0x1 90909090 - .text 0x0000000000596c28 0x39c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x0000000000596c28 MPI_Issend - 0x0000000000596c28 PMPI_Issend - .text 0x0000000000596fc4 0x2ab /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x0000000000596fc4 MPI_Type_commit - 0x0000000000596fc4 PMPI_Type_commit - *fill* 0x000000000059726f 0x1 90909090 - .text 0x0000000000597270 0x53a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x0000000000597270 PMPI_Type_contiguous - 0x0000000000597270 MPI_Type_contiguous - *fill* 0x00000000005977aa 0x2 90909090 - .text 0x00000000005977ac 0x30d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x00000000005977ac PMPI_Type_indexed - 0x00000000005977ac MPI_Type_indexed - *fill* 0x0000000000597ab9 0x3 90909090 - .text 0x0000000000597abc 0x3c4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0x0000000000597abc MPIR_Type_dup - 0x0000000000597adb MPIR_Type_permanent - 0x0000000000597afc MPIR_Type_free - 0x0000000000597d6b MPIR_Type_get_limits - 0x0000000000597d9b MPIR_Free_perm_type - 0x0000000000597ddc MPIR_Free_struct_internals - 0x0000000000597e56 MPIR_Datatype_iscontig - .text 0x0000000000597e80 0xce /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x0000000000597e80 PMPI_Abort - 0x0000000000597e80 MPI_Abort - *fill* 0x0000000000597f4e 0x2 90909090 - .text 0x0000000000597f50 0x1f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x0000000000597f50 MPI_Init - 0x0000000000597f50 PMPI_Init - *fill* 0x0000000000597f6f 0x1 90909090 - .text 0x0000000000597f70 0xff8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x0000000000597f70 MPIR_Init - 0x0000000000598e8c MPIR_Errhandler_create - 0x0000000000598f1b MPIR_Errhandler_mark - .text 0x0000000000598f68 0x26f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x0000000000598f68 PMPI_Finalize - 0x0000000000598f68 MPI_Finalize - *fill* 0x00000000005991d7 0x1 90909090 - .text 0x00000000005991d8 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x00000000005991d8 PMPI_Error_string - 0x00000000005991d8 MPI_Error_string - *fill* 0x0000000000599251 0x3 90909090 - .text 0x0000000000599254 0x62d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x0000000000599254 MPIR_Init_dtes - 0x00000000005995f0 MPIR_Free_dtes - 0x00000000005996d2 MPIR_Setup_base_datatype - 0x00000000005997ce MPIR_Setup_complex_datatype - 0x000000000059984c MPIR_Type_contiguous - *fill* 0x0000000000599881 0x3 90909090 - .text 0x0000000000599884 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x0000000000599884 PMPI_Errhandler_free - 0x0000000000599884 MPI_Errhandler_free - .text 0x00000000005999a4 0x29 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x00000000005999a4 PMPI_Wtime - 0x00000000005999a4 MPI_Wtime - *fill* 0x00000000005999cd 0x3 90909090 - .text 0x00000000005999d0 0xa44 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0x0000000000599a70 MPIR_Err_setmsg - 0x0000000000599d6e MPIR_Err_map_code_to_string - 0x0000000000599e81 MPIR_GetErrorMessage - 0x0000000000599f6e MPIR_Get_error_string - 0x000000000059a0d9 MPIR_GetNLSMsg - .text 0x000000000059a414 0x6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x000000000059a414 MPIR_Msg_queue_export - *fill* 0x000000000059a41a 0x2 90909090 - .text 0x000000000059a41c 0xe55 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x000000000059a41c MPIR_HBT_Init - 0x000000000059a458 MPIR_HBT_Free - 0x000000000059a47c MPIR_HBT_new_tree - 0x000000000059a4ea MPIR_HBT_new_node - 0x000000000059a587 MPIR_HBT_free_node - 0x000000000059a5b4 MPIR_HBT_free_subtree - 0x000000000059a5f1 MPIR_HBT_free_tree - 0x000000000059a638 MPIR_HBT_lookup - 0x000000000059a6c2 MPIR_HBT_insert - 0x000000000059ab2b MPIR_HBT_delete - *fill* 0x000000000059b271 0x3 90909090 - .text 0x000000000059b274 0xd53 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x000000000059b274 MPIR_PointerPerm - 0x000000000059b286 MPIR_PointerOpts - 0x000000000059b382 MPIR_DestroyPointer - 0x000000000059b3d7 MPIR_ToPointer - 0x000000000059b56a MPIR_FromPointer - 0x000000000059b848 MPIR_RmPointer - 0x000000000059ba32 MPIR_UsePointer - 0x000000000059bb29 MPIR_RegPointerIdx - 0x000000000059bd52 MPIR_DumpPointers - *fill* 0x000000000059bfc7 0x1 90909090 - .text 0x000000000059bfc8 0xa5b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0x000000000059bfc8 MPIR_BsendInitBuffer - 0x000000000059c0a4 MPIR_BsendRelease - 0x000000000059c8bb MPIR_IbsendDatatype - *fill* 0x000000000059ca23 0x1 90909090 - .text 0x000000000059ca24 0x1d0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x000000000059ca24 PMPI_Keyval_free - 0x000000000059ca24 MPI_Keyval_free - .text 0x000000000059cbf4 0x142 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x000000000059cbf4 PMPI_Attr_get - 0x000000000059cbf4 MPI_Attr_get - *fill* 0x000000000059cd36 0x2 90909090 - .text 0x000000000059cd38 0x784 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x000000000059cd38 MPIR_Attr_copy_node - 0x000000000059cf4c MPIR_Attr_copy_subtree - 0x000000000059cfe7 MPIR_Attr_copy - 0x000000000059d050 MPIR_Attr_free_node - 0x000000000059d1f1 MPIR_Attr_free_subtree - 0x000000000059d270 MPIR_Attr_free_tree - 0x000000000059d314 MPIR_Attr_dup_tree - 0x000000000059d355 MPIR_Attr_create_tree - 0x000000000059d384 MPIR_Keyval_create - 0x000000000059d498 MPIR_Attr_make_perm - .text 0x000000000059d4bc 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x000000000059d4bc PMPI_Attr_put - 0x000000000059d4bc MPI_Attr_put - *fill* 0x000000000059d77d 0x3 90909090 - .text 0x000000000059d780 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x000000000059d780 PMPI_Group_free - 0x000000000059d780 MPI_Group_free - *fill* 0x000000000059d915 0x3 90909090 - .text 0x000000000059d918 0x452 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x000000000059d918 MPI_Group_incl - 0x000000000059d918 PMPI_Group_incl - *fill* 0x000000000059dd6a 0x2 90909090 - .text 0x000000000059dd6c 0xc4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x000000000059dd6c MPI_Group_rank - 0x000000000059dd6c PMPI_Group_rank - .text 0x000000000059de30 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x000000000059de30 MPIR_CreateGroup - 0x000000000059df42 MPIR_FreeGroup - 0x000000000059dfab MPIR_SetToIdentity - 0x000000000059e011 MPIR_Dump_group - 0x000000000059e0db MPIR_Dump_ranks - 0x000000000059e143 MPIR_Dump_ranges - 0x000000000059e1fa MPIR_Powers_of_2 - 0x000000000059e2a1 MPIR_Group_N2_prev - *fill* 0x000000000059e2c1 0x3 90909090 - .text 0x000000000059e2c4 0x2c1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x000000000059e2c4 MPI_Comm_free - 0x000000000059e2c4 PMPI_Comm_free - *fill* 0x000000000059e585 0x3 90909090 - .text 0x000000000059e588 0xf5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x000000000059e588 PMPI_Comm_group - 0x000000000059e588 MPI_Comm_group - *fill* 0x000000000059e67d 0x3 90909090 - .text 0x000000000059e680 0x2f9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x000000000059e680 MPI_Comm_create - 0x000000000059e680 PMPI_Comm_create - *fill* 0x000000000059e979 0x3 90909090 - .text 0x000000000059e97c 0xc5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x000000000059e97c MPI_Comm_rank - 0x000000000059e97c PMPI_Comm_rank - *fill* 0x000000000059ea41 0x3 90909090 - .text 0x000000000059ea44 0x20c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x000000000059ea44 PMPI_Comm_set_name - 0x000000000059ea44 MPI_Comm_set_name - .text 0x000000000059ec50 0x107 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x000000000059ec50 MPI_Comm_size - 0x000000000059ec50 PMPI_Comm_size - *fill* 0x000000000059ed57 0x1 90909090 - .text 0x000000000059ed58 0x75b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x000000000059ed58 MPIR_Comm_make_coll - 0x000000000059ef8b MPIR_Comm_N2_prev - 0x000000000059efaf MPIR_Dump_comm - 0x000000000059f0c2 MPIR_Intercomm_high - 0x000000000059f1e3 MPIR_Comm_init - 0x000000000059f298 MPIR_Comm_remember - 0x000000000059f2ce MPIR_Comm_forget - 0x000000000059f32d MPIR_Comm_collops_init - 0x000000000059f375 MPIR_Sort_split_table - *fill* 0x000000000059f4b3 0x1 90909090 - .text 0x000000000059f4b4 0x5ad /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x000000000059f4b4 MPI_Comm_split - 0x000000000059f4b4 PMPI_Comm_split - *fill* 0x000000000059fa61 0x3 90909090 - .text 0x000000000059fa64 0x159 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x000000000059fa64 MPIR_Context_alloc - 0x000000000059fba8 MPIR_Context_dealloc - *fill* 0x000000000059fbbd 0x3 90909090 - .text 0x000000000059fbc0 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x000000000059fbc0 MPI_Group_translate_ranks - 0x000000000059fbc0 PMPI_Group_translate_ranks - *fill* 0x000000000059fe49 0x3 90909090 - .text 0x000000000059fe4c 0x36 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x000000000059fe4c MPIR_dup_fn - *fill* 0x000000000059fe82 0x2 90909090 - .text 0x000000000059fe84 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x000000000059fe84 MPI_Barrier - 0x000000000059fe84 PMPI_Barrier - *fill* 0x000000000059ff9d 0x3 90909090 - .text 0x000000000059ffa0 0x289 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x000000000059ffa0 MPI_Bcast - 0x000000000059ffa0 PMPI_Bcast - *fill* 0x00000000005a0229 0x3 90909090 - .text 0x00000000005a022c 0x309 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x00000000005a022c MPI_Gather - 0x00000000005a022c PMPI_Gather - *fill* 0x00000000005a0535 0x3 90909090 - .text 0x00000000005a0538 0x2bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x00000000005a0538 PMPI_Scatter - 0x00000000005a0538 MPI_Scatter - .text 0x00000000005a07f4 0x362 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x00000000005a07f4 PMPI_Scatterv - 0x00000000005a07f4 MPI_Scatterv - *fill* 0x00000000005a0b56 0x2 90909090 - .text 0x00000000005a0b58 0x335 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x00000000005a0b58 PMPI_Allgather - 0x00000000005a0b58 MPI_Allgather - *fill* 0x00000000005a0e8d 0x3 90909090 - .text 0x00000000005a0e90 0x296 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x00000000005a0e90 PMPI_Reduce - 0x00000000005a0e90 MPI_Reduce - *fill* 0x00000000005a1126 0x2 90909090 - .text 0x00000000005a1128 0x287 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x00000000005a1128 MPI_Allreduce - 0x00000000005a1128 PMPI_Allreduce - *fill* 0x00000000005a13af 0x1 90909090 - .text 0x00000000005a13b0 0x8081 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x00000000005a13b0 MPIR_MAXF - 0x00000000005a1b3b MPIR_MINF - 0x00000000005a22c6 MPIR_SUM - 0x00000000005a2b02 MPIR_PROD - 0x00000000005a340e MPIR_LAND - 0x00000000005a3e46 MPIR_BAND - 0x00000000005a441f MPIR_LOR - 0x00000000005a4e1f MPIR_BOR - 0x00000000005a53f8 MPIR_LXOR - 0x00000000005a6116 MPIR_BXOR - 0x00000000005a66ef MPIR_MAXLOC - 0x00000000005a7d8e MPIR_MINLOC - *fill* 0x00000000005a9431 0x3 90909090 - .text 0x00000000005a9434 0x136 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x00000000005a9434 PMPI_Op_free - 0x00000000005a9434 MPI_Op_free - *fill* 0x00000000005a956a 0x2 90909090 - .text 0x00000000005a956c 0x99 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x00000000005a956c MPIR_Op_setup - *fill* 0x00000000005a9605 0x3 90909090 - .text 0x00000000005a9608 0x39d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - *fill* 0x00000000005a99a5 0x3 90909090 - .text 0x00000000005a99a8 0xa1bc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .text 0x00000000005b3b64 0x53b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x00000000005b3b64 MPIR_intra_Scan - *fill* 0x00000000005b409f 0x1 90909090 - .text 0x00000000005b40a0 0x426 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x00000000005b40a0 MPIR_Topology_Init - 0x00000000005b40c1 MPIR_Topology_Free - 0x00000000005b40d6 MPIR_Topology_copy_fn - 0x00000000005b43ff MPIR_Topology_delete_fn - 0x00000000005b4497 MPIR_Topology_init - 0x00000000005b44b6 MPIR_Topology_finalize - *fill* 0x00000000005b44c6 0x2 90909090 - .text 0x00000000005b44c8 0x54 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x00000000005b44c8 PMPI_Request_c2f - 0x00000000005b44c8 MPI_Request_c2f - .text 0x00000000005b451c 0x8c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x00000000005b451c PMPI_Status_c2f - 0x00000000005b451c MPI_Status_c2f - .text 0x00000000005b45a8 0x19f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x00000000005b45a8 MPIR_fstr2cstr - 0x00000000005b46a1 MPIR_cstr2fstr - *fill* 0x00000000005b4747 0x1 90909090 - .text 0x00000000005b4748 0x1bbb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x00000000005b4748 p4_post_init - 0x00000000005b474e p4_version - 0x00000000005b476a p4_machine_type - 0x00000000005b4788 p4_initenv - 0x00000000005b499b p4_shmalloc - 0x00000000005b49d7 p4_shfree - 0x00000000005b49ee p4_num_cluster_ids - 0x00000000005b4a04 p4_num_total_ids - 0x00000000005b4a17 p4_num_total_slaves - 0x00000000005b4a2d p4_global_barrier - 0x00000000005b4a63 p4_get_cluster_masters - 0x00000000005b4ae1 p4_get_cluster_ids - 0x00000000005b4b15 p4_get_my_id_from_proc - 0x00000000005b505e p4_get_my_id - 0x00000000005b506e p4_get_my_cluster_id - 0x00000000005b50b0 p4_am_i_cluster_master - 0x00000000005b50fa in_same_cluster - 0x00000000005b5146 p4_cluster_shmem_sync - 0x00000000005b51ac get_pipe - 0x00000000005b51fb setup_conntab - 0x00000000005b543a p4_accept_wait_timeout - 0x00000000005b5463 p4_wait_for_end - 0x00000000005b5a04 fork_p4 - 0x00000000005b5abd zap_p4_processes - 0x00000000005b5b4c zap_remote_p4_processes - 0x00000000005b5e43 get_qualified_hostname - 0x00000000005b5efc same_data_representation - 0x00000000005b5f78 p4_proc_info - 0x00000000005b6015 put_execer_port - 0x00000000005b60eb p4_clean_execer_port - 0x00000000005b60f1 init_usclock - 0x00000000005b6127 p4_usclock - *fill* 0x00000000005b6303 0x1 90909090 - .text 0x00000000005b6304 0x10e2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0x00000000005b6304 bm_start - 0x00000000005b64c7 p4_create_procgroup - 0x00000000005b656d p4_startup - 0x00000000005b67cc create_bm_processes - 0x00000000005b6dd9 procgroup_to_proctable - 0x00000000005b708a sync_with_remotes - 0x00000000005b71b3 send_proc_table - *fill* 0x00000000005b73e6 0x2 90909090 - .text 0x00000000005b73e8 0xf3d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x00000000005b73e8 rm_start - 0x00000000005b7abc create_rm_processes - 0x00000000005b8189 receive_proc_table - *fill* 0x00000000005b8325 0x3 90909090 - .text 0x00000000005b8328 0x1ed3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x00000000005b83b4 p4_socket_control - 0x00000000005b8817 net_set_sockbuf_size - 0x00000000005b896f net_setup_listener - 0x00000000005b8ac2 net_setup_anon_listener - 0x00000000005b8c44 net_accept - 0x00000000005b8f88 net_conn_to_listener - 0x00000000005b91fa net_recv - 0x00000000005b9516 net_send - 0x00000000005b96a4 net_send_w - 0x00000000005b987d net_send2 - 0x00000000005b9a08 p4_socket_stat - 0x00000000005b9ac8 p4_timein_hostbyname - 0x00000000005b9af1 gethostbyname_p4 - 0x00000000005b9c46 gethostname_p4 - 0x00000000005b9c65 get_inet_addr - 0x00000000005b9cb0 get_inet_addr_str - 0x00000000005b9cdb p4_print_sock_params - 0x00000000005b9ef8 dump_sockaddr - 0x00000000005b9faa dump_sockinfo - 0x00000000005ba020 mpiexec_reopen_stdin - 0x00000000005ba1b2 p4_make_socket_nonblocking - *fill* 0x00000000005ba1fb 0x1 90909090 - .text 0x00000000005ba1fc 0x154d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0x00000000005ba1fc create_remote_processes - 0x00000000005ba3ed net_slave_info - 0x00000000005ba894 p4_accept_timeout - 0x00000000005ba91f p4_accept_sigchild - 0x00000000005ba9b0 net_create_slave - *fill* 0x00000000005bb749 0x3 90909090 - .text 0x00000000005bb74c 0xa5a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0x00000000005bb74c p4_has_timedout - 0x00000000005bb7ac p4_establish_all_conns - 0x00000000005bb837 establish_connection - 0x00000000005bb917 request_connection - 0x00000000005bbce4 handle_connection_interrupt - *fill* 0x00000000005bc1a6 0x2 90909090 - .text 0x00000000005bc1a8 0x1860 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x00000000005bc1a8 xdr_send - 0x00000000005bc522 socket_send - 0x00000000005bc6c9 socket_close_conn - 0x00000000005bc7a4 socket_recv - 0x00000000005bcae2 socket_recv_on_fd - 0x00000000005bcd26 socket_msgs_available - 0x00000000005bcdd9 sock_msg_avail_on_fd - 0x00000000005bcf6e xdr_recv - 0x00000000005bd1ce wait_for_ack - 0x00000000005bd25a send_ack - 0x00000000005bd2ef shutdown_p4_socks - 0x00000000005bd3a7 p4_sockets_ready - 0x00000000005bd789 p4_look_for_close - 0x00000000005bd84d p4_wait_for_socket_msg - .text 0x00000000005bda08 0xd41 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x00000000005bda08 listener - 0x00000000005be4bd net_recv_timeout - *fill* 0x00000000005be749 0x3 90909090 - .text 0x00000000005be74c 0xc02 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x00000000005be74c start_slave - 0x00000000005bf2bc getpw_ss - *fill* 0x00000000005bf34e 0x2 90909090 - .text 0x00000000005bf350 0xb0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x00000000005bf350 usc_init - 0x00000000005bf3ac usc_MD_clock - .text 0x00000000005bf400 0x7fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0x00000000005bf400 MPID_RecvContig - 0x00000000005bf4cd MPID_IrecvContig - 0x00000000005bf7a3 MPID_RecvIcomplete - 0x00000000005bf9bc MPID_RecvComplete - 0x00000000005bfbe8 MPID_Status_set_bytes - *fill* 0x00000000005bfbfe 0x2 90909090 - .text 0x00000000005bfc00 0x68d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0x00000000005bfc00 MPID_SendContig - 0x00000000005bfd40 MPID_IsendContig - 0x00000000005bfe9b MPID_BsendContig - 0x00000000005bffa4 MPID_SendIcomplete - 0x00000000005c00a6 MPID_SendComplete - *fill* 0x00000000005c028d 0x3 90909090 - .text 0x00000000005c0290 0xa4b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x00000000005c0290 MPID_Init - 0x00000000005c05ca MPID_Abort - 0x00000000005c0781 MPID_End - 0x00000000005c0877 MPID_DeviceCheck - 0x00000000005c0ac4 MPID_Complete_pending - 0x00000000005c0c3c MPID_SetPktSize - 0x00000000005c0c4e MPID_WaitForCompleteSend - 0x00000000005c0c78 MPID_WaitForCompleteRecv - 0x00000000005c0ca2 MPID_Version_name - *fill* 0x00000000005c0cdb 0x1 90909090 - .text 0x00000000005c0cdc 0x47b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x00000000005c0cdc MPID_Iprobe - 0x00000000005c0f6e MPID_Probe - *fill* 0x00000000005c1157 0x1 90909090 - .text 0x00000000005c1158 0x349 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x00000000005c1158 MPID_SendDatatype - 0x00000000005c12d4 MPID_IsendDatatype - *fill* 0x00000000005c14a1 0x3 90909090 - .text 0x00000000005c14a4 0x4df /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x00000000005c14a4 MPID_RecvDatatype - 0x00000000005c1573 MPID_IrecvDatatype - *fill* 0x00000000005c1983 0x1 90909090 - .text 0x00000000005c1984 0x50d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0x00000000005c1984 MPID_Msg_rep - 0x00000000005c1b46 MPID_Msg_act - 0x00000000005c1c38 MPID_Pack_size - 0x00000000005c1cba MPID_Pack - 0x00000000005c1dd7 MPID_Unpack - *fill* 0x00000000005c1e91 0x3 90909090 - .text 0x00000000005c1e94 0x2fe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x00000000005c1e94 MPID_PackMessage - 0x00000000005c1f82 MPID_PackMessageFree - 0x00000000005c1fca MPID_UnpackMessageSetup - 0x00000000005c204d MPID_UnpackMessageComplete - *fill* 0x00000000005c2192 0x2 90909090 - .text 0x00000000005c2194 0x33a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x00000000005c2194 MPID_SsendDatatype - 0x00000000005c2310 MPID_IssendDatatype - *fill* 0x00000000005c24ce 0x2 90909090 - .text 0x00000000005c24d0 0x1360 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x00000000005c24d0 MPID_BSwap_N_inplace - 0x00000000005c25e3 MPID_BSwap_N_copy - 0x00000000005c2652 MPID_Type_swap_copy - 0x00000000005c27f3 MPID_Type_swap_inplace - 0x00000000005c2906 MPID_Mem_convert_len - 0x00000000005c2944 MPID_Mem_XDR_Len - 0x00000000005c2965 MPID_Mem_XDR_Init - 0x00000000005c2990 MPID_Mem_XDR_Free - 0x00000000005c29c1 MPID_Mem_XDR_Encode - 0x00000000005c2a8e MPID_Mem_XDR_ByteEncode - 0x00000000005c2b39 MPID_Mem_XDR_Encode_Logical - 0x00000000005c2c20 MPID_Mem_XDR_Decode - 0x00000000005c2d2b MPID_Mem_XDR_ByteDecode - 0x00000000005c2df2 MPID_Mem_XDR_Decode_Logical - 0x00000000005c2f25 MPID_Type_XDR_encode - 0x00000000005c3265 MPID_Type_XDR_decode - .text 0x00000000005c3830 0xa13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x00000000005c3830 MPID_Rndv_print_pkt - 0x00000000005c395d MPID_Cancel_print_pkt - 0x00000000005c3a02 MPID_Print_packet - 0x00000000005c3c7c MPID_Get_print_pkt - 0x00000000005c3c8a MPID_Print_mode - 0x00000000005c3def MPID_Print_pkt_data - 0x00000000005c3e97 MPID_Print_Send_Handle - 0x00000000005c3ed4 MPID_SetDebugFile - 0x00000000005c3fca MPID_Set_tracefile - 0x00000000005c40c0 MPID_SetSpaceDebugFlag - 0x00000000005c40c9 MPID_SetDebugFlag - 0x00000000005c40e4 MPID_SetMsgDebugFlag - 0x00000000005c40f6 MPID_GetMsgDebugFlag - 0x00000000005c4102 MPID_PrintMsgDebug - 0x00000000005c4108 MPID_Print_rhandle - 0x00000000005c4154 MPID_Print_shandle - 0x00000000005c41b0 MPID_Print_Short_data - *fill* 0x00000000005c4243 0x1 90909090 - .text 0x00000000005c4244 0x3e6 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x00000000005c4244 MPID_CH_InitMsgPass - 0x00000000005c4428 MPID_CH_Abort - 0x00000000005c44ac MPID_CH_End - 0x00000000005c45f1 MPID_CH_Version_name - *fill* 0x00000000005c462a 0x2 90909090 - .text 0x00000000005c462c 0xb2f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x00000000005c462c MPID_CH_Init_hetero - 0x00000000005c4df7 MPID_CH_Comm_msgrep - 0x00000000005c4ed6 MPID_CH_Pkt_pack - 0x00000000005c4fb6 MPID_CH_Pkt_unpack - 0x00000000005c5077 MPID_CH_Hetero_free - 0x00000000005c509a MPID_GetByteOrder - 0x00000000005c50d3 MPID_ByteSwapInt - *fill* 0x00000000005c515b 0x1 90909090 - .text 0x00000000005c515c 0x4fa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x00000000005c515c MPID_P4_Init - 0x00000000005c561b MPID_P4_End - *fill* 0x00000000005c5656 0x2 90909090 - .text 0x00000000005c5658 0x90f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x00000000005c5658 MPID_Dump_queues - 0x00000000005c5668 MPID_Dump_queue - 0x00000000005c59d4 MPID_Dequeue - 0x00000000005c5b6f MPID_Search_unexpected_for_request - 0x00000000005c5c53 MPID_Search_unexpected_queue - 0x00000000005c5d76 MPID_Msg_arrived - 0x00000000005c5ebf MPID_Search_unexpected_queue_and_post - 0x00000000005c5f1a MPID_InitQueue - *fill* 0x00000000005c5f67 0x1 90909090 - .text 0x00000000005c5f68 0xa18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x00000000005c5f68 MPID_GetIntParameter - 0x00000000005c5fa4 MPID_ArgSqueeze - 0x00000000005c6051 MPID_ProcessArgs - .text 0x00000000005c6980 0x4f2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x00000000005c6980 MPID_SBinit - 0x00000000005c6a38 MPID_SBfree - 0x00000000005c6a83 MPID_SBiAllocate - 0x00000000005c6b8f MPID_SBalloc - 0x00000000005c6c24 MPID_SBPrealloc - 0x00000000005c6c61 MPID_SBdestroy - 0x00000000005c6ca8 MPID_SBrelease - 0x00000000005c6d25 MPID_SBFlush - 0x00000000005c6db6 MPID_SBDump - 0x00000000005c6e12 MPID_SBReleaseAvail - *fill* 0x00000000005c6e72 0x2 90909090 - .text 0x00000000005c6e74 0x79 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x00000000005c6e74 MPID_Process_group_init - *fill* 0x00000000005c6eed 0x3 90909090 - .text 0x00000000005c6ef0 0x954 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x00000000005c6ef0 MPID_PacketFlowSetup - 0x00000000005c6f8e MPID_SendProtoAck - 0x00000000005c7194 MPID_RecvProtoAck - 0x00000000005c75c4 MPID_FinishRecvPackets - 0x00000000005c7826 MPID_PackDelete - .text 0x00000000005c7844 0x809 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x00000000005c7844 MPID_SendCancelPacket - 0x00000000005c7a29 MPID_SendCancelOkPacket - 0x00000000005c7ccb MPID_RecvCancelOkPacket - 0x00000000005c7eb9 MPID_FinishCancelPackets - *fill* 0x00000000005c804d 0x3 90909090 - .text 0x00000000005c8050 0x92 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x00000000005c8050 MPI_Wait - 0x00000000005c8050 PMPI_Wait - *fill* 0x00000000005c80e2 0x2 90909090 - .text 0x00000000005c80e4 0x1f5 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x00000000005c80e4 PMPI_Cancel - 0x00000000005c80e4 MPI_Cancel - *fill* 0x00000000005c82d9 0x3 90909090 - .text 0x00000000005c82dc 0x232 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x00000000005c82dc PMPI_Sendrecv - 0x00000000005c82dc MPI_Sendrecv - *fill* 0x00000000005c850e 0x2 90909090 - .text 0x00000000005c8510 0xd2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x00000000005c8510 MPI_Type_extent - 0x00000000005c8510 PMPI_Type_extent - *fill* 0x00000000005c85e2 0x2 90909090 - .text 0x00000000005c85e4 0x187 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x00000000005c85e4 MPI_Type_free - 0x00000000005c85e4 PMPI_Type_free - *fill* 0x00000000005c876b 0x1 90909090 - .text 0x00000000005c876c 0x84c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x00000000005c876c MPI_Type_hindexed - 0x00000000005c876c PMPI_Type_hindexed - .text 0x00000000005c8fb8 0x10d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x00000000005c8fb8 PMPI_Type_lb - 0x00000000005c8fb8 MPI_Type_lb - *fill* 0x00000000005c90c5 0x3 90909090 - .text 0x00000000005c90c8 0x10b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x00000000005c90c8 PMPI_Type_size - 0x00000000005c90c8 MPI_Type_size - *fill* 0x00000000005c91d3 0x1 90909090 - .text 0x00000000005c91d4 0xbaf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x00000000005c91d4 PMPI_Type_struct - 0x00000000005c91d4 MPI_Type_struct - *fill* 0x00000000005c9d83 0x1 90909090 - .text 0x00000000005c9d84 0x229 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x00000000005c9d84 MPI_Pack_size - 0x00000000005c9d84 PMPI_Pack_size - *fill* 0x00000000005c9fad 0x3 90909090 - .text 0x00000000005c9fb0 0x339 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x00000000005c9fb0 PMPI_Pack - 0x00000000005c9fb0 MPI_Pack - *fill* 0x00000000005ca2e9 0x3 90909090 - .text 0x00000000005ca2ec 0x30f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x00000000005ca2ec PMPI_Unpack - 0x00000000005ca2ec MPI_Unpack - *fill* 0x00000000005ca5fb 0x1 90909090 - .text 0x00000000005ca5fc 0xd1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x00000000005ca5fc MPIR_Breakpoint - *fill* 0x00000000005ca6cd 0x3 90909090 - .text 0x00000000005ca6d0 0x198 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x00000000005ca6d0 PMPI_Errhandler_set - 0x00000000005ca6d0 MPI_Errhandler_set - .text 0x00000000005ca868 0xf9f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x00000000005ca868 MPIR_Unpack - 0x00000000005ca93d MPIR_Pack2 - 0x00000000005cae7e MPIR_Unpack2 - 0x00000000005cb406 MPIR_Elementcnt - 0x00000000005cb4c0 MPIR_Printcontig - 0x00000000005cb529 MPIR_Printcontig2 - 0x00000000005cb595 MPIR_Printcontig2a - 0x00000000005cb615 MPIR_PrintDatatypePack - 0x00000000005cb6f9 MPIR_PrintDatatypeUnpack - *fill* 0x00000000005cb807 0x1 90909090 - .text 0x00000000005cb808 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x00000000005cb808 PMPI_Keyval_create - 0x00000000005cb808 MPI_Keyval_create - *fill* 0x00000000005cb847 0x1 90909090 - .text 0x00000000005cb848 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .text 0x00000000005cb848 0xc35 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x00000000005cb848 MD_initmem - 0x00000000005cb851 MD_initenv - 0x00000000005cb85c MD_malloc_hint - 0x00000000005cb868 MD_shmalloc - 0x00000000005cb888 MD_shfree - 0x00000000005cb89f MD_set_reference_time - 0x00000000005cb8c8 MD_clock - 0x00000000005cb942 data_representation - *fill* 0x00000000005cc47d 0x3 90909090 - .text 0x00000000005cc480 0xb3c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x00000000005cc480 p4_soft_errors - 0x00000000005cc4c5 p4_error - 0x00000000005cc868 trap_sig_errs - 0x00000000005ccfaa p4_set_hard_errors - .text 0x00000000005ccfbc 0xf51 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x00000000005ccfbc process_args - *fill* 0x00000000005cdf0d 0x3 90909090 - .text 0x00000000005cdf10 0xb00 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x00000000005cdf10 alloc_local_bm - 0x00000000005ce039 alloc_local_rm - 0x00000000005ce154 alloc_local_listener - 0x00000000005ce1cb alloc_local_slave - 0x00000000005ce2cc p4_set_avail_buff - 0x00000000005ce318 init_avail_buffs - 0x00000000005ce37a p4_print_avail_buffs - 0x00000000005ce413 alloc_p4_msg - 0x00000000005ce5d6 free_p4_msg - 0x00000000005ce755 free_avail_buffs - 0x00000000005ce7d7 alloc_global - 0x00000000005ce958 alloc_listener_info - .text 0x00000000005cea10 0x7cb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x00000000005cea10 p4_get_dbg_level - 0x00000000005cea1c p4_set_dbg_level - 0x00000000005cea2e p4_dprintf - 0x00000000005ceb7b p4_dprint_last - 0x00000000005ceb85 p4_dprintfl - 0x00000000005cece9 dump_global - 0x00000000005cee18 dump_local - 0x00000000005cef20 print_conn_type - 0x00000000005cefbd dump_listener - 0x00000000005cf00f dump_procgroup - 0x00000000005cf0b7 dump_tmsg - 0x00000000005cf10f dump_conntab - *fill* 0x00000000005cf1db 0x1 90909090 - .text 0x00000000005cf1dc 0x5a7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x00000000005cf1dc p4_alloc_procgroup - 0x00000000005cf235 read_procgroup - 0x00000000005cf5e6 install_in_proctable - *fill* 0x00000000005cf783 0x1 90909090 - .text 0x00000000005cf784 0xcac /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x00000000005cf784 search_p4_queue - 0x00000000005cf9ff p4_recv - 0x00000000005cfc52 recv_message - 0x00000000005cfc8e p4_any_messages_available - 0x00000000005cfd47 p4_messages_available - 0x00000000005cfe94 queue_p4_message - 0x00000000005cfefd send_message - 0x00000000005d0120 get_tmsg - 0x00000000005d01e1 p4_msg_alloc - 0x00000000005d020e p4_msg_free - 0x00000000005d023c initialize_msg_queue - 0x00000000005d0270 alloc_quel - 0x00000000005d0323 free_quel - 0x00000000005d0371 free_avail_quels - 0x00000000005d03cb p4_yield - 0x00000000005d03d6 p4_waitformsg - .text 0x00000000005d0430 0x512 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x00000000005d0430 p4_moninit - 0x00000000005d04d7 p4_menter - 0x00000000005d04e1 p4_mexit - 0x00000000005d04eb p4_mdelay - 0x00000000005d0520 p4_mcontinue - 0x00000000005d055f num_in_mon_queue - 0x00000000005d058b p4_getsub_init - 0x00000000005d05b2 p4_getsubs - 0x00000000005d065b p4_barrier_init - 0x00000000005d0677 p4_barrier - 0x00000000005d06c7 p4_askfor_init - 0x00000000005d06f9 p4_askfor - 0x00000000005d0848 p4_update - 0x00000000005d088e p4_probend - 0x00000000005d08bb p4_progend - 0x00000000005d08eb p4_create - *fill* 0x00000000005d0942 0x2 90909090 - .text 0x00000000005d0944 0x124b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x00000000005d0944 p4_broadcastx - 0x00000000005d09f2 subtree_broadcast_p4 - 0x00000000005d0e61 p4_global_op - 0x00000000005d10f7 p4_dbl_sum_op - 0x00000000005d1146 p4_dbl_mult_op - 0x00000000005d1195 p4_dbl_max_op - 0x00000000005d1201 p4_dbl_min_op - 0x00000000005d126d p4_dbl_absmax_op - 0x00000000005d13e4 p4_dbl_absmin_op - 0x00000000005d155b p4_flt_sum_op - 0x00000000005d15aa p4_flt_mult_op - 0x00000000005d15f9 p4_flt_max_op - 0x00000000005d1664 p4_flt_min_op - 0x00000000005d16cf p4_flt_absmax_op - 0x00000000005d1835 p4_flt_absmin_op - 0x00000000005d199b p4_int_sum_op - 0x00000000005d19e3 p4_int_mult_op - 0x00000000005d1a2b p4_int_max_op - 0x00000000005d1a79 p4_int_min_op - 0x00000000005d1ac7 p4_int_absmax_op - 0x00000000005d1b2b p4_int_absmin_op - *fill* 0x00000000005d1b8f 0x1 90909090 - .text 0x00000000005d1b90 0x12e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x00000000005d1b90 MPID_SsendContig - 0x00000000005d1c22 MPID_IssendContig - *fill* 0x00000000005d1cbe 0x2 90909090 - .text 0x00000000005d1cc0 0x365 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x00000000005d1cc0 MPID_SendCancel - 0x00000000005d1edf MPID_RecvCancel - *fill* 0x00000000005d2025 0x3 90909090 - .text 0x00000000005d2028 0x169b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x00000000005d2028 MPID_CH_Eagerb_send - 0x00000000005d2536 MPID_CH_Eagerb_recv - 0x00000000005d2812 MPID_CH_Eagerb_unxrecv_start - 0x00000000005d2a3b MPID_CH_Eagerb_save - 0x00000000005d2d67 MPID_CH_Eagerb_isend - 0x00000000005d32b6 MPID_CH_Eagerb_cancel_send - 0x00000000005d32c5 MPID_CH_Eagerb_irecv - 0x00000000005d35d9 MPID_CH_Eagerb_delete - 0x00000000005d35f0 MPID_CH_Eagerb_setup - *fill* 0x00000000005d36c3 0x1 90909090 - .text 0x00000000005d36c4 0x2169 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x00000000005d36c4 MPID_CH_Rndvb_isend - 0x00000000005d3b2f MPID_CH_Rndvb_send - 0x00000000005d3c51 MPID_CH_Rndvb_irecv - 0x00000000005d4346 MPID_CH_Rndvb_save - 0x00000000005d4564 MPID_CH_Rndvb_ok_to_send - 0x00000000005d4716 MPID_CH_Rndvb_unxrecv_start - 0x00000000005d49ec MPID_CH_Rndvb_unxrecv_end - 0x00000000005d4d29 MPID_CH_Rndvb_unxrecv_test_end - 0x00000000005d4fa1 MPID_CH_Rndvb_ack - 0x00000000005d53af MPID_CH_Rndvb_save_self - 0x00000000005d54bf MPID_CH_Rndvb_unxrecv_start_self - 0x00000000005d5743 MPID_CH_Rndvb_delete - 0x00000000005d575a MPID_CH_Rndvb_setup - *fill* 0x00000000005d582d 0x3 90909090 - .text 0x00000000005d5830 0xbe2 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x00000000005d5830 MPID_CH_Check_incoming - *fill* 0x00000000005d6412 0x2 90909090 - .text 0x00000000005d6414 0x160b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0x00000000005d6414 MPID_CH_Eagerb_send_short - 0x00000000005d6ad1 MPID_CH_Eagerb_isend_short - 0x00000000005d71b6 MPID_CH_Eagerb_recv_short - 0x00000000005d7455 MPID_CH_Eagerb_unxrecv_start_short - 0x00000000005d767e MPID_CH_Eagerb_save_short - 0x00000000005d7935 MPID_CH_Eagerb_short_delete - 0x00000000005d794c MPID_CH_Short_setup - *fill* 0x00000000005d7a1f 0x1 90909090 - .text 0x00000000005d7a20 0x427 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x00000000005d7a20 MPID_FlowDebug - 0x00000000005d7a32 MPID_SendFlowPacket - 0x00000000005d7b87 MPID_RecvFlowPacket - 0x00000000005d7bf4 MPID_FlowSetup - 0x00000000005d7ce8 MPID_FlowDelete - 0x00000000005d7cfa MPID_FlowDump - *fill* 0x00000000005d7e47 0x1 90909090 - .text 0x00000000005d7e48 0x491 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x00000000005d7e48 MPIR_Pack_Hvector - 0x00000000005d808f MPIR_UnPack_Hvector - 0x00000000005d82c1 MPIR_HvectorLen - *fill* 0x00000000005d82d9 0x7 90909090 - .text 0x00000000005d82e0 0x1ea9 xdrf_em64/libxdrf.a(libxdrf.o) - 0x00000000005d82e0 xdrfsetpos_ - 0x00000000005d82fc xdrf_ - 0x00000000005d8316 xdrfvector_ - 0x00000000005d8737 xdrfint_ - 0x00000000005d8756 xdrffloat_ - 0x00000000005d8775 xdrfopaque_ - 0x00000000005d894a xdr3dfcoord - 0x00000000005d9c40 xdrf3dfcoord_ - 0x00000000005d9c58 xdrclose - 0x00000000005d9cfa xdrfclose_ - 0x00000000005d9d1c xdropen - 0x00000000005d9e52 xdrfopen_ - 0x00000000005d9efc xdrfwrapstring_ - 0x00000000005d9fc2 xdrfstring_ - 0x00000000005da093 xdrfushort_ - 0x00000000005da0b2 xdrfulong_ - 0x00000000005da0d1 xdrfuchar_ - 0x00000000005da0ef xdrfshort_ - 0x00000000005da10e xdrflong_ - 0x00000000005da12d xdrfdouble_ - 0x00000000005da14c xdrfchar_ - 0x00000000005da16a xdrfbool_ - *fill* 0x00000000005da189 0x3 90909090 - .text 0x00000000005da18c 0x9d xdrf_em64/libxdrf.a(ftocstr.o) - 0x00000000005da18c ftocstr - 0x00000000005da1ef ctofstr - *fill* 0x00000000005da229 0x7 90909090 - .text 0x00000000005da230 0x430 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0x00000000005da230 etime_ - 0x00000000005da300 dtime_ - 0x00000000005da4c0 dtimer8_ - .text 0x00000000005da660 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x00000000005da660 fdate_ - .text 0x00000000005da700 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x00000000005da700 flush_ - .text 0x00000000005da710 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x00000000005da710 getenv_ - .text 0x00000000005da890 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x00000000005da890 system_ - .text 0x00000000005da8d0 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x00000000005da8d0 allocCstr - 0x00000000005da980 deallocCstr - .text 0x00000000005da990 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x00000000005da990 CstrToFstr - .text 0x00000000005daae0 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x00000000005daae0 for_close - 0x00000000005db150 for__close_args - 0x00000000005db280 for__close_default - .text 0x00000000005db430 0x740 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x00000000005db430 for__close_proc - .text 0x00000000005dbb70 0xc90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000005dbb70 for__desc_ret_item - 0x00000000005dbea0 for__key_desc_ret_item - 0x00000000005dc1c0 for__desc_test_item - 0x00000000005dc440 for__desc_zero_length_item - .text 0x00000000005dc800 0x3550 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x00000000005dc800 for__io_return - 0x00000000005dd340 for__issue_diagnostic - 0x00000000005dda10 for__get_msg - 0x00000000005ddc10 for_emit_diagnostic - 0x00000000005ddd90 for__message_catalog_close - 0x00000000005de130 for_errmsg - 0x00000000005de310 for__rtc_uninit_use - 0x00000000005de330 TRACEBACKQQ - 0x00000000005de550 tracebackqq_ - 0x00000000005de780 for_perror_ - 0x00000000005df460 for_gerror_ - .text 0x00000000005dfd50 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0x00000000005dfd50 for_errsns_load - 0x00000000005dfd90 for_errsns_w - 0x00000000005dfe80 for_errsns - .text 0x00000000005dff70 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x00000000005dff70 for__fpe_exit_handler - 0x00000000005e0050 for__exit_handler - .text 0x00000000005e0250 0x610 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x00000000005e0250 for_nargs - 0x00000000005e0260 for_iargc - 0x00000000005e0280 for_getarg - 0x00000000005e03c0 for_getarg_i2 - 0x00000000005e0500 nargs_ - 0x00000000005e0510 iargc_ - 0x00000000005e0530 iarg_ - 0x00000000005e0550 numarg_ - 0x00000000005e0570 getarg_ - 0x00000000005e0670 for_getcmd_arg - .text 0x00000000005e0860 0x2310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x00000000005e0860 for_setup_mxcsr - 0x00000000005e0920 for__signal_handler - 0x00000000005e1710 for_enable_underflow - 0x00000000005e1730 for_get_fpe_ - 0x00000000005e1740 for_set_fpe_ - 0x00000000005e19f0 for_get_fpe_counts_ - 0x00000000005e1a40 for_rtl_finish_ - 0x00000000005e1a60 dump_dfil_exception_info - 0x00000000005e2940 for_rtl_init_ - .text 0x00000000005e2b70 0x5eb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x00000000005e2b70 for_inquire - .text 0x00000000005e8a20 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x00000000005e8a20 for__adjust_buffer - 0x00000000005e8cb0 for__lower_bound_index - 0x00000000005e8d00 for__cvt_foreign_read - 0x00000000005e8ec0 for__cvt_foreign_write - 0x00000000005e92f0 for__cvt_foreign_check - 0x00000000005e9380 for_check_env_name - .text 0x00000000005e9450 0x1ea0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x00000000005e9450 for__create_lub - 0x00000000005e95d0 for__release_lun - 0x00000000005e9910 for__deallocate_lub - 0x00000000005e9960 for__acquire_lun - 0x00000000005ea890 for__get_next_lub - 0x00000000005eae60 for__preconnected_units_create - 0x00000000005eb0b0 for__default_io_sizes_env_init - .text 0x00000000005eb2f0 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x00000000005eb2f0 for__add_to_lf_table - 0x00000000005eb5c0 for__rm_from_lf_table - .text 0x00000000005eb650 0x5960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x00000000005eb650 SetEndian - 0x00000000005eb9b0 CheckStreamRecortType - 0x00000000005ebdf0 CheckEndian - 0x00000000005ec1a0 for_open - 0x00000000005ed690 for__update_reopen_keywords - 0x00000000005ee890 for__set_foreign_bits - 0x00000000005ef840 for__open_key - 0x00000000005efaf0 for__open_args - 0x00000000005f0220 for__find_iomsg - 0x00000000005f02d0 for__set_terminator_option - 0x00000000005f0710 for__set_conversion_option - 0x00000000005f0a20 for__is_special_device - 0x00000000005f0bd0 for__open_default - .text 0x00000000005f0fb0 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x00000000005f0fb0 for_pause - .text 0x00000000005f12d0 0x2090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x00000000005f12d0 for__put_su - 0x00000000005f1990 for__write_output - 0x00000000005f1ce0 for__put_sf - 0x00000000005f2ef0 for__put_d - 0x00000000005f3220 for__flush_readahead - .text 0x00000000005f3360 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x00000000005f3360 for_set_reentrancy - 0x00000000005f33b0 for__reentrancy_cleanup - 0x00000000005f3410 for__disable_asynch_deliv_private - 0x00000000005f3430 for__enable_asynch_deliv_private - 0x00000000005f3450 for__once_private - 0x00000000005f34b0 for__reentrancy_init - .text 0x00000000005f3640 0x1350 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x00000000005f3640 for_rewind - .text 0x00000000005f4990 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x00000000005f4990 for_read_int_fmt - 0x00000000005f6060 for_read_int_fmt_xmit - .text 0x00000000005f7c90 0x4000 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x00000000005f7c90 for_read_int_lis - 0x00000000005f91b0 for_read_int_lis_xmit - 0x00000000005fb950 for_ri_cvt_2step - .text 0x00000000005fbc90 0x4010 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x00000000005fbc90 for_read_seq - 0x00000000005fdd00 for_read_seq_xmit - .text 0x00000000005ffca0 0x40f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x00000000005ffca0 for_read_seq_fmt - 0x0000000000601c00 for_read_seq_fmt_xmit - 0x0000000000603b90 for__read_args - .text 0x0000000000603d90 0x5250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x0000000000603d90 for_read_seq_lis - 0x00000000006059e0 for_read_seq_lis_xmit - 0x0000000000608da0 for__swallow_imaginary_part - .text 0x0000000000608fe0 0x1f40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x0000000000608fe0 for_abort - 0x00000000006099d0 for_stop_core - 0x000000000060a5b0 for_stop - .text 0x000000000060af20 0xdc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x000000000060af20 for__set_signal_ops_during_vm - 0x000000000060af50 for__get_vm - 0x000000000060b060 for__realloc_vm - 0x000000000060b150 for__free_vm - 0x000000000060b1c0 for_allocate - 0x000000000060b430 for_alloc_allocatable - 0x000000000060b6b0 for_deallocate - 0x000000000060b810 for_dealloc_allocatable - 0x000000000060b9a0 for_check_mult_overflow - 0x000000000060bac0 for_check_mult_overflow64 - 0x000000000060bc80 for__spec_align_alloc - 0x000000000060bcd0 for__spec_align_free - .text 0x000000000060bce0 0x33e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x000000000060bce0 for_write_int_fmt - 0x000000000060d3f0 for_write_int_fmt_xmit - .text 0x000000000060f0c0 0x7c30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x000000000060f0c0 for_write_seq - 0x0000000000611020 for_write_seq_xmit - 0x0000000000616820 for__finish_ufseq_write - .text 0x0000000000616cf0 0x4940 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x0000000000616cf0 for_write_seq_fmt - 0x0000000000618ea0 for_write_seq_fmt_xmit - 0x000000000061b4b0 for__write_args - .text 0x000000000061b630 0x6b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x000000000061b630 for_write_seq_lis - 0x000000000061d680 for_write_seq_lis_xmit - .text 0x00000000006221a0 0x330 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x00000000006221a0 for_index_back - 0x0000000000622330 for_f90_index - .text 0x00000000006224d0 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x00000000006224d0 for_fp_class_s_ - 0x0000000000622590 for_is_nan_s_ - 0x00000000006225c0 for_fp_class_t_ - 0x0000000000622680 for_is_nan_t_ - 0x00000000006226c0 for_fp_class_x_ - 0x0000000000622790 for_is_nan_x_ - .text 0x00000000006227d0 0xf90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x00000000006227d0 for_cpystr - 0x0000000000622860 for_cpstr_gt - 0x0000000000622a70 for_cpstr_lt - 0x0000000000622c80 for_cpstr_eq - 0x0000000000622e00 for_cpstr_ne - 0x0000000000622f90 for_cpstr_ge - 0x00000000006231a0 for_cpstr_le - 0x00000000006233b0 for_cpstr - 0x0000000000623570 for_concat - .text 0x0000000000623760 0x2190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x0000000000623760 __msportlib_d_gethandle - 0x00000000006239e0 __msportlib_set_posix_io_flag - 0x00000000006239f0 __msportlib_d_curpos - 0x0000000000623ae0 __msportlib_d_curpos_i8 - 0x0000000000623bc0 __msportlib_d_fseek - 0x0000000000623d70 __msportlib_d_fseek_i8 - 0x0000000000623f60 __msportlib_d_readchar - 0x0000000000624550 __msportlib_d_writechar - 0x0000000000625480 commitqq_ - 0x0000000000625550 flushqq_ - 0x00000000006255e0 set_keypress - 0x0000000000625670 reset_keypress - 0x0000000000625690 getstrqq_ - 0x0000000000625760 getcharqq_ - 0x00000000006257f0 peekcharqq_ - .text 0x00000000006258f0 0x360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x00000000006258f0 r_int - 0x0000000000625910 r_int_val - 0x0000000000625920 d_int - 0x0000000000625940 d_int_val - 0x0000000000625950 h_nint - 0x0000000000625970 i_nint - 0x0000000000625990 k_nint - 0x00000000006259b0 r_nint - 0x0000000000625a30 f_lanint_val - 0x0000000000625ab0 b_nint - 0x0000000000625ad0 i_dnnt - 0x0000000000625af0 h_dnnt - 0x0000000000625b10 b_dnnt - 0x0000000000625b30 k_dnnt - 0x0000000000625b50 d_nint - 0x0000000000625bd0 f_ldnint_val - .text 0x0000000000625c50 0x1400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x0000000000626e30 tbk_stack_trace - .text 0x0000000000627050 0x5540 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x0000000000627050 for__aio_acquire_lun_fname - 0x0000000000627350 for__aio_release_lun - 0x0000000000627870 for__aio_release - 0x0000000000627bd0 for__aio_acquire_lun - 0x0000000000628400 for__aio_destroy - 0x0000000000628840 for_asynchronous - 0x0000000000629580 for_waitid - 0x000000000062aa10 for_wait - 0x000000000062bc20 for__aio_error_handling - 0x000000000062c3e0 for__aio_init - .text 0x000000000062c590 0x63b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x000000000062c590 for__compute_filename - 0x000000000062dfd0 for__open_proc - 0x0000000000631c60 for__reopen_file - 0x0000000000632930 for__decl_exit_hand - .text 0x0000000000632940 0xa0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x0000000000632940 for__aio_pthread_self - 0x0000000000632950 for__aio_pthread_create - 0x0000000000632970 for__aio_pthread_cancel - 0x0000000000632980 for__aio_pthread_mutex_lock - 0x0000000000632990 for__aio_pthread_mutex_unlock - 0x00000000006329a0 for__aio_pthread_cond_wait - 0x00000000006329b0 for__aio_pthread_cond_signal - 0x00000000006329c0 for__aio_pthread_mutex_init - 0x00000000006329d0 for__aio_pthread_exit - .text 0x00000000006329e0 0x630 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x00000000006329e0 cvt_text_to_integer - 0x0000000000632b90 cvt_text_to_unsigned64 - 0x0000000000632e30 cvt_text_to_unsigned - 0x0000000000632e90 cvt_text_to_integer64 - .text 0x0000000000633010 0xe30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x0000000000633010 cvt_vax_f_to_ieee_single_ - 0x00000000006334c0 CVT_VAX_F_TO_IEEE_SINGLE - 0x0000000000633970 cvt_vax_f_to_ieee_single - .text 0x0000000000633e40 0x1080 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x0000000000633e40 cvt_vax_d_to_ieee_double_ - 0x00000000006343b0 CVT_VAX_D_TO_IEEE_DOUBLE - 0x0000000000634920 cvt_vax_d_to_ieee_double - .text 0x0000000000634ec0 0x1090 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x0000000000634ec0 cvt_vax_g_to_ieee_double_ - 0x0000000000635430 CVT_VAX_G_TO_IEEE_DOUBLE - 0x00000000006359a0 cvt_vax_g_to_ieee_double - .text 0x0000000000635f50 0x21a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x0000000000635f50 cvt_cray_to_ieee_single_ - 0x0000000000636480 CVT_CRAY_TO_IEEE_SINGLE - 0x00000000006369b0 cvt_cray_to_ieee_single - 0x0000000000636f20 cvt_cray_to_ieee_double_ - 0x00000000006374f0 CVT_CRAY_TO_IEEE_DOUBLE - 0x0000000000637ac0 cvt_cray_to_ieee_double - .text 0x00000000006380f0 0xf00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x00000000006380f0 cvt_ibm_short_to_ieee_single_ - 0x00000000006385e0 CVT_IBM_SHORT_TO_IEEE_SINGLE - 0x0000000000638ad0 cvt_ibm_short_to_ieee_single - .text 0x0000000000638ff0 0x11d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x0000000000638ff0 cvt_ibm_long_to_ieee_double_ - 0x00000000006395b0 CVT_IBM_LONG_TO_IEEE_DOUBLE - 0x0000000000639b70 cvt_ibm_long_to_ieee_double - .text 0x000000000063a1c0 0x4760 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0x000000000063a1c0 cvt_ieee_double_to_cray_ - 0x000000000063a6a0 CVT_IEEE_DOUBLE_TO_CRAY - 0x000000000063ab80 cvt_ieee_double_to_cray - 0x000000000063b0a0 cvt_ieee_double_to_ibm_long_ - 0x000000000063b5f0 CVT_IEEE_DOUBLE_TO_IBM_LONG - 0x000000000063bb40 cvt_ieee_double_to_ibm_long - 0x000000000063c0b0 cvt_ieee_double_to_vax_d_ - 0x000000000063c4e0 CVT_IEEE_DOUBLE_TO_VAX_D - 0x000000000063c910 cvt_ieee_double_to_vax_d - 0x000000000063cdb0 cvt_ieee_double_to_vax_g_ - 0x000000000063d1e0 CVT_IEEE_DOUBLE_TO_VAX_G - 0x000000000063d610 cvt_ieee_double_to_vax_g - 0x000000000063dab0 cvt_ieee_double_to_vax_h_ - 0x000000000063df60 CVT_IEEE_DOUBLE_TO_VAX_H - 0x000000000063e410 cvt_ieee_double_to_vax_h - .text 0x000000000063e920 0x2360 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x000000000063e920 cvt_ieee_single_to_cray_ - 0x000000000063ed40 CVT_IEEE_SINGLE_TO_CRAY - 0x000000000063f160 cvt_ieee_single_to_cray - 0x000000000063f5b0 cvt_ieee_single_to_ibm_short_ - 0x000000000063f9d0 CVT_IEEE_SINGLE_TO_IBM_SHORT - 0x000000000063fdf0 cvt_ieee_single_to_ibm_short - 0x0000000000640250 cvt_ieee_single_to_vax_f_ - 0x0000000000640590 CVT_IEEE_SINGLE_TO_VAX_F - 0x00000000006408d0 cvt_ieee_single_to_vax_f - .text 0x0000000000640c80 0x1d30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x0000000000640c80 for__common_inquire - 0x00000000006421f0 for__inquire_args - .text 0x00000000006429b0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x00000000006429b0 for_exit - .text 0x00000000006429d0 0x2dd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x00000000006429d0 for__format_compiler - .text 0x00000000006457a0 0x1660 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x00000000006457a0 for__format_value - 0x0000000000646330 for__cvt_value - .text 0x0000000000646e00 0x1840 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x0000000000646e00 for__get_s - 0x0000000000648170 for__read_input - 0x0000000000648280 for__get_d - .text 0x0000000000648640 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x0000000000648640 for_index - 0x00000000006486c0 for_string_index - 0x0000000000648740 for_index_ssll - .text 0x00000000006487c0 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x00000000006487c0 for__interp_fmt - .text 0x0000000000649640 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .text 0x0000000000649640 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .text 0x0000000000649640 0xa60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x0000000000649640 cvt_integer_to_text - 0x00000000006498f0 cvt_unsigned_to_text - 0x0000000000649b60 cvt_integer64_to_text - 0x0000000000649e20 cvt_unsigned64_to_text - .text 0x000000000064a0a0 0x8e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x000000000064a0a0 cvt_data_to_text - 0x000000000064a510 cvt_data64_to_text - .text 0x000000000064a980 0xb50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x000000000064a980 cvt_boolean_to_text - 0x000000000064ad40 cvt_boolean_to_text_ex - 0x000000000064b120 cvt_boolean64_to_text - .text 0x000000000064b4d0 0x5c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x000000000064b4d0 cvt_text_to_data - 0x000000000064b7f0 cvt_text_to_data64 - .text 0x000000000064ba90 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x000000000064ba90 cvt_text_to_boolean - 0x000000000064bbb0 cvt_text_to_boolean64 - .text 0x000000000064bce0 0x25c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x000000000064bce0 cvt_ieee_t_to_text_ex - 0x000000000064d050 cvt_ieee_t_to_text - 0x000000000064e200 cvt_text_to_ieee_t_ex - .text 0x000000000064e2a0 0x2530 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x000000000064e2a0 cvt_ieee_s_to_text_ex - 0x000000000064f5c0 cvt_ieee_s_to_text - 0x0000000000650730 cvt_text_to_ieee_s_ex - .text 0x00000000006507d0 0x14e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x00000000006507d0 cvt_ieee_x_to_text - 0x0000000000650820 cvt_ieee_x_to_text_ex - 0x0000000000651c10 cvt_text_to_ieee_x_ex - .text 0x0000000000651cb0 0x15a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x0000000000651cb0 cvtas_a_to_s - .text 0x0000000000653250 0x2f00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x0000000000653250 cvtas_a_to_t - .text 0x0000000000656150 0x5bb0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x0000000000656150 cvtas_s_to_a - .text 0x000000000065bd00 0x5d00 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0x000000000065bd00 cvtas_t_to_a - .text 0x0000000000661a00 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x0000000000661a00 cvtas_string_to_nan_s - .text 0x0000000000661a80 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x0000000000661a80 cvtas_string_to_nan_t - .text 0x0000000000661af0 0x5ed0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x0000000000661af0 cvtas_a_to_x - .text 0x00000000006679c0 0x5f80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0x00000000006679c0 cvtas_x_to_a - .text 0x000000000066d940 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x000000000066d940 cvtas_string_to_nan_x - .text 0x000000000066da00 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - .text 0x000000000066da00 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - .text 0x000000000066da00 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - .text 0x000000000066da00 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - .text 0x000000000066da00 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x000000000066da00 acos - .text 0x000000000066dee0 0x510 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x000000000066dee0 asin - .text 0x000000000066e3f0 0x570 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x000000000066e3f0 atan2 - .text 0x000000000066e960 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - 0x000000000066e960 cbrt - .text 0x000000000066e990 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - 0x000000000066e990 cos - .text 0x000000000066e9d0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - 0x000000000066e9d0 exp2 - .text 0x000000000066ea00 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - 0x000000000066ea00 expf - .text 0x000000000066ea30 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - 0x000000000066ea30 exp - .text 0x000000000066ea60 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - 0x000000000066ea60 fmod - .text 0x000000000066ea90 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x000000000066ea90 __powi4i4 - .text 0x000000000066eb00 0xb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x000000000066eb00 __powr8i4 - .text 0x000000000066ebb0 0x66c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x000000000066ed00 __libm_error_support - 0x0000000000675210 __libm_setusermatherrl - 0x0000000000675230 __libm_setusermatherr - 0x0000000000675250 __libm_setusermatherrf - .text 0x0000000000675270 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x0000000000675270 __libm_sse2_sincos - .text 0x00000000006755f0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - 0x00000000006755f0 llroundf - .text 0x0000000000675620 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - 0x0000000000675620 llround - .text 0x0000000000675650 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - 0x0000000000675650 log10 - .text 0x0000000000675680 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - 0x0000000000675680 logf - .text 0x00000000006756b0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - 0x00000000006756b0 log - .text 0x00000000006756e0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - 0x00000000006756e0 lroundf - .text 0x0000000000675710 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - 0x0000000000675710 lround - .text 0x0000000000675740 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x0000000000675740 matherrf - .text 0x0000000000675750 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x0000000000675750 matherrl - .text 0x0000000000675760 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x0000000000675760 matherr - .text 0x0000000000675770 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - 0x0000000000675770 pow - .text 0x00000000006757a0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - 0x00000000006757a0 sin - .text 0x00000000006757e0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x00000000006757e0 sqrt - .text 0x0000000000675830 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - 0x0000000000675830 tan - .text 0x0000000000675860 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x0000000000675860 truncf - .text 0x00000000006758c0 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - 0x00000000006758c0 trunc - .text 0x0000000000675900 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x0000000000675900 cbrt.L - .text 0x0000000000675b60 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x0000000000675b60 cbrt.A - .text 0x0000000000675d40 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x0000000000675d40 cos.L - .text 0x0000000000676380 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x0000000000676380 cos.A - .text 0x00000000006769c0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x00000000006769c0 cos.N - .text 0x0000000000677000 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x0000000000677000 exp2.L - .text 0x00000000006772f0 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0x00000000006772f0 exp2.A - .text 0x0000000000677870 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x0000000000677870 exp.L - .text 0x0000000000677b50 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x0000000000677b50 expf.L - .text 0x0000000000677d50 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x0000000000677d50 expf.A - .text 0x0000000000677f50 0x2e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x0000000000677f50 exp.A - .text 0x0000000000678230 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .text 0x0000000000678230 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x0000000000678230 fmod.L - .text 0x0000000000678750 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0x0000000000678750 fmod.A - .text 0x0000000000678910 0x500 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x0000000000678910 __libm_reduce_pio2d - .text 0x0000000000678e10 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x0000000000678e10 llround.L - .text 0x0000000000678f60 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x0000000000678f60 llroundf.L - .text 0x0000000000679070 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x0000000000679070 llroundf.A - .text 0x0000000000679150 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x0000000000679150 llround.A - .text 0x0000000000679230 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x0000000000679230 log10.L - .text 0x00000000006794e0 0x2b0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x00000000006794e0 log10.A - .text 0x0000000000679790 0x260 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x0000000000679790 log.L - .text 0x00000000006799f0 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x00000000006799f0 logf.L - .text 0x0000000000679bb0 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0x0000000000679bb0 logf.A - .text 0x0000000000679dd0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .text 0x0000000000679dd0 0x270 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x0000000000679dd0 log.A - .text 0x000000000067a040 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x000000000067a040 lround.L - .text 0x000000000067a190 0x110 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x000000000067a190 lroundf.L - .text 0x000000000067a2a0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x000000000067a2a0 lroundf.A - .text 0x000000000067a380 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x000000000067a380 lround.A - .text 0x000000000067a460 0x1010 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x000000000067a460 pow.L - .text 0x000000000067b470 0xbb0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x000000000067b470 pow.A - .text 0x000000000067c020 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .text 0x000000000067c020 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x000000000067c020 sin.L - .text 0x000000000067c670 0x660 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x000000000067c670 sin.A - .text 0x000000000067ccd0 0x650 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x000000000067ccd0 sin.N - .text 0x000000000067d320 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x000000000067d320 tan.L - .text 0x000000000067db10 0x7f0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x000000000067db10 tan.A - .text 0x000000000067e300 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x000000000067e300 trunc.L - .text 0x000000000067e360 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x000000000067e360 trunc.A - .text 0x000000000067e3f0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x000000000067e3f0 trunc.N - .text 0x000000000067e400 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x000000000067e400 vmldCos2 - 0x000000000067e410 __svml_cos2 - 0x000000000067e460 vmldCos2Mask - 0x000000000067e470 __svml_cos2_mask - .text 0x000000000067e490 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x000000000067e490 vmldSin2 - 0x000000000067e4a0 __svml_sin2 - 0x000000000067e4f0 vmldSin2Mask - 0x000000000067e500 __svml_sin2_mask - .text 0x000000000067e520 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0x000000000067e520 __svml_cos2.R - .text 0x000000000067ee80 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0x000000000067ee80 __svml_sin2.R - .text 0x000000000067f7e0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0x000000000067f7e0 __svml_cos2.N - .text 0x0000000000680140 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0x0000000000680140 __svml_sin2.N - .text 0x0000000000680aa0 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0x0000000000680aa0 __svml_cos2.L - .text 0x00000000006813f0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0x00000000006813f0 __svml_sin2.L - .text 0x0000000000681d50 0x950 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0x0000000000681d50 __svml_cos2.A - .text 0x00000000006826a0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0x00000000006826a0 __svml_sin2.A - .text 0x0000000000683000 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x0000000000683000 __qtoj - 0x00000000006831a0 __qtok - 0x00000000006832c0 __qtoi - 0x0000000000683400 __qtou - .text 0x00000000006834e0 0x7c0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x00000000006834e0 __qtod - 0x00000000006837d0 __qtol - 0x0000000000683a00 __qtof - .text 0x0000000000683ca0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x0000000000683ca0 a_divq - .text 0x0000000000683cb0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x0000000000683cb0 a_mulq - .text 0x0000000000683cc0 0x4a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x0000000000683cc0 tbk_string_stack_signal - .text 0x0000000000684160 0x1210 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x0000000000684160 tbk_getPC - 0x0000000000684170 tbk_getRetAddr - 0x0000000000684180 tbk_getFramePtr - 0x0000000000684190 tbk_getModuleName - 0x00000000006844c0 tbk_get_pc_info - 0x0000000000684f70 tbk_geterrorstring - 0x0000000000685080 tbk_trace_stack - .text 0x0000000000685370 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x0000000000685370 _intel_fast_memcmp - .text 0x00000000006854c0 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x00000000006854c0 __intel_cpu_indicator_init - .text 0x0000000000685650 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x0000000000685650 _intel_fast_memcpy.A - 0x0000000000685660 _intel_fast_memcpy.J - 0x0000000000685670 _intel_fast_memcpy - .text 0x00000000006856a0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x00000000006856a0 _intel_fast_memset.A - 0x00000000006856b0 _intel_fast_memset.J - 0x00000000006856c0 _intel_fast_memset - .text 0x00000000006856f0 0x1780 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x00000000006857e0 __intel_new_proc_init - 0x0000000000685810 __intel_new_proc_init.H - 0x00000000006858f0 __intel_new_proc_init.A - 0x0000000000685900 __intel_proc_init - 0x0000000000685930 __intel_proc_init.H - 0x00000000006859b0 __intel_proc_init.A - 0x00000000006859c0 __intel_new_proc_init_G - 0x00000000006859f0 __intel_new_proc_init_G.R - 0x0000000000685a60 __intel_new_proc_init_G.A - 0x0000000000685ae0 __intel_new_proc_init_H - 0x0000000000685b10 __intel_new_proc_init_H.P - 0x0000000000685b70 __intel_new_proc_init_H.A - 0x0000000000685bf0 __intel_new_proc_init_L - 0x0000000000685c30 __intel_new_proc_init_L.O - 0x0000000000685d00 __intel_new_proc_init_L.M - 0x0000000000685db0 __intel_new_proc_init_L.A - 0x0000000000685e30 __intel_new_proc_init_S - 0x0000000000685e60 __intel_new_proc_init_S.N - 0x0000000000685f30 __intel_new_proc_init_S.A - 0x0000000000685fb0 __intel_new_proc_init_T - 0x0000000000685fe0 __intel_new_proc_init_T.M - 0x00000000006860b0 __intel_new_proc_init_T.A - 0x0000000000686130 __intel_proc_init_T - 0x0000000000686160 __intel_proc_init_T.M - 0x0000000000686190 __intel_proc_init_T.A - 0x0000000000686210 __intel_new_proc_init_P - 0x0000000000686240 __intel_new_proc_init_P.L - 0x0000000000686310 __intel_new_proc_init_P.A - 0x0000000000686390 __intel_proc_init_P - 0x00000000006863c0 __intel_proc_init_P.L - 0x00000000006863f0 __intel_proc_init_P.A - 0x0000000000686470 __intel_new_proc_init_B - 0x00000000006864c0 __intel_new_proc_init_B.L - 0x0000000000686590 __intel_new_proc_init_B.K - 0x0000000000686660 __intel_new_proc_init_B.J - 0x0000000000686740 __intel_new_proc_init_B.A - 0x00000000006867c0 __intel_proc_init_B - 0x0000000000686810 __intel_proc_init_B.L - 0x0000000000686840 __intel_proc_init_B.K - 0x0000000000686870 __intel_proc_init_B.J - 0x00000000006868f0 __intel_proc_init_B.A - 0x0000000000686970 __intel_new_proc_init_N - 0x00000000006869c0 __intel_new_proc_init_N.L - 0x0000000000686a90 __intel_new_proc_init_N.K - 0x0000000000686b60 __intel_new_proc_init_N.J - 0x0000000000686c40 __intel_new_proc_init_N.A - 0x0000000000686cc0 __intel_proc_init_N - 0x0000000000686d10 __intel_proc_init_N.L - 0x0000000000686d40 __intel_proc_init_N.K - 0x0000000000686d70 __intel_proc_init_N.J - 0x0000000000686df0 __intel_proc_init_N.A - .text 0x0000000000686e70 0x1590 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x0000000000686e70 __mulq.L - 0x0000000000687920 __mulq.A - 0x00000000006883d0 __mulq - .text 0x0000000000688400 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0x0000000000688400 __divq.L - 0x00000000006891e0 __divq.A - 0x0000000000689fc0 __divq - .text 0x0000000000689ff0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x0000000000689ff0 __intel_sse2_strlen - 0x000000000068a020 __intel_sse4_strlen - .text 0x000000000068a040 0x23e0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - 0x000000000068a040 __intel_new_memcpy - .text 0x000000000068c420 0x1220 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - 0x000000000068c420 __intel_new_memset - .text 0x000000000068d640 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x000000000068d640 irc__get_msg - 0x000000000068d830 irc__print - .text 0x000000000068da80 0x1bf0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000068da80 __intel_get_mem_ops_method - 0x000000000068de60 __intel_set_memcpy_largest_cache_size - 0x000000000068e270 __intel_set_memcpy_largest_cachelinesize - 0x000000000068e690 __intel_get_memcpy_largest_cache_size - 0x000000000068ea90 __intel_get_memcpy_largest_cachelinesize - 0x000000000068eea0 __intel_init_mem_ops_method - 0x000000000068f270 __intel_override_mem_ops_method - .text 0x000000000068f670 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - 0x000000000068f670 __intel_get_new_mem_ops_cpuid - 0x000000000068f6a0 __intel_get_new_mem_ops_cpuid4 - .text 0x000000000068f6f0 0x99 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x000000000068f6f0 __libc_csu_fini - 0x000000000068f700 __libc_csu_init - *fill* 0x000000000068f789 0x7 90909090 - .text 0x000000000068f790 0x36 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - *fill* 0x000000000068f7c6 0x2 90909090 - .text 0x000000000068f7c8 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(.gnu.warning) - -.fini 0x000000000068f7c8 0xe - *(.fini) - .fini 0x000000000068f7c8 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - 0x000000000068f7c8 _fini - .fini 0x000000000068f7cc 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .fini 0x000000000068f7d1 0x5 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - 0x000000000068f7d6 PROVIDE (__etext, .) - 0x000000000068f7d6 PROVIDE (_etext, .) - 0x000000000068f7d6 PROVIDE (etext, .) - -.rodata 0x000000000068f7e0 0x5b580 - *(.rodata .rodata.* .gnu.linkonce.r.*) - .rodata.cst4 0x000000000068f7e0 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000068f7e0 _IO_stdin_used - *fill* 0x000000000068f7e4 0x4 00 - .rodata 0x000000000068f7e8 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - 0x000000000068f7e8 __dso_handle - *fill* 0x000000000068f7f0 0x10 00 - .rodata 0x000000000068f800 0x500 unres.o - .rodata.str1.32 - 0x000000000068fd00 0xf3 unres.o - 0xf4 (size before relaxing) - *fill* 0x000000000068fdf3 0x1 00 - .rodata.str1.4 - 0x000000000068fdf4 0x20f unres.o - 0x29c (size before relaxing) - *fill* 0x0000000000690003 0xd 00 - .rodata 0x0000000000690010 0x30 arcos.o - .rodata 0x0000000000690040 0x180 cartprint.o - .rodata 0x00000000006901c0 0x38 chainbuild.o - .rodata 0x00000000006901f8 0x30 convert.o - *fill* 0x0000000000690228 0x8 00 - .rodata 0x0000000000690230 0x340 initialize_p.o - .rodata.str1.4 - 0x0000000000690570 0x13a initialize_p.o - 0x154 (size before relaxing) - *fill* 0x00000000006906aa 0x2 00 - .rodata.str1.32 - 0x00000000006906ac 0x15d initialize_p.o - 0x160 (size before relaxing) - *fill* 0x0000000000690809 0x7 00 - .rodata 0x0000000000690810 0x1760 readrtns_CSA.o - .rodata.str1.4 - 0x0000000000691f70 0x1141 readrtns_CSA.o - 0x142c (size before relaxing) - *fill* 0x00000000006930b1 0x3 00 - .rodata.str1.32 - 0x00000000006930b4 0xbef readrtns_CSA.o - 0xde4 (size before relaxing) - *fill* 0x0000000000693ca3 0x1 00 - .rodata.str1.4 - 0x0000000000693ca4 0x517 parmread.o - 0x65c (size before relaxing) - *fill* 0x00000000006941bb 0x5 00 - .rodata 0x00000000006941c0 0xdb0 parmread.o - .rodata.str1.32 - 0x0000000000694f70 0x3f5 parmread.o - 0x4ac (size before relaxing) - *fill* 0x0000000000695365 0xb 00 - .rodata 0x0000000000695370 0x2a0 gen_rand_conf.o - .rodata.str1.32 - 0x0000000000695610 0x125 gen_rand_conf.o - 0x23c (size before relaxing) - *fill* 0x0000000000695735 0x3 00 - .rodata.str1.4 - 0x0000000000695738 0x9f gen_rand_conf.o - 0xd4 (size before relaxing) - *fill* 0x00000000006957d7 0x9 00 - .rodata 0x00000000006957e0 0xc0 printmat.o - .rodata 0x00000000006958a0 0xac map.o - .rodata.str1.32 - 0x000000000069594c 0x29 map.o - 0x2c (size before relaxing) - *fill* 0x0000000000695975 0x3 00 - .rodata.str1.4 - 0x0000000000695978 0x36 map.o - 0x64 (size before relaxing) - *fill* 0x00000000006959ae 0x2 00 - .rodata 0x00000000006959b0 0x68 randgens.o - .rodata 0x0000000000695a18 0x10 rescode.o - .rodata.str1.4 - 0x0000000000000000 0x4 rescode.o - *fill* 0x0000000000695a28 0x8 00 - .rodata 0x0000000000695a30 0x30 intcor.o - .rodata 0x0000000000695a60 0x448 timing.o - .rodata.str1.4 - 0x0000000000695ea8 0x230 timing.o - 0x2e4 (size before relaxing) - .rodata.str1.32 - 0x00000000006960d8 0x69 timing.o - 0x6c (size before relaxing) - *fill* 0x0000000000696141 0x3 00 - .rodata.str1.4 - 0x0000000000696144 0x6 misc.o - 0x18 (size before relaxing) - *fill* 0x000000000069614a 0x2 00 - .rodata 0x000000000069614c 0x24 misc.o - .rodata 0x0000000000696170 0x228 intlocal.o - .rodata.str1.4 - 0x0000000000696398 0x38 intlocal.o - 0x44 (size before relaxing) - .rodata 0x00000000006963d0 0x10 cartder.o - .rodata 0x00000000006963e0 0x450 checkder_p.o - .rodata.str1.4 - 0x0000000000696830 0x15f checkder_p.o - 0x1c0 (size before relaxing) - *fill* 0x000000000069698f 0x1 00 - .rodata.str1.32 - 0x0000000000696990 0x78 checkder_p.o - 0xa0 (size before relaxing) - *fill* 0x0000000000696a08 0x8 00 - .rodata 0x0000000000696a10 0x20 econstr_local.o - .rodata 0x0000000000696a30 0xb70 energy_p_new_barrier.o - .rodata.str1.4 - 0x00000000006975a0 0xf0 energy_p_new_barrier.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x0000000000697690 0x50 energy_p_new_barrier.o - .rodata 0x00000000006976e0 0x2e8 energy_p_new-sep_barrier.o - .rodata.str1.4 - 0x0000000000000000 0x3c energy_p_new-sep_barrier.o - .rodata.str1.32 - 0x0000000000000000 0x50 energy_p_new-sep_barrier.o - *fill* 0x00000000006979c8 0x18 00 - .rodata 0x00000000006979e0 0x180 minimize_p.o - .rodata.str1.4 - 0x0000000000697b60 0x1e minimize_p.o - 0x54 (size before relaxing) - *fill* 0x0000000000697b7e 0x2 00 - .rodata.str1.32 - 0x0000000000697b80 0x22 minimize_p.o - 0x24 (size before relaxing) - *fill* 0x0000000000697ba2 0x1e 00 - .rodata 0x0000000000697bc0 0x1a0 sumsld.o - .rodata 0x0000000000697d60 0x33a0 cored.o - .rodata 0x000000000069b100 0x60 rmdd.o - .rodata 0x000000000069b160 0x7ec geomout.o - .rodata.str1.4 - 0x000000000069b94c 0x136 geomout.o - 0x1b4 (size before relaxing) - *fill* 0x000000000069ba82 0x2 00 - .rodata.str1.32 - 0x000000000069ba84 0x59 geomout.o - 0x5c (size before relaxing) - *fill* 0x000000000069badd 0x3 00 - .rodata 0x000000000069bae0 0x370 readpdb.o - .rodata 0x000000000069be50 0x150 regularize.o - .rodata.str1.4 - 0x000000000069bfa0 0xd5 regularize.o - 0x10c (size before relaxing) - *fill* 0x000000000069c075 0x3 00 - .rodata.str1.32 - 0x000000000069c078 0x29 regularize.o - 0x58 (size before relaxing) - *fill* 0x000000000069c0a1 0xf 00 - .rodata 0x000000000069c0b0 0x4d0 thread.o - .rodata.str1.4 - 0x000000000069c580 0x13e thread.o - 0x230 (size before relaxing) - *fill* 0x000000000069c6be 0x2 00 - .rodata.str1.32 - 0x000000000069c6c0 0x24e thread.o - 0x388 (size before relaxing) - *fill* 0x000000000069c90e 0x12 00 - .rodata 0x000000000069c920 0x100 fitsq.o - .rodata.str1.32 - 0x000000000069ca20 0x2a fitsq.o - 0x58 (size before relaxing) - *fill* 0x000000000069ca4a 0x6 00 - .rodata 0x000000000069ca50 0x700 mcm.o - .rodata.str1.4 - 0x000000000069d150 0x41f mcm.o - 0x518 (size before relaxing) - *fill* 0x000000000069d56f 0x1 00 - .rodata.str1.32 - 0x000000000069d570 0x249 mcm.o - 0x24c (size before relaxing) - *fill* 0x000000000069d7b9 0x7 00 - .rodata 0x000000000069d7c0 0x648 mc.o - .rodata.str1.4 - 0x000000000069de08 0x30d mc.o - 0x428 (size before relaxing) - *fill* 0x000000000069e115 0x3 00 - .rodata.str1.32 - 0x000000000069e118 0xe8 mc.o - 0x114 (size before relaxing) - .rodata 0x000000000069e200 0x110 bond_move.o - .rodata.str1.4 - 0x000000000069e310 0x73 bond_move.o - 0x7c (size before relaxing) - *fill* 0x000000000069e383 0x1 00 - .rodata.str1.32 - 0x000000000069e384 0x6f bond_move.o - 0x70 (size before relaxing) - *fill* 0x000000000069e3f3 0xd 00 - .rodata 0x000000000069e400 0x1c0 refsys.o - .rodata 0x000000000069e5c0 0x38 check_sc_distr.o - .rodata.str1.4 - 0x000000000069e5f8 0xf check_sc_distr.o - 0x18 (size before relaxing) - *fill* 0x000000000069e607 0x1 00 - .rodata 0x000000000069e608 0x20 check_bond.o - *fill* 0x000000000069e628 0x8 00 - .rodata 0x000000000069e630 0xd0 contact.o - .rodata.str1.4 - 0x000000000069e700 0x2a contact.o - 0x2c (size before relaxing) - *fill* 0x000000000069e72a 0x16 00 - .rodata 0x000000000069e740 0xe0 djacob.o - .rodata 0x000000000069e820 0x3c0 eigen.o - .rodata.str1.32 - 0x000000000069ebe0 0x29 eigen.o - 0x2c (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x4 eigen.o - *fill* 0x000000000069ec09 0x7 00 - .rodata 0x000000000069ec10 0x80 blas.o - .rodata.str1.4 - 0x000000000069ec90 0x8 add.o - *fill* 0x000000000069ec98 0x8 00 - .rodata 0x000000000069eca0 0x730 entmcm.o - .rodata.str1.4 - 0x000000000069f3d0 0x11e entmcm.o - 0x538 (size before relaxing) - *fill* 0x000000000069f4ee 0x2 00 - .rodata.str1.32 - 0x000000000069f4f0 0x51 entmcm.o - 0x168 (size before relaxing) - *fill* 0x000000000069f541 0xf 00 - .rodata 0x000000000069f550 0x70 minim_mcmf.o - .rodata 0x000000000069f5c0 0xb70 together.o - .rodata.str1.4 - 0x00000000006a0130 0x316 together.o - 0x58c (size before relaxing) - *fill* 0x00000000006a0446 0x2 00 - .rodata.str1.32 - 0x00000000006a0448 0x16c together.o - 0x224 (size before relaxing) - *fill* 0x00000000006a05b4 0xc 00 - .rodata 0x00000000006a05c0 0x240 csa.o - .rodata.str1.4 - 0x00000000006a0800 0x5a csa.o - 0xc4 (size before relaxing) - *fill* 0x00000000006a085a 0x2 00 - .rodata.str1.32 - 0x00000000006a085c 0x58 csa.o - 0x7c (size before relaxing) - *fill* 0x00000000006a08b4 0xc 00 - .rodata 0x00000000006a08c0 0x380 minim_jlee.o - .rodata.str1.4 - 0x00000000006a0c40 0xfd minim_jlee.o - 0x1fc (size before relaxing) - *fill* 0x00000000006a0d3d 0x3 00 - .rodata.str1.32 - 0x00000000006a0d40 0x89 minim_jlee.o - 0x230 (size before relaxing) - *fill* 0x00000000006a0dc9 0x3 00 - .rodata 0x00000000006a0dcc 0x3a4 shift.o - .rodata.str1.4 - 0x00000000006a1170 0x25 shift.o - 0x54 (size before relaxing) - *fill* 0x00000000006a1195 0xb 00 - .rodata 0x00000000006a11a0 0x20 diff12.o - .rodata 0x00000000006a11c0 0xbe8 bank.o - .rodata.str1.4 - 0x00000000006a1da8 0x114 bank.o - 0x2ac (size before relaxing) - .rodata.str1.32 - 0x00000000006a1ebc 0x4a bank.o - 0x4c (size before relaxing) - *fill* 0x00000000006a1f06 0xa 00 - .rodata 0x00000000006a1f10 0x3f0 newconf.o - .rodata.str1.4 - 0x00000000006a2300 0xaf newconf.o - 0xf8 (size before relaxing) - *fill* 0x00000000006a23af 0x1 00 - .rodata.str1.32 - 0x00000000006a23b0 0x7c newconf.o - 0xf0 (size before relaxing) - .rodata 0x00000000006a242c 0x18 ran.o - .rodata.str1.4 - 0x00000000006a2444 0x1b indexx.o - 0x1c (size before relaxing) - *fill* 0x00000000006a245f 0x1 00 - .rodata 0x00000000006a2460 0x730 MP.o - .rodata.str1.4 - 0x00000000006a2b90 0x27d MP.o - 0x5e8 (size before relaxing) - *fill* 0x00000000006a2e0d 0x3 00 - .rodata.str1.32 - 0x00000000006a2e10 0x31b MP.o - 0x470 (size before relaxing) - *fill* 0x00000000006a312b 0x5 00 - .rodata 0x00000000006a3130 0x170 compare_s1.o - .rodata.str1.4 - 0x00000000006a32a0 0x71 compare_s1.o - 0x78 (size before relaxing) - *fill* 0x00000000006a3311 0x3 00 - .rodata.str1.32 - 0x00000000006a3314 0x14c compare_s1.o - .rodata 0x00000000006a3460 0x30 prng_32.o - .rodata 0x00000000006a3490 0xf50 test.o - .rodata.str1.4 - 0x00000000006a43e0 0x46a test.o - 0xa00 (size before relaxing) - *fill* 0x00000000006a484a 0x2 00 - .rodata.str1.32 - 0x00000000006a484c 0x5a test.o - 0x12c (size before relaxing) - *fill* 0x00000000006a48a6 0xa 00 - .rodata 0x00000000006a48b0 0x40 banach.o - .rodata 0x00000000006a48f0 0xf0 distfit.o - .rodata.str1.32 - 0x00000000006a49e0 0x75 distfit.o - 0x78 (size before relaxing) - *fill* 0x00000000006a4a55 0x3 00 - .rodata.str1.4 - 0x00000000006a4a58 0x25 distfit.o - 0x3c (size before relaxing) - *fill* 0x00000000006a4a7d 0x3 00 - .rodata 0x00000000006a4a80 0x150 rmsd.o - .rodata.str1.4 - 0x00000000006a4bd0 0x6a rmsd.o - 0x10c (size before relaxing) - .rodata.str1.32 - 0x0000000000000000 0x2c rmsd.o - *fill* 0x00000000006a4c3a 0x6 00 - .rodata 0x00000000006a4c40 0x580 elecont.o - .rodata.str1.32 - 0x00000000006a51c0 0xdf elecont.o - 0x108 (size before relaxing) - *fill* 0x00000000006a529f 0x1 00 - .rodata.str1.4 - 0x00000000006a52a0 0x1b elecont.o - 0x278 (size before relaxing) - *fill* 0x00000000006a52bb 0x1 00 - .rodata.str1.4 - 0x00000000006a52bc 0x6c dihed_cons.o - 0x90 (size before relaxing) - .rodata 0x00000000006a5328 0x118 dihed_cons.o - .rodata.str1.32 - 0x00000000006a5440 0xc3 dihed_cons.o - 0xc4 (size before relaxing) - *fill* 0x00000000006a5503 0xd 00 - .rodata 0x00000000006a5510 0x130 sc_move.o - .rodata.str1.4 - 0x0000000000000000 0x8 sc_move.o - .rodata 0x00000000006a5640 0x3a0 local_move.o - .rodata.str1.32 - 0x00000000006a59e0 0x84 local_move.o - .rodata.str1.4 - 0x00000000006a5a64 0x92 local_move.o - 0xa0 (size before relaxing) - *fill* 0x00000000006a5af6 0x2 00 - .rodata 0x00000000006a5af8 0x1e8 intcartderiv.o - .rodata.str1.32 - 0x00000000006a5ce0 0xef intcartderiv.o - 0xf0 (size before relaxing) - *fill* 0x00000000006a5dcf 0x1 00 - .rodata 0x00000000006a5dd0 0x130 /tmp/ipo_ifortScZxT8.o - .rodata.str1.4 - 0x00000000006a5f00 0x72 /tmp/ipo_ifortScZxT8.o - 0xa0 (size before relaxing) - *fill* 0x00000000006a5f72 0xe 00 - .rodata 0x00000000006a5f80 0x110 stochfric.o - .rodata.str1.4 - 0x00000000006a6090 0x38 stochfric.o - .rodata.str1.32 - 0x00000000006a60c8 0x3e stochfric.o - 0x40 (size before relaxing) - *fill* 0x00000000006a6106 0xa 00 - .rodata 0x00000000006a6110 0x20 kinetic_lesyng.o - .rodata.str1.4 - 0x00000000006a6130 0x39b MD_A-MTS.o - 0x540 (size before relaxing) - *fill* 0x00000000006a64cb 0x5 00 - .rodata 0x00000000006a64d0 0xa90 MD_A-MTS.o - .rodata.str1.32 - 0x00000000006a6f60 0x369 MD_A-MTS.o - 0x480 (size before relaxing) - *fill* 0x00000000006a72c9 0x7 00 - .rodata 0x00000000006a72d0 0xa0 moments.o - .rodata 0x00000000006a7370 0x60 surfatom.o - .rodata.str1.4 - 0x0000000000000000 0xc surfatom.o - *fill* 0x00000000006a73d0 0x10 00 - .rodata 0x00000000006a73e0 0x3e0 muca_md.o - .rodata.str1.4 - 0x00000000006a77c0 0xea muca_md.o - 0x10c (size before relaxing) - *fill* 0x00000000006a78aa 0x6 00 - .rodata 0x00000000006a78b0 0x8a0 MREMD.o - .rodata.str1.4 - 0x00000000006a8150 0x2ea MREMD.o - 0x4e0 (size before relaxing) - *fill* 0x00000000006a843a 0x2 00 - .rodata.str1.32 - 0x00000000006a843c 0x22 MREMD.o - 0xb8 (size before relaxing) - *fill* 0x00000000006a845e 0x2 00 - .rodata 0x00000000006a8460 0x18 rattle.o - .rodata.str1.32 - 0x00000000006a8478 0xa5 rattle.o - 0xa8 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0xc rattle.o - *fill* 0x00000000006a851d 0x3 00 - .rodata 0x00000000006a8520 0x30 gauss.o - .rodata 0x00000000006a8550 0xa0 energy_split-sep.o - .rodata 0x00000000006a85f0 0x68 q_measure.o - .rodata.str1.32 - 0x00000000006a8658 0x20 q_measure.o - .rodata 0x00000000006a8678 0x20 gnmr1.o - .rodata 0x00000000006a8698 0x3 proc_proc.o - *fill* 0x00000000006a869b 0x1 00 - .rodata 0x00000000006a869c 0xd0 cinfo.o - .rodata.str1.4 - 0x00000000006a876c 0xe2 cinfo.o - 0xe4 (size before relaxing) - *fill* 0x00000000006a884e 0x2 00 - .rodata.str1.32 - 0x00000000006a8850 0x2c3 cinfo.o - 0x2c4 (size before relaxing) - .rodata 0x00000000006a8b13 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .rodata 0x00000000006a8b24 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .rodata 0x00000000006a8b3f 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .rodata 0x00000000006a8b4b 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .rodata 0x00000000006a8b62 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .rodata 0x00000000006a8b6a 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .rodata 0x00000000006a8b72 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - *fill* 0x00000000006a8b82 0x6 00 - .rodata 0x00000000006a8b88 0xa9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .rodata 0x00000000006a8c31 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .rodata 0x00000000006a8c39 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .rodata 0x00000000006a8c43 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .rodata 0x00000000006a8c4a 0x7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .rodata 0x00000000006a8c51 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .rodata 0x00000000006a8c5a 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .rodata 0x00000000006a8c64 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .rodata 0x00000000006a8c6f 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .rodata 0x00000000006a8c78 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .rodata 0x00000000006a8c86 0x22 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .rodata 0x00000000006a8ca8 0x15 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .rodata 0x00000000006a8cbd 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .rodata 0x00000000006a8cc9 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x00000000006a8ce3 0xd 00 - .rodata 0x00000000006a8cf0 0x195 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000006a8cf0 MPIR_Version_patches - 0x00000000006a8cf4 MPIR_Version_major - 0x00000000006a8cf8 MPIR_Version_minor - 0x00000000006a8cfc MPIR_Version_subminor - 0x00000000006a8d00 MPIR_Version_string - 0x00000000006a8d10 MPIR_Version_date - 0x00000000006a8d30 MPIR_Version_configure - 0x00000000006a8d43 MPIR_Version_device - .rodata 0x00000000006a8e85 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - *fill* 0x00000000006a8e8f 0x1 00 - .rodata 0x00000000006a8e90 0x2d40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .rodata 0x00000000006abbd0 0x225 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - *fill* 0x00000000006abdf5 0x3 00 - .rodata 0x00000000006abdf8 0xde /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .rodata 0x00000000006abed6 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .rodata 0x00000000006abee4 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x00000000006abef2 0x6 00 - .rodata 0x00000000006abef8 0xa3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .rodata 0x00000000006abf9b 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .rodata 0x00000000006abfa9 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .rodata 0x00000000006abfb6 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .rodata 0x00000000006abfc3 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .rodata 0x00000000006abfd0 0x121 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .rodata 0x00000000006ac0f1 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .rodata 0x00000000006ac0fd 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .rodata 0x00000000006ac10a 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .rodata 0x00000000006ac128 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .rodata 0x00000000006ac134 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .rodata 0x00000000006ac162 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x00000000006ac16e 0x2 00 - .rodata 0x00000000006ac170 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .rodata 0x00000000006ac267 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .rodata 0x00000000006ac283 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .rodata 0x00000000006ac294 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .rodata 0x00000000006ac29e 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .rodata 0x00000000006ac2a6 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .rodata 0x00000000006ac2af 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .rodata 0x00000000006ac2b9 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .rodata 0x00000000006ac2c4 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .rodata 0x00000000006ac2d0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .rodata 0x00000000006ac2d9 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x00000000006ac2e5 0x3 00 - .rodata 0x00000000006ac2e8 0xb58 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .rodata 0x00000000006ace40 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .rodata 0x00000000006ace49 0x17 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .rodata 0x00000000006ace60 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .rodata 0x00000000006acf20 0x69 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .rodata 0x00000000006acf89 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .rodata 0x00000000006acf96 0x1b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - *fill* 0x00000000006acfb1 0x7 00 - .rodata 0x00000000006acfb8 0xa48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .rodata 0x00000000006ada00 0x3d7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - *fill* 0x00000000006addd7 0x1 00 - .rodata 0x00000000006addd8 0x469 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - *fill* 0x00000000006ae241 0x7 00 - .rodata 0x00000000006ae248 0x9aa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x00000000006aebf2 0x6 00 - .rodata 0x00000000006aebf8 0x5ba /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - *fill* 0x00000000006af1b2 0x6 00 - .rodata 0x00000000006af1b8 0x664 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - *fill* 0x00000000006af81c 0x4 00 - .rodata 0x00000000006af820 0x5de /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x00000000006afdfe 0x2 00 - .rodata 0x00000000006afe00 0x501 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x00000000006b0301 0x7 00 - .rodata 0x00000000006b0308 0x1a9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - *fill* 0x00000000006b04b1 0x7 00 - .rodata 0x00000000006b04b8 0x16c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - *fill* 0x00000000006b0624 0x4 00 - .rodata 0x00000000006b0628 0xec /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - *fill* 0x00000000006b0714 0x4 00 - .rodata 0x00000000006b0718 0x119 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - *fill* 0x00000000006b0831 0x7 00 - .rodata 0x00000000006b0838 0xe7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - *fill* 0x00000000006b091f 0x1 00 - .rodata 0x00000000006b0920 0xf9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - *fill* 0x00000000006b0a19 0x7 00 - .rodata 0x00000000006b0a20 0xbf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - *fill* 0x00000000006b0adf 0x1 00 - .rodata 0x00000000006b0ae0 0x3f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - *fill* 0x00000000006b0b1f 0x1 00 - .rodata 0x00000000006b0b20 0x440 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .rodata 0x00000000006b0f60 0x506 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - *fill* 0x00000000006b1466 0x2 00 - .rodata 0x00000000006b1468 0xb9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x00000000006b1521 0x7 00 - .rodata 0x00000000006b1528 0x4e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - *fill* 0x00000000006b1576 0x2 00 - .rodata 0x00000000006b1578 0xf7 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - *fill* 0x00000000006b166f 0x1 00 - .rodata 0x00000000006b1670 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - *fill* 0x00000000006b1787 0x1 00 - .rodata 0x00000000006b1788 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .rodata 0x00000000006b1948 0x2d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .rodata 0x00000000006b1975 0x18 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - *fill* 0x00000000006b198d 0x3 00 - .rodata 0x00000000006b1990 0x1ef /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - *fill* 0x00000000006b1b7f 0x1 00 - .rodata 0x00000000006b1b80 0x1a1 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .rodata 0x00000000006b1d21 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .rodata 0x00000000006b1d31 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .rodata 0x00000000006b1d3a 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .rodata 0x00000000006b1d45 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .rodata 0x00000000006b1d53 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .rodata 0x00000000006b1d5f 0x1e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .rodata 0x00000000006b1d7d 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .rodata 0x00000000006b1d87 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .rodata 0x00000000006b1d93 0x32 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .rodata 0x00000000006b1dc5 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x00000000006b1dd1 0x7 00 - .rodata 0x00000000006b1dd8 0x5e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .rodata 0x00000000006b1e36 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .rodata 0x00000000006b1e3f 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .rodata 0x00000000006b1e48 0xbe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x00000000006b1f06 0x2 00 - .rodata 0x00000000006b1f08 0x152 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x00000000006b205a 0x6 00 - .rodata 0x00000000006b2060 0x250 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .rodata 0x00000000006b22b0 0x415 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x00000000006b26c5 0x3 00 - .rodata 0x00000000006b26c8 0x373 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x00000000006b2a3b 0x5 00 - .rodata 0x00000000006b2a40 0x39b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - *fill* 0x00000000006b2ddb 0x5 00 - .rodata 0x00000000006b2de0 0x1f8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .rodata 0x00000000006b2fd8 0x3c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .rodata 0x00000000006b3398 0x6d /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - *fill* 0x00000000006b3405 0xb 00 - .rodata 0x00000000006b3410 0x280 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .rodata 0x00000000006b3690 0xd0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .rodata 0x00000000006b3760 0x2da /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - *fill* 0x00000000006b3a3a 0x6 00 - .rodata 0x00000000006b3a40 0x4b0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .rodata 0x00000000006b3ef0 0x300 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .rodata 0x00000000006b41f0 0x2db /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - *fill* 0x00000000006b44cb 0x5 00 - .rodata 0x00000000006b44d0 0x13f /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - *fill* 0x00000000006b460f 0x1 00 - .rodata.str1.8 - 0x00000000006b4610 0xf0 xdrf_em64/libxdrf.a(libxdrf.o) - 0xe9 (size before relaxing) - .rodata.str1.1 - 0x00000000006b4700 0x17 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b4717 0x1 00 - .rodata.cst8 0x00000000006b4718 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - .rodata.cst4 0x00000000006b4728 0xc xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b4734 0xc 00 - .rodata.cst16 0x00000000006b4740 0x10 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b4750 0x10 00 - .rodata 0x00000000006b4760 0x124 xdrf_em64/libxdrf.a(libxdrf.o) - *fill* 0x00000000006b4884 0x4 00 - .rodata 0x00000000006b4888 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .rodata 0x00000000006b48a0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .rodata 0x00000000006b48b0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .rodata.str1.4 - 0x0000000000000000 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .rodata 0x00000000006b48c0 0x48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .rodata.str1.4 - 0x00000000006b4908 0x68 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - *fill* 0x00000000006b4970 0x10 00 - .rodata 0x00000000006b4980 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x00000000006b4b00 for__dsc_itm_table - .rodata.str1.4 - 0x00000000006b4b80 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .rodata.str1.4 - 0x00000000006b4b90 0xec9 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0xee8 (size before relaxing) - *fill* 0x00000000006b5a59 0x7 00 - .rodata 0x00000000006b5a60 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .rodata.str1.32 - 0x00000000006b5ae0 0x3bda /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x3c00 (size before relaxing) - *fill* 0x00000000006b96ba 0x2 00 - .rodata.str1.4 - 0x00000000006b96bc 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x14 (size before relaxing) - *fill* 0x00000000006b96cf 0x1 00 - .rodata 0x00000000006b96d0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .rodata.str1.4 - 0x00000000006b9700 0x98 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0xa4 (size before relaxing) - *fill* 0x00000000006b9798 0x8 00 - .rodata 0x00000000006b97a0 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .rodata.str1.32 - 0x00000000006b9920 0x1eea /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x1f00 (size before relaxing) - *fill* 0x00000000006bb80a 0x2 00 - .rodata.str1.4 - 0x00000000006bb80c 0x176 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x1a0 (size before relaxing) - *fill* 0x00000000006bb982 0x1e 00 - .rodata 0x00000000006bb9a0 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .rodata 0x00000000006bbf40 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .rodata.str1.4 - 0x00000000006bc300 0x3 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x4 (size before relaxing) - *fill* 0x00000000006bc303 0x1 00 - .rodata.str1.4 - 0x00000000006bc304 0x5b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x5c (size before relaxing) - *fill* 0x00000000006bc35f 0x1 00 - .rodata 0x00000000006bc360 0x580 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .rodata 0x00000000006bc8e0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .rodata.str1.4 - 0x00000000006bc940 0x271 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x400 (size before relaxing) - *fill* 0x00000000006bcbb1 0xf 00 - .rodata 0x00000000006bcbc0 0x1980 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .rodata 0x00000000006be540 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .rodata.str1.4 - 0x00000000006be550 0x2a /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x2c (size before relaxing) - *fill* 0x00000000006be57a 0x2 00 - .rodata.str1.32 - 0x00000000006be57c 0x34 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - *fill* 0x00000000006be5b0 0x10 00 - .rodata 0x00000000006be5c0 0x220 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .rodata.str1.4 - 0x00000000006be7e0 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0xc (size before relaxing) - *fill* 0x00000000006be7ea 0x16 00 - .rodata 0x00000000006be800 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .rodata.str1.4 - 0x00000000006be880 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0x18 (size before relaxing) - *fill* 0x00000000006be88d 0x3 00 - .rodata.str1.4 - 0x00000000006be890 0x2f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x38 (size before relaxing) - *fill* 0x00000000006be8bf 0x1 00 - .rodata.str1.32 - 0x00000000006be8c0 0x22 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006be8e2 0x1e 00 - .rodata 0x00000000006be900 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .rodata.str1.4 - 0x00000000006beba0 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x34 (size before relaxing) - *fill* 0x00000000006bebcc 0x14 00 - .rodata 0x00000000006bebe0 0xa80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .rodata.str1.4 - 0x00000000006bf660 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006bf66b 0x1 00 - .rodata.str1.4 - 0x00000000006bf66c 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006bf67b 0x5 00 - .rodata 0x00000000006bf680 0x400 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .rodata.str1.4 - 0x00000000006bfa80 0x1d /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x28 (size before relaxing) - *fill* 0x00000000006bfa9d 0x3 00 - .rodata 0x00000000006bfaa0 0xd80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .rodata.str1.4 - 0x00000000006c0820 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x14 (size before relaxing) - *fill* 0x00000000006c082b 0x15 00 - .rodata 0x00000000006c0840 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .rodata.str1.4 - 0x00000000006c09c0 0x29 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x3c (size before relaxing) - *fill* 0x00000000006c09e9 0x3 00 - .rodata.str1.32 - 0x00000000006c09ec 0x23 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x24 (size before relaxing) - *fill* 0x00000000006c0a0f 0x11 00 - .rodata 0x00000000006c0a20 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .rodata.str1.4 - 0x00000000006c0c60 0xb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x14 (size before relaxing) - *fill* 0x00000000006c0c6b 0x15 00 - .rodata 0x00000000006c0c80 0x2a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .rodata.str1.4 - 0x00000000006c0f20 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x20 (size before relaxing) - *fill* 0x00000000006c0f2f 0x11 00 - .rodata 0x00000000006c0f40 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .rodata.str1.4 - 0x00000000006c1240 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x18 (size before relaxing) - *fill* 0x00000000006c124f 0x11 00 - .rodata 0x00000000006c1260 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .rodata 0x00000000006c1580 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .rodata.str1.4 - 0x00000000006c15b8 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c15c5 0x1b 00 - .rodata 0x00000000006c15e0 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .rodata.str1.4 - 0x00000000006c16c0 0xe /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c16ce 0x2 00 - .rodata 0x00000000006c16d0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - *fill* 0x00000000006c1730 0x10 00 - .rodata.str1.32 - 0x00000000006c1740 0xbdb /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0xbe0 (size before relaxing) - *fill* 0x00000000006c231b 0x1 00 - .rodata.str1.4 - 0x00000000006c231c 0x16b /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x198 (size before relaxing) - *fill* 0x00000000006c2487 0x1 00 - .rodata.str1.4 - 0x00000000006c2488 0xb2 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0xc4 (size before relaxing) - *fill* 0x00000000006c253a 0x6 00 - .rodata 0x00000000006c2540 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .rodata.str1.4 - 0x00000000006c2660 0x6e /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006c26ce 0x12 00 - .rodata 0x00000000006c26e0 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .rodata 0x00000000006c2b00 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .rodata 0x00000000006c2e00 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .rodata 0x00000000006c2fe0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .rodata 0x00000000006c31c0 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .rodata 0x00000000006c33a0 0x3c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .rodata 0x00000000006c3760 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .rodata 0x00000000006c3940 0x1e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .rodata 0x00000000006c3b20 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .rodata 0x00000000006c4480 0x5a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .rodata 0x00000000006c4a20 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .rodata.str1.4 - 0x00000000006c5000 0x1f /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0xb8 (size before relaxing) - *fill* 0x00000000006c501f 0x1 00 - .rodata 0x00000000006c5020 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .rodata.str1.4 - 0x00000000006c5340 0xf /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x10 (size before relaxing) - *fill* 0x00000000006c534f 0x11 00 - .rodata 0x00000000006c5360 0x11a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .rodata 0x00000000006c6500 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .rodata.str1.4 - 0x00000000006c6540 0xa /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0xc (size before relaxing) - *fill* 0x00000000006c654a 0x16 00 - .rodata 0x00000000006c6560 0xb40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x00000000006c6ac0 for__b_fmt_table - 0x00000000006c6b40 for__fedg_fmt_table - 0x00000000006c6c20 for__coerce_data_types - 0x00000000006c7040 for__i_fmt_table - 0x00000000006c7050 for__oz_fmt_table - .rodata.str1.4 - 0x00000000006c70a0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - *fill* 0x00000000006c70b0 0x10 00 - .rodata 0x00000000006c70c0 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - 0x00000000006c70c0 for__wfs_table - 0x00000000006c71c0 for__wfs_msf_table - .rodata 0x00000000006c72c0 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - 0x00000000006c72c0 vax_c - 0x00000000006c7300 ieee_t - 0x00000000006c7370 ieee_s - 0x00000000006c73a8 ibm_s - 0x00000000006c73c4 ibm_l - 0x00000000006c73fc cray - 0x00000000006c7434 int_c - .rodata 0x00000000006c7480 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .rodata.str1.4 - 0x00000000006c7500 0x11 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x14 (size before relaxing) - .rodata.str1.4 - 0x0000000000000000 0x14 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - *fill* 0x00000000006c7511 0xf 00 - .rodata 0x00000000006c7520 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .rodata 0x00000000006c7560 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - *fill* 0x00000000006c75b0 0x10 00 - .rodata 0x00000000006c75c0 0x600 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .rodata 0x00000000006c7bc0 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .rodata 0x00000000006c7c30 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .rodata 0x00000000006c7cb0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .rodata.str1.4 - 0x00000000006c7cc0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata 0x00000000006c7cd0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata 0x00000000006c7cf0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .rodata.str1.4 - 0x00000000006c7d00 0xd /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0x30 (size before relaxing) - *fill* 0x00000000006c7d0d 0x3 00 - .rodata 0x00000000006c7d10 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata 0x00000000006c7d20 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - .rodata.str1.4 - 0x0000000000000000 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .rodata.str1.4 - 0x0000000000000000 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006c7d30 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - .rodata 0x00000000006c7d40 0x180 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_globals.o) - 0x00000000006c7d40 cvtas_pten_word - 0x00000000006c7de0 cvtas_globals_t - 0x00000000006c7e40 cvtas_globals_x - 0x00000000006c7ea0 cvtas_globals_s - .rodata 0x00000000006c7ec0 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_t.o) - 0x00000000006c7ec0 cvtas_pten_t - 0x00000000006c81c0 cvtas_tiny_pten_t - 0x00000000006c8260 cvtas_tiny_pten_t_map - 0x00000000006c82c0 cvtas_huge_pten_t - 0x00000000006c8340 cvtas_huge_pten_t_map - .rodata 0x00000000006c83a0 0x5e0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_64.o) - 0x00000000006c83a0 cvtas_pten_64 - 0x00000000006c86a0 cvtas_pten_64_bexp - 0x00000000006c8760 cvtas_tiny_pten_64 - 0x00000000006c87e0 cvtas_tiny_pten_64_map - 0x00000000006c8860 cvtas_huge_pten_64 - 0x00000000006c88e0 cvtas_huge_pten_64_map - 0x00000000006c893c cvtas_tiny_pten_64_bexp - 0x00000000006c895c cvtas_huge_pten_64_bexp - .rodata 0x00000000006c8980 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_pow_ten_128.o) - 0x00000000006c8980 cvtas_pten_128 - 0x00000000006c8b40 cvtas_tiny_tiny_pten_128 - 0x00000000006c8b80 cvtas_tiny_pten_128 - 0x00000000006c8c20 cvtas_tiny_pten_128_map - 0x00000000006c8cc0 cvtas_huge_huge_pten_128 - 0x00000000006c8d00 cvtas_huge_pten_128 - 0x00000000006c8da0 cvtas_huge_pten_128_map - 0x00000000006c8e28 cvtas_pten_128_bexp - 0x00000000006c8e60 cvtas_tiny_tiny_pten_128_bexp - 0x00000000006c8e68 cvtas_tiny_pten_128_bexp - 0x00000000006c8e7c cvtas_huge_huge_pten_128_bexp - 0x00000000006c8e84 cvtas_huge_pten_128_bexp - .rodata 0x00000000006c8ea0 0x17e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .rodata 0x00000000006ca680 0x17c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .rodata 0x00000000006cbe40 0xbc0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .rodata 0x00000000006cca00 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .rodata 0x00000000006cca10 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .rodata.str1.4 - 0x00000000006cca20 0xcbb /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0xcc4 (size before relaxing) - *fill* 0x00000000006cd6db 0x1 00 - .rodata.str1.32 - 0x00000000006cd6dc 0x10c /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .rodata 0x00000000006cd7e8 0xe0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x00000000006cd7e8 __libm_float_zero - 0x00000000006cd7f0 __libm_float_one - 0x00000000006cd7f8 __libm_float_inf - 0x00000000006cd800 __libm_float_huge - 0x00000000006cd808 __libm_double_zero - 0x00000000006cd818 __libm_double_one - 0x00000000006cd828 __libm_double_inf - 0x00000000006cd838 __libm_double_huge - 0x00000000006cd848 __libm_ldouble_zero - 0x00000000006cd858 __libm_ldouble_neg_zero - 0x00000000006cd868 __libm_ldouble_one - 0x00000000006cd878 __libm_ldouble_neg_one - 0x00000000006cd888 __libm_ldouble_inf - 0x00000000006cd898 __libm_ldouble_neg_inf - 0x00000000006cd8a8 __libm_ldouble_huge - 0x00000000006cd8b8 __libm_ldouble_neg_huge - *fill* 0x00000000006cd8c8 0x18 00 - .rodata 0x00000000006cd8e0 0x11c0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .rodata 0x00000000006ceaa0 0x780 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .rodata 0x00000000006cf220 0xc80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .rodata 0x00000000006cfea0 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .rodata 0x00000000006d07e0 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .rodata 0x00000000006d1120 0x940 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .rodata 0x00000000006d1a60 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .rodata 0x00000000006d22c0 0xd0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - *fill* 0x00000000006d2390 0x10 00 - .rodata 0x00000000006d23a0 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .rodata 0x00000000006d2880 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .rodata 0x00000000006d30a0 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .rodata 0x00000000006d38c0 0x4e0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .rodata 0x00000000006d3da0 0xe80 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - 0x00000000006d3da0 __libm_exp_hi_table_64 - 0x00000000006d3fc0 __libm_exp_mi_table_64 - 0x00000000006d41e0 __libm_exp_lo_table_64 - 0x00000000006d4400 __libm_exp_table_128 - .rodata 0x00000000006d4c20 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .rodata 0x00000000006d4c58 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - *fill* 0x00000000006d4c68 0x18 00 - .rodata 0x00000000006d4c80 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .rodata 0x00000000006d4ec0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .rodata 0x00000000006d4ee0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .rodata 0x00000000006d4f00 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .rodata 0x00000000006d4f20 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .rodata 0x00000000006d4f40 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .rodata 0x00000000006d57c0 0x880 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .rodata 0x00000000006d6040 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .rodata 0x00000000006d68a0 0x820 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .rodata 0x00000000006d70c0 0x58 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - *fill* 0x00000000006d7118 0x8 00 - .rodata 0x00000000006d7120 0x800 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - 0x00000000006d7120 __libm_logf_table_256 - .rodata 0x00000000006d7920 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .rodata 0x00000000006d8180 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .rodata 0x00000000006d81a0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .rodata 0x00000000006d81c0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .rodata 0x00000000006d81e0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .rodata 0x00000000006d8200 0x3300 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .rodata 0x00000000006db500 0x3a60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .rodata 0x00000000006def60 0xc00 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - 0x00000000006def60 __libm_rcp_table_256 - 0x00000000006df360 __libm_double_rcp_table_256 - .rodata 0x00000000006dfb60 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .rodata 0x00000000006e04c0 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .rodata 0x00000000006e0e20 0x960 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .rodata 0x00000000006e1780 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .rodata 0x00000000006e2f20 0x17a0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .rodata 0x00000000006e46c0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .rodata 0x00000000006e46e0 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .rodata 0x00000000006e4700 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .rodata 0x00000000006e5260 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .rodata 0x00000000006e5dc0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .rodata 0x00000000006e6920 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .rodata 0x00000000006e7480 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .rodata 0x00000000006e7fe0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .rodata 0x00000000006e8b40 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .rodata 0x00000000006e96a0 0xb60 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .rodata 0x00000000006ea200 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .rodata 0x00000000006ea218 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .rodata.str1.32 - 0x00000000006ea240 0x158 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x160 (size before relaxing) - .rodata.str1.4 - 0x00000000006ea398 0x1e /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x28 (size before relaxing) - *fill* 0x00000000006ea3b6 0x2 00 - .rodata.str1.4 - 0x00000000006ea3b8 0x2c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x3c (size before relaxing) - .rodata 0x00000000006ea3e4 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - *fill* 0x00000000006ea3ec 0x4 00 - .rodata 0x00000000006ea3f0 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .rodata 0x00000000006ea480 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .rodata.str1.4 - 0x00000000006ea510 0x18c /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x1b0 (size before relaxing) - *fill* 0x00000000006ea69c 0x4 00 - .rodata.str1.32 - 0x00000000006ea6a0 0x6a0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .rodata 0x00000000006ead40 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.rodata1 - *(.rodata1) - -.eh_frame_hdr 0x00000000006ead60 0x3484 - *(.eh_frame_hdr) - .eh_frame_hdr 0x00000000006ead60 0x3484 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - -.eh_frame 0x00000000006ee1e8 0x404cc - *(.eh_frame) - .eh_frame 0x00000000006ee1e8 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .eh_frame 0x00000000006ee258 0x5a8 unres.o - .eh_frame 0x00000000006ee800 0x38 arcos.o - 0x50 (size before relaxing) - .eh_frame 0x00000000006ee838 0x90 cartprint.o - 0xa8 (size before relaxing) - .eh_frame 0x00000000006ee8c8 0x1b0 chainbuild.o - 0x1c8 (size before relaxing) - .eh_frame 0x00000000006eea78 0x2f8 convert.o - 0x310 (size before relaxing) - .eh_frame 0x00000000006eed70 0x5e8 initialize_p.o - 0x600 (size before relaxing) - .eh_frame 0x00000000006ef358 0x18 matmult.o - 0x30 (size before relaxing) - .eh_frame 0x00000000006ef370 0xfd0 readrtns_CSA.o - 0xfe8 (size before relaxing) - .eh_frame 0x00000000006f0340 0x148 parmread.o - 0x160 (size before relaxing) - .eh_frame 0x00000000006f0488 0xbf8 gen_rand_conf.o - 0xc10 (size before relaxing) - .eh_frame 0x00000000006f1080 0xa0 printmat.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000006f1120 0xc0 map.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f11e0 0x18 pinorm.o - 0x30 (size before relaxing) - .eh_frame 0x00000000006f11f8 0xb0 randgens.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006f12a8 0xa0 rescode.o - 0xb8 (size before relaxing) - .eh_frame 0x00000000006f1348 0x68 intcor.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006f13b0 0x198 timing.o - 0x1b0 (size before relaxing) - .eh_frame 0x00000000006f1548 0x488 misc.o - 0x4a0 (size before relaxing) - .eh_frame 0x00000000006f19d0 0x5a0 intlocal.o - 0x5b8 (size before relaxing) - .eh_frame 0x00000000006f1f70 0xa8 cartder.o - 0xc0 (size before relaxing) - .eh_frame 0x00000000006f2018 0x388 checkder_p.o - 0x3a0 (size before relaxing) - .eh_frame 0x00000000006f23a0 0xb0 econstr_local.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006f2450 0x2398 energy_p_new_barrier.o - 0x23b0 (size before relaxing) - .eh_frame 0x00000000006f47e8 0xa60 energy_p_new-sep_barrier.o - 0xa78 (size before relaxing) - .eh_frame 0x00000000006f5248 0x258 gradient_p.o - 0x270 (size before relaxing) - .eh_frame 0x00000000006f54a0 0x488 minimize_p.o - 0x4a0 (size before relaxing) - .eh_frame 0x00000000006f5928 0x658 sumsld.o - 0x670 (size before relaxing) - .eh_frame 0x00000000006f5f80 0x480 cored.o - 0x498 (size before relaxing) - .eh_frame 0x00000000006f6400 0x30 rmdd.o - 0x48 (size before relaxing) - .eh_frame 0x00000000006f6430 0x458 geomout.o - 0x470 (size before relaxing) - .eh_frame 0x00000000006f6888 0x120 readpdb.o - 0x138 (size before relaxing) - .eh_frame 0x00000000006f69a8 0xc0 regularize.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f6a68 0x4b0 thread.o - 0x4c8 (size before relaxing) - .eh_frame 0x00000000006f6f18 0x318 fitsq.o - 0x330 (size before relaxing) - .eh_frame 0x00000000006f7230 0x8c0 mcm.o - 0x8d8 (size before relaxing) - .eh_frame 0x00000000006f7af0 0x3c8 mc.o - 0x3e0 (size before relaxing) - .eh_frame 0x00000000006f7eb8 0xa8 bond_move.o - 0xc0 (size before relaxing) - .eh_frame 0x00000000006f7f60 0x110 refsys.o - 0x128 (size before relaxing) - .eh_frame 0x00000000006f8070 0x40 check_sc_distr.o - 0x58 (size before relaxing) - .eh_frame 0x00000000006f80b0 0x68 check_bond.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006f8118 0x250 contact.o - 0x268 (size before relaxing) - .eh_frame 0x00000000006f8368 0xc0 djacob.o - 0xd8 (size before relaxing) - .eh_frame 0x00000000006f8428 0xea8 eigen.o - 0xec0 (size before relaxing) - .eh_frame 0x00000000006f92d0 0x520 blas.o - 0x538 (size before relaxing) - .eh_frame 0x00000000006f97f0 0x60 add.o - 0x78 (size before relaxing) - .eh_frame 0x00000000006f9850 0x380 entmcm.o - 0x398 (size before relaxing) - .eh_frame 0x00000000006f9bd0 0xe0 minim_mcmf.o - 0xf8 (size before relaxing) - .eh_frame 0x00000000006f9cb0 0xb90 together.o - 0xba8 (size before relaxing) - .eh_frame 0x00000000006fa840 0x3d0 csa.o - 0x3e8 (size before relaxing) - .eh_frame 0x00000000006fac10 0x310 minim_jlee.o - 0x328 (size before relaxing) - .eh_frame 0x00000000006faf20 0xd8 shift.o - 0xf0 (size before relaxing) - .eh_frame 0x00000000006faff8 0x78 diff12.o - 0x90 (size before relaxing) - .eh_frame 0x00000000006fb070 0xa40 bank.o - 0xa58 (size before relaxing) - .eh_frame 0x00000000006fbab0 0x790 newconf.o - 0x7a8 (size before relaxing) - .eh_frame 0x00000000006fc240 0x60 ran.o - 0x78 (size before relaxing) - .eh_frame 0x00000000006fc2a0 0xb0 indexx.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006fc350 0x480 MP.o - 0x498 (size before relaxing) - .eh_frame 0x00000000006fc7d0 0x358 compare_s1.o - 0x370 (size before relaxing) - .eh_frame 0x00000000006fcb28 0x128 prng_32.o - 0x140 (size before relaxing) - .eh_frame 0x00000000006fcc50 0x948 test.o - 0x960 (size before relaxing) - .eh_frame 0x00000000006fd598 0x2a0 banach.o - 0x2b8 (size before relaxing) - .eh_frame 0x00000000006fd838 0x3a0 distfit.o - 0x3b8 (size before relaxing) - .eh_frame 0x00000000006fdbd8 0x248 rmsd.o - 0x260 (size before relaxing) - .eh_frame 0x00000000006fde20 0x1b8 elecont.o - 0x1d0 (size before relaxing) - .eh_frame 0x00000000006fdfd8 0x268 dihed_cons.o - 0x280 (size before relaxing) - .eh_frame 0x00000000006fe240 0x4c0 sc_move.o - 0x4d8 (size before relaxing) - .eh_frame 0x00000000006fe700 0x538 local_move.o - 0x550 (size before relaxing) - .eh_frame 0x00000000006fec38 0x190 intcartderiv.o - 0x1a8 (size before relaxing) - .eh_frame 0x00000000006fedc8 0x288 /tmp/ipo_ifortScZxT8.o - 0x2a0 (size before relaxing) - .eh_frame 0x00000000006ff050 0x298 stochfric.o - 0x2b0 (size before relaxing) - .eh_frame 0x00000000006ff2e8 0x68 kinetic_lesyng.o - 0x80 (size before relaxing) - .eh_frame 0x00000000006ff350 0x590 MD_A-MTS.o - 0x5a8 (size before relaxing) - .eh_frame 0x00000000006ff8e0 0x1b0 moments.o - 0x1c8 (size before relaxing) - .eh_frame 0x00000000006ffa90 0xb0 int_to_cart.o - 0xc8 (size before relaxing) - .eh_frame 0x00000000006ffb40 0x140 surfatom.o - 0x158 (size before relaxing) - .eh_frame 0x00000000006ffc80 0x4b0 sort.o - 0x4c8 (size before relaxing) - .eh_frame 0x0000000000700130 0x598 muca_md.o - 0x5b0 (size before relaxing) - .eh_frame 0x00000000007006c8 0x420 MREMD.o - 0x438 (size before relaxing) - .eh_frame 0x0000000000700ae8 0x78 rattle.o - 0x90 (size before relaxing) - .eh_frame 0x0000000000700b60 0x1c8 gauss.o - 0x1e0 (size before relaxing) - .eh_frame 0x0000000000700d28 0xa0 energy_split-sep.o - 0xb8 (size before relaxing) - .eh_frame 0x0000000000700dc8 0x3c0 q_measure.o - 0x3d8 (size before relaxing) - .eh_frame 0x0000000000701188 0xa0 gnmr1.o - 0xb8 (size before relaxing) - .eh_frame 0x0000000000701228 0x80 proc_proc.o - 0x98 (size before relaxing) - .eh_frame 0x00000000007012a8 0x40 cinfo.o - 0x58 (size before relaxing) - .eh_frame 0x00000000007012e8 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .eh_frame 0x0000000000701320 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701340 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701360 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701380 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007013a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007013c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007013e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701400 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701420 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701440 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701460 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701480 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007014a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007014c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007014e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701500 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701520 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701540 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701560 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701580 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007015a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007015c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007015e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701600 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701620 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701640 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701660 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701680 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007016a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007016c0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007016e0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701700 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701720 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701740 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701760 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701780 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007017a0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007017c0 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(farg.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000701820 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0xd8 (size before relaxing) - .eh_frame 0x00000000007018e0 0x48 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfcmn.o) - 0x60 (size before relaxing) - .eh_frame 0x0000000000701928 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701948 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701968 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701988 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007019a8 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000701a48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701a68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701a88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701aa8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ac8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ae8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701b88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ba8 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000701c88 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701ca8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701cc8 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000701d28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701d48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701d68 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000701e08 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701e28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701e48 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000701f28 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000701f48 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000702088 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - 0x158 (size before relaxing) - .eh_frame 0x00000000007021c8 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000702288 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007022a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007022c8 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000702408 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702428 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702448 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702468 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702488 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000702588 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007025a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007025c8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007025e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702608 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000702648 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702668 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000702788 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007027a8 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - 0x58 (size before relaxing) - .eh_frame 0x00000000007027e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702808 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702828 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702848 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702868 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702888 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007028a8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007028c8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - 0x38 (size before relaxing) - .eh_frame 0x00000000007028e8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702908 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702928 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000702aa8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702ac8 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702ae8 0x1e0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x1f8 (size before relaxing) - .eh_frame 0x0000000000702cc8 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x1b8 (size before relaxing) - .eh_frame 0x0000000000702e68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702e88 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000702f48 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702f68 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000702f88 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000702fc8 0x400 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - 0x418 (size before relaxing) - .eh_frame 0x00000000007033c8 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - 0xf8 (size before relaxing) - .eh_frame 0x00000000007034a8 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000703508 0x2e8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - 0x300 (size before relaxing) - .eh_frame 0x00000000007037f0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703890 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703930 0x1c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - 0x1d8 (size before relaxing) - .eh_frame 0x0000000000703af0 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000703bf0 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000703cd0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703d10 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703db0 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000703e50 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000703f70 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703fb0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000703ff0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000704030 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - 0xb8 (size before relaxing) - .eh_frame 0x00000000007040d0 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000704150 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000704190 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000704390 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x238 (size before relaxing) - .eh_frame 0x00000000007045b0 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000704630 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000704710 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000704750 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000704890 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - 0x78 (size before relaxing) - .eh_frame 0x00000000007048f0 0x140 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - 0x158 (size before relaxing) - .eh_frame 0x0000000000704a30 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704a50 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000704af0 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000704b70 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704b90 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704bb0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704bd0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704bf0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704c10 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704c30 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704c50 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704c70 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704c90 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704cb0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704cd0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704cf0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704d10 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704d30 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000704e50 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000704e70 0x100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - 0x118 (size before relaxing) - .eh_frame 0x0000000000704f70 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0xb8 (size before relaxing) - .eh_frame 0x0000000000705010 0x80 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - 0x98 (size before relaxing) - .eh_frame 0x0000000000705090 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000705210 0x180 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - 0x198 (size before relaxing) - .eh_frame 0x0000000000705390 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - 0x78 (size before relaxing) - .eh_frame 0x00000000007053f0 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - 0x218 (size before relaxing) - .eh_frame 0x00000000007055f0 0x200 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - 0x218 (size before relaxing) - .eh_frame 0x00000000007057f0 0x2c0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - 0x2d8 (size before relaxing) - .eh_frame 0x0000000000705ab0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000705af0 0x40 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - 0x58 (size before relaxing) - .eh_frame 0x0000000000705b30 0x120 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000705c50 0x1a0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - 0x1b8 (size before relaxing) - .eh_frame 0x0000000000705df0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - 0x38 (size before relaxing) - .eh_frame 0x0000000000705e10 0xe0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - 0xf8 (size before relaxing) - .eh_frame 0x0000000000705ef0 0xc0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0xd8 (size before relaxing) - .eh_frame 0x0000000000705fb0 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - 0x78 (size before relaxing) - .eh_frame 0x0000000000706010 0x358 xdrf_em64/libxdrf.a(libxdrf.o) - 0x370 (size before relaxing) - .eh_frame 0x0000000000706368 0x30 xdrf_em64/libxdrf.a(ftocstr.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000706398 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000706470 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - 0x68 (size before relaxing) - .eh_frame 0x00000000007064c0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - 0x40 (size before relaxing) - .eh_frame 0x00000000007064e8 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000706608 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - 0x68 (size before relaxing) - .eh_frame 0x0000000000706658 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - 0x100 (size before relaxing) - .eh_frame 0x0000000000706740 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - 0x90 (size before relaxing) - .eh_frame 0x00000000007067b8 0x5f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - 0x608 (size before relaxing) - .eh_frame 0x0000000000706da8 0x120 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - 0x138 (size before relaxing) - .eh_frame 0x0000000000706ec8 0x458 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - 0x470 (size before relaxing) - .eh_frame 0x0000000000707320 0x788 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x7a0 (size before relaxing) - .eh_frame 0x0000000000707aa8 0x90 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - 0xa8 (size before relaxing) - .eh_frame 0x0000000000707b38 0x70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x88 (size before relaxing) - .eh_frame 0x0000000000707ba8 0x250 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - 0x268 (size before relaxing) - .eh_frame 0x0000000000707df8 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x300 (size before relaxing) - .eh_frame 0x00000000007080e0 0x9d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - 0x9e8 (size before relaxing) - .eh_frame 0x0000000000708ab0 0x340 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - 0x358 (size before relaxing) - .eh_frame 0x0000000000708df0 0x620 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x638 (size before relaxing) - .eh_frame 0x0000000000709410 0x150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x168 (size before relaxing) - .eh_frame 0x0000000000709560 0x1cd0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x1ce8 (size before relaxing) - .eh_frame 0x000000000070b230 0xe8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - 0x100 (size before relaxing) - .eh_frame 0x000000000070b318 0x4d8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - 0x4f0 (size before relaxing) - .eh_frame 0x000000000070b7f0 0x258 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x270 (size before relaxing) - .eh_frame 0x000000000070ba48 0xa48 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - 0xa60 (size before relaxing) - .eh_frame 0x000000000070c490 0x1680 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - 0x1698 (size before relaxing) - .eh_frame 0x000000000070db10 0x1200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - 0x1218 (size before relaxing) - .eh_frame 0x000000000070ed10 0x19f8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - 0x1a10 (size before relaxing) - .eh_frame 0x0000000000710708 0x2028 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - 0x2040 (size before relaxing) - .eh_frame 0x0000000000712730 0x1880 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - 0x1898 (size before relaxing) - .eh_frame 0x0000000000713fb0 0x568 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - 0x580 (size before relaxing) - .eh_frame 0x0000000000714518 0x668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - 0x680 (size before relaxing) - .eh_frame 0x0000000000714b80 0x1668 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - 0x1680 (size before relaxing) - .eh_frame 0x00000000007161e8 0x24e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - 0x2500 (size before relaxing) - .eh_frame 0x00000000007186d0 0x2150 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - 0x2168 (size before relaxing) - .eh_frame 0x000000000071a820 0x2a08 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - 0x2a20 (size before relaxing) - .eh_frame 0x000000000071d228 0x1c0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - 0x1d8 (size before relaxing) - .eh_frame 0x000000000071d3e8 0x2e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - 0x300 (size before relaxing) - .eh_frame 0x000000000071d6d0 0x470 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - 0x488 (size before relaxing) - .eh_frame 0x000000000071db40 0xc60 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - 0xc78 (size before relaxing) - .eh_frame 0x000000000071e7a0 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - 0x318 (size before relaxing) - .eh_frame 0x000000000071eaa0 0xf8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - 0x110 (size before relaxing) - .eh_frame 0x000000000071eb98 0x1700 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x1718 (size before relaxing) - .eh_frame 0x0000000000720298 0x1b20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - 0x1b38 (size before relaxing) - .eh_frame 0x0000000000721db8 0x1b0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - 0x1c8 (size before relaxing) - .eh_frame 0x0000000000721f68 0x3c8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - 0x3e0 (size before relaxing) - .eh_frame 0x0000000000722330 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000722498 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000722600 0x168 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - 0x180 (size before relaxing) - .eh_frame 0x0000000000722768 0x380 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - 0x398 (size before relaxing) - .eh_frame 0x0000000000722ae8 0x190 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - 0x1a8 (size before relaxing) - .eh_frame 0x0000000000722c78 0x1e8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - 0x200 (size before relaxing) - .eh_frame 0x0000000000722e60 0xa18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - 0xa30 (size before relaxing) - .eh_frame 0x0000000000723878 0x518 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - 0x530 (size before relaxing) - .eh_frame 0x0000000000723d90 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000723e98 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000723ec8 0x1b70 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - 0x1b88 (size before relaxing) - .eh_frame 0x0000000000725a38 0x2f0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - 0x308 (size before relaxing) - .eh_frame 0x0000000000725d28 0x6d0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - 0x6e8 (size before relaxing) - .eh_frame 0x00000000007263f8 0x108 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - 0x120 (size before relaxing) - .eh_frame 0x0000000000726500 0x300 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - 0x318 (size before relaxing) - .eh_frame 0x0000000000726800 0x200 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - 0x218 (size before relaxing) - .eh_frame 0x0000000000726a00 0x310 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - 0x328 (size before relaxing) - .eh_frame 0x0000000000726d10 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - 0x2a0 (size before relaxing) - .eh_frame 0x0000000000726f98 0x288 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - 0x2a0 (size before relaxing) - .eh_frame 0x0000000000727220 0x130 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - 0x148 (size before relaxing) - .eh_frame 0x0000000000727350 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - 0x590 (size before relaxing) - .eh_frame 0x00000000007278c8 0x578 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - 0x590 (size before relaxing) - .eh_frame 0x0000000000727e40 0x520 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - 0x538 (size before relaxing) - .eh_frame 0x0000000000728360 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - 0x150 (size before relaxing) - .eh_frame 0x0000000000728498 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - 0x150 (size before relaxing) - .eh_frame 0x00000000007285d0 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_s_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x00000000007286a8 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_t_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x0000000000728780 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - 0x48 (size before relaxing) - .eh_frame 0x00000000007287b0 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - 0x30 (size before relaxing) - .eh_frame 0x00000000007287c8 0x138 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - 0x150 (size before relaxing) - .eh_frame 0x0000000000728900 0xd8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_x_to_a.o) - 0xf0 (size before relaxing) - .eh_frame 0x00000000007289d8 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000728a08 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000728a30 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000728a58 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - 0x40 (size before relaxing) - .eh_frame 0x0000000000728a80 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - 0x30 (size before relaxing) - .eh_frame 0x0000000000728a98 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - 0x48 (size before relaxing) - .eh_frame 0x0000000000728ac8 0x1fa8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x1fc0 (size before relaxing) - .eh_frame 0x000000000072aa70 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072aa98 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072aab0 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072aac8 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072aae0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ab08 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072ab20 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ab48 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072ab60 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072ab98 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072abd0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072ac08 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ac30 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072ace8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ad10 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ad38 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ad60 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072ad88 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072adb0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072ae68 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072ae80 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072aea8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072aed0 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072af30 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072af90 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072afb8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072afe0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b008 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b030 0x88 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - 0xa0 (size before relaxing) - .eh_frame 0x000000000072b0b8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b0e0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b108 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b130 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072b190 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072b1f0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b218 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072b240 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072b278 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072b2b0 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072b2e8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072b320 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - 0x50 (size before relaxing) - .eh_frame 0x000000000072b358 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072b378 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072b390 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072b3b0 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000072b428 0x78 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - 0x90 (size before relaxing) - .eh_frame 0x000000000072b4a0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b558 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b610 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b6c8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b780 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b838 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b8f0 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072b9a8 0xb8 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - 0xd0 (size before relaxing) - .eh_frame 0x000000000072ba60 0x60 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - 0x78 (size before relaxing) - .eh_frame 0x000000000072bac0 0x100 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - 0x118 (size before relaxing) - .eh_frame 0x000000000072bbc0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072bbe8 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - 0x40 (size before relaxing) - .eh_frame 0x000000000072bc10 0x328 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - 0x340 (size before relaxing) - .eh_frame 0x000000000072bf38 0x830 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x848 (size before relaxing) - .eh_frame 0x000000000072c768 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - 0x30 (size before relaxing) - .eh_frame 0x000000000072c780 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x38 (size before relaxing) - .eh_frame 0x000000000072c7a0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000072c7f0 0x50 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - 0x68 (size before relaxing) - .eh_frame 0x000000000072c840 0x860 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - 0x878 (size before relaxing) - .eh_frame 0x000000000072d0a0 0x680 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - 0x698 (size before relaxing) - .eh_frame 0x000000000072d720 0xa30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - 0xa48 (size before relaxing) - .eh_frame 0x000000000072e150 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - 0x48 (size before relaxing) - .eh_frame 0x000000000072e180 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - 0x178 (size before relaxing) - .eh_frame 0x000000000072e2e0 0x390 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x3a8 (size before relaxing) - .eh_frame 0x000000000072e670 0x40 /usr/lib64/libc_nonshared.a(elf-init.oS) - 0x58 (size before relaxing) - .eh_frame 0x000000000072e6b0 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - 0x000000000072e6b4 . = (ALIGN (0x200000) - ((0x200000 - .) & 0x1fffff)) - 0x000000000092e6b4 . = (0x200000 DATA_SEGMENT_ALIGN 0x1000) - -.eh_frame - *(.eh_frame) - -.gcc_except_table - *(.gcc_except_table .gcc_except_table.*) - -.tdata - *(.tdata .tdata.* .gnu.linkonce.td.*) - -.tbss - *(.tbss .tbss.* .gnu.linkonce.tb.*) - *(.tcommon) - -.preinit_array 0x000000000092e6b4 0x0 - 0x000000000092e6b4 PROVIDE (__preinit_array_start, .) - *(.preinit_array) - 0x000000000092e6b4 PROVIDE (__preinit_array_end, .) - -.init_array 0x000000000092e6b4 0x0 - 0x000000000092e6b4 PROVIDE (__init_array_start, .) - *(SORT(.init_array.*)) - *(.init_array) - 0x000000000092e6b4 PROVIDE (__init_array_end, .) - -.fini_array 0x000000000092e6b4 0x0 - 0x000000000092e6b4 PROVIDE (__fini_array_start, .) - *(.fini_array) - *(SORT(.fini_array.*)) - 0x000000000092e6b4 PROVIDE (__fini_array_end, .) - -.ctors 0x000000000092e6b8 0x10 - *crtbegin.o(.ctors) - .ctors 0x000000000092e6b8 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.ctors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .ctors) - *(SORT(.ctors.*)) - *(.ctors) - .ctors 0x000000000092e6c0 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.dtors 0x000000000092e6c8 0x10 - *crtbegin.o(.dtors) - .dtors 0x000000000092e6c8 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *crtbegin?.o(.dtors) - *(EXCLUDE_FILE(*crtend?.o *crtend.o) .dtors) - *(SORT(.dtors.*)) - *(.dtors) - .dtors 0x000000000092e6d0 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - 0x000000000092e6d0 __DTOR_END__ - -.jcr 0x000000000092e6d8 0x8 - *(.jcr) - .jcr 0x000000000092e6d8 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .jcr 0x000000000092e6d8 0x8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - -.data.rel.ro - *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) - *(.data.rel.ro* .gnu.linkonce.d.rel.ro.*) - -.dynamic 0x000000000092e6e0 0x1d0 - *(.dynamic) - .dynamic 0x000000000092e6e0 0x1d0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092e6e0 _DYNAMIC - -.got 0x000000000092e8b0 0x1c8 - *(.got) - .got 0x000000000092e8b0 0x1c8 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.igot) - 0x000000000092ea78 . = (. DATA_SEGMENT_RELRO_END 0x18) - -.got.plt 0x000000000092ea78 0x570 - *(.got.plt) - .got.plt 0x000000000092ea78 0x570 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092ea78 _GLOBAL_OFFSET_TABLE_ - *(.igot.plt) - .igot.plt 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - -.data 0x000000000092f000 0x1edc0 - *(.data .data.* .gnu.linkonce.d.*) - .data 0x000000000092f000 0x4 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x000000000092f000 data_start - 0x000000000092f000 __data_start - .data 0x000000000092f004 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .data 0x000000000092f004 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x000000000092f004 0x1c 00 - .data 0x000000000092f020 0x760 unres.o - .data 0x000000000092f780 0x9d20 initialize_p.o - 0x000000000092f980 moveid_ - 0x000000000092fa00 langevin_ - 0x0000000000939230 potentials_ - 0x0000000000939240 names_ - 0x00000000009392a0 namterm_ - .data 0x00000000009394a0 0x1540 readrtns_CSA.o - .data 0x000000000093a9e0 0xbc0 parmread.o - .data 0x000000000093b5a0 0x460 gen_rand_conf.o - .data 0x000000000093ba00 0xa0 map.o - .data 0x000000000093baa0 0x60 rescode.o - .data 0x000000000093bb00 0x180 timing.o - .data 0x000000000093bc80 0x18 misc.o - *fill* 0x000000000093bc98 0x8 00 - .data 0x000000000093bca0 0x6a0 checkder_p.o - .data 0x000000000093c340 0xf80 energy_p_new_barrier.o - .data 0x000000000093d2c0 0x340 energy_p_new-sep_barrier.o - .data 0x000000000093d600 0x11a0 cored.o - .data 0x000000000093e7a0 0x30 rmdd.o - *fill* 0x000000000093e7d0 0x10 00 - .data 0x000000000093e7e0 0xae0 geomout.o - .data 0x000000000093f2c0 0x1e0 readpdb.o - .data 0x000000000093f4a0 0x100 regularize.o - .data 0x000000000093f5a0 0x500 thread.o - .data 0x000000000093faa0 0x9c0 mcm.o - .data 0x0000000000940460 0x660 mc.o - .data 0x0000000000940ac0 0x160 bond_move.o - .data 0x0000000000940c20 0x120 contact.o - .data 0x0000000000940d40 0x4a0 eigen.o - .data 0x00000000009411e0 0x740 entmcm.o - .data 0x0000000000941920 0x580 together.o - .data 0x0000000000941ea0 0x34 csa.o - *fill* 0x0000000000941ed4 0xc 00 - .data 0x0000000000941ee0 0x380 minim_jlee.o - .data 0x0000000000942260 0x1220 bank.o - .data 0x0000000000943480 0xe0 newconf.o - .data 0x0000000000943560 0x4 ran.o - *fill* 0x0000000000943564 0x1c 00 - .data 0x0000000000943580 0x1c0 MP.o - .data 0x0000000000943740 0x100 compare_s1.o - .data 0x0000000000943840 0x3fe0 prng_32.o - 0x0000000000943840 ksrprng_ - .data 0x0000000000947820 0xce0 test.o - .data 0x0000000000948500 0x160 rmsd.o - .data 0x0000000000948660 0x640 elecont.o - .data 0x0000000000948ca0 0x1a0 dihed_cons.o - .data 0x0000000000948e40 0x38 sc_move.o - .data 0x0000000000948e78 0x28 local_move.o - .data 0x0000000000948ea0 0x280 intcartderiv.o - .data 0x0000000000949120 0x80 stochfric.o - .data 0x00000000009491a0 0x780 MD_A-MTS.o - .data 0x0000000000949920 0x160 surfatom.o - .data 0x0000000000949a80 0x400 MREMD.o - .data 0x0000000000949e80 0x20 q_measure.o - .data 0x0000000000949ea0 0x0 proc_proc.o - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .data 0x0000000000949ea0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .data 0x0000000000949ea0 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - *fill* 0x0000000000949eb1 0x3 00 - .data 0x0000000000949eb4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .data 0x0000000000949eb4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .data 0x0000000000949eb4 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000000949eb4 MPIR_F_TRUE - .data 0x0000000000949ec0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .data 0x0000000000949ec0 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - *fill* 0x0000000000949eca 0x2 00 - .data 0x0000000000949ecc 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - *fill* 0x0000000000949ed6 0x2 00 - .data 0x0000000000949ed8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .data 0x0000000000949ed8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .data 0x0000000000949ed8 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - *fill* 0x0000000000949ee2 0x2 00 - .data 0x0000000000949ee4 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .data 0x0000000000949ef0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - *fill* 0x0000000000949ef9 0x3 00 - .data 0x0000000000949efc 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - *fill* 0x0000000000949f05 0x3 00 - .data 0x0000000000949f08 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - *fill* 0x0000000000949f13 0x1 00 - .data 0x0000000000949f14 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .data 0x0000000000949f20 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - *fill* 0x0000000000949f2e 0x2 00 - .data 0x0000000000949f30 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - *fill* 0x0000000000949f3b 0x5 00 - .data 0x0000000000949f40 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .data 0x0000000000949f50 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - *fill* 0x0000000000949f64 0xc 00 - .data 0x0000000000949f70 0x11 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - *fill* 0x0000000000949f81 0x3 00 - .data 0x0000000000949f84 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - *fill* 0x0000000000949f92 0x2 00 - .data 0x0000000000949f94 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - *fill* 0x0000000000949f9e 0x2 00 - .data 0x0000000000949fa0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .data 0x0000000000949fa0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - *fill* 0x0000000000949fa9 0x3 00 - .data 0x0000000000949fac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .data 0x0000000000949fac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .data 0x0000000000949fac 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - *fill* 0x0000000000949fac 0x4 00 - .data 0x0000000000949fb0 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .data 0x0000000000949fc4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x0000000000949fc4 0x1c 00 - .data 0x0000000000949fe0 0xce4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .data 0x000000000094acc4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .data 0x000000000094acc4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - *fill* 0x000000000094acc4 0x1c 00 - .data 0x000000000094ace0 0xf8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .data 0x000000000094add8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - *fill* 0x000000000094add8 0x8 00 - .data 0x000000000094ade0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .data 0x000000000094adf0 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - *fill* 0x000000000094adfd 0x3 00 - .data 0x000000000094ae00 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .data 0x000000000094ae00 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - *fill* 0x000000000094ae0d 0x3 00 - .data 0x000000000094ae10 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - *fill* 0x000000000094ae1f 0x1 00 - .data 0x000000000094ae20 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - *fill* 0x000000000094ae2f 0x1 00 - .data 0x000000000094ae30 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - *fill* 0x000000000094ae3f 0x1 00 - .data 0x000000000094ae40 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .data 0x000000000094ae40 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - *fill* 0x000000000094ae4e 0x2 00 - .data 0x000000000094ae50 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - *fill* 0x000000000094ae5f 0x1 00 - .data 0x000000000094ae60 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .data 0x000000000094ae70 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - *fill* 0x000000000094ae7e 0x2 00 - .data 0x000000000094ae80 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .data 0x000000000094ae80 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - *fill* 0x000000000094ae8e 0x2 00 - .data 0x000000000094ae90 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .data 0x000000000094ae90 0xf /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - *fill* 0x000000000094ae9f 0x1 00 - .data 0x000000000094aea0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - *fill* 0x000000000094aea4 0xc 00 - .data 0x000000000094aeb0 0x1a /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - *fill* 0x000000000094aeca 0x2 00 - .data 0x000000000094aecc 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .data 0x000000000094aecc 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .data 0x000000000094aed8 0xa /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - *fill* 0x000000000094aee2 0x2 00 - .data 0x000000000094aee4 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - *fill* 0x000000000094aeef 0x1 00 - .data 0x000000000094aef0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .data 0x000000000094aefc 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - *fill* 0x000000000094af09 0x3 00 - .data 0x000000000094af0c 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - *fill* 0x000000000094af1a 0x2 00 - .data 0x000000000094af1c 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - *fill* 0x000000000094af27 0x1 00 - .data 0x000000000094af28 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - *fill* 0x000000000094af36 0x2 00 - .data 0x000000000094af38 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .data 0x000000000094af38 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .data 0x000000000094af44 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - *fill* 0x000000000094af44 0x1c 00 - .data 0x000000000094af60 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - 0x000000000094afe0 MPIR_inter_collops - *fill* 0x000000000094afe8 0x18 00 - .data 0x000000000094b000 0x103 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - 0x000000000094b080 MPIR_intra_collops - *fill* 0x000000000094b103 0x1 00 - .data 0x000000000094b104 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - *fill* 0x000000000094b10d 0x3 00 - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .data 0x000000000094b110 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .data 0x000000000094b110 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .data 0x000000000094b124 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .data 0x000000000094b128 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .data 0x000000000094b12c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .data 0x000000000094b12c 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .data 0x000000000094b130 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .data 0x000000000094b130 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .data 0x000000000094b134 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .data 0x000000000094b134 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - *fill* 0x000000000094b13f 0x1 00 - .data 0x000000000094b140 0xd /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - *fill* 0x000000000094b14d 0x3 00 - .data 0x000000000094b150 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .data 0x000000000094b160 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - *fill* 0x000000000094b16e 0x2 00 - .data 0x000000000094b170 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - *fill* 0x000000000094b182 0x2 00 - .data 0x000000000094b184 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .data 0x000000000094b190 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - *fill* 0x000000000094b19e 0x2 00 - .data 0x000000000094b1a0 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .data 0x000000000094b1b0 0xe /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - *fill* 0x000000000094b1be 0x2 00 - .data 0x000000000094b1c0 0x9 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - *fill* 0x000000000094b1c9 0x3 00 - .data 0x000000000094b1cc 0xb /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x000000000094b1d7 0x1 00 - .data 0x000000000094b1d8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - *fill* 0x000000000094b1d8 0x8 00 - .data 0x000000000094b1e0 0x13 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - *fill* 0x000000000094b1f3 0x1 00 - .data 0x000000000094b1f4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .data 0x000000000094b1f4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .data 0x000000000094b1f4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .data 0x000000000094b1f4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .data 0x000000000094b1f4 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - 0x000000000094b1f4 p4_hard_errors - .data 0x000000000094b1f8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - *fill* 0x000000000094b1f8 0x8 00 - .data 0x000000000094b200 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .data 0x000000000094b220 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .data 0x000000000094b220 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .data 0x000000000094b220 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .data 0x000000000094b224 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .data 0x000000000094b224 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .data 0x000000000094b224 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .data 0x000000000094b224 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .data 0x000000000094b224 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .data 0x000000000094b224 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .data 0x000000000094b228 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .data 0x000000000094b228 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .data 0x000000000094b228 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .data 0x000000000094b228 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .data 0x000000000094b228 0x0 xdrf_em64/libxdrf.a(libxdrf.o) - .data 0x000000000094b228 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .data 0x000000000094b228 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x000000000094b230 0x10 00 - .data 0x000000000094b240 0x1c20 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .data 0x000000000094ce60 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .data 0x000000000094ce60 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x000000000094ce60 for__segv_default_msg - 0x000000000094ce68 for__l_current_arg - .data 0x000000000094ce70 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .data 0x000000000094ce70 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - *fill* 0x000000000094ce70 0x10 00 - .data 0x000000000094ce80 0x140 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x000000000094ce80 for__static_threadstor_private - .data 0x000000000094cfc0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .data 0x000000000094cfc4 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - *fill* 0x000000000094cfc8 0x18 00 - .data 0x000000000094cfe0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .data 0x000000000094d060 0x460 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - 0x000000000094d488 __libm_pmatherrf - 0x000000000094d490 __libm_pmatherr - 0x000000000094d498 __libm_pmatherrl - 0x000000000094d4a4 _LIB_VERSIONIMF - .data 0x000000000094d4c0 0x28 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .data 0x000000000094d4e8 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data 0x000000000094d4e8 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x000000000094d4e8 __xxref - .data 0x000000000094d4f0 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .data 0x000000000094d520 0x30 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .data 0x000000000094d550 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .data 0x000000000094d550 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - .data 0x000000000094d550 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - *fill* 0x000000000094d570 0x10 00 - .data 0x000000000094d580 0x840 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x000000000094ddb4 __intel_memcpy_mem_ops_method - .data 0x000000000094ddc0 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .data 0x000000000094ddc0 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .data 0x000000000094ddc0 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .data 0x000000000094ddc0 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.data1 0x000000000094ddc0 0x3ba0 - *(.data1) - .data1 0x000000000094ddc0 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_s.o) - .data1 0x000000000094e400 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_t.o) - .data1 0x000000000094ea40 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_s.o) - .data1 0x000000000094ede0 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_t.o) - .data1 0x000000000094f180 0x640 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_a_to_x.o) - .data1 0x000000000094f7c0 0x3a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvtas_nan_x.o) - .data1 0x000000000094fb60 0x1a40 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .data1 0x00000000009515a0 0x10 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - *fill* 0x00000000009515b0 0x10 00 - .data1 0x00000000009515c0 0x80 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .data1 0x0000000000951640 0x320 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - -.sharable_data 0x0000000000a00000 0x0 - 0x0000000000a00000 PROVIDE (__sharable_data_start, .) - *(.sharable_data .sharable_data.* .gnu.linkonce.shrd.*) - 0x0000000000a00000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x0000000000a00000 PROVIDE (__sharable_data_end, .) - 0x0000000000a00000 _edata = . - 0x0000000000a00000 PROVIDE (edata, .) - 0x0000000000a00000 __bss_start = . - -.bss 0x0000000000951980 0xf0fecdc0 - *(.dynbss) - .dynbss 0x0000000000951980 0x28 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x0000000000951980 environ@@GLIBC_2.2.5 - 0x0000000000951980 __environ@@GLIBC_2.2.5 - 0x0000000000951980 _environ@@GLIBC_2.2.5 - 0x0000000000951988 stdin@@GLIBC_2.2.5 - 0x0000000000951990 stderr@@GLIBC_2.2.5 - 0x00000000009519a0 stdout@@GLIBC_2.2.5 - *(.bss .bss.* .gnu.linkonce.b.*) - .bss 0x00000000009519a8 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - .bss 0x00000000009519a8 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .bss 0x00000000009519a8 0x10 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - *fill* 0x00000000009519b8 0x8 00 - .bss 0x00000000009519c0 0x13060 unres.o - .bss 0x0000000000964a20 0x20 chainbuild.o - .bss 0x0000000000964a40 0x12c00 convert.o - .bss 0x0000000000977640 0x10c0 initialize_p.o - .bss 0x0000000000978700 0x60 matmult.o - .bss 0x0000000000978760 0x4d60 readrtns_CSA.o - .bss 0x000000000097d4c0 0x1a0 parmread.o - *fill* 0x000000000097d660 0x20 00 - .bss 0x000000000097d680 0x2ec0 gen_rand_conf.o - .bss 0x0000000000980540 0x25960 map.o - .bss 0x00000000009a5ea0 0x2440 randgens.o - .bss 0x00000000009a82e0 0x10 timing.o - *fill* 0x00000000009a82f0 0x10 00 - .bss 0x00000000009a8300 0xc0 misc.o - .bss 0x00000000009a83c0 0x80 intlocal.o - .bss 0x00000000009a8440 0xa8d00 cartder.o - .bss 0x0000000000a51140 0xead60 checkder_p.o - *fill* 0x0000000000b3bea0 0x20 00 - .bss 0x0000000000b3bec0 0xe21f700 energy_p_new_barrier.o - .bss 0x000000000ed5b5c0 0x3e0 energy_p_new-sep_barrier.o - .bss 0x000000000ed5b9a0 0x83960 minimize_p.o - .bss 0x000000000eddf300 0xc8 cored.o - *fill* 0x000000000eddf3c8 0x18 00 - .bss 0x000000000eddf3e0 0x10940 geomout.o - .bss 0x000000000edefd20 0x2c0 readpdb.o - .bss 0x000000000edeffe0 0x1604e40 regularize.o - .bss 0x00000000103f4e20 0x380 thread.o - *fill* 0x00000000103f51a0 0x20 00 - .bss 0x00000000103f51c0 0x2c0 fitsq.o - .bss 0x00000000103f5480 0x386e0 mcm.o - .bss 0x000000001042db60 0x38600 mc.o - .bss 0x0000000010466160 0x140 bond_move.o - .bss 0x00000000104662a0 0xc0 check_bond.o - .bss 0x0000000010466360 0x38400 contact.o - .bss 0x000000001049e760 0x4c0 djacob.o - .bss 0x000000001049ec20 0x25940 entmcm.o - .bss 0x00000000104c4560 0x25960 minim_mcmf.o - .bss 0x00000000104e9ec0 0x602e0 together.o - .bss 0x000000001054a1a0 0xc0 csa.o - .bss 0x000000001054a260 0x162cde0 minim_jlee.o - .bss 0x0000000011b77040 0x1a0 bank.o - .bss 0x0000000011b771e0 0xfaa0 newconf.o - .bss 0x0000000011b86c80 0x240 ran.o - .bss 0x0000000011b86ec0 0x7e0 indexx.o - .bss 0x0000000011b876a0 0x2180 MP.o - .bss 0x0000000011b89820 0x12c80 compare_s1.o - .bss 0x0000000011b9c4a0 0x4e83340 test.o - .bss 0x0000000016a1f7e0 0xe180 distfit.o - .bss 0x0000000016a2d960 0x70a00 rmsd.o - .bss 0x0000000016a9e360 0x7c400 elecont.o - .bss 0x0000000016b1a760 0xc0 dihed_cons.o - .bss 0x0000000016b1a820 0x4b340 sc_move.o - .bss 0x0000000016b65b60 0x200 local_move.o - .bss 0x0000000016b65d60 0x19c8c0 intcartderiv.o - .bss 0x0000000016d02620 0x156400 /tmp/ipo_ifortScZxT8.o - .bss 0x0000000016e58a20 0x7ea40 stochfric.o - .bss 0x0000000016ed7460 0x40 kinetic_lesyng.o - .bss 0x0000000016ed74a0 0xbbd20 MD_A-MTS.o - .bss 0x0000000016f931c0 0x3c0 moments.o - .bss 0x0000000016f93580 0xce60 surfatom.o - .bss 0x0000000016fa03e0 0x300 sort.o - .bss 0x0000000016fa06e0 0x50a0 muca_md.o - .bss 0x0000000016fa5780 0xde1de0 MREMD.o - .bss 0x0000000017d87560 0x180 energy_split-sep.o - .bss 0x0000000017d876e0 0x6bda0 q_measure.o - .bss 0x0000000017df3480 0x10 proc_proc.o - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .bss 0x0000000017df3490 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .bss 0x0000000017df3490 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x0000000017df3490 MPIR_F_FALSE - 0x0000000017df3498 MPIR_F_MPI_BOTTOM - 0x0000000017df34a0 MPIR_F_STATUS_IGNORE - 0x0000000017df34a8 MPIR_F_STATUSES_IGNORE - .bss 0x0000000017df34b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .bss 0x0000000017df34b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .bss 0x0000000017df34b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .bss 0x0000000017df34b0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .bss 0x0000000017df34b0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .bss 0x0000000017df34b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - *fill* 0x0000000017df34b4 0x4 00 - .bss 0x0000000017df34b8 0x50 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x0000000017df34b8 MPIR_Infotable - 0x0000000017df34c0 MPIR_Infotable_ptr - 0x0000000017df34c4 MPIR_Infotable_max - 0x0000000017df34c8 MPIR_COMM_WORLD - 0x0000000017df34d0 MPIR_COMM_SELF - 0x0000000017df34d8 MPIR_GROUP_EMPTY - 0x0000000017df34e0 MPIR_Has_been_initialized - 0x0000000017df34e4 MPIR_Print_queues - 0x0000000017df34e8 MPIR_Dump_Mem - 0x0000000017df34ec MPIR_Dump_Ptrs - 0x0000000017df34f0 MPICHX_QOS_BANDWIDTH - 0x0000000017df34f4 MPICHX_QOS_PARAMETERS - .bss 0x0000000017df3508 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .bss 0x0000000017df3508 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .bss 0x0000000017df3508 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x0000000017df3508 MPIR_PACKED_PTR - .bss 0x0000000017df3510 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .bss 0x0000000017df3510 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - *fill* 0x0000000017df3510 0x10 00 - .bss 0x0000000017df3520 0x2100 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .bss 0x0000000017df5620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .bss 0x0000000017df5620 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .bss 0x0000000017df5620 0x6820 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .bss 0x0000000017dfbe40 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .bss 0x0000000017dfbe4c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .bss 0x0000000017dfbe4c 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - 0x0000000017dfbe4c MPIR_TOPOLOGY_KEYVAL - .bss 0x0000000017dfbe50 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .bss 0x0000000017dfbe50 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .bss 0x0000000017dfbe50 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - *fill* 0x0000000017dfbe50 0x10 00 - .bss 0x0000000017dfbe60 0x1058 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .bss 0x0000000017dfceb8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .bss 0x0000000017dfceb8 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .bss 0x0000000017dfcec0 0x5c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - *fill* 0x0000000017dfcf1c 0x4 00 - .bss 0x0000000017dfcf20 0x220 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .bss 0x0000000017dfd140 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .bss 0x0000000017dfd14c 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - *fill* 0x0000000017dfd14c 0x4 00 - .bss 0x0000000017dfd150 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - *fill* 0x0000000017dfd158 0x8 00 - .bss 0x0000000017dfd160 0x520 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x0000000017dfd160 start_prog_error - .bss 0x0000000017dfd680 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - 0x0000000017dfd680 usc_MD_rollover_val - .bss 0x0000000017dfd688 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .bss 0x0000000017dfd688 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .bss 0x0000000017dfd688 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x0000000017dfd688 MPID_Print_queues - 0x0000000017dfd68c MPID_n_pending - 0x0000000017dfd690 MPID_devset - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .bss 0x0000000017dfd698 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .bss 0x0000000017dfd698 0x1c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - 0x0000000017dfd698 MPID_TRACE_FILE - 0x0000000017dfd6a0 MPID_DEBUG_FILE - 0x0000000017dfd6a8 MPID_UseDebugFile - 0x0000000017dfd6ac MPID_DebugFlag - .bss 0x0000000017dfd6b4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - *fill* 0x0000000017dfd6b4 0x4 00 - .bss 0x0000000017dfd6b8 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x0000000017dfd6b8 MPID_procinfo - 0x0000000017dfd6c0 MPID_IS_HETERO - *fill* 0x0000000017dfd6c4 0x4 00 - .bss 0x0000000017dfd6c8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .bss 0x0000000017dfd6d8 0x8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .bss 0x0000000017dfd6e0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .bss 0x0000000017dfd6e0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .bss 0x0000000017dfd6e0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .bss 0x0000000017dfd6e0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .bss 0x0000000017dfd6e0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - 0x0000000017dfd6e0 expect_cancel_ack - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .bss 0x0000000017dfd6e4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - *fill* 0x0000000017dfd6e4 0x1c 00 - .bss 0x0000000017dfd700 0x88 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x0000000017dfd700 MPIR_proctable - 0x0000000017dfd708 MPIR_proctable_size - 0x0000000017dfd70c MPIR_debug_state - 0x0000000017dfd710 MPIR_debug_gate - 0x0000000017dfd718 MPIR_debug_abort_string - 0x0000000017dfd720 MPIR_being_debugged - .bss 0x0000000017dfd788 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .bss 0x0000000017dfd788 0x19 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - *fill* 0x0000000017dfd7a1 0x3 00 - .bss 0x0000000017dfd7a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .bss 0x0000000017dfd7a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .bss 0x0000000017dfd7a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - *fill* 0x0000000017dfd7a4 0x4 00 - .bss 0x0000000017dfd7a8 0x70 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - *fill* 0x0000000017dfd818 0x8 00 - .bss 0x0000000017dfd820 0x64 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .bss 0x0000000017dfd884 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - *fill* 0x0000000017dfd884 0xc 00 - .bss 0x0000000017dfd890 0x14 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .bss 0x0000000017dfd8a4 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - *fill* 0x0000000017dfd8a4 0x4 00 - .bss 0x0000000017dfd8a8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .bss 0x0000000017dfd8b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .bss 0x0000000017dfd8b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .bss 0x0000000017dfd8b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .bss 0x0000000017dfd8b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .bss 0x0000000017dfd8b8 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .bss 0x0000000017dfd8b8 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .bss 0x0000000017dfd8bc 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .bss 0x0000000017dfd8c0 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .bss 0x0000000017dfd8c0 0xc /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - 0x0000000017dfd8c0 MPID_flow_info - 0x0000000017dfd8c8 MPID_DebugFlow - .bss 0x0000000017dfd8cc 0x0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - *fill* 0x0000000017dfd8cc 0x14 00 - .bss 0x0000000017dfd8e0 0x178 xdrf_em64/libxdrf.a(libxdrf.o) - .bss 0x0000000017dfda58 0x0 xdrf_em64/libxdrf.a(ftocstr.o) - .bss 0x0000000017dfda58 0x20 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - *fill* 0x0000000017dfda78 0x8 00 - .bss 0x0000000017dfda80 0x240 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x0000000017dfdc88 for__user_iomsg_buf - 0x0000000017dfdc90 for__user_iomsg_len - .bss 0x0000000017dfdcc0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - 0x0000000017dfdcc0 for__l_exit_termination - *fill* 0x0000000017dfdcc4 0x4 00 - .bss 0x0000000017dfdcc8 0x38 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x0000000017dfdcd0 for__l_excpt_info - 0x0000000017dfdcd8 for__l_fpe_mask - 0x0000000017dfdcdc for__l_undcnt - 0x0000000017dfdce0 for__l_ovfcnt - 0x0000000017dfdce4 for__l_div0cnt - 0x0000000017dfdce8 for__l_invcnt - 0x0000000017dfdcec for__l_inecnt - 0x0000000017dfdcf0 for__l_fmtrecl - 0x0000000017dfdcf4 for__l_ufmtrecl - 0x0000000017dfdcf8 for__l_blocksize - 0x0000000017dfdcfc for__l_buffercount - .bss 0x0000000017dfdd00 0x3b40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - 0x0000000017dff120 for__lub_table - .bss 0x0000000017e01840 0x20a0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - 0x0000000017e01840 for__file_info_hash_table - .bss 0x0000000017e038e0 0x440 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - 0x0000000017e03d00 for__l_exit_hand_decl - .bss 0x0000000017e03d20 0x18 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - 0x0000000017e03d30 for__reentrancy_mode - 0x0000000017e03d34 for__reentrancy_initialized - .bss 0x0000000017e03d38 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .bss 0x0000000017e03d40 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - *fill* 0x0000000017e03d4c 0x4 00 - .bss 0x0000000017e03d50 0x40 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .bss 0x0000000017e03d90 0xc0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x0000000017e03e20 for__aio_global_mutex - .bss 0x0000000017e03e50 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - *fill* 0x0000000017e03e58 0x8 00 - .bss 0x0000000017e03e60 0x160 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - 0x0000000017e03ee0 tbk__jmp_env - .bss 0x0000000017e03fc0 0x4 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - 0x0000000017e03fc0 __intel_cpu_indicator - .bss 0x0000000017e03fc4 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memcpy_pp.o) - .bss 0x0000000017e03fc4 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_memset_pp.o) - *fill* 0x0000000017e03fc4 0x1c 00 - .bss 0x0000000017e03fe0 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .bss 0x0000000017e04400 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - 0x0000000017e04400 __intel_memcpy_largest_cache_size - 0x0000000017e04404 __intel_memcpy_largest_cachelinesize - .bss 0x0000000017e04408 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fast_get_cpuid.o) - .bss 0x0000000017e04408 0x0 /usr/lib64/libc_nonshared.a(elf-init.oS) - .bss 0x0000000017e04408 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .bss 0x0000000017e04408 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - *(COMMON) - *fill* 0x0000000017e04408 0x18 00 - COMMON 0x0000000017e04420 0x947a9f10 unres.o - 0x0000000017e04420 header_ - 0x0000000017e04480 timing_ - 0x0000000017e045c0 ffield_ - 0x0000000017e04740 refstruct_ - 0x0000000017e3cbb0 sumsl_flag_ - 0x0000000017e3cbc0 links_split_ - 0x0000000017e3cbe0 precomp1_ - 0x0000000017f1dbe0 chain_ - 0x0000000017fc6860 parfiles_ - 0x0000000017fc7360 rotat_old_ - 0x0000000017fd9f60 contacts1_ - 0x000000001b14c8e0 diploc_ - 0x000000001b150220 mdpmpi_ - 0x000000001b158240 iounits_ - 0x000000001b1582c0 mdpar_ - 0x000000001b158340 remdrestart_ - 0x000000001b569b60 restr_ - 0x000000001b583800 precomp2_ - 0x000000001b664800 links_ - 0x000000001f83a6a0 mdgrad_ - 0x000000001f872ad0 from_zscore_ - 0x000000001f872ae0 types_ - 0x000000001f872b40 back_constr_ - 0x000000001f89bd20 setup_ - 0x000000001f8a1d60 restraints_ - 0x000000001f8a1d80 qmeas_ - 0x000000001f9342c0 mpipriv_ - 0x000000001f934300 cntrl_ - 0x000000001f934380 rotmat_ - 0x000000001f9dcf80 lagrange_ - 0x00000000619f1440 fnames_ - 0x00000000619f2450 stoptim_ - 0x00000000619f2460 time1_ - 0x00000000619f24a0 mdcalc_ - 0x00000000619f25c0 dipmat_ - 0x000000008d9125c0 remdcommon_ - 0x000000008d918600 sbridge_ - 0x000000008d9186a0 csafiles_ - 0x000000008d9192a0 inertia_ - 0x000000008d919400 contacts_hb_ - 0x00000000a1237d80 srutu_ - 0x00000000a1237da0 contdistrib_ - 0x00000000ac22d640 traj1cache_ - 0x00000000ac2bbc20 stretch_ - 0x00000000ac2bc240 contacts_ - 0x00000000ac32ca60 geo_ - 0x00000000ac32caa0 csaunits_ - 0x00000000ac32cae0 body_ - 0x00000000ac332c60 interact_ - 0x00000000ac35ad20 oldgeo_ - 0x00000000ac4d1e20 rotat_ - 0x00000000ac542620 var_ - *fill* 0x00000000ac5ae330 0x10 00 - COMMON 0x00000000ac5ae340 0x37d50 chainbuild.o - 0x00000000ac5ae340 thetas_ - 0x00000000ac5aeca0 peptbond_ - 0x00000000ac5aece0 indices_ - 0x00000000ac5b5d40 sclocal_ - 0x00000000ac5b8020 invlen_ - 0x00000000ac5c1620 theta_abinitio_ - *fill* 0x00000000ac5e6090 0x10 00 - COMMON 0x00000000ac5e60a0 0x10b6c2c0 initialize_p.o - 0x00000000ac5e60a0 deriv_loc_ - 0x00000000ac5e6280 splitele_ - 0x00000000ac5e62a0 fourier_ - 0x00000000ac5e6600 torsiond_ - 0x00000000ac5fa800 machsw_ - 0x00000000ac5fa820 derivat_ - 0x00000000bd0abfa0 deriv_scloc_ - 0x00000000bd12a8a0 mpgrad_ - 0x00000000bd12f3c0 torcnstr_ - 0x00000000bd13d4e0 mcm_ - 0x00000000bd13f5a0 move_ - 0x00000000bd148c20 windows_ - 0x00000000bd14fcc0 accept_stats_ - 0x00000000bd151ce0 iofile_ - 0x00000000bd152340 minimm_ - COMMON 0x00000000bd152360 0x16282550 readrtns_CSA.o - 0x00000000bd152360 mvstat_ - 0x00000000bd1525b0 dih_control_ - 0x00000000bd1525c0 bounds_ - 0x00000000bd15bbc0 alphaa_ - 0x00000000bd198ae0 bank_ - 0x00000000bd1e3c00 mce_ - 0x00000000bd1e3e40 mucarem_ - 0x00000000bd1ebe40 mapp_ - 0x00000000bd236e60 langforc_ - 0x00000000d3253900 minvar_ - 0x00000000d3279280 struct_ - 0x00000000d3279cc0 pool_ - 0x00000000d3335520 double_muca_ - 0x00000000d3380560 csa_input_ - 0x00000000d3380600 diffcuta_ - 0x00000000d3380620 thread_ - 0x00000000d3380780 pizda_ - 0x00000000d3382d00 varin_ - 0x00000000d33a8660 bank_disulfid_ - 0x00000000d33a8860 thread1_ - 0x00000000d33aa530 langmat_ - 0x00000000d33aa540 integer_muca_ - 0x00000000d33aa550 mce_counters_ - 0x00000000d33aa580 send2_ - *fill* 0x00000000d33d48b0 0x10 00 - COMMON 0x00000000d33d48c0 0x8380 parmread.o - 0x00000000d33d48c0 torsion_ - 0x00000000d33da3a0 scrot_ - COMMON 0x00000000d33dcc40 0x1f0 gen_rand_conf.o - 0x00000000d33dcc40 calc_ - *fill* 0x00000000d33dce30 0x10 00 - COMMON 0x00000000d33dce40 0x3f0 randgens.o - 0x00000000d33dce40 vrandd_ - *fill* 0x00000000d33dd230 0x10 00 - COMMON 0x00000000d33dd240 0x6844 timing.o - 0x00000000d33dd240 info_ - 0x00000000d33e1260 info1_ - COMMON 0x00000000d33e3a84 0x0 cartder.o - *fill* 0x00000000d33e3a84 0x1c 00 - COMMON 0x00000000d33e3aa0 0xc5204 energy_p_new_barrier.o - 0x00000000d33e3aa0 calcthet_ - 0x00000000d33e3b40 locel_ - 0x00000000d33e3dc0 maxgrad_ - 0x00000000d33e3e70 sccalc_ - 0x00000000d33e3ea0 vectors_ - 0x00000000d34a8ca0 kutas_ - *fill* 0x00000000d34a8ca4 0xc 00 - COMMON 0x00000000d34a8cb0 0x4 minimize_p.o - 0x00000000d34a8cb0 chuju_ - *fill* 0x00000000d34a8cb4 0xc 00 - COMMON 0x00000000d34a8cc0 0x2c02768 geomout.o - 0x00000000d34a8cc0 frag_ - 0x00000000d34a8d60 wagi_ - 0x00000000d34a8d80 frozen_ - 0x00000000d34ab300 pochodne_ - 0x00000000d60a6910 store0_ - 0x00000000d60a6920 c_frag_ - *fill* 0x00000000d60ab428 0x18 00 - COMMON 0x00000000d60ab440 0xbb8d0 mcm.o - 0x00000000d60ab440 cache_ - *fill* 0x00000000d6166d10 0x10 00 - COMMON 0x00000000d6166d20 0x98 bond_move.o - 0x00000000d6166d20 refer_ - *fill* 0x00000000d6166db8 0x8 00 - COMMON 0x00000000d6166dc0 0xc djacob.o - 0x00000000d6166dc0 __BLNK__ - *fill* 0x00000000d6166dcc 0x4 00 - COMMON 0x00000000d6166dd0 0x20 eigen.o - 0x00000000d6166dd0 par_ - COMMON 0x00000000d6166df0 0x0 minim_mcmf.o - *fill* 0x00000000d6166df0 0x10 00 - COMMON 0x00000000d6166e00 0x708c newconf.o - 0x00000000d6166e00 spinka_ - *fill* 0x00000000d616de8c 0x4 00 - COMMON 0x00000000d616de90 0x8 MP.o - 0x00000000d616de90 aaaa_ - *fill* 0x00000000d616de98 0x8 00 - COMMON 0x00000000d616dea0 0x1c200 banach.o - 0x00000000d616dea0 banii_ - COMMON 0x00000000d618a0a0 0x960 dihed_cons.o - 0x00000000d618a0a0 secondarys_ - COMMON 0x00000000d618aa00 0x360 local_move.o - 0x00000000d618aa00 loc_work_ - 0x00000000d618ad20 loc_const_ - COMMON 0x00000000d618ad60 0x4 /tmp/ipo_ifortScZxT8.o - 0x00000000d618ad60 cipiszcze_ - *fill* 0x00000000d618ad64 0x1c 00 - COMMON 0x00000000d618ad80 0x1b794d00 stochfric.o - 0x00000000d618ad80 przechowalnia_ - 0x00000000f1903880 syfek_ - COMMON 0x00000000f191fa80 0x1c218 MD_A-MTS.o - 0x00000000f191fa80 stochcalc_ - 0x00000000f193bc80 gucio_ - *fill* 0x00000000f193bc98 0x8 00 - COMMON 0x00000000f193bca0 0xbe8 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - 0x00000000f193bca0 MPIR_I_COMPLEX - 0x00000000f193bd60 MPIR_I_DOUBLE_PRECISION - 0x00000000f193be20 MPIR_I_2DCOMPLEX - 0x00000000f193bee0 MPIR_real8_dte - 0x00000000f193bfa0 MPIR_int1_dte - 0x00000000f193c060 MPIR_I_REAL - 0x00000000f193c120 MPIR_I_2REAL - 0x00000000f193c1e0 MPIR_I_DCOMPLEX - 0x00000000f193c2a0 MPIR_I_INTEGER - 0x00000000f193c360 MPIR_real4_dte - 0x00000000f193c420 MPIR_I_2DOUBLE_PRECISION - 0x00000000f193c4e0 MPIR_I_2INTEGER - 0x00000000f193c5a0 MPIR_I_2COMPLEX - 0x00000000f193c660 MPIR_I_LOGICAL - 0x00000000f193c720 MPIR_int2_dte - 0x00000000f193c7e0 MPIR_int4_dte - COMMON 0x00000000f193c888 0x28 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - 0x00000000f193c888 MPIR_errhandlers - 0x00000000f193c890 MPIR_topo_els - 0x00000000f193c898 MPIR_tid - 0x00000000f193c8a0 MPIR_fdtels - 0x00000000f193c8a8 MPIR_qels - *fill* 0x00000000f193c8b0 0x10 00 - COMMON 0x00000000f193c8c0 0x1228 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - 0x00000000f193c8c0 MPIR_I_LONG_LONG_INT - 0x00000000f193c980 MPIR_I_LONG_INT - 0x00000000f193ca40 MPIR_I_SHORT - 0x00000000f193cb00 MPI_LONG_DOUBLE_INT_var - 0x00000000f193cb20 MPIR_dtes - 0x00000000f193cb40 MPIR_I_UB - 0x00000000f193cc00 MPIR_I_FLOAT_INT - 0x00000000f193ccc0 MPIR_I_SHORT_INT - 0x00000000f193cd70 MPI_DOUBLE_INT_var - 0x00000000f193cd80 MPIR_I_2INT - 0x00000000f193ce40 MPIR_I_USHORT - 0x00000000f193cf00 MPIR_I_FLOAT - 0x00000000f193cfc0 MPIR_I_UINT - 0x00000000f193d068 MPI_FLOAT_INT_var - 0x00000000f193d080 MPIR_I_BYTE - 0x00000000f193d140 MPIR_I_CHAR - 0x00000000f193d200 MPIR_I_PACKED - 0x00000000f193d2c0 MPIR_I_INT - 0x00000000f193d380 MPIR_I_DOUBLE_INT - 0x00000000f193d440 MPIR_I_LONG_DOUBLE - 0x00000000f193d500 MPIR_I_2FLOAT - 0x00000000f193d5c0 MPIR_I_UCHAR - 0x00000000f193d680 MPIR_I_2DOUBLE - 0x00000000f193d728 MPI_SHORT_INT_var - 0x00000000f193d740 MPIR_I_LONG - 0x00000000f193d800 MPIR_I_ULONG - 0x00000000f193d8c0 MPIR_I_LONG_DOUBLE_INT - 0x00000000f193d970 MPI_LONG_INT_var - 0x00000000f193d980 MPIR_I_LB - 0x00000000f193da40 MPIR_I_DOUBLE - COMMON 0x00000000f193dae8 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - 0x00000000f193dae8 MPIR_hbt_els - 0x00000000f193daf0 MPIR_hbts - COMMON 0x00000000f193daf8 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - 0x00000000f193daf8 MPIR_Op_errno - *fill* 0x00000000f193dafc 0x4 00 - COMMON 0x00000000f193db00 0x12 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - 0x00000000f193db00 tty_orig - *fill* 0x00000000f193db12 0xe 00 - COMMON 0x00000000f193db20 0xa0 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - 0x00000000f193db20 MPID_MyWorldSize - 0x00000000f193db24 MPID_MyWorldRank - 0x00000000f193db28 MPIR_rhandles - 0x00000000f193db30 MPIR_shandles - 0x00000000f193db40 ch_debug_buf - COMMON 0x00000000f193dbc0 0x4 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - 0x00000000f193dbc0 MPID_byte_order - COMMON 0x00000000f193dbc4 0x10 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - 0x00000000f193dbc4 __P4FROM - 0x00000000f193dbc8 __P4GLOBALTYPE - 0x00000000f193dbcc __P4TYPE - 0x00000000f193dbd0 __P4LEN - *fill* 0x00000000f193dbd4 0xc 00 - COMMON 0x00000000f193dbe0 0x20 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - 0x00000000f193dbe0 MPID_recvs - COMMON 0x00000000f193dc00 0x24 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - 0x00000000f193dc00 total_pack_unacked - 0x00000000f193dc10 MPID_pack_info - 0x00000000f193dc20 expect_ack - *fill* 0x00000000f193dc24 0xc 00 - COMMON 0x00000000f193dc30 0x60 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - 0x00000000f193dc30 MPIR_debug_q - 0x00000000f193dc38 MPIR_debug_sq - 0x00000000f193dc40 MPIR_debug_rh - 0x00000000f193dc50 MPIR_All_communicators - 0x00000000f193dc60 MPIR_debug_qh - 0x00000000f193dc68 MPIR_debug_s - 0x00000000f193dc70 MPIR_debug_c - 0x00000000f193dc78 MPIR_debug_qel - 0x00000000f193dc80 MPIR_debug_sqel - 0x00000000f193dc88 MPIR_debug_cl - *fill* 0x00000000f193dc90 0x10 00 - COMMON 0x00000000f193dca0 0x64c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - 0x00000000f193dca0 bm_outfile - 0x00000000f193dd20 rm_outfile_head - 0x00000000f193dd88 execer_pg - 0x00000000f193dd90 globmemsize - 0x00000000f193dd94 p4_rm_rank - 0x00000000f193dda0 p4_brdcst_info - 0x00000000f193ddc0 procgroup_file - 0x00000000f193dec0 p4_global - 0x00000000f193dec8 execer_mastport - 0x00000000f193dee0 execer_id - 0x00000000f193df64 execer_numtotnodes - 0x00000000f193df68 listener_info - 0x00000000f193df70 p4_local - 0x00000000f193df78 logging_flag - 0x00000000f193df80 execer_myhost - 0x00000000f193e000 p4_wd - 0x00000000f193e100 p4_remote_debug_level - 0x00000000f193e104 sserver_port - 0x00000000f193e120 p4_myname_in_procgroup - 0x00000000f193e160 hand_start_remotes - 0x00000000f193e164 execer_starting_remotes - 0x00000000f193e180 whoami_p4 - 0x00000000f193e200 execer_masthost - 0x00000000f193e264 p4_debug_level - 0x00000000f193e280 local_domain - 0x00000000f193e2e4 execer_mynumprocs - 0x00000000f193e2e8 execer_mynodenum - *fill* 0x00000000f193e2ec 0x4 00 - COMMON 0x00000000f193e2f0 0x8 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - 0x00000000f193e2f0 message_catalog - COMMON 0x00000000f193e2f8 0xc /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - 0x00000000f193e2f8 for__a_argv - 0x00000000f193e300 for__l_argc - *fill* 0x00000000f193e304 0x1c 00 - COMMON 0x00000000f193e320 0x420 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - 0x00000000f193e320 for__pthread_mutex_unlock_ptr - 0x00000000f193e328 for__pthread_mutex_init_ptr - 0x00000000f193e330 for__pthread_mutex_lock_ptr - 0x00000000f193e340 for__aio_lub_table - 0x00000000f193e740 . = ALIGN ((. != 0x0)?0x8:0x1) - -.lbss - *(.dynlbss) - *(.lbss .lbss.* .gnu.linkonce.lb.*) - *(LARGE_COMMON) - -.sharable_bss 0x00000000f1a00000 0x0 - 0x00000000f1a00000 PROVIDE (__sharable_bss_start, .) - *(.dynsharablebss) - .dynsharablebss - 0x0000000000000000 0x0 /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - *(.sharable_bss .sharable_bss.* .gnu.linkonce.shrb.*) - *(SHARABLE_COMMON) - 0x00000000f1a00000 . = ALIGN ((. != 0x0)?0x200000:0x1) - 0x00000000f1a00000 PROVIDE (__sharable_bss_end, .) - 0x00000000f1a00000 . = ALIGN (0x8) - -.lrodata - *(.lrodata .lrodata.* .gnu.linkonce.lr.*) - -.ldata 0x00000000f1d3e740 0x0 - *(.ldata .ldata.* .gnu.linkonce.l.*) - 0x00000000f1d3e740 . = ALIGN ((. != 0x0)?0x8:0x1) - 0x00000000f1d3e740 . = ALIGN (0x8) - 0x00000000f1d3e740 _end = . - 0x00000000f1d3e740 PROVIDE (end, .) - 0x00000000f1d3e740 . = DATA_SEGMENT_END (.) - -.stab - *(.stab) - -.stabstr - *(.stabstr) - -.stab.excl - *(.stab.excl) - -.stab.exclstr - *(.stab.exclstr) - -.stab.index - *(.stab.index) - -.stab.indexstr - *(.stab.indexstr) - -.comment 0x0000000000000000 0x2143 - *(.comment) - .comment 0x0000000000000000 0x2c /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crt1.o - 0x2d (size before relaxing) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crti.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtbegin.o - .comment 0x000000000000002c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .comment 0x000000000000003f 0x13 unres.o - .comment 0x0000000000000052 0x29 energy_p_new_barrier.o - .comment 0x0000000000000000 0x2d proc_proc.o - .comment 0x000000000000007b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abortf.o) - .comment 0x00000000000000a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgatherf.o) - .comment 0x00000000000000d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrierf.o) - .comment 0x0000000000000105 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcastf.o) - .comment 0x0000000000000133 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_createf.o) - .comment 0x0000000000000161 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_groupf.o) - .comment 0x000000000000018f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rankf.o) - .comment 0x00000000000001bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_sizef.o) - .comment 0x00000000000001eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_splitf.o) - .comment 0x0000000000000219 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fnf.o) - .comment 0x0000000000000247 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalizef.o) - .comment 0x0000000000000275 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gatherf.o) - .comment 0x00000000000002a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcountf.o) - .comment 0x00000000000002d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getpnamef.o) - .comment 0x00000000000002ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_freef.o) - .comment 0x000000000000032d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_inclf.o) - .comment 0x000000000000035b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rankf.o) - .comment 0x0000000000000389 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(grouptranksf.o) - .comment 0x00000000000003b7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initf.o) - .comment 0x00000000000003e5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobef.o) - .comment 0x0000000000000413 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecvf.o) - .comment 0x0000000000000441 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isendf.o) - .comment 0x000000000000046f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issendf.o) - .comment 0x000000000000049d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_copyfnf.o) - .comment 0x00000000000004cb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(null_del_fnf.o) - .comment 0x00000000000004f9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probef.o) - .comment 0x0000000000000527 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recvf.o) - .comment 0x0000000000000555 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reducef.o) - .comment 0x0000000000000583 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterf.o) - .comment 0x00000000000005b1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scattervf.o) - .comment 0x00000000000005df 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendf.o) - .comment 0x000000000000060d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusf2c.o) - .comment 0x000000000000063b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testf.o) - .comment 0x0000000000000669 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commitf.o) - .comment 0x0000000000000697 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contigf.o) - .comment 0x00000000000006c5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_indf.o) - .comment 0x00000000000006f3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitallf.o) - .comment 0x0000000000000721 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtimef.o) - .comment 0x000000000000074f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initfutil.o) - .comment 0x000000000000077d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chnodename.o) - .comment 0x00000000000007ab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(isend.o) - .comment 0x00000000000007d9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(irecv.o) - .comment 0x0000000000000807 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(test.o) - .comment 0x0000000000000835 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(mperror.o) - .comment 0x0000000000000863 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(probe.o) - .comment 0x0000000000000891 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(waitall.o) - .comment 0x00000000000008bf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(send.o) - .comment 0x00000000000008ed 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(recv.o) - .comment 0x000000000000091b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(iprobe.o) - .comment 0x0000000000000949 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(testall.o) - .comment 0x0000000000000977 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(getcount.o) - .comment 0x00000000000009a5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(issend.o) - .comment 0x00000000000009d3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_commit.o) - .comment 0x0000000000000a01 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_contig.o) - .comment 0x0000000000000a2f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_ind.o) - .comment 0x0000000000000a5d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_util.o) - .comment 0x0000000000000a8b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(abort.o) - .comment 0x0000000000000ab9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(init.o) - .comment 0x0000000000000ae7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initutil.o) - .comment 0x0000000000000b15 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(finalize.o) - .comment 0x0000000000000b43 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errorstring.o) - .comment 0x0000000000000b71 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(initdte.o) - .comment 0x0000000000000b9f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errfree.o) - .comment 0x0000000000000bcd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wtime.o) - .comment 0x0000000000000bfb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(nerrmsg.o) - .comment 0x0000000000000c29 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(msgqdllloc.o) - .comment 0x0000000000000c57 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(util_hbt.o) - .comment 0x0000000000000c85 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(ptrcvt.o) - .comment 0x0000000000000cb3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bsendutil2.o) - .comment 0x0000000000000ce1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyval_free.o) - .comment 0x0000000000000d0f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_getval.o) - .comment 0x0000000000000d3d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_util.o) - .comment 0x0000000000000d6b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(attr_putval.o) - .comment 0x0000000000000d99 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_free.o) - .comment 0x0000000000000dc7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_incl.o) - .comment 0x0000000000000df5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_rank.o) - .comment 0x0000000000000e23 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_util.o) - .comment 0x0000000000000e51 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_free.o) - .comment 0x0000000000000e7f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_group.o) - .comment 0x0000000000000ead 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_create.o) - .comment 0x0000000000000edb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_rank.o) - .comment 0x0000000000000f09 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_name_put.o) - .comment 0x0000000000000f37 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_size.o) - .comment 0x0000000000000f65 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_util.o) - .comment 0x0000000000000f93 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(comm_split.o) - .comment 0x0000000000000fc1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(context_util.o) - .comment 0x0000000000000fef 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(group_tranks.o) - .comment 0x000000000000101d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dup_fn.o) - .comment 0x000000000000104b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(barrier.o) - .comment 0x0000000000001079 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bcast.o) - .comment 0x00000000000010a7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(gather.o) - .comment 0x00000000000010d5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatter.o) - .comment 0x0000000000001103 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(scatterv.o) - .comment 0x0000000000001131 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allgather.o) - .comment 0x000000000000115f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(reduce.o) - .comment 0x000000000000118d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(allreduce.o) - .comment 0x00000000000011bb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(global_ops.o) - .comment 0x00000000000011e9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(opfree.o) - .comment 0x0000000000001217 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(oputil.o) - .comment 0x0000000000001245 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(inter_fns.o) - .comment 0x0000000000001273 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_fns_new.o) - .comment 0x00000000000012a1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(intra_scan.o) - .comment 0x00000000000012cf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(topo_util.o) - .comment 0x00000000000012fd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(requestc2f.o) - .comment 0x000000000000132b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(statusc2f.o) - .comment 0x0000000000001359 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(fstrutils.o) - .comment 0x0000000000001387 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_utils.o) - .comment 0x00000000000013b5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_bm.o) - .comment 0x00000000000013e3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_rm.o) - .comment 0x0000000000001411 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_util.o) - .comment 0x000000000000143f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_cr.o) - .comment 0x000000000000146d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_conn.o) - .comment 0x000000000000149b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_sr.o) - .comment 0x00000000000014c9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_sock_list.o) - .comment 0x00000000000014f7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_secure.o) - .comment 0x0000000000001525 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(usc.o) - .comment 0x0000000000001553 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2recv.o) - .comment 0x0000000000001581 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2send.o) - .comment 0x00000000000015af 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2init.o) - .comment 0x00000000000015dd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2probe.o) - .comment 0x000000000000160b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hsend.o) - .comment 0x0000000000001639 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hrecv.o) - .comment 0x0000000000001667 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2pack.o) - .comment 0x0000000000001695 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2mpack.o) - .comment 0x00000000000016c3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2hssend.o) - .comment 0x00000000000016f1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(bswap2.o) - .comment 0x000000000000171f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chdebug.o) - .comment 0x000000000000174d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chinit.o) - .comment 0x000000000000177b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chhetero.o) - .comment 0x00000000000017a9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4priv.o) - .comment 0x00000000000017d7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(queue.o) - .comment 0x0000000000001805 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cmnargs.o) - .comment 0x0000000000001833 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sbcnst2.o) - .comment 0x0000000000001861 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(session.o) - .comment 0x000000000000188f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chpackflow.o) - .comment 0x00000000000018bd 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chcancel.o) - .comment 0x00000000000018eb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(wait.o) - .comment 0x0000000000001919 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(cancel.o) - .comment 0x0000000000001947 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(sendrecv.o) - .comment 0x0000000000001975 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_extent.o) - .comment 0x00000000000019a3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_free.o) - .comment 0x00000000000019d1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_hind.o) - .comment 0x00000000000019ff 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_lb.o) - .comment 0x0000000000001a2d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_size.o) - .comment 0x0000000000001a5b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(type_struct.o) - .comment 0x0000000000001a89 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack_size.o) - .comment 0x0000000000001ab7 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pack.o) - .comment 0x0000000000001ae5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(unpack.o) - .comment 0x0000000000001b13 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .comment 0x0000000000001b41 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(errset.o) - .comment 0x0000000000001b6f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(pkutil.o) - .comment 0x0000000000001b9d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(keyvalcreate.o) - .comment 0x0000000000001bcb 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_globals.o) - .comment 0x0000000000001bf9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_MD.o) - .comment 0x0000000000001c27 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_error.o) - .comment 0x0000000000001c55 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_args.o) - .comment 0x0000000000001c83 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_alloc.o) - .comment 0x0000000000001cb1 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_debug.o) - .comment 0x0000000000001cdf 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_procgroup.o) - .comment 0x0000000000001d0d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_tsr.o) - .comment 0x0000000000001d3b 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_mon.o) - .comment 0x0000000000001d69 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(p4_broadcast.o) - .comment 0x0000000000001d97 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2ssend.o) - .comment 0x0000000000001dc5 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(adi2cancel.o) - .comment 0x0000000000001df3 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbeager.o) - .comment 0x0000000000001e21 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chbrndv.o) - .comment 0x0000000000001e4f 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chchkdev.o) - .comment 0x0000000000001e7d 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chshort.o) - .comment 0x0000000000001eab 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(chflow.o) - .comment 0x0000000000001ed9 0x2e /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(dmpipk.o) - .comment 0x0000000000001f07 0x3a xdrf_em64/libxdrf.a(libxdrf.o) - .comment 0x0000000000001f41 0x3a xdrf_em64/libxdrf.a(ftocstr.o) - .comment 0x0000000000001f7b 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .comment 0x0000000000001f8e 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .comment 0x0000000000001fa1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .comment 0x0000000000001fb4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .comment 0x0000000000001fc7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .comment 0x0000000000001fda 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .comment 0x0000000000001fed 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .comment 0x0000000000002000 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .comment 0x0000000000002013 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .comment 0x0000000000002026 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .comment 0x0000000000002039 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .comment 0x000000000000204c 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .comment 0x000000000000205f 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .comment 0x0000000000002072 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .comment 0x0000000000002085 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .comment 0x0000000000002098 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .comment 0x00000000000020ab 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .comment 0x00000000000020be 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .comment 0x00000000000020d1 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .comment 0x00000000000020e4 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .comment 0x00000000000020f7 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .comment 0x000000000000210a 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .comment 0x000000000000211d 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .comment 0x0000000000002130 0x13 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .comment 0x0000000000000000 0x2d /usr/lib64/libc_nonshared.a(elf-init.oS) - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/crtend.o - .comment 0x0000000000000000 0x2d /usr/lib/gcc/x86_64-redhat-linux/4.4.5/../../../../lib64/crtn.o - -.debug - *(.debug) - -.line - *(.line) - -.debug_srcinfo - *(.debug_srcinfo) - -.debug_sfnames - *(.debug_sfnames) - -.debug_aranges 0x0000000000000000 0x30 - *(.debug_aranges) - .debug_aranges - 0x0000000000000000 0x30 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_pubnames - 0x0000000000000000 0x16b - *(.debug_pubnames) - .debug_pubnames - 0x0000000000000000 0x16b /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_info 0x0000000000000000 0x3147 - *(.debug_info .gnu.linkonce.wi.*) - .debug_info 0x0000000000000000 0x1d94 cored.o - .debug_info 0x0000000000001d94 0x13b3 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_abbrev 0x0000000000000000 0x204 - *(.debug_abbrev) - .debug_abbrev 0x0000000000000000 0xed cored.o - .debug_abbrev 0x00000000000000ed 0x117 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_line 0x0000000000000000 0x16bf - *(.debug_line) - .debug_line 0x0000000000000000 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/for_main.o - .debug_line 0x0000000000000000 0x0 unres.o - .debug_line 0x0000000000000000 0x0 arcos.o - .debug_line 0x0000000000000000 0x0 cartprint.o - .debug_line 0x0000000000000000 0x0 chainbuild.o - .debug_line 0x0000000000000000 0x0 convert.o - .debug_line 0x0000000000000000 0x0 initialize_p.o - .debug_line 0x0000000000000000 0x0 matmult.o - .debug_line 0x0000000000000000 0x0 readrtns_CSA.o - .debug_line 0x0000000000000000 0x0 parmread.o - .debug_line 0x0000000000000000 0x0 gen_rand_conf.o - .debug_line 0x0000000000000000 0x0 printmat.o - .debug_line 0x0000000000000000 0x0 map.o - .debug_line 0x0000000000000000 0x0 pinorm.o - .debug_line 0x0000000000000000 0x0 randgens.o - .debug_line 0x0000000000000000 0x0 rescode.o - .debug_line 0x0000000000000000 0x0 intcor.o - .debug_line 0x0000000000000000 0x0 timing.o - .debug_line 0x0000000000000000 0x0 misc.o - .debug_line 0x0000000000000000 0x0 intlocal.o - .debug_line 0x0000000000000000 0x0 cartder.o - .debug_line 0x0000000000000000 0x0 checkder_p.o - .debug_line 0x0000000000000000 0x0 econstr_local.o - .debug_line 0x0000000000000000 0x0 energy_p_new_barrier.o - .debug_line 0x0000000000000000 0x0 energy_p_new-sep_barrier.o - .debug_line 0x0000000000000000 0x0 gradient_p.o - .debug_line 0x0000000000000000 0x0 minimize_p.o - .debug_line 0x0000000000000000 0x0 sumsld.o - .debug_line 0x0000000000000000 0x1543 cored.o - .debug_line 0x0000000000001543 0x0 rmdd.o - .debug_line 0x0000000000001543 0x0 geomout.o - .debug_line 0x0000000000001543 0x0 readpdb.o - .debug_line 0x0000000000001543 0x0 regularize.o - .debug_line 0x0000000000001543 0x0 thread.o - .debug_line 0x0000000000001543 0x0 fitsq.o - .debug_line 0x0000000000001543 0x0 mcm.o - .debug_line 0x0000000000001543 0x0 mc.o - .debug_line 0x0000000000001543 0x0 bond_move.o - .debug_line 0x0000000000001543 0x0 refsys.o - .debug_line 0x0000000000001543 0x0 check_sc_distr.o - .debug_line 0x0000000000001543 0x0 check_bond.o - .debug_line 0x0000000000001543 0x0 contact.o - .debug_line 0x0000000000001543 0x0 djacob.o - .debug_line 0x0000000000001543 0x0 eigen.o - .debug_line 0x0000000000001543 0x0 blas.o - .debug_line 0x0000000000001543 0x0 add.o - .debug_line 0x0000000000001543 0x0 entmcm.o - .debug_line 0x0000000000001543 0x0 minim_mcmf.o - .debug_line 0x0000000000001543 0x0 together.o - .debug_line 0x0000000000001543 0x0 csa.o - .debug_line 0x0000000000001543 0x0 minim_jlee.o - .debug_line 0x0000000000001543 0x0 shift.o - .debug_line 0x0000000000001543 0x0 diff12.o - .debug_line 0x0000000000001543 0x0 bank.o - .debug_line 0x0000000000001543 0x0 newconf.o - .debug_line 0x0000000000001543 0x0 ran.o - .debug_line 0x0000000000001543 0x0 indexx.o - .debug_line 0x0000000000001543 0x0 MP.o - .debug_line 0x0000000000001543 0x0 compare_s1.o - .debug_line 0x0000000000001543 0x0 prng_32.o - .debug_line 0x0000000000001543 0x0 test.o - .debug_line 0x0000000000001543 0x0 banach.o - .debug_line 0x0000000000001543 0x0 distfit.o - .debug_line 0x0000000000001543 0x0 rmsd.o - .debug_line 0x0000000000001543 0x0 elecont.o - .debug_line 0x0000000000001543 0x0 dihed_cons.o - .debug_line 0x0000000000001543 0x0 sc_move.o - .debug_line 0x0000000000001543 0x0 local_move.o - .debug_line 0x0000000000001543 0x0 intcartderiv.o - .debug_line 0x0000000000001543 0x0 /tmp/ipo_ifortScZxT8.o - .debug_line 0x0000000000001543 0x0 stochfric.o - .debug_line 0x0000000000001543 0x0 kinetic_lesyng.o - .debug_line 0x0000000000001543 0x0 MD_A-MTS.o - .debug_line 0x0000000000001543 0x0 moments.o - .debug_line 0x0000000000001543 0x0 int_to_cart.o - .debug_line 0x0000000000001543 0x0 surfatom.o - .debug_line 0x0000000000001543 0x0 sort.o - .debug_line 0x0000000000001543 0x0 muca_md.o - .debug_line 0x0000000000001543 0x0 MREMD.o - .debug_line 0x0000000000001543 0x0 rattle.o - .debug_line 0x0000000000001543 0x0 gauss.o - .debug_line 0x0000000000001543 0x0 energy_split-sep.o - .debug_line 0x0000000000001543 0x0 q_measure.o - .debug_line 0x0000000000001543 0x0 gnmr1.o - .debug_line 0x0000000000001543 0x0 cinfo.o - .debug_line 0x0000000000001543 0x17c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(etime.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(fdate.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(flush.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(getenv.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(system.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_alloccstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifport.a(utility_c2fstr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_close_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_desc_item.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_diags_intel.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_errsns.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit_handler.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_getarg.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_io_util.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_lub_mgt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_need_lf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_pause.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_put.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_reentrancy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rewind.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rint_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_rseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_stop.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_vm.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wint_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_wseq_lis.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_90_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fp_class.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_f90str.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_portlib.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_mi_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(tbk_traceback.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_open_proc.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_aio_wrap.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_int.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_f.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_d.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_vax_g.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cray.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_short.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ibm_long.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_double.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_ieee_single.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_common_inquire.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_exit.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_comp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_fmt_val.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_get.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_index.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_intrp_fmt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(for_ldir_wfs.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt__globals.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_int_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_data_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_log_to_text.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_data.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_text_to_log.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_t.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_s.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libifcore.a(cvt_cvtas_x.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(acos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(asin.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(atan2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powi4i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(f__powr8i4.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_error.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_sse2_sincos.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherrl.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(matherr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sqrt.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(truncf.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_stub.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cbrt_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(cos_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp2_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(expf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(exp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(fmod_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(libm_reduce_pio2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(llround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log10_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(logf_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(log_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lroundf_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(lround_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(pow_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(rcp_table.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(sin_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(tan_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_ct.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_gen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libimf.a(trunc_pnr.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_stub_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e9_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_y8_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_e7_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dcos2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libsvml.a(svml_ex_dsin2.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2ints.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(q2fp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(w_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_display.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(tbk_backtrace.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_memcmp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(cpu_disp.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemcpy.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(fastmemset.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(proc_init.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_mulq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(ia32_divq.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(faststrlen.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(irc_msg_support.o) - .debug_line 0x00000000000016bf 0x0 /opt/intel/Compiler/11.1/046/lib/intel64/libirc.a(efi2_fast_mem_ops.o) - -.debug_frame 0x0000000000000000 0x770 - *(.debug_frame) - .debug_frame 0x0000000000000000 0x498 cored.o - .debug_frame 0x0000000000000498 0x2a0 /tmp/ipo_ifortScZxT8.o - .debug_frame 0x0000000000000738 0x38 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_str 0x0000000000000000 0x96 - *(.debug_str) - .debug_str 0x0000000000000000 0x96 /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_loc 0x0000000000000000 0x4c - *(.debug_loc) - .debug_loc 0x0000000000000000 0x4c /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib/libmpich.a(debugutil.o) - -.debug_macinfo - *(.debug_macinfo) - -.debug_weaknames - *(.debug_weaknames) - -.debug_funcnames - *(.debug_funcnames) - -.debug_typenames - *(.debug_typenames) - -.debug_varnames - *(.debug_varnames) - -.debug_pubtypes - *(.debug_pubtypes) - -.debug_ranges - *(.debug_ranges) - -.gnu.attributes - *(.gnu.attributes) - -/DISCARD/ - *(.note.GNU-stack) - *(.gnu_debuglink) - *(.gnu.lto_*) -OUTPUT(../bin/unres_Tc_procor_oldparm_em64-D-finegrain.exe elf64-x86-64) diff --git a/source/unres/src_MD-M/local_move.f b/source/unres/src_MD-M/local_move.f index d02a9d1..763d3cc 100644 --- a/source/unres/src_MD-M/local_move.f +++ b/source/unres/src_MD-M/local_move.f @@ -129,7 +129,7 @@ c$$$ endif c$$$ endif c The actual move, on residue i - iretcode=move_res(min,max,i,c) ! Discard iretcode + iretcode=move_res(min,max,i) ! Discard iretcode i=i+1 if (i.le.j) then @@ -150,7 +150,7 @@ c$$$ endif c$$$ endif c The actual move, on residue j - iretcode=move_res(min,max,j,c) ! Discard iretcode + iretcode=move_res(min,max,j) ! Discard iretcode j=j-1 endif enddo @@ -960,7 +960,9 @@ c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg R(j,i)=vbl*R(j,i) enddo enddo - i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) +c i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) + imov=2 + i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov) print *,'RETURNED ',i print *,(R(i,3)/vbl,i=0,2) diff --git a/source/unres/src_MD-M/map.f b/source/unres/src_MD-M/map.f index 6ea2632..2a0c696 100644 --- a/source/unres/src_MD-M/map.f +++ b/source/unres/src_MD-M/map.f @@ -55,7 +55,7 @@ Cd write (iout,*) i,iii,(nn(j),j=1,nmap) 5 continue enddo ! k enddo ! j - call chainbuild + call chainbuild_extconf if (minim) then call geom_to_var(nvar,x) call minimize(etot,x,iretcode,nfun) diff --git a/source/unres/src_MD-M/mc.F b/source/unres/src_MD-M/mc.F index ec5b87b..a513794 100644 --- a/source/unres/src_MD-M/mc.F +++ b/source/unres/src_MD-M/mc.F @@ -328,7 +328,8 @@ C Decide whether to generate a random conformation or perturb the old one if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) & write (iout,'(2a,i3)') 'Random-generated conformation', & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) + nrestmp=nres + call gen_rand_conf(nstart_grow,nrestmp,*30) endif call geom_to_var(nvar,varia) endif ! pool diff --git a/source/unres/src_MD-M/mcm.F b/source/unres/src_MD-M/mcm.F index 7f839f4..a304256 100644 --- a/source/unres/src_MD-M/mcm.F +++ b/source/unres/src_MD-M/mcm.F @@ -110,6 +110,8 @@ crc include 'COMMON.DEFORM1' double precision varia(maxvar),varold(maxvar),elowest,eold, & przes(3),obr(3,3) double precision energia(0:n_ene) + double precision coord1(maxres,3) + C--------------------------------------------------------------------------- C Initialize counters. @@ -170,7 +172,7 @@ C Minimize the energy of the first conformation. call enerprint(energia(0)) endif if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, + call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup,1),nsup,przes, & obr,non_conv) rms=dsqrt(rms) call contact(.false.,ncont,icont,co) @@ -256,7 +258,8 @@ C Decide whether to generate a random conformation or perturb the old one if (print_mc.gt.0) & write (iout,'(2a,i3)') 'Random-generated conformation', & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) + nrestmp=nres + call gen_rand_conf(nstart_grow,nrestmp,*30) endif call geom_to_var(nvar,varia) cd write (iout,'(a)') 'New variables:' @@ -315,7 +318,7 @@ C-------------------------------------------------------------------------- C Check against conformation repetitions. irepet=conf_comp(varia,etot) if (print_stat) then -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open (istat,file=statname,position='append') #else open (istat,file=statname,access='append') @@ -325,7 +328,7 @@ C Check against conformation repetitions. if (refstr) then call var_to_geom(nvar,varia) call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), + call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup,1), & nsup,przes,obr,non_conv) rms=dsqrt(rms) call contact(.false.,ncont,icont,co) @@ -578,7 +581,8 @@ c print *,'after perturb',error,finish if (print_mc.gt.0) & write (iout,'(2a,i3)') 'Random-generated conformation', & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) + nrestmp=nres + call gen_rand_conf(nstart_grow,nrestmp,*30) endif call geom_to_var(nvar,varia) ngen=ngen+1 @@ -697,7 +701,7 @@ C Write the accepted conformation. & write (iout,*) 'Writing new conformation',nout if (print_stat) then call var_to_geom(nvar,varia) -#if defined(AIX) || defined(PGI) +#if defined(AIX) || defined(PGI) || defined(CRAY) open (istat,file=statname,position='append') #else open (istat,file=statname,access='append') diff --git a/source/unres/src_MD-M/minim_jlee.F b/source/unres/src_MD-M/minim_jlee.F index d83b15b..56d5010 100644 --- a/source/unres/src_MD-M/minim_jlee.F +++ b/source/unres/src_MD-M/minim_jlee.F @@ -7,16 +7,18 @@ c controls minimization and sorting routines include 'COMMON.IOUNITS' include 'COMMON.MINIM' include 'COMMON.CONTROL' - include 'mpif.h' external func,gradient,fdum real ran1,ran2,ran3 +#ifdef MPI + include 'mpif.h' include 'COMMON.SETUP' + dimension muster(mpi_status_size) +#endif include 'COMMON.GEO' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.CHAIN' - dimension muster(mpi_status_size) dimension var(maxvar),erg(mxch*(mxch+1)/2+1) dimension var2(maxvar) integer iffr(maxres),ihpbt(maxdim),jhpbt(maxdim) diff --git a/source/unres/src_MD-M/minimize_p.F b/source/unres/src_MD-M/minimize_p.F index 06c7a73..3de233f 100644 --- a/source/unres/src_MD-M/minimize_p.F +++ b/source/unres/src_MD-M/minimize_p.F @@ -141,11 +141,13 @@ C Workers wait for variables and NF, and NFL from the boss do while (iorder.ge.0) c write (*,*) 'Processor',fg_rank,' CG group',kolor, c & ' receives order from Master' +#ifdef MPI time00=MPI_Wtime() call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR) time_Bcast=time_Bcast+MPI_Wtime()-time00 if (icall.gt.4 .and. iorder.ge.0) & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00 +#endif icall=icall+1 c write (*,*) c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder @@ -261,7 +263,7 @@ c endif cd print *,'func',nf,nfl,icg call var_to_geom(n,x) call zerograd - call chainbuild + call chainbuild_extconf cd write (iout,*) 'ETOTAL called from FUNC' call etotal(energia(0)) call sum_gradient @@ -295,7 +297,7 @@ c endif icg=mod(nf,2)+1 call var_to_geom_restr(n,x) call zerograd - call chainbuild + call chainbuild_extconf cd write (iout,*) 'ETOTAL called from FUNC' call etotal(energia(0)) call sum_gradient @@ -408,6 +410,7 @@ c---------------------------------------------------------- #ifdef MPI include 'mpif.h' #endif + include 'COMMON.CONTROL' include 'COMMON.SETUP' include 'COMMON.IOUNITS' include 'COMMON.VAR' @@ -482,8 +485,18 @@ c v(25)=4.0D0 enddo endif enddo +c----- +c write (iout,*) "checkgrad before SUMSL" +c icheckgrad=1 +c aincr=1.0d-7 +c call exec_checkgrad +c----- call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) +c----- +c write (iout,*) "checkgrad after SUMSL" +c call exec_checkgrad +c----- k=0 do i=1,nres-1 diff --git a/source/unres/src_MD-M/module.log b/source/unres/src_MD-M/module.log deleted file mode 100644 index 684781c..0000000 --- a/source/unres/src_MD-M/module.log +++ /dev/null @@ -1,11 +0,0 @@ -Currently Loaded Modulefiles: - 1) modules/3.1.6 11) xt-libc/1.5.60 - 2) pgi/7.2.2 12) xt-os/1.5.60 - 3) totalview-support/1.0.5 13) xt-catamount/1.5.60 - 4) xt-totalview/8.4.1b 14) xt-boot/1.5.60 - 5) xt-libsci/10.0.0 15) xt-crms/1.5.60 - 6) xt-mpt/1.5.60 16) xt-lustre-ss/1.5.60 - 7) xt-pe/1.5.60 17) Base-opts/1.5.60 - 8) PrgEnv-pgi/1.5.60 18) psc_path/1.0 - 9) xt-pbs/5.3.5-6xt_psc 19) dmover/1.0 - 10) xt-service/1.5.60 20) tau/tau-2.17 diff --git a/source/unres/src_MD-M/moments.f b/source/unres/src_MD-M/moments.f index 007c089..f2fc1b2 100644 --- a/source/unres/src_MD-M/moments.f +++ b/source/unres/src_MD-M/moments.f @@ -42,11 +42,11 @@ c calculating the center of the mass of the protein enddo M_SC=0.0d0 do i=nnt,nct - iti=itype(i) - M_SC=M_SC+msc(iti) + iti=iabs(itype(i)) + M_SC=M_SC+msc(iabs(iti)) inres=i+nres do j=1,3 - cm(j)=cm(j)+msc(iti)*c(j,inres) + cm(j)=cm(j)+msc(iabs(iti))*c(j,inres) enddo enddo do j=1,3 @@ -66,17 +66,17 @@ c calculating the center of the mass of the protein enddo do i=nnt,nct - iti=itype(i) + iti=iabs(itype(i)) inres=i+nres do j=1,3 pr(j)=c(j,inres)-cm(j) enddo - Im(1,1)=Im(1,1)+msc(iti)*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-msc(iti)*pr(1)*pr(2) - Im(1,3)=Im(1,3)-msc(iti)*pr(1)*pr(3) - Im(2,3)=Im(2,3)-msc(iti)*pr(2)*pr(3) - Im(2,2)=Im(2,2)+msc(iti)*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+msc(iti)*(pr(1)*pr(1)+pr(2)*pr(2)) + Im(1,1)=Im(1,1)+msc(iabs(iti))*(pr(2)*pr(2)+pr(3)*pr(3)) + Im(1,2)=Im(1,2)-msc(iabs(iti))*pr(1)*pr(2) + Im(1,3)=Im(1,3)-msc(iabs(iti))*pr(1)*pr(3) + Im(2,3)=Im(2,3)-msc(iabs(iti))*pr(2)*pr(3) + Im(2,2)=Im(2,2)+msc(iabs(iti))*(pr(3)*pr(3)+pr(1)*pr(1)) + Im(3,3)=Im(3,3)+msc(iabs(iti))*(pr(1)*pr(1)+pr(2)*pr(2)) enddo do i=nnt,nct-1 @@ -96,8 +96,8 @@ c calculating the center of the mass of the protein do i=nnt,nct - if (itype(i).ne.10 .and. itype(i).ne.21) then - iti=itype(i) + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then + iti=iabs(itype(i)) inres=i+nres Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)* & dc_norm(1,inres))*vbld(inres)*vbld(inres) @@ -131,6 +131,8 @@ c Copying the Im matrix for the djacob subroutine enddo c Finding the eigenvectors and eignvalues of the inertia tensor +c write (iout,*) "Calling djacob" +c call flush(iout) call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval) c write (iout,*) "Eigenvalues & Eigenvectors" c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3) @@ -138,6 +140,7 @@ c write (iout,*) c do i=1,3 c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3) c enddo +c call flush(iout) c Constructing the diagonalized matrix do i=1,3 if (dabs(eigval(i)).gt.1.0d-15) then @@ -179,7 +182,7 @@ c Resetting the velocities enddo enddo do i=nnt,nct - if(itype(i).ne.10 .and. itype(i).ne.21) then + if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then inres=i+nres call vecpr(vrot(1),dc(1,inres),vp) do j=1,3 @@ -244,12 +247,12 @@ c Calculate the angular momentum incr(j)=d_t(j,0) enddo do i=nnt,nct - iti=itype(i) + iti=iabs(itype(i)) inres=i+nres do j=1,3 pr(j)=c(j,inres)-cm(j) enddo - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 v(j)=incr(j)+d_t(j,inres) enddo @@ -262,10 +265,10 @@ c Calculate the angular momentum c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3), c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3) do j=1,3 - L(j)=L(j)+msc(iti)*vp(j) + L(j)=L(j)+msc(iabs(iti))*vp(j) enddo c write (iout,*) "L",(l(j),j=1,3) - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 v(j)=incr(j)+d_t(j,inres) enddo @@ -305,9 +308,9 @@ c------------------------------------------------------------------------------ vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i)) enddo endif - amas=msc(itype(i)) + amas=msc(iabs(itype(i))) summas=summas+amas - if (itype(i).ne.10 .and. itype(i).ne.21) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres)) enddo diff --git a/source/unres/src_MD-M/objects.sizes b/source/unres/src_MD-M/objects.sizes deleted file mode 100644 index 862d1e3..0000000 --- a/source/unres/src_MD-M/objects.sizes +++ /dev/null @@ -1,168 +0,0 @@ - text data bss dec hex filename - 342 80 0 422 1a6 add.o - text data bss dec hex filename - 104 44 0 148 94 arcos.o - text data bss dec hex filename - 2316 352 0 2668 a6c banach.o - text data bss dec hex filename - 42120 5468 772 48360 bce8 bank.o - text data bss dec hex filename - 9994 764 8 10766 2a0e blas.o - text data bss dec hex filename - 5016 680 272 5968 1750 bond_move.o - text data bss dec hex filename - 4144 196 259392 263732 40634 cartder.o - text data bss dec hex filename - 1040 224 0 1264 4f0 cartprint.o - text data bss dec hex filename - 2572 404 40 3016 bc8 chainbuild.o - text data bss dec hex filename - 368 132 184 684 2ac check_bond.o - text data bss dec hex filename - 16364 2264 390656 409284 63ec4 checkder_p.o - text data bss dec hex filename - 696 236 32 964 3c4 check_sc_distr.o - text data bss dec hex filename - 2640 832 0 3472 d90 cinfo.o - text data bss dec hex filename - 6036 980 43352 50368 c4c0 compare_s1.o - text data bss dec hex filename - 5032 672 86456 92160 16800 contact.o - text data bss dec hex filename - 3576 484 43216 47276 b8ac convert.o - text data bss dec hex filename - 28680 5840 1240 35760 8bb0 cored.o - text data bss dec hex filename - 7372 1448 264 9084 237c csa.o - text data bss dec hex filename - 632 52 0 684 2ac diff12.o - text data bss dec hex filename - 5276 768 248 6292 1894 dihed_cons.o - text data bss dec hex filename - 5840 884 21744 28468 6f34 distfit.o - text data bss dec hex filename - 4276 256 1256 5788 169c djacob.o - text data bss dec hex filename - 2200 240 0 2440 988 econstr_local.o - text data bss dec hex filename - 35258 3508 320 39086 98ae eigen.o - text data bss dec hex filename - 17660 1744 191000 210404 335e4 elecont.o - text data bss dec hex filename - 150482 10704 429408 590594 90302 energy_p_new.o - text data bss dec hex filename - 44420 4204 1136 49760 c260 energy_p_new-sep.o - text data bss dec hex filename - 3276 304 600 4180 1054 energy_split-sep.o - text data bss dec hex filename - 27800 2828 86956 117584 1cb50 entmcm.o - text data bss dec hex filename - 9964 764 568 11296 2c20 fitsq.o - text data bss dec hex filename - 2604 136 0 2740 ab4 gauss.o - text data bss dec hex filename - 15888 3224 6056 25168 6250 gen_rand_conf.o - text data bss dec hex filename - 21996 2892 26120 51008 c740 geomout.o - text data bss dec hex filename - 272 156 0 428 1ac gnmr1.o - text data bss dec hex filename - 5564 464 24 6052 17a4 gradient_p.o - text data bss dec hex filename - 1202 116 2000 3318 cf6 indexx.o - text data bss dec hex filename - 9528 16928 8308 34764 87cc initialize_p.o - text data bss dec hex filename - 12732 1176 633768 647676 9e1fc intcartderiv.o - text data bss dec hex filename - 1300 192 72 1564 61c intcor.o - text data bss dec hex filename - 11628 1740 384 13752 35b8 intlocal.o - text data bss dec hex filename - 4732 180 0 4912 1330 int_to_cart.o - text data bss dec hex filename - 2116 132 48 2296 8f8 kinetic_lesyng.o - text data bss dec hex filename - 21386 2700 39369688 39393774 25919ee lagrangian_lesyng.o - text data bss dec hex filename - 12394 1692 624 14710 3976 local_move.o - text data bss dec hex filename - 3802 412 86768 90982 16366 map.o - text data bss dec hex filename - 648 60 72 780 30c matmult.o - text data bss dec hex filename - 32904 4732 218020 255656 3e6a8 mcm.o - text data bss dec hex filename - 25172 2412 130332 157916 268dc mc.o - text data bss dec hex filename - 51422 5916 865520 922858 e14ea MD_A-MTS.o - text data bss dec hex filename - 8328 764 260456 269548 41cec minimize_p.o - text data bss dec hex filename - 11376 1464 3406284 3419124 342bf4 minim_jlee.o - text data bss dec hex filename - 1384 164 86728 88276 158d4 minim_mcmf.o - text data bss dec hex filename - 5170 878 216 6264 1878 misc.o - text data bss dec hex filename - 6752 368 712 7832 1e98 moments.o - text data bss dec hex filename - 19346 3576 8716 31638 7b96 MP.o - text data bss dec hex filename - 42300 4512 14380584 14427396 dc2504 MREMD.o - text data bss dec hex filename - 8912 1368 20568 30848 7880 muca_md.o - text data bss dec hex filename - 50648 2904 24272 77824 13000 newconf.o - text data bss dec hex filename - 42598 4892 208 47698 ba52 parmread.o - text data bss dec hex filename - 124 40 0 164 a4 pinorm.o - text data bss dec hex filename - 1256 332 0 1588 634 printmat.o - text data bss dec hex filename - 1184 16588 0 17772 456c prng.o - text data bss dec hex filename - 11748 896 194728 207372 32a0c q_measure.o - text data bss dec hex filename - 2190 448 8840 11478 2cd6 randgens.o - text data bss dec hex filename - 3104 228 524 3856 f10 ran.o - text data bss dec hex filename - 23134 1992 129688 154814 25cbe rattle.o - text data bss dec hex filename - 10440 1176 896 12512 30e0 readpdb.o - text data bss dec hex filename - 114098 11732 14564 140394 2246a readrtns_CSA.o - text data bss dec hex filename - 1816 244 0 2060 80c refsys.o - text data bss dec hex filename - 3852 492 3272720 3277064 320108 regularize.o - text data bss dec hex filename - 896 140 0 1036 40c rescode.o - text data bss dec hex filename - 444 188 0 632 278 rmdd.o - text data bss dec hex filename - 4944 776 173320 179040 2bb60 rmsd.o - text data bss dec hex filename - 9152 1292 173700 184144 2cf50 sc_move.o - text data bss dec hex filename - 5960 1888 0 7848 1ea8 shift.o - text data bss dec hex filename - 5894 920 768 7582 1d9e sort.o - text data bss dec hex filename - 17784 1960 288280 308024 4b338 stochfric.o - text data bss dec hex filename - 10248 928 120 11296 2c20 sumsld.o - text data bss dec hex filename - 4894 524 67240 72658 11bd2 surfatom.o - text data bss dec hex filename - 55640 6124 8813080 8874844 876b5c test.o - text data bss dec hex filename - 16436 1876 1048 19360 4ba0 thread.o - text data bss dec hex filename - 1820 404 28 2252 8cc timing.o - text data bss dec hex filename - 31980 4560 220320 256860 3eb5c together.o - text data bss dec hex filename - 15850 3704 44640 64194 fac2 unres.o diff --git a/source/unres/src_MD-M/parmread.F b/source/unres/src_MD-M/parmread.F index b3f26b3..80417db 100644 --- a/source/unres/src_MD-M/parmread.F +++ b/source/unres/src_MD-M/parmread.F @@ -26,11 +26,15 @@ C include 'COMMON.SBRIDGE' include 'COMMON.MD' include 'COMMON.SETUP' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' character*1 t1,t2,t3 character*1 onelett(4) /"G","A","P","D"/ + character*1 toronelet(-2:2) /"p","a","G","A","P"/ logical lprint,LaTeX dimension blower(3,3,maxlob) - dimension b(13) + character*3 string +C dimension b(13) character*3 lancuch,ucase C C For printing parameters after they are read set the following in the UNRES @@ -55,10 +59,10 @@ C Assign virtual-bond length vblinv2=vblinv*vblinv c c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains +c and Stokes radii of the peptide group and side chains c #ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok + read (ibond,*) vbldp0,vbldpdum,akp,mp,ip,pstok do i=1,ntyp nbondterm(i)=1 read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) @@ -70,7 +74,7 @@ c endif enddo #else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok + read (ibond,*) junk,vbldp0,vbldpdum,akp,rjunk,mp,ip,pstok do i=1,ntyp read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), & j=1,nbondterm(i)),msc(i),isc(i),restok(i) @@ -96,19 +100,64 @@ c enddo enddo endif +C reading lipid parameters + if (lprint) then + write (iout,*) "iliptranpar",iliptranpar + call flush(iout) + endif + read(iliptranpar,*) pepliptran + do i=1,ntyp + read(iliptranpar,*) liptranene(i) + enddo + close(iliptranpar) #ifdef CRYST_THETA C C Read the parameters of the probability distribution/energy expression C of the virtual-bond valence angles theta C do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) + read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i,1,1),j=1,2), + & (bthet(j,i,1,1),j=1,2) read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 + read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) + read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) + sigc0(i)=sigc0(i)**2 + enddo + do i=1,ntyp + athet(1,i,1,-1)=athet(1,i,1,1) + athet(2,i,1,-1)=athet(2,i,1,1) + bthet(1,i,1,-1)=-bthet(1,i,1,1) + bthet(2,i,1,-1)=-bthet(2,i,1,1) + athet(1,i,-1,1)=-athet(1,i,1,1) + athet(2,i,-1,1)=-athet(2,i,1,1) + bthet(1,i,-1,1)=bthet(1,i,1,1) + bthet(2,i,-1,1)=bthet(2,i,1,1) + enddo + do i=-ntyp,-1 + a0thet(i)=a0thet(-i) + athet(1,i,-1,-1)=athet(1,-i,1,1) + athet(2,i,-1,-1)=-athet(2,-i,1,1) + bthet(1,i,-1,-1)=bthet(1,-i,1,1) + bthet(2,i,-1,-1)=-bthet(2,-i,1,1) + athet(1,i,-1,1)=athet(1,-i,1,1) + athet(2,i,-1,1)=-athet(2,-i,1,1) + bthet(1,i,-1,1)=-bthet(1,-i,1,1) + bthet(2,i,-1,1)=bthet(2,-i,1,1) + athet(1,i,1,-1)=-athet(1,-i,1,1) + athet(2,i,1,-1)=athet(2,-i,1,1) + bthet(1,i,1,-1)=bthet(1,-i,1,1) + bthet(2,i,1,-1)=-bthet(2,-i,1,1) + theta0(i)=theta0(-i) + sig0(i)=sig0(-i) + sigc0(i)=sigc0(-i) + do j=0,3 + polthet(j,i)=polthet(j,-i) + enddo + do j=1,3 + gthet(j,i)=gthet(j,-i) + enddo enddo + close (ithep) if (lprint) then if (.not.LaTeX) then @@ -119,7 +168,7 @@ C & ' B1 ',' B2 ' do i=1,ntyp write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) + & a0thet(i),(athet(j,i,1,1),j=1,2),(bthet(j,i,1,1),j=1,2) enddo write (iout,'(/a/9x,5a/79(1h-))') & 'Parameters of the expression for sigma(theta_c):', @@ -146,7 +195,8 @@ C & ' b1*10^1 ',' b2*10^1 ' do i=1,ntyp write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) + & a0thet(i),(100*athet(j,i,1,1),j=1,2), + & (10*bthet(j,i,1,1),j=1,2) enddo write (iout,'(/a/9x,5a/79(1h-))') & 'Parameters of the expression for sigma(theta_c):', @@ -167,54 +217,76 @@ C endif endif #else + IF (tor_mode.eq.0) THEN C C Read the parameters of Utheta determined from ab initio surfaces C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 C read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, & ntheterm3,nsingle,ndouble + write (iout,*) "ithep",ithep + call flush(iout) nntheterm=max0(ntheterm,ntheterm2,ntheterm3) read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 + do i=-ntyp1,-1 + ithetyp(i)=-ithetyp(-i) + enddo + do iblock=1,2 + do i=-maxthetyp,maxthetyp + do j=-maxthetyp,maxthetyp + do k=-maxthetyp,maxthetyp + aa0thet(i,j,k,iblock)=0.0d0 do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 + aathet(l,i,j,k,iblock)=0.0d0 enddo do l=1,ntheterm2 do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 + bbthet(m,l,i,j,k,iblock)=0.0d0 + ccthet(m,l,i,j,k,iblock)=0.0d0 + ddthet(m,l,i,j,k,iblock)=0.0d0 + eethet(m,l,i,j,k,iblock)=0.0d0 enddo enddo do l=1,ntheterm3 do m=1,ndouble do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 + ffthet(mm,m,l,i,j,k,iblock)=0.0d0 + ggthet(mm,m,l,i,j,k,iblock)=0.0d0 enddo enddo enddo enddo enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) + enddo + enddo +c VAR:iblock means terminally blocking group 1=non-proline 2=proline + do iblock=1,2 +c VAR:ntethtyp is type of theta potentials type currently 0=glycine +c VAR:1=non-glicyne non-proline 2=proline +c VAR:negative values for D-aminoacid + do i=0,nthetyp + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + read (ithep,'(6a)',end=111,err=111) res1 + read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock) +c VAR: aa0thet is variable describing the average value of Foureir +c VAR: expansion series +c VAR: aathet is foureir expansion in theta/2 angle for full formula +c VAR: look at the fitting equation in Kozlowska et al., J. Phys.: +Condens. Matter 19 (2007) 285203 and Sieradzan et al., unpublished + read (ithep,*,end=111,err=111) + &(aathet(l,i,j,k,iblock),l=1,ntheterm) read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) + & ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & ll=1,ntheterm2) read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), + & (((ffthet(llll,lll,ll,i,j,k,iblock), + & ffthet(lll,llll,ll,i,j,k,iblock), + & ggthet(llll,lll,ll,i,j,k,iblock), + & ggthet(lll,llll,ll,i,j,k,iblock), & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) enddo enddo @@ -222,42 +294,97 @@ C C C For dummy ends assign glycine-type coefficients of theta-only terms; the C coefficients of theta-and-gamma-dependent terms are zero. -C +C IF YOU WANT VALENCE POTENTIALS FOR DUMMY ATOM UNCOMENT BELOW (NOT +C RECOMENTDED AFTER VERSION 3.3) +c do i=1,nthetyp +c do j=1,nthetyp +c do l=1,ntheterm +c aathet(l,i,j,nthetyp+1,iblock)=aathet(l,i,j,1,iblock) +c aathet(l,nthetyp+1,i,j,iblock)=aathet(l,1,i,j,iblock) +c enddo +c aa0thet(i,j,nthetyp+1,iblock)=aa0thet(i,j,1,iblock) +c aa0thet(nthetyp+1,i,j,iblock)=aa0thet(1,i,j,iblock) +c enddo +c do l=1,ntheterm +c aathet(l,nthetyp+1,i,nthetyp+1,iblock)=aathet(l,1,i,1,iblock) +c enddo +c aa0thet(nthetyp+1,i,nthetyp+1,iblock)=aa0thet(1,i,1,iblock) +c enddo +c enddo +C AND COMMENT THE LOOPS BELOW do i=1,nthetyp do j=1,nthetyp do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) + aathet(l,i,j,nthetyp+1,iblock)=0.0d0 + aathet(l,nthetyp+1,i,j,iblock)=0.0d0 enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) + aa0thet(i,j,nthetyp+1,iblock)=0.0d0 + aa0thet(nthetyp+1,i,j,iblock)=0.0d0 enddo do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) + aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0 enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) + aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0 + enddo enddo +C TILL HERE +C Substitution for D aminoacids from symmetry. + do iblock=1,2 + do i=-nthetyp,0 + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock) + do l=1,ntheterm + aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock) + enddo + do ll=1,ntheterm2 + do lll=1,nsingle + bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock) + ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock) + ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock) + eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock) + enddo + enddo + do ll=1,ntheterm3 + do lll=2,ndouble + do llll=1,lll-1 + ffthet(llll,lll,ll,i,j,k,iblock)= + & ffthet(llll,lll,ll,-i,-j,-k,iblock) + ffthet(lll,llll,ll,i,j,k,iblock)= + & ffthet(lll,llll,ll,-i,-j,-k,iblock) + ggthet(llll,lll,ll,i,j,k,iblock)= + & -ggthet(llll,lll,ll,-i,-j,-k,iblock) + ggthet(lll,llll,ll,i,j,k,iblock)= + & -ggthet(lll,llll,ll,-i,-j,-k,iblock) + enddo !ll + enddo !lll + enddo !llll + enddo !k + enddo !j + enddo !i + enddo !iblock C C Control printout of the coefficients of virtual-bond-angle potentials C if (lprint) then write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 + do iblock=1,2 + do i=0,nthetyp + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) + & 'Type ',toronelet(i),toronelet(j),toronelet(k) write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) + write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock) write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) + & (l,aathet(l,i,j,k,iblock),l=1,ntheterm) do l=1,ntheterm2 write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') & "b",l,"c",l,"d",l,"e",l do m=1,nsingle write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) + & bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock), + & ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock) enddo enddo do l=1,ntheterm3 @@ -266,16 +393,90 @@ C do m=2,ndouble do n=1,m-1 write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) + & ffthet(n,m,l,i,j,k,iblock), + & ffthet(m,n,l,i,j,k,iblock), + & ggthet(n,m,l,i,j,k,iblock), + & ggthet(m,n,l,i,j,k,iblock) enddo enddo enddo enddo enddo + enddo enddo call flush(iout) endif + + ELSE + +C here will be the apropriate recalibrating for D-aminoacid + read (ithep,*,end=121,err=121) nthetyp + do i=-nthetyp+1,nthetyp-1 + read (ithep,*,end=121,err=121) nbend_kcc_Tb(i) + do j=0,nbend_kcc_Tb(i) + read (ithep,*,end=121,err=121) ijunk,v1bend_chyb(j,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Parameters of the valence-only potentials" + do i=-nthetyp+1,nthetyp-1 + write (iout,'(2a)') "Type ",toronelet(i) + do k=0,nbend_kcc_Tb(i) + write(iout,'(i5,f15.5)') k,v1bend_chyb(k,i) + enddo + enddo + endif + + ENDIF ! TOR_MODE + +c write (2,*) "Start reading THETA_PDB",ithep_pdb + do i=1,ntyp +c write (2,*) 'i=',i + read (ithep_pdb,*,err=111,end=111) + & a0thet(i),(athet(j,i,1,1),j=1,2), + & (bthet(j,i,1,1),j=1,2) + read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) + read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) + read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) + sigc0(i)=sigc0(i)**2 + enddo + do i=1,ntyp + athet(1,i,1,-1)=athet(1,i,1,1) + athet(2,i,1,-1)=athet(2,i,1,1) + bthet(1,i,1,-1)=-bthet(1,i,1,1) + bthet(2,i,1,-1)=-bthet(2,i,1,1) + athet(1,i,-1,1)=-athet(1,i,1,1) + athet(2,i,-1,1)=-athet(2,i,1,1) + bthet(1,i,-1,1)=bthet(1,i,1,1) + bthet(2,i,-1,1)=bthet(2,i,1,1) + enddo + do i=-ntyp,-1 + a0thet(i)=a0thet(-i) + athet(1,i,-1,-1)=athet(1,-i,1,1) + athet(2,i,-1,-1)=-athet(2,-i,1,1) + bthet(1,i,-1,-1)=bthet(1,-i,1,1) + bthet(2,i,-1,-1)=-bthet(2,-i,1,1) + athet(1,i,-1,1)=athet(1,-i,1,1) + athet(2,i,-1,1)=-athet(2,-i,1,1) + bthet(1,i,-1,1)=-bthet(1,-i,1,1) + bthet(2,i,-1,1)=bthet(2,-i,1,1) + athet(1,i,1,-1)=-athet(1,-i,1,1) + athet(2,i,1,-1)=athet(2,-i,1,1) + bthet(1,i,1,-1)=bthet(1,-i,1,1) + bthet(2,i,1,-1)=-bthet(2,-i,1,1) + theta0(i)=theta0(-i) + sig0(i)=sig0(-i) + sigc0(i)=sigc0(-i) + do j=0,3 + polthet(j,i)=polthet(j,-i) + enddo + do j=1,3 + gthet(j,i)=gthet(j,-i) + enddo + enddo +c write (2,*) "End reading THETA_PDB" + close (ithep_pdb) #endif close(ithep) #ifdef CRYST_SC @@ -301,10 +502,17 @@ C bsc(1,i)=0.0D0 read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), & ((blower(k,l,1),l=1,k),k=1,3) + censc(1,1,-i)=censc(1,1,i) + censc(2,1,-i)=censc(2,1,i) + censc(3,1,-i)=-censc(3,1,i) do j=2,nlob(i) read (irotam,*,end=112,err=112) bsc(j,i) read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), & ((blower(k,l,j),l=1,k),k=1,3) + censc(1,j,-i)=censc(1,j,i) + censc(2,j,-i)=censc(2,j,i) + censc(3,j,-i)=-censc(3,j,i) +C BSC is amplitude of Gaussian enddo do j=1,nlob(i) do k=1,3 @@ -315,6 +523,14 @@ C enddo gaussc(k,l,j,i)=akl gaussc(l,k,j,i)=akl + if (((k.eq.3).and.(l.ne.3)) + & .or.((l.eq.3).and.(k.ne.3))) then + gaussc(k,l,j,-i)=-akl + gaussc(l,k,j,-i)=-akl + else + gaussc(k,l,j,-i)=akl + gaussc(l,k,j,-i)=akl + endif enddo enddo enddo @@ -363,8 +579,441 @@ C enddo endif enddo +C +C Read the parameters of the probability distribution/energy expression +C of the side chains. +C + write (2,*) "Start reading ROTAM_PDB" + do i=1,ntyp + read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) + if (i.eq.10) then + dsc_inv(i)=0.0D0 + else + dsc_inv(i)=1.0D0/dsc(i) + endif + if (i.ne.10) then + do j=1,nlob(i) + do k=1,3 + do l=1,3 + blower(l,k,j)=0.0D0 + enddo + enddo + enddo + bsc(1,i)=0.0D0 + read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), + & ((blower(k,l,1),l=1,k),k=1,3) + do j=2,nlob(i) + read (irotam_pdb,*,end=112,err=112) bsc(j,i) + read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), + & ((blower(k,l,j),l=1,k),k=1,3) + enddo + do j=1,nlob(i) + do k=1,3 + do l=1,k + akl=0.0D0 + do m=1,3 + akl=akl+blower(k,m,j)*blower(l,m,j) + enddo + gaussc(k,l,j,i)=akl + gaussc(l,k,j,i)=akl + enddo + enddo + enddo + endif + enddo + close (irotam_pdb) + write (2,*) "End reading ROTAM_PDB" #endif close(irotam) +C +C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local +C interaction energy of the Gly, Ala, and Pro prototypes. +C + read (ifourier,*) nloctyp + SPLIT_FOURIERTOR = nloctyp.lt.0 + nloctyp = iabs(nloctyp) +#ifdef NEWCORR + read (ifourier,*,end=115,err=115) (itype2loc(i),i=1,ntyp) + read (ifourier,*,end=115,err=115) (iloctyp(i),i=0,nloctyp-1) + itype2loc(ntyp1)=nloctyp + iloctyp(nloctyp)=ntyp1 + do i=1,ntyp1 + itype2loc(-i)=-itype2loc(i) + enddo +#else + iloctyp(0)=10 + iloctyp(1)=9 + iloctyp(2)=20 + iloctyp(3)=ntyp1 +#endif + do i=1,nloctyp + iloctyp(-i)=-iloctyp(i) + enddo +c write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1) +c write (iout,*) "nloctyp",nloctyp, +c & " iloctyp",(iloctyp(i),i=0,nloctyp) +#ifdef NEWCORR + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1" +c write (iout,*) ((bnew1(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2" +c write (iout,*) ((bnew2(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnew(kk,1,i) + read (ifourier,*,end=115,err=115) ccnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnew(kk,1,i) + read (ifourier,*,end=115,err=115) ddnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW" +c write (iout,*) ((ddnew(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenew(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1" +c write(iout,*)(((eenew(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0new(ii,i) + enddo +c write (iout,*) (e0new(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW" + do i=0,nloctyp-1 + do ii=1,3 + ccnew(ii,1,i)=ccnew(ii,1,i)/2 + ccnew(ii,2,i)=ccnew(ii,2,i)/2 + ddnew(ii,1,i)=ddnew(ii,1,i)/2 + ddnew(ii,2,i)=ddnew(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1(ii,1,-i)= bnew1(ii,1,i) + bnew1(ii,2,-i)=-bnew1(ii,2,i) + bnew2(ii,1,-i)= bnew2(ii,1,i) + bnew2(ii,2,-i)=-bnew2(ii,2,i) + enddo + do ii=1,3 +c ccnew(ii,1,i)=ccnew(ii,1,i)/2 +c ccnew(ii,2,i)=ccnew(ii,2,i)/2 +c ddnew(ii,1,i)=ddnew(ii,1,i)/2 +c ddnew(ii,2,i)=ddnew(ii,2,i)/2 + ccnew(ii,1,-i)=ccnew(ii,1,i) + ccnew(ii,2,-i)=-ccnew(ii,2,i) + ddnew(ii,1,-i)=ddnew(ii,1,i) + ddnew(ii,2,-i)=-ddnew(ii,2,i) + enddo + e0new(1,-i)= e0new(1,i) + e0new(2,-i)=-e0new(2,i) + e0new(3,-i)=-e0new(3,i) + do kk=1,2 + eenew(kk,1,1,-i)= eenew(kk,1,1,i) + eenew(kk,1,2,-i)=-eenew(kk,1,2,i) + eenew(kk,2,1,-i)=-eenew(kk,2,1,i) + eenew(kk,2,2,-i)= eenew(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') "Coefficients of the multibody terms" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') j,(bnew1(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') j,(bnew2(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of C" + write (iout,'(3hC11,3f10.5)') (ccnew(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of D" + write (iout,'(3hD11,3f10.5)') (ddnew(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of E" + write (iout,'(2hE0,3f10.5)') (e0new(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') j,k,(eenew(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + IF (SPLIT_FOURIERTOR) THEN + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR TOR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1 TOR" +c write (iout,*) ((bnew1tor(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2 TOR" +c write (iout,*) ((bnew2tor(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ccnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW TOR" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ddnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW TOR" +c write (iout,*) ((ddnewtor(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenewtor(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1 TOR" +c write(iout,*)(((eenewtor(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0newtor(ii,i) + enddo +c write (iout,*) (e0newtor(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW TOR" + do i=0,nloctyp-1 + do ii=1,3 + ccnewtor(ii,1,i)=ccnewtor(ii,1,i)/2 + ccnewtor(ii,2,i)=ccnewtor(ii,2,i)/2 + ddnewtor(ii,1,i)=ddnewtor(ii,1,i)/2 + ddnewtor(ii,2,i)=ddnewtor(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1tor(ii,1,-i)= bnew1tor(ii,1,i) + bnew1tor(ii,2,-i)=-bnew1tor(ii,2,i) + bnew2tor(ii,1,-i)= bnew2tor(ii,1,i) + bnew2tor(ii,2,-i)=-bnew2tor(ii,2,i) + enddo + do ii=1,3 + ccnewtor(ii,1,-i)=ccnewtor(ii,1,i) + ccnewtor(ii,2,-i)=-ccnewtor(ii,2,i) + ddnewtor(ii,1,-i)=ddnewtor(ii,1,i) + ddnewtor(ii,2,-i)=-ddnewtor(ii,2,i) + enddo + e0newtor(1,-i)= e0newtor(1,i) + e0newtor(2,-i)=-e0newtor(2,i) + e0newtor(3,-i)=-e0newtor(3,i) + do kk=1,2 + eenewtor(kk,1,1,-i)= eenewtor(kk,1,1,i) + eenewtor(kk,1,2,-i)=-eenewtor(kk,1,2,i) + eenewtor(kk,2,1,-i)=-eenewtor(kk,2,1,i) + eenewtor(kk,2,2,-i)= eenewtor(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Single-body coefficients of the torsional potentials" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1tor" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') + & j,(bnew1tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2tor" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') + & j,(bnew2tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of Ctor" + write (iout,'(3hC11,3f10.5)') (ccnewtor(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Dtor" + write (iout,'(3hD11,3f10.5)') (ddnewtor(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Etor" + write (iout,'(2hE0,3f10.5)') (e0newtor(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') + & j,k,(eenewtor(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + ELSE + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1tor(ii,j,i)=bnew1(ii,j,i) + enddo + enddo + do ii=1,3 + do j=1,2 + bnew2tor(ii,j,i)=bnew2(ii,j,i) + enddo + enddo + do ii=1,3 + ccnewtor(ii,1,i)=ccnew(ii,1,i) + ccnewtor(ii,2,i)=ccnew(ii,2,i) + ddnewtor(ii,1,i)=ddnew(ii,1,i) + ddnewtor(ii,2,i)=ddnew(ii,2,i) + enddo + enddo + ENDIF !SPLIT_FOURIER_TOR +#else + if (lprint) + & write (iout,*) "Coefficients of the expansion of Eloc(l1,l2)" + do i=0,nloctyp-1 + read (ifourier,*,end=115,err=115) + read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13) + if (lprint) then + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) + endif + if (i.gt.0) then + b(2,-i)= b(2,i) + b(3,-i)= b(3,i) + b(4,-i)=-b(4,i) + b(5,-i)=-b(5,i) + endif +c B1(1,i) = b(3) +c B1(2,i) = b(5) +c B1(1,-i) = b(3) +c B1(2,-i) = -b(5) +c b1(1,i)=0.0d0 +c b1(2,i)=0.0d0 +c B1tilde(1,i) = b(3) +c B1tilde(2,i) =-b(5) +c B1tilde(1,-i) =-b(3) +c B1tilde(2,-i) =b(5) +c b1tilde(1,i)=0.0d0 +c b1tilde(2,i)=0.0d0 +c B2(1,i) = b(2) +c B2(2,i) = b(4) +c B2(1,-i) =b(2) +c B2(2,-i) =-b(4) +cc B1tilde(1,i) = b(3,i) +cc B1tilde(2,i) =-b(5,i) +C B1tilde(1,-i) =-b(3,i) +C B1tilde(2,-i) =b(5,i) +cc b1tilde(1,i)=0.0d0 +cc b1tilde(2,i)=0.0d0 +cc B2(1,i) = b(2,i) +cc B2(2,i) = b(4,i) +C B2(1,-i) =b(2,i) +C B2(2,-i) =-b(4,i) + +c b2(1,i)=0.0d0 +c b2(2,i)=0.0d0 + CCold(1,1,i)= b(7,i) + CCold(2,2,i)=-b(7,i) + CCold(2,1,i)= b(9,i) + CCold(1,2,i)= b(9,i) + CCold(1,1,-i)= b(7,i) + CCold(2,2,-i)=-b(7,i) + CCold(2,1,-i)=-b(9,i) + CCold(1,2,-i)=-b(9,i) +c CC(1,1,i)=0.0d0 +c CC(2,2,i)=0.0d0 +c CC(2,1,i)=0.0d0 +c CC(1,2,i)=0.0d0 +c Ctilde(1,1,i)= CCold(1,1,i) +c Ctilde(1,2,i)= CCold(1,2,i) +c Ctilde(2,1,i)=-CCold(2,1,i) +c Ctilde(2,2,i)=-CCold(2,2,i) + +c Ctilde(1,1,i)=0.0d0 +c Ctilde(1,2,i)=0.0d0 +c Ctilde(2,1,i)=0.0d0 +c Ctilde(2,2,i)=0.0d0 + DDold(1,1,i)= b(6,i) + DDold(2,2,i)=-b(6,i) + DDold(2,1,i)= b(8,i) + DDold(1,2,i)= b(8,i) + DDold(1,1,-i)= b(6,i) + DDold(2,2,-i)=-b(6,i) + DDold(2,1,-i)=-b(8,i) + DDold(1,2,-i)=-b(8,i) +c DD(1,1,i)=0.0d0 +c DD(2,2,i)=0.0d0 +c DD(2,1,i)=0.0d0 +c DD(1,2,i)=0.0d0 +c Dtilde(1,1,i)= DD(1,1,i) +c Dtilde(1,2,i)= DD(1,2,i) +c Dtilde(2,1,i)=-DD(2,1,i) +c Dtilde(2,2,i)=-DD(2,2,i) + +c Dtilde(1,1,i)=0.0d0 +c Dtilde(1,2,i)=0.0d0 +c Dtilde(2,1,i)=0.0d0 +c Dtilde(2,2,i)=0.0d0 + EEold(1,1,i)= b(10,i)+b(11,i) + EEold(2,2,i)=-b(10,i)+b(11,i) + EEold(2,1,i)= b(12,i)-b(13,i) + EEold(1,2,i)= b(12,i)+b(13,i) + EEold(1,1,-i)= b(10,i)+b(11,i) + EEold(2,2,-i)=-b(10,i)+b(11,i) + EEold(2,1,-i)=-b(12,i)+b(13,i) + EEold(1,2,-i)=-b(12,i)-b(13,i) + write(iout,*) "TU DOCHODZE" + print *,"JESTEM" +c ee(1,1,i)=1.0d0 +c ee(2,2,i)=1.0d0 +c ee(2,1,i)=0.0d0 +c ee(1,2,i)=0.0d0 +c ee(2,1,i)=ee(1,2,i) + enddo + if (lprint) then + write (iout,*) + write (iout,*) + &"Coefficients of the cumulants (independent of valence angles)" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,*) 'B1' + write(iout,'(2f10.5)') B(3,i),B(5,i) + write (iout,*) 'B2' + write(iout,'(2f10.5)') B(2,i),B(4,i) + write (iout,*) 'CC' + do j=1,2 + write (iout,'(2f10.5)') CCold(j,1,i),CCold(j,2,i) + enddo + write(iout,*) 'DD' + do j=1,2 + write (iout,'(2f10.5)') DDold(j,1,i),DDold(j,2,i) + enddo + write(iout,*) 'EE' + do j=1,2 + write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i) + enddo + enddo + endif +#endif #ifdef CRYST_TOR C @@ -395,54 +1044,86 @@ C C C Read torsional parameters C + IF (TOR_MODE.eq.0) THEN + read (itorp,*,end=113,err=113) ntortyp read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j) + do i=1,ntyp1 + itype2loc(i)=itortyp(i) + enddo + do i=1,ntyp1 + itype2loc(-i)=-itype2loc(i) + enddo + itortyp(ntyp1)=ntortyp + do iblock=1,2 + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo + write (iout,*) 'ntortyp',ntortyp + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + read (itorp,*,end=113,err=113) nterm(i,j,iblock), + & nlor(i,j,iblock) + nterm(-i,-j,iblock)=nterm(i,j,iblock) + nlor(-i,-j,iblock)=nlor(i,j,iblock) v0ij=0.0d0 si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) + do k=1,nterm(i,j,iblock) + read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock), + & v2(k,i,j,iblock) + v1(k,-i,-j,iblock)=v1(k,i,j,iblock) + v2(k,-i,-j,iblock)=-v2(k,i,j,iblock) + v0ij=v0ij+si*v1(k,i,j,iblock) si=-si +c write(iout,*) i,j,k,iblock,nterm(i,j,iblock) +c write(iout,*) v1(k,-i,-j,iblock),v1(k,i,j,iblock), +c &v2(k,-i,-j,iblock),v2(k,i,j,iblock) enddo - do k=1,nlor(i,j) + do k=1,nlor(i,j,iblock) read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) + & vlor2(k,i,j),vlor3(k,i,j) v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) enddo - v0(i,j)=v0ij + v0(i,j,iblock)=v0ij + v0(-i,-j,iblock)=v0ij enddo enddo + enddo close (itorp) if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp + write (iout,'(/a/)') 'Parameters of the SCCOR potentials:' + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 write (iout,*) 'ityp',i,' jtyp',j write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) + do k=1,nterm(i,j,iblock) + write (iout,'(2(1pe15.5))') v1(k,i,j,iblock), + & v2(k,i,j,iblock) enddo write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') + do k=1,nlor(i,j,iblock) + write (iout,'(3(1pe15.5))') & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) enddo enddo enddo + enddo endif + C C 6/23/01 Read parameters for double torsionals C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then +c write (iout,*) "OK onelett", +c & i,j,k,t1,t2,t3 + + if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) + & .or. t3.ne.toronelet(k)) then write (iout,*) "Error in double torsional parameter file", & i,j,k,t1,t2,t3 #ifdef MPI @@ -450,173 +1131,319 @@ C #endif stop "Error in double torsional parameter file" endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k), - & ntermd_2(i,j,k) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k), - & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k), - & m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo + read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock), + & ntermd_2(i,j,k,iblock) + ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock) + ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock) + read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) +C Martix of D parameters for one dimesional foureir series + do l=1,ntermd_1(i,j,k,iblock) + v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock) + v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock) + v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock) + v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock) +c write(iout,*) "whcodze" , +c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) + enddo + read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock), + & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock), + & v2s(m,l,i,j,k,iblock), + & m=1,l-1),l=1,ntermd_2(i,j,k,iblock)) +C Martix of D parameters for two dimesional fourier series + do l=1,ntermd_2(i,j,k,iblock) + do m=1,l-1 + v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock) + v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock) + v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock) + v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock) + enddo!m + enddo!l + enddo!k + enddo!j + enddo!i + enddo!iblock if (lprint) then - write (iout,*) + write (iout,*) write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) + & ' nsingle',ntermd_1(i,j,k,iblock), + & ' ndouble',ntermd_2(i,j,k,iblock) write (iout,*) write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) + do l=1,ntermd_1(i,j,k,iblock) + write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l, + & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock), + & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock), + & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock) enddo write (iout,*) write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)), + & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) enddo enddo enddo + enddo endif + + ELSE IF (TOR_MODE.eq.1) THEN + +C read valence-torsional parameters + read (itorp,*,end=121,err=121) ntortyp + nkcctyp=ntortyp + write (iout,*) "Valence-torsional parameters read in ntortyp", + & ntortyp + read (itorp,*,end=121,err=121) (itortyp(i),i=1,ntyp) + write (iout,*) "itortyp_kcc",(itortyp(i),i=1,ntyp) +#ifndef NEWCORR + do i=1,ntyp1 + itype2loc(i)=itortyp(i) + enddo #endif -C -C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local -C correlation energies. -C - read (isccor,*,end=119,err=119) nterm_sccor - do i=1,20 - do j=1,20 - read (isccor,'(a)') - do k=1,nterm_sccor - read (isccor,*,end=119,err=119) kk,v1sccor(k,i,j), - & v2sccor(k,i,j) + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 +C first we read the cos and sin gamma parameters + read (itorp,'(13x,a)',end=121,err=121) string + write (iout,*) i,j,string + read (itorp,*,end=121,err=121) + & nterm_kcc(j,i),nterm_kcc_Tb(j,i) +C read (itorkcc,*,end=121,err=121) nterm_kcc_Tb(j,i) + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + read (itorp,*,end=121,err=121) ii,jj,kk, + & v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) + enddo + enddo enddo enddo enddo - close (isccor) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants of SCCORR:' - do i=1,20 - do j=1,20 - write (iout,*) 'ityp',i,' jtyp',j - do k=1,nterm_sccor - write (iout,'(2(1pe15.5))') v1sccor(k,i,j),v2sccor(k,i,j) + ELSE +#ifdef NEWCORR +c AL 4/8/16: Calculate coefficients from one-body parameters + ntortyp=nloctyp + do i=-ntyp1,ntyp1 + itortyp(i)=itype2loc(i) + enddo + write (iout,*) + &"Val-tor parameters calculated from cumulant coefficients ntortyp" + & ,ntortyp + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + nterm_kcc(j,i)=2 + nterm_kcc_Tb(j,i)=3 + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) + v1_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,1,j) + & +bnew1tor(k,2,i)*bnew2tor(l,2,j) + v2_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,2,j) + & +bnew1tor(k,2,i)*bnew2tor(l,1,j) enddo enddo + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) +#ifdef CORRCD + v1_kcc(k,l,2,i,j)=-(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) +#else + v1_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) +#endif + enddo + enddo +c f(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(theta)*b11(theta)+b21(theta)*b12(theta))*sin(gamma)+(c11(theta)*d11(theta)-c12(theta)*d12(theta))*cos(2*gamma)+(c12(theta)*d11(theta)+c11(theta)*d12(theta))*sin(2*gamma) + enddo + enddo +#else + write (iout,*) "TOR_MODE>1 only with NEWCORR" + stop +#endif + ENDIF ! TOR_MODE + + if (tor_mode.gt.0 .and. lprint) then +c Print valence-torsional parameters + write (iout,'(a)') + & "Parameters of the valence-torsional potentials" + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + write (iout,'(3a)') "Type ",toronelet(i),toronelet(j) + write (iout,'(3a5,2a15)') "itor","ival","jval","v_kcc","v2_kcc" + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + write (iout,'(3i5,2f15.4)') + & k,l-1,ll-1,v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) + enddo + enddo + enddo + enddo enddo endif + +#endif +C Read of Side-chain backbone correlation parameters +C Modified 11 May 2012 by Adasko +CCC C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - if (lprint) then - write (iout,*) - write (iout,*) "Coefficients of the cumulants" - endif - read (ifourier,*) nloctyp - do i=1,nloctyp - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13) - endif - B1(1,i) = b(3) - B1(2,i) = b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 - B1tilde(1,i) = b(3) - B1tilde(2,i) =-b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 - B2(1,i) = b(2) - B2(2,i) = b(4) -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CC(1,1,i)= b(7) - CC(2,2,i)=-b(7) - CC(2,1,i)= b(9) - CC(1,2,i)= b(9) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 - Ctilde(1,1,i)=b(7) - Ctilde(1,2,i)=b(9) - Ctilde(2,1,i)=-b(9) - Ctilde(2,2,i)=b(7) -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DD(1,1,i)= b(6) - DD(2,2,i)=-b(6) - DD(2,1,i)= b(8) - DD(1,2,i)= b(8) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 - Dtilde(1,1,i)=b(6) - Dtilde(1,2,i)=b(8) - Dtilde(2,1,i)=-b(8) - Dtilde(2,2,i)=b(6) -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EE(1,1,i)= b(10)+b(11) - EE(2,2,i)=-b(10)+b(11) - EE(2,1,i)= b(12)-b(13) - EE(1,2,i)= b(12)+b(13) -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) + read (isccor,*,end=119,err=119) nsccortyp +#ifdef SCCORPDB + read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) + do i=-ntyp,-1 + isccortyp(i)=-isccortyp(-i) enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) + iscprol=isccortyp(20) +c write (iout,*) 'ntortyp',ntortyp + maxinter=3 +cc maxinter is maximum interaction sites + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + read (isccor,*,end=119,err=119) + &nterm_sccor(i,j),nlor_sccor(i,j) + v0ijsccor=0.0d0 + v0ijsccor1=0.0d0 + v0ijsccor2=0.0d0 + v0ijsccor3=0.0d0 + si=-1.0d0 + nterm_sccor(-i,j)=nterm_sccor(i,j) + nterm_sccor(-i,-j)=nterm_sccor(i,j) + nterm_sccor(i,-j)=nterm_sccor(i,j) + do k=1,nterm_sccor(i,j) + read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) + & ,v2sccor(k,l,i,j) + if (j.eq.iscprol) then + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0 + & +v2sccor(k,l,i,j)*dsqrt(0.75d0) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0 + & +v1sccor(k,l,i,j)*dsqrt(0.75d0) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + else + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + if (j.eq.isccortyp(10)) then + v1sccor(k,l,-i,j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + endif + endif + v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) + v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j) + v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j) + v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j) + si=-si + enddo + do k=1,nlor_sccor(i,j) + read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), + & vlor2sccor(k,i,j),vlor3sccor(k,i,j) + v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ + &(1+vlor3sccor(k,i,j)**2) + enddo + v0sccor(l,i,j)=v0ijsccor + v0sccor(l,-i,j)=v0ijsccor1 + v0sccor(l,i,-j)=v0ijsccor2 + v0sccor(l,-i,-j)=v0ijsccor3 enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) + enddo + enddo + close (isccor) +#else + read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) +c write (iout,*) 'ntortyp',ntortyp + maxinter=3 +cc maxinter is maximum interaction sites + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + read (isccor,*,end=119,err=119) + & nterm_sccor(i,j),nlor_sccor(i,j) + v0ijsccor=0.0d0 + si=-1.0d0 + + do k=1,nterm_sccor(i,j) + read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) + & ,v2sccor(k,l,i,j) + v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) + si=-si + enddo + do k=1,nlor_sccor(i,j) + read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), + & vlor2sccor(k,i,j),vlor3sccor(k,i,j) + v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ + &(1+vlor3sccor(k,i,j)**2) + enddo + v0sccor(l,i,j)=v0ijsccor enddo enddo + enddo + close (isccor) + +#endif + if (lprint) then + write (iout,'(/a/)') 'Torsional constants:' + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + write (iout,*) 'ityp',i,' jtyp',j + write (iout,*) 'Fourier constants' + do k=1,nterm_sccor(i,j) + write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) + enddo + write (iout,*) 'Lorenz constants' + do k=1,nlor_sccor(i,j) + write (iout,'(3(1pe15.5))') + & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) + enddo + enddo + enddo + enddo endif + C C Read electrostatic-interaction parameters C @@ -638,8 +1465,10 @@ C bpp (i,j)=-2.0D0*epp(i,j)*rri ael6(i,j)=elpp6(i,j)*4.2D0**6 ael3(i,j)=elpp3(i,j)*4.2D0**3 +c lprint=.true. if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), & ael6(i,j),ael3(i,j) +c lprint=.false. enddo enddo C @@ -660,7 +1489,7 @@ C & ', exponents are ',expon,2*expon goto (10,20,30,30,40) ipot C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), + 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJ potential:' @@ -672,7 +1501,7 @@ C----------------------- LJ potential --------------------------------- endif goto 50 C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), + 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJK potential:' @@ -685,47 +1514,79 @@ C----------------------- LJK potential -------------------------------- endif goto 50 C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) + 30 do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) +C now we start reading lipid + do i=1,ntyp + read (isidep,*,end=1161,err=1161)(epslip(i,j),j=i,ntyp) + if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) + +C print *,"WARNING!!" +C do j=1,ntyp +C epslip(i,j)=epslip(i,j)+0.05d0 +C enddo + enddo + if (lprint) write(iout,*) epslip(1,1),"OK?" C For the GB potential convert sigma'**2 into chi' if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) + do i=1,ntyp + chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) enddo endif if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', + write (iout,'(/a/)') 'Parameters of the BP potential:' + write (iout,'(a/)') 'The epsilon array:' + call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) + write (iout,'(/a)') 'One-body parameters:' + write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), + write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), & chip(i),alp(i),i=1,ntyp) endif goto 50 C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) +c 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), +c & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), +c & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) + 40 do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(rr0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) + do i=1,ntyp + read (isidep,*,end=1161,err=1161)(epslip(i,j),j=i,ntyp) + if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) + enddo + do i=1,ntyp + chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) + enddo if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', + write (iout,'(/a/)') 'Parameters of the GBV potential:' + write (iout,'(a/)') 'The epsilon array:' + call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) + write (iout,'(/a)') 'One-body parameters:' + write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), + write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), & sigii(i),chip(i),alp(i),i=1,ntyp) endif +C now we start reading lipid 50 continue close (isidep) C----------------------------------------------------------------------- C Calculate the "working" parameters of SC interactions. do i=2,ntyp do j=1,i-1 - eps(i,j)=eps(j,i) + eps(i,j)=eps(j,i) + epslip(i,j)=epslip(j,i) enddo enddo do i=1,ntyp @@ -754,10 +1615,17 @@ C Calculate the "working" parameters of SC interactions. epsij=eps(i,j) sigeps=dsign(1.0D0,epsij) epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) + aa_aq(i,j)=epsij*rrij*rrij + bb_aq(i,j)=-sigeps*epsij*rrij + aa_aq(j,i)=aa_aq(i,j) + bb_aq(j,i)=bb_aq(i,j) + epsijlip=epslip(i,j) + sigeps=dsign(1.0D0,epsijlip) + epsijlip=dabs(epsijlip) + aa_lip(i,j)=epsijlip*rrij*rrij + bb_lip(i,j)=-sigeps*epsijlip*rrij + aa_lip(j,i)=aa_lip(i,j) + bb_lip(j,i)=bb_lip(i,j) if (ipot.gt.2) then sigt1sq=sigma0(i)**2 sigt2sq=sigma0(j)**2 @@ -790,16 +1658,36 @@ c augm(i,j)=0.5D0**(2*expon)*aa(i,j) endif if (lprint) then write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), + & restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j), & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) endif enddo enddo +#ifdef TUBE + write(iout,*) "tube param" + read(itube,*) epspeptube,sigmapeptube + sigmapeptube=sigmapeptube**6 + sigeps=dsign(1.0D0,epspeptube) + epspeptube=dabs(epspeptube) + pep_aa_tube=4.0d0*epspeptube*sigmapeptube**2 + pep_bb_tube=-sigeps*4.0d0*epspeptube*sigmapeptube + write(iout,*) pep_aa_tube,pep_bb_tube,tubetranenepep + do i=1,ntyp + read(itube,*) epssctube,sigmasctube + sigmasctube=sigmasctube**6 + sigeps=dsign(1.0D0,epssctube) + epssctube=dabs(epssctube) + sc_aa_tube_par(i)=4.0d0*epssctube*sigmasctube**2 + sc_bb_tube_par(i)=-sigeps*4.0d0*epssctube*sigmasctube + write(iout,*) sc_aa_tube_par(i), sc_bb_tube_par(i),tubetranene(i) + enddo +#endif + #ifdef OLDSCP C C Define the SC-p interaction constants (hard-coded; old style) C - do i=1,20 + do i=1,ntyp C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates C helix formation) c aad(i,1)=0.3D0*4.0D0**12 @@ -834,19 +1722,20 @@ C bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 enddo - +c lprint=.true. if (lprint) then write (iout,*) "Parameters of SC-p interactions:" - do i=1,20 + do i=1,ntyp write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) enddo endif +c lprint=.false. #endif C C Define the constants of the disulfide bridge C - ebr=-5.50D0 +C ebr=-12.00D0 c c Old arbitrary potential - commented out. c @@ -857,13 +1746,13 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G** c energy surface of diethyl disulfide. c A. Liwo and U. Kozlowska, 11/24/03 c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 +C D0CM = 3.78d0 +C AKCM = 15.1d0 +C AKTH = 11.0d0 +C AKCT = 12.0d0 +C V1SS =-1.08d0 +C V2SS = 7.61d0 +C V3SS = 13.7d0 c akcm=0.0d0 c akth=0.0d0 c akct=0.0d0 @@ -871,13 +1760,30 @@ c v1ss=0.0d0 c v2ss=0.0d0 c v3ss=0.0d0 - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss +C if(me.eq.king) then +C write (iout,'(/a)') "Disulfide bridge parameters:" +C write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr +C write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm +C write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct +C write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, +C & ' v3ss:',v3ss +C endif + if (shield_mode.gt.0) then +C VSolvSphere the volume of solving sphere +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters +c write (iout,*) "rpp(1,1)",rpp(1,1)," pi",pi + VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 + VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 + write (iout,*) "VSolvSphere",VSolvSphere,"VSolvSphere_div", + & VSolvSphere_div +C long axis of side chain + do i=1,ntyp + long_r_sidechain(i)=vbldsc0(1,i) + short_r_sidechain(i)=sigma0(i) + enddo + buff_shield=1.0d0 endif return 111 write (iout,*) "Error reading bending energy parameters." @@ -893,11 +1799,15 @@ c v3ss=0.0d0 goto 999 116 write (iout,*) "Error reading electrostatic energy parameters." goto 999 + 1161 write (iout,*) "Error reading electrostatic energy parameters.Lip" + goto 999 117 write (iout,*) "Error reading side chain interaction parameters." goto 999 118 write (iout,*) "Error reading SCp interaction parameters." goto 999 119 write (iout,*) "Error reading SCCOR parameters" + go to 999 + 121 write (iout,*) "Error in Czybyshev parameters" 999 continue #ifdef MPI call MPI_Finalize(Ierror) @@ -948,6 +1858,22 @@ c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' #else call getenv(var,val) #endif - +C set the variables used for shielding effect +C if (shield_mode.gt.0) then +C VSolvSphere the volume of solving sphere +C print *,pi,"pi" +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters +C VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 +C VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 +C long axis of side chain +C do i=1,ntyp +C long_r_sidechain(i)=vbldsc0(1,i) +C short_r_sidechain(i)=sigma0(i) +C enddo +C lets set the buffor value +C buff_shield=1.0d0 +C endif return end diff --git a/source/unres/src_MD-M/pdtf5579.pdb b/source/unres/src_MD-M/pdtf5579.pdb deleted file mode 100644 index c606aed..0000000 --- a/source/unres/src_MD-M/pdtf5579.pdb +++ /dev/null @@ -1,1195 +0,0 @@ - -lang fortran - -so#1 readrtns_CSA.pp.F - - -so#2 DIMENSIONS - - -so#3 mpif.h - - -so#4 COMMON.SETUP - - -so#5 COMMON.CONTROL - - -so#6 COMMON.SBRIDGE - - -so#7 COMMON.IOUNITS - - -so#8 DIMENSIONS - - -so#9 mpif.h - - -so#10 COMMON.IOUNITS - - -so#11 COMMON.TIME1 - - -so#12 COMMON.THREAD - - -so#13 COMMON.SBRIDGE - - -so#14 COMMON.CONTROL - - -so#15 COMMON.MCM - - -so#16 COMMON.MAP - - -so#17 COMMON.HEADER - - -so#18 COMMON.CSA - - -so#19 COMMON.CHAIN - - -so#20 COMMON.MUCA - - -so#21 COMMON.MD - - -so#22 COMMON.FFIELD - - -so#23 COMMON.SETUP - - -so#24 DIMENSIONS - - -so#25 COMMON.IOUNITS - - -so#26 COMMON.TIME1 - - -so#27 COMMON.MD - - -so#28 COMMON.LANGEVIN.lang0 - - -so#29 COMMON.INTERACT - - -so#30 COMMON.NAMES - - -so#31 COMMON.GEO - - -so#32 COMMON.REMD - - -so#33 COMMON.CONTROL - - -so#34 COMMON.SETUP - - -so#35 DIMENSIONS - - -so#36 COMMON.IOUNITS - - -so#37 COMMON.TIME1 - - -so#38 COMMON.MD - - -so#39 COMMON.LANGEVIN.lang0 - - -so#40 COMMON.INTERACT - - -so#41 COMMON.NAMES - - -so#42 COMMON.GEO - - -so#43 COMMON.SETUP - - -so#44 COMMON.CONTROL - - -so#45 COMMON.SPLITELE - - -so#46 DIMENSIONS - - -so#47 mpif.h - - -so#48 COMMON.IOUNITS - - -so#49 COMMON.GEO - - -so#50 COMMON.VAR - - -so#51 COMMON.INTERACT - - -so#52 COMMON.LOCAL - - -so#53 COMMON.NAMES - - -so#54 COMMON.CHAIN - - -so#55 COMMON.FFIELD - - -so#56 COMMON.SBRIDGE - - -so#57 COMMON.HEADER - - -so#58 COMMON.CONTROL - - -so#59 COMMON.DBASE - - -so#60 COMMON.THREAD - - -so#61 COMMON.CONTACTS - - -so#62 COMMON.TORCNSTR - - -so#63 COMMON.TIME1 - - -so#64 COMMON.BOUNDS - - -so#65 COMMON.MD - - -so#66 COMMON.SETUP - - -so#67 DIMENSIONS - - -so#68 mpif.h - - -so#69 COMMON.IOUNITS - - -so#70 COMMON.GEO - - -so#71 COMMON.VAR - - -so#72 COMMON.INTERACT - - -so#73 COMMON.LOCAL - - -so#74 COMMON.NAMES - - -so#75 COMMON.CHAIN - - -so#76 COMMON.FFIELD - - -so#77 COMMON.SBRIDGE - - -so#78 COMMON.HEADER - - -so#79 COMMON.CONTROL - - -so#80 COMMON.DBASE - - -so#81 COMMON.THREAD - - -so#82 COMMON.TIME1 - - -so#83 COMMON.SETUP - - -so#84 DIMENSIONS - - -so#85 COMMON.GEO - - -so#86 COMMON.VAR - - -so#87 COMMON.CHAIN - - -so#88 COMMON.IOUNITS - - -so#89 COMMON.CONTROL - - -so#90 COMMON.LOCAL - - -so#91 COMMON.INTERACT - - -so#92 DIMENSIONS - - -so#93 COMMON.IOUNITS - - -so#94 COMMON.GEO - - -so#95 COMMON.VAR - - -so#96 COMMON.INTERACT - - -so#97 COMMON.LOCAL - - -so#98 COMMON.NAMES - - -so#99 COMMON.CHAIN - - -so#100 COMMON.FFIELD - - -so#101 COMMON.SBRIDGE - - -so#102 COMMON.HEADER - - -so#103 COMMON.CONTROL - - -so#104 COMMON.DBASE - - -so#105 COMMON.THREAD - - -so#106 COMMON.TIME1 - - -so#107 DIMENSIONS - - -so#108 COMMON.IOUNITS - - -so#109 COMMON.GEO - - -so#110 COMMON.VAR - - -so#111 COMMON.INTERACT - - -so#112 COMMON.LOCAL - - -so#113 COMMON.NAMES - - -so#114 COMMON.CHAIN - - -so#115 COMMON.FFIELD - - -so#116 COMMON.SBRIDGE - - -so#117 COMMON.HEADER - - -so#118 COMMON.CONTROL - - -so#119 COMMON.DBASE - - -so#120 COMMON.THREAD - - -so#121 COMMON.TIME1 - - -so#122 DIMENSIONS - - -so#123 COMMON.IOUNITS - - -so#124 COMMON.GEO - - -so#125 COMMON.VAR - - -so#126 COMMON.INTERACT - - -so#127 COMMON.LOCAL - - -so#128 COMMON.NAMES - - -so#129 COMMON.CHAIN - - -so#130 COMMON.FFIELD - - -so#131 COMMON.SBRIDGE - - -so#132 COMMON.HEADER - - -so#133 COMMON.CONTROL - - -so#134 COMMON.DBASE - - -so#135 COMMON.THREAD - - -so#136 COMMON.TIME1 - - -so#137 DIMENSIONS - - -so#138 COMMON.MAP - - -so#139 COMMON.IOUNITS - - -so#140 DIMENSIONS - - -so#141 COMMON.IOUNITS - - -so#142 COMMON.GEO - - -so#143 COMMON.CSA - - -so#144 COMMON.BANK - - -so#145 COMMON.CONTROL - - -so#146 DIMENSIONS - - -so#147 COMMON.MCM - - -so#148 COMMON.MCE - - -so#149 COMMON.IOUNITS - - -so#150 DIMENSIONS - - -so#151 COMMON.MINIM - - -so#152 COMMON.IOUNITS - - -so#153 DIMENSIONS - - -so#154 COMMON.GEO - - -so#155 COMMON.VAR - - -so#156 COMMON.CHAIN - - -so#157 COMMON.IOUNITS - - -so#158 COMMON.CONTROL - - -so#159 DIMENSIONS - - -so#160 mpif.h - - -so#161 COMMON.SETUP - - -so#162 COMMON.IOUNITS - - -so#163 COMMON.MD - - -so#164 COMMON.CONTROL - - -so#165 DIMENSIONS - - -so#166 COMMON.IOUNITS - - -so#167 DIMENSIONS - - -so#168 COMMON.CHAIN - - -so#169 COMMON.IOUNITS - - -so#170 COMMON.MD - - -so#171 DIMENSIONS - - -so#172 mpif.h - - -so#173 COMMON.SETUP - - -so#174 COMMON.CHAIN - - -so#175 COMMON.IOUNITS - - -so#176 COMMON.MD - - -so#177 COMMON.CONTROL - - -so#178 DIMENSIONS - - -so#179 mpif.h - - -so#180 COMMON.SETUP - - -so#181 COMMON.CONTROL - - -so#182 COMMON.CHAIN - - -so#183 COMMON.IOUNITS - - -so#184 COMMON.SBRIDGE - - -so#185 DIMENSIONS - - -so#186 COMMON.IOUNITS - - -so#187 DIMENSIONS - - -so#188 COMMON.IOUNITS - - -so#189 DIMENSIONS - - -so#190 mpif.h - - -so#191 COMMON.IOUNITS - - -so#192 COMMON.TIME1 - - -so#193 COMMON.THREAD - - -so#194 COMMON.SBRIDGE - - -so#195 COMMON.CONTROL - - -so#196 COMMON.MCM - - -so#197 COMMON.MAP - - -so#198 COMMON.HEADER - - -so#199 COMMON.CSA - - -so#200 COMMON.CHAIN - - -so#201 COMMON.MUCA - - -so#202 COMMON.MD - - -so#203 COMMON.FFIELD - - -so#204 COMMON.SETUP - - -ro#1 READRTNS -rloc so#1 1 18 -rlink f90 -rkind fext -rstart so#1 13 7 -rstmt st#0 fsingle_if so#1 17 7 so#1 17 32 st#1 NA -rstmt st#1 fsingle_if so#1 19 7 so#1 19 56 st#2 NA -rstmt st#2 fsingle_if so#1 21 7 so#1 21 41 st#3 NA -rstmt st#3 fif so#1 23 7 so#1 26 11 st#4 NA -rstmt st#4 fsingle_if so#1 28 7 so#1 28 31 st#5 NA -rstmt st#6 fio so#1 32 8 so#1 32 48 st#7 NA -rstmt st#7 fsingle_if so#1 33 8 so#1 33 40 NA NA -rstmt st#5 fif so#1 31 7 so#1 34 12 st#8 st#6 -rstmt st#10 fio so#1 44 7 so#1 45 48 NA NA -rstmt st#9 fsingle_if so#1 43 7 so#1 45 48 st#11 st#10 -rstmt st#12 fio so#1 47 9 so#1 47 66 NA NA -rstmt st#11 fdo so#1 46 7 so#1 48 11 NA st#12 -rstmt st#8 fif so#1 41 7 so#1 50 11 st#13 st#9 -rstmt st#13 freturn so#1 53 7 so#1 53 12 st#14 NA -rstmt st#14 freturn so#1 54 7 so#1 54 9 NA NA -rbody st#0 - -ro#2 READ_CONTROL -rloc so#1 56 18 -rlink f90 -rkind fext -rstart so#1 86 7 -rstmt st#0 fassign so#1 86 7 so#1 86 17 st#1 NA -rstmt st#1 fassign so#1 87 7 so#1 87 20 st#2 NA -rstmt st#2 fassign so#1 88 7 so#1 88 16 st#3 NA -rstmt st#3 fio so#1 89 7 so#1 89 28 st#4 NA -rstmt st#4 fassign so#1 96 7 so#1 96 51 st#5 NA -rstmt st#5 fassign so#1 97 7 so#1 97 57 st#6 NA -rstmt st#6 fassign so#1 100 7 so#1 100 55 st#7 NA -rstmt st#8 fio so#1 108 8 so#1 108 50 st#9 NA -rstmt st#9 fio so#1 109 8 so#1 109 52 st#10 NA -rstmt st#10 fio so#1 110 8 so#1 110 58 st#11 NA -rstmt st#11 fio so#1 111 8 so#1 111 49 st#12 NA -rstmt st#12 fio so#1 112 8 so#1 112 52 st#13 NA -rstmt st#13 fio so#1 113 8 so#1 113 58 NA NA -rstmt st#7 fif so#1 107 7 so#1 114 11 st#14 st#8 -rstmt st#14 fassign so#1 118 7 so#1 118 26 st#15 NA -rstmt st#15 fassign so#1 119 7 so#1 119 28 st#16 NA -rstmt st#16 fassign so#1 120 7 so#1 120 18 st#17 NA -rstmt st#17 fassign so#1 121 7 so#1 121 16 st#18 NA -rstmt st#18 fassign so#1 123 7 so#1 123 48 st#19 NA -rstmt st#19 fassign so#1 124 7 so#1 124 45 st#20 NA -rstmt st#20 fassign so#1 125 7 so#1 125 51 st#21 NA -rstmt st#21 fassign so#1 126 7 so#1 126 30 st#22 NA -rstmt st#22 fassign so#1 127 7 so#1 127 53 st#23 NA -rstmt st#23 fassign so#1 128 7 so#1 128 28 st#24 NA -rstmt st#24 fassign so#1 129 7 so#1 129 49 st#25 NA -rstmt st#25 fassign so#1 130 7 so#1 130 55 st#26 NA -rstmt st#26 fassign so#1 131 7 so#1 131 47 st#27 NA -rstmt st#27 fassign so#1 132 7 so#1 132 49 st#28 NA -rstmt st#28 fassign so#1 133 7 so#1 133 47 st#29 NA -rstmt st#29 fassign so#1 134 7 so#1 134 59 st#30 NA -rstmt st#30 fassign so#1 135 7 so#1 135 42 st#31 NA -rstmt st#31 fassign so#1 136 7 so#1 136 49 st#32 NA -rstmt st#33 fio so#1 143 8 so#1 143 49 NA NA -rstmt st#32 fsingle_if so#1 142 7 so#1 143 49 st#34 st#33 -rstmt st#35 fassign so#1 146 9 so#1 146 18 st#36 NA -rstmt st#36 fassign so#1 147 9 so#1 147 21 NA NA -rstmt st#34 fif so#1 144 7 so#1 148 11 st#37 st#35 -rstmt st#38 fassign so#1 150 9 so#1 150 18 st#39 NA -rstmt st#40 fassign so#1 152 11 so#1 152 22 NA NA -rstmt st#42 fassign so#1 154 11 so#1 154 22 NA NA -rstmt st#43 fassign so#1 156 11 so#1 156 22 NA NA -rstmt st#41 fif so#1 153 9 so#1 157 13 NA st#42 st#43 -rstmt st#39 fif so#1 151 9 so#1 157 13 NA st#40 st#41 -rstmt st#45 fassign so#1 159 9 so#1 159 18 st#46 NA -rstmt st#48 fio so#1 165 11 so#1 165 72 NA NA -rstmt st#47 fsingle_if so#1 164 11 so#1 165 72 st#49 st#48 -rstmt st#49 fstop so#1 166 11 NULL 0 0 NA NA -rstmt st#46 fif so#1 161 9 so#1 167 13 NA NA st#47 -rstmt st#51 fassign so#1 169 9 so#1 169 18 NA NA -rstmt st#53 fassign so#1 171 9 so#1 171 18 NA NA -rstmt st#55 fassign so#1 173 9 so#1 173 18 NA NA -rstmt st#57 fassign so#1 175 9 so#1 175 18 NA NA -rstmt st#59 fassign so#1 178 9 so#1 178 18 NA NA -rstmt st#61 fassign so#1 187 9 so#1 187 19 NA NA -rstmt st#63 fassign so#1 189 9 so#1 189 19 NA NA -rstmt st#65 fassign so#1 191 9 so#1 191 19 NA NA -rstmt st#67 fassign so#1 193 9 so#1 193 19 NA NA -rstmt st#69 fassign so#1 195 9 so#1 195 19 NA NA -rstmt st#68 fif so#1 194 7 so#1 196 11 NA st#69 -rstmt st#66 fif so#1 192 7 so#1 196 11 NA st#67 st#68 -rstmt st#64 fif so#1 190 7 so#1 196 11 NA st#65 st#66 -rstmt st#62 fif so#1 188 7 so#1 196 11 NA st#63 st#64 -rstmt st#60 fif so#1 186 7 so#1 196 11 NA st#61 st#62 -rstmt st#58 fif so#1 177 7 so#1 196 11 NA st#59 st#60 -rstmt st#56 fif so#1 174 7 so#1 196 11 NA st#57 st#58 -rstmt st#54 fif so#1 172 7 so#1 196 11 NA st#55 st#56 -rstmt st#52 fif so#1 170 7 so#1 196 11 NA st#53 st#54 -rstmt st#50 fif so#1 168 7 so#1 196 11 NA st#51 st#52 -rstmt st#44 fif so#1 158 7 so#1 196 11 NA st#45 st#50 -rstmt st#37 fif so#1 149 7 so#1 196 11 st#70 st#38 st#44 -rstmt st#70 fassign so#1 198 7 so#1 198 42 st#71 NA -rstmt st#72 fio so#1 203 8 so#1 203 40 st#73 NA -rstmt st#73 fio so#1 204 8 so#1 204 47 NA NA -rstmt st#71 fif so#1 201 7 so#1 205 11 st#74 st#72 -rstmt st#74 fassign so#1 207 7 so#1 207 44 st#75 NA -rstmt st#75 fassign so#1 208 7 so#1 208 37 st#76 NA -rstmt st#76 fassign so#1 209 7 so#1 209 39 st#77 NA -rstmt st#77 fassign so#1 210 7 so#1 210 45 st#78 NA -rstmt st#78 fassign so#1 211 7 so#1 211 47 st#79 NA -rstmt st#79 fassign so#1 212 7 so#1 212 47 st#80 NA -rstmt st#80 fassign so#1 213 7 so#1 213 55 st#81 NA -rstmt st#82 fio so#1 216 8 so#1 217 48 NA NA -rstmt st#81 fsingle_if so#1 215 7 so#1 217 48 st#83 st#82 -rstmt st#83 freturn so#1 218 7 so#1 218 12 st#84 NA -rstmt st#84 freturn so#1 219 7 so#1 219 9 NA NA -rbody st#0 - -ro#3 READ_REMDPAR -rloc so#1 221 18 -rlink f90 -rkind fext -rstart so#1 246 7 -rstmt st#1 fio so#1 247 8 so#1 247 34 NA NA -rstmt st#0 fsingle_if so#1 246 7 so#1 247 34 st#2 st#1 -rstmt st#2 fassign so#1 254 7 so#1 254 48 st#3 NA -rstmt st#3 fassign so#1 256 7 so#1 256 56 st#4 NA -rstmt st#4 fassign so#1 257 7 so#1 257 53 st#5 NA -rstmt st#6 fassign so#1 260 18 so#1 260 50 NA NA -rstmt st#5 fsingle_if so#1 259 7 so#1 260 50 st#7 st#6 -rstmt st#8 fio so#1 268 8 so#1 268 35 st#9 NA -rstmt st#9 fio so#1 269 8 so#1 269 37 st#10 NA -rstmt st#10 fio so#1 270 8 so#1 270 41 st#11 NA -rstmt st#11 fio so#1 271 8 so#1 271 42 st#12 NA -rstmt st#12 fio so#1 272 8 so#1 272 54 NA NA -rstmt st#7 fif so#1 261 7 so#1 273 11 st#13 st#8 -rstmt st#13 fassign so#1 274 7 so#1 274 24 st#14 NA -rstmt st#15 fassign so#1 276 10 so#1 276 26 st#16 NA -rstmt st#16 fio so#1 278 10 so#1 278 51 st#17 NA -rstmt st#18 fio so#1 280 11 so#1 280 53 NA NA -rstmt st#17 fsingle_if so#1 279 10 so#1 280 53 NA st#18 -rstmt st#14 fif so#1 275 7 so#1 281 11 st#19 st#15 -rstmt st#19 fassign so#1 282 7 so#1 282 24 st#20 NA -rstmt st#21 fassign so#1 284 10 so#1 284 26 st#22 NA -rstmt st#22 fio so#1 286 10 so#1 286 52 st#23 NA -rstmt st#24 fio so#1 288 11 so#1 288 52 st#25 NA -rstmt st#25 fassign so#1 289 11 so#1 289 25 st#26 NA -rstmt st#27 fassign so#1 291 12 so#1 291 48 NA NA -rstmt st#26 fdo so#1 290 11 so#1 292 15 st#28 st#27 -rstmt st#28 fio so#1 293 11 so#1 293 66 NA NA -rstmt st#23 fif so#1 287 10 so#1 294 14 NA st#24 -rstmt st#20 fif so#1 283 7 so#1 295 11 st#29 st#21 -rstmt st#30 fio so#1 297 8 so#1 297 69 NA NA -rstmt st#29 fsingle_if so#1 296 7 so#1 297 69 st#31 st#30 -rstmt st#31 freturn so#1 298 7 so#1 298 12 st#32 NA -rstmt st#32 freturn so#1 299 7 so#1 299 9 NA NA -rbody st#0 - -ro#4 READ_MDPAR -rloc so#1 301 18 -rlink f90 -rkind fext -rstart so#1 324 7 -rstmt st#0 fassign so#1 333 7 so#1 333 47 st#1 NA -rstmt st#1 fassign so#1 335 7 so#1 335 30 st#2 NA -rstmt st#2 fassign so#1 337 7 so#1 337 30 st#3 NA -rstmt st#3 fassign so#1 340 7 so#1 340 43 st#4 NA -rstmt st#4 fassign so#1 341 7 so#1 341 41 st#5 NA -rstmt st#5 fassign so#1 342 7 so#1 342 47 st#6 NA -rstmt st#6 fassign so#1 343 7 so#1 343 45 st#7 NA -rstmt st#8 fassign so#1 348 36 so#1 348 64 NA NA -rstmt st#7 fsingle_if so#1 348 7 so#1 348 64 st#9 st#8 -rstmt st#9 fassign so#1 350 7 so#1 350 68 st#10 NA -rstmt st#10 fassign so#1 351 7 so#1 351 62 st#11 NA -rstmt st#12 fassign so#1 352 33 so#1 352 58 NA NA -rstmt st#11 fsingle_if so#1 352 7 so#1 352 58 st#13 st#12 -rstmt st#13 fassign so#1 353 7 so#1 353 45 st#14 NA -rstmt st#14 fassign so#1 354 7 so#1 354 59 st#15 NA -rstmt st#15 fassign so#1 355 7 so#1 355 47 st#16 NA -rstmt st#16 fassign so#1 357 7 so#1 357 12 st#17 NA -rstmt st#17 fif so#1 358 7 so#1 360 11 st#18 NA -rstmt st#19 fio so#1 363 8 so#1 363 21 st#20 NA -rstmt st#20 fio so#1 364 8 so#1 364 72 st#21 NA -rstmt st#21 fio so#1 365 8 so#1 365 21 st#22 NA -rstmt st#22 fio so#1 366 8 so#1 366 42 st#23 NA -rstmt st#23 fio so#1 367 8 so#1 367 62 st#24 NA -rstmt st#24 fio so#1 368 8 so#1 369 46 st#25 NA -rstmt st#25 fio so#1 370 8 so#1 370 60 st#26 NA -rstmt st#26 fio so#1 371 8 so#1 371 21 st#27 NA -rstmt st#27 fio so#1 372 8 so#1 372 66 st#28 NA -rstmt st#28 fio so#1 373 8 so#1 375 24 st#29 NA -rstmt st#29 fio so#1 376 8 so#1 376 53 st#30 NA -rstmt st#31 fio so#1 378 9 so#1 380 64 st#32 NA -rstmt st#32 fio so#1 381 9 so#1 382 30 NA NA -rstmt st#30 fif so#1 377 8 so#1 383 12 st#33 st#31 -rstmt st#33 fio so#1 384 8 so#1 386 39 st#34 NA -rstmt st#34 fio so#1 387 8 so#1 389 43 st#35 NA -rstmt st#35 fio so#1 390 8 so#1 391 63 st#36 NA -rstmt st#36 fio so#1 392 8 so#1 392 68 st#37 NA -rstmt st#37 fio so#1 393 8 so#1 393 70 st#38 NA -rstmt st#39 fio so#1 394 20 so#1 395 62 NA NA -rstmt st#38 fsingle_if so#1 394 8 so#1 395 62 NA st#39 -rstmt st#18 fif so#1 362 7 so#1 396 11 st#40 st#19 -rstmt st#40 fassign so#1 397 7 so#1 397 24 st#41 NA -rstmt st#42 fassign so#1 402 9 so#1 402 51 st#43 NA -rstmt st#44 fio so#1 405 10 so#1 405 62 st#45 NA -rstmt st#46 fio so#1 407 11 so#1 408 62 NA NA -rstmt st#48 fio so#1 410 11 so#1 410 68 NA NA -rstmt st#50 fio so#1 412 11 so#1 412 72 NA NA -rstmt st#52 fio so#1 414 11 so#1 414 51 NA NA -rstmt st#53 fio so#1 416 11 so#1 417 69 st#54 NA -rstmt st#54 fstop so#1 418 11 NULL 0 0 NA NA -rstmt st#51 fif so#1 413 10 so#1 419 14 NA st#52 st#53 -rstmt st#49 fif so#1 411 10 so#1 419 14 NA st#50 st#51 -rstmt st#47 fif so#1 409 10 so#1 419 14 NA st#48 st#49 -rstmt st#45 fif so#1 406 10 so#1 419 14 st#55 st#46 st#47 -rstmt st#55 fio so#1 420 10 so#1 420 57 st#56 NA -rstmt st#56 fio so#1 421 10 so#1 421 70 st#57 NA -rstmt st#57 fio so#1 422 10 so#1 422 70 st#58 NA -rstmt st#58 fio so#1 423 10 so#1 424 59 st#59 NA -rstmt st#60 fio so#1 425 24 so#1 427 56 NA NA -rstmt st#59 fsingle_if so#1 425 10 so#1 427 56 NA st#60 -rstmt st#43 fif so#1 404 9 so#1 428 13 st#61 st#44 -rstmt st#61 fassign so#1 430 9 so#1 430 30 st#62 NA -rstmt st#63 fio so#1 432 10 so#1 433 13 NA NA -rstmt st#62 fsingle_if so#1 431 9 so#1 433 13 st#64 st#63 -rstmt st#64 fassign so#1 434 9 so#1 434 39 st#65 NA -rstmt st#65 fassign so#1 435 9 so#1 435 39 st#66 NA -rstmt st#67 fassign so#1 437 11 so#1 437 51 st#68 NA -rstmt st#68 fassign so#1 438 11 so#1 438 45 NA NA -rstmt st#66 fdo so#1 436 9 so#1 439 14 st#69 st#67 -rstmt st#70 fio so#1 441 10 so#1 443 52 st#71 NA -rstmt st#71 fio so#1 444 10 so#1 444 72 st#72 NA -rstmt st#73 fio so#1 446 11 so#1 447 45 NA NA -rstmt st#72 fdo so#1 445 10 so#1 448 14 NA st#73 -rstmt st#69 fif so#1 440 9 so#1 449 13 NA st#70 -rstmt st#76 fio so#1 452 10 so#1 452 56 st#77 NA -rstmt st#77 fio so#1 453 10 so#1 453 57 st#78 NA -rstmt st#78 fio so#1 454 10 so#1 454 71 st#79 NA -rstmt st#80 fio so#1 456 10 so#1 457 36 NA NA -rstmt st#79 fsingle_if so#1 455 10 so#1 457 36 st#81 st#80 -rstmt st#82 fio so#1 459 11 so#1 461 17 NA NA -rstmt st#81 fsingle_if so#1 458 10 so#1 461 17 NA st#82 -rstmt st#75 fif so#1 451 9 so#1 462 13 NA st#76 -rstmt st#84 fio so#1 465 10 so#1 465 63 NA NA -rstmt st#83 fsingle_if so#1 464 9 so#1 465 63 NA st#84 -rstmt st#74 fif so#1 450 7 so#1 466 11 NA st#75 st#83 -rstmt st#41 fif so#1 398 7 so#1 466 11 st#85 st#42 st#74 -rstmt st#87 fio so#1 468 18 so#1 468 72 NA NA -rstmt st#86 fsingle_if so#1 468 8 so#1 468 72 st#88 st#87 -rstmt st#89 fio so#1 470 11 so#1 470 54 st#90 NA -rstmt st#90 fio so#1 471 11 so#1 471 65 st#91 NA -rstmt st#91 fio so#1 472 11 so#1 472 60 st#92 NA -rstmt st#92 fio so#1 473 11 so#1 473 65 st#93 NA -rstmt st#94 fio so#1 475 12 so#1 475 52 st#95 NA -rstmt st#96 fio so#1 477 15 so#1 478 62 NA NA -rstmt st#95 fdo so#1 476 12 so#1 479 16 st#97 st#96 -rstmt st#97 fio so#1 480 12 so#1 480 68 st#98 NA -rstmt st#98 fio so#1 481 12 so#1 481 60 st#99 NA -rstmt st#100 fio so#1 483 13 so#1 484 64 NA NA -rstmt st#99 fdo so#1 482 12 so#1 485 16 st#101 st#100 -rstmt st#101 fio so#1 486 12 so#1 487 33 st#102 NA -rstmt st#102 fio so#1 488 12 so#1 488 45 st#103 NA -rstmt st#104 fio so#1 490 13 so#1 492 56 NA NA -rstmt st#103 fdo so#1 489 12 so#1 493 16 NA st#104 -rstmt st#93 fdo so#1 474 11 so#1 494 15 st#105 st#94 -rstmt st#105 fassign so#1 495 9 so#1 495 30 NA NA -rstmt st#88 fif so#1 469 8 so#1 496 12 NA st#89 -rstmt st#85 fif so#1 467 7 so#1 497 11 st#106 st#86 -rstmt st#107 fio so#1 499 8 so#1 499 67 NA NA -rstmt st#106 fsingle_if so#1 498 7 so#1 499 67 st#108 st#107 -rstmt st#108 freturn so#1 500 7 so#1 500 12 st#109 NA -rstmt st#109 freturn so#1 501 7 so#1 501 9 NA NA -rbody st#0 - -ro#5 MOLREAD -rloc so#1 503 18 -rlink f90 -rkind fext -rstart so#1 546 7 -rstmt st#1 fassign so#1 571 42 so#1 571 47 NA NA -rstmt st#0 fsingle_if so#1 571 7 so#1 571 47 st#2 st#1 -rstmt st#3 fassign so#1 574 28 so#1 574 39 NA NA -rstmt st#2 fsingle_if so#1 574 7 so#1 574 39 st#4 st#3 -rstmt st#4 fassign so#1 575 7 so#1 575 20 st#5 NA -rstmt st#5 fassign so#1 576 7 so#1 576 21 st#6 NA -rstmt st#6 fassign so#1 577 7 so#1 577 22 st#7 NA -rstmt st#7 fassign so#1 578 7 so#1 578 22 st#8 NA -rstmt st#8 fassign so#1 579 7 so#1 579 23 st#9 NA -rstmt st#9 fassign so#1 580 7 so#1 580 23 st#10 NA -rstmt st#10 fassign so#1 581 7 so#1 581 24 st#11 NA -rstmt st#11 fassign so#1 582 7 so#1 582 23 st#12 NA -rstmt st#12 fassign so#1 583 7 so#1 583 23 st#13 NA -rstmt st#13 fassign so#1 584 7 so#1 584 24 st#14 NA -rstmt st#14 fassign so#1 585 7 so#1 585 22 st#15 NA -rstmt st#15 fassign so#1 586 7 so#1 586 24 st#16 NA -rstmt st#16 fassign so#1 587 7 so#1 587 22 st#17 NA -rstmt st#17 fassign so#1 588 7 so#1 588 24 st#18 NA -rstmt st#18 fassign so#1 589 7 so#1 589 25 st#19 NA -rstmt st#19 fassign so#1 590 7 so#1 590 24 st#20 NA -rstmt st#20 fassign so#1 591 7 so#1 591 23 st#21 NA -rstmt st#21 fassign so#1 592 7 so#1 592 24 st#22 NA -rstmt st#22 fassign so#1 593 7 so#1 593 24 st#23 NA -rstmt st#24 fio so#1 595 8 so#1 597 21 NA NA -rstmt st#23 fsingle_if so#1 594 7 so#1 597 21 st#25 st#24 -rstmt st#25 flabel so#1 598 1 NULL 0 0 st#26 NA -rstmt st#28 fio so#1 619 9 so#1 620 50 st#29 NA -rstmt st#29 fio so#1 621 9 so#1 623 64 NA NA -rstmt st#31 fio so#1 625 9 so#1 626 50 NA NA -rstmt st#30 fif so#1 624 8 so#1 627 12 NA st#31 -rstmt st#27 fif so#1 618 8 so#1 627 12 st#32 st#28 st#30 -rstmt st#32 fio so#1 628 8 so#1 629 57 st#33 NA -rstmt st#33 fio so#1 630 8 so#1 631 62 NA NA -rstmt st#26 fif so#1 617 7 so#1 632 11 st#34 st#27 -rstmt st#34 fassign so#1 633 7 so#1 633 35 st#35 NA -rstmt st#36 fassign so#1 635 9 so#1 635 33 st#37 NA -rstmt st#37 fassign so#1 636 9 so#1 636 33 st#38 NA -rstmt st#38 fassign so#1 637 9 so#1 637 33 st#39 NA -rstmt st#39 fassign so#1 638 9 so#1 638 33 NA NA -rstmt st#35 fdo so#1 634 7 so#1 639 11 st#40 st#36 -rstmt st#41 fio so#1 642 8 so#1 644 21 NA NA -rstmt st#40 fsingle_if so#1 641 7 so#1 644 21 st#42 st#41 -rstmt st#42 flabel so#1 645 1 NULL 0 0 st#43 NA -rstmt st#44 fio so#1 665 8 so#1 666 13 NA NA -rstmt st#43 fsingle_if so#1 664 7 so#1 666 13 st#45 st#44 -rstmt st#46 fio so#1 676 8 so#1 676 60 st#47 NA -rstmt st#47 fio so#1 677 8 so#1 678 19 st#48 NA -rstmt st#48 fio so#1 679 8 so#1 679 59 st#49 NA -rstmt st#49 fio so#1 680 8 so#1 680 31 st#50 NA -rstmt st#50 fio so#1 681 8 so#1 681 49 NA NA -rstmt st#45 fif so#1 675 7 so#1 682 11 st#51 st#46 -rstmt st#52 fio so#1 684 9 so#1 684 31 st#53 NA -rstmt st#54 fio so#1 686 10 so#1 686 71 NA NA -rstmt st#53 fsingle_if so#1 685 9 so#1 686 71 st#55 st#54 -rstmt st#55 fio so#1 687 9 so#1 687 53 st#56 NA -rstmt st#57 flabel so#1 689 1 NULL 0 0 st#58 NA -rstmt st#58 fio so#1 689 3 so#1 689 52 st#59 NA -rstmt st#59 fstop so#1 690 9 NULL 0 0 st#60 NA -rstmt st#56 fgoto so#1 688 9 so#1 688 16 st#57 NA st#60 -rstmt st#60 flabel so#1 691 1 NULL 0 0 st#61 NA -rstmt st#62 fio so#1 696 10 so#1 696 72 NA NA -rstmt st#61 fsingle_if so#1 695 9 so#1 696 72 st#63 st#62 -rstmt st#64 fassign so#1 698 11 so#1 698 31 NA NA -rstmt st#63 fdo so#1 697 9 so#1 699 13 st#65 st#64 -rstmt st#65 fio so#1 700 9 so#1 700 22 st#66 NA -rstmt st#66 fassign so#1 701 9 so#1 701 22 st#67 NA -rstmt st#67 fassign so#1 702 9 so#1 702 29 st#68 NA -rstmt st#70 fio so#1 707 11 so#1 707 42 NA NA -rstmt st#69 fsingle_if so#1 706 10 so#1 707 42 st#71 st#70 -rstmt st#71 fassign so#1 708 10 so#1 708 19 st#72 NA -rstmt st#73 fassign so#1 710 11 so#1 710 22 st#74 NA -rstmt st#75 fassign so#1 712 13 so#1 712 17 st#76 NA -rstmt st#76 fassign so#1 713 13 so#1 713 23 st#77 NA -rstmt st#78 fassign so#1 716 15 so#1 716 23 NA NA -rstmt st#77 fdo so#1 714 13 so#1 717 17 st#79 st#78 -rstmt st#80 fio so#1 718 22 so#1 719 45 NA NA -rstmt st#79 fsingle_if so#1 718 13 so#1 719 45 NA st#80 -rstmt st#74 fif so#1 711 11 so#1 720 15 NA st#75 -rstmt st#72 fdo so#1 709 10 so#1 721 14 NA st#73 -rstmt st#68 fif so#1 705 9 so#1 722 15 NA st#69 -rstmt st#51 fif so#1 683 7 so#1 723 11 st#81 st#52 -rstmt st#82 fio so#1 726 9 so#1 726 25 st#83 NA -rstmt st#84 fio so#1 729 11 so#1 729 57 NA NA -rstmt st#85 fio so#1 731 11 so#1 731 57 NA NA -rstmt st#83 fif so#1 728 9 so#1 732 13 st#86 st#84 st#85 -rstmt st#87 fassign so#1 735 11 so#1 735 48 NA NA -rstmt st#86 fdo so#1 734 9 so#1 736 13 st#88 st#87 -rstmt st#89 fassign so#1 739 11 so#1 739 21 st#90 NA -rstmt st#90 fassign so#1 740 11 so#1 740 28 NA NA -rstmt st#88 fdo so#1 738 9 so#1 741 13 st#91 st#89 -rstmt st#92 fassign so#1 743 11 so#1 743 36 st#93 NA -rstmt st#93 fassign so#1 744 11 so#1 744 44 NA NA -rstmt st#91 fdo so#1 742 9 so#1 747 13 NA st#92 -rstmt st#81 fif so#1 724 7 so#1 748 12 st#94 st#82 -rstmt st#96 fassign so#1 757 11 so#1 757 19 NA NA -rstmt st#98 fassign so#1 763 4 so#1 763 12 NA NA -rstmt st#99 fassign so#1 765 4 so#1 765 12 NA NA -rstmt st#97 fif so#1 759 9 so#1 766 15 NA st#98 st#99 -rstmt st#95 fif so#1 753 9 so#1 766 15 NA st#96 st#97 -rstmt st#94 fdo so#1 751 7 so#1 767 11 st#100 st#95 -rstmt st#101 fio so#1 769 8 so#1 769 28 st#102 NA -rstmt st#103 fio so#1 771 10 so#1 771 42 NA NA -rstmt st#102 fdo so#1 770 8 so#1 772 12 st#104 st#103 -rstmt st#104 fio so#1 773 8 so#1 773 34 NA NA -rstmt st#100 fif so#1 768 7 so#1 774 11 st#105 st#101 -rstmt st#106 fassign so#1 778 9 so#1 778 25 st#107 NA -rstmt st#107 fassign so#1 779 9 so#1 779 24 NA NA -rstmt st#105 fdo so#1 777 7 so#1 780 11 st#108 st#106 -rstmt st#108 fio so#1 781 7 so#1 781 30 st#109 NA -rstmt st#110 fio so#1 783 9 so#1 783 26 st#111 NA -rstmt st#111 fio so#1 784 9 so#1 784 71 st#112 NA -rstmt st#113 fio so#1 786 10 so#1 787 62 st#114 NA -rstmt st#115 fio so#1 789 11 so#1 789 68 NA NA -rstmt st#114 fdo so#1 788 10 so#1 790 14 NA st#115 -rstmt st#112 fif so#1 785 9 so#1 791 13 st#116 st#113 -rstmt st#117 fassign so#1 793 11 so#1 793 33 st#118 NA -rstmt st#118 fassign so#1 794 11 so#1 794 37 NA NA -rstmt st#116 fdo so#1 792 9 so#1 795 13 st#119 st#117 -rstmt st#120 fio so#1 797 10 so#1 797 37 NA NA -rstmt st#119 fsingle_if so#1 796 9 so#1 797 37 st#121 st#120 -rstmt st#122 fassign so#1 799 11 so#1 799 29 st#123 NA -rstmt st#123 fassign so#1 800 11 so#1 800 44 st#124 NA -rstmt st#124 fassign so#1 801 11 so#1 801 44 NA NA -rstmt st#121 fdo so#1 798 9 so#1 802 14 NA st#122 -rstmt st#109 fif so#1 782 7 so#1 803 11 st#125 st#110 -rstmt st#125 fassign so#1 804 7 so#1 804 11 st#126 NA -rstmt st#127 fio so#1 808 8 so#1 808 61 st#128 NA -rstmt st#129 fio so#1 810 10 so#1 811 71 NA NA -rstmt st#128 fdo so#1 809 8 so#1 812 12 NA st#129 -rstmt st#126 fif so#1 806 7 so#1 814 11 st#130 st#127 -rstmt st#130 fassign so#1 816 7 so#1 816 14 st#131 NA -rstmt st#132 fassign so#1 818 27 so#1 818 31 NA NA -rstmt st#131 fsingle_if so#1 818 7 so#1 818 31 st#133 st#132 -rstmt st#134 fassign so#1 819 30 so#1 819 38 NA NA -rstmt st#133 fsingle_if so#1 819 7 so#1 819 38 st#135 st#134 -rstmt st#137 fio so#1 822 10 so#1 822 43 NA NA -rstmt st#136 fsingle_if so#1 821 9 so#1 822 43 st#138 st#137 -rstmt st#138 fassign so#1 823 9 so#1 823 22 st#139 NA -rstmt st#142 fassign so#1 827 15 so#1 827 30 st#143 NA -rstmt st#141 fif so#1 826 13 so#1 829 17 NA st#142 -rstmt st#140 fdo so#1 825 11 so#1 830 15 st#144 st#141 -rstmt st#144 fio so#1 831 11 so#1 832 68 st#145 NA -rstmt st#145 fstop so#1 833 11 NULL 0 0 NA NA -rstmt st#148 fassign so#1 838 15 so#1 838 37 st#149 NA -rstmt st#149 fassign so#1 839 15 so#1 839 28 st#150 NA -rstmt st#147 fif so#1 836 13 so#1 841 17 NA st#148 -rstmt st#146 fdo so#1 835 11 so#1 842 16 st#151 st#147 -rstmt st#151 fio so#1 843 11 so#1 844 68 NA NA -rstmt st#139 fif so#1 824 9 so#1 845 13 st#152 st#140 st#146 -rstmt st#150 fgoto so#1 840 15 so#1 840 22 NA NA st#152 -rstmt st#143 fgoto so#1 828 15 so#1 828 22 NA NA st#152 -rstmt st#152 flabel so#1 846 1 NULL 0 0 st#153 NA -rstmt st#154 fassign so#1 847 24 so#1 847 35 NA NA -rstmt st#153 fsingle_if so#1 847 9 so#1 847 35 st#155 st#154 -rstmt st#156 fassign so#1 848 30 so#1 848 43 NA NA -rstmt st#155 fsingle_if so#1 848 9 so#1 848 43 st#157 st#156 -rstmt st#158 fassign so#1 849 30 so#1 849 43 NA NA -rstmt st#157 fsingle_if so#1 849 9 so#1 849 43 st#159 st#158 -rstmt st#160 fio so#1 851 10 so#1 852 48 NA NA -rstmt st#159 fsingle_if so#1 850 9 so#1 852 48 NA st#160 -rstmt st#135 fif so#1 820 7 so#1 853 11 st#161 st#136 -rstmt st#162 fassign so#1 855 26 so#1 855 37 NA NA -rstmt st#161 fsingle_if so#1 855 7 so#1 855 37 st#163 st#162 -rstmt st#164 fassign so#1 857 9 so#1 857 25 NA NA -rstmt st#166 fassign so#1 859 9 so#1 859 18 NA NA -rstmt st#165 fif so#1 858 7 so#1 860 11 NA st#166 -rstmt st#163 fif so#1 856 7 so#1 860 11 st#167 st#164 st#165 -rstmt st#168 fio so#1 862 8 so#1 862 60 st#169 NA -rstmt st#169 fio so#1 863 8 so#1 863 36 NA NA -rstmt st#167 fif so#1 861 7 so#1 864 11 st#170 st#168 -rstmt st#173 flabel so#1 871 1 NULL 0 0 st#174 NA -rstmt st#174 fio so#1 871 4 so#1 871 65 st#175 NA -rstmt st#175 fstop so#1 874 11 NULL 0 0 st#176 NA -rstmt st#172 fgoto so#1 870 11 so#1 870 17 st#173 NA st#176 -rstmt st#176 flabel so#1 876 1 NULL 0 0 st#177 NA -rstmt st#177 fassign so#1 879 11 so#1 879 24 st#178 NA -rstmt st#178 fassign so#1 880 11 so#1 880 24 st#179 NA -rstmt st#179 fassign so#1 881 11 so#1 881 24 st#180 NA -rstmt st#182 fassign so#1 884 15 so#1 884 30 NA NA -rstmt st#181 fdo so#1 883 13 so#1 885 17 NA st#182 -rstmt st#180 fdo so#1 882 11 so#1 886 15 NA st#181 -rstmt st#171 fif so#1 868 9 so#1 888 13 st#183 st#172 -rstmt st#183 fsingle_if so#1 891 9 so#1 891 46 st#184 NA -rstmt st#185 fio so#1 893 10 so#1 893 43 NA NA -rstmt st#184 fsingle_if so#1 892 9 so#1 893 43 st#186 st#185 -rstmt st#188 fio so#1 896 10 so#1 896 63 NA NA -rstmt st#187 fsingle_if so#1 895 9 so#1 896 63 st#189 st#188 -rstmt st#191 fassign so#1 899 13 so#1 899 63 NA NA -rstmt st#190 fdo so#1 898 11 so#1 900 15 st#192 st#191 -rstmt st#193 fio so#1 902 12 so#1 904 59 NA NA -rstmt st#192 fsingle_if so#1 901 11 so#1 904 59 NA st#193 -rstmt st#189 fdo so#1 897 9 so#1 905 13 NA st#190 -rstmt st#186 fif so#1 894 9 so#1 906 13 NA st#187 -rstmt st#170 fif so#1 867 7 so#1 907 11 st#194 st#171 -rstmt st#197 fio so#1 915 12 so#1 915 65 NA NA -rstmt st#196 fsingle_if so#1 914 11 so#1 915 65 st#198 st#197 -rstmt st#199 fio so#1 917 13 so#1 919 44 st#200 NA -rstmt st#202 fassign so#1 923 17 so#1 923 39 st#203 NA -rstmt st#203 fassign so#1 924 17 so#1 924 55 NA NA -rstmt st#201 fdo so#1 922 15 so#1 925 19 NA st#202 -rstmt st#200 fdo so#1 921 13 so#1 926 17 st#204 st#201 -rstmt st#207 fassign so#1 930 19 so#1 930 50 st#208 NA -rstmt st#208 fassign so#1 931 19 so#1 931 70 NA NA -rstmt st#206 fdo so#1 929 17 so#1 932 21 NA st#207 -rstmt st#205 fif so#1 928 15 so#1 933 19 NA st#206 -rstmt st#204 fdo so#1 927 13 so#1 934 17 st#209 st#205 -rstmt st#209 freturn so#1 935 13 so#1 935 18 NA NA -rstmt st#198 fif so#1 916 11 so#1 938 15 st#210 st#199 -rstmt st#211 flabel so#1 940 1 NULL 0 0 st#212 NA -rstmt st#212 fio so#1 940 4 so#1 940 56 st#213 NA -rstmt st#213 fstop so#1 944 11 NULL 0 0 st#214 NA -rstmt st#210 fgoto so#1 939 11 so#1 939 17 st#211 NA st#214 -rstmt st#214 flabel so#1 945 1 NULL 0 0 NA NA -rstmt st#217 fio so#1 948 11 so#1 948 63 NA NA -rstmt st#216 fsingle_if so#1 947 10 so#1 948 63 st#218 st#217 -rstmt st#219 fassign so#1 950 11 so#1 950 31 NA NA -rstmt st#218 fdo so#1 949 10 so#1 951 14 st#220 st#219 -rstmt st#221 fassign so#1 953 11 so#1 953 30 NA NA -rstmt st#220 fdo so#1 952 10 so#1 954 14 st#222 st#221 -rstmt st#223 fassign so#1 956 11 so#1 956 31 NA NA -rstmt st#222 fdo so#1 955 10 so#1 957 14 st#224 st#223 -rstmt st#225 fassign so#1 959 11 so#1 959 32 NA NA -rstmt st#224 fdo so#1 958 10 so#1 960 14 NA st#225 -rstmt st#227 fio so#1 963 12 so#1 963 66 NA NA -rstmt st#226 fsingle_if so#1 962 11 so#1 963 66 st#228 st#227 -rstmt st#230 fassign so#1 971 15 so#1 971 20 st#231 NA -rstmt st#232 flabel so#1 974 1 NULL 0 0 st#233 NA -rstmt st#233 fio so#1 974 4 so#1 975 34 st#234 NA -rstmt st#234 fio so#1 976 15 so#1 978 33 NA NA -rstmt st#229 fdo so#1 970 13 so#1 986 17 st#235 st#230 -rstmt st#235 fio so#1 987 13 so#1 988 57 st#236 NA -rstmt st#236 fio so#1 989 13 so#1 990 57 st#237 NA -rstmt st#231 fgoto so#1 973 15 so#1 973 21 st#232 NA st#237 -rstmt st#237 flabel so#1 994 1 NULL 0 0 NA NA -rstmt st#228 fif so#1 967 11 so#1 995 15 NA st#229 -rstmt st#215 fif so#1 946 9 so#1 996 13 NA st#216 st#226 -rstmt st#195 fif so#1 913 9 so#1 996 13 NA st#196 st#215 -rstmt st#239 fio so#1 998 9 so#1 998 34 st#240 NA -rstmt st#240 fio so#1 999 9 so#1 999 56 st#241 NA -rstmt st#242 fio so#1 1001 9 so#1 1001 48 NA NA -rstmt st#241 fsingle_if so#1 1000 9 so#1 1001 48 st#243 st#242 -rstmt st#243 fio so#1 1002 9 so#1 1002 65 st#244 NA -rstmt st#245 flabel so#1 1004 1 NULL 0 0 st#246 NA -rstmt st#246 fio so#1 1004 3 so#1 1004 65 st#247 NA -rstmt st#247 fstop so#1 1008 9 NULL 0 0 st#248 NA -rstmt st#244 fgoto so#1 1003 9 so#1 1003 16 st#245 NA st#248 -rstmt st#248 flabel so#1 1009 1 NULL 0 0 NA NA -rstmt st#238 fif so#1 997 7 so#1 1011 12 NA st#239 -rstmt st#194 fif so#1 908 7 so#1 1011 12 st#249 st#195 st#238 -rstmt st#249 fif so#1 1013 7 so#1 1015 11 st#250 NA -rstmt st#250 fsingle_if so#1 1017 7 so#1 1018 18 st#251 NA -rstmt st#252 fio so#1 1020 9 so#1 1021 64 st#253 NA -rstmt st#253 fio so#1 1022 9 so#1 1022 45 st#254 NA -rstmt st#254 fio so#1 1023 9 so#1 1023 53 st#255 NA -rstmt st#256 fassign so#1 1025 4 so#1 1025 18 st#257 NA -rstmt st#257 fassign so#1 1026 4 so#1 1026 18 st#258 NA -rstmt st#258 fassign so#1 1027 4 so#1 1027 16 st#259 NA -rstmt st#259 fassign so#1 1028 4 so#1 1028 16 st#260 NA -rstmt st#261 fio so#1 1030 11 so#1 1032 23 NA NA -rstmt st#260 fsingle_if so#1 1029 4 so#1 1032 23 NA st#261 -rstmt st#255 fdo so#1 1024 2 so#1 1033 6 st#262 st#256 -rstmt st#262 fio so#1 1034 2 so#1 1034 19 NA NA -rstmt st#251 fif so#1 1019 7 so#1 1035 11 st#263 st#252 -rstmt st#263 fsingle_if so#1 1036 7 so#1 1036 41 st#264 NA -rstmt st#265 fio so#1 1047 9 so#1 1048 58 NA NA -rstmt st#264 fsingle_if so#1 1046 7 so#1 1048 58 st#266 st#265 -rstmt st#266 freturn so#1 1050 7 so#1 1050 12 st#267 NA -rstmt st#267 freturn so#1 1051 7 so#1 1051 9 NA NA -rbody st#0 - -ro#6 SEQ_COMP -rloc so#1 1053 24 -rlink f90 -rkind fint -rstart so#1 1057 7 -rstmt st#2 fassign so#1 1059 11 so#1 1059 26 st#3 NA -rstmt st#3 freturn so#1 1060 11 so#1 1060 16 NA NA -rstmt st#1 fif so#1 1058 9 so#1 1061 13 NA st#2 -rstmt st#0 fdo so#1 1057 7 so#1 1062 11 st#4 st#1 -rstmt st#4 fassign so#1 1063 7 so#1 1063 21 st#5 NA -rstmt st#5 freturn so#1 1064 7 so#1 1064 12 st#6 NA -rstmt st#6 freturn so#1 1065 7 so#1 1065 9 NA NA -rbody st#0 - -ro#7 READ_BRIDGE -rloc so#1 1067 18 -rlink f90 -rkind fext -rstart so#1 1090 7 -rstmt st#0 fio so#1 1090 7 so#1 1090 37 st#1 NA -rstmt st#1 fio so#1 1091 7 so#1 1091 22 st#2 NA -rstmt st#3 fio so#1 1093 9 so#1 1093 55 NA NA -rstmt st#2 fsingle_if so#1 1092 7 so#1 1093 55 st#4 st#3 -rstmt st#7 fio so#1 1097 37 so#1 1099 43 NA NA -rstmt st#6 fsingle_if so#1 1097 4 so#1 1099 43 st#8 st#7 -rstmt st#8 fio so#1 1100 4 so#1 1102 43 st#9 NA -rstmt st#9 fstop so#1 1105 10 NULL 0 0 NA NA -rstmt st#5 fif so#1 1096 2 so#1 1107 13 NA st#6 -rstmt st#4 fdo so#1 1095 7 so#1 1108 11 st#10 st#5 -rstmt st#11 fio so#1 1111 7 so#1 1111 48 st#12 NA -rstmt st#12 fio so#1 1112 7 so#1 1112 72 st#13 NA -rstmt st#14 fassign so#1 1114 9 so#1 1114 16 st#15 NA -rstmt st#18 fio so#1 1121 8 so#1 1122 56 st#19 NA -rstmt st#19 fio so#1 1123 8 so#1 1124 56 s \ No newline at end of file diff --git a/source/unres/src_MD-M/prng.f b/source/unres/src_MD-M/prng.f deleted file mode 100644 index 73f6766..0000000 --- a/source/unres/src_MD-M/prng.f +++ /dev/null @@ -1,525 +0,0 @@ - real*8 function prng_next(me) - implicit none - integer me -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end diff --git a/source/unres/src_MD-M/prng_32.F b/source/unres/src_MD-M/prng_32.F index 21cac76..9448f31 100644 --- a/source/unres/src_MD-M/prng_32.F +++ b/source/unres/src_MD-M/prng_32.F @@ -1,7 +1,7 @@ #if defined(AIX) || defined(AMD64) - real*8 function prng_next(me) + real*8 function prng_next(mel) implicit none - integer me + integer me,mel c c Calling sequence: c = prng_next ( ) @@ -47,8 +47,11 @@ c parameter ( ishift = 9007199254740991 ) ! 2**53-1 crc g77 doesn't support integer*8 constants m = dint(34522712143931.0d0) ishift = dint(9007199254740991.0d0) - if(me.gt.nmax) me=mod(me,nmax) - + if(mel.gt.nmax) then + me=mod(mel,nmax) + else + me=mel + endif c RS6K porting note: ishift now takes 64-bit integers , with a warning if ( 0.le.me .and. me.le.nmax ) then next = iparam(1,me)*m + iparam(2,me) @@ -125,9 +128,9 @@ c c me is the particular generator being restarted c iseed is a 8-byte integer containing the "l"-values c - logical function prng_restart (me, iseed) + logical function prng_restart (mel, iseed) implicit none - integer me + integer me,mel integer*8 iseed integer nmax @@ -135,7 +138,11 @@ c parameter(nmax=1021) common/ksrprng/iparam(2,0:nmax) - if(me.gt.nmax) me=mod(me,nmax) + if(mel.gt.nmax) then + me=mod(mel,nmax) + else + me=mel + endif if (me .lt. 0 .or. me .gt. nmax) then prng_restart=.false. return diff --git a/source/unres/src_MD-M/q_measure.F b/source/unres/src_MD-M/q_measure.F index 8f12dc1..5077b40 100644 --- a/source/unres/src_MD-M/q_measure.F +++ b/source/unres/src_MD-M/q_measure.F @@ -14,6 +14,10 @@ logical flag double precision sigm,x sigm(x)=0.25d0*x +#ifdef DEBUG + write (iout,*) "qwolynes: nperm",nperm," flag",flag, + & " seg1",seg1," seg2",seg2," nsep",nsep +#endif do kkk=1,nperm qq = 0.0d0 nl=0 @@ -26,6 +30,7 @@ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) + qq = qq+qqij if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( @@ -34,10 +39,15 @@ & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) dijCM=dist(il+nres,jl+nres) qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) + qq = qq+qqijCM endif - qq = qq+qqij+qqijCM +c write (iout,*) "il",il,itype(il)," jl",jl,itype(jl), +c & " qqiij",qqij," qqijCM",qqijCM enddo enddo +#ifdef DEBUG + write (iout,*) "qwolynes: nl",nl +#endif qq = qq/nl else do il=seg1,seg2 @@ -53,6 +63,7 @@ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) + qq = qq+qqij if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( @@ -62,14 +73,16 @@ dijCM=dist(il+nres,jl+nres) qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) endif - qq = qq+qqij+qqijCM +c write (iout,*) "il",il,itype(il)," jl",jl,itype(jl), +c & " qqiij",qqij," qqijCM",qqijCM + qq = qq+qqijCM enddo enddo qq = qq/nl endif - if (qqmax.le.qq) qqmax=qq enddo - qwolynes=1.0d0-qqmax +c write (iout,*) "qq",qq + qwolynes=1.0d0-qq return end c------------------------------------------------------------------- @@ -90,6 +103,11 @@ c------------------------------------------------------------------- logical flag double precision sigm,x,sim,dd0,fac,ddqij sigm(x)=0.25d0*x +#ifdef DEBUG + write (iout,*) "qwolynes: flag",flag," seg1 seg1",seg1,seg2, + & " nsep",nsep + write (iout,*) "nperm",nperm +#endif do kkk=1,nperm do i=0,nres do j=1,3 @@ -115,7 +133,6 @@ c------------------------------------------------------------------- dqwol(k,il)=dqwol(k,il)+ddqij dqwol(k,jl)=dqwol(k,jl)-ddqij enddo - if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( @@ -133,6 +150,10 @@ c------------------------------------------------------------------- dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo endif +#ifdef DEBUG + write (iout,*) "prim il",il,itype(il)," jl",jl,itype(jl), + & " dqwol",(dqwol(k,il),k=1,3)," dxqwol",(dxqwol(k,il),k=1,3) +#endif enddo enddo else @@ -178,6 +199,9 @@ c------------------------------------------------------------------- enddo endif enddo +#ifdef DEBUG + write (iout,*) "qwolynes: nl",nl +#endif do i=0,nres do j=1,3 dqwol(j,i)=dqwol(j,i)/nl @@ -230,262 +254,3 @@ c enddo return end c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i), - & qinfrag(i,iset)) -c hm1=harmonic(qfrag(i,iset),qinfrag(i,iset)) -c hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset), -c & qinfrag(i,iset)) -c write(iout,*) "harmonicnum frag", hmnum -c Calculating the derivatives of Q with respect to cartesian coordinates - call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dU/dQi and dQi/dxi -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true. -c & ,idummy,idummy) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c hm1=harmonic(qpair(i),qinpair(i,iset)) -c hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i), -c & qinpair(i,iset)) -c write(iout,*) "harmonicnum pair ", hmnum -c Calculating dQ/dXi - call qwolynes_prim(kstart,kend,.false. - & ,lstart,lend) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients -c call qwol_num(kstart,kend,.false. -c & ,lstart,lend) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - duxcartan(j,i)=0.0d0 - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset), - & ifrag(2,ii,iset),.true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo -c write(iout,*) "Numerical dUconst/ddx side-chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) -c enddo - return - end -c--------------------------------------------------------------------------- diff --git a/source/unres/src_MD-M/readpdb.F b/source/unres/src_MD-M/readpdb.F index ef48c2a..778df3c 100644 --- a/source/unres/src_MD-M/readpdb.F +++ b/source/unres/src_MD-M/readpdb.F @@ -13,31 +13,21 @@ C geometry. include 'COMMON.CONTROL' include 'COMMON.DISTFIT' include 'COMMON.SETUP' - integer i,j,ibeg,ishift1,ires,iii,ires_old,ishift,ity, - & ishift_pdb - logical lprn /.true./,fail - double precision e1(3),e2(3),e3(3) - double precision dcj,efree_temp - character*3 seq,res - character*5 atom + character*3 seq,atom,res character*80 card - double precision sccor(3,20) - integer rescode - efree_temp=0.0d0 + dimension sccor(3,20) + double precision e1(3),e2(3),e3(3) + integer rescode,iterter(maxres),cou + logical fail + do i=1,maxres + iterter(i)=0 + enddo ibeg=1 - ishift1=0 - ishift=0 -c write (2,*) "UNRES_PDB",unres_pdb - ires=0 - ires_old=0 - nres=0 - iii=0 lsecondary=.false. nhfrag=0 nbfrag=0 - do i=1,100000 + do read (ipdbin,'(a80)',end=10) card -c write (iout,'(a)') card if (card(:5).eq.'HELIX') then nhfrag=nhfrag+1 lsecondary=.true. @@ -59,139 +49,139 @@ crc---------------------------------------- goto 10 else if (card(:3).eq.'TER') then C End current chain - ires_old=ires+1 - ishift1=ishift1+1 + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + iterter(ires_old-1)=1 itype(ires_old)=ntyp1 + iterter(ires_old)=1 ibeg=2 -c write (iout,*) "Chain ended",ires,ishift,ires_old + write (iout,*) "Chain ended",ires,ishift,ires_old if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) enddo - else + else call sccenter(ires,iii,sccor) endif - iii=0 endif -c Read free energy - if (index(card,"FREE ENERGY").gt.0) read(card(35:),*) efree_temp C Fish out the ATOM cards. if (index(card(1:4),'ATOM').gt.0) then - read (card(12:16),*) atom -c write (iout,*) "! ",atom," !",ires -c if (atom.eq.'CA' .or. atom.eq.'CH3') then - read (card(23:26),*) ires - read (card(18:20),'(a3)') res -c write (iout,*) "ires",ires,ires-ishift+ishift1, -c & " ires_old",ires_old -c write (iout,*) "ishift",ishift," ishift1",ishift1 -c write (iout,*) "IRES",ires-ishift+ishift1,ires_old - if (ires-ishift+ishift1.ne.ires_old) then + read (card(14:16),'(a3)') atom + if (atom.eq.'CA' .or. atom.eq.'CH3') then C Calculate the CM of the preceding residue. -c if (ibeg.eq.0) call sccenter(ires,iii,sccor) if (ibeg.eq.0) then -c write (iout,*) "Calculating sidechain center iii",iii if (unres_pdb) then do j=1,3 dc(j,ires+nres)=sccor(j,iii) enddo else - call sccenter(ires_old,iii,sccor) + call sccenter(ires,iii,sccor) endif - iii=0 endif C Start new residue. - if (res.eq.'Cl-' .or. res.eq.'Na+') then - ires=ires_old - cycle - else if (ibeg.eq.1) then -c write (iout,*) "BEG ires",ires +c write (iout,'(a80)') card + read (card(23:26),*) ires + read (card(18:20),'(a3)') res + if (ibeg.eq.1) then ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 itype(1)=ntyp1 endif - ires=ires-ishift+ishift1 - ires_old=ires -c write (iout,*) "ishift",ishift," ires",ires, -c & " ires_old",ires_old - ibeg=0 +c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift + ibeg=0 else if (ibeg.eq.2) then c Start a new chain -c ishift=-ires_old+ires-1 -c ishift1=ishift1+1 -c write (iout,*) "New chain started",ires,ishift,ishift1,"!" - ires=ires-ishift+ishift1 - ires_old=ires + ishift=-ires_old+ires-1 +c write (iout,*) "New chain started",ires,ishift ibeg=0 - else - ishift=ishift-(ires-ishift+ishift1-ires_old-1) - ires=ires-ishift+ishift1 - ires_old=ires endif - if (res.eq.'ACE' .or. res.eq.'NHE') then + ires=ires-ishift +c write (2,*) "ires",ires," ishift",ishift + if (res.eq.'ACE') then itype(ires)=10 else itype(ires)=rescode(ires,res,0) endif - else - ires=ires-ishift+ishift1 - endif -c write (iout,*) "ires_old",ires_old," ires",ires - if (card(27:27).eq."A" .or. card(27:27).eq."B") then -c ishift1=ishift1+1 - endif -c write (2,*) "ires",ires," res ",res," ity",ity - if (atom.eq.'CA' .or. atom.eq.'CH3' .or. - & res.eq.'NHE'.and.atom(:2).eq.'HN') then read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c write (iout,*) "backbone ",atom -#ifdef DEBUG - write (iout,'(2i3,2x,a,3f8.3)') - & ires,itype(ires),res,(c(j,ires),j=1,3) -#endif - iii=iii+1 + if(me.eq.king.or..not.out1file) + & write (iout,'(2i3,2x,a,3f8.3)') + & ires,itype(ires),res,(c(j,ires),j=1,3) + iii=1 do j=1,3 sccor(j,iii)=c(j,ires) enddo -c write (*,*) card(23:27),ires,itype(ires) - else if (atom.ne.'O'.and.atom(1:1).ne.'H' .and. - & atom.ne.'N' .and. atom.ne.'C' .and. - & atom(:2).ne.'1H' .and. atom(:2).ne.'2H' .and. - & atom.ne.'OXT' .and. atom(:2).ne.'3H') then -c write (iout,*) "sidechain ",atom + else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. + & atom.ne.'N ' .and. atom.ne.'C ') then iii=iii+1 read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) endif endif enddo - 10 write (iout,'(a,i5)') ' Number of residues found: ',ires - if (ires.eq.0) return + 10 if(me.eq.king.or..not.out1file) + & write (iout,'(a,i5)') ' Nres: ',ires C Calculate dummy residue coordinates inside the "chain" of a multichain C system nres=ires do i=2,nres-1 -c write (iout,*) i,itype(i) - if (itype(i).eq.ntyp1) then -c write (iout,*) "dummy",i,itype(i) - do j=1,3 - c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2 -c c(j,i)=(c(j,i-1)+c(j,i+1))/2 - dc(j,i)=c(j,i) - enddo - endif + write (iout,*) i,itype(i),itype(i+1) + if (itype(i).eq.ntyp1.and.iterter(i).eq.1) then + if (itype(i+1).eq.ntyp1.and.iterter(i+1).eq.1 ) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue + print *,i,'tu dochodze' + call refsys(i-3,i-2,i-1,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif !fail + print *,i,'a tu?' + do j=1,3 + c(j,i)=c(j,i-1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + else !itype(i+1).eq.ntyp1 + if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue + call refsys(i+1,i+2,i+3,e1,e2,e3,fail) + if (fail) then + e2(1)=0.0d0 + e2(2)=1.0d0 + e2(3)=0.0d0 + endif + do j=1,3 + c(j,i)=c(j,i+1)-1.9d0*e2(j) + enddo + else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + if (dcj.eq.0) dcj=1.23591524223 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo + endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 enddo C Calculate the CM of the last side chain. - if (iii.gt.0) then if (unres_pdb) then do j=1,3 dc(j,ires)=sccor(j,iii) enddo - else + else call sccenter(ires,iii,sccor) endif - endif -c nres=ires nsup=nres nstart_sup=1 if (itype(nres).ne.10) then @@ -206,11 +196,12 @@ C 2/15/2013 by Adam: corrected insertion of the last dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) + c(j,nres)=c(j,nres-1)-1.9d0*e2(j) enddo else do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 + if (dcj.eq.0) dcj=1.23591524223 c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo @@ -237,47 +228,27 @@ C 2/15/2013 by Adam: corrected insertion of the first dummy residue e2(3)=0.0d0 endif do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) + c(j,1)=c(j,2)-1.9d0*e2(j) enddo else do j=1,3 - dcj=c(j,4)-c(j,3) + dcj=(c(j,4)-c(j,3))/2.0 c(j,1)=c(j,2)-dcj c(j,nres+1)=c(j,1) enddo endif endif -C Copy the coordinates to reference coordinates -c do i=1,2*nres -c do j=1,3 -c cref(j,i)=c(j,i) -c enddo -c enddo -C Calculate internal coordinates. - if (lprn) then - write (iout,'(/a)') - & "Cartesian coordinates of the reference structure" - write (iout,'(a,3(3x,a5),5x,3(3x,a5))') - & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" - do ires=1,nres - write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') - & restyp(itype(ires)),ires,(c(j,ires),j=1,3), - & (c(j,ires+nres),j=1,3) - enddo - endif C Calculate internal coordinates. if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" do ires=1,nres write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), & (c(j,nres+ires),j=1,3) enddo endif +C print *,"before int_from_cart" call int_from_cart(.true.,.false.) call sc_loc_geom(.true.) -c wczesbiej bylo false do i=1,nres thetaref(i)=theta(i) phiref(i)=phi(i) @@ -299,13 +270,6 @@ c & vbld_inv(i+nres) c call chainbuild C Copy the coordinates to reference coordinates C Splits to single chain if occurs - -c do i=1,2*nres -c do j=1,3 -c cref(j,i,cou)=c(j,i) -c enddo -c enddo -c kkk=1 lll=0 cou=1 @@ -343,10 +307,11 @@ c do kkk=1,chain_length c write (iout,*) itype(kkk),(chain_rep(j,kkk,i), j=1,3) c enddo c enddo -c enddiagnostic +c enddiagnostic C makes copy of chains - write (iout,*) "symetr", symetr - + nperm=1 + write (iout,*) "symetr", symetr + if (symetr.gt.1) then call permut(symetr) nperm=1 @@ -392,7 +357,7 @@ c diag 1 ' ', 6X,'X',11X,'Y',11X,'Z', & 10X,'X',11X,'Y',11X,'Z') 110 format (a,'(',i3,')',6f12.5) - + enddo cc enddiag do j=1,nbfrag @@ -406,7 +371,6 @@ cc enddiag hfrag(i,j)=hfrag(i,j)-ishift enddo enddo - ishift_pdb=ishift return end c--------------------------------------------------------------------------- @@ -415,7 +379,7 @@ c--------------------------------------------------------------------------- include 'DIMENSIONS' #ifdef MPI include "mpif.h" -#endif +#endif include 'COMMON.LOCAL' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -425,29 +389,33 @@ c--------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.CONTROL' include 'COMMON.SETUP' - character*3 seq,res -c character*5 atom + character*3 seq,atom,res character*80 card dimension sccor(3,20) integer rescode logical lside,lprn +#ifdef MPI if(me.eq.king.or..not.out1file)then +#endif if (lprn) then write (iout,'(/a)') & 'Internal coordinates calculated from crystal structure.' if (lside) then write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' + & ' Phi',' Dsc_id',' Dsc',' Alpha', + & ' Omega' else write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' + & ' Phi' endif endif +#ifdef MPI endif +#endif do i=1,nres-1 iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then + if (iti.ne.ntyp1 .and. itype(i+1).ne.ntyp1 .and. + & (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i ctest stop endif @@ -470,6 +438,7 @@ c vbld(nres)=3.8d0 c vbld_inv(nres)=1.0d0/vbld(2) c endif c endif +c print *,"A TU2" if (lside) then do i=2,nres-1 do j=1,3 @@ -478,9 +447,6 @@ c endif enddo iti=itype(i) di=dist(i,nres+i) -C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.ntyp1. and. di.eq.0.0d0) - & di=dsc(itype(i)) vbld(i+nres)=di if (itype(i).ne.10) then vbld_inv(i+nres)=1.0d0/di @@ -514,7 +480,7 @@ c------------------------------------------------------------------------------- include 'DIMENSIONS' #ifdef MPI include "mpif.h" -#endif +#endif include 'COMMON.LOCAL' include 'COMMON.VAR' include 'COMMON.CHAIN' @@ -532,7 +498,7 @@ c------------------------------------------------------------------------------- enddo enddo do i=2,nres-1 - if (itype(i).ne.10) then + if (itype(i).ne.10 .and. itype(i).ne.ntyp1) then do j=1,3 dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) enddo @@ -552,7 +518,7 @@ c------------------------------------------------------------------------------- sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) it=itype(i) - if (it.ne.10) then + if (it.ne.10 .and. itype(i).ne.ntyp1) then c C Compute the axes of tghe local cartesian coordinates system; store in c x_prime, y_prime and z_prime @@ -592,9 +558,14 @@ c if (lprn) then do i=2,nres iti=itype(i) +#ifdef MPI if(me.eq.king.or..not.out1file) & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), & yyref(i),zzref(i) +#else + write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i),yyref(i), + & zzref(i) +#endif enddo endif return @@ -626,9 +597,10 @@ c--------------------------------------------------------------------------- do i=1,nres-1 vbld(i+1)=vbl vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) + vbld(i+1+nres)=dsc(iabs(itype(i+1))) + vbld_inv(i+1+nres)=dsc_inv(iabs(itype(i+1))) c print *,vbld(i+1),vbld(i+1+nres) enddo return end + diff --git a/source/unres/src_MD-M/readpdb.f.safe b/source/unres/src_MD-M/readpdb.f.safe deleted file mode 100644 index 084d907c05b686ae11c3af387078936502ce1799..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 43512 zcmc(o3w%|@wf{FHN|4}AELya*M(?o=l_GEeX+vucB)ShA9xAq>riOTu0BwLY1O$tU zCZTMT6R{Utdy6ft+Isu2*jlRAYIuW+0`-Bfimfli2cjaP<@|qZX04NzNzU!P{ol|3 zKcAk=-rrfXW@gQr$DX~V*OVvD@7t$Oj>n;o_Z6>?+^BfT&%16)&1I=~qBo!mI#;A4 z*Lx@JV3Q-KmwcaqU`{V3f6DN_t{QKt;hAb@(yul=H*+r+D-1tQZZq+nh994~my18+ zqL0_bCFkqR^H@-7&=(CR`F!RgA7egRS`F2PCE#|8o zP9uccyT;*znBV5`&oM7zE_N$19Dg`W=XeV9S$w~b^UY#jih5CyoQ=%O9NuiW^q%Lv zXR~>04Hv6>o=E(Txzw*8%Wq~b{VM!P=F(5XUt?ax`Gp^4UhMFERE6w0!r`A`KF;AI zn3p|g5WKh5x5Z?hx+ z1(uibEA=m7`9~c2sVraN=&xk?=`1hxY+xQZyoLEJhu_TnAnPyS_}9$$IlPm3g`?+j z=Hngvzsg+ZbLq#U%oC3MKs1EL`wWK{F|TxZlzENA&u3om@R`h;9A3|SnZvJPKFHzU zV?M;;w=<78{2u1R9R4u#(GEYpzqP|0$IhoQhmlN>{yOypnt!0o2}2D>CMS$B9Dkf} zp5gfp^}I=j5A4Cu04ekirHdqGvb`AU@Ku-D8F#qDWxX2X@cNCmfu#;Fodtk!0e-sN z<>y<^n(FZTXIMQnezd&Im(>nmc@_Y|T>P}WtZxnACwbgixGp^te-PU7lfE#3|J;&= zKb(a>orNFC!hJNaw{iz(;h)dK7iZzOWZ@^m1ih7eau$AJ7QQwMPoO)=&SKwHJaJr$ zSog~#XTmTD*E_t_P|v%8_3Zkb1r0pm{uM*T=#N^y4(+7y8o1VfkojB8rOm}w+&jX0 z4vw~97t0UFkkfi*@emyA@P_8r_t*w}&EaK_TKUTy?(w*&V=ncV z5x&roUtVqXEOmGu);|i@IlLb$yx!sRz_^;Zl*?xFe(cI~zue()*)QDX@U^Bkp7%#b zzm)T5N50?_>r9Sq4(~k4DtgS(gYBpZPdV~3U;WjQkFfl!;8F)hCi*Z7ABcIiH~HAt zVqcA25}R?!#lf|2EWz9vdw@JEdN`z+($jzGk=|=FIM~(_*=HTfyO(gx{3W~{*{6d9 zsr!vcw3Dc~Yj9uRbW3v)(i15w`x>sj<|App%98}H*!Jve2YYNt%kwc|jt)KT-r8_fc)=W(01grt-Jg`}PQJ;L%oY zb?|`4?F>@wCZlO*B58E%;*3ITB-u-m`ckN)c)C*z?T30VgmRcd*dT1V?j{o}T9a7| zX184M;EeL};9@dR$p?Px*(jkm8=5BQHg%a09hFNdvyhb*X4}vP+!?cnzmCwxV@hhJ zm~jbidv719&_*<>+1$#A;+9J1&7>2RSdN$~p*jb2B`5{zD3Tz_RfwsAro13&t+nCB z+_q~;vh7Ct8=7nOxzM2QmJc?(SP*RZTV62Wpj$V=w!^}A%A=jpPSeKLPQT-fkJD-0i_#6Td&y{- zPTosu5E5Z~WEbMtJ#^Q6qhQUW(O{zImu)LYJ6a3DDDIEAJo;>TbWiMF7Aq>6 z=9T;9yOE=)XeyepIzk(svT%EuU%t1iT8VH?bn)0#r)IM{u7kpms>mc7f8lunBGXf2LNU*9WUy z#!l$y)M|q>PUJzxdZ6_;k;A~uLlOnbLt>dcD*?qg4U<#(*N}Br0g`@J{o?| z{A$0mKY&|eVy24Y_pEJ#-|<`I2%104^V>J$$}j$lU;J=9d}j(aDyi{XsNh3>!7nJT z^G`8xyty+Ej4~4AxZ;sIzXFXa_#<!EN99+At6EcaCt;q4zvbFg8kYBvJ z&OdoK*<^BRd>rFFCsDHFs*?fQw~@l2dE4N4dIR9H1Bciw#+DhAoJ}TaJCaUM33ng3 z&+a?JmdH9dSZk*mB4us2*&%Wr)MgnPvL>{c#Ra>EjEBJ?;FCwFN(fy;h6W2QM8^4~ zh_djuNGHk{_mnXJzb9;E!?Q?JbVn>z7J-AslW(BbcObd>NMFDG6{Nv{14#z4*^LCL z@?*{8Q-n_TTkp0h-=kYd{0GNB6l5oR4G*`MTnb zuIrimk#`?tk0JgLzk|3&dL`?p^g<~MGL@`b809GxX5yfE4Iw+~0(mD#?C zHNS%0*7bO~8l;xZ!;*mJDTxeqm-oS$Y&Vn3Qa$IO*2>yTsVyQ$V-TYzSWn(6$%4&|b zc3wR!NSSp8GxA#FWo2kbYS5Nlu%>Y}<6vzz)vgsM2XoVHoVgrCI7@4?qVkJ=9PdRy3^R;d5n>CxLkQ zL=e7<)tPeWHCa6>L*F=Pk-^wCcBAM%n`RA`Z`=Tdl`3&Hb_pBF1a=NLtYa>SqH{&J`3Gq~l@?-u%#g+q- z8bcZ#ZG2 zKAzqjZ~i#v>W70it1*E|mDEXPx|bVo-ZD6r-bNb^@`WJ1r7S!Wl-REJJIasIM&91B zx6%wsU0eoC{cD^68@rA#qJ=UK!aB2{4#{5l@PU5lU%I6#*!b>94c#X@%i1EX)U9X*McDVzK6rPxf1AEew)x@=OEpeE?K#AeB_- zpJRRXiW6{YX6?mGyB3=ww1R^2PU`D>fKLOaCXk3-Y&u!E%VEh~N!C;feOiP{Ngmo% z(LFm_#v5$=?vB(WExiSq=z{IgW-TX`r}Y(9gLQJZP%Uv`4_%s%^zl1xXXe(_^<{-7PmWcQZX;mF0z*JFP1-;nweQtjG>RC`gD zvk!2{PErFX7nK|9{F&Qna+{8pX*Z^O?2`7^`IXN==I_x?+`WM-QxkNLiR=7N+Iv*p z7IdiGpSc%B*&Q#|rb?{ZGmlZ*>@y_?iGOp5eB8nSG4I?KykW0JGF8BH91iyt&ZK!RdO&hKIl;!-*Yzd+` za=6W;*x|Ou6eUXoG6gCVb_P`J^Hdl;!X}Vbma{3niJXK4F+UPx&2}Jg?YS|O-}G^i z-WcveHZw>{p71-~gWp7-jp1=3jotnpzk>(&$y8cb6YYMCY?0o+YE_UjOC^%cxb}-* zz-7c#5EpmZtd;1Hna|<=Kka?t4=MJGw+87=*fwoI>SomIT1$8O#oIt10(}wmr|J(a^l3zhI02 z>v2di{yL#8_YWpz0{ZuTy7G(h95r)0Ie90X98Xm-vzx8N6UT+mpy@6b#HOm;&D4@C;tHR6U zIa|>bo8Hw6wp;uHqm0f?A!COX)r^dehYtLqnaCcWp)cSqGyj4g8YwfbKl5#fRnT-g zhU$e>YCd;A6l|m9J@n@}`m^)U`B<22*WmU^x*cS1F^}z~TidHa^CmnyZcUWD@3-HC zfo+HNVRHtGwH!m|R+zP{%^1JUG?pJmu=vxih6Xrh2fg= zC~r+S^*7HDdB|?|qlhUaQmacTj{ON!lNbJ#jy-2#5YV~k922jJ&*% z!+!fhn$1e~UR8{f+vlmoplz6qL%t9B9w*P3srN=vds<6q=7*Ep;ng*s%+R)L2~y2+ z;TQiEm%LIG{FDm8q=11WtHu_)WXN*yh+QiR2AO(5EVNn7d~6mP462Rb*D}ZaS7_g( z6hH14W3{1Wh?f?>eGyt1eKY!OW_iKek~khik4;JqdYLrf>7fP{Y}sVh$)j;Wy8wRX zEm$pppKS})yl%4;O5Q@rQz)`_dEtz9d665lyqFt2OVIERO7{Ehji@d?kK@t!bBJql zI&t-B)Om7hP)(4thu-Iysnj^VamluUR1JEtxF7L`7yAau9XJj9gx`KOxul&S!-rB6 z1~%{W`S$ExL2}PMIgn>i7xU+Dsq-5;F>0GWi&=j`ek-ZP#UQyDA{X{aq|QIOz0SWz zdl8csFS_5hc!WHN}QO=$AQ%j99ZFm`qiBM zx4%i|>^cN<4z%{SB0WeY=!ERWoM>n3vq5MkkM5D*@c|W_{7d+xd)mAwXg-RGd^D`> z7h@w^(6WIl+2f4)Cq!Xd6Z07}J!2E&xMCBwMVRAyoIPV2?0)Xt?Tq^V{sSheSNF(0A;(!k&5=u28v_t)vcxuCQ@IyMPV`s|C>G z8s4Z4*&huQwA&;54Xngb~4-#6Cyy}L>%Pf~dOX440mi1$0}P&D%uVyLZqF|tqe0EbVC#2rfrp<0JLFIc$jA5R7Ww+8#F`)9c?0@_igGaY~+d<|r2DgLkt$B>Wt?k-4 zUV&k|6EAtoZ(ohanDB)u;p?%(eet^F989h;bAV;OWob^sMLz{*HwA6R)!L4;7D&f1 z`ogEeow4w}fc$pL)TBM}Zhf<9VC;jf$mjX3&yl(Cu>@tBmRcRB*gmwBg~#aohf;bw z9njTuoDD?oH3H_ZKBz2BTIP$UKzHh|J=rj4p{e zj>McE5)F=oeIqPS9|!!70W_aBZ(gD{8;LMtZ0^SUS6~*#mkwrLaO3@d!5(B)Wed#K5c^h4IJ&XSj&Wsy8^=+2F>M*2pf-~1Bn)85iJ(cqKxQ>ETZE?bVNq9G>d2;qNN$p=~+Z8M09#abXFG8 zIU;HukebzyMRbXXT0h(WHtzpx%eO?9L#B7@$#V~qC{P{}GkMsVW9diCiyE^}9|I@HOlxKx zxGeowRrsH0-qX+x`I3$C@{I23J)NC6DE23Kn0;*% zeUsjX?!s-xy>cLCtYqKk@LL<&8#u3Z%GyTXM53tkTGOU3-?I1l7s1x{j0n4XxtRHS zw6p8|k3CXCvRv4gIml=am5?GA75i}_Yu*gW>zse-Weyr*&#$mG{g*jG(rgKW z>O&^OX=Mk63N2W_>H?FXoLYA@e9< z{JzbWqTb`&tg^W8an>L$^B#u;(X+&iK6W6fI3@=B0!UWdLirLdFBU$(|1h%AiraLk z=YY0*8O#fG0!!l`o1DdD0Xm7@huDmGN~AVWJ83HD8rfan$Wdmgmxy6xkD$WC=jn8q zF1rnKd~6cfFDdA4`#4F?l!EL8Su4DVoq48tpf}TDDbht=mSbciY>eJ(rl9vsgiWSN z@=-HtHNAIP!bXjn> zJH2?x<9^5M*rn~i14(xGmBJM-SbwG&#J&Q!0+hW7Z}kH{$X6e;OojmZl4j6s-js0} zatS%<7k^@h$?8z{D-_CUTEK22T}Tokhu;$nQ9b z+7LEHUZbzI4+dd<KxG5gK zJtf3e)o!Y-c|Ab2 zH5WvFNJU^zK`%h%B?Fo;s1xT^^w!kAQ9zbYnk<`ol=gc%wOSPq59}XDPg$wO7;9z) ziKXJ`AHRbJ;(hpe(R8?d!)vEcNHyi9cOPp#e8q87k{b>z#UJiyKJQB9o`)_U zK{DTL3A(;Iw6B2Tsqy$4UA{Q9Um9ZI*tOKQGLA!`<|F<6_D4{T3@X@@Ub>h`+%Gm! z5E`SDg&R{7`Ze$CXJ0CiS#U@Sd*d73%QoPP0=!S~huT%wADU}g{6D?Ndjq_%+PLhG z@seFvo#oVtzkdkxpCH3v&VS%cW|1-niWU$I(^x*h-Ge z9np{Fa%?ObD6dWH--l*m&y#o@|Kk8QmEb@MX$(-9!WoVp4)c%?@gt>(tc@cS8Q7? zmKGg7W050^b=kS6T()%1&-VYP_4%iAww$hZxc5DKb1dpjr+bt#9X~oW(Jbemuru(w zjAZhZ936X6$;3~@k95<0fUDl*dt)R^dMGcAd8yZbSGSZ)d0qWLnLus50HsiQQbvH* zbY17F>#jOscc0;6KWeYknbN6TI;Wt+0MYlqBzqi{C3x+^L7Btq( zonMXG7A33elZ)zcSyNQkxL{sUvT^CcCde#oYFw0TTGUuO+#5sE?7rE>H86`8B{4;;vsgZrO&B3~Bt_kF(1 z<2>v7HTPR_eEV^!+>V?Z%wVSa)9JE=Rpj6ZCgZF0n^6=! zkV=q$ci>;BzqR_ooZPEW>*h%Ar_l_u{Ewmj|Jw2gbDASvmd~Z>jdW8VG)M3!fnSa3 z5nLdw<2L2egwl~q|2&g-Lyn17^v(Scchu2Dsh3R*&zOY!6@5E$Z^$8ky<6$qB{piT zt*&XPxqSHf-f*~gQ}yMDm(DYBQ|*!_Z|?lX^|kY>yv5axRo?vSd9@3xyvEu(I~1zC zg|$tK8mheHoa(s{noFapI@yG)1&ij-ZGvpFs;;qmHsbkBjrEk(6j$X9zkK0BZ+PQ^ znraO9;pQ(Uh$>32T3Gw-s=9eiUIsvKRsGzIJk@mM@X_AIGcHQRXH1VxoLn_(jFGPU z;)trb^J{9Cbk9r5wD2gCoNRy|&Bvj73zG|KYO7586^(P7YP(gY8>w0{Z*F(BUe&0% z^&{%)7gRSjR42bx+cbRC=w8?u4|Qy+t*@%9Uf5JMuXbLtVQDX7=Xy1Bk*+H^GCE@T zh~cBi&M@nOc~!~k#-^&sgv8_sY&EaCsfx-qBC5IPj_9sqq!H***XRhZnkL99?{ZAR zRlU^ci@mUMUZx9-+T?s8Y)iccv=VzhfgMYe>QDq(SLvH^~# zS~GIY7kldJX@O|BJY&gj4k9x+XjD%WHK>QNMvcw5a%5ucqB2O0>>?LWoH*^G?uZu3 z?&PBKi@SrKjTosLF`BB<(=!)Yy<6#H$fhGR-EZ$yM~xu^ zch5og?M`~MX-tncjp@;*F+Ex^re_O!)Ytexx6;SQV=zcqrjM5E#v0L*;jwBm( z7wA4!jIz^>>eO*x>{j9^JC|sIaoq*TpxufXcW!q9vTt{RvE2p8+}#DnbQd7&cNgfk zG>jZY&fHDlT&E7!w5k>7I(6t_$#b1L^swZ)z0Ca4b9-@tu|3)7kv&SE8SP=mk%#ove)_%0D{la9jmbN6=eqc*qHn(A&76i56wgtkqXyYte|U#pMfX zmSW@7)L7e;oP#vpR3#Ty*UhabCAi|vQ$uwlGYFv_^GFr#rmm=-Jr~VckesuiW*!fLRc zqwC@G7c|ulzhLSmU%;bJ@>|%V)n2}6Hg;k2YrWyMb7)sL4_A$~_0_}8M$ukoQa*(Z zCk5JbF2}DFKMH5q$nb0E`cw-(=Wu*TYQiw)^e{@>+E4QRD2_@0)%eK+*+k|fe>`7P z6z6N=w6mA+Exs6lnDk4yjxR_*T}yqwr#Q(Azt!P*S89U!QV(gQhvXTjw>a{A>pkXh zoY(@qB+WZ}46D2yvF%T^fyCJ z?C@>HwfuFC{sN=j^W?!<>T?EjI*F!0ob=?fpFF1Y>vEq|T=&cK4wrs;+2PVJM;uOd zpwOQTi6H$b{SsB2>M3@h{}z@4Ma%J%eko@zb{>p03KdFT>!JUOn1a~hJ+A0)mAtmY zdd0P#ZOo_8bND#suR6Sx`5Vlsf2lqa4l9nc=}gGMX$A$d zPYZrx=g%`2KPe_5gt5%UAIuvP@G>P&^Qz3l^oa-skuRl!5WdZvZd>t_au+K-RDY3Q zt~k|6!VO9fb(QG(f#RfRJeT`phku#*?;ZXX<^$P?Vo#~h>55a^Bn)Rx*>!zxRPuEB z8P4z^bFq*34}C#HLF_-m-g2`={e6LZ%- zk10LW)s?KD{=r%b)UFUe(er^LUqeC&$MGaf`pM4Hk0&vA^^_=i8ZTo1Qs&a$dZbaP z&Z4I=i=HbTevs`?|DY@d>33OwL#3bUFLqevaB1%k94_^IPw6K;v+$#E%;8Hc_C8Au zMG(6M_STCkPWF-Yv4T0-ll(kbVKdyVnF^qTIByt z_))lBaT;H%4aHZU%qhxeM$uoHQ+-zAC-wPA=^_2p1_~!|W_Mf^Do(PpPK{BV_8_AF z%Zk&>S>XY5DxUmg2K&j^6qmXn*{gE+2!aT+9nQnwTi|e6r8Hy1Fc`d^7(2Q(%yVAcLb(i&Mu=#G%ju*Wi&1Wv_Q46=XNpV__ ze$9N1(z6mw?0+kBng8Xv{*Ouztw-&wXRFc^Dn0LH(et6=OCc}k3CA4$vThD!L%HkS zXPHZT*KmEl$lUdxSy}YVbM)NCdKPDq|B<6##^X9i&mFAi!7O@ScI4Nw{99S%%lSc! z>_DcH{#wl3?XML|zD>!m&%$>*dZzO@-KXTqC8gYV71#CoNOA3-`6nSW0`(U+(cGV; zIAtw1)bmC&r*`qBNtw(yWC!iHvz4AtunvmmD|zjo9g1uF(7%&Of%Ff;Pulw%=2V|0 z_<7%_Kc2T<@hdDcf8SAhXsn2yT&`S359gW2oXSlp`O6*oi+E^ZwKs z2xK?XFX1GI=W#-UIob0R{G^^U6em3|?ZY30N{7F(&tR|4(J%IFa=6R`-*ve7`fW-- zZ4IP8zfqj(^B$M`JH^|S{Jn~ky!88{%*j5wzxFCletYC5{6YAe(nFV0pZAr#_McPu z#RrXFd8b5r&SFk>)_xvUT-S3NbE>DQ&m_`<{cjfiS13JtT&z%B>%YO#zofzH|Fa{X zZ?U(<;j&NI>2R^nOG-bLEBm5@ij&>M505BL@}nNvT~rHtz+bDFRCRVc1J?<cT;y+5{07Jizgcmzzs&zXRh;T0^1oD^$`$^5#pzP`2E|E_%!fM^ zCq2SDT9nYZce~-d`xb9Oczep$IQ1{d#`xLybY8_AbRwo{xqz zCx4c2MR4hjR(uEn4pW#@tykhF{rgQN|7j6M{B0$#_sL6{Q+>4EI+UKzC_T4i(Q~__ zN9=r`(sR1fvm=Y1-HsmVmsgaYBBkg3EP5ug5v5&{WwOI%zkRX8WgWTH;j4Imo^-g> z>01t8EBkqekKhV@$KmT(zS-g4i#9`>!G z?{GO+{FB4ivHTMb7yCc&aIyc(4wv@6>2PUpe;y3v|1?j^JW%LxnXgWDxQv(2F_-y= zrzvlg!;829UvjwYf6jM!!1lbv;nSJdDt-lY=du2IiZ27JVELsEmvy$);j+%&=x|w2 zA9uL4_qiSg24?A4!b1Vz*$CDJF@@& z+c^%G^=Q1qWj%^JT-KwjnbZ7yCEI|aX2q#K5>_%N|GXYQ@wX1e^>;zPak%KY-{IoV zI~^|m^D=X?C+QdYw;axof!+rWk4V8h>5HDx%m+GL^q=N%(f>Jzi~i9L7yXkQF8V8& zlRc?jvgupwaQQB-)!})(9^dZh7k;P12ebSi9bU}5)8XTo?{v86f5zdW|5b;J{`VX% z`cL3RRQg5qPg7j4<6m>Qtjkpnmvy#Yaq?#wFHH`Y@v_X}GG02EQ-9HTk@rMD%EE6~ zoXRc3kHT*pp0L>agTse0|Fgrz54Sjc2+QwsxQx@i%*oDrT<>$ZjJwwyJ>usF9X^B0 zJ>u~3%)KIe;jU|W%%wiEKRMZvm-c>I@iU-O+7(fp+BF0}3TGFY$efE3m-k;7>WQyAv(RTg`r9exM%GKY6EPdI!p^9qL_ zWIoH`@;$~%#mP^kT|djhf2Fu?Z>Qo~&(m4>iw+n2?{~P^|NSid#4~LJ-F`X6;iCUy z<}x1Td3=Gx#m}#BxQvTy94_PNCgxNhz5lsIak7u>)9!G1k!_CmCx;g^-{f%FH$Lfb z**Cu7aM?G0=HIMBs^?Ys$$3z92Mi%}JhfBL^v+yev*Y<2toa!m- z+KmpEb?wIvmv!w$#c7PnJp2mtzF_*i@h!#ALz?va2U&Pp@lqw9#}hK?*Ln&R*Yc-k z;b&&yLz%n%J4$iWUOsP}>2Nu3T;y;$Z@kXoa^Cn0#dW`|bGY=&y$%{xZMSDo*tgJ@XZ(a)n=^xVA&9;-n`RKMESK9_O5+2P_p&p2HC;egVw?Ri9Ts*l+Dl+WS@fy!NipPVObIhvH@w)N+QmE^U*l`yCNjj=367ci%OoT&IE zN}fLzF{zbG|4IvjqtoXB8^n9%J$TK%( z8~k~jne0z~C39SaIobabD`NgenY(_KP2zb{<&P~sZjDAO3zHi zf0RYf-Ad2bmHbAf=TgNV%cAE=#r1yRZN)30N9zBXv#nCHn_hQ@Gbg*XDf!E?@b54m zzh>^VvC%M|}QbE*&RH{|=Yq~i3vBjLwNPdlLKze~v* zJ)Gf~l20l5!Y^0>DOcXte1SQ&OZ&;3Ed1L_57kr7Tb3yKDpl@vj=Ze}d`Zb`fB1JL zul?|kic>x1T&UCGaxV0w!{t2c1&7Od)Io9?FUp+yh2+JaF^9|f*kp&x82Gl*UkyD{pDPt7{qo(~HHx<>`4x(jygWzz zkU7;;_sgw{lOM`=Yj-I<+W#L=^4fo1V@~7xllVz^Q|ZzE|B>Rlo}WC&=A?R>`b@I- z%9-=}?5$FloOs(`d5NU{XbChQWwf{Ov&r@tN#eAFk`oy?ENXssXp?ILMdNhPIl9J#wh+h zr15m*ec9E|--}+X^w*MN4woxETK_i{*ZLbB{Y&_HZ>7>-C(053Ko<2ss&# zcPl-!m7Yym^gN`v_Rl>^zaB4dEB$kn{=-U-uIDkuwH=NhX)|Z~k^O%NbLz*rO8?o+ z-F}QJuJxBV`ej^PsPunR>7S+a==y(Gac!S9itF)p2XlA+S*PTeqg?Uz&5G-B_bhX= z!?#pD4=DY5JbtL;3n5?6dCnYVFUW3s+P=@(g&ELZZ{4z-H6K~Bc+ca)xaq=3Wq zN?z;vq2k|ztc<($%rpML<8Cu^s^@%Bj`(4vN9+HK;@?yHpJy)mW!$~Xob)eH`uj%h zjq7hCn3Ep8E?lBG`H8%znB{Oe=b!Cxd5>_r!$nWgXj>mDSL-jy!Y|Fj+q3YS94__z zvBRaFzskZNbhy-iyTe8QyUfYXdVGCpOjmnp9hdX}35wqcF7w_D#c96E`@YRzsW{26 zwb-jsob*?$unF~wYyC}%Q@_jp>T1QQ+yX9lh2py04#i1Nfi2eix#CnGc^=Q`Kc$Kb?iYrFesqKdLzCmvhuUV{wB(`oE2z=+9G} z>Y2-S!@vAxf{at?$MK45`>USyL!x)s|K+DCs7gv&pO zyq5C`-^J&2^#8NnO`hi?^M9bH^c>`IJHiH=>0kf*31sDxyD2HN=gu6*+RWbW{0`m?!yHISFq0H2Y9~ zxBP-hfC&32QH3IPO_z7#M DY(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL -C TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = DX(IX) - DX(IX) = DY(IY) - DY(IY) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,3) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - 30 CONTINUE - IF( N .LT. 3 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,3 - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - DTEMP = DX(I + 1) - DX(I + 1) = DY(I + 1) - DY(I + 1) = DTEMP - DTEMP = DX(I + 2) - DX(I + 2) = DY(I + 2) - DY(I + 2) = DTEMP - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK IDAMAX - INTEGER FUNCTION IDAMAX(N,DX,INCX) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1) -C -C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IDAMAX = 0 - IF( N .LT. 1 ) RETURN - IDAMAX = 1 - IF(N.EQ.1)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - IX = 1 - RMAX = ABS(DX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF(ABS(DX(IX)).LE.RMAX) GO TO 5 - IDAMAX = I - RMAX = ABS(DX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C - 20 RMAX = ABS(DX(1)) - DO 30 I = 2,N - IF(ABS(DX(I)).LE.RMAX) GO TO 30 - IDAMAX = I - RMAX = ABS(DX(I)) - 30 CONTINUE - RETURN - END -C*MODULE BLAS *DECK DGEMV - SUBROUTINE DGEMV(FORMA,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - CHARACTER*1 FORMA - DIMENSION A(LDA,*),X(*),Y(*) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00) -C -C CLONE OF -DGEMV- WRITTEN BY MIKE SCHMIDT -C - LOCY = 1 - IF(FORMA.EQ.'T') GO TO 200 -C -C Y = ALPHA * A * X + BETA * Y -C - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 110 I=1,M - Y(LOCY) = DDOT(N,A(I,1),LDA,X,INCX) - LOCY = LOCY+INCY - 110 CONTINUE - ELSE - DO 120 I=1,M - Y(LOCY) = ALPHA*DDOT(N,A(I,1),LDA,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 120 CONTINUE - END IF - RETURN -C -C Y = ALPHA * A-TRANSPOSE * X + BETA * Y -C - 200 CONTINUE - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 210 I=1,N - Y(LOCY) = DDOT(M,A(1,I),1,X,INCX) - LOCY = LOCY+INCY - 210 CONTINUE - ELSE - DO 220 I=1,N - Y(LOCY) = ALPHA*DDOT(M,A(1,I),1,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 220 CONTINUE - END IF - RETURN - END diff --git a/source/unres/src_MD-NEWSC-NEWC/bond_move.f b/source/unres/src_MD-NEWSC-NEWC/bond_move.f deleted file mode 100644 index 4843f60..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/bond_move.f +++ /dev/null @@ -1,124 +0,0 @@ - subroutine bond_move(nbond,nstart,psi,lprint,error) -C Move NBOND fragment starting from the CA(nstart) by angle PSI. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nbond,nstart - double precision psi - logical fail,error,lprint - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - dimension x(3),e(3,3),e1(3),e2(3),e3(3),rot(3,3),trans(3,3) - error=.false. - nend=nstart+nbond - if (print_mc.gt.2) then - write (iout,*) 'nstart=',nstart,' nend=',nend,' nbond=',nbond - write (iout,*) 'psi=',psi - write (iout,'(a)') 'Original coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - if (nstart.lt.1 .or. nend .gt.nres .or. nbond.lt.2 .or. - & nbond.ge.nres-1) then - write (iout,'(a)') 'Bad data in BOND_MOVE.' - error=.true. - return - endif -C Generate the reference system. - i2=nend - i3=nstart - i4=nstart+1 - call refsys(i2,i3,i4,e1,e2,e3,error) -C Return, if couldn't define the reference system. - if (error) return -C Compute the transformation matrix. - cospsi=dcos(psi) - sinpsi=dsin(psi) - rot(1,1)=1.0D0 - rot(1,2)=0.0D0 - rot(1,3)=0.0D0 - rot(2,1)=0.0D0 - rot(2,2)=cospsi - rot(2,3)=-sinpsi - rot(3,1)=0.0D0 - rot(3,2)=sinpsi - rot(3,3)=cospsi - do i=1,3 - e(1,i)=e1(i) - e(2,i)=e2(i) - e(3,i)=e3(i) - enddo - - if (print_mc.gt.2) then - write (iout,'(a)') 'Reference system and matrix r:' - do i=1,3 - write(iout,'(i5,2(3f10.5,5x))')i,(e(i,j),j=1,3),(rot(i,j),j=1,3) - enddo - endif - - call matmult(rot,e,trans) - do i=1,3 - do j=1,3 - e(i,1)=e1(i) - e(i,2)=e2(i) - e(i,3)=e3(i) - enddo - enddo - call matmult(e,trans,trans) - - if (lprint) then - write (iout,'(a)') 'The trans matrix:' - do i=1,3 - write (iout,'(i5,3f10.5)') i,(trans(i,j),j=1,3) - enddo - endif - - do i=nstart,nend - do j=1,3 - rij=c(j,nstart) - do k=1,3 - rij=rij+trans(j,k)*(c(k,i)-c(k,nstart)) - enddo - x(j)=rij - enddo - do j=1,3 - c(j,i)=x(j) - enddo - enddo - - if (lprint) then - write (iout,'(a)') 'Rotated coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - -c call int_from_cart(.false.,lprint) - if (nstart.gt.1) then - theta(nstart+1)=alpha(nstart-1,nstart,nstart+1) - phi(nstart+2)=beta(nstart-1,nstart,nstart+1,nstart+2) - if (nstart.gt.2) phi(nstart+1)= - & beta(nstart-2,nstart-1,nstart,nstart+1) - endif - if (nend.lt.nres) then - theta(nend+1)=alpha(nend-1,nend,nend+1) - phi(nend+1)=beta(nend-2,nend-1,nend,nend+1) - if (nend.lt.nres-1) phi(nend+2)= - & beta(nend-1,nend,nend+1,nend+2) - endif - if (print_mc.gt.2) then - write (iout,'(/a,i3,a,i3,a/)') - & 'Moved internal coordinates of the ',nstart,'-',nend, - & ' fragment:' - do i=nstart+1,nstart+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - do i=nend+1,nend+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/build.txt b/source/unres/src_MD-NEWSC-NEWC/build.txt deleted file mode 100644 index a5eba7c..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/build.txt +++ /dev/null @@ -1 +0,0 @@ -cmake /users/czarek/UNRES/GIT/unres/ -DMPIF_LOCAL_DIR=/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh \ No newline at end of file diff --git a/source/unres/src_MD-NEWSC-NEWC/cartder.F b/source/unres/src_MD-NEWSC-NEWC/cartder.F deleted file mode 100644 index e2e8c1a..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/cartder.F +++ /dev/null @@ -1,314 +0,0 @@ - subroutine cartder -*********************************************************************** -* This subroutine calculates the derivatives of the consecutive virtual -* bond vectors and the SC vectors in the virtual-bond angles theta and -* virtual-torsional angles phi, as well as the derivatives of SC vectors -* in the angles alpha and omega, describing the location of a side chain -* in its local coordinate system. -* -* The derivatives are stored in the following arrays: -* -* DDCDV - the derivatives of virtual-bond vectors DC in theta and phi. -* The structure is as follows: -* -* dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0 -* dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4) -* . . . . . . . . . . . . . . . . . . -* dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4) -* . -* . -* . -* dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N) -* -* DXDV - the derivatives of the side-chain vectors in theta and phi. -* The structure is same as above. -* -* DCDS - the derivatives of the side chain vectors in the local spherical -* andgles alph and omega: -* -* dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2) -* dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3) -* . -* . -* . -* dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1) -* -* Version of March '95, based on an early version of November '91. -* -*********************************************************************** - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3), - & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres) - dimension xx(3),xx1(3) -c common /przechowalnia/ fromto -* get the position of the jth ijth fragment of the chain coordinate system -* in the fromto array. - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* calculate the derivatives of transformation matrix elements in theta -* - do i=1,nres-2 - rdt(1,1,i)=-rt(1,2,i) - rdt(1,2,i)= rt(1,1,i) - rdt(1,3,i)= 0.0d0 - rdt(2,1,i)=-rt(2,2,i) - rdt(2,2,i)= rt(2,1,i) - rdt(2,3,i)= 0.0d0 - rdt(3,1,i)=-rt(3,2,i) - rdt(3,2,i)= rt(3,1,i) - rdt(3,3,i)= 0.0d0 - enddo -* -* derivatives in phi -* - do i=2,nres-2 - drt(1,1,i)= 0.0d0 - drt(1,2,i)= 0.0d0 - drt(1,3,i)= 0.0d0 - drt(2,1,i)= rt(3,1,i) - drt(2,2,i)= rt(3,2,i) - drt(2,3,i)= rt(3,3,i) - drt(3,1,i)=-rt(2,1,i) - drt(3,2,i)=-rt(2,2,i) - drt(3,3,i)=-rt(2,3,i) - enddo -* -* generate the matrix products of type r(i)t(i)...r(j)t(j) -* - do i=2,nres-2 - ind=indmat(i,i+1) - do k=1,3 - do l=1,3 - temp(k,l)=rt(k,l,i) - enddo - enddo - do k=1,3 - do l=1,3 - fromto(k,l,ind)=temp(k,l) - enddo - enddo - do j=i+1,nres-2 - ind=indmat(i,j+1) - do k=1,3 - do l=1,3 - dpkl=0.0d0 - do m=1,3 - dpkl=dpkl+temp(k,m)*rt(m,l,j) - enddo - dp(k,l)=dpkl - fromto(k,l,ind)=dpkl - enddo - enddo - do k=1,3 - do l=1,3 - temp(k,l)=dp(k,l) - enddo - enddo - enddo - enddo -* -* Calculate derivatives. -* - ind1=0 - do i=1,nres-2 - ind1=ind1+1 -* -* Derivatives of DC(i+1) in theta(i+2) -* - do j=1,3 - do k=1,2 - dpjk=0.0D0 - do l=1,3 - dpjk=dpjk+prod(j,l,i)*rdt(l,k,i) - enddo - dp(j,k)=dpjk - prordt(j,k,i)=dp(j,k) - enddo - dp(j,3)=0.0D0 - dcdv(j,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in theta(i+2) -* - xx1(1)=-0.5D0*xloc(2,i+1) - xx1(2)= 0.5D0*xloc(1,i+1) - do j=1,3 - xj=0.0D0 - do k=1,2 - xj=xj+r(j,k,i)*xx1(k) - enddo - xx(j)=xj - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j,ind1)=rj - enddo -* -* Derivatives of SC(i+1) in theta(i+3). The have to be handled differently -* than the other off-diagonal derivatives. -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j,ind1+1)=dxoiij - enddo -cd print *,ind1+1,(dxdv(j,ind1+1),j=1,3) -* -* Derivatives of DC(i+1) in phi(i+2) -* - do j=1,3 - do k=1,3 - dpjk=0.0 - do l=2,3 - dpjk=dpjk+prod(j,l,i)*drt(l,k,i) - enddo - dp(j,k)=dpjk - prodrt(j,k,i)=dp(j,k) - enddo - dcdv(j+3,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in phi(i+2) -* - xx(1)= 0.0D0 - xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i) - xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i) - do j=1,3 - rj=0.0D0 - do k=2,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j+3,ind1)=-rj - enddo -* -* Derivatives of SC(i+1) in phi(i+3). -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j+3,ind1+1)=dxoiij - enddo -* -* Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru -* theta(nres) and phi(i+3) thru phi(nres). -* - do j=i+1,nres-2 - ind1=ind1+1 - ind=indmat(i+1,j+1) -cd print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1 - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,2 - tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo -cd print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3) -cd print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3) -cd print '(9f8.3)',((temp(k,l),l=1,3),k=1,3) -* Derivatives of virtual-bond vectors in theta - do k=1,3 - dcdv(k,ind1)=vbld(i+1)*temp(k,1) - enddo -cd print '(3f8.3)',(dcdv(k,ind1),k=1,3) -* Derivatives of SC vectors in theta - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k,ind1+1)=dxoijk - enddo -* -*--- Calculate the derivatives in phi -* - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,3 - tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo - do k=1,3 - dcdv(k+3,ind1)=vbld(i+1)*temp(k,1) - enddo - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k+3,ind1+1)=dxoijk - enddo - enddo - enddo -* -* Derivatives in alpha and omega: -* - do i=2,nres-1 -c dsci=dsc(itype(i)) - dsci=vbld(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if(alphi.ne.alphi) alphi=100.0 - if(omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif -cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - temp(1,1)=-dsci*sinalphi - temp(2,1)= dsci*cosalphi*cosomegi - temp(3,1)=-dsci*cosalphi*sinomegi - temp(1,2)=0.0D0 - temp(2,2)=-dsci*sinalphi*sinomegi - temp(3,2)=-dsci*sinalphi*cosomegi - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - jjj=0 -cd print *,((temp(l,k),l=1,3),k=1,2) - do j=1,2 - xp=temp(1,j) - yp=temp(2,j) - xxp= xp*cost2+yp*sint2 - yyp=-xp*sint2+yp*cost2 - zzp=temp(3,j) - xx(1)=xxp - xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1) - xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1) - do k=1,3 - dj=0.0D0 - do l=1,3 - dj=dj+prod(k,l,i-1)*xx(l) - enddo - dxds(jjj+k,i)=dj - enddo - jjj=jjj+3 - enddo - enddo - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/cartprint.f b/source/unres/src_MD-NEWSC-NEWC/cartprint.f deleted file mode 100644 index d79409e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/cartprint.f +++ /dev/null @@ -1,19 +0,0 @@ - subroutine cartprint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - write (iout,100) - do i=1,nres - write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i), - & c(3,i),c(1,nres+i),c(2,nres+i),c(3,nres+i) - enddo - 100 format (//' alpha-carbon coordinates ', - & ' centroid coordinates'/ - 1 ' ', 6X,'X',11X,'Y',11X,'Z', - & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i3,')',6f12.5) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/chainbuild.F b/source/unres/src_MD-NEWSC-NEWC/chainbuild.F deleted file mode 100644 index 45a1a53..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/chainbuild.F +++ /dev/null @@ -1,274 +0,0 @@ - subroutine chainbuild -C -C Build the virtual polypeptide chain. Side-chain centroids are moveable. -C As of 2/17/95. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - logical lprn -C Set lprn=.true. for debugging - lprn = .false. -C -C Define the origin and orientation of the coordinate system and locate the -C first three CA's and SC(2). -C - call orig_frame -* -* Build the alpha-carbon chain. -* - do i=4,nres - call locate_next_res(i) - enddo -C -C First and last SC must coincide with the corresponding CA. -C - do j=1,3 - dc(j,nres+1)=0.0D0 - dc_norm(j,nres+1)=0.0D0 - dc(j,nres+nres)=0.0D0 - dc_norm(j,nres+nres)=0.0D0 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo -* -* Temporary diagnosis -* - if (lprn) then - - call cartprint - write (iout,'(/a)') 'Recalculated internal coordinates' - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - be=0.0D0 - if (i.gt.3) be=rad2deg*beta(i-3,i-2,i-1,i) - be1=rad2deg*beta(nres+i,i,maxres2,i+1) - alfai=0.0D0 - if (i.gt.2) alfai=rad2deg*alpha(i-2,i-1,i) - write (iout,1212) restyp(itype(i)),i,dist(i-1,i), - & alfai,be,dist(nres+i,i),rad2deg*alpha(nres+i,i,maxres2),be1 - enddo - 1212 format (a3,'(',i3,')',2(f10.5,2f10.2)) - - endif - - return - end -c------------------------------------------------------------------------- - subroutine orig_frame -C -C Define the origin and orientation of the coordinate system and locate -C the first three atoms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - cost=dcos(theta(3)) - sint=dsin(theta(3)) - t(1,1,1)=-cost - t(1,2,1)=-sint - t(1,3,1)= 0.0D0 - t(2,1,1)=-sint - t(2,2,1)= cost - t(2,3,1)= 0.0D0 - t(3,1,1)= 0.0D0 - t(3,2,1)= 0.0D0 - t(3,3,1)= 1.0D0 - r(1,1,1)= 1.0D0 - r(1,2,1)= 0.0D0 - r(1,3,1)= 0.0D0 - r(2,1,1)= 0.0D0 - r(2,2,1)= 1.0D0 - r(2,3,1)= 0.0D0 - r(3,1,1)= 0.0D0 - r(3,2,1)= 0.0D0 - r(3,3,1)= 1.0D0 - do i=1,3 - do j=1,3 - rt(i,j,1)=t(i,j,1) - enddo - enddo - do i=1,3 - do j=1,3 - prod(i,j,1)=0.0D0 - prod(i,j,2)=t(i,j,1) - enddo - prod(i,i,1)=1.0D0 - enddo - c(1,1)=0.0D0 - c(2,1)=0.0D0 - c(3,1)=0.0D0 - c(1,2)=vbld(2) - c(2,2)=0.0D0 - c(3,2)=0.0D0 - dc(1,0)=0.0d0 - dc(2,0)=0.0D0 - dc(3,0)=0.0D0 - dc(1,1)=vbld(2) - dc(2,1)=0.0D0 - dc(3,1)=0.0D0 - dc_norm(1,0)=0.0D0 - dc_norm(2,0)=0.0D0 - dc_norm(3,0)=0.0D0 - dc_norm(1,1)=1.0D0 - dc_norm(2,1)=0.0D0 - dc_norm(3,1)=0.0D0 - do j=1,3 - dc_norm(j,2)=prod(j,1,2) - dc(j,2)=vbld(3)*prod(j,1,2) - c(j,3)=c(j,2)+dc(j,2) - enddo - call locate_side_chain(2) - return - end -c----------------------------------------------------------------------------- - subroutine locate_next_res(i) -C -C Locate CA(i) and SC(i-1) -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' -C -C Define the rotation matrices corresponding to CA(i) -C -#ifdef OSF - theti=theta(i) - if (theti.ne.theti) theti=100.0 - phii=phi(i) - if (phii.ne.phii) phii=180.0 -#else - theti=theta(i) - phii=phi(i) -#endif - cost=dcos(theti) - sint=dsin(theti) - cosphi=dcos(phii) - sinphi=dsin(phii) -* Define the matrices of the rotation about the virtual-bond valence angles -* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this -* program), R(i,j,k), and, the cumulative matrices of rotation RT - t(1,1,i-2)=-cost - t(1,2,i-2)=-sint - t(1,3,i-2)= 0.0D0 - t(2,1,i-2)=-sint - t(2,2,i-2)= cost - t(2,3,i-2)= 0.0D0 - t(3,1,i-2)= 0.0D0 - t(3,2,i-2)= 0.0D0 - t(3,3,i-2)= 1.0D0 - r(1,1,i-2)= 1.0D0 - r(1,2,i-2)= 0.0D0 - r(1,3,i-2)= 0.0D0 - r(2,1,i-2)= 0.0D0 - r(2,2,i-2)=-cosphi - r(2,3,i-2)= sinphi - r(3,1,i-2)= 0.0D0 - r(3,2,i-2)= sinphi - r(3,3,i-2)= cosphi - rt(1,1,i-2)=-cost - rt(1,2,i-2)=-sint - rt(1,3,i-2)=0.0D0 - rt(2,1,i-2)=sint*cosphi - rt(2,2,i-2)=-cost*cosphi - rt(2,3,i-2)=sinphi - rt(3,1,i-2)=-sint*sinphi - rt(3,2,i-2)=cost*sinphi - rt(3,3,i-2)=cosphi - call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1)) - do j=1,3 - dc_norm(j,i-1)=prod(j,1,i-1) - dc(j,i-1)=vbld(i)*prod(j,1,i-1) - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo -cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3) -C -C Now calculate the coordinates of SC(i-1) -C - call locate_side_chain(i-1) - return - end -c----------------------------------------------------------------------------- - subroutine locate_side_chain(i) -C -C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - dimension xx(3) - -c dsci=dsc(itype(i)) -c dsci_inv=dsc_inv(itype(i)) - dsci=vbld(i+nres) - dsci_inv=vbld_inv(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if (alphi.ne.alphi) alphi=100.0 - if (omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - xp= dsci*cosalphi - yp= dsci*sinalphi*cosomegi - zp=-dsci*sinalphi*sinomegi -* Now we have to rotate the coordinate system by 180-theta(i)/2 so as to get its -* X-axis aligned with the vector DC(*,i) - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - xx(1)= xp*cost2+yp*sint2 - xx(2)=-xp*sint2+yp*cost2 - xx(3)= zp -cd print '(a3,i3,3f10.5,5x,3f10.5)',restyp(itype(i)),i, -cd & xp,yp,zp,(xx(k),k=1,3) - do j=1,3 - xloc(j,i)=xx(j) - enddo -* Bring the SC vectors to the common coordinate system. - xx(1)=xloc(1,i) - xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1) - xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1) - do j=1,3 - xrot(j,i)=xx(j) - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i-1)*xx(k) - enddo - dc(j,nres+i)=rj - dc_norm(j,nres+i)=rj*dsci_inv - c(j,nres+i)=c(j,i)+rj - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/change.awk b/source/unres/src_MD-NEWSC-NEWC/change.awk deleted file mode 100644 index d192a6e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/change.awk +++ /dev/null @@ -1,11 +0,0 @@ -{ - if($0==" include 'COMMON.LANGEVIN'") { - print "#ifndef LANG0" - print " include 'COMMON.LANGEVIN'" - print "#else" - print " include 'COMMON.LANGEVIN.lang0'" - print "#endif" - }else{ - print $0 - } -} diff --git a/source/unres/src_MD-NEWSC-NEWC/check_bond.f b/source/unres/src_MD-NEWSC-NEWC/check_bond.f deleted file mode 100644 index c8a4ad1..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/check_bond.f +++ /dev/null @@ -1,20 +0,0 @@ - subroutine check_bond -C Subroutine is checking if the fitted function which describs sc_rot_pot -C is correct, printing, alpha,beta, energy, data - for some known theta. -C theta angle is read from the input file. Sc_rot_pot are printed -C for the second residue in sequance. - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision energia(0:n_ene) - it=itype(2) - do i=1,101 - vbld(nres+2)=0.5d0+0.05d0*(i-1) - call chainbuild - call etotal(energia) - write (2,*) vbld(nres+2),energia(17) - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/check_sc_distr.f b/source/unres/src_MD-NEWSC-NEWC/check_sc_distr.f deleted file mode 100644 index db2ed1b..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/check_sc_distr.f +++ /dev/null @@ -1,43 +0,0 @@ - subroutine check_sc_distr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - logical fail - double precision varia(maxvar) - double precision hrtime,mintime,sectime - parameter (MaxSample=10000000,delt=1.0D0/MaxSample) - dimension prob(0:72,0:90) - dV=2.0D0*5.0D0*deg2rad*deg2rad - print *,'dv=',dv - do 10 it=1,1 - if (it.eq.10) goto 10 - open (20,file=restyp(it)//'_distr.sdc',status='unknown') - call gen_side(it,90.0D0*deg2rad,al,om,fail) - close (20) - goto 10 - open (20,file=restyp(it)//'_distr1.sdc',status='unknown') - do i=0,90 - do j=0,72 - prob(j,i)=0.0D0 - enddo - enddo - do isample=1,MaxSample - call gen_side(it,90.0D0*deg2rad,al,om) - indal=rad2deg*al/2 - indom=(rad2deg*om+180.0D0)/5 - prob(indom,indal)=prob(indom,indal)+delt - enddo - do i=45,90 - do j=0,72 - write (20,'(2f10.3,1pd15.5)') 2*i+0.0D0,5*j-180.0D0, - & prob(j,i)/dV - enddo - enddo - 10 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/checkder_p.F b/source/unres/src_MD-NEWSC-NEWC/checkder_p.F deleted file mode 100644 index 4d0379e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/checkder_p.F +++ /dev/null @@ -1,713 +0,0 @@ - subroutine check_cartgrad -C Check the gradient of Cartesian coordinates in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.DERIV' - include 'COMMON.SCCOR' - dimension temp(6,maxres),xx(3),gg(3) - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* Check the gradient of the virtual-bond and SC vectors in the internal -* coordinates. -* - aincr=1.0d-7 - aincr2=5.0d-8 - call cartder - write (iout,'(a)') '**************** dx/dalpha' - write (iout,'(a)') - do i=2,nres-1 - alphi=alph(i) - alph(i)=alph(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - alph(i)=alphi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/domega' - write (iout,'(a)') - do i=2,nres-1 - omegi=omeg(i) - omeg(i)=omeg(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k+3,i))/ - & (aincr*dabs(dxds(k+3,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - omeg(i)=omegi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/dtheta' - write (iout,'(a)') - do i=3,nres - theti=theta(i) - theta(i)=theta(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'i=',i-2,' j=',j-1,' ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k,ii))/ - & (aincr*dabs(dxdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - write (iout,'(a)') - theta(i)=theti - call chainbuild - enddo - write (iout,'(a)') '***************** dx/dphi' - write (iout,'(a)') - do i=4,nres - phi(i)=phi(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ - & (aincr*dabs(dxdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - phi(i)=phi(i)-aincr - call chainbuild - enddo - write (iout,'(a)') '****************** ddc/dtheta' - do i=1,nres-2 - thet=theta(i+2) - theta(i+2)=thet+aincr - do j=i,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+1,nres-1 - ii = indmat(i,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k,ii))/ - & (aincr*dabs(dcdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - theta(i+2)=thet - enddo - write (iout,'(a)') '******************* ddc/dphi' - do i=1,nres-3 - phii=phi(i+3) - phi(i+3)=phii+aincr - do j=1,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+2,nres-1 - ii = indmat(i+1,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ - & (aincr*dabs(dcdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - phi(i+3)=phii - enddo - return - end -C---------------------------------------------------------------------------- - subroutine check_ecart -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar) - dimension grad_s(6,maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - icg=1 - nf=0 - nfl=0 - call zerograd - aincr=1.0D-7 - print '(a)','CG processor',me,' calling CHECK_CART.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gradc(j,i,icg) - grad_s(j+3,i)=gradx(j,i,icg) - enddo - enddo - call flush(iout) - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=1,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - enddo - do j=1,3 - dc(j,i)=dc(j,i)+aincr - do k=i+1,nres - c(j,k)=c(j,k)+aincr - c(j,k+nres)=c(j,k+nres)+aincr - enddo - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j)=(etot1-etot)/aincr - dc(j,i)=ddc(j) - do k=i+1,nres - c(j,k)=c(j,k)-aincr - c(j,k+nres)=c(j,k+nres)-aincr - enddo - enddo - do j=1,3 - c(j,i+nres)=c(j,i+nres)+aincr - dc(j,i+nres)=dc(j,i+nres)+aincr - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j+3)=(etot1-etot)/aincr - c(j,i+nres)=xx(j) - dc(j,i+nres)=ddx(j) - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine check_ecartint -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - include 'COMMON.LOCAL' - include 'COMMON.SPLITELE' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar), - & g(maxvar) - dimension dcnorm_safe(3),dxnorm_safe(3) - dimension grad_s(6,0:maxres),grad_s1(6,0:maxres) - double precision phi_temp(maxres),theta_temp(maxres), - & alph_temp(maxres),omeg_temp(maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - r_cut=2.0d0 - rlambd=0.3d0 - icg=1 - nf=0 - nfl=0 - call intout -c call intcartderiv -c call checkintcartgrad - call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - if (.not.split_ene) then - call etotal(energia(0)) -c do i=1,nres -c write (iout,*) "atu?", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - etot=energia(0) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - else -!- split gradient check - call zerograd - call etotal_long(energia(0)) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "longrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - call zerograd - call etotal_short(energia(0)) - call enerprint(energia(0)) -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "shortrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s1(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s1(j,i)=gcart(j,i) - grad_s1(j+3,i)=gxcart(j,i) - enddo - enddo - endif - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=0,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - do k=1,3 - dcnorm_safe(k)=dc_norm(k,i) - dxnorm_safe(k)=dc_norm(k,i+nres) - enddo - enddo - do j=1,3 - dc(j,i)=ddc(j)+aincr - call chainbuild_cart -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. -c if (nfgtasks.gt.1) -c & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) -c write (iout,*) "etot11",etot11," etot12",etot12 - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i)=ddc(j)-aincr - call chainbuild_cart -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j)=(etot12-etot22)/(2*aincr) -!- end split gradient -c write (iout,*) "etot21",etot21," etot22",etot22 - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i)=ddc(j) - call chainbuild_cart - enddo - do j=1,3 - dc(j,i+nres)=ddx(j)+aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm+ and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) -c write (iout,*) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i+nres)=ddx(j)-aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm- and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j+3)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j+3)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j+3)=(etot12-etot22)/(2*aincr) -!- end split gradient - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i+nres)=ddx(j) - call chainbuild_cart - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) - if (split_ene) then - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i), - & k=1,6) - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6), - & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6) - endif - enddo - return - end -c------------------------------------------------------------------------- - subroutine int_from_cart1(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.SETUP' - include 'COMMON.TIME1' - logical lprn - if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' -#ifdef TIMING - time01=MPI_Wtime() -#endif -#if defined(PARINT) && defined(MPI) - do i=iint_start,iint_end+1 -#else - do i=2,nres -#endif - dnorm1=dist(i-1,i) - dnorm2=dist(i,i+1) - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 - & +(c(j,i+1)-c(j,i))/dnorm2) - enddo - be=0.0D0 - if (i.gt.2) then - if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1) - if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then - tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) - endif - if (itype(i-1).ne.10) then - tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) - omicron(1,i)=alpha(i-2,i-1,i-1+nres) - omicron(2,i)=alpha(i-1+nres,i-1,i) - endif - if (itype(i).ne.10) then - tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) - endif - endif - omeg(i)=beta(nres+i,i,maxres2,i+1) - alph(i)=alpha(nres+i,i,maxres2) - theta(i+1)=alpha(i-1,i,i+1) - vbld(i)=dist(i-1,i) - vbld_inv(i)=1.0d0/vbld(i) - vbld(nres+i)=dist(nres+i,i) - if (itype(i).ne.10) then - vbld_inv(nres+i)=1.0d0/vbld(nres+i) - else - vbld_inv(nres+i)=0.0d0 - endif - enddo - -#if defined(PARINT) && defined(MPI) - if (nfgtasks1.gt.1) then -cd write(iout,*) "iint_start",iint_start," iint_count", -cd & (iint_count(i),i=0,nfgtasks-1)," iint_displ", -cd & (iint_displ(i),i=0,nfgtasks-1) -cd write (iout,*) "Gather vbld backbone" -cd call flush(iout) - time00=MPI_Wtime() - call MPI_Allgatherv(vbld(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld_inv(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld(iint_start+nres),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(nres+1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start+nres), - & iint_count(fg_rank1),MPI_DOUBLE_PRECISION,vbld_inv(nres+1), - & iint_count(0),iint_displ(0),MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather theta" -cd call flush(iout) - call MPI_Allgatherv(theta(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,theta(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather phi" -cd call flush(iout) - call MPI_Allgatherv(phi(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,phi(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#ifdef CRYST_SC -cd write (iout,*) "Gather alph" -cd call flush(iout) - call MPI_Allgatherv(alph(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,alph(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather omeg" -cd call flush(iout) - call MPI_Allgatherv(omeg(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,omeg(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#endif - time_gather=time_gather+MPI_Wtime()-time00 - endif -#endif - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - enddo - if (lprn) then - do i=2,nres - write (iout,1212) restyp(itype(i)),i,vbld(i), - &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), - &rad2deg*alph(i),rad2deg*omeg(i) - enddo - endif - 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) -#ifdef TIMING - time_intfcart=time_intfcart+MPI_Wtime()-time01 -#endif - return - end -c---------------------------------------------------------------------------- - subroutine check_eint -C Check the gradient of energy in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - common /srutu/ icall - dimension x(maxvar),gana(maxvar),gg(maxvar) - integer uiparm(1) - double precision urparm(1) - double precision energia(0:n_ene),energia1(0:n_ene), - & energia2(0:n_ene) - character*6 key - external fdum - call zerograd - aincr=1.0D-7 - print '(a)','Calling CHECK_INT.' - nf=0 - nfl=0 - icg=1 - call geom_to_var(nvar,x) - call var_to_geom(nvar,x) - call chainbuild - icall=1 - print *,'ICG=',ICG - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - print *,'ICG=',ICG -#ifdef MPL - if (MyID.ne.BossID) then - call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID) - nf=x(nvar+1) - nfl=x(nvar+2) - icg=x(nvar+3) - endif -#endif - nf=1 - nfl=3 -cd write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) - call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) -cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar) - icall=1 - do i=1,nvar - xi=x(i) - x(i)=xi-0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia1(0)) - etot1=energia1(0) - x(i)=xi+0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia2(0)) - etot2=energia2(0) - gg(i)=(etot2-etot1)/aincr - write (iout,*) i,etot1,etot2 - x(i)=xi - enddo - write (iout,'(/2a)')' Variable Numerical Analytical', - & ' RelDiff*100% ' - do i=1,nvar - if (i.le.nphi) then - ii=i - key = ' phi' - else if (i.le.nphi+ntheta) then - ii=i-nphi - key=' theta' - else if (i.le.nphi+ntheta+nside) then - ii=i-(nphi+ntheta) - key=' alpha' - else - ii=i-(nphi+ntheta+nside) - key=' omega' - endif - write (iout,'(i3,a,i3,3(1pd16.6))') - & i,key,ii,gg(i),gana(i), - & 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr) - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/compare_s1.F b/source/unres/src_MD-NEWSC-NEWC/compare_s1.F deleted file mode 100644 index 300e7ed..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/compare_s1.F +++ /dev/null @@ -1,188 +0,0 @@ - subroutine compare_s1(n_thr,num_thread_save,energyx,x, - & icomp,enetbss,coordss,rms_d,modif,iprint) -C This subroutine compares the new conformation, whose variables are in X -C with the previously accumulated conformations whose energies and variables -C are stored in ENETBSS and COORDSS, respectively. The meaning of other -C variables is as follows: -C -C N_THR - on input the previous # of accumulated confs, on output the current -C # of accumulated confs. -C N_REPEAT - an array that indicates how many times the structure has already -C been used to start the reversed-reversing procedure. Addition of -C a new structure replacement of a structure with a similar, but -C lower-energy structure resets the respective entry in N_REPEAT to zero -C I9 - output unit -C ENERGYX,X - the energy and variables of the new conformations. -C ICOMP - comparison result: -C 0 - the new structure is similar to one of the previous ones and does -C not have a remarkably lower energy and is therefore rejected; -C 1 - the new structure is different and is added to the set, because -C there is still room in the COORDSS and ENETBSS arrays; -C 2 - the new structure is different, but higher in energy than any -C previous one and is therefore rejected -C 3 - there is no more room in the COORDSS and ENETBSS arrays, but -C the new structure is lower in energy than at least the highest- -C energy previous structure and therefore replaces it. -C 9 - the new structure is similar to a number of previous structures, -C but has a remarkably lower energy than any of them; therefore -C replaces all these structures; -C MODIF - a logical variable that shows whether to include the new structure -C in the set of accumulated structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' -crc include 'COMMON.DEFORM' - include 'COMMON.IOUNITS' -#ifdef UNRES - include 'COMMON.CHAIN' -#endif - - dimension x(maxvar) - dimension x1(maxvar) - double precision przes(3),obrot(3,3) - integer list(max_thread) - logical non_conv,modif - double precision enetbss(max_threadss) - double precision coordss(maxvar,max_threadss) - - nlist=0 -#ifdef UNRES - call var_to_geom(nvar,x) - call chainbuild - do k=1,2*nres - do kk=1,3 - cref(kk,k)=c(kk,k) - enddo - enddo -#endif -c write(iout,*)'*ene=',energyx - j=0 - enex_jp=-1.0d+99 - do i=1,n_thr - do k=1,nvar - x1(k)=coordss(k,i) - enddo - if (iprint.gt.3) then - write (iout,*) 'Compare_ss, i=',i - write (iout,*) 'New structure Energy:',energyx - write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar) - write (iout,*) 'Template structure Energy:',enetbss(i) - write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar) - endif - -#ifdef UNRES - call var_to_geom(nvar,x1) - call chainbuild -cd write(iout,*)'C and CREF' -cd write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3), -cd & (cref(j,k),j=1,3),k=1,nres) - call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!!' - print *,'X' - print '(10f8.3)',(x(k),k=1,nvar) - print *,'X1' - print '(10f8.3)',(x1(k),k=1,nvar) - print *,'C and CREF' - print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3), - & (cref(j,k),j=1,3),k=1,nres) - endif - roznica=dsqrt(dabs(roznica)) - iresult = 1 - if (roznica.lt.rms_d) iresult = 0 -#else - energyy=enetbss(i) - call cmprs(x,x1,roznica,energyx,energyy,iresult) -#endif - if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica -c print '(i5,f8.3)',i,roznica - if(iresult.eq.0) then - nlist = nlist + 1 - list(nlist)=i - if (iprint.gt.1) write(iout,*) - if(energyx.ge.enetbss(i)) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - same as nr ',i, - & ' RMS',roznica - minimize_s_flag=0 - icomp=0 - go to 1106 - endif - endif - if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then - j=i - enex_jp=enetbss(i) - endif - enddo - if (iprint.gt.1) write(iout,*) - if(nlist.gt.0) then - if (modif) then - if (iprint.gt.1) - & write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ', - & list(1) - else - if (iprint.gt.1) - & write(iout,'(a,i3)') - & 's*>> structure accepted1 - would repl nr ',list(1) - endif - icomp=9 - if (.not. modif) goto 1106 - j=list(1) - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - do j=2,nlist - if (iprint.gt.1) write(iout,'(i3,$)')list(j) - do kk=list(j)+1,nlist - enetbss(kk-1)=enetbss(kk) - do i=1,nvar - coordss(i,kk-1)=coordss(i,kk) - enddo - enddo - enddo - if (iprint.gt.1) write(iout,*) - go to 1106 - endif - if(n_thr.lt.num_thread_save) then - icomp=1 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1 - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would add with nr ', - & n_thr+1 - goto 1106 - endif - n_thr=n_thr+1 - enetbss(n_thr)=energyx - do i=1,nvar - coordss(i,n_thr)=x(i) - enddo - else - if(j.eq.0) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - too high energy' - icomp=2 - go to 1106 - end if - icomp=3 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - repl nr ',j - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would repl nr ',j - goto 1106 - endif - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - end if - -1106 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/compinfo.c b/source/unres/src_MD-NEWSC-NEWC/compinfo.c deleted file mode 100644 index e28f686..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/compinfo.c +++ /dev/null @@ -1,82 +0,0 @@ -#include -#include -#include -#include -#include - -main() -{ -FILE *in, *in1, *out; -int i,j,k,iv1,iv2,iv3; -char *p1,buf[500],buf1[500],buf2[100],buf3[100]; -struct utsname Name; -time_t Tp; - -in=fopen("cinfo.f","r"); -out=fopen("cinfo.f.new","w"); -if (fgets(buf,498,in) != NULL) - fprintf(out,"C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C\n"); -if (fgets(buf,498,in) != NULL) - sscanf(&buf[1],"%d %d %d",&iv1,&iv2,&iv3); -iv3++; -fprintf(out,"C %d %d %d\n",iv1,iv2,iv3); -fprintf(out," subroutine cinfo\n"); -fprintf(out," include 'COMMON.IOUNITS'\n"); -fprintf(out," write(iout,*)'++++ Compile info ++++'\n"); -fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3); -uname(&Name); -time(&Tp); -system("whoami > tmptmp"); -in1=fopen("tmptmp","r"); -if (fscanf(in1,"%s",buf1) != EOF) -{ -p1=ctime(&Tp); -p1[strlen(p1)-1]='\0'; -fprintf(out," write(iout,*)'compiled %s'\n",p1); -fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename); -fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname); -fprintf(out," write(iout,*)'OS release: %s '\n",Name.release); -fprintf(out," write(iout,*)'OS version:',\n"); -fprintf(out," & ' %s '\n",Name.version); -fprintf(out," write(iout,*)'flags:'\n"); -} -system("rm tmptmp"); -fclose(in1); -in1=fopen("Makefile","r"); -while(fgets(buf,498,in1) != NULL) - { - if((p1=strchr(buf,'=')) != NULL && buf[0] != '#') - { - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - else - { - while(buf[strlen(buf)-1]=='\\') - { - strcat(buf,"\\"); - fprintf(out," write(iout,*)'%s'\n",buf); - if (fgets(buf,498,in1) != NULL) - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - } - } - - fprintf(out," write(iout,*)'%s'\n",buf); - } - } -fprintf(out," write(iout,*)'++++ End of compile info ++++'\n"); -fprintf(out," return\n"); -fprintf(out," end\n"); -fclose(out); -fclose(in1); -fclose(in); -system("mv cinfo.f.new cinfo.f"); -} diff --git a/source/unres/src_MD-NEWSC-NEWC/contact.f b/source/unres/src_MD-NEWSC-NEWC/contact.f deleted file mode 100644 index a244d86..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/contact.f +++ /dev/null @@ -1,195 +0,0 @@ - subroutine contact(lprint,ncont,icont,co) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - real*8 facont /1.569D0/ ! facont = (2/(1-sqrt(1-1/4)))**(1/6) - integer ncont,icont(2,maxcont) - logical lprint - ncont=0 - kkk=3 - do i=nnt+kkk,nct - iti=itype(i) - do j=nnt,i-kkk - itj=itype(j) - if (ipot.ne.4) then -c rcomp=sigmaii(iti,itj)+1.0D0 - rcomp=facont*sigmaii(iti,itj) - else -c rcomp=sigma(iti,itj)+1.0D0 - rcomp=facont*sigma(iti,itj) - endif -c rcomp=6.5D0 -c print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j) - if (dist(nres+i,nres+j).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'Contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif - co = 0.0d0 - do i=1,ncont - co = co + dfloat(iabs(icont(1,i)-icont(2,i))) - enddo - co = co / (nres*ncont) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract=dfloat(nmatch)/dfloat(ncont_ref) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract_nn(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont) - return - end -c---------------------------------------------------------------------------- - subroutine hairpin(lprint,nharp,iharp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - integer ncont,icont(2,maxcont) - integer nharp,iharp(4,maxres/3) - logical lprint,not_done - real*8 rcomp /6.0d0/ - ncont=0 - kkk=0 -c print *,'nnt=',nnt,' nct=',nct - do i=nnt,nct-3 - do k=1,3 - c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1)) - enddo - do j=i+2,nct-1 - do k=1,3 - c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1)) - enddo - if (dist(2*nres+1,2*nres+2).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'PP contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif -c finding hairpins - nharp=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then -c write (iout,*) "found turn at ",i1,j1 - ii1=i1 - jj1=j1 - not_done=.true. - do while (not_done) - i1=i1-1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -c write (iout,*) i1,j1,not_done - enddo - i1=i1+1 - j1=j1-1 - if (j1-i1.gt.4) then - nharp=nharp+1 - iharp(1,nharp)=i1 - iharp(2,nharp)=j1 - iharp(3,nharp)=ii1 - iharp(4,nharp)=jj1 -c write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4) - endif - endif - enddo -c do i=1,nharp -c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4) -c enddo - if (lprint) then - write (iout,*) "Hairpins:" - do i=1,nharp - i1=iharp(1,i) - j1=iharp(2,i) - ii1=iharp(3,i) - jj1=iharp(4,i) - write (iout,*) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) -c do k=jj1,j1,-1 -c write (iout,'(a,i3,$)') restyp(itype(k)),k -c enddo - enddo - endif - return - end -c---------------------------------------------------------------------------- - diff --git a/source/unres/src_MD-NEWSC-NEWC/convert.f b/source/unres/src_MD-NEWSC-NEWC/convert.f deleted file mode 100644 index dc0cccd..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/convert.f +++ /dev/null @@ -1,196 +0,0 @@ - subroutine geom_to_var(n,x) -C -C Transfer the geometry parameters to the variable array. -C The positions of variables are as follows: -C 1. Virtual-bond torsional angles: 1 thru nres-3 -C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5 -C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru -C 2*nres-4+nside -C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1 -C thru 2*nre-4+2*nside -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - double precision x(n) -cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar - do i=4,nres - x(i-3)=phi(i) -cd print *,i,i-3,phi(i) - enddo - if (n.eq.nphi) return - do i=3,nres - x(i-2+nphi)=theta(i) -cd print *,i,i-2+nphi,theta(i) - enddo - if (n.eq.nphi+ntheta) return - do i=2,nres-1 - if (ialph(i,1).gt.0) then - x(ialph(i,1))=alph(i) - x(ialph(i,1)+nside)=omeg(i) -cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i) - endif - enddo - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom(n,x) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(n) - logical change,reduce - change=reduce(x) - if (n.gt.nphi+ntheta) then - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - endif - do i=4,nres - phi(i)=x(i-3) - enddo - if (n.eq.nphi) return - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- - logical function convert_side(alphi,omegi) - implicit none - double precision alphi,omegi - double precision pinorm - include 'COMMON.GEO' - convert_side=.false. -C Apply periodicity restrictions. - if (alphi.gt.pi) then - alphi=dwapi-alphi - omegi=pinorm(omegi+pi) - convert_side=.true. - endif - return - end -c------------------------------------------------------------------------- - logical function reduce(x) -C -C Apply periodic restrictions to variables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - logical zm,zmiana,convert_side - dimension x(nvar) - zmiana=.false. - do i=4,nres - x(i-3)=pinorm(x(i-3)) - enddo - if (nvar.gt.nphi+ntheta) then - do i=1,nside - ii=nphi+ntheta+i - iii=ii+nside - x(ii)=thetnorm(x(ii)) - x(iii)=pinorm(x(iii)) -C Apply periodic restrictions. - zm=convert_side(x(ii),x(iii)) - zmiana=zmiana.or.zm - enddo - endif - if (nvar.eq.nphi) return - do i=3,nres - ii=i-2+nphi - iii=i-3 - x(ii)=dmod(x(ii),dwapi) -C Apply periodic restrictions. - if (x(ii).gt.pi) then - zmiana=.true. - x(ii)=dwapi-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.-pi) then - zmiana=.true. - x(ii)=dwapi+x(ii) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-pi-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.0.0d0) then - zmiana=.true. - x(ii)=-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - endif - enddo - reduce=zmiana - return - end -c-------------------------------------------------------------------------- - double precision function thetnorm(x) -C This function puts x within [0,2Pi]. - implicit none - double precision x,xx - include 'COMMON.GEO' - xx=dmod(x,dwapi) - if (xx.lt.0.0d0) xx=xx+dwapi - if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi - thetnorm=xx - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom_restr(n,xx) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(maxvar),xx(maxvar) - logical change,reduce - - call xx2x(x,xx) - change=reduce(x) - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - do i=4,nres - phi(i)=x(i-3) - enddo - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/cored.f b/source/unres/src_MD-NEWSC-NEWC/cored.f deleted file mode 100644 index 1cf25e5..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/cored.f +++ /dev/null @@ -1,3151 +0,0 @@ - subroutine assst(iv, liv, lv, v) -c -c *** assess candidate step (***sol version 2.3) *** -c - integer liv, l - integer iv(liv) - double precision v(lv) -c -c *** purpose *** -c -c this subroutine is called by an unconstrained minimization -c routine to assess the next candidate step. it may recommend one -c of several courses of action, such as accepting the step, recom- -c puting it using the same or a new quadratic model, or halting due -c to convergence or false convergence. see the return code listing -c below. -c -c-------------------------- parameter usage -------------------------- -c -c iv (i/o) integer parameter and scratch vector -- see description -c below of iv values referenced. -c liv (in) length of iv array. -c lv (in) length of v array. -c v (i/o) real parameter and scratch vector -- see description -c below of v values referenced. -c -c *** iv values referenced *** -c -c iv(irc) (i/o) on input for the first step tried in a new iteration, -c iv(irc) should be set to 3 or 4 (the value to which it is -c set when step is definitely to be accepted). on input -c after step has been recomputed, iv(irc) should be -c unchanged since the previous return of assst. -c on output, iv(irc) is a return code having one of the -c following values... -c 1 = switch models or try smaller step. -c 2 = switch models or accept step. -c 3 = accept step and determine v(radfac) by gradient -c tests. -c 4 = accept step, v(radfac) has been determined. -c 5 = recompute step (using the same model). -c 6 = recompute step with radius = v(lmaxs) but do not -c evaulate the objective function. -c 7 = x-convergence (see v(xctol)). -c 8 = relative function convergence (see v(rfctol)). -c 9 = both x- and relative function convergence. -c 10 = absolute function convergence (see v(afctol)). -c 11 = singular convergence (see v(lmaxs)). -c 12 = false convergence (see v(xftol)). -c 13 = iv(irc) was out of range on input. -c return code i has precdence over i+1 for i = 9, 10, 11. -c iv(mlstgd) (i/o) saved value of iv(model). -c iv(model) (i/o) on input, iv(model) should be an integer identifying -c the current quadratic model of the objective function. -c if a previous step yielded a better function reduction, -c then iv(model) will be set to iv(mlstgd) on output. -c iv(nfcall) (in) invocation count for the objective function. -c iv(nfgcal) (i/o) value of iv(nfcall) at step that gave the biggest -c function reduction this iteration. iv(nfgcal) remains -c unchanged until a function reduction is obtained. -c iv(radinc) (i/o) the number of radius increases (or minus the number -c of decreases) so far this iteration. -c iv(restor) (out) set to 1 if v(f) has been restored and x should be -c restored to its initial value, to 2 if x should be saved, -c to 3 if x should be restored from the saved value, and to -c 0 otherwise. -c iv(stage) (i/o) count of the number of models tried so far in the -c current iteration. -c iv(stglim) (in) maximum number of models to consider. -c iv(switch) (out) set to 0 unless a new model is being tried and it -c gives a smaller function value than the previous model, -c in which case assst sets iv(switch) = 1. -c iv(toobig) (in) is nonzero if step was too big (e.g. if it caused -c overflow). -c iv(xirc) (i/o) value that iv(irc) would have in the absence of -c convergence, false convergence, and oversized steps. -c -c *** v values referenced *** -c -c v(afctol) (in) absolute function convergence tolerance. if the -c absolute value of the current function value v(f) is less -c than v(afctol), then assst returns with iv(irc) = 10. -c v(decfac) (in) factor by which to decrease radius when iv(toobig) is -c nonzero. -c v(dstnrm) (in) the 2-norm of d*step. -c v(dstsav) (i/o) value of v(dstnrm) on saved step. -c v(dst0) (in) the 2-norm of d times the newton step (when defined, -c i.e., for v(nreduc) .ge. 0). -c v(f) (i/o) on both input and output, v(f) is the objective func- -c tion value at x. if x is restored to a previous value, -c then v(f) is restored to the corresponding value. -c v(fdif) (out) the function reduction v(f0) - v(f) (for the output -c value of v(f) if an earlier step gave a bigger function -c decrease, and for the input value of v(f) otherwise). -c v(flstgd) (i/o) saved value of v(f). -c v(f0) (in) objective function value at start of iteration. -c v(gtslst) (i/o) value of v(gtstep) on saved step. -c v(gtstep) (in) inner product between step and gradient. -c v(incfac) (in) minimum factor by which to increase radius. -c v(lmaxs) (in) maximum reasonable step size (and initial step bound). -c if the actual function decrease is no more than twice -c what was predicted, if a return with iv(irc) = 7, 8, 9, -c or 10 does not occur, if v(dstnrm) .gt. v(lmaxs), and if -c v(preduc) .le. v(sctol) * abs(v(f0)), then assst re- -c turns with iv(irc) = 11. if so doing appears worthwhile, -c then assst repeats this test with v(preduc) computed for -c a step of length v(lmaxs) (by a return with iv(irc) = 6). -c v(nreduc) (i/o) function reduction predicted by quadratic model for -c newton step. if assst is called with iv(irc) = 6, i.e., -c if v(preduc) has been computed with radius = v(lmaxs) for -c use in the singular convervence test, then v(nreduc) is -c set to -v(preduc) before the latter is restored. -c v(plstgd) (i/o) value of v(preduc) on saved step. -c v(preduc) (i/o) function reduction predicted by quadratic model for -c current step. -c v(radfac) (out) factor to be used in determining the new radius, -c which should be v(radfac)*dst, where dst is either the -c output value of v(dstnrm) or the 2-norm of -c diag(newd)*step for the output value of step and the -c updated version, newd, of the scale vector d. for -c iv(irc) = 3, v(radfac) = 1.0 is returned. -c v(rdfcmn) (in) minimum value for v(radfac) in terms of the input -c value of v(dstnrm) -- suggested value = 0.1. -c v(rdfcmx) (in) maximum value for v(radfac) -- suggested value = 4.0. -c v(reldx) (in) scaled relative change in x caused by step, computed -c (e.g.) by function reldst as -c max (d(i)*abs(x(i)-x0(i)), 1 .le. i .le. p) / -c max (d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p). -c v(rfctol) (in) relative function convergence tolerance. if the -c actual function reduction is at most twice what was pre- -c dicted and v(nreduc) .le. v(rfctol)*abs(v(f0)), then -c assst returns with iv(irc) = 8 or 9. -c v(stppar) (in) marquardt parameter -- 0 means full newton step. -c v(tuner1) (in) tuning constant used to decide if the function -c reduction was much less than expected. suggested -c value = 0.1. -c v(tuner2) (in) tuning constant used to decide if the function -c reduction was large enough to accept step. suggested -c value = 10**-4. -c v(tuner3) (in) tuning constant used to decide if the radius -c should be increased. suggested value = 0.75. -c v(xctol) (in) x-convergence criterion. if step is a newton step -c (v(stppar) = 0) having v(reldx) .le. v(xctol) and giving -c at most twice the predicted function decrease, then -c assst returns iv(irc) = 7 or 9. -c v(xftol) (in) false convergence tolerance. if step gave no or only -c a small function decrease and v(reldx) .le. v(xftol), -c then assst returns with iv(irc) = 12. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine is called as part of the nl2sol (nonlinear -c least-squares) package. it may be used in any unconstrained -c minimization solver that uses dogleg, goldfeld-quandt-trotter, -c or levenberg-marquardt steps. -c -c *** algorithm notes *** -c -c see (1) for further discussion of the assessing and model -c switching strategies. while nl2sol considers only two models, -c assst is designed to handle any number of models. -c -c *** usage notes *** -c -c on the first call of an iteration, only the i/o variables -c step, x, iv(irc), iv(model), v(f), v(dstnrm), v(gtstep), and -c v(preduc) need have been initialized. between calls, no i/o -c values execpt step, x, iv(model), v(f) and the stopping toler- -c ances should be changed. -c after a return for convergence or false convergence, one can -c change the stopping tolerances and call assst again, in which -c case the stopping tests will be repeated. -c -c *** references *** -c -c (1) dennis, j.e., jr., gay, d.m., and welsch, r.e. (1981), -c an adaptive nonlinear least-squares algorithm, -c acm trans. math. software, vol. 7, no. 3. -c -c (2) powell, m.j.d. (1970) a fortran subroutine for solving -c systems of nonlinear algebraic equations, in numerical -c methods for nonlinear algebraic equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** history *** -c -c john dennis designed much of this routine, starting with -c ideas in (2). roy welsch suggested the model switching strategy. -c david gay and stephen peters cast this subroutine into a more -c portable form (winter 1977), and david gay cast it into its -c present form (fall 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** no external functions and subroutines *** -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1 -c/ -c *** no common blocks *** -c -c-------------------------- local variables -------------------------- -c - logical goodx - integer i, nfc - double precision emax, emaxs, gts, rfac1, xmax - double precision half, one, onep2, two, zero -c -c *** subscripts for iv and v *** -c - integer afctol, decfac, dstnrm, dstsav, dst0, f, fdif, flstgd, f0, - 1 gtslst, gtstep, incfac, irc, lmaxs, mlstgd, model, nfcall, - 2 nfgcal, nreduc, plstgd, preduc, radfac, radinc, rdfcmn, - 3 rdfcmx, reldx, restor, rfctol, sctol, stage, stglim, - 4 stppar, switch, toobig, tuner1, tuner2, tuner3, xctol, - 5 xftol, xirc -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, onep2/1.2d+0/, two/2.d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, onep2=1.2d+0, two=2.d+0, - 1 zero=0.d+0) -c/ -c -c/6 -c data irc/29/, mlstgd/32/, model/5/, nfcall/6/, nfgcal/7/, -c 1 radinc/8/, restor/9/, stage/10/, stglim/11/, switch/12/, -c 2 toobig/2/, xirc/13/ -c/7 - parameter (irc=29, mlstgd=32, model=5, nfcall=6, nfgcal=7, - 1 radinc=8, restor=9, stage=10, stglim=11, switch=12, - 2 toobig=2, xirc=13) -c/ -c/6 -c data afctol/31/, decfac/22/, dstnrm/2/, dst0/3/, dstsav/18/, -c 1 f/10/, fdif/11/, flstgd/12/, f0/13/, gtslst/14/, gtstep/4/, -c 2 incfac/23/, lmaxs/36/, nreduc/6/, plstgd/15/, preduc/7/, -c 3 radfac/16/, rdfcmn/24/, rdfcmx/25/, reldx/17/, rfctol/32/, -c 4 sctol/37/, stppar/5/, tuner1/26/, tuner2/27/, tuner3/28/, -c 5 xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, decfac=22, dstnrm=2, dst0=3, dstsav=18, - 1 f=10, fdif=11, flstgd=12, f0=13, gtslst=14, gtstep=4, - 2 incfac=23, lmaxs=36, nreduc=6, plstgd=15, preduc=7, - 3 radfac=16, rdfcmn=24, rdfcmx=25, reldx=17, rfctol=32, - 4 sctol=37, stppar=5, tuner1=26, tuner2=27, tuner3=28, - 5 xctol=33, xftol=34) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nfc = iv(nfcall) - iv(switch) = 0 - iv(restor) = 0 - rfac1 = one - goodx = .true. - i = iv(irc) - if (i .ge. 1 .and. i .le. 12) - 1 go to (20,30,10,10,40,280,220,220,220,220,220,170), i - iv(irc) = 13 - go to 999 -c -c *** initialize for new iteration *** -c - 10 iv(stage) = 1 - iv(radinc) = 0 - v(flstgd) = v(f0) - if (iv(toobig) .eq. 0) go to 110 - iv(stage) = -1 - iv(xirc) = i - go to 60 -c -c *** step was recomputed with new model or smaller radius *** -c *** first decide which *** -c - 20 if (iv(model) .ne. iv(mlstgd)) go to 30 -c *** old model retained, smaller radius tried *** -c *** do not consider any more new models this iteration *** - iv(stage) = iv(stglim) - iv(radinc) = -1 - go to 110 -c -c *** a new model is being tried. decide whether to keep it. *** -c - 30 iv(stage) = iv(stage) + 1 -c -c *** now we add the possibiltiy that step was recomputed with *** -c *** the same model, perhaps because of an oversized step. *** -c - 40 if (iv(stage) .gt. 0) go to 50 -c -c *** step was recomputed because it was too big. *** -c - if (iv(toobig) .ne. 0) go to 60 -c -c *** restore iv(stage) and pick up where we left off. *** -c - iv(stage) = -iv(stage) - i = iv(xirc) - go to (20, 30, 110, 110, 70), i -c - 50 if (iv(toobig) .eq. 0) go to 70 -c -c *** handle oversize step *** -c - if (iv(radinc) .gt. 0) go to 80 - iv(stage) = -iv(stage) - iv(xirc) = iv(irc) -c - 60 v(radfac) = v(decfac) - iv(radinc) = iv(radinc) - 1 - iv(irc) = 5 - iv(restor) = 1 - go to 999 -c - 70 if (v(f) .lt. v(flstgd)) go to 110 -c -c *** the new step is a loser. restore old model. *** -c - if (iv(model) .eq. iv(mlstgd)) go to 80 - iv(model) = iv(mlstgd) - iv(switch) = 1 -c -c *** restore step, etc. only if a previous step decreased v(f). -c - 80 if (v(flstgd) .ge. v(f0)) go to 110 - iv(restor) = 1 - v(f) = v(flstgd) - v(preduc) = v(plstgd) - v(gtstep) = v(gtslst) - if (iv(switch) .eq. 0) rfac1 = v(dstnrm) / v(dstsav) - v(dstnrm) = v(dstsav) - nfc = iv(nfgcal) - goodx = .false. -c - 110 v(fdif) = v(f0) - v(f) - if (v(fdif) .gt. v(tuner2) * v(preduc)) go to 140 - if(iv(radinc).gt.0) go to 140 -c -c *** no (or only a trivial) function decrease -c *** -- so try new model or smaller radius -c - if (v(f) .lt. v(f0)) go to 120 - iv(mlstgd) = iv(model) - v(flstgd) = v(f) - v(f) = v(f0) - iv(restor) = 1 - go to 130 - 120 iv(nfgcal) = nfc - 130 iv(irc) = 1 - if (iv(stage) .lt. iv(stglim)) go to 160 - iv(irc) = 5 - iv(radinc) = iv(radinc) - 1 - go to 160 -c -c *** nontrivial function decrease achieved *** -c - 140 iv(nfgcal) = nfc - rfac1 = one - v(dstsav) = v(dstnrm) - if (v(fdif) .gt. v(preduc)*v(tuner1)) go to 190 -c -c *** decrease was much less than predicted -- either change models -c *** or accept step with decreased radius. -c - if (iv(stage) .ge. iv(stglim)) go to 150 -c *** consider switching models *** - iv(irc) = 2 - go to 160 -c -c *** accept step with decreased radius *** -c - 150 iv(irc) = 4 -c -c *** set v(radfac) to fletcher*s decrease factor *** -c - 160 iv(xirc) = iv(irc) - emax = v(gtstep) + v(fdif) - v(radfac) = half * rfac1 - if (emax .lt. v(gtstep)) v(radfac) = rfac1 * dmax1(v(rdfcmn), - 1 half * v(gtstep)/emax) -c -c *** do false convergence test *** -c - 170 if (v(reldx) .le. v(xftol)) go to 180 - iv(irc) = iv(xirc) - if (v(f) .lt. v(f0)) go to 200 - go to 230 -c - 180 iv(irc) = 12 - go to 240 -c -c *** handle good function decrease *** -c - 190 if (v(fdif) .lt. (-v(tuner3) * v(gtstep))) go to 210 -c -c *** increasing radius looks worthwhile. see if we just -c *** recomputed step with a decreased radius or restored step -c *** after recomputing it with a larger radius. -c - if (iv(radinc) .lt. 0) go to 210 - if (iv(restor) .eq. 1) go to 210 -c -c *** we did not. try a longer step unless this was a newton -c *** step. -c - v(radfac) = v(rdfcmx) - gts = v(gtstep) - if (v(fdif) .lt. (half/v(radfac) - one) * gts) - 1 v(radfac) = dmax1(v(incfac), half*gts/(gts + v(fdif))) - iv(irc) = 4 - if (v(stppar) .eq. zero) go to 230 - if (v(dst0) .ge. zero .and. (v(dst0) .lt. two*v(dstnrm) - 1 .or. v(nreduc) .lt. onep2*v(fdif))) go to 230 -c *** step was not a newton step. recompute it with -c *** a larger radius. - iv(irc) = 5 - iv(radinc) = iv(radinc) + 1 -c -c *** save values corresponding to good step *** -c - 200 v(flstgd) = v(f) - iv(mlstgd) = iv(model) - if (iv(restor) .ne. 1) iv(restor) = 2 - v(dstsav) = v(dstnrm) - iv(nfgcal) = nfc - v(plstgd) = v(preduc) - v(gtslst) = v(gtstep) - go to 230 -c -c *** accept step with radius unchanged *** -c - 210 v(radfac) = one - iv(irc) = 3 - go to 230 -c -c *** come here for a restart after convergence *** -c - 220 iv(irc) = iv(xirc) - if (v(dstsav) .ge. zero) go to 240 - iv(irc) = 12 - go to 240 -c -c *** perform convergence tests *** -c - 230 iv(xirc) = iv(irc) - 240 if (iv(restor) .eq. 1 .and. v(flstgd) .lt. v(f0)) iv(restor) = 3 - if (half * v(fdif) .gt. v(preduc)) go to 999 - emax = v(rfctol) * dabs(v(f0)) - emaxs = v(sctol) * dabs(v(f0)) - if (v(dstnrm) .gt. v(lmaxs) .and. v(preduc) .le. emaxs) - 1 iv(irc) = 11 - if (v(dst0) .lt. zero) go to 250 - i = 0 - if ((v(nreduc) .gt. zero .and. v(nreduc) .le. emax) .or. - 1 (v(nreduc) .eq. zero. and. v(preduc) .eq. zero)) i = 2 - if (v(stppar) .eq. zero .and. v(reldx) .le. v(xctol) - 1 .and. goodx) i = i + 1 - if (i .gt. 0) iv(irc) = i + 6 -c -c *** consider recomputing step of length v(lmaxs) for singular -c *** convergence test. -c - 250 if (iv(irc) .gt. 5 .and. iv(irc) .ne. 12) go to 999 - if (v(dstnrm) .gt. v(lmaxs)) go to 260 - if (v(preduc) .ge. emaxs) go to 999 - if (v(dst0) .le. zero) go to 270 - if (half * v(dst0) .le. v(lmaxs)) go to 999 - go to 270 - 260 if (half * v(dstnrm) .le. v(lmaxs)) go to 999 - xmax = v(lmaxs) / v(dstnrm) - if (xmax * (two - xmax) * v(preduc) .ge. emaxs) go to 999 - 270 if (v(nreduc) .lt. zero) go to 290 -c -c *** recompute v(preduc) for use in singular convergence test *** -c - v(gtslst) = v(gtstep) - v(dstsav) = v(dstnrm) - if (iv(irc) .eq. 12) v(dstsav) = -v(dstsav) - v(plstgd) = v(preduc) - i = iv(restor) - iv(restor) = 2 - if (i .eq. 3) iv(restor) = 0 - iv(irc) = 6 - go to 999 -c -c *** perform singular convergence test with recomputed v(preduc) *** -c - 280 v(gtstep) = v(gtslst) - v(dstnrm) = dabs(v(dstsav)) - iv(irc) = iv(xirc) - if (v(dstsav) .le. zero) iv(irc) = 12 - v(nreduc) = -v(preduc) - v(preduc) = v(plstgd) - iv(restor) = 3 - 290 if (-v(nreduc) .le. v(sctol) * dabs(v(f0))) iv(irc) = 11 -c - 999 return -c -c *** last card of assst follows *** - end - subroutine deflt(alg, iv, liv, lv, v) -c -c *** supply ***sol (version 2.3) default values to iv and v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer liv, l - integer alg, iv(liv) - double precision v(lv) -c - external imdcon, vdflt - integer imdcon -c imdcon... returns machine-dependent integer constants. -c vdflt.... provides default values to v. -c - integer miv, m - integer miniv(2), minv(2) -c -c *** subscripts for iv *** -c - integer algsav, covprt, covreq, dtype, hc, ierr, inith, inits, - 1 ipivot, ivneed, lastiv, lastv, lmat, mxfcal, mxiter, - 2 nfcov, ngcov, nvdflt, outlev, parprt, parsav, perm, - 3 prunit, qrtyp, rdreq, rmat, solprt, statpr, vneed, - 4 vsave, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, covprt/14/, covreq/15/, dtype/16/, hc/71/, -c 1 ierr/75/, inith/25/, inits/25/, ipivot/76/, ivneed/3/, -c 2 lastiv/44/, lastv/45/, lmat/42/, mxfcal/17/, mxiter/18/, -c 3 nfcov/52/, ngcov/53/, nvdflt/50/, outlev/19/, parprt/20/, -c 4 parsav/49/, perm/58/, prunit/21/, qrtyp/80/, rdreq/57/, -c 5 rmat/78/, solprt/22/, statpr/23/, vneed/4/, vsave/60/, -c 6 x0prt/24/ -c/7 - parameter (algsav=51, covprt=14, covreq=15, dtype=16, hc=71, - 1 ierr=75, inith=25, inits=25, ipivot=76, ivneed=3, - 2 lastiv=44, lastv=45, lmat=42, mxfcal=17, mxiter=18, - 3 nfcov=52, ngcov=53, nvdflt=50, outlev=19, parprt=20, - 4 parsav=49, perm=58, prunit=21, qrtyp=80, rdreq=57, - 5 rmat=78, solprt=22, statpr=23, vneed=4, vsave=60, - 6 x0prt=24) -c/ - data miniv(1)/80/, miniv(2)/59/, minv(1)/98/, minv(2)/71/ -c -c------------------------------- body -------------------------------- -c - if (alg .lt. 1 .or. alg .gt. 2) go to 40 - miv = miniv(alg) - if (liv .lt. miv) go to 20 - mv = minv(alg) - if (lv .lt. mv) go to 30 - call vdflt(alg, lv, v) - iv(1) = 12 - iv(algsav) = alg - iv(ivneed) = 0 - iv(lastiv) = miv - iv(lastv) = mv - iv(lmat) = mv + 1 - iv(mxfcal) = 200 - iv(mxiter) = 150 - iv(outlev) = 1 - iv(parprt) = 1 - iv(perm) = miv + 1 - iv(prunit) = imdcon(1) - iv(solprt) = 1 - iv(statpr) = 1 - iv(vneed) = 0 - iv(x0prt) = 1 -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - iv(covprt) = 3 - iv(covreq) = 1 - iv(dtype) = 1 - iv(hc) = 0 - iv(ierr) = 0 - iv(inits) = 0 - iv(ipivot) = 0 - iv(nvdflt) = 32 - iv(parsav) = 67 - iv(qrtyp) = 1 - iv(rdreq) = 3 - iv(rmat) = 0 - iv(vsave) = 58 - go to 999 -c -c *** general optimization values -c - 10 iv(dtype) = 0 - iv(inith) = 1 - iv(nfcov) = 0 - iv(ngcov) = 0 - iv(nvdflt) = 25 - iv(parsav) = 47 - go to 999 -c - 20 iv(1) = 15 - go to 999 -c - 30 iv(1) = 16 - go to 999 -c - 40 iv(1) = 67 -c - 999 return -c *** last card of deflt follows *** - end - double precision function dotprd(p, x, y) -c -c *** return the inner product of the p-vectors x and y. *** -c - integer p - double precision x(p), y(p) -c - integer i - double precision one, sqteta, t, zero -c/+ - double precision dmax1, dabs -c/ - external rmdcon - double precision rmdcon -c -c *** rmdcon(2) returns a machine-dependent constant, sqteta, which -c *** is slightly larger than the smallest positive number that -c *** can be squared without underflowing. -c -c/6 -c data one/1.d+0/, sqteta/0.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - data sqteta/0.d+0/ -c/ -c - dotprd = zero - if (p .le. 0) go to 999 -crc if (sqteta .eq. zero) sqteta = rmdcon(2) - do 20 i = 1, p -crc t = dmax1(dabs(x(i)), dabs(y(i))) -crc if (t .gt. one) go to 10 -crc if (t .lt. sqteta) go to 20 -crc t = (x(i)/sqteta)*y(i) -crc if (dabs(t) .lt. sqteta) go to 20 - 10 dotprd = dotprd + x(i)*y(i) - 20 continue -c - 999 return -c *** last card of dotprd follows *** - end - subroutine itsum(d, g, iv, liv, lv, p, v, x) -c -c *** print iteration summary for ***sol (version 2.3) *** -c -c *** parameter declarations *** -c - integer liv, lv, p - integer iv(liv) - double precision d(p), g(p), v(lv), x(p) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer alg, i, iv1, m, nf, ng, ol, pu -c/6 -c real model1(6), model2(6) -c/7 - character*4 model1(6), model2(6) -c/ - double precision nreldf, oldf, preldf, reldf, zero -c -c *** intrinsic functions *** -c/+ - integer iabs - double precision dabs, dmax1 -c/ -c *** no external functions or subroutines *** -c -c *** subscripts for iv and v *** -c - integer algsav, dstnrm, f, fdif, f0, needhd, nfcall, nfcov, ngcov, - 1 ngcall, niter, nreduc, outlev, preduc, prntit, prunit, - 2 reldx, solprt, statpr, stppar, sused, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, needhd/36/, nfcall/6/, nfcov/52/, ngcall/30/, -c 1 ngcov/53/, niter/31/, outlev/19/, prntit/39/, prunit/21/, -c 2 solprt/22/, statpr/23/, sused/64/, x0prt/24/ -c/7 - parameter (algsav=51, needhd=36, nfcall=6, nfcov=52, ngcall=30, - 1 ngcov=53, niter=31, outlev=19, prntit=39, prunit=21, - 2 solprt=22, statpr=23, sused=64, x0prt=24) -c/ -c -c *** v subscript values *** -c -c/6 -c data dstnrm/2/, f/10/, f0/13/, fdif/11/, nreduc/6/, preduc/7/, -c 1 reldx/17/, stppar/5/ -c/7 - parameter (dstnrm=2, f=10, f0=13, fdif=11, nreduc=6, preduc=7, - 1 reldx=17, stppar=5) -c/ -c -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c/6 -c data model1(1)/4h /, model1(2)/4h /, model1(3)/4h /, -c 1 model1(4)/4h /, model1(5)/4h g /, model1(6)/4h s /, -c 2 model2(1)/4h g /, model2(2)/4h s /, model2(3)/4hg-s /, -c 3 model2(4)/4hs-g /, model2(5)/4h-s-g/, model2(6)/4h-g-s/ -c/7 - data model1/' ',' ',' ',' ',' g ',' s '/, - 1 model2/' g ',' s ','g-s ','s-g ','-s-g','-g-s'/ -c/ -c -c------------------------------- body -------------------------------- -c - pu = iv(prunit) - if (pu .eq. 0) go to 999 - iv1 = iv(1) - if (iv1 .gt. 62) iv1 = iv1 - 51 - ol = iv(outlev) - alg = iv(algsav) - if (iv1 .lt. 2 .or. iv1 .gt. 15) go to 370 - if (iv1 .ge. 12) go to 120 - if (iv1 .eq. 2 .and. iv(niter) .eq. 0) go to 390 - if (ol .eq. 0) go to 120 - if (iv1 .ge. 10 .and. iv(prntit) .eq. 0) go to 120 - if (iv1 .gt. 2) go to 10 - iv(prntit) = iv(prntit) + 1 - if (iv(prntit) .lt. iabs(ol)) go to 999 - 10 nf = iv(nfcall) - iabs(iv(nfcov)) - iv(prntit) = 0 - reldf = zero - preldf = zero - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - if (oldf .le. zero) go to 20 - reldf = v(fdif) / oldf - preldf = v(preduc) / oldf - 20 if (ol .gt. 0) go to 60 -c -c *** print short summary line *** -c - if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,30) - 30 format(/10h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,40) - 40 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar) - iv(needhd) = 0 - if (alg .eq. 2) go to 50 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar) - go to 120 -c - 50 write(pu,110) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 v(stppar) - go to 120 -c -c *** print long summary line *** -c - 60 if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,70) - 70 format(/11h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar,2x,6hd*step,2x,7hnpreldf) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,80) - 80 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar,3x,6hd*step,3x,7hnpreldf) - iv(needhd) = 0 - nreldf = zero - if (oldf .gt. zero) nreldf = v(nreduc) / oldf - if (alg .eq. 2) go to 90 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar), v(dstnrm), nreldf - go to 120 -c - 90 write(pu,110) iv(niter), nf, v(f), reldf, preldf, - 1 v(reldx), v(stppar), v(dstnrm), nreldf - 100 format(i6,i5,d10.3,2d9.2,d8.1,a3,a4,2d8.1,d9.2) - 110 format(i6,i5,d11.3,2d10.2,3d9.1,d10.2) -c - 120 if (iv(statpr) .lt. 0) go to 430 - go to (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310, - 1 330, 350, 520), iv1 -c - 130 write(pu,140) - 140 format(/26h ***** x-convergence *****) - go to 430 -c - 150 write(pu,160) - 160 format(/42h ***** relative function convergence *****) - go to 430 -c - 170 write(pu,180) - 180 format(/49h ***** x- and relative function convergence *****) - go to 430 -c - 190 write(pu,200) - 200 format(/42h ***** absolute function convergence *****) - go to 430 -c - 210 write(pu,220) - 220 format(/33h ***** singular convergence *****) - go to 430 -c - 230 write(pu,240) - 240 format(/30h ***** false convergence *****) - go to 430 -c - 250 write(pu,260) - 260 format(/38h ***** function evaluation limit *****) - go to 430 -c - 270 write(pu,280) - 280 format(/28h ***** iteration limit *****) - go to 430 -c - 290 write(pu,300) - 300 format(/18h ***** stopx *****) - go to 430 -c - 310 write(pu,320) - 320 format(/44h ***** initial f(x) cannot be computed *****) -c - go to 390 -c - 330 write(pu,340) - 340 format(/37h ***** bad parameters to assess *****) - go to 999 -c - 350 write(pu,360) - 360 format(/43h ***** gradient could not be computed *****) - if (iv(niter) .gt. 0) go to 480 - go to 390 -c - 370 write(pu,380) iv(1) - 380 format(/14h ***** iv(1) =,i5,6h *****) - go to 999 -c -c *** initial call on itsum *** -c - 390 if (iv(x0prt) .ne. 0) write(pu,400) (i, x(i), d(i), i = 1, p) - 400 format(/23h i initial x(i),8x,4hd(i)//(1x,i5,d17.6,d14.3)) -c *** the following are to avoid undefined variables when the -c *** function evaluation limit is 1... - v(dstnrm) = zero - v(fdif) = zero - v(nreduc) = zero - v(preduc) = zero - v(reldx) = zero - if (iv1 .ge. 12) go to 999 - iv(needhd) = 0 - iv(prntit) = 0 - if (ol .eq. 0) go to 999 - if (ol .lt. 0 .and. alg .eq. 1) write(pu,30) - if (ol .lt. 0 .and. alg .eq. 2) write(pu,40) - if (ol .gt. 0 .and. alg .eq. 1) write(pu,70) - if (ol .gt. 0 .and. alg .eq. 2) write(pu,80) - if (alg .eq. 1) write(pu,410) v(f) - if (alg .eq. 2) write(pu,420) v(f) - 410 format(/11h 0 1,d10.3) -c365 format(/11h 0 1,e11.3) - 420 format(/11h 0 1,d11.3) - go to 999 -c -c *** print various information requested on solution *** -c - 430 iv(needhd) = 1 - if (iv(statpr) .eq. 0) go to 480 - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - preldf = zero - nreldf = zero - if (oldf .le. zero) go to 440 - preldf = v(preduc) / oldf - nreldf = v(nreduc) / oldf - 440 nf = iv(nfcall) - iv(nfcov) - ng = iv(ngcall) - iv(ngcov) - write(pu,450) v(f), v(reldx), nf, ng, preldf, nreldf - 450 format(/9h function,d17.6,8h reldx,d17.3/12h func. evals, - 1 i8,9x,11hgrad. evals,i8/7h preldf,d16.3,6x,7hnpreldf,d15.3) -c - if (iv(nfcov) .gt. 0) write(pu,460) iv(nfcov) - 460 format(/1x,i4,50h extra func. evals for covariance and diagnost - 1ics.) - if (iv(ngcov) .gt. 0) write(pu,470) iv(ngcov) - 470 format(1x,i4,50h extra grad. evals for covariance and diagnosti - 1cs.) -c - 480 if (iv(solprt) .eq. 0) go to 999 - iv(needhd) = 1 - write(pu,490) - 490 format(/22h i final x(i),8x,4hd(i),10x,4hg(i)/) - do 500 i = 1, p - write(pu,510) i, x(i), d(i), g(i) - 500 continue - 510 format(1x,i5,d16.6,2d14.3) - go to 999 -c - 520 write(pu,530) - 530 format(/24h inconsistent dimensions) - 999 return -c *** last card of itsum follows *** - end - subroutine litvmu(n, x, l, y) -c -c *** solve (l**t)*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - integer i, ii, ij, im1, i0, j, np1 - double precision xi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 i = 1, n - 10 x(i) = y(i) - np1 = n + 1 - i0 = n*(n+1)/2 - do 30 ii = 1, n - i = np1 - ii - xi = x(i)/l(i0) - x(i) = xi - if (i .le. 1) go to 999 - i0 = i0 - i - if (xi .eq. zero) go to 30 - im1 = i - 1 - do 20 j = 1, im1 - ij = i0 + j - x(j) = x(j) - xi*l(ij) - 20 continue - 30 continue - 999 return -c *** last card of litvmu follows *** - end - subroutine livmul(n, x, l, y) -c -c *** solve l*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - external dotprd - double precision dotprd - integer i, j, k - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 k = 1, n - if (y(k) .ne. zero) go to 20 - x(k) = zero - 10 continue - go to 999 - 20 j = k*(k+1)/2 - x(k) = y(k) / l(j) - if (k .ge. n) go to 999 - k = k + 1 - do 30 i = k, n - t = dotprd(i-1, l(j+1), x) - j = j + i - x(i) = (y(i) - t)/l(j) - 30 continue - 999 return -c *** last card of livmul follows *** - end - subroutine parck(alg, d, iv, liv, lv, n, v) -c -c *** check ***sol (version 2.3) parameters, print changed values *** -c -c *** alg = 1 for regression, alg = 2 for general unconstrained opt. -c - integer alg, liv, lv, n - integer iv(liv) - double precision d(n), v(lv) -c - external rmdcon, vcopy, vdflt - double precision rmdcon -c rmdcon -- returns machine-dependent constants. -c vcopy -- copies one vector to another. -c vdflt -- supplies default parameter values to v alone. -c/+ - integer max0 -c/ -c -c *** local variables *** -c - integer i, ii, iv1, j, k, l, m, miv1, miv2, ndfalt, parsv1, pu - integer ijmp, jlim(2), miniv(2), ndflt(2) -c/6 -c integer varnm(2), sh(2) -c real cngd(3), dflt(3), vn(2,34), which(3) -c/7 - character*1 varnm(2), sh(2) - character*4 cngd(3), dflt(3), vn(2,34), which(3) -c/ - double precision big, machep, tiny, vk, vm(34), vx(34), zero -c -c *** iv and v subscripts *** -c - integer algsav, dinit, dtype, dtype0, epslon, inits, ivneed, - 1 lastiv, lastv, lmat, nextiv, nextv, nvdflt, oldn, - 2 parprt, parsav, perm, prunit, vneed -c -c -c/6 -c data algsav/51/, dinit/38/, dtype/16/, dtype0/54/, epslon/19/, -c 1 inits/25/, ivneed/3/, lastiv/44/, lastv/45/, lmat/42/, -c 2 nextiv/46/, nextv/47/, nvdflt/50/, oldn/38/, parprt/20/, -c 3 parsav/49/, perm/58/, prunit/21/, vneed/4/ -c/7 - parameter (algsav=51, dinit=38, dtype=16, dtype0=54, epslon=19, - 1 inits=25, ivneed=3, lastiv=44, lastv=45, lmat=42, - 2 nextiv=46, nextv=47, nvdflt=50, oldn=38, parprt=20, - 3 parsav=49, perm=58, prunit=21, vneed=4) - save big, machep, tiny -c/ -c - data big/0.d+0/, machep/-1.d+0/, tiny/1.d+0/, zero/0.d+0/ -c/6 -c data vn(1,1),vn(2,1)/4hepsl,4hon../ -c data vn(1,2),vn(2,2)/4hphmn,4hfc../ -c data vn(1,3),vn(2,3)/4hphmx,4hfc../ -c data vn(1,4),vn(2,4)/4hdecf,4hac../ -c data vn(1,5),vn(2,5)/4hincf,4hac../ -c data vn(1,6),vn(2,6)/4hrdfc,4hmn../ -c data vn(1,7),vn(2,7)/4hrdfc,4hmx../ -c data vn(1,8),vn(2,8)/4htune,4hr1../ -c data vn(1,9),vn(2,9)/4htune,4hr2../ -c data vn(1,10),vn(2,10)/4htune,4hr3../ -c data vn(1,11),vn(2,11)/4htune,4hr4../ -c data vn(1,12),vn(2,12)/4htune,4hr5../ -c data vn(1,13),vn(2,13)/4hafct,4hol../ -c data vn(1,14),vn(2,14)/4hrfct,4hol../ -c data vn(1,15),vn(2,15)/4hxcto,4hl.../ -c data vn(1,16),vn(2,16)/4hxfto,4hl.../ -c data vn(1,17),vn(2,17)/4hlmax,4h0.../ -c data vn(1,18),vn(2,18)/4hlmax,4hs.../ -c data vn(1,19),vn(2,19)/4hscto,4hl.../ -c data vn(1,20),vn(2,20)/4hdini,4ht.../ -c data vn(1,21),vn(2,21)/4hdtin,4hit../ -c data vn(1,22),vn(2,22)/4hd0in,4hit../ -c data vn(1,23),vn(2,23)/4hdfac,4h..../ -c data vn(1,24),vn(2,24)/4hdltf,4hdc../ -c data vn(1,25),vn(2,25)/4hdltf,4hdj../ -c data vn(1,26),vn(2,26)/4hdelt,4ha0../ -c data vn(1,27),vn(2,27)/4hfuzz,4h..../ -c data vn(1,28),vn(2,28)/4hrlim,4hit../ -c data vn(1,29),vn(2,29)/4hcosm,4hin../ -c data vn(1,30),vn(2,30)/4hhube,4hrc../ -c data vn(1,31),vn(2,31)/4hrspt,4hol../ -c data vn(1,32),vn(2,32)/4hsigm,4hin../ -c data vn(1,33),vn(2,33)/4heta0,4h..../ -c data vn(1,34),vn(2,34)/4hbias,4h..../ -c/7 - data vn(1,1),vn(2,1)/'epsl','on..'/ - data vn(1,2),vn(2,2)/'phmn','fc..'/ - data vn(1,3),vn(2,3)/'phmx','fc..'/ - data vn(1,4),vn(2,4)/'decf','ac..'/ - data vn(1,5),vn(2,5)/'incf','ac..'/ - data vn(1,6),vn(2,6)/'rdfc','mn..'/ - data vn(1,7),vn(2,7)/'rdfc','mx..'/ - data vn(1,8),vn(2,8)/'tune','r1..'/ - data vn(1,9),vn(2,9)/'tune','r2..'/ - data vn(1,10),vn(2,10)/'tune','r3..'/ - data vn(1,11),vn(2,11)/'tune','r4..'/ - data vn(1,12),vn(2,12)/'tune','r5..'/ - data vn(1,13),vn(2,13)/'afct','ol..'/ - data vn(1,14),vn(2,14)/'rfct','ol..'/ - data vn(1,15),vn(2,15)/'xcto','l...'/ - data vn(1,16),vn(2,16)/'xfto','l...'/ - data vn(1,17),vn(2,17)/'lmax','0...'/ - data vn(1,18),vn(2,18)/'lmax','s...'/ - data vn(1,19),vn(2,19)/'scto','l...'/ - data vn(1,20),vn(2,20)/'dini','t...'/ - data vn(1,21),vn(2,21)/'dtin','it..'/ - data vn(1,22),vn(2,22)/'d0in','it..'/ - data vn(1,23),vn(2,23)/'dfac','....'/ - data vn(1,24),vn(2,24)/'dltf','dc..'/ - data vn(1,25),vn(2,25)/'dltf','dj..'/ - data vn(1,26),vn(2,26)/'delt','a0..'/ - data vn(1,27),vn(2,27)/'fuzz','....'/ - data vn(1,28),vn(2,28)/'rlim','it..'/ - data vn(1,29),vn(2,29)/'cosm','in..'/ - data vn(1,30),vn(2,30)/'hube','rc..'/ - data vn(1,31),vn(2,31)/'rspt','ol..'/ - data vn(1,32),vn(2,32)/'sigm','in..'/ - data vn(1,33),vn(2,33)/'eta0','....'/ - data vn(1,34),vn(2,34)/'bias','....'/ -c/ -c - data vm(1)/1.0d-3/, vm(2)/-0.99d+0/, vm(3)/1.0d-3/, vm(4)/1.0d-2/, - 1 vm(5)/1.2d+0/, vm(6)/1.d-2/, vm(7)/1.2d+0/, vm(8)/0.d+0/, - 2 vm(9)/0.d+0/, vm(10)/1.d-3/, vm(11)/-1.d+0/, vm(13)/0.d+0/, - 3 vm(15)/0.d+0/, vm(16)/0.d+0/, vm(19)/0.d+0/, vm(20)/-10.d+0/, - 4 vm(21)/0.d+0/, vm(22)/0.d+0/, vm(23)/0.d+0/, vm(27)/1.01d+0/, - 5 vm(28)/1.d+10/, vm(30)/0.d+0/, vm(31)/0.d+0/, vm(32)/0.d+0/, - 6 vm(34)/0.d+0/ - data vx(1)/0.9d+0/, vx(2)/-1.d-3/, vx(3)/1.d+1/, vx(4)/0.8d+0/, - 1 vx(5)/1.d+2/, vx(6)/0.8d+0/, vx(7)/1.d+2/, vx(8)/0.5d+0/, - 2 vx(9)/0.5d+0/, vx(10)/1.d+0/, vx(11)/1.d+0/, vx(14)/0.1d+0/, - 3 vx(15)/1.d+0/, vx(16)/1.d+0/, vx(19)/1.d+0/, vx(23)/1.d+0/, - 4 vx(24)/1.d+0/, vx(25)/1.d+0/, vx(26)/1.d+0/, vx(27)/1.d+10/, - 5 vx(29)/1.d+0/, vx(31)/1.d+0/, vx(32)/1.d+0/, vx(33)/1.d+0/, - 6 vx(34)/1.d+0/ -c -c/6 -c data varnm(1)/1hp/, varnm(2)/1hn/, sh(1)/1hs/, sh(2)/1hh/ -c data cngd(1),cngd(2),cngd(3)/4h---c,4hhang,4hed v/, -c 1 dflt(1),dflt(2),dflt(3)/4hnond,4hefau,4hlt v/ -c/7 - data varnm(1)/'p'/, varnm(2)/'n'/, sh(1)/'s'/, sh(2)/'h'/ - data cngd(1),cngd(2),cngd(3)/'---c','hang','ed v'/, - 1 dflt(1),dflt(2),dflt(3)/'nond','efau','lt v'/ -c/ - data ijmp/33/, jlim(1)/0/, jlim(2)/24/, ndflt(1)/32/, ndflt(2)/25/ - data miniv(1)/80/, miniv(2)/59/ -c -c............................... body ................................ -c - pu = 0 - if (prunit .le. liv) pu = iv(prunit) - if (alg .lt. 1 .or. alg .gt. 2) go to 340 - if (iv(1) .eq. 0) call deflt(alg, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .ne. 13 .and. iv1 .ne. 12) go to 10 - miv1 = miniv(alg) - if (perm .le. liv) miv1 = max0(miv1, iv(perm) - 1) - if (ivneed .le. liv) miv2 = miv1 + max0(iv(ivneed), 0) - if (lastiv .le. liv) iv(lastiv) = miv2 - if (liv .lt. miv1) go to 300 - iv(ivneed) = 0 - iv(lastv) = max0(iv(vneed), 0) + iv(lmat) - 1 - iv(vneed) = 0 - if (liv .lt. miv2) go to 300 - if (lv .lt. iv(lastv)) go to 320 - 10 if (alg .eq. iv(algsav)) go to 30 - if (pu .ne. 0) write(pu,20) alg, iv(algsav) - 20 format(/39h the first parameter to deflt should be,i3, - 1 12h rather than,i3) - iv(1) = 82 - go to 999 - 30 if (iv1 .lt. 12 .or. iv1 .gt. 14) go to 60 - if (n .ge. 1) go to 50 - iv(1) = 81 - if (pu .eq. 0) go to 999 - write(pu,40) varnm(alg), n - 40 format(/8h /// bad,a1,2h =,i5) - go to 999 - 50 if (iv1 .ne. 14) iv(nextiv) = iv(perm) - if (iv1 .ne. 14) iv(nextv) = iv(lmat) - if (iv1 .eq. 13) go to 999 - k = iv(parsav) - epslon - call vdflt(alg, lv-k, v(k+1)) - iv(dtype0) = 2 - alg - iv(oldn) = n - which(1) = dflt(1) - which(2) = dflt(2) - which(3) = dflt(3) - go to 110 - 60 if (n .eq. iv(oldn)) go to 80 - iv(1) = 17 - if (pu .eq. 0) go to 999 - write(pu,70) varnm(alg), iv(oldn), n - 70 format(/5h /// ,1a1,14h changed from ,i5,4h to ,i5) - go to 999 -c - 80 if (iv1 .le. 11 .and. iv1 .ge. 1) go to 100 - iv(1) = 80 - if (pu .ne. 0) write(pu,90) iv1 - 90 format(/13h /// iv(1) =,i5,28h should be between 0 and 14.) - go to 999 -c - 100 which(1) = cngd(1) - which(2) = cngd(2) - which(3) = cngd(3) -c - 110 if (iv1 .eq. 14) iv1 = 12 - if (big .gt. tiny) go to 120 - tiny = rmdcon(1) - machep = rmdcon(3) - big = rmdcon(6) - vm(12) = machep - vx(12) = big - vx(13) = big - vm(14) = machep - vm(17) = tiny - vx(17) = big - vm(18) = tiny - vx(18) = big - vx(20) = big - vx(21) = big - vx(22) = big - vm(24) = machep - vm(25) = machep - vm(26) = machep - vx(28) = rmdcon(5) - vm(29) = machep - vx(30) = big - vm(33) = machep - 120 m = 0 - i = 1 - j = jlim(alg) - k = epslon - ndfalt = ndflt(alg) - do 150 l = 1, ndfalt - vk = v(k) - if (vk .ge. vm(i) .and. vk .le. vx(i)) go to 140 - m = k - if (pu .ne. 0) write(pu,130) vn(1,i), vn(2,i), k, vk, - 1 vm(i), vx(i) - 130 format(/6h /// ,2a4,5h.. v(,i2,3h) =,d11.3,7h should, - 1 11h be between,d11.3,4h and,d11.3) - 140 k = k + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 150 continue -c - if (iv(nvdflt) .eq. ndfalt) go to 170 - iv(1) = 51 - if (pu .eq. 0) go to 999 - write(pu,160) iv(nvdflt), ndfalt - 160 format(/13h iv(nvdflt) =,i5,13h rather than ,i5) - go to 999 - 170 if ((iv(dtype) .gt. 0 .or. v(dinit) .gt. zero) .and. iv1 .eq. 12) - 1 go to 200 - do 190 i = 1, n - if (d(i) .gt. zero) go to 190 - m = 18 - if (pu .ne. 0) write(pu,180) i, d(i) - 180 format(/8h /// d(,i3,3h) =,d11.3,19h should be positive) - 190 continue - 200 if (m .eq. 0) go to 210 - iv(1) = m - go to 999 -c - 210 if (pu .eq. 0 .or. iv(parprt) .eq. 0) go to 999 - if (iv1 .ne. 12 .or. iv(inits) .eq. alg-1) go to 230 - m = 1 - write(pu,220) sh(alg), iv(inits) - 220 format(/22h nondefault values..../5h init,a1,14h..... iv(25) =, - 1 i3) - 230 if (iv(dtype) .eq. iv(dtype0)) go to 250 - if (m .eq. 0) write(pu,260) which - m = 1 - write(pu,240) iv(dtype) - 240 format(20h dtype..... iv(16) =,i3) - 250 i = 1 - j = jlim(alg) - k = epslon - l = iv(parsav) - ndfalt = ndflt(alg) - do 290 ii = 1, ndfalt - if (v(k) .eq. v(l)) go to 280 - if (m .eq. 0) write(pu,260) which - 260 format(/1h ,3a4,9halues..../) - m = 1 - write(pu,270) vn(1,i), vn(2,i), k, v(k) - 270 format(1x,2a4,5h.. v(,i2,3h) =,d15.7) - 280 k = k + 1 - l = l + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 290 continue -c - iv(dtype0) = iv(dtype) - parsv1 = iv(parsav) - call vcopy(iv(nvdflt), v(parsv1), v(epslon)) - go to 999 -c - 300 iv(1) = 15 - if (pu .eq. 0) go to 999 - write(pu,310) liv, miv2 - 310 format(/10h /// liv =,i5,17h must be at least,i5) - if (liv .lt. miv1) go to 999 - if (lv .lt. iv(lastv)) go to 320 - go to 999 -c - 320 iv(1) = 16 - if (pu .eq. 0) go to 999 - write(pu,330) lv, iv(lastv) - 330 format(/9h /// lv =,i5,17h must be at least,i5) - go to 999 -c - 340 iv(1) = 67 - if (pu .eq. 0) go to 999 - write(pu,350) alg - 350 format(/10h /// alg =,i5,15h must be 1 or 2) -c - 999 return -c *** last card of parck follows *** - end - double precision function reldst(p, d, x, x0) -c -c *** compute and return relative difference between x and x0 *** -c *** nl2sol version 2.2 *** -c - integer p - double precision d(p), x(p), x0(p) -c/+ - double precision dabs -c/ - integer i - double precision emax, t, xmax, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - emax = zero - xmax = zero - do 10 i = 1, p - t = dabs(d(i) * (x(i) - x0(i))) - if (emax .lt. t) emax = t - t = d(i) * (dabs(x(i)) + dabs(x0(i))) - if (xmax .lt. t) xmax = t - 10 continue - reldst = zero - if (xmax .gt. zero) reldst = emax / xmax - 999 return -c *** last card of reldst follows *** - end -c logical function stopx(idummy) -c *****parameters... -c integer idummy -c -c .................................................................. -c -c *****purpose... -c this function may serve as the stopx (asynchronous interruption) -c function for the nl2sol (nonlinear least-squares) package at -c those installations which do not wish to implement a -c dynamic stopx. -c -c *****algorithm notes... -c at installations where the nl2sol system is used -c interactively, this dummy stopx should be replaced by a -c function that returns .true. if and only if the interrupt -c (break) key has been pressed since the last call on stopx. -c -c .................................................................. -c -c stopx = .false. -c return -c end - subroutine vaxpy(p, w, a, x, y) -c -c *** set w = a*x + y -- w, x, y = p-vectors, a = scalar *** -c - integer p - double precision a, w(p), x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 w(i) = a*x(i) + y(i) - return - end - subroutine vcopy(p, y, x) -c -c *** set y = x, where x and y are p-vectors *** -c - integer p - double precision x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = x(i) - return - end - subroutine vdflt(alg, lv, v) -c -c *** supply ***sol (version 2.3) default values to v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer alg, l - double precision v(lv) -c/+ - double precision dmax1 -c/ - external rmdcon - double precision rmdcon -c rmdcon... returns machine-dependent constants -c - double precision machep, mepcrt, one, sqteps, three -c -c *** subscripts for v *** -c - integer afctol, bias, cosmin, decfac, delta0, dfac, dinit, dltfdc, - 1 dltfdj, dtinit, d0init, epslon, eta0, fuzz, huberc, - 2 incfac, lmax0, lmaxs, phmnfc, phmxfc, rdfcmn, rdfcmx, - 3 rfctol, rlimit, rsptol, sctol, sigmin, tuner1, tuner2, - 4 tuner3, tuner4, tuner5, xctol, xftol -c -c/6 -c data one/1.d+0/, three/3.d+0/ -c/7 - parameter (one=1.d+0, three=3.d+0) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/, bias/43/, cosmin/47/, decfac/22/, delta0/44/, -c 1 dfac/41/, dinit/38/, dltfdc/42/, dltfdj/43/, dtinit/39/, -c 2 d0init/40/, epslon/19/, eta0/42/, fuzz/45/, huberc/48/, -c 3 incfac/23/, lmax0/35/, lmaxs/36/, phmnfc/20/, phmxfc/21/, -c 4 rdfcmn/24/, rdfcmx/25/, rfctol/32/, rlimit/46/, rsptol/49/, -c 5 sctol/37/, sigmin/50/, tuner1/26/, tuner2/27/, tuner3/28/, -c 6 tuner4/29/, tuner5/30/, xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, bias=43, cosmin=47, decfac=22, delta0=44, - 1 dfac=41, dinit=38, dltfdc=42, dltfdj=43, dtinit=39, - 2 d0init=40, epslon=19, eta0=42, fuzz=45, huberc=48, - 3 incfac=23, lmax0=35, lmaxs=36, phmnfc=20, phmxfc=21, - 4 rdfcmn=24, rdfcmx=25, rfctol=32, rlimit=46, rsptol=49, - 5 sctol=37, sigmin=50, tuner1=26, tuner2=27, tuner3=28, - 6 tuner4=29, tuner5=30, xctol=33, xftol=34) -c/ -c -c------------------------------- body -------------------------------- -c - machep = rmdcon(3) - v(afctol) = 1.d-20 - if (machep .gt. 1.d-10) v(afctol) = machep**2 - v(decfac) = 0.5d+0 - sqteps = rmdcon(4) - v(dfac) = 0.6d+0 - v(delta0) = sqteps - v(dtinit) = 1.d-6 - mepcrt = machep ** (one/three) - v(d0init) = 1.d+0 - v(epslon) = 0.1d+0 - v(incfac) = 2.d+0 - v(lmax0) = 1.d+0 - v(lmaxs) = 1.d+0 - v(phmnfc) = -0.1d+0 - v(phmxfc) = 0.1d+0 - v(rdfcmn) = 0.1d+0 - v(rdfcmx) = 4.d+0 - v(rfctol) = dmax1(1.d-10, mepcrt**2) - v(sctol) = v(rfctol) - v(tuner1) = 0.1d+0 - v(tuner2) = 1.d-4 - v(tuner3) = 0.75d+0 - v(tuner4) = 0.5d+0 - v(tuner5) = 0.75d+0 - v(xctol) = sqteps - v(xftol) = 1.d+2 * machep -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - v(cosmin) = dmax1(1.d-6, 1.d+2 * machep) - v(dinit) = 0.d+0 - v(dltfdc) = mepcrt - v(dltfdj) = sqteps - v(fuzz) = 1.5d+0 - v(huberc) = 0.7d+0 - v(rlimit) = rmdcon(5) - v(rsptol) = 1.d-3 - v(sigmin) = 1.d-4 - go to 999 -c -c *** general optimization values -c - 10 v(bias) = 0.8d+0 - v(dinit) = -1.0d+0 - v(eta0) = 1.0d+3 * machep -c - 999 return -c *** last card of vdflt follows *** - end - subroutine vscopy(p, y, s) -c -c *** set p-vector y to scalar s *** -c - integer p - double precision s, y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = s - return - end - double precision function v2norm(p, x) -c -c *** return the 2-norm of the p-vector x, taking *** -c *** care to avoid the most likely underflows. *** -c - integer p - double precision x(p) -c - integer i, j - double precision one, r, scale, sqteta, t, xi, zero -c/+ - double precision dabs, dsqrt -c/ - external rmdcon - double precision rmdcon -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - save sqteta -c/ - data sqteta/0.d+0/ -c - if (p .gt. 0) go to 10 - v2norm = zero - go to 999 - 10 do 20 i = 1, p - if (x(i) .ne. zero) go to 30 - 20 continue - v2norm = zero - go to 999 -c - 30 scale = dabs(x(i)) - if (i .lt. p) go to 40 - v2norm = scale - go to 999 - 40 t = one - if (sqteta .eq. zero) sqteta = rmdcon(2) -c -c *** sqteta is (slightly larger than) the square root of the -c *** smallest positive floating point number on the machine. -c *** the tests involving sqteta are done to prevent underflows. -c - j = i + 1 - do 60 i = j, p - xi = dabs(x(i)) - if (xi .gt. scale) go to 50 - r = xi / scale - if (r .gt. sqteta) t = t + r*r - go to 60 - 50 r = scale / xi - if (r .le. sqteta) r = zero - t = one + t * r*r - scale = xi - 60 continue -c - v2norm = scale * dsqrt(t) - 999 return -c *** last card of v2norm follows *** - end - subroutine humsl(n, d, x, calcf, calcgh, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** (analytic) gradient and hessian provided by the caller. *** -c - integer liv, lv, n - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(78 + n*(n+12)), uiparm(*), urparm(*) - external calcf, calcgh, ufparm -c -c------------------------------ discussion --------------------------- -c -c this routine is like sumsl, except that the subroutine para- -c meter calcg of sumsl (which computes the gradient of the objec- -c tive function) is replaced by the subroutine parameter calcgh, -c which computes both the gradient and (lower triangle of the) -c hessian of the objective function. the calling sequence is... -c call calcgh(n, x, nf, g, h, uiparm, urparm, ufparm) -c parameters n, x, nf, g, uiparm, urparm, and ufparm are the same -c as for sumsl, while h is an array of length n*(n+1)/2 in which -c calcgh must store the lower triangle of the hessian at x. start- -c ing at h(1), calcgh must store the hessian entries in the order -c (1,1), (2,1), (2,2), (3,1), (3,2), (3,3), ... -c the value printed (by itsum) in the column labelled stppar -c is the levenberg-marquardt used in computing the current step. -c zero means a full newton step. if the special case described in -c ref. 1 is detected, then stppar is negated. the value printed -c in the column labelled npreldf is zero if the current hessian -c is not positive definite. -c it sometimes proves worthwhile to let d be determined from the -c diagonal of the hessian matrix by setting iv(dtype) = 1 and -c v(dinit) = 0. the following iv and v components are relevant... -c -c iv(dtol)..... iv(59) gives the starting subscript in v of the dtol -c array used when d is updated. (iv(dtol) can be -c initialized by calling humsl with iv(1) = 13.) -c iv(dtype).... iv(16) tells how the scale vector d should be chosen. -c iv(dtype) .le. 0 means that d should not be updated, and -c iv(dtype) .ge. 1 means that d should be updated as -c described below with v(dfac). default = 0. -c v(dfac)..... v(41) and the dtol and d0 arrays (see v(dtinit) and -c v(d0init)) are used in updating the scale vector d when -c iv(dtype) .gt. 0. (d is initialized according to -c v(dinit), described in sumsl.) let -c d1(i) = max(sqrt(abs(h(i,i))), v(dfac)*d(i)), -c where h(i,i) is the i-th diagonal element of the current -c hessian. if iv(dtype) = 1, then d(i) is set to d1(i) -c unless d1(i) .lt. dtol(i), in which case d(i) is set to -c max(d0(i), dtol(i)). -c if iv(dtype) .ge. 2, then d is updated during the first -c iteration as for iv(dtype) = 1 (after any initialization -c due to v(dinit)) and is left unchanged thereafter. -c default = 0.6. -c v(dtinit)... v(39), if positive, is the value to which all components -c of the dtol array (see v(dfac)) are initialized. if -c v(dtinit) = 0, then it is assumed that the caller has -c stored dtol in v starting at v(iv(dtol)). -c default = 10**-6. -c v(d0init)... v(40), if positive, is the value to which all components -c of the d0 vector (see v(dfac)) are initialized. if -c v(dfac) = 0, then it is assumed that the caller has -c stored d0 in v starting at v(iv(dtol)+n). default = 1.0. -c -c *** reference *** -c -c 1. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. comput. 2, pp. 186-197. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c---------------------------- declarations --------------------------- -c - external deflt, humit -c -c deflt... provides default input values for iv and v. -c humit... reverse-communication routine that does humsl algorithm. -c - integer g1, h1, iv1, lh, nf - double precision f -c -c *** subscripts for iv *** -c - integer g, h, nextv, nfcall, nfgcal, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, h/56/, toobig/2/, -c 1 vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, h=56, toobig=2, - 1 vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - lh = n * (n + 1) / 2 - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+3)/2 - iv1 = iv(1) - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - h1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) - h1 = iv(h) -c - 20 call humit(d, f, v(g1), v(h1), iv, lh, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcgh(n, x, iv(nfgcal), v(g1), v(h1), uiparm, urparm, - 1 ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(h) = iv(g) + n - iv(nextv) = iv(h) + n*(n+1)/2 - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of humsl follows *** - end - subroutine humit(d, fx, g, h, iv, lh, liv, lv, n, v, x) -c -c *** carry out humsl (unconstrained minimization) iterations, using -c *** hessian matrix provided by the caller. -c -c *** parameter declarations *** -c - integer lh, liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), h(lh), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c h.... lower triangle of the hessian, stored rowwise. -c iv... integer value array. -c lh... length of h = p*(p+1)/2. -c liv.. length of iv (at least 60). -c lv... length of v (at least 78 + n*(n+21)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... parameter vector. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to humsl (which see), except that v can be shorter (since -c the part of v that humsl uses for storing g and h is not needed). -c moreover, compared with humsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from humsl, is not referenced by humit or the -c subroutines it calls. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call humit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c computed (e.g. if overflow would occur), which may happen -c because of an oversized step. in this case the caller -c should set iv(toobig) = iv(2) to 1, which will cause -c humit to ignore fx and try a smaller step. the para- -c meter nf that humsl passes to calcf (for possible use by -c calcgh) is a copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient of f at -c x, and h to the lower triangle of h(x), the hessian of f -c at x, and call humit again, having changed none of the -c other parameters except perhaps the scale vector d. -c the parameter nf that humsl passes to calcg is -c iv(nfgcal) = iv(7). if g(x) and h(x) cannot be evaluated, -c then the caller may set iv(nfgcal) to 0, in which case -c humit will return with iv(1) = 65. -c note -- humit overwrites h with the lower triangle -c of diag(d)**-1 * h(x) * diag(d)**-1. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl and humsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, i, j, k, l, lstgst, nn1o2, step1, - 1 temp1, w1, x01 - double precision t -c -c *** constants *** -c - double precision one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, deflt, dotprd, dupdu, gqtst, itsum, parck, - 1 reldst, slvmul, stopx, vaxpy, vcopy, vscopy, v2norm - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c deflt.... provides default iv and v input values. -c dotprd... returns inner product of two vectors. -c dupdu.... updates scale vector d. -c gqtst.... computes optimally locally constrained step. -c itsum.... prints iteration summary and info on initial and final x. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c slvmul... multiplies symmetric matrix times vector, given the lower -c triangle of the matrix. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c v2norm... returns the 2-norm of a vector. -c -c *** subscripts for iv and v *** -c - integer cnvcod, dg, dgnorm, dinit, dstnrm, dtinit, dtol, - 1 dtype, d0init, f, f0, fdif, gtstep, incfac, irc, kagqt, - 2 lmat, lmax0, lmaxs, mode, model, mxfcal, mxiter, nextv, - 3 nfcall, nfgcal, ngcall, niter, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, stppar, - 5 toobig, tuner4, tuner5, vneed, w, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, dtol/59/, dtype/16/, irc/29/, kagqt/33/, -c 1 lmat/42/, mode/35/, model/5/, mxfcal/17/, mxiter/18/, -c 2 nextv/47/, nfcall/6/, nfgcal/7/, ngcall/30/, niter/31/, -c 3 radinc/8/, restor/9/, step/40/, stglim/11/, stlstg/41/, -c 4 toobig/2/, vneed/4/, w/34/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, dtol=59, dtype=16, irc=29, kagqt=33, - 1 lmat=42, mode=35, model=5, mxfcal=17, mxiter=18, - 2 nextv=47, nfcall=6, nfgcal=7, ngcall=30, niter=31, - 3 radinc=8, restor=9, step=40, stglim=11, stlstg=41, - 4 toobig=2, vneed=4, w=34, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data dgnorm/1/, dinit/38/, dstnrm/2/, dtinit/39/, d0init/40/, -c 1 f/10/, f0/13/, fdif/11/, gtstep/4/, incfac/23/, lmax0/35/, -c 2 lmaxs/36/, preduc/7/, radfac/16/, radius/8/, rad0/9/, -c 3 reldx/17/, stppar/5/, tuner4/29/, tuner5/30/ -c/7 - parameter (dgnorm=1, dinit=38, dstnrm=2, dtinit=39, d0init=40, - 1 f=10, f0=13, fdif=11, gtstep=4, incfac=23, lmax0=35, - 2 lmaxs=36, preduc=7, radfac=16, radius=8, rad0=9, - 3 reldx=17, stppar=5, tuner4=29, tuner5=30) -c/ -c -c/6 -c data one/1.d+0/, onep2/1.2d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, onep2=1.2d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - i = iv(1) - if (i .eq. 1) go to 30 - if (i .eq. 2) go to 40 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+21)/2 + 7 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - nn1o2 = n * (n + 1) / 2 - if (lh .ge. nn1o2) go to (210,210,210,210,210,210,160,120,160, - 1 10,10,20), i - iv(1) = 66 - go to 350 -c -c *** storage allocation *** -c - 10 iv(dtol) = iv(lmat) + nn1o2 - iv(x0) = iv(dtol) + 2*n - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(dg) = iv(stlstg) + n - iv(w) = iv(dg) + n - iv(nextv) = iv(w) + 4*n + 7 - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - v(stppar) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - k = iv(dtol) - if (v(dtinit) .gt. zero) call vscopy(n, v(k), v(dtinit)) - k = k + n - if (v(d0init) .gt. zero) call vscopy(n, v(k), v(d0init)) - iv(1) = 1 - go to 999 -c - 30 v(f) = fx - if (iv(mode) .ge. 0) go to 210 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 350 -c -c *** make sure gradient could be computed *** -c - 40 if (iv(nfgcal) .ne. 0) go to 50 - iv(1) = 65 - go to 350 -c -c *** update the scale vector d *** -c - 50 dg1 = iv(dg) - if (iv(dtype) .le. 0) go to 70 - k = dg1 - j = 0 - do 60 i = 1, n - j = j + i - v(k) = h(j) - k = k + 1 - 60 continue - call dupdu(d, v(dg1), iv, liv, lv, n, v) -c -c *** compute scaled gradient and its norm *** -c - 70 dg1 = iv(dg) - k = dg1 - do 80 i = 1, n - v(k) = g(i) / d(i) - k = k + 1 - 80 continue - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** compute scaled hessian *** -c - k = 1 - do 100 i = 1, n - t = one / d(i) - do 90 j = 1, i - h(k) = t * h(k) / d(j) - k = k + 1 - 90 continue - 100 continue -c - if (iv(cnvcod) .ne. 0) go to 340 - if (iv(mode) .eq. 0) go to 300 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 110 call itsum(d, g, iv, liv, lv, n, v, x) - 120 k = iv(niter) - if (k .lt. iv(mxiter)) go to 130 - iv(1) = 10 - go to 350 -c - 130 iv(niter) = k + 1 -c -c *** initialize for start of next iteration *** -c - dg1 = iv(dg) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0 *** -c - call vcopy(n, v(x01), x) -c -c *** update radius *** -c - if (k .eq. 0) go to 150 - step1 = iv(step) - k = step1 - do 140 i = 1, n - v(k) = d(i) * v(k) - k = k + 1 - 140 continue - v(radius) = v(radfac) * v2norm(n, v(step1)) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 150 if (.not. stopx(dummy)) go to 170 - iv(1) = 11 - go to 180 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 160 if (v(f) .ge. v(f0)) go to 170 - v(radfac) = one - k = iv(niter) - go to 130 -c - 170 if (iv(nfcall) .lt. iv(mxfcal)) go to 190 - iv(1) = 9 - 180 if (v(f) .ge. v(f0)) go to 350 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 290 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 190 step1 = iv(step) - dg1 = iv(dg) - l = iv(lmat) - w1 = iv(w) - call gqtst(d, v(dg1), h, iv(kagqt), v(l), n, v(step1), v, v(w1)) - if (iv(irc) .eq. 6) go to 210 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 210 - if (iv(irc) .ne. 5) go to 200 - if (v(radfac) .le. one) go to 200 - if (v(preduc) .le. onep2 * v(fdif)) go to 210 -c -c *** compute f(x0 + step) *** -c - 200 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 210 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 220 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 220 k = iv(irc) - go to (230,260,260,260,230,240,250,250,250,250,250,250,330,300), k -c -c *** recompute step with new radius *** -c - 230 v(radius) = v(radfac) * v(dstnrm) - go to 150 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 240 v(radius) = v(lmaxs) - go to 190 -c -c *** convergence or false convergence *** -c - 250 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 340 - if (iv(xirc) .eq. 14) go to 340 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 260 if (iv(irc) .ne. 3) go to 290 - temp1 = lstgst -c -c *** prepare for gradient tests *** -c *** set temp1 = hessian * step + g(x0) -c *** = diag(d) * (h * step + g(x0)) -c -c use x0 vector as temporary. - k = x01 - do 270 i = 1, n - v(k) = d(i) * v(step1) - k = k + 1 - step1 = step1 + 1 - 270 continue - call slvmul(n, v(temp1), h, v(x01)) - do 280 i = 1, n - v(temp1) = d(i) * v(temp1) + g(i) - temp1 = temp1 + 1 - 280 continue -c -c *** compute gradient and hessian *** -c - 290 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c - 300 iv(1) = 2 - if (iv(irc) .ne. 3) go to 110 -c -c *** set v(radfac) by gradient tests *** -c - temp1 = iv(stlstg) - step1 = iv(step) -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - k = temp1 - do 310 i = 1, n - v(k) = (v(k) - g(i)) / d(i) - k = k + 1 - 310 continue -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) go to 320 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 110 - 320 v(radfac) = v(incfac) - go to 110 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 330 iv(1) = 64 - go to 350 -c -c *** print summary of final iteration and other requested items *** -c - 340 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 350 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last card of humit follows *** - end - subroutine dupdu(d, hdiag, iv, liv, lv, n, v) -c -c *** update scale vector d for humsl *** -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), hdiag(n), v(lv) -c -c *** local variables *** -c - integer dtoli, d0i, i - double precision t, vdfac -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dsqrt -c/ -c *** subscripts for iv and v *** -c - integer dfac, dtol, dtype, niter -c/6 -c data dfac/41/, dtol/59/, dtype/16/, niter/31/ -c/7 - parameter (dfac=41, dtol=59, dtype=16, niter=31) -c/ -c -c------------------------------- body -------------------------------- -c - i = iv(dtype) - if (i .eq. 1) go to 10 - if (iv(niter) .gt. 0) go to 999 -c - 10 dtoli = iv(dtol) - d0i = dtoli + n - vdfac = v(dfac) - do 20 i = 1, n - t = dmax1(dsqrt(dabs(hdiag(i))), vdfac*d(i)) - if (t .lt. v(dtoli)) t = dmax1(v(dtoli), v(d0i)) - d(i) = t - dtoli = dtoli + 1 - d0i = d0i + 1 - 20 continue -c - 999 return -c *** last card of dupdu follows *** - end - subroutine gqtst(d, dig, dihdi, ka, l, p, step, v, w) -c -c *** compute goldfeld-quandt-trotter step by more-hebden technique *** -c *** (nl2sol version 2.2), modified a la more and sorensen *** -c -c *** parameter declarations *** -c - integer ka, p -cal double precision d(p), dig(p), dihdi(1), l(1), v(21), step(p), -cal 1 w(1) - double precision d(p), dig(p), dihdi(p*(p+1)/2), l(p*(p+1)/2), - 1 v(21), step(p),w(4*p+7) -c dimension dihdi(p*(p+1)/2), l(p*(p+1)/2), w(4*p+7) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c given the (compactly stored) lower triangle of a scaled -c hessian (approximation) and a nonzero scaled gradient vector, -c this subroutine computes a goldfeld-quandt-trotter step of -c approximate length v(radius) by the more-hebden technique. in -c other words, step is computed to (approximately) minimize -c psi(step) = (g**t)*step + 0.5*(step**t)*h*step such that the -c 2-norm of d*step is at most (approximately) v(radius), where -c g is the gradient, h is the hessian, and d is a diagonal -c scale matrix whose diagonal is stored in the parameter d. -c (gqtst assumes dig = d**-1 * g and dihdi = d**-1 * h * d**-1.) -c -c *** parameter description *** -c -c d (in) = the scale vector, i.e. the diagonal of the scale -c matrix d mentioned above under purpose. -c dig (in) = the scaled gradient vector, d**-1 * g. if g = 0, then -c step = 0 and v(stppar) = 0 are returned. -c dihdi (in) = lower triangle of the scaled hessian (approximation), -c i.e., d**-1 * h * d**-1, stored compactly by rows., i.e., -c in the order (1,1), (2,1), (2,2), (3,1), (3,2), etc. -c ka (i/o) = the number of hebden iterations (so far) taken to deter- -c mine step. ka .lt. 0 on input means this is the first -c attempt to determine step (for the present dig and dihdi) -c -- ka is initialized to 0 in this case. output with -c ka = 0 (or v(stppar) = 0) means step = -(h**-1)*g. -c l (i/o) = workspace of length p*(p+1)/2 for cholesky factors. -c p (in) = number of parameters -- the hessian is a p x p matrix. -c step (i/o) = the step computed. -c v (i/o) contains various constants and variables described below. -c w (i/o) = workspace of length 4*p + 6. -c -c *** entries in v *** -c -c v(dgnorm) (i/o) = 2-norm of (d**-1)*g. -c v(dstnrm) (output) = 2-norm of d*step. -c v(dst0) (i/o) = 2-norm of d*(h**-1)*g (for pos. def. h only), or -c overestimate of smallest eigenvalue of (d**-1)*h*(d**-1). -c v(epslon) (in) = max. rel. error allowed for psi(step). for the -c step returned, psi(step) will exceed its optimal value -c by less than -v(epslon)*psi(step). suggested value = 0.1. -c v(gtstep) (out) = inner product between g and step. -c v(nreduc) (out) = psi(-(h**-1)*g) = psi(newton step) (for pos. def. -c h only -- v(nreduc) is set to zero otherwise). -c v(phmnfc) (in) = tol. (together with v(phmxfc)) for accepting step -c (more*s sigma). the error v(dstnrm) - v(radius) must lie -c between v(phmnfc)*v(radius) and v(phmxfc)*v(radius). -c v(phmxfc) (in) (see v(phmnfc).) -c suggested values -- v(phmnfc) = -0.25, v(phmxfc) = 0.5. -c v(preduc) (out) = psi(step) = predicted obj. func. reduction for step. -c v(radius) (in) = radius of current (scaled) trust region. -c v(rad0) (i/o) = value of v(radius) from previous call. -c v(stppar) (i/o) is normally the marquardt parameter, i.e. the alpha -c described below under algorithm notes. if h + alpha*d**2 -c (see algorithm notes) is (nearly) singular, however, -c then v(stppar) = -alpha. -c -c *** usage notes *** -c -c if it is desired to recompute step using a different value of -c v(radius), then this routine may be restarted by calling it -c with all parameters unchanged except v(radius). (this explains -c why step and w are listed as i/o). on an initial call (one with -c ka .lt. 0), step and w need not be initialized and only compo- -c nents v(epslon), v(stppar), v(phmnfc), v(phmxfc), v(radius), and -c v(rad0) of v must be initialized. -c -c *** algorithm notes *** -c -c the desired g-q-t step (ref. 2, 3, 4, 6) satisfies -c (h + alpha*d**2)*step = -g for some nonnegative alpha such that -c h + alpha*d**2 is positive semidefinite. alpha and step are -c computed by a scheme analogous to the one described in ref. 5. -c estimates of the smallest and largest eigenvalues of the hessian -c are obtained from the gerschgorin circle theorem enhanced by a -c simple form of the scaling described in ref. 7. cases in which -c h + alpha*d**2 is nearly (or exactly) singular are handled by -c the technique discussed in ref. 2. in these cases, a step of -c (exact) length v(radius) is returned for which psi(step) exceeds -c its optimal value by less than -v(epslon)*psi(step). the test -c suggested in ref. 6 for detecting the special case is performed -c once two matrix factorizations have been done -- doing so sooner -c seems to degrade the performance of optimization routines that -c call this routine. -c -c *** functions and subroutines called *** -c -c dotprd - returns inner product of two vectors. -c litvmu - applies inverse-transpose of compact lower triang. matrix. -c livmul - applies inverse of compact lower triang. matrix. -c lsqrt - finds cholesky factor (of compactly stored lower triang.). -c lsvmin - returns approx. to min. sing. value of lower triang. matrix. -c rmdcon - returns machine-dependent constants. -c v2norm - returns 2-norm of a vector. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), an adaptive -c nonlinear least-squares algorithm, acm trans. math. -c software, vol. 7, no. 3. -c 2. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. computing, vol. 2, no. 2, pp. -c 186-197. -c 3. goldfeld, s.m., quandt, r.e., and trotter, h.f. (1966), -c maximization by quadratic hill-climbing, econometrica 34, -c pp. 541-551. -c 4. hebden, m.d. (1973), an algorithm for minimization using exact -c second derivatives, report t.p. 515, theoretical physics -c div., a.e.r.e. harwell, oxon., england. -c 5. more, j.j. (1978), the levenberg-marquardt algorithm, implemen- -c tation and theory, pp.105-116 of springer lecture notes -c in mathematics no. 630, edited by g.a. watson, springer- -c verlag, berlin and new york. -c 6. more, j.j., and sorensen, d.c. (1981), computing a trust region -c step, technical report anl-81-83, argonne national lab. -c 7. varga, r.s. (1965), minimal gerschgorin sets, pacific j. math. 15, -c pp. 719-729. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - logical restrt - integer dggdmx, diag, diag0, dstsav, emax, emin, i, im1, inc, irc, - 1 j, k, kalim, kamin, k1, lk0, phipin, q, q0, uk0, x - double precision alphak, aki, akk, delta, dst, eps, gtsta, lk, - 1 oldphi, phi, phimax, phimin, psifac, rad, radsq, - 2 root, si, sk, sw, t, twopsi, t1, t2, uk, wi -c -c *** constants *** - double precision big, dgxfac, epsfac, four, half, kappa, negone, - 1 one, p001, six, three, two, zero -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dmin1, dsqrt -c/ -c *** external functions and subroutines *** -c - external dotprd, litvmu, livmul, lsqrt, lsvmin, rmdcon, v2norm - double precision dotprd, lsvmin, rmdcon, v2norm -c -c *** subscripts for v *** -c - integer dgnorm, dstnrm, dst0, epslon, gtstep, stppar, nreduc, - 1 phmnfc, phmxfc, preduc, radius, rad0 -c/6 -c data dgnorm/1/, dstnrm/2/, dst0/3/, epslon/19/, gtstep/4/, -c 1 nreduc/6/, phmnfc/20/, phmxfc/21/, preduc/7/, radius/8/, -c 2 rad0/9/, stppar/5/ -c/7 - parameter (dgnorm=1, dstnrm=2, dst0=3, epslon=19, gtstep=4, - 1 nreduc=6, phmnfc=20, phmxfc=21, preduc=7, radius=8, - 2 rad0=9, stppar=5) -c/ -c -c/6 -c data epsfac/50.0d+0/, four/4.0d+0/, half/0.5d+0/, -c 1 kappa/2.0d+0/, negone/-1.0d+0/, one/1.0d+0/, p001/1.0d-3/, -c 2 six/6.0d+0/, three/3.0d+0/, two/2.0d+0/, zero/0.0d+0/ -c/7 - parameter (epsfac=50.0d+0, four=4.0d+0, half=0.5d+0, - 1 kappa=2.0d+0, negone=-1.0d+0, one=1.0d+0, p001=1.0d-3, - 2 six=6.0d+0, three=3.0d+0, two=2.0d+0, zero=0.0d+0) - save dgxfac -c/ - data big/0.d+0/, dgxfac/0.d+0/ -c -c *** body *** -c -c *** store largest abs. entry in (d**-1)*h*(d**-1) at w(dggdmx). - dggdmx = p + 1 -c *** store gerschgorin over- and underestimates of the largest -c *** and smallest eigenvalues of (d**-1)*h*(d**-1) at w(emax) -c *** and w(emin) respectively. - emax = dggdmx + 1 - emin = emax + 1 -c *** for use in recomputing step, the final values of lk, uk, dst, -c *** and the inverse derivative of more*s phi at 0 (for pos. def. -c *** h) are stored in w(lk0), w(uk0), w(dstsav), and w(phipin) -c *** respectively. - lk0 = emin + 1 - phipin = lk0 + 1 - uk0 = phipin + 1 - dstsav = uk0 + 1 -c *** store diag of (d**-1)*h*(d**-1) in w(diag),...,w(diag0+p). - diag0 = dstsav - diag = diag0 + 1 -c *** store -d*step in w(q),...,w(q0+p). - q0 = diag0 + p - q = q0 + 1 -c *** allocate storage for scratch vector x *** - x = q + p - rad = v(radius) - radsq = rad**2 -c *** phitol = max. error allowed in dst = v(dstnrm) = 2-norm of -c *** d*step. - phimax = v(phmxfc) * rad - phimin = v(phmnfc) * rad - psifac = two * v(epslon) / (three * (four * (v(phmnfc) + one) * - 1 (kappa + one) + kappa + two) * rad**2) -c *** oldphi is used to detect limits of numerical accuracy. if -c *** we recompute step and it does not change, then we accept it. - oldphi = zero - eps = v(epslon) - irc = 0 - restrt = .false. - kalim = ka + 50 -c -c *** start or restart, depending on ka *** -c - if (ka .ge. 0) go to 290 -c -c *** fresh start *** -c - k = 0 - uk = negone - ka = 0 - kalim = 50 - v(dgnorm) = v2norm(p, dig) - v(nreduc) = zero - v(dst0) = zero - kamin = 3 - if (v(dgnorm) .eq. zero) kamin = 0 -c -c *** store diag(dihdi) in w(diag0+1),...,w(diag0+p) *** -c - j = 0 - do 10 i = 1, p - j = j + i - k1 = diag0 + i - w(k1) = dihdi(j) - 10 continue -c -c *** determine w(dggdmx), the largest element of dihdi *** -c - t1 = zero - j = p * (p + 1) / 2 - do 20 i = 1, j - t = dabs(dihdi(i)) - if (t1 .lt. t) t1 = t - 20 continue - w(dggdmx) = t1 -c -c *** try alpha = 0 *** -c - 30 call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 50 -c *** indef. h -- underestimate smallest eigenvalue, use this -c *** estimate to initialize lower bound lk on alpha. - j = irc*(irc+1)/2 - t = l(j) - l(j) = one - do 40 i = 1, irc - 40 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = -t / t1 / t1 - v(dst0) = -lk - if (restrt) go to 210 - go to 70 -c -c *** positive definite h -- compute unmodified newton step. *** - 50 lk = zero - t = lsvmin(p, l, w(q), w(q)) - if (t .ge. one) go to 60 - if (big .le. zero) big = rmdcon(6) - if (v(dgnorm) .ge. t*t*big) go to 70 - 60 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - v(nreduc) = half * gtsta - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - v(dst0) = dst - phi = dst - rad - if (phi .le. phimax) go to 260 - if (restrt) go to 210 -c -c *** prepare to compute gerschgorin estimates of largest (and -c *** smallest) eigenvalues. *** -c - 70 k = 0 - do 100 i = 1, p - wi = zero - if (i .eq. 1) go to 90 - im1 = i - 1 - do 80 j = 1, im1 - k = k + 1 - t = dabs(dihdi(k)) - wi = wi + t - w(j) = w(j) + t - 80 continue - 90 w(i) = wi - k = k + 1 - 100 continue -c -c *** (under-)estimate smallest eigenvalue of (d**-1)*h*(d**-1) *** -c - k = 1 - t1 = w(diag) - w(1) - if (p .le. 1) go to 120 - do 110 i = 2, p - j = diag0 + i - t = w(j) - w(i) - if (t .ge. t1) go to 110 - t1 = t - k = i - 110 continue -c - 120 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 150 i = 1, p - if (i .eq. k) go to 130 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (akk - w(j) + si - aki) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 140 - 130 inc = i - 140 k1 = k1 + inc - 150 continue -c - w(emin) = akk - t - uk = v(dgnorm)/rad - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 -c -c *** compute gerschgorin (over-)estimate of largest eigenvalue *** -c - k = 1 - t1 = w(diag) + w(1) - if (p .le. 1) go to 170 - do 160 i = 2, p - j = diag0 + i - t = w(j) + w(i) - if (t .le. t1) go to 160 - t1 = t - k = i - 160 continue -c - 170 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 200 i = 1, p - if (i .eq. k) go to 180 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (w(j) + si - aki - akk) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 190 - 180 inc = i - 190 k1 = k1 + inc - 200 continue -c - w(emax) = akk + t - lk = dmax1(lk, v(dgnorm)/rad - w(emax)) -c -c *** alphak = current value of alpha (see alg. notes above). we -c *** use more*s scheme for initializing it. - alphak = dabs(v(stppar)) * v(rad0)/rad -c - if (irc .ne. 0) go to 210 -c -c *** compute l0 for positive definite h *** -c - call livmul(p, w, l, w(q)) - t = v2norm(p, w) - w(phipin) = dst / t / t - lk = dmax1(lk, phi*w(phipin)) -c -c *** safeguard alphak and add alphak*i to (d**-1)*h*(d**-1) *** -c - 210 ka = ka + 1 - if (-v(dst0) .ge. alphak .or. alphak .lt. lk .or. alphak .ge. uk) - 1 alphak = uk * dmax1(p001, dsqrt(lk/uk)) - if (alphak .le. zero) alphak = half * uk - if (alphak .le. zero) alphak = uk - k = 0 - do 220 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) + alphak - 220 continue -c -c *** try computing cholesky decomposition *** -c - call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 240 -c -c *** (d**-1)*h*(d**-1) + alphak*i is indefinite -- overestimate -c *** smallest eigenvalue for use in updating lk *** -c - j = (irc*(irc+1))/2 - t = l(j) - l(j) = one - do 230 i = 1, irc - 230 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = alphak - t/t1/t1 - v(dst0) = -lk - go to 210 -c -c *** alphak makes (d**-1)*h*(d**-1) positive definite. -c *** compute q = -d*step, check for convergence. *** -c - 240 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - phi = dst - rad - if (phi .le. phimax .and. phi .ge. phimin) go to 270 - if (phi .eq. oldphi) go to 270 - oldphi = phi - if (phi .lt. zero) go to 330 -c -c *** unacceptable alphak -- update lk, uk, alphak *** -c - 250 if (ka .ge. kalim) go to 270 -c *** the following dmin1 is necessary because of restarts *** - if (phi .lt. zero) uk = dmin1(uk, alphak) -c *** kamin = 0 only iff the gradient vanishes *** - if (kamin .eq. 0) go to 210 - call livmul(p, w, l, w(q)) - t1 = v2norm(p, w) - alphak = alphak + (phi/t1) * (dst/t1) * (dst/rad) - lk = dmax1(lk, alphak) - go to 210 -c -c *** acceptable step on first try *** -c - 260 alphak = zero -c -c *** successful step in general. compute step = -(d**-1)*q *** -c - 270 do 280 i = 1, p - j = q0 + i - step(i) = -w(j)/d(i) - 280 continue - v(gtstep) = -gtsta - v(preduc) = half * (dabs(alphak)*dst*dst + gtsta) - go to 410 -c -c -c *** restart with new radius *** -c - 290 if (v(dst0) .le. zero .or. v(dst0) - rad .gt. phimax) go to 310 -c -c *** prepare to return newton step *** -c - restrt = .true. - ka = ka + 1 - k = 0 - do 300 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) - 300 continue - uk = negone - go to 30 -c - 310 kamin = ka + 3 - if (v(dgnorm) .eq. zero) kamin = 0 - if (ka .eq. 0) go to 50 -c - dst = w(dstsav) - alphak = dabs(v(stppar)) - phi = dst - rad - t = v(dgnorm)/rad - uk = t - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 - if (rad .gt. v(rad0)) go to 320 -c -c *** smaller radius *** - lk = zero - if (alphak .gt. zero) lk = w(lk0) - lk = dmax1(lk, t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** bigger radius *** - 320 if (alphak .gt. zero) uk = dmin1(uk, w(uk0)) - lk = dmax1(zero, -v(dst0), t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** decide whether to check for special case... in practice (from -c *** the standpoint of the calling optimization code) it seems best -c *** not to check until a few iterations have failed -- hence the -c *** test on kamin below. -c - 330 delta = alphak + dmin1(zero, v(dst0)) - twopsi = alphak*dst*dst + gtsta - if (ka .ge. kamin) go to 340 -c *** if the test in ref. 2 is satisfied, fall through to handle -c *** the special case (as soon as the more-sorensen test detects -c *** it). - if (delta .ge. psifac*twopsi) go to 370 -c -c *** check for the special case of h + alpha*d**2 (nearly) -c *** singular. use one step of inverse power method with start -c *** from lsvmin to obtain approximate eigenvector corresponding -c *** to smallest eigenvalue of (d**-1)*h*(d**-1). lsvmin returns -c *** x and w with l*w = x. -c - 340 t = lsvmin(p, l, w(x), w) -c -c *** normalize w *** - do 350 i = 1, p - 350 w(i) = t*w(i) -c *** complete current inv. power iter. -- replace w by (l**-t)*w. - call litvmu(p, w, l, w) - t2 = one/v2norm(p, w) - do 360 i = 1, p - 360 w(i) = t2*w(i) - t = t2 * t -c -c *** now w is the desired approximate (unit) eigenvector and -c *** t*x = ((d**-1)*h*(d**-1) + alphak*i)*w. -c - sw = dotprd(p, w(q), w) - t1 = (rad + dst) * (rad - dst) - root = dsqrt(sw*sw + t1) - if (sw .lt. zero) root = -root - si = t1 / (sw + root) -c -c *** the actual test for the special case... -c - if ((t2*si)**2 .le. eps*(dst**2 + alphak*radsq)) go to 380 -c -c *** update upper bound on smallest eigenvalue (when not positive) -c *** (as recommended by more and sorensen) and continue... -c - if (v(dst0) .le. zero) v(dst0) = dmin1(v(dst0), t2**2 - alphak) - lk = dmax1(lk, -v(dst0)) -c -c *** check whether we can hope to detect the special case in -c *** the available arithmetic. accept step as it is if not. -c -c *** if not yet available, obtain machine dependent value dgxfac. - 370 if (dgxfac .eq. zero) dgxfac = epsfac * rmdcon(3) -c - if (delta .gt. dgxfac*w(dggdmx)) go to 250 - go to 270 -c -c *** special case detected... negate alphak to indicate special case -c - 380 alphak = -alphak - v(preduc) = half * twopsi -c -c *** accept current step if adding si*w would lead to a -c *** further relative reduction in psi of less than v(epslon)/3. -c - t1 = zero - t = si*(alphak*sw - half*si*(alphak + t*dotprd(p,w(x),w))) - if (t .lt. eps*twopsi/six) go to 390 - v(preduc) = v(preduc) + t - dst = rad - t1 = -si - 390 do 400 i = 1, p - j = q0 + i - w(j) = t1*w(i) - w(j) - step(i) = w(j) / d(i) - 400 continue - v(gtstep) = dotprd(p, dig, w(q)) -c -c *** save values for use in a possible restart *** -c - 410 v(dstnrm) = dst - v(stppar) = alphak - w(lk0) = lk - w(uk0) = uk - v(rad0) = rad - w(dstsav) = dst -c -c *** restore diagonal of dihdi *** -c - j = 0 - do 420 i = 1, p - j = j + i - k = diag0 + i - dihdi(j) = w(k) - 420 continue -c - 999 return -c -c *** last card of gqtst follows *** - end - subroutine lsqrt(n1, n, l, a, irc) -c -c *** compute rows n1 through n of the cholesky factor l of -c *** a = l*(l**t), where l and the lower triangle of a are both -c *** stored compactly by rows (and may occupy the same storage). -c *** irc = 0 means all went well. irc = j means the leading -c *** principal j x j submatrix of a is not positive definite -- -c *** and l(j*(j+1)/2) contains the (nonpos.) reduced j-th diagonal. -c -c *** parameters *** -c - integer n1, n, irc -cal double precision l(1), a(1) - double precision l(n*(n+1)/2), a(n*(n+1)/2) -c dimension l(n*(n+1)/2), a(n*(n+1)/2) -c -c *** local variables *** -c - integer i, ij, ik, im1, i0, j, jk, jm1, j0, k - double precision t, td, zero -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c -c *** body *** -c - i0 = n1 * (n1 - 1) / 2 - do 50 i = n1, n - td = zero - if (i .eq. 1) go to 40 - j0 = 0 - im1 = i - 1 - do 30 j = 1, im1 - t = zero - if (j .eq. 1) go to 20 - jm1 = j - 1 - do 10 k = 1, jm1 - ik = i0 + k - jk = j0 + k - t = t + l(ik)*l(jk) - 10 continue - 20 ij = i0 + j - j0 = j0 + j - t = (a(ij) - t) / l(j0) - l(ij) = t - td = td + t*t - 30 continue - 40 i0 = i0 + i - t = a(i0) - td - if (t .le. zero) go to 60 - l(i0) = dsqrt(t) - 50 continue -c - irc = 0 - go to 999 -c - 60 l(i0) = t - irc = i -c - 999 return -c -c *** last card of lsqrt *** - end - double precision function lsvmin(p, l, x, y) -c -c *** estimate smallest sing. value of packed lower triang. matrix l -c -c *** parameter declarations *** -c - integer p -cal double precision l(1), x(p), y(p) - double precision l(p*(p+1)/2), x(p), y(p) -c dimension l(p*(p+1)/2) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c this function returns a good over-estimate of the smallest -c singular value of the packed lower triangular matrix l. -c -c *** parameter description *** -c -c p (in) = the order of l. l is a p x p lower triangular matrix. -c l (in) = array holding the elements of l in row order, i.e. -c l(1,1), l(2,1), l(2,2), l(3,1), l(3,2), l(3,3), etc. -c x (out) if lsvmin returns a positive value, then x is a normalized -c approximate left singular vector corresponding to the -c smallest singular value. this approximation may be very -c crude. if lsvmin returns zero, then some components of x -c are zero and the rest retain their input values. -c y (out) if lsvmin returns a positive value, then y = (l**-1)*x is an -c unnormalized approximate right singular vector correspond- -c ing to the smallest singular value. this approximation -c may be crude. if lsvmin returns zero, then y retains its -c input value. the caller may pass the same vector for x -c and y (nonstandard fortran usage), in which case y over- -c writes x (for nonzero lsvmin returns). -c -c *** algorithm notes *** -c -c the algorithm is based on (1), with the additional provision that -c lsvmin = 0 is returned if the smallest diagonal element of l -c (in magnitude) is not more than the unit roundoff times the -c largest. the algorithm uses a random number generator proposed -c in (4), which passes the spectral test with flying colors -- see -c (2) and (3). -c -c *** subroutines and functions called *** -c -c v2norm - function, returns the 2-norm of a vector. -c -c *** references *** -c -c (1) cline, a., moler, c., stewart, g., and wilkinson, j.h.(1977), -c an estimate for the condition number of a matrix, report -c tm-310, applied math. div., argonne national laboratory. -c -c (2) hoaglin, d.c. (1976), theoretical properties of congruential -c random-number generators -- an empirical view, -c memorandum ns-340, dept. of statistics, harvard univ. -c -c (3) knuth, d.e. (1969), the art of computer programming, vol. 2 -c (seminumerical algorithms), addison-wesley, reading, mass. -c -c (4) smith, c.s. (1971), multiplicative pseudo-random number -c generators with prime modulus, j. assoc. comput. mach. 18, -c pp. 586-593. -c -c *** history *** -c -c designed and coded by david m. gay (winter 1977/summer 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, and mcs76-11989. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer i, ii, ix, j, ji, jj, jjj, jm1, j0, pm1 - double precision b, sminus, splus, t, xminus, xplus -c -c *** constants *** -c - double precision half, one, r9973, zero -c -c *** intrinsic functions *** -c/+ - integer mod - real float - double precision dabs -c/ -c *** external functions and subroutines *** -c - external dotprd, v2norm, vaxpy - double precision dotprd, v2norm -c -c/6 -c data half/0.5d+0/, one/1.d+0/, r9973/9973.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, r9973=9973.d+0, zero=0.d+0) -c/ -c -c *** body *** -c - ix = 2 - pm1 = p - 1 -c -c *** first check whether to return lsvmin = 0 and initialize x *** -c - ii = 0 - j0 = p*pm1/2 - jj = j0 + p - if (l(jj) .eq. zero) go to 110 - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = b / l(jj) - x(p) = xplus - if (p .le. 1) go to 60 - do 10 i = 1, pm1 - ii = ii + i - if (l(ii) .eq. zero) go to 110 - ji = j0 + i - x(i) = xplus * l(ji) - 10 continue -c -c *** solve (l**t)*x = b, where the components of b have randomly -c *** chosen magnitudes in (.5,1) with signs chosen to make x large. -c -c do j = p-1 to 1 by -1... - do 50 jjj = 1, pm1 - j = p - jjj -c *** determine x(j) in this iteration. note for i = 1,2,...,j -c *** that x(i) holds the current partial sum for row i. - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = (b - x(j)) - xminus = (-b - x(j)) - splus = dabs(xplus) - sminus = dabs(xminus) - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - xplus = xplus/l(jj) - xminus = xminus/l(jj) - if (jm1 .eq. 0) go to 30 - do 20 i = 1, jm1 - ji = j0 + i - splus = splus + dabs(x(i) + l(ji)*xplus) - sminus = sminus + dabs(x(i) + l(ji)*xminus) - 20 continue - 30 if (sminus .gt. splus) xplus = xminus - x(j) = xplus -c *** update partial sums *** - if (jm1 .gt. 0) call vaxpy(jm1, x, xplus, l(j0+1), x) - 50 continue -c -c *** normalize x *** -c - 60 t = one/v2norm(p, x) - do 70 i = 1, p - 70 x(i) = t*x(i) -c -c *** solve l*y = x and return lsvmin = 1/twonorm(y) *** -c - do 100 j = 1, p - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - t = zero - if (jm1 .gt. 0) t = dotprd(jm1, l(j0+1), y) - y(j) = (x(j) - t) / l(jj) - 100 continue -c - lsvmin = one/v2norm(p, y) - go to 999 -c - 110 lsvmin = zero - 999 return -c *** last card of lsvmin follows *** - end - subroutine slvmul(p, y, s, x) -c -c *** set y = s * x, s = p x p symmetric matrix. *** -c *** lower triangle of s stored rowwise. *** -c -c *** parameter declarations *** -c - integer p -cal double precision s(1), x(p), y(p) - double precision s(p*(p+1)/2), x(p), y(p) -c dimension s(p*(p+1)/2) -c -c *** local variables *** -c - integer i, im1, j, k - double precision xi -c -c *** no intrinsic functions *** -c -c *** external function *** -c - external dotprd - double precision dotprd -c -c----------------------------------------------------------------------- -c - j = 1 - do 10 i = 1, p - y(i) = dotprd(i, s(j), x) - j = j + i - 10 continue -c - if (p .le. 1) go to 999 - j = 1 - do 40 i = 2, p - xi = x(i) - im1 = i - 1 - j = j + 1 - do 30 k = 1, im1 - y(k) = y(k) + s(j)*xi - j = j + 1 - 30 continue - 40 continue -c - 999 return -c *** last card of slvmul follows *** - end diff --git a/source/unres/src_MD-NEWSC-NEWC/dihed_cons.F b/source/unres/src_MD-NEWSC-NEWC/dihed_cons.F deleted file mode 100644 index e45405f..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/dihed_cons.F +++ /dev/null @@ -1,185 +0,0 @@ - subroutine secstrp2dihc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' - include 'COMMON.CHAIN' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - character*80 line - logical errflag - external ilen - -cdr call getenv_loc('SECPREDFIL',secpred) - lenpre=ilen(prefix) - secpred=prefix(:lenpre)//'.spred' - -#if defined(WINIFL) || defined(WINPGI) - open(isecpred,file=secpred,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(isecpred,file=secpred,status='old',action='read') -#elif (defined G77) - open(isecpred,file=secpred,status='old') -#else - open(isecpred,file=secpred,status='old',action='read') -#endif -C read secondary structure prediction from JPRED here! -! read(isecpred,'(A80)',err=100,end=100) line -! read(line,'(f10.3)',err=110) ftors - read(isecpred,'(f10.3)',err=110) ftors - - write (iout,*) 'FTORS factor =',ftors -! initialize secstruc to any - do i=1,nres - secstruc(i) ='-' - enddo - ndih_constr=0 - ndih_nconstr=0 - - call read_secstr_pred(isecpred,iout,errflag) - if (errflag) then - write(iout,*)'There is a problem with the list of secondary-', - & 'structure prediction' - goto 100 - endif -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - - ii=0 - do i=1,nres - if ( secstruc(i) .eq. 'H') then -C Helix restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 45.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else if (secstruc(i) .eq. 'E') then -C strand restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 180.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else -C no restraints for this residue - ndih_nconstr=ndih_nconstr+1 - idih_nconstr(ndih_nconstr)=i - endif - enddo - ndih_constr=ii - return -100 continue - write(iout,'(A30,A80)')'Error reading file SECPRED',secpred - return - 110 continue - write(iout,'(A20)')'Error reading FTORS' - return - end - - subroutine read_secstr_pred(jin,jout,errors) - - implicit real*8 (a-h,o-z) - INCLUDE 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - EXTERNAL ILEN - character*80 line,line1,ucase - logical errflag,errors,blankline - - errors=.false. - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) -C Remember that we number full residues starting from 2, then, iseq=1 and iseq=nres -C correspond to the end-groups. ADD to the secondary structure prediction "-" for the -C end-groups in the input file "*.spred" - - iseq=1 - do while (index(line1,'$END').eq.0) -* Override commented lines. - ipos=1 - blankline=.false. - do while (.not.blankline) - line1=' ' - call mykey(line,line1,ipos,blankline,errflag) - if (errflag) write (jout,'(2a)') - & 'Error when reading sequence in line: ',line - errors=errors .or. errflag - if (.not. blankline .and. .not. errflag) then - ipos1=2 - iend=ilen(line1) - if (iseq.le.maxres) then - if (line1(1:1).eq.'-' ) then - secstruc(iseq)=line1(1:1) - else if ( ( ucase(line1(1:1)).eq.'E' ) .or. - & ( ucase(line1(1:1)).eq.'H' ) ) then - secstruc(iseq)=ucase(line1(1:1)) - else - errors=.true. - write (jout,1010) line1(1:1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - do while (ipos1.le.iend) - - iseq=iseq+1 - il=1 - ipos1=ipos1+1 - if (iseq.le.maxres) then - if (line1(ipos1-1:ipos1-1).eq.'-' ) then - secstruc(iseq)=line1(ipos1-1:ipos1-1) - else if((ucase(line1(ipos1-1:ipos1-1)).eq.'E').or. - & (ucase(line1(ipos1-1:ipos1-1)).eq.'H') ) then - secstruc(iseq)=ucase(line1(ipos1-1:ipos1-1)) - else - errors=.true. - write (jout,1010) line1(ipos1-1:ipos1-1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - enddo - iseq=iseq+1 - endif - enddo - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) - enddo - -cd write (jout,'(10a8)') (sequence(i),i=1,iseq-1) - -cd check whether the found length of the chain is correct. - length_of_chain=iseq-1 - if (length_of_chain .ne. nres) then -! errors=.true. - write (jout,'(a,i4,a,i4,a)') - & 'Error: the number of labels specified in $SEC_STRUC_PRED (' - & ,length_of_chain,') does not match with the number of residues (' - & ,nres,').' - endif - 80 continue - - 1000 format('Error - the number of residues (',i4, - & ') has exceeded maximum (',i4,').') - 1010 format ('Error - unrecognized secondary structure label',a4, - & ' in position',i4) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/djacob.f b/source/unres/src_MD-NEWSC-NEWC/djacob.f deleted file mode 100644 index e3f46bc..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/djacob.f +++ /dev/null @@ -1,107 +0,0 @@ - SUBROUTINE DJACOB(N,NMAX,MAXJAC,E,A,C,AII) - IMPLICIT REAL*8 (A-H,O-Z) -C THE JACOBI DIAGONALIZATION PROCEDURE - COMMON INP,IOUT,IPN - DIMENSION A(NMAX,N),C(NMAX,N),AII(150),AJJ(150) - SIN45 = .70710678 - COS45 = .70710678 - S45SQ = 0.50 - C45SQ = 0.50 -C UNIT EIGENVECTOR MATRIX - DO 70 I = 1,N - DO 7 J = I,N - A(J,I)=A(I,J) - C(I,J) = 0.0 - 7 C(J,I) = 0.0 - 70 C(I,I) = 1.0 -C DETERMINATION OF SEARCH ARGUMENT, TEST - AMAX = 0.0 - DO 1 I = 1,N - DO 1 J = 1,I - TEMPA=DABS(A(I,J)) - IF (AMAX-TEMPA) 2,1,1 - 2 AMAX = TEMPA - 1 CONTINUE - TEST = AMAX*E -C SEARCH FOR LARGEST OFF DIAGONAL ELEMENT - DO 72 IJAC=1,MAXJAC - AIJMAX = 0.0 - DO 3 I = 2,N - LIM = I-1 - DO 3 J = 1,LIM - TAIJ=DABS(A(I,J)) - IF (AIJMAX-TAIJ) 4,3,3 - 4 AIJMAX = TAIJ - IPIV = I - JPIV = J - 3 CONTINUE - IF(AIJMAX-TEST)300,300,5 -C PARAMETERS FOR ROTATION - 5 TAII = A(IPIV,IPIV) - TAJJ = A(JPIV,JPIV) - TAIJ = A(IPIV,JPIV) - TMT = TAII-TAJJ - IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6 - 60 IF(TAIJ) 10,10,11 - 6 ZAMMA=TAIJ/(2.0*TMT) - 90 IF(DABS(ZAMMA)-0.38268)8,8,9 - 9 IF(ZAMMA)10,10,11 - 10 SINT = -SIN45 - GO TO 12 - 11 SINT = SIN45 - 12 COST = COS45 - SINSQ = S45SQ - COSSQ = C45SQ - GO TO 120 - 8 GAMSQ=ZAMMA*ZAMMA - SINT=2.0*ZAMMA/(1.0+GAMSQ) - COST = (1.0-GAMSQ)/(1.0+GAMSQ) - SINSQ=SINT*SINT - COSSQ=COST*COST -C ROTATION - 120 DO 13 K = 1,N - TAIK = A(IPIV,K) - TAJK = A(JPIV,K) - A(IPIV,K) = TAIK*COST+TAJK*SINT - A(JPIV,K) = TAJK*COST-TAIK*SINT - TCIK = C(IPIV,K) - TCJK = C(JPIV,K) - C(IPIV,K) = TCIK*COST+TCJK*SINT - 13 C(JPIV,K) = TCJK*COST-TCIK*SINT - A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST - A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST - A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT - A(JPIV,IPIV) = A(IPIV,JPIV) - DO 30 K = 1,N - A(K,IPIV) = A(IPIV,K) - 30 A(K,JPIV) = A(JPIV,K) - 72 CONTINUE - WRITE (IOUT,1000) AIJMAX - 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE', - 1 'MENT = ',1PE14.7) -C ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER - 300 DO 14 I=1,N - 14 AJJ(I)=A(I,I) - LT=N+1 - DO15 L=1,N - LT=LT-1 - AIIMIN=1.0E+30 - DO16 I=1,N - IF(AJJ(I)-AIIMIN)17,16,16 - 17 AIIMIN=AJJ(I) - IT=I - 16 CONTINUE - IN=L - AII(IN)=AIIMIN - AJJ(IT)=1.0E+30 - DO15 K=1,N - 15 A(IN,K)=C(IT,K) - DO 18 I=1,N - IF(A(I,1))19,22,22 - 19 T=-1.0 - GO TO 91 - 22 T=1.0 - 91 DO 18 J=1,N - 18 C(J,I)=T*A(I,J) - RETURN - END diff --git a/source/unres/src_MD-NEWSC-NEWC/econstr_local.F b/source/unres/src_MD-NEWSC-NEWC/econstr_local.F deleted file mode 100644 index f11acfb..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/econstr_local.F +++ /dev/null @@ -1,91 +0,0 @@ - subroutine Econstr_back -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - Uconst_back=0.0d0 - do i=1,nres - dutheta(i)=0.0d0 - dugamma(i)=0.0d0 - do j=1,3 - duscdiff(j,i)=0.0d0 - duscdiffx(j,i)=0.0d0 - enddo - enddo - do i=1,nfrag_back - ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) -c -c Deviations from theta angles -c - utheta_i=0.0d0 - do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) - dtheta_i=theta(j)-thetaref(j) - utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i - dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) - enddo - utheta(i)=utheta_i/(ii-1) -c -c Deviations from gamma angles -c - ugamma_i=0.0d0 - do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset) - dgamma_i=pinorm(phi(j)-phiref(j)) -c write (iout,*) j,phi(j),phi(j)-phiref(j) - ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i - dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2) -c write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3) - enddo - ugamma(i)=ugamma_i/(ii-2) -c -c Deviations from local SC geometry -c - uscdiff(i)=0.0d0 - do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 - dxx=xxtab(j)-xxref(j) - dyy=yytab(j)-yyref(j) - dzz=zztab(j)-zzref(j) - uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz - do k=1,3 - duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* - & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ - & (ii-1) - duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* - & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ - & (ii-1) - duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* - & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) - & /(ii-1) - enddo -c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), -c & xxref(j),yyref(j),zzref(j) - enddo - uscdiff(i)=0.5d0*uscdiff(i)/(ii-1) -c write (iout,*) i," uscdiff",uscdiff(i) -c -c Put together deviations from local geometry -c - Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ - & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i) -c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i), -c & " uconst_back",uconst_back - utheta(i)=dsqrt(utheta(i)) - ugamma(i)=dsqrt(ugamma(i)) - uscdiff(i)=dsqrt(uscdiff(i)) - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/eigen.f b/source/unres/src_MD-NEWSC-NEWC/eigen.f deleted file mode 100644 index e4088ee..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/eigen.f +++ /dev/null @@ -1,2351 +0,0 @@ -C 10 AUG 94 - MWS - INCREASE NUMBER OF DAF RECORDS -C 31 MAR 94 - MWS - ADD A VARIABLE TO END OF MACHSW COMMON -C 26 JUN 93 - MWS - ETRED3: ADD RETURN FOR SPECIAL CASE N=1 -C 4 JAN 92 - TLW - MAKE WRITES PARALLEL;ADD COMMON PAR -C 30 AUG 91 - MWS - JACDIA: LIMIT ITERATIONS, USE EPSLON IN TEST. -C 14 JUL 91 - MWS - JACOBI DIAGONALIZATION ALLOWS FOR LDVEC.NE.N -C 29 JAN 91 - TLW - GLDIAG: CHANGED COMMON DIAGSW TO MACHSW -C 29 OCT 90 - STE - FIX JACDIA UNDEFINED VARIABLE BUG -C 14 SEP 90 - MK - NEW JACOBI DIAGONALIZATION (KDIAG=3) -C 27 MAR 88 - MWS - ALLOW FOR VECTOR ROUTINE IN GLDIAG -C 11 AUG 87 - MWS - SANITIZE CONSTANTS IN EQLRAT -C 15 FEB 87 - STE - FIX EINVIT SUB-MATRIX LOOP LIMIT -C SCRATCH ARRAYS ARE N*8 REAL AND N INTEGER -C 8 DEC 86 - STE - USE PERF INDEX FROM ESTPI1 TO JUDGE EINVIT FAILURE -C 30 NOV 86 - STE - DELETE LIGENB, MAKE EVVRSP DEFAULT -C (GIVEIS FAILS ON CRAY FOR BENCHMC AND BENCHCI) -C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS -C 11 OCT 85 - STE - LIGENB,TQL2: USE DROT,DSWAP; TINVTB: SCALE VECTOR -C BEFORE NORMALIZING; GENERIC FUNCTIONS -C 24 FEB 84 - STE - INITIALIZE INDEX ARRAY FOR LIGENB IN GLDIAG -C 1 DEC 83 - STE - CHANGE MACHEP FROM 2**-54 TO 2**-50 -C 28 SEP 82 - MWS - CONVERT TO IBM -C -C*MODULE EIGEN *DECK EINVIT - SUBROUTINE EINVIT(NM,N,D,E,E2,M,W,IND,Z,IERR,RV1,RV2,RV3,RV4,RV6) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF TINVIT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TINVIT IS A TRANSLATION OF THE INVERSE ITERATION TECHNIQUE -C* IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C* SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES. -C* -C* METHOD - -C* INVERSE ITERATION. -C* -C* ON ENTRY - -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C* IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF CORRESPONDING ELEMENTS OF E, -C* WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C* E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C* THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE -C* SUM OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST -C* CONTAIN 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, -C* OR 2.0 IF THE EIGENVALUES ARE IN DESCENDING ORDER. -C* IF TQLRAT, BISECT, TRIDIB, OR IMTQLV -C* HAS BEEN USED TO FIND THE EIGENVALUES, THEIR -C* OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE. -C* M - INTEGER -C* THE NUMBER OF SPECIFIED EIGENVECTORS. -C* W - W.P. REAL (M) -C* CONTAINS THE M EIGENVALUES IN ASCENDING -C* OR DESCENDING ORDER. -C* IND - INTEGER (M) -C* CONTAINS IN FIRST M POSITIONS THE SUBMATRIX INDICES -C* ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C* 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX -C* FROM THE TOP, 2 FOR THOSE BELONGING TO THE SECOND -C* SUBMATRIX, ETC. -C* IERR - INTEGER (LOGICAL UNIT NUMBER) -C* LOGICAL UNIT FOR ERROR MESSAGES -C* -C* ON EXIT - -C* ALL INPUT ARRAYS ARE UNALTERED. -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE ASSOCIATED SET OF ORTHONORMAL -C* EIGENVECTORS. ANY VECTOR WHICH WHICH FAILS TO CONVERGE -C* IS LEFT AS IS (BUT NORMALIZED) WHEN ITERATING STOPPED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C* EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS. -C* (ONLY LAST FAILURE TO CONVERGE IS REPORTED) -C* -C* RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C* -C* RV1 - W.P. REAL (N) -C* DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV2 - W.P. REAL (N) -C* SUPER(1)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV3 - W.P. REAL (N) -C* SUPER(2)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV4 - W.P. REAL (N) -C* ELEMENTS DEFINING L IN LU DECOMPOSITION -C* RV6 - W.P. REAL (N) -C* APPROXIMATE EIGENVECTOR -C* -C* DIFFERENCES FROM EISPACK 3 - -C* EPS3 IS SCALED BY EPSCAL (ENHANCES CONVERGENCE, BUT -C* LOWERS ACCURACY)! -C* ONE MORE ITERATION (MINIMUM 2) IS PERFORMED AFTER CONVERGENCE -C* (ENHANCES ACCURACY)! -C* REPLACE LOOP WITH PYTHAG WITH SINGLE CALL TO DNRM2! -C* IF NOT CONVERGED, USE PERFORMANCE INDEX TO DECIDE ON ERROR -C* VALUE SETTING, BUT DO NOT STOP! -C* L.U. FOR ERROR MESSAGES PASSED THROUGH IERR -C* USE PARAMETER STATEMENTS AND GENERIC INTRINSIC FUNCTIONS -C* USE LEVEL 1 BLAS -C* USE IF-THEN-ELSE TO CLARIFY LOGIC -C* LOOP OVER SUBSPACES MADE INTO DO LOOP. -C* LOOP OVER INVERSE ITERATIONS MADE INTO DO LOOP -C* ZERO ONLY REQUIRED PORTIONS OF OUTPUT VECTOR -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C* -C - LOGICAL CONVGD,GOPARR,DSKWRK,MASWRK -C - INTEGER GROUP,I,IERR,ITS,J,JJ,M,N,NM,P,Q,R,S,SUBMAT,TAG - INTEGER IND(M) -C - DOUBLE PRECISION D(N),E(N),E2(N),W(M),Z(NM,M) - DOUBLE PRECISION RV1(N),RV2(N),RV3(N),RV4(N),RV6(N) - DOUBLE PRECISION ANORM,EPS2,EPS3,EPS4,NORM,ORDER,RHO,U,UK,V - DOUBLE PRECISION X0,X1,XU - DOUBLE PRECISION EPSCAL,GRPTOL,HUNDRD,ONE,TEN,ZERO - DOUBLE PRECISION EPSLON, ESTPI1, DASUM, DDOT, DNRM2 -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00, GRPTOL = 0.001D+00) - PARAMETER (EPSCAL = 0.5D+00, HUNDRD = 100.0D+00, TEN = 10.0D+00) -C - 001 FORMAT(' EIGENVECTOR ROUTINE EINVIT DID NOT CONVERGE FOR VECTOR' - * ,I5,'. NORM =',1P,E10.2,' PERFORMANCE INDEX =',E10.2/ - * ' (AN ERROR HALT WILL OCCUR IF THE PI IS GREATER THAN 100)') -C -C----------------------------------------------------------------------- -C - LUEMSG = IERR - IERR = 0 - X0 = ZERO - UK = ZERO - NORM = ZERO - EPS2 = ZERO - EPS3 = ZERO - EPS4 = ZERO - GROUP = 0 - TAG = 0 - ORDER = ONE - E2(1) - Q = 0 - DO 930 SUBMAT = 1, N - P = Q + 1 -C -C .......... ESTABLISH AND PROCESS NEXT SUBMATRIX .......... -C - DO 120 Q = P, N-1 - IF (E2(Q+1) .EQ. ZERO) GO TO 140 - 120 CONTINUE - Q = N -C -C .......... FIND VECTORS BY INVERSE ITERATION .......... -C - 140 CONTINUE - TAG = TAG + 1 - ANORM = ZERO - S = 0 -C - DO 920 R = 1, M - IF (IND(R) .NE. TAG) GO TO 920 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 510 -C -C .......... CHECK FOR ISOLATED ROOT .......... -C - XU = ONE - IF (P .EQ. Q) THEN - RV6(P) = ONE - CONVGD = .TRUE. - GO TO 860 -C - END IF - NORM = ABS(D(P)) - DO 500 I = P+1, Q - NORM = MAX( NORM, ABS(D(I)) + ABS(E(I)) ) - 500 CONTINUE -C -C .......... EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ......... -C - EPS2 = GRPTOL * NORM - EPS3 = EPSCAL * EPSLON(NORM) - UK = Q - P + 1 - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - GROUP = 0 - GO TO 520 -C -C .......... LOOK FOR CLOSE OR COINCIDENT ROOTS .......... -C - 510 IF (ABS(X1-X0) .GE. EPS2) THEN -C -C ROOTS ARE SEPERATE -C - GROUP = 0 - ELSE -C -C ROOTS ARE CLOSE -C - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. EPS3) X1 = X0 + ORDER * EPS3 - END IF -C -C .......... ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR .......... -C - 520 CONTINUE -C - U = D(P) - X1 - V = E(P+1) - RV6(P) = UK - DO 550 I = P+1, Q - RV6(I) = UK - IF (ABS(E(I)) .GT. ABS(U)) THEN -C -C EXCHANGE ROWS BEFORE ELIMINATION -C -C *** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ....... -C - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) -C - ELSE -C -C STRAIGHT ELIMINATION -C - XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = ZERO - U = D(I) - X1 - XU * V - V = E(I+1) - END IF - 550 CONTINUE -C - IF (ABS(U) .LE. EPS3) U = EPS3 - RV1(Q) = U - RV2(Q) = ZERO - RV3(Q) = ZERO -C -C DO INVERSE ITERATIONS -C - CONVGD = .FALSE. - DO 800 ITS = 1, 5 - IF (ITS .EQ. 1) GO TO 600 -C -C .......... FORWARD SUBSTITUTION .......... -C - IF (NORM .EQ. ZERO) THEN - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - ELSE - XU = EPS4 / NORM - CALL DSCAL (Q-P+1, XU, RV6(P), 1) - END IF -C -C ... ELIMINATION OPERATIONS ON NEXT VECTOR -C - DO 590 I = P+1, Q - U = RV6(I) -C -C IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS .......... -C - IF (RV1(I-1) .EQ. E(I)) THEN - U = RV6(I-1) - RV6(I-1) = RV6(I) - ELSE - U = RV6(I) - END IF - RV6(I) = U - RV4(I) * RV6(I-1) - 590 CONTINUE - 600 CONTINUE -C -C .......... BACK SUBSTITUTION -C - RV6(Q) = RV6(Q) / RV1(Q) - V = U - U = RV6(Q) - NORM = ABS(U) - DO 620 I = Q-1, P, -1 - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - NORM = NORM + ABS(U) - 620 CONTINUE - IF (GROUP .EQ. 0) GO TO 700 -C -C ....... ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP .......... -C - J = R - DO 680 JJ = 1, GROUP - 630 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 630 - CALL DAXPY(Q-P+1, -DDOT(Q-P+1,RV6(P),1,Z(P,J),1), - * Z(P,J),1,RV6(P),1) - 680 CONTINUE - NORM = DASUM(Q-P+1, RV6(P), 1) - 700 CONTINUE -C - IF (CONVGD) GO TO 840 - IF (NORM .GE. ONE) CONVGD = .TRUE. - 800 CONTINUE -C -C .......... NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER .......... -C - 840 CONTINUE -C - XU = ONE / DNRM2(Q-P+1,RV6(P),1) -C - 860 CONTINUE - DO 870 I = 1, P-1 - Z(I,R) = ZERO - 870 CONTINUE - DO 890 I = P,Q - Z(I,R) = RV6(I) * XU - 890 CONTINUE - DO 900 I = Q+1, N - Z(I,R) = ZERO - 900 CONTINUE -C - IF (.NOT.CONVGD) THEN - RHO = ESTPI1(Q-P+1,X1,D(P),E(P),Z(P,R),ANORM) - IF (RHO .GE. TEN .AND. LUEMSG .GT. 0 .AND. MASWRK) - * WRITE(LUEMSG,001) R,NORM,RHO -C -C *** SET ERROR -- NON-CONVERGED EIGENVECTOR .......... -C - IF (RHO .GT. HUNDRD) IERR = -R - END IF -C - X0 = X1 - 920 CONTINUE -C - IF (Q .EQ. N) GO TO 940 - 930 CONTINUE - 940 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ELAUM - SUBROUTINE ELAU(HINV,L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G - DOUBLE PRECISION HALF - DOUBLE PRECISION HH - DOUBLE PRECISION HINV - DOUBLE PRECISION ZERO -C - PARAMETER (ZERO = 0.0D+00, HALF = 0.5D+00) -C - JL = L - E(1) = A(1) * D(1) - JK = 2 - DO 210 J = 2, JL - F = D(J) - G = ZERO - JM1 = J - 1 -C - DO 200 K = 1, JM1 - G = G + A(JK) * D(K) - E(K) = E(K) + A(JK) * F - JK = JK + 1 - 200 CONTINUE -C - E(J) = G + A(JK) * F - JK = JK + 1 - 210 CONTINUE -C -C .......... FORM P .......... -C - F = ZERO - DO 245 J = 1, L - E(J) = E(J) * HINV - F = F + E(J) * D(J) - 245 CONTINUE -C -C .......... FORM Q .......... -C - HH = F * HALF * HINV - DO 250 J = 1, L - 250 E(J) = E(J) - HH * D(J) -C - RETURN - END -C*MODULE EIGEN *DECK EPSLON - DOUBLE PRECISION FUNCTION EPSLON (X) -C* -C* AUTHORS - -C* THIS ROUTINE WAS TAKEN FROM EISPACK EDITION 3 DATED 4/6/83 -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE NOV 1986 -C* -C* PURPOSE - -C* ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X. -C* -C* ON ENTRY - -C* X - WORKING PRECISION REAL -C* VALUES TO FIND EPSLON FOR -C* -C* ON EXIT - -C* EPSLON - WORKING PRECISION REAL -C* SMALLEST POSITIVE VALUE SUCH THAT X+EPSLON .NE. ZERO -C* -C* QUALIFICATIONS - -C* THIS ROUTINE SHOULD PERFORM PROPERLY ON ALL SYSTEMS -C* SATISFYING THE FOLLOWING TWO ASSUMPTIONS, -C* 1. THE BASE USED IN REPRESENTING FLOATING POINT -C* NUMBERS IS NOT A POWER OF THREE. -C* 2. THE QUANTITY A IN STATEMENT 10 IS REPRESENTED TO -C* THE ACCURACY USED IN FLOATING POINT VARIABLES -C* THAT ARE STORED IN MEMORY. -C* THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO -C* FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING -C* ASSUMPTION 2. -C* UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT, -C* A IS NOT EXACTLY EQUAL TO FOUR-THIRDS, -C* B HAS A ZERO FOR ITS LAST BIT OR DIGIT, -C* C IS NOT EXACTLY EQUAL TO ONE, -C* EPS MEASURES THE SEPARATION OF 1.0 FROM -C* THE NEXT LARGER FLOATING POINT NUMBER. -C* THE DEVELOPERS OF EISPACK WOULD APPRECIATE BEING INFORMED -C* ABOUT ANY SYSTEMS WHERE THESE ASSUMPTIONS DO NOT HOLD. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* USE IS MADE OF PARAMETER STATEMENTS AND INTRINSIC FUNCTIONS -C* --NO EXECUTEABLE CODE CHANGES-- -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - DOUBLE PRECISION A,B,C,EPS,X - DOUBLE PRECISION ZERO, ONE, THREE, FOUR -C - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, THREE=3.0D+00, FOUR=4.0D+00) -C -C----------------------------------------------------------------------- -C - A = FOUR/THREE - 10 B = A - ONE - C = B + B + B - EPS = ABS(C - ONE) - IF (EPS .EQ. ZERO) GO TO 10 - EPSLON = EPS*ABS(X) - RETURN - END -C*MODULE EIGEN *DECK EQLRAT - SUBROUTINE EQLRAT(N,DIAG,E,E2IN,D,IND,IERR,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE EQLRAT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TQLRAT IS A TRANSLATION OF THE ALGOL PROCEDURE TQLRAT, -C* ALGORITHM 464, COMM. ACM 16, 689(1973) BY REINSCH. -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC -C* TRIDIAGONAL MATRIX -C* -C* METHOD - -C* RATIONAL QL -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE SUBDIAGONAL ELEMENTS OF -C* THE INPUT MATRIX IN ITS LAST N-1 POSITIONS. -C* E2(1) IS ARBITRARY. -C* -C* ON EXIT - -C* D - W.P. REAL (N) -C* CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C* ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C* ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C* THE SMALLEST EIGENVALUES. -C* E2 - W.P. REAL (N) -C* DESTROYED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* J IF THE J-TH EIGENVALUE HAS NOT BEEN -C* DETERMINED AFTER 30 ITERATIONS. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* G=G+B INSTEAD OF IF(G.EQ.0) G=B ; B=B/4 -C* F77 BACKWARD LOOPS INSTEAD OF F66 CONSTRUCT -C* GENERIC INTRINSIC FUNCTIONS -C* ARRARY IND ADDED FOR USE BY EINVIT -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,J,L,M,N,II,L1,IERR - INTEGER IND(N) -C - DOUBLE PRECISION D(N),E(N),E2(N),DIAG(N),E2IN(N) - DOUBLE PRECISION B,C,F,G,H,P,R,S,T,EPSLON - DOUBLE PRECISION SCALE,ZERO,ONE -C - PARAMETER (ZERO = 0.0D+00, SCALE= 1.0D+00/64.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- - IERR = 0 - D(1)=DIAG(1) - IND(1) = 1 - K = 0 - ITAG = 0 - IF (N .EQ. 1) GO TO 1001 -C - DO 100 I = 2, N - D(I)=DIAG(I) - 100 E2(I-1) = E2IN(I) -C - F = ZERO - T = ZERO - B = EPSLON(ONE) - C = B *B - B = B * SCALE - E2(N) = ZERO -C - DO 290 L = 1, N - H = ABS(D(L)) + ABS(E(L)) - IF (T .GE. H) GO TO 105 - T = H - B = EPSLON(T) - C = B * B - B = B * SCALE - 105 CONTINUE -C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT .......... - M = L - 1 - 110 M = M + 1 - IF (E2(M) .GT. C) GO TO 110 -C .......... E2(N) IS ALWAYS ZERO, SO THERE IS AN EXIT -C FROM THE LOOP .......... -C - IF (M .LE. K) GO TO 125 - IF (M .NE. N) E2IN(M+1) = ZERO - K = M - ITAG = ITAG + 1 - 125 CONTINUE - IF (M .EQ. L) GO TO 210 -C -C ITERATE -C - DO 205 J = 1, 30 -C .......... FORM SHIFT .......... - L1 = L + 1 - S = SQRT(E2(L)) - G = D(L) - P = (D(L1) - G) / (2.0D+00 * S) - R = SQRT(P*P+1.0D+00) - D(L) = S / (P + SIGN(R,P)) - H = G - D(L) -C - DO 140 I = L1, N - 140 D(I) = D(I) - H -C - F = F + H -C .......... RATIONAL QL TRANSFORMATION .......... - G = D(M) + B - H = G - S = ZERO - DO 200 I = M-1,L,-1 - P = G * H - R = P + E2(I) - E2(I+1) = S * R - S = E2(I) / R - D(I+1) = H + S * (H + D(I)) - G = D(I) - E2(I) / G + B - H = G * P / R - 200 CONTINUE -C - E2(L) = S * G - D(L) = H -C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST - IF (H .EQ. ZERO) GO TO 210 - IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210 - E2(L) = H * E2(L) - IF (E2(L) .EQ. ZERO) GO TO 210 - 205 CONTINUE -C .......... SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS .......... - IERR = L - GO TO 1001 -C -C CONVERGED -C - 210 P = D(L) + F -C .......... ORDER EIGENVALUES .......... - I = 1 - IF (L .EQ. 1) GO TO 250 - IF (P .LT. D(1)) GO TO 230 - I = L -C .......... LOOP TO FIND ORDERED POSITION - 220 I = I - 1 - IF (P .LT. D(I)) GO TO 220 -C - I = I + 1 - IF (I .EQ. L) GO TO 250 - 230 CONTINUE - DO 240 II = L, I+1, -1 - D(II) = D(II-1) - IND(II) = IND(II-1) - 240 CONTINUE -C - 250 CONTINUE - D(I) = P - IND(I) = ITAG - 290 CONTINUE -C - 1001 RETURN - END -C*MODULE EIGEN *DECK ESTPI1 - DOUBLE PRECISION FUNCTION ESTPI1 (N,EVAL,D,E,X,ANORM) -C* -C* AUTHOR - -C* STEPHEN T. ELBERT (AMES LABORATORY-USDOE) DATE: 5 DEC 1986 -C* -C* PURPOSE - -C* EVALUATE SYMMETRIC TRIDIAGONAL MATRIX PERFORMANCE INDEX -C* * * * * * -C* FOR 1 EIGENVECTOR -C* * -C* -C* METHOD - -C* THIS ROUTINE FORMS THE 1-NORM OF THE RESIDUAL MATRIX A*X-X*EVAL -C* WHERE A IS A SYMMETRIC TRIDIAGONAL MATRIX STORED -C* IN THE DIAGONAL (D) AND SUB-DIAGONAL (E) VECTORS, EVAL IS THE -C* EIGENVALUE OF AN EIGENVECTOR OF A, NAMELY X. -C* THIS NORM IS SCALED BY MACHINE ACCURACY FOR THE PROBLEM SIZE. -C* ALL NORMS APPEARING IN THE COMMENTS BELOW ARE 1-NORMS. -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* EVAL - W.P. REAL -C* THE EIGENVALUE CORRESPONDING TO VECTOR X. -C* D - W.P. REAL (N) -C* THE DIAGONAL VECTOR OF A. -C* E - W.P. REAL (N) -C* THE SUB-DIAGONAL VECTOR OF A. -C* X - W.P. REAL (N) -C* AN EIGENVECTOR OF A. -C* ANORM - W.P. REAL -C* THE NORM OF A IF IT HAS BEEN PREVIOUSLY COMPUTED. -C* -C* ON EXIT - -C* ANORM - W.P. REAL -C* THE NORM OF A, COMPUTED IF INITIALLY ZERO. -C* ESTPI1 - W.P. REAL -C* !!A*X-X*EVAL!! / (EPSLON(10*N)*!!A!!*!!X!!); -C* WHERE EPSLON(X) IS THE SMALLEST NUMBER SUCH THAT -C* X + EPSLON(X) .NE. X -C* -C* ESTPI1 .LT. 1 == SATISFACTORY PERFORMANCE -C* .GE. 1 AND .LE. 100 == MARGINAL PERFORMANCE -C* .GT. 100 == POOR PERFORMANCE -C* (SEE LECT. NOTES IN COMP. SCI. VOL.6 PP 124-125) -C - DOUBLE PRECISION ANORM,EVAL,RNORM,SIZE,XNORM - DOUBLE PRECISION D(N), E(N), X(N) - DOUBLE PRECISION EPSLON, ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - ESTPI1 = ZERO - IF( N .LE. 1 ) RETURN - SIZE = 10 * N - IF (ANORM .EQ. ZERO) THEN -C -C COMPUTE NORM OF A -C - ANORM = MAX( ABS(D(1)) + ABS(E(2)) - * ,ABS(D(N)) + ABS(E(N))) - DO 110 I = 2, N-1 - ANORM = MAX( ANORM, ABS(E(I))+ABS(D(I))+ABS(E(I+1))) - 110 CONTINUE - IF(ANORM .EQ. ZERO) ANORM = ONE - END IF -C -C COMPUTE NORMS OF RESIDUAL AND EIGENVECTOR -C - XNORM = ABS(X(1)) + ABS(X(N)) - RNORM = ABS( (D(1)-EVAL)*X(1) + E(2)*X(2)) - * +ABS( (D(N)-EVAL)*X(N) + E(N)*X(N-1)) - DO 120 I = 2, N-1 - XNORM = XNORM + ABS(X(I)) - RNORM = RNORM + ABS(E(I)*X(I-1) + (D(I)-EVAL)*X(I) - * + E(I+1)*X(I+1)) - 120 CONTINUE -C - ESTPI1 = RNORM / (EPSLON(SIZE)*ANORM*XNORM) - RETURN - END -C*MODULE EIGEN *DECK ETRBK3 - SUBROUTINE ETRBK3(NM,N,NV,A,M,Z) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF ROUTINE TRBAK3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRBAK3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C* MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C* SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY ETRED3. -C* -C* METHOD - -C* THE CALCULATION IS CARRIED OUT BY FORMING THE MATRIX PRODUCT -C* Q*Z -C* WHERE Q IS A PRODUCT OF THE ORTHOGONAL SYMMETRIC MATRICES -C* Q = PROD(I)[1 - U(I)*.TRANSPOSE.U(I)*H(I)] -C* U IS THE AUGMENTED SUB-DIAGONAL ROWS OF A AND -C* Z IS THE SET OF EIGENVECTORS OF THE TRIDIAGONAL -C* MATRIX F WHICH WAS FORMED FROM THE ORIGINAL SYMMETRIC -C* MATRIX C BY THE SIMILARITY TRANSFORMATION -C* F = Q(TRANSPOSE) C Q -C* NOTE THAT ETRBK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C* -C* -C* COMPLEXITY - -C* M*N**2 -C* -C* ON ENTRY- -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY A AS -C* DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT. -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION BY ETRED3 IN -C* ITS FIRST NV = N*(N+1)/2 POSITIONS. -C* M - INTEGER -C* THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. -C* Z - W.P REAL (NM,M) -C* CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C* IN ITS FIRST M COLUMNS. -C* -C* ON EXIT- -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE TRANSFORMED EIGENVECTORS -C* IN ITS FIRST M COLUMNS. -C* -C* DIFFERENCES WITH EISPACK 3 - -C* THE TWO INNER LOOPS ARE REPLACED BY DDOT AND DAXPY. -C* MULTIPLICATION USED INSTEAD OF DIVISION TO FIND S. -C* OUTER LOOP RANGE CHANGED FROM 2,N TO 3,N. -C* ADDRESS POINTERS FOR A SIMPLIFIED. -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,II,IM1,IZ,J,M,N,NM,NV -C - DOUBLE PRECISION A(NV),Z(NM,M) - DOUBLE PRECISION H,S,DDOT,ZERO -C - PARAMETER (ZERO = 0.0D+00) -C -C----------------------------------------------------------------------- -C - IF (M .EQ. 0) RETURN - IF (N .LE. 2) RETURN -C - II=3 - DO 140 I = 3, N - IZ=II+1 - II=II+I - H = A(II) - IF (H .EQ. ZERO) GO TO 140 - IM1 = I - 1 - DO 130 J = 1, M - S = -( DDOT(IM1,A(IZ),1,Z(1,J),1) * H) * H - CALL DAXPY(IM1,S,A(IZ),1,Z(1,J),1) - 130 CONTINUE - 140 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ETRED3 - SUBROUTINE ETRED3(N,NV,A,D,E,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE TRED3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRED3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE JUN 1986 -C* -C* PURPOSE - -C* THIS ROUTINE REDUCES A REAL SYMMETRIC (PACKED) MATRIX, STORED -C* AS A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C* USING ORTHOGONAL SIMILARITY TRANSFORMATIONS, PRESERVING THE -C* INFORMATION ABOUT THE TRANSFORMATIONS IN A. -C* -C* METHOD - -C* THE TRIDIAGONAL REDUCTION IS PERFORMED IN THE FOLLOWING WAY. -C* STARTING WITH J=N, THE ELEMENTS IN THE J-TH ROW TO THE -C* LEFT OF THE DIAGONAL ARE FIRST SCALED, TO AVOID POSSIBLE -C* UNDERFLOW IN THE TRANSFORMATION THAT MIGHT RESULT IN SEVERE -C* DEPARTURE FROM ORTHOGONALITY. THE SUM OF SQUARES SIGMA OF -C* THESE SCALED ELEMENTS IS NEXT FORMED. THEN, A VECTOR U AND -C* A SCALAR -C* H = U(TRANSPOSE) * U / 2 -C* DEFINE A REFLECTION OPERATOR -C* P = I - U * U(TRANSPOSE) / H -C* WHICH IS ORTHOGONAL AND SYMMETRIC AND FOR WHICH THE -C* SIMILIARITY TRANSFORMATION PAP ELIMINATES THE ELEMENTS IN -C* THE J-TH ROW OF A TO THE LEFT OF THE SUBDIAGONAL AND THE -C* SYMMETRICAL ELEMENTS IN THE J-TH COLUMN. -C* -C* THE NON-ZERO COMPONENTS OF U ARE THE ELEMENTS OF THE J-TH -C* ROW TO THE LEFT OF THE DIAGONAL WITH THE LAST OF THEM -C* AUGMENTED BY THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE SUBDIAGONAL ELEMENT. BY STORING THE TRANSFORMED SUB- -C* DIAGONAL ELEMENT IN E(J) AND NOT OVERWRITING THE ROW -C* ELEMENTS ELIMINATED IN THE TRANSFORMATION, FULL INFORMATION -C* ABOUT P IS SAVE FOR LATER USE IN ETRBK3. -C* -C* THE TRANSFORMATION SETS E2(J) EQUAL TO SIGMA AND E(J) -C* EQUAL TO THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE REPLACED SUBDIAGONAL ELEMENT. -C* -C* THE ABOVE STEPS ARE REPEATED ON FURTHER ROWS OF THE -C* TRANSFORMED A IN REVERSE ORDER UNTIL A IS REDUCED TO TRI- -C* DIAGONAL FORM, THAT IS, REPEATED FOR J = N-1,N-2,...,3. -C* -C* COMPLEXITY - -C* 2/3 N**3 -C* -C* ON ENTRY- -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C* AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT -C* A - W.P. REAL (NV) -C* CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C* INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C* ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C* -C* ON EXIT- -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF -C* E. MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* OUTER LOOP CHANGED FROM II=1,N TO I=N,3,-1 -C* PARAMETER STATEMENT AND GENERIC INTRINSIC FUNCTIONS USED -C* SCALE.NE.0 TEST NOW SPOTS TRI-DIAGONAL FORM -C* VALUES LESS THAN EPSLON CLEARED TO ZERO -C* USE BLAS(1) -C* U NOT COPIED TO D, LEFT IN A -C* E2 COMPUTED FROM E -C* INNER LOOPS SPLIT INTO ROUTINES ELAU AND FREDA -C* INVERSE OF H STORED INSTEAD OF H -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,IIA,IZ0,L,N,NV -C - DOUBLE PRECISION A(NV),D(N),E(N),E2(N) - DOUBLE PRECISION AIIMAX,F,G,H,HROOT,SCALE,SCALEI - DOUBLE PRECISION DASUM, DNRM2 - DOUBLE PRECISION ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - IF (N .LE. 2) GO TO 310 - IZ0 = (N*N+N)/2 - AIIMAX = ABS(A(IZ0)) - DO 300 I = N, 3, -1 - L = I - 1 - IIA = IZ0 - IZ0 = IZ0 - I - AIIMAX = MAX(AIIMAX, ABS(A(IIA))) - SCALE = DASUM (L, A(IZ0+1), 1) - IF(SCALE .EQ. ABS(A(IIA-1)) .OR. AIIMAX+SCALE .EQ. AIIMAX) THEN -C -C THIS ROW IS ALREADY IN TRI-DIAGONAL FORM -C - D(I) = A(IIA) - IF (AIIMAX+D(I) .EQ. AIIMAX) D(I) = ZERO - E(I) = A(IIA-1) - IF (AIIMAX+E(I) .EQ. AIIMAX) E(I) = ZERO - E2(I) = E(I)*E(I) - A(IIA) = ZERO - GO TO 300 -C - END IF -C - SCALEI = ONE / SCALE - CALL DSCAL(L,SCALEI,A(IZ0+1),1) - HROOT = DNRM2(L,A(IZ0+1),1) -C - F = A(IZ0+L) - G = -SIGN(HROOT,F) - E(I) = SCALE * G - E2(I) = E(I)*E(I) - H = HROOT*HROOT - F * G - A(IZ0+L) = F - G - D(I) = A(IIA) - A(IIA) = ONE / SQRT(H) -C .......... FORM P THEN Q IN E(1:L) .......... - CALL ELAU(ONE/H,L,A(IZ0+1),A,E) -C .......... FORM REDUCED A .......... - CALL FREDA(L,A(IZ0+1),A,E) -C - 300 CONTINUE - 310 CONTINUE - E(1) = ZERO - E2(1)= ZERO - D(1) = A(1) - IF(N.EQ.1) RETURN -C - E(2) = A(2) - E2(2)= A(2)*A(2) - D(2) = A(3) - RETURN - END -C*MODULE EIGEN *DECK EVVRSP - SUBROUTINE EVVRSP(MSGFL,N,NVECT,LENA,NV,A,B,IND,ROOT, - * VECT,IORDER,IERR) -C* -C* AUTHOR: S. T. ELBERT, AMES LABORATORY-USDOE, JUNE 1985 -C* -C* PURPOSE - -C* FINDS (ALL) EIGENVALUES AND (SOME OR ALL) EIGENVECTORS -C* * * * -C* OF A REAL SYMMETRIC PACKED MATRIX. -C* * * * -C* -C* METHOD - -C* THE METHOD AS PRESENTED IN THIS ROUTINE CONSISTS OF FOUR STEPS: -C* FIRST, THE INPUT MATRIX IS REDUCED TO TRIDIAGONAL FORM BY THE -C* HOUSEHOLDER TECHNIQUE (ORTHOGONAL SIMILARITY TRANSFORMATIONS). -C* SECOND, THE ROOTS ARE LOCATED USING THE RATIONAL QL METHOD. -C* THIRD, THE VECTORS OF THE TRIDIAGONAL FORM ARE EVALUATED BY THE -C* INVERSE ITERATION TECHNIQUE. VECTORS FOR DEGENERATE OR NEAR- -C* DEGENERATE ROOTS ARE FORCED TO BE ORTHOGONAL. -C* FOURTH, THE TRIDIAGONAL VECTORS ARE ROTATED TO VECTORS OF THE -C* ORIGINAL ARRAY. -C* -C* THESE ROUTINES ARE MODIFICATIONS OF THE EISPACK 3 -C* ROUTINES TRED3, TQLRAT, TINVIT AND TRBAK3 -C* -C* FOR FURTHER DETAILS, SEE EISPACK USERS GUIDE, B. T. SMITH -C* ET AL, SPRINGER-VERLAG, LECTURE NOTES IN COMPUTER SCIENCE, -C* VOL. 6, 2-ND EDITION, 1976. ANOTHER GOOD REFERENCE IS -C* THE SYMMETRIC EIGENVALUE PROBLEM BY B. N. PARLETT -C* PUBLISHED BY PRENTICE-HALL, INC., ENGLEWOOD CLIFFS, N.J. (1980) -C* -C* ON ENTRY - -C* MSGFL - INTEGER (LOGICAL UNIT NO.) -C* FILE WHERE ERROR MESSAGES WILL BE PRINTED. -C* IF MSGFL IS 0, ERROR MESSAGES WILL BE PRINTED ON LU 6. -C* IF MSGFL IS NEGATIVE, NO ERROR MESSAGES PRINTED. -C* N - INTEGER -C* ORDER OF MATRIX A. -C* NVECT - INTEGER -C* NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N. -C* LENA - INTEGER -C* DIMENSION OF A IN CALLING ROUTINE. MUST NOT BE LESS -C* THAN (N*N+N)/2. -C* NV - INTEGER -C* ROW DIMENSION OF VECT IN CALLING ROUTINE. N .LE. NV. -C* A - WORKING PRECISION REAL (LENA) -C* INPUT MATRIX, ROWS OF THE LOWER TRIANGLE PACKED INTO -C* LINEAR ARRAY OF DIMENSION N*(N+1)/2. THE PACKED ORDER -C* IS A(1,1), A(2,1), A(2,2), A(3,1), A(3,2), ... -C* B - WORKING PRECISION REAL (N,8) -C* SCRATCH ARRAY, 8*N ELEMENTS -C* IND - INTEGER (N) -C* SCRATCH ARRAY OF LENGTH N. -C* IORDER - INTEGER -C* ROOT ORDERING FLAG. -C* = 0, ROOTS WILL BE PUT IN ASCENDING ORDER. -C* = 2, ROOTS WILL BE PUT IN DESCENDING ORDER. -C* -C* ON EXIT - -C* A - DESTORYED. NOW HOLDS REFLECTION OPERATORS. -C* ROOT - WORKING PRECISION REAL (N) -C* ALL EIGENVALUES IN ASCENDING OR DESCENDING ORDER. -C* IF IORDER = 0, ROOT(1) .LE. ... .LE. ROOT(N) -C* IF IORDER = 2, ROOT(1) .GE. ... .GE. ROOT(N) -C* VECT - WORKING PRECISION REAL (NV,NVECT) -C* EIGENVECTORS FOR ROOT(1), ..., ROOT(NVECT). -C* IERR - INTEGER -C* = 0 IF NO ERROR DETECTED, -C* = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C* = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C* (FAILURES SHOULD BE VERY RARE. CONTACT C. MOLER.) -C* -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DOUBLE PRECISION A(LENA) - DOUBLE PRECISION B(N,8) - DOUBLE PRECISION ROOT(N) - DOUBLE PRECISION T - DOUBLE PRECISION VECT(NV,*) -C - INTEGER IND(N) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - 900 FORMAT(26H0*** EVVRSP PARAMETERS ***/ - + 14H *** N = ,I8,4H ***/ - + 14H *** NVECT = ,I8,4H ***/ - + 14H *** LENA = ,I8,4H ***/ - + 14H *** NV = ,I8,4H ***/ - + 14H *** IORDER = ,I8,4H ***/ - + 14H *** IERR = ,I8,4H ***) - 901 FORMAT(37H VALUE OF LENA IS LESS THAN (N*N+N)/2) - 902 FORMAT(39H EQLRAT HAS FAILED TO CONVERGE FOR ROOT,I5) - 903 FORMAT(18H NV IS LESS THAN N) - 904 FORMAT(41H EINVIT HAS FAILED TO CONVERGE FOR VECTOR,I5) - 905 FORMAT(51H VALUE OF IORDER MUST BE 0 (SMALLEST ROOT FIRST) OR - * ,23H 2 (LARGEST ROOT FIRST)) - 906 FORMAT(' VALUE OF N IS LESS THAN OR EQUAL ZERO') -C -C----------------------------------------------------------------------- -C - LMSGFL=MSGFL - IF (MSGFL .EQ. 0) LMSGFL=6 - IERR = N - 1 - IF (N .LE. 0) GO TO 800 - IERR = N + 1 - IF ( (N*N+N)/2 .GT. LENA) GO TO 810 -C -C REDUCE REAL SYMMETRIC MATRIX A TO TRIDIAGONAL FORM -C - CALL ETRED3(N,LENA,A,B(1,1),B(1,2),B(1,3)) -C -C FIND ALL EIGENVALUES OF TRIDIAGONAL MATRIX -C - CALL EQLRAT(N,B(1,1),B(1,2),B(1,3),ROOT,IND,IERR,B(1,4)) - IF (IERR .NE. 0) GO TO 820 -C -C CHECK THE DESIRED ORDER OF THE EIGENVALUES -C - B(1,3) = IORDER - IF (IORDER .EQ. 0) GO TO 300 - IF (IORDER .NE. 2) GO TO 850 -C -C ORDER ROOTS IN DESCENDING ORDER (LARGEST FIRST)... -C TURN ROOT AND IND ARRAYS END FOR END -C - DO 210 I = 1, N/2 - J = N+1-I - T = ROOT(I) - ROOT(I) = ROOT(J) - ROOT(J) = T - L = IND(I) - IND(I) = IND(J) - IND(J) = L - 210 CONTINUE -C -C FIND I AND J MARKING THE START AND END OF A SEQUENCE -C OF DEGENERATE ROOTS -C - I=0 - 220 CONTINUE - I = I+1 - IF (I .GT. N) GO TO 300 - DO 230 J=I,N - IF (ROOT(J) .NE. ROOT(I)) GO TO 240 - 230 CONTINUE - J = N+1 - 240 CONTINUE - J = J-1 - IF (J .EQ. I) GO TO 220 -C -C TURN AROUND IND BETWEEN I AND J -C - JSV = J - KLIM = (J-I+1)/2 - DO 250 K=1,KLIM - L = IND(J) - IND(J) = IND(I) - IND(I) = L - I = I+1 - J = J-1 - 250 CONTINUE - I = JSV - GO TO 220 -C - 300 CONTINUE -C - IF (NVECT .LE. 0) RETURN - IF (NV .LT. N) GO TO 830 -C -C FIND EIGENVECTORS OF TRI-DIAGONAL MATRIX VIA INVERSE ITERATION -C - IERR = LMSGFL - CALL EINVIT(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,IND, - + VECT,IERR,B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .NE. 0) GO TO 840 -C -C FIND EIGENVECTORS OF SYMMETRIC MATRIX VIA BACK TRANSFORMATION -C - 400 CONTINUE - CALL ETRBK3(NV,N,LENA,A,NVECT,VECT) - RETURN -C -C ERROR MESSAGE SECTION -C - 800 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,906) - GO TO 890 -C - 810 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,901) - GO TO 890 -C - 820 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,902) IERR - GO TO 890 -C - 830 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,903) - GO TO 890 -C - 840 CONTINUE - IF ((LMSGFL .GT. 0).AND.MASWRK) WRITE(LMSGFL,904) -IERR - GO TO 400 -C - 850 IERR=-1 - IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,905) - GO TO 890 -C - 890 CONTINUE - IF (MASWRK) WRITE(LMSGFL,900) N,NVECT,LENA,NV,IORDER,IERR - RETURN - END -C*MODULE EIGEN *DECK FREDA - SUBROUTINE FREDA(L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G -C - JK = 1 -C -C .......... FORM REDUCED A .......... -C - DO 280 J = 1, L - F = D(J) - G = E(J) -C - DO 260 K = 1, J - A(JK) = A(JK) - F * E(K) - G * D(K) - JK = JK + 1 - 260 CONTINUE -C - 280 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK GIVEIS - SUBROUTINE GIVEIS(N,NVECT,NV,A,B,INDB,ROOT,VECT,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(*),B(N,8),INDB(N),ROOT(N),VECT(NV,NVECT) -C -C EISPACK-BASED SUBSTITUTE FOR QCPE ROUTINE GIVENS. -C FINDS ALL EIGENVALUES AND SOME EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX. AUTHOR.. C. MOLER AND D. SPANGLER, N.R.C.C., 4/1/79. -C -C INPUT.. -C N = ORDER OF MATRIX . -C NVECT = NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N . -C NV = LEADING DIMENSION OF VECT . -C A = INPUT MATRIX, COLUMNS OF THE UPPER TRIANGLE PACKED INTO -C LINEAR ARRAY OF DIMENSION N*(N+1)/2 . -C B = SCRATCH ARRAY, 8*N ELEMENTS (NOTE THIS IS MORE THAN -C PREVIOUS VERSIONS OF GIVENS.) -C IND = INDEX ARRAY OF N ELEMENTS -C -C OUTPUT.. -C A DESTROYED . -C ROOT = ALL EIGENVALUES, ROOT(1) .LE. ... .LE. ROOT(N) . -C (FOR OTHER ORDERINGS, SEE BELOW.) -C VECT = EIGENVECTORS FOR ROOT(1),..., ROOT(NVECT) . -C IERR = 0 IF NO ERROR DETECTED, -C = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C (FAILURES SHOULD BE VERY RARE. CONTACT MOLER.) -C -C CALLS MODIFIED EISPACK ROUTINES TRED3B, IMTQLV, TINVTB, AND -C TRBK3B. THE ROUTINES TRED3B, TINVTB, AND TRBK3B. -C THE ORIGINAL EISPACK ROUTINES TRED3, TINVIT, AND TRBAK3 -C WERE MODIFIED BY THE INTRODUCTION OF TWO ROUTINES FROM THE -C BLAS LIBRARY - DDOT AND DAXPY. -C -C IF TINVIT FAILS TO CONVERGE, TQL2 IS CALLED -C -C SEE EISPACK USERS GUIDE, B. T. SMITH ET AL, SPRINGER-VERLAG -C LECTURE NOTES IN COMPUTER SCIENCE, VOL. 6, 2-ND EDITION, 1976 . -C NOTE THAT IMTQLV AND TINVTB HAVE INTERNAL MACHINE -C DEPENDENT CONSTANTS. -C - DATA ONE, ZERO /1.0D+00, 0.0D+00/ - CALL TRED3B(N,(N*N+N)/2,A,B(1,1),B(1,2),B(1,3)) - CALL IMTQLV(N,B(1,1),B(1,2),B(1,3),ROOT,INDB,IERR,B(1,4)) - IF (IERR .NE. 0) RETURN -C -C TO REORDER ROOTS... -C K = N/2 -C B(1,3) = 2.0D+00 -C DO 50 I = 1, K -C J = N+1-I -C T = ROOT(I) -C ROOT(I) = ROOT(J) -C ROOT(J) = T -C 50 CONTINUE -C - IF (NVECT .LE. 0) RETURN - CALL TINVTB(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,INDB,VECT,IERR, - + B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .EQ. 0) GO TO 160 -C -C IF INVERSE ITERATION GIVES AN ERROR IN DETERMINING THE -C EIGENVECTORS, TRY THE QL ALGORITHM IF ALL THE EIGENVECTORS -C ARE DESIRED. -C - IF (NVECT .NE. N) RETURN - DO 120 I = 1, NVECT - DO 100 J = 1, N - VECT(I,J) = ZERO - 100 CONTINUE - VECT(I,I) = ONE - 120 CONTINUE - CALL TQL2 (NV,N,B(1,1),B(1,2),VECT,IERR) - DO 140 I = 1, NVECT - ROOT(I) = B(I,1) - 140 CONTINUE - IF (IERR .NE. 0) RETURN - 160 CALL TRBK3B(NV,N,(N*N+N)/2,A,NVECT,VECT) - RETURN - END -C*MODULE EIGEN *DECK GLDIAG - SUBROUTINE GLDIAG(LDVECT,NVECT,N,H,WRK,EIG,VECTOR,IERR,IWRK) -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DIMENSION H(*),WRK(N,8),EIG(N),VECTOR(LDVECT,NVECT),IWRK(N) -C - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C -C ----- GENERAL ROUTINE TO DIAGONALIZE A SYMMETRIC MATRIX ----- -C IF KDIAG = 0, USE A ROUTINE FROM THE VECTOR LIBRARY, -C IF AVAILABLE (SEE THE SUBROUTINE 'GLDIAG' -C IN VECTOR.SRC), OR EVVRSP OTHERWISE -C = 1, USE EVVRSP -C = 2, USE GIVEIS -C = 3, USE JACOBI -C -C N = DIMENSION (ORDER) OF MATRIX TO BE SOLVED -C LDVECT = LEADING DIMENSION OF VECTOR -C NVECT = NUMBER OF VECTORS DESIRED -C H = MATRIX TO BE DIAGONALIZED -C WRK = N*8 W.P. REAL WORDS OF SCRATCH SPACE -C EIG = EIGENVECTORS (OUTPUT) -C VECTOR = EIGENVECTORS (OUTPUT) -C IERR = ERROR FLAG (OUTPUT) -C IWRK = N INTEGER WORDS OF SCRATCH SPACE -C - IERR = 0 -C -C ----- USE STEVE ELBERT'S ROUTINE ----- -C - IF(KDIAG.LE.1 .OR. KDIAG.GT.3) THEN - LENH = (N*N+N)/2 - KORDER =0 - CALL EVVRSP(IW,N,NVECT,LENH,LDVECT,H,WRK,IWRK,EIG,VECTOR - * ,KORDER,IERR) - END IF -C -C ----- USE MODIFIED EISPAK ROUTINE ----- -C - IF(KDIAG.EQ.2) - * CALL GIVEIS(N,NVECT,LDVECT,H,WRK,IWRK,EIG,VECTOR,IERR) -C -C ----- USE JACOBI ROTATION ROUTINE ----- -C - IF(KDIAG.EQ.3) THEN - IF(NVECT.EQ.N) THEN - CALL JACDG(H,VECTOR,EIG,IWRK,WRK,LDVECT,N) - ELSE - IF (MASWRK) WRITE(IW,9000) N,NVECT,LDVECT - CALL ABRT - END IF - END IF - RETURN -C - 9000 FORMAT(1X,'IN -GLDIAG-, N,NVECT,LDVECT=',3I8/ - * 1X,'THE JACOBI CODE CANNOT COPE WITH N.NE.NVECT!'/ - * 1X,'SO THIS RUN DOES NOT PERMIT KDIAG=3.') - END -C*MODULE EIGEN *DECK IMTQLV - SUBROUTINE IMTQLV(N,D,E,E2,W,IND,IERR,RV1) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - INTEGER TAG - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),E2(N),W(N),RV1(N),IND(N) -C -C THIS ROUTINE IS A VARIANT OF IMTQL1 WHICH IS A TRANSLATION OF -C ALGOL PROCEDURE IMTQL1, NUM. MATH. 12, 377-383(1968) BY MARTIN AND -C WILKINSON, AS MODIFIED IN NUM. MATH. 15, 450(1970) BY DUBRULLE. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC TRIDIAGONAL -C MATRIX BY THE IMPLICIT QL METHOD AND ASSOCIATES WITH THEM -C THEIR CORRESPONDING SUBMATRIX INDICES. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2(1) IS ARBITRARY. -C -C ON OUTPUT- -C -C D AND E ARE UNALTERED, -C -C ELEMENTS OF E2, CORRESPONDING TO ELEMENTS OF E REGARDED -C AS NEGLIGIBLE, HAVE BEEN REPLACED BY ZERO CAUSING THE -C MATRIX TO SPLIT INTO A DIRECT SUM OF SUBMATRICES. -C E2(1) IS ALSO SET TO ZERO, -C -C W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C THE SMALLEST EIGENVALUES, -C -C IND CONTAINS THE SUBMATRIX INDICES ASSOCIATED WITH THE -C CORRESPONDING EIGENVALUES IN W -- 1 FOR EIGENVALUES -C BELONGING TO THE FIRST SUBMATRIX FROM THE TOP, -C 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC., -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS, -C -C RV1 IS A TEMPORARY STORAGE ARRAY. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - K = 0 - TAG = 0 -C - DO 100 I = 1, N - W(I) = D(I) - IF (I .NE. 1) RV1(I-1) = E(I) - 100 CONTINUE -C - E2(1) = 0.0D+00 - RV1(N) = 0.0D+00 -C - DO 360 L = 1, N - J = 0 -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - 120 DO 140 M = L, N - IF (M .EQ. N) GO TO 160 - IF (ABS(RV1(M)) .LE. MACHEP * (ABS(W(M)) + ABS(W(M+1)))) GO TO - + 160 -C ********** GUARD AGAINST UNDERFLOWED ELEMENT OF E2 ********** - IF (E2(M+1) .EQ. 0.0D+00) GO TO 180 - 140 CONTINUE -C - 160 IF (M .LE. K) GO TO 200 - IF (M .NE. N) E2(M+1) = 0.0D+00 - 180 K = M - TAG = TAG + 1 - 200 P = W(L) - IF (M .EQ. L) GO TO 280 - IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - G = (W(L+1) - P) / (2.0D+00 * RV1(L)) - R = SQRT(G*G+1.0D+00) - G = W(M) - P + RV1(L) / (G + SIGN(R,G)) - S = 1.0D+00 - C = 1.0D+00 - P = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - F = S * RV1(I) - B = C * RV1(I) - IF (ABS(F) .LT. ABS(G)) GO TO 220 - C = G / F - R = SQRT(C*C+1.0D+00) - RV1(I+1) = F * R - S = 1.0D+00 / R - C = C * S - GO TO 240 - 220 S = F / G - R = SQRT(S*S+1.0D+00) - RV1(I+1) = G * R - C = 1.0D+00 / R - S = S * C - 240 G = W(I+1) - P - R = (W(I) - G) * S + 2.0D+00 * C * B - P = S * R - W(I+1) = G + P - G = C * R - B - 260 CONTINUE -C - W(L) = W(L) - P - RV1(L) = G - RV1(M) = 0.0D+00 - GO TO 120 -C ********** ORDER EIGENVALUES ********** - 280 IF (L .EQ. 1) GO TO 320 -C ********** FOR I=L STEP -1 UNTIL 2 DO -- ********** - DO 300 II = 2, L - I = L + 2 - II - IF (P .GE. W(I-1)) GO TO 340 - W(I) = W(I-1) - IND(I) = IND(I-1) - 300 CONTINUE -C - 320 I = 1 - 340 W(I) = P - IND(I) = TAG - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF IMTQLV ********** - END -C*MODULE EIGEN *DECK JACDG - SUBROUTINE JACDG(A,VEC,EIG,JBIG,BIG,LDVEC,N) -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) -C - DIMENSION A(*),VEC(LDVEC,N),EIG(N),JBIG(N),BIG(N) -C - PARAMETER (ONE=1.0D+00) -C -C ----- JACOBI DIAGONALIZATION OF SYMMETRIC MATRIX ----- -C SYMMETRIC MATRIX -A- OF DIMENSION -N- IS DESTROYED ON EXIT. -C ALL EIGENVECTORS ARE FOUND, SO -VEC- MUST BE SQUARE, -C UNLESS SOMEONE TAKES THE TROUBLE TO LOOK AT -NMAX- BELOW. -C -BIG- AND -JBIG- ARE SCRATCH WORK ARRAYS. -C - CALL VCLR(VEC,1,LDVEC*N) - DO 20 I = 1,N - VEC(I,I) = ONE - 20 CONTINUE -C - NB1 = N - NB2 = (NB1*NB1+NB1)/2 - NMIN = 1 - NMAX = NB1 -C - CALL JACDIA(A,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) -C - DO 30 I=1,N - EIG(I) = A((I*I+I)/2) - 30 CONTINUE -C - CALL JACORD(VEC,EIG,NB1,LDVEC) - RETURN - END -C*MODULE EIGEN *DECK JACDIA - SUBROUTINE JACDIA(F,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - LOGICAL GOPARR,DSKWRK,MASWRK - DIMENSION F(NB2),VEC(LDVEC,NB1),BIG(NB1),JBIG(NB1) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ROOT2=0.707106781186548D+00 ) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, D1050=1.05D+00, - * D1500=1.5D+00, D3875=3.875D+00, - * D0500=0.5D+00, D1375=1.375D+00, D0250=0.25D+00 ) - PARAMETER (C2=1.0D-12, C3=4.0D-16, - * C4=2.0D-16, C5=8.0D-09, C6=3.0D-06 ) -C -C F IS THE MATRIX TO BE DIAGONALIZED, F IS STORED TRIANGULAR -C VEC IS THE ARRAY OF EIGENVECTORS, DIMENSION NB1*NB1 -C BIG AND JBIG ARE TEMPORARY SCRATCH AREAS OF DIMENSION NB1 -C THE ROTATIONS AMONG THE FIRST NMIN BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C THE ROTATIONS AMONG THE LAST NB1-NMAX BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C - IEAA=0 - IEAB=0 - TT=ZERO - EPS = 64.0D+00*EPSLON(ONE) -C -C LOOP OVER COLUMNS (K) OF TRIANGULAR MATRIX TO DETERMINE -C LARGEST OFF-DIAGONAL ELEMENTS IN ROW(I). -C - DO 20 I=1,NB1 - BIG(I)=ZERO - JBIG(I)=0 - IF(I.LT.NMIN .OR. I.EQ.1) GO TO 20 - II = (I*I-I)/2 - J=MIN(I-1,NMAX) - DO 10 K=1,J - IF(ABS(BIG(I)).GE.ABS(F(II+K))) GO TO 10 - BIG(I)=F(II+K) - JBIG(I)=K - 10 CONTINUE - 20 CONTINUE -C -C ----- 2X2 JACOBI ITERATIONS BEGIN HERE ----- -C - MAXIT=MAX(NB2*20,500) - ITER=0 - 30 CONTINUE - ITER=ITER+1 -C -C FIND SMALLEST DIAGONAL ELEMENT -C - SD=D1050 - JJ=0 - DO 40 J=1,NB1 - JJ=JJ+J - SD= MIN(SD,ABS(F(JJ))) - 40 CONTINUE - TEST = MAX(EPS, C2*MAX(SD,C6)) -C -C FIND LARGEST OFF-DIAGONAL ELEMENT -C - T=ZERO - I1=MAX(2,NMIN) - IB = I1 - DO 50 I=I1,NB1 - IF(T.GE.ABS(BIG(I))) GO TO 50 - T= ABS(BIG(I)) - IB=I - 50 CONTINUE -C -C TEST FOR CONVERGENCE, THEN DETERMINE ROTATION. -C - IF(T.LT.TEST) RETURN -C ****** -C - IF(ITER.GT.MAXIT) THEN - IF (MASWRK) THEN - WRITE(6,*) 'JACOBI DIAGONALIZATION FAILS, DIMENSION=',NB1 - WRITE(6,9020) ITER,T,TEST,SD - ENDIF - CALL ABRT - STOP - END IF -C - IA=JBIG(IB) - IAA=IA*(IA-1)/2 - IBB=IB*(IB-1)/2 - DIF=F(IAA+IA)-F(IBB+IB) - IF(ABS(DIF).GT.C3*T) GO TO 70 - SX=ROOT2 - CX=ROOT2 - GO TO 110 - 70 T2X2=BIG(IB)/DIF - T2X25=T2X2*T2X2 - IF(T2X25 . GT . C4) GO TO 80 - CX=ONE - SX=T2X2 - GO TO 110 - 80 IF(T2X25 . GT . C5) GO TO 90 - SX=T2X2*(ONE-D1500*T2X25) - CX=ONE-D0500*T2X25 - GO TO 110 - 90 IF(T2X25 . GT . C6) GO TO 100 - CX=ONE+T2X25*(T2X25*D1375 - D0500) - SX= T2X2*(ONE + T2X25*(T2X25*D3875 - D1500)) - GO TO 110 - 100 T=D0250 / SQRT(D0250 + T2X25) - CX= SQRT(D0500 + T) - SX= SIGN( SQRT(D0500 - T),T2X2) - 110 IEAR=IAA+1 - IEBR=IBB+1 -C - DO 230 IR=1,NB1 - T=F(IEAR)*SX - F(IEAR)=F(IEAR)*CX+F(IEBR)*SX - F(IEBR)=T-F(IEBR)*CX - IF(IR-IA) 220,120,130 - 120 TT=F(IEBR) - IEAA=IEAR - IEAB=IEBR - F(IEBR)=BIG(IB) - IEAR=IEAR+IR-1 - IF(JBIG(IR)) 200,220,200 - 130 T=F(IEAR) - IT=IA - IEAR=IEAR+IR-1 - IF(IR-IB) 180,150,160 - 150 F(IEAA)=F(IEAA)*CX+F(IEAB)*SX - F(IEAB)=TT*CX+F(IEBR)*SX - F(IEBR)=TT*SX-F(IEBR)*CX - IEBR=IEBR+IR-1 - GO TO 200 - 160 IF( ABS(T) . GE . ABS(F(IEBR))) GO TO 170 - IF(IB.GT.NMAX) GO TO 170 - T=F(IEBR) - IT=IB - 170 IEBR=IEBR+IR-1 - 180 IF( ABS(T) . LT . ABS(BIG(IR))) GO TO 190 - BIG(IR) = T - JBIG(IR) = IT - GO TO 220 - 190 IF(IA . NE . JBIG(IR) . AND . IB . NE . JBIG(IR)) GO TO 220 - 200 KQ=IEAR-IR-IA+1 - BIG(IR)=ZERO - IR1=MIN(IR-1,NMAX) - DO 210 I=1,IR1 - K=KQ+I - IF(ABS(BIG(IR)) . GE . ABS(F(K))) GO TO 210 - BIG(IR) = F(K) - JBIG(IR)=I - 210 CONTINUE - 220 IEAR=IEAR+1 - 230 IEBR=IEBR+1 -C - DO 240 I=1,NB1 - T1=VEC(I,IA)*CX + VEC(I,IB)*SX - T2=VEC(I,IA)*SX - VEC(I,IB)*CX - VEC(I,IA)=T1 - VEC(I,IB)=T2 - 240 CONTINUE - GO TO 30 -C - 9020 FORMAT(1X,'ITER=',I6,' T,TEST,SD=',1P,3E20.10) - END -C*MODULE EIGEN *DECK JACORD - SUBROUTINE JACORD(VEC,EIG,N,LDVEC) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION VEC(LDVEC,N),EIG(N) -C -C ---- SORT EIGENDATA INTO ASCENDING ORDER ----- -C - DO 290 I = 1, N - JJ = I - DO 270 J = I, N - IF (EIG(J) .LT. EIG(JJ)) JJ = J - 270 CONTINUE - IF (JJ .EQ. I) GO TO 290 - T = EIG(JJ) - EIG(JJ) = EIG(I) - EIG(I) = T - DO 280 J = 1, N - T = VEC(J,JJ) - VEC(J,JJ) = VEC(J,I) - VEC(J,I) = T - 280 CONTINUE - 290 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK TINVTB - SUBROUTINE TINVTB(NM,N,D,E,E2,M,W,IND,Z, - * IERR,RV1,RV2,RV3,RV4,RV6) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION D(N),E(N),E2(N),W(M),Z(NM,M), - * RV1(N),RV2(N),RV3(N),RV4(N),RV6(N),IND(M) - DOUBLE PRECISION MACHEP,NORM - INTEGER P,Q,R,S,TAG,GROUP -C ------------------------------------------------------------------ -C -C THIS ROUTINE IS A TRANSLATION OF THE INVERSE ITERATION TECH- -C NIQUE IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C -C THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES, -C USING INVERSE ITERATION. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E, -C WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE SUM -C OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST CONTAIN -C 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, OR 2.0 -C IF THE EIGENVALUES ARE IN DESCENDING ORDER. IF BISECT, -C TRIDIB, OR IMTQLV HAS BEEN USED TO FIND THE EIGENVALUES, -C THEIR OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE, -C -C M IS THE NUMBER OF SPECIFIED EIGENVALUES, -C -C W CONTAINS THE M EIGENVALUES IN ASCENDING OR DESCENDING ORDER, -C -C IND CONTAINS IN ITS FIRST M POSITIONS THE SUBMATRIX INDICES -C ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX FROM -C THE TOP, 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC. -C -C ON OUTPUT- -C -C ALL INPUT ARRAYS ARE UNALTERED, -C -C Z CONTAINS THE ASSOCIATED SET OF ORTHONORMAL EIGENVECTORS. -C ANY VECTOR WHICH FAILS TO CONVERGE IS SET TO ZERO, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS, -C -C RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (M .EQ. 0) GO TO 680 - TAG = 0 - ORDER = 1.0D+00 - E2(1) - XU = 0.0D+00 - UK = 0.0D+00 - X0 = 0.0D+00 - U = 0.0D+00 - EPS2 = 0.0D+00 - EPS3 = 0.0D+00 - EPS4 = 0.0D+00 - GROUP = 0 - Q = 0 -C ********** ESTABLISH AND PROCESS NEXT SUBMATRIX ********** - 100 P = Q + 1 - IP = P + 1 -C - DO 120 Q = P, N - IF (Q .EQ. N) GO TO 140 - IF (E2(Q+1) .EQ. 0.0D+00) GO TO 140 - 120 CONTINUE -C ********** FIND VECTORS BY INVERSE ITERATION ********** - 140 TAG = TAG + 1 - IQMP = Q - P + 1 - S = 0 -C - DO 660 R = 1, M - IF (IND(R) .NE. TAG) GO TO 660 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 220 -C ********** CHECK FOR ISOLATED ROOT ********** - XU = 1.0D+00 - IF (P .NE. Q) GO TO 160 - RV6(P) = 1.0D+00 - GO TO 600 - 160 NORM = ABS(D(P)) -C - DO 180 I = IP, Q - 180 NORM = NORM + ABS(D(I)) + ABS(E(I)) -C ********** EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ********** - EPS2 = 1.0D-03 * NORM - EPS3 = MACHEP * NORM - UK = IQMP - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - 200 GROUP = 0 - GO TO 240 -C ********** LOOK FOR CLOSE OR COINCIDENT ROOTS ********** - 220 IF (ABS(X1-X0) .GE. EPS2) GO TO 200 - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. 0.0D+00) X1 = X0 + ORDER * EPS3 -C ********** ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR ********** - 240 V = 0.0D+00 -C - DO 300 I = P, Q - RV6(I) = UK - IF (I .EQ. P) GO TO 280 - IF (ABS(E(I)) .LT. ABS(U)) GO TO 260 -C ********** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ********** - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = 0.0D+00 - IF (I .NE. Q) RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) - GO TO 300 - 260 XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = 0.0D+00 - 280 U = D(I) - X1 - XU * V - IF (I .NE. Q) V = E(I+1) - 300 CONTINUE -C - IF (U .EQ. 0.0D+00) U = EPS3 - RV1(Q) = U - RV2(Q) = 0.0D+00 - RV3(Q) = 0.0D+00 -C ********** BACK SUBSTITUTION -C FOR I=Q STEP -1 UNTIL P DO -- ********** - 320 DO 340 II = P, Q - I = P + Q - II - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - 340 CONTINUE -C ********** ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP ********** - IF (GROUP .EQ. 0) GO TO 400 - J = R -C - DO 380 JJ = 1, GROUP - 360 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 360 - XU = DDOT(IQMP,RV6(P),1,Z(P,J),1) -C - CALL DAXPY(IQMP,-XU,Z(P,J),1,RV6(P),1) -C - 380 CONTINUE -C - 400 NORM = 0.0D+00 -C - DO 420 I = P, Q - 420 NORM = NORM + ABS(RV6(I)) -C - IF (NORM .GE. 1.0D+00) GO TO 560 -C ********** FORWARD SUBSTITUTION ********** - IF (ITS .EQ. 5) GO TO 540 - IF (NORM .NE. 0.0D+00) GO TO 440 - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - GO TO 480 - 440 XU = EPS4 / NORM -C - DO 460 I = P, Q - 460 RV6(I) = RV6(I) * XU -C ********** ELIMINATION OPERATIONS ON NEXT VECTOR -C ITERATE ********** - 480 DO 520 I = IP, Q - U = RV6(I) -C ********** IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS ********** - IF (RV1(I-1) .NE. E(I)) GO TO 500 - U = RV6(I-1) - RV6(I-1) = RV6(I) - 500 RV6(I) = U - RV4(I) * RV6(I-1) - 520 CONTINUE -C - ITS = ITS + 1 - GO TO 320 -C ********** SET ERROR -- NON-CONVERGED EIGENVECTOR ********** - 540 IERR = -R - XU = 0.0D+00 - GO TO 600 -C ********** NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER ********** - 560 U = 0.0D+00 -C - DO 580 I = P, Q - RV6(I) = RV6(I) / NORM - 580 U = U + RV6(I)**2 -C - XU = 1.0D+00 / SQRT(U) -C - 600 DO 620 I = 1, N - 620 Z(I,R) = 0.0D+00 -C - DO 640 I = P, Q - 640 Z(I,R) = RV6(I) * XU -C - X0 = X1 - 660 CONTINUE -C - IF (Q .LT. N) GO TO 100 - 680 RETURN -C ********** LAST CARD OF TINVIT ********** - END -C*MODULE EIGEN *DECK TQL2 -C -C ------------------------------------------------------------------ -C - SUBROUTINE TQL2(NM,N,D,E,Z,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),Z(NM,N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQL2, -C NUM. MATH. 11, 293-306(1968) BY BOWDLER, MARTIN, REINSCH, AND -C WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS -C OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE QL METHOD. -C THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO -C BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS -C FULL MATRIX TO TRIDIAGONAL FORM. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE -C REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS -C OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN -C THE IDENTITY MATRIX. -C -C ON OUTPUT- -C -C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT -C UNORDERED FOR INDICES 1,2,...,IERR-1, -C -C E HAS BEEN DESTROYED, -C -C Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC -C TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE, -C Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED -C EIGENVALUES, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (N .EQ. 1) GO TO 400 -C - DO 100 I = 2, N - 100 E(I-1) = E(I) -C - F = 0.0D+00 - B = 0.0D+00 - E(N) = 0.0D+00 -C - DO 300 L = 1, N - J = 0 - H = MACHEP * (ABS(D(L)) + ABS(E(L))) - IF (B .LT. H) B = H -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - DO 120 M = L, N - IF (ABS(E(M)) .LE. B) GO TO 140 -C ********** E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT -C THROUGH THE BOTTOM OF THE LOOP ********** - 120 CONTINUE -C - 140 IF (M .EQ. L) GO TO 280 - 160 IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - L1 = L + 1 - G = D(L) - P = (D(L1) - G) / (2.0D+00 * E(L)) - R = SQRT(P*P+1.0D+00) - D(L) = E(L) / (P + SIGN(R,P)) - H = G - D(L) -C - DO 180 I = L1, N - 180 D(I) = D(I) - H -C - F = F + H -C ********** QL TRANSFORMATION ********** - P = D(M) - C = 1.0D+00 - S = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - G = C * E(I) - H = C * P - IF (ABS(P) .LT. ABS(E(I))) GO TO 200 - C = E(I) / P - R = SQRT(C*C+1.0D+00) - E(I+1) = S * P * R - S = C / R - C = 1.0D+00 / R - GO TO 220 - 200 C = P / E(I) - R = SQRT(C*C+1.0D+00) - E(I+1) = S * E(I) * R - S = 1.0D+00 / R - C = C * S - 220 P = C * D(I) - S * G - D(I+1) = H + S * (C * G + S * D(I)) -C ********** FORM VECTOR ********** - CALL DROT(N,Z(1,I+1),1,Z(1,I),1,C,S) -C - 260 CONTINUE -C - E(L) = S * P - D(L) = C * P - IF (ABS(E(L)) .GT. B) GO TO 160 - 280 D(L) = D(L) + F - 300 CONTINUE -C ********** ORDER EIGENVALUES AND EIGENVECTORS ********** - DO 360 II = 2, N - I = II - 1 - K = I - P = D(I) -C - DO 320 J = II, N - IF (D(J) .GE. P) GO TO 320 - K = J - P = D(J) - 320 CONTINUE -C - IF (K .EQ. I) GO TO 360 - D(K) = D(I) - D(I) = P -C - CALL DSWAP(N,Z(1,I),1,Z(1,K),1) -C - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF TQL2 ********** - END -C*MODULE EIGEN *DECK TRBK3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRBK3B(NM,N,NV,A,M,Z) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),Z(NM,M) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY TRED3B. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANSFORMATIONS -C USED IN THE REDUCTION BY TRED3B IN ITS FIRST -C N*(N+1)/2 POSITIONS, -C -C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED, -C -C Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C IN ITS FIRST M COLUMNS. -C -C ON OUTPUT- -C -C Z CONTAINS THE TRANSFORMED EIGENVECTORS -C IN ITS FIRST M COLUMNS. -C -C NOTE THAT TRBAK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C - IF (M .EQ. 0) GO TO 140 - IF (N .EQ. 1) GO TO 140 -C - DO 120 I = 2, N - L = I - 1 - IZ = (I * L) / 2 - IK = IZ + I - H = A(IK) - IF (H .EQ. 0.0D+00) GO TO 120 -C - DO 100 J = 1, M - S = -DDOT(L,A(IZ+1),1,Z(1,J),1) -C -C ********** DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW ********** - S = (S / H) / H -C - CALL DAXPY(L,S,A(IZ+1),1,Z(1,J),1) -C - 100 CONTINUE -C - 120 CONTINUE -C - 140 RETURN -C ********** LAST CARD OF TRBAK3 ********** - END -C*MODULE EIGEN *DECK TRED3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRED3B(N,NV,A,D,E,E2) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),D(N),E(N),E2(N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE REDUCES A REAL SYMMETRIC MATRIX, STORED AS -C A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C USING ORTHOGONAL SIMILARITY TRANSFORMATIONS. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C -C ON OUTPUT- -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C TRANSFORMATIONS USED IN THE REDUCTION, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** FOR I=N STEP -1 UNTIL 1 DO -- ********** - DO 300 II = 1, N - I = N + 1 - II - L = I - 1 - IZ = (I * L) / 2 - H = 0.0D+00 - SCALE = 0.0D+00 - IF (L .LT. 1) GO TO 120 -C ********** SCALE ROW (ALGOL TOL THEN NOT NEEDED) ********** - DO 100 K = 1, L - IZ = IZ + 1 - D(K) = A(IZ) - SCALE = SCALE + ABS(D(K)) - 100 CONTINUE -C - IF (SCALE .NE. 0.0D+00) GO TO 140 - 120 E(I) = 0.0D+00 - E2(I) = 0.0D+00 - GO TO 280 -C - 140 DO 160 K = 1, L - D(K) = D(K) / SCALE - H = H + D(K) * D(K) - 160 CONTINUE -C - E2(I) = SCALE * SCALE * H - F = D(L) - G = -SIGN(SQRT(H),F) - E(I) = SCALE * G - H = H - F * G - D(L) = F - G - A(IZ) = SCALE * D(L) - IF (L .EQ. 1) GO TO 280 - F = 0.0D+00 -C - JK = 1 - DO 220 J = 1, L - JM1 = J - 1 - DT = D(J) - G = 0.0D+00 -C ********** FORM ELEMENT OF A*U ********** - IF (JM1 .EQ. 0) GO TO 200 - DO 180 K = 1, JM1 - E(K) = E(K) + DT * A(JK) - G = G + D(K) * A(JK) - JK = JK + 1 - 180 CONTINUE - 200 E(J) = G + A(JK) * DT - JK = JK + 1 -C ********** FORM ELEMENT OF P ********** - 220 CONTINUE - F = 0.0D+00 - DO 240 J = 1, L - E(J) = E(J) / H - F = F + E(J) * D(J) - 240 CONTINUE -C - HH = F / (H + H) - JK = 0 -C ********** FORM REDUCED A ********** - DO 260 J = 1, L - F = D(J) - G = E(J) - HH * F - E(J) = G -C - DO 260 K = 1, J - JK = JK + 1 - A(JK) = A(JK) - F * E(K) - G * D(K) - 260 CONTINUE -C - 280 D(I) = A(IZ+1) - A(IZ+1) = SCALE * SQRT(H) - 300 CONTINUE -C - RETURN -C ********** LAST CARD OF TRED3 ********** - END diff --git a/source/unres/src_MD-NEWSC-NEWC/elecont.f b/source/unres/src_MD-NEWSC-NEWC/elecont.f deleted file mode 100644 index e9ed067..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/elecont.f +++ /dev/null @@ -1,509 +0,0 @@ - subroutine elecont(lprint,ncont,icont) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - logical lprint - double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2) - double precision app_(2,2),bpp_(2,2),rpp_(2,2) - integer ncont,icont(2,maxcont) - double precision econt(maxcont) -* -* Load the constants of peptide bond - peptide bond interactions. -* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g. -* proline) - determined by averaging ECEPP energy. -* -* as of 7/06/91. -* -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ - data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ - data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ - data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ - data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/ - if (lprint) write (iout,'(a)') - & "Constants of electrostatic interaction energy expression." - do i=1,2 - do j=1,2 - rri=rpp_(i,j)**6 - app_(i,j)=epp(i,j)*rri*rri - bpp_(i,j)=-2.0*epp(i,j)*rri - ael6_(i,j)=elpp_6(i,j)*4.2**6 - ael3_(i,j)=elpp_3(i,j)*4.2**3 - if (lprint) - & write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j), - & ael3_(i,j) - enddo - enddo - ncont=0 - ees=0.0 - evdw=0.0 - do 1 i=nnt,nct-2 - xi=c(1,i) - yi=c(2,i) - zi=c(3,i) - dxi=c(1,i+1)-c(1,i) - dyi=c(2,i+1)-c(2,i) - dzi=c(3,i+1)-c(3,i) - xmedi=xi+0.5*dxi - ymedi=yi+0.5*dyi - zmedi=zi+0.5*dzi - do 4 j=i+2,nct-1 - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - if (iteli.eq.2 .and. itelj.eq.2) goto 4 - aaa=app_(iteli,itelj) - bbb=bpp_(iteli,itelj) - ael6_i=ael6_(iteli,itelj) - ael3_i=ael3_(iteli,itelj) - dxj=c(1,j+1)-c(1,j) - dyj=c(2,j+1)-c(2,j) - dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi - rrmij=1.0/(xj*xj+yj*yj+zj*zj) - rmij=sqrt(rrmij) - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - vrmij=vblinv*rmij - cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2 - cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij - cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij - fac=cosa-3.0*cosb*cosg - ev1=aaa*r6ij*r6ij - ev2=bbb*r6ij - fac3=ael6_i*r6ij - fac4=ael3_i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 - if (j.gt.i+2 .and. eesij.le.elcutoff .or. - & j.eq.i+2 .and. eesij.le.elecutoff_14) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - econt(ncont)=eesij - endif - ees=ees+eesij - evdw=evdw+evdwij - 4 continue - 1 continue - if (lprint) then - write (iout,*) 'Total average electrostatic energy: ',ees - write (iout,*) 'VDW energy between peptide-group centers: ',evdw - write (iout,*) - write (iout,*) 'Electrostatic contacts before pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif -c For given residues keep only the contacts with the greatest energy. - i=0 - do while (i.lt.ncont) - i=i+1 - ene=econt(i) - ic1=icont(1,i) - ic2=icont(2,i) - j=i - do while (j.lt.ncont) - j=j+1 - if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or. - & ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then -c write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2, -c & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont - if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j) - & .and. iabs(icont(1,k)-ic1).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j) - & .and. iabs(icont(2,k)-ic2).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - endif -c Remove ith contact - do k=i+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - i=i-1 - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - goto 20 - else if (econt(j).gt.ene .and. ic2.ne.ic1+2) - & then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2 - & .and. iabs(icont(1,k)-icont(1,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1 - & .and. iabs(icont(2,k)-icont(2,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - endif -c Remove jth contact - do k=j+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - j=j-1 - endif - endif - 21 continue - enddo - 20 continue - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Electrostatic contacts after pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif - return - end -c-------------------------------------------- - subroutine secondary2(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - integer ncont,icont(2,maxcont),isec(maxres,4),nsec(maxres) - logical lprint,not_done,freeres - double precision p1,p2 - external freeres - - if(.not.dccart) call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - nsec(i)=0 - enddo - - call elecont(lprint,ncont,icont) - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,'(a,i3,4i4)')'parallel beta', - & nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1+1 - bfrag(2,nbfrag)=i1+1 - bfrag(3,nbfrag)=jj1+1 - bfrag(4,nbfrag)=min0(j1+1,nres) - - do ij=ii1,i1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - do ij=jj1,j1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - p1=phi(i1+2)*rad2deg - p2=0.0 - if (j1+2.le.nres) p2=phi(j1+2)*rad2deg - - - if (j1.eq.i1+3 .and. - & ((p1.ge.10.and.p1.le.80).or.i1.le.2).and. - & ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2 -co if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2 - ii1=i1 - jj1=j1 - if (nsec(ii1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue - p1=phi(i1+2)*rad2deg - p2=phi(j1+2)*rad2deg - if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) - & not_done=.false. -cd write (iout,*) i1,j1,not_done,p1,p2 - enddo - j1=j1+1 - if (j1-ii1.gt.5) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=j1 - - do ij=ii1,j1 - nsec(ij)=-1 - enddo - if (lprint) then - write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=min0(i1+1,nres) - bfrag(3,nbfrag)=min0(jj1+1,nres) - bfrag(4,nbfrag)=j1 - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2) then - isec(ij,nsec(ij))=nbeta - endif - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2 .and. nsec(ij).gt.0) then - isec(ij,nsec(ij))=nbeta - endif - enddo - - - if (lprint) then - write (iout,'(a,i3,4i4)')'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - - - write(iout,*) 'UNRES seq:' - do j=1,nbfrag - write(iout,*) 'beta ',(bfrag(i,j),i=1,4) - enddo - - do j=1,nhfrag - write(iout,*) 'helix ',(hfrag(i,j),i=1,2) - enddo - endif - - return - end -c------------------------------------------------- - logical function freeres(i,j,nsec,isec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer isec(maxres,4),nsec(maxres) - freeres=.false. - - if (nsec(i).lt.0.or.nsec(j).lt.0) return - if (nsec(i).gt.1.or.nsec(j).gt.1) return - do k=1,nsec(i) - do l=1,nsec(j) - if (isec(i,k).eq.isec(j,l)) return - enddo - enddo - freeres=.true. - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/energy_p_new-sep_barrier.F b/source/unres/src_MD-NEWSC-NEWC/energy_p_new-sep_barrier.F deleted file mode 100644 index c89aee2..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/energy_p_new-sep_barrier.F +++ /dev/null @@ -1,2322 +0,0 @@ -C----------------------------------------------------------------------- - double precision function sscale(r) - double precision r,gamm - include "COMMON.SPLITELE" - if(r.lt.r_cut-rlamb) then - sscale=1.0d0 - else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then - gamm=(r-(r_cut-rlamb))/rlamb - sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) - else - sscale=0d0 - endif - return - end -C----------------------------------------------------------------------- - subroutine elj_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------- - subroutine elj_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine eljk_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine eljk_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine ebp_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine ebp_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine egb_long(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*(1.0d0-sss) - else - evdw_m=evdw_m+evdwij*(1.0d0-sss) - endif -#else - evdw=evdw+evdwij*(1.0d0-sss) -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(1.0d0-sss) - else - call sc_grad_scale(1.0d0-sss) - endif -#else - call sc_grad_scale(1.0d0-sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egb_short(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*sss - else - evdw_m=evdw_m+evdwij*sss - endif -#else - evdw=evdw+evdwij*sss -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(sss) - else - call sc_grad_scale(sss) - endif -#else - call sc_grad_scale(sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egbv_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- - subroutine egbv_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - return - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale_T(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwcT(l,i)=gvdwcT(l,i)-gg(l) - gvdwcT(l,j)=gvdwcT(l,j)+gg(l) - enddo - return - end - -C-------------------------------------------------------------------------- - subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C -C This subroutine calculates the average interaction energy and its gradient -C in the virtual-bond vectors between non-adjacent peptide groups, based on -C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. -C The potential depends both on the distance of peptide-group centers and on -C the orientation of the CA-CA virtual bonds. -C - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -cd write(iout,*) 'In EELEC' -cd do i=1,nloctyp -cd write(iout,*) 'Type',i -cd write(iout,*) 'B1',B1(:,i) -cd write(iout,*) 'B2',B2(:,i) -cd write(iout,*) 'CC',CC(:,:,i) -cd write(iout,*) 'DD',DD(:,:,i) -cd write(iout,*) 'EE',EE(:,:,i) -cd enddo -cd call check_vecgrad -cd stop - if (icheckgrad.eq.1) then - do i=1,nres-1 - fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) - do k=1,3 - dc_norm(k,i)=dc(k,i)*fac - enddo -c write (iout,*) 'i',i,' fac',fac - enddo - endif - if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. - & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -c call vec_and_deriv -#ifdef TIMING - time01=MPI_Wtime() -#endif - call set_matrices -#ifdef TIMING - time_mat=time_mat+MPI_Wtime()-time01 -#endif - endif -cd do i=1,nres-1 -cd write (iout,*) 'i=',i -cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -cd enddo -cd do k=1,3 -cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') -cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) -cd enddo -cd enddo - t_eelecij=0.0d0 - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=1,nres - num_cont_hb(i)=0 - enddo -cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - enddo -c -c -c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -C -C Loop over i,i+2 and i,i+3 pairs of the peptide groups -C - do i=iturn3_start,iturn3_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 - call eelecij_scale(i,i+2,ees,evdw1,eel_loc) - if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) - num_cont_hb(i)=num_conti - enddo - do i=iturn4_start,iturn4_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=num_cont_hb(i) - call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) - num_cont_hb(i)=num_conti - enddo ! i -c -c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -c - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - num_conti=num_cont_hb(i) - do j=ielstart(i),ielend(i) - call eelecij_scale(i,j,ees,evdw1,eel_loc) - enddo ! j - num_cont_hb(i)=num_conti - enddo ! i -c write (iout,*) "Number of loop steps in EELEC:",ind -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 -cd print *,"Processor",fg_rank," t_eelecij",t_eelecij - return - end -C------------------------------------------------------------------------------- - subroutine eelecij_scale(i,j,ees,evdw1,eel_loc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -c time00=MPI_Wtime() -cd write (iout,*) "eelecij",i,j - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - ael6i=ael6(iteli,itelj) - ael3i=ael3(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - rmij=1.0D0/rij -c For extracting the short-range part of Evdwpp - sss=sscale(rij/rpp(iteli,itelj)) - - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj - cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij - cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij - fac=cosa-3.0D0*cosb*cosg - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - fac3=ael6i*r6ij - fac4=ael3i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 -C 12/26/95 - for the evaluation of multi-body H-bonding interactions - ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij - evdw1=evdw1+evdwij*(1.0d0-sss) -cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, -cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, -cd & xmedi,ymedi,zmedi,xj,yj,zj - - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij - endif - -C -C Calculate contributions to the Cartesian gradient. -C -#ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) - facel=-3*rrmij*(el1+eesij) - fac1=fac - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -cgrad enddo -cgrad enddo -#else - facvdw=ev1+evdwij*(1.0d0-sss) - facel=el1+eesij - fac1=fac - fac=-3*rrmij*(facvdw+facvdw+facel) - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc(k,j)+ggg(k) - gelc_long(k,i)=gelc(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -#endif -* -* Angular part -* - ecosa=2.0D0*fac3*fac1+fac4 - fac4=-3.0D0*fac4 - fac3=-6.0D0*fac3 - ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4) - ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4) - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo -cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), -cd & (dcosg(k),k=1,3) - do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) - enddo -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -c gelc(k,j)=gelc(k,j)+ghalf -c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -c enddo -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo - IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 - & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C -C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction -C energy of a peptide unit is assumed in the form of a second-order -C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. -C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms -C are computed for EVERY pair of non-contiguous peptide groups. -C - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - kkk=0 - do k=1,2 - do l=1,2 - kkk=kkk+1 - muij(kkk)=mu(k,i)*mu(l,j) - enddo - enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij - ury=scalar(uy(1,i),erij) - urz=scalar(uz(1,i),erij) - vry=scalar(uy(1,j),erij) - vrz=scalar(uz(1,j),erij) - a22=scalar(uy(1,i),uy(1,j))-3*ury*vry - a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz - a32=scalar(uz(1,i),uy(1,j))-3*urz*vry - a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz - fac=dsqrt(-ael6i)*r3ij - a22=a22*fac - a23=a23*fac - a32=a32*fac - a33=a33*fac -cd write (iout,'(4i5,4f10.5)') -cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 -cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -cd & uy(:,j),uz(:,j) -cd write (iout,'(4f10.5)') -cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), -cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) -cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(9f10.5/)') -cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij -C Derivatives of the elements of A in virtual-bond vectors - call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) - do k=1,3 - uryg(k,1)=scalar(erder(1,k),uy(1,i)) - uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) - uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1)) - urzg(k,1)=scalar(erder(1,k),uz(1,i)) - urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1)) - urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1)) - vryg(k,1)=scalar(erder(1,k),uy(1,j)) - vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1)) - vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1)) - vrzg(k,1)=scalar(erder(1,k),uz(1,j)) - vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) - vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) - enddo -C Compute radial contributions to the gradient - facr=-3.0d0*rrmij - a22der=a22*facr - a23der=a23*facr - a32der=a32*facr - a33der=a33*facr - agg(1,1)=a22der*xj - agg(2,1)=a22der*yj - agg(3,1)=a22der*zj - agg(1,2)=a23der*xj - agg(2,2)=a23der*yj - agg(3,2)=a23der*zj - agg(1,3)=a32der*xj - agg(2,3)=a32der*yj - agg(3,3)=a32der*zj - agg(1,4)=a33der*xj - agg(2,4)=a33der*yj - agg(3,4)=a33der*zj -C Add the contributions coming from er - fac3=-3.0d0*fac - do k=1,3 - agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury) - agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury) - agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz) - agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz) - enddo - do k=1,3 -C Derivatives in DC(i) -cgrad ghalf1=0.5d0*agg(k,1) -cgrad ghalf2=0.5d0*agg(k,2) -cgrad ghalf3=0.5d0*agg(k,3) -cgrad ghalf4=0.5d0*agg(k,4) - aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)!+ghalf1 - aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)!+ghalf2 - aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)!+ghalf3 - aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -C Derivatives in DC(i+1) - aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)!+agg(k,1) - aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) - aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)!+agg(k,3) - aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -C Derivatives in DC(j) - aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)!+ghalf1 - aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)!+ghalf2 - aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)!+ghalf3 - aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -C Derivatives in DC(j+1) or DC(nres-1) - aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) - & -3.0d0*vryg(k,3)*ury) - aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) - & -3.0d0*vrzg(k,3)*ury) - aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) - & -3.0d0*vryg(k,3)*urz) - aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) - & -3.0d0*vrzg(k,3)*urz) -cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -cgrad do l=1,4 -cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -cgrad enddo -cgrad endif - enddo - acipa(1,1)=a22 - acipa(1,2)=a23 - acipa(2,1)=a32 - acipa(2,2)=a33 - a22=-a22 - a23=-a23 - do l=1,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - if (j.lt.nres-1) then - a22=-a22 - a32=-a32 - do l=1,3,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - else - a22=-a22 - a23=-a23 - a32=-a32 - a33=-a33 - do l=1,4 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - endif - ENDIF ! WCORR - IF (wel_loc.gt.0.0d0) THEN -C Contribution to the local-electrostatic energy coming from the i-j pair - eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) - & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eelloc',i,j,eel_loc_ij - - eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma - if (i.gt.1) - & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) - gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -cgrad ghalf=0.5d0*ggg(l) -cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf - enddo -cgrad do k=i+1,j2 -cgrad do l=1,3 -cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -C Remaining derivatives of eello - do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) - enddo - ENDIF -C Change 12/26/95 to calculate four-body contributions to H-bonding energy -c if (j.gt.i+1 .and. num_conti.le.maxconts) then - if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 - & .and. num_conti.le.maxconts) then -c write (iout,*) i,j," entered corr" -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -c r0ij=1.02D0*rpp(iteli,itelj) -c r0ij=1.11D0*rpp(iteli,itelj) - r0ij=2.20D0*rpp(iteli,itelj) -c r0ij=1.55D0*rpp(iteli,itelj) - call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) - if (fcont.gt.0.0D0) then - num_conti=num_conti+1 - if (num_conti.gt.maxconts) then - write (iout,*) 'WARNING - max. # of contacts exceeded;', - & ' will skip next contacts for this conf.' - else - jcont_hb(num_conti,i)=j -cd write (iout,*) "i",i," j",j," num_conti",num_conti, -cd & " jcont_hb",jcont_hb(num_conti,i) - IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. - & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el -C terms. - d_cont(num_conti,i)=rij -cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij -C --- Electrostatic-interaction matrix --- - a_chuj(1,1,num_conti,i)=a22 - a_chuj(1,2,num_conti,i)=a23 - a_chuj(2,1,num_conti,i)=a32 - a_chuj(2,2,num_conti,i)=a33 -C --- Gradient of rij - do kkk=1,3 - grij_hb_cont(kkk,num_conti,i)=erij(kkk) - enddo - kkll=0 - do k=1,2 - do l=1,2 - kkll=kkll+1 - do m=1,3 - a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll) - a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll) - a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) - a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) - a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) - enddo - enddo - enddo - ENDIF - IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN -C Calculate contact energies - cosa4=4.0D0*cosa - wij=cosa-3.0D0*cosb*cosg - cosbg1=cosb+cosg - cosbg2=cosb-cosg -c fac3=dsqrt(-ael6i)/r0ij**3 - fac3=dsqrt(-ael6i)*r3ij -c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 - if (ees0tmp.gt.0) then - ees0pij=dsqrt(ees0tmp) - else - ees0pij=0 - endif -c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) - ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 - if (ees0tmp.gt.0) then - ees0mij=dsqrt(ees0tmp) - else - ees0mij=0 - endif -c ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) -C Diagnostics. Comment out or remove after debugging! -c ees0p(num_conti,i)=0.5D0*fac3*ees0pij -c ees0m(num_conti,i)=0.5D0*fac3*ees0mij -c ees0m(num_conti,i)=0.0D0 -C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -C Angular derivatives of the contact function - ees0pij1=fac3/ees0pij - ees0mij1=fac3/ees0mij - fac3p=-3.0D0*fac3*rrmij - ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) - ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) -c ees0mij1=0.0D0 - ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) - ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) - ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) - ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) - ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) - ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) - ecosap=ecosa1+ecosa2 - ecosbp=ecosb1+ecosb2 - ecosgp=ecosg1+ecosg2 - ecosam=ecosa1-ecosa2 - ecosbm=ecosb1-ecosb2 - ecosgm=ecosg1-ecosg2 -C Diagnostics -c ecosap=ecosa1 -c ecosbp=ecosb1 -c ecosgp=ecosg1 -c ecosam=0.0D0 -c ecosbm=0.0D0 -c ecosgm=0.0D0 -C End diagnostics - facont_hb(num_conti,i)=fcont - fprimcont=fprimcont/rij -cd facont_hb(num_conti,i)=1.0D0 -C Following line is for diagnostics. -cd fprimcont=0.0D0 - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo - do k=1,3 - gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) - gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) - enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj -C Derivatives due to the contact function - gacont_hbr(1,num_conti,i)=fprimcont*xj - gacont_hbr(2,num_conti,i)=fprimcont*yj - gacont_hbr(3,num_conti,i)=fprimcont*zj - do k=1,3 -c -c 10/24/08 cgrad and ! comments indicate the parts of the code removed -c following the change of gradient-summation algorithm. -c -cgrad ghalfp=0.5D0*gggp(k) -cgrad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) - enddo - ENDIF ! wcorr - endif ! num_conti.le.maxconts - endif ! fcont.gt.0 - endif ! j.gt.i+1 - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then - do k=1,4 - do l=1,3 - ghalf=0.5d0*agg(l,k) - aggi(l,k)=aggi(l,k)+ghalf - aggi1(l,k)=aggi1(l,k)+agg(l,k) - aggj(l,k)=aggj(l,k)+ghalf - enddo - enddo - if (j.eq.nres-1 .and. i.lt.j-2) then - do k=1,4 - do l=1,3 - aggj1(l,k)=aggj1(l,k)+agg(l,k) - enddo - enddo - endif - endif -c t_eelecij=t_eelecij+MPI_Wtime()-time00 - return - end -C----------------------------------------------------------------------- - subroutine evdwpp_short(evdw1) -C -C Compute Evdwpp -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - dimension ggg(3) -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif - evdw1=0.0D0 -c write (iout,*) "iatel_s_vdw",iatel_s_vdw, -c & " iatel_e_vdw",iatel_e_vdw - call flush(iout) - do i=iatel_s_vdw,iatel_e_vdw - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 -c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), -c & ' ielend',ielend_vdw(i) - call flush(iout) - do j=ielstart_vdw(i),ielend_vdw(i) - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - sss=sscale(rij/rpp(iteli,itelj)) - if (sss.gt.0.0d0) then - rmij=1.0D0/rij - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - evdwij=ev1+ev2 - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - endif - evdw1=evdw1+evdwij*sss -C -C Calculate contributions to the Cartesian gradient. -C - facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo - endif - enddo ! j - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp_long(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.lt.1.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss) - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*(1.0d0-sss) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*(1.0d0-sss) - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine escp_short(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.gt.0.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*sss - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*sss - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*sss - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier.F b/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier.F deleted file mode 100644 index 62a4730..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier.F +++ /dev/null @@ -1,10979 +0,0 @@ - SUBROUTINE etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - if (nfgtasks.gt.1) then -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wsct -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wsct=weights(22) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106,107) ipot -C Lennard-Jones potential. - 101 call elj(evdw,evdw_p,evdw_m) -cd print '(a)','Exit ELJ' - goto 108 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw,evdw_p,evdw_m) - goto 108 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw,evdw_p,evdw_m) - goto 108 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw,evdw_p,evdw_m) - goto 108 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw,evdw_p,evdw_m) - goto 108 -C New SC-SC potential - 106 call emomo(evdw,evdw_p,evdw_m) - goto 108 -C Soft-sphere potential - 107 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 108 continue -cmc -cmc Sep-06: egb takes care of dynamic ss bonds too -cmc -c if (dyn_ss) call dyn_set_nss - -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif - call vec_and_deriv -#ifdef TIMING -#ifdef MPI - time_vec=time_vec+MPI_Wtime()-time01 -#else - time_vec=time_vec+tcpu()-time01 -#endif -#endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.7) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.7) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.7) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.7) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr - endif -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -#ifdef TIMING -#ifdef MPI - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#else - time_enecalc=time_enecalc+tcpu()-time00 -#endif -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) - if (dyn_ss) call dyn_set_nss -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING -#ifdef MPI - time_sumene=time_sumene+MPI_Wtime()-time00 -#else - time_sumene=time_sumene+tcpu()-time00 -#endif -#endif - RETURN - END SUBROUTINE etotal -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' -#endif - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres) - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' - include 'COMMON.SCCOR' -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time01=tcpu() -#endif -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3), - & (gvdwcT(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef SPLITELE -#ifdef TSCSC - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - enddo - enddo -c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG -c write (iout,*) "gradbufc_sum after allreduce" -c do i=1,nres -c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -c enddo -c call flush(iout) -#endif -#ifdef TIMING -c time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif -c -c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -c do not parallelize this part. -c -c do i=igrad_start,igrad_end -c do j=jgrad_start(i),jgrad_end(i) -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -c enddo -c enddo -c enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - gradbufc(j,i)=0.0d0 - enddo - enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -c do i=nnt,nres-1 -c do k=1,3 -c gradbufc(k,i)=0.0d0 -c enddo -c do j=i+1,nres -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -c enddo -c enddo -c enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=1,nct - do j=1,3 -#ifdef SPLITELE - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#endif -#ifdef TSCSC - gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+ - & wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#else - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#endif - enddo - enddo -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo -#ifdef DEBUG - write (iout,*) "gloc_sc before reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif - do i=1,nres - do j=1,3 - gloc_scbuf(j,i)=gloc_sc(j,i,icg) - enddo - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc_sc after reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#ifdef TSCSC - gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#endif - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#ifdef TSCSC - gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#endif - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING -#ifdef MPI - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#else - time_sumgradient=time_sumgradient+tcpu()-time01 -#endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact -#ifdef TSCSC -c wsct=t_bath/temp0 - wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 -#endif - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ebr*nss, - & Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ - & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ebr*nss,Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij - else - evdw_m=evdw_m+evdwij - endif -#else - evdw=evdw+evdwij -#endif -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -#ifdef TSCSC - if (bb(itypi,itypj).gt.0.0d0) then - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - else - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - gvdwcT(k,i)=gvdwcT(k,i)-gg(k) - gvdwcT(k,j)=gvdwcT(k,j)+gg(k) - enddo - endif -#else - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -#endif -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (r.< -c! om = omega, sqom = om^2 - sqom1 = om1 * om1 - sqom2 = om2 * om2 - sqom12 = om12 * om12 - -c! now we calculate EGB - Gey-Berne -c! It will be summed up in evdwij and saved in evdw - sigsq = 1.0D0 / sigsq - sig = sig0ij * dsqrt(sigsq) -c! rij_shift = 1.0D0 / rij - sig + sig0ij - rij_shift = Rtail - sig + sig0ij - IF (rij_shift.le.0.0D0) THEN - evdw = 1.0D20 - RETURN - END IF - sigder = -sig * sigsq - rij_shift = 1.0D0 / rij_shift - fac = rij_shift**expon - c1 = fac * fac * aa(itypi,itypj) -c! c1 = 0.0d0 - c2 = fac * bb(itypi,itypj) -c! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij -c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij - evdwij = eps2rt * eps3rt * evdwij -c! evdwij = 0.0d0 -c! write (*,*) "Gey Berne = ", evdwij -#ifdef TSCSC - IF (bb(itypi,itypj).gt.0) THEN - evdw_p = evdw_p + evdwij - ELSE - evdw_m = evdw_m + evdwij - END IF -#else - evdw = evdw - & + evdwij -#endif -c!------------------------------------------------------------------- -c! Calculate some components of GGB - c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 - fac = -expon * (c1 + evdwij) * rij_shift - sigder = fac * sigder -c! fac = rij * fac -c! Calculate distance derivative -c! gg(1) = xj * fac -c! gg(2) = yj * fac -c! gg(3) = zj * fac - gg(1) = fac - gg(2) = fac - gg(3) = fac -c! write (*,*) "gg(1) = ", gg(1) -c! write (*,*) "gg(2) = ", gg(2) -c! write (*,*) "gg(3) = ", gg(3) -c! The angular derivatives of GGB are brought together in sc_grad -c!------------------------------------------------------------------- -c! Fcav -c! -c! Catch gly-gly interactions to skip calculation of something that -c! does not exist - - IF (itypi.eq.10.and.itypj.eq.10) THEN - Fcav = 0.0d0 - dFdR = 0.0d0 - dCAVdOM1 = 0.0d0 - dCAVdOM2 = 0.0d0 - dCAVdOM12 = 0.0d0 - ELSE - -c! we are not 2 glycines, so we calculate Fcav (and maybe more) - fac = chis1 * sqom1 + chis2 * sqom2 - & - 2.0d0 * chis12 * om1 * om2 * om12 -c! we will use pom later in Gcav, so dont mess with it! - pom = 1.0d0 - chis1 * chis2 * sqom12 - - Lambf = (1.0d0 - (fac / pom)) - Lambf = dsqrt(Lambf) - - - sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) -c! write (*,*) "sparrow = ", sparrow - Chif = Rtail * sparrow - ChiLambf = Chif * Lambf - eagle = dsqrt(ChiLambf) - bat = ChiLambf ** 11.0d0 - - top = b1 * ( eagle + b2 * ChiLambf - b3 ) - bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0) - botsq = bot * bot - -c! write (*,*) "sig1 = ",sig1 -c! write (*,*) "sig2 = ",sig2 -c! write (*,*) "Rtail = ",Rtail -c! write (*,*) "sparrow = ",sparrow -c! write (*,*) "Chis1 = ", chis1 -c! write (*,*) "Chis2 = ", chis2 -c! write (*,*) "Chis12 = ", chis12 -c! write (*,*) "om1 = ", om1 -c! write (*,*) "om2 = ", om2 -c! write (*,*) "om12 = ", om12 -c! write (*,*) "sqom1 = ", sqom1 -c! write (*,*) "sqom2 = ", sqom2 -c! write (*,*) "sqom12 = ", sqom12 -c! write (*,*) "Lambf = ",Lambf -c! write (*,*) "b1 = ",b1 -c! write (*,*) "b2 = ",b2 -c! write (*,*) "b3 = ",b3 -c! write (*,*) "b4 = ",b4 -c! write (*,*) "top = ",top -c! write (*,*) "bot = ",bot - Fcav = top / bot -c! Fcav = 0.0d0 -c! write (*,*) "Fcav = ", Fcav -c!------------------------------------------------------------------- -c! derivative of Fcav is Gcav... -c!--------------------------------------------------- - - dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf)) - dbot = 12.0d0 * b4 * bat * Lambf - dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow -c! dFdR = 0.0d0 -c! write (*,*) "dFcav/dR = ", dFdR - - dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif)) - dbot = 12.0d0 * b4 * bat * Chif - eagle = Lambf * pom - dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) - dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) - dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) - & * (chis2 * om2 * om12 - om1) / (eagle * pom) - - dFdL = ((dtop * bot - top * dbot) / botsq) -c! dFdL = 0.0d0 - dCAVdOM1 = dFdL * ( dFdOM1 ) - dCAVdOM2 = dFdL * ( dFdOM2 ) - dCAVdOM12 = dFdL * ( dFdOM12 ) -c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1 -c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2 -c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12 -c! write (*,*) "" -c!------------------------------------------------------------------- -c! Finally, add the distance derivatives of GB and Fcav to gvdwc -c! Pom is used here to project the gradient vector into -c! cartesian coordinates and at the same time contains -c! dXhb/dXsc derivative (for charged amino acids -c! location of hydrophobic centre of interaction is not -c! the same as geometric centre of side chain, this -c! derivative takes that into account) -c! derivatives of omega angles will be added in sc_grad - - DO k= 1, 3 - ertail(k) = Rtail_distance(k)/Rtail - END DO - erdxi = scalar( ertail(1), dC_norm(1,i+nres) ) - erdxj = scalar( ertail(1), dC_norm(1,j+nres) ) - facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres) - facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres) - DO k = 1, 3 -c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) -c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) - pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - (( dFdR + gg(k) ) * pom) -c! & - ( dFdR * pom ) - pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + (( dFdR + gg(k) ) * pom) -c! & + ( dFdR * pom ) - - gvdwc(k,i) = gvdwc(k,i) - & - (( dFdR + gg(k) ) * ertail(k)) -c! & - ( dFdR * ertail(k)) - - gvdwc(k,j) = gvdwc(k,j) - & + (( dFdR + gg(k) ) * ertail(k)) -c! & + ( dFdR * ertail(k)) - - gg(k) = 0.0d0 -c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) -c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) - END DO - -c!------------------------------------------------------------------- -c! Compute head-head and head-tail energies for each state - - isel = iabs(Qi) + iabs(Qj) - IF (isel.eq.0) THEN -c! No charges - do nothing - eheadtail = 0.0d0 - - ELSE IF (isel.eq.4) THEN -c! Calculate dipole-dipole interactions - CALL edd(ecl) - eheadtail = ECL - - ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN -c! Charge-nonpolar interactions - CALL eqn(epol) - eheadtail = epol - - ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN -c! Nonpolar-charge interactions - CALL enq(epol) - eheadtail = epol - - ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN -c! Charge-dipole interactions - CALL eqd(ecl, elj, epol) - eheadtail = ECL + elj + epol - - ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN -c! Dipole-charge interactions - CALL edq(ecl, elj, epol) - eheadtail = ECL + elj + epol - - ELSE IF ((isel.eq.2.and. - & iabs(Qi).eq.1).and. - & nstate(itypi,itypj).eq.1) THEN -c! Same charge-charge interaction ( +/+ or -/- ) - CALL eqq(Ecl,Egb,Epol,Fisocav,Elj) - eheadtail = ECL + Egb + Epol + Fisocav + Elj - - ELSE IF ((isel.eq.2.and. - & iabs(Qi).eq.1).and. - & nstate(itypi,itypj).ne.1) THEN -c! Different charge-charge interaction ( +/- or -/+ ) - CALL energy_quad - & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) - END IF - END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav -c! write (*,*) "evdw = ", evdw -c! write (*,*) "Fcav = ", Fcav -c! write (*,*) "eheadtail = ", eheadtail - evdw = evdw - & + Fcav - & + eheadtail - - IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)') - & restyp(itype(i)),i,restyp(itype(j)),j, - & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj, - & Equad,evdw - IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)') - & restyp(itype(i)),i,restyp(itype(j)),j, - & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj, - & Equad,evdw -#IFDEF CHECK_MOMO - evdw = 0.0d0 - END DO ! troll -#ENDIF - -c!------------------------------------------------------------------- -c! As all angular derivatives are done, now we sum them up, -c! then transform and project into cartesian vectors and add to gvdwc -c! We call sc_grad always, with the exception of +/- interaction. -c! This is because energy_quad subroutine needs to handle -c! this job in his own way. -c! This IS probably not very efficient and SHOULD be optimised -c! but it will require major restructurization of emomo -c! so it will be left as it is for now -c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj) - IF (nstate(itypi,itypj).eq.1) THEN -#ifdef TSCSC - IF (bb(itypi,itypj).gt.0) THEN - CALL sc_grad - ELSE - CALL sc_grad_T - END IF -#else - CALL sc_grad -#endif - END IF -c!------------------------------------------------------------------- -c! NAPISY KONCOWE - END DO ! j - END DO ! iint - END DO ! i -c write (iout,*) "Number of loop steps in EGB:",ind -c energy_dec=.false. - RETURN - END SUBROUTINE emomo -c! END OF MOMO - - -C----------------------------------------------------------------------------- - - - SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar, facd3, facd4, federmaus, adler -c! Epol and Gpol analytical parameters - alphapol1 = alphapol(itypi,itypj) - alphapol2 = alphapol(itypj,itypi) -c! Fisocav and Gisocav analytical parameters - al1 = alphiso(1,itypi,itypj) - al2 = alphiso(2,itypi,itypj) - al3 = alphiso(3,itypi,itypj) - al4 = alphiso(4,itypi,itypj) - csig = (1.0d0 - & / dsqrt(sigiso1(itypi, itypj)**2.0d0 - & + sigiso2(itypi,itypj)**2.0d0)) -c! - pis = sig0head(itypi,itypj) - eps_head = epshead(itypi,itypj) - Rhead_sq = Rhead * Rhead -c! R1 - distance between head of ith side chain and tail of jth sidechain -c! R2 - distance between head of jth side chain and tail of ith sidechain - R1 = 0.0d0 - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances needed by Epol - R1=R1+(ctail(k,2)-chead(k,1))**2 - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - R2 = dsqrt(R2) - -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,1,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,1,itypi,itypj))**2)) - -c!------------------------------------------------------------------- -c! Coulomb electrostatic interaction - Ecl = (332.0d0 * Qij) / Rhead -c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / Rhead_sq - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 -c!------------------------------------------------------------------- -c! Generalised Born Solvent Polarization -c! Charged head polarizes the solvent - ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) - Fgb = sqrt( ( Rhead_sq ) + a12sq * ee) - Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb -c! Derivative of Egb is Ggb... - dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) - dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) ) - & / ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR -c!------------------------------------------------------------------- -c! Fisocav - isotropic cavity creation term -c! or "how much energy it costs to put charged head in water" - pom = Rhead * csig - top = al1 * (dsqrt(pom) + al2 * pom - al3) - bot = (1.0d0 + al4 * pom**12.0d0) - botsq = bot * bot - FisoCav = top / bot -c! write (*,*) "Rhead = ",Rhead -c! write (*,*) "csig = ",csig -c! write (*,*) "pom = ",pom -c! write (*,*) "al1 = ",al1 -c! write (*,*) "al2 = ",al2 -c! write (*,*) "al3 = ",al3 -c! write (*,*) "al4 = ",al4 -c! write (*,*) "top = ",top -c! write (*,*) "bot = ",bot -c! Derivative of Fisocav is GCV... - dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) - dbot = 12.0d0 * al4 * pom ** 11.0d0 - dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig -c!------------------------------------------------------------------- -c! Epol -c! Polarization energy - charged heads polarize hydrophobic "neck" - MomoFac1 = (1.0d0 - chi1 * sqom2) - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR1 = ( R1 * R1 ) / MomoFac1 - RR2 = ( R2 * R2 ) / MomoFac2 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1 ) - fgb2 = sqrt( RR2 + a12sq * ee2 ) - epol = 332.0d0 * eps_inout_fac * ( - & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) -c! epol = 0.0d0 -c write (*,*) "eps_inout_fac = ",eps_inout_fac -c write (*,*) "alphapol1 = ", alphapol1 -c write (*,*) "alphapol2 = ", alphapol2 -c write (*,*) "fgb1 = ", fgb1 -c write (*,*) "fgb2 = ", fgb2 -c write (*,*) "epol = ", epol -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / ( 2.0d0 * fgb2 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * ( 2.0d0 - 0.5d0 * ee1) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * ( 2.0d0 - 0.5d0 * ee2) ) - & / ( 2.0d0 * fgb2 ) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 -c! dPOLdR1 = 0.0d0 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 -c! dPOLdR2 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 -c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj -c! Lennard-Jones 6-12 interaction between heads - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps_head - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c!------------------------------------------------------------------- -c! Return the results -c! These things do the dRdX derivatives, that is -c! allow us to change what we see from function that changes with -c! distance to function that changes with LOCATION (of the interaction -c! site) - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) - facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) - -c! Now we add appropriate partial derivatives (one in each dimension) - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - condor = (erhead_tail(k,2) + - & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dGGBdR * pom - & - dGCVdR * pom - & - dPOLdR1 * hawk - & - dPOLdR2 * (erhead_tail(k,2) - & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dGGBdR * pom - & + dGCVdR * pom - & + dPOLdR1 * (erhead_tail(k,1) - & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) - & + dPOLdR2 * condor - & + dGLJdR * pom - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dGGBdR * erhead(k) - & - dGCVdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dGGBdR * erhead(k) - & + dGCVdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE eqq -c!------------------------------------------------------------------- - SUBROUTINE energy_quad - &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - double precision ener(4) - double precision dcosom1(3),dcosom2(3) -c! used in Epol derivatives - double precision facd3, facd4 - double precision federmaus, adler -c! Epol and Gpol analytical parameters - alphapol1 = alphapol(itypi,itypj) - alphapol2 = alphapol(itypj,itypi) -c! Fisocav and Gisocav analytical parameters - al1 = alphiso(1,itypi,itypj) - al2 = alphiso(2,itypi,itypj) - al3 = alphiso(3,itypi,itypj) - al4 = alphiso(4,itypi,itypj) - csig = (1.0d0 - & / dsqrt(sigiso1(itypi, itypj)**2.0d0 - & + sigiso2(itypi,itypj)**2.0d0)) -c! - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps_head = epshead(itypi,itypj) -c! First things first: -c! We need to do sc_grad's job with GB and Fcav - eom1 = - & eps2der * eps2rt_om1 - & - 2.0D0 * alf1 * eps3der - & + sigder * sigsq_om1 - & + dCAVdOM1 - eom2 = - & eps2der * eps2rt_om2 - & + 2.0D0 * alf2 * eps3der - & + sigder * sigsq_om2 - & + dCAVdOM2 - eom12 = - & evdwij * eps1_om12 - & + eps2der * eps2rt_om12 - & - 2.0D0 * alf12 * eps3der - & + sigder *sigsq_om12 - & + dCAVdOM12 -c! now some magical transformations to project gradient into -c! three cartesian vectors - DO k = 1, 3 - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) - gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) -c! this acts on hydrophobic center of interaction - gvdwx(k,i)= gvdwx(k,i) - gg(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)= gvdwx(k,j) + gg(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c! this acts on Calpha - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - END DO -c! sc_grad is done, now we will compute - eheadtail = 0.0d0 - eom1 = 0.0d0 - eom2 = 0.0d0 - eom12 = 0.0d0 - -c! ENERGY DEBUG -c! ii = 1 -c! jj = 1 -c! d1 = dhead(1, 1, itypi, itypj) -c! d2 = dhead(2, 1, itypi, itypj) -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,ii,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,jj,itypi,itypj))**2)) -c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2)) -c! END OF ENERGY DEBUG -c************************************************************* - DO istate = 1, nstate(itypi,itypj) -c************************************************************* - IF (istate.ne.1) THEN - IF (istate.lt.3) THEN - ii = 1 - ELSE - ii = 2 - END IF - jj = istate/ii - d1 = dhead(1,ii,itypi,itypj) - d2 = dhead(2,jj,itypi,itypj) - DO k = 1,3 - chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) - chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) - Rhead_distance(k) = chead(k,2) - chead(k,1) - END DO -c! pitagoras (root of sum of squares) - Rhead = dsqrt( - & (Rhead_distance(1)*Rhead_distance(1)) - & + (Rhead_distance(2)*Rhead_distance(2)) - & + (Rhead_distance(3)*Rhead_distance(3))) - END IF - Rhead_sq = Rhead * Rhead - -c! R1 - distance between head of ith side chain and tail of jth sidechain -c! R2 - distance between head of jth side chain and tail of ith sidechain - R1 = 0.0d0 - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - R2 = dsqrt(R2) - -c! ENERGY DEBUG -c! write (*,*) "istate = ", istate -c! write (*,*) "ii = ", ii -c! write (*,*) "jj = ", jj -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,ii,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,jj,itypi,itypj))**2)) -c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2)) -c! Rhead_sq = Rhead * Rhead -c! write (*,*) "d1 = ",d1 -c! write (*,*) "d2 = ",d2 -c! write (*,*) "R1 = ",R1 -c! write (*,*) "R2 = ",R2 -c! write (*,*) "Rhead = ",Rhead -c! END OF ENERGY DEBUG - -c!------------------------------------------------------------------- -c! Coulomb electrostatic interaction - Ecl = (332.0d0 * Qij) / (Rhead * eps_in) -c! Ecl = 0.0d0 -c! write (*,*) "Ecl = ", Ecl -c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in) -c! dGCLdR = 0.0d0 - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 -c!------------------------------------------------------------------- -c! Generalised Born Solvent Polarization - ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) - Fgb = sqrt( ( Rhead_sq ) + a12sq * ee) - Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb -c! Egb = 0.0d0 -c! write (*,*) "a1*a2 = ", a12sq -c! write (*,*) "Rhead = ", Rhead -c! write (*,*) "Rhead_sq = ", Rhead_sq -c! write (*,*) "ee = ", ee -c! write (*,*) "Fgb = ", Fgb -c! write (*,*) "fac = ", eps_inout_fac -c! write (*,*) "Qij = ", Qij -c! write (*,*) "Egb = ", Egb -c! Derivative of Egb is Ggb... -c! dFGBdR is used by Quad's later... - dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) - dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) ) - & / ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR -c! dGGBdR = 0.0d0 -c!------------------------------------------------------------------- -c! Fisocav - isotropic cavity creation term - pom = Rhead * csig - top = al1 * (dsqrt(pom) + al2 * pom - al3) - bot = (1.0d0 + al4 * pom**12.0d0) - botsq = bot * bot - FisoCav = top / bot -c! FisoCav = 0.0d0 -c! write (*,*) "pom = ",pom -c! write (*,*) "al1 = ",al1 -c! write (*,*) "al2 = ",al2 -c! write (*,*) "al3 = ",al3 -c! write (*,*) "al4 = ",al4 -c! write (*,*) "top = ",top -c! write (*,*) "bot = ",bot -c! write (*,*) "Fisocav = ", Fisocav - -c! Derivative of Fisocav is GCV... - dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) - dbot = 12.0d0 * al4 * pom ** 11.0d0 - dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig -c! dGCVdR = 0.0d0 -c!------------------------------------------------------------------- -c! Polarization energy -c! Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR1 = ( R1 * R1 ) / MomoFac1 - RR2 = ( R2 * R2 ) / MomoFac2 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1 ) - fgb2 = sqrt( RR2 + a12sq * ee2 ) - epol = 332.0d0 * eps_inout_fac * ( - & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) -c! epol = 0.0d0 -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / ( 2.0d0 * fgb2 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * ( 2.0d0 - 0.5d0 * ee1) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * ( 2.0d0 - 0.5d0 * ee2) ) - & / ( 2.0d0 * fgb2 ) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 -c! dPOLdR1 = 0.0d0 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 -c! dPOLdR2 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 -c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) -c! Elj = 0.0d0 -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps_head - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c! dGLJdR = 0.0d0 -c!------------------------------------------------------------------- -c! Equad - IF (Wqd.ne.0.0d0) THEN - Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) - & - 37.5d0 * ( sqom1 + sqom2 ) - & + 157.5d0 * ( sqom1 * sqom2 ) - & - 45.0d0 * om1*om2*om12 - fac = -( Wqd / (2.0d0 * Fgb**5.0d0) ) - Equad = fac * Beta1 -c! Equad = 0.0d0 -c! derivative of Equad... - dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR -c! dQUADdR = 0.0d0 - dQUADdOM1 = fac - & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12) -c! dQUADdOM1 = 0.0d0 - dQUADdOM2 = fac - & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12) -c! dQUADdOM2 = 0.0d0 - dQUADdOM12 = fac - & * ( 6.0d0*om12 - 45.0d0*om1*om2 ) -c! dQUADdOM12 = 0.0d0 - ELSE - Beta1 = 0.0d0 - Equad = 0.0d0 - END IF -c!------------------------------------------------------------------- -c! Return the results -c! Angular stuff - eom1 = dPOLdOM1 + dQUADdOM1 - eom2 = dPOLdOM2 + dQUADdOM2 - eom12 = dQUADdOM12 -c! now some magical transformations to project gradient into -c! three cartesian vectors - DO k = 1, 3 - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) - tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k) - END DO -c! Radial stuff - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) - facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) -c! Throw the results into gheadtail which holds gradients -c! for each micro-state - DO k = 1, 3 - hawk = erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)) - condor = erhead_tail(k,2) + - & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) -c! this acts on hydrophobic center of interaction - gheadtail(k,1,1) = gheadtail(k,1,1) - & - dGCLdR * pom - & - dGGBdR * pom - & - dGCVdR * pom - & - dPOLdR1 * hawk - & - dPOLdR2 * (erhead_tail(k,2) - & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) - & - dGLJdR * pom - & - dQUADdR * pom - & - tuna(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) -c! this acts on hydrophobic center of interaction - gheadtail(k,2,1) = gheadtail(k,2,1) - & + dGCLdR * pom - & + dGGBdR * pom - & + dGCVdR * pom - & + dPOLdR1 * (erhead_tail(k,1) - & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) - & + dPOLdR2 * condor - & + dGLJdR * pom - & + dQUADdR * pom - & + tuna(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - -c! this acts on Calpha - gheadtail(k,3,1) = gheadtail(k,3,1) - & - dGCLdR * erhead(k) - & - dGGBdR * erhead(k) - & - dGCVdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - & - dQUADdR * erhead(k) - & - tuna(k) - -c! this acts on Calpha - gheadtail(k,4,1) = gheadtail(k,4,1) - & + dGCLdR * erhead(k) - & + dGGBdR * erhead(k) - & + dGCVdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - & + dQUADdR * erhead(k) - & + tuna(k) - END DO -c! write(*,*) "ECL = ", Ecl -c! write(*,*) "Egb = ", Egb -c! write(*,*) "Epol = ", Epol -c! write(*,*) "Fisocav = ", Fisocav -c! write(*,*) "Elj = ", Elj -c! write(*,*) "Equad = ", Equad -c! write(*,*) "wstate = ", wstate(istate,itypi,itypj) -c! write(*,*) "eheadtail = ", eheadtail -c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate)) -c! write(*,*) "dGCLdR = ", dGCLdR -c! write(*,*) "dGGBdR = ", dGGBdR -c! write(*,*) "dGCVdR = ", dGCVdR -c! write(*,*) "dPOLdR1 = ", dPOLdR1 -c! write(*,*) "dPOLdR2 = ", dPOLdR2 -c! write(*,*) "dGLJdR = ", dGLJdR -c! write(*,*) "dQUADdR = ", dQUADdR -c! write(*,*) "tuna(",k,") = ", tuna(k) - ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad - eheadtail = eheadtail - & + wstate(istate, itypi, itypj) - & * dexp(-betaT * ener(istate)) -c! foreach cartesian dimension - DO k = 1, 3 -c! foreach of two gvdwx and gvdwc - DO l = 1, 4 - gheadtail(k,l,2) = gheadtail(k,l,2) - & + wstate( istate, itypi, itypj ) - & * dexp(-betaT * ener(istate)) - & * gheadtail(k,l,1) - gheadtail(k,l,1) = 0.0d0 - END DO - END DO - END DO -c! Here ended the gigantic DO istate = 1, 4, which starts -c! at the beggining of the subroutine - - DO k = 1, 3 - DO l = 1, 4 - gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail - END DO - gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2) - gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2) - gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2) - gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2) - DO l = 1, 4 - gheadtail(k,l,1) = 0.0d0 - gheadtail(k,l,2) = 0.0d0 - END DO - END DO - eheadtail = (-dlog(eheadtail)) / betaT - dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 - dQUADdOM1 = 0.0d0 - dQUADdOM2 = 0.0d0 - dQUADdOM12 = 0.0d0 - RETURN - END SUBROUTINE energy_quad - - -c!------------------------------------------------------------------- - - - SUBROUTINE eqn(Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar, facd4, federmaus - alphapol1 = alphapol(itypi,itypj) -c! R1 - distance between head of ith side chain and tail of jth sidechain - R1 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,1,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,1,itypi,itypj))**2)) -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - RR1 = R1 * R1 / MomoFac1 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1) - epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) -c! epol = 0.0d0 -c!------------------------------------------------------------------ -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * (2.0d0 - 0.5d0 * ee1) ) - & / (2.0d0 * fgb1) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 -c! dPOLdR1 = 0.0d0 - dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Return the results -c! (see comments in Eqq) - DO k = 1, 3 - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - END DO - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) - facd1 = d1 * vbld_inv(i+nres) - facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - - gvdwx(k,i) = gvdwx(k,i) - & - dPOLdR1 * hawk - gvdwx(k,j) = gvdwx(k,j) - & + dPOLdR1 * (erhead_tail(k,1) - & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) - - gvdwc(k,i) = gvdwc(k,i) - & - dPOLdR1 * erhead_tail(k,1) - gvdwc(k,j) = gvdwc(k,j) - & + dPOLdR1 * erhead_tail(k,1) - - END DO - RETURN - END SUBROUTINE eqn - - -c!------------------------------------------------------------------- - - - - SUBROUTINE enq(Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar, facd3, adler - alphapol2 = alphapol(itypj,itypi) -c! R2 - distance between head of jth side chain and tail of ith sidechain - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R2 = dsqrt(R2) - -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,1,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,1,itypi,itypj))**2)) -c------------------------------------------------------------------------ -c Polarization energy - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR2 = R2 * R2 / MomoFac2 - ee2 = exp(-(RR2 / (4.0d0 * a12sq))) - fgb2 = sqrt(RR2 + a12sq * ee2) - epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) -c! epol = 0.0d0 -c!------------------------------------------------------------------- -c! derivative of Epol is Gpol... - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / (2.0d0 * fgb2) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * (2.0d0 - 0.5d0 * ee2) ) - & / (2.0d0 * fgb2) - dPOLdR2 = dPOLdFGB2 * dFGBdR2 -c! dPOLdR2 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 -c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Return the results -c! (See comments in Eqq) - DO k = 1, 3 - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) - facd2 = d2 * vbld_inv(j+nres) - facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) - DO k = 1, 3 - condor = (erhead_tail(k,2) - & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - gvdwx(k,i) = gvdwx(k,i) - & - dPOLdR2 * (erhead_tail(k,2) - & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) - gvdwx(k,j) = gvdwx(k,j) - & + dPOLdR2 * condor - - gvdwc(k,i) = gvdwc(k,i) - & - dPOLdR2 * erhead_tail(k,2) - gvdwc(k,j) = gvdwc(k,j) - & + dPOLdR2 * erhead_tail(k,2) - - END DO - RETURN - END SUBROUTINE enq - - -c!------------------------------------------------------------------- - - - SUBROUTINE eqd(Ecl,Elj,Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar, facd4, federmaus - alphapol1 = alphapol(itypi,itypj) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps_head = epshead(itypi,itypj) -c!------------------------------------------------------------------- -c! R1 - distance between head of ith side chain and tail of jth sidechain - R1 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,1,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,1,itypi,itypj))**2)) - -c!------------------------------------------------------------------- -c! ecl - sparrow = w1 * Qi * om1 - hawk = w2 * Qi * Qi * (1.0d0 - sqom2) - Ecl = sparrow / Rhead**2.0d0 - & - hawk / Rhead**4.0d0 -c!------------------------------------------------------------------- -c! derivative of ecl is Gcl -c! dF/dr part - dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 - & + 4.0d0 * hawk / Rhead**5.0d0 -c! dF/dom1 - dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) -c! dF/dom2 - dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - RR1 = R1 * R1 / MomoFac1 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1) - epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) -c! epol = 0.0d0 -c!------------------------------------------------------------------ -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * (2.0d0 - 0.5d0 * ee1) ) - & / (2.0d0 * fgb1) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 -c! dPOLdR1 = 0.0d0 - dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps_head - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - END DO - - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dPOLdR1 * hawk - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dPOLdR1 * (erhead_tail(k,1) - & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) - & + dGLJdR * pom - - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE eqd - - -c!------------------------------------------------------------------- - - - SUBROUTINE edq(Ecl,Elj,Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar, facd3, adler - alphapol2 = alphapol(itypj,itypi) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps_head = epshead(itypi,itypj) -c!------------------------------------------------------------------- -c! R2 - distance between head of jth side chain and tail of ith sidechain - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R2 = dsqrt(R2) - -c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) -c! & +dhead(1,1,itypi,itypj))**2)) -c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) -c! & +dhead(2,1,itypi,itypj))**2)) - - -c!------------------------------------------------------------------- -c! ecl - sparrow = w1 * Qi * om1 - hawk = w2 * Qi * Qi * (1.0d0 - sqom2) - ECL = sparrow / Rhead**2.0d0 - & - hawk / Rhead**4.0d0 -c!------------------------------------------------------------------- -c! derivative of ecl is Gcl -c! dF/dr part - dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 - & + 4.0d0 * hawk / Rhead**5.0d0 -c! dF/dom1 - dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) -c! dF/dom2 - dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR2 = R2 * R2 / MomoFac2 - ee2 = exp(-(RR2 / (4.0d0 * a12sq))) - fgb2 = sqrt(RR2 + a12sq * ee2) - epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) -c! epol = 0.0d0 -c! derivative of Epol is Gpol... - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / (2.0d0 * fgb2) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * (2.0d0 - 0.5d0 * ee2) ) - & / (2.0d0 * fgb2) - dPOLdR2 = dPOLdFGB2 * dFGBdR2 -c! dPOLdR2 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 -c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps_head - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c!------------------------------------------------------------------- -c! Return the results -c! (see comments in Eqq) - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) - - DO k = 1, 3 - condor = (erhead_tail(k,2) - & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dPOLdR2 * (erhead_tail(k,2) - & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dPOLdR2 * condor - & + dGLJdR * pom - - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE edq - - -C-------------------------------------------------------------------- - - - SUBROUTINE edd(ECL) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar -c! csig = sigiso(itypi,itypj) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) -c!------------------------------------------------------------------- -c! ECL - fac = (om12 - 3.0d0 * om1 * om2) - c1 = (w1 / (Rhead**3.0d0)) * fac - c2 = (w2 / Rhead ** 6.0d0) - & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) - ECL = c1 - c2 -c! write (*,*) "w1 = ", w1 -c! write (*,*) "w2 = ", w2 -c! write (*,*) "om1 = ", om1 -c! write (*,*) "om2 = ", om2 -c! write (*,*) "om12 = ", om12 -c! write (*,*) "fac = ", fac -c! write (*,*) "c1 = ", c1 -c! write (*,*) "c2 = ", c2 -c! write (*,*) "Ecl = ", Ecl -c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0) -c! write (*,*) "c2_2 = ", -c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) -c!------------------------------------------------------------------- -c! dervative of ECL is GCL... -c! dECL/dr - c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0) - c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) - & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) - dGCLdR = c1 - c2 -c! dECL/dom1 - c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0) - c2 = (-6.0d0 * w2) / (Rhead**6.0d0) - & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 ) - dGCLdOM1 = c1 - c2 -c! dECL/dom2 - c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) - c2 = (-6.0d0 * w2) / (Rhead**6.0d0) - & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) - dGCLdOM2 = c1 - c2 -c! dECL/dom12 - c1 = w1 / (Rhead ** 3.0d0) - c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 - dGCLdOM12 = c1 - c2 -c!------------------------------------------------------------------- -c! Return the results -c! (see comments in Eqq) - DO k= 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - END DO - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - DO k = 1, 3 - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - END DO - RETURN - END SUBROUTINE edd - - -c!------------------------------------------------------------------- - - - SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol) - IMPLICIT NONE -c! maxres - INCLUDE 'DIMENSIONS' -c! itypi, itypj, i, j, k, l, chead, - INCLUDE 'COMMON.CALC' -c! c, nres, dc_norm - INCLUDE 'COMMON.CHAIN' -c! gradc, gradx - INCLUDE 'COMMON.DERIV' -c! electrostatic gradients-specific variables - INCLUDE 'COMMON.EMP' -c! wquad, dhead, alphiso, alphasur, rborn, epsintab - INCLUDE 'COMMON.INTERACT' -c! t_bath, Rb - INCLUDE 'COMMON.MD' -c! io for debug, disable it in final builds - INCLUDE 'COMMON.IOUNITS' -c!------------------------------------------------------------------- -c! Variable Init - -c! what amino acid is the aminoacid j'th? - itypj = itype(j) -c! 1/(Gas Constant * Thermostate temperature) = BetaT -c! ENABLE THIS LINE WHEN USING CHECKGRAD!!! -c! t_bath = 300 -c! BetaT = 1.0d0 / (t_bath * Rb) - BetaT = 1.0d0 / (298.0d0 * Rb) -c! Gay-berne var's - sig0ij = sigma( itypi,itypj ) - chi1 = chi( itypi, itypj ) - chi2 = chi( itypj, itypi ) - chi12 = chi1 * chi2 - chip1 = chipp( itypi, itypj ) - chip2 = chipp( itypj, itypi ) - chip12 = chip1 * chip2 -c! not used by momo potential, but needed by sc_angular which is shared -c! by all energy_potential subroutines - alf1 = 0.0d0 - alf2 = 0.0d0 - alf12 = 0.0d0 -c! location, location, location - xj = c( 1, nres+j ) - xi - yj = c( 2, nres+j ) - yi - zj = c( 3, nres+j ) - zi - dxj = dc_norm( 1, nres+j ) - dyj = dc_norm( 2, nres+j ) - dzj = dc_norm( 3, nres+j ) -c! distance from center of chain(?) to polar/charged head -c! write (*,*) "istate = ", 1 -c! write (*,*) "ii = ", 1 -c! write (*,*) "jj = ", 1 - d1 = dhead(1, 1, itypi, itypj) - d2 = dhead(2, 1, itypi, itypj) -c! ai*aj from Fgb - a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) -c! a12sq = a12sq * a12sq -c! charge of amino acid itypi is... - Qi = icharge(itypi) - Qj = icharge(itypj) - Qij = Qi * Qj -c! chis1,2,12 - chis1 = chis(itypi,itypj) - chis2 = chis(itypj,itypi) - chis12 = chis1 * chis2 - sig1 = sigmap1(itypi,itypj) - sig2 = sigmap2(itypi,itypj) -c! write (*,*) "sig1 = ", sig1 -c! write (*,*) "sig2 = ", sig2 -c! alpha factors from Fcav/Gcav - b1 = alphasur(1,itypi,itypj) - b2 = alphasur(2,itypi,itypj) - b3 = alphasur(3,itypi,itypj) - b4 = alphasur(4,itypi,itypj) -c! used to determine whether we want to do quadrupole calculations - wqd = wquad(itypi, itypj) -c! used by Fgb - eps_in = epsintab(itypi,itypj) - eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) -c! write (*,*) "eps_inout_fac = ", eps_inout_fac -c!------------------------------------------------------------------- -c! tail location and distance calculations - Rtail = 0.0d0 - DO k = 1, 3 - ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i) - ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j) - END DO -c! tail distances will be themselves usefull elswhere -c1 (in Gcav, for example) - Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 ) - Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 ) - Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 ) - Rtail = dsqrt( - & (Rtail_distance(1)*Rtail_distance(1)) - & + (Rtail_distance(2)*Rtail_distance(2)) - & + (Rtail_distance(3)*Rtail_distance(3))) -c!------------------------------------------------------------------- -c! Calculate location and distance between polar heads -c! distance between heads -c! for each one of our three dimensional space... - DO k = 1,3 -c! location of polar head is computed by taking hydrophobic centre -c! and moving by a d1 * dc_norm vector -c! see unres publications for very informative images - chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) - chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) -c! distance -c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) -c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) - Rhead_distance(k) = chead(k,2) - chead(k,1) - END DO -c! pitagoras (root of sum of squares) - Rhead = dsqrt( - & (Rhead_distance(1)*Rhead_distance(1)) - & + (Rhead_distance(2)*Rhead_distance(2)) - & + (Rhead_distance(3)*Rhead_distance(3))) -c!------------------------------------------------------------------- -c! zero everything that should be zero'ed - Egb = 0.0d0 - ECL = 0.0d0 - Elj = 0.0d0 - Equad = 0.0d0 - Epol = 0.0d0 - eheadtail = 0.0d0 - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 - dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 - RETURN - END SUBROUTINE elgrad_init - - -c!------------------------------------------------------------------- - - subroutine sc_angular -C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2, -C om12. Called by ebp, egb, and egbv. - implicit none - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj -c! om1 = 0.0d0 -c! om2 = 0.0d0 -c! om12 = 0.0d0 - chiom12=chi12*om12 -C Calculate eps1(om12) and its derivative in om12 - faceps1=1.0D0-om12*chiom12 - faceps1_inv=1.0D0/faceps1 - eps1=dsqrt(faceps1_inv) -C Following variable is eps1*deps1/dom12 - eps1_om12=faceps1_inv*chiom12 -c diagnostics only -c faceps1_inv=om12 -c eps1=om12 -c eps1_om12=1.0d0 -c write (iout,*) "om12",om12," eps1",eps1 -C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2, -C and om12. - om1om2=om1*om2 - chiom1=chi1*om1 - chiom2=chi2*om2 - facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12 - sigsq=1.0D0-facsig*faceps1_inv - sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv - sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv - sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2 -c diagnostics only -c sigsq=1.0d0 -c sigsq_om1=0.0d0 -c sigsq_om2=0.0d0 -c sigsq_om12=0.0d0 -c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12 -c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv, -c & " eps1",eps1 -C Calculate eps2 and its derivatives in om1, om2, and om12. - chipom1=chip1*om1 - chipom2=chip2*om2 - chipom12=chip12*om12 - facp=1.0D0-om12*chipom12 - facp_inv=1.0D0/facp - facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12 -c write (iout,*) "chipom1",chipom1," chipom2",chipom2, -c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv -C Following variable is the square root of eps2 - eps2rt=1.0D0-facp1*facp_inv -C Following three variables are the derivatives of the square root of eps -C in om1, om2, and om12. - eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv - eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv - eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2 -C Evaluate the "asymmetric" factor in the VDW constant, eps3 -c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular -c! Or frankly, we should restructurize the whole energy section - eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12 -c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt -c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2, -c & " eps2rt_om12",eps2rt_om12 -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - return - end - -C---------------------------------------------------------------------------- - subroutine sc_grad_T - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - do l=1,3 - gvdwcT(l,i)=gvdwcT(l,i)-gg(l) - gvdwcT(l,j)=gvdwcT(l,j)+gg(l) - enddo - return - end - -C---------------------------------------------------------------------------- - - - SUBROUTINE sc_grad - IMPLICIT real*8 (a-h,o-z) - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.EMP' - double precision dcosom1(3),dcosom2(3) -c! write (*,*) "Start sc_grad" -c! each eom holds sum of omega-angular derivatives of each component -c! of energy function. First GGB, then Gcav, dipole-dipole,... - eom1 = - & eps2der * eps2rt_om1 - & - 2.0D0 * alf1 * eps3der - & + sigder * sigsq_om1 - & + dCAVdOM1 - & + dGCLdOM1 - & + dPOLdOM1 - - eom2 = - & eps2der * eps2rt_om2 - & + 2.0D0 * alf2 * eps3der - & + sigder * sigsq_om2 - & + dCAVdOM2 - & + dGCLdOM2 - & + dPOLdOM2 - - eom12 = - & evdwij * eps1_om12 - & + eps2der * eps2rt_om12 - & - 2.0D0 * alf12 * eps3der - & + sigder *sigsq_om12 - & + dCAVdOM12 - & + dGCLdOM12 - -c! write (*,*) "evdwij=", evdwij -c! write (*,*) "eps1_om12=", eps1_om12 -c! write (*,*) "eps2der=", eps2rt_om12 -c! write (*,*) "alf12=", alf12 -c! write (*,*) "eps3der=", eps3der -c! write (*,*) "eom1=", eom1 -c! write (*,*) "eom2=", eom2 -c! write (*,*) "eom12=", eom12 -c! eom1 = 0.0d0 -c! eom2 = 0.0d0 -c! eom12 = 0.0d0 -c! write (*,*) "" - - DO k = 1, 3 -c! now some magical transformations to project gradient into -c! three cartesian vectors -c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) -c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) -c! write (*,*) "gg(",k,")=", gg(k) - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) - gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) -c! write (*,*) "gg(",k,")=", gg(k) -c! this acts on hydrophobic center of interaction - gvdwx(k,i)= gvdwx(k,i) - gg(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)= gvdwx(k,j) + gg(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c! this acts on Calpha - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) -c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) -c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) - END DO -c! write (*,*) "*************" -c! write (*,*) "" - RETURN - END SUBROUTINE sc_grad - - -C----------------------------------------------------------------------- - - - subroutine e_softsphere(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rij=xj*xj+yj*yj+zj*zj -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - r0ij=r0(itypi,itypj) - r0ijsq=r0ij*r0ij -c print *,i,j,r0ij,dsqrt(rij) - if (rij.lt.r0ijsq) then - evdwij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdwij=0.0d0 - fac=0.0d0 - endif - evdw=evdw+evdwij -C -C Calculate the components of the gradient in DC and X -C - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - enddo ! j - enddo ! iint - enddo ! i - return - end -C-------------------------------------------------------------------------- - subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) -C -C Soft-sphere potential of p-p interaction -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - dimension ggg(3) -cd write(iout,*) 'In EELEC_soft_sphere' - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - do j=ielstart(i),ielend(i) - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - r0ij=rpp(iteli,itelj) - r0ijsq=r0ij*r0ij - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - if (rij.lt.r0ijsq) then - evdw1ij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdw1ij=0.0d0 - fac=0.0d0 - endif - evdw1=evdw1+evdw1ij -C -C Calculate contributions to the Cartesian gradient. -C - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj - do k=1,3 - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - enddo ! j - enddo ! i -cgrad do i=nnt,nct-1 -cgrad do k=1,3 -cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i) -cgrad enddo -cgrad do j=i+1,nct-1 -cgrad do k=1,3 -cgrad gelc(k,i)=gelc(k,i)+gelc(k,j) -cgrad enddo -cgrad enddo -cgrad enddo - return - end -c------------------------------------------------------------------------------ - subroutine vec_and_deriv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - include 'COMMON.SETUP' - include 'COMMON.TIME1' - dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2) -C Compute the local reference systems. For reference system (i), the -C X-axis points from CA(i) to CA(i+1), the Y axis is in the -C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. -#ifdef PARVEC - do i=ivec_start,ivec_end -#else - do i=1,nres-1 -#endif - if (i.eq.nres-1) then -C Case of the last full residue -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) - costh=dcos(pi-theta(nres)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i-1) - uzder(3,1,1)= dc_norm(2,i-1) - uzder(1,2,1)= dc_norm(3,i-1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i-1) - uzder(1,3,1)=-dc_norm(2,i-1) - uzder(2,3,1)= dc_norm(1,i-1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - do k=1,3 - uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i-1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo - uyder(j,j,1)=uyder(j,j,1)-costh - uyder(j,j,2)=1.0d0+uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - else -C Other residues -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) - costh=dcos(pi-theta(i+2)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i+1) - uzder(3,1,1)= dc_norm(2,i+1) - uzder(1,2,1)= dc_norm(3,i+1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i+1) - uzder(1,3,1)=-dc_norm(2,i+1) - uzder(2,3,1)= dc_norm(1,i+1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - do k=1,3 - uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i+1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo - uyder(j,j,1)=uyder(j,j,1)-costh - uyder(j,j,2)=1.0d0+uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - endif - enddo - do i=1,nres-1 - vbld_inv_temp(1)=vbld_inv(i+1) - if (i.lt.nres-1) then - vbld_inv_temp(2)=vbld_inv(i+2) - else - vbld_inv_temp(2)=vbld_inv(i) - endif - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i) - uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo -#if defined(PARVEC) && defined(MPI) - if (nfgtasks1.gt.1) then - time00=MPI_Wtime() -c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start, -c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1), -c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1) - call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1), - & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, - & FG_COMM1,IERR) - call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1), - & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, - & FG_COMM1,IERR) - call MPI_Allgatherv(uygrad(1,1,1,ivec_start), - & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0), - & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) - call MPI_Allgatherv(uzgrad(1,1,1,ivec_start), - & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0), - & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) - time_gather=time_gather+MPI_Wtime()-time00 - endif -c if (fg_rank.eq.0) then -c write (iout,*) "Arrays UY and UZ" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), -c & (uz(k,i),k=1,3) -c enddo -c endif -#endif - return - end -C----------------------------------------------------------------------------- - subroutine check_vecgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres) - dimension uyt(3,maxres),uzt(3,maxres) - dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3) - double precision delta /1.0d-7/ - call vec_and_deriv -cd do i=1,nres -crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i) -crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i) -crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i) -cd write(iout,'(2i5,2(3f10.5,5x))') i,1, -cd & (dc_norm(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3) -cd write(iout,'(a)') -cd enddo - do i=1,nres - do j=1,2 - do k=1,3 - do l=1,3 - uygradt(l,k,j,i)=uygrad(l,k,j,i) - uzgradt(l,k,j,i)=uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - call vec_and_deriv - do i=1,nres - do j=1,3 - uyt(j,i)=uy(j,i) - uzt(j,i)=uz(j,i) - enddo - enddo - do i=1,nres -cd write (iout,*) 'i=',i - do k=1,3 - erij(k)=dc_norm(k,i) - enddo - do j=1,3 - do k=1,3 - dc_norm(k,i)=erij(k) - enddo - dc_norm(j,i)=dc_norm(j,i)+delta -c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) -c do k=1,3 -c dc_norm(k,i)=dc_norm(k,i)/fac -c enddo -c write (iout,*) (dc_norm(k,i),k=1,3) -c write (iout,*) (erij(k),k=1,3) - call vec_and_deriv - do k=1,3 - uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta - uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta - uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta - uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta - enddo -c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3), -c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3) - enddo - do k=1,3 - dc_norm(k,i)=erij(k) - enddo -cd do k=1,3 -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3), -cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3) -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3), -cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3) -cd write (iout,'(a)') -cd enddo - enddo - return - end -C-------------------------------------------------------------------------- - subroutine set_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include "COMMON.SETUP" - integer IERR - integer status(MPI_STATUS_SIZE) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - double precision auxvec(2),auxmat(2,2) -C -C Compute the virtual-bond-torsional-angle dependent quantities needed -C to calculate the el-loc multibody terms of various order. -C -#ifdef NEWCORR - do i=3,nres+1 - if (i.gt. nnt+2 .and. i.lt.nct+2) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif - b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0) - & +bnew1(2,1,iti)*sin(theta(i-1)) - & +bnew1(3,1,iti)*cos(theta(i-1)/2.0) - b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0) - & +bnew2(2,1,iti)*sin(theta(i-1)) - & +bnew2(3,1,iti)*cos(theta(i-1)/2.0) - b1(2,i-2)=bnew1(1,2,iti) - b2(2,i-2)=bnew2(1,2,iti) -#ifdef DEBUG - write (iout,*) "i",i," iti",iti," theta",theta(i-1) - write (iout,*) "bnew1",bnew1(1,1,iti),bnew1(2,1,iti), - & bnew1(3,1,iti),bnew1(1,2,iti) - write (iout,*) "bnew2",bnew2(1,1,iti),bnew2(2,1,iti), - & bnew2(3,1,iti),bnew2(1,2,iti) -#endif - EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1)) - EE(1,2,i-2)=eeold(1,2,iti) - EE(2,1,i-2)=eeold(2,1,iti) - EE(2,2,i-2)=eeold(2,2,iti) - b1tilde(1,i-2)=b1(1,i-2) - b1tilde(2,i-2)=-b1(2,i-2) - enddo -#endif - -#ifdef PARMAT - do i=ivec_start+2,ivec_end+2 -#else - do i=3,nres+1 -#endif - if (i .lt. nres+1) then - sin1=dsin(phi(i)) - cos1=dcos(phi(i)) - sintab(i-2)=sin1 - costab(i-2)=cos1 - obrot(1,i-2)=cos1 - obrot(2,i-2)=sin1 - sin2=dsin(2*phi(i)) - cos2=dcos(2*phi(i)) - sintab2(i-2)=sin2 - costab2(i-2)=cos2 - obrot2(1,i-2)=cos2 - obrot2(2,i-2)=sin2 - Ug(1,1,i-2)=-cos1 - Ug(1,2,i-2)=-sin1 - Ug(2,1,i-2)=-sin1 - Ug(2,2,i-2)= cos1 - Ug2(1,1,i-2)=-cos2 - Ug2(1,2,i-2)=-sin2 - Ug2(2,1,i-2)=-sin2 - Ug2(2,2,i-2)= cos2 - else - costab(i-2)=1.0d0 - sintab(i-2)=0.0d0 - obrot(1,i-2)=1.0d0 - obrot(2,i-2)=0.0d0 - obrot2(1,i-2)=0.0d0 - obrot2(2,i-2)=0.0d0 - Ug(1,1,i-2)=1.0d0 - Ug(1,2,i-2)=0.0d0 - Ug(2,1,i-2)=0.0d0 - Ug(2,2,i-2)=1.0d0 - Ug2(1,1,i-2)=0.0d0 - Ug2(1,2,i-2)=0.0d0 - Ug2(2,1,i-2)=0.0d0 - Ug2(2,2,i-2)=0.0d0 - endif - if (i .gt. 3 .and. i .lt. nres+1) then - obrot_der(1,i-2)=-sin1 - obrot_der(2,i-2)= cos1 - Ugder(1,1,i-2)= sin1 - Ugder(1,2,i-2)=-cos1 - Ugder(2,1,i-2)=-cos1 - Ugder(2,2,i-2)=-sin1 - dwacos2=cos2+cos2 - dwasin2=sin2+sin2 - obrot2_der(1,i-2)=-dwasin2 - obrot2_der(2,i-2)= dwacos2 - Ug2der(1,1,i-2)= dwasin2 - Ug2der(1,2,i-2)=-dwacos2 - Ug2der(2,1,i-2)=-dwacos2 - Ug2der(2,2,i-2)=-dwasin2 - else - obrot_der(1,i-2)=0.0d0 - obrot_der(2,i-2)=0.0d0 - Ugder(1,1,i-2)=0.0d0 - Ugder(1,2,i-2)=0.0d0 - Ugder(2,1,i-2)=0.0d0 - Ugder(2,2,i-2)=0.0d0 - obrot2_der(1,i-2)=0.0d0 - obrot2_der(2,i-2)=0.0d0 - Ug2der(1,1,i-2)=0.0d0 - Ug2der(1,2,i-2)=0.0d0 - Ug2der(2,1,i-2)=0.0d0 - Ug2der(2,2,i-2)=0.0d0 - endif -c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then - if (i.gt. nnt+2 .and. i.lt.nct+2) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif -c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif -cd write (iout,*) '*******i',i,' iti1',iti -cd write (iout,*) 'b1',b1(:,i-2) -cd write (iout,*) 'b2',b2(:,i-2) -cd write (iout,*) 'Ug',Ug(:,:,i-2) -c if (i .gt. iatel_s+2) then - if (i .gt. nnt+2) then - call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2)) - call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2)) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) - call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) - endif - else - do k=1,2 - Ub2(k,i-2)=0.0d0 - Ctobr(k,i-2)=0.0d0 - Dtobr2(k,i-2)=0.0d0 - do l=1,2 - EUg(l,k,i-2)=0.0d0 - CUg(l,k,i-2)=0.0d0 - DUg(l,k,i-2)=0.0d0 - DtUg2(l,k,i-2)=0.0d0 - enddo - enddo - endif - call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2)) - call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) - do k=1,2 - muder(k,i-2)=Ub2der(k,i-2) - enddo -c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif - do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) - enddo -cd write (iout,*) 'mu ',mu(:,i-2) -cd write (iout,*) 'mu1',mu1(:,i-2) -cd write (iout,*) 'mu2',mu2(:,i-2) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) - & then - call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) - call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1)) - call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) - call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) - call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) - call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) - endif - enddo -C Matrices dependent on two consecutive virtual-bond dihedrals. -C The order of matrices is from left to right. - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) - &then -c do i=max0(ivec_start,2),ivec_end - do i=2,nres-1 - call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i)) - call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i)) - call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i)) - call transpose2(DtUg2(1,1,i-1),auxmat(1,1)) - call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i)) - call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i)) - call transpose2(DtUg2der(1,1,i-1),auxmat(1,1)) - call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i)) - enddo - endif -#if defined(MPI) && defined(PARMAT) -#ifdef DEBUG -c if (fg_rank.eq.0) then - write (iout,*) "Arrays UG and UGDER before GATHER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug(l,k,i),l=1,2),k=1,2), - & ((ugder(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays UG2 and UG2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug2(l,k,i),l=1,2),k=1,2), - & ((ug2der(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), - & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) - enddo - write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & costab(i),sintab(i),costab2(i),sintab2(i) - enddo - write (iout,*) "Array MUDER" - do i=1,nres-1 - write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) - enddo -c endif -#endif - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start, -c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1), -c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1) -#ifdef MATGATHER - call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2Db1tder(1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtug2der(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0), - & MPI_MAT2,FG_COMM1,IERR) - call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0), - & MPI_MAT2,FG_COMM1,IERR) - endif -#else -c Passes matrix info through the ring - isend=fg_rank1 - irecv=fg_rank1-1 - if (irecv.lt.0) irecv=nfgtasks1-1 - iprev=irecv - inext=fg_rank1+1 - if (inext.ge.nfgtasks1) inext=0 - do i=1,nfgtasks1-1 -c write (iout,*) "isend",isend," irecv",irecv -c call flush(iout) - lensend=lentyp(isend) - lenrecv=lentyp(irecv) -c write (iout,*) "lensend",lensend," lenrecv",lenrecv -c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1, -c & MPI_ROTAT1(lensend),inext,2200+isend, -c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv), -c & iprev,2200+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT1" -c call flush(iout) -c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1, -c & MPI_ROTAT2(lensend),inext,3300+isend, -c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), -c & iprev,3300+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT2" -c call flush(iout) - call MPI_SENDRECV(costab(ivec_displ(isend)+1),1, - & MPI_ROTAT_OLD(lensend),inext,4400+isend, - & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv), - & iprev,4400+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT_OLD" -c call flush(iout) - call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1, - & MPI_PRECOMP11(lensend),inext,5500+isend, - & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv), - & iprev,5500+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP11" -c call flush(iout) - call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP12(lensend),inext,6600+isend, - & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv), - & iprev,6600+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP12" -c call flush(iout) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1, - & MPI_ROTAT2(lensend),inext,7700+isend, - & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), - & iprev,7700+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP21" -c call flush(iout) - call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP22(lensend),inext,8800+isend, - & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv), - & iprev,8800+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP22" -c call flush(iout) - call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP23(lensend),inext,9900+isend, - & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1, - & MPI_PRECOMP23(lenrecv), - & iprev,9900+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP23" -c call flush(iout) - endif - isend=irecv - irecv=irecv-1 - if (irecv.lt.0) irecv=nfgtasks1-1 - enddo -#endif - time_gather=time_gather+MPI_Wtime()-time00 - endif -#ifdef DEBUG -c if (fg_rank.eq.0) then - write (iout,*) "Arrays UG and UGDER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug(l,k,i),l=1,2),k=1,2), - & ((ugder(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays UG2 and UG2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug2(l,k,i),l=1,2),k=1,2), - & ((ug2der(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), - & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) - enddo - write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & costab(i),sintab(i),costab2(i),sintab2(i) - enddo - write (iout,*) "Array MUDER" - do i=1,nres-1 - write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) - enddo -c endif -#endif -#endif -cd do i=1,nres -cd iti = itortyp(itype(i)) -cd write (iout,*) i -cd do j=1,2 -cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') -cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) -cd enddo -cd enddo - return - end -C-------------------------------------------------------------------------- - subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C -C This subroutine calculates the average interaction energy and its gradient -C in the virtual-bond vectors between non-adjacent peptide groups, based on -C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. -C The potential depends both on the distance of peptide-group centers and on -C the orientation of the CA-CA virtual bonds. -C - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -cd write(iout,*) 'In EELEC' -cd do i=1,nloctyp -cd write(iout,*) 'Type',i -cd write(iout,*) 'B1',B1(:,i) -cd write(iout,*) 'B2',B2(:,i) -cd write(iout,*) 'CC',CC(:,:,i) -cd write(iout,*) 'DD',DD(:,:,i) -cd write(iout,*) 'EE',EE(:,:,i) -cd enddo -cd call check_vecgrad -cd stop - if (icheckgrad.eq.1) then - do i=1,nres-1 - fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) - do k=1,3 - dc_norm(k,i)=dc(k,i)*fac - enddo -c write (iout,*) 'i',i,' fac',fac - enddo - endif - if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. - & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -c call vec_and_deriv -#ifdef TIMING - time01=MPI_Wtime() -#endif - call set_matrices -#ifdef TIMING - time_mat=time_mat+MPI_Wtime()-time01 -#endif - endif -cd do i=1,nres-1 -cd write (iout,*) 'i=',i -cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -cd enddo -cd do k=1,3 -cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') -cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) -cd enddo -cd enddo - t_eelecij=0.0d0 - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=1,nres - num_cont_hb(i)=0 - enddo -cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - enddo -c -c -c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -C -C Loop over i,i+2 and i,i+3 pairs of the peptide groups -C - do i=iturn3_start,iturn3_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 - call eelecij(i,i+2,ees,evdw1,eel_loc) - if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) - num_cont_hb(i)=num_conti - enddo - do i=iturn4_start,iturn4_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=num_cont_hb(i) - call eelecij(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) - num_cont_hb(i)=num_conti - enddo ! i -c -c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -c - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - num_conti=num_cont_hb(i) - do j=ielstart(i),ielend(i) - call eelecij(i,j,ees,evdw1,eel_loc) - enddo ! j - num_cont_hb(i)=num_conti - enddo ! i -c write (iout,*) "Number of loop steps in EELEC:",ind -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 -cd print *,"Processor",fg_rank," t_eelecij",t_eelecij - return - end -C------------------------------------------------------------------------------- - subroutine eelecij(i,j,ees,evdw1,eel_loc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -c time00=MPI_Wtime() -cd write (iout,*) "eelecij",i,j -c ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - ael6i=ael6(iteli,itelj) - ael3i=ael3(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - rmij=1.0D0/rij - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj - cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij - cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij - fac=cosa-3.0D0*cosb*cosg - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - fac3=ael6i*r6ij - fac4=ael3i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 -C 12/26/95 - for the evaluation of multi-body H-bonding interactions - ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij - evdw1=evdw1+evdwij -cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, -cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, -cd & xmedi,ymedi,zmedi,xj,yj,zj - - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij - endif - -C -C Calculate contributions to the Cartesian gradient. -C -#ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) - facel=-3*rrmij*(el1+eesij) - fac1=fac - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -cgrad enddo -cgrad enddo -#else - facvdw=ev1+evdwij - facel=el1+eesij - fac1=fac - fac=-3*rrmij*(facvdw+facvdw+facel) - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc(k,j)+ggg(k) - gelc_long(k,i)=gelc(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -#endif -* -* Angular part -* - ecosa=2.0D0*fac3*fac1+fac4 - fac4=-3.0D0*fac4 - fac3=-6.0D0*fac3 - ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4) - ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4) - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo -cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), -cd & (dcosg(k),k=1,3) - do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) - enddo -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -c gelc(k,j)=gelc(k,j)+ghalf -c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -c enddo -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo - IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 - & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C -C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction -C energy of a peptide unit is assumed in the form of a second-order -C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. -C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms -C are computed for EVERY pair of non-contiguous peptide groups. -C - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - kkk=0 - do k=1,2 - do l=1,2 - kkk=kkk+1 - muij(kkk)=mu(k,i)*mu(l,j) - enddo - enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij - ury=scalar(uy(1,i),erij) - urz=scalar(uz(1,i),erij) - vry=scalar(uy(1,j),erij) - vrz=scalar(uz(1,j),erij) - a22=scalar(uy(1,i),uy(1,j))-3*ury*vry - a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz - a32=scalar(uz(1,i),uy(1,j))-3*urz*vry - a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz - fac=dsqrt(-ael6i)*r3ij - a22=a22*fac - a23=a23*fac - a32=a32*fac - a33=a33*fac -cd write (iout,'(4i5,4f10.5)') -cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 -cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -cd & uy(:,j),uz(:,j) -cd write (iout,'(4f10.5)') -cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), -cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) -cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(9f10.5/)') -cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij -C Derivatives of the elements of A in virtual-bond vectors - call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) - do k=1,3 - uryg(k,1)=scalar(erder(1,k),uy(1,i)) - uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) - uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1)) - urzg(k,1)=scalar(erder(1,k),uz(1,i)) - urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1)) - urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1)) - vryg(k,1)=scalar(erder(1,k),uy(1,j)) - vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1)) - vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1)) - vrzg(k,1)=scalar(erder(1,k),uz(1,j)) - vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) - vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) - enddo -C Compute radial contributions to the gradient - facr=-3.0d0*rrmij - a22der=a22*facr - a23der=a23*facr - a32der=a32*facr - a33der=a33*facr - agg(1,1)=a22der*xj - agg(2,1)=a22der*yj - agg(3,1)=a22der*zj - agg(1,2)=a23der*xj - agg(2,2)=a23der*yj - agg(3,2)=a23der*zj - agg(1,3)=a32der*xj - agg(2,3)=a32der*yj - agg(3,3)=a32der*zj - agg(1,4)=a33der*xj - agg(2,4)=a33der*yj - agg(3,4)=a33der*zj -C Add the contributions coming from er - fac3=-3.0d0*fac - do k=1,3 - agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury) - agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury) - agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz) - agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz) - enddo - do k=1,3 -C Derivatives in DC(i) -cgrad ghalf1=0.5d0*agg(k,1) -cgrad ghalf2=0.5d0*agg(k,2) -cgrad ghalf3=0.5d0*agg(k,3) -cgrad ghalf4=0.5d0*agg(k,4) - aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)!+ghalf1 - aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)!+ghalf2 - aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)!+ghalf3 - aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -C Derivatives in DC(i+1) - aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)!+agg(k,1) - aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) - aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)!+agg(k,3) - aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -C Derivatives in DC(j) - aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)!+ghalf1 - aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)!+ghalf2 - aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)!+ghalf3 - aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -C Derivatives in DC(j+1) or DC(nres-1) - aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) - & -3.0d0*vryg(k,3)*ury) - aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) - & -3.0d0*vrzg(k,3)*ury) - aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) - & -3.0d0*vryg(k,3)*urz) - aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) - & -3.0d0*vrzg(k,3)*urz) -cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -cgrad do l=1,4 -cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -cgrad enddo -cgrad endif - enddo - acipa(1,1)=a22 - acipa(1,2)=a23 - acipa(2,1)=a32 - acipa(2,2)=a33 - a22=-a22 - a23=-a23 - do l=1,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - if (j.lt.nres-1) then - a22=-a22 - a32=-a32 - do l=1,3,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - else - a22=-a22 - a23=-a23 - a32=-a32 - a33=-a33 - do l=1,4 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - endif - ENDIF ! WCORR - IF (wel_loc.gt.0.0d0) THEN -C Contribution to the local-electrostatic energy coming from the i-j pair - eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) - & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eelloc',i,j,eel_loc_ij - - eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma - if (i.gt.1) - & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) - gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -cgrad ghalf=0.5d0*ggg(l) -cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf - enddo -cgrad do k=i+1,j2 -cgrad do l=1,3 -cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -C Remaining derivatives of eello - do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) - enddo - ENDIF -C Change 12/26/95 to calculate four-body contributions to H-bonding energy -c if (j.gt.i+1 .and. num_conti.le.maxconts) then - if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 - & .and. num_conti.le.maxconts) then -c write (iout,*) i,j," entered corr" -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -c r0ij=1.02D0*rpp(iteli,itelj) -c r0ij=1.11D0*rpp(iteli,itelj) - r0ij=2.20D0*rpp(iteli,itelj) -c r0ij=1.55D0*rpp(iteli,itelj) - call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) - if (fcont.gt.0.0D0) then - num_conti=num_conti+1 - if (num_conti.gt.maxconts) then - write (iout,*) 'WARNING - max. # of contacts exceeded;', - & ' will skip next contacts for this conf.' - else - jcont_hb(num_conti,i)=j -cd write (iout,*) "i",i," j",j," num_conti",num_conti, -cd & " jcont_hb",jcont_hb(num_conti,i) - IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. - & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el -C terms. - d_cont(num_conti,i)=rij -cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij -C --- Electrostatic-interaction matrix --- - a_chuj(1,1,num_conti,i)=a22 - a_chuj(1,2,num_conti,i)=a23 - a_chuj(2,1,num_conti,i)=a32 - a_chuj(2,2,num_conti,i)=a33 -C --- Gradient of rij - do kkk=1,3 - grij_hb_cont(kkk,num_conti,i)=erij(kkk) - enddo - kkll=0 - do k=1,2 - do l=1,2 - kkll=kkll+1 - do m=1,3 - a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll) - a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll) - a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) - a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) - a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) - enddo - enddo - enddo - ENDIF - IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN -C Calculate contact energies - cosa4=4.0D0*cosa - wij=cosa-3.0D0*cosb*cosg - cosbg1=cosb+cosg - cosbg2=cosb-cosg -c fac3=dsqrt(-ael6i)/r0ij**3 - fac3=dsqrt(-ael6i)*r3ij -c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 - if (ees0tmp.gt.0) then - ees0pij=dsqrt(ees0tmp) - else - ees0pij=0 - endif -c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) - ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 - if (ees0tmp.gt.0) then - ees0mij=dsqrt(ees0tmp) - else - ees0mij=0 - endif -c ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) -C Diagnostics. Comment out or remove after debugging! -c ees0p(num_conti,i)=0.5D0*fac3*ees0pij -c ees0m(num_conti,i)=0.5D0*fac3*ees0mij -c ees0m(num_conti,i)=0.0D0 -C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -C Angular derivatives of the contact function - ees0pij1=fac3/ees0pij - ees0mij1=fac3/ees0mij - fac3p=-3.0D0*fac3*rrmij - ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) - ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) -c ees0mij1=0.0D0 - ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) - ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) - ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) - ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) - ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) - ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) - ecosap=ecosa1+ecosa2 - ecosbp=ecosb1+ecosb2 - ecosgp=ecosg1+ecosg2 - ecosam=ecosa1-ecosa2 - ecosbm=ecosb1-ecosb2 - ecosgm=ecosg1-ecosg2 -C Diagnostics -c ecosap=ecosa1 -c ecosbp=ecosb1 -c ecosgp=ecosg1 -c ecosam=0.0D0 -c ecosbm=0.0D0 -c ecosgm=0.0D0 -C End diagnostics - facont_hb(num_conti,i)=fcont - fprimcont=fprimcont/rij -cd facont_hb(num_conti,i)=1.0D0 -C Following line is for diagnostics. -cd fprimcont=0.0D0 - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo - do k=1,3 - gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) - gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) - enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj -C Derivatives due to the contact function - gacont_hbr(1,num_conti,i)=fprimcont*xj - gacont_hbr(2,num_conti,i)=fprimcont*yj - gacont_hbr(3,num_conti,i)=fprimcont*zj - do k=1,3 -c -c 10/24/08 cgrad and ! comments indicate the parts of the code removed -c following the change of gradient-summation algorithm. -c -cgrad ghalfp=0.5D0*gggp(k) -cgrad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) - enddo -C Diagnostics. Comment out or remove after debugging! -cdiag do k=1,3 -cdiag gacontp_hb1(k,num_conti,i)=0.0D0 -cdiag gacontp_hb2(k,num_conti,i)=0.0D0 -cdiag gacontp_hb3(k,num_conti,i)=0.0D0 -cdiag gacontm_hb1(k,num_conti,i)=0.0D0 -cdiag gacontm_hb2(k,num_conti,i)=0.0D0 -cdiag gacontm_hb3(k,num_conti,i)=0.0D0 -cdiag enddo - ENDIF ! wcorr - endif ! num_conti.le.maxconts - endif ! fcont.gt.0 - endif ! j.gt.i+1 - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then - do k=1,4 - do l=1,3 - ghalf=0.5d0*agg(l,k) - aggi(l,k)=aggi(l,k)+ghalf - aggi1(l,k)=aggi1(l,k)+agg(l,k) - aggj(l,k)=aggj(l,k)+ghalf - enddo - enddo - if (j.eq.nres-1 .and. i.lt.j-2) then - do k=1,4 - do l=1,3 - aggj1(l,k)=aggj1(l,k)+agg(l,k) - enddo - enddo - endif - endif -c t_eelecij=t_eelecij+MPI_Wtime()-time00 - return - end -C----------------------------------------------------------------------------- - subroutine eturn3(i,eello_turn3) -C Third- and fourth-order contributions from turns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - dimension ggg(3) - double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), - & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) - double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 - j=i+2 -c write (iout,*) "eturn3",i,j,j1,j2 - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Third-order contributions -C -C (i+2)o----(i+3) -C | | -C | | -C (i+1)o----i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd call checkint_turn3(i,a_temp,eello_turn3_num) - call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) - call transpose2(auxmat(1,1),auxmat1(1,1)) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) -cd write (2,*) 'i,',i,' j',j,'eello_turn3', -cd & 0.5d0*(pizda(1,1)+pizda(2,2)), -cd & ' eello_turn3_num',4*eello_turn3_num -C Derivatives in gamma(i) - call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),auxmat3(1,1)) - call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) - gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) -C Derivatives in gamma(i+1) - call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),auxmat3(1,1)) - call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) - gel_loc_turn3(i+1)=gel_loc_turn3(i+1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) -C Cartesian derivatives - do l=1,3 -c ghalf1=0.5d0*agg(l,1) -c ghalf2=0.5d0*agg(l,2) -c ghalf3=0.5d0*agg(l,3) -c ghalf4=0.5d0*agg(l,4) - a_temp(1,1)=aggi(l,1)!+ghalf1 - a_temp(1,2)=aggi(l,2)!+ghalf2 - a_temp(2,1)=aggi(l,3)!+ghalf3 - a_temp(2,2)=aggi(l,4)!+ghalf4 - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,i)=gcorr3_turn(l,i) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggi1(l,1)!+agg(l,1) - a_temp(1,2)=aggi1(l,2)!+agg(l,2) - a_temp(2,1)=aggi1(l,3)!+agg(l,3) - a_temp(2,2)=aggi1(l,4)!+agg(l,4) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj(l,1)!+ghalf1 - a_temp(1,2)=aggj(l,2)!+ghalf2 - a_temp(2,1)=aggj(l,3)!+ghalf3 - a_temp(2,2)=aggj(l,4)!+ghalf4 - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,j)=gcorr3_turn(l,j) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj1(l,1) - a_temp(1,2)=aggj1(l,2) - a_temp(2,1)=aggj1(l,3) - a_temp(2,2)=aggj1(l,4) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,j1)=gcorr3_turn(l,j1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - enddo - return - end -C------------------------------------------------------------------------------- - subroutine eturn4(i,eello_turn4) -C Third- and fourth-order contributions from turns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - dimension ggg(3) - double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), - & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) - double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 - j=i+3 -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Fourth-order contributions -C -C (i+3)o----(i+4) -C / | -C (i+2)o | -C \ | -C (i+1)o----i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd call checkint_turn4(i,a_temp,eello_turn4_num) -c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) -c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 - call transpose2(EUg(1,1,i+1),e1t(1,1)) - call transpose2(Eug(1,1,i+2),e2t(1,1)) - call transpose2(Eug(1,1,i+3),e3t(1,1)) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - eello_turn4=eello_turn4-(s1+s2+s3) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn4',i,j,-(s1+s2+s3) -cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), -cd & ' eello_turn4_num',8*eello_turn4_num -C Derivatives in gamma(i) - call transpose2(EUgder(1,1,i+1),e1tder(1,1)) - call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) -C Derivatives in gamma(i+1) - call transpose2(EUgder(1,1,i+2),e2tder(1,1)) - call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) - call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) -C Derivatives in gamma(i+2) - call transpose2(EUgder(1,1,i+3),e3tder(1,1)) - call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) - call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) -C Cartesian derivatives -C Derivatives of this turn contributions in DC(i+2) - if (j.lt.nres-1) then - do l=1,3 - a_temp(1,1)=agg(l,1) - a_temp(1,2)=agg(l,2) - a_temp(2,1)=agg(l,3) - a_temp(2,2)=agg(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - ggg(l)=-(s1+s2+s3) - gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) - enddo - endif -C Remaining derivatives of this turn contribution - do l=1,3 - a_temp(1,1)=aggi(l,1) - a_temp(1,2)=aggi(l,2) - a_temp(2,1)=aggi(l,3) - a_temp(2,2)=aggi(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) - a_temp(1,1)=aggi1(l,1) - a_temp(1,2)=aggi1(l,2) - a_temp(2,1)=aggi1(l,3) - a_temp(2,2)=aggi1(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) - a_temp(1,1)=aggj(l,1) - a_temp(1,2)=aggj(l,2) - a_temp(2,1)=aggj(l,3) - a_temp(2,2)=aggj(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) - a_temp(1,1)=aggj1(l,1) - a_temp(1,2)=aggj1(l,2) - a_temp(2,1)=aggj1(l,3) - a_temp(2,2)=aggj1(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) -c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 - gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) - enddo - return - end -C----------------------------------------------------------------------------- - subroutine vecpr(u,v,w) - implicit real*8(a-h,o-z) - dimension u(3),v(3),w(3) - w(1)=u(2)*v(3)-u(3)*v(2) - w(2)=-u(1)*v(3)+u(3)*v(1) - w(3)=u(1)*v(2)-u(2)*v(1) - return - end -C----------------------------------------------------------------------------- - subroutine unormderiv(u,ugrad,unorm,ungrad) -C This subroutine computes the derivatives of a normalized vector u, given -C the derivatives computed without normalization conditions, ugrad. Returns -C ungrad. - implicit none - double precision u(3),ugrad(3,3),unorm,ungrad(3,3) - double precision vec(3) - double precision scalar - integer i,j -c write (2,*) 'ugrad',ugrad -c write (2,*) 'u',u - do i=1,3 - vec(i)=scalar(ugrad(1,i),u(1)) - enddo -c write (2,*) 'vec',vec - do i=1,3 - do j=1,3 - ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm - enddo - enddo -c write (2,*) 'ungrad',ungrad - return - end -C----------------------------------------------------------------------------- - subroutine escp_soft_sphere(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 - r0_scp=4.5d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rij=xj*xj+yj*yj+zj*zj - r0ij=r0_scp - r0ijsq=r0ij*r0ij - if (rij.lt.r0ijsq) then - evdwij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdwij=0.0d0 - fac=0.0d0 - endif - evdw2=evdw2+evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, -c & dhpb(i),dhpb1(i),forcon(i) -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. -cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then -C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds - if (.not.dyn_ss .and. i.le.nss) then -C 15/02/13 CC dynamic SSbond - additional check - if (ii.gt.nres - & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij - endif -cd write (iout,*) "eij",eij - else if (ii.gt.nres .and. jj.gt.nres) then -c Restraints from contact prediction - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "beta nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "beta reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "alph nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "alpha reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12+ebr - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci - write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -c write (iout,*) "gloci", gloc(i-3,icg) -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 -c write (iout,*) "gloci", gloc(i-3,icg) - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=itau_start,itau_end - esccor_ii=0.0D0 - isccori=isccortyp(itype(i-2)) - isccori1=isccortyp(itype(i-1)) - phii=phi(i) -cccc Added 9 May 2012 -cc Tauangle is torsional engle depending on the value of first digit -c(see comment below) -cc Omicron is flat angle depending on the value of first digit -c(see comment below) - - - do intertyp=1,3 !intertyp -cc Added 09 May 2012 (Adasko) -cc Intertyp means interaction type of backbone mainchain correlation: -c 1 = SC...Ca...Ca...Ca -c 2 = Ca...Ca...Ca...SC -c 3 = SC...Ca...Ca...SCi - gloci=0.0D0 - if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. - & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or. - & (itype(i-1).eq.21))) - & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) - & .or.(itype(i-2).eq.21))) - & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. - & (itype(i-1).eq.21)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21)) - & cycle - do j=1,nterm_sccor(isccori,isccori1) - v1ij=v1sccor(j,intertyp,isccori,isccori1) - v2ij=v2sccor(j,intertyp,isccori,isccori1) - cosphi=dcos(j*tauangle(intertyp,i)) - sinphi=dsin(j*tauangle(intertyp,i)) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci -c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi -c &gloc_sc(intertyp,i-3,icg) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,intertyp,itori,itori1),j=1,6) - & ,(v2sccor(j,intertyp,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo !intertyp - enddo -c do i=1,nres -c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,i+1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,i+1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) - vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) - vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(2),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C \ /l\ /j\ / C -C \ / \ / \ / C -C o| o | | o |o C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C j|/k\| / |/k\|l / C -C / \ / / \ / C -C / o / o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o \ o \ C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,j+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,l+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,l)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,k),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,k),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier_v3ok1.F b/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier_v3ok1.F deleted file mode 100644 index 1c46174..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/energy_p_new_barrier_v3ok1.F +++ /dev/null @@ -1,10958 +0,0 @@ - SUBROUTINE etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - if (nfgtasks.gt.1) then -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wsct -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wsct=weights(22) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106,107) ipot -C Lennard-Jones potential. - 101 call elj(evdw,evdw_p,evdw_m) -cd print '(a)','Exit ELJ' - goto 108 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw,evdw_p,evdw_m) - goto 108 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw,evdw_p,evdw_m) - goto 108 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw,evdw_p,evdw_m) - goto 108 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw,evdw_p,evdw_m) - goto 108 -C New SC-SC potential - 106 call emomo(evdw,evdw_p,evdw_m) - goto 108 -C Soft-sphere potential - 107 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 108 continue -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif - call vec_and_deriv -#ifdef TIMING -#ifdef MPI - time_vec=time_vec+MPI_Wtime()-time01 -#else - time_vec=time_vec+tcpu()-time01 -#endif -#endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - IF (ipot.lt.7) THEN -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.7) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - write (*,*) "eback_sc_corr XX" - if (wsccor.gt.0.0d0) then - write (*,*) "eback_sc_corr 00a" - call eback_sc_corr(esccor) - else - write (*,*) "eback_sc_corr 00b" - esccor=0.0d0 - END IF -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.7) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - end if - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.7) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr - end if -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - IF(usampl.and.totT.gt.eq_time) THEN - call EconstrQ - call Econstr_back - ELSE - Uconst=0.0d0 - Uconst_back=0.0d0 - ENDIF -#ifdef TIMING -#ifdef MPI - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#else - time_enecalc=time_enecalc+tcpu()-time00 -#endif -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING -#ifdef MPI - time_sumene=time_sumene+MPI_Wtime()-time00 -#else - time_sumene=time_sumene+tcpu()-time00 -#endif -#endif - RETURN - END SUBROUTINE etotal - - -c------------------------------------------------------------------------------- - - - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end - - -c------------------------------------------------------------------------------- - - - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' -#endif - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres) - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time01=tcpu() -#endif -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3), - & (gvdwcT(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef SPLITELE -#ifdef TSCSC - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - enddo - enddo -c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG -c write (iout,*) "gradbufc_sum after allreduce" -c do i=1,nres -c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -c enddo -c call flush(iout) -#endif -#ifdef TIMING -c time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif -c -c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -c do not parallelize this part. -c -c do i=igrad_start,igrad_end -c do j=jgrad_start(i),jgrad_end(i) -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -c enddo -c enddo -c enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - gradbufc(j,i)=0.0d0 - enddo - enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -c do i=nnt,nres-1 -c do k=1,3 -c gradbufc(k,i)=0.0d0 -c enddo -c do j=i+1,nres -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -c enddo -c enddo -c enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=1,nct - do j=1,3 -#ifdef SPLITELE - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#endif -#ifdef TSCSC - gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+ - & wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#else - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) - -#endif - enddo - enddo -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - & +wsccor*gsccor_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#ifdef TSCSC - gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#endif - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#ifdef TSCSC - gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#endif - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING -#ifdef MPI - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#else - time_sumgradient=time_sumgradient+tcpu()-time01 -#endif -#endif - return - end - - -c------------------------------------------------------------------------------- - - - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact -#ifdef TSCSC -c wsct=t_bath/temp0 - wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 -#endif - return - end - - -C------------------------------------------------------------------------ - - - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ebr*nss, - & Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ebr*nss,Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end - - -C----------------------------------------------------------------------- - - - subroutine elj(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij - else - evdw_m=evdw_m+evdwij - endif -#else - evdw=evdw+evdwij -#endif -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -#ifdef TSCSC - if (bb(itypi,itypj).gt.0.0d0) then - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - else - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - gvdwcT(k,i)=gvdwcT(k,i)-gg(k) - gvdwcT(k,j)=gvdwcT(k,j)+gg(k) - enddo - endif -#else - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -#endif -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (r.< -c! om = omega, sqom = om^2 - sqom1 = om1 * om1 - sqom2 = om2 * om2 - sqom12 = om12 * om12 -c! now we calculate FGB - Gey-Berne Force. -c! It will be summed up in evdwij and saved in evdw - sigsq = 1.0D0 / sigsq - sig = sig0ij * dsqrt(sigsq) - rij_shift = 1.0D0 / rij - sig + sig0ij - IF (rij_shift.le.0.0D0) THEN - evdw = 1.0D20 - RETURN - END IF - sigder = -sig * sigsq - rij_shift = 1.0D0 / rij_shift - fac = rij_shift**expon - c1 = fac * fac * aa(itypi,itypj) - c2 = fac * bb(itypi,itypj) - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = evdwij * eps3rt - eps3der = evdwij * eps2rt - evdwij = evdwij * eps2rt * eps3rt -#ifdef TSCSC - IF (bb(itypi,itypj).gt.0) THEN - evdw_p = evdw_p + evdwij - ELSE - evdw_m = evdw_m + evdwij - END IF -#else - evdw = evdw - & + evdwij -#endif -c!------------------------------------------------------------------- -c! Calculate some components of GGB and EGB - c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 - fac = -expon * (c1 + evdwij) * rij_shift - sigder = fac * sigder - fac = rij * fac -c! fac = 0.0d0 -c! Calculate the radial part of GGB - gg(1) = xj * fac - gg(2) = yj * fac - gg(3) = zj * fac - -c! The angular derivatives of GGB are brought together in sc_grad -c!------------------------------------------------------------------- -c! Fcav -c! -c! Catch gly-gly interactions to skip calculation of something that -c! does not exist - - IF (itypi.eq.10.and.itypj.eq.10) THEN - Fcav = 0.0d0 - dFdR = 0.0d0 - dCAVdOM1 = 0.0d0 - dCAVdOM2 = 0.0d0 - dCAVdOM12 = 0.0d0 - ELSE - -c! we are not 2 glycines, so we calculate Fcav - fac = chis1 * sqom1 + chis2 * sqom2 - & - 2.0d0 * chis12 * om1 * om2 * om12 -c! we will use pom later in Gcav, so dont mess with it! - pom = 1.0d0 - chis1 * chis2 * sqom12 - - Lambf = (1.0d0 - (fac / pom)) - Lambf = dsqrt(Lambf) - - sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) - Chif = Rtail * sparrow - ChiLambf = Chif * Lambf - eagle = dsqrt(ChiLambf) - bat = ChiLambf ** 11.0d0 - - top = b1 * ( eagle + b2 * ChiLambf - b3 ) - bot = 1.0d0 + b4 * (ChiLambf * bat) - botsq = bot * bot - - Fcav = top / bot - -c!------------------------------------------------------------------- -c! derivative of Fcav is Gcav... -c!--------------------------------------------------- - - dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf)) - dbot = 12.0d0 * b4 * bat * Lambf - dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow - - dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif)) - dbot = 12.0d0 * b4 * bat * Chif - eagle = Lambf * pom - dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) - dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) - dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) - & * (chis2 * om2 * om12 - om1) / (eagle * pom) - - dFdL = ((dtop * bot - top * dbot) / botsq) - dCAVdOM1 = dFdL * ( dFdOM1 ) - dCAVdOM2 = dFdL * ( dFdOM2 ) - dCAVdOM12 = dFdL * ( dFdOM12 ) -c!---------------------------------------------------- -c! Finally, add the distance derivatives to gvdwc -c! Fac is used here to project the gradient vector into -c! cartesian coordinates -c! derivatives of omega angles will be added in sc_grad - DO k = 1, 3 - fac = Rtail_distance(k) / Rtail - gvdwx(k,i) = gvdwx(k,i) - & - dFdR * fac - - gvdwx(k,j) = gvdwx(k,j) - & + dFdR * fac - - gvdwc(k,i) = gvdwc(k,i) - & - dFdR * fac - - gvdwc(k,j) = gvdwc(k,j) - & + dFdR * fac - END DO - -c!------------------------------------------------------------------- -c! Compute head-head and head-tail energies for each state - - isel = iabs(Qi) + iabs(Qj) - IF (isel.eq.0) THEN -c! No charges - do nothing - eheadtail = 0.0d0 - - ELSE IF (isel.eq.4) THEN -c! Calculate dipole-dipole interactions - CALL edd(ecl) - eheadtail = ECL - - ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN -c! Charge-nonpolar interactions - CALL eqn(epol) - eheadtail = epol - - ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN -c! Nonpolar-charge interactions - CALL enq(epol) - eheadtail = epol - - ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN -c! Charge-dipole interactions - CALL eqd(ecl, elj, epol) - eheadtail = ECL + elj + epol - - ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN -c! Dipole-charge interactions - CALL edq(ecl, elj, epol) - eheadtail = ECL + elj + epol - - ELSE IF ((isel.eq.2.and. - & iabs(Qi).eq.1).and. - & nstate(itypi,itypj).eq.1) THEN -c! Same charge-charge interaction ( +/+ or -/- ) - CALL eqq(Ecl,Egb,Epol,Fisocav,Elj) - eheadtail = ECL + Egb + Epol + Fisocav + Elj - - ELSE IF ((isel.eq.2.and. - & iabs(Qi).eq.1).and. - & nstate(itypi,itypj).ne.1) THEN -c! Different charge-charge interaction ( +/- or -/+ ) - CALL energy_quad - & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) - END IF - -c! this endif ends the "catch the gly-gly" at the beggining of Fcav - END IF - evdw = evdw - & + Fcav - & + eheadtail -c!------------------------------------------------------------------- -c! As all angular derivatives are done, now we sum them up, -c! then transform and project into cartesian vectors and add to gvdwc -c! We call sc_grad always, with the exception of +/- interaction. -c! This is because energy_quad subroutine needs to handle -c! this job in his own way. -c! This IS probably not very efficient and SHOULD be optimised -c! but it will require major restructurization of emomo -c! so it will be left as it is for now - IF (nstate(itypi,itypj).eq.1) THEN -#ifdef TSCSC - IF (bb(itypi,itypj).gt.0) THEN - CALL sc_grad - ELSE - CALL sc_grad_T - END IF -#else - CALL sc_grad -#endif - END IF -c!------------------------------------------------------------------- -c! NAPISY KONCOWE -c! j - END DO -c! iint - END DO -c! i - END DO -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - RETURN - END SUBROUTINE emomo - -c! END OF MOMO -C-------------------------------------------------------------------- - - - SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar -c! Epol and Gpol analytical parameters - alphapol1 = alphapol(itypi,itypj) - alphapol2 = alphapol(itypj,itypi) -c! Fisocav and Gisocav analytical parameters - al1 = alphiso(1,itypi,itypj) - al2 = alphiso(2,itypi,itypj) - al3 = alphiso(3,itypi,itypj) - al4 = alphiso(4,itypi,itypj) - csig = sigiso(itypi, itypj) -c! - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps0 = epshead(itypi,itypj) - Rhead_sq = Rhead * Rhead - -c! R1 - distance between head of ith side chain and tail of jth sidechain -c! R2 - distance between head of jth side chain and tail of ith sidechain - R1 = 0.0d0 - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - R2 = dsqrt(R2) - -c!------------------------------------------------------------------- -c! Coulomb electrostatic interaction - Ecl = (332.0d0 * Qij) / Rhead -c! write (*,*) "Ecl = ", Ecl -c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / Rhead_sq -c! ============= -c! Ecl = 0.0d0 -c! dGCLdR = 0.0d0 -c! ============= - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 -c!------------------------------------------------------------------- -c! Generalised Born Solvent Polarization - ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) - Fgb = sqrt( ( Rhead_sq ) + a12sq * ee) - Egb = (332.0d0 * Qij * eps_inout_fac) / Fgb - -c! Derivative of Egb is Ggb... - dGGBdFGB = (-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) - dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) ) - & / ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR - -c! ============= -c! write (*,*) "Fgb = ", Fgb -c! write (*,*) "Egb = ", Egb -c! write (*,*) "dFGBdR = ", dFGBdR -c! write (*,*) "dGGBdR = ", dGGBdR -c! Egb = 0.0d0 -c! dGGBdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Fisocav - isotropic cavity creation term - pom = Rhead * csig - top = al1 * (dsqrt(pom) + al2 * pom - al3) - bot = (1.0d0 + al4 * pom**12.0d0) - botsq = bot * bot - FisoCav = top / bot - -c! Derivative of Fisocav is GCV... - dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) - dbot = 12.0d0 * al4 * pom ** 11.0d0 - dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig - -c! ============= -c! FisoCav = 0.0d0 -c! dGCVdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Polarization energy -c! Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR1 = ( R1 * R1 ) / MomoFac1 - RR2 = ( R2 * R2 ) / MomoFac2 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1 ) - fgb2 = sqrt( RR2 + a12sq * ee2 ) - epol = 332.0d0 * eps_inout_fac * ( - & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) - -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / ( 2.0d0 * fgb2 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * ( 2.0d0 - 0.5d0 * ee1) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * ( 2.0d0 - 0.5d0 * ee2) ) - & / ( 2.0d0 * fgb2 ) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! ============= -c! Epol = 0.0d0 -c! dPOLdR1 = 0.0d0 -c! dPOLdR2 = 0.0d0 -c! dPOLdOM1 = 0.0d0 -c! dPOLdOM2 = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps0 * pom * (pom-1.0d0) -c! write (*,*) "ELJ = ", ELJ -c! derivative of Elj is Glj - Glj = 4.0d0 * eps0 - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c! dGLJdR = glj * fish - dGLJdR = glj -c! ============= -c! Elj = 0.0d0 -c! dGLJdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - condor = (erhead_tail(k,2) + - & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dGGBdR * pom - & - dGCVdR * pom - & - dPOLdR1 * hawk - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dGGBdR * pom - & + dGCVdR * pom - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * condor - & + dGLJdR * pom - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dGGBdR * erhead(k) - & - dGCVdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dGGBdR * erhead(k) - & + dGCVdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE eqq - - -c!------------------------------------------------------------------- - - SUBROUTINE energy_quad - &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - double precision ener(4) - double precision dcosom1(3),dcosom2(3) -c! Epol and Gpol analytical parameters - alphapol1 = alphapol(itypi,itypj) - alphapol2 = alphapol(itypj,itypi) -c! Fisocav and Gisocav analytical parameters - al1 = alphiso(1,itypi,itypj) - al2 = alphiso(2,itypi,itypj) - al3 = alphiso(3,itypi,itypj) - al4 = alphiso(4,itypi,itypj) - csig = sigiso(itypi, itypj) -c! - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps0 = epshead(itypi,itypj) - -c! First things first: -c! We need to do sc_grad's job with GB and Fcav - - eom1 = - & eps2der * eps2rt_om1 - & - 2.0D0 * alf1 * eps3der - & + sigder * sigsq_om1 - & + dCAVdOM1 - - eom2 = - & eps2der * eps2rt_om2 - & + 2.0D0 * alf2 * eps3der - & + sigder * sigsq_om2 - & + dCAVdOM2 - - eom12 = - & evdwij * eps1_om12 - & + eps2der * eps2rt_om12 - & - 2.0D0 * alf12 * eps3der - & + sigder *sigsq_om12 - & + dCAVdOM12 - -c! now some magical transformations to project gradient into -c! three cartesian vectors - - DO k = 1, 3 - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) - gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) -c! this acts on hydrophobic center of interaction - gvdwx(k,i)= gvdwx(k,i) - gg(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)= gvdwx(k,j) + gg(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c! this acts on Calpha - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - END DO - -c! sc_grad is done, now we will compute - - eheadtail = 0.0d0 - eom1 = 0.0d0 - eom2 = 0.0d0 - eom12 = 0.0d0 -c************************************************************* - DO istate = 1, nstate(itypi,itypj) -c! DO istate = 1, 1 -c! write (*,*) "istate = ", istate -c************************************************************* - IF (istate.ne.1) THEN - IF (istate.lt.3) THEN - ii = 1 - ELSE - ii = 2 - END IF - jj = istate/ii - d1 = dhead(1,ii,itypi,itypj) - d2 = dhead(2,jj,itypi,itypj) - DO k = 1,3 - chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) - chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) - Rhead_distance(k) = chead(k,2) - chead(k,1) - END DO -c! pitagoras (root of sum of squares) - Rhead = dsqrt( - & (Rhead_distance(1)*Rhead_distance(1)) - & + (Rhead_distance(2)*Rhead_distance(2)) - & + (Rhead_distance(3)*Rhead_distance(3))) - END IF - Rhead_sq = Rhead * Rhead - -c! R1 - distance between head of ith side chain and tail of jth sidechain -c! R2 - distance between head of jth side chain and tail of ith sidechain - R1 = 0.0d0 - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - R2 = dsqrt(R2) - -c!------------------------------------------------------------------- -c! Coulomb electrostatic interaction - Ecl = (332.0d0 * Qij) / Rhead -c! write (*,*) "Ecl = ", Ecl -c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / Rhead_sq -c! ============= -c! write (*,*) "Ecl = ", Ecl -c! write (*,*) "dGCLdR = ", dGCLdR -c! Ecl = 0.0d0 -c! dGCLdR = 0.0d0 -c! ============= - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 -c!------------------------------------------------------------------- -c! Generalised Born Solvent Polarization - ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) - Fgb = sqrt( ( Rhead_sq ) + a12sq * ee) - Egb = (332.0d0 * Qij * eps_inout_fac) / Fgb - -c! Derivative of Egb is Ggb... - dGGBdFGB = (-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) - dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) ) - & / ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR - -c! ============= -c! write (*,*) "Fgb = ", Fgb -c! write (*,*) "Egb = ", Egb -c! write (*,*) "dFGBdR = ", dFGBdR -c! write (*,*) "dGGBdR = ", dGGBdR -c! Egb = 0.0d0 -c! dGGBdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Fisocav - isotropic cavity creation term - pom = Rhead * csig - top = al1 * (dsqrt(pom) + al2 * pom - al3) - bot = (1.0d0 + al4 * pom**12.0d0) - botsq = bot * bot - FisoCav = top / bot - -c! Derivative of Fisocav is GCV... - dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) - dbot = 12.0d0 * al4 * pom ** 11.0d0 - dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig - -c! ============= -c! write(*,*) "FisoCav = ", Fisocav -c! write(*,*) "dGCVdR = ", dGCVdR -c! FisoCav = 0.0d0 -c! dGCVdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Polarization energy -c! Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR1 = ( R1 * R1 ) / MomoFac1 - RR2 = ( R2 * R2 ) / MomoFac2 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1 ) - fgb2 = sqrt( RR2 + a12sq * ee2 ) - epol = 332.0d0 * eps_inout_fac * ( - & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) - -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / ( 2.0d0 * fgb2 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * ( 2.0d0 - 0.5d0 * ee1) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * ( 2.0d0 - 0.5d0 * ee2) ) - & / ( 2.0d0 * fgb2 ) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! ============= -c! write(*,*) "Epol = ", Epol -c! write(*,*) "dPOLdR1 = ", dPOLdOM2 -c! write(*,*) "dPOLdR2 = ", dPOLdR2 -c! write(*,*) "dPOLdOM1 = ", dPOLdOM1 -c! write(*,*) "dPOLdOM2 = ", dPOLdOM2 -c! Epol = 0.0d0 -c! dPOLdR1 = 0.0d0 -c! dPOLdR2 = 0.0d0 -c! dPOLdOM1 = 0.0d0 -c! dPOLdOM2 = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps0 * pom * (pom-1.0d0) -c! write (*,*) "ELJ = ", ELJ -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps0 - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) - -c! ============= -c! write (*,*) "Elj = ", Elj -c! write (*,*) "dGLJdR = ", dGLJdR -c! Elj = 0.0d0 -c! dGLJdR = 0.0d0 -c! ============= -c!------------------------------------------------------------------- -c! Equad - IF (Wqd.ne.0.0d0) THEN - - Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) - & - 37.5d0 * ( sqom1 + sqom2 ) - & + 157.5d0 * ( sqom1 * sqom2 ) - & - 45.0d0 * om1*om2*om12 - fac = -( Wqd / (2.0d0 * Fgb**5.0d0) ) - Equad = fac * Beta1 -c! derivative of Equad... - dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR - dQUADdOM1 = fac - & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12) - dQUADdOM2 = fac - & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12) - dQUADdOM12 = fac - & * ( 6.0d0*om12 - 45.0d0*om1*om2 ) -c! write(*,*) "Equad = ", Equad -c! write(*,*) "dQUADdR = ", dQUADdR -c! write(*,*) "dQUADdOM1 = ", dQUADdOM1 -c! write(*,*) "dQUADdOM2 = ", dQUADdOM2 -c! write(*,*) "dQUADdOM12 = ", dQUADdOM12 - ELSE - Beta1 = 0.0d0 - Equad = 0.0d0 - END IF -c!------------------------------------------------------------------- -c! Return the results - -c! Angular stuff -c! eom1 = eom1 + dPOLdOM1 + dQUADdOM1 -c! eom2 = eom2 + dPOLdOM2 + dQUADdOM2 -c! eom12 = eom12 + dQUADdOM12 - eom1 = dPOLdOM1 + dQUADdOM1 - eom2 = dPOLdOM2 + dQUADdOM2 - eom12 = dQUADdOM12 -c! now some magical transformations to project gradient into -c! three cartesian vectors - DO k = 1, 3 - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) -c! gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) - tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k) - END DO - -c! Radial stuff - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - -c! Throw the results into gheadtail which holds gradients -c! for each micro-state - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - condor = (erhead_tail(k,2) + - & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) -c! this acts on hydrophobic center of interaction -c! gvdwx(k,i) = gvdwx(k,i) - gheadtail(k,1,1) = gheadtail(k,1,1) - & - dGCLdR * pom - & - dGGBdR * pom - & - dGCVdR * pom - & - dPOLdR1 * hawk - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * pom - & - dQUADdR * pom - & - tuna(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c! write (*,*) "gheadtail(k,1,1) = ", gheadtail(k,1,1) - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) -c! this acts on hydrophobic center of interaction -c! gvdwx(k,j) = gvdwx(k,j) - gheadtail(k,2,1) = gheadtail(k,2,1) - & + dGCLdR * pom - & + dGGBdR * pom - & + dGCVdR * pom - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * condor - & + dGLJdR * pom - & + dQUADdR * pom - & + tuna(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - -c! this acts on Calpha -c! gvdwc(k,i) = gvdwc(k,i) - gheadtail(k,3,1) = gheadtail(k,3,1) - & - dGCLdR * erhead(k) - & - dGGBdR * erhead(k) - & - dGCVdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - & - dQUADdR * erhead(k) - & - tuna(k) - -c! this acts on Calpha -c! gvdwc(k,j) = gvdwc(k,j) - gheadtail(k,4,1) = gheadtail(k,4,1) - & + dGCLdR * erhead(k) - & + dGGBdR * erhead(k) - & + dGCVdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - & + dQUADdR * erhead(k) - & + tuna(k) - END DO - ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad -c! write (*,*) "ener(",istate,") = ", ener(istate) - eheadtail = eheadtail - & + wstate(istate, itypi, itypj) - & * dexp(-betaT * ener(istate)) -c! write (*,*) "wstate = ", wstate(istate, itypi, itypj) -c! write (*,*) "betaT = ", betaT -c! write (*,*) "-E1beta = ", (-betaT * ener(istate)) -c! write (*,*) "w1exp = ", (wstate(istate, itypi, itypj) -c! & * dexp(-betaT * ener(istate))) -c! foreach cartesian dimension - DO k = 1, 3 -c! foreach of two gvdwx and gvdwc - DO l = 1, 4 - gheadtail(k,l,2) = gheadtail(k,l,2) - & + wstate( istate, itypi, itypj ) - & * dexp(-betaT * ener(istate)) - & * gheadtail(k,l,1) - gheadtail(k,l,1) = 0.0d0 -c! write (*,*) "wstate = ", wstate(istate,itypi,itypj) -c! write (*,*) "-G1beta =", (-betaT * gheadtail(k,l,1)) -c! write (*,*) "top(",k,",",l,",",2,") = ", gheadtail(k,l,2) - END DO - END DO - END DO -c! Here ended the gigantic DO istate = 1, 4, which starts -c! at the beggining of the subroutine - - DO k = 1, 3 - DO l = 1, 4 - gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail -c! write (*,*) "eheadtail = ", eheadtail -c! write (*,*) "gheadtail(",k,",",l,",2) = ", -c! & gheadtail(k,l,2) - END DO - gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2) - gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2) - gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2) - gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2) - DO l = 1, 4 - gheadtail(k,l,1) = 0.0d0 - gheadtail(k,l,2) = 0.0d0 - END DO - END DO - eheadtail = (-dlog(eheadtail)) / betaT -c! write (*,*) "eheadtail_final = ", eheadtail - dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 - dQUADdOM1 = 0.0d0 - dQUADdOM2 = 0.0d0 - dQUADdOM12 = 0.0d0 - RETURN - END SUBROUTINE energy_quad - - -c!------------------------------------------------------------------- - - - SUBROUTINE eqn(Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - alphapol1 = alphapol(itypi,itypj) -c! R1 - distance between head of ith side chain and tail of jth sidechain - R1 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - RR1 = R1 * R1 / MomoFac1 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1) - epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) -c!------------------------------------------------------------------ -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * (2.0d0 - 0.5d0 * ee1) ) - & / (2.0d0 * fgb1) - - dPOLdR1 = dPOLdFGB1 * dFGBdR1 - - dPOLdOM1 = 0.0d0 - - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - END DO - - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - facd1 = d1 * vbld_inv(i+nres) - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - - gvdwx(k,i) = gvdwx(k,i) - & - dPOLdR1 * hawk - - gvdwx(k,j) = gvdwx(k,j) - & + dPOLdR1 * erhead_tail(k,1) - - gvdwc(k,i) = gvdwc(k,i) - & - dPOLdR1 * erhead_tail(k,1) - - gvdwc(k,j) = gvdwc(k,j) - & + dPOLdR1 * erhead_tail(k,1) - - END DO - RETURN - END SUBROUTINE eqn - - -c!------------------------------------------------------------------- - - - - SUBROUTINE enq(Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - alphapol2 = alphapol(itypj,itypi) -c! R2 - distance between head of jth side chain and tail of ith sidechain - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R2 = dsqrt(R2) -c------------------------------------------------------------------------ -c Polarization energy - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR2 = R2 * R2 / MomoFac2 - ee2 = exp(-(RR2 / (4.0d0 * a12sq))) - fgb2 = sqrt(RR2 + a12sq * ee2) - epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) -c!------------------------------------------------------------------- -c! derivative of Epol is Gpol... - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / (2.0d0 * fgb2) - - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * (2.0d0 - 0.5d0 * ee2) ) - & / (2.0d0 * fgb2) - - dPOLdR2 = dPOLdFGB2 * dFGBdR2 - - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 - - dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - facd2 = d2 * vbld_inv(j+nres) - DO k = 1, 3 - condor = (erhead_tail(k,2) - & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - gvdwx(k,i) = gvdwx(k,i) - & - dPOLdR2 * erhead_tail(k,2) - - gvdwx(k,j) = gvdwx(k,j) - & + dPOLdR2 * condor - - gvdwc(k,i) = gvdwc(k,i) - & - dPOLdR2 * erhead_tail(k,2) - - gvdwc(k,j) = gvdwc(k,j) - & + dPOLdR2 * erhead_tail(k,2) - - END DO - RETURN - END SUBROUTINE enq - - -c!------------------------------------------------------------------- - - - SUBROUTINE eqd(Ecl,Elj,Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - alphapol1 = alphapol(itypi,itypj) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps0 = epshead(itypi,itypj) -c!------------------------------------------------------------------- -c! R1 - distance between head of ith side chain and tail of jth sidechain - R1 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 - END DO -c! Pitagoras - R1 = dsqrt(R1) - -c!------------------------------------------------------------------- -c! ecl - sparrow = w1 * Qi * om1 - hawk = w2 * Qi * Qi * (1.0d0 - sqom2) - Ecl = sparrow / Rhead**2.0d0 - & - hawk / Rhead**4.0d0 -c! Ecl = 0.0d0 -c! write (iout,*) "ECL = ", ECL -c!------------------------------------------------------------------- -c! derivative of ecl is Gcl -c! dF/dr part - dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 - & + 4.0d0 * hawk / Rhead**5.0d0 -c! dGCLdR = 0.0d0 -c! dF/dom1 - dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) -c! dGCLdOM1 = 0.0d0 -c! dF/dom2 - dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) -c! dGCLdOM2 = 0.0d0 -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac1 = (1.0d0 - chi1 * sqom2) - RR1 = R1 * R1 / MomoFac1 - ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) - fgb1 = sqrt( RR1 + a12sq * ee1) - epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) -c! epol = 0.0d0 -c! write (iout,*) "EPOL = ", EPOL -c!------------------------------------------------------------------ -c! derivative of Epol is Gpol... - dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) - & / (fgb1 ** 5.0d0) - dFGBdR1 = ( (R1 / MomoFac1) - & * ( 2.0d0 - (0.5d0 * ee1) ) ) - & / ( 2.0d0 * fgb1 ) - dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) - & * (2.0d0 - 0.5d0 * ee1) ) - & / (2.0d0 * fgb1) - dPOLdR1 = dPOLdFGB1 * dFGBdR1 -c! dPOLdR1 = 0.0d0 - dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 -c! dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps0 * pom * (pom-1.0d0) -c! write (*,*) "ELJ = ", ELJ -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps0 - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) - END DO - - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - - DO k = 1, 3 - hawk = (erhead_tail(k,1) + - & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dPOLdR1 * hawk - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dPOLdR1 * erhead_tail(k,1) - & + dGLJdR * pom - - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dPOLdR1 * erhead_tail(k,1) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dPOLdR1 * erhead_tail(k,1) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE eqd - - -c!------------------------------------------------------------------- - - - SUBROUTINE edq(Ecl,Elj,Epol) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - alphapol2 = alphapol(itypj,itypi) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) - pis = sig0head(itypi,itypj) - eps0 = epshead(itypi,itypj) -c!------------------------------------------------------------------- -c! R2 - distance between head of jth side chain and tail of ith sidechain - R2 = 0.0d0 - DO k = 1, 3 -c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 - END DO -c! Pitagoras - R2 = dsqrt(R2) - -c!------------------------------------------------------------------- -c! ecl - sparrow = w1 * Qi * om1 - hawk = w2 * Qi * Qi * (1.0d0 - sqom2) - ECL = sparrow / Rhead**2.0d0 - & - hawk / Rhead**4.0d0 -c! write (iout,*) "ECL = ", ECL -c! Ecl = 0.0d0 -c!------------------------------------------------------------------- -c! derivative of ecl is Gcl -c! dF/dr part - dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 - & + 4.0d0 * hawk / Rhead**5.0d0 -c! dGCLdR = 0.0d0 -c! dF/dom1 - dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) -c! dGCLdOM1 = 0.0d0 -c! dF/dom2 - dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) -c! dGCLdOM2 = 0.0d0 -c-------------------------------------------------------------------- -c Polarization energy -c Epol - MomoFac2 = (1.0d0 - chi2 * sqom1) - RR2 = R2 * R2 / MomoFac2 - ee2 = exp(-(RR2 / (4.0d0 * a12sq))) - fgb2 = sqrt(RR2 + a12sq * ee2) - epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) -c! write (iout,*) "EPOL = ", EPOL -c! epol = 0.0d0 -c!------------------------------------------------------------------ -c! derivative of Epol is Gpol... - dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) - & / (fgb2 ** 5.0d0) - dFGBdR2 = ( (R2 / MomoFac2) - & * ( 2.0d0 - (0.5d0 * ee2) ) ) - & / (2.0d0 * fgb2) - dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) - & * (2.0d0 - 0.5d0 * ee2) ) - & / (2.0d0 * fgb2) - dPOLdR2 = dPOLdFGB2 * dFGBdR2 -c! dPOLdR1 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 -c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 -c!------------------------------------------------------------------- -c! Elj - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps0 * pom * (pom-1.0d0) -c! write (iout,*) "ELJ = ", ELJ -c! derivative of Elj is Glj - dGLJdR = 4.0d0 * eps0 - & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) - & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) -c!------------------------------------------------------------------- -c! Return the results - DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) - END DO - - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - - DO k = 1, 3 - condor = (erhead_tail(k,2) - & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * pom - - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - & + dPOLdR2 * condor - & + dGLJdR * pom - - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - & - dPOLdR2 * erhead_tail(k,2) - & - dGLJdR * erhead(k) - - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - & + dPOLdR2 * erhead_tail(k,2) - & + dGLJdR * erhead(k) - - END DO - RETURN - END SUBROUTINE edq - - -C-------------------------------------------------------------------- - - - SUBROUTINE edd(ECL) - IMPLICIT NONE - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.CONTROL' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.EMP' - INCLUDE 'COMMON.GEO' - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.LOCAL' - INCLUDE 'COMMON.NAMES' - INCLUDE 'COMMON.VAR' - double precision scalar - csig = sigiso(itypi,itypj) - w1 = wqdip(1,itypi,itypj) - w2 = wqdip(2,itypi,itypj) -c! intermediates - sparrow = -3.0d0 * w1 - rosella = 6.0d0 * w2 - hawk = Rhead**3.0d0 -c! bat = R^6 - bat = hawk**2.0d0 -c! condor = -3w1 / R^3 - condor = sparrow / hawk -c! eagle = 6w2 / R^6 - eagle = rosella / bat - fac = (om12 - 3.0d0 * om1 * om2) - c1 = (w1 / hawk) * fac - c2 = (w2 / Rhead ** 6.0d0) - & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) - ECL = c1 - c2 -c!------------------------------------------------------------------- -c! dervative of ECL is GCL... -c! dECL/dr - c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0) - c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) - & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) - dGCLdR = c1 - c2 -c! dECL/dom1 - c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0) - c2 = (-6.0d0 * w2) / (Rhead**6.0d0) - & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 ) - dGCLdOM1 = c1 - c2 -c! dECL/dom2 - c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) - c2 = (-6.0d0 * w2) / (Rhead**6.0d0) - & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) - dGCLdOM2 = c1 - c2 -c! dECL/dom12 - c1 = w1 / (Rhead ** 3.0d0) - c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 - dGCLdOM12 = c1 - c2 -c!------------------------------------------------------------------- -c! Return the results - DO k= 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - END DO - erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) - erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) - facd1 = d1 * vbld_inv(i+nres) - facd2 = d2 * vbld_inv(j+nres) - DO k = 1, 3 - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gvdwx(k,i) = gvdwx(k,i) - & - dGCLdR * pom - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) - & + dGCLdR * pom - - gvdwc(k,i) = gvdwc(k,i) - & - dGCLdR * erhead(k) - gvdwc(k,j) = gvdwc(k,j) - & + dGCLdR * erhead(k) - END DO - RETURN - END SUBROUTINE edd - - -c!------------------------------------------------------------------- - - - SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol) - IMPLICIT NONE -c! maxres - INCLUDE 'DIMENSIONS' -c! itypi, itypj, i, j, k, l, chead, - INCLUDE 'COMMON.CALC' -c! c, nres, dc_norm - INCLUDE 'COMMON.CHAIN' -c! gradc, gradx - INCLUDE 'COMMON.DERIV' -c! electrostatic gradients-specific variables - INCLUDE 'COMMON.EMP' -c! wquad, dhead, alphiso, alphasur, rborn, epsintab - INCLUDE 'COMMON.INTERACT' -c! Rb - INCLUDE 'COMMON.MD' -c! io for debug, disable it in final builds - INCLUDE 'COMMON.IOUNITS' -c!------------------------------------------------------------------- -c! Variable Init - -c! what amino acid is the aminoacid j'th? - itypj=itype(j) -c! 1/(Gas Constant * Thermostate temperature) = BetaT - BetaT = 1.0d0 / (t_bath * Rb) -c! write (*,*) "t_bath = ", t_bath, "Rb = ", Rb -c! write (*,'(a,f5.3)') " Betat = ", BetaT -c! Gay-berne var's - sig0ij = sigma( itypi,itypj ) - chi1 = chi( itypi, itypj ) - chi2 = chi( itypj, itypi ) - chi12 = chi1 * chi2 - chip1 = chipp( itypi, itypj ) - chip2 = chipp( itypj, itypi ) - chip12 = chip1 * chip2 -c! not used by momo potential, but needed by sc_angular which is shared -c! by all energy_potential subroutines - alf1 = 0.0d0 - alf2 = 0.0d0 - alf12 = 0.0d0 -c! location, location, location - xj = c( 1, nres+j ) - xi - yj = c( 2, nres+j ) - yi - zj = c( 3, nres+j ) - zi - dxj = dc_norm( 1, nres+j ) - dyj = dc_norm( 2, nres+j ) - dzj = dc_norm( 3, nres+j ) -c! distance from center of chain(?) to polar/charged head - d1 = dhead(1, 1, itypi, itypj) - d2 = dhead(2, 1, itypi, itypj) -c! ai*aj from Fgb - a12sq = rborn(itypi,itypj) - a12sq = a12sq * a12sq -c! charge of amino acid itypi is... - Qi = icharge(itypi) - Qj = icharge(itypj) - Qij = Qi * Qj -c! Eps'(i,j) for Elj - eps_head = epshead(itypi,itypj) -c! chis1,2,12 - chis1 = chis(itypi,itypj) - chis2 = chis(itypj,itypi) - chis12 = chis1 * chis2 - sig1 = sigmap(itypi,itypj) - sig2 = sigmap(itypj,itypi) -c! alpha factors from Fcav/Gcav - b1 = alphasur(1,itypi,itypj) - b2 = alphasur(2,itypi,itypj) - b3 = alphasur(3,itypi,itypj) - b4 = alphasur(4,itypi,itypj) -c! used to determine wheter we want to do quadrupole calculations - wqd = wquad(itypi, itypj) - eps_in = epsintab(itypi,itypj) - eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) -c! write (*,*) "eps_inout_fac = ", eps_inout_fac -c!------------------------------------------------------------------- -c! tail location and distance calculations -c! shameless ripoff from emomo - Rtail = 0.0d0 - DO k = 1, 3 - ctail(k,1)=c(k,i+nres)-dtail(k,itypi)*dc_norm(k,nres+i) - ctail(k,2)=c(k,j+nres)-dtail(k,itypj)*dc_norm(k,nres+j) - END DO -c! tail distances will be themselves usefull elswhere -c1 (in Gcav, for example) - Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 ) - Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 ) - Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 ) - Rtail = dsqrt( - & (Rtail_distance(1)*Rtail_distance(1)) - & + (Rtail_distance(2)*Rtail_distance(2)) - & + (Rtail_distance(3)*Rtail_distance(3))) -c!------------------------------------------------------------------- -c! Calculate location and distance between polar heads -c! distance between heads -c! for each one of our three dimensional space... - DO k = 1,3 -c! location of polar head is computed by taking hydrophobic centre -c! and moving by a d1 * dc_norm vector -c! see unres publications for very informative images - chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) - chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) -c! distance -c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) -c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) - Rhead_distance(k) = chead(k,2) - chead(k,1) - END DO -c! pitagoras (root of sum of squares) - Rhead = dsqrt( - & (Rhead_distance(1)*Rhead_distance(1)) - & + (Rhead_distance(2)*Rhead_distance(2)) - & + (Rhead_distance(3)*Rhead_distance(3))) -c!------------------------------------------------------------------- -c! zero everything that should be zero'ed - Egb = 0.0d0 - ECL = 0.0d0 - Elj = 0.0d0 - Equad = 0.0d0 - Epol = 0.0d0 - eheadtail = 0.0d0 - dGCLdR = 0.0d0 - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 0.0d0 - dPOLdR1 = 0.0d0 - dPOLdOM1 = 0.0d0 - dPOLdOM2 = 0.0d0 - Glj = 0.0d0 - dGLJdR = 0.0d0 - dGLJdOM1 = 0.0d0 - dGLJdOM2 = 0.0d0 - dGLJdOM12 = 0.0d0 - RETURN - END SUBROUTINE elgrad_init - - -c!------------------------------------------------------------------- - - - SUBROUTINE sc_angular -C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2, -C om12. Called by ebp, egb, egbv, and emomo - IMPLICIT NONE -c! ntyp needed in other commons - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CALC' -c! chi() - INCLUDE 'COMMON.INTERACT' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.EMP' - - erij(1) = xj * rij - erij(2) = yj * rij - erij(3) = zj * rij - om1 = dxi * erij(1) + dyi * erij(2) + dzi * erij(3) - om2 = dxj * erij(1) + dyj * erij(2) + dzj * erij(3) - om12 = dxi * dxj + dyi * dyj + dzi * dzj - chiom12 = chi12 * om12 -C Calculate eps1(om12) and its derivative in om12 - faceps1 = 1.0D0 - om12 * chiom12 - faceps1_inv = 1.0D0 / faceps1 - eps1 = dsqrt(faceps1_inv) -C Following variable is eps1*deps1/dom12 - eps1_om12 = faceps1_inv * chiom12 -C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2, -C and om12. - om1om2 = om1 * om2 - chiom1 = chi1 * om1 - chiom2 = chi2 * om2 - facsig = om1 * chiom1 + om2 * chiom2 - & - 2.0D0 * om1om2 * chiom12 - sigsq = 1.0D0 - facsig * faceps1_inv - sigsq_om1 = (chiom1 - chiom12 * om2) * faceps1_inv - sigsq_om2 = (chiom2 - chiom12 * om1) * faceps1_inv - sigsq_om12 = -chi12 * (om1om2 * faceps1 - om12 * facsig) - & * faceps1_inv**2 -C Calculate eps2 and its derivatives in om1, om2, and om12. - chipom1 = chip1 * om1 - chipom2 = chip2 * om2 - chipom12 = chip12 * om12 - facp = 1.0D0 - om12 * chipom12 - facp_inv = 1.0D0 / facp - facp1 = om1 * chipom1 + om2 * chipom2 - & -2.0D0 * om1om2 * chipom12 -C Following variable is the square root of eps2 - eps2rt = 1.0D0 - facp1 * facp_inv - -C Following three variables are the derivatives of the square root of eps -C in om1, om2, and om12. - eps2rt_om1 =-4.0D0 * (chipom1 - chipom12 * om2) * facp_inv - eps2rt_om2 =-4.0D0 * (chipom2 - chipom12 * om1) * facp_inv - eps2rt_om12 = 4.0D0 * chip12 - & * (om1om2*facp-om12*facp1)*facp_inv**2 - -c! Evaluate the "asymmetric" factor in the VDW constant, eps3 -c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular -c! Or frankly, we should restructurize the whole energy section - eps3rt = 1.0D0 - alf1 * om1 + alf2 * om2 - alf12 * om12 - -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - - RETURN - END SUBROUTINE sc_angular - - -C-------------------------------------------------------------------- - - - subroutine sc_grad_T - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - do l=1,3 - gvdwcT(l,i)=gvdwcT(l,i)-gg(l) - gvdwcT(l,j)=gvdwcT(l,j)+gg(l) - enddo - return - end - - -C-------------------------------------------------------------------- - - - SUBROUTINE sc_grad - IMPLICIT real*8 (a-h,o-z) - INCLUDE 'DIMENSIONS' - INCLUDE 'COMMON.CHAIN' - INCLUDE 'COMMON.DERIV' - INCLUDE 'COMMON.CALC' - INCLUDE 'COMMON.IOUNITS' - INCLUDE 'COMMON.EMP' - double precision dcosom1(3),dcosom2(3) - -c! each eom holds sum of omega-angular derivatives of each component -c! of energy function. First GGB, then Gcav, dipole-dipole,... - eom1 = - & eps2der * eps2rt_om1 - & - 2.0D0 * alf1 * eps3der - & + sigder * sigsq_om1 - & + dCAVdOM1 - & + dGCLdOM1 - & + dPOLdOM1 - - eom2 = - & eps2der * eps2rt_om2 - & + 2.0D0 * alf2 * eps3der - & + sigder * sigsq_om2 - & + dCAVdOM2 - & + dGCLdOM2 - & + dPOLdOM2 - - eom12 = - & evdwij * eps1_om12 - & + eps2der * eps2rt_om12 - & - 2.0D0 * alf12 * eps3der - & + sigder *sigsq_om12 - & + dCAVdOM12 - & + dGCLdOM12 - -c! now some magical transformations to project gradient into -c! three cartesian vectors - - DO k = 1, 3 - dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) - dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) - gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) -c! this acts on hydrophobic center of interaction - gvdwx(k,i)= gvdwx(k,i) - gg(k) - & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)= gvdwx(k,j) + gg(k) - & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv -c! this acts on Calpha - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - END DO - RETURN - END SUBROUTINE sc_grad - - -C-------------------------------------------------------------------- - - - subroutine e_softsphere(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rij=xj*xj+yj*yj+zj*zj -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - r0ij=r0(itypi,itypj) - r0ijsq=r0ij*r0ij -c print *,i,j,r0ij,dsqrt(rij) - if (rij.lt.r0ijsq) then - evdwij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdwij=0.0d0 - fac=0.0d0 - endif - evdw=evdw+evdwij -C -C Calculate the components of the gradient in DC and X -C - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - enddo ! j - enddo ! iint - enddo ! i - return - end - - -C-------------------------------------------------------------------- - - - subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) -C -C Soft-sphere potential of p-p interaction -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - dimension ggg(3) -cd write(iout,*) 'In EELEC_soft_sphere' - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - do j=ielstart(i),ielend(i) - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - r0ij=rpp(iteli,itelj) - r0ijsq=r0ij*r0ij - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - if (rij.lt.r0ijsq) then - evdw1ij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdw1ij=0.0d0 - fac=0.0d0 - endif - evdw1=evdw1+evdw1ij -C -C Calculate contributions to the Cartesian gradient. -C - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj - do k=1,3 - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - enddo ! j - enddo ! i -cgrad do i=nnt,nct-1 -cgrad do k=1,3 -cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i) -cgrad enddo -cgrad do j=i+1,nct-1 -cgrad do k=1,3 -cgrad gelc(k,i)=gelc(k,i)+gelc(k,j) -cgrad enddo -cgrad enddo -cgrad enddo - return - end - - -c-------------------------------------------------------------------- - - - subroutine vec_and_deriv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - include 'COMMON.SETUP' - include 'COMMON.TIME1' - dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2) -C Compute the local reference systems. For reference system (i), the -C X-axis points from CA(i) to CA(i+1), the Y axis is in the -C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. -#ifdef PARVEC - do i=ivec_start,ivec_end -#else - do i=1,nres-1 -#endif - if (i.eq.nres-1) then -C Case of the last full residue -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) - costh=dcos(pi-theta(nres)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i-1) - uzder(3,1,1)= dc_norm(2,i-1) - uzder(1,2,1)= dc_norm(3,i-1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i-1) - uzder(1,3,1)=-dc_norm(2,i-1) - uzder(2,3,1)= dc_norm(1,i-1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - do k=1,3 - uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i-1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo - uyder(j,j,1)=uyder(j,j,1)-costh - uyder(j,j,2)=1.0d0+uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - else -C Other residues -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) - costh=dcos(pi-theta(i+2)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i+1) - uzder(3,1,1)= dc_norm(2,i+1) - uzder(1,2,1)= dc_norm(3,i+1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i+1) - uzder(1,3,1)=-dc_norm(2,i+1) - uzder(2,3,1)= dc_norm(1,i+1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - do k=1,3 - uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i+1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo - uyder(j,j,1)=uyder(j,j,1)-costh - uyder(j,j,2)=1.0d0+uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - endif - enddo - do i=1,nres-1 - vbld_inv_temp(1)=vbld_inv(i+1) - if (i.lt.nres-1) then - vbld_inv_temp(2)=vbld_inv(i+2) - else - vbld_inv_temp(2)=vbld_inv(i) - endif - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i) - uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo -#if defined(PARVEC) && defined(MPI) - if (nfgtasks1.gt.1) then - time00=MPI_Wtime() -c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start, -c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1), -c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1) - call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1), - & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, - & FG_COMM1,IERR) - call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1), - & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, - & FG_COMM1,IERR) - call MPI_Allgatherv(uygrad(1,1,1,ivec_start), - & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0), - & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) - call MPI_Allgatherv(uzgrad(1,1,1,ivec_start), - & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0), - & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR) - time_gather=time_gather+MPI_Wtime()-time00 - endif -c if (fg_rank.eq.0) then -c write (iout,*) "Arrays UY and UZ" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), -c & (uz(k,i),k=1,3) -c enddo -c endif -#endif - return - end - - -C-------------------------------------------------------------------- - - - subroutine check_vecgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres) - dimension uyt(3,maxres),uzt(3,maxres) - dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3) - double precision delta /1.0d-7/ - call vec_and_deriv -cd do i=1,nres -crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i) -crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i) -crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i) -cd write(iout,'(2i5,2(3f10.5,5x))') i,1, -cd & (dc_norm(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3) -cd write(iout,'(a)') -cd enddo - do i=1,nres - do j=1,2 - do k=1,3 - do l=1,3 - uygradt(l,k,j,i)=uygrad(l,k,j,i) - uzgradt(l,k,j,i)=uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - call vec_and_deriv - do i=1,nres - do j=1,3 - uyt(j,i)=uy(j,i) - uzt(j,i)=uz(j,i) - enddo - enddo - do i=1,nres -cd write (iout,*) 'i=',i - do k=1,3 - erij(k)=dc_norm(k,i) - enddo - do j=1,3 - do k=1,3 - dc_norm(k,i)=erij(k) - enddo - dc_norm(j,i)=dc_norm(j,i)+delta -c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) -c do k=1,3 -c dc_norm(k,i)=dc_norm(k,i)/fac -c enddo -c write (iout,*) (dc_norm(k,i),k=1,3) -c write (iout,*) (erij(k),k=1,3) - call vec_and_deriv - do k=1,3 - uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta - uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta - uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta - uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta - enddo -c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3), -c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3) - enddo - do k=1,3 - dc_norm(k,i)=erij(k) - enddo -cd do k=1,3 -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3), -cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3) -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3), -cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3) -cd write (iout,'(a)') -cd enddo - enddo - return - end - - -C-------------------------------------------------------------------------- - - - subroutine set_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include "COMMON.SETUP" - integer IERR - integer status(MPI_STATUS_SIZE) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - double precision auxvec(2),auxmat(2,2) -C -C Compute the virtual-bond-torsional-angle dependent quantities needed -C to calculate the el-loc multibody terms of various order. -C -#ifdef PARMAT - do i=ivec_start+2,ivec_end+2 -#else - do i=3,nres+1 -#endif - if (i .lt. nres+1) then - sin1=dsin(phi(i)) - cos1=dcos(phi(i)) - sintab(i-2)=sin1 - costab(i-2)=cos1 - obrot(1,i-2)=cos1 - obrot(2,i-2)=sin1 - sin2=dsin(2*phi(i)) - cos2=dcos(2*phi(i)) - sintab2(i-2)=sin2 - costab2(i-2)=cos2 - obrot2(1,i-2)=cos2 - obrot2(2,i-2)=sin2 - Ug(1,1,i-2)=-cos1 - Ug(1,2,i-2)=-sin1 - Ug(2,1,i-2)=-sin1 - Ug(2,2,i-2)= cos1 - Ug2(1,1,i-2)=-cos2 - Ug2(1,2,i-2)=-sin2 - Ug2(2,1,i-2)=-sin2 - Ug2(2,2,i-2)= cos2 - else - costab(i-2)=1.0d0 - sintab(i-2)=0.0d0 - obrot(1,i-2)=1.0d0 - obrot(2,i-2)=0.0d0 - obrot2(1,i-2)=0.0d0 - obrot2(2,i-2)=0.0d0 - Ug(1,1,i-2)=1.0d0 - Ug(1,2,i-2)=0.0d0 - Ug(2,1,i-2)=0.0d0 - Ug(2,2,i-2)=1.0d0 - Ug2(1,1,i-2)=0.0d0 - Ug2(1,2,i-2)=0.0d0 - Ug2(2,1,i-2)=0.0d0 - Ug2(2,2,i-2)=0.0d0 - endif - if (i .gt. 3 .and. i .lt. nres+1) then - obrot_der(1,i-2)=-sin1 - obrot_der(2,i-2)= cos1 - Ugder(1,1,i-2)= sin1 - Ugder(1,2,i-2)=-cos1 - Ugder(2,1,i-2)=-cos1 - Ugder(2,2,i-2)=-sin1 - dwacos2=cos2+cos2 - dwasin2=sin2+sin2 - obrot2_der(1,i-2)=-dwasin2 - obrot2_der(2,i-2)= dwacos2 - Ug2der(1,1,i-2)= dwasin2 - Ug2der(1,2,i-2)=-dwacos2 - Ug2der(2,1,i-2)=-dwacos2 - Ug2der(2,2,i-2)=-dwasin2 - else - obrot_der(1,i-2)=0.0d0 - obrot_der(2,i-2)=0.0d0 - Ugder(1,1,i-2)=0.0d0 - Ugder(1,2,i-2)=0.0d0 - Ugder(2,1,i-2)=0.0d0 - Ugder(2,2,i-2)=0.0d0 - obrot2_der(1,i-2)=0.0d0 - obrot2_der(2,i-2)=0.0d0 - Ug2der(1,1,i-2)=0.0d0 - Ug2der(1,2,i-2)=0.0d0 - Ug2der(2,1,i-2)=0.0d0 - Ug2der(2,2,i-2)=0.0d0 - endif -c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then - if (i.gt. nnt+2 .and. i.lt.nct+2) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif -c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif -cd write (iout,*) '*******i',i,' iti1',iti -cd write (iout,*) 'b1',b1(:,iti) -cd write (iout,*) 'b2',b2(:,iti) -cd write (iout,*) 'Ug',Ug(:,:,i-2) -c if (i .gt. iatel_s+2) then - if (i .gt. nnt+2) then - call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) - call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) - call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) - endif - else - do k=1,2 - Ub2(k,i-2)=0.0d0 - Ctobr(k,i-2)=0.0d0 - Dtobr2(k,i-2)=0.0d0 - do l=1,2 - EUg(l,k,i-2)=0.0d0 - CUg(l,k,i-2)=0.0d0 - DUg(l,k,i-2)=0.0d0 - DtUg2(l,k,i-2)=0.0d0 - enddo - enddo - endif - call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) - call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) - do k=1,2 - muder(k,i-2)=Ub2der(k,i-2) - enddo -c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then - if (i.gt. nnt+1 .and. i.lt.nct+1) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif - do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) - enddo -cd write (iout,*) 'mu ',mu(:,i-2) -cd write (iout,*) 'mu1',mu1(:,i-2) -cd write (iout,*) 'mu2',mu2(:,i-2) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) - & then - call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) - call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) - call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) - call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) - call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) - call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) - endif - enddo -C Matrices dependent on two consecutive virtual-bond dihedrals. -C The order of matrices is from left to right. - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) - &then -c do i=max0(ivec_start,2),ivec_end - do i=2,nres-1 - call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i)) - call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i)) - call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i)) - call transpose2(DtUg2(1,1,i-1),auxmat(1,1)) - call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i)) - call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i)) - call transpose2(DtUg2der(1,1,i-1),auxmat(1,1)) - call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i)) - enddo - endif -#if defined(MPI) && defined(PARMAT) -#ifdef DEBUG -c if (fg_rank.eq.0) then - write (iout,*) "Arrays UG and UGDER before GATHER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug(l,k,i),l=1,2),k=1,2), - & ((ugder(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays UG2 and UG2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug2(l,k,i),l=1,2),k=1,2), - & ((ug2der(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), - & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) - enddo - write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & costab(i),sintab(i),costab2(i),sintab2(i) - enddo - write (iout,*) "Array MUDER" - do i=1,nres-1 - write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) - enddo -c endif -#endif - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start, -c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1), -c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1) -#ifdef MATGATHER - call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1), - & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2Db1tder(1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1), - & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU, - & FG_COMM1,IERR) - call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Dtug2der(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1), - & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1, - & FG_COMM1,IERR) - call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0), - & MPI_MAT2,FG_COMM1,IERR) - call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start), - & ivec_count(fg_rank1), - & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0), - & MPI_MAT2,FG_COMM1,IERR) - endif -#else -c Passes matrix info through the ring - isend=fg_rank1 - irecv=fg_rank1-1 - if (irecv.lt.0) irecv=nfgtasks1-1 - iprev=irecv - inext=fg_rank1+1 - if (inext.ge.nfgtasks1) inext=0 - do i=1,nfgtasks1-1 -c write (iout,*) "isend",isend," irecv",irecv -c call flush(iout) - lensend=lentyp(isend) - lenrecv=lentyp(irecv) -c write (iout,*) "lensend",lensend," lenrecv",lenrecv -c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1, -c & MPI_ROTAT1(lensend),inext,2200+isend, -c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv), -c & iprev,2200+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT1" -c call flush(iout) -c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1, -c & MPI_ROTAT2(lensend),inext,3300+isend, -c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), -c & iprev,3300+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT2" -c call flush(iout) - call MPI_SENDRECV(costab(ivec_displ(isend)+1),1, - & MPI_ROTAT_OLD(lensend),inext,4400+isend, - & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv), - & iprev,4400+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather ROTAT_OLD" -c call flush(iout) - call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1, - & MPI_PRECOMP11(lensend),inext,5500+isend, - & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv), - & iprev,5500+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP11" -c call flush(iout) - call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP12(lensend),inext,6600+isend, - & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv), - & iprev,6600+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP12" -c call flush(iout) - if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) - & then - call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1, - & MPI_ROTAT2(lensend),inext,7700+isend, - & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv), - & iprev,7700+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP21" -c call flush(iout) - call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP22(lensend),inext,8800+isend, - & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv), - & iprev,8800+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP22" -c call flush(iout) - call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1, - & MPI_PRECOMP23(lensend),inext,9900+isend, - & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1, - & MPI_PRECOMP23(lenrecv), - & iprev,9900+irecv,FG_COMM,status,IERR) -c write (iout,*) "Gather PRECOMP23" -c call flush(iout) - endif - isend=irecv - irecv=irecv-1 - if (irecv.lt.0) irecv=nfgtasks1-1 - enddo -#endif - time_gather=time_gather+MPI_Wtime()-time00 - endif -#ifdef DEBUG -c if (fg_rank.eq.0) then - write (iout,*) "Arrays UG and UGDER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug(l,k,i),l=1,2),k=1,2), - & ((ugder(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays UG2 and UG2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & ((ug2(l,k,i),l=1,2),k=1,2), - & ((ug2der(l,k,i),l=1,2),k=1,2) - enddo - write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2), - & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2) - enddo - write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2" - do i=1,nres-1 - write (iout,'(i5,4f10.5,5x,4f10.5)') i, - & costab(i),sintab(i),costab2(i),sintab2(i) - enddo - write (iout,*) "Array MUDER" - do i=1,nres-1 - write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i) - enddo -c endif -#endif -#endif -cd do i=1,nres -cd iti = itortyp(itype(i)) -cd write (iout,*) i -cd do j=1,2 -cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') -cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) -cd enddo -cd enddo - return - end - - -C-------------------------------------------------------------------------- - - - subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C -C This subroutine calculates the average interaction energy and its gradient -C in the virtual-bond vectors between non-adjacent peptide groups, based on -C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. -C The potential depends both on the distance of peptide-group centers and on -C the orientation of the CA-CA virtual bonds. -C - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -cd write(iout,*) 'In EELEC' -cd do i=1,nloctyp -cd write(iout,*) 'Type',i -cd write(iout,*) 'B1',B1(:,i) -cd write(iout,*) 'B2',B2(:,i) -cd write(iout,*) 'CC',CC(:,:,i) -cd write(iout,*) 'DD',DD(:,:,i) -cd write(iout,*) 'EE',EE(:,:,i) -cd enddo -cd call check_vecgrad -cd stop - if (icheckgrad.eq.1) then - do i=1,nres-1 - fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) - do k=1,3 - dc_norm(k,i)=dc(k,i)*fac - enddo -c write (iout,*) 'i',i,' fac',fac - enddo - endif - if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. - & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -c call vec_and_deriv -#ifdef TIMING - time01=MPI_Wtime() -#endif - call set_matrices -#ifdef TIMING - time_mat=time_mat+MPI_Wtime()-time01 -#endif - endif -cd do i=1,nres-1 -cd write (iout,*) 'i=',i -cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -cd enddo -cd do k=1,3 -cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') -cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) -cd enddo -cd enddo - t_eelecij=0.0d0 - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=1,nres - num_cont_hb(i)=0 - enddo -cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - enddo -c -c -c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -C -C Loop over i,i+2 and i,i+3 pairs of the peptide groups -C - do i=iturn3_start,iturn3_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 - call eelecij(i,i+2,ees,evdw1,eel_loc) - if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) - num_cont_hb(i)=num_conti - enddo - do i=iturn4_start,iturn4_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=num_cont_hb(i) - call eelecij(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) - num_cont_hb(i)=num_conti - enddo ! i -c -c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -c - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - num_conti=num_cont_hb(i) - do j=ielstart(i),ielend(i) - call eelecij(i,j,ees,evdw1,eel_loc) - enddo ! j - num_cont_hb(i)=num_conti - enddo ! i -c write (iout,*) "Number of loop steps in EELEC:",ind -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 -cd print *,"Processor",fg_rank," t_eelecij",t_eelecij - return - end - - -C------------------------------------------------------------------------------- - - -cDEC$ ATTRIBUTES FORCEINLINE :: eelecij - subroutine eelecij(i,j,ees,evdw1,eel_loc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -c time00=MPI_Wtime() -cd write (iout,*) "eelecij",i,j -c ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - ael6i=ael6(iteli,itelj) - ael3i=ael3(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - rmij=1.0D0/rij - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj - cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij - cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij - fac=cosa-3.0D0*cosb*cosg - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - fac3=ael6i*r6ij - fac4=ael3i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 -C 12/26/95 - for the evaluation of multi-body H-bonding interactions - ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij - evdw1=evdw1+evdwij -cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, -cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, -cd & xmedi,ymedi,zmedi,xj,yj,zj - - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij - endif - -C -C Calculate contributions to the Cartesian gradient. -C -#ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) - facel=-3*rrmij*(el1+eesij) - fac1=fac - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -cgrad enddo -cgrad enddo -#else - facvdw=ev1+evdwij - facel=el1+eesij - fac1=fac - fac=-3*rrmij*(facvdw+facvdw+facel) - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc(k,j)+ggg(k) - gelc_long(k,i)=gelc(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -#endif -* -* Angular part -* - ecosa=2.0D0*fac3*fac1+fac4 - fac4=-3.0D0*fac4 - fac3=-6.0D0*fac3 - ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4) - ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4) - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo -cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), -cd & (dcosg(k),k=1,3) - do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) - enddo -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -c gelc(k,j)=gelc(k,j)+ghalf -c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -c enddo -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo - IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 - & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C -C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction -C energy of a peptide unit is assumed in the form of a second-order -C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. -C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms -C are computed for EVERY pair of non-contiguous peptide groups. -C - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - kkk=0 - do k=1,2 - do l=1,2 - kkk=kkk+1 - muij(kkk)=mu(k,i)*mu(l,j) - enddo - enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij - ury=scalar(uy(1,i),erij) - urz=scalar(uz(1,i),erij) - vry=scalar(uy(1,j),erij) - vrz=scalar(uz(1,j),erij) - a22=scalar(uy(1,i),uy(1,j))-3*ury*vry - a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz - a32=scalar(uz(1,i),uy(1,j))-3*urz*vry - a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz - fac=dsqrt(-ael6i)*r3ij - a22=a22*fac - a23=a23*fac - a32=a32*fac - a33=a33*fac -cd write (iout,'(4i5,4f10.5)') -cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 -cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -cd & uy(:,j),uz(:,j) -cd write (iout,'(4f10.5)') -cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), -cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) -cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(9f10.5/)') -cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij -C Derivatives of the elements of A in virtual-bond vectors - call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) - do k=1,3 - uryg(k,1)=scalar(erder(1,k),uy(1,i)) - uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) - uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1)) - urzg(k,1)=scalar(erder(1,k),uz(1,i)) - urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1)) - urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1)) - vryg(k,1)=scalar(erder(1,k),uy(1,j)) - vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1)) - vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1)) - vrzg(k,1)=scalar(erder(1,k),uz(1,j)) - vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) - vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) - enddo -C Compute radial contributions to the gradient - facr=-3.0d0*rrmij - a22der=a22*facr - a23der=a23*facr - a32der=a32*facr - a33der=a33*facr - agg(1,1)=a22der*xj - agg(2,1)=a22der*yj - agg(3,1)=a22der*zj - agg(1,2)=a23der*xj - agg(2,2)=a23der*yj - agg(3,2)=a23der*zj - agg(1,3)=a32der*xj - agg(2,3)=a32der*yj - agg(3,3)=a32der*zj - agg(1,4)=a33der*xj - agg(2,4)=a33der*yj - agg(3,4)=a33der*zj -C Add the contributions coming from er - fac3=-3.0d0*fac - do k=1,3 - agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury) - agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury) - agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz) - agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz) - enddo - do k=1,3 -C Derivatives in DC(i) -cgrad ghalf1=0.5d0*agg(k,1) -cgrad ghalf2=0.5d0*agg(k,2) -cgrad ghalf3=0.5d0*agg(k,3) -cgrad ghalf4=0.5d0*agg(k,4) - aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)!+ghalf1 - aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)!+ghalf2 - aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)!+ghalf3 - aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -C Derivatives in DC(i+1) - aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)!+agg(k,1) - aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) - aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)!+agg(k,3) - aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -C Derivatives in DC(j) - aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)!+ghalf1 - aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)!+ghalf2 - aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)!+ghalf3 - aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -C Derivatives in DC(j+1) or DC(nres-1) - aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) - & -3.0d0*vryg(k,3)*ury) - aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) - & -3.0d0*vrzg(k,3)*ury) - aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) - & -3.0d0*vryg(k,3)*urz) - aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) - & -3.0d0*vrzg(k,3)*urz) -cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -cgrad do l=1,4 -cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -cgrad enddo -cgrad endif - enddo - acipa(1,1)=a22 - acipa(1,2)=a23 - acipa(2,1)=a32 - acipa(2,2)=a33 - a22=-a22 - a23=-a23 - do l=1,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - if (j.lt.nres-1) then - a22=-a22 - a32=-a32 - do l=1,3,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - else - a22=-a22 - a23=-a23 - a32=-a32 - a33=-a33 - do l=1,4 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - endif - ENDIF ! WCORR - IF (wel_loc.gt.0.0d0) THEN -C Contribution to the local-electrostatic energy coming from the i-j pair - eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) - & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eelloc',i,j,eel_loc_ij - - eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma - if (i.gt.1) - & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) - gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -cgrad ghalf=0.5d0*ggg(l) -cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf - enddo -cgrad do k=i+1,j2 -cgrad do l=1,3 -cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -C Remaining derivatives of eello - do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) - enddo - ENDIF -C Change 12/26/95 to calculate four-body contributions to H-bonding energy -c if (j.gt.i+1 .and. num_conti.le.maxconts) then - if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 - & .and. num_conti.le.maxconts) then -c write (iout,*) i,j," entered corr" -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -c r0ij=1.02D0*rpp(iteli,itelj) -c r0ij=1.11D0*rpp(iteli,itelj) - r0ij=2.20D0*rpp(iteli,itelj) -c r0ij=1.55D0*rpp(iteli,itelj) - call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) - if (fcont.gt.0.0D0) then - num_conti=num_conti+1 - if (num_conti.gt.maxconts) then - write (iout,*) 'WARNING - max. # of contacts exceeded;', - & ' will skip next contacts for this conf.' - else - jcont_hb(num_conti,i)=j -cd write (iout,*) "i",i," j",j," num_conti",num_conti, -cd & " jcont_hb",jcont_hb(num_conti,i) - IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. - & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el -C terms. - d_cont(num_conti,i)=rij -cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij -C --- Electrostatic-interaction matrix --- - a_chuj(1,1,num_conti,i)=a22 - a_chuj(1,2,num_conti,i)=a23 - a_chuj(2,1,num_conti,i)=a32 - a_chuj(2,2,num_conti,i)=a33 -C --- Gradient of rij - do kkk=1,3 - grij_hb_cont(kkk,num_conti,i)=erij(kkk) - enddo - kkll=0 - do k=1,2 - do l=1,2 - kkll=kkll+1 - do m=1,3 - a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll) - a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll) - a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) - a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) - a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) - enddo - enddo - enddo - ENDIF - IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN -C Calculate contact energies - cosa4=4.0D0*cosa - wij=cosa-3.0D0*cosb*cosg - cosbg1=cosb+cosg - cosbg2=cosb-cosg -c fac3=dsqrt(-ael6i)/r0ij**3 - fac3=dsqrt(-ael6i)*r3ij -c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 - if (ees0tmp.gt.0) then - ees0pij=dsqrt(ees0tmp) - else - ees0pij=0 - endif -c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) - ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 - if (ees0tmp.gt.0) then - ees0mij=dsqrt(ees0tmp) - else - ees0mij=0 - endif -c ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) -C Diagnostics. Comment out or remove after debugging! -c ees0p(num_conti,i)=0.5D0*fac3*ees0pij -c ees0m(num_conti,i)=0.5D0*fac3*ees0mij -c ees0m(num_conti,i)=0.0D0 -C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -C Angular derivatives of the contact function - ees0pij1=fac3/ees0pij - ees0mij1=fac3/ees0mij - fac3p=-3.0D0*fac3*rrmij - ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) - ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) -c ees0mij1=0.0D0 - ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) - ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) - ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) - ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) - ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) - ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) - ecosap=ecosa1+ecosa2 - ecosbp=ecosb1+ecosb2 - ecosgp=ecosg1+ecosg2 - ecosam=ecosa1-ecosa2 - ecosbm=ecosb1-ecosb2 - ecosgm=ecosg1-ecosg2 -C Diagnostics -c ecosap=ecosa1 -c ecosbp=ecosb1 -c ecosgp=ecosg1 -c ecosam=0.0D0 -c ecosbm=0.0D0 -c ecosgm=0.0D0 -C End diagnostics - facont_hb(num_conti,i)=fcont - fprimcont=fprimcont/rij -cd facont_hb(num_conti,i)=1.0D0 -C Following line is for diagnostics. -cd fprimcont=0.0D0 - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo - do k=1,3 - gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) - gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) - enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj -C Derivatives due to the contact function - gacont_hbr(1,num_conti,i)=fprimcont*xj - gacont_hbr(2,num_conti,i)=fprimcont*yj - gacont_hbr(3,num_conti,i)=fprimcont*zj - do k=1,3 -c -c 10/24/08 cgrad and ! comments indicate the parts of the code removed -c following the change of gradient-summation algorithm. -c -cgrad ghalfp=0.5D0*gggp(k) -cgrad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) - enddo -C Diagnostics. Comment out or remove after debugging! -cdiag do k=1,3 -cdiag gacontp_hb1(k,num_conti,i)=0.0D0 -cdiag gacontp_hb2(k,num_conti,i)=0.0D0 -cdiag gacontp_hb3(k,num_conti,i)=0.0D0 -cdiag gacontm_hb1(k,num_conti,i)=0.0D0 -cdiag gacontm_hb2(k,num_conti,i)=0.0D0 -cdiag gacontm_hb3(k,num_conti,i)=0.0D0 -cdiag enddo - ENDIF ! wcorr - endif ! num_conti.le.maxconts - endif ! fcont.gt.0 - endif ! j.gt.i+1 - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then - do k=1,4 - do l=1,3 - ghalf=0.5d0*agg(l,k) - aggi(l,k)=aggi(l,k)+ghalf - aggi1(l,k)=aggi1(l,k)+agg(l,k) - aggj(l,k)=aggj(l,k)+ghalf - enddo - enddo - if (j.eq.nres-1 .and. i.lt.j-2) then - do k=1,4 - do l=1,3 - aggj1(l,k)=aggj1(l,k)+agg(l,k) - enddo - enddo - endif - endif -c t_eelecij=t_eelecij+MPI_Wtime()-time00 - return - end - - -C-------------------------------------------------------------------- - - - subroutine eturn3(i,eello_turn3) -C Third- and fourth-order contributions from turns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - dimension ggg(3) - double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), - & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) - double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 - j=i+2 -c write (iout,*) "eturn3",i,j,j1,j2 - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Third-order contributions -C -C (i+2)o----(i+3) -C | | -C | | -C (i+1)o----i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd call checkint_turn3(i,a_temp,eello_turn3_num) - call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) - call transpose2(auxmat(1,1),auxmat1(1,1)) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) -cd write (2,*) 'i,',i,' j',j,'eello_turn3', -cd & 0.5d0*(pizda(1,1)+pizda(2,2)), -cd & ' eello_turn3_num',4*eello_turn3_num -C Derivatives in gamma(i) - call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),auxmat3(1,1)) - call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) - gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) -C Derivatives in gamma(i+1) - call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),auxmat3(1,1)) - call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) - gel_loc_turn3(i+1)=gel_loc_turn3(i+1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) -C Cartesian derivatives - do l=1,3 -c ghalf1=0.5d0*agg(l,1) -c ghalf2=0.5d0*agg(l,2) -c ghalf3=0.5d0*agg(l,3) -c ghalf4=0.5d0*agg(l,4) - a_temp(1,1)=aggi(l,1)!+ghalf1 - a_temp(1,2)=aggi(l,2)!+ghalf2 - a_temp(2,1)=aggi(l,3)!+ghalf3 - a_temp(2,2)=aggi(l,4)!+ghalf4 - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,i)=gcorr3_turn(l,i) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggi1(l,1)!+agg(l,1) - a_temp(1,2)=aggi1(l,2)!+agg(l,2) - a_temp(2,1)=aggi1(l,3)!+agg(l,3) - a_temp(2,2)=aggi1(l,4)!+agg(l,4) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj(l,1)!+ghalf1 - a_temp(1,2)=aggj(l,2)!+ghalf2 - a_temp(2,1)=aggj(l,3)!+ghalf3 - a_temp(2,2)=aggj(l,4)!+ghalf4 - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,j)=gcorr3_turn(l,j) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj1(l,1) - a_temp(1,2)=aggj1(l,2) - a_temp(2,1)=aggj1(l,3) - a_temp(2,2)=aggj1(l,4) - call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) - gcorr3_turn(l,j1)=gcorr3_turn(l,j1) - & +0.5d0*(pizda(1,1)+pizda(2,2)) - enddo - return - end - - -C------------------------------------------------------------------------------- - - - subroutine eturn4(i,eello_turn4) -C Third- and fourth-order contributions from turns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - dimension ggg(3) - double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), - & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) - double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 - j=i+3 -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Fourth-order contributions -C -C (i+3)o----(i+4) -C / | -C (i+2)o | -C \ | -C (i+1)o----i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd call checkint_turn4(i,a_temp,eello_turn4_num) -c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) -c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 - call transpose2(EUg(1,1,i+1),e1t(1,1)) - call transpose2(Eug(1,1,i+2),e2t(1,1)) - call transpose2(Eug(1,1,i+3),e3t(1,1)) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - eello_turn4=eello_turn4-(s1+s2+s3) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eturn4',i,j,-(s1+s2+s3) -cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), -cd & ' eello_turn4_num',8*eello_turn4_num -C Derivatives in gamma(i) - call transpose2(EUgder(1,1,i+1),e1tder(1,1)) - call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) -C Derivatives in gamma(i+1) - call transpose2(EUgder(1,1,i+2),e2tder(1,1)) - call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) - call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) -C Derivatives in gamma(i+2) - call transpose2(EUgder(1,1,i+3),e3tder(1,1)) - call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) - call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) -C Cartesian derivatives -C Derivatives of this turn contributions in DC(i+2) - if (j.lt.nres-1) then - do l=1,3 - a_temp(1,1)=agg(l,1) - a_temp(1,2)=agg(l,2) - a_temp(2,1)=agg(l,3) - a_temp(2,2)=agg(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - ggg(l)=-(s1+s2+s3) - gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) - enddo - endif -C Remaining derivatives of this turn contribution - do l=1,3 - a_temp(1,1)=aggi(l,1) - a_temp(1,2)=aggi(l,2) - a_temp(2,1)=aggi(l,3) - a_temp(2,2)=aggi(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) - a_temp(1,1)=aggi1(l,1) - a_temp(1,2)=aggi1(l,2) - a_temp(2,1)=aggi1(l,3) - a_temp(2,2)=aggi1(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) - a_temp(1,1)=aggj(l,1) - a_temp(1,2)=aggj(l,2) - a_temp(2,1)=aggj(l,3) - a_temp(2,2)=aggj(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) - gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) - a_temp(1,1)=aggj1(l,1) - a_temp(1,2)=aggj1(l,2) - a_temp(2,1)=aggj1(l,3) - a_temp(2,2)=aggj1(l,4) - call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) - call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) - call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) - call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) - call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) - s3=0.5d0*(pizda(1,1)+pizda(2,2)) -c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 - gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) - enddo - return - end - - -C----------------------------------------------------------------------------- - - - subroutine vecpr(u,v,w) - implicit real*8(a-h,o-z) - dimension u(3),v(3),w(3) - w(1)=u(2)*v(3)-u(3)*v(2) - w(2)=-u(1)*v(3)+u(3)*v(1) - w(3)=u(1)*v(2)-u(2)*v(1) - return - end - - -C-------------------------------------------------------------------- - - - subroutine unormderiv(u,ugrad,unorm,ungrad) -C This subroutine computes the derivatives of a normalized vector u, given -C the derivatives computed without normalization conditions, ugrad. Returns -C ungrad. - implicit none - double precision u(3),ugrad(3,3),unorm,ungrad(3,3) - double precision vec(3) - double precision scalar - integer i,j -c write (2,*) 'ugrad',ugrad -c write (2,*) 'u',u - do i=1,3 - vec(i)=scalar(ugrad(1,i),u(1)) - enddo -c write (2,*) 'vec',vec - do i=1,3 - do j=1,3 - ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm - enddo - enddo -c write (2,*) 'ungrad',ungrad - return - end - - -C-------------------------------------------------------------------- - - - subroutine escp_soft_sphere(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 - r0_scp=4.5d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rij=xj*xj+yj*yj+zj*zj - r0ij=r0_scp - r0ijsq=r0ij*r0ij - if (rij.lt.r0ijsq) then - evdwij=0.25d0*(rij-r0ijsq)**2 - fac=rij-r0ijsq - else - evdwij=0.0d0 - fac=0.0d0 - endif - evdw2=evdw2+evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end - - -C----------------------------------------------------------------------------- - - - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end - - -C-------------------------------------------------------------------- - - - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij -cd write (iout,*) "eij",eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end - - -C-------------------------------------------------------------------- - - - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end - - -C-------------------------------------------------------------------- - - - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA - - -C-------------------------------------------------------------------- - - - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - enddo -C Ufff.... We've done all this!!! - return - end - - -C--------------------------------------------------------------------------- - - - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end - - -c-------------------------------------------------------------------- - - - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else - - -C-------------------------------------------------------------------- - - - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC - - -c-------------------------------------------------------------------- - - - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end - - -C-------------------------------------------------------------------- - - - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end - - -C-------------------------------------------------------------------- - - - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else - - -c-------------------------------------------------------------------- - - - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif - - -c-------------------------------------------------------------------- - - - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end - - -c-------------------------------------------------------------------- - - - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end - - -c-------------------------------------------------------------------- - - - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end - - -c-------------------------------------------------------------------- - - - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end - - -C-------------------------------------------------------------------- -#ifdef CRYST_TOR -C-------------------------------------------------------------------- - - - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end - - -c-------------------------------------------------------------------- - - - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end - - -c-------------------------------------------------------------------- - - -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end - - -c-------------------------------------------------------------------- - - - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 -C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 - enddo - return - end -#endif - - -c-------------------------------------------------------------------- - - - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - write (*,*) "eback_sc_corr 01" - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=iphi_start,iphi_end - write (*,*) "eback_sc_corr 02" - esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) - phii=phi(i) - gloci=0.0D0 - do j=1,nterm_sccor - write (*,*) "eback_sc_corr 03" - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo - write (*,*) "eback_sc_corr 04" - return - end - - -c-------------------------------------------------------------------- - - - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end - - -c-------------------------------------------------------------------- - - - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end - - -c-------------------------------------------------------------------- - - - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end - - -c-------------------------------------------------------------------- - - - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end - - -c-------------------------------------------------------------------- - - - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end - - -c-------------------------------------------------------------------- - - - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT - - -C-------------------------------------------------------------------- - - - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif - - -C-------------------------------------------------------------------- - - - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end - - -C-------------------------------------------------------------------- - - - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end - - -C-------------------------------------------------------------------- - - - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end - - -C-------------------------------------------------------------------- - - - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C \ /l\ /j\ / -C \ / \ / \ / -C o| o | | o |o -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C j|/k\| / |/k\|l / -C / \ / / \ / -C / o / o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ / \ /j\ -C / \ / \ / \ -C /| o |o o| o |\ -C \ j|/k\| \ |/k\|l -C \ / \ \ / \ -C o \ o \ -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end - - -c-------------------------------------------------------------------- - - - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - - -C-------------------------------------------------------------------- - - - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end - - -crc----------------------------------------------------------------- - - - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END - - -C-------------------------------------------------------------------- - - - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - - -c-------------------------------------------------------------------- - - - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - - -C-------------------------------------------------------------------- - - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end - - -c-------------------------------------------------------------------- - - - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end - - -C-------------------------------------------------------------------- - - - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/energy_split-sep.F b/source/unres/src_MD-NEWSC-NEWC/energy_split-sep.F deleted file mode 100644 index 81e4d81..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/energy_split-sep.F +++ /dev/null @@ -1,476 +0,0 @@ - subroutine etotal_long(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the long-range slow-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.MD' -c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI -c if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_LONG Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif - call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart -c call int_from_cart1(.false.) - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -cd print *,'nnt=',nnt,' nct=',nct -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_long(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_long(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_long(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_long(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_long(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - call vec_and_deriv - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp_long(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else - call escp_soft_sphere(evdw2,evdw2_14) - endif -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) - endif -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -C -C Sum the energies -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(20)=Uconst+Uconst_back - energia(22)=evdw_p - energia(23)=evdw_m - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine etotal_short(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the short-range fast-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - -c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot -c call flush(iout) - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks -c call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_short(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_short(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_short(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_short(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_short(evdw) - goto 107 -C Soft-sphere potential - already dealt with in the long-range part - 106 evdw=0.0d0 -c 106 call e_softsphere_short(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -c -c Calculate the short-range part of Evdwpp -c - call evdwpp_short(evdw1) -c -c Calculate the short-range part of ESCp -c - if (ipot.lt.6) then - call escp_short(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. - call edis(ehpb) -C -C Calculate the virtual-bond-angle energy. -C - call ebend(ebe) -C -C Calculate the SC local energy. -C - call vec_and_deriv - call esc(escloc) -C -C Calculate the virtual-bond torsional energy. -C - call etor(etors,edihcnstr) -C -C 6/23/01 Calculate double-torsional energy -C - call etor_d(etors_d) -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -C -C Put energy components into an array -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(16)=evdw1 -#else - energia(3)=evdw1 -#endif - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(17)=estr - energia(19)=edihcnstr - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m -c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/entmcm.F b/source/unres/src_MD-NEWSC-NEWC/entmcm.F deleted file mode 100644 index 3c2dc5a..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/entmcm.F +++ /dev/null @@ -1,684 +0,0 @@ - subroutine entmcm -C Does modified entropic sampling in the space of minima. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,ehighest,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - double precision energia(0:n_ene),energia_ave(0:n_ene) -C -cd write (iout,*) 'print_mc=',print_mc - WhatsUp=0 - maxtrial_iter=50 -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - indminn=-max_ene - indmaxx=max_ene - delte=0.5D0 - facee=1.0D0/(maxacc*delte) - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else - call gen_rand_conf(1,*20) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 -#ifdef MPL - if (MyID.eq.MasterID) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif -#endif - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) - call minimize(etot,varia,iretcode,nfun) - call etotal(energia(0)) - etot = energia(0) - write (iout,'(/80(1h*)/a/80(1h*))') - & 'Results of the first energy minimization:' - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - write (istat,'(i5,11(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot,rms,frac,co - else - write (istat,'(i5,9(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - neneval=neneval+nfun+1 - if (.not. ent_read) then -C Initialize the entropy array - do i=-max_ene,max_ene - emin=etot -C Uncomment the line below for actual entropic sampling (start with uniform -C energy distribution). -c entropy(i)=0.0D0 -C Uncomment the line below for multicanonical sampling (start with Boltzmann -C distribution). - entropy(i)=(emin+i*delte)*betbol - enddo - emax=10000000.0D0 - emin=etot - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done = (iretcode.ne.11) -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - indeold=(eold-emin)/delte - deix=eold-(emin+indeold*delte) - dent=entropy(indeold+1)-entropy(indeold) -cd write (iout,*) 'indeold=',indeold,' deix=',deix,' dent=',dent -cd write (*,*) 'Processor',MyID,' indeold=',indeold,' deix=',deix, -cd & ' dent=',dent - sold=entropy(indeold)+(dent/delte)*deix - elowest=etot - write (iout,*) 'eold=',eold,' sold=',sold,' elowest=',etot - write (*,*) 'Processor',MyID,' eold=',eold,' sold=',sold, - & ' elowest=',etot - if (minim) call zapis(varia,etot) - nminima(1)=1.0D0 -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - else - call send_MCM_info(2) - endif -#endif - do iene=indminn,indmaxx - nhist(iene)=0.0D0 - enddo - do i=2,maxsave - nminima(i)=0.0D0 - enddo -C Main loop. -c---------------------------------------------------------------------------- - elowest=1.0D10 - ehighest=-1.0D10 - it=0 - do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0) write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0) write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+1 - endif - if (print_mc.gt.2) then - write (iout,'(a)') 'Total energies of trial conf:' - call enerprint(energia(0)) - else if (print_mc.eq.1) then - write (iout,'(a,i6,a,1pe16.6)') - & 'Trial conformation:',ngen,' energy:',etot - endif -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accepting(etot,eold,scur,sold,varia,varold, - & accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irep=conf_comp(varia,etot) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup, - & przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - if (print_mc.gt.0) - & write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,11(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,co - elseif (print_stat) then - write (istat,'(i5,10(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - if (print_mc.gt.1) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) -#ifdef MPL - if (MyID.ne.MasterID) then - call recv_stop_sig(Kwita) -cd print *,'Processor:',MyID,' STOP=',Kwita - if (irep.eq.0) then - call send_MCM_info(2) - else - call send_MCM_info(1) - endif - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo - if (irep.eq.0) then - irep=nsave+1 -cd write (iout,*) 'Accepted conformation:' -cd write (iout,*) (rad2deg*varia(i),i=1,nphi) - if (minim) call zapis(varia,etot) - do i=1,n_ene - ener(i,nsave)=energia(i) - enddo - ener(n_ene+1,nsave)=etot - ener(n_ene+2,nsave)=frac - endif - nminima(irep)=nminima(irep)+1.0D0 -c print *,'irep=',irep,' nminima=',nminima(irep) -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif - if (ntrial.gt.maxtrial_iter .and. npool.gt.0) then -C Take a conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Iteration',it,' max. # of trials exceeded.' - write (iout,*) - & 'Take conformation',ii,' from the pool energy=',epool(ii) - if (print_mc.gt.2) - & write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - ntrial=0 - endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) -#endif - 21 continue -#ifdef MPL - if (MyID.eq.MasterID) then -c call receive_MCM_results - call receive_energies -#endif - do i=1,nsave - if (esave(i).lt.elowest) elowest=esave(i) - if (esave(i).gt.ehighest) ehighest=esave(i) - enddo - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - if (isweep.eq.1 .and. .not.ent_read) then - emin=elowest - emax=ehighest - write (iout,*) 'EMAX=',emax - indminn=0 - indmaxx=(ehighest-emin)/delte - indmin=indminn - indmax=indmaxx - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ent_read=.true. - else - indmin=(elowest-emin)/delte - indmax=(ehighest-emin)/delte - if (indmin.lt.indminn) indminn=indmin - if (indmax.gt.indmaxx) indmaxx=indmax - endif - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Construct energy histogram - do i=1,nsave - inde=(esave(i)-emin)/delte - nhist(inde)=nhist(inde)+nminima(i) - enddo -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo -Cd do i=indmaxx+1 -Cd entropy(i)=1.0D+10 -Cd enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - entropy(-max_ene-4)=dfloat(indminn) - entropy(-max_ene-3)=dfloat(indmaxx) - entropy(-max_ene-2)=emin - entropy(-max_ene-1)=emax - call send_MCM_update -cd print *,entname,ientout - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - else - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo -c call send_MCM_results - call send_energies - call receive_MCM_update - indminn=entropy(-max_ene-4) - indmaxx=entropy(-max_ene-3) - emin=entropy(-max_ene-2) - emax=entropy(-max_ene-1) - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif - if (WhatsUp.lt.-1) return -#else - if (ovrtim() .or. WhatsUp.lt.0) return -#endif - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - write (iout,'(a,i10)') 'Number of chain regrowths:',nregrow - write (iout,'(a,i10)') 'Accepted chain regrowths:',nregrow_acc - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accepting(ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - double precision tole /1.0D-1/, tola /5.0D0/ - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - else if (dabs(ecur-eold).lt.tole .and. - & dif_ang(nphi,x,xold).lt.tola) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too similar' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - indecur=(ecur-emin)/delte - if (iabs(indecur).gt.max_ene) then - write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.eq.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0) write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.1) then - write(iout,*)'ecur=',ecur,' indecur=',indecur,' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation rejected.' - endif - endif - return - end -c----------------------------------------------------------------------------- - subroutine read_pool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.VAR' - double precision varia(maxvar) - print '(a)','Call READ_POOL' - do npool=1,max_pool - print *,'i=',i - read (intin,'(i5,f10.5)',end=10,err=10) iconf,epool(npool) - if (epool(npool).eq.0.0D0) goto 10 - call read_angles(intin,*10) - call geom_to_var(nvar,xpool(1,npool)) - enddo - goto 11 - 10 npool=npool-1 - 11 write (iout,'(a,i5)') 'Number of pool conformations:',npool - if (print_mc.gt.2) then - do i=1,npool - write (iout,'(a,i5,a,1pe14.5)') 'Pool conformation',i,' energy', - & epool(i) - write (iout,'(10f8.3)') (rad2deg*xpool(j,i),j=1,nvar) - enddo - endif ! (print_mc.gt.2) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/fitsq.f b/source/unres/src_MD-NEWSC-NEWC/fitsq.f deleted file mode 100644 index 36cbd30..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/fitsq.f +++ /dev/null @@ -1,364 +0,0 @@ - subroutine fitsq(rms,x,y,nn,t,b,non_conv) - implicit real*8 (a-h,o-z) - include 'COMMON.IOUNITS' -c x and y are the vectors of coordinates (dimensioned (3,n)) of the two -c structures to be superimposed. nn is 3*n, where n is the number of -c points. t and b are respectively the translation vector and the -c rotation matrix that transforms the second set of coordinates to the -c frame of the first set. -c eta = machine-specific variable - - dimension x(3*nn),y(3*nn),t(3) - dimension b(3,3),q(3,3),r(3,3),v(3),xav(3),yav(3),e(3),c(3,3) - logical non_conv -c eta = z00100000 -c small=25.0*rmdcon(3) -c small=25.0*eta -c small=25.0*10.e-10 -c the following is a very lenient value for 'small' - small = 0.0001D0 - non_conv=.false. - fn=nn - do 10 i=1,3 - xav(i)=0.0D0 - yav(i)=0.0D0 - do 10 j=1,3 - 10 b(j,i)=0.0D0 - nc=0 -c - do 30 n=1,nn - do 20 i=1,3 -c write(iout,*)'x = ',x(nc+i),' y = ',y(nc+i) - xav(i)=xav(i)+x(nc+i)/fn - 20 yav(i)=yav(i)+y(nc+i)/fn - 30 nc=nc+3 -c - do i=1,3 - t(i)=yav(i)-xav(i) - enddo - - rms=0.0d0 - do n=1,nn - do i=1,3 - rms=rms+(y(3*(n-1)+i)-x(3*(n-1)+i)-t(i))**2 - enddo - enddo - rms=dabs(rms/fn) - -c write(iout,*)'xav = ',(xav(j),j=1,3) -c write(iout,*)'yav = ',(yav(j),j=1,3) -c write(iout,*)'t = ',(t(j),j=1,3) -c write(iout,*)'rms=',rms - if (rms.lt.small) return - - - nc=0 - rms=0.0D0 - do 50 n=1,nn - do 40 i=1,3 - rms=rms+((x(nc+i)-xav(i))**2+(y(nc+i)-yav(i))**2)/fn - do 40 j=1,3 - b(j,i)=b(j,i)+(x(nc+i)-xav(i))*(y(nc+j)-yav(j))/fn - 40 c(j,i)=b(j,i) - 50 nc=nc+3 - call sivade(b,q,r,d,non_conv) - sn3=dsign(1.0d0,d) - do 120 i=1,3 - do 120 j=1,3 - 120 b(j,i)=-q(j,1)*r(i,1)-q(j,2)*r(i,2)-sn3*q(j,3)*r(i,3) - call mvvad(b,xav,yav,t) - do 130 i=1,3 - do 130 j=1,3 - rms=rms+2.0*c(j,i)*b(j,i) - 130 b(j,i)=-b(j,i) - if (dabs(rms).gt.small) go to 140 -* write (6,301) - return - 140 if (rms.gt.0.0d0) go to 150 -c write (iout,303) rms - rms=0.0d0 -* stop -c 150 write (iout,302) dsqrt(rms) - 150 continue - return - 301 format (5x,'rms deviation negligible') - 302 format (5x,'rms deviation ',f14.6) - 303 format (//,5x,'negative ms deviation - ',f14.6) - end -c - subroutine sivade(x,q,r,dt,non_conv) - implicit real*8(a-h,o-z) -c computes q,e and r such that q(t)xr = diag(e) - dimension x(3,3),q(3,3),r(3,3),e(3) - dimension h(3,3),p(3,3),u(3,3),d(3) - logical non_conv -c eta = z00100000 -c write (2,*) "SIVADE" - nit = 0 - small=25.0*10.d-10 -c small=25.0*eta -c small=2.0*rmdcon(3) - xnrm=0.0d0 - do 20 i=1,3 - do 10 j=1,3 - xnrm=xnrm+x(j,i)*x(j,i) - u(j,i)=0.0d0 - r(j,i)=0.0d0 - 10 h(j,i)=0.0d0 - u(i,i)=1.0 - 20 r(i,i)=1.0 - xnrm=dsqrt(xnrm) - do 110 n=1,2 - xmax=0.0d0 - do 30 j=n,3 - 30 if (dabs(x(j,n)).gt.xmax) xmax=dabs(x(j,n)) - a=0.0d0 - do 40 j=n,3 - h(j,n)=x(j,n)/xmax - 40 a=a+h(j,n)*h(j,n) - a=dsqrt(a) - den=a*(a+dabs(h(n,n))) - d(n)=1.0/den - h(n,n)=h(n,n)+dsign(a,h(n,n)) - do 70 i=n,3 - s=0.0d0 - do 50 j=n,3 - 50 s=s+h(j,n)*x(j,i) - s=d(n)*s - do 60 j=n,3 - 60 x(j,i)=x(j,i)-s*h(j,n) - 70 continue - if (n.gt.1) go to 110 - xmax=dmax1(dabs(x(1,2)),dabs(x(1,3))) - h(2,3)=x(1,2)/xmax - h(3,3)=x(1,3)/xmax - a=dsqrt(h(2,3)*h(2,3)+h(3,3)*h(3,3)) - den=a*(a+dabs(h(2,3))) - d(3)=1.0/den - h(2,3)=h(2,3)+sign(a,h(2,3)) - do 100 i=1,3 - s=0.0d0 - do 80 j=2,3 - 80 s=s+h(j,3)*x(i,j) - s=d(3)*s - do 90 j=2,3 - 90 x(i,j)=x(i,j)-s*h(j,3) - 100 continue - 110 continue - do 130 i=1,3 - do 120 j=1,3 - 120 p(j,i)=-d(1)*h(j,1)*h(i,1) - 130 p(i,i)=1.0+p(i,i) - do 140 i=2,3 - do 140 j=2,3 - u(j,i)=u(j,i)-d(2)*h(j,2)*h(i,2) - 140 r(j,i)=r(j,i)-d(3)*h(j,3)*h(i,3) - call mmmul(p,u,q) - 150 np=1 - nq=1 - nit=nit+1 -c write (2,*) "nit",nit," e",(x(i,i),i=1,3) - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif - if (dabs(x(2,3)).gt.small*(dabs(x(2,2))+abs(x(3,3)))) go to 160 - x(2,3)=0.0d0 - nq=nq+1 - 160 if (dabs(x(1,2)).gt.small*(dabs(x(1,1))+dabs(x(2,2)))) go to 180 - x(1,2)=0.0d0 - if (x(2,3).ne.0.0d0) go to 170 - nq=nq+1 - go to 180 - 170 np=np+1 - 180 if (nq.eq.3) go to 310 - npq=4-np-nq -c write (2,*) "np",np," npq",npq - if (np.gt.npq) go to 230 - n0=0 - do 220 n=np,npq - nn=n+np-1 -c write (2,*) "nn",nn - if (dabs(x(nn,nn)).gt.small*xnrm) go to 220 - x(nn,nn)=0.0d0 - if (x(nn,nn+1).eq.0.0d0) go to 220 - n0=n0+1 -c write (2,*) "nn",nn - go to (190,210,220),nn - 190 do 200 j=2,3 - 200 call givns(x,q,1,j) - go to 220 - 210 call givns(x,q,2,3) - 220 continue -c write (2,*) "nn",nn," np",np," nq",nq," n0",n0 -c write (2,*) "x",(x(i,i),i=1,3) - if (n0.ne.0) go to 150 - 230 nn=3-nq - a=x(nn,nn)*x(nn,nn) - if (nn.gt.1) a=a+x(nn-1,nn)*x(nn-1,nn) - b=x(nn+1,nn+1)*x(nn+1,nn+1)+x(nn,nn+1)*x(nn,nn+1) - c=x(nn,nn)*x(nn,nn+1) - dd=0.5*(a-b) - xn2=c*c - rt=b-xn2/(dd+sign(dsqrt(dd*dd+xn2),dd)) - y=x(np,np)*x(np,np)-rt - z=x(np,np)*x(np,np+1) - do 300 n=np,nn -c write (2,*) "n",n," a",a," b",b," c",c," y",y," z",z - if (dabs(y).lt.dabs(z)) go to 240 - t=z/y - c=1.0/dsqrt(1.0d0+t*t) - s=c*t - go to 250 - 240 t=y/z - s=1.0/dsqrt(1.0d0+t*t) - c=s*t - 250 do 260 j=1,3 - v=x(j,n) - w=x(j,n+1) - x(j,n)=c*v+s*w - x(j,n+1)=-s*v+c*w - a=r(j,n) - b=r(j,n+1) - r(j,n)=c*a+s*b - 260 r(j,n+1)=-s*a+c*b - y=x(n,n) - z=x(n+1,n) - if (dabs(y).lt.dabs(z)) go to 270 - t=z/y - c=1.0/dsqrt(1.0+t*t) - s=c*t - go to 280 - 270 t=y/z - s=1.0/dsqrt(1.0+t*t) - c=s*t - 280 do 290 j=1,3 - v=x(n,j) - w=x(n+1,j) - a=q(j,n) - b=q(j,n+1) - x(n,j)=c*v+s*w - x(n+1,j)=-s*v+c*w - q(j,n)=c*a+s*b - 290 q(j,n+1)=-s*a+c*b - if (n.ge.nn) go to 300 - y=x(n,n+1) - z=x(n,n+2) - 300 continue - go to 150 - 310 do 320 i=1,3 - 320 e(i)=x(i,i) - nit=0 - 330 n0=0 - nit=nit+1 - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif -c write (2,*) "e",(e(i),i=1,3) - do 360 i=1,3 - if (e(i).ge.0.0d0) go to 350 - e(i)=-e(i) - do 340 j=1,3 - 340 q(j,i)=-q(j,i) - 350 if (i.eq.1) go to 360 - if (dabs(e(i)).lt.dabs(e(i-1))) go to 360 - call switch(i,1,q,r,e) - n0=n0+1 - 360 continue - if (n0.ne.0) go to 330 -c write (2,*) "e",(e(i),i=1,3) - if (dabs(e(3)).gt.small*xnrm) go to 370 - e(3)=0.0d0 - if (dabs(e(2)).gt.small*xnrm) go to 370 - e(2)=0.0d0 - 370 dt=det(q(1,1),q(1,2),q(1,3))*det(r(1,1),r(1,2),r(1,3)) -c write (2,*) "nit",nit -c write (2,501) (e(i),i=1,3) - return - 501 format (/,5x,'singular values - ',3e15.5) - end - subroutine givns(a,b,m,n) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3) - if (dabs(a(m,n)).lt.dabs(a(n,n))) go to 10 - t=a(n,n)/a(m,n) - s=1.0/dsqrt(1.0+t*t) - c=s*t - go to 20 - 10 t=a(m,n)/a(n,n) - c=1.0/dsqrt(1.0+t*t) - s=c*t - 20 do 30 j=1,3 - v=a(m,j) - w=a(n,j) - x=b(j,m) - y=b(j,n) - a(m,j)=c*v-s*w - a(n,j)=s*v+c*w - b(j,m)=c*x-s*y - 30 b(j,n)=s*x+c*y - return - end - subroutine switch(n,m,u,v,d) - implicit real*8 (a-h,o-z) - dimension u(3,3),v(3,3),d(3) - do 10 i=1,3 - tem=u(i,n) - u(i,n)=u(i,n-1) - u(i,n-1)=tem - if (m.eq.0) go to 10 - tem=v(i,n) - v(i,n)=v(i,n-1) - v(i,n-1)=tem - 10 continue - tem=d(n) - d(n)=d(n-1) - d(n-1)=tem - return - end - subroutine mvvad(b,xav,yav,t) - implicit real*8 (a-h,o-z) - dimension b(3,3),xav(3),yav(3),t(3) -c dimension a(3,3),b(3),c(3),d(3) -c do 10 j=1,3 -c d(j)=c(j) -c do 10 i=1,3 -c 10 d(j)=d(j)+a(j,i)*b(i) - do 10 j=1,3 - t(j)=yav(j) - do 10 i=1,3 - 10 t(j)=t(j)+b(j,i)*xav(i) - return - end - double precision function det (a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3),b(3),c(3) - det=a(1)*(b(2)*c(3)-b(3)*c(2))+a(2)*(b(3)*c(1)-b(1)*c(3)) - 1 +a(3)*(b(1)*c(2)-b(2)*c(1)) - return - end - subroutine mmmul(a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3),c(3,3) - do 10 i=1,3 - do 10 j=1,3 - c(i,j)=0.0d0 - do 10 k=1,3 - 10 c(i,j)=c(i,j)+a(i,k)*b(k,j) - return - end - subroutine matvec(uvec,tmat,pvec,nback) - implicit real*8 (a-h,o-z) - real*8 tmat(3,3),uvec(3,nback), pvec(3,nback) -c - do 2 j=1,nback - do 1 i=1,3 - uvec(i,j) = 0.0d0 - do 1 k=1,3 - 1 uvec(i,j)=uvec(i,j)+tmat(i,k)*pvec(k,j) - 2 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/gauss.f b/source/unres/src_MD-NEWSC-NEWC/gauss.f deleted file mode 100644 index 7ba6e1d..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/gauss.f +++ /dev/null @@ -1,69 +0,0 @@ - subroutine gauss(RO,AP,MT,M,N,*) -c -c CALCULATES (RO**(-1))*AP BY GAUSS ELIMINATION -c RO IS A SQUARE MATRIX -c THE CALCULATED PRODUCT IS STORED IN AP -c ABNORMAL EXIT IF RO IS SINGULAR -c - integer MT, M, N, M1,I,J,IM, - & I1,MI,MI1 - double precision RO(MT,M),AP(MT,N),X,RM,PR, - & Y - if(M.ne.1)goto 10 - X=RO(1,1) - if(dabs(X).le.1.0D-13) return 1 - X=1.0/X - do 16 I=1,N -16 AP(1,I)=AP(1,I)*X - return -10 continue - M1=M-1 - DO1 I=1,M1 - IM=I - RM=DABS(RO(I,I)) - I1=I+1 - do 2 J=I1,M - if(DABS(RO(J,I)).LE.RM) goto 2 - RM=DABS(RO(J,I)) - IM=J -2 continue - If(IM.eq.I)goto 17 - do 3 J=1,N - PR=AP(I,J) - AP(I,J)=AP(IM,J) -3 AP(IM,J)=PR - do 4 J=I,M - PR=RO(I,J) - RO(I,J)=RO(IM,J) -4 RO(IM,J)=PR -17 X=RO(I,I) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 5 J=1,N -5 AP(I,J)=X*AP(I,J) - do 6 J=I1,M -6 RO(I,J)=X*RO(I,J) - do 7 J=I1,M - Y=RO(J,I) - do 8 K=1,N -8 AP(J,K)=AP(J,K)-Y*AP(I,K) - do 9 K=I1,M -9 RO(J,K)=RO(J,K)-Y*RO(I,K) -7 continue -1 continue - X=RO(M,M) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 11 J=1,N -11 AP(M,J)=X*AP(M,J) - do 12 I=1,M1 - MI=M-I - MI1=MI+1 - do 14 J=1,N - X=AP(MI,J) - do 15 K=MI1,M -15 X=X-AP(K,J)*RO(MI,K) -14 AP(MI,J)=X -12 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/gen_rand_conf.F b/source/unres/src_MD-NEWSC-NEWC/gen_rand_conf.F deleted file mode 100644 index 6cc31ba..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/gen_rand_conf.F +++ /dev/null @@ -1,910 +0,0 @@ - subroutine gen_rand_conf(nstart,*) -C Generate random conformation or chain cut and regrowth. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical overlap,back,fail -cd print *,' CG Processor',me,' maxgen=',maxgen - maxsi=100 -cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart - if (nstart.lt.5) then - it1=itype(2) - phi(4)=gen_phi(4,itype(2),itype(3)) -c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) -c write(iout,*)'theta(3)=',rad2deg*theta(3) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(3),alph(2),omeg(2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif ! it1.ne.10 - call orig_frame - i=4 - nstart=4 - else - i=nstart - nstart=max0(i,4) - endif - - maxnit=0 - - nit=0 - niter=0 - back=.false. - do while (i.le.nres .and. niter.lt.maxgen) - if (i.lt.nstart) then - if(iprint.gt.1) then - write (iout,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - write (*,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - endif - return1 - endif - it1=itype(i-1) - it2=itype(i-2) - it=itype(i) -c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, -c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen - phi(i+1)=gen_phi(i+1,it1,it) - if (back) then - phi(i)=gen_phi(i+1,it2,it1) -c print *,'phi(',i,')=',phi(i) - theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) - if (it2.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i-1) - endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i) - if (overlap(i-1)) then - if (nit.lt.maxnit) then - back=.true. - nit=nit+1 - else - nit=0 - if (i.gt.3) then - back=.true. - i=i-1 - else - write (iout,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - write (*,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - return1 - endif - endif - else - back=.false. - nit=0 - i=i+1 - endif - niter=niter+1 - enddo - if (niter.ge.maxgen) then - write (iout,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - write (*,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - return1 - endif - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo - return - end -c------------------------------------------------------------------------- - logical function overlap(i) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - data redfac /0.5D0/ - overlap=.false. - iti=itype(i) - if (iti.gt.ntyp) return -C Check for SC-SC overlaps. -cd print *,'nnt=',nnt,' nct=',nct - do j=nnt,i-1 - itj=itype(j) - if (j.lt.i-1 .or. ipot.ne.4) then - rcomp=sigmaii(iti,itj) - else - rcomp=sigma(iti,itj) - endif -cd print *,'j=',j - if (dist(nres+i,nres+j).lt.redfac*rcomp) then - overlap=.true. -c print *,'overlap, SC-SC: i=',i,' j=',j, -c & ' dist=',dist(nres+i,nres+j),' rcomp=', -c & rcomp - return - endif - enddo -C Check for overlaps between the added peptide group and the preceding -C SCs. - iteli=itel(i) - do j=1,3 - c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itj=itype(j) -cd print *,'overlap, p-Sc: i=',i,' j=',j, -cd & ' dist=',dist(nres+j,maxres2+1) - if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for overlaps between the added side chain and the preceding peptide -C groups. - do j=1,nnt-2 - do k=1,3 - c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, SC-p: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,maxres2+1) - if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for p-p overlaps - do j=1,3 - c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itelj=itel(j) - do k=1,3 - c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, p-p: i=',i,' j=',j, -cd & ' dist=',dist(maxres2+1,maxres2+2) - if(iteli.ne.0.and.itelj.ne.0)then - if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then - overlap=.true. - return - endif - endif - enddo - return - end -c-------------------------------------------------------------------------- - double precision function gen_phi(i,it1,it2) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' -c gen_phi=ran_number(-pi,pi) -C 8/13/98 Generate phi using pre-defined boundaries - gen_phi=ran_number(phibound(1,i),phibound(2,i)) - return - end -c--------------------------------------------------------------------------- - double precision function gen_theta(it,gama,gama1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - double precision y(2),z(2) - double precision theta_max,theta_min -c print *,'gen_theta: it=',it - theta_min=0.05D0*pi - theta_max=0.95D0*pi - if (dabs(gama).gt.dwapi) then - y(1)=dcos(gama) - y(2)=dsin(gama) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (dabs(gama1).gt.dwapi) then - z(1)=dcos(gama1) - z(2)=dsin(gama1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif - thet_pred_mean=a0thet(it) - do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k) - enddo - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo - sig=0.5D0/(sig*sig+sigc0(it)) - ak=dexp(gthet(1,it)- - &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2) -c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) -c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak - theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak) - if (theta_temp.lt.theta_min) theta_temp=theta_min - if (theta_temp.gt.theta_max) theta_temp=theta_max - gen_theta=theta_temp -c print '(a)','Exiting GENTHETA.' - return - end -c------------------------------------------------------------------------- - subroutine gen_side(it,the,al,om,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision MaxBoxLen /10.0D0/ - double precision Ap_inv(3,3),a(3,3),z(3,maxlob),W1(maxlob), - & sumW(0:maxlob),y(2),cm(2),eig(2),box(2,2),work(100),detAp(maxlob) - double precision eig_limit /1.0D-8/ - double precision Big /10.0D0/ - double precision vec(3,3) - logical lprint,fail,lcheck - lcheck=.false. - lprint=.false. - fail=.false. - if (the.eq.0.0D0 .or. the.eq.pi) then -#ifdef MPI - write (*,'(a,i4,a,i3,a,1pe14.5)') - & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the -#else -cd write (iout,'(a,i3,a,1pe14.5)') -cd & 'Error in GenSide: it=',it,' theta=',the -#endif - fail=.true. - return - endif - tant=dtan(the-pipol) - nlobit=nlob(it) - if (lprint) then -#ifdef MPI - print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.' - write (iout,'(a,i4,a)') 'Processor:',me,' Enter Gen_Side.' -#endif - print *,'it=',it,' nlobit=',nlobit,' the=',the,' tant=',tant - write (iout,*) 'it=',it,' nlobit=',nlobit,' the=',the, - & ' tant=',tant - endif - do i=1,nlobit - zz1=tant-censc(1,i,it) - do k=1,3 - do l=1,3 - a(k,l)=gaussc(k,l,i,it) - enddo - enddo - detApi=a(2,2)*a(3,3)-a(2,3)**2 - Ap_inv(2,2)=a(3,3)/detApi - Ap_inv(2,3)=-a(2,3)/detApi - Ap_inv(3,2)=Ap_inv(2,3) - Ap_inv(3,3)=a(2,2)/detApi - if (lprint) then - write (*,'(/a,i2/)') 'Cluster #',i - write (*,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - write (iout,'(/a,i2/)') 'Cluster #',i - write (iout,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - endif - W1i=0.0D0 - do k=2,3 - do l=2,3 - W1i=W1i+a(k,1)*a(l,1)*Ap_inv(k,l) - enddo - enddo - W1i=a(1,1)-W1i - W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1) -c if (lprint) write(*,'(a,3(1pe15.5)/)') -c & 'detAp, W1, anormi',detApi,W1i,anormi - do k=2,3 - zk=censc(k,i,it) - do l=2,3 - zk=zk+zz1*Ap_inv(k,l)*a(l,1) - enddo - z(k,i)=zk - enddo - detAp(i)=dsqrt(detApi) - enddo - - if (lprint) then - print *,'W1:',(w1(i),i=1,nlobit) - print *,'detAp:',(detAp(i),i=1,nlobit) - print *,'Z' - do i=1,nlobit - print '(i2,3f10.5)',i,(rad2deg*z(j,i),j=2,3) - enddo - write (iout,*) 'W1:',(w1(i),i=1,nlobit) - write (iout,*) 'detAp:',(detAp(i),i=1,nlobit) - write (iout,*) 'Z' - do i=1,nlobit - write (iout,'(i2,3f10.5)') i,(rad2deg*z(j,i),j=2,3) - enddo - endif - if (lcheck) then -C Writing the distribution just to check the procedure - fac=0.0D0 - dV=deg2rad**2*10.0D0 - sum=0.0D0 - sum1=0.0D0 - do i=1,nlobit - fac=fac+W1(i)/detAp(i) - enddo - fac=1.0D0/(2.0D0*fac*pi) -cd print *,it,'fac=',fac - do ial=90,180,2 - y(1)=deg2rad*ial - do iom=-180,180,5 - y(2)=deg2rad*iom - wart=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo - y2=y(2) - - do iii=-1,1 - - y(2)=y2+iii*dwapi - - wykl=0.0D0 - do j=1,2 - do k=1,2 - wykl=wykl+a(j,k)*(y(j)-z(j+1,i))*(y(k)-z(k+1,i)) - enddo - enddo - wart=wart+W1(i)*dexp(-0.5D0*wykl) - - enddo - - y(2)=y2 - - enddo -c print *,'y',y(1),y(2),' fac=',fac - wart=fac*wart - write (20,'(2f10.3,1pd15.5)') y(1)*rad2deg,y(2)*rad2deg,wart - sum=sum+wart - sum1=sum1+1.0D0 - enddo - enddo -c print *,'it=',it,' sum=',sum*dV,' sum1=',sum1*dV - return - endif - -C Calculate the CM of the system -C - do i=1,nlobit - W1(i)=W1(i)/detAp(i) - enddo - sumW(0)=0.0D0 - do i=1,nlobit - sumW(i)=sumW(i-1)+W1(i) - enddo - cm(1)=z(2,1)*W1(1) - cm(2)=z(3,1)*W1(1) - do j=2,nlobit - cm(1)=cm(1)+z(2,j)*W1(j) - cm(2)=cm(2)+W1(j)*(z(3,1)+pinorm(z(3,j)-z(3,1))) - enddo - cm(1)=cm(1)/sumW(nlobit) - cm(2)=cm(2)/sumW(nlobit) - if (cm(1).gt.Big .or. cm(1).lt.-Big .or. - & cm(2).gt.Big .or. cm(2).lt.-Big) then -cd write (iout,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (iout,'(i5,2(1pe14.5))') it,cm(1),cm(2) -cd write (*,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (*,'(i5,2(1pe14.5))') it,cm(1),cm(2) - fail=.true. - return - endif -cd print *,'CM:',cm(1),cm(2) -C -C Find the largest search distance from CM -C - radmax=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo -#ifdef NAG - call f02faf('N','U',2,a,3,eig,work,100,ifail) -#else - call djacob(2,3,10000,1.0d-10,a,vec,eig) -#endif -#ifdef MPI - if (lprint) then - print *,'*************** CG Processor',me - print *,'CM:',cm(1),cm(2) - write (iout,*) '*************** CG Processor',me - write (iout,*) 'CM:',cm(1),cm(2) - print '(A,8f10.5)','Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - write (iout,'(A,8f10.5)') - & 'Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - endif -#endif - if (eig(1).lt.eig_limit) then - write(iout,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - write(*,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif - radius=0.0D0 -cd print *,'i=',i - do j=1,2 - radius=radius+pinorm(z(j+1,i)-cm(j))**2 - enddo - radius=dsqrt(radius)+3.0D0/dsqrt(eig(1)) - if (radius.gt.radmax) radmax=radius - enddo - if (radmax.gt.pi) radmax=pi -C -C Determine the boundaries of the search rectangle. -C - if (lprint) then - print '(a,4(1pe14.4))','W1: ',(W1(i),i=1,nlob(it) ) - print '(a,4(1pe14.4))','radmax: ',radmax - endif - box(1,1)=dmax1(cm(1)-radmax,0.0D0) - box(2,1)=dmin1(cm(1)+radmax,pi) - box(1,2)=cm(2)-radmax - box(2,2)=cm(2)+radmax - if (lprint) then -#ifdef MPI - print *,'CG Processor',me,' Array BOX:' -#else - print *,'Array BOX:' -#endif - print '(4(1pe14.4))',((box(k,j),k=1,2),j=1,2) - print '(a,4(1pe14.4))','sumW: ',(sumW(i),i=0,nlob(it) ) -#ifdef MPI - write (iout,*)'CG Processor',me,' Array BOX:' -#else - write (iout,*)'Array BOX:' -#endif - write(iout,'(4(1pe14.4))') ((box(k,j),k=1,2),j=1,2) - write(iout,'(a,4(1pe14.4))')'sumW: ',(sumW(i),i=0,nlob(it) ) - endif - if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then -#ifdef MPI - write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' - write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' -#else -c write (iout,'(a)') 'Bad sampling box.' -#endif - fail=.true. - return - endif - which_lobe=ran_number(0.0D0,sumW(nlobit)) -c print '(a,1pe14.4)','which_lobe=',which_lobe - do i=1,nlobit - if (sumW(i-1).le.which_lobe .and. sumW(i).ge.which_lobe) goto 1 - enddo - 1 ilob=i -c print *,'ilob=',ilob,' nlob=',nlob(it) - do i=2,3 - cm(i-1)=z(i,ilob) - do j=2,3 - a(i-1,j-1)=gaussc(i,j,ilob,it) - enddo - enddo -cd print '(a,i4,a)','CG Processor',me,' Calling MultNorm1.' - call mult_norm1(3,2,a,cm,box,y,fail) - if (fail) return - al=y(1) - om=pinorm(y(2)) -cd print *,'al=',al,' om=',om -cd stop - return - end -c--------------------------------------------------------------------------- - double precision function ran_number(x1,x2) -C Calculate a random real number from the range (x1,x2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - double precision x1,x2,fctor - data fctor /2147483647.0D0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ran_number=x1+(x2-x1)*prng_next(me) -#else - call vrnd(ix,1) - ran_number=x1+(x2-x1)*ix/fctor -#endif - return - end -c-------------------------------------------------------------------------- - integer function iran_num(n1,n2) -C Calculate a random integer number from the range (n1,n2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer n1,n2,ix - real fctor /2147483647.0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ix=n1+(n2-n1+1)*prng_next(me) - if (ix.lt.n1) ix=n1 - if (ix.gt.n2) ix=n2 - iran_num=ix -#else - call vrnd(ix,1) - ix=n1+(n2-n1+1)*(ix/fctor) - if (ix.gt.n2) ix=n2 - iran_num=ix -#endif - return - end -c-------------------------------------------------------------------------- - double precision function binorm(x1,x2,sigma1,sigma2,ak) - implicit real*8 (a-h,o-z) -c print '(a)','Enter BINORM.' - alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2) - aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2) - seg=sigma1/(sigma1+ak*sigma2) - alen=ran_number(0.0D0,1.0D0) - if (alen.lt.seg) then - binorm=anorm_distr(x1,sigma1,alowb,aupb) - else - binorm=anorm_distr(x2,sigma2,alowb,aupb) - endif -c print '(a)','Exiting BINORM.' - return - end -c----------------------------------------------------------------------- -c double precision function anorm_distr(x,sigma,alowb,aupb) -c implicit real*8 (a-h,o-z) -c print '(a)','Enter ANORM_DISTR.' -c 10 y=ran_number(alowb,aupb) -c expon=dexp(-0.5D0*((y-x)/sigma)**2) -c ran=ran_number(0.0D0,1.0D0) -c if (expon.lt.ran) goto 10 -c anorm_distr=y -c print '(a)','Exiting ANORM_DISTR.' -c return -c end -c----------------------------------------------------------------------- - double precision function anorm_distr(x,sigma,alowb,aupb) - implicit real*8 (a-h,o-z) -c to make a normally distributed deviate with zero mean and unit variance -c - integer iset - real fac,gset,rsq,v1,v2,ran1 - save iset,gset - data iset/0/ - if(iset.eq.0) then -1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - rsq=v1**2+v2**2 - if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1 - fac=sqrt(-2.0d0*log(rsq)/rsq) - gset=v1*fac - gaussdev=v2*fac - iset=1 - else - gaussdev=gset - iset=0 - endif - anorm_distr=x+gaussdev*sigma - return - end -c------------------------------------------------------------------------ - subroutine mult_norm(lda,n,a,x,fail) -C -C Generate the vector X whose elements obey the multiple-normal distribution -C from exp(-0.5*X'AX). LDA is the leading dimension of the moment matrix A, -C n is the dimension of the problem. FAIL is set at .TRUE., if the smallest -C eigenvalue of the matrix A is close to 0. -C - implicit double precision (a-h,o-z) - double precision a(lda,n),x(n),eig(100),vec(3,3),work(100) - double precision eig_limit /1.0D-8/ - logical fail - fail=.false. -c print '(a)','Enter MULT_NORM.' -C -C Find the smallest eigenvalue of the matrix A. -C -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo -#ifdef NAG - call f02faf('V','U',2,a,lda,eig,work,100,ifail) -#else - call djacob(2,lda,10000,1.0d-10,a,vec,eig) -#endif -c print '(8f10.5)',(eig(i),i=1,n) -C print '(a)' -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo - if (eig(1).lt.eig_limit) then - print *,'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C - do i=1,n - sigma=1.0D0/dsqrt(eig(i)) - alim=-3.0D0*sigma - work(i)=anorm_distr(0.0D0,sigma,-alim,alim) - enddo -C -C Transform the vector of normal variables back to the original basis. -C - do i=1,n - xi=0.0D0 - do j=1,n - xi=xi+a(i,j)*work(j) - enddo - x(i)=xi - enddo - return - end -c------------------------------------------------------------------------ - subroutine mult_norm1(lda,n,a,z,box,x,fail) -C -C Generate the vector X whose elements obey the multi-gaussian multi-dimensional -C distribution from sum_{i=1}^m W(i)exp[-0.5*X'(i)A(i)X(i)]. LDA is the -C leading dimension of the moment matrix A, n is the dimension of the -C distribution, nlob is the number of lobes. FAIL is set at .TRUE., if the -C smallest eigenvalue of the matrix A is close to 0. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - double precision a(lda,n),z(n),x(n),box(n,n) - double precision etmp - include 'COMMON.IOUNITS' -#ifdef MP - include 'COMMON.SETUP' -#endif - logical fail -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C -cd print *,'CG Processor',me,' entered MultNorm1.' -cd print '(2(1pe14.4),3x,1pe14.4)',((a(i,j),j=1,2),z(i),i=1,2) -cd do i=1,n -cd print *,i,box(1,i),box(2,i) -cd enddo - istep = 0 - 10 istep = istep + 1 - if (istep.gt.10000) then -c write (iout,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (*,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (iout,*) 'box',box -c write (iout,*) 'a',a -c write (iout,*) 'z',z - fail=.true. - return - endif - do i=1,n - x(i)=ran_number(box(1,i),box(2,i)) - enddo - ww=0.0D0 - do i=1,n - xi=pinorm(x(i)-z(i)) - ww=ww+0.5D0*a(i,i)*xi*xi - do j=i+1,n - ww=ww+a(i,j)*xi*pinorm(x(j)-z(j)) - enddo - enddo - dec=ran_number(0.0D0,1.0D0) -c print *,(x(i),i=1,n),ww,dexp(-ww),dec -crc if (dec.gt.dexp(-ww)) goto 10 - if(-ww.lt.100) then - etmp=dexp(-ww) - else - return - endif - if (dec.gt.etmp) goto 10 -cd print *,'CG Processor',me,' exitting MultNorm1.' - return - end -c -crc-------------------------------------- - subroutine overlap_sc(scfail) -c Internal and cartesian coordinates must be consistent as input, -c and will be up-to-date on return. -c At the end of this procedure, scfail is true if there are -c overlapping residues left, or false otherwise (success) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical had_overlaps,fail,scfail - integer ioverlap(maxres),ioverlap_last - - had_overlaps=.false. - call overlap_sc_list(ioverlap,ioverlap_last) - if (ioverlap_last.gt.0) then - write (iout,*) '#OVERLAPing residues ',ioverlap_last - write (iout,'(20i4)') (ioverlap(k),k=1,ioverlap_last) - had_overlaps=.true. - endif - - maxsi=1000 - do k=1,1000 - if (ioverlap_last.eq.0) exit - - do ires=1,ioverlap_last - i=ioverlap(ires) - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) goto 999 - endif - enddo - - call chainbuild - call overlap_sc_list(ioverlap,ioverlap_last) -c write (iout,*) 'Overlaping residues ',ioverlap_last, -c & (ioverlap(j),j=1,ioverlap_last) - enddo - - if (k.le.1000.and.ioverlap_last.eq.0) then - scfail=.false. - if (had_overlaps) then - write (iout,*) '#OVERLAPing all corrected after ',k, - & ' random generation' - endif - else - scfail=.true. - write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last - write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last) - endif - - return - - 999 continue - write (iout,'(a30,i5,a12,i4)') - & '#OVERLAP FAIL in gen_side after',maxsi, - & 'iter for RES',i - scfail=.true. - return - end - - subroutine overlap_sc_list(ioverlap,ioverlap_last) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.CALC' - logical fail - integer ioverlap(maxres),ioverlap_last - data redfac /0.5D0/ - - ioverlap_last=0 -C Check for SC-SC overlaps and mark residues -c print *,'>>overlap_sc nnt=',nnt,' nct=',nct - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -c - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - if (j.gt.i+1) then - rcomp=sigmaii(itypi,itypj) - else - rcomp=sigma(itypi,itypj) - endif -c print '(2(a3,2i3),a3,2f10.5)', -c & ' i=',i,iti,' j=',j,itj,' d=',dist(nres+i,nres+j) -c & ,rcomp - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij - -ct if ( 1.0/rij .lt. redfac*rcomp .or. -ct & rij_shift.le.0.0D0 ) then - if ( rij_shift.le.0.0D0 ) then -cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)') -cd & 'overlap SC-SC: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,nres+j),' rcomp=', -cd & rcomp,1.0/rij,rij_shift - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=i - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.i) ioverlap_last=ioverlap_last-1 - enddo - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=j - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1 - enddo - endif - enddo - enddo - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/geomout.F b/source/unres/src_MD-NEWSC-NEWC/geomout.F deleted file mode 100644 index 0a46b14..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/geomout.F +++ /dev/null @@ -1,507 +0,0 @@ - subroutine pdbout(etot,tytul,iunit) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - character*50 tytul - dimension ica(maxres) - write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot -cmodel write (iunit,'(a5,i6)') 'MODEL',1 - if (nhfrag.gt.0) then - do j=1,nhfrag - iti=itype(hfrag(1,j)) - itj=itype(hfrag(2,j)) - if (j.lt.10) then - write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - else - write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - endif - enddo - endif - - if (nbfrag.gt.0) then - - do j=1,nbfrag - - iti=itype(bfrag(1,j)) - itj=itype(bfrag(2,j)-1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') - & 'SHEET',1,'B',j,2, - & restyp(iti),bfrag(1,j)-1, - & restyp(itj),bfrag(2,j)-2,0 - - if (bfrag(3,j).gt.bfrag(4,j)) then - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)+1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itl),bfrag(4,j), - & restyp(itk),bfrag(3,j)-1,-1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - else - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)-1) - - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itk),bfrag(3,j)-1, - & restyp(itl),bfrag(4,j)-2,1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - - - endif - - enddo - endif - - if (nss.gt.0) then - do i=1,nss - if (dyn_ss) then - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',idssb(i)-nnt+1, - & 'CYS',jdssb(i)-nnt+1 - else - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, - & 'CYS',jhpb(i)-nnt+1-nres - endif - enddo - endif - - iatom=0 - do i=nnt,nct - ires=i-nnt+1 - iatom=iatom+1 - ica(i)=iatom - iti=itype(i) - write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i) - if (iti.ne.10) then - iatom=iatom+1 - write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), - & vtot(i+nres) - endif - enddo - write (iunit,'(a)') 'TER' - do i=nnt,nct-1 - if (itype(i).eq.10) then - write (iunit,30) ica(i),ica(i+1) - else - write (iunit,30) ica(i),ica(i+1),ica(i)+1 - endif - enddo - if (itype(nct).ne.10) then - write (iunit,30) ica(nct),ica(nct)+1 - endif - do i=1,nss - if (dyn_ss) then - write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 - else - write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 - endif - enddo - write (iunit,'(a6)') 'ENDMDL' - 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) - 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I5) - return - end -c------------------------------------------------------------------------------ - subroutine MOL2out(etot,tytul) -C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 -C format. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - character*32 tytul,fd - character*3 zahl - character*6 res_num,pom,ucase -#ifdef AIX - call fdate_(fd) -#elif (defined CRAY) - call date(fd) -#else - call fdate(fd) -#endif - write (imol2,'(a)') '#' - write (imol2,'(a)') - & '# Creating user name: unres' - write (imol2,'(2a)') '# Creation time: ', - & fd - write (imol2,'(/a)') '\@MOLECULE' - write (imol2,'(a)') tytul - write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 - write (imol2,'(a)') 'SMALL' - write (imol2,'(a)') 'USER_CHARGES' - write (imol2,'(a)') '\@ATOM' - do i=nnt,nct - write (zahl,'(i3)') i - pom=ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 - enddo - write (imol2,'(a)') '\@BOND' - do i=nnt,nct-1 - write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 - enddo - do i=1,nss - write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 - enddo - write (imol2,'(a)') '\@SUBSTRUCTURE' - do i=nnt,nct - write (zahl,'(i3)') i - pom = ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 - enddo - 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') - 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') - return - end -c------------------------------------------------------------------------ - subroutine intout - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - write (iout,'(/a)') 'Geometry of the virtual chain.' - write (iout,'(7a)') ' Res ',' d',' Theta', - & ' Gamma',' Dsc',' Alpha',' Beta ' - do i=1,nres - iti=itype(i) - write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), - & rad2deg*omeg(i) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine briefout(it,ener) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' -c print '(a,i5)',intname,igeom -#if defined(AIX) || defined(PGI) - open (igeom,file=intname,position='append') -#else - open (igeom,file=intname,access='append') -#endif - IF (NSS.LE.9) THEN - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) - ELSE - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) - WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) - ENDIF -c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) -c if (nvar.gt.nphi+ntheta) then - write (igeom,200) (rad2deg*alph(i),i=2,nres-1) - write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) -c endif - close(igeom) - 180 format (I5,F12.3,I2,9(1X,2I3)) - 190 format (3X,11(1X,2I3)) - 200 format (8F10.4) - return - end -#ifdef WINIFL - subroutine fdate(fd) - character*32 fd - write(fd,'(32x)') - return - end -#endif -c---------------------------------------------------------------- -#ifdef NOXDR - subroutine cartout(time) -#else - subroutine cartoutx(time) -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time -#if defined(AIX) || defined(PGI) - open(icart,file=cartname,position="append") -#else - open(icart,file=cartname,access="append") -#endif - write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - write (icart,'(i4,$)') - & nss,(ihpb(j),jhpb(j),j=1,nss) - write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, - & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write (icart,'(8f10.5)') - & ((c(k,j),k=1,3),j=1,nres), - & ((c(k,j+nres),k=1,3),j=nnt,nct) - close(icart) - return - end -c----------------------------------------------------------------- -#ifndef NOXDR - subroutine cartout(time) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#else - parameter (me=0) -#endif - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time - integer iret,itmp - real xcoord(3,maxres2+2),prec - -#ifdef AIX - call xdrfopen_(ixdrf,cartname, "a", iret) - call xdrffloat_(ixdrf, real(time), iret) - call xdrffloat_(ixdrf, real(potE), iret) - call xdrffloat_(ixdrf, real(uconst), iret) - call xdrffloat_(ixdrf, real(uconst_back), iret) - call xdrffloat_(ixdrf, real(t_bath), iret) - call xdrfint_(ixdrf, nss, iret) - do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - enddo - call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat_(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat_(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat_(ixdrf, real(utheta(i)), iret) - call xdrffloat_(ixdrf, real(ugamma(i)), iret) - call xdrffloat_(ixdrf, real(uscdiff(i)), iret) - enddo -#else - call xdrfopen(ixdrf,cartname, "a", iret) - call xdrffloat(ixdrf, real(time), iret) - call xdrffloat(ixdrf, real(potE), iret) - call xdrffloat(ixdrf, real(uconst), iret) - call xdrffloat(ixdrf, real(uconst_back), iret) - call xdrffloat(ixdrf, real(t_bath), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, real(utheta(i)), iret) - call xdrffloat(ixdrf, real(ugamma(i)), iret) - call xdrffloat(ixdrf, real(uscdiff(i)), iret) - enddo -#endif - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=c(j,i) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=c(j,i+nres) - enddo - enddo - - itmp=nres+nct-nnt+1 -#ifdef AIX - call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose_(ixdrf, iret) -#else - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose(ixdrf, iret) -#endif - return - end -#endif -c----------------------------------------------------------------- - subroutine statout(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - integer itime - double precision energia(0:n_ene) - double precision gyrate - external gyrate - common /gucio/ cm - character*256 line1,line2 - character*4 format1,format2 - character*30 format -#ifdef AIX - if(itime.eq.0) then - open(istat,file=statname,position="append") - endif -#else -#ifdef PGI - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif -#endif - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.false.) - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a145" - else - write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a133" - endif - else - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a126" - else - write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a114" - endif - endif - if(usampl.and.totT.gt.eq_time) then - write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, - & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair - & +21*nfrag_back - elseif(hremd.gt.0) then - write(line2,'(i5)') iset - format2="a005" - else - format2="a001" - line2=' ' - endif - if (print_compon) then - if(itime.eq.0) then - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",20a12)" - write (istat,format) "#","", - & (ename(print_order(i)),i=1,nprint_ene) - endif - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",20f12.3)" - write (istat,format) line1,line2, - & (potEcomp(print_order(i)),i=1,nprint_ene) - else - write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" - write (istat,format) line1,line2 - endif -#if defined(AIX) - call flush(istat) -#else - close(istat) -#endif - return - end -c--------------------------------------------------------------- - double precision function gyrate() - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision cen(3),rg - - do j=1,3 - cen(j)=0.0d0 - enddo - - do i=nnt,nct - do j=1,3 - cen(j)=cen(j)+c(j,i) - enddo - enddo - do j=1,3 - cen(j)=cen(j)/dble(nct-nnt+1) - enddo - rg = 0.0d0 - do i = nnt, nct - do j=1,3 - rg = rg + (c(j,i)-cen(j))**2 - enddo - end do - gyrate = sqrt(rg/dble(nct-nnt+1)) - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/gnmr1.f b/source/unres/src_MD-NEWSC-NEWC/gnmr1.f deleted file mode 100644 index 905e746..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/gnmr1.f +++ /dev/null @@ -1,43 +0,0 @@ - double precision function gnmr1(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1=(ymin-y)**wykl/wykl - else if (y.gt.ymax) then - gnmr1=(y-ymax)**wykl/wykl - else - gnmr1=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function gnmr1prim(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1prim=-(ymin-y)**(wykl-1) - else if (y.gt.ymax) then - gnmr1prim=(y-ymax)**(wykl-1) - else - gnmr1prim=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function harmonic(y,ymax) - implicit none - double precision y,ymax - double precision wykl /2.0d0/ - harmonic=(y-ymax)**wykl - return - end -c------------------------------------------------------------------------------- - double precision function harmonicprim(y,ymax) - double precision y,ymin,ymax - double precision wykl /2.0d0/ - harmonicprim=(y-ymax)*wykl - return - end -c--------------------------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/gradient_p.F b/source/unres/src_MD-NEWSC-NEWC/gradient_p.F deleted file mode 100644 index 7fec1e8..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/gradient_p.F +++ /dev/null @@ -1,421 +0,0 @@ - subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c This subroutine calculates total internal coordinate gradient. -c Depending on the number of function evaluations, either whole energy -c is evaluated beforehand, Cartesian coordinates and their derivatives in -c internal coordinates are reevaluated or only the cartesian-in-internal -c coordinate derivatives are evaluated. The subroutine was designed to work -c with SUMSL. -c -c - icg=mod(nf,2)+1 - -cd print *,'grad',nf,icg - if (nf-nfl+1) 20,30,40 - 20 call func(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom(n,x) - call chainbuild -c write (iout,*) 'grad 30' -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -c write (iout,*) 'grad 40' -c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - ind=0 - ind1=0 - do i=1,nres-2 - gthetai=0.0D0 - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 -c ind=indmat(i,j) -c print *,'GRAD: i=',i,' jc=',j,' ind=',ind - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - enddo - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - enddo - enddo - do j=i+1,nres-1 - ind1=ind1+1 -c ind1=indmat(i,j) -c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 - do k=1,3 - gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) - gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) - enddo - enddo - if (i.gt.1) g(i-1)=gphii - if (n.gt.nphi) g(nphi+i)=gthetai - enddo - if (n.le.nphi+ntheta) goto 10 - do i=2,nres-1 - if (itype(i).ne.10) then - galphai=0.0D0 - gomegai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ialph(i,1))=galphai - g(ialph(i,1)+nside)=gomegai - endif - enddo -C -C Add the components corresponding to local energy terms. -C - 10 continue - do i=1,nvar -cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg) - g(i)=g(i)+gloc(i,icg) - enddo -C Uncomment following three lines for diagnostics. -cd call intout -cd call briefout(0,0.0d0) -cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n) - return - end -C------------------------------------------------------------------------- - subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 continue -#ifdef OSF -c Intercept NaNs in the coordinates -c write(iout,*) (var(i),i=1,nvar) - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - if (x_sum.ne.x_sum) then - write(iout,*)" *** grad_restr : Found NaN in coordinates" - call flush(iout) - print *," *** grad_restr : Found NaN in coordinates" - return - endif -#endif - call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C------------------------------------------------------------------------- - subroutine cartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SCCOR' -c -c This subrouting calculates total Cartesian coordinate gradient. -c The subroutine chainbuild_cart and energy MUST be called beforehand. -c -c do i=1,nres -c write (iout,*) "przed sum_grad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - -#ifdef TIMING - time00=MPI_Wtime() -#endif - icg=1 - call sum_gradient -#ifdef TIMING -#endif -c do i=1,nres -c write (iout,*) "checkgrad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo -cd write (iout,*) "After sum_gradient" -cd do i=1,nres-1 -cd write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) -cd write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) -cd enddo -c If performing constraint dynamics, add the gradients of the constraint energy - if(usampl.and.totT.gt.eq_time) then - do i=1,nct - do j=1,3 - gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i) - gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i) - enddo - enddo - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+dugamma(i) - enddo - do i=1,nres-2 - gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) - enddo - endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - call intcartderiv -#ifdef TIMING - time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 -#endif -cd call checkintcartgrad -cd write(iout,*) 'calling int_to_cart' -cd write (iout,*) "gcart, gxcart, gloc before int_to_cart" - do i=1,nct - do j=1,3 - gcart(j,i)=gradc(j,i,icg) - gxcart(j,i)=gradx(j,i,icg) - enddo -cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3),gloc(i,icg) - enddo -#ifdef TIMING - time01=MPI_Wtime() -#endif - call int_to_cart -#ifdef TIMING - time_inttocart=time_inttocart+MPI_Wtime()-time01 -#endif -cd write (iout,*) "gcart and gxcart after int_to_cart" -cd do i=0,nres-1 -cd write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3) -cd enddo -#ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 -#endif - return - end -C------------------------------------------------------------------------- - subroutine zerograd - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.SCCOR' -C -C Initialize Cartesian-coordinate gradient -C - do i=1,nres - do j=1,3 - gvdwx(j,i)=0.0D0 - gvdwxT(j,i)=0.0D0 - gradx_scp(j,i)=0.0D0 - gvdwc(j,i)=0.0D0 - gvdwcT(j,i)=0.0D0 - gvdwc_scp(j,i)=0.0D0 - gvdwc_scpp(j,i)=0.0d0 - gelc (j,i)=0.0D0 - gelc_long(j,i)=0.0D0 - gradb(j,i)=0.0d0 - gradbx(j,i)=0.0d0 - gvdwpp(j,i)=0.0d0 - gel_loc(j,i)=0.0d0 - gel_loc_long(j,i)=0.0d0 - ghpbc(j,i)=0.0D0 - ghpbx(j,i)=0.0D0 - gcorr3_turn(j,i)=0.0d0 - gcorr4_turn(j,i)=0.0d0 - gradcorr(j,i)=0.0d0 - gradcorr_long(j,i)=0.0d0 - gradcorr5_long(j,i)=0.0d0 - gradcorr6_long(j,i)=0.0d0 - gcorr6_turn_long(j,i)=0.0d0 - gradcorr5(j,i)=0.0d0 - gradcorr6(j,i)=0.0d0 - gcorr6_turn(j,i)=0.0d0 - gsccorc(j,i)=0.0d0 - gsccorx(j,i)=0.0d0 - gradc(j,i,icg)=0.0d0 - gradx(j,i,icg)=0.0d0 - gscloc(j,i)=0.0d0 - gsclocx(j,i)=0.0d0 - do intertyp=1,3 - gloc_sc(intertyp,i,icg)=0.0d0 - enddo - enddo - enddo -C -C Initialize the gradient of local energy terms. -C - do i=1,4*nres - gloc(i,icg)=0.0D0 - enddo - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - g_corr5_loc(i)=0.0d0 - g_corr6_loc(i)=0.0d0 - gel_loc_turn3(i)=0.0d0 - gel_loc_turn4(i)=0.0d0 - gel_loc_turn6(i)=0.0d0 - gsccor_loc(i)=0.0d0 - enddo -c initialize gcart and gxcart - do i=0,nres - do j=1,3 - gcart(j,i)=0.0d0 - gxcart(j,i)=0.0d0 - enddo - enddo - return - end -c------------------------------------------------------------------------- - double precision function fdum() - fdum=0.0D0 - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/initialize_p.F b/source/unres/src_MD-NEWSC-NEWC/initialize_p.F deleted file mode 100644 index 3c989e3..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/initialize_p.F +++ /dev/null @@ -1,1399 +0,0 @@ - block data - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MD' - include 'COMMON.INTERACT' - data MovTypID - & /'pool','chain regrow','multi-bond','phi','theta','side chain', - & 'total'/ -c Conversion from poises to molecular unit and the gas constant - data cPoise /2.9361d0/, Rb /0.001986d0/ -c Dielectric constant of water - data eps_out /80.0d0/ - end -c-------------------------------------------------------------------------- - subroutine initialize -C -C Define constants and zero out tables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MCM' - include 'COMMON.MINIM' - include 'COMMON.DERIV' - include 'COMMON.SPLITELE' -c Common blocks from the diagonalization routines - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - logical mask_r -c real*8 text1 /'initial_i'/ - - mask_r=.false. -#ifndef ISNAN -c NaNQ initialization - i=-1 - arg=100.0d0 - rr=dacos(arg) -#ifdef WINPGI - idumm=proc_proc(rr,i) -#else - call proc_proc(rr,i) -#endif -#endif - - kdiag=0 - icorfl=0 - iw=2 -C -C The following is just to define auxiliary variables used in angle conversion -C - pi=4.0D0*datan(1.0D0) - dwapi=2.0D0*pi - dwapi3=dwapi/3.0D0 - pipol=0.5D0*pi - deg2rad=pi/180.0D0 - rad2deg=1.0D0/deg2rad - angmin=10.0D0*deg2rad -C -C Define I/O units. -C - inp= 1 - iout= 2 - ipdbin= 3 - ipdb= 7 - icart = 30 - imol2= 4 - igeom= 8 - intin= 9 - ithep= 11 - ithep_pdb=51 - irotam=12 - irotam_pdb=52 - itorp= 13 - itordp= 23 - ielep= 14 - isidep=15 - iscpp=25 - icbase=16 - ifourier=20 - istat= 17 - irest1=55 - irest2=56 - iifrag=57 - ientin=18 - ientout=19 - ibond = 28 - isccor = 29 -crc for write_rmsbank1 - izs1=21 -cdr include secondary structure prediction bias - isecpred=27 -C -C CSA I/O units (separated from others especially for Jooyoung) -C - icsa_rbank=30 - icsa_seed=31 - icsa_history=32 - icsa_bank=33 - icsa_bank1=34 - icsa_alpha=35 - icsa_alpha1=36 - icsa_bankt=37 - icsa_int=39 - icsa_bank_reminimized=38 - icsa_native_int=41 - icsa_in=40 -crc for ifc error 118 - icsa_pdb=42 -C -C Set default weights of the energy terms. -C - wlong=1.0D0 - welec=1.0D0 - wtor =1.0D0 - wang =1.0D0 - wscloc=1.0D0 - wstrain=1.0D0 -C -C Zero out tables. -C - print '(a,$)','Inside initialize' -c call memmon_print_usage() - do i=1,maxres2 - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 - enddo - enddo - do i=1,maxres - do j=1,3 - xloc(j,i)=0.0D0 - enddo - enddo - do i=1,ntyp - do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - augm(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 - chi(i,j)=0.0D0 - enddo - do j=1,2 - bad(i,j)=0.0D0 - enddo - chip(i)=0.0D0 - alp(i)=0.0D0 - sigma0(i)=0.0D0 - sigii(i)=0.0D0 - rr0(i)=0.0D0 - a0thet(i)=0.0D0 - do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 - enddo - do j=0,3 - polthet(j,i)=0.0D0 - enddo - do j=1,3 - gthet(j,i)=0.0D0 - enddo - theta0(i)=0.0D0 - sig0(i)=0.0D0 - sigc0(i)=0.0D0 - do j=1,maxlob - bsc(j,i)=0.0D0 - do k=1,3 - censc(k,j,i)=0.0D0 - enddo - do k=1,3 - do l=1,3 - gaussc(l,k,j,i)=0.0D0 - enddo - enddo - nlob(i)=0 - enddo - enddo - nlob(ntyp1)=0 - dsc(ntyp1)=0.0D0 - do i=1,maxtor - itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 - enddo - enddo - enddo - do i=1,maxres - itype(i)=0 - itel(i)=0 - enddo -C Initialize the bridge arrays - ns=0 - nss=0 - nhpb=0 - do i=1,maxss - iss(i)=0 - enddo - do i=1,maxdim - dhpb(i)=0.0D0 - enddo - do i=1,maxres - ihpb(i)=0 - jhpb(i)=0 - enddo -C -C Initialize timing. -C - call set_timers -C -C Initialize variables used in minimization. -C -c maxfun=5000 -c maxit=2000 - maxfun=500 - maxit=200 - tolf=1.0D-2 - rtolf=5.0D-4 -C -C Initialize the variables responsible for the mode of gradient storage. -C - nfl=0 - icg=1 -C -C Initialize constants used to split the energy into long- and short-range -C components -C - r_cut=2.0d0 - rlamb=0.3d0 -#ifndef SPLITELE - nprint_ene=nprint_ene-1 -#endif - return - end -c------------------------------------------------------------------------- - block data nazwy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - data restyp / - &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ - data onelet / - &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ - data potname /'LJ','LJK','BP','GB','GBV','MOMO'/ - data ename / - & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", - & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", - & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", - & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," "/ - data wname / - & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", - & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR", - & " "," "/ - data nprint_ene /20/ - data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, - & 21,0,0,0/ - end -c--------------------------------------------------------------------------- - subroutine init_int_table - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer blocklengths(15),displs(15) -#endif - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.SBRIDGE' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1), - & ntask_cont_from_all(0:max_fg_procs-1), - & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), - & ntask_cont_to_all(0:max_fg_procs-1), - & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) - integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP - logical scheck,lprint,flag -#ifdef MPI - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - do i=0,nfgtasks-1 - itask_cont_from(i)=fg_rank - itask_cont_to(i)=fg_rank - enddo - lprint=energy_dec - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif -c lprint=.false. - do i=1,maxres - nint_gr(i)=0 - nscp_gr(i)=0 - do j=1,maxint_gr - istart(i,1)=0 - iend(i,1)=0 - ielstart(i)=0 - ielend(i)=0 - iscpstart(i,1)=0 - iscpend(i,1)=0 - enddo - enddo - ind_scint=0 - ind_scint_old=0 -cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', -cd & (ihpb(i),jhpb(i),i=1,nss) - do i=nnt,nct-1 - scheck=.false. - if (dyn_ss) goto 10 - do ii=1,nss - if (ihpb(ii).eq.i+nres) then - scheck=.true. - jj=jhpb(ii)-nres - goto 10 - endif - enddo - 10 continue -cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj - if (scheck) then - if (jj.eq.i+1) then -#ifdef MPI -c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+2 - iend(i,1)=nct -#endif - else if (jj.eq.nct) then -#ifdef MPI -c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct-1 -#endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else - nint_gr(i)=2 - istart(i,1)=i+1 - iend(i,1)=jj-1 - istart(i,2)=jj+1 - iend(i,2)=nct -#endif - endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct - ind_scint=ind_scint+nct-i -#endif - endif -#ifdef MPI - ind_scint_old=ind_scint -#endif - enddo - 12 continue -#ifndef MPI - iatsc_s=nnt - iatsc_e=nct-1 -#endif - if (iatsc_s.eq.0) iatsc_s=1 -#ifdef MPI - if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor, - & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e -#endif - if (lprint) then - write (iout,'(a)') 'Interaction array:' - do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') - & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) - enddo - endif - ispp=4 -#ifdef MPI -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue - if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 -c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) -c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, -c & " my_ele_inde_vdw",my_ele_inde_vdw - ind_eleint_vdw=0 - ind_eleint_vdw_old=0 - iatel_s_vdw=0 - iatel_e_vdw=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, - & my_ele_inde_vdw,i, - & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), - & ielend_vdw(i),*15) -c write (iout,*) i," ielstart_vdw",ielstart_vdw(i), -c & " ielend_vdw",ielend_vdw(i) - enddo ! i - if (iatel_s_vdw.eq.0) iatel_s_vdw=1 - 15 continue -#else - iatel_s=nnt - iatel_e=nct-5 - do i=iatel_s,iatel_e - ielstart(i)=i+4 - ielend(i)=nct-1 - enddo - iatel_s_vdw=nnt - iatel_e_vdw=nct-3 - do i=iatel_s_vdw,iatel_e_vdw - ielstart_vdw(i)=i+2 - ielend_vdw(i)=nct-1 - enddo -#endif - if (lprint) then - write (*,'(a)') 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank - write (iout,*) 'Electrostatic interaction array:' - do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) - enddo - endif ! lprint -c iscp=3 - iscp=2 -C Partition the SC-p interaction array -#ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else - iatscp_s=nnt - iatscp_e=nct-1 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=i+iscp - iscpend(i,1)=nct - elseif (i.gt.nct-iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - else - nscp_gr(i)=2 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - iscpstart(i,2)=i+iscp - iscpend(i,2)=nct - endif - enddo ! i -#endif - if (iatscp_s.eq.0) iatscp_s=1 - if (lprint) then - write (iout,'(a)') 'SC-p interaction array:' - do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') - & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) - enddo - endif ! lprint -C Partition local interactions -#ifdef MPI - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iturn3_start,iturn3_end) - iturn3_start=iturn3_start+nnt - iphi_start=iturn3_start+2 - iturn3_end=iturn3_end+nnt - iphi_end=iturn3_end+2 - iturn3_start=iturn3_start-1 - iturn3_end=iturn3_end-1 - call int_bounds(nres-3,itau_start,itau_end) - itau_start=itau_start+3 - itau_end=itau_end+3 - call int_bounds(nres-3,iphi1_start,iphi1_end) - iphi1_start=iphi1_start+3 - iphi1_end=iphi1_end+3 - call int_bounds(nct-nnt-3,iturn4_start,iturn4_end) - iturn4_start=iturn4_start+nnt - iphid_start=iturn4_start+2 - iturn4_end=iturn4_end+nnt - iphid_end=iturn4_end+2 - iturn4_start=iturn4_start-1 - iturn4_end=iturn4_end-1 - call int_bounds(nres-2,ibond_start,ibond_end) - ibond_start=ibond_start+1 - ibond_end=ibond_end+1 - call int_bounds(nct-nnt,ibondp_start,ibondp_end) - ibondp_start=ibondp_start+nnt - ibondp_end=ibondp_end+nnt - call int_bounds1(nres-1,ivec_start,ivec_end) - print *,"Processor",myrank,fg_rank,fg_rank1, - & " ivec_start",ivec_start," ivec_end",ivec_end - iset_start=loc_start+2 - iset_end=loc_end+2 - if (ndih_constr.eq.0) then - idihconstr_start=1 - idihconstr_end=0 - else - call int_bounds(ndih_constr,idihconstr_start,idihconstr_end) - endif - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo - if (lprint) then - write (*,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end, - & ' iphid_start',iphid_start,' iphid_end',iphid_end, - & ' ibond_start',ibond_start,' ibond_end',ibond_end, - & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end, - & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end, - & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end, - & ' ivec_start',ivec_start,' ivec_end',ivec_end, - & ' iset_start',iset_start,' iset_end',iset_end, - & ' idihconstr_start',idihconstr_start,' idihconstr_end', - & idihconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo - endif - if (nfgtasks.gt.1) then - call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - iaux=ivec_end-ivec_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iset_end-iset_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ibond_end-ibond_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ithet_end-ithet_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi_end-iphi_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi1_end-iphi1_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - do i=0,maxprocs-1 - do j=1,maxres - ielstart_all(j,i)=0 - ielend_all(j,i)=0 - enddo - enddo - call MPI_Allgather(iturn3_start,1,MPI_INTEGER, - & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_start,1,MPI_INTEGER, - & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn3_end,1,MPI_INTEGER, - & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_end,1,MPI_INTEGER, - & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_s,1,MPI_INTEGER, - & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_e,1,MPI_INTEGER, - & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER, - & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielend(1),maxres,MPI_INTEGER, - & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - if (lprint) then - write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks) - write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks) - write (iout,*) "iturn3_start_all", - & (iturn3_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn3_end_all", - & (iturn3_end_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_start_all", - & (iturn4_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_end_all", - & (iturn4_end_all(i),i=0,nfgtasks-1) - write (iout,*) "The ielstart_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1) - enddo - write (iout,*) "The ielend_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1) - enddo - call flush(iout) - endif - ntask_cont_from=0 - ntask_cont_to=0 - itask_cont_from(0)=fg_rank - itask_cont_to(0)=fg_rank - flag=.false. - do ii=iturn3_start,iturn3_end - call add_int(ii,ii+2,iturn3_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn4_start,iturn4_end - call add_int(ii,ii+3,iturn4_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn3_start,iturn3_end - call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from) - enddo - do ii=iturn4_start,iturn4_end - call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from) - enddo - if (lprint) then - write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - endif -c write (iout,*) "Loop forward" -c call flush(iout) - do i=iatel_s,iatel_e -c write (iout,*) "from loop i=",i -c call flush(iout) - do j=ielstart(i),ielend(i) - call add_int_from(i,j,ntask_cont_from,itask_cont_from) - enddo - enddo -c write (iout,*) "Loop backward iatel_e-1",iatel_e-1, -c & " iatel_e",iatel_e -c call flush(iout) - nat_sent=0 - do i=iatel_s,iatel_e -c write (iout,*) "i",i," ielstart",ielstart(i), -c & " ielend",ielend(i) -c call flush(iout) - flag=.false. - do j=ielstart(i),ielend(i) - call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to, - & itask_cont_to,flag) - enddo - if (flag) then - nat_sent=nat_sent+1 - iat_sent(nat_sent)=i - endif - enddo - if (lprint) then - write (iout,*)"After longrange ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - write (iout,*) "iint_sent" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - enddo - write (iout,*) "iturn3_sent iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Gather(ntask_cont_from,1,MPI_INTEGER, - & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_from ended" -c call flush(iout) - call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER, - & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king, - & FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_from ended" -c call flush(iout) - call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all, - & 1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_to ended" -c call flush(iout) - call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER, - & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_to ended" -c call flush(iout) - if (fg_rank.eq.king) then - write (iout,*)"Contact receive task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_from_all(i), - & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i)) - enddo - write (iout,*) - call flush(iout) - write (iout,*) "Contact send task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_to_all(i), - & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i)) - enddo - write (iout,*) - call flush(iout) -C Check if every send will have a matching receive - ncheck_to=0 - ncheck_from=0 - do i=0,nfgtasks-1 - ncheck_to=ncheck_to+ntask_cont_to_all(i) - ncheck_from=ncheck_from+ntask_cont_from_all(i) - enddo - write (iout,*) "Control sums",ncheck_from,ncheck_to - if (ncheck_from.ne.ncheck_to) then - write (iout,*) "Error: #receive differs from #send." - write (iout,*) "Terminating program...!" - call flush(iout) - flag=.false. - else - flag=.true. - do i=0,nfgtasks-1 - do j=1,ntask_cont_to_all(i) - ii=itask_cont_to_all(j,i) - do k=1,ntask_cont_from_all(ii) - if (itask_cont_from_all(k,ii).eq.i) then - if(lprint)write(iout,*)"Matching send/receive",i,ii - exit - endif - enddo - if (k.eq.ntask_cont_from_all(ii)+1) then - flag=.false. - write (iout,*) "Error: send by",j," to",ii, - & " would have no matching receive" - endif - enddo - enddo - endif - if (.not.flag) then - write (iout,*) "Unmatched sends; terminating program" - call flush(iout) - endif - endif - call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR) -c write (iout,*) "flag broadcast ended flag=",flag -c call flush(iout) - if (.not.flag) then - call MPI_Finalize(IERROR) - stop "Error in INIT_INT_TABLE: unmatched send/receive." - endif - call MPI_Comm_group(FG_COMM,fg_group,IERR) -c write (iout,*) "MPI_Comm_group ended" -c call flush(iout) - call MPI_Group_incl(fg_group,ntask_cont_from+1, - & itask_cont_from(0),CONT_FROM_GROUP,IERR) - call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0), - & CONT_TO_GROUP,IERR) - do i=1,nat_sent - ii=iat_sent(i) - iaux=4*(ielend(ii)-ielstart(ii)+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP, - & iint_sent_local(1,ielstart(ii),i),IERR ) -c write (iout,*) "Ranks translated i=",i -c call flush(iout) - enddo - iaux=4*(iturn3_end-iturn3_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn3_sent(1,iturn3_start),CONT_TO_GROUP, - & iturn3_sent_local(1,iturn3_start),IERR) - iaux=4*(iturn4_end-iturn4_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn4_sent(1,iturn4_start),CONT_TO_GROUP, - & iturn4_sent_local(1,iturn4_start),IERR) - if (lprint) then - write (iout,*) "iint_sent_local" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - call flush(iout) - enddo - write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Group_free(fg_group,ierr) - call MPI_Group_free(cont_from_group,ierr) - call MPI_Group_free(cont_to_group,ierr) - call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR) - call MPI_Type_commit(MPI_UYZ,IERROR) - call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD, - & IERROR) - call MPI_Type_commit(MPI_UYZGRAD,IERROR) - call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR) - call MPI_Type_commit(MPI_MU,IERROR) - call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR) - call MPI_Type_commit(MPI_MAT1,IERROR) - call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR) - call MPI_Type_commit(MPI_MAT2,IERROR) - call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR) - call MPI_Type_commit(MPI_THET,IERROR) - call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR) - call MPI_Type_commit(MPI_GAM,IERROR) -#ifndef MATGATHER -c 9/22/08 Derived types to send matrices which appear in correlation terms - do i=0,nfgtasks-1 - if (ivec_count(i).eq.ivec_count(0)) then - lentyp(i)=0 - else - lentyp(i)=1 - endif - enddo - do ind_typ=lentyp(0),lentyp(nfgtasks-1) - if (ind_typ.eq.0) then - ichunk=ivec_count(0) - else - ichunk=ivec_count(1) - endif -c do i=1,4 -c blocklengths(i)=4 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1 -c do i=1,4 -c blocklengths(i)=2 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 - do i=1,8 - blocklengths(i)=2 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR) - do i=1,8 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR) - do i=1,6 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,6 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,6 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(6,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR) - do i=1,2 - blocklengths(i)=8 - enddo - displs(1)=0 - do i=2,2 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,2 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(2,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR) - do i=1,4 - blocklengths(i)=1 - enddo - displs(1)=0 - do i=2,4 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,4 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(4,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR) - call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR) - enddo -#endif - endif - iint_start=ivec_start+1 - iint_end=ivec_end+1 - do i=0,nfgtasks-1 - iint_count(i)=ivec_count(i) - iint_displ(i)=ivec_displ(i) - ivec_displ(i)=ivec_displ(i)-1 - iset_displ(i)=iset_displ(i)-1 - ithet_displ(i)=ithet_displ(i)-1 - iphi_displ(i)=iphi_displ(i)-1 - iphi1_displ(i)=iphi1_displ(i)-1 - ibond_displ(i)=ibond_displ(i)-1 - enddo - if (nfgtasks.gt.1 .and. fg_rank.eq.king - & .and. (me.eq.0 .or. out1file)) then - write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT" - do i=0,nfgtasks-1 - write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i), - & iset_count(i) - enddo - write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end, - & " iphi1_start",iphi1_start," iphi1_end",iphi1_end - write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL" - do i=0,nfgtasks-1 - write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i), - & iphi1_displ(i) - enddo - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',nfgtasks, - & ' fine-grain processors.' - endif -#else - loc_start=2 - loc_end=nres-1 - ithet_start=3 - ithet_end=nres - iturn3_start=nnt - iturn3_end=nct-3 - iturn4_start=nnt - iturn4_end=nct-4 - iphi_start=nnt+3 - iphi_end=nct - iphi1_start=4 - iphi1_end=nres - idihconstr_start=1 - idihconstr_end=ndih_constr - iphid_start=iphi_start - iphid_end=iphi_end-1 - itau_start=4 - itau_end=nres - ibond_start=2 - ibond_end=nres-1 - ibondp_start=nnt+1 - ibondp_end=nct - ivec_start=1 - ivec_end=nres-1 - iset_start=3 - iset_end=nres+1 - iint_start=2 - iint_end=nres-1 -#endif - return - end -#ifdef MPI -c--------------------------------------------------------------------------- - subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(4), - & ntask_cont_to,itask_cont_to(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,isent,k,l -c Determines whether to send interaction ii,jj to other processors; a given -c interaction can be sent to at most 2 processors. -c Sets flag=.true. if interaction ii,jj needs to be sent to at least -c one processor, otherwise flag is unchanged from the input value. - isent=0 - itask(1)=fg_rank - itask(2)=fg_rank - itask(3)=fg_rank - itask(4)=fg_rank -c write (iout,*) "ii",ii," jj",jj -c Loop over processors to check if anybody could need interaction ii,jj - do iproc=0,fg_rank-1 -c Check if the interaction matches any turn3 at iproc - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo -C Check if the interaction matches any turn4 at iproc - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and. - & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then - if (ielstart_all(ii-1,iproc).le.jj-1.and. - & ielend_all(ii-1,iproc).ge.jj-1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - if (ielstart_all(ii-1,iproc).le.jj+1.and. - & ielend_all(ii-1,iproc).ge.jj+1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,k,l - do iproc=fg_rank+1,nfgtasks-1 - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then - if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc)) - & then - if (jj+1.ge.ielstart_all(ii+1,iproc).and. - & jj+1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj-1.ge.ielstart_all(ii+1,iproc).and. - & jj-1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc)) - & then - if (jj-1.ge.ielstart_all(ii-1,iproc).and. - & jj-1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj+1.ge.ielstart_all(ii-1,iproc).and. - & jj+1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_task(iproc,ntask_cont,itask_cont) - implicit none - include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) - integer ii - do ii=1,ntask_cont - if (itask_cont(ii).eq.iproc) return - enddo - ntask_cont=ntask_cont+1 - itask_cont(ntask_cont)=iproc - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks - do i=1,nfgtasks - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks - do i=1,nexcess - int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds1(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks1 - do i=1,nfgtasks1 - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks1 - do i=1,nexcess - int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank1-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank1) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_partition(int_index,lower_index,upper_index,atom, - & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer int_index,lower_index,upper_index,atom,at_start,at_end, - & first_atom,last_atom,int_gr,jat_start,jat_end - logical lprn - lprn=.false. - if (lprn) write (iout,*) 'int_index=',int_index - int_index_old=int_index - int_index=int_index+last_atom-first_atom+1 - if (lprn) - & write (iout,*) 'int_index=',int_index, - & ' int_index_old',int_index_old, - & ' lower_index=',lower_index, - & ' upper_index=',upper_index, - & ' atom=',atom,' first_atom=',first_atom, - & ' last_atom=',last_atom - if (int_index.ge.lower_index) then - int_gr=int_gr+1 - if (at_start.eq.0) then - at_start=atom - jat_start=first_atom-1+lower_index-int_index_old - else - jat_start=first_atom - endif - if (lprn) write (iout,*) 'jat_start',jat_start - if (int_index.ge.upper_index) then - at_end=atom - jat_end=first_atom-1+upper_index-int_index_old - return1 - else - jat_end=last_atom - endif - if (lprn) write (iout,*) 'jat_end',jat_end - endif - return - end -#endif -c------------------------------------------------------------------------------ - subroutine hpb_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' -c write(2,*)"hpb_partition: nhpb=",nhpb -#ifdef MPI - call int_bounds(nhpb,link_start,link_end) - if (.not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nhpb',nhpb,' link_start=',link_start, - & ' link_end',link_end -#else - link_start=1 - link_end=nhpb -#endif -c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/int_to_cart.f b/source/unres/src_MD-NEWSC-NEWC/int_to_cart.f deleted file mode 100644 index 73e8384..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/int_to_cart.f +++ /dev/null @@ -1,278 +0,0 @@ - subroutine int_to_cart -c-------------------------------------------------------------- -c This subroutine converts the energy derivatives from internal -c coordinates to cartesian coordinates -c------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' -c calculating dE/ddc1 - if (nres.lt.3) goto 18 -c do i=1,nres -c c do intertyp=1,3 -c write (iout,*) "przed tosyjnymi",i,intertyp,gcart(intertyp,i) -c &,gloc_sc(1,i,icg),gloc(i,icg) -c enddo -c enddo - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) - & +gloc(nres-2,icg)*dtheta(j,1,3) - if(itype(2).ne.10) then - gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,1,2) - endif - enddo -c Calculating the remainder of dE/ddc2 - do j=1,3 - gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ - & gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4) - if(itype(2).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,2,2) - endif - if(itype(3).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+ - & gloc(ialph(3,1)+nside,icg)*domega(j,1,3) - endif - if(nres.gt.4) then - gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5) - endif - enddo -c If there are only five residues - if(nres.eq.5) then - do j=1,3 - gcart(j,3)=gcart(j,3)+gloc(1,icg)*dphi(j,3,4)+gloc(2,icg)* - & dphi(j,2,5)+gloc(nres-1,icg)*dtheta(j,2,4)+gloc(nres,icg)* - & dtheta(j,1,5) - if(itype(3).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(3,1),icg)* - & dalpha(j,2,3)+gloc(ialph(3,1)+nside,icg)*domega(j,2,3) - endif - if(itype(4).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(4,1),icg)* - & dalpha(j,1,4)+gloc(ialph(4,1)+nside,icg)*domega(j,1,4) - endif - enddo - endif -c If there are more than five residues - if(nres.gt.5) then - do i=3,nres-3 - do j=1,3 - gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1) - & +gloc(i-1,icg)*dphi(j,2,i+2)+ - & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+ - & gloc(nres+i-3,icg)*dtheta(j,1,i+2) - if(itype(i).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+ - & gloc(ialph(i,1)+nside,icg)*domega(j,2,i) - endif - if(itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1) - & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1) - endif - enddo - enddo - endif -c Setting dE/ddnres-2 - if(nres.gt.5) then - do j=1,3 - gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)* - & dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres) - & +gloc(2*nres-6,icg)* - & dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres) - if(itype(nres-2).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)* - & dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)* - & domega(j,2,nres-2) - endif - if(itype(nres-1).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,1,nres-1) - endif - enddo - endif -c Settind dE/ddnres-1 - do j=1,3 - gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+ - & gloc(2*nres-5,icg)*dtheta(j,2,nres) - if(itype(nres-1).ne.10) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,2,nres-1) - endif - enddo -c The side-chain vector derivatives - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) - & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) - enddo - endif - enddo -c---------------------------------------------------------------------- -C INTERTYP=1 SC...Ca...Ca...Ca -C INTERTYP=2 Ca...Ca...Ca...SC -C INTERTYP=3 SC...Ca...Ca...SC -c calculating dE/ddc1 - 18 continue -c do i=1,nres -c gloc(i,icg)=0.0D0 -c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) -c enddo - if (nres.lt.2) return - if ((nres.lt.3).and.(itype(1).eq.10)) return - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - do j=1,3 -cc Derviative was calculated for oposite vector of side chain therefore -c there is "-" sign before gloc_sc - gxcart(j,1)=gxcart(j,1)-gloc_sc(1,0,icg)* - & dtauangle(j,1,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* - & dtauangle(j,1,2,3) - if ((itype(2).ne.10).and.(itype(2).ne.21)) then - gxcart(j,1)= gxcart(j,1) - & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* - & dtauangle(j,3,2,3) - endif - enddo - endif - if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.21)) - & then - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4) - enddo - endif -c As potetnial DO NOT depend on omicron anlge their derivative is -c ommited -c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3) - -c Calculating the remainder of dE/ddc2 - do j=1,3 - if((itype(2).ne.10).and.(itype(2).ne.21)) then - if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+ - & gloc_sc(3,0,icg)*dtauangle(j,3,3,3) - if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.21)) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4) - endif - if (nres.gt.3) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4) -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart" -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx" - endif - endif - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3) -c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3) - endif - if ((itype(3).ne.10).and.(nres.ge.3)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4) -c write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4) - endif - if ((itype(4).ne.10).and.(nres.ge.4)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5) -c write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5) - endif - -c write(iout,*) gcart(j,2),itype(2),itype(1),itype(3), "gcart2" - enddo -c If there are more than five residues - if(nres.ge.5) then - do i=3,nres-2 - do j=1,3 -c write(iout,*) "before", gcart(j,i) - if (itype(i).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg) - & *dtauangle(j,2,3,i+1) - & -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-1,icg) - & *dtauangle(j,1,2,i+2) -c write(iout,*) "new",j,i, -c & gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2) - - if (itype(i-1).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg) - &*dtauangle(j,3,3,i+1) - endif - if (itype(i+1).ne.10) then - gxcart(j,i)=gxcart(j,i)-gloc_sc(3,i-1,icg) - &*dtauangle(j,3,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(3,i-1,icg) - &*dtauangle(j,3,2,i+2) - endif - endif - if (itype(i-1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-2,icg)* - & dtauangle(j,1,3,i+1) - endif - if (itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i-1,icg)* - & dtauangle(j,2,2,i+2) -c write(iout,*) "numer",i,gloc_sc(2,i-1,icg), -c & dtauangle(j,2,2,i+2) - endif - if (itype(i+2).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)* - & dtauangle(j,2,1,i+3) - endif - enddo - enddo - endif -c Setting dE/ddnres-1 - if(nres.ge.4) then - do j=1,3 - if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) - & *dtauangle(j,2,3,nres) -c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg), -c & dtauangle(j,2,3,nres), gxcart(j,nres-1) - if (itype(nres-2).ne.10) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) - & *dtauangle(j,3,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,1,nres+1) - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,2,nres+1) - endif - endif - if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* - & dtauangle(j,1,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* - & dtauangle(j,2,2,nres+1) -c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg), -c & dtauangle(j,2,2,nres+1), itype(nres-1),itype(nres) - endif - enddo - endif -c Settind dE/ddnres - if ((nres.ge.3).and.(itype(nres).ne.10))then - do j=1,3 - gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg) - & *dtauangle(j,2,3,nres+1) - enddo - endif -c The side-chain vector derivatives - return - end - - diff --git a/source/unres/src_MD-NEWSC-NEWC/intcartderiv.F b/source/unres/src_MD-NEWSC-NEWC/intcartderiv.F deleted file mode 100644 index c220540..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/intcartderiv.F +++ /dev/null @@ -1,725 +0,0 @@ - subroutine intcartderiv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.LOCAL' - include 'COMMON.SCCOR' - double precision dcostheta(3,2,maxres), - & dcosphi(3,3,maxres),dsinphi(3,3,maxres), - & dcosalpha(3,3,maxres),dcosomega(3,3,maxres), - & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3), - & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3) - -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1 .and. me.eq.king) - & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - pi4 = 0.5d0*pipol - pi34 = 3*pi4 - -c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end -c Derivatives of theta's -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) - do j=1,3 - dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ - & vbld(i-1) - dtheta(j,1,i)=-1/sint*dcostheta(j,1,i) - dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ - & vbld(i) - dtheta(j,2,i)=-1/sint*dcostheta(j,2,i) - enddo - enddo - -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then - cost1=dcos(omicron(1,i)) - sint1=sqrt(1-cost1*cost1) - cost2=dcos(omicron(2,i)) - sint2=sqrt(1-cost2*cost2) - do j=1,3 -CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) - dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ - & cost1*dc_norm(j,i-2))/ - & vbld(i-1) - domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i) - dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) - & +cost1*(dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) - domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i) -CC Calculate derivative over second omicron Sci-1,Cai-1 Cai -CC Looks messy but better than if in loop - dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) - & +cost2*dc_norm(j,i-1))/ - & vbld(i) - domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i) - dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) - & +cost2*(-dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) -c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres) - domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i) - enddo - endif - enddo - - - -c Derivatives of phi: -c If phi is 0 or 180 degrees, then the formulas -c have to be derived by power series expansion of the -c conventional formulas around 0 and 180. -#ifdef PARINTDER - do i=iphi1_start,iphi1_end -#else - do i=4,nres -#endif -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(theta(i-1)) - sing=dsin(phi(i)) - cost=dcos(theta(i)) - cost1=dcos(theta(i-1)) - cosg=dcos(phi(i)) - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. - & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) - dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) - dsinphi(j,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) -c Bug fixed 3/24/05 (AL) - dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dphi(j,1,i)=-1/sing*dcosphi(j,1,i) - dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcostheta(j,1,i) - dphi(j,2,i)=-1/sing*dcosphi(j,2,i) - dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1))/vbld(i) - dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - enddo - endif - enddo - -Calculate derivative of Tauangle -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=3,nres -#endif - if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle -cc dtauangle(j,intertyp,dervityp,residue number) -cc INTERTYP=1 SC...Ca...Ca..Ca -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(1,i)) - cost=dcos(theta(i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(1,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 -c Obtaining the gamma derivatives from sine derivative - if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. - & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. - & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) - & *vbld_inv(i-2+nres) - dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) - dsintau(j,1,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "dsintau", dsintau(j,1,2,i) - dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) - dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) - dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcostheta(j,1,i) - dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) - dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* - & dc_norm(j,i-1))/vbld(i) - dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) -c write (iout,*) "else",i - enddo - endif -c do k=1,3 -c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) -c enddo - enddo -CC Second case Ca...Ca...Ca...SC -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=4,nres -#endif - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle -c the conventional case - sint=dsin(omicron(1,i)) - sint1=dsin(theta(i-1)) - sing=dsin(tauangle(2,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(theta(i-1)) - cosg=dcos(tauangle(2,i)) -c do j=1,3 -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) -c enddo - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. - & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. - & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then - call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) -c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), -c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" - dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) - dsintau(j,2,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), -c & sing*ctgt*domicron(j,1,2,i), -c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) - dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) - dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) -c write(iout,*) i,j,"else", dtauangle(j,2,3,i) - enddo - endif - enddo - - -CCC third case SC...Ca...Ca...SC -#ifdef PARINTDER - - do i=itau_start,itau_end -#else - do i=3,nres -#endif -c the conventional case - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or. - &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle - sint=dsin(omicron(1,i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(3,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(3,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. - & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. - & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then - call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) - & *vbld_inv(i-2+nres) - dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) - dsintau(j,3,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) - & *vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm2(j,i-2+nres))/vbld(i-2+nres) - dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) - dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) - dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) -c write(iout,*) "else",i - enddo - endif - enddo -#ifdef CRYST_SC -c Derivatives of side-chain angles alpha and omega -#if defined(MPI) && defined(PARINTDER) - do i=ibond_start,ibond_end -#else - do i=2,nres-1 -#endif - if(itype(i).ne.10) then - fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) - fac6=fac5/vbld(i) - fac7=fac5*fac5 - fac8=fac5/vbld(i+1) - fac9=fac5/vbld(i+nres) - scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*( - & scalar(dC_norm(1,i),dC_norm(1,i+nres)) - & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) - sina=sqrt(1-cosa*cosa) - sino=dsin(omeg(i)) - do j=1,3 - dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- - & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) - dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) - dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- - & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) - dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) - dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- - & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ - & vbld(i+nres)) - dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) - enddo -c obtaining the derivatives of omega from sines - if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. - & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then - fac15=dcos(theta(i+1))/(dsin(theta(i+1))* - & dsin(theta(i+1))) - fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) - fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) - call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) - coso_inv=1.0d0/dcos(omeg(i)) - do j=1,3 - dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) - & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-( - & sino*dc_norm(j,i-1))/vbld(i) - domega(j,1,i)=coso_inv*dsinomega(j,1,i) - dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) - & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) - & -sino*dc_norm(j,i)/vbld(i+1) - domega(j,2,i)=coso_inv*dsinomega(j,2,i) - dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- - & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ - & vbld(i+nres) - domega(j,3,i)=coso_inv*dsinomega(j,3,i) - enddo - else -c obtaining the derivatives of omega from cosines - fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) - fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) - fac12=fac10*sina - fac13=fac12*fac12 - fac14=sina*sina - do j=1,3 - dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* - & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ - & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* - & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 - domega(j,1,i)=-1/sino*dcosomega(j,1,i) - dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* - & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* - & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ - & (scala2-fac11*cosa)*(0.25d0*sina/fac10* - & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i) - & ))/fac13 - domega(j,2,i)=-1/sino*dcosomega(j,2,i) - dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- - & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ - & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 - domega(j,3,i)=-1/sino*dcosomega(j,3,i) - enddo - endif - endif - enddo -#endif -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1) then -#ifdef DEBUG - write (iout,*) "Gather dtheta" -cd call flush(iout) -c write (iout,*) "dtheta before gather" -c do i=1,nres -c write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) -c enddo -#endif - call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank), - & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET, - & king,FG_COMM,IERROR) -#ifdef DEBUG -cd write (iout,*) "Gather dphi" -cd call flush(iout) - write (iout,*) "dphi before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) - enddo -#endif - call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank), - & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather dalpha" -cd call flush(iout) -#ifdef CRYST_SC - call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather domega" -cd call flush(iout) - call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -#endif - endif -#endif -#ifdef DEBUG - write (iout,*) "dtheta after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2) - enddo - write (iout,*) "dphi after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) - enddo -#endif - return - end - - subroutine checkintcartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - double precision dthetanum(3,2,maxres),dphinum(3,3,maxres) - & ,dalphanum(3,3,maxres), domeganum(3,3,maxres) - double precision theta_s(maxres),phi_s(maxres),alph_s(maxres), - & omeg_s(maxres),dc_norm_s(3) - double precision aincr /1.0d-5/ - - do i=1,nres - phi_s(i)=phi(i) - theta_s(i)=theta(i) - alph_s(i)=alph(i) - omeg_s(i)=omeg(i) - enddo -c Check theta gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of theta" - write (iout,*) - do i=3,nres - do j=1,3 - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - call int_from_cart1(.false.) - dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3), - & (dtheta(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3), - & (dthetanum(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') - & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3), - & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3) - write (iout,*) - enddo -c Check gamma gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of gamma" - do i=4,nres - do j=1,3 - dcji=dc(j,i-3) - dc(j,i-3)=dcji+aincr - call chainbuild_cart - dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3), - & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3), - & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dphinum(j,1,i)/dphi(j,1,i),j=1,3), - & (dphinum(j,2,i)/dphi(j,2,i),j=1,3), - & (dphinum(j,3,i)/dphi(j,3,i),j=1,3) - write (iout,*) - enddo -c Check alpha gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of alpha" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - dalphanum(j,1,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - dalphanum(j,2,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - dalphanum(j,3,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3), - & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3), - & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3), - & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3), - & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3) - write (iout,*) - enddo -c Check omega gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of omega" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - domeganum(j,1,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - domeganum(j,2,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - domeganum(j,3,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3), - & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3), - & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (domeganum(j,1,i)/domega(j,1,i),j=1,3), - & (domeganum(j,2,i)/domega(j,2,i),j=1,3), - & (domeganum(j,3,i)/domega(j,3,i),j=1,3) - write (iout,*) - enddo - return - end - - subroutine chainbuild_cart - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' - -#ifdef MPI - if (nfgtasks.gt.1) then -c write (iout,*) "BCAST in chainbuild_cart" -c call flush(iout) -c Broadcast the order to build the chain and compute internal coordinates -c to the slaves. The slaves receive the order in ERGASTULUM. - time00=MPI_Wtime() -c write (iout,*) "CHAINBUILD_CART: DC before BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo - if (fg_rank.eq.0) - & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_bcast7=time_bcast7+MPI_Wtime()-time00 - time01=MPI_Wtime() - call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "CHAINBUILD_CART: DC after BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo -c write (iout,*) "End BCAST in chainbuild_cart" -c call flush(iout) - time_bcast=time_bcast+MPI_Wtime()-time00 - time_bcastc=time_bcastc+MPI_Wtime()-time01 - endif -#endif - do j=1,3 - c(j,1)=dc(j,0) - enddo - do i=2,nres - do j=1,3 - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo - enddo - do i=1,nres - do j=1,3 - c(j,i+nres)=c(j,i)+dc(j,i+nres) - enddo - enddo -c write (iout,*) "CHAINBUILD_CART" -c call cartprint - call int_from_cart1(.false.) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/intcor.f b/source/unres/src_MD-NEWSC-NEWC/intcor.f deleted file mode 100644 index a3cd5d0..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/intcor.f +++ /dev/null @@ -1,91 +0,0 @@ -C -C------------------------------------------------------------------------------ -C - double precision function alpha(i1,i2,i3) -c -c Calculates the planar angle between atoms (i1), (i2), and (i3). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - vnorm=dsqrt(x12*x12+y12*y12+z12*z12) - wnorm=dsqrt(x23*x23+y23*y23+z23*z23) - scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm) - alpha=arcos(scalar) - return - end -C -C------------------------------------------------------------------------------ -C - double precision function beta(i1,i2,i3,i4) -c -c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4) -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - x34=c(1,i4)-c(1,i3) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - y34=c(2,i4)-c(2,i3) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - z34=c(3,i4)-c(3,i3) -cd print '(2i3,3f10.5)',i1,i2,x12,y12,z12 -cd print '(2i3,3f10.5)',i2,i3,x23,y23,z23 -cd print '(2i3,3f10.5)',i3,i4,x34,y34,z34 - wx=-y23*z34+y34*z23 - wy=x23*z34-z23*x34 - wz=-x23*y34+y23*x34 - wnorm=dsqrt(wx*wx+wy*wy+wz*wz) - vx=y12*z23-z12*y23 - vy=-x12*z23+z12*x23 - vz=x12*y23-y12*x23 - vnorm=dsqrt(vx*vx+vy*vy+vz*vz) - if (vnorm.gt.1.0D-13 .and. wnorm.gt.1.0D-13) then - scalar=(vx*wx+vy*wy+vz*wz)/(vnorm*wnorm) - if (dabs(scalar).gt.1.0D0) - &scalar=0.99999999999999D0*scalar/dabs(scalar) - angle=dacos(scalar) -cd print '(2i4,10f7.3)',i2,i3,vx,vy,vz,wx,wy,wz,vnorm,wnorm, -cd &scalar,angle - else - angle=pi - endif -c if (angle.le.0.0D0) angle=pi+angle - tx=vy*wz-vz*wy - ty=-vx*wz+vz*wx - tz=vx*wy-vy*wx - scalar=tx*x23+ty*y23+tz*z23 - if (scalar.lt.0.0D0) angle=-angle - beta=angle - return - end -C -C------------------------------------------------------------------------------ -C - function dist(i1,i2) -c -c Calculates the distance between atoms (i1) and (i2). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - y12=c(2,i1)-c(2,i2) - z12=c(3,i1)-c(3,i2) - dist=dsqrt(x12*x12+y12*y12+z12*z12) - return - end -C diff --git a/source/unres/src_MD-NEWSC-NEWC/intlocal.f b/source/unres/src_MD-NEWSC-NEWC/intlocal.f deleted file mode 100644 index 2dbcc88..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/intlocal.f +++ /dev/null @@ -1,517 +0,0 @@ - subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2, - & si1,si2,si3,si4,transp,q) - implicit none - integer ity1,ity2 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4 - logical transp - double precision elocal,ele - double precision delta,delta2,sum,ene,sumene,boltz - double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=20 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum=0.0d0 - sumene=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - ene= - & -elocal(ity1,lambda1,lambda2,.false.)* - & elocal(ity2,lambda3,lambda4,transp)* - & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)* - & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2) -cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2), -cd & elocal(ity2,lambda3,gamma2-pi-lambda4), -cd & ele(lambda1,lambda2,a1,si1,si3), -cd & ele(lambda3,lambda4,a2,si2,si4) - sum=sum+ene - enddo - enddo - enddo - enddo - q=sum/(2*pi)**4*delta**4 - write (2,* )'sum',sum,' q',q - return - end -c--------------------------------------------------------------------------- - subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4, - & a1,koniec,q1,q2,q3,q4) - implicit none - integer ity1,ity2,ity3,ity4 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1, - & lambda2,lambda3,lambda4 - logical koniec - double precision elocal,ele - double precision delta,delta2,sum1,sum2,sum3,sum4, - & ene1,ene2,ene3,ene4,boltz - double precision q1,q2,q3,q4,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - if (.not.koniec) then - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda2,lambda4,a1) - else - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda2,-lambda4,a1) - endif - ene2= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda2,lambda3,a1) - if (.not.koniec) then - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda1,lambda4,a1) - else - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda1,-lambda4,a1) - endif - ene4= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda1,lambda3,a1) - sum1=sum1+ene1 - sum2=sum2+ene2 - sum3=sum3+ene3 - sum4=sum4+ene4 - enddo - enddo - enddo - enddo - q1=sum1/(2*pi)**4*delta**4 - q2=sum2/(2*pi)**4*delta**4 - q3=sum3/(2*pi)**4*delta**4 - q4=sum4/(2*pi)**4*delta**4 - write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4 - return - end -c------------------------------------------------------------------------- - subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4, - & a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - sum1=sum1+pom*eloc1 - endif - eloc3=elocal(ity3,lambda2,lambda5,.false.) - sum2=sum2+pom*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc4 - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda5,.false.) - sum4=sum4+pom*eloc6 - endif - enddo - enddo - enddo - enddo - enddo - pom=1.0d0/(2*pi)**5*delta**5 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom -c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4 - return - end -c------------------------------------------------------------------------- - subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2, - & ity3,ity4,ity5,ity6,a1,a2,ene_turn6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom,ene5 - double precision ene_turn6,sum5,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, - & ' gamma3=',gamma3,' gamma4=',gamma4 - write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 - write(2,*) 'a1=',a1 - write(2,*) 'a2=',a2 - - sum5=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - ele1=ele(lambda1,-lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.) - eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.) - sum5=sum5+pom*eloc3*eloc4 - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**5*delta**5 - ene_turn6=sum5*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4, - & ene5,ene6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - sum5=0.0d0 - sum6=0.0d0 - eloc1=0.0d0 - eloc6=0.0d0 - eloc61=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - do ilam6=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - lambda6=ilam6*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - endif - eloc3=elocal(ity3,lambda2,lambda6,.false.) - sum1=sum1+pom*eloc1*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda6,.false.) - eloc61=elocal(ity6,lambda4,lambda5,.false.) - endif - sum2=sum2+pom*eloc4*eloc6 - eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc1*eloc41 - sum4=sum4+pom*eloc1*eloc6 - sum5=sum5+pom*eloc3*eloc4 - sum6=sum6+pom*eloc3*eloc61 - enddo - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**6*delta**6 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom - ene5=sum5*pom - ene6=sum6*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2 -cd write(2,*) ity1,ity2 -cd write(2,*) 'a1=',a1 -cd write(2,*) si1, - - sum1=0.0d0 - eloc1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - ele1=ele(lambda1,si1*lambda3,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - if (si1.gt.0) then - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - else - eloc2=elocal(ity2,lambda2,lambda3,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2 - enddo - enddo - enddo - pom=1.0d0/(2*pi)**3*delta**3 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1, - & ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3 -cd write(2,*) ity1,ity2,ity3 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'si1=',si1 - sum1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - ele1=ele(lambda1,si1*lambda4,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - if (si1.gt.0) then - eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.) - else - eloc3=elocal(ity3,lambda3,lambda4,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2*eloc3 - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**4*delta**4 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - double precision function elocal(i,x,y,transp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TORSION' - integer i - double precision x,y,u(2),v(2),cu(2),dv(2),ev(2) - double precision scalar2 - logical transp - u(1)=dcos(x) - u(2)=dsin(x) - v(1)=dcos(y) - v(2)=dsin(y) - if (transp) then - call matvec2(cc(1,1,i),v,cu) - call matvec2(dd(1,1,i),u,dv) - call matvec2(ee(1,1,i),u,ev) - elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+ - & scalar2(dv,u)+scalar2(ev,v) - else - call matvec2(cc(1,1,i),u,cu) - call matvec2(dd(1,1,i),v,dv) - call matvec2(ee(1,1,i),v,ev) - elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+ - & scalar2(dv,v)+scalar2(ev,u) - endif - return - end -c------------------------------------------------------------------------- - double precision function ele(x,y,a) - implicit none - double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2) - double precision scalar2 - u(1)=-cos(x) - u(2)= sin(x) - v(1)=-cos(y) - v(2)= sin(y) - call matvec2(a,v,av) - ele=scalar2(u,av) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/kinetic_lesyng.f b/source/unres/src_MD-NEWSC-NEWC/kinetic_lesyng.f deleted file mode 100644 index 8535f5d..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/kinetic_lesyng.f +++ /dev/null @@ -1,104 +0,0 @@ - subroutine kinetic(KE_total) -c---------------------------------------------------------------- -c This subroutine calculates the total kinetic energy of the chain -c----------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - double precision KE_total - - integer i,j,k - double precision KEt_p,KEt_sc,KEr_p,KEr_sc,incr(3), - & mag1,mag2,v(3) - - KEt_p=0.0d0 - KEt_sc=0.0d0 -c write (iout,*) "ISC",(isc(itype(i)),i=1,nres) -c The translational part for peptide virtual bonds - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 -c write (iout,*) "Kinetic trp:",i,(incr(j),j=1,3) - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - vtot(i)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - KEt_p=KEt_p+(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c write(iout,*) 'KEt_p', KEt_p -c The translational part for the side chain virtual bond -c Only now we can initialize incr with zeros. It must be equal -c to the velocities of the first Calpha. - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - if (itype(i).eq.10) then - do j=1,3 - v(j)=incr(j) - enddo - else - do j=1,3 - v(j)=incr(j)+d_t(j,nres+i) - enddo - endif -c write (iout,*) "Kinetic trsc:",i,(incr(j),j=1,3) -c write (iout,*) "i",i," msc",msc(iti)," v",(v(j),j=1,3) - KEt_sc=KEt_sc+msc(iti)*(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - vtot(i+nres)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c goto 111 -c write(iout,*) 'KEt_sc', KEt_sc -c The part due to stretching and rotation of the peptide groups - KEr_p=0.0D0 - do i=nnt,nct-1 -c write (iout,*) "i",i -c write (iout,*) "i",i," mag1",mag1," mag2",mag2 - do j=1,3 - incr(j)=d_t(j,i) - enddo -c write (iout,*) "Kinetic rotp:",i,(incr(j),j=1,3) - KEr_p=KEr_p+(incr(1)*incr(1)+incr(2)*incr(2) - & +incr(3)*incr(3)) - enddo -c goto 111 -c write(iout,*) 'KEr_p', KEr_p -c The rotational part of the side chain virtual bond - KEr_sc=0.0D0 - do i=nnt,nct - iti=itype(i) - if (itype(i).ne.10) then - do j=1,3 - incr(j)=d_t(j,nres+i) - enddo -c write (iout,*) "Kinetic rotsc:",i,(incr(j),j=1,3) - KEr_sc=KEr_sc+Isc(iti)*(incr(1)*incr(1)+incr(2)*incr(2)+ - & incr(3)*incr(3)) - endif - enddo -c The total kinetic energy - 111 continue -c write(iout,*) 'KEr_sc', KEr_sc - KE_total=0.5d0*(mp*KEt_p+KEt_sc+0.25d0*Ip*KEr_p+KEr_sc) -c write (iout,*) "KE_total",KE_total - return - end - - - - diff --git a/source/unres/src_MD-NEWSC-NEWC/lagrangian_lesyng.F b/source/unres/src_MD-NEWSC-NEWC/lagrangian_lesyng.F deleted file mode 100644 index 8a9163a..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/lagrangian_lesyng.F +++ /dev/null @@ -1,726 +0,0 @@ - subroutine lagrangian -c------------------------------------------------------------------------- -c This subroutine contains the total lagrangain from which the accelerations -c are obtained. For numerical gradient checking, the derivetive of the -c lagrangian in the velocities and coordinates are calculated seperately -c------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MUCA' - include 'COMMON.TIME1' - - integer i,j,ind - double precision zapas(MAXRES6),muca_factor - logical lprn /.false./ - common /cipiszcze/ itime - -#ifdef TIMING - time00=MPI_Wtime() -#endif - do j=1,3 - zapas(j)=-gcart(j,0) - enddo - ind=3 - if (lprn) then - write (iout,*) "Potential forces backbone" - endif - do i=nnt,nct-1 - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gcart(j,i) - enddo - enddo - if (lprn) write (iout,*) "Potential forces sidechain" - do i=nnt,nct - if (itype(i).ne.10) then - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gxcart(j,i) - enddo - endif - enddo - - call ginv_mult(zapas,d_a_work) - - do j=1,3 - d_a(j,0)=d_a_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_a(j,i)=d_a_work(ind) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_a(j,i+nres)=d_a_work(ind) - enddo - endif - enddo - - if(lmuca) then - imtime=imtime+1 - if(mucadyn.gt.0) call muca_update(potE) - factor=muca_factor(potE)*t_bath*Rb - -cd print *,'lmuca ',factor,potE - do j=1,3 - d_a(j,0)=d_a(j,0)*factor - enddo - do i=nnt,nct-1 - do j=1,3 - d_a(j,i)=d_a(j,i)*factor - enddo - enddo - do i=nnt,nct - do j=1,3 - d_a(j,i+nres)=d_a(j,i+nres)*factor - enddo - enddo - - endif - - if (lprn) then - write(iout,*) 'acceleration 3D' - write (iout,'(i3,3f10.5,3x,3f10.5)') 0,(d_a(j,0),j=1,3) - do i=nnt,nct-1 - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3) - enddo - do i=nnt,nct - write (iout,'(i3,3f10.5,3x,3f10.5)') - & i+nres,(d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef TIMING - time_lagrangian=time_lagrangian+MPI_Wtime()-time00 -#endif - return - end -c------------------------------------------------------------------ - subroutine setup_MD_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer i,j - logical lprn /.false./ - logical osob - double precision dtdi,massvec(maxres2),Gcopy(maxres2,maxres2), - & Ghalf(mmaxres2),sqreig(maxres2), invsqreig(maxres2), Gcopytmp, - & Gsqrptmp, Gsqrmtmp, Gvec2tmp,Gvectmp(maxres2,maxres2) - double precision work(8*maxres6) - integer iwork(maxres6) - common /przechowalnia/ Gcopy,Ghalf,invsqreig,Gvectmp -c -c Set up the matrix of the (dC,dX)-->(C,X) transformation (A), the -c inertia matrix (Gmat) and the inverse of the inertia matrix (Ginv) -c -c Determine the number of degrees of freedom (dimen) and the number of -c sites (dimen1) - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() - call MPI_Bcast(5,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - write (iout,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' igmult_start',igmult_start, - & ' igmult_end',igmult_end,' count',my_ng_count - write (iout,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) - write (iout,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - call flush(iout) - else -#endif - igmult_start=1 - igmult_end=dimen - my_ng_count=dimen -#ifdef MPI - endif -#endif -c write (iout,*) "dimen",dimen," dimen1",dimen1," dimen3",dimen3 -c Zeroing out A and fricmat - do i=1,dimen - do j=1,dimen - A(i,j)=0.0D0 - enddo - enddo -c Diagonal elements of the dC part of A and the respective friction coefficients - ind=1 - ind1=0 - do i=nnt,nct-1 - ind=ind+1 - ind1=ind1+1 - coeff=0.25d0*IP - massvec(ind1)=mp - Gmat(ind,ind)=coeff - A(ind1,ind)=0.5d0 - enddo - -c Off-diagonal elements of the dC part of A - k=3 - do i=1,nct-nnt - do j=1,i - A(i,j)=1.0d0 - enddo - enddo -c Diagonal elements of the dX part of A and the respective friction coefficients - m=nct-nnt - m1=nct-nnt+1 - ind=0 - ind1=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - massvec(ii)=msc(iti) - if (iti.ne.10) then - ind1=ind1+1 - ii1= ind1+m1 - A(ii,ii1)=1.0d0 - Gmat(ii1,ii1)=ISC(iti) - endif - enddo -c Off-diagonal elements of the dX part of A - ind=0 - k=nct-nnt - do i=nnt,nct - iti=itype(i) - ind=ind+1 - do j=nnt,i - ii = ind - jj = j-nnt+1 - A(k+ii,jj)=1.0d0 - enddo - enddo - if (lprn) then - write (iout,*) - write (iout,*) "Vector massvec" - do i=1,dimen1 - write (iout,*) i,massvec(i) - enddo - write (iout,'(//a)') "A" - call matout(dimen,dimen1,maxres2,maxres2,A) - endif - -c Calculate the G matrix (store in Gmat) - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*massvec(j) - enddo - Gmat(k,i)=Gmat(k,i)+dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Gmat" - call matout(dimen,dimen,maxres2,maxres2,Gmat) - endif - do i=1,dimen - do j=1,dimen - Ginv(i,j)=0.0d0 - Gcopy(i,j)=Gmat(i,j) - enddo - Ginv(i,i)=1.0d0 - enddo -c Invert the G matrix - call MATINVERT(dimen,maxres2,Gcopy,Ginv,osob) - if (lprn) then - write (iout,'(//a)') "Ginv" - call matout(dimen,dimen,maxres2,maxres2,Ginv) - endif -#ifdef MPI - if (nfgtasks.gt.1) then - myginv_ng_count=maxres2*my_ng_count - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) - if (lprn .and. (me.eq.king .or. .not. out1file) ) then - write (iout,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) - write (iout,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) - call flush(iout) - endif -c call MPI_Scatterv(ginv(1,1),nginv_counts(0), -c & nginv_start(0),MPI_DOUBLE_PRECISION,ginv, -c & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c call MPI_Barrier(FG_COMM,IERR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (iout,*) "Master's chunk of ginv" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,ginv) - endif -#endif - if (osob) then - write (iout,*) "The G matrix is singular." - stop - endif -c Compute G**(-1/2) and G**(1/2) - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Gmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,Geigen,Gvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//a)') - & "Eigenvectors and eigenvalues of the G matrix" - call eigout(dimen,dimen,maxres2,maxres2,Gvec,Geigen) - endif - - do i=1,dimen - sqreig(i)=dsqrt(Geigen(i)) - invsqreig(i)=1.d0/sqreig(i) - enddo - do i=1,dimen - do j=1,dimen - Gvectmp(i,j)=Gvec(j,i) - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gsqrptmp=0.0d0 - Gsqrmtmp=0.0d0 - Gcopytmp=0.0d0 - do k=1,dimen -c Gvec2tmp=Gvec(i,k)*Gvec(j,k) - Gvec2tmp=Gvec(k,i)*Gvec(k,j) - Gsqrptmp=Gsqrptmp+Gvec2tmp*sqreig(k) - Gsqrmtmp=Gsqrmtmp+Gvec2tmp*invsqreig(k) - Gcopytmp=Gcopytmp+Gvec2tmp*Geigen(k) - enddo - Gsqrp(i,j)=Gsqrptmp - Gsqrm(i,j)=Gsqrmtmp - Gcopy(i,j)=Gcopytmp - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gvec(i,j)=Gvectmp(j,i) - enddo - enddo - - if (lprn) then - write (iout,*) "Comparison of original and restored G" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,5f10.5)') i,j,Gmat(i,j),Gcopy(i,j), - & Gmat(i,j)-Gcopy(i,j),Gsqrp(i,j),Gsqrm(i,j) - enddo - enddo - endif - return - end -c------------------------------------------------------------------------------- - SUBROUTINE EIGOUT(NC,NR,LM2,LM3,A,B) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3),B(LM2) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,601) (B(I),I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (// 9H ROOT NO.,I4,9I11) - 601 FORMAT (/5X,10(1PE11.4)) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.5) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (//5x,9I11) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.3) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT1(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=21 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+21 - GO TO 1 - 600 FORMAT (//5x,7(3I5,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,7(3F5.1,2x)) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT2(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=12 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+12 - GO TO 1 - 600 FORMAT (//5x,4(3I9,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,4(3F9.3,2x)) - 604 FORMAT (1H1) - END -c--------------------------------------------------------------------------- - SUBROUTINE ginv_mult(z,d_a_tmp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierr -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.MD' - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(4,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in GINV_MULT" - endif -c write (2,*) "time00",time00 -c write (2,*) "Before Scatterv" -c call flush(2) -c write (2,*) "Whole z (for FG master)" -c do i=1,dimen -c write (2,*) i,z(i) -c enddo -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo -c write (2,*) "After SCATTERV" -c call flush(2) -c write (2,*) "MPI_Wtime",MPI_Wtime() - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_ginvmult=time_scatter_ginvmult+MPI_Wtime()-time00 -#endif -c write (2,*) "time_scatter",time_scatter -c write (2,*) "dimen",dimen," dimen3",dimen3," my_ng_count", -c & my_ng_count -c call flush(2) - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1, -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) -c temp(ind)=temp(ind)+Ginv(i,j)*z((j-1)*3+k+1) - temp(ind)=temp(ind)+Ginv(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c call flush(2) -c write (2,*) "z before reduce" -c do i=1,dimen -c write (2,*) i,temp(i) -c enddo - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1 -c call flush(2) -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) - d_a_tmp(ind)=d_a_tmp(ind) - & +Ginv(j,i)*z((j-1)*3+k+1) -c d_a_tmp(ind)=d_a_tmp(ind) -c & +Ginv(i,j)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif - return - end -c--------------------------------------------------------------------------- -#ifdef GINV_MULT - SUBROUTINE ginv_mult_test(z,d_a_tmp) - include 'DIMENSIONS' - integer dimen -c include 'COMMON.MD' - double precision z(dimen),d_a_tmp(dimen) - double precision ztmp(dimen/3),dtmp(dimen/3) - -c do i=1,dimen -c d_a_tmp(i)=0.0d0 -c do j=1,dimen -c d_a_tmp(i)=d_a_tmp(i)+Ginv(i,j)*z(j) -c enddo -c enddo -c -c return - -!ibm* unroll(3) - do k=0,2 - do j=1,dimen/3 - ztmp(j)=z((j-1)*3+k+1) - enddo - - call alignx(16,ztmp(1)) - call alignx(16,dtmp(1)) - call alignx(16,Ginv(1,1)) - - do i=1,dimen/3 - dtmp(i)=0.0d0 - do j=1,dimen/3 - dtmp(i)=dtmp(i)+Ginv(i,j)*ztmp(j) - enddo - enddo - do i=1,dimen/3 - ind=(i-1)*3+k+1 - d_a_tmp(ind)=dtmp(i) - enddo - enddo - return - end -#endif -c--------------------------------------------------------------------------- - SUBROUTINE fricmat_mult(z,d_a_tmp) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR -#endif - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(9,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in FRICMAT_MULT" - endif -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_fmatmult=time_scatter_fmatmult+MPI_Wtime()-time00 -#endif - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count - temp(ind)=temp(ind)-fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c write (2,*) "d_a_tmp before reduce" -c do i=1,dimen3 -c write (2,*) i,temp(i) -c enddo -c call flush(2) - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen - d_a_tmp(ind)=d_a_tmp(ind) - & -fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif -c write (iout,*) "Vector d_a" -c do i=1,dimen3 -c write (2,*) i,d_a_tmp(i) -c enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/local_move.f b/source/unres/src_MD-NEWSC-NEWC/local_move.f deleted file mode 100644 index 7a7e125..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/local_move.f +++ /dev/null @@ -1,972 +0,0 @@ -c------------------------------------------------------------- - - subroutine local_move_init(debug) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' ! Needed by COMMON.LOCAL - include 'COMMON.GEO' ! For pi, deg2rad - include 'COMMON.LOCAL' ! For vbl - include 'COMMON.LOCMOVE' - -c INPUT arguments - logical debug - - -c Determine wheter to do some debugging output - locmove_output=debug - -c Set the init_called flag to 1 - init_called=1 - -c The following are never changed - min_theta=60.D0*deg2rad ! (0,PI) - max_theta=175.D0*deg2rad ! (0,PI) - dmin2=vbl*vbl*2.*(1.-cos(min_theta)) - dmax2=vbl*vbl*2.*(1.-cos(max_theta)) - flag=1.0D300 - small=1.0D-5 - small2=0.5*small*small - -c Not really necessary... - a_n=0 - b_n=0 - res_n=0 - - return - end - -c------------------------------------------------------------- - - subroutine local_move(n_start, n_end, PHImin, PHImax) -c Perform a local move between residues m and n (inclusive) -c PHImin and PHImax [0,PI] determine the size of the move -c Works on whatever structure is in the variables theta and phi, -c sidechain variables are left untouched -c The final structure is NOT minimized, but both the cartesian -c variables c and the angles are up-to-date at the end (no further -c chainbuild is required) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MINIM' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - double precision ran_number - external ran_number - -c INPUT arguments - integer n_start, n_end ! First and last residues to move - double precision PHImin, PHImax ! min/max angles [0,PI] - -c Local variables - integer i,j - double precision min,max - integer iretcode - - -c Check if local_move_init was called. This assumes that it -c would not be 1 if not explicitely initialized - if (init_called.ne.1) then - write(6,*)' *** local_move_init not called!!!' - stop - endif - -c Quick check for crazy range - if (n_start.gt.n_end .or. n_start.lt.1 .or. n_end.gt.nres) then - write(6,'(a,i3,a,i3)') - + ' *** Cannot make local move between n_start = ', - + n_start,' and n_end = ',n_end - return - endif - -c Take care of end residues first... - if (n_start.eq.1) then -c Move residue 1 (completely random) - theta(3)=ran_number(min_theta,max_theta) - phi(4)=ran_number(-PI,PI) - i=2 - else - i=n_start - endif - if (n_end.eq.nres) then -c Move residue nres (completely random) - theta(nres)=ran_number(min_theta,max_theta) - phi(nres)=ran_number(-PI,PI) - j=nres-1 - else - j=n_end - endif - -c ...then go through all other residues one by one -c Start from the two extremes and converge - call chainbuild - do while (i.le.j) - min=PHImin - max=PHImax -c$$$c Move the first two residues by less than the others -c$$$ if (i-n_start.lt.3) then -c$$$ if (i-n_start.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (i-n_start.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (i-n_start.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue i - iretcode=move_res(min,max,i) ! Discard iretcode - i=i+1 - - if (i.le.j) then - min=PHImin - max=PHImax -c$$$c Move the last two residues by less than the others -c$$$ if (n_end-j.lt.3) then -c$$$ if (n_end-j.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (n_end-j.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (n_end-j.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue j - iretcode=move_res(min,max,j) ! Discard iretcode - j=j-1 - endif - enddo - - call int_from_cart(.false.,.false.) - - return - end - -c------------------------------------------------------------- - - subroutine output_tabs -c Prints out the contents of a_..., b_..., res_... - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Local variables - integer i,j - - - write(6,*)'a_...' - write(6,'(8f7.1)')(a_ang(i)*rad2deg,i=0,a_n-1) - write(6,'(8(2x,3l1,2x))')((a_tab(i,j),i=0,2),j=0,a_n-1) - - write(6,*)'b_...' - write(6,'(4f7.1)')(b_ang(i)*rad2deg,i=0,b_n-1) - write(6,'(4(2x,3l1,2x))')((b_tab(i,j),i=0,2),j=0,b_n-1) - - write(6,*)'res_...' - write(6,'(12f7.1)')(res_ang(i)*rad2deg,i=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(0,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(1,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(2,i,j),i=0,2),j=0,res_n-1) - - return - end - -c------------------------------------------------------------- - - subroutine angles2tab(PHImin,PHImax,n,ang,tab) -c Only uses angles if [0,PI] (but PHImin cannot be 0., -c and PHImax cannot be PI) - implicit none - -c Includes - include 'COMMON.GEO' - -c INPUT arguments - double precision PHImin,PHImax - -c OUTPUT arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - - - if (PHImin .eq. PHImax) then -c Special case with two 010's - n = 2; - ang(0) = -PHImin; - ang(1) = PHImin; - tab(0,0) = .false. - tab(2,0) = .false. - tab(0,1) = .false. - tab(2,1) = .false. - tab(1,0) = .true. - tab(1,1) = .true. - else if (PHImin .eq. PI) then -c Special case with one 010 - n = 1 - ang(0) = PI - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else if (PHImax .eq. 0.) then -c Special case with one 010 - n = 1 - ang(0) = 0. - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else -c Standard cases - n = 0 - if (PHImin .gt. 0.) then -c Start of range (011) - ang(n) = PHImin - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = -PHImin - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - if (PHImax .lt. PI) then -c Start of range (011) - ang(n) = -PHImax - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = PHImax - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine minmax_angles(x,y,z,r,n,ang,tab) -c When solutions do not exist, assume all angles -c are acceptable - i.e., initial geometry must be correct - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Input arguments - double precision x,y,z,r - -c Output arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - -c Local variables - double precision num, denom, phi - double precision Kmin, Kmax - integer i - - - num = x*x + y*y + z*z - denom = x*x + y*y - n = 0 - if (denom .gt. 0.) then - phi = atan2(y,x) - denom = 2.*r*sqrt(denom) - num = num+r*r - Kmin = (num - dmin2)/denom - Kmax = (num - dmax2)/denom - -c Allowed values of K (else all angles are acceptable) -c -1 <= Kmin < 1 -c -1 < Kmax <= 1 - if (Kmin .gt. 1. .or. abs(Kmin-1.) .lt. small2) then - Kmin = -flag - else if (Kmin .lt. -1. .or. abs(Kmin+1.) .lt. small2) then - Kmin = PI - else - Kmin = acos(Kmin) - endif - - if (Kmax .lt. -1. .or. abs(Kmax+1.) .lt. small2) then - Kmax = flag - else if (Kmax .gt. 1. .or. abs(Kmax-1.) .lt. small2) then - Kmax = 0. - else - Kmax = acos(Kmax) - endif - - if (Kmax .lt. Kmin) Kmax = Kmin - - call angles2tab(Kmin, Kmax, n, ang, tab) - -c Add phi and check that angles are within range (-PI,PI] - do i=0,n-1 - ang(i) = ang(i)+phi - if (ang(i) .le. -PI) then - ang(i) = ang(i)+2.*PI - else if (ang(i) .gt. PI) then - ang(i) = ang(i)-2.*PI - endif - enddo - endif - - return - end - -c------------------------------------------------------------- - - subroutine construct_tab -c Take a_... and b_... values and produces the results res_... -c x_ang are assumed to be all different (diff > small) -c x_tab(1,i) must be 1 for all i (i.e., all x_ang are acceptable) - implicit none - -c Includes - include 'COMMON.LOCMOVE' - -c Local variables - integer n_max,i,j,index - logical done - double precision phi - - - n_max = a_n + b_n - if (n_max .eq. 0) then - res_n = 0 - return - endif - - do i=0,n_max-1 - do j=0,1 - res_tab(j,0,i) = .true. - res_tab(j,2,i) = .true. - res_tab(j,1,i) = .false. - enddo - enddo - - index = 0 - phi = -flag - done = .false. - do while (.not.done) - res_ang(index) = flag - -c Check a first... - do i=0,a_n-1 - if ((a_ang(i)-phi).gt.small .and. - + a_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = a_ang(i) -c Copy the values from a_tab into res_tab(0,,) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) -c Set default values for res_tab(1,,) - res_tab(1,0,index) = .true. - res_tab(1,1,index) = .false. - res_tab(1,2,index) = .true. - else if (abs(a_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to a b_ang) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) - endif - enddo -c ...then check b - do i=0,b_n-1 - if ((b_ang(i)-phi).gt.small .and. - + b_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = b_ang(i) -c Copy the values from b_tab into res_tab(1,,) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) -c Set default values for res_tab(0,,) - res_tab(0,0,index) = .true. - res_tab(0,1,index) = .false. - res_tab(0,2,index) = .true. - else if (abs(b_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to an a_ang) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) - endif - enddo - - if (res_ang(index) .eq. flag) then - res_n = index - done = .true. - else if (index .eq. n_max-1) then - res_n = n_max - done = .true. - else - phi = res_ang(index) ! Store previous angle - index = index+1 - endif - enddo - -c Fill the gaps -c First a... - index = 0 - if (a_n .gt. 0) then - do while (.not.res_tab(0,1,index)) - index=index+1 - enddo - done = res_tab(0,2,index) - do i=index+1,res_n-1 - if (res_tab(0,1,i)) then - done = res_tab(0,2,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - done = res_tab(0,0,index) - do i=index-1,0,-1 - if (res_tab(0,1,i)) then - done = res_tab(0,0,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(0,0,i) = .true. - res_tab(0,1,i) = .true. - res_tab(0,2,i) = .true. - enddo - endif -c ...then b - index = 0 - if (b_n .gt. 0) then - do while (.not.res_tab(1,1,index)) - index=index+1 - enddo - done = res_tab(1,2,index) - do i=index+1,res_n-1 - if (res_tab(1,1,i)) then - done = res_tab(1,2,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - done = res_tab(1,0,index) - do i=index-1,0,-1 - if (res_tab(1,1,i)) then - done = res_tab(1,0,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(1,0,i) = .true. - res_tab(1,1,i) = .true. - res_tab(1,2,i) = .true. - enddo - endif - -c Finally fill the last row with AND operation - do i=0,res_n-1 - do j=0,2 - res_tab(2,j,i) = (res_tab(0,j,i) .and. res_tab(1,j,i)) - enddo - enddo - - return - end - -c------------------------------------------------------------- - - subroutine construct_ranges(phi_n,phi_start,phi_end) -c Given the data in res_..., construct a table of -c min/max allowed angles - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - -c Local variables - logical done - integer index - - - if (res_n .eq. 0) then -c Any move is allowed - phi_n = 1 - phi_start(0) = -PI - phi_end(0) = PI - else - phi_n = 0 - index = 0 - done = .false. - do while (.not.done) -c Find start of range (01x) - done = .false. - do while (.not.done) - if (res_tab(2,0,index).or.(.not.res_tab(2,1,index))) then - index=index+1 - else - done = .true. - phi_start(phi_n) = res_ang(index) - endif - if (index .eq. res_n) done = .true. - enddo -c If a start was found (index < res_n), find the end of range (x10) -c It may not be found without wrapping around - if (index .lt. res_n) then - done = .false. - do while (.not.done) - if ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) then - index=index+1 - else - done = .true. - endif - if (index .eq. res_n) done = .true. - enddo - if (index .lt. res_n) then -c Found the end of the range - phi_end(phi_n) = res_ang(index) - phi_n=phi_n+1 - index=index+1 - if (index .eq. res_n) then - done = .true. - else - done = .false. - endif - else -c Need to wrap around - done = .true. - phi_end(phi_n) = flag - endif - endif - enddo -c Take care of the last one if need to wrap around - if (phi_end(phi_n) .eq. flag) then - index = 0 - do while ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) - index=index+1 - enddo - phi_end(phi_n) = res_ang(index) + 2.*PI - phi_n=phi_n+1 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine fix_no_moves(phi) - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - double precision phi - -c Local variables - integer index - double precision diff,temp - - -c Look for first 01x in gammas (there MUST be at least one) - diff = flag - index = 0 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index+1 - enddo - if (res_ang(index) .le. 0.D0) then ! Make sure it's from PHImax -c Try to increase PHImax - if (index .gt. 0) then - phi = res_ang(index-1) - diff = abs(res_ang(index) - res_ang(index-1)) - endif -c Look for last (corresponding) x10 - index = res_n - 1 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index-1 - enddo - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif - endif - -c If increasing PHImax didn't work, decreasing PHImin -c will (with one exception) -c Look for first x10 (there MUST be at least one) - index = 0 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index+1 - enddo - if (res_ang(index) .lt. 0.D0) then ! Make sure it's from PHImin -c Try to decrease PHImin - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (res_ang(index+1) .le. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif -c Look for last (corresponding) 01x - index = res_n - 1 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index-1 - enddo - if (index .gt. 0) then - temp = abs(res_ang(index) - res_ang(index-1)) - if (res_ang(index-1) .ge. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index-1) - diff = temp - endif - endif - endif - -c If it still didn't work, it must be PHImax == 0. or PHImin == PI - if (diff .eq. flag) then - index = 0 - if (res_tab(index,1,0) .or. (.not.res_tab(index,1,1)) .or. - + res_tab(index,1,2)) index = res_n - 1 -c This MUST work at this point - if (index .eq. 0) then - phi = res_ang(1) - else - phi = res_ang(index - 1) - endif - endif - - return - end - -c------------------------------------------------------------- - - integer function move_res(PHImin,PHImax,i_move) -c Moves residue i_move (in array c), leaving everything else fixed -c Starting geometry is not checked, it should be correct! -c R(,i_move) is the only residue that will move, but must have -c 1 < i_move < nres (i.e., cannot move ends) -c Whether any output is done is controlled by locmove_output -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c External functions - double precision ran_number - external ran_number - -c Input arguments - double precision PHImin,PHImax - integer i_move - -c RETURN VALUES: -c 0: move successfull -c 1: Dmin or Dmax had to be modified -c 2: move failed - check your input geometry - - -c Local variables - double precision X(0:2),Y(0:2),Z(0:2),Orig(0:2) - double precision P(0:2) - logical no_moves,done - integer index,i,j - double precision phi,temp,radius - double precision phi_start(0:11), phi_end(0:11) - integer phi_n - -c Set up the coordinate system - do i=0,2 - Orig(i)=0.5*(c(i+1,i_move-1)+c(i+1,i_move+1)) ! Position of origin - enddo - - do i=0,2 - Z(i)=c(i+1,i_move+1)-c(i+1,i_move-1) - enddo - temp=sqrt(Z(0)*Z(0)+Z(1)*Z(1)+Z(2)*Z(2)) - do i=0,2 - Z(i)=Z(i)/temp - enddo - - do i=0,2 - X(i)=c(i+1,i_move)-Orig(i) - enddo -c radius is the radius of the circle on which c(,i_move) can move - radius=sqrt(X(0)*X(0)+X(1)*X(1)+X(2)*X(2)) - do i=0,2 - X(i)=X(i)/radius - enddo - - Y(0)=Z(1)*X(2)-X(1)*Z(2) - Y(1)=X(0)*Z(2)-Z(0)*X(2) - Y(2)=Z(0)*X(1)-X(0)*Z(1) - -c Calculate min, max angles coming from dmin, dmax to c(,i_move-2) - if (i_move.gt.2) then - do i=0,2 - P(i)=c(i+1,i_move-2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,a_n,a_ang,a_tab) - else - a_n=0 - endif - -c Calculate min, max angles coming from dmin, dmax to c(,i_move+2) - if (i_move.lt.nres-2) then - do i=0,2 - P(i)=c(i+1,i_move+2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,b_n,b_ang,b_tab) - else - b_n=0 - endif - -c Construct the resulting table for alpha and beta - call construct_tab() - - if (locmove_output) then - print *,'ALPHAS & BETAS TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - if (no_moves) then - if (locmove_output) print *,' *** Cannot move anywhere' - move_res=2 - return - endif - -c Transfer res_... into a_... - a_n = 0 - do i=0,res_n-1 - if ( (res_tab(2,0,i).neqv.res_tab(2,1,i)) .or. - + (res_tab(2,0,i).neqv.res_tab(2,2,i)) ) then - a_ang(a_n) = res_ang(i) - do j=0,2 - a_tab(j,a_n) = res_tab(2,j,i) - enddo - a_n=a_n+1 - endif - enddo - -c Check that the PHI's are within [0,PI] - if (PHImin .lt. 0. .or. abs(PHImin) .lt. small) PHImin = -flag - if (PHImin .gt. PI .or. abs(PHImin-PI) .lt. small) PHImin = PI - if (PHImax .gt. PI .or. abs(PHImax-PI) .lt. small) PHImax = flag - if (PHImax .lt. 0. .or. abs(PHImax) .lt. small) PHImax = 0. - if (PHImax .lt. PHImin) PHImax = PHImin -c Calculate min and max angles coming from PHImin and PHImax, -c and put them in b_... - call angles2tab(PHImin, PHImax, b_n, b_ang, b_tab) -c Construct the final table - call construct_tab() - - if (locmove_output) then - print *,'FINAL TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - - if (no_moves) then -c Take care of the case where no solution exists... - call fix_no_moves(phi) - if (locmove_output) then - print *,' *** Had to modify PHImin or PHImax' - print *,'phi: ',phi*rad2deg - endif - move_res=1 - else -c ...or calculate the solution -c Construct phi_start/phi_end arrays - call construct_ranges(phi_n, phi_start, phi_end) -c Choose random angle phi in allowed range(s) - temp = 0. - do i=0,phi_n-1 - temp = temp + phi_end(i) - phi_start(i) - enddo - phi = ran_number(phi_start(0),phi_start(0)+temp) - index = 0 - done = .false. - do while (.not.done) - if (phi .lt. phi_end(index)) then - done = .true. - else - index=index+1 - endif - if (index .eq. phi_n) then - done = .true. - else if (.not.done) then - phi = phi + phi_start(index) - phi_end(index-1) - endif - enddo - if (index.eq.phi_n) phi=phi_end(phi_n-1) ! Fix numerical errors - if (phi .gt. PI) phi = phi-2.*PI - - if (locmove_output) then - print *,'ALLOWED RANGE(S)' - do i=0,phi_n-1 - print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg - enddo - print *,'phi: ',phi*rad2deg - endif - move_res=0 - endif - -c Re-use radius as temp variable - temp=radius*cos(phi) - radius=radius*sin(phi) - do i=0,2 - c(i+1,i_move)=Orig(i)+temp*X(i)+radius*Y(i) - enddo - - return - end - -c------------------------------------------------------------- - - subroutine loc_test -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - -c Local variables - integer i,j - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - double precision phi - double precision R(0:2,0:5) - - locmove_output=.true. - -c call angles2tab(30.*deg2rad,70.*deg2rad,a_n,a_ang,a_tab) -c call angles2tab(80.*deg2rad,130.*deg2rad,b_n,b_ang,b_tab) -c call minmax_angles(0.D0,3.8D0,0.D0,3.8D0,b_n,b_ang,b_tab) -c call construct_tab -c call output_tabs - -c call construct_ranges(phi_n,phi_start,phi_end) -c do i=0,phi_n-1 -c print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg -c enddo - -c call fix_no_moves(phi) -c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg - - R(0,0)=0.D0 - R(1,0)=0.D0 - R(2,0)=0.D0 - R(0,1)=0.D0 - R(1,1)=-cos(28.D0*deg2rad) - R(2,1)=-0.5D0-sin(28.D0*deg2rad) - R(0,2)=0.D0 - R(1,2)=0.D0 - R(2,2)=-0.5D0 - R(0,3)=cos(30.D0*deg2rad) - R(1,3)=0.D0 - R(2,3)=0.D0 - R(0,4)=0.D0 - R(1,4)=0.D0 - R(2,4)=0.5D0 - R(0,5)=0.D0 - R(1,5)=cos(26.D0*deg2rad) - R(2,5)=0.5D0+sin(26.D0*deg2rad) - do i=1,5 - do j=0,2 - R(j,i)=vbl*R(j,i) - enddo - enddo -c i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) - imov=nnt - i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov) - print *,'RETURNED ',i - print *,(R(i,3)/vbl,i=0,2) - - return - end - -c------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/map.f b/source/unres/src_MD-NEWSC-NEWC/map.f deleted file mode 100644 index 9dbe64e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/map.f +++ /dev/null @@ -1,90 +0,0 @@ - subroutine map - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.TORCNSTR' - double precision energia(0:n_ene) - character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/ - double precision ang_list(10) - double precision g(maxvar),x(maxvar) - integer nn(10) - write (iout,'(a,i3,a)')'Energy map constructed in the following ', - & nmap,' groups of variables:' - do i=1,nmap - write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ', - & res1(i),' to ',res2(i) - enddo - nmax=nstep(1) - do i=2,nmap - if (nmax.lt.nstep(i)) nmax=nstep(i) - enddo - ntot=nmax**nmap - iii=0 - write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap), - & (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM" - do i=0,ntot-1 - ii=i - do j=1,nmap - nn(j)=mod(ii,nmax)+1 - ii=ii/nmax - enddo - do j=1,nmap - if (nn(j).gt.nstep(j)) goto 10 - enddo - iii=iii+1 -Cd write (iout,*) i,iii,(nn(j),j=1,nmap) - do j=1,nmap - ang_list(j)=ang_from(j) - & +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j) - do k=res1(j),res2(j) - goto (1,2,3,4), kang(j) - 1 phi(k)=deg2rad*ang_list(j) - if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j) - goto 5 - 2 theta(k)=deg2rad*ang_list(j) - goto 5 - 3 alph(k)=deg2rad*ang_list(j) - goto 5 - 4 omeg(k)=deg2rad*ang_list(j) - 5 continue - enddo ! k - enddo ! j - call chainbuild - call int_from_cart1(.false.) - if (minim) then - call geom_to_var(nvar,x) - call minimize(etot,x,iretcode,nfun) - print *,'SUMSL return code is',iretcode,' eval ',nfun -c call intout - else - call zerograd - call geom_to_var(nvar,x) - endif - call etotal(energia(0)) - etot = energia(0) - nf=1 - nfl=3 - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - gnorm=0.0d0 - do k=1,nvar - gnorm=gnorm+g(k)**2 - enddo - etot=energia(0) - - gnorm=dsqrt(gnorm) -c write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm - write (istat,'(30e15.5)') (ang_list(k),k=1,nmap), - & (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm -c write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap) -c call intout -c call enerprint(energia) - 10 continue - enddo ! i - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/matmult.f b/source/unres/src_MD-NEWSC-NEWC/matmult.f deleted file mode 100644 index e9257cf..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/matmult.f +++ /dev/null @@ -1,18 +0,0 @@ - SUBROUTINE MATMULT(A1,A2,A3) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(3,3),A2(3,3),A3(3,3) - DIMENSION AI3(3,3) - DO 1 I=1,3 - DO 2 J=1,3 - A3IJ=0.0 - DO 3 K=1,3 - 3 A3IJ=A3IJ+A1(I,K)*A2(K,J) - AI3(I,J)=A3IJ - 2 CONTINUE - 1 CONTINUE - DO 4 I=1,3 - DO 4 J=1,3 - 4 A3(I,J)=AI3(I,J) - RETURN - END diff --git a/source/unres/src_MD-NEWSC-NEWC/mc.F b/source/unres/src_MD-NEWSC-NEWC/mc.F deleted file mode 100644 index 0f39d48..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/mc.F +++ /dev/null @@ -1,819 +0,0 @@ - subroutine monte_carlo -C Does Boltzmann and entropic sampling without energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond,nbins - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,elowest1, - & ehighest,ehighest1,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - integer moves1(-1:MaxMoveType+1,0:MaxProcs-1), - & moves_acc1(-1:MaxMoveType+1,0:MaxProcs-1) -#ifdef MPL - double precision etot_temp,etot_all(0:MaxProcs) - external d_vadd,d_vmin,d_vmax - double precision entropy1(-max_ene:max_ene), - & nhist1(-max_ene:max_ene) - integer nbond_move1(maxres*(MaxProcs+1)), - & nbond_acc1(maxres*(MaxProcs+1)),itemp(2) -#endif - double precision var_lowest(maxvar) - double precision energia(0:n_ene),energia_ave(0:n_ene) -C - write(iout,'(a,i8,2x,a,f10.5)') - & 'pool_read_freq=',pool_read_freq,' pool_fraction=',pool_fraction - open (istat,file=statname) - WhatsUp=0 - indminn=-max_ene - indmaxx=max_ene - facee=1.0D0/(maxacc*delte) -C Number of bins in energy histogram - nbins=e_up/delte-1 - write (iout,*) 'NBINS=',nbins - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool - elowest=1.0D+10 - ehighest=-1.0D+10 -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy; -C set NSWEEP=1 for Boltzmann sampling. -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C -C Initialize the IFINISH array. -C -#ifdef MPL - do i=1,nctasks - ifinish(i)=0 - enddo -#endif -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - nbond_acc(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=-1,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - rewind(istat) - write (iout,*) 'emin=',emin,' emax=',emax - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else if (isweep.gt.1) then - if (eold.lt.emax) then - do i=1,nvar - varia(i)=varold(i) - enddo - else - do i=1,nvar - varia(i)=var_lowest(i) - enddo - endif - call var_to_geom(nvar,varia) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call geom_to_var(nvar,varia) - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - write (istat,'(i10,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - write (istat,'(i10,14(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif -c close(istat) - neneval=neneval+1 - if (.not. ent_read) then -C Initialize the entropy array -#ifdef MPL -C Collect total energies from other processors. - etot_temp=etot - etot_all(0)=etot - call mp_gather(etot_temp,etot_all,8,MasterID,cgGroupID) - if (MyID.eq.MasterID) then -C Get the lowest and the highest energy. - print *,'MASTER: etot_temp: ',(etot_all(i),i=0,nprocs-1), - & ' emin=',emin,' emax=',emax - emin=1.0D10 - emax=-1.0D10 - do i=0,nprocs - if (emin.gt.etot_all(i)) emin=etot_all(i) - if (emax.lt.etot_all(i)) emax=etot_all(i) - enddo - emax=emin+e_up - endif ! MyID.eq.MasterID - etot_all(1)=emin - etot_all(2)=emax - print *,'Processor',MyID,' calls MP_BCAST to send/recv etot_all' - call mp_bcast(etot_all(1),16,MasterID,cgGroupID) - print *,'Processor',MyID,' MP_BCAST to send/recv etot_all ended' - if (MyID.ne.MasterID) then - print *,'Processor:',MyID,etot_all(1),etot_all(2), - & etot_all(1),etot_all(2) - emin=etot_all(1) - emax=etot_all(2) - endif ! MyID.ne.MasterID - write (iout,*) 'After MP_GATHER etot_temp=', - & etot_temp,' emin=',emin -#else - emin=etot - emax=emin+e_up - indminn=0 - indmin=0 -#endif - IF (MULTICAN) THEN -C Multicanonical sampling - start from Boltzmann distribution - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ELSE -C Entropic sampling - start from uniform distribution of the density of states - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - ENDIF ! MULTICAN - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - if (isweep.eq.1) then - emax=emin+e_up - indminn=0 - indmin=0 - indmaxx=indminn+nbins - indmax=indmaxx - endif ! isweep.eq.1 - endif ! .not. ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done=.true. -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - call entropia(eold,sold,indeold) -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -C Main loop. -c---------------------------------------------------------------------------- -C Zero out average energies - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo -C Initialize energy histogram - do i=-max_ene,max_ene - nhist(i)=0.0D0 - enddo ! i -C Zero out iteration counter. - it=0 - do j=1,nvar - varold(j)=varia(j) - enddo -C Begin MC iteration loop. - do while (not_done) - it=it+1 -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to take a conformation from the pool or generate/perturb one -C randomly - from_pool=ran_number(0.0D0,1.0D0) - if (npool.gt.0 .and. from_pool.lt.pool_fraction) then -C Throw a dice to choose the conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - call var_to_geom(nvar,varia) - call chainbuild -cd call intout -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i3,a,f10.5)') - & 'Try conformation',ii,' from the pool energy=',epool(ii) - MoveType=-1 - moves(-1)=moves(-1)+1 - else -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,0.1D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - endif ! pool -Cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+1 -cd call enerprint(energia(0)) -cd write(iout,*)'it=',it,' etot=',etot - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accept_mc(it,etot,eold,scur,sold,varia,varold,accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) then - elowest=etot - do i=1,nvar - var_lowest(i)=varia(i) - enddo - endif - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Compare with reference structure. - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - endif ! refstr -C -C Periodically save average energies and confs. -C - do i=0,n_ene - energia_ave(i)=energia_ave(i)+energia(i) - enddo - moves(MaxMoveType+1)=nmove - moves_acc(MaxMoveType+1)=nacc - IF ((it/save_frequency)*save_frequency.eq.it) THEN - do i=0,n_ene - energia_ave(i)=energia_ave(i)/save_frequency - enddo - etot_ave=energia_ave(0) -C#ifdef AIX -C open (istat,file=statname,position='append') -C#else -C open (istat,file=statname,access='append') -Cendif - if (print_mc.gt.0) - & write (iout,'(80(1h*)/20x,a,i20)') - & 'Iteration #',it - if (refstr .and. print_mc.gt.0) then - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif - if (print_stat) then - if (refstr) then - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave,rms_ave,frac_ave - else - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave - endif - endif -c close(istat) - if (print_mc.gt.0) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo - ENDIF ! ( (it/save_frequency)*save_frequency.eq.it) -C Update histogram - inde=icialosc((etot-emin)/delte) - nhist(inde)=nhist(inde)+1.0D0 -#ifdef MPL - if ( (it/message_frequency)*message_frequency.eq.it - & .and. (MyID.ne.MasterID) ) then - call recv_stop_sig(Kwita) - call send_MCM_info(message_frequency) - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif -C if ((ntrial.gt.maxtrial_iter -C & .or. (it/pool_read_freq)*pool_read_freq.eq.it) -C & .and. npool.gt.0) then -C Take a conformation from the pool -C ii=iran_num(1,npool) -C do i=1,nvar -C varold(i)=xpool(i,ii) -C enddo -C if (ntrial.gt.maxtrial_iter) -C & write (iout,*) 'Iteration',it,' max. # of trials exceeded.' -C write (iout,*) -C & 'Take conformation',ii,' from the pool energy=',epool(ii) -C if (print_mc.gt.2) -C & write (iout,'(10f8.3)') (rad2deg*varold(i),i=1,nvar) -C ntrial=0 -C eold=epool(ii) -C call entropia(eold,sold,indeold) -C accepted=.true. -C endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - if (MyID.ne.MasterID) call send_MCM_info(-1) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) - if (MyID.ne.MasterID) call send_MCM_info(-1) -#endif - 21 continue - write (iout,'(/a)') 'Energy histogram' - do i=-100,100 - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo -#ifdef MPL -C Wait until every processor has sent complete MC info. - if (MyID.eq.MasterID) then - not_done=.true. - do while (not_done) -C write (*,*) 'The IFINISH array:' -C write (*,*) (ifinish(i),i=1,nctasks) - not_done=.false. - do i=2,nctasks - not_done=not_done.or.(ifinish(i).ge.0) - enddo - if (not_done) call receive_MC_info - enddo - endif -C Make collective histogram from the work of all processors. - msglen=(2*max_ene+1)*8 - print *, - & 'Processor',MyID,' calls MP_REDUCE to send/receive histograms', - & ' msglen=',msglen - call mp_reduce(nhist,nhist1,msglen,MasterID,d_vadd, - & cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for histogr.' - do i=-max_ene,max_ene - nhist(i)=nhist1(i) - enddo -C Collect min. and max. energy - print *, - &'Processor',MyID,' calls MP_REDUCE to send/receive energy borders' - call mp_reduce(elowest,elowest1,8,MasterID,d_vmin,cgGroupID) - call mp_reduce(ehighest,ehighest1,8,MasterID,d_vmax,cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for energies.' - IF (MyID.eq.MasterID) THEN - elowest=elowest1 - ehighest=ehighest1 -#endif - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - indmin=icialosc((elowest-emin)/delte) - imdmax=icialosc((ehighest-emin)/delte) - if (indmin.lt.indminn) then - emax=emin+indmin*delte+e_up - indmaxx=indmin+nbins - indminn=indmin - endif - if (.not.ent_read) ent_read=.true. - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - ELSE - if (.not. ent_read) ent_read=.true. - ENDIF ! MyID .eq. MaterID - if (MyID.eq.MasterID) then - itemp(1)=indminn - itemp(2)=indmaxx - endif - print *,'before mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - call mp_bcast(itemp(1),8,MasterID,cgGroupID) - call mp_bcast(emax,8,MasterID,cgGroupID) - print *,'after mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - if (MyID .ne. MasterID) then - indminn=itemp(1) - indmaxx=itemp(2) - endif - msglen=(indmaxx-indminn+1)*8 - print *,'processor',MyID,' calling mp_bcast msglen=',msglen, - & ' indminn=',indminn,' indmaxx=',indmaxx,' isweep=',isweep - call mp_bcast(entropy(indminn),msglen,MasterID,cgGroupID) - IF(MyID.eq.MasterID .and. .not. ovrtim() .and. WhatsUp.ge.0)THEN - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - ELSE - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - ENDIF ! MyID.eq.MasterID - print *,'Processor',MyID,' calls MP_GATHER' - call mp_gather(nbond_move,nbond_move1,4*Nbm,MasterID, - & cgGroupID) - call mp_gather(nbond_acc,nbond_acc1,4*Nbm,MasterID, - & cgGroupID) - print *,'Processor',MyID,' MP_GATHER call accomplished' - if (MyID.eq.MasterID) then - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - - write (iout,'(a)') - & 'Statistics of multi-bond moves of respective processors:' - do iproc=1,Nprocs-1 - do i=1,Nbm - ind=iproc*nbm+i - nbond_move(i)=nbond_move(i)+nbond_move1(ind) - nbond_acc(i)=nbond_acc(i)+nbond_acc1(ind) - enddo - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' nbond_move:', - & (nbond_move1(iproc*nbm+i),i=1,Nbm), - & ' nbond_acc:',(nbond_acc1(iproc*nbm+i),i=1,Nbm) - enddo - endif - call mp_gather(moves,moves1,4*(MaxMoveType+3),MasterID, - & cgGroupID) - call mp_gather(moves_acc,moves_acc1,4*(MaxMoveType+3), - & MasterID,cgGroupID) - if (MyID.eq.MasterID) then - do iproc=1,Nprocs-1 - do i=-1,MaxMoveType+1 - moves(i)=moves(i)+moves1(i,iproc) - moves_acc(i)=moves_acc(i)+moves_acc1(i,iproc) - enddo - enddo - nmove=0 - do i=0,MaxMoveType+1 - nmove=nmove+moves(i) - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' moves', - & (moves1(i,iproc),i=0,MaxMoveType+1), - & ' moves_acc:',(moves_acc1(i,iproc),i=0,MaxMoveType+1) - enddo - endif -#else - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) -#endif - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - if (ovrtim() .or. WhatsUp.lt.0) return - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accept_mc(it,ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - call entropia(ecur,scur,indecur) -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) then - write(iout,*)'it=',it,'ecur=',ecur,' indecur=',indecur, - & ' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected.' - endif - endif - return - end -c-------------------------------------------------------------------------- - integer function icialosc(x) - double precision x - if (x.lt.0.0D0) then - icialosc=dint(x)-1 - else - icialosc=dint(x) - endif - return - end -c-------------------------------------------------------------------------- - subroutine entropia(ecur,scur,indecur) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - double precision ecur,scur - integer indecur - indecur=icialosc((ecur-emin)/delte) - if (iabs(indecur).gt.max_ene) then - if ((it/print_freq)*it.eq.it) write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.ge.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0 .and. (it/print_freq)*it.eq.it) - & write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/mcm.F b/source/unres/src_MD-NEWSC-NEWC/mcm.F deleted file mode 100644 index d9ca9ad..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/mcm.F +++ /dev/null @@ -1,1481 +0,0 @@ - subroutine mcm_setup - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.CONTROL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.VAR' -C -C Set up variables used in MC/MCM. -C - write (iout,'(80(1h*)/20x,a/80(1h*))') 'MCM control parameters:' - write (iout,'(5(a,i7))') 'Maxacc:',maxacc,' MaxTrial:',MaxTrial, - & ' MaxRepm:',MaxRepm,' MaxGen:',MaxGen,' MaxOverlap:',MaxOverlap - write (iout,'(4(a,f8.1)/2(a,i3))') - & 'Tmin:',Tmin,' Tmax:',Tmax,' TstepH:',TstepH, - & ' TstepC:',TstepC,'NstepH:',NstepH,' NstepC:',NstepC - if (nwindow.gt.0) then - write (iout,'(a)') 'Perturbation windows:' - do i=1,nwindow - i1=winstart(i) - i2=winend(i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(a,i3,a,i3,a,i3)') restyp(it1),i1,restyp(it2),i2, - & ' length',winlen(i) - enddo - endif -C Rbolt=8.3143D-3*2.388459D-01 kcal/(mol*K) - RBol=1.9858D-3 -C Number of "end bonds". - koniecl=0 -c koniecl=nphi - print *,'koniecl=',koniecl - write (iout,'(a)') 'Probabilities of move types:' - write (*,'(a)') 'Probabilities of move types:' - do i=1,MaxMoveType - write (iout,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - write (*,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - enddo - write (iout,*) -C Maximum length of N-bond segment to be moved -c nbm=nres-1-(2*koniecl-1) - if (nwindow.gt.0) then - maxwinlen=winlen(1) - do i=2,nwindow - if (winlen(i).gt.maxwinlen) maxwinlen=winlen(i) - enddo - nbm=min0(maxwinlen,6) - write (iout,'(a,i3,a,i3)') 'Nbm=',Nbm,' Maxwinlen=',Maxwinlen - else - nbm=min0(6,nres-2) - endif - sumpro_bond(0)=0.0D0 - sumpro_bond(1)=0.0D0 - do i=2,nbm - sumpro_bond(i)=sumpro_bond(i-1)+1.0D0/dfloat(i) - enddo - write (iout,'(a)') 'The SumPro_Bond array:' - write (iout,'(8f10.5)') (sumpro_bond(i),i=1,nbm) - write (*,'(a)') 'The SumPro_Bond array:' - write (*,'(8f10.5)') (sumpro_bond(i),i=1,nbm) -C Maximum number of side chains moved simultaneously -c print *,'nnt=',nnt,' nct=',nct - ngly=0 - do i=nnt,nct - if (itype(i).eq.10) ngly=ngly+1 - enddo - mmm=nct-nnt-ngly+1 - if (mmm.gt.0) then - MaxSideMove=min0((nct-nnt+1)/2,mmm) - endif -c print *,'MaxSideMove=',MaxSideMove -C Max. number of generated confs (not used at present). - maxgen=10000 -C Set initial temperature - Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - write (iout,'(a,f8.1,a,f10.5)') 'Initial temperature:',Tcur, - & ' BetBol:',betbol - write (iout,*) 'RanFract=',ranfract - return - end -c------------------------------------------------------------------------------ -#ifndef MPI - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - serial code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,my_conf, - & enelower,non_conv - integer MoveType,nbond,conf_comp - integer ifeed(max_cache) - double precision varia(maxvar),varold(maxvar),elowest,eold, - & przes(3),obr(3,3) - double precision energia(0:n_ene) - double precision coord1(maxres,3) - -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 - - write (iout,*) 'RanFract=',RanFract - - WhatsUp=0 - Kwita=0 - -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - - call etotal(energia(0)) - etot = energia(0) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - if (print_stat) write (istat,'(i5,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - if (print_stat) close(istat) - neneval=neneval+nfun+1 - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_int) then - close(igeom) - call briefout(0,etot) - endif - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - - not_done = (iretcode.ne.11) - -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - do while (not_done) - it=it+1 - write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - accepted=.false. - do while (.not. accepted) - -C Retrieve the angles of previously accepted conformation - noverlap=0 ! # of overlapping confs. - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) goto 20 - MoveType=0 - nbond=0 - lprint=.true. -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - - call etotal(energia(0)) - etot=energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - if(iprint.gt.1.or.etot.lt.1d20) - & write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,*) 'etot from MINIMIZE:',etot -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+2 - endif -c call enerprint(energia(0)) - write (iout,'(a,i6,a,1pe16.6)') 'Conformation:',ngen, - & ' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - accepted=.false. - my_conf=.false. - - if (WhatsUp.eq.0 .and. Kwita.eq.0) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & my_conf,EneLower) - endif - write (iout,*) 'My_Conf=',My_Conf,' EneLower=',EneLower - if (accepted) then - - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (print_stat) then -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - endif - call statprint(nacc,nfun,iretcode,etot,elowest) - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - endif ! refstr - if (My_Conf) then - nout=nout+1 - write (iout,*) 'Writing new conformation',nout - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - if (print_stat) close(istat) -C Print internal coordinates. - if (print_int) call briefout(nout,etot) -C Accumulate the newly accepted conf in the coord1 array, if it is different -C from all confs that are already there. - call compare_s1(n_thr,max_thread2,etot,varia,ii, - & enetb1,coord1,rms_deform,.true.,iprint) - write (iout,*) 'After compare_ss: n_thr=',n_thr - if (ii.eq.1 .or. ii.eq.3) then - write (iout,'(8f10.4)') - & (rad2deg*coord1(i,n_thr),i=1,nvar) - endif - else - write (iout,*) 'Conformation from cache, not written.' - endif ! My_Conf - - if (nrepm.gt.maxrepm) then - write (iout,'(a)') 'Too many conformation repetitions.' - goto 20 - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - - else - - ntrial=ntrial+1 - endif ! accepted - endif ! overlap - - 30 continue - enddo ! accepted -C Check for time limit. - if (ovrtim()) WhatsUp=-1 - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) - - enddo ! not_done - goto 21 - 20 WhatsUp=-3 - - 21 continue - runtime=tcpu() - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - - return - end -#endif -#ifdef MPI -c------------------------------------------------------------------------------ - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - parallel code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.INFO' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.MINIM' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,similar, - & enelower,non_conv,flag,finish - integer MoveType,nbond,conf_comp - double precision varia(maxvar),varold(maxvar),elowest,eold, - & x1(maxvar), varold1(maxvar), przes(3),obr(3,3) - integer iparentx(max_threadss2) - integer iparentx1(max_threadss2) - integer imtasks(150),imtasks_n - double precision energia(0:n_ene) - - print *,'Master entered DO_MCM' - nodenum = nprocs - - finish=.false. - imtasks_n=0 - do i=1,nodenum-1 - imtasks(i)=0 - enddo -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won`t be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 -c write (iout,*) 'RanFract=',RanFract - WhatsUp=0 - Kwita=0 -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Request energy computation from slave processors. - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - neneval=0 - eneglobal=1.0d99 - if (print_mc .gt. 0) write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_mc .gt. 0) write (iout,'(i5,1pe14.5)' ) i_orig,etot - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) -c diagnostics - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energia(0)) - if (print_mc.gt.0) write (iout,*) 'Initial energy:',etot -c end diagnostics - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - not_done=.true. -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - LOOP1:do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - LOOP2:do while (.not. accepted) - - LOOP3:do while (imtasks_n.lt.nodenum-1.and..not.finish) - do i=1,nodenum-1 - if(imtasks(i).eq.0) then - is=i - exit - endif - enddo -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) then - finish=.true. - endif - MoveType=0 - nbond=0 -c write (iout,'(a)') 'Old variables:' -c write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) -c print *,'after perturb',error,finish - if (error) finish = .true. - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - finish=.true. - write (*,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - ngen=ngen+1 -c print *,'finish=',finish - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.1) write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - if(iprint.gt.1.or.etot.lt.1d19) print *, - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,*) 'Too many overlapping confs.', - & ' etot, elowest, overlap_cut', etot, elowest, overlap_cut - finish=.true. - endif - else if (.not. finish) then -C Distribute tasks to processors -c print *,'Master sending order' - call MPI_SEND(12, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) '12: tag=',tag -c print *,'Master sent order to processor',is - call MPI_SEND(it, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'it: tag=',tag - call MPI_SEND(eold, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'eold: tag=',tag - call MPI_SEND(varia(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varia: tag=',tag - call MPI_SEND(varold(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varold: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - imtasks(is)=1 - imtasks_n=imtasks_n+1 -C End distribution - endif ! overlap - enddo LOOP3 - - flag = .false. - LOOP_RECV:do while(.not.flag) - do is=1, nodenum-1 - call MPI_IPROBE(is,tag,CG_COMM,flag,status,ierr) - if(flag) then - call MPI_RECV(iitt, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(eold1, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(etot, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(varia(1), nvar, MPI_DOUBLE_PRECISION,is,tag, - & CG_COMM, status, ierr) - call MPI_RECV(varold1(1), nvar, MPI_DOUBLE_PRECISION, is, - & tag, CG_COMM, status, ierr) - call MPI_RECV(ii_grnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_ennum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_hesnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - i_grnum_d=i_grnum_d+ii_grnum_d - i_ennum_d=i_ennum_d+ii_ennum_d - neneval = neneval+ii_ennum_d - i_hesnum_d=i_hesnum_d+ii_hesnum_d - i_minimiz=i_minimiz+1 - imtasks(is)=0 - imtasks_n=imtasks_n-1 - exit - endif - enddo - enddo LOOP_RECV - - if(print_mc.gt.0) write (iout,'(a,i6,a,i6,a,i6,a,1pe16.6)') - & 'From Worker #',is,' iitt',iitt, - & ' Conformation:',ngen,' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - call metropolis(nvar,varia,varold1,etot,eold1,accepted, - & similar,EneLower) - if(iitt.ne.it.and..not.similar) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & similar,EneLower) - accepted=enelower - endif - if(etot.lt.eneglobal)eneglobal=etot -c if(mod(it,100).eq.0) - write(iout,*)'CHUJOJEB ',neneval,eneglobal - if (accepted) then -C Write the accepted conformation. - nout=nout+1 - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif ! refstr - if (print_mc.gt.0) - & write (iout,*) 'Writing new conformation',nout - if (print_stat) then - call var_to_geom(nvar,varia) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - close(istat) - endif ! print_stat -C Print internal coordinates. - if (print_int) call briefout(nout,etot) - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (nrepm.gt.maxrepm) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Too many conformation repetitions.' - finish=.true. - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - else - ntrial=ntrial+1 - endif ! accepted - 30 continue - if(finish.and.imtasks_n.eq.0)exit LOOP2 - enddo LOOP2 ! accepted -C Check for time limit. - not_done = (it.lt.max_mcm_it) .and. (nacc_tot.lt.maxacc) - if(.not.not_done .or. finish) then - if(imtasks_n.gt.0) then - not_done=.true. - else - not_done=.false. - endif - finish=.true. - endif - enddo LOOP1 ! not_done - runtime=tcpu() - if (print_mc.gt.0) then - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - do is=1,nodenum-1 - call MPI_SEND(999, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) - enddo - return - end -c------------------------------------------------------------------------------ - subroutine execute_slave(nodeinfo,iprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INFO' - include 'COMMON.MINIM' - character*10 nodeinfo - double precision x(maxvar),x1(maxvar) - nodeinfo='chujwdupe' -c print *,'Processor:',MyID,' Entering execute_slave' - tag=0 -c call MPI_SEND(nodeinfo, 10, MPI_CHARACTER, 0, tag, -c & CG_COMM, ierr) - -1001 call MPI_RECV(i_switch, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - if(iprint.ge.2)print *, MyID,' recv order ',i_switch - if (i_switch.eq.12) then - i_grnum_d=0 - i_ennum_d=0 - i_hesnum_d=0 - call MPI_RECV(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - call MPI_RECV(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'ener: tag=',tag - call MPI_RECV(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x: tag=',tag - call MPI_RECV(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x1: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif -c print *,'calling minimize' - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.0) - & write(iout,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - write(*,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - 100 format(a20,f10.5,a12,i5,a6,i2) - if(iretcode.eq.10) then - do iminrep=2,3 - if(iprint.gt.1) - & write(iout,*)' ... not converged - trying again ',iminrep - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.1) - & write(iout,*)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - if(iretcode.ne.10)go to 812 - enddo - if(iretcode.eq.10) then - if(iprint.gt.1) - & write(iout,*)' ... not converged again - giving up' - go to 812 - endif - endif -812 continue -c print *,'Sending results' - call MPI_SEND(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(energyx, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_grnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(nfun, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_hesnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) -c print *,'End sending' - go to 1001 - endif - - return - end -#endif -c------------------------------------------------------------------------------ - subroutine statprint(it,nfun,iretcode,etot,elowest) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - if (minim) then - write (iout, - & '(80(1h*)/a,i5,a,1pe14.5,a,1pe14.5/a,i3,a,i10,a,i5,a,i5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest, - & 'SUMSL return code:',iretcode, - & ' # of energy evaluations:',neneval, - & '# of temperature jumps:',ntherm, - & ' # of minima repetitions:',nrepm - else - write (iout,'(80(1h*)/a,i8,a,1pe14.5,a,1pe14.5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest - endif - write (iout,'(/4a)') - & 'Kind of move ',' total',' accepted', - & ' fraction' - write (iout,'(58(1h-))') - do i=-1,MaxMoveType - if (moves(i).eq.0) then - fr_mov_i=0.0d0 - else - fr_mov_i=dfloat(moves_acc(i))/dfloat(moves(i)) - endif - write(iout,'(a,2i15,f10.5)')MovTypID(i),moves(i),moves_acc(i), - & fr_mov_i - enddo - write (iout,'(a,2i15,f10.5)') 'total ',nmove,nacc_tot, - & dfloat(nacc_tot)/dfloat(nmove) - write (iout,'(58(1h-))') - write (iout,'(a,1pe12.4)') 'Elapsed time:',tcpu() - return - end -c------------------------------------------------------------------------------ - subroutine heat(over) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - logical over -C Check if there`s a need to increase temperature. - if (ntrial.gt.maxtrial) then - if (NstepH.gt.0) then - if (dabs(Tcur-TMax).lt.1.0D-7) then - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a/80(1h*))') - & 'Upper limit of temperature reached. Terminating.' - over=.true. - Tcur=Tmin - else - Tcur=Tcur*TstepH - if (Tcur.gt.Tmax) Tcur=Tmax - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System heated up to ',Tcur,' K; BetBol:',betbol - ntherm=ntherm+1 - ntrial=0 - over=.false. - endif - else - if (print_mc.gt.0) - & write (iout,'(a)') - & 'Maximum number of trials in a single MCM iteration exceeded.' - over=.true. - Tcur=Tmin - endif - else - over=.false. - endif - return - end -c------------------------------------------------------------------------------ - subroutine cool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - if (nstepC.gt.0 .and. dabs(Tcur-Tmin).gt.1.0D-7) then - Tcur=Tcur/TstepC - if (Tcur.lt.Tmin) Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System cooled down up to ',Tcur,' K; BetBol:',betbol - endif - return - end -C--------------------------------------------------------------------------- - subroutine zapis(varia,etot) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer itemp(maxsave) - double precision varia(maxvar) - logical lprint - lprint=.false. - if (lprint) then - write (iout,'(a,i5,a,i5)') 'Enter ZAPIS NSave=',Nsave, - & ' MaxSave=',MaxSave - write (iout,'(a)') 'Current energy and conformation:' - write (iout,'(1pe14.5)') etot - write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - endif -C Shift the contents of the esave and varsave arrays if filled up. - call add2cache(maxvar,maxsave,nsave,nvar,MyID,itemp, - & etot,varia,esave,varsave) - if (lprint) then - write (iout,'(a)') 'Energies and the VarSave array.' - do i=1,nsave - write (iout,'(i5,1pe14.5)') i,esave(i) - write (iout,'(10f8.3)') (rad2deg*varsave(j,i),j=1,nvar) - enddo - endif - return - end -C--------------------------------------------------------------------------- - subroutine perturb(error,lprint,MoveType,nbond,max_phi) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (MMaxSideMove=100) - include 'COMMON.MCM' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM1' - logical error,lprint,fail - integer MoveType,nbond,end_select,ind_side(MMaxSideMove) - double precision max_phi - double precision psi,gen_psi - external iran_num - integer iran_num - integer ifour - data ifour /4/ - error=.false. - lprint=.false. -C Perturb the conformation according to a randomly selected move. - call SelectMove(MoveType) -c write (iout,*) 'MoveType=',MoveType - itrial=0 - goto (100,200,300,400,500) MoveType -C------------------------------------------------------------------------------ -C Backbone N-bond move. -C Select the number of bonds (length of the segment to perturb). - 100 continue - if (itrial.gt.1000) then - write (iout,'(a)') 'Too many attempts at multiple-bond move.' - error=.true. - return - endif - bond_prob=ran_number(0.0D0,sumpro_bond(nbm)) -c print *,'sumpro_bond(nbm)=',sumpro_bond(nbm), -c & ' Bond_prob=',Bond_Prob - do i=1,nbm-1 -c print *,i,Bond_Prob,sumpro_bond(i),sumpro_bond(i+1) - if (bond_prob.ge.sumpro_bond(i) .and. - & bond_prob.le.sumpro_bond(i+1)) then - nbond=i+1 - goto 10 - endif - enddo - write (iout,'(2a)') 'In PERTURB: Error - number of bonds', - & ' to move out of range.' - error=.true. - return - 10 continue - if (nwindow.gt.0) then -C Select the first residue to perturb - iwindow=iran_num(1,nwindow) - print *,'iwindow=',iwindow - iiwin=1 - do while (winlen(iwindow).lt.nbond) - iwindow=iran_num(1,nwindow) - iiwin=iiwin+1 - if (iiwin.gt.1000) then - write (iout,'(a)') 'Cannot select moveable residues.' - error=.true. - return - endif - enddo - nstart=iran_num(winstart(iwindow),winend(iwindow)) - else - nstart = iran_num(koniecl+2,nres-nbond-koniecl) -cd print *,'nres=',nres,' nbond=',nbond,' koniecl=',koniecl, -cd & ' nstart=',nstart - endif - psi = gen_psi() - if (psi.eq.0.0) then - error=.true. - return - endif - if (print_mc.gt.1) write (iout,'(a,i4,a,i4,a,f8.3)') - & 'PERTURB: nbond=',nbond,' nstart=',nstart,' psi=',psi*rad2deg -cd print *,'nstart=',nstart - call bond_move(nbond,nstart,psi,.false.,error) - if (error) then - write (iout,'(2a)') - & 'Could not define reference system in bond_move, ', - & 'choosing ahother segment.' - itrial=itrial+1 - goto 100 - endif - nbond_move(nbond)=nbond_move(nbond)+1 - moves(1)=moves(1)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Backbone endmove. Perturb a SINGLE angle of a residue close to the end of -C the chain. - 200 continue - lprint=.true. -c end_select=iran_num(1,2*koniecl) -c if (end_select.gt.koniecl) then -c end_select=nphi-(end_select-koniecl) -c else -c end_select=koniecl+3 -c endif -c if (nwindow.gt.0) then -c iwin=iran_num(1,nwindow) -c i1=max0(4,winstart(iwin)) -c i2=min0(winend(imin)+2,nres) -c end_select=iran_num(i1,i2) -c else -c iselect = iran_num(1,nmov_var) -c jj = 0 -c do i=1,nphi -c if (isearch_tab(i).eq.1) jj = jj+1 -c if (jj.eq.iselect) then -c end_select=i+3 -c exit -c endif -c enddo -c endif - end_select = iran_num(4,nres) - psi=max_phi*gen_psi() - if (psi.eq.0.0D0) then - error=.true. - return - endif - phi(end_select)=pinorm(phi(end_select)+psi) - if (print_mc.gt.1) write (iout,'(a,i4,a,f8.3,a,f8.3)') - & 'End angle',end_select,' moved by ',psi*rad2deg,' new angle:', - & phi(end_select)*rad2deg -c if (end_select.gt.3) -c & theta(end_select-1)=gen_theta(itype(end_select-2), -c & phi(end_select-1),phi(end_select)) -c if (end_select.lt.nres) -c & theta(end_select)=gen_theta(itype(end_select-1), -c & phi(end_select),phi(end_select+1)) -cd print *,'nres=',nres,' end_select=',end_select -cd print *,'theta',end_select-1,theta(end_select-1) -cd print *,'theta',end_select,theta(end_select) - moves(2)=moves(2)+1 - nmove=nmove+1 - lprint=.false. - return -C------------------------------------------------------------------------------ -C Side chain move. -C Select the number of SCs to perturb. - 300 isctry=0 - 301 nside_move=iran_num(1,MaxSideMove) -c print *,'nside_move=',nside_move,' MaxSideMove',MaxSideMove -C Select the indices. - do i=1,nside_move - icount=0 - 111 inds=iran_num(nnt,nct) - icount=icount+1 - if (icount.gt.1000) then - write (iout,'(a)')'Error - cannot select side chains to move.' - error=.true. - return - endif - if (itype(inds).eq.10) goto 111 - do j=1,i-1 - if (inds.eq.ind_side(j)) goto 111 - enddo - do j=1,i-1 - if (inds.lt.ind_side(j)) then - indx=j - goto 112 - endif - enddo - indx=i - 112 do j=i,indx+1,-1 - ind_side(j)=ind_side(j-1) - enddo - 113 ind_side(indx)=inds - enddo -C Carry out perturbation. - do i=1,nside_move - ii=ind_side(i) - iti=itype(ii) - call gen_side(iti,theta(ii+1),alph(ii),omeg(ii),fail) - if (fail) then - isctry=isctry+1 - if (isctry.gt.1000) then - write (iout,'(a)') 'Too many errors in SC generation.' - error=.true. - return - endif - goto 301 - endif - if (print_mc.gt.1) write (iout,'(2a,i4,a,2f8.3)') - & 'Side chain ',restyp(iti),ii,' moved to ', - & alph(ii)*rad2deg,omeg(ii)*rad2deg - enddo - moves(3)=moves(3)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C THETA move - 400 end_select=iran_num(3,nres) - theta_new=gen_theta(itype(end_select),phi(end_select), - & phi(end_select+1)) - if (print_mc.gt.1) write (iout,'(a,i3,a,f8.3,a,f8.3)') - & 'Theta ',end_select,' moved from',theta(end_select)*rad2deg, - & ' to ',theta_new*rad2deg - theta(end_select)=theta_new - moves(4)=moves(4)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Error returned from SelectMove. - 500 error=.true. - return - end -C------------------------------------------------------------------------------ - subroutine SelectMove(MoveType) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - what_move=ran_number(0.0D0,sumpro_type(MaxMoveType)) - do i=1,MaxMoveType - if (what_move.ge.sumpro_type(i-1).and. - & what_move.lt.sumpro_type(i)) then - MoveType=i - return - endif - enddo - write (iout,'(a)') - & 'Fatal error in SelectMoveType: cannot select move.' - MoveType=MaxMoveType+1 - return - end -c---------------------------------------------------------------------------- - double precision function gen_psi() - implicit none - integer i - double precision x,ran_number - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - x=0.0D0 - do i=1,100 - x=ran_number(-pi,pi) - if (dabs(x).gt.angmin) then - gen_psi=x - return - endif - enddo - write (iout,'(a)')'From Gen_Psi: Cannot generate angle increment.' - gen_psi=0.0D0 - return - end -c---------------------------------------------------------------------------- - subroutine metropolis(n,xcur,xold,ecur,eold,accepted,similar, - & enelower) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' -crc include 'COMMON.DEFORM' - double precision ecur,eold,xx,ran_number,bol - double precision xcur(n),xold(n) - double precision ecut1 ,ecut2 ,tola - logical accepted,similar,not_done,enelower - logical lprn - data ecut1 /-1.0D-5/,ecut2 /5.0D-3/,tola/5.0D0/ -! ecut1=-5*enedif -! ecut2=50*enedif -! tola=5.0d0 -C Set lprn=.true. for debugging. - lprn=.false. - if (lprn) - &write(iout,*)'enedif',enedif,' ecut1',ecut1,' ecut2',ecut2 - similar=.false. - enelower=.false. - accepted=.false. -C Check if the conformation is similar. - difene=ecur-eold - reldife=difene/dmax1(dabs(eold),dabs(ecur),1.0D0) - if (lprn) then - write (iout,*) 'Metropolis' - write(iout,*)'ecur,eold,difene,reldife',ecur,eold,difene,reldife - endif -C If energy went down remarkably, we accept the new conformation -C unconditionally. -cjp if (reldife.lt.ecut1) then - if (difene.lt.ecut1) then - accepted=.true. - EneLower=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because energy has lowered remarkably.' -! elseif (reldife.lt.ecut2 .and. dif_ang(nphi,xcur,xold).lt.tola) -cjp elseif (reldife.lt.ecut2) - elseif (difene.lt.ecut2) - & then -C Reject the conf. if energy has changed insignificantly and there is not -C much change in conformation. - if (lprn) - & write (iout,'(2a)') 'Conformation rejected, because it is', - & ' similar to the preceding one.' - accepted=.false. - similar=.true. - else -C Else carry out Metropolis test. - EneLower=.false. - xx=ran_number(0.0D0,1.0D0) - xxh=betbol*difene - if (lprn) - & write (iout,*) 'betbol=',betbol,' difene=',difene,' xxh=',xxh - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (lprn) write (iout,*) 'bol=',bol,' xx=',xx - if (bol.gt.xx) then - accepted=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because it passed Metropolis test.' - else - accepted=.false. - if (lprn) write (iout,'(a)') - & 'Conformation rejected, because it did not pass Metropolis test.' - endif - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - return - end -c------------------------------------------------------------------------------ - integer function conf_comp(x,ene) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - double precision etol , angtol - double precision x(maxvar) - double precision dif_ang,difa - data etol /0.1D0/, angtol /20.0D0/ - do ii=nsave,1,-1 -c write (iout,*) 'ii=',ii,'ene=',ene,esave(ii),dabs(ene-esave(ii)) - if (dabs(ene-esave(ii)).lt.etol) then - difa=dif_ang(nphi,x,varsave(1,ii)) -c do i=1,nphi -c write(iout,'(i3,3f8.3)')i,rad2deg*x(i), -c & rad2deg*varsave(i,ii) -c enddo -c write(iout,*) 'ii=',ii,' difa=',difa,' angtol=',angtol - if (difa.le.angtol) then - if (print_mc.gt.0) then - write (iout,'(a,i5,2(a,1pe15.4))') - & 'Current conformation matches #',ii, - & ' in the store array ene=',ene,' esave=',esave(ii) -c write (*,'(a,i5,a)') 'Current conformation matches #',ii, -c & ' in the store array.' - endif ! print_mc.gt.0 - if (print_mc.gt.1) then - do i=1,nphi - write(iout,'(i3,3f8.3)')i,rad2deg*x(i), - & rad2deg*varsave(i,ii) - enddo - endif ! print_mc.gt.1 - nrepm=nrepm+1 - conf_comp=ii - return - endif - endif - enddo - conf_comp=0 - return - end -C---------------------------------------------------------------------------- - double precision function dif_ang(n,x,y) - implicit none - integer i,n - double precision x(n),y(n) - double precision w,wa,dif,difa - double precision pinorm - include 'COMMON.GEO' - wa=0.0D0 - difa=0.0D0 - do i=1,n - dif=dabs(pinorm(y(i)-x(i))) - if (dabs(dif-dwapi).lt.dif) dif=dabs(dif-dwapi) - w=1.0D0-(2.0D0*(i-1)/(n-1)-1.0D0)**2+1.0D0/n - wa=wa+w - difa=difa+dif*dif*w - enddo - dif_ang=rad2deg*dsqrt(difa/wa) - return - end -c-------------------------------------------------------------------------- - subroutine add2cache(n1,n2,ncache,nvar,SourceID,CachSrc, - & ecur,xcur,ecache,xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,SourceID,CachSrc(n2) - integer i,ii,j - double precision ecur,xcur(nvar),ecache(n2),xcache(n1,n2) -cd write (iout,*) 'Enter ADD2CACHE ncache=',ncache ,' ecur',ecur -cd write (iout,'(10f8.3)') (rad2deg*xcur(i),i=1,nvar) -cd write (iout,*) 'Old CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - - i=ncache - do while (i.gt.0 .and. ecur.lt.ecache(i)) - i=i-1 - enddo - i=i+1 -cd write (iout,*) 'i=',i,' ncache=',ncache - if (ncache.eq.n2) then - write (iout,*) 'Cache dimension exceeded',ncache,n2 - write (iout,*) 'Highest-energy conformation will be removed.' - ncache=ncache-1 - endif - do ii=ncache,i,-1 - ecache(ii+1)=ecache(ii) - CachSrc(ii+1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii+1)=xcache(j,ii) - enddo - enddo - ecache(i)=ecur - CachSrc(i)=SourceID - do j=1,nvar - xcache(j,i)=xcur(j) - enddo - ncache=ncache+1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end -c-------------------------------------------------------------------------- - subroutine rm_from_cache(i,n1,n2,ncache,nvar,CachSrc,ecache, - & xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,CachSrc(n2) - integer i,ii,j - double precision ecache(n2),xcache(n1,n2) - -cd write (iout,*) 'Enter RM_FROM_CACHE' -cd write (iout,*) 'Old CACHE array:' -cd do ii=1,ncache -cd write (iout,*)'i=',ii,' ecache=',ecache(ii),' CachSrc',CachSrc(ii) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,ii),j=1,nvar) -cd enddo - - do ii=i+1,ncache - ecache(ii-1)=ecache(ii) - CachSrc(ii-1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii-1)=xcache(j,ii) - enddo - enddo - ncache=ncache-1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/minim_mcmf.F b/source/unres/src_MD-NEWSC-NEWC/minim_mcmf.F deleted file mode 100644 index beb3d4c..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/minim_mcmf.F +++ /dev/null @@ -1,121 +0,0 @@ -#ifdef MPI - subroutine minim_mcmf - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - dimension indx(6) - dimension iv(liv) - dimension idum(1),rdum(1) - double precision przes(3),obrot(3,3) - logical non_conv - data rad /1.745329252d-2/ - common /przechowalnia/ v - - ichuj=0 - 10 continue - ichuj = ichuj + 1 - call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - if (indx(1).eq.0) return -c print *, 'worker ',me,' received order ',n,ichuj - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene0,1,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -c print *, 'worker ',me,' var read ' - - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy - - call func(nvar,var,nf,eee,idum,rdum,fdum) - if(eee.gt.1.0d18) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - nf=1 - go to 201 - endif - - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -c find which conformation was returned from sumsl - nf=iv(7)+1 - 201 continue -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(4)=nf - indx(5)=iv(1) - eee=v(10) - - call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM, - * ierr) -c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10) - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) - call mpi_send(eee,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - go to 10 - - return - end -#endif diff --git a/source/unres/src_MD-NEWSC-NEWC/minimize_p.F b/source/unres/src_MD-NEWSC-NEWC/minimize_p.F deleted file mode 100644 index c7922c7..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/minimize_p.F +++ /dev/null @@ -1,641 +0,0 @@ - subroutine minimize(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -********************************************************************* -* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -* the calling subprogram. * -* when d(i)=1.0, then v(35) is the length of the initial step, * -* calculated in the usual pythagorean way. * -* absolute convergence occurs when the function is within v(31) of * -* zero. unless you know the minimum value in advance, abs convg * -* is probably not useful. * -* relative convergence is when the model predicts that the function * -* will decrease by less than v(32)*abs(fun). * -********************************************************************* - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr,grad_restr - logical not_done,change,reduce -c common /przechowalnia/ v - - icall = 1 - - NOT_DONE=.TRUE. - -c DO WHILE (NOT_DONE) - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -cd print *,'Calling SUMSL' -c call var_to_geom(nvar,x) -c call chainbuild -c call etotal(energia(0)) -c etot = energia(0) - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr,grad_restr, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) -cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot -cd write (iout,'(/a,i4/)') 'SUMSL return code:',iv(1) -c call intout -c change=reduce(x) - call var_to_geom(nvar,x) -c if (change) then -c write (iout,'(a)') 'Reduction worked, minimizing again...' -c else -c not_done=.false. -c endif - call chainbuild -c call etotal(energia(0)) -c etot=energia(0) -c call enerprint(energia(0)) - nfun=iv(6) - -c write (*,*) 'Processor',MyID,' leaves MINIMIZE.' - -c ENDDO ! NOT_DONE - - return - end -#ifdef MPI -c---------------------------------------------------------------------------- - subroutine ergastulum - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' - double precision z(maxres6),d_a_tmp(maxres6) - double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy - integer icall /0/ -C Workers wait for variables and NF, and NFL from the boss - iorder=0 - do while (iorder.ge.0) -c write (*,*) 'Processor',fg_rank,' CG group',kolor, -c & ' receives order from Master' - time00=MPI_Wtime() - call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - if (icall.gt.4 .and. iorder.ge.0) - & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00 - icall=icall+1 -c write (*,*) -c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder - if (iorder.eq.0) then - call zerograd - call etotal(edum) -c write (2,*) "After etotal" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.2) then - call zerograd - call etotal_short(edum) -c write (2,*) "After etotal_short" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.3) then - call zerograd - call etotal_long(edum) -c write (2,*) "After etotal_long" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.1) then - call sum_gradient -c write (2,*) "After sum_gradient" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.4) then - call ginv_mult(z,d_a_tmp) - else if (iorder.eq.5) then -c Setup MD things for a slave - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) -c write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - myginv_ng_count=maxres2*my_ng_count -c write (2,*) "igmult_start",igmult_start," igmult_end", -c & igmult_end," my_ng_count",my_ng_count -c call flush(2) - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) -c write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) -c call flush(2) -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (2,*) "dimen",dimen," dimen3",dimen3 -c write (2,*) "End MD setup" -c call flush(2) -c write (iout,*) "My chunk of ginv_block" -c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) - else if (iorder.eq.6) then - call int_from_cart1(.false.) - else if (iorder.eq.7) then - call chainbuild_cart - else if (iorder.eq.8) then - call intcartderiv - else if (iorder.eq.9) then - call fricmat_mult(z,d_a_tmp) - else if (iorder.eq.10) then - call setup_fricmat - endif - enddo - write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' leves ERGASTULUM.' - write(*,*)'Processor',fg_rank,' wait times for respective orders', - & (' order[',i,']',time_order(i),i=0,10) - return - end -#endif -************************************************************************ - subroutine func(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 -cd print *,'func',nf,nfl,icg - call var_to_geom(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -************************************************************************ - subroutine func_restr(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -c------------------------------------------------------- - subroutine x2xx(x,xx,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - varall(i)=x(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - endif - enddo - enddo - - n=ig - - return - end - - subroutine xx2x(x,xx) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - x(i)=varall(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - endif - enddo - enddo - - return - end - -c---------------------------------------------------------- - subroutine minim_dc(etot,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) -c common /przechowalnia/ v - - double precision energia(0:n_ene) - external func_dc,grad_dc,fdum - logical not_done,change,reduce - double precision g(maxvar),f1 - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,6*nres - d(i)=1.0D-1 - enddo - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - x(k)=dc(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - x(k)=dc(j,i+nres) - enddo - endif - enddo - - call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -cd call zerograd -cd nf=0 -cd call func_dc(k,x,nf,f,idum,rdum,fdum) -cd call grad_dc(k,x,nf,g,idum,rdum,fdum) -cd -cd do i=1,k -cd x(i)=x(i)+1.0D-5 -cd call func_dc(k,x,nf,f1,idum,rdum,fdum) -cd x(i)=x(i)-1.0D-5 -cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5 -cd enddo - - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - return - end - - subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - double precision energia(0:n_ene) - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf -cbad icg=mod(nf,2)+1 - icg=1 - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - - call zerograd - call etotal(energia(0)) - f=energia(0) - -cd print *,'func_dc ',nf,nfl,f - - return - end - - subroutine grad_dc(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1),k - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c -c -cbad icg=mod(nf,2)+1 - icg=1 -cd print *,'grad_dc ',nf,nfl,nf-nfl+1,icg - if (nf-nfl+1) 20,30,40 - 20 call func_dc(n,x,nf,f,uiparm,urparm,ufparm) -cd print *,20 - if (nf.eq.0) return - goto 40 - 30 continue -cd print *,30 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartgrad -cd print *,40 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - g(k)=gcart(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - g(k)=gxcart(j,i) - enddo - endif - enddo - - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/misc.f b/source/unres/src_MD-NEWSC-NEWC/misc.f deleted file mode 100644 index e189839..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/misc.f +++ /dev/null @@ -1,203 +0,0 @@ -C $Date: 1994/10/12 17:24:21 $ -C $Revision: 2.5 $ -C -C -C - logical function find_arg(ipos,line,errflag) - parameter (maxlen=80) - character*80 line - character*1 empty /' '/,equal /'='/ - logical errflag -* This function returns .TRUE., if an argument follows keyword keywd; if so -* IPOS will point to the first non-blank character of the argument. Returns -* .FALSE., if no argument follows the keyword; in this case IPOS points -* to the first non-blank character of the next keyword. - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - errflag=.false. - if (line(ipos:ipos).eq.equal) then - find_arg=.true. - ipos=ipos+1 - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen) errflag=.true. - else - find_arg=.false. - endif - return - end - logical function find_group(iunit,jout,key1) - character*(*) key1 - character*80 karta,ucase - integer ilen - external ilen - logical lcom - rewind (iunit) - karta=' ' - ll=ilen(key1) - do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta)) - read (iunit,'(a)',end=10) karta - enddo - write (jout,'(2a)') '> ',karta(1:78) - find_group=.true. - return - 10 find_group=.false. - return - end - logical function iblnk(charc) - character*1 charc - integer n - n = ichar(charc) - iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ') - return - end - integer function ilen(string) - character*(*) string - logical iblnk - - ilen = len(string) -1 if ( ilen .gt. 0 ) then - if ( iblnk( string(ilen:ilen) ) ) then - ilen = ilen - 1 - goto 1 - endif - endif - return - end - integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset) - character*16 keywd,keywdset(1:nkey,0:nkey) - character*16 ucase - do i=1,narg - if (ucase(keywd).eq.keywdset(i,ikey)) then -* Match found - in_keywd_set=i - return - endif - enddo -* No match to the allowed set of keywords if this point is reached. - in_keywd_set=0 - return - end - character*(*) function lcase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(lcase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - lcase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'A') .and. lle(c,'Z')) then - lcase(i:i) = char(ichar(c) + idiff) - endif - 99 continue - return - end - logical function lcom(ipos,karta) - character*80 karta - character koment(2) /'!','#'/ - lcom=.false. - do i=1,2 - if (karta(ipos:ipos).eq.koment(i)) lcom=.true. - enddo - return - end - logical function lower_case(ch) - character*(*) ch - lower_case=(ch.ge.'a' .and. ch.le.'z') - return - end - subroutine mykey(line,keywd,ipos,blankline,errflag) -* This subroutine seeks a non-empty substring keywd in the string LINE. -* The substring begins with the first character different from blank and -* "=" encountered right to the pointer IPOS (inclusively) and terminates -* at the character left to the first blank or "=". When the subroutine is -* exited, the pointer IPOS is moved to the position of the terminator in LINE. -* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains -* only separators or the maximum length of the data line (80) has been reached. -* The logical variable ERRFLAG is set at .TRUE. if the string -* consists only from a "=". - parameter (maxlen=80) - character*1 empty /' '/,equal /'='/,comma /','/ - character*(*) keywd - character*80 line - logical blankline,errflag,lcom - errflag=.false. - do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen)) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen .or. lcom(ipos,line) ) then -* At this point the rest of the input line turned out to contain only blanks -* or to be commented out. - blankline=.true. - return - endif - blankline=.false. - istart=ipos -* Checks whether the current char is a separator. - do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal - & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - iend=ipos-1 -* Error flag set to .true., if the length of the keyword was found less than 1. - if (iend.lt.istart) then - errflag=.true. - return - endif - keywd=line(istart:iend) - return - end - subroutine numstr(inum,numm) - character*10 huj /'0123456789'/ - character*(*) numm - inumm=inum - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(3:3)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(2:2)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(1:1)=huj(inum2+1:inum2+1) - return - end - character*(*) function ucase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(ucase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - ucase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'a') .and. lle(c,'z')) then - ucase(i:i) = char(ichar(c) - idiff) - endif - 99 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/moments.f b/source/unres/src_MD-NEWSC-NEWC/moments.f deleted file mode 100644 index 5adbf21..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/moments.f +++ /dev/null @@ -1,328 +0,0 @@ - subroutine inertia_tensor -c Calculating the intertia tensor for the entire protein in order to -c remove the perpendicular components of velocity matrix which cause -c the molecule to rotate. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision Im(3,3),Imcp(3,3),cm(3),pr(3),M_SC, - & eigvec(3,3),Id(3,3),eigval(3),L(3),vp(3),vrot(3), - & vpp(3,0:MAXRES),vs_p(3),pr1(3,3), - & pr2(3,3),pp(3),incr(3),v(3),mag,mag2 - common /gucio/ cm - integer iti,inres - do i=1,3 - do j=1,3 - Im(i,j)=0.0d0 - pr1(i,j)=0.0d0 - pr2(i,j)=0.0d0 - enddo - L(i)=0.0d0 - cm(i)=0.0d0 - vrot(i)=0.0d0 - enddo -c calculating the center of the mass of the protein - do i=nnt,nct-1 - do j=1,3 - cm(j)=cm(j)+c(j,i)+0.5d0*dc(j,i) - enddo - enddo - do j=1,3 - cm(j)=mp*cm(j) - enddo - M_SC=0.0d0 - do i=nnt,nct - iti=itype(i) - M_SC=M_SC+msc(iti) - inres=i+nres - do j=1,3 - cm(j)=cm(j)+msc(iti)*c(j,inres) - enddo - enddo - do j=1,3 - cm(j)=cm(j)/(M_SC+(nct-nnt)*mp) - enddo - - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - Im(1,1)=Im(1,1)+mp*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-mp*pr(1)*pr(2) - Im(1,3)=Im(1,3)-mp*pr(1)*pr(3) - Im(2,3)=Im(2,3)-mp*pr(2)*pr(3) - Im(2,2)=Im(2,2)+mp*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+mp*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - Im(1,1)=Im(1,1)+msc(iti)*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-msc(iti)*pr(1)*pr(2) - Im(1,3)=Im(1,3)-msc(iti)*pr(1)*pr(3) - Im(2,3)=Im(2,3)-msc(iti)*pr(2)*pr(3) - Im(2,2)=Im(2,2)+msc(iti)*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+msc(iti)*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct-1 - Im(1,1)=Im(1,1)+Ip*(1-dc_norm(1,i)*dc_norm(1,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,2)=Im(1,2)+Ip*(-dc_norm(1,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,3)=Im(1,3)+Ip*(-dc_norm(1,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,3)=Im(2,3)+Ip*(-dc_norm(2,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,2)=Im(2,2)+Ip*(1-dc_norm(2,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(3,3)=Im(3,3)+Ip*(1-dc_norm(3,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - enddo - - - do i=nnt,nct - if (itype(i).ne.10) then - iti=itype(i) - inres=i+nres - Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)* - & dc_norm(1,inres))*vbld(inres)*vbld(inres) - Im(1,2)=Im(1,2)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(1,3)=Im(1,3)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,3)=Im(2,3)-Isc(iti)*(dc_norm(2,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,2)=Im(2,2)+Isc(iti)*(1-dc_norm(2,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(3,3)=Im(3,3)+Isc(iti)*(1-dc_norm(3,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - endif - enddo - - call angmom(cm,L) -c write(iout,*) "The angular momentum before adjustment:" -c write(iout,*) (L(j),j=1,3) - - Im(2,1)=Im(1,2) - Im(3,1)=Im(1,3) - Im(3,2)=Im(2,3) - -c Copying the Im matrix for the djacob subroutine - do i=1,3 - do j=1,3 - Imcp(i,j)=Im(i,j) - Id(i,j)=0.0d0 - enddo - enddo - -c Finding the eigenvectors and eignvalues of the inertia tensor - call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval) -c write (iout,*) "Eigenvalues & Eigenvectors" -c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3) -c write (iout,*) -c do i=1,3 -c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3) -c enddo -c Constructing the diagonalized matrix - do i=1,3 - if (dabs(eigval(i)).gt.1.0d-15) then - Id(i,i)=1.0d0/eigval(i) - else - Id(i,i)=0.0d0 - endif - enddo - do i=1,3 - do j=1,3 - Imcp(i,j)=eigvec(j,i) - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr1(i,j)=pr1(i,j)+Id(i,k)*Imcp(k,j) - enddo - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr2(i,j)=pr2(i,j)+eigvec(i,k)*pr1(k,j) - enddo - enddo - enddo -c Calculating the total rotational velocity of the molecule - do i=1,3 - do j=1,3 - vrot(i)=vrot(i)+pr2(i,j)*L(j) - enddo - enddo -c Resetting the velocities - do i=nnt,nct-1 - call vecpr(vrot(1),dc(1,i),vp) - do j=1,3 - d_t(j,i)=d_t(j,i)-vp(j) - enddo - enddo - do i=nnt,nct - if(itype(i).ne.10) then - inres=i+nres - call vecpr(vrot(1),dc(1,inres),vp) - do j=1,3 - d_t(j,inres)=d_t(j,inres)-vp(j) - enddo - endif - enddo - call angmom(cm,L) -c write(iout,*) "The angular momentum after adjustment:" -c write(iout,*) (L(j),j=1,3) - return - end -c---------------------------------------------------------------------------- - subroutine angmom(cm,L) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision L(3),cm(3),pr(3),vp(3),vrot(3),incr(3),v(3), - & pp(3) - integer iti,inres -c Calculate the angular momentum - do j=1,3 - L(j)=0.0d0 - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - call vecpr(pr(1),v(1),vp) - do j=1,3 - L(j)=L(j)+mp*vp(j) - enddo - do j=1,3 - pr(j)=0.5d0*dc(j,i) - pp(j)=0.5d0*d_t(j,i) - enddo - call vecpr(pr(1),pp(1),vp) - do j=1,3 - L(j)=L(j)+Ip*vp(j) - enddo - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - else - do j=1,3 - v(j)=incr(j) - enddo - endif - call vecpr(pr(1),v(1),vp) -c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3), -c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3) - do j=1,3 - L(j)=L(j)+msc(iti)*vp(j) - enddo -c write (iout,*) "L",(l(j),j=1,3) - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - call vecpr(dc(1,inres),d_t(1,inres),vp) - do j=1,3 - L(j)=L(j)+Isc(iti)*vp(j) - enddo - endif - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo - return - end -c------------------------------------------------------------------------------ - subroutine vcm_vel(vcm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision vcm(3),vv(3),summas,amas - do j=1,3 - vcm(j)=0.0d0 - vv(j)=d_t(j,0) - enddo - summas=0.0d0 - do i=nnt,nct - if (i.lt.nct) then - summas=summas+mp - do j=1,3 - vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i)) - enddo - endif - amas=msc(itype(i)) - summas=summas+amas - if (itype(i).ne.10) then - do j=1,3 - vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres)) - enddo - else - do j=1,3 - vcm(j)=vcm(j)+amas*vv(j) - enddo - endif - do j=1,3 - vv(j)=vv(j)+d_t(j,i) - enddo - enddo -c write (iout,*) "vcm",(vcm(j),j=1,3)," summas",summas - do j=1,3 - vcm(j)=vcm(j)/summas - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/muca_md.f b/source/unres/src_MD-NEWSC-NEWC/muca_md.f deleted file mode 100644 index c10a6a7..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/muca_md.f +++ /dev/null @@ -1,334 +0,0 @@ - subroutine muca_delta(remd_t_bath,remd_ene,i,iex,delta) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision remd_t_bath(maxprocs) - double precision remd_ene(maxprocs) - double precision muca_ene - double precision betai,betaiex,delta - - betai=1.0/(Rb*remd_t_bath(i)) - betaiex=1.0/(Rb*remd_t_bath(iex)) - - delta=betai*(muca_ene(remd_ene(iex),i,remd_t_bath)- - & muca_ene(remd_ene(i),i,remd_t_bath)) - & -betaiex*(muca_ene(remd_ene(iex),iex,remd_t_bath)- - & muca_ene(remd_ene(i),iex,remd_t_bath)) - - return - end - - double precision function muca_ene(energy,i,remd_t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision y,yp,energy - double precision remd_t_bath(maxprocs) - integer i - - if (energy.lt.elowi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,elowi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-elowi(i))+y) - elseif (energy.gt.ehighi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,ehighi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-ehighi(i))+y) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - muca_ene=remd_t_bath(i)*Rb*y - endif - return - end - - subroutine read_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - imtime=0 - do i=1,4*maxres - hist(i)=0 - enddo - if (modecalc.eq.14.and..not.remd_tlist) then - print *,"MUCAREMD works only with TLIST" - stop - endif - open(89,file='muca.input') - read(89,*) - read(89,*) - if (modecalc.eq.14) then - read(89,*) (elowi(i),ehighi(i),i=1,nrep) - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - elow=elowi(i2rep(me)) - ehigh=ehighi(i2rep(me)) - elowi(me+1)=elow - ehighi(me+1)=ehigh - else - elow=elowi(me+1) - ehigh=ehighi(me+1) - endif - else - read(89,*) elow,ehigh - elowi(1)=elow - ehighi(1)=ehigh - endif - i=0 - do while(.true.) - i=i+1 - read(89,*,end=100) emuca(i),nemuca(i) -cd nemuca(i)=nemuca(i)*remd_t(me+1)*Rb - enddo - 100 continue - nmuca=i-1 - hbin=emuca(nmuca)-emuca(nmuca-1) - write (iout,*) 'hbin',hbin - write (iout,*) me,'elow,ehigh',elow,ehigh - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - factor_min=0.0d0 - factor_min=muca_factor(ehigh) - call print_muca - return - end - - - subroutine print_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - double precision dummy(maxprocs) - - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - endif - - do i=1,nmuca -c print *,'nemuca ',emuca(i),nemuca(i) - do j=0,4 - x=emuca(i)+hbin/5*j - if (modecalc.eq.14) then - if (remd_mlist) then - yp=muca_factor(x)*remd_t(i2rep(me))*Rb - dummy(me+1)=remd_t(i2rep(me)) - y=muca_ene(x,me+1,dummy) - else - yp=muca_factor(x)*remd_t(me+1)*Rb - y=muca_ene(x,me+1,remd_t) - endif - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - else - yp=muca_factor(x)*t_bath*Rb - dummy(1)=t_bath - y=muca_ene(x,1,dummy) - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - endif - enddo - enddo - if(mucadyn.gt.0) then - do i=1,nmuca - write(iout,'(a13,i8,2f12.5)') 'nemuca after ', - & imtime,emuca(i),nemuca(i) - enddo - endif - return - end - - subroutine muca_update(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energy - double precision yp1,ypn - integer k - logical lnotend - - k=int((energy-emuca(1))/hbin)+1 - - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN - if(energy.ge.ehigh) - & write (iout,*) 'MUCA reject',energy,emuca(k) - if(energy.ge.ehigh.and.(energy-ehigh).lt.hbin) then - write (iout,*) 'MUCA ehigh',energy,emuca(k) - do i=k,nmuca - hist(i)=hist(i)+1 - enddo - endif - if(k.gt.0.and.energy.lt.ehigh) hist(k)=hist(k)+1 - ELSE - if(k.gt.0.and.k.lt.4*maxres) hist(k)=hist(k)+1 - ENDIF - if(mod(imtime,mucadyn).eq.0) then - - do i=1,nmuca - IF(muca_smooth.eq.2.or.muca_smooth.eq.3) THEN - nemuca(i)=nemuca(i)+dlog(hist(i)+1) - ELSE - if (hist(i).gt.0) hist(i)=dlog(hist(i)) - nemuca(i)=nemuca(i)+hist(i) - ENDIF - hist(i)=0 - write(iout,'(a24,i8,2f12.5)')'nemuca before smoothing ', - & imtime,emuca(i),nemuca(i) - enddo - - - lnotend=.true. - ismooth=0 - ist=2 - ien=nmuca-1 - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN -c lnotend=.false. -c do i=1,nmuca-1 -c do j=i+1,nmuca -c if(nemuca(j).lt.nemuca(i)) lnotend=.true. -c enddo -c enddo - do while(lnotend) - ismooth=ismooth+1 - write (iout,*) 'MUCA update smoothing',ist,ien - do i=ist,ien - nemuca(i)=(nemuca(i-1)+nemuca(i)+nemuca(i+1))/3 - enddo - lnotend=.false. - ist=0 - ien=0 - do i=1,nmuca-1 - do j=i+1,nmuca - if(nemuca(j).lt.nemuca(i)) then - lnotend=.true. - if(ist.eq.0) ist=i-1 - if(ien.lt.j+1) ien=j+1 - endif - enddo - enddo - enddo - ENDIF - - write (iout,*) 'MUCA update ',imtime,' smooth= ',ismooth - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - call print_muca - - endif - return - end - - double precision function muca_factor(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - double precision y,yp,energy - - if (energy.lt.elow) then - call splint(emuca,nemuca,nemuca2,nmuca,elow,y,yp) - elseif (energy.gt.ehigh) then - call splint(emuca,nemuca,nemuca2,nmuca,ehigh,y,yp) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - endif - - if(yp.ge.factor_min) then - muca_factor=yp - else - muca_factor=factor_min - endif -cd print *,'energy, muca_factor',energy,muca_factor - return - end - - - SUBROUTINE spline(x,y,n,yp1,ypn,y2) - INTEGER n,NMAX - REAL*8 yp1,ypn,x(n),y(n),y2(n) - PARAMETER (NMAX=500) - INTEGER i,k - REAL*8 p,qn,sig,un,u(NMAX) - if (yp1.gt..99e30) then - y2(1)=0. - u(1)=0. - else - y2(1)=-0.5 - u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1) - endif - do i=2,n-1 - sig=(x(i)-x(i-1))/(x(i+1)-x(i-1)) - p=sig*y2(i-1)+2. - y2(i)=(sig-1.)/p - u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1)) - * /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p - enddo - if (ypn.gt..99e30) then - qn=0. - un=0. - else - qn=0.5 - un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1))) - endif - y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.) - do k=n-1,1,-1 - y2(k)=y2(k)*y2(k+1)+u(k) - enddo - return - END - - - SUBROUTINE splint(xa,ya,y2a,n,x,y,yp) - INTEGER n - REAL*8 x,y,xa(n),y2a(n),ya(n),yp - INTEGER k,khi,klo - REAL*8 a,b,h - klo=1 - khi=n - 1 if (khi-klo.gt.1) then - k=(khi+klo)/2 - if (xa(k).gt.x) then - khi=k - else - klo=k - endif - goto 1 - endif - h=xa(khi)-xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' - a=(xa(khi)-x)/h - b=(x-xa(klo))/h - y=a*ya(klo)+b*ya(khi)+ - * ((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6. - yp=-ya(klo)/h+ya(khi)/h-3*(a**2)*y2a(klo)*h/6. - + +(3*(b**2)-1)*y2a(khi)*h/6. - return - END diff --git a/source/unres/src_MD-NEWSC-NEWC/parmread.F b/source/unres/src_MD-NEWSC-NEWC/parmread.F deleted file mode 100644 index 7fe7caf..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/parmread.F +++ /dev/null @@ -1,1223 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - include 'COMMON.SETUP' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) - enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) - enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) - enddo -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 - write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - write (2,*) "Start reading THETA_PDB" - do i=1,ntyp - read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - write (2,*) "End reading THETA_PDB" - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) -#endif - close(irotam) - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) - si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j)=v0ij - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - endif -C -C 6/23/01 Read parameters for double torsionals -C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k), - & ntermd_2(i,j,k) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k), - & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k), - & m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - enddo - enddo - enddo - endif -#endif -C Read of Side-chain backbone correlation parameters -C Modified 11 May 2012 by Adasko -CCC -C - read (isccor,*,end=1113,err=1113) nsccortyp - read (isccor,*,end=1113,err=1113) (isccortyp(i),i=1,ntyp) - write (iout,*) 'ntortyp',ntortyp - maxinter = 3 -cc maxinter is maximum interaction sites - DO l = 1, maxinter - DO i = 1, nsccortyp - DO j = 1, nsccortyp - read (isccor,*,end=1113,err=1113) nterm_sccor(i,j), - & nlor_sccor(i,j) - v0ijsccor = 0.0d0 - si = -1.0d0 - - DO k = 1, nterm_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk, v1sccor(k,l,i,j) - & ,v2sccor(k,l,i,j) - v0ijsccor = v0ijsccor + si * v1sccor(k,l,i,j) - si = -si - END DO - DO k = 1, nlor_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk, vlor1sccor(k,i,j), - & vlor2sccor(k,i,j),vlor3sccor(k,i,j) - v0ijsccor = v0ijsccor + vlor1sccor(k,i,j) / - & (1 + vlor3sccor(k,i,j)**2) - END DO - v0sccor(i,j) = v0ijsccor - END DO - END DO - END DO - close (isccor) - - IF (lprint) THEN - write (iout,'(/a/)') 'Torsional constants:' - DO i=1,nsccortyp - DO j=1,nsccortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - DO k=1,nterm_sccor(i,j) - write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) - END DO - write (iout,*) 'Lorenz constants' - DO k=1,nlor_sccor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) - END DO - END DO - END DO - END IF -C -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - IF (lprint) THEN - write (iout,*) - write (iout,*) "Coefficients of the cumulants" - END IF - read (ifourier,*) nloctyp - DO i=1,nloctyp - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) - IF (lprint) THEN - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13) - END IF - B1(1,i) = b(3) - B1(2,i) = b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 - B1tilde(1,i) = b(3) - B1tilde(2,i) =-b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 - B2(1,i) = b(2) - B2(2,i) = b(4) -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CC(1,1,i)= b(7) - CC(2,2,i)=-b(7) - CC(2,1,i)= b(9) - CC(1,2,i)= b(9) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 - Ctilde(1,1,i)=b(7) - Ctilde(1,2,i)=b(9) - Ctilde(2,1,i)=-b(9) - Ctilde(2,2,i)=b(7) -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DD(1,1,i)= b(6) - DD(2,2,i)=-b(6) - DD(2,1,i)= b(8) - DD(1,2,i)= b(8) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 - Dtilde(1,1,i)=b(6) - Dtilde(1,2,i)=b(8) - Dtilde(2,1,i)=-b(8) - Dtilde(2,2,i)=b(6) -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EE(1,1,i)= b(10)+b(11) - EE(2,2,i)=-b(10)+b(11) - EE(2,1,i)= b(12)-b(13) - EE(1,2,i)= b(12)+b(13) -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) - enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) - enddo - enddo - endif -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.6) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40,50) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 60 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 60 -C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GB or BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 60 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - goto 60 - -C--------------------- Momo potential ----------------------------------- - - 50 continue - - read (isidep,*) (icharge(i),i=1,ntyp) -c write (2,*) "icharge",(icharge(i),i=1,ntyp) - do i=1,ntyp - do j=1,i -c! write (*,*) "Im in ", i, " ", j - read(isidep,*) - & eps(i,j),sigma(i,j),chi(i,j),chi(j,i),chipp(i,j),chipp(j,i), - & (alphasur(k,i,j),k=1,4),sigmap1(i,j),sigmap2(i,j), - & chis(i,j),chis(j,i), - & nstate(i,j),(wstate(k,i,j),k=1,4), - & dhead(1,1,i,j), - & dhead(1,2,i,j), - & dhead(2,1,i,j), - & dhead(2,2,i,j), - & dtail(1,i,j),dtail(2,i,j), - & epshead(i,j),sig0head(i,j), - & rborn(i,j),rborn(j,i), - & (wqdip(k,i,j),k=1,2),wquad(i,j), - & alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso1(i,j),sigiso2(i,j),epsintab(i,j) - END DO - END DO -c! write (*,*) "nstate gly-gly", nstate(10,10) -c! THIS LOOP FILLS PARAMETERS FOR PAIRS OF AA's NOT EXPLICITLY -c! DEFINED IN SCPARM.MOMO. IT DOES SO BY TAKING THEM FROM SYMMETRIC -c! PAIR, FOR EG. IF ARG-HIS IS BLANK, IT WILL TAKE PARAMETERS -c! FROM HIS-ARG. -c! -c! DISABLE IT AT >>YOUR OWN PERIL<< -c! - DO i = 1, ntyp - DO j = i+1, ntyp - eps(i,j) = eps(j,i) - sigma(i,j) = sigma(j,i) - nstate(i,j) = nstate(j,i) - sigmap1(i,j) = sigmap1(j,i) - sigmap2(i,j) = sigmap2(j,i) - sigiso1(i,j) = sigiso1(j,i) - sigiso2(i,j) = sigiso2(j,i) - - DO k = 1, 4 - alphasur(k,i,j) = alphasur(k,j,i) - wstate(k,i,j) = wstate(k,j,i) - alphiso(k,i,j) = alphiso(k,j,i) - END DO - - dhead(2,1,i,j) = dhead(1,1,j,i) - dhead(2,2,i,j) = dhead(1,2,j,i) - dhead(1,1,i,j) = dhead(2,1,j,i) - dhead(1,2,i,j) = dhead(2,2,j,i) - dtail(1,i,j) = dtail(1,j,i) - dtail(2,i,j) = dtail(2,j,i) -c! DO k = 1, 2 -c! DO l = 1, 2 -c! write (*,*) "dhead(k,l,j,i) = ", dhead(k,l,j,i) -c! write (*,*) "dhead(k,l,i,j) = ", dhead(k,l,i,j) -c! dhead(l,k,i,j) = dhead(k,l,j,i) -c! END DO -c! END DO - - epshead(i,j) = epshead(j,i) - sig0head(i,j) = sig0head(j,i) - - DO k = 1, 2 - wqdip(k,i,j) = wqdip(k,j,i) - END DO - - wquad(i,j) = wquad(j,i) - epsintab(i,j) = epsintab(j,i) - - END DO - END DO - - if (.not.lprint) goto 70 - write (iout,'(a)') - & "Parameters of the new physics-based SC-SC interaction potential" - write (iout,'(/7a)') 'Residues',' epsGB',' rGB', - & ' chi1GB',' chi2GB',' chip1GB',' chip2GB' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),1pe10.3,5(0pf10.3))') - & restyp(i),restyp(j),eps(i,j),sigma(i,j),chi(i,j),chi(j,i), - & chipp(i,j),chipp(j,i) - enddo - enddo - write (iout,'(/9a)') 'Residues',' alphasur1',' alphasur2', - & ' alphasur3',' alphasur4',' sigmap1',' sigmap2', - & ' chis1',' chis2' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),8(0pf10.3))') - & restyp(i),restyp(j),(alphasur(k,i,j),k=1,4), - & sigmap1(i,j),sigmap2(j,i),chis(i,j),chis(j,i) - enddo - enddo - write (iout,'(/14a)') 'Residues',' nst ',' wst1', - & ' wst2',' wst3',' wst4',' dh11',' dh21', - & ' dh12',' dh22',' dt1',' dt2',' epsh1', - & ' sigh' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),i3,4f8.3,6f7.2,f9.5,f7.2)') - & restyp(i),restyp(j),nstate(i,j),(wstate(k,i,j),k=1,4), - & ((dhead(l,k,i,j),l=1,2),k=1,2),dtail(1,i,j),dtail(2,i,j), - & epshead(i,j),sig0head(i,j) - enddo - enddo - write (iout,'(/12a)') 'Residues',' ch1',' ch2', - & ' rborn1',' rborn2',' wqdip1',' wqdip2', - & ' wquad' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),2i4,5f10.3)') - & restyp(i),restyp(j),icharge(i),icharge(j), - & rborn(i,j),rborn(j,i),(wqdip(k,i,j),k=1,2),wquad(i,j) - enddo - enddo - write (iout,'(/12a)') 'Residues', - & ' alphpol1', - & ' alphpol2',' alphiso1',' alpiso2', - & ' alpiso3',' alpiso4',' sigiso1',' sigiso2', - & ' epsin' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),11f10.3)') - & restyp(i),restyp(j),alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso1(i,j),sigiso2(j,i), - & epsintab(i,j) - enddo - enddo - goto 70 - -C For the GB potential convert sigma'**2 into chi' - DO i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - END DO - IF (lprint) THEN - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - CALL printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - END IF - GOTO 60 - 60 CONTINUE - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - do k=1,4 - alphasur(k,j,i)=alphasur(k,i,j) - alphiso(k,j,i)=alphiso(k,i,j) - wstate(k,j,i)=wstate(k,i,j) - enddo - do k=1,2 - wqdip(k,j,i)=wqdip(k,i,j) - enddo - do k=1,2 - do l=1,2 - dhead(l,k,j,i)=dhead(l,k,i,j) - enddo - enddo - enddo - enddo - IF (ipot.LT.6) THEN - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - END IF - - 70 continue - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4 .or. ipot.eq.6 ) THEN - rrij=sigma(i,j) - else - rrij=rr0(i)+rr0(j) - endif - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) - IF ((ipot.gt.2).AND.(ipot.LT.6)) THEN - sigt1sq=sigma0(i)**2 - sigt2sq=sigma0(j)**2 - sigii1=sigii(i) - sigii2=sigii(j) - ratsig1=sigt2sq/sigt1sq - ratsig2=1.0D0/ratsig1 - chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1) - if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - else - rsum_max=sigma(i,j) - endif -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - if (lprint) then - if (ipot.lt.6) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - else - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3),2i3,10f8.4, - & i3,40f10.4)') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i), - & icharge(i),icharge(j),chipp(i,j),chipp(j,i), - & (alphasur(k,i,j),k=1,4),sigmap1(i,j),sigmap2(j,i), - & chis(i,j),chis(j,i), - & nstate(i,j),(wstate(k,i,j),k=1,4), - & ((dhead(l,k,i,j),l=1,2),k=1,2),dtail(1,i,j),dtail(2,i,j), - & epshead(i,j),sig0head(i,j), - & rborn(i,j),(wqdip(k,i,j),k=1,2),wquad(i,j), - & alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso1(i,j),sigiso2(i,j) - - endif - endif - enddo - enddo -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,20 -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo - - if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" - do i=1,20 - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -#endif -C -C Define the constants of the disulfide bridge -C - ebr=-5.50D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 1113 write (iout,*) - & "Error reading side-chain torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif - - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/parmread_v3ok1.F b/source/unres/src_MD-NEWSC-NEWC/parmread_v3ok1.F deleted file mode 100644 index 299309e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/parmread_v3ok1.F +++ /dev/null @@ -1,1245 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - include 'COMMON.SETUP' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) - enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) - enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) - enddo -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 - write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - write (2,*) "Start reading THETA_PDB" - do i=1,ntyp - read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - write (2,*) "End reading THETA_PDB" - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) -#endif - close(irotam) - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) - si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j)=v0ij - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - endif -C -C 6/23/01 Read parameters for double torsionals -C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k), - & ntermd_2(i,j,k) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k), - & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k), - & m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - enddo - enddo - enddo - endif -#endif -C -C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local -C correlation energies. -C - read (isccor,*,end=119,err=119) nterm_sccor - do i=1,20 - do j=1,20 - read (isccor,'(a)') - do k=1,nterm_sccor - read (isccor,*,end=119,err=119) kk,v1sccor(k,i,j), - & v2sccor(k,i,j) - enddo - enddo - enddo - close (isccor) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants of SCCORR:' - do i=1,20 - do j=1,20 - write (iout,*) 'ityp',i,' jtyp',j - do k=1,nterm_sccor - write (iout,'(2(1pe15.5))') v1sccor(k,i,j),v2sccor(k,i,j) - enddo - enddo - enddo - endif -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - read (ifourier,*,end=115,err=115) nloctyp - do i=1,nloctyp - read (ifourier,*) - read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13) -#ifdef NEWCORR - read (ifourier,*,end=115,err=115) (bnew1(ii,1,i),ii=1,3) - read (ifourier,*,end=115,err=115) (bnew2(ii,1,i),ii=1,3) - read (ifourier,*,end=115,err=115) (bnew1(ii,2,i),ii=1,1) - read (ifourier,*,end=115,err=115) (bnew2(ii,2,i),ii=1,1) - read (ifourier,*,end=115,err=115) (eenew(ii,i),ii=1,1) -#endif - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) - do ii=1,3 - write (iout,'("Bnew1",i3,2f10.5)') ii,(bnew1(ii,k,i),k=1,2) - write (iout,'("Bnew2",i3,2f10.5)') ii,(bnew2(ii,k,i),k=1,2) - enddo - do ii=1,1 - write (iout,'("EEnew",i3,2f10.5)') ii,eenew(ii,i) - enddo - endif -#ifndef NEWCORR - B1(1,i) = b(3,i) - B1(2,i) = b(5,i) - B1tilde(1,i) = b(3,i) - B1tilde(2,i) =-b(5,i) - B2(1,i) = b(2,i) - B2(2,i) = b(4,i) -#endif - CC(1,1,i)= b(7,i) - CC(2,2,i)=-b(7,i) - CC(2,1,i)= b(9,i) - CC(1,2,i)= b(9,i) - Ctilde(1,1,i)=b(7,i) - Ctilde(1,2,i)=b(9,i) - Ctilde(2,1,i)=-b(9,i) - Ctilde(2,2,i)=b(7,i) - DD(1,1,i)= b(6,i) - DD(2,2,i)=-b(6,i) - DD(2,1,i)= b(8,i) - DD(1,2,i)= b(8,i) - Dtilde(1,1,i)=b(6,i) - Dtilde(1,2,i)=b(8,i) - Dtilde(2,1,i)=-b(8,i) - Dtilde(2,2,i)=b(6,i) -#ifdef NEWCORR - EEold(1,1,i)= b(10,i)+b(11,i) - EEold(2,2,i)=-b(10,i)+b(11,i) - EEold(2,1,i)= b(12,i)-b(13,i) - EEold(1,2,i)= b(12,i)+b(13,i) -c EEold(1,1,-i)= b(10,i)+b(11,i) -c EEold(2,2,-i)=-b(10,i)+b(11,i) -c EEold(2,1,-i)=-b(12,i)+b(13,i) -c EEold(1,2,-i)=-b(12,i)-b(13,i) -#else - EE(1,1,i)= b(10,i)+b(11,i) - EE(2,2,i)=-b(10,i)+b(11,i) - EE(2,1,i)= b(12,i)-b(13,i) - EE(1,2,i)= b(12,i)+b(13,i) -#endif - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) - enddo - enddo - endif -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.6) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40,50) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 60 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 60 -C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 60 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - goto 60 - -C--------------------- Momo potential ----------------------------------- - - 50 continue - - read (isidep,*) (icharge(i),i=1,ntyp) -c write (2,*) "icharge",(icharge(i),i=1,ntyp) - do i=1,ntyp - do j=1,i -c! write (*,*) "Im in ", i, " ", j - read(isidep,*) - & eps(i,j),sigma(i,j),chi(i,j),chi(j,i),chipp(i,j),chipp(j,i), - & (alphasur(k,i,j),k=1,4),sigmap(i,j),sigmap(j,i), - & chis(i,j),chis(j,i), - & nstate(i,j),(wstate(k,i,j),k=1,4), - & ((dhead(l,k,i,j),k=1,2),l=1,2),dtail(i,j),dtail(j,i), - & epshead(i,j),sig0head(i,j), - & rborn(i,j),rborn(j,i),(wqdip(k,i,j),k=1,2),wquad(i,j), - & alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso(i,j),sigiso(j,i),epsintab(i,j) - END DO - END DO - -c! write (*,*) "Parameters read in" - -c! THIS LOOP FILLS PARAMETERS FOR PAIRS OF AA's NOT EXPLICITLY -c! DEFINED IN SCPARM.MOMO. IT DOES SO BY TAKING THEM FROM SYMMETRIC -c! PAIR, FOR EG. IF ARG-HIS IS BLANK, IT WILL TRY TO TAKE PARAMETERS -c! FROM HIS-ARG. -c! -c! DISABLE IT AT >>YOUR OWN PERIL<< -c! - DO i = 1, ntyp - DO j = i+1, ntyp - eps(i,j) = eps(j,i) - sigma(i,j) = sigma(j,i) - nstate(i,j) = nstate(j,i) - - DO k = 1, 4 - alphasur(k,i,j) = alphasur(k,j,i) - wstate(k,i,j) = wstate(k,j,i) - alphiso(k,i,j) = alphiso(k,j,i) - END DO - - DO k = 1, 2 - DO l = 1, 2 - dhead(k,l,i,j) = dhead(k,l,j,i) - END DO - END DO - - epshead(i,j) = epshead(j,i) - sig0head(i,j) = sig0head(j,i) - - DO k = 1, 2 - wqdip(k,i,j) = wqdip(k,j,i) - END DO - - wquad(i,j) = wquad(j,i) - epsintab(i,j) = epsintab(j,i) - - END DO - END DO - -c! IF (1.eq.0) THEN -c! write (*,*) "" -c! write (*,*) "" -c! write (*,'(f17.15)') ((eps(i,j),j=i,ntyp), i=1, ntyp) -c! write (*,'(f17.15)') (sigma0(i),i=1,ntyp) -c! write (*,'(f17.15)') (sigii(i),i=1,ntyp) -c! write (*,'(f17.15)') (chip(i),i=1,ntyp) -c! write (*,'(f17.15)') (alp(i),i=1,ntyp) -c! write (*,*) "" -c! write (*,*) "" -c! END IF - -c! This is older parameter-filling loop -c! DO i = 1, ntyp -c! DO j = 1, ntyp -c -c IF ((sig0head(i,j).EQ.0.0d0).AND.(sig0head(j,i).NE.0.0d0)) THEN -c sig0head(i,j) = sig0head(j,i) -c ELSE IF ((sig0head(j,i).EQ.0.0d0).AND.(sig0head(i,j).NE.0.0d0)) -c & THEN -c sig0head(j,i) = sig0head(i,j) -c END IF -c -c IF ((epshead(i,j).EQ.0.0d0).AND.(epshead(j,i).NE.0.0d0)) THEN -c epshead(i,j) = epshead(j,i) -c ELSE IF ((epshead(j,i).EQ.0.0d0).AND.(epshead(i,j).NE.0.0d0)) -c & THEN -c epshead(j,i) = epshead(i,j) -c END IF -c -c IF ((wquad(i,j).EQ.0.0d0).AND.(wquad(j,i).NE.0.0d0)) THEN -c wquad(i,j) = wquad(j,i) -c ELSE IF ((wquad(j,i).EQ.0.0d0).AND.(wquad(i,j).NE.0.0d0)) -c & THEN -c wquad(j,i) = wquad(i,j) -c END IF -c -c IF ((sigiso(i,j).EQ.0.0d0).AND.sigiso(j,i).NE.0.0d0)) THEN -c sigiiso(i,j) = sigiso(j,i) -c ELSE IF ((epshead(j,i).EQ.0.0d0).AND.(epshead(i,j).NE.0.0d0)) -c & THEN -c sigiso(j,i) = sigiso(i,j) -c END IF -c! DO k = 1, 4 -c! IF ((wstate(k,i,j).EQ.0.0d0).AND. -c! & (wstate(k,j,i).NE.0.0d0)) THEN -c! wstate(k,i,j) = wstate(k,j,i) -c! ELSE IF ((wstate(k,j,i).EQ.0.0d0).AND. -c! & (wstate(k,i,j).NE.0.0d0)) THEN -c! wstate(k,j,i) = wstate(k,i,j) -c! END IF -c! END DO -c! END DO -c! END DO -c! THE LOOP MAKING MOMO_TABLES SYMMETRIC ENDS HERE - - if (.not.lprint) goto 70 - write (iout,'(a)') - & "Parameters of the new physics-based SC-SC interaction potential" - write (iout,'(/7a)') 'Residues',' epsGB',' rGB', - & ' chi1GB',' chi2GB',' chip1GB',' chip2GB' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),1pe10.3,5(0pf10.3))') - & restyp(i),restyp(j),eps(i,j),sigma(i,j),chi(i,j),chi(j,i), - & chipp(i,j),chipp(j,i) - enddo - enddo - write (iout,'(/9a)') 'Residues',' alphasur1',' alphasur2', - & ' alphasur3',' alphasur4',' sigmap1',' sigmap2', - & ' chis1',' chis2' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),8(0pf10.3))') - & restyp(i),restyp(j),(alphasur(k,i,j),k=1,4), - & sigmap(i,j),sigmap(j,i),chis(i,j),chis(j,i) - enddo - enddo - write (iout,'(/14a)') 'Residues',' nst ',' wst1', - & ' wst2',' wst3',' wst4',' dh11',' dh21', - & ' dh12',' dh22',' dt1',' dt2',' epsh1', - & ' sigh' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),i3,4f8.3,6f7.2,f9.5,f7.2)') - & restyp(i),restyp(j),nstate(i,j),(wstate(k,i,j),k=1,4), - & ((dhead(l,k,i,j),l=1,2),k=1,2),dtail(i,j),dtail(j,i), - & epshead(i,j),sig0head(i,j) - enddo - enddo - write (iout,'(/12a)') 'Residues',' ch1',' ch2', - & ' rborn1',' rborn2',' wqdip1',' wqdip2', - & ' wquad' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),2i4,5f10.3)') - & restyp(i),restyp(j),icharge(i),icharge(j), - & rborn(i,j),rborn(j,i),(wqdip(k,i,j),k=1,2),wquad(i,j) - enddo - enddo - write (iout,'(/12a)') 'Residues', - & ' alphpol1', - & ' alphpol2',' alphiso1',' alpiso2', - & ' alpiso3',' alpiso4',' sigiso1',' sigiso2', - & ' epsin' - do i=1,ntyp - do j=1,i - write (iout,'(2(a3,1x),11f10.3)') - & restyp(i),restyp(j),alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso(i,j),sigiso(j,i),epsintab(i,j) - enddo - enddo - goto 70 - -C For the GB potential convert sigma'**2 into chi' - DO i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - END DO - IF (lprint) THEN - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - CALL printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - END IF - GOTO 60 - 60 CONTINUE - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - do k=1,4 - alphasur(k,j,i)=alphasur(k,i,j) - alphiso(k,j,i)=alphiso(k,i,j) - wstate(k,j,i)=wstate(k,i,j) - enddo - do k=1,2 - wqdip(k,j,i)=wqdip(k,i,j) - enddo - do k=1,2 - do l=1,2 - dhead(l,k,j,i)=dhead(l,k,i,j) - enddo - enddo - enddo - enddo - IF (ipot.LT.6) THEN - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - END IF - - 70 continue - - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - IF (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4 .or. ipot.eq.6) - & THEN - rrij=sigma(i,j) - ELSE - rrij=rr0(i)+rr0(j) - END IF - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) - IF ((ipot.GT.2).AND.(ipot.LT.6)) THEN - sigt1sq = sigma0(i)**2 - sigt2sq = sigma0(j)**2 - sigii1 = sigii(i) - sigii2 = sigii(j) - ratsig1 = sigt2sq/sigt1sq - ratsig2 = 1.0D0/ratsig1 - chi(i,j) = (sigii1-1.0D0) / (sigii1+ratsig1) - IF (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - ELSE - rsum_max=sigma(i,j) - END IF -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - - if (lprint) then - if (ipot.lt.6) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - else - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3),2i3,10f8.4, - & i3,40f10.4)') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i), - & icharge(i),icharge(j),chipp(i,j),chipp(j,i), - & (alphasur(k,i,j),k=1,4),sigmap(i,j),sigmap(j,i), - & chis(i,j),chis(j,i), - & nstate(i,j),(wstate(k,i,j),k=1,4), - & ((dhead(l,k,i,j),l=1,2),k=1,2),dtail(i,j),dtail(j,i), - & epshead(i,j),sig0head(i,j), - & rborn(i,j),(wqdip(k,i,j),k=1,2),wquad(i,j), - & alphapol(i,j),alphapol(j,i), - & (alphiso(k,i,j),k=1,4),sigiso(i,j) - - endif - endif - enddo - enddo - - - -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,20 -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo - - if (lprint) then - write (iout,'(/a)') "Parameters of SC-p interactions:" - do i=1,20 - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -#endif -C -C Define the constants of the disulfide bridge -C - ebr=-5.50D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - -c! print *, " " -c! print *, "END OF PARMREAD" -c! print *, "eps = ", eps(9,9), "sigma = ", sigma(9,9) -c! print *, "chi1 = ", chi(9,9), "chi2 = ", chi(9,9) -c! print *, "chip1 = ", chipp(9,9), "chip2 = ", chipp(9,9) -c! print *, "sig1 = ", sigmap(9,9), "sig2 = ", sigmap(9,9) -c! print *, "chis1 = ", chis(9,9)," chis2 = ", chis(9,9) -c! print *, "END OF PARMREAD" -c! print *, " " - - - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif - - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/pinorm.f b/source/unres/src_MD-NEWSC-NEWC/pinorm.f deleted file mode 100644 index 91392bf..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/pinorm.f +++ /dev/null @@ -1,17 +0,0 @@ - double precision function pinorm(x) - implicit real*8 (a-h,o-z) -c -c this function takes an angle (in radians) and puts it in the range of -c -pi to +pi. -c - integer n - include 'COMMON.GEO' - n = x / dwapi - pinorm = x - n * dwapi - if ( pinorm .gt. pi ) then - pinorm = pinorm - dwapi - else if ( pinorm .lt. - pi ) then - pinorm = pinorm + dwapi - end if - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/printmat.f b/source/unres/src_MD-NEWSC-NEWC/printmat.f deleted file mode 100644 index be2b38f..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/printmat.f +++ /dev/null @@ -1,16 +0,0 @@ - subroutine printmat(ldim,m,n,iout,key,a) - character*3 key(n) - double precision a(ldim,n) - do 1 i=1,n,8 - nlim=min0(i+7,n) - write (iout,1000) (key(k),k=i,nlim) - write (iout,1020) - 1000 format (/5x,8(6x,a3)) - 1020 format (/80(1h-)/) - do 2 j=1,n - write (iout,1010) key(j),(a(j,k),k=i,nlim) - 2 continue - 1 continue - 1010 format (a3,2x,8(f9.4)) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/prng.f b/source/unres/src_MD-NEWSC-NEWC/prng.f deleted file mode 100644 index 73f6766..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/prng.f +++ /dev/null @@ -1,525 +0,0 @@ - real*8 function prng_next(me) - implicit none - integer me -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end diff --git a/source/unres/src_MD-NEWSC-NEWC/prng_32.F b/source/unres/src_MD-NEWSC-NEWC/prng_32.F deleted file mode 100644 index 9448f31..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/prng_32.F +++ /dev/null @@ -1,1077 +0,0 @@ -#if defined(AIX) || defined(AMD64) - real*8 function prng_next(mel) - implicit none - integer me,mel -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (mel, iseed) - implicit none - integer me,mel - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end -#else - real function prng_next(me) -crc logical prng_restart, prng_chkpnt -c -c Calling sequence: -c = prng_next ( ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses 4 16-bit packets, and uses a block data common -c area for the initial seeds and constants. A 64-bit floating point -c number is returned. -c -c The arrays "l" and "n" are full-word aligned, being padded by zeros -c That is, rows 1-4 in a given column are for real, rows 5-16 are bogus -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c - real tpm12 - integer iseed(4) - parameter(tpm12 = 1.d0/65536.d0) - parameter(nmax=1021) -c external prngblk - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - data m1,m2,m3,m4 / 0, 8037, 61950, 30779/ - if (me .lt. 0 .or. me .gt. nmax) then - prng_next=-1.0 - return - endif - l1=l(1,me) - l2=l(2,me) - l3=l(3,me) - l4=l(4,me) - i1=l1*m4+l2*m3+l3*m2+l4*m1 + n(1,me) - i2=l2*m4+l3*m3+l4*m2 + n(2,me) - i3=l3*m4+l4*m3 + n(3,me) - i4=l4*m4 + n(4,me) - l4=and(i4,65535) - i3=i3+ishft(i4,-16) - l3=and(i3,65535) - i2=i2+ishft(i3,-16) - l2=and(i2,65535) - l1=and(i1+ishft(i2,-16),65535) - prng_next=tpm12*(l1+tpm12*(l2+tpm12*(l3+tpm12*l4))) - l(1,me)=l1 - l(2,me)=l2 - l(3,me)=l3 - l(4,me)=l4 - return - end -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c -crc entry prng_chkpnt (me, iseed) - logical function prng_chkpnt (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed(1)=l(1,me) - iseed(2)=l(2,me) - iseed(3)=l(3,me) - iseed(4)=l(4,me) - endif - return - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c seed is an 4-element integer array containing the "l"-values -c -crc entry prng_restart (me, iseed) - logical function prng_restart (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - l(1,me)=iseed(1) - l(2,me)=iseed(2) - l(3,me)=iseed(3) - l(4,me)=iseed(4) - endif - return - end - - block data prngblk -c -c Sequence of prime numbers represented as pairs of 16-bit integers -c modulo 2**16, obtained from Mal Kalos August 28, 1992. Only 98 -c continuation cards are allowed by ksr Fortran, so several DATA -c statements are used to initialize 1022 generators. -c -c @cornell university, 1992 -c - parameter(nmax=1021,nmax1=2*nmax+2) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - -c High order quads in arrays "l" and "n" are initialized to zero : rows 1-2 -c Rows 5-16 remain uninitialized. They are just pads, never used. - DATA ((l(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - DATA ((n(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - -c The rest of array "l" and "n" are initialized to a 20-bit seed - DATA ((l(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180,51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((l(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((l(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181,1015,181,1021,181,1023,181,1041,181,1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - DATA ((n(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180, 51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((n(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((n(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181, 1015,181, 1021,181, 1023,181, 1041,181, 1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - end -#endif diff --git a/source/unres/src_MD-NEWSC-NEWC/proc_proc.c b/source/unres/src_MD-NEWSC-NEWC/proc_proc.c deleted file mode 100644 index d77c5a4..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/proc_proc.c +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include - -#ifdef CRAY -void PROC_PROC(long int *f, int *i) -#else -#ifdef LINUX -#ifdef PGI -void proc_proc_(long int *f, int *i) -#else -void proc_proc__(long int *f, int *i) -#endif -#endif -#ifdef SGI -void proc_proc_(long int *f, int *i) -#endif -#if defined(WIN) && !defined(WINIFL) -void _stdcall PROC_PROC(long int *f, int *i) -#endif -#ifdef WINIFL -void proc_proc(long int *f, int *i) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_proc(long int *f, int *i) -#endif -#endif - -{ -static long int NaNQ; -static long int NaNQm; - -if(*i==-1) - { - NaNQ=*f; - NaNQm=0xffffffff; - return; - } -*i=0; -if(*f==NaNQ) - *i=1; -if(*f==NaNQm) - *i=1; -} - -#ifdef CRAY -void PROC_CONV(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV(char *buf, int *i, int n) -#endif -{ -int j; - -sscanf(buf,"%d",&j); -*i=j; -return; -} - -#ifdef CRAY -void PROC_CONV_R(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv_r__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_r_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv_r(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV_R(char *buf, int *i, int n) -#endif - -{ - -/* sprintf(buf,"%d",*i); */ - -return; -} - - -#ifndef IMSL -#ifdef CRAY -void DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef LINUX -void dsvrgp__(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef SGI -void dsvrgp_(int *n, double *tab1, double *tab2, int *itab) -#endif -#if defined(AIX) || defined(WINPGI) -void dsvrgp(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef WIN -void _stdcall DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -{ -double t; -int i,j,k; - -if(tab1 != tab2) - { - for(i=0; i<*n; i++) - tab2[i]=tab1[i]; - } -k=0; -while(k<*n-1) - { - j=k; - t=tab2[k]; - for(i=k+1; i<*n; i++) - if(t>tab2[i]) - { - j=i; - t=tab2[i]; - } - if(j!=k) - { - tab2[j]=tab2[k]; - tab2[k]=t; - i=itab[j]; - itab[j]=itab[k]; - itab[k]=i; - } - k++; - } -} -#endif diff --git a/source/unres/src_MD-NEWSC-NEWC/q_measure.F b/source/unres/src_MD-NEWSC-NEWC/q_measure.F deleted file mode 100644 index 417cf35..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/q_measure.F +++ /dev/null @@ -1,487 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x - sigm(x)=0.25d0*x - qq = 0.0d0 - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - endif - qwolynes=1.0d0-qq - return - end -c------------------------------------------------------------------- - subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist - double precision dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x,sim,dd0,fac,ddqij - sigm(x)=0.25d0*x - - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim = sim*sim - dd0=dijCM-d0ijCM - fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim=sim*sim - dd0 = dijCM-d0ijCM - fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - endif - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-10/ - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=(q2-q1)/delta - c(j,i)=cdummy(j,i) - enddo - enddo - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo -c write(iout,*) "Numerical Q carteisan gradients backbone: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) -c enddo -c write(iout,*) "Numerical Q carteisan gradients side-chain: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) -c enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i), - & qinfrag(i,iset)) -c hm1=harmonic(qfrag(i,iset),qinfrag(i,iset)) -c hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset), -c & qinfrag(i,iset)) -c write(iout,*) "harmonicnum frag", hmnum -c Calculating the derivatives of Q with respect to cartesian coordinates - call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dU/dQi and dQi/dxi -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true. -c & ,idummy,idummy) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c hm1=harmonic(qpair(i),qinpair(i,iset)) -c hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i), -c & qinpair(i,iset)) -c write(iout,*) "harmonicnum pair ", hmnum -c Calculating dQ/dXi - call qwolynes_prim(kstart,kend,.false. - & ,lstart,lend) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients -c call qwol_num(kstart,kend,.false. -c & ,lstart,lend) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - duxcartan(j,i)=0.0d0 - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset), - & ifrag(2,ii,iset),.true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo -c write(iout,*) "Numerical dUconst/ddx side-chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) -c enddo - return - end -c--------------------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/q_measure1.F b/source/unres/src_MD-NEWSC-NEWC/q_measure1.F deleted file mode 100644 index 9c1546d..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/q_measure1.F +++ /dev/null @@ -1,470 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i),ifrag(2,i),.true.,idummy,idummy) - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - integer i,j,k,il,jl,il1,jl1,nd - double precision dist - external dist - double precision dij1,dij2,dij3,dij4,d0ij1,d0ij2,d0ij3,d0ij4,fac, - & fac1,ddave,ssij,ddqij - logical lprn /.false./ - d0ij1=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij1=dist(il,jl) - ddave=(dij1-d0ij1)**2 - nd=1 - if (jl1.ne.jl) then - d0ij2=dsqrt((cref(1,jl1)-cref(1,il))**2+ - & (cref(2,jl1)-cref(2,il))**2+ - & (cref(3,jl1)-cref(3,il))**2) - dij2=dist(il,jl1) - ddave=ddave+(dij2-d0ij2)**2 - nd=nd+1 - endif - if (il1.ne.il) then - d0ij3=dsqrt((cref(1,jl)-cref(1,il1))**2+ - & (cref(2,jl)-cref(2,il1))**2+ - & (cref(3,jl)-cref(3,il1))**2) - dij3=dist(il1,jl) - ddave=ddave+(dij3-d0ij3)**2 - nd=nd+1 - endif - if (il1.ne.il .and. jl1.ne.jl) then - d0ij4=dsqrt((cref(1,jl1)-cref(1,il1))**2+ - & (cref(2,jl1)-cref(2,il1))**2+ - & (cref(3,jl1)-cref(3,il1))**2) - dij4=dist(il1,jl1) - ddave=ddave+(dij4-d0ij4)**2 - nd=nd+1 - endif - ddave=ddave/nd - if (lprn) then - write (iout,*) "il",il," jl",jl, - & " itype",itype(il),itype(jl)," nd",nd - write (iout,*)"d0ij",d0ij1,d0ij2,d0ij3,d0ij4, - & " dij",dij1,dij2,dij3,dij4," ddave",ddave - call flush(iout) - endif -c ssij = (0.25d0*d0ij1)**2 - if (il.ne.il1 .and. jl.ne.jl1) then - ssij = 16.0d0/(d0ij1*d0ij4) - else - ssij = 16.0d0/(d0ij1*d0ij1) - endif - qcontrib = dexp(-0.5d0*ddave*ssij) -c Compute gradient - fac1 = qcontrib*ssij/nd - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (jl1.ne.jl) then - fac = fac1*(dij2-d0ij2)/dij2 - do k=1,3 - ddqij = (c(k,il)-c(k,jl1))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il) then - fac = fac1*(dij3-d0ij3)/dij3 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il .and. jl1.ne.jl) then - fac = fac1*(dij4-d0ij4)/dij4 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/q_measure3.F b/source/unres/src_MD-NEWSC-NEWC/q_measure3.F deleted file mode 100644 index f0a030e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/q_measure3.F +++ /dev/null @@ -1,529 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.,idummy,idummy) - enddo -c stop - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.LOCAL' - integer i,j,k,il,jl,il1,jl1,nd,itl,jtl - double precision dist - external dist - double precision dij,dij1,d0ij,d0ij1,om1,om2,om12,om10,om20,om120 - & ,fac,fac1,ddave,ssij,ddqij,d0ii1,d0jj1,rij,eom1,eom2,eom12 - double precision u(3),v(3),er(3),er0(3),dcosom1(3),dcosom2(3), - & aux1,aux2 - double precision scalar - external scalar - logical lprn /.false./ - if (lprn) write (iout,*) "il",il," jl",jl," il1",il1," jl1",jl1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - dij1=dist(il1,jl1) - do i=1,3 - er(i)=(c(i,jl1)-c(i,il1))/dij1 - enddo - do i=1,3 - er0(i)=cref(i,jl1)-cref(i,il1) - enddo - d0ij1=dsqrt(scalar(er0,er0)) - do i=1,3 - er0(i)=er0(i)/d0ij1 - enddo - if (il.ne.il1 .or. jl.ne.jl1) then - ddave=0.5d0*((dij-d0ij)**2+(dij1-d0ij1)**2) - nd=2 - else - ddave=(dij-d0ij)**2 - nd=1 - endif - if (il.ne.il1) then - do i=1,3 - u(i)=cref(i,il1)-cref(i,il) - enddo - d0ii1=dsqrt(scalar(u,u)) - do i=1,3 - u(i)=u(i)/d0ii1 - enddo - if (lprn) then - write (iout,*) "u",(u(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om10=scalar(er0,u) - om1=scalar(er,dc_norm(1,il1)) - write (iout,*) "om10",om10," om1",om1 - endif - else - om1=0.0d0 - om10=0.0d0 - endif - if (jl.ne.jl1) then - do i=1,3 - v(i)=cref(i,jl1)-cref(i,jl) - enddo - d0jj1=dsqrt(scalar(v,v)) - do i=1,3 - v(i)=v(i)/d0jj1 - enddo - if (lprn) then - write (iout,*) "v",(v(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om20=scalar(er,v) - om2=scalar(er,dc_norm(1,jl1)) - write (iout,*) "om20",om20," om2",om2 - endif - else - om2=0.0d0 - om20=0.0d0 - endif - if (il.ne.il1 .and. jl.ne.jl1) then - om120=scalar(u,v) - om12=scalar(dc_norm(1,il1),dc_norm(1,jl1)) - else - om12=0.0d0 - om120=0.0d0 - endif - if (lprn) then - write (iout,*) "il",il," jl",jl,itype(il),itype(jl) - write (iout,*)"d0ij",d0ij," om10",om10," om20",om20, - & " om120",om120, - & " dij",dij," om1",om1," om2",om2," om12",om12 - call flush(iout) - endif - ssij = 16.0d0/(d0ij*d0ij) - qcontrib = dexp(-0.5d0*(ddave*ssij+((om1-om10)**2 - & +(om2-om20)**2+(om12-om120)**2))) - if (lprn) write (iout,*) "ssij",ssij," qcontrib",qcontrib -c qcontrib = dexp(-0.5d0*(ddave*ssij)+(om1-om10)**2+(om2-om20)**2) -c qcontrib = dexp(-0.5d0*(ddave*ssij)) -c Compute gradient - radial component - fac1 = qcontrib*ssij/nd - fac = fac1*(dij-d0ij)/dij - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (il1.ne.il .or. jl1.ne.jl) then - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - if (il1.ne.il) then - dxqwol(k,il)=dxqwol(k,il)+ddqij - else - dqwol(k,il)=dqwol(k,il)+ddqij - endif - if (jl1.ne.jl) then - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - else - dqwol(k,jl)=dqwol(k,jl)-ddqij - endif - enddo - endif -c return -c Orientational contributions - rij=1.0d0/dij1 - eom1=qcontrib*(om1-om10) - eom2=qcontrib*(om2-om20) - eom12=qcontrib*(om12-om120) - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,il1)-om1*er(k)) - dcosom2(k)=rij*(dc_norm(k,jl1)-om2*er(k)) - enddo - do k=1,3 - ddqij=eom1*dcosom1(k)+eom2*dcosom2(k) - aux1=(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) - & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - aux2=(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) - & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - dqwol(k,il)=dqwol(k,il)-ddqij-aux1 - dqwol(k,jl)=dqwol(k,jl)+ddqij-aux2 - dxqwol(k,il)=dxqwol(k,il)-ddqij+aux1 -c & +(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) -c & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - dxqwol(k,jl)=dxqwol(k,jl)+ddqij+aux2 -c & +(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) -c & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/randgens.f b/source/unres/src_MD-NEWSC-NEWC/randgens.f deleted file mode 100644 index 0daeb35..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/randgens.f +++ /dev/null @@ -1,99 +0,0 @@ -C $Date: 1994/10/04 16:19:52 $ -C $Revision: 2.1 $ -C -C -C See help for RANDOMV on the PSFSHARE disk to understand these -C subroutines. This is the VS Fortran version of this code. -C -C - SUBROUTINE VRND(VEC,N) - INTEGER A(250) - COMMON /VRANDD/ A, I, I147 - INTEGER LOOP,I,I147,VEC(N) - DO 23000 LOOP=1,N - I=I+1 - IF(.NOT.(I.GE.251))GOTO 23002 - I=1 -23002 CONTINUE - I147=I147+1 - IF(.NOT.(I147.GE.251))GOTO 23004 - I147=1 -23004 CONTINUE - A(I)=IEOR(A(I147),A(I)) - VEC(LOOP)=A(I) -23000 CONTINUE - RETURN - END -C -C - DOUBLE PRECISION FUNCTION RNDV(IDUM) - DOUBLE PRECISION RM1,RM2,R(99) - INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM - SAVE - DATA IA1,IC1,M1/1279,351762,1664557/ - DATA IA2,IC2,M2/2011,221592,1048583/ - DATA IA3,IC3,M3/15551,6150,29101/ - IF(.NOT.(IDUM.LT.0))GOTO 23006 - IX1 = MOD(-IDUM,M1) - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IX1,M2) - IX1 = MOD(IA1*IX1+IC1,M1) - IX3 = MOD(IX1,M3) - RM1 = 1./DBLE(M1) - RM2 = 1./DBLE(M2) - DO 23008 J = 1,99 - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 -23008 CONTINUE -23006 CONTINUE - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - IX3 = MOD(IA3*IX3+IC3,M3) - J = 1+(99*IX3)/M3 - RNDV = R(J) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 - IDUM = IX1 - RETURN - END -C -C - SUBROUTINE VRNDST(SEED) - INTEGER A(250),LOOP,IDUM,SEED - DOUBLE PRECISION RNDV - COMMON /VRANDD/ A, I, I147 - I=0 - I147=103 - IDUM=SEED - DO 23010 LOOP=1,250 - A(LOOP)=INT(RNDV(IDUM)*2147483647) -23010 CONTINUE - RETURN - END -C -C - SUBROUTINE VRNDIN(IODEV) - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - READ(IODEV) A, I, I147 - RETURN - END -C -C - SUBROUTINE VRNDOU(IODEV) -C This corresponds to VRNDOUT in the APFTN64 version - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - WRITE(IODEV) A, I, I147 - RETURN - END - FUNCTION RNUNF(N) - INTEGER IRAN1(2000) - DATA FCTOR /2147483647.0D0/ -C We get only one random number, here! DR 9/1/92 - CALL VRND(IRAN1,1) - RNUNF= DBLE( IRAN1(1) ) / FCTOR -C****************************** -C write(6,*) 'rnunf in rnunf = ',rnunf - RETURN - END diff --git a/source/unres/src_MD-NEWSC-NEWC/rattle.F b/source/unres/src_MD-NEWSC-NEWC/rattle.F deleted file mode 100644 index a2e5034..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/rattle.F +++ /dev/null @@ -1,706 +0,0 @@ - subroutine rattle1 -c RATTLE algorithm for velocity Verlet - step 1, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2),xcorr(3,MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE1" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i)=dC(j,i)-xx - d_t_new(j,i)=d_t_new(j,i)-xx/d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i+nres)=dC(j,i+nres)-xx - d_t_new(j,i+nres)=d_t_new(j,i+nres)-xx/d_time - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle2 -c RATTLE algorithm for velocity Verlet - step 2, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE2" - if (lprn) write (iout,*) "Velocity correction" -c Calculate the matrix G dC - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k+nres) - enddo - endif - enddo - enddo -c if (lprn) then -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo -c endif -c Calculate the matrix of the system of equations - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i)*gdc(k,ind,j) - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i+nres)*gdc(k,ind,j) - enddo - enddo - endif - enddo -c Calculate the scalar product dC o d_t_new - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - if (lprn) then - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind) - endif - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to velocities - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i)=d_t(j,i)-xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i+nres)=d_t(j,i+nres)-xx - enddo - endif - enddo - if (lprn) then - write (iout,*) - & "New velocities, Lagrange multipliers violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - if (lprn) write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind),scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind), - & scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - endif - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle_brown -c RATTLE/LINCS algorithm for Brownian dynamics, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.true./, lprn1 /.true./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE_BROWN" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1)GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),scalar(d_t(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3), - & scalar(d_t(1,i+nres),dC_old(1,i+nres)) - endif - enddo - write (iout,*) "gdc" - do i=1,nbond - write (iout,*) "i",i - do j=1,nbond - write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) - enddo - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i)=d_t(j,i)+xx/d_time - dC(j,i)=dC(j,i)+xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i+nres)=d_t(j,i+nres)+xx/d_time - dC(j,i+nres)=dC(j,i+nres)+xx - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end diff --git a/source/unres/src_MD-NEWSC-NEWC/readpdb.F b/source/unres/src_MD-NEWSC-NEWC/readpdb.F deleted file mode 100644 index 48e0abd..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/readpdb.F +++ /dev/null @@ -1,432 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - logical fail - integer rescode - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - - - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if(me.eq.king.or..not.out1file)then - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' - endif - endif - endif - do i=1,nres-1 - iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) -C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) - & di=dsc(itype(i)) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/readrtns.F b/source/unres/src_MD-NEWSC-NEWC/readrtns.F deleted file mode 100644 index b861fdb..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/readrtns.F +++ /dev/null @@ -1,2711 +0,0 @@ - subroutine readrtns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical file_exist -C Read force-field parameters except weights - call parmread -C Read job setup parameters - call read_control -C Read control parameters for energy minimzation if required - if (minim) call read_minim -C Read MCM control parameters if required - if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread -C Read MD control parameters if reqjuired - if (modecalc.eq.12) call read_MDpar -C Read MREMD control parameters if required - if (modecalc.eq.14) then - call read_MDpar - call read_REMDpar - endif -C Read MUCA control parameters if required - if (lmuca) call read_muca -C Read CSA control parameters if required (from fort.40 if exists -C otherwise from general input file) -csa if (modecalc.eq.8) then -csa inquire (file="fort.40",exist=file_exist) -csa if (.not.file_exist) call csaread -csa endif -cfmc if (modecalc.eq.10) call mcmfread -C Read molecule information, molecule geometry, energy-term weights, and -C restraints if requested - call molread -C Print restraint information -#ifdef MPI - if (.not. out1file .or. me.eq.king) then -#endif - if (nhpb.gt.nss) - &write (iout,'(a,i5,a)') "The following",nhpb-nss, - & " distance constraints have been imposed" - do i=nss+1,nhpb - write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i), - & ibecarb(i),dhpb(i),dhpb1(i),forcon(i) - enddo -#ifdef MPI - endif -#endif -c print *,"Processor",myrank," leaves READRTNS" - return - end -C------------------------------------------------------------------------------- - subroutine read_control -C -C Read contorl data -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/ - character*80 ucase - character*320 controlcard - - nglob_csa=0 - eglob_csa=1d99 - nmin_csa=0 - read (INP,'(a)') titel - call card_concat(controlcard) -c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0 -c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file - call reada(controlcard,'SEED',seed,0.0D0) - call random_init(seed) -C Set up the time limit (caution! The time must be input in minutes!) - read_cart=index(controlcard,'READ_CART').gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours - unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 - call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes - call reada(controlcard,'RMSDBC',rmsdbc,3.0D0) - call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0) - call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0) - call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0) - call reada(controlcard,'DRMS',drms,0.1D0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc - write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1 - write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max - write (iout,'(a,f10.1)')'DRMS = ',drms - write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm - write (iout,'(a,f10.1)') 'Time limit (min):',timlim - endif - call readi(controlcard,'NZ_START',nz_start,0) - call readi(controlcard,'NZ_END',nz_end,0) - call readi(controlcard,'IZ_SC',iz_sc,0) - timlim=60.0D0*timlim - safety = 60.0d0*safety - timem=timlim - modecalc=0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - minim=(index(controlcard,'MINIMIZE').gt.0) - dccart=(index(controlcard,'CART').gt.0) - overlapsc=(index(controlcard,'OVERLAP').gt.0) - overlapsc=.not.overlapsc - searchsc=(index(controlcard,'NOSEARCHSC').gt.0) - searchsc=.not.searchsc - sideadd=(index(controlcard,'SIDEADD').gt.0) - energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) - outpdb=(index(controlcard,'PDBOUT').gt.0) - outmol2=(index(controlcard,'MOL2OUT').gt.0) - pdbref=(index(controlcard,'PDBREF').gt.0) - refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) - indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) - call readi(controlcard,'IPRINT',iprint,0) - call readi(controlcard,'MAXGEN',maxgen,10000) - call readi(controlcard,'MAXOVERLAP',maxoverlap,1000) - call readi(controlcard,"KDIAG",kdiag,0) - call readi(controlcard,"RESCALE_MODE",rescale_mode,2) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) - & write (iout,*) "RESCALE_MODE",rescale_mode - split_ene=index(controlcard,'SPLIT_ENE').gt.0 - if (index(controlcard,'REGULAR').gt.0.0D0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - modecalc=1 - refstr=.true. - endif - if (index(controlcard,'CHECKGRAD').gt.0) then - modecalc=5 - if (index(controlcard,'CART').gt.0) then - icheckgrad=1 - elseif (index(controlcard,'CARINT').gt.0) then - icheckgrad=2 - else - icheckgrad=3 - endif - elseif (index(controlcard,'THREAD').gt.0) then - modecalc=2 - call readi(controlcard,'THREAD',nthread,0) - if (nthread.gt.0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - else - if (fg_rank.eq.0) - & write (iout,'(a)')'A number has to follow the THREAD keyword.' - stop 'Error termination in Read_Control.' - endif - else if (index(controlcard,'MCMA').gt.0) then - modecalc=3 - else if (index(controlcard,'MCEE').gt.0) then - modecalc=6 - else if (index(controlcard,'MULTCONF').gt.0) then - modecalc=4 - else if (index(controlcard,'MAP').gt.0) then - modecalc=7 - call readi(controlcard,'MAP',nmap,0) - else if (index(controlcard,'CSA').gt.0) then - write(*,*) "CSA not supported in this version" - stop -csa modecalc=8 -crc else if (index(controlcard,'ZSCORE').gt.0) then -crc -crc ZSCORE is rm from UNRES, modecalc=9 is available -crc -crc modecalc=9 -cfcm else if (index(controlcard,'MCMF').gt.0) then -cfmc modecalc=10 - else if (index(controlcard,'SOFTREG').gt.0) then - modecalc=11 - else if (index(controlcard,'CHECK_BOND').gt.0) then - modecalc=-1 - else if (index(controlcard,'TEST').gt.0) then - modecalc=-2 - else if (index(controlcard,'MD').gt.0) then - modecalc=12 - else if (index(controlcard,'RE ').gt.0) then - modecalc=14 - endif - - lmuca=index(controlcard,'MUCA').gt.0 - call readi(controlcard,'MUCADYN',mucadyn,0) - call readi(controlcard,'MUCASMOOTH',muca_smooth,0) - if (lmuca .and. (me.eq.king .or. .not.out1file )) - & then - write (iout,*) 'MUCADYN=',mucadyn - write (iout,*) 'MUCASMOOTH=',muca_smooth - endif - - iscode=index(controlcard,'ONE_LETTER') - indphi=index(controlcard,'PHI') - indback=index(controlcard,'BACK') - iranconf=index(controlcard,'RAND_CONF') - i2ndstr=index(controlcard,'USE_SEC_PRED') - gradout=index(controlcard,'GRADOUT').gt.0 - gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 - - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') diagmeth(kdiag), - & ' routine used to diagonalize matrices.' - return - end -c-------------------------------------------------------------------------- - subroutine read_REMDpar -C -C Read REMD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.REMD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*80 ucase - character*320 controlcard - character*3200 controlcard1 - integer iremd_m_total - - if(me.eq.king.or..not.out1file) - & write (iout,*) "REMD setup" - - call card_concat(controlcard) - call readi(controlcard,"NREP",nrep,3) - call readi(controlcard,"NSTEX",nstex,1000) - call reada(controlcard,"RETMIN",retmin,10.0d0) - call reada(controlcard,"RETMAX",retmax,1000.0d0) - mremdsync=(index(controlcard,'SYNC').gt.0) - call readi(controlcard,"NSYN",i_sync_step,100) - restart1file=(index(controlcard,'REST1FILE').gt.0) - traj1file=(index(controlcard,'TRAJ1FILE').gt.0) - call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1) - if(max_cache_traj_use.gt.max_cache_traj) - & max_cache_traj_use=max_cache_traj - if(me.eq.king.or..not.out1file) then -cd if (traj1file) then -crc caching is in testing - NTWX is not ignored -cd write (iout,*) "NTWX value is ignored" -cd write (iout,*) " trajectory is stored to one file by master" -cd write (iout,*) " before exchange at NSTEX intervals" -cd endif - write (iout,*) "NREP= ",nrep - write (iout,*) "NSTEX= ",nstex - write (iout,*) "SYNC= ",mremdsync - write (iout,*) "NSYN= ",i_sync_step - write (iout,*) "TRAJCACHE= ",max_cache_traj_use - endif - - t_exchange_only=(index(controlcard,'TONLY').gt.0) - call readi(controlcard,"HREMD",hremd,0) - if((me.eq.king.or..not.out1file).and.hremd.gt.0) then - write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights" - endif - if(usampl.and.hremd.gt.0) then - write (iout,'(//a)') - & "========== ERROR: USAMPL and HREMD cannot be used together" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop - endif - - - remd_tlist=.false. - if (index(controlcard,'TLIST').gt.0) then - remd_tlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_t(i),i=1,nrep) - if(me.eq.king.or..not.out1file) - & write (iout,*)'tlist',(remd_t(i),i=1,nrep) - endif - remd_mlist=.false. - if (index(controlcard,'MLIST').gt.0) then - remd_mlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_m(i),i=1,nrep) - if(me.eq.king.or..not.out1file) then - write (iout,*)'mlist',(remd_m(i),i=1,nrep) - iremd_m_total=0 - do i=1,nrep - iremd_m_total=iremd_m_total+remd_m(i) - enddo - if(hremd.gt.1)then - write (iout,*) 'Total number of replicas ', - & iremd_m_total*hremd - else - write (iout,*) 'Total number of replicas ',iremd_m_total - endif - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup " - return - end -c-------------------------------------------------------------------------- - subroutine read_MDpar -C -C Read MD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - character*80 ucase - character*320 controlcard - - call card_concat(controlcard) - call readi(controlcard,"NSTEP",n_timestep,1000000) - call readi(controlcard,"NTWE",ntwe,100) - call readi(controlcard,"NTWX",ntwx,1000) - call reada(controlcard,"DT",d_time,1.0d-1) - call reada(controlcard,"DVMAX",dvmax,2.0d1) - call reada(controlcard,"DAMAX",damax,1.0d1) - call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1) - call readi(controlcard,"LANG",lang,0) - RESPA = index(controlcard,"RESPA") .gt. 0 - call readi(controlcard,"NTIME_SPLIT",ntime_split,1) - ntime_split0=ntime_split - call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64) - ntime_split0=ntime_split - call reada(controlcard,"R_CUT",r_cut,2.0d0) - call reada(controlcard,"LAMBDA",rlamb,0.3d0) - rest = index(controlcard,"REST").gt.0 - tbf = index(controlcard,"TBF").gt.0 - call readi(controlcard,"HMC",hmc,0) - tnp = index(controlcard,"NOSEPOINCARE99").gt.0 - tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0 - tnh = index(controlcard,"NOSEHOOVER96").gt.0 - if (RESPA.and.tnh)then - xiresp = index(controlcard,"XIRESP").gt.0 - endif - call reada(controlcard,"Q_NP",Q_np,0.1d0) - usampl = index(controlcard,"USAMPL").gt.0 - - mdpdb = index(controlcard,"MDPDB").gt.0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1) - call reada(controlcard,"EQ_TIME",eq_time,1.0d+4) - call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000) - if (count_reset_moment.eq.0) count_reset_moment=1000000000 - call readi(controlcard,"RESET_VEL",count_reset_vel,1000) - reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0 - reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0 - if (count_reset_vel.eq.0) count_reset_vel=1000000000 - large = index(controlcard,"LARGE").gt.0 - print_compon = index(controlcard,"PRINT_COMPON").gt.0 - rattle = index(controlcard,"RATTLE").gt.0 -c if performing umbrella sampling, fragments constrained are read from the fragment file - nset=0 - if(usampl) then - call read_fragments - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) - write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run " - write (iout,*) - write (iout,'(a)') "The units are:" - write (iout,'(a)') "positions: angstrom, time: 48.9 fs" - write (iout,'(2a)') "velocity: angstrom/(48.9 fs),", - & " acceleration: angstrom/(48.9 fs)**2" - write (iout,'(a)') "energy: kcal/mol, temperature: K" - write (iout,*) - write (iout,'(a60,i10)') "Number of time steps:",n_timestep - write (iout,'(a60,f10.5,a)') - & "Initial time step of numerical integration:",d_time, - & " natural units" - write (iout,'(60x,f10.5,a)') d_time*48.9," fs" - if (RESPA) then - write (iout,'(2a,i4,a)') - & "A-MTS algorithm used; initial time step for fast-varying", - & " short-range forces split into",ntime_split," steps." - write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff", - & r_cut," lambda",rlamb - endif - write (iout,'(2a,f10.5)') - & "Maximum acceleration threshold to reduce the time step", - & "/increase split number:",damax - write (iout,'(2a,f10.5)') - & "Maximum predicted energy drift to reduce the timestep", - & "/increase split number:",edriftmax - write (iout,'(a60,f10.5)') - & "Maximum velocity threshold to reduce velocities:",dvmax - write (iout,'(a60,i10)') "Frequency of property output:",ntwe - write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx - if (rattle) write (iout,'(a60)') - & "Rattle algorithm used to constrain the virtual bonds" - endif - reset_fricmat=1000 - if (lang.gt.0) then - call reada(controlcard,"ETAWAT",etawat,0.8904d0) - call reada(controlcard,"RWAT",rwat,1.4d0) - call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2) - surfarea=index(controlcard,"SURFAREA").gt.0 - call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000) - if(me.eq.king.or..not.out1file)then - write (iout,'(/a,$)') "Langevin dynamics calculation" - if (lang.eq.1) then - write (iout,'(a/)') - & " with direct integration of Langevin equations" - else if (lang.eq.2) then - write (iout,'(a/)') " with TINKER stochasic MD integrator" - else if (lang.eq.3) then - write (iout,'(a/)') " with Ciccotti's stochasic MD integrator" - else if (lang.eq.4) then - write (iout,'(a/)') " in overdamped mode" - else - write (iout,'(//a,i5)') - & "=========== ERROR: Unknown Langevin dynamics mode:",lang - stop - endif - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat - write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat - write (iout,'(a60,f10.5)') - & "Scaling factor of the friction forces:",scal_fric - if (surfarea) write (iout,'(2a,i10,a)') - & "Friction coefficients will be scaled by solvent-accessible", - & " surface area every",reset_fricmat," steps." - endif -c Calculate friction coefficients and bounds of stochastic forces - eta=6*pi*cPoise*etawat - if(me.eq.king.or..not.out1file) - & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:" - & ,eta - gamp=scal_fric*(pstok+rwat)*eta - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - gamsc(i)=scal_fric*(restok(i)+rwat)*eta - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if(me.eq.king.or..not.out1file)then - write (iout,'(/2a/)') - & "Radii of site types and friction coefficients and std's of", - & " stochastic forces of fully exposed sites" - write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp) - do i=1,ntyp - write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i), - & gamsc(i),stdfsc(i)*dsqrt(gamsc(i)) - enddo - endif - else if (tbf) then - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') "Berendsen bath calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - endif - else if (tnp .or. tnp1 .or. tnh) then - if (tnp .or. tnp1) then - write (iout,'(a)') "Nose-Poincare bath calculation" - if (tnp) write (iout,'(a)') - & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird" - if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose" - else - write (iout,'(a)') "Nose-Hoover bath calculation" - write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al." - nresn=1 - nyosh=1 - nnos=1 - do i=1,nnos - qmass(i)=Q_np - xlogs(i)=1.0 - vlogs(i)=0.0 - enddo - do i=1,nyosh - WDTI(i) = 1.0*d_time/nresn - WDTI2(i)=WDTI(i)/2 - WDTI4(i)=WDTI(i)/4 - WDTI8(i)=WDTI(i)/8 - enddo - if (RESPA) then - if(xiresp) then - write (iout,'(a)') "NVT-XI-RESPA algorithm" - else - write (iout,'(a)') "NVT-XO-RESPA algorithm" - endif - do i=1,nyosh - WDTIi(i) = 1.0*d_time/nresn/ntime_split - WDTIi2(i)=WDTIi(i)/2 - WDTIi4(i)=WDTIi(i)/4 - WDTIi8(i)=WDTIi(i)/8 - enddo - endif - endif - - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Q =",Q_np - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - - else if (hmc.gt.0) then - write (iout,'(a)') "Hybrid Monte Carlo calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,i10)') - & "Number of MD steps between Metropolis tests:",hmc - - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a31)') "Microcanonical mode calculation" - endif - if(me.eq.king.or..not.out1file)then - if (rest) write (iout,'(/a/)') "===== Calculation restarted ====" - if (usampl) then - write(iout,*) "MD running with constraints." - write(iout,*) "Equilibration time ", eq_time, " mtus." - write(iout,*) "Constraining ", nfrag," fragments." - write(iout,*) "Length of each fragment, weight and q0:" - do iset=1,nset - write (iout,*) "Set of restraints #",iset - do i=1,nfrag - write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset), - & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset) - enddo - write(iout,*) "constraints between ", npair, "fragments." - write(iout,*) "constraint pairs, weights and q0:" - do i=1,npair - write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset), - & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset) - enddo - write(iout,*) "angle constraints within ", nfrag_back, - & "backbone fragments." - write(iout,*) "fragment, weights:" - do i=1,nfrag_back - write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset), - & ifrag_back(2,i,iset),wfrag_back(1,i,iset), - & wfrag_back(2,i,iset),wfrag_back(3,i,iset) - enddo - enddo - iset=mod(kolor,nset)+1 - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup " - return - end -c------------------------------------------------------------------------------ - subroutine molread -C -C Read molecular data. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer error_msg -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.CONTACTS' - include 'COMMON.TORCNSTR' - include 'COMMON.TIME1' - include 'COMMON.BOUNDS' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - character*4 sequence(maxres) - integer rescode - double precision x(maxvar) - character*256 pdbfile - character*320 weightcard - character*80 weightcard_t,ucase - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - logical seq_comp,fail - double precision energia(0:n_ene) - integer ilen - external ilen -C -C Body -C -C Read weights of the subsequent energy terms. - if(hremd.gt.0) then - - k=0 - do il=1,hremd - do i=1,nrep - do j=1,remd_m(i) - i2set(k)=il - k=k+1 - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write (iout,*) 'Reading ',hremd,' sets of weights for HREMD' - write (iout,*) 'Current weights for processor ', - & me,' set ',i2set(me) - endif - - do i=1,hremd - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - - hweights(i,1)=wsc - hweights(i,2)=wscp - hweights(i,3)=welec - hweights(i,4)=wcorr - hweights(i,5)=wcorr5 - hweights(i,6)=wcorr6 - hweights(i,7)=wel_loc - hweights(i,8)=wturn3 - hweights(i,9)=wturn4 - hweights(i,10)=wturn6 - hweights(i,11)=wang - hweights(i,12)=wscloc - hweights(i,13)=wtor - hweights(i,14)=wtor_d - hweights(i,15)=wstrain - hweights(i,16)=wvdwpp - hweights(i,17)=wbond - hweights(i,18)=scal14 - hweights(i,21)=wsccor - - enddo - - do i=1,n_ene - weights(i)=hweights(i2set(me),i) - enddo - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - - else - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - weights(1)=wsc - weights(2)=wscp - weights(3)=welec - weights(4)=wcorr - weights(5)=wcorr5 - weights(6)=wcorr6 - weights(7)=wel_loc - weights(8)=wturn3 - weights(9)=wturn4 - weights(10)=wturn6 - weights(11)=wang - weights(12)=wscloc - weights(13)=wtor - weights(14)=wtor_d - weights(15)=wstrain - weights(16)=wvdwpp - weights(17)=wbond - weights(18)=scal14 - weights(21)=wsccor - endif - - if(me.eq.king.or..not.out1file) - & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 10 format (/'Energy-term weights (unscaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file)then - if (wcorr4.gt.0.0d0) then - write (iout,'(/2a/)') 'Local-electrostatic type correlation ', - & 'between contact pairs of peptide groups' - write (iout,'(2(a,f5.3/))') - & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr, - & 'Range of quenching the correlation terms:',2*delt_corr - else if (wcorr.gt.0.0d0) then - write (iout,'(/2a/)') 'Hydrogen-bonding correlation ', - & 'between contact pairs of peptide groups' - endif - write (iout,'(a,f8.3)') - & 'Scaling factor of 1,4 SC-p interactions:',scal14 - write (iout,'(a,f8.3)') - & 'General scaling factor of SC-p interactions:',scalscp - endif - r0_corr=cutoff_corr-delt_corr - do i=1,20 - aad(i,1)=scalscp*aad(i,1) - aad(i,2)=scalscp*aad(i,2) - bad(i,1)=scalscp*bad(i,1) - bad(i,2)=scalscp*bad(i,2) - enddo - call rescale_weights(t_bath) - if(me.eq.king.or..not.out1file) - & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 22 format (/'Energy-term weights (scaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file) - & write (iout,*) "Reference temperature for weights calculation:", - & temp0 - call reada(weightcard,"D0CM",d0cm,3.78d0) - call reada(weightcard,"AKCM",akcm,15.1d0) - call reada(weightcard,"AKTH",akth,11.0d0) - call reada(weightcard,"AKCT",akct,12.0d0) - call reada(weightcard,"V1SS",v1ss,-1.08d0) - call reada(weightcard,"V2SS",v2ss,7.61d0) - call reada(weightcard,"V3SS",v3ss,13.7d0) - call reada(weightcard,"EBR",ebr,-5.50D0) - dyn_ss=(index(weightcard,'DYN_SS').gt.0) - do i=1,maxres - dyn_ss_mask(i)=.false. - enddo - do i=1,maxres-1 - do j=i+1,maxres - dyn_ssbond_ij(i,j)=1.0d300 - enddo - enddo - call reada(weightcard,"HT",Ht,0.0D0) - if (dyn_ss) then - ss_depth=ebr/wsc-0.25*eps(1,1) - Ht=Ht/wsc-0.25*eps(1,1) - akcm=akcm*wstrain/wsc - akth=akth*wstrain/wsc - akct=akct*wstrain/wsc - v1ss=v1ss*wstrain/wsc - v2ss=v2ss*wstrain/wsc - v3ss=v3ss*wstrain/wsc - else - ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) "Parameters of the SS-bond potential:" - write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, - & " AKCT",akct - write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth - write (iout,*)" HT",Ht - print *,'indpdb=',indpdb,' pdbref=',pdbref - endif - if (indpdb.gt.0 .or. pdbref) then - read(inp,'(a)') pdbfile - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') 'PDB data will be read from file ', - & pdbfile(:ilen(pdbfile)) - open(ipdbin,file=pdbfile,status='old',err=33) - goto 34 - 33 write (iout,'(a)') 'Error opening PDB file.' - stop - 34 continue -c print *,'Begin reading pdb data' - call readpdb -c print *,'Finished reading pdb data' - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3,a,i3)')'nsup=',nsup, - & ' nstart_sup=',nstart_sup - do i=1,nres - itype_pdb(i)=itype(i) - enddo - close (ipdbin) - nnt=nstart_sup - nct=nstart_sup+nsup-1 - call contact(.false.,ncont_ref,icont_ref,co) - - if (sideadd) then -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "Before sideadd" - call intout - if(me.eq.king.or..not.out1file) - & write(iout,*)'Adding sidechains' - maxsi=1000 - do i=2,nres-1 - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) write(iout,*)'Adding sidechain failed for res ', - & i,' after ',nsi,' trials' - endif - enddo -C 10/03/12 Adam: Recalculate coordinates with new side chain positions - call chainbuild - endif -C Following 2 lines for diagnostics; comment out if not needed -c write (iout,*) "After sideadd" -c call intout - endif - if (indpdb.eq.0) then -C Read sequence if not taken from the pdb file. - read (inp,*) nres -c print *,'nres=',nres - if (iscode.gt.0) then - read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres) - else - read (inp,'(20(1x,a3))') (sequence(i),i=1,nres) - endif -C Convert sequence to numeric code - do i=1,nres - itype(i)=rescode(i,sequence(i),iscode) - enddo -C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(itype(i)) - vbld_inv(i+nres)=dsc_inv(itype(i)) -c write (iout,*) "i",i," itype",itype(i), -c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo - endif -c print *,nres -c print '(20i4)',(itype(i),i=1,nres) - do i=1,nres -#ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then -#else - if (itype(i).eq.21) then -#endif - itel(i)=0 -#ifdef PROCOR - else if (itype(i+1).ne.20) then -#else - else if (itype(i).ne.20) then -#endif - itel(i)=1 - else - itel(i)=2 - endif - enddo - if(me.eq.king.or..not.out1file)then - write (iout,*) "ITEL" - do i=1,nres-1 - write (iout,*) i,itype(i),itel(i) - enddo - print *,'Call Read_Bridge.' - endif - call read_bridge -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - read (inp,*) ndih_constr - if (ndih_constr.gt.0) then - read (inp,*) ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) - if(me.eq.king.or..not.out1file)then - write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' - do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) - enddo - endif - do i=1,ndih_constr - phi0(i)=deg2rad*phi0(i) - drange(i)=deg2rad*drange(i) - enddo - if(me.eq.king.or..not.out1file) - & write (iout,*) 'FTORS',ftors - do i=1,ndih_constr - ii = idih_constr(i) - phibound(1,ii) = phi0(i)-drange(i) - phibound(2,ii) = phi0(i)+drange(i) - enddo - endif - nnt=1 -#ifdef MPI - if (me.eq.king) then -#endif - write (iout,'(a)') 'Boundaries in phi angle sampling:' - do i=1,nres - write (iout,'(a3,i5,2f10.1)') - & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg - enddo -#ifdef MP - endif -#endif - nct=nres -cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3)') 'nsup=',nsup - nstart_seq=nnt - if (nsup.le.(nct-nnt+1)) then - do i=0,nct-nnt+1-nsup - if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then - nstart_seq=nnt+i - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - stop - else - do i=0,nsup-(nct-nnt+1) - if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1)) - & then - nstart_sup=nstart_sup+i - nsup=nct-nnt+1 - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - endif - 111 continue - if (nsup.eq.0) nsup=nct-nnt - if (nstart_sup.eq.0) nstart_sup=nnt - if (nstart_seq.eq.0) nstart_seq=nnt - if(me.eq.king.or..not.out1file) - & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, - & ' nstart_seq=',nstart_seq - endif -c--- Zscore rms ------- - if (nz_start.eq.0) nz_start=nnt - if (nz_end.eq.0 .and. nsup.gt.0) then - nz_end=nnt+nsup-1 - else if (nz_end.eq.0) then - nz_end=nct - endif - if(me.eq.king.or..not.out1file)then - write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end - write (iout,*) 'IZ_SC=',iz_sc - endif -c---------------------- - call init_int_table - if (refstr) then - if (.not.pdbref) then - call read_angles(inp,*38) - goto 39 - 38 write (iout,'(a)') 'Error reading reference structure.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) - stop 'Error reading reference structure' -#endif - 39 call chainbuild - call setup_var -czscore call geom_to_var(nvar,coord_exp_zs(1,1)) - nstart_sup=nnt - nstart_seq=nnt - nsup=nct-nnt+1 - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - call contact(.true.,ncont_ref,icont_ref,co) - endif - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Contact order:',co - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup - do i=1,ncont_ref - do j=1,2 - icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup - enddo - if(me.eq.king.or..not.out1file) - & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ', - & icont_ref(1,i),' ', - & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i) - enddo - endif - endif -c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup - if (constr_dist.gt.0) then - call read_dist_constr - endif - if (nhpb.gt.0) call hpb_partition -c write (iout,*) "After read_dist_constr nhpb",nhpb -c call flush(iout) - if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 - & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. - & modecalc.ne.10) then -C If input structure hasn't been supplied from the PDB file read or generate -C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then - if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) - & write (iout,'(a)') 'Initial geometry will be read in.' - if (read_cart) then - read(inp,'(8f10.5)',end=36,err=36) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - return - else - call read_angles(inp,*36) - endif - goto 37 - 36 write (iout,'(a)') 'Error reading angle file.' -#ifdef MPI - call mpi_finalize( MPI_COMM_WORLD,IERR ) -#endif - stop 'Error reading angle file.' - 37 continue - else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - enddo - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a)') 'Random-generated initial geometry.' - - -#ifdef MPI - if (me.eq.king .or. fg_rank.eq.0 .and. ( - & modecalc.eq.12 .or. modecalc.eq.14) ) then -#endif - do itrial=1,100 - itmp=1 - call gen_rand_conf(itmp,*30) - goto 40 - 30 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Processor:',me, - & ' Failed to generate random conformation', - & ' itrial=',itrial - call intout - -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - call flush(iout) -#ifdef MPI - call MPI_Abort(mpi_comm_world,error_msg,ierrcode) - 40 continue - endif -#else - 40 continue -#endif - endif - elseif (modecalc.eq.4) then - read (inp,'(a)') intinname - open (intin,file=intinname,status='old',err=333) - if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0) - & write (iout,'(a)') 'intinname',intinname - write (*,'(a)') 'Processor',myrank,' intinname',intinname - goto 334 - 333 write (iout,'(2a)') 'Error opening angle file ',intinname -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERR) -#endif - stop 'Error opening angle file.' - 334 continue - - endif -C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif - call setup_var - if (me.eq.king .or. .not. out1file) - & call intout - if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then - write (iout,'(/a,i3,a)') - & 'The chain contains',ns,' disulfide-bridging cysteines.' - write (iout,'(20i4)') (iss(i),i=1,ns) - if (dyn_ss) then - write(iout,*)"Running with dynamic disulfide-bond formation" - else - write (iout,'(/a/)') 'Pre-formed links are:' - do i=1,nss - i1=ihpb(i)-nres - i2=jhpb(i)-nres - it1=itype(i1) - it2=itype(i2) - write (iout,'(2a,i3,3a,i3,a,3f10.3)') - & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), - & ebr,forcon(i) - enddo - write (iout,'(a)') - endif - endif - if (ns.gt.0.and.dyn_ss) then - do i=nss+1,nhpb - ihpb(i-nss)=ihpb(i) - jhpb(i-nss)=jhpb(i) - forcon(i-nss)=forcon(i) - dhpb(i-nss)=dhpb(i) - enddo - nhpb=nhpb-nss - nss=0 - call hpb_partition - do i=1,ns - dyn_ss_mask(iss(i))=.true. - enddo - endif - if (i2ndstr.gt.0) call secstrp2dihc -c call geom_to_var(nvar,x) -c call etotal(energia(0)) -c call enerprint(energia(0)) -c call briefout(0,etot) -c stop -cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT -cd write (iout,'(a)') 'Variable list:' -cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar) -#ifdef MPI - if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file)) - & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') - & 'Processor',myrank,': end reading molecular data.' -#endif - return - end -c-------------------------------------------------------------------------- - logical function seq_comp(itypea,itypeb,length) - implicit none - integer length,itypea(length),itypeb(length) - integer i - do i=1,length - if (itypea(i).ne.itypeb(i)) then - seq_comp=.false. - return - endif - enddo - seq_comp=.true. - return - end -c----------------------------------------------------------------------------- - subroutine read_bridge -C Read information about disulfide bridges. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -C Read bridging residues. - read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns - if(me.eq.king.or..not.out1file) - & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) -C Check whether the specified bridging residues are cystines. - do i=1,ns - if (itype(iss(i)).ne.1) then - if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' - write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo -C Read preformed bridges. - if (ns.gt.0) then - read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - if(fg_rank.eq.0) - & write(iout,*)'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) - if (nss.gt.0) then - nhpb=nss -C Check if the residues involved in bridges are in the specified list of -C bridging residues. - do i=1,nss - do j=1,i-1 - if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j) - & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then - write (iout,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' - write (*,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo - do j=1,ns - if (ihpb(i).eq.iss(j)) goto 10 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 10 continue - do j=1,ns - if (jhpb(i).eq.iss(j)) goto 20 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 20 continue - dhpb(i)=dbr - forcon(i)=fbr - enddo - do i=1,nss - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - enddo - endif - endif - return - end -c---------------------------------------------------------------------------- - subroutine read_x(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' -c Read coordinates from input -c - read(kanal,'(8f10.5)',end=10,err=10) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine read_threadbase - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Read pattern database for threading. - read (icbase,*) nseq - do i=1,nseq - read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), - & nres_base(2,i),nres_base(3,i) - read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, - & nres_base(1,i)) -c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), -c & nres_base(2,i),nres_base(3,i) -c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, -c & nres_base(1,i)) - enddo - close (icbase) - if (weidis.eq.0.0D0) weidis=0.1D0 - do i=nnt,nct - do j=i+2,nct - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=weidis - enddo - enddo - read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl) - write (iout,'(a,i5)') 'nexcl: ',nexcl - write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl) - return - end -c------------------------------------------------------------------------------ - subroutine setup_var - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Set up variable list. - ntheta=nres-2 - nphi=nres-3 - nvar=ntheta+nphi - nside=0 - do i=2,nres-1 - if (itype(i).ne.10) then - nside=nside+1 - ialph(i,1)=nvar+nside - ialph(nside,2)=i - endif - enddo - if (indphi.gt.0) then - nvar=nphi - else if (indback.gt.0) then - nvar=nphi+ntheta - else - nvar=nvar+2*nside - endif -cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1) - return - end -c---------------------------------------------------------------------------- - subroutine gen_dist_constr -C Generate CA distance constraints. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - character*2 iden -cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct -cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct, -cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq, -cd & ' nsup',nsup - do i=nstart_sup,nstart_sup+nsup-1 -cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), -cd & ' seq_pdb', restyp(itype_pdb(i)) - do j=i+2,nstart_sup+nsup-1 - nhpb=nhpb+1 - ihpb(nhpb)=i+nstart_seq-nstart_sup - jhpb(nhpb)=j+nstart_seq-nstart_sup - forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) - enddo - enddo -cd write (iout,'(a)') 'Distance constraints:' -cd do i=nss+1,nhpb -cd ii=ihpb(i) -cd jj=jhpb(i) -cd iden='CA' -cd if (ii.gt.nres) then -cd iden='SC' -cd ii=ii-nres -cd jj=jj-nres -cd endif -cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)') -cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, -cd & dhpb(i),forcon(i) -cd enddo - return - end -c---------------------------------------------------------------------------- - subroutine map_read - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.IOUNITS' - character*3 angid(4) /'THE','PHI','ALP','OME'/ - character*80 mapcard,ucase - do imap=1,nmap - read (inp,'(a)') mapcard - mapcard=ucase(mapcard) - if (index(mapcard,'PHI').gt.0) then - kang(imap)=1 - else if (index(mapcard,'THE').gt.0) then - kang(imap)=2 - else if (index(mapcard,'ALP').gt.0) then - kang(imap)=3 - else if (index(mapcard,'OME').gt.0) then - kang(imap)=4 - else - write(iout,'(a)')'Error - illegal variable spec in MAP card.' - stop 'Error - illegal variable spec in MAP card.' - endif - call readi (mapcard,'RES1',res1(imap),0) - call readi (mapcard,'RES2',res2(imap),0) - if (res1(imap).eq.0) then - res1(imap)=res2(imap) - else if (res2(imap).eq.0) then - res2(imap)=res1(imap) - endif - if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then - write (iout,'(a)') - & 'Error - illegal definition of variable group in MAP.' - stop 'Error - illegal definition of variable group in MAP.' - endif - call reada(mapcard,'FROM',ang_from(imap),0.0D0) - call reada(mapcard,'TO',ang_to(imap),0.0D0) - call readi(mapcard,'NSTEP',nstep(imap),0) - if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then - write (iout,'(a)') - & 'Illegal boundary and/or step size specification in MAP.' - stop 'Illegal boundary and/or step size specification in MAP.' - endif - enddo ! imap - return - end -c---------------------------------------------------------------------------- -csa subroutine csaread -csa implicit real*8 (a-h,o-z) -csa include 'DIMENSIONS' -csa include 'COMMON.IOUNITS' -csa include 'COMMON.GEO' -csa include 'COMMON.CSA' -csa include 'COMMON.BANK' -csa include 'COMMON.CONTROL' -csa character*80 ucase -csa character*620 mcmcard -csa call card_concat(mcmcard) -csa -csa call readi(mcmcard,'NCONF',nconf,50) -csa call readi(mcmcard,'NADD',nadd,0) -csa call readi(mcmcard,'JSTART',jstart,1) -csa call readi(mcmcard,'JEND',jend,1) -csa call readi(mcmcard,'NSTMAX',nstmax,500000) -csa call readi(mcmcard,'N0',n0,1) -csa call readi(mcmcard,'N1',n1,6) -csa call readi(mcmcard,'N2',n2,4) -csa call readi(mcmcard,'N3',n3,0) -csa call readi(mcmcard,'N4',n4,0) -csa call readi(mcmcard,'N5',n5,0) -csa call readi(mcmcard,'N6',n6,10) -csa call readi(mcmcard,'N7',n7,0) -csa call readi(mcmcard,'N8',n8,0) -csa call readi(mcmcard,'N9',n9,0) -csa call readi(mcmcard,'N14',n14,0) -csa call readi(mcmcard,'N15',n15,0) -csa call readi(mcmcard,'N16',n16,0) -csa call readi(mcmcard,'N17',n17,0) -csa call readi(mcmcard,'N18',n18,0) -csa -csa vdisulf=(index(mcmcard,'DYNSS').gt.0) -csa -csa call readi(mcmcard,'NDIFF',ndiff,2) -csa call reada(mcmcard,'DIFFCUT',diffcut,0.0d0) -csa call readi(mcmcard,'IS1',is1,1) -csa call readi(mcmcard,'IS2',is2,8) -csa call readi(mcmcard,'NRAN0',nran0,4) -csa call readi(mcmcard,'NRAN1',nran1,2) -csa call readi(mcmcard,'IRR',irr,1) -csa call readi(mcmcard,'NSEED',nseed,20) -csa call readi(mcmcard,'NTOTAL',ntotal,10000) -csa call reada(mcmcard,'CUT1',cut1,2.0d0) -csa call reada(mcmcard,'CUT2',cut2,5.0d0) -csa call reada(mcmcard,'ESTOP',estop,-3000.0d0) -csa call readi(mcmcard,'ICMAX',icmax,3) -csa call readi(mcmcard,'IRESTART',irestart,0) -csac!bankt call readi(mcmcard,'NBANKTM',ntbankm,0) -csa ntbankm=0 -csac!bankt -csa call reada(mcmcard,'DELE',dele,20.0d0) -csa call reada(mcmcard,'DIFCUT',difcut,720.0d0) -csa call readi(mcmcard,'IREF',iref,0) -csa call reada(mcmcard,'RMSCUT',rmscut,4.0d0) -csa call reada(mcmcard,'PNCCUT',pnccut,0.5d0) -csa call readi(mcmcard,'NCONF_IN',nconf_in,0) -csa call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0) -csa write (iout,*) "NCONF_IN",nconf_in -csa return -csa end -c---------------------------------------------------------------------------- -cfmc subroutine mcmfread -cfmc implicit real*8 (a-h,o-z) -cfmc include 'DIMENSIONS' -cfmc include 'COMMON.MCMF' -cfmc include 'COMMON.IOUNITS' -cfmc include 'COMMON.GEO' -cfmc character*80 ucase -cfmc character*620 mcmcard -cfmc call card_concat(mcmcard) -cfmc -cfmc call readi(mcmcard,'MAXRANT',maxrant,1000) -cfmc write(iout,*)'MAXRANT=',maxrant -cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p) -cfmc write(iout,*)'MAXFAM=',maxfam -cfmc call readi(mcmcard,'NNET1',nnet1,5) -cfmc write(iout,*)'NNET1=',nnet1 -cfmc call readi(mcmcard,'NNET2',nnet2,4) -cfmc write(iout,*)'NNET2=',nnet2 -cfmc call readi(mcmcard,'NNET3',nnet3,4) -cfmc write(iout,*)'NNET3=',nnet3 -cfmc call readi(mcmcard,'ILASTT',ilastt,0) -cfmc write(iout,*)'ILASTT=',ilastt -cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf) -cfmc write(iout,*)'MAXSTR=',maxstr -cfmc maxstr_f=maxstr/maxfam -cfmc write(iout,*)'MAXSTR_F=',maxstr_f -cfmc call readi(mcmcard,'NMCMF',nmcmf,10) -cfmc write(iout,*)'NMCMF=',nmcmf -cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf) -cfmc write(iout,*)'IFOCUS=',ifocus -cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000) -cfmc write(iout,*)'NLOCMCMF=',nlocmcmf -cfmc call readi(mcmcard,'INTPRT',intprt,1000) -cfmc write(iout,*)'INTPRT=',intprt -cfmc call readi(mcmcard,'IPRT',iprt,100) -cfmc write(iout,*)'IPRT=',iprt -cfmc call readi(mcmcard,'IMAXTR',imaxtr,100) -cfmc write(iout,*)'IMAXTR=',imaxtr -cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000) -cfmc write(iout,*)'MAXEVEN=',maxeven -cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3) -cfmc write(iout,*)'MAXEVEN1=',maxeven1 -cfmc call readi(mcmcard,'INIMIN',inimin,200) -cfmc write(iout,*)'INIMIN=',inimin -cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10) -cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf -cfmc call readi(mcmcard,'NTHREAD',nthread,5) -cfmc write(iout,*)'NTHREAD=',nthread -cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500) -cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf -cfmc call readi(mcmcard,'MAXPERT',maxpert,9) -cfmc write(iout,*)'MAXPERT=',maxpert -cfmc call readi(mcmcard,'IRMSD',irmsd,1) -cfmc write(iout,*)'IRMSD=',irmsd -cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0) -cfmc write(iout,*)'DENEMIN=',denemin -cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0) -cfmc write(iout,*)'RCUT1S=',rcut1s -cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0) -cfmc write(iout,*)'RCUT1E=',rcut1e -cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0) -cfmc write(iout,*)'RCUT2S=',rcut2s -cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0) -cfmc write(iout,*)'RCUT2E=',rcut2e -cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0) -cfmc write(iout,*)'DPERT1=',d_pert1 -cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0) -cfmc write(iout,*)'DPERT1A=',d_pert1a -cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0) -cfmc write(iout,*)'DPERT2=',d_pert2 -cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0) -cfmc write(iout,*)'DPERT2A=',d_pert2a -cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0) -cfmc write(iout,*)'DPERT2B=',d_pert2b -cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0) -cfmc write(iout,*)'DPERT2C=',d_pert2c -cfmc d_pert1=deg2rad*d_pert1 -cfmc d_pert1a=deg2rad*d_pert1a -cfmc d_pert2=deg2rad*d_pert2 -cfmc d_pert2a=deg2rad*d_pert2a -cfmc d_pert2b=deg2rad*d_pert2b -cfmc d_pert2c=deg2rad*d_pert2c -cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0) -cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1 -cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0) -cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2 -cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0) -cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1 -cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0) -cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2 -cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0) -cfmc write(iout,*)'RCUTINI=',rcutini -cfmc call reada(mcmcard,'GRAT',grat,0.5D0) -cfmc write(iout,*)'GRAT=',grat -cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0) -cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf -cfmc -cfmc return -cfmc end -c---------------------------------------------------------------------------- - subroutine mcmread - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 mcmcard - call card_concat(mcmcard) - call readi(mcmcard,'MAXACC',maxacc,100) - call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000) - call readi(mcmcard,'MAXTRIAL',maxtrial,100) - call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000) - call readi(mcmcard,'MAXREPM',maxrepm,200) - call reada(mcmcard,'RANFRACT',RanFract,0.5D0) - call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0) - call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3) - call reada(mcmcard,'E_UP',e_up,5.0D0) - call reada(mcmcard,'DELTE',delte,0.1D0) - call readi(mcmcard,'NSWEEP',nsweep,5) - call readi(mcmcard,'NSTEPH',nsteph,0) - call readi(mcmcard,'NSTEPC',nstepc,0) - call reada(mcmcard,'TMIN',tmin,298.0D0) - call reada(mcmcard,'TMAX',tmax,298.0D0) - call readi(mcmcard,'NWINDOW',nwindow,0) - call readi(mcmcard,'PRINT_MC',print_mc,0) - print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0) - print_int=(index(mcmcard,'NO_PRINT_INT').le.0) - ent_read=(index(mcmcard,'ENT_READ').gt.0) - call readi(mcmcard,'SAVE_FREQ',save_frequency,1000) - call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000) - call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000) - call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000) - call readi(mcmcard,'PRINT_FREQ',print_freq,1000) - if (nwindow.gt.0) then - read (inp,*) (winstart(i),winend(i),i=1,nwindow) - do i=1,nwindow - winlen(i)=winend(i)-winstart(i)+1 - enddo - endif - if (tmax.lt.tmin) tmax=tmin - if (tmax.eq.tmin) then - nstepc=0 - nsteph=0 - endif - if (nstepc.gt.0 .and. nsteph.gt.0) then - tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0)) - tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0)) - endif -C Probabilities of different move types - sumpro_type(0)=0.0D0 - call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0) - call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0) - sumpro_type(2)=sumpro_type(1)+sumpro_type(2) - call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0) - sumpro_type(3)=sumpro_type(2)+sumpro_type(3) - call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0) - sumpro_type(4)=sumpro_type(3)+sumpro_type(4) - do i=1,MaxMoveType - print *,'i',i,' sumprotype',sumpro_type(i) - sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType) - print *,'i',i,' sumprotype',sumpro_type(i) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine read_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MINIM' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 minimcard - call card_concat(minimcard) - call readi(minimcard,'MAXMIN',maxmin,2000) - call readi(minimcard,'MAXFUN',maxfun,5000) - call readi(minimcard,'MINMIN',minmin,maxmin) - call readi(minimcard,'MINFUN',minfun,maxmin) - call reada(minimcard,'TOLF',tolf,1.0D-2) - call reada(minimcard,'RTOLF',rtolf,1.0D-4) - print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1) - print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1) - print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1) - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Options in energy minimization:' - write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') - & 'MaxMin:',MaxMin,' MaxFun:',MaxFun, - & 'MinMin:',MinMin,' MinFun:',MinFun, - & ' TolF:',TolF,' RTolF:',RTolF - return - end -c---------------------------------------------------------------------------- - subroutine read_angles(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' -c Read angles from input -c - read (kanal,*,err=10,end=10) (theta(i),i=3,nres) - read (kanal,*,err=10,end=10) (phi(i),i=4,nres) - read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1) - read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1) - - do i=1,nres -c 9/7/01 avoid 180 deg valence angle - if (theta(i).gt.179.99d0) theta(i)=179.99d0 -c - theta(i)=deg2rad*theta(i) - phi(i)=deg2rad*phi(i) - alph(i)=deg2rad*alph(i) - omeg(i)=deg2rad*omeg(i) - enddo - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine openunits - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - character*16 form,nodename - integer nodelen -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - integer lenpre,lenpot,ilen,lentmp - external ilen - character*3 out1file_text,ucase - character*3 ll - external ucase -c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits" - call getenv_loc("PREFIX",prefix) - pref_orig = prefix - call getenv_loc("POT",pot) - call getenv_loc("DIRTMP",tmpdir) - call getenv_loc("CURDIR",curdir) - call getenv_loc("OUT1FILE",out1file_text) -c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV" - out1file_text=ucase(out1file_text) - if (out1file_text(1:1).eq."Y") then - out1file=.true. - else - out1file=fg_rank.gt.0 - endif - lenpre=ilen(prefix) - lenpot=ilen(pot) - lentmp=ilen(tmpdir) - if (lentmp.gt.0) then - write (*,'(80(1h!))') - write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!" - write (*,'(80(1h!))') - write (*,*)"All output files will be on node /tmp directory." -#ifdef MPI - call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR ) - if (me.eq.king) then - write (*,*) "The master node is ",nodename - else if (fg_rank.eq.0) then - write (*,*) "I am the CG slave node ",nodename - else - write (*,*) "I am the FG slave node ",nodename - endif -#endif - PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre) - lenpre = lentmp+lenpre+1 - endif - entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' -C Get the names and open the input files -#if defined(WINIFL) || defined(WINPGI) - open(1,file=pref_orig(:ilen(pref_orig))// - & '.inp',status='old',readonly,shared) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly,shared) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly,shared) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly,shared) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly,shared) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly,shared) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly,shared) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly,shared) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & action='read') -c print *,"Processor",myrank," opened file 1" - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -c print *,"Processor",myrank," opened file 9" -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') -c print *,"Processor",myrank," opened file IBOND" - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -c print *,"Processor",myrank," opened file ITHEP" -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',action='read') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -c print *,"Processor",myrank," opened file IROTAM" -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORP" - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORDP" - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') -c print *,"Processor",myrank," opened file ISCCOR" - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') -c print *,"Processor",myrank," opened file IFOURIER" - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') -c print *,"Processor",myrank," opened file IELEP" - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -c print *,"Processor",myrank," opened file ISIDEP" -c print *,"Processor",myrank," opened parameter files" -#elif (defined G77) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') -#else - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - &action='read') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - print *,"thetname_pdb ",thetname_pdb - open (ithep_pdb,file=thetname_pdb,status='old',action='read') - print *,ithep_pdb," opened" -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -#endif -#ifndef OLDSCP -C -C 8/9/01 In the newest version SCp interaction constants are read from a file -C Use -DOLDSCP to use hard-coded constants instead. -C - call getenv_loc('SCPPAR',scpname) -#if defined(WINIFL) || defined(WINPGI) - open (iscpp,file=scpname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (iscpp,file=scpname,status='old',action='read') -#elif (defined G77) - open (iscpp,file=scpname,status='old') -#else - open (iscpp,file=scpname,status='old',action='read') -#endif -#endif - call getenv_loc('PATTERN',patname) -#if defined(WINIFL) || defined(WINPGI) - open (icbase,file=patname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (icbase,file=patname,status='old',action='read') -#elif (defined G77) - open (icbase,file=patname,status='old') -#else - open (icbase,file=patname,status='old',action='read') -#endif -#ifdef MPI -C Open output file only for CG processes -c print *,"Processor",myrank," fg_rank",fg_rank - if (fg_rank.eq.0) then - - if (nodes.eq.1) then - npos=3 - else - npos = dlog10(dfloat(nodes-1))+1 - endif - if (npos.lt.3) npos=3 - write (liczba,'(i1)') npos - form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) - & //')' - write (liczba,form) me - outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// - & liczba(:ilen(liczba)) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //liczba(:ilen(liczba))//'.stat') - rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) - & //'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.const' - endif - - endif -#else - outname=prefix(:lenpre)//'.out_'//pot(:lenpot) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //'.stat') - rest2name=prefix(:ilen(prefix))//'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const' - endif -#endif -#if defined(AIX) || defined(PGI) - if (me.eq.king .or. .not. out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',position='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',position='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#else - if (me.eq.king .or. .not.out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - print "Processor",fg_rank," opening output file" - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',access='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',access='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#endif -csa csa_rbank=prefix(:lenpre)//'.CSA.rbank' -csa csa_seed=prefix(:lenpre)//'.CSA.seed' -csa csa_history=prefix(:lenpre)//'.CSA.history' -csa csa_bank=prefix(:lenpre)//'.CSA.bank' -csa csa_bank1=prefix(:lenpre)//'.CSA.bank1' -csa csa_alpha=prefix(:lenpre)//'.CSA.alpha' -csa csa_alpha1=prefix(:lenpre)//'.CSA.alpha1' -csac!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt' -csa csa_int=prefix(:lenpre)//'.int' -csa csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized' -csa csa_native_int=prefix(:lenpre)//'.CSA.native.int' -csa csa_in=prefix(:lenpre)//'.CSA.in' -c print *,"Processor",myrank,"fg_rank",fg_rank," opened files" -C Write file names - if (me.eq.king)then - write (iout,'(80(1h-))') - write (iout,'(30x,a)') "FILE ASSIGNMENT" - write (iout,'(80(1h-))') - write (iout,*) "Input file : ", - & pref_orig(:ilen(pref_orig))//'.inp' - write (iout,*) "Output file : ", - & outname(:ilen(outname)) - write (iout,*) - write (iout,*) "Sidechain potential file : ", - & sidename(:ilen(sidename)) -#ifndef OLDSCP - write (iout,*) "SCp potential file : ", - & scpname(:ilen(scpname)) -#endif - write (iout,*) "Electrostatic potential file : ", - & elename(:ilen(elename)) - write (iout,*) "Cumulant coefficient file : ", - & fouriername(:ilen(fouriername)) - write (iout,*) "Torsional parameter file : ", - & torname(:ilen(torname)) - write (iout,*) "Double torsional parameter file : ", - & tordname(:ilen(tordname)) - write (iout,*) "SCCOR parameter file : ", - & sccorname(:ilen(sccorname)) - write (iout,*) "Bond & inertia constant file : ", - & bondname(:ilen(bondname)) - write (iout,*) "Bending parameter file : ", - & thetname(:ilen(thetname)) - write (iout,*) "Rotamer parameter file : ", - & rotname(:ilen(rotname)) - write (iout,*) "Threading database : ", - & patname(:ilen(patname)) - if (lentmp.ne.0) - &write (iout,*)" DIRTMP : ", - & tmpdir(:lentmp) - write (iout,'(80(1h-))') - endif - return - end -c---------------------------------------------------------------------------- - subroutine card_concat(card) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*(*) card - character*80 karta,ucase - external ilen - read (inp,'(a)') karta - karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end -c---------------------------------------------------------------------------------- - subroutine readrst - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - open(irest2,file=rest2name,status='unknown') - read(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - read(irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl) then - read (irest2,*) iset - endif - close(irest2) - return - end -c--------------------------------------------------------------------------------- - subroutine read_fragments - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - read(inp,*) nset,nfrag,npair,nfrag_back - if(me.eq.king.or..not.out1file) - & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair, - & " nfrag_back",nfrag_back - do iset=1,nset - read(inp,*) mset(iset) - do i=1,nfrag - read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset), - & qinfrag(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset), - & ifrag(2,i,iset), qinfrag(i,iset) - enddo - do i=1,npair - read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset), - & qinpair(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset), - & ipair(2,i,iset), qinpair(i,iset) - enddo - do i=1,nfrag_back - read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset), - & ifrag_back(1,i,iset),ifrag_back(2,i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset) - enddo - enddo - return - end -c------------------------------------------------------------------------------- - subroutine read_dist_constr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - integer ifrag_(2,100),ipair_(2,100) - double precision wfrag_(100),wpair_(100) - character*500 controlcard -c write (iout,*) "Calling read_dist_constr" -c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup -c call flush(iout) - call card_concat(controlcard) - call readi(controlcard,"NFRAG",nfrag_,0) - call readi(controlcard,"NPAIR",npair_,0) - call readi(controlcard,"NDIST",ndist_,0) - call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) - call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) - call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) - call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) - call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) -c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ -c write (iout,*) "IFRAG" -c do i=1,nfrag_ -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) -c enddo -c write (iout,*) "IPAIR" -c do i=1,npair_ -c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) -c enddo - if (.not.refstr .and. nfrag.gt.0) then - write (iout,*) - & "ERROR: no reference structure to compute distance restraints" - write (iout,*) - & "Restraints must be specified explicitly (NDIST=number)" - stop - endif - if (nfrag.lt.2 .and. npair.gt.0) then - write (iout,*) "ERROR: Less than 2 fragments specified", - & " but distance restraints between pairs requested" - stop - endif - call flush(iout) - do i=1,nfrag_ - if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup - if (ifrag_(2,i).gt.nstart_sup+nsup-1) - & ifrag_(2,i)=nstart_sup+nsup-1 -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) - call flush(iout) - if (wfrag_(i).gt.0.0d0) then - do j=ifrag_(1,i),ifrag_(2,i)-1 - do k=j+1,ifrag_(2,i) -c write (iout,*) "j",j," k",k - ddjk=dist(j,k) - if (constr_dist.eq.1) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - else if (constr_dist.eq.2) then - if (ddjk.le.dist_cut) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - endif - else - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) - endif -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,npair_ - if (wpair_(i).gt.0.0d0) then - ii = ipair_(1,i) - jj = ipair_(2,i) - if (ii.gt.jj) then - itemp=ii - ii=jj - jj=itemp - endif - do j=ifrag_(1,ii),ifrag_(2,ii) - do k=ifrag_(1,jj),ifrag_(2,jj) - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - forcon(nhpb)=wpair_(i) - dhpb(nhpb)=dist(j,k) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,ndist_ - read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), - & ibecarb(i),forcon(nhpb+1) - if (forcon(nhpb+1).gt.0.0d0) then - nhpb=nhpb+1 - if (ibecarb(i).gt.0) then - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - endif - if (dhpb(nhpb).eq.0.0d0) - & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) - endif - enddo -#ifdef MPI - if (.not.out1file .or. me.eq.king) then -#endif - do i=1,nhpb - write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ", - & i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i) - enddo - call flush(iout) -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- -#ifdef WINIFL - subroutine flush(iu) - return - end -#endif -#ifdef AIX - subroutine flush(iu) - call flush_(iu) - return - end -#endif -c------------------------------------------------------------------------------ - subroutine copy_to_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - character* 256 tmpfile - integer ilen - external ilen - logical ex - tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source)) - inquire(file=tmpfile,exist=ex) - if (ex) then - write (*,*) "Copying ",tmpfile(:ilen(tmpfile)), - & " to temporary directory..." - write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir - call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir) - endif - return - end -c------------------------------------------------------------------------------ - subroutine move_from_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - integer ilen - external ilen - write (*,*) "Moving ",source(:ilen(source)), - & " from temporary directory to working directory" - write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir - call system("/bin/mv "//source(:ilen(source))//" "//curdir) - return - end -c------------------------------------------------------------------------------ - subroutine random_init(seed) -C -C Initialize random number generator -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef AMD64 - integer*8 iseedi8 -#endif -#ifdef MPI - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 - integer iseed_array(4) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - iseed=-dint(dabs(seed)) - if (iseed.eq.0) then - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' - write (*,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' -#ifdef MPI - call mpi_finalize(mpi_comm_world,ierr) -#endif - stop 'Bad random seed.' - endif -#ifdef MPI - if (fg_rank.eq.0) then - seed=seed*(me+1)+1 -#ifdef AMD64 - iseedi8=dint(seed) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - OKRandom = prng_restart(me,iseedi8) -#else - do i=1,4 - tmp=65536.0d0**(4-i) - iseed_array(i) = dint(seed/tmp) - seed=seed-iseed_array(i)*tmp - enddo - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - write (*,*) 'MPI: node= ',me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - OKRandom = prng_restart(me,iseed_array) -#endif - if (OKRandom) then - r1=ran_number(0.0D0,1.0D0) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'ran_num',r1 - if (r1.lt.0.0d0) OKRandom=.false. - endif - if (.not.OKRandom) then - write (iout,*) 'PRNG IS NOT WORKING!!!' - print *,'PRNG IS NOT WORKING!!!' - if (me.eq.0) then - call flush(iout) - call mpi_abort(mpi_comm_world,error_msg,ierr) - stop - else - write (iout,*) 'too many processors for parallel prng' - write (*,*) 'too many processors for parallel prng' - call flush(iout) - stop - endif - endif - endif -#else - call vrndst(iseed) - write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0) -#endif - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/refsys.f b/source/unres/src_MD-NEWSC-NEWC/refsys.f deleted file mode 100644 index b57c201..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/refsys.f +++ /dev/null @@ -1,60 +0,0 @@ - subroutine refsys(i2,i3,i4,e1,e2,e3,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c this subroutine calculates unity vectors of a local reference system -c defined by atoms (i2), (i3), and (i4). the x axis is the axis from -c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms -c (i2), (i3), and (i4). z axis is directed according to the sign of the -c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms -c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4) -c form a linear fragment. returns vectors e1, e2, and e3. - logical fail - double precision e1(3),e2(3),e3(3) - double precision u(3),z(3) - include 'COMMON.IOUNITS' - include "COMMON.CHAIN" - data coinc /1.0d-13/,align /1.0d-13/ - fail=.false. - s1=0.0d0 - s2=0.0d0 - do 1 i=1,3 - zi=c(i,i2)-c(i,i3) - ui=c(i,i4)-c(i,i3) - s1=s1+zi*zi - s2=s2+ui*ui - z(i)=zi - 1 u(i)=ui - s1=sqrt(s1) - s2=sqrt(s2) - if (s1.gt.coinc) goto 2 - write (iout,1000) i2,i3,i1 - fail=.true. - return - 2 if (s2.gt.coinc) goto 4 - write(iout,1000) i3,i4,i1 - fail=.true. - return - 4 s1=1.0/s1 - s2=1.0/s2 - v1=z(2)*u(3)-z(3)*u(2) - v2=z(3)*u(1)-z(1)*u(3) - v3=z(1)*u(2)-z(2)*u(1) - anorm=sqrt(v1*v1+v2*v2+v3*v3) - if (anorm.gt.align) goto 6 - write (iout,1010) i2,i3,i4,i1 - fail=.true. - return - 6 anorm=1.0/anorm - e3(1)=v1*anorm - e3(2)=v2*anorm - e3(3)=v3*anorm - e1(1)=z(1)*s1 - e1(2)=z(2)*s1 - e1(3)=z(3)*s1 - e2(1)=e1(3)*e3(2)-e1(2)*e3(3) - e2(2)=e1(1)*e3(3)-e1(3)*e3(1) - e2(3)=e1(2)*e3(1)-e1(1)*e3(2) - 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.') - 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear') - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/regularize.F b/source/unres/src_MD-NEWSC-NEWC/regularize.F deleted file mode 100644 index c506b8a..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/regularize.F +++ /dev/null @@ -1,76 +0,0 @@ - subroutine regularize(ncart,etot,rms,cref0,iretcode) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar) - double precision cref0(3,ncart) - double precision energia(0:n_ene) - logical non_conv - link_end0=link_end - do i=1,nhpb - fhpb0(i)=forcon(i) - enddo - maxit_reg=2 - print *,'Enter REGULARIZE: nnt=',nnt,' nct=',nct,' nsup=',nsup, - & ' nstart_seq=',nstart_seq,' nstart_sup',nstart_sup - write (iout,'(/a/)') 'Initial energies:' - call geom_to_var(nvar,varia) - call chainbuild - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - write (iout,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - write (*,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - maxit0=maxit - maxfun0=maxfun - rtolf0=rtolf - maxit=100 - maxfun=200 - rtolf=1.0D-2 - do it=1,maxit_reg - print *,'Regularization: pass:',it -C Minimize with distance constraints, gradually relieving the weight. - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - if (iretcode.eq.11) return - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,i2,a,f10.5,a,1pe14.5,a,i3/)') - & 'Finish pass',it,', RMS deviation:',rms,', energy',etot, - & ' SUMSL convergence',iretcode - do i=nss+1,nhpb - forcon(i)=0.1D0*forcon(i) - enddo - enddo -C Turn off the distance constraints and re-minimize energy. - print *,'Final minimization ... ' - maxit=maxit0 - maxfun=maxfun0 - rtolf=rtolf0 - link_end=min0(link_end,nss) - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),nsup, - & przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,f10.5,a,1pe14.5,a,i3/)') - & 'Final RMS deviation:',rms,' energy',etot,' SUMSL convergence', - & iretcode - link_end=link_end0 - do i=nss+1,nhpb - forcon(i)=fhpb0(i) - enddo - call var_to_geom(nvar,varia) - call chainbuild - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/rescode.f b/source/unres/src_MD-NEWSC-NEWC/rescode.f deleted file mode 100644 index 2973ef9..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/rescode.f +++ /dev/null @@ -1,32 +0,0 @@ - integer function rescode(iseq,nam,itype) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - character*3 nam,ucase - - if (itype.eq.0) then - - do i=1,ntyp1 - if (ucase(nam).eq.restyp(i)) then - rescode=i - return - endif - enddo - - else - - do i=1,ntyp1 - if (nam(1:1).eq.onelet(i)) then - rescode=i - return - endif - enddo - - endif - - write (iout,10) iseq,nam - stop - 10 format ('**** Error - residue',i4,' has an unresolved name ',a3) - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/rmdd.f b/source/unres/src_MD-NEWSC-NEWC/rmdd.f deleted file mode 100644 index 799ab47..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/rmdd.f +++ /dev/null @@ -1,159 +0,0 @@ -c algorithm 611, collected algorithms from acm. -c algorithm appeared in acm-trans. math. software, vol.9, no. 4, -c dec., 1983, p. 503-524. - integer function imdcon(k) -c - integer k -c -c *** return integer machine-dependent constants *** -c -c *** k = 1 means return standard output unit number. *** -c *** k = 2 means return alternate output unit number. *** -c *** k = 3 means return input unit number. *** -c (note -- k = 2, 3 are used only by test programs.) -c -c +++ port version follows... -c external i1mach -c integer i1mach -c integer mdperm(3) -c data mdperm(1)/2/, mdperm(2)/4/, mdperm(3)/1/ -c imdcon = i1mach(mdperm(k)) -c +++ end of port version +++ -c -c +++ non-port version follows... - integer mdcon(3) - data mdcon(1)/6/, mdcon(2)/8/, mdcon(3)/5/ - imdcon = mdcon(k) -c +++ end of non-port version +++ -c - 999 return -c *** last card of imdcon follows *** - end - double precision function rmdcon(k) -c -c *** return machine dependent constants used by nl2sol *** -c -c +++ comments below contain data statements for various machines. +++ -c +++ to convert to another machine, place a c in column 1 of the +++ -c +++ data statement line(s) that correspond to the current machine +++ -c +++ and remove the c from column 1 of the data statement line(s) +++ -c +++ that correspond to the new machine. +++ -c - integer k -c -c *** the constant returned depends on k... -c -c *** k = 1... smallest pos. eta such that -eta exists. -c *** k = 2... square root of eta. -c *** k = 3... unit roundoff = smallest pos. no. machep such -c *** that 1 + machep .gt. 1 .and. 1 - machep .lt. 1. -c *** k = 4... square root of machep. -c *** k = 5... square root of big (see k = 6). -c *** k = 6... largest machine no. big such that -big exists. -c - double precision big, eta, machep - integer bigi(4), etai(4), machei(4) -c/+ - double precision dsqrt -c/ - equivalence (big,bigi(1)), (eta,etai(1)), (machep,machei(1)) -c -c +++ ibm 360, ibm 370, or xerox +++ -c -c data big/z7fffffffffffffff/, eta/z0010000000000000/, -c 1 machep/z3410000000000000/ -c -c +++ data general +++ -c -c data big/0.7237005577d+76/, eta/0.5397605347d-78/, -c 1 machep/2.22044605d-16/ -c -c +++ dec 11 +++ -c -c data big/1.7d+38/, eta/2.938735878d-39/, machep/2.775557562d-17/ -c -c +++ hp3000 +++ -c -c data big/1.157920892d+77/, eta/8.636168556d-78/, -c 1 machep/5.551115124d-17/ -c -c +++ honeywell +++ -c -c data big/1.69d+38/, eta/5.9d-39/, machep/2.1680435d-19/ -c -c +++ dec10 +++ -c -c data big/"377777100000000000000000/, -c 1 eta/"002400400000000000000000/, -c 2 machep/"104400000000000000000000/ -c -c +++ burroughs +++ -c -c data big/o0777777777777777,o7777777777777777/, -c 1 eta/o1771000000000000,o7770000000000000/, -c 2 machep/o1451000000000000,o0000000000000000/ -c -c +++ control data +++ -c -c data big/37767777777777777777b,37167777777777777777b/, -c 1 eta/00014000000000000000b,00000000000000000000b/, -c 2 machep/15614000000000000000b,15010000000000000000b/ -c -c +++ prime +++ -c -c data big/1.0d+9786/, eta/1.0d-9860/, machep/1.4210855d-14/ -c -c +++ univac +++ -c -c data big/8.988d+307/, eta/1.2d-308/, machep/1.734723476d-18/ -c -c +++ vax +++ -c - data big/1.7d+38/, eta/2.939d-39/, machep/1.3877788d-17/ -c -c +++ cray 1 +++ -c -c data bigi(1)/577767777777777777777b/, -c 1 bigi(2)/000007777777777777776b/, -c 2 etai(1)/200004000000000000000b/, -c 3 etai(2)/000000000000000000000b/, -c 4 machei(1)/377224000000000000000b/, -c 5 machei(2)/000000000000000000000b/ -c -c +++ port library -- requires more than just a data statement... +++ -c -c external d1mach -c double precision d1mach, zero -c data big/0.d+0/, eta/0.d+0/, machep/0.d+0/, zero/0.d+0/ -c if (big .gt. zero) go to 1 -c big = d1mach(2) -c eta = d1mach(1) -c machep = d1mach(4) -c1 continue -c -c +++ end of port +++ -c -c------------------------------- body -------------------------------- -c - go to (10, 20, 30, 40, 50, 60), k -c - 10 rmdcon = eta - go to 999 -c - 20 rmdcon = dsqrt(256.d+0*eta)/16.d+0 - go to 999 -c - 30 rmdcon = machep - go to 999 -c - 40 rmdcon = dsqrt(machep) - go to 999 -c - 50 rmdcon = dsqrt(big/256.d+0)*16.d+0 - go to 999 -c - 60 rmdcon = big -c - 999 return -c *** last card of rmdcon follows *** - end diff --git a/source/unres/src_MD-NEWSC-NEWC/rmsd.F b/source/unres/src_MD-NEWSC-NEWC/rmsd.F deleted file mode 100644 index 52e7b37..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/rmsd.F +++ /dev/null @@ -1,140 +0,0 @@ - subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - include 'COMMON.IOUNITS' - double precision przes(3),obr(3,3) - logical non_conv,lprn -c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, -c & obr,non_conv) -c rms=dsqrt(rms) - call rmsd(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref) - if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100, - & ' % of nonnative contacts:',frac_nn*100, - & ' contact order:',co - - return - end -c--------------------------------------------------------------------------- - subroutine rmsd(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 -c print *,"nz_start",nz_start," nz_end",nz_end - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,nres+i) - enddo - endif - enddo - -c ----- diagnostics -c write (iout,*) 'Ccopy and CREFcopy' -c print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c ----- end diagnostics - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd' - write (iout,*) 'Problems in FITSQ!!! rmsd' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI -c call mpi_abort(mpi_comm_world,ierror,ierrcode) - roznica=100.0 -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) -c ---- diagnostics -c write (iout,*) "rms",drms -c ---- end diagnostics - return - end - -c-------------------------------------------- - subroutine rmsd_csa(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i) - crefcopy(k,iatom)=crefjlee(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i) - crefcopy(k,iatom)=crefjlee(k,nres+i) - enddo - endif - enddo - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd_csa' - write (iout,*) 'Problems in FITSQ!!! rmsd_csa' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI - call mpi_abort(mpi_comm_world,ierror,ierrcode) -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) - return - end - diff --git a/source/unres/src_MD-NEWSC-NEWC/sc_move.F b/source/unres/src_MD-NEWSC-NEWC/sc_move.F deleted file mode 100644 index b6837fd..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/sc_move.F +++ /dev/null @@ -1,823 +0,0 @@ - subroutine sc_move(n_start,n_end,n_maxtry,e_drop, - + n_fun,etot) -c Perform a quick search over side-chain arrangments (over -c residues n_start to n_end) for a given (frozen) CA trace -c Only side-chains are minimized (at most n_maxtry times each), -c not CA positions -c Stops if energy drops by e_drop, otherwise tries all residues -c in the given range -c If there is an energy drop, full minimization may be useful -c n_start, n_end CAN be modified by this routine, but only if -c out of bounds (n_start <= 1, n_end >= nres, n_start < n_end) -c NOTE: this move should never increase the energy -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c External functions - integer iran_num - external iran_num - -c Input arguments - integer n_start,n_end,n_maxtry - double precision e_drop - -c Output arguments - integer n_fun - double precision etot - -c Local variables - double precision energy(0:n_ene) - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision orig_e,cur_e - integer n,n_steps,n_first,n_cur,n_tot,i - double precision orig_w(n_ene) - double precision wtime - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - orig_w(15)=wvdwpp - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - wvdwpp=0.D0 - -c Make sure n_start, n_end are within proper range - if (n_start.lt.2) n_start=2 - if (n_end.gt.nres-1) n_end=nres-1 -crc if (n_start.lt.n_end) then - if (n_start.gt.n_end) then - n_start=2 - n_end=nres-1 - endif - -c Save the initial values of energy and coordinates -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'start sc ene',energy(0) -cd call enerprint(energy(0)) -crc etot=energy(0) - n_fun=0 -crc orig_e=etot -crc cur_e=orig_e -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo - -ct wtime=MPI_WTIME() -c Try (one by one) all specified residues, starting from a -c random position in sequence -c Stop early if the energy has decreased by at least e_drop - n_tot=n_end-n_start+1 - n_first=iran_num(0,n_tot-1) - n_steps=0 - n=0 -crc do while (n.lt.n_tot .and. orig_e-etot.lt.e_drop) - do while (n.lt.n_tot) - n_cur=n_start+mod(n_first+n,n_tot) - call single_sc_move(n_cur,n_maxtry,e_drop, - + n_steps,n_fun,etot) -c If a lower energy was found, update the current structure... -crc if (etot.lt.cur_e) then -crc cur_e=etot -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo -crc else -c ...else revert to the previous one -crc etot=cur_e -crc do i=2,nres-1 -crc alph(i)=cur_alph(i) -crc omeg(i)=cur_omeg(i) -crc enddo -crc endif - n=n+1 -cd -cd call chainbuild -cd call etotal(energy) -cd print *,'running',n,energy(0) - enddo - -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'end sc ene',energy(0) - -c Put the original weights back to calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - wvdwpp=orig_w(15) - -crc n_fun=n_fun+1 -ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime - return - end - -c------------------------------------------------------------- - - subroutine single_sc_move(res_pick,n_maxtry,e_drop, - + n_steps,n_fun,e_sc) -c Perturb one side-chain (res_pick) and minimize the -c neighbouring region, keeping all CA's and non-neighbouring -c side-chains fixed -c Try until e_drop energy improvement is achieved, or n_maxtry -c attempts have been made -c At the start, e_sc should contain the side-chain-only energy(0) -c nsteps and nfun for this move are ADDED to n_steps and n_fun -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - -c External functions - double precision dist - external dist - -c Input arguments - integer res_pick,n_maxtry - double precision e_drop - -c Input/Output arguments - integer n_steps,n_fun - double precision e_sc - -c Local variables - logical fail - integer i,j - integer nres_moved - integer iretcode,loc_nfun,orig_maxfun,n_try - double precision sc_dist,sc_dist_cutoff - double precision energy(0:n_ene),orig_e,cur_e - double precision evdw,escloc - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision var(maxvar) - - double precision orig_theta(1:nres),orig_phi(1:nres), - + orig_alph(1:nres),orig_omeg(1:nres) - - -c Define what is meant by "neighbouring side-chain" - sc_dist_cutoff=5.0D0 - -c Don't do glycine or ends - i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return - -c Freeze everything (later will relax only selected side-chains) - mask_r=.true. - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=0 - enddo - -c Find the neighbours of the side-chain to move -c and save initial variables -crc orig_e=e_sc -crc cur_e=orig_e - nres_moved=0 - do i=2,nres-1 -c Don't do glycine (itype(j)==10) - if (itype(i).ne.10) then - sc_dist=dist(nres+i,nres+res_pick) - else - sc_dist=sc_dist_cutoff - endif - if (sc_dist.lt.sc_dist_cutoff) then - nres_moved=nres_moved+1 - mask_side(i)=1 - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - - call chainbuild - call egb1(evdw) - call esc(escloc) - e_sc=wsc*evdw+wscloc*escloc -cd call etotal(energy) -cd print *,'new ',(energy(k),k=0,n_ene) - orig_e=e_sc - cur_e=orig_e - - n_try=0 - do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop) -c Move the selected residue (don't worry if it fails) - call gen_side(itype(res_pick),theta(res_pick+1), - + alph(res_pick),omeg(res_pick),fail) - -c Minimize the side-chains starting from the new arrangement - call geom_to_var(nvar,var) - orig_maxfun=maxfun - maxfun=7 - -crc do i=1,nres -crc orig_theta(i)=theta(i) -crc orig_phi(i)=phi(i) -crc orig_alph(i)=alph(i) -crc orig_omeg(i)=omeg(i) -crc enddo - - call minimize_sc1(e_sc,var,iretcode,loc_nfun) - -cv write(*,'(2i3,2f12.5,2i3)') -cv & res_pick,nres_moved,orig_e,e_sc-cur_e, -cv & iretcode,loc_nfun - -c$$$ if (iretcode.eq.8) then -c$$$ write(iout,*)'Coordinates just after code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ do i=1,nres -c$$$ theta(i)=orig_theta(i) -c$$$ phi(i)=orig_phi(i) -c$$$ alph(i)=orig_alph(i) -c$$$ omeg(i)=orig_omeg(i) -c$$$ enddo -c$$$ write(iout,*)'Coordinates just before code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ endif - - n_fun=n_fun+loc_nfun - maxfun=orig_maxfun - call var_to_geom(nvar,var) - -c If a lower energy was found, update the current structure... - if (e_sc.lt.cur_e) then -cv call chainbuild -cv call etotal(energy) -cd call egb1(evdw) -cd call esc(escloc) -cd e_sc1=wsc*evdw+wscloc*escloc -cd print *,' new',e_sc1,energy(0) -cv print *,'new ',energy(0) -cd call enerprint(energy(0)) - cur_e=e_sc - do i=2,nres-1 - if (mask_side(i).eq.1) then - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - else -c ...else revert to the previous one - e_sc=cur_e - do i=2,nres-1 - if (mask_side(i).eq.1) then - alph(i)=cur_alph(i) - omeg(i)=cur_omeg(i) - endif - enddo - endif - n_try=n_try+1 - - enddo - n_steps=n_steps+n_try - -c Reset the minimization mask_r to false - mask_r=.false. - - return - end - -c------------------------------------------------------------- - - subroutine sc_minimize(etot,iretcode,nfun) -c Minimizes side-chains only, leaving backbone frozen -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c Output arguments - double precision etot - integer iretcode,nfun - -c Local variables - integer i - double precision orig_w(n_ene),energy(0:n_ene) - double precision var(maxvar) - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - -c Prepare to freeze backbone - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=1 - enddo - -c Minimize the side-chains - mask_r=.true. - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - call var_to_geom(nvar,var) - mask_r=.false. - -c Put the original weights back and calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - - call chainbuild - call etotal(energy) - etot=energy(0) - - return - end - -c------------------------------------------------------------- - subroutine minimize_sc1(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr1,grad_restr1 - logical not_done,change,reduce - common /przechowalnia/ v - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr1,grad_restr1, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - - return - end -************************************************************************ - subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.TIME1' - common /chuju/ jjj - double precision energia(0:n_ene),evdw,escloc - integer jjj - double precision ufparm,e1,e2 - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf - icg=mod(nf,2)+1 - -#ifdef OSF -c Intercept NaNs in the coordinates, before calling etotal - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - FOUND_NAN=.false. - if (x_sum.ne.x_sum) then - write(iout,*)" *** func_restr1 : Found NaN in coordinates" - f=1.0D+73 - FOUND_NAN=.true. - return - endif -#endif - - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call egb1(evdw) - call esc(escloc) - f=wsc*evdw+wscloc*escloc -cd call etotal(energia(0)) -cd f=wsc*energia(1)+wscloc*energia(12) -cd print *,f,evdw,escloc,energia(0) -C -C Sum up the components of the Cartesian gradient. -C - do i=1,nct - do j=1,3 - gradx(j,i,icg)=wsc*gvdwx(j,i) - enddo - enddo - - return - end -c------------------------------------------------------- - subroutine grad_restr1(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr1(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C----------------------------------------------------------------------------- - subroutine egb1(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - - - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) -C For diagnostics only!!! -c chi1=0.0D0 -c chi2=0.0D0 -c chi12=0.0D0 -c chip1=0.0D0 -c chip2=0.0D0 -c chip12=0.0D0 -c alf1=0.0D0 -c alf2=0.0D0 -c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -cd & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -cd & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad - ENDIF - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/sizes.i b/source/unres/src_MD-NEWSC-NEWC/sizes.i deleted file mode 100644 index 45c44ff..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/sizes.i +++ /dev/null @@ -1,83 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1992 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ############################################################# -c ## ## -c ## sizes.i -- parameter values to set array dimensions ## -c ## ## -c ############################################################# -c -c -c "sizes.i" sets values for critical array dimensions used -c throughout the software; these parameters will fix the size -c of the largest systems that can be handled; values too large -c for the computer's memory and/or swap space to accomodate -c will result in poor performance or outright failure -c -c parameter: maximum allowed number of: -c -c maxatm atoms in the molecular system -c maxval atoms directly bonded to an atom -c maxgrp user-defined groups of atoms -c maxtyp force field atom type definitions -c maxclass force field atom class definitions -c maxkey lines in the keyword file -c maxrot bonds for torsional rotation -c maxvar optimization variables (vector storage) -c maxopt optimization variables (matrix storage) -c maxhess off-diagonal Hessian elements -c maxlight sites for method of lights neighbors -c maxvib vibrational frequencies -c maxgeo distance geometry points -c maxcell unit cells in replicated crystal -c maxring 3-, 4-, or 5-membered rings -c maxfix geometric restraints -c maxbio biopolymer atom definitions -c maxres residues in the macromolecule -c maxamino amino acid residue types -c maxnuc nucleic acid residue types -c maxbnd covalent bonds in molecular system -c maxang bond angles in molecular system -c maxtors torsional angles in molecular system -c maxpi atoms in conjugated pisystem -c maxpib covalent bonds involving pisystem -c maxpit torsional angles involving pisystem -c -c - integer maxatm,maxval,maxgrp - integer maxtyp,maxclass,maxkey - integer maxrot,maxopt - integer maxhess,maxlight,maxvib - integer maxgeo,maxcell,maxring - integer maxfix,maxbio - integer maxamino,maxnuc,maxbnd - integer maxang,maxtors,maxpi - integer maxpib,maxpit - parameter (maxatm=maxres2) - parameter (maxval=8) - parameter (maxgrp=1000) - parameter (maxtyp=3000) - parameter (maxclass=500) - parameter (maxkey=10000) - parameter (maxrot=1000) - parameter (maxopt=1000) - parameter (maxhess=1000000) - parameter (maxlight=8*maxatm) - parameter (maxvib=1000) - parameter (maxgeo=1000) - parameter (maxcell=10000) - parameter (maxring=10000) - parameter (maxfix=10000) - parameter (maxbio=10000) - parameter (maxamino=31) - parameter (maxnuc=12) - parameter (maxbnd=2*maxatm) - parameter (maxang=3*maxatm) - parameter (maxtors=4*maxatm) - parameter (maxpi=100) - parameter (maxpib=2*maxpi) - parameter (maxpit=4*maxpi) diff --git a/source/unres/src_MD-NEWSC-NEWC/sort.f b/source/unres/src_MD-NEWSC-NEWC/sort.f deleted file mode 100644 index 46b43d9..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/sort.f +++ /dev/null @@ -1,589 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1990 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ######################################################### -c ## ## -c ## subroutine sort -- heapsort of an integer array ## -c ## ## -c ######################################################### -c -c -c "sort" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm -c -c - subroutine sort (n,list) - implicit none - integer i,j,k,n - integer index,lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################## -c ## ## -c ## subroutine sort2 -- heapsort of real array with keys ## -c ## ## -c ############################################################## -c -c -c "sort2" takes an input list of reals and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort2 (n,list,key) - implicit none - integer i,j,k,n - integer index,keys - integer key(*) - real*8 lists - real*8 list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort3 -- heapsort of integer array with keys ## -c ## ## -c ################################################################# -c -c -c "sort3" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort3 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer lists - integer keys - integer list(*) - integer key(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort4 -- heapsort of integer absolute values ## -c ## ## -c ################################################################# -c -c -c "sort4" takes an input list of integers and sorts it into -c ascending absolute value using the Heapsort algorithm -c -c - subroutine sort4 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1 - end if - if (abs(lists) .lt. abs(list(j))) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort5 -- heapsort of integer array modulo m ## -c ## ## -c ################################################################ -c -c -c "sort5" takes an input list of integers and sorts it -c into ascending order based on each value modulo "m" -c -c - subroutine sort5 (n,list,m) - implicit none - integer i,j,k,m,n - integer index,smod - integer jmod,j1mod - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - jmod = mod(list(j),m) - j1mod = mod(list(j+1),m) - if (jmod .lt. j1mod) then - j = j + 1 - else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then - j = j + 1 - end if - end if - smod = mod(lists,m) - jmod = mod(list(j),m) - if (smod .lt. jmod) then - list(i) = list(j) - i = j - j = j + j - else if (smod.eq.jmod .and. lists.lt.list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort6 -- heapsort of a text string array ## -c ## ## -c ############################################################# -c -c -c "sort6" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm -c -c - subroutine sort6 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort7 -- heapsort of text strings with keys ## -c ## ## -c ################################################################ -c -c -c "sort7" takes an input list of character strings and sorts it -c into alphabetical order using the Heapsort algorithm; it also -c returns a key into the original ordering -c -c - subroutine sort7 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer keys - integer key(*) - character*256 lists - character*(*) list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ######################################################### -c ## ## -c ## subroutine sort8 -- heapsort to unique integers ## -c ## ## -c ######################################################### -c -c -c "sort8" takes an input list of integers and sorts it into -c ascending order using the Heapsort algorithm, duplicate -c values are removed from the final sorted list -c -c - subroutine sort8 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort9 -- heapsort to unique text strings ## -c ## ## -c ############################################################# -c -c -c "sort9" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm, -c duplicate values are removed from the final sorted list -c -c - subroutine sort9 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/ssMD.F b/source/unres/src_MD-NEWSC-NEWC/ssMD.F deleted file mode 100644 index eab3c70..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/ssMD.F +++ /dev/null @@ -1,1951 +0,0 @@ -c---------------------------------------------------------------------------- - subroutine check_energies -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - -c External functions - double precision ran_number - external ran_number - -c Local variables - integer i,j,k,l,lmax,p,pmax - double precision rmin,rmax - double precision eij - - double precision d - double precision wi,rij,tj,pj - - -c return - - i=5 - j=14 - - d=dsc(1) - rmin=2.0D0 - rmax=12.0D0 - - lmax=10000 - pmax=1 - - do k=1,3 - c(k,i)=0.0D0 - c(k,j)=0.0D0 - c(k,nres+i)=0.0D0 - c(k,nres+j)=0.0D0 - enddo - - do l=1,lmax - -ct wi=ran_number(0.0D0,pi) -c wi=ran_number(0.0D0,pi/6.0D0) -c wi=0.0D0 -ct tj=ran_number(0.0D0,pi) -ct pj=ran_number(0.0D0,pi) -c pj=ran_number(0.0D0,pi/6.0D0) -c pj=0.0D0 - - do p=1,pmax -ct rij=ran_number(rmin,rmax) - - c(1,j)=d*sin(pj)*cos(tj) - c(2,j)=d*sin(pj)*sin(tj) - c(3,j)=d*cos(pj) - - c(3,nres+i)=-rij - - c(1,i)=d*sin(wi) - c(3,i)=-rij-d*cos(wi) - - do k=1,3 - dc(k,nres+i)=c(k,nres+i)-c(k,i) - dc_norm(k,nres+i)=dc(k,nres+i)/d - dc(k,nres+j)=c(k,nres+j)-c(k,j) - dc_norm(k,nres+j)=dc(k,nres+j)/d - enddo - - call dyn_ssbond_ene(i,j,eij) - enddo - enddo - - call exit(1) - - return - end - -C----------------------------------------------------------------------------- - - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c External functions - double precision h_base - external h_base - -c Input arguments - integer resi,resj - -c Output arguments - double precision eij - -c Local variables - logical havebond -c integer itypi,itypj,k,l - double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi - double precision sig0ij,ljd,sig,fac,e1,e2 - double precision dcosom1(3),dcosom2(3),ed - double precision pom1,pom2 - double precision ljA,ljB,ljXs - double precision d_ljB(1:3) - double precision ssA,ssB,ssC,ssXs - double precision ssxm,ljxm,ssm,ljm - double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3) - double precision f1,f2,h1,h2,hd1,hd2 - double precision omega,delta_inv,deltasq_inv,fac1,fac2 -c-------FIRST METHOD - double precision xm,d_xm(1:3) -c-------END FIRST METHOD -c-------SECOND METHOD -c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) -c-------END SECOND METHOD - -c-------TESTING CODE - logical checkstop,transgrad - common /sschecks/ checkstop,transgrad - - integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 -c-------END TESTING CODE - - - i=resi - j=resj - - itypi=itype(i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=vbld_inv(i+nres) - - itypj=itype(j) - xj=c(1,nres+j)-c(1,nres+i) - yj=c(2,nres+j)-c(2,nres+i) - zj=c(3,nres+j)-c(3,nres+i) - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - dscj_inv=vbld_inv(j+nres) - - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse -c The following are set in sc_angular -c erij(1)=xj*rij -c erij(2)=yj*rij -c erij(3)=zj*rij -c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) -c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) -c om12=dxi*dxj+dyi*dyj+dzi*dzj - call sc_angular - rij=1.0D0/rij ! Reset this so it makes sense - - sig0ij=sigma(itypi,itypj) - sig=sig0ij*dsqrt(1.0D0/sigsq) - - ljXs=sig-sig0ij - ljA=eps1*eps2rt**2*eps3rt**2 - ljB=ljA*bb(itypi,itypj) - ljA=ljA*aa(itypi,itypj) - ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - - ssXs=d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - ssA=akcm - ssB=akct*deltat12 - ssC=ss_depth - & +akth*(deltat1*deltat1+deltat2*deltat2) - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi - ssxm=ssXs-0.5D0*ssB/ssA - -c-------TESTING CODE -c$$$c Some extra output -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC -c$$$ if (ssx0.gt.0.0d0) then -c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA -c$$$ else -c$$$ ssx0=ssxm -c$$$ endif -c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ", -c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12 -c$$$ return -c-------END TESTING CODE - -c-------TESTING CODE -c Stop and plot energy and derivative as a function of distance - if (checkstop) then - ssm=ssC-0.25D0*ssB*ssB/ssA - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - if (ssm.lt.ljm .and. - & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then - nicheck=1000 - njcheck=1 - deps=0.5d-7 - else - checkstop=.false. - endif - endif - if (.not.checkstop) then - nicheck=0 - njcheck=-1 - endif - - do icheck=0,nicheck - do jcheck=-1,njcheck - if (checkstop) rij=(ssxm-1.0d0)+ - & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps -c-------END TESTING CODE - - if (rij.gt.ljxm) then - havebond=.false. - ljd=rij-ljXs - fac=(1.0D0/ljd)**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - eij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=eij*eps3rt - eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt - - sigder=-sig/sigsq - e1=e1*eps1*eps2rt**2*eps3rt**2 - ed=-expon*(e1+eij)/ljd - sigder=ed*sigder - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=eij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 - else if (rij.lt.ssxm) then - havebond=.true. - ssd=rij-ssXs - eij=ssA*ssd*ssd+ssB*ssd+ssC - - ed=2*akcm*ssd+akct*deltat12 - pom1=akct*ssd - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - else - omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi - - d_ssxm(1)=0.5D0*akct/ssA - d_ssxm(2)=-d_ssxm(1) - d_ssxm(3)=0.0D0 - - d_ljxm(1)=sig0ij/sqrt(sigsq**3) - d_ljxm(2)=d_ljxm(1)*sigsq_om2 - d_ljxm(3)=d_ljxm(1)*sigsq_om12 - d_ljxm(1)=d_ljxm(1)*sigsq_om1 - -c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - xm=0.5d0*(ssxm+ljxm) - do k=1,3 - d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k)) - enddo - if (rij.lt.xm) then - havebond=.true. - ssm=ssC-0.25D0*ssB*ssB/ssA - d_ssm(1)=0.5D0*akct*ssB/ssA - d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) - d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) - d_ssm(3)=omega - f1=(rij-xm)/(ssxm-xm) - f2=(rij-ssxm)/(xm-ssxm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=ssm*h1+Ht*h2 - delta_inv=1.0d0/(xm-ssxm) - deltasq_inv=delta_inv*delta_inv - fac=ssm*hd1-Ht*hd2 - fac1=deltasq_inv*fac*(xm-rij) - fac2=deltasq_inv*fac*(rij-ssxm) - ed=delta_inv*(Ht*hd2-ssm*hd1) - eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) - eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) - eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) - else - havebond=.false. - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB - d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt) - d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- - + alf12/eps3rt) - d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt) - f1=(rij-ljxm)/(xm-ljxm) - f2=(rij-xm)/(ljxm-xm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=Ht*h1+ljm*h2 - delta_inv=1.0d0/(ljxm-xm) - deltasq_inv=delta_inv*delta_inv - fac=Ht*hd1-ljm*hd2 - fac1=deltasq_inv*fac*(ljxm-rij) - fac2=deltasq_inv*fac*(rij-xm) - ed=delta_inv*(ljm*hd2-Ht*hd1) - eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) - eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) - eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) - endif -c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - -c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE -c$$$ ssd=rij-ssXs -c$$$ ljd=rij-ljXs -c$$$ fac1=rij-ljxm -c$$$ fac2=rij-ssxm -c$$$ -c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt) -c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt) -c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt) -c$$$ -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA -c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) -c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) -c$$$ d_ssm(3)=omega -c$$$ -c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ do k=1,3 -c$$$ d_ljm(k)=ljm*d_ljB(k) -c$$$ enddo -c$$$ ljm=ljm*ljB -c$$$ -c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC -c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB -c$$$ d_ss(2)=akct*ssd -c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega -c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega -c$$$ d_ss(3)=omega -c$$$ -c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0) -c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1 -c$$$ do k=1,3 -c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1- -c$$$ & 2.0d0*ljB*fac1*d_ljxm(k)) -c$$$ enddo -c$$$ ljf=ljm+ljf*ljB*fac1*fac1 -c$$$ -c$$$ f1=(rij-ljxm)/(ssxm-ljxm) -c$$$ f2=(rij-ssxm)/(ljxm-ssxm) -c$$$ h1=h_base(f1,hd1) -c$$$ h2=h_base(f2,hd2) -c$$$ eij=ss*h1+ljf*h2 -c$$$ delta_inv=1.0d0/(ljxm-ssxm) -c$$$ deltasq_inv=delta_inv*delta_inv -c$$$ fac=ljf*hd2-ss*hd1 -c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac -c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1))) -c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2))) -c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3))) -c$$$ -c$$$ havebond=.false. -c$$$ if (ed.gt.0.0d0) havebond=.true. -c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE - - endif - - if (havebond) then -#ifndef CLUST -#ifndef WHAM -c if (dyn_ssbond_ij(i,j).eq.1.0d300) then -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_FORM",totT,t_bath,i,j -c endif -#endif -#endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 -#ifndef CLUST -#ifndef WHAM -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_BREAK",totT,t_bath,i,j -#endif -#endif - endif - -c-------TESTING CODE - if (checkstop) then - if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') - & "CHECKSTOP",rij,eij,ed - echeck(jcheck)=eij - endif - enddo - if (checkstop) then - write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps - endif - enddo - if (checkstop) then - transgrad=.true. - checkstop=.false. - endif -c-------END TESTING CODE - - do k=1,3 - dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij - dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij - enddo - do k=1,3 - gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - - return - end - -C----------------------------------------------------------------------------- - - double precision function h_base(x,deriv) -c A smooth function going 0->1 in range [0,1] -c It should NOT be called outside range [0,1], it will not work there. - implicit none - -c Input arguments - double precision x - -c Output arguments - double precision deriv - -c Local variables - double precision xsq - - -c Two parabolas put together. First derivative zero at extrema -c$$$ if (x.lt.0.5D0) then -c$$$ h_base=2.0D0*x*x -c$$$ deriv=4.0D0*x -c$$$ else -c$$$ deriv=1.0D0-x -c$$$ h_base=1.0D0-2.0D0*deriv*deriv -c$$$ deriv=4.0D0*deriv -c$$$ endif - -c Third degree polynomial. First derivative zero at extrema - h_base=x*x*(3.0d0-2.0d0*x) - deriv=6.0d0*x*(1.0d0-x) - -c Fifth degree polynomial. First and second derivatives zero at extrema -c$$$ xsq=x*x -c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0) -c$$$ deriv=x-1.0d0 -c$$$ deriv=deriv*deriv -c$$$ deriv=30.0d0*xsq*deriv - - return - end - -c---------------------------------------------------------------------------- - - subroutine dyn_set_nss -c Adjust nss and other relevant variables based on dyn_ssbond_ij -c implicit none - -c Includes - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c Local variables - double precision emin - integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) - logical found - integer i_newnss(max_fg_procs),displ(max_fg_procs) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss - - allnss=0 - do i=1,nres-1 - do j=i+1,nres - if (dyn_ssbond_ij(i,j).lt.1.0d300) then - allnss=allnss+1 - allflag(allnss)=0 - allihpb(allnss)=i - alljhpb(allnss)=j - endif - enddo - enddo - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - 1 emin=1.0d300 - do i=1,allnss - if (allflag(i).eq.0 .and. - & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then - emin=dyn_ssbond_ij(allihpb(i),alljhpb(i)) - imin=i - endif - enddo - if (emin.lt.1.0d300) then - allflag(imin)=1 - do i=1,allnss - if (allflag(i).eq.0 .and. - & (allihpb(i).eq.allihpb(imin) .or. - & alljhpb(i).eq.allihpb(imin) .or. - & allihpb(i).eq.alljhpb(imin) .or. - & alljhpb(i).eq.alljhpb(imin))) then - allflag(i)=-1 - endif - enddo - goto 1 - endif - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - newnss=0 - do i=1,allnss - if (allflag(i).eq.1) then - newnss=newnss+1 - newihpb(newnss)=allihpb(i) - newjhpb(newnss)=alljhpb(i) - endif - enddo - -#ifdef MPI - if (nfgtasks.gt.1)then - - call MPI_Reduce(newnss,g_newnss,1, - & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - call MPI_Gather(newnss,1,MPI_INTEGER, - & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_newnss(i-1)+displ(i-1) - enddo - call MPI_Gatherv(newihpb,newnss,MPI_INTEGER, - & g_newihpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER, - & g_newjhpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - if(fg_rank.eq.0) then -c print *,'g_newnss',g_newnss -c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss) -c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss) - newnss=g_newnss - do i=1,newnss - newihpb(i)=g_newihpb(i) - newjhpb(i)=g_newjhpb(i) - enddo - endif - endif -#endif - - diff=newnss-nss - -cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss) - - do i=1,nss - found=.false. - do j=1,newnss - if (idssb(i).eq.newihpb(j) .and. - & jdssb(i).eq.newjhpb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i) -#endif -#endif - enddo - - do i=1,newnss - found=.false. - do j=1,nss - if (newihpb(i).eq.idssb(j) .and. - & newjhpb(i).eq.jdssb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) -#endif -#endif - enddo - - nss=newnss - do i=1,nss - idssb(i)=newihpb(i) - jdssb(i)=newjhpb(i) - enddo - - return - end - -c---------------------------------------------------------------------------- - -#ifdef WHAM - subroutine read_ssHist - implicit none - -c Includes - include 'DIMENSIONS' - include "DIMENSIONS.FREE" - include 'COMMON.FREE' - -c Local variables - integer i,j - character*80 controlcard - - do i=1,dyn_nssHist - call card_concat(controlcard,.true.) - read(controlcard,*) - & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) - enddo - - return - end -#endif - -c---------------------------------------------------------------------------- - - -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- - -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-NEWSC-NEWC/stochfric.F b/source/unres/src_MD-NEWSC-NEWC/stochfric.F deleted file mode 100644 index 74eda61..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/stochfric.F +++ /dev/null @@ -1,626 +0,0 @@ - subroutine friction_force - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - double precision gamvec(MAXRES6) - common /syfek/ gamvec - double precision vv(3),vvtot(3,maxres),v_work(MAXRES6), - & ginvfric(maxres2,maxres2) - common /przechowalnia/ ginvfric - - logical lprn /.false./, checkmode /.false./ - - do i=0,MAXRES2 - do j=1,3 - friction(j,i)=0.0d0 - enddo - enddo - - do j=1,3 - d_t_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t_work(ind+j)=d_t(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - d_t_work(ind+j)=d_t(j,i+nres) - enddo - ind=ind+3 - endif - enddo - - call fricmat_mult(d_t_work,fric_work) - - if (.not.checkmode) return - - if (lprn) then - write (iout,*) "d_t_work and fric_work" - do i=1,3*dimen - write (iout,'(i3,2e15.5)') i,d_t_work(i),fric_work(i) - enddo - endif - do j=1,3 - friction(j,0)=fric_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - friction(j,i)=fric_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - friction(j,i+nres)=fric_work(ind+j) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write(iout,*) "Friction backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i),j=1,3),(d_t(j,i),j=1,3) - enddo - write(iout,*) "Friction side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i+nres),j=1,3),(d_t(j,i+nres),j=1,3) - enddo - endif - if (lprn) then - do j=1,3 - vv(j)=d_t(j,0) - enddo - do i=nnt,nct - do j=1,3 - vvtot(j,i)=vv(j)+0.5d0*d_t(j,i) - vvtot(j,i+nres)=vv(j)+d_t(j,i+nres) - vv(j)=vv(j)+d_t(j,i) - enddo - enddo - write (iout,*) "vvtot backbone and sidechain" - do i=nnt,nct - write (iout,'(i5,3e15.5,5x,3e15.5)') i,(vvtot(j,i),j=1,3), - & (vvtot(j,i+nres),j=1,3) - enddo - ind=0 - do i=nnt,nct-1 - do j=1,3 - v_work(ind+j)=vvtot(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - v_work(ind+j)=vvtot(j,i+nres) - enddo - ind=ind+3 - enddo - write (iout,*) "v_work gamvec and site-based friction forces" - do i=1,dimen1 - write (iout,'(i5,3e15.5)') i,v_work(i),gamvec(i), - & gamvec(i)*v_work(i) - enddo -c do i=1,dimen -c fric_work1(i)=0.0d0 -c do j=1,dimen1 -c fric_work1(i)=fric_work1(i)-A(j,i)*gamvec(j)*v_work(j) -c enddo -c enddo -c write (iout,*) "fric_work and fric_work1" -c do i=1,dimen -c write (iout,'(i5,2e15.5)') i,fric_work(i),fric_work1(i) -c enddo - do i=1,dimen - do j=1,dimen - ginvfric(i,j)=0.0d0 - do k=1,dimen - ginvfric(i,j)=ginvfric(i,j)+ginv(i,k)*fricmat(k,j) - enddo - enddo - enddo - write (iout,*) "ginvfric" - do i=1,dimen - write (iout,'(i5,100f8.3)') i,(ginvfric(i,j),j=1,dimen) - enddo - write (iout,*) "symmetry check" - do i=1,dimen - do j=1,i-1 - write (iout,*) i,j,ginvfric(i,j)-ginvfric(j,i) - enddo - enddo - endif - return - end -c----------------------------------------------------- - subroutine stochastic_force(stochforcvec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - - double precision x,sig,lowb,highb, - & ff(3),force(3,0:MAXRES2),zeta2,lowb2, - & highb2,sig2,forcvec(MAXRES6),stochforcvec(MAXRES6) - logical lprn /.false./ - do i=0,MAXRES2 - do j=1,3 - stochforc(j,i)=0.0d0 - enddo - enddo - x=0.0d0 - -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Compute the stochastic forces acting on bodies. Store in force. - do i=nnt,nct-1 - sig=stdforcp(i) - lowb=-5*sig - highb=5*sig - do j=1,3 - force(j,i)=anorm_distr(x,sig,lowb,highb) - enddo - enddo - do i=nnt,nct - sig2=stdforcsc(i) - lowb2=-5*sig2 - highb2=5*sig2 - do j=1,3 - force(j,i+nres)=anorm_distr(x,sig2,lowb2,highb2) - enddo - enddo -#ifdef MPI - time_fsample=time_fsample+MPI_Wtime()-time00 -#else - time_fsample=time_fsample+tcpu()-time00 -#endif -c Compute the stochastic forces acting on virtual-bond vectors. - do j=1,3 - ff(j)=0.0d0 - enddo - do i=nct-1,nnt,-1 - do j=1,3 - stochforc(j,i)=ff(j)+0.5d0*force(j,i) - enddo - do j=1,3 - ff(j)=ff(j)+force(j,i) - enddo - if (itype(i+1).ne.21) then - do j=1,3 - stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1) - ff(j)=ff(j)+force(j,i+nres+1) - enddo - endif - enddo - do j=1,3 - stochforc(j,0)=ff(j)+force(j,nnt+nres) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforc(j,i+nres)=force(j,i+nres) - enddo - endif - enddo - - do j=1,3 - stochforcvec(j)=stochforc(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i+nres) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write (iout,*) "stochforcvec" - do i=1,3*dimen - write(iout,'(i5,e15.5)') i,stochforcvec(i) - enddo - write(iout,*) "Stochastic forces backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5)') i,(stochforc(j,i),j=1,3) - enddo - write(iout,*) "Stochastic forces side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5)') - & i,(stochforc(j,i+nres),j=1,3) - enddo - endif - - if (lprn) then - - ind=0 - do i=nnt,nct-1 - write (iout,*) i,ind - do j=1,3 - forcvec(ind+j)=force(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - write (iout,*) i,ind - do j=1,3 - forcvec(j+ind)=force(j,i+nres) - enddo - ind=ind+3 - enddo - - write (iout,*) "forcvec" - ind=0 - do i=nnt,nct-1 - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i+nres), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - - endif - - return - end -c------------------------------------------------------------------ - subroutine setup_fricmat - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -c integer licznik /0/ -c save licznik -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - integer IERROR - integer i,j,ind,ind1,m - logical lprn /.false./ - double precision dtdi,gamvec(MAXRES2), - & ginvfric(maxres2,maxres2),Ghalf(mmaxres2),fcopy(maxres2,maxres2) - common /syfek/ gamvec - double precision work(8*maxres2) - integer iwork(maxres2) - common /przechowalnia/ ginvfric,Ghalf,fcopy -#ifdef MPI - if (fg_rank.ne.king) goto 10 -#endif -c Zeroing out fricmat - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - enddo - enddo -c Load the friction coefficients corresponding to peptide groups - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - gamvec(ind1)=gamp - enddo -c Load the friction coefficients corresponding to side chains - m=nct-nnt - ind=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - gamvec(ii)=gamsc(iti) - enddo - if (surfarea) call sdarea(gamvec) -c if (lprn) then -c write (iout,*) "Matrix A and vector gamma" -c do i=1,dimen1 -c write (iout,'(i2,$)') i -c do j=1,dimen -c write (iout,'(f4.1,$)') A(i,j) -c enddo -c write (iout,'(f8.3)') gamvec(i) -c enddo -c endif - if (lprn) then - write (iout,*) "Vector gamvec" - do i=1,dimen1 - write (iout,'(i5,f10.5)') i, gamvec(i) - enddo - endif - -c The friction matrix - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*gamvec(j) - enddo - fricmat(k,i)=dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Matrix fricmat" - call matout2(dimen,dimen,maxres2,maxres2,fricmat) - endif - if (lang.eq.2 .or. lang.eq.3) then -c Mass-scale the friction matrix if non-direct integration will be performed - do i=1,dimen - do j=1,dimen - Ginvfric(i,j)=0.0d0 - do k=1,dimen - do l=1,dimen - Ginvfric(i,j)=Ginvfric(i,j)+ - & Gsqrm(i,k)*Gsqrm(l,j)*fricmat(k,l) - enddo - enddo - enddo - enddo -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Ginvfric(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " mass-scaled friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Precompute matrices for tinker stochastic integrator -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - mt1(i,j)=0.0d0 - mt2(i,j)=0.0d0 - do k=1,dimen - mt1(i,j)=mt1(i,j)+fricvec(k,i)*gsqrm(k,j) - mt2(i,j)=mt2(i,j)+fricvec(k,i)*gsqrp(k,j) - enddo - mt3(j,i)=mt1(i,j) - enddo - enddo -#endif - else if (lang.eq.4) then -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=fricmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Determine the number of zero eigenvalues of the friction matrix - nzero=max0(dimen-dimen1,0) -c do while (fricgam(nzero+1).le.1.0d-5 .and. nzero.lt.dimen) -c nzero=nzero+1 -c enddo - write (iout,*) "Number of zero eigenvalues:",nzero - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - do k=nzero+1,dimen - fricmat(i,j)=fricmat(i,j) - & +fricvec(i,k)*fricvec(j,k)/fricgam(k) - enddo - enddo - enddo - if (lprn) then - write (iout,'(//a)') "Generalized inverse of fricmat" - call matout(dimen,dimen,maxres6,maxres6,fricmat) - endif - endif -#ifdef MPI - 10 continue - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call MPI_Bcast(10,1,MPI_INTEGER,king,FG_COMM,IERROR) -#ifdef MPI - time_Bcast=time_Bcast+MPI_Wtime()-time00 -#else - time_Bcast=time_Bcast+tcpu()-time00 -#endif -c print *,"Processor",myrank, -c & " BROADCAST iorder in SETUP_FRICMAT" - endif -c licznik=licznik+1 -c write (iout,*) "setup_fricmat licznik",licznik -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Scatter the friction matrix - call MPI_Scatterv(fricmat(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,fcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) -#ifdef TIMING -#ifdef MPI - time_scatter=time_scatter+MPI_Wtime()-time00 - time_scatter_fmat=time_scatter_fmat+MPI_Wtime()-time00 -#else - time_scatter=time_scatter+tcpu()-time00 - time_scatter_fmat=time_scatter_fmat+tcpu()-time00 -#endif -#endif - do i=1,dimen - do j=1,2*my_ng_count - fricmat(j,i)=fcopy(i,j) - enddo - enddo -c write (iout,*) "My chunk of fricmat" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy) - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sdarea(gamvec) -c -c Scale the friction coefficients according to solvent accessible surface areas -c Code adapted from TINKER -c AL 9/3/04 -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision radius(maxres2),gamvec(maxres2) - parameter (twosix=1.122462048309372981d0) - logical lprn /.false./ -c -c determine new friction coefficients every few SD steps -c -c set the atomic radii to estimates of sigma values -c -c print *,"Entered sdarea" - probe = 0.0d0 - - do i=1,2*nres - radius(i)=0.0d0 - enddo -c Load peptide group radii - do i=nnt,nct-1 - radius(i)=pstok - enddo -c Load side chain radii - do i=nnt,nct - iti=itype(i) - radius(i+nres)=restok(iti) - enddo -c do i=1,2*nres -c write (iout,*) "i",i," radius",radius(i) -c enddo - do i = 1, 2*nres - radius(i) = radius(i) / twosix - if (radius(i) .ne. 0.0d0) radius(i) = radius(i) + probe - end do -c -c scale atomic friction coefficients by accessible area -c - if (lprn) write (iout,*) - & "Original gammas, surface areas, scaling factors, new gammas, ", - & "std's of stochastic forces" - ind=0 - do i=nnt,nct-1 - if (radius(i).gt.0.0d0) then - call surfatom (i,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcp(i)=stdfp*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcp(i) - endif - enddo - do i=nnt,nct - if (radius(i+nres).gt.0.0d0) then - call surfatom (i+nres,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i+nres)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcsc(i) - endif - enddo - - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/sumsld.f b/source/unres/src_MD-NEWSC-NEWC/sumsld.f deleted file mode 100644 index 1ce7b78..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/sumsld.f +++ /dev/null @@ -1,1446 +0,0 @@ - subroutine sumsl(n, d, x, calcf, calcg, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** analytic gradient and hessian approx. from secant update *** -c - integer n, liv, lv - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(71 + n*(n+15)/2), uiparm(*), urparm(*) - external calcf, calcg, ufparm -c -c *** purpose *** -c -c this routine interacts with subroutine sumit in an attempt -c to find an n-vector x* that minimizes the (unconstrained) -c objective function computed by calcf. (often the x* found is -c a local minimizer rather than a global one.) -c -c-------------------------- parameter usage -------------------------- -c -c n........ (input) the number of variables on which f depends, i.e., -c the number of components in x. -c d........ (input/output) a scale vector such that d(i)*x(i), -c i = 1,2,...,n, are all in comparable units. -c d can strongly affect the behavior of sumsl. -c finding the best choice of d is generally a trial- -c and-error process. choosing d so that d(i)*x(i) -c has about the same value for all i often works well. -c the defaults provided by subroutine deflt (see i -c below) require the caller to supply d. -c x........ (input/output) before (initially) calling sumsl, the call- -c er should set x to an initial guess at x*. when -c sumsl returns, x contains the best point so far -c found, i.e., the one that gives the least value so -c far seen for f(x). -c calcf.... (input) a subroutine that, given x, computes f(x). calcf -c must be declared external in the calling program. -c it is invoked by -c call calcf(n, x, nf, f, uiparm, urparm, ufparm) -c when calcf is called, nf is the invocation -c count for calcf. nf is included for possible use -c with calcg. if x is out of bounds (e.g., if it -c would cause overflow in computing f(x)), then calcf -c should set nf to 0. this will cause a shorter step -c to be attempted. (if x is in bounds, then calcf -c should not change nf.) the other parameters are as -c described above and below. calcf should not change -c n, p, or x. -c calcg.... (input) a subroutine that, given x, computes g(x), the gra- -c dient of f at x. calcg must be declared external in -c the calling program. it is invoked by -c call calcg(n, x, nf, g, uiparm, urparm, ufaprm) -c when calcg is called, nf is the invocation -c count for calcf at the time f(x) was evaluated. the -c x passed to calcg is usually the one passed to calcf -c on either its most recent invocation or the one -c prior to it. if calcf saves intermediate results -c for use by calcg, then it is possible to tell from -c nf whether they are valid for the current x (or -c which copy is valid if two copies are kept). if g -c cannot be computed at x, then calcg should set nf to -c 0. in this case, sumsl will return with iv(1) = 65. -c (if g can be computed at x, then calcg should not -c changed nf.) the other parameters to calcg are as -c described above and below. calcg should not change -c n or x. -c iv....... (input/output) an integer value array of length liv (see -c below) that helps control the sumsl algorithm and -c that is used to store various intermediate quanti- -c ties. of particular interest are the initialization/ -c return code iv(1) and the entries in iv that control -c printing and limit the number of iterations and func- -c tion evaluations. see the section on iv input -c values below. -c liv...... (input) length of iv array. must be at least 60. if li -c is too small, then sumsl returns with iv(1) = 15. -c when sumsl returns, the smallest allowed value of -c liv is stored in iv(lastiv) -- see the section on -c iv output values below. (this is intended for use -c with extensions of sumsl that handle constraints.) -c lv....... (input) length of v array. must be at least 71+n*(n+15)/2. -c (at least 77+n*(n+17)/2 for smsno, at least -c 78+n*(n+12) for humsl). if lv is too small, then -c sumsl returns with iv(1) = 16. when sumsl returns, -c the smallest allowed value of lv is stored in -c iv(lastv) -- see the section on iv output values -c below. -c v........ (input/output) a floating-point value array of length l -c (see below) that helps control the sumsl algorithm -c and that is used to store various intermediate -c quantities. of particular interest are the entries -c in v that limit the length of the first step -c attempted (lmax0) and specify convergence tolerances -c (afctol, lmaxs, rfctol, sctol, xctol, xftol). -c uiparm... (input) user integer parameter array passed without change -c to calcf and calcg. -c urparm... (input) user floating-point parameter array passed without -c change to calcf and calcg. -c ufparm... (input) user external subroutine or function passed without -c change to calcf and calcg. -c -c *** iv input values (from subroutine deflt) *** -c -c iv(1)... on input, iv(1) should have a value between 0 and 14...... -c 0 and 12 mean this is a fresh start. 0 means that -c deflt(2, iv, liv, lv, v) -c is to be called to provide all default values to iv and -c v. 12 (the value that deflt assigns to iv(1)) means the -c caller has already called deflt and has possibly changed -c some iv and/or v entries to non-default values. -c 13 means deflt has been called and that sumsl (and -c sumit) should only do their storage allocation. that is, -c they should set the output components of iv that tell -c where various subarrays arrays of v begin, such as iv(g) -c (and, for humsl and humit only, iv(dtol)), and return. -c 14 means that a storage has been allocated (by a call -c with iv(1) = 13) and that the algorithm should be -c started. when called with iv(1) = 13, sumsl returns -c iv(1) = 14 unless liv or lv is too small (or n is not -c positive). default = 12. -c iv(inith).... iv(25) tells whether the hessian approximation h should -c be initialized. 1 (the default) means sumit should -c initialize h to the diagonal matrix whose i-th diagonal -c element is d(i)**2. 0 means the caller has supplied a -c cholesky factor l of the initial hessian approximation -c h = l*(l**t) in v, starting at v(iv(lmat)) = v(iv(42)) -c (and stored compactly by rows). note that iv(lmat) may -c be initialized by calling sumsl with iv(1) = 13 (see -c the iv(1) discussion above). default = 1. -c iv(mxfcal)... iv(17) gives the maximum number of function evaluations -c (calls on calcf) allowed. if this number does not suf- -c fice, then sumsl returns with iv(1) = 9. default = 200. -c iv(mxiter)... iv(18) gives the maximum number of iterations allowed. -c it also indirectly limits the number of gradient evalua- -c tions (calls on calcg) to iv(mxiter) + 1. if iv(mxiter) -c iterations do not suffice, then sumsl returns with -c iv(1) = 10. default = 150. -c iv(outlev)... iv(19) controls the number and length of iteration sum- -c mary lines printed (by itsum). iv(outlev) = 0 means do -c not print any summary lines. otherwise, print a summary -c line after each abs(iv(outlev)) iterations. if iv(outlev) -c is positive, then summary lines of length 78 (plus carri- -c age control) are printed, including the following... the -c iteration and function evaluation counts, f = the current -c function value, relative difference in function values -c achieved by the latest step (i.e., reldf = (f0-v(f))/f01, -c where f01 is the maximum of abs(v(f)) and abs(v(f0)) and -c v(f0) is the function value from the previous itera- -c tion), the relative function reduction predicted for the -c step just taken (i.e., preldf = v(preduc) / f01, where -c v(preduc) is described below), the scaled relative change -c in x (see v(reldx) below), the step parameter for the -c step just taken (stppar = 0 means a full newton step, -c between 0 and 1 means a relaxed newton step, between 1 -c and 2 means a double dogleg step, greater than 2 means -c a scaled down cauchy step -- see subroutine dbldog), the -c 2-norm of the scale vector d times the step just taken -c (see v(dstnrm) below), and npreldf, i.e., -c v(nreduc)/f01, where v(nreduc) is described below -- if -c npreldf is positive, then it is the relative function -c reduction predicted for a newton step (one with -c stppar = 0). if npreldf is negative, then it is the -c negative of the relative function reduction predicted -c for a step computed with step bound v(lmaxs) for use in -c testing for singular convergence. -c if iv(outlev) is negative, then lines of length 50 -c are printed, including only the first 6 items listed -c above (through reldx). -c default = 1. -c iv(parprt)... iv(20) = 1 means print any nondefault v values on a -c fresh start or any changed v values on a restart. -c iv(parprt) = 0 means skip this printing. default = 1. -c iv(prunit)... iv(21) is the output unit number on which all printing -c is done. iv(prunit) = 0 means suppress all printing. -c default = standard output unit (unit 6 on most systems). -c iv(solprt)... iv(22) = 1 means print out the value of x returned (as -c well as the gradient and the scale vector d). -c iv(solprt) = 0 means skip this printing. default = 1. -c iv(statpr)... iv(23) = 1 means print summary statistics upon return- -c ing. these consist of the function value, the scaled -c relative change in x caused by the most recent step (see -c v(reldx) below), the number of function and gradient -c evaluations (calls on calcf and calcg), and the relative -c function reductions predicted for the last step taken and -c for a newton step (or perhaps a step bounded by v(lmaxs) -c -- see the descriptions of preldf and npreldf under -c iv(outlev) above). -c iv(statpr) = 0 means skip this printing. -c iv(statpr) = -1 means skip this printing as well as that -c of the one-line termination reason message. default = 1. -c iv(x0prt).... iv(24) = 1 means print the initial x and scale vector d -c (on a fresh start only). iv(x0prt) = 0 means skip this -c printing. default = 1. -c -c *** (selected) iv output values *** -c -c iv(1)........ on output, iv(1) is a return code.... -c 3 = x-convergence. the scaled relative difference (see -c v(reldx)) between the current parameter vector x and -c a locally optimal parameter vector is very likely at -c most v(xctol). -c 4 = relative function convergence. the relative differ- -c ence between the current function value and its lo- -c cally optimal value is very likely at most v(rfctol). -c 5 = both x- and relative function convergence (i.e., the -c conditions for iv(1) = 3 and iv(1) = 4 both hold). -c 6 = absolute function convergence. the current function -c value is at most v(afctol) in absolute value. -c 7 = singular convergence. the hessian near the current -c iterate appears to be singular or nearly so, and a -c step of length at most v(lmaxs) is unlikely to yield -c a relative function decrease of more than v(sctol). -c 8 = false convergence. the iterates appear to be converg- -c ing to a noncritical point. this may mean that the -c convergence tolerances (v(afctol), v(rfctol), -c v(xctol)) are too small for the accuracy to which -c the function and gradient are being computed, that -c there is an error in computing the gradient, or that -c the function or gradient is discontinuous near x. -c 9 = function evaluation limit reached without other con- -c vergence (see iv(mxfcal)). -c 10 = iteration limit reached without other convergence -c (see iv(mxiter)). -c 11 = stopx returned .true. (external interrupt). see the -c usage notes below. -c 14 = storage has been allocated (after a call with -c iv(1) = 13). -c 17 = restart attempted with n changed. -c 18 = d has a negative component and iv(dtype) .le. 0. -c 19...43 = v(iv(1)) is out of range. -c 63 = f(x) cannot be computed at the initial x. -c 64 = bad parameters passed to assess (which should not -c occur). -c 65 = the gradient could not be computed at x (see calcg -c above). -c 67 = bad first parameter to deflt. -c 80 = iv(1) was out of range. -c 81 = n is not positive. -c iv(g)........ iv(28) is the starting subscript in v of the current -c gradient vector (the one corresponding to x). -c iv(lastiv)... iv(44) is the least acceptable value of liv. (it is -c only set if liv is at least 44.) -c iv(lastv).... iv(45) is the least acceptable value of lv. (it is -c only set if liv is large enough, at least iv(lastiv).) -c iv(nfcall)... iv(6) is the number of calls so far made on calcf (i.e., -c function evaluations). -c iv(ngcall)... iv(30) is the number of gradient evaluations (calls on -c calcg). -c iv(niter).... iv(31) is the number of iterations performed. -c -c *** (selected) v input values (from subroutine deflt) *** -c -c v(bias)..... v(43) is the bias parameter used in subroutine dbldog -- -c see that subroutine for details. default = 0.8. -c v(afctol)... v(31) is the absolute function convergence tolerance. -c if sumsl finds a point where the function value is less -c than v(afctol) in absolute value, and if sumsl does not -c return with iv(1) = 3, 4, or 5, then it returns with -c iv(1) = 6. this test can be turned off by setting -c v(afctol) to zero. default = max(10**-20, machep**2), -c where machep is the unit roundoff. -c v(dinit).... v(38), if nonnegative, is the value to which the scale -c vector d is initialized. default = -1. -c v(lmax0).... v(35) gives the maximum 2-norm allowed for d times the -c very first step that sumsl attempts. this parameter can -c markedly affect the performance of sumsl. -c v(lmaxs).... v(36) is used in testing for singular convergence -- if -c the function reduction predicted for a step of length -c bounded by v(lmaxs) is at most v(sctol) * abs(f0), where -c f0 is the function value at the start of the current -c iteration, and if sumsl does not return with iv(1) = 3, -c 4, 5, or 6, then it returns with iv(1) = 7. default = 1. -c v(rfctol)... v(32) is the relative function convergence tolerance. -c if the current model predicts a maximum possible function -c reduction (see v(nreduc)) of at most v(rfctol)*abs(f0) -c at the start of the current iteration, where f0 is the -c then current function value, and if the last step attempt- -c ed achieved no more than twice the predicted function -c decrease, then sumsl returns with iv(1) = 4 (or 5). -c default = max(10**-10, machep**(2/3)), where machep is -c the unit roundoff. -c v(sctol).... v(37) is the singular convergence tolerance -- see the -c description of v(lmaxs) above. -c v(tuner1)... v(26) helps decide when to check for false convergence. -c this is done if the actual function decrease from the -c current step is no more than v(tuner1) times its predict- -c ed value. default = 0.1. -c v(xctol).... v(33) is the x-convergence tolerance. if a newton step -c (see v(nreduc)) is tried that has v(reldx) .le. v(xctol) -c and if this step yields at most twice the predicted func- -c tion decrease, then sumsl returns with iv(1) = 3 (or 5). -c (see the description of v(reldx) below.) -c default = machep**0.5, where machep is the unit roundoff. -c v(xftol).... v(34) is the false convergence tolerance. if a step is -c tried that gives no more than v(tuner1) times the predict- -c ed function decrease and that has v(reldx) .le. v(xftol), -c and if sumsl does not return with iv(1) = 3, 4, 5, 6, or -c 7, then it returns with iv(1) = 8. (see the description -c of v(reldx) below.) default = 100*machep, where -c machep is the unit roundoff. -c v(*)........ deflt supplies to v a number of tuning constants, with -c which it should ordinarily be unnecessary to tinker. see -c section 17 of version 2.2 of the nl2sol usage summary -c (i.e., the appendix to ref. 1) for details on v(i), -c i = decfac, incfac, phmnfc, phmxfc, rdfcmn, rdfcmx, -c tuner2, tuner3, tuner4, tuner5. -c -c *** (selected) v output values *** -c -c v(dgnorm)... v(1) is the 2-norm of (diag(d)**-1)*g, where g is the -c most recently computed gradient. -c v(dstnrm)... v(2) is the 2-norm of diag(d)*step, where step is the -c current step. -c v(f)........ v(10) is the current function value. -c v(f0)....... v(13) is the function value at the start of the current -c iteration. -c v(nreduc)... v(6), if positive, is the maximum function reduction -c possible according to the current model, i.e., the func- -c tion reduction predicted for a newton step (i.e., -c step = -h**-1 * g, where g is the current gradient and -c h is the current hessian approximation). -c if v(nreduc) is negative, then it is the negative of -c the function reduction predicted for a step computed with -c a step bound of v(lmaxs) for use in testing for singular -c convergence. -c v(preduc)... v(7) is the function reduction predicted (by the current -c quadratic model) for the current step. this (divided by -c v(f0)) is used in testing for relative function -c convergence. -c v(reldx).... v(17) is the scaled relative change in x caused by the -c current step, computed as -c max(abs(d(i)*(x(i)-x0(i)), 1 .le. i .le. p) / -c max(d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p), -c where x = x0 + step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c this routine uses a hessian approximation computed from the -c bfgs update (see ref 3). only a cholesky factor of the hessian -c approximation is stored, and this is updated using ideas from -c ref. 4. steps are computed by the double dogleg scheme described -c in ref. 2. the steps are assessed as in ref. 1. -c -c *** usage notes *** -c -c after a return with iv(1) .le. 11, it is possible to restart, -c i.e., to change some of the iv and v input values described above -c and continue the algorithm from the point where it was interrupt- -c ed. iv(1) should not be changed, nor should any entries of i -c and v other than the input values (those supplied by deflt). -c those who do not wish to write a calcg which computes the -c gradient analytically should call smsno rather than sumsl. -c smsno uses finite differences to compute an approximate gradient. -c those who would prefer to provide f and g (the function and -c gradient) by reverse communication rather than by writing subrou- -c tines calcf and calcg may call on sumit directly. see the com- -c ments at the beginning of sumit. -c those who use sumsl interactively may wish to supply their -c own stopx function, which should return .true. if the break key -c has been pressed since stopx was last invoked. this makes it -c possible to externally interrupt sumsl (which will return with -c iv(1) = 11 if stopx returns .true.). -c storage for g is allocated at the end of v. thus the caller -c may make v longer than specified above and may allow calcg to use -c elements of g beyond the first n as scratch storage. -c -c *** portability notes *** -c -c the sumsl distribution tape contains both single- and double- -c precision versions of the sumsl source code, so it should be un- -c necessary to change precisions. -c only the functions imdcon and rmdcon contain machine-dependent -c constants. to change from one machine to another, it should -c suffice to change the (few) relevant lines in these functions. -c intrinsic functions are explicitly declared. on certain com- -c puters (e.g. univac), it may be necessary to comment out these -c declarations. so that this may be done automatically by a simple -c program, such declarations are preceded by a comment having c/+ -c in columns 1-3 and blanks in columns 4-72 and are followed by -c a comment having c/ in columns 1 and 2 and blanks in columns 3-72. -c the sumsl source code is expressed in 1966 ansi standard -c fortran. it may be converted to fortran 77 by commenting out all -c lines that fall between a line having c/6 in columns 1-3 and a -c line having c/7 in columns 1-3 and by removing (i.e., replacing -c by a blank) the c in column 1 of the lines that follow the c/7 -c line and precede a line having c/ in columns 1-2 and blanks in -c columns 3-72. these changes convert some data statements into -c parameter statements, convert some variables from real to -c character*4, and make the data statements that initialize these -c variables use character strings delimited by primes instead -c of hollerith constants. (such variables and data statements -c appear only in modules itsum and parck. parameter statements -c appear nearly everywhere.) these changes also add save state- -c ments for variables given machine-dependent constants by rmdcon. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), algorithm 573 -- -c an adaptive nonlinear least-squares algorithm, acm trans. -c math. software 7, pp. 369-383. -c -c 2. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c -c 3. dennis, j.e., and more, j.j. (1977), quasi-newton methods, motiva- -c tion and theory, siam rev. 19, pp. 46-89. -c -c 4. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (winter 1980). revised summer 1982. -c this subroutine was written in connection with research -c supported in part by the national science foundation under -c grants mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, -c and mcs-7906671. -c. -c -c---------------------------- declarations --------------------------- -c - external deflt, sumit -c -c deflt... supplies default iv and v input components. -c sumit... reverse-communication routine that carries out sumsl algo- -c rithm. -c - integer g1, iv1, nf - double precision f -c -c *** subscripts for iv *** -c - integer nextv, nfcall, nfgcal, g, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, toobig/2/, vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, toobig=2, vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .eq. 12 .or. iv1 .eq. 13) iv(vneed) = iv(vneed) + n - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) -c - 20 call sumit(d, f, v(g1), iv, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcg(n, x, iv(nfgcal), v(g1), uiparm, urparm, ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(nextv) = iv(g) + n - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of sumsl follows *** - end - subroutine sumit(d, fx, g, iv, liv, lv, n, v, x) -c -c *** carry out sumsl (unconstrained minimization) iterations, using -c *** double-dogleg/bfgs steps. -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c iv... integer value array. -c liv.. length of iv (at least 60). -c lv... length of v (at least 71 + n*(n+13)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... vector of parameters to be optimized. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to sumsl (which see), except that v can be shorter (since -c the part of v that sumsl uses for storing g is not needed). -c moreover, compared with sumsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from sumsl (and smsno), is not referenced by -c sumit or the subroutines it calls. -c fx and g need not have been initialized when sumit is called -c with iv(1) = 12, 13, or 14. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call sumit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c (e.g. if overflow would occur), which may happen because -c of an oversized step. in this case the caller should set -c iv(toobig) = iv(2) to 1, which will cause sumit to ig- -c nore fx and try a smaller step. the parameter nf that -c sumsl passes to calcf (for possible use by calcg) is a -c copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient vector -c of f at x, and call sumit again, having changed none of -c the other parameters except possibly the scale vector d -c when iv(dtype) = 0. the parameter nf that sumsl passes -c to calcg is iv(nfgcal) = iv(7). if g(x) cannot be -c evaluated, then the caller may set iv(nfgcal) to 0, in -c which case sumit will return with iv(1) = 65. -c. -c *** general *** -c -c coded by david m. gay (december 1979). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, g01, i, k, l, lstgst, nwtst1, step1, - 1 temp1, w, x01, z - double precision t -c -c *** constants *** -c - double precision half, negone, one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, dbdog, deflt, dotprd, itsum, litvmu, livmul, - 1 ltvmul, lupdat, lvmul, parck, reldst, stopx, vaxpy, - 2 vcopy, vscopy, vvmulp, v2norm, wzbfgs - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c dbdog.... computes double-dogleg (candidate) step. -c deflt.... supplies default iv and v input components. -c dotprd... returns inner product of two vectors. -c itsum.... prints iteration summary and info on initial and final x. -c litvmu... multiplies inverse transpose of lower triangle times vector. -c livmul... multiplies inverse of lower triangle times vector. -c ltvmul... multiplies transpose of lower triangle times vector. -c lupdt.... updates cholesky factor of hessian approximation. -c lvmul.... multiplies lower triangle times vector. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c vvmulp... multiplies vector by vector raised to power (componentwise). -c v2norm... returns the 2-norm of a vector. -c wzbfgs... computes w and z for lupdat corresponding to bfgs update. -c -c *** subscripts for iv and v *** -c - integer afctol - integer cnvcod, dg, dgnorm, dinit, dstnrm, dst0, f, f0, fdif, - 1 gthg, gtstep, g0, incfac, inith, irc, kagqt, lmat, lmax0, - 2 lmaxs, mode, model, mxfcal, mxiter, nextv, nfcall, nfgcal, - 3 ngcall, niter, nreduc, nwtstp, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, toobig, - 5 tuner4, tuner5, vneed, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, g0/48/, inith/25/, irc/29/, kagqt/33/, -c 1 mode/35/, model/5/, mxfcal/17/, mxiter/18/, nfcall/6/, -c 2 nfgcal/7/, ngcall/30/, niter/31/, nwtstp/34/, radinc/8/, -c 3 restor/9/, step/40/, stglim/11/, stlstg/41/, toobig/2/, -c 4 vneed/4/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, g0=48, inith=25, irc=29, kagqt=33, - 1 mode=35, model=5, mxfcal=17, mxiter=18, nfcall=6, - 2 nfgcal=7, ngcall=30, niter=31, nwtstp=34, radinc=8, - 3 restor=9, step=40, stglim=11, stlstg=41, toobig=2, - 4 vneed=4, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/ -c data dgnorm/1/, dinit/38/, dstnrm/2/, dst0/3/, f/10/, f0/13/, -c 1 fdif/11/, gthg/44/, gtstep/4/, incfac/23/, lmat/42/, -c 2 lmax0/35/, lmaxs/36/, nextv/47/, nreduc/6/, preduc/7/, -c 3 radfac/16/, radius/8/, rad0/9/, reldx/17/, tuner4/29/, -c 4 tuner5/30/ -c/7 - parameter (afctol=31) - parameter (dgnorm=1, dinit=38, dstnrm=2, dst0=3, f=10, f0=13, - 1 fdif=11, gthg=44, gtstep=4, incfac=23, lmat=42, - 2 lmax0=35, lmaxs=36, nextv=47, nreduc=6, preduc=7, - 3 radfac=16, radius=8, rad0=9, reldx=17, tuner4=29, - 4 tuner5=30) -c/ -c -c/6 -c data half/0.5d+0/, negone/-1.d+0/, one/1.d+0/, onep2/1.2d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, negone=-1.d+0, one=1.d+0, onep2=1.2d+0, - 1 zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c -C Following SAVE statement inserted. - save l - i = iv(1) - if (i .eq. 1) go to 50 - if (i .eq. 2) go to 60 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+13)/2 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - go to (180, 180, 180, 180, 180, 180, 120, 90, 120, 10, 10, 20), i -c -c *** storage allocation *** -c -10 l = iv(lmat) - iv(x0) = l + n*(n+1)/2 - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(g0) = iv(stlstg) + n - iv(nwtstp) = iv(g0) + n - iv(dg) = iv(nwtstp) + n - iv(nextv) = iv(dg) + n - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - if (iv(inith) .ne. 1) go to 40 -c -c *** set the initial hessian approximation to diag(d)**-2 *** -c - l = iv(lmat) - call vscopy(n*(n+1)/2, v(l), zero) - k = l - 1 - do 30 i = 1, n - k = k + i - t = d(i) - if (t .le. zero) t = one - v(k) = t - 30 continue -c -c *** compute initial function value *** -c - 40 iv(1) = 1 - go to 999 -c - 50 v(f) = fx - if (iv(mode) .ge. 0) go to 180 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 300 -c -c *** make sure gradient could be computed *** -c - 60 if (iv(nfgcal) .ne. 0) go to 70 - iv(1) = 65 - go to 300 -c - 70 dg1 = iv(dg) - call vvmulp(n, v(dg1), g, d, -1) - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** test norm of gradient *** -c - if (v(dgnorm) .gt. v(afctol)) go to 75 - iv(irc) = 10 - iv(cnvcod) = iv(irc) - 4 -c - 75 if (iv(cnvcod) .ne. 0) go to 290 - if (iv(mode) .eq. 0) go to 250 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 80 call itsum(d, g, iv, liv, lv, n, v, x) - 90 k = iv(niter) - if (k .lt. iv(mxiter)) go to 100 - iv(1) = 10 - go to 300 -c -c *** update radius *** -c - 100 iv(niter) = k + 1 - if(k.gt.0)v(radius) = v(radfac) * v(dstnrm) -c -c *** initialize for start of next iteration *** -c - g01 = iv(g0) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0, g to g0 *** -c - call vcopy(n, v(x01), x) - call vcopy(n, v(g01), g) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 110 if (.not. stopx(dummy)) go to 130 - iv(1) = 11 - go to 140 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 120 if (v(f) .ge. v(f0)) go to 130 - v(radfac) = one - k = iv(niter) - go to 100 -c - 130 if (iv(nfcall) .lt. iv(mxfcal)) go to 150 - iv(1) = 9 - 140 if (v(f) .ge. v(f0)) go to 300 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 240 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 150 step1 = iv(step) - dg1 = iv(dg) - nwtst1 = iv(nwtstp) - if (iv(kagqt) .ge. 0) go to 160 - l = iv(lmat) - call livmul(n, v(nwtst1), v(l), g) - v(nreduc) = half * dotprd(n, v(nwtst1), v(nwtst1)) - call litvmu(n, v(nwtst1), v(l), v(nwtst1)) - call vvmulp(n, v(step1), v(nwtst1), d, 1) - v(dst0) = v2norm(n, v(step1)) - call vvmulp(n, v(dg1), v(dg1), d, -1) - call ltvmul(n, v(step1), v(l), v(dg1)) - v(gthg) = v2norm(n, v(step1)) - iv(kagqt) = 0 - 160 call dbdog(v(dg1), lv, n, v(nwtst1), v(step1), v) - if (iv(irc) .eq. 6) go to 180 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 180 - if (iv(irc) .ne. 5) go to 170 - if (v(radfac) .le. one) go to 170 - if (v(preduc) .le. onep2 * v(fdif)) go to 180 -c -c *** compute f(x0 + step) *** -c - 170 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 180 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 190 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 190 k = iv(irc) - go to (200,230,230,230,200,210,220,220,220,220,220,220,280,250), k -c -c *** recompute step with changed radius *** -c - 200 v(radius) = v(radfac) * v(dstnrm) - go to 110 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 210 v(radius) = v(lmaxs) - go to 150 -c -c *** convergence or false convergence *** -c - 220 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 290 - if (iv(xirc) .eq. 14) go to 290 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 230 if (iv(irc) .ne. 3) go to 240 - step1 = iv(step) - temp1 = iv(stlstg) -c -c *** set temp1 = hessian * step for use in gradient tests *** -c - l = iv(lmat) - call ltvmul(n, v(temp1), v(l), v(step1)) - call lvmul(n, v(temp1), v(l), v(temp1)) -c -c *** compute gradient *** -c - 240 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c -c *** initializations -- g0 = g - g0, etc. *** -c - 250 g01 = iv(g0) - call vaxpy(n, v(g01), negone, v(g01), g) - step1 = iv(step) - temp1 = iv(stlstg) - if (iv(irc) .ne. 3) go to 270 -c -c *** set v(radfac) by gradient tests *** -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - call vaxpy(n, v(temp1), negone, v(g01), v(temp1)) - call vvmulp(n, v(temp1), v(temp1), d, -1) -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) - 1 go to 260 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 270 - 260 v(radfac) = v(incfac) -c -c *** update h, loop *** -c - 270 w = iv(nwtstp) - z = iv(x0) - l = iv(lmat) - call wzbfgs(v(l), n, v(step1), v(w), v(g01), v(z)) -c -c ** use the n-vectors starting at v(step1) and v(g01) for scratch.. - call lupdat(v(temp1), v(step1), v(l), v(g01), v(l), n, v(w), v(z)) - iv(1) = 2 - go to 80 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 280 iv(1) = 64 - go to 300 -c -c *** print summary of final iteration and other requested items *** -c - 290 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 300 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last line of sumit follows *** - end - subroutine dbdog(dig, lv, n, nwtstp, step, v) -c -c *** compute double dogleg step *** -c -c *** parameter declarations *** -c - integer lv, n - double precision dig(n), nwtstp(n), step(n), v(lv) -c -c *** purpose *** -c -c this subroutine computes a candidate step (for use in an uncon- -c strained minimization code) by the double dogleg algorithm of -c dennis and mei (ref. 1), which is a variation on powell*s dogleg -c scheme (ref. 2, p. 95). -c -c-------------------------- parameter usage -------------------------- -c -c dig (input) diag(d)**-2 * g -- see algorithm notes. -c g (input) the current gradient vector. -c lv (input) length of v. -c n (input) number of components in dig, g, nwtstp, and step. -c nwtstp (input) negative newton step -- see algorithm notes. -c step (output) the computed step. -c v (i/o) values array, the following components of which are -c used here... -c v(bias) (input) bias for relaxed newton step, which is v(bias) of -c the way from the full newton to the fully relaxed newton -c step. recommended value = 0.8 . -c v(dgnorm) (input) 2-norm of diag(d)**-1 * g -- see algorithm notes. -c v(dstnrm) (output) 2-norm of diag(d) * step, which is v(radius) -c unless v(stppar) = 0 -- see algorithm notes. -c v(dst0) (input) 2-norm of diag(d) * nwtstp -- see algorithm notes. -c v(grdfac) (output) the coefficient of dig in the step returned -- -c step(i) = v(grdfac)*dig(i) + v(nwtfac)*nwtstp(i). -c v(gthg) (input) square-root of (dig**t) * (hessian) * dig -- see -c algorithm notes. -c v(gtstep) (output) inner product between g and step. -c v(nreduc) (output) function reduction predicted for the full newton -c step. -c v(nwtfac) (output) the coefficient of nwtstp in the step returned -- -c see v(grdfac) above. -c v(preduc) (output) function reduction predicted for the step returned. -c v(radius) (input) the trust region radius. d times the step returned -c has 2-norm v(radius) unless v(stppar) = 0. -c v(stppar) (output) code telling how step was computed... 0 means a -c full newton step. between 0 and 1 means v(stppar) of the -c way from the newton to the relaxed newton step. between -c 1 and 2 means a true double dogleg step, v(stppar) - 1 of -c the way from the relaxed newton to the cauchy step. -c greater than 2 means 1 / (v(stppar) - 1) times the cauchy -c step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c let g and h be the current gradient and hessian approxima- -c tion respectively and let d be the current scale vector. this -c routine assumes dig = diag(d)**-2 * g and nwtstp = h**-1 * g. -c the step computed is the same one would get by replacing g and h -c by diag(d)**-1 * g and diag(d)**-1 * h * diag(d)**-1, -c computing step, and translating step back to the original -c variables, i.e., premultiplying it by diag(d)**-1. -c -c *** references *** -c -c 1. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c 2. powell, m.j.d. (1970), a hybrid method for non-linear equations, -c in numerical methods for non-linear equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, v2norm - double precision dotprd, v2norm -c -c dotprd... returns inner product of two vectors. -c v2norm... returns 2-norm of a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cfact, cnorm, ctrnwt, ghinvg, femnsq, gnorm, - 1 nwtnrm, relax, rlambd, t, t1, t2 - double precision half, one, two, zero -c -c *** v subscripts *** -c - integer bias, dgnorm, dstnrm, dst0, grdfac, gthg, gtstep, - 1 nreduc, nwtfac, preduc, radius, stppar -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, two/2.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, two=2.d+0, zero=0.d+0) -c/ -c -c/6 -c data bias/43/, dgnorm/1/, dstnrm/2/, dst0/3/, grdfac/45/, -c 1 gthg/44/, gtstep/4/, nreduc/6/, nwtfac/46/, preduc/7/, -c 2 radius/8/, stppar/5/ -c/7 - parameter (bias=43, dgnorm=1, dstnrm=2, dst0=3, grdfac=45, - 1 gthg=44, gtstep=4, nreduc=6, nwtfac=46, preduc=7, - 2 radius=8, stppar=5) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nwtnrm = v(dst0) - rlambd = one - if (nwtnrm .gt. zero) rlambd = v(radius) / nwtnrm - gnorm = v(dgnorm) - ghinvg = two * v(nreduc) - v(grdfac) = zero - v(nwtfac) = zero - if (rlambd .lt. one) go to 30 -c -c *** the newton step is inside the trust region *** -c - v(stppar) = zero - v(dstnrm) = nwtnrm - v(gtstep) = -ghinvg - v(preduc) = v(nreduc) - v(nwtfac) = -one - do 20 i = 1, n - 20 step(i) = -nwtstp(i) - go to 999 -c - 30 v(dstnrm) = v(radius) - cfact = (gnorm / v(gthg))**2 -c *** cauchy step = -cfact * g. - cnorm = gnorm * cfact - relax = one - v(bias) * (one - gnorm*cnorm/ghinvg) - if (rlambd .lt. relax) go to 50 -c -c *** step is between relaxed newton and full newton steps *** -c - v(stppar) = one - (rlambd - relax) / (one - relax) - t = -rlambd - v(gtstep) = t * ghinvg - v(preduc) = rlambd * (one - half*rlambd) * ghinvg - v(nwtfac) = t - do 40 i = 1, n - 40 step(i) = t * nwtstp(i) - go to 999 -c - 50 if (cnorm .lt. v(radius)) go to 70 -c -c *** the cauchy step lies outside the trust region -- -c *** step = scaled cauchy step *** -c - t = -v(radius) / gnorm - v(grdfac) = t - v(stppar) = one + cnorm / v(radius) - v(gtstep) = -v(radius) * gnorm - v(preduc) = v(radius)*(gnorm - half*v(radius)*(v(gthg)/gnorm)**2) - do 60 i = 1, n - 60 step(i) = t * dig(i) - go to 999 -c -c *** compute dogleg step between cauchy and relaxed newton *** -c *** femur = relaxed newton step minus cauchy step *** -c - 70 ctrnwt = cfact * relax * ghinvg / gnorm -c *** ctrnwt = inner prod. of cauchy and relaxed newton steps, -c *** scaled by gnorm**-1. - t1 = ctrnwt - gnorm*cfact**2 -c *** t1 = inner prod. of femur and cauchy step, scaled by -c *** gnorm**-1. - t2 = v(radius)*(v(radius)/gnorm) - gnorm*cfact**2 - t = relax * nwtnrm - femnsq = (t/gnorm)*t - ctrnwt - t1 -c *** femnsq = square of 2-norm of femur, scaled by gnorm**-1. - t = t2 / (t1 + dsqrt(t1**2 + femnsq*t2)) -c *** dogleg step = cauchy step + t * femur. - t1 = (t - one) * cfact - v(grdfac) = t1 - t2 = -t * relax - v(nwtfac) = t2 - v(stppar) = two - t - v(gtstep) = t1*gnorm**2 + t2*ghinvg - v(preduc) = -t1*gnorm * ((t2 + one)*gnorm) - 1 - t2 * (one + half*t2)*ghinvg - 2 - half * (v(gthg)*t1)**2 - do 80 i = 1, n - 80 step(i) = t1*dig(i) + t2*nwtstp(i) -c - 999 return -c *** last line of dbdog follows *** - end - subroutine ltvmul(n, x, l, y) -c -c *** compute x = (l**t)*y, where l is an n x n lower -c *** triangular matrix stored compactly by rows. x and y may -c *** occupy the same storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ij, i0, j - double precision yi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - i0 = 0 - do 20 i = 1, n - yi = y(i) - x(i) = zero - do 10 j = 1, i - ij = i0 + j - x(j) = x(j) + yi*l(ij) - 10 continue - i0 = i0 + i - 20 continue - 999 return -c *** last card of ltvmul follows *** - end - subroutine lupdat(beta, gamma, l, lambda, lplus, n, w, z) -c -c *** compute lplus = secant update of l *** -c -c *** parameter declarations *** -c - integer n -cal double precision beta(n), gamma(n), l(1), lambda(n), lplus(1), - double precision beta(n), gamma(n), l(n*(n+1)/2), lambda(n), - 1 lplus(n*(n+1)/2),w(n), z(n) -c dimension l(n*(n+1)/2), lplus(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c beta = scratch vector. -c gamma = scratch vector. -c l (input) lower triangular matrix, stored rowwise. -c lambda = scratch vector. -c lplus (output) lower triangular matrix, stored rowwise, which may -c occupy the same storage as l. -c n (input) length of vector parameters and order of matrices. -c w (input, destroyed on output) right singular vector of rank 1 -c correction to l. -c z (input, destroyed on output) left singular vector of rank 1 -c correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine updates the cholesky factor l of a symmetric -c positive definite matrix to which a secant update is being -c applied -- it computes a cholesky factor lplus of -c l * (i + z*w**t) * (i + w*z**t) * l**t. it is assumed that w -c and z have been chosen so that the updated matrix is strictly -c positive definite. -c -c *** algorithm notes *** -c -c this code uses recurrence 3 of ref. 1 (with d(j) = 1 for all j) -c to compute lplus of the form l * (i + z*w**t) * q, where q -c is an orthogonal matrix that makes the result lower triangular. -c lplus may have some negative diagonal elements. -c -c *** references *** -c -c 1. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i, ij, j, jj, jp1, k, nm1, np1 - double precision a, b, bj, eta, gj, lj, lij, ljj, nu, s, theta, - 1 wj, zj - double precision one, zero -c -c *** data initializations *** -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nu = one - eta = zero - if (n .le. 1) go to 30 - nm1 = n - 1 -c -c *** temporarily store s(j) = sum over k = j+1 to n of w(k)**2 in -c *** lambda(j). -c - s = zero - do 10 i = 1, nm1 - j = n - i - s = s + w(j+1)**2 - lambda(j) = s - 10 continue -c -c *** compute lambda, gamma, and beta by goldfarb*s recurrence 3. -c - do 20 j = 1, nm1 - wj = w(j) - a = nu*z(j) - eta*wj - theta = one + a*wj - s = a*lambda(j) - lj = dsqrt(theta**2 + a*s) - if (theta .gt. zero) lj = -lj - lambda(j) = lj - b = theta*wj + s - gamma(j) = b * nu / lj - beta(j) = (a - b*eta) / lj - nu = -nu / lj - eta = -(eta + (a**2)/(theta - lj)) / lj - 20 continue - 30 lambda(n) = one + (nu*z(n) - eta*w(n))*w(n) -c -c *** update l, gradually overwriting w and z with l*w and l*z. -c - np1 = n + 1 - jj = n * (n + 1) / 2 - do 60 k = 1, n - j = np1 - k - lj = lambda(j) - ljj = l(jj) - lplus(jj) = lj * ljj - wj = w(j) - w(j) = ljj * wj - zj = z(j) - z(j) = ljj * zj - if (k .eq. 1) go to 50 - bj = beta(j) - gj = gamma(j) - ij = jj + j - jp1 = j + 1 - do 40 i = jp1, n - lij = l(ij) - lplus(ij) = lj*lij + bj*w(i) + gj*z(i) - w(i) = w(i) + lij*wj - z(i) = z(i) + lij*zj - ij = ij + i - 40 continue - 50 jj = jj - j - 60 continue -c - 999 return -c *** last card of lupdat follows *** - end - subroutine lvmul(n, x, l, y) -c -c *** compute x = l*y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ii, ij, i0, j, np1 - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - np1 = n + 1 - i0 = n*(n+1)/2 - do 20 ii = 1, n - i = np1 - ii - i0 = i0 - i - t = zero - do 10 j = 1, i - ij = i0 + j - t = t + l(ij)*y(j) - 10 continue - x(i) = t - 20 continue - 999 return -c *** last card of lvmul follows *** - end - subroutine vvmulp(n, x, y, z, k) -c -c *** set x(i) = y(i) * z(i)**k, 1 .le. i .le. n (for k = 1 or -1) *** -c - integer n, k - double precision x(n), y(n), z(n) - integer i -c - if (k .ge. 0) go to 20 - do 10 i = 1, n - 10 x(i) = y(i) / z(i) - go to 999 -c - 20 do 30 i = 1, n - 30 x(i) = y(i) * z(i) - 999 return -c *** last card of vvmulp follows *** - end - subroutine wzbfgs (l, n, s, w, y, z) -c -c *** compute y and z for lupdat corresponding to bfgs update. -c - integer n -cal double precision l(1), s(n), w(n), y(n), z(n) - double precision l(n*(n+1)/2), s(n), w(n), y(n), z(n) -c dimension l(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c l (i/o) cholesky factor of hessian, a lower triang. matrix stored -c compactly by rows. -c n (input) order of l and length of s, w, y, z. -c s (input) the step just taken. -c w (output) right singular vector of rank 1 correction to l. -c y (input) change in gradients corresponding to s. -c z (output) left singular vector of rank 1 correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c when s is computed in certain ways, e.g. by gqtstp or -c dbldog, it is possible to save n**2/2 operations since (l**t)*s -c or l*(l**t)*s is then known. -c if the bfgs update to l*(l**t) would reduce its determinant to -c less than eps times its old value, then this routine in effect -c replaces y by theta*y + (1 - theta)*l*(l**t)*s, where theta -c (between 0 and 1) is chosen to make the reduction factor = eps. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, livmul, ltvmul - double precision dotprd -c dotprd returns inner product of two vectors. -c livmul multiplies l**-1 times a vector. -c ltvmul multiplies l**t times a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cs, cy, eps, epsrt, one, shs, ys, theta -c -c *** data initializations *** -c -c/6 -c data eps/0.1d+0/, one/1.d+0/ -c/7 - parameter (eps=0.1d+0, one=1.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - call ltvmul(n, w, l, s) - shs = dotprd(n, w, w) - ys = dotprd(n, y, s) - if (ys .ge. eps*shs) go to 10 - theta = (one - eps) * shs / (shs - ys) - epsrt = dsqrt(eps) - cy = theta / (shs * epsrt) - cs = (one + (theta-one)/epsrt) / shs - go to 20 - 10 cy = one / (dsqrt(ys) * dsqrt(shs)) - cs = one / shs - 20 call livmul(n, z, l, y) - do 30 i = 1, n - 30 z(i) = cy * z(i) - cs * w(i) -c - 999 return -c *** last card of wzbfgs follows *** - end diff --git a/source/unres/src_MD-NEWSC-NEWC/surfatom.f b/source/unres/src_MD-NEWSC-NEWC/surfatom.f deleted file mode 100644 index 9974842..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/surfatom.f +++ /dev/null @@ -1,494 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1996 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ################################################################ -c ## ## -c ## subroutine surfatom -- exposed surface area of an atom ## -c ## ## -c ################################################################ -c -c -c "surfatom" performs an analytical computation of the surface -c area of a specified atom; a simplified version of "surface" -c -c literature references: -c -c T. J. Richmond, "Solvent Accessible Surface Area and -c Excluded Volume in Proteins", Journal of Molecular Biology, -c 178, 63-89 (1984) -c -c L. Wesson and D. Eisenberg, "Atomic Solvation Parameters -c Applied to Molecular Dynamics of Proteins in Solution", -c Protein Science, 1, 227-235 (1992) -c -c variables and parameters: -c -c ir number of atom for which area is desired -c area accessible surface area of the atom -c radius radii of each of the individual atoms -c -c - subroutine surfatom (ir,area,radius) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizes.i' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer nres,nsup,nstart_sup - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - integer maxarc - parameter (maxarc=300) - integer i,j,k,m - integer ii,ib,jb - integer io,ir - integer mi,ni,narc - integer key(maxarc) - integer intag(maxarc) - integer intag1(maxarc) - real*8 area,arcsum - real*8 arclen,exang - real*8 delta,delta2 - real*8 eps,rmove - real*8 xr,yr,zr - real*8 rr,rrsq - real*8 rplus,rminus - real*8 axx,axy,axz - real*8 ayx,ayy - real*8 azx,azy,azz - real*8 uxj,uyj,uzj - real*8 tx,ty,tz - real*8 txb,tyb,td - real*8 tr2,tr,txr,tyr - real*8 tk1,tk2 - real*8 thec,the,t,tb - real*8 txk,tyk,tzk - real*8 t1,ti,tf,tt - real*8 txj,tyj,tzj - real*8 ccsq,cc,xysq - real*8 bsqk,bk,cosine - real*8 dsqj,gi,pix2 - real*8 therk,dk,gk - real*8 risqk,rik - real*8 radius(maxatm) - real*8 ri(maxarc),risq(maxarc) - real*8 ux(maxarc),uy(maxarc),uz(maxarc) - real*8 xc(maxarc),yc(maxarc),zc(maxarc) - real*8 xc1(maxarc),yc1(maxarc),zc1(maxarc) - real*8 dsq(maxarc),bsq(maxarc) - real*8 dsq1(maxarc),bsq1(maxarc) - real*8 arci(maxarc),arcf(maxarc) - real*8 ex(maxarc),lt(maxarc),gr(maxarc) - real*8 b(maxarc),b1(maxarc),bg(maxarc) - real*8 kent(maxarc),kout(maxarc) - real*8 ther(maxarc) - logical moved,top - logical omit(maxarc) -c -c -c zero out the surface area for the sphere of interest -c - area = 0.0d0 -c write (2,*) "ir",ir," radius",radius(ir) - if (radius(ir) .eq. 0.0d0) return -c -c set the overlap significance and connectivity shift -c - pix2 = 2.0d0 * pi - delta = 1.0d-8 - delta2 = delta * delta - eps = 1.0d-8 - moved = .false. - rmove = 1.0d-8 -c -c store coordinates and radius of the sphere of interest -c - xr = c(1,ir) - yr = c(2,ir) - zr = c(3,ir) - rr = radius(ir) - rrsq = rr * rr -c -c initialize values of some counters and summations -c - 10 continue - io = 0 - jb = 0 - ib = 0 - arclen = 0.0d0 - exang = 0.0d0 -c -c test each sphere to see if it overlaps the sphere of interest -c - do i = 1, 2*nres - if (i.eq.ir .or. radius(i).eq.0.0d0) goto 30 - rplus = rr + radius(i) - tx = c(1,i) - xr - if (abs(tx) .ge. rplus) goto 30 - ty = c(2,i) - yr - if (abs(ty) .ge. rplus) goto 30 - tz = c(3,i) - zr - if (abs(tz) .ge. rplus) goto 30 -c -c check for sphere overlap by testing distance against radii -c - xysq = tx*tx + ty*ty - if (xysq .lt. delta2) then - tx = delta - ty = 0.0d0 - xysq = delta2 - end if - ccsq = xysq + tz*tz - cc = sqrt(ccsq) - if (rplus-cc .le. delta) goto 30 - rminus = rr - radius(i) -c -c check to see if sphere of interest is completely buried -c - if (cc-abs(rminus) .le. delta) then - if (rminus .le. 0.0d0) goto 170 - goto 30 - end if -c -c check for too many overlaps with sphere of interest -c - if (io .ge. maxarc) then - write (iout,20) - 20 format (/,' SURFATOM -- Increase the Value of MAXARC') - stop - end if -c -c get overlap between current sphere and sphere of interest -c - io = io + 1 - xc1(io) = tx - yc1(io) = ty - zc1(io) = tz - dsq1(io) = xysq - bsq1(io) = ccsq - b1(io) = cc - gr(io) = (ccsq+rplus*rminus) / (2.0d0*rr*b1(io)) - intag1(io) = i - omit(io) = .false. - 30 continue - end do -c -c case where no other spheres overlap the sphere of interest -c - if (io .eq. 0) then - area = 4.0d0 * pi * rrsq - return - end if -c -c case where only one sphere overlaps the sphere of interest -c - if (io .eq. 1) then - area = pix2 * (1.0d0 + gr(1)) - area = mod(area,4.0d0*pi) * rrsq - return - end if -c -c case where many spheres intersect the sphere of interest; -c sort the intersecting spheres by their degree of overlap -c - call sort2 (io,gr,key) - do i = 1, io - k = key(i) - intag(i) = intag1(k) - xc(i) = xc1(k) - yc(i) = yc1(k) - zc(i) = zc1(k) - dsq(i) = dsq1(k) - b(i) = b1(k) - bsq(i) = bsq1(k) - end do -c -c get radius of each overlap circle on surface of the sphere -c - do i = 1, io - gi = gr(i) * rr - bg(i) = b(i) * gi - risq(i) = rrsq - gi*gi - ri(i) = sqrt(risq(i)) - ther(i) = 0.5d0*pi - asin(min(1.0d0,max(-1.0d0,gr(i)))) - end do -c -c find boundary of inaccessible area on sphere of interest -c - do k = 1, io-1 - if (.not. omit(k)) then - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - bk = b(k) - therk = ther(k) -c -c check to see if J circle is intersecting K circle; -c get distance between circle centers and sum of radii -c - do j = k+1, io - if (omit(j)) goto 60 - cc = (txk*xc(j)+tyk*yc(j)+tzk*zc(j))/(bk*b(j)) - cc = acos(min(1.0d0,max(-1.0d0,cc))) - td = therk + ther(j) -c -c check to see if circles enclose separate regions -c - if (cc .ge. td) goto 60 -c -c check for circle J completely inside circle K -c - if (cc+ther(j) .lt. therk) goto 40 -c -c check for circles that are essentially parallel -c - if (cc .gt. delta) goto 50 - 40 continue - omit(j) = .true. - goto 60 -c -c check to see if sphere of interest is completely buried -c - 50 continue - if (pix2-cc .le. td) goto 170 - 60 continue - end do - end if - end do -c -c find T value of circle intersections -c - do k = 1, io - if (omit(k)) goto 110 - omit(k) = .true. - narc = 0 - top = .false. - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - dk = sqrt(dsq(k)) - bsqk = bsq(k) - bk = b(k) - gk = gr(k) * rr - risqk = risq(k) - rik = ri(k) - therk = ther(k) -c -c rotation matrix elements -c - t1 = tzk / (bk*dk) - axx = txk * t1 - axy = tyk * t1 - axz = dk / bk - ayx = tyk / dk - ayy = txk / dk - azx = txk / bk - azy = tyk / bk - azz = tzk / bk - do j = 1, io - if (.not. omit(j)) then - txj = xc(j) - tyj = yc(j) - tzj = zc(j) -c -c rotate spheres so K vector colinear with z-axis -c - uxj = txj*axx + tyj*axy - tzj*axz - uyj = tyj*ayy - txj*ayx - uzj = txj*azx + tyj*azy + tzj*azz - cosine = min(1.0d0,max(-1.0d0,uzj/b(j))) - if (acos(cosine) .lt. therk+ther(j)) then - dsqj = uxj*uxj + uyj*uyj - tb = uzj*gk - bg(j) - txb = uxj * tb - tyb = uyj * tb - td = rik * dsqj - tr2 = risqk*dsqj - tb*tb - tr2 = max(eps,tr2) - tr = sqrt(tr2) - txr = uxj * tr - tyr = uyj * tr -c -c get T values of intersection for K circle -c - tb = (txb+tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk1 = acos(tb) - if (tyb-txr .lt. 0.0d0) tk1 = pix2 - tk1 - tb = (txb-tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk2 = acos(tb) - if (tyb+txr .lt. 0.0d0) tk2 = pix2 - tk2 - thec = (rrsq*uzj-gk*bg(j)) / (rik*ri(j)*b(j)) - if (abs(thec) .lt. 1.0d0) then - the = -acos(thec) - else if (thec .ge. 1.0d0) then - the = 0.0d0 - else if (thec .le. -1.0d0) then - the = -pi - end if -c -c see if "tk1" is entry or exit point; check t=0 point; -c "ti" is exit point, "tf" is entry point -c - cosine = min(1.0d0,max(-1.0d0, - & (uzj*gk-uxj*rik)/(b(j)*rr))) - if ((acos(cosine)-ther(j))*(tk2-tk1) .le. 0.0d0) then - ti = tk2 - tf = tk1 - else - ti = tk2 - tf = tk1 - end if - narc = narc + 1 - if (narc .ge. maxarc) then - write (iout,70) - 70 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - if (tf .le. ti) then - arcf(narc) = tf - arci(narc) = 0.0d0 - tf = pix2 - lt(narc) = j - ex(narc) = the - top = .true. - narc = narc + 1 - end if - arcf(narc) = tf - arci(narc) = ti - lt(narc) = j - ex(narc) = the - ux(j) = uxj - uy(j) = uyj - uz(j) = uzj - end if - end if - end do - omit(k) = .false. -c -c special case; K circle without intersections -c - if (narc .le. 0) goto 90 -c -c general case; sum up arclength and set connectivity code -c - call sort2 (narc,arci,key) - arcsum = arci(1) - mi = key(1) - t = arcf(mi) - ni = mi - if (narc .gt. 1) then - do j = 2, narc - m = key(j) - if (t .lt. arci(j)) then - arcsum = arcsum + arci(j) - t - exang = exang + ex(ni) - jb = jb + 1 - if (jb .ge. maxarc) then - write (iout,80) - 80 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(m) - kout(jb) = maxarc*k + i - end if - tt = arcf(m) - if (tt .ge. t) then - t = tt - ni = m - end if - end do - end if - arcsum = arcsum + pix2 - t - if (.not. top) then - exang = exang + ex(ni) - jb = jb + 1 - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(mi) - kout(jb) = maxarc*k + i - end if - goto 100 - 90 continue - arcsum = pix2 - ib = ib + 1 - 100 continue - arclen = arclen + gr(k)*arcsum - 110 continue - end do - if (arclen .eq. 0.0d0) goto 170 - if (jb .eq. 0) goto 150 -c -c find number of independent boundaries and check connectivity -c - j = 0 - do k = 1, jb - if (kout(k) .ne. 0) then - i = k - 120 continue - m = kout(i) - kout(i) = 0 - j = j + 1 - do ii = 1, jb - if (m .eq. kent(ii)) then - if (ii .eq. k) then - ib = ib + 1 - if (j .eq. jb) goto 150 - goto 130 - end if - i = ii - goto 120 - end if - end do - 130 continue - end if - end do - ib = ib + 1 -c -c attempt to fix connectivity error by moving atom slightly -c - if (moved) then - write (iout,140) ir - 140 format (/,' SURFATOM -- Connectivity Error at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if -c -c compute the exposed surface area for the sphere of interest -c - 150 continue - area = ib*pix2 + exang + arclen - area = mod(area,4.0d0*pi) * rrsq -c -c attempt to fix negative area by moving atom slightly -c - if (area .lt. 0.0d0) then - if (moved) then - write (iout,160) ir - 160 format (/,' SURFATOM -- Negative Area at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if - end if - 170 continue - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/test.F b/source/unres/src_MD-NEWSC-NEWC/test.F deleted file mode 100644 index 0140ee5..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/test.F +++ /dev/null @@ -1,863 +0,0 @@ - subroutine test - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar),var1(maxvar) - integer j1,j2 - logical debug,accepted - debug=.true. - - - call geom_to_var(nvar,var1) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',0,etot,rms - call secondary2(.false.) - - call write_pdb(0,'first structure',etot) - - j1=13 - j2=21 - da=180.0*deg2rad - - - - temp=3000.0d0 - betbol=1.0D0/(1.9858D-3*temp) - jr=iran_num(j1,j2) - d=ran_number(-pi,pi) -c phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot0=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',1,etot0,rms - call write_pdb(1,'perturb structure',etot0) - - do i=2,500,2 - jr=iran_num(j1,j2) - d=ran_number(-da,da) - phiold=phi(jr) - phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - - if (etot.lt.etot0) then - accepted=.true. - else - accepted=.false. - xxr=ran_number(0.0D0,1.0D0) - xxh=betbol*(etot-etot0) - if (xxh.lt.50.0D0) then - xxh=dexp(-xxh) - if (xxh.gt.xxr) accepted=.true. - endif - endif - accepted=.true. -c print *,etot0,etot,accepted - if (accepted) then - etot0=etot - call rmsd(rms) - write(iout,*) 'etot=',i,etot,rms - call write_pdb(i,'MC structure',etot) -c minimize -c call geom_to_var(nvar,var1) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun - call var_to_geom(nvar,var) - call chainbuild - call rmsd(rms) - write(iout,*) 'etot mcm=',i,etot,rms - call write_pdb(i+1,'MCM structure',etot) - call var_to_geom(nvar,var1) -c -------- - else - phi(jr)=phiold - endif - enddo - -c minimize -c call sc_move(2,nres-1,1,10d0,nft_sc,etot) -c call geom_to_var(nvar,var) -c -c call chainbuild -c call write_pdb(998 ,'sc min',etot) -c -c call minimize(etot,var,iretcode,nfun) -c write(iout,*)'------------------------------------------------' -c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun -c -c call var_to_geom(nvar,var) -c call chainbuild -c call write_pdb(999,'full min',etot) - - - return - end - - - - - subroutine test_local - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling local_move' - call local_move_init(.false.) - call local_move(24,29,20d0,50d0) - call chainbuild - call write_pdb(3,'third structure',etot) - - write(iout,*) 'calling sc_move' - call sc_move(24,29,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'last structure',etot) - - - return - end - - subroutine test_sc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling sc_move 2nd time' - - call sc_move(nnt,nct,5,1d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(3,'last structure',etot) - return - end -c-------------------------------------------------------- - subroutine bgrow(bstrand,nbstrand,in,ind,new) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - integer bstrand(maxres/3,6) - - ishift=iabs(bstrand(in,ind+4)-new) - - print *,'bgrow',bstrand(in,ind+4),new,ishift - - bstrand(in,ind)=new - - if(ind.eq.1)then - bstrand(nbstrand,5)=bstrand(nbstrand,1) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,5).lt.bstrand(i,6)) then - bstrand(i,5)=bstrand(i,5)-ishift - else - bstrand(i,5)=bstrand(i,5)+ishift - endif - ENDIF - enddo - else - bstrand(nbstrand,6)=bstrand(nbstrand,2) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,6).lt.bstrand(i,5)) then - bstrand(i,6)=bstrand(i,6)-ishift - else - bstrand(i,6)=bstrand(i,6)+ishift - endif - ENDIF - enddo - endif - - - return - end - - -c------------------------------------------------- - - subroutine secondary(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) - logical lprint,not_done - real dcont(maxres*maxres/2),d - real rcomp /7.0/ - real rbeta /5.2/ - real ralfa /5.2/ - real r310 /6.6/ - double precision xpi(3),xpj(3) - - - - call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - isec(i,3)=0 - enddo - - do i=2,nres-3 - do k=1,3 - xpi(k)=0.5d0*(c(k,i-1)+c(k,i)) - enddo - do j=i+2,nres - do k=1,3 - xpj(k)=0.5d0*(c(k,j-1)+c(k,j)) - enddo -cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) + -cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) + -cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j)) -cd print *,'CA',i,j,d - d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) + - & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) + - & (xpi(3)-xpj(3))*(xpi(3)-xpj(3)) - if ( d.lt.rcomp*rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - dcont(ncont)=sqrt(d) - endif - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,'(a)') '#PP contact map distances:' - do i=1,ncont - write (iout,'(3i4,f10.5)') - & i,icont(1,i),icont(2,i),dcont(i) - enddo - endif - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) - & .and. dcont(j).le.rbeta .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=j1 - - do ij=ii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - do ij=jj1,j1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (dcont(i).le.rbeta.and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & .and. dcont(j).le.rbeta ) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - if(lprint)write (iout,*)'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=max0(ii1-1,1) - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=max0(j1-1,1) - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - - if (lprint) then - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+3.and.dcont(i).le.r310 - & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i) -cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i) - ii1=i1 - jj1=j1 - if (isec(ii1,1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - if (j1-ii1.gt.4) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=max0(j1-1,1) - - do ij=ii1,j1 - isec(ij,1)=-1 - enddo - if (lprint) then - write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - endif - - - return - end -c---------------------------------------------------------------------------- - - subroutine write_pdb(npdb,titelloc,ee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*50 titelloc1 - character*(*) titelloc - character*3 zahl - character*5 liczba5 - double precision ee - integer npdb,ilen - external ilen - - titelloc1=titelloc - lenpre=ilen(prefix) - if (npdb.lt.1000) then - call numstr(npdb,zahl) - open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb') - else - if (npdb.lt.10000) then - write(liczba5,'(i1,i4)') 0,npdb - else - write(liczba5,'(i5)') npdb - endif - open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb') - endif - call pdbout(ee,titelloc1,ipdb) - close(ipdb) - return - end - -c-------------------------------------------------------- - subroutine softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.INTERACT' -c - include 'COMMON.DISTFIT' - integer iff(maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - integer ieval -c - logical debug,ltest,fail - character*50 linia -c - linia='test' - debug=.true. - in_pdb=0 - - - -c------------------------ -c -c freeze sec.elements -c - do i=1,nres - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - iff(i)=0 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - enddo - mask_r=.true. - - - - nhpb0=nhpb -c -c store dist. constrains -c - do i=1,nres-3 - do j=i+3,nres - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=0.1 - dhpb(nhpb)=DIST(i,j) - endif - enddo - enddo - call hpb_partition - - if (debug) then - call chainbuild - call write_pdb(100+in_pdb,'input reg. structure',0d0) - endif - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - wang0=wang -c -c run soft pot. optimization -c - ipot=6 - wang=3.0 - maxmin=2000 - maxfun=4000 - call geom_to_var(nvar,var) -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, - & nfun/(time1-time0),' SOFT eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(300+in_pdb,'soft structure',etot) - endif -c -c run full UNRES optimization with constrains and frozen 2D -c the same variables as soft pot. optimizatio -c - ipot=ipot0 - wang=wang0 - maxmin=maxmin0 - maxfun=maxfun0 -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK DIST return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for mask dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(400+in_pdb,'mask & dist',etot) - endif -c -c switch off constrains and -c run full UNRES optimization with frozen 2D -c - -c -c reset constrains -c - nhpb_c=nhpb - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun - ieval=ieval+nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(500+in_pdb,'mask 2d frozen',etot) - endif - - mask_r=.false. - - -c -c run full UNRES optimization with constrains and NO frozen 2D -c - - nhpb=nhpb_c - link_start=1 - link_end=nhpb - maxfun=maxfun0/5 - - do ico=1,5 - - wstrain=wstrain0/ico -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(600+in_pdb+ico,'dist cons',etot) - endif - - enddo -c - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - maxfun=maxfun0 - - -c - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - return - end - - diff --git a/source/unres/src_MD-NEWSC-NEWC/thread.F b/source/unres/src_MD-NEWSC-NEWC/thread.F deleted file mode 100644 index 9f169a0..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/thread.F +++ /dev/null @@ -1,549 +0,0 @@ - subroutine thread_seq -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.CONTACTS' - include 'COMMON.MCM' - include 'COMMON.NAMES' -#ifdef MPI - include 'COMMON.INFO' - integer ThreadId,ThreadType,Kwita -#endif - double precision varia(maxvar) - double precision przes(3),obr(3,3) - double precision time_for_thread - logical found_pattern,non_conv - character*32 head_pdb - double precision energia(0:n_ene) - n_ene_comp=nprint_ene -C -C Body -C -#ifdef MPI - if (me.eq.king) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif - nacc_tot=0 -#endif - Kwita=0 - close(igeom) - close(ipdb) - close(istat) - do i=1,maxthread - do j=1,14 - ener0(j,i)=0.0D0 - ener(j,i)=0.0D0 - enddo - enddo - nres0=nct-nnt+1 - ave_time_for_thread=0.0D0 - max_time_for_thread=0.0D0 -cd print *,'nthread=',nthread,' nseq=',nseq,' nres0=',nres0 - nthread=nexcl+nthread - do ithread=1,nthread - found_pattern=.false. - itrial=0 - do while (.not.found_pattern) - itrial=itrial+1 - if (itrial.gt.1000) then - write (iout,'(/a/)') 'Too many attempts to find pattern.' - nthread=ithread-1 -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-3) -#endif - goto 777 - endif -C Find long enough chain in the database - ii=iran_num(1,nseq) - nres_t=nres_base(1,ii) -C Select the starting position to thread. - print *,'nseq',nseq,' ii=',ii,' nres_t=', - & nres_t,' nres0=',nres0 - if (nres_t.ge.nres0) then - ist=iran_num(0,nres_t-nres0) -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_receive -#endif - do i=1,nexcl - if (iexam(1,i).eq.ii .and. iexam(2,i).eq.ist) goto 10 - enddo - found_pattern=.true. - endif -C If this point is reached, the pattern has not yet been examined. - 10 continue -c print *,'found_pattern:',found_pattern - enddo - nexcl=nexcl+1 - iexam(1,nexcl)=ii - iexam(2,nexcl)=ist -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_send -#endif - ipatt(1,ithread)=ii - ipatt(2,ithread)=ist -#ifdef MPI - write (iout,'(/80(1h*)/a,i4,a,i5,2a,i3,a,i3,a,i3/)') - & 'Processor:',me,' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i4,a,i5,2a,i3,a,i3,a,i3)') 'Processor:',me, - & ' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#else - write (iout,'(/80(1h*)/a,i5,2a,i3,a,i3,a,i3/)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i5,2a,i3,a,i3,a,i3)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#endif - ipattern=ii -C Copy coordinates from the database. - ist=ist-(nnt-1) - do i=nnt,nct - do j=1,3 - c(j,i)=cart_base(j,i+ist,ii) -c cref(j,i)=c(j,i) - enddo -cd write (iout,'(a,i4,3f10.5)') restyp(itype(i)),i,(c(j,i),j=1,3) - enddo -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr, -cd non_conv) -cd write (iout,'(a,f10.5)') -cd & 'Initial RMS deviation from reference structure:',rms - if (itype(nres).eq.21) then - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - if (itype(1).eq.21) then - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - call int_from_cart(.false.,.false.) -cd print *,'Exit INT_FROM_CART.' -cd print *,'nhpb=',nhpb - do i=nss+1,nhpb - ii=ihpb(i) - jj=jhpb(i) - dhpb(i)=dist(ii,jj) -c write (iout,'(2i5,2f10.5)') ihpb(i),jhpb(i),dhpb(i),forcon(i) - enddo -c stop 'End generate' -C Generate SC conformations. - call sc_conf -c call intout -#ifdef MPI -cd print *,'Processor:',me,': exit GEN_SIDE.' -#else -cd print *,'Exit GEN_SIDE.' -#endif -C Calculate initial energy. - call chainbuild - call etotal(energia(0)) - etot=energia(0) - do i=1,n_ene_comp - ener0(i,ithread)=energia(i) - enddo - ener0(n_ene_comp+1,ithread)=energia(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener0(n_ene_comp+3,ithread)=contact_fract(ncont,ncont_ref, - & icont,icont_ref) - ener0(n_ene_comp+2,ithread)=rms - ener0(n_ene_comp+4,ithread)=frac - ener0(n_ene_comp+5,ithread)=frac_nn - endif - ener0(n_ene_comp+3,ithread)=0.0d0 -C Minimize energy. -#ifdef MPI - print*,'Processor:',me,' ithread=',ithread,' Start REGULARIZE.' -#else - print*,'ithread=',ithread,' Start REGULARIZE.' -#endif - curr_tim=tcpu() - call regularize(nct-nnt+1,etot,rms, - & cart_base(1,ist+nnt,ipattern),iretcode) - curr_tim1=tcpu() - time_for_thread=curr_tim1-curr_tim - ave_time_for_thread= - & ((ithread-1)*ave_time_for_thread+time_for_thread)/ithread - if (time_for_thread.gt.max_time_for_thread) - & max_time_for_thread=time_for_thread -#ifdef MPI - print *,'Processor',me,': Exit REGULARIZE.' - if (WhatsUp.eq.2) then - write (iout,*) - & 'Sufficient number of confs. collected. Terminating.' - nthread=ithread-1 - goto 777 - else if (WhatsUp.eq.-1) then - nthread=ithread-1 - write (iout,*) 'Time up in REGULARIZE. Call SEND_STOP_SIG.' - if (Kwita.eq.0) call recv_stop_sig(Kwita) - call send_stop_sig(-2) - goto 777 - else if (WhatsUp.eq.-2) then - nthread=ithread-1 - write (iout,*) 'Timeup signal received. Terminating.' - goto 777 - else if (WhatsUp.eq.-3) then - nthread=ithread-1 - write (iout,*) 'Error stop signal received. Terminating.' - goto 777 - endif -#else - print *,'Exit REGULARIZE.' - if (iretcode.eq.11) then - write (iout,'(/a/)') - &'******* Allocated time exceeded in SUMSL. The program will stop.' - nthread=ithread-1 - goto 777 - endif -#endif - head_pdb=titel(:24)//':'//str_nam(ipattern) - if (outpdb) call pdbout(etot,head_pdb,ipdb) - if (outmol2) call mol2out(etot,head_pdb) -c call intout - call briefout(ithread,etot) - link_end0=link_end - link_end=min0(link_end,nss) - write (iout,*) 'link_end=',link_end,' link_end0=',link_end0, - & ' nss=',nss - call etotal(energia(0)) -c call enerprint(energia(0)) - link_end=link_end0 -cd call chainbuild -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,non_conv) -cd write (iout,'(a,f10.5)') -cd & 'RMS deviation from reference structure:',dsqrt(rms) - do i=1,n_ene_comp - ener(i,ithread)=energia(i) - enddo - ener(n_ene_comp+1,ithread)=energia(0) - ener(n_ene_comp+3,ithread)=rms - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener(n_ene_comp+2,ithread)=rms - ener(n_ene_comp+4,ithread)=frac - ener(n_ene_comp+5,ithread)=frac_nn - endif - call write_stat_thread(ithread,ipattern,ist) -c write (istat,'(i4,2x,a8,i4,11(1pe14.5),2(0pf8.3),f8.5)') -c & ithread,str_nam(ipattern),ist+1,(ener(k,ithread),k=1,11), -c & (ener(k,ithread),k=12,14) -#ifdef MPI - if (me.eq.king) then - nacc_tot=nacc_tot+1 - call pattern_receive - call receive_MCM_info - if (nacc_tot.ge.nthread) then - write (iout,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - write (*,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - call recv_stop_sig(Kwita) - if (Kwita.eq.0) call send_stop_sig(-1) - nthread=ithread - goto 777 - endif - else - call send_MCM_info(2) - endif -#endif - if (timlim-curr_tim1-safety .lt. max_time_for_thread) then - write (iout,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (*,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (iout,'(a,1pe14.4/)') - & 'Elapsed time for last threading step: ',time_for_thread - nthread=ithread -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-2) -#endif - goto 777 - else - curr_tim=curr_tim1 - write (iout,'(a,1pe14.4)') - & 'Elapsed time for this threading step: ',time_for_thread - endif -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread - write (*,*) 'nthread=',nthread,' ithread=',ithread - goto 777 - endif -#endif - enddo -#ifdef MPI - call send_stop_sig(-1) -#endif - 777 continue -#ifdef MPI -C Any messages left for me? - call pattern_receive - if (Kwita.eq.0) call recv_stop_sig(Kwita) -#endif - call write_thread_summary -#ifdef MPI - if (king.eq.king) then - Kwita=1 - do while (Kwita.ne.0 .or. nacc_tot.ne.0) - Kwita=0 - nacc_tot=0 - call recv_stop_sig(Kwita) - call receive_MCM_info - enddo - do iproc=1,nprocs-1 - call receive_thread_results(iproc) - enddo - call write_thread_summary - else - call send_thread_results - endif -#endif - return - end -c-------------------------------------------------------------------------- - subroutine write_thread_summary -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -#ifdef MPI - include 'COMMON.INFO' -#endif - dimension ip(maxthread) - double precision energia(0:n_ene) - write (iout,'(30x,a/)') - & ' *********** Summary threading statistics ************' - write (iout,'(a)') 'Initial energies:' - write (iout,'(a4,2x,a12,14a14,3a8)') - & 'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' -C Energy sort patterns - do i=1,nthread - ip(i)=i - enddo - do i=1,nthread-1 - enet=ener(n_ene-1,ip(i)) - jj=i - do j=i+1,nthread - if (ener(n_ene-1,ip(j)).lt.enet) then - jj=j - enet=ener(n_ene-1,ip(j)) - endif - enddo - if (jj.ne.i) then - ipj=ip(jj) - ip(jj)=ip(i) - ip(i)=ipj - endif - enddo - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(i)=ener0(kk,i) - enddo - etot=ener0(n_ene_comp+1,i) - rmsnat=ener0(n_ene_comp+2,i) - rms=ener0(n_ene_comp+3,i) - frac=ener0(n_ene_comp+4,i) - frac_nn=ener0(n_ene_comp+5,i) - - if (refstr) then - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - else - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene),etot - endif - enddo - write (iout,'(//a)') 'Final energies:' - write (iout,'(a4,2x,a12,17a14,3a8)') - & 'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(kk)=ener(kk,ik) - enddo - etot=ener(n_ene_comp+1,i) - rmsnat=ener(n_ene_comp+2,i) - rms=ener(n_ene_comp+3,i) - frac=ener(n_ene_comp+4,i) - frac_nn=ener(n_ene_comp+5,i) - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - enddo - write (iout,'(/a/)') 'IEXAM array:' - write (iout,'(i5)') nexcl - do i=1,nexcl - write (iout,'(2i5)') iexam(1,i),iexam(2,i) - enddo - write (iout,'(/a,1pe14.4/a,1pe14.4/)') - & 'Max. time for threading step ',max_time_for_thread, - & 'Average time for threading step: ',ave_time_for_thread - return - end -c---------------------------------------------------------------------------- - subroutine sc_conf -C Sample (hopefully) optimal SC orientations given backcone conformation. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - double precision varia(maxvar) - common /srutu/ icall - double precision energia(0:n_ene) - logical glycine,fail - maxsample=10 - link_end0=link_end - link_end=min0(link_end,nss) - do i=nnt,nct - if (itype(i).ne.10) then -cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1) - call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail) - endif - enddo - call chainbuild - call etotal(energia(0)) - do isample=1,maxsample -C Choose a non-glycine side chain. - glycine=.true. - do while(glycine) - ind_sc=iran_num(nnt,nct) - glycine=(itype(ind_sc).eq.10) - enddo - alph0=alph(ind_sc) - omeg0=omeg(ind_sc) - call gen_side(itype(ind_sc),theta(ind_sc+1),alph(ind_sc), - & omeg(ind_sc),fail) - call chainbuild - call etotal(energia(0)) -cd write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))') -cd & 'Step:',isample,' SC',ind_sc,' alpha',alph(ind_sc)*rad2deg, -cd & ' omega',omeg(ind_sc)*rad2deg,' old energy',e0,' new energy',e1 - e1=0.0d0 - if (e0.le.e1) then - alph(ind_sc)=alph0 - omeg(ind_sc)=omeg0 - else - e0=e1 - endif - enddo - link_end=link_end0 - return - end -c--------------------------------------------------------------------------- - subroutine write_stat_thread(ithread,ipattern,ist) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.CONTROL" - include "COMMON.IOUNITS" - include "COMMON.THREAD" - include "COMMON.FFIELD" - include "COMMON.DBASE" - include "COMMON.NAMES" - double precision energia(0:n_ene) - -#if defined(AIX) || defined(PGI) - open(istat,file=statname,position='append') -#else - open(istat,file=statname,access='append') -#endif - do i=1,n_ene_comp - energia(i)=ener(i,ithread) - enddo - etot=ener(n_ene_comp+1,ithread) - rmsnat=ener(n_ene_comp+2,ithread) - rms=ener(n_ene_comp+3,ithread) - frac=ener(n_ene_comp+4,ithread) - frac_nn=ener(n_ene_comp+5,ithread) - write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & ithread,str_nam(ipattern),ist+1, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - close (istat) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/timing.F b/source/unres/src_MD-NEWSC-NEWC/timing.F deleted file mode 100644 index fb65430..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/timing.F +++ /dev/null @@ -1,344 +0,0 @@ -C $Date: 1994/10/05 16:41:52 $ -C $Revision: 2.2 $ -C -C -C - subroutine set_timers -c - implicit none - double precision tcpu - include 'COMMON.TIME1' -#ifdef MP - include 'mpif.h' -#endif -C Diminish the assigned time limit a little so that there is some time to -C end a batch job -c timlim=batime-150.0 -C Calculate the initial time, if it is not zero (e.g. for the SUN). - stime=tcpu() -#ifdef MPI - walltime=MPI_WTIME() - time_reduce=0.0d0 - time_allreduce=0.0d0 - time_bcast=0.0d0 - time_gather=0.0d0 - time_sendrecv=0.0d0 - time_scatter=0.0d0 - time_scatter_fmat=0.0d0 - time_scatter_ginv=0.0d0 - time_scatter_fmatmult=0.0d0 - time_scatter_ginvmult=0.0d0 - time_barrier_e=0.0d0 - time_barrier_g=0.0d0 - time_enecalc=0.0d0 - time_sumene=0.0d0 - time_lagrangian=0.0d0 - time_sumgradient=0.0d0 - time_intcartderiv=0.0d0 - time_inttocart=0.0d0 - time_ginvmult=0.0d0 - time_fricmatmult=0.0d0 - time_cartgrad=0.0d0 - time_bcastc=0.0d0 - time_bcast7=0.0d0 - time_bcastw=0.0d0 - time_intfcart=0.0d0 - time_vec=0.0d0 - time_mat=0.0d0 - time_fric=0.0d0 - time_stoch=0.0d0 - time_fricmatmult=0.0d0 - time_fsample=0.0d0 -#endif -cd print *,' in SET_TIMERS stime=',stime - return - end -C------------------------------------------------------------------------------ - logical function stopx(nf) -C This function returns .true. if one of the following reasons to exit SUMSL -C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: -C -C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false. -C... 1 - Time up in current node; -C... 2 - STOP signal was received from another node because the -C... node's task was accomplished (parallel only); -C... -1 - STOP signal was received from another node because of error; -C... -2 - STOP signal was received from another node, because -C... the node's time was up. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nf - logical ovrtim -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer Kwita - -cd print *,'Processor',MyID,' NF=',nf -#ifndef MPI - if (ovrtim()) then -C Finish if time is up. - stopx = .true. - WhatsUp=1 -#ifdef MPL - else if (mod(nf,100).eq.0) then -C Other processors might have finished. Check this every 100th function -C evaluation. -C Master checks if any other processor has sent accepted conformation(s) to it. - if (MyID.ne.MasterID) call receive_mcm_info - if (MyID.eq.MasterID) call receive_conf -cd print *,'Processor ',MyID,' is checking STOP: nf=',nf - call recv_stop_sig(Kwita) - if (Kwita.eq.-1) then - write (iout,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - write (*,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - stopx=.true. - WhatsUp=2 - elseif (Kwita.eq.-2) then - write (iout,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - WhatsUp=-2 - stopx=.true. - else if (Kwita.eq.-3) then - write (iout,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - WhatsUp=-1 - stopx=.true. - else - stopx=.false. - WhatsUp=0 - endif -#endif - else - stopx = .false. - WhatsUp=0 - endif -#else - stopx=.false. -#endif - -#ifdef OSF -c Check for FOUND_NAN flag - if (FOUND_NAN) then - write(iout,*)" *** stopx : Found a NaN" - stopx=.true. - endif -#endif - - return - end -C-------------------------------------------------------------------------- - logical function ovrtim() - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - real*8 tcpu -#ifdef MPI - include "mpif.h" - curtim = MPI_Wtime()-walltime -#else - curtim= tcpu() -#endif -C curtim is the current time in seconds. -c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety - if (curtim .ge. timlim - safety) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') - & "***************** Elapsed time (",curtim, - & " s) is within the safety limit (",safety, - & " s) of the allocated time (",timlim," s). Terminating." - ovrtim=.true. - else - ovrtim=.false. - endif - return - end -************************************************************************** - double precision function tcpu() - include 'COMMON.TIME1' -#ifdef ES9000 -**************************** -C Next definition for EAGLE (ibm-es9000) - real*8 micseconds - integer rcode - tcpu=cputime(micseconds,rcode) - tcpu=(micseconds/1.0E6) - stime -**************************** -#endif -#ifdef SUN -**************************** -C Next definitions for sun - REAL*8 ECPU,ETIME,ETCPU - dimension tarray(2) - tcpu=etime(tarray) - tcpu=tarray(1) -**************************** -#endif -#ifdef KSR -**************************** -C Next definitions for ksr -C this function uses the ksr timer ALL_SECONDS from the PMON library to -C return the elapsed time in seconds - tcpu= all_seconds() - stime -**************************** -#endif -#ifdef SGI -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - -#ifdef LINUX -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - - -#ifdef CRAY -**************************** -C Next definitions for Cray -C call date(curdat) -C curdat=curdat(1:9) -C call clock(curtim) -C curtim=curtim(1:8) - cpusec = second() - tcpu=cpusec - stime -**************************** -#endif -#ifdef AIX -**************************** -C Next definitions for RS6000 - integer*4 i1,mclock - i1 = mclock() - tcpu = (i1+0.0D0)/100.0D0 -#endif -#ifdef WINPGI -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif -#ifdef WINIFL -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif - - return - end -C--------------------------------------------------------------------------- - subroutine dajczas(rntime,hrtime,mintime,sectime) - include 'COMMON.IOUNITS' - real*8 rntime,hrtime,mintime,sectime - hrtime=rntime/3600.0D0 - hrtime=aint(hrtime) - mintime=aint((rntime-3600.0D0*hrtime)/60.0D0) - sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0) - if (sectime.eq.60.0D0) then - sectime=0.0D0 - mintime=mintime+1.0D0 - endif - ihr=hrtime - imn=mintime - isc=sectime - write (iout,328) ihr,imn,isc - 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 , - 1 ' minutes ', I2 ,' seconds *****') - return - end -C--------------------------------------------------------------------------- - subroutine print_detailed_timing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -#ifdef MPI - time1=MPI_WTIME() - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g, - & "TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - write (*,*) fg_rank,myrank, - & ': Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",fg_rank,myrank, - & ": BROADCAST time",time_bcast," REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter, - & " SCATTER fmatmult",time_scatter_fmatmult, - & " SCATTER ginvmult",time_scatter_ginvmult, - & " SCATTER fmat",time_scatter_fmat, - & " SCATTER ginv",time_scatter_ginv, - & " SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e, - & " BARRIER GRAD",time_barrier_g, - & " BCAST7",time_bcast7," BCASTC",time_bcastc, - & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce, - & " TOTAL", - & time_bcast+time_reduce+time_gather+time_scatter+ - & time_sendrecv+time_barrier+time_bcastc -#else - time1=tcpu() -#endif - write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc - write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene - write (*,*) "Processor",fg_rank,myrank," intfromcart", - & time_intfcart - write (*,*) "Processor",fg_rank,myrank," vecandderiv", - & time_vec - write (*,*) "Processor",fg_rank,myrank," setmatrices", - & time_mat - write (*,*) "Processor",fg_rank,myrank," ginvmult", - & time_ginvmult - write (*,*) "Processor",fg_rank,myrank," fricmatmult", - & time_fricmatmult - write (*,*) "Processor",fg_rank,myrank," inttocart", - & time_inttocart - write (*,*) "Processor",fg_rank,myrank," sumgradient", - & time_sumgradient - write (*,*) "Processor",fg_rank,myrank," intcartderiv", - & time_intcartderiv - if (fg_rank.eq.0) then - write (*,*) "Processor",fg_rank,myrank," lagrangian", - & time_lagrangian - write (*,*) "Processor",fg_rank,myrank," cartgrad", - & time_cartgrad - endif - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/unres.F b/source/unres/src_MD-NEWSC-NEWC/unres.F deleted file mode 100644 index e4f54cb..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/unres.F +++ /dev/null @@ -1,799 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C U N R E S C -C C -C Program to carry out conformational search of proteins in an united-residue C -C approximation. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#endif - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision hrtime,mintime,sectime - character*64 text_mode_calc(-2:14) /'test', - & 'SC rotamer distribution', - & 'Energy evaluation or minimization', - & 'Regularization of PDB structure', - & 'Threading of a sequence on PDB structures', - & 'Monte Carlo (with minimization) ', - & 'Energy minimization of multiple conformations', - & 'Checking energy gradient', - & 'Entropic sampling Monte Carlo (with minimization)', - & 'Energy map', - & 'CSA calculations', - & 'Not used 9', - & 'Not used 10', - & 'Soft regularization of PDB structure', - & 'Mesoscopic molecular dynamics (MD) ', - & 'Not used 13', - & 'Replica exchange molecular dynamics (REMD)'/ - external ilen - -c call memmon_print_usage() - - call init_task - if (me.eq.king) - & write(iout,*)'### LAST MODIFIED 03/28/12 23:29 by czarek' - if (me.eq.king) call cinfo -C Read force field parameters and job setup data - call readrtns - call flush(iout) -C - if (me.eq.king .or. .not. out1file) then - write (iout,'(2a/)') - & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), - & ' calculation.' - if (minim) write (iout,'(a)') - & 'Conformations will be energy-minimized.' - write (iout,'(80(1h*)/)') - endif - call flush(iout) -C - if (modecalc.eq.-2) then - call test - stop - else if (modecalc.eq.-1) then - write(iout,*) "call check_sc_map next" - call check_bond - stop - endif -#ifdef MPI - if (fg_rank.gt.0) then -C Fine-grain slaves just do energy and gradient components. - call ergastulum ! slave workhouse in Latin - else -#endif - if (modecalc.eq.0) then - call exec_eeval_or_minim - else if (modecalc.eq.1) then - call exec_regularize - else if (modecalc.eq.2) then - call exec_thread - else if (modecalc.eq.3 .or. modecalc .eq.6) then - call exec_MC - else if (modecalc.eq.4) then - call exec_mult_eeval_or_minim - else if (modecalc.eq.5) then - call exec_checkgrad - else if (ModeCalc.eq.7) then - call exec_map - else if (ModeCalc.eq.8) then - call exec_CSA - else if (modecalc.eq.11) then - call exec_softreg - else if (modecalc.eq.12) then - call exec_MD - else if (modecalc.eq.14) then - call exec_MREMD - else - write (iout,'(a)') 'This calculation type is not supported', - & ModeCalc - endif -#ifdef MPI - endif -C Finish task. - if (fg_rank.eq.0) call finish_task -c call memmon_print_usage() -#ifdef TIMING - call print_detailed_timing -#endif - call MPI_Finalize(ierr) - stop 'Bye Bye...' -#else - call dajczas(tcpu(),hrtime,mintime,sectime) - stop '********** Program terminated normally.' -#endif - end -c-------------------------------------------------------------------------- - subroutine exec_MD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - call MD - return - end -c--------------------------------------------------------------------------- - subroutine exec_MREMD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling REMD" - if (remd_mlist) then - call MREMD - else - do i=1,nrep - remd_m(i)=1 - enddo - call MREMD - endif -#else - write (iout,*) "MREMD works on parallel machines only" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:n_ene) - double precision energy_long(0:n_ene),energy_short(0:n_ene) - double precision varia(maxvar) - if (indpdb.eq.0) call chainbuild -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call chainbuild_cart - if (split_ene) then - print *,"Processor",myrank," after chainbuild" - icall=1 - call etotal_long(energy_long(0)) - write (iout,*) "Printing long range energy" - call enerprint(energy_long(0)) - call etotal_short(energy_short(0)) - write (iout,*) "Printing short range energy" - call enerprint(energy_short(0)) - do i=0,n_ene - energy(i)=energy_long(i)+energy_short(i) - write (iout,*) i,energy_long(i),energy_short(i),energy(i) - enddo - write (iout,*) "Printing long+short range energy" - call enerprint(energy(0)) - endif - call etotal(energy(0)) -#ifdef MPI - time_ene=MPI_Wtime()-time00 -#else - time_ene=tcpu()-time00 -#endif - write (iout,*) "Time for energy evaluation",time_ene - print *,"after etotal" - etota = energy(0) - etot =etota - call enerprint(energy(0)) - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - if (minim) then -crc overlap test - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - write(iout,*) 'SC_move',nft_sc,etot - endif - - if (dccart) then - print *, 'Calling MINIM_DC' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minim_dc(etot,iretcode,nfun) - else - if (indpdb.ne.0) then - call bond_regular - call chainbuild - endif - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - endif - print *,'SUMSL return code is',iretcode,' eval ',nfun -#ifdef MPI - evals=nfun/(MPI_WTIME()-time1) -#else - evals=nfun/(tcpu()-time1) -#endif - print *,'# eval/s',evals - print *,'refstr=',refstr - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - - call intout - call briefout(0,etot) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 - write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals - else - print *,'refstr=',refstr - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call briefout(0,etot) - endif - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - return - end -c--------------------------------------------------------------------------- - subroutine exec_regularize - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision energy(0:n_ene) - - call gen_dist_constr - call sc_conf - call intout - call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode) - call etotal(energy(0)) - energy(0)=energy(0)-energy(14) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - return - end -c--------------------------------------------------------------------------- - subroutine exec_thread - include 'DIMENSIONS' -#ifdef MP - include "mpif.h" -#endif - include "COMMON.SETUP" - call thread_seq - return - end -c--------------------------------------------------------------------------- - subroutine exec_MC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - character*10 nodeinfo - double precision varia(maxvar) -#ifdef MPI - include "mpif.h" -#endif - include "COMMON.SETUP" - include 'COMMON.CONTROL' - call mcm_setup - if (minim) then -#ifdef MPI - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#else - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#endif - else - call monte_carlo - endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_mult_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - dimension muster(mpi_status_size) -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision varia(maxvar) - dimension ind(6) - double precision energy(0:n_ene) - logical eof - eof=.false. -#ifdef MPI - if(me.ne.king) then - call minim_mcmf - return - endif - - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,30a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact","cont.order" - else - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - - if (.not.minim) then - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - call etotal(energy(0)) - call briefout(iconf,energy(0)) - call enerprint(energy(0)) - etot=energy(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo -1100 continue - goto 1101 - endif - - mm=0 - imm=0 - nft=0 - ene0=0.0d0 - n=0 - iconf=0 -c do n=1,nzsc - do while (.not. eof) - mm=mm+1 - if (mm.lt.nodes) then - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - ene0=0.0d0 - call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) -c print *,'task ',n,' sent to worker ',mm,nvar - else - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) -c print *,'receiving result from worker ',man,' (',iii1,iii,')' - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -c print *,'result received from worker ',man,' sending now' - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) -c if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - - imm=imm-1 - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - nf_mcmf=nf_mcmf+ind(4) - nmin=nmin+1 - endif - enddo -11 continue - do j=1,imm - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - nmin=nmin+1 - enddo -1101 continue - do i=1, nodes-1 - ind(1)=0 - ind(2)=0 - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM, - * ierr) - enddo -#else - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,20a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - write (istat,'("# ",20(1pe12.4))') - & (weights(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,20a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact" - else - write (istat,'(a5,14a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - if (minim) call minimize(etot,varia,iretcode,nfun) - call etotal(energy(0)) - - etot=energy(0) - call enerprint(energy(0)) - if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,18(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,14(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo - 11 continue - 1100 continue -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_checkgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:max_ene) -c do i=2,nres -c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0) -c if (itype(i).ne.10) -c & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0) -c enddo - if (indpdb.eq.0) call chainbuild -c do i=0,nres -c do j=1,3 -c dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0) -c enddo -c enddo -c do i=1,nres-1 -c if (itype(i).ne.10) then -c do j=1,3 -c dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0) -c enddo -c endif -c enddo -c do j=1,3 -c dc(j,0)=ran_number(-0.2d0,0.2d0) -c enddo - usampl=.true. - totT=1.d0 - eq_time=0.0d0 - call read_fragments - read(inp,*) t_bath -c! t_bath = 300 - call rescale_weights(t_bath) - call chainbuild_cart - call cartprint - call intout - icall=1 - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back - print *,'icheckgrad=',icheckgrad - goto (10,20,30) icheckgrad - 10 call check_ecartint - return - 20 call check_cartgrad - return - 30 call check_eint - return - end -c--------------------------------------------------------------------------- - subroutine exec_map -C Energy maps - call map_read - call map - return - end -c--------------------------------------------------------------------------- - subroutine exec_CSA -#ifdef MPI - include "mpif.h" -#endif - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -C Conformational Space Annealling programmed by Jooyoung Lee. -C This method works only with parallel machines! -#ifdef MPI -csa call together - write (iout,*) "CSA is not supported in this version" -#else -csa write (iout,*) "CSA works on parallel machines only" - write (iout,*) "CSA is not supported in this version" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - double precision energy(0:max_ene) - logical debug /.false./ - call chainbuild - call etotal(energy(0)) - call enerprint(energy(0)) - if (.not.lsecondary) then - write(iout,*) 'Calling secondary structure recognition' - call secondary2(debug) - else - write(iout,*) 'Using secondary structure supplied in pdb' - endif - - call softreg - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - call secondary2(.true.) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - return - end diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/CMakeLists.txt b/source/unres/src_MD-NEWSC-NEWC/xdrf/CMakeLists.txt deleted file mode 100644 index 26baa36..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/CMakeLists.txt +++ /dev/null @@ -1,19 +0,0 @@ -# -# CMake project file for UNRESPACK -# - -# m4 macro processor -add_custom_command( - OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c - COMMAND m4 - ARGS ${CMAKE_CURRENT_SOURCE_DIR}/underscore.m4 ${CMAKE_CURRENT_SOURCE_DIR}/libxdrf.m4 > ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c - VERBATIM -) - -# add headers from current dir -include_directories(${CMAKE_CURRENT_SOURCE_DIR}) -# compile the libxdrf library -add_library(xdrf STATIC ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.c ftocstr.c) -set(UNRES_XDRFLIB ${CMAKE_CURRENT_BINARY_DIR}/libxdrf.a PARENT_SCOPE) - -#add_dependencies( ${UNRES_BIN} xdrf ) diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile b/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile deleted file mode 100644 index 02c29f6..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = gcc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_jubl b/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_jubl deleted file mode 100644 index 8dc35cf..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_jubl +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc - -CFLAGS= -O2 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f *.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_linux b/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_linux deleted file mode 100644 index f03276e..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/Makefile_linux +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/RS6K.m4 b/source/unres/src_MD-NEWSC-NEWC/xdrf/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/ftocstr.c b/source/unres/src_MD-NEWSC-NEWC/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/libxdrf.m4 b/source/unres/src_MD-NEWSC-NEWC/xdrf/libxdrf.m4 deleted file mode 100644 index a6da458..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1238 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "w+"; - lmode = XDR_ENCODE; - } else if (*type == 'a' || *type == 'A') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/types.h b/source/unres/src_MD-NEWSC-NEWC/xdrf/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/underscore.m4 b/source/unres/src_MD-NEWSC-NEWC/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.c b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.h b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_array.c b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_float.c b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_stdio.c b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdrf.h b/source/unres/src_MD-NEWSC-NEWC/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/unres/src_MD-NEWSC-NEWC/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/unres/src_MD-NEWSC/MREMD.F b/source/unres/src_MD-NEWSC/MREMD.F index 0e4045f..576e43d 100644 --- a/source/unres/src_MD-NEWSC/MREMD.F +++ b/source/unres/src_MD-NEWSC/MREMD.F @@ -1828,7 +1828,6 @@ ctime call flush(iout) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) common /przechowalnia/ d_restart1 - integer i2set_(0:maxprocs) write (*,*) "Processor",me," called read1restart" if(me.eq.king)then @@ -1987,16 +1986,13 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) enddo endif #endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its -c own element -c call mpi_scatter(i2set,1,mpi_integer, -c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) - call mpi_bcast(i2set(0),nodes,mpi_integer,king, - & CG_COMM,ierr) - iset=i2set(me) + call mpi_scatter(i2set,1,mpi_integer, + & iset,1,mpi_integer,king, + & CG_COMM,ierr) + endif + if(me.eq.king) close(irest2) return end diff --git a/source/unres/src_MD-restraints/CMakeLists.txt b/source/unres/src_MD-restraints/CMakeLists.txt deleted file mode 100644 index a0353f4..0000000 --- a/source/unres/src_MD-restraints/CMakeLists.txt +++ /dev/null @@ -1,398 +0,0 @@ -# -# CMake project file for UNRES with MD for single chains -# - -enable_language (Fortran) - - -#================================ -# Set source file lists -#================================ -set(UNRES_MD_SRC0 - add.f - arcos.f - banach.f - blas.f - bond_move.f - cartder.F - cartprint.f - check_sc_distr.f - check_bond.f - chainbuild.F - checkder_p.F - compare_s1.F - contact.f - convert.f - cored.f - dihed_cons.F - djacob.f - econstr_local.F - eigen.f - elecont.f - energy_split-sep.F - entmcm.F - fitsq.f - gauss.f - gen_rand_conf.F - geomout.F - gnmr1.f - intcartderiv.F - initialize_p.F - int_to_cart.f - intcor.f - intlocal.f - kinetic_lesyng.f - lagrangian_lesyng.F - local_move.f - map.f - matmult.f - mc.F - mcm.F - MD_A-MTS.F - minimize_p.F - minim_mcmf.F - misc.f - moments.f - MP.F - MREMD.F - muca_md.f - parmread.F - pinorm.f - printmat.f - q_measure.F - randgens.f - rattle.F - readpdb.F - readrtns.F - refsys.f - regularize.F - rescode.f - rmdd.f - rmsd.F - sc_move.F - sort.f - stochfric.F - sumsld.f - surfatom.f - test.F - timing.F - thread.F - unres.F - ssMD.F -) - -if(Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "f95") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "gfortran") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -else() - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - -set(UNRES_MD_SRC3 - energy_p_new_barrier.F - energy_p_new-sep_barrier.F - gradient_p.F ) - -set(UNRES_MD_PP_SRC - cartder.F - chainbuild.F - checkder_p.F - compare_s1.F - dihed_cons.F - econstr_local.F - energy_p_new_barrier.F - energy_p_new-sep_barrier.F - energy_split-sep.F - entmcm.F - gen_rand_conf.F - geomout.F - gradient_p.F - initialize_p.F - intcartderiv.F - lagrangian_lesyng.F - mc.F - mcm.F - MD_A-MTS.F - minimize_p.F - minim_mcmf.F - MP.F - MREMD.F - parmread.F - q_measure1.F - q_measure3.F - q_measure.F - rattle.F - readpdb.F - readrtns.F - regularize.F - rmsd.F - sc_move.F - stochfric.F - test.F - thread.F - timing.F - unres.F - proc_proc.c -) - - -if(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_PP_SRC ${UNRES_MD_PP_SRC} prng_32.F) -endif(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - -#================================================ -# Set comipiler flags for different sourcefiles -#================================================ -if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-ip -w" ) - set(FFLAGS1 "-w -g -d2 -CA -CB" ) - set(FFLAGS2 "-w -g -00 ") - #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" ) - set(FFLAGS3 "-w -ipo " ) -elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 "-std=legacy -I. " ) - set(FFLAGS1 "-std=legacy -g -I. " ) - set(FFLAGS2 "-std=legacy -I. ") - #set(FFLAGS3 "-c -w -O3 -ipo -ipo_obj -opt_report" ) - set(FFLAGS3 "-std=legacy -I. " ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - -# Add MPI compiler flags -if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") -endif(UNRES_WITH_MPI) - -set_property(SOURCE ${UNRES_MD_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) -#set_property(SOURCE ${UNRES_MD_SRC1} PROPERTY COMPILE_FLAGS ${FFLAGS1} ) -#set_property(SOURCE ${UNRES_MD_SRC2} PROPERTY COMPILE_FLAGS ${FFLAGS2} ) -set_property(SOURCE ${UNRES_MD_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) - -#========================================= -# Settings for GAB force field -#========================================= -if(UNRES_MD_FF STREQUAL "GAB" ) - # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) - -#========================================= -# Settings for E0LL2Y force field -#========================================= -elseif(UNRES_MD_FF STREQUAL "E0LL2Y") - # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" ) -endif(UNRES_MD_FF STREQUAL "GAB") - -#========================================= -# System specific flags -#========================================= -if(${CMAKE_SYSTEM_NAME} MATCHES "Linux") - set(CPPFLAGS "${CPPFLAGS} -DLINUX") -endif(${CMAKE_SYSTEM_NAME} MATCHES "Linux") - -#========================================= -# Compiler specific flags -#========================================= - -if (Fortran_COMPILER_NAME STREQUAL "ifort") - # Add ifort preprocessor flags - set(CPPFLAGS "${CPPFLAGS} -DPGI") -elseif (Fortran_COMPILER_NAME STREQUAL "f95") - # Add new gfortran flags - set(CPPFLAGS "${CPPFLAGS} -DG77") -elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - # Add old gfortran flags - set(CPPFLAGS "${CPPFLAGS} -DG77") -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - -#========================================= -# Add MPI preprocessor flags -#========================================= -if (UNRES_WITH_MPI) - set(CPPFLAGS "${CPPFLAGS} -DMP -DMPI") -endif(UNRES_WITH_MPI) - -#========================================= -# Apply preprocesor flags to *.F files -#========================================= -set_property(SOURCE ${UNRES_MD_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) - - -#======================================== -# Setting binary name -#======================================== -if(UNRES_WITH_MPI) - # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") -else(UNRES_WITH_MPI) - # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") -endif(UNRES_WITH_MPI) - -#========================================= -# cinfo.f workaround for cmake -#========================================= -# get the current date -TODAY(DATE) -# generate cinfo.f - -set(CINFO "${CMAKE_CURRENT_BINARY_DIR}/cinfo.f") -FILE(WRITE ${CINFO} -"C CMake generated file - subroutine cinfo - include 'COMMON.IOUNITS' - write(iout,*)'++++ Compile info ++++' - write(iout,*)'Version ${UNRES_MAJOR}.${UNRES_MINOR} build ${UNRES_PATCH}' -") - -CINFO_FORMAT(${CINFO} "Compiled" "${DATE}" ) -CINFO_FORMAT(${CINFO} "Compiled by" "$ENV{USER}@$ENV{HOST}" ) -CINFO_FORMAT(${CINFO} "OS name:" "${CMAKE_SYSTEM_NAME}" ) -CINFO_FORMAT(${CINFO} "OS release:" "${CMAKE_SYSTEM}" ) -CINFO_FORMAT(${CINFO} "Fortran Compiler:" "${CMAKE_Fortran_COMPILER}" ) -CINFO_FORMAT(${CINFO} "MD Force field:" "${UNRES_MD_FF}" ) -CINFO_FORMAT(${CINFO} "CPPFLAGS =" "${CPPFLAGS}") - -FILE(APPEND ${CINFO} -" write(iout,*)'++++ End of compile info ++++' - return - end ") - -# add include path -set_property(SOURCE ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f PROPERTY COMPILE_FLAGS "${FFLAGS0} -I${CMAKE_CURRENT_SOURCE_DIR}") - -#========================================= -# Set full unres MD sources -#========================================= -set(UNRES_MD_SRCS ${UNRES_MD_SRC0} ${UNRES_MD_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f ) - - -#========================================= -# Build the binary -#========================================= -add_executable(UNRES_BIN-MD ${UNRES_MD_SRCS} ) -set_target_properties(UNRES_BIN-MD PROPERTIES OUTPUT_NAME ${UNRES_BIN}) -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) -#add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) - - -#========================================= -# Link libraries -#========================================= -# link MPI library (libmpich.a) -if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD ${MPIF_LIBRARIES} ) -endif(UNRES_WITH_MPI) -# link libxdrf.a -#message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") -target_link_libraries( UNRES_BIN-MD xdrf ) - -#========================================= -# TESTS -#========================================= - -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) - -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) - -#========================================= -# Generate data test files -#========================================= -# test_single_ala.sh -#========================================= - -FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh -"#!/bin/sh -export POT=GB -export PREFIX=ala10 -#----------------------------------------------------------------------------- -UNRES_BIN=./${UNRES_BIN} -#----------------------------------------------------------------------------- -DD=${CMAKE_SOURCE_DIR}/PARAM -export BONDPAR=$DD/bond.parm -export THETPAR=$DD/thetaml.5parm -export ROTPAR=$DD/scgauss.parm -export TORPAR=$DD/torsion_631Gdp.parm -export TORDPAR=$DD/torsion_double_631Gdp.parm -export ELEPAR=$DD/electr_631Gdp.parm -export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k -export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 -export SCPPAR=$DD/scp.parm -export SCCORPAR=$DD/sccor_pdb_shelly.dat -export PATTERN=$DD/patterns.cart -#----------------------------------------------------------------------------- -$UNRES_BIN -") - -# -# File permissions workaround -# -FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh - DESTINATION ${CMAKE_CURRENT_BINARY_DIR} - FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE -) - - - -#========================================= -# ala10.inp -#========================================= - -file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp -"ala10 unblocked -SEED=-1111333 MD ONE_LETTER rescale_mode=2 -nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & -reset_moment=1000 reset_vel=1000 -WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & -WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & -WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & -WVDWPP=0.11371 WHPB=1.00000 & -CUTOFF=7.00000 WCORR4=0.00000 -12 -XAAAAAAAAAAX - 0 - 0 - 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 - 90.0000 90.0000 - 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 - 180.0000 - 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 - 110.0000 110.0000 - -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 - -120.0000 -120.0000 -") - - -# Add tests - -if(NOT UNRES_WITH_MPI) - - add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -else(NOT UNRES_WITH_MPI) - - - add_test(NAME UNRES_MD_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -endif(NOT UNRES_WITH_MPI) - diff --git a/source/unres/src_MD-restraints/COMMON.BOUNDS b/source/unres/src_MD-restraints/COMMON.BOUNDS deleted file mode 100644 index f3859ae..0000000 --- a/source/unres/src_MD-restraints/COMMON.BOUNDS +++ /dev/null @@ -1,2 +0,0 @@ - double precision phibound(2,maxres) - common /bounds/ phibound diff --git a/source/unres/src_MD-restraints/COMMON.CACHE b/source/unres/src_MD-restraints/COMMON.CACHE deleted file mode 100644 index 8cb0cbc..0000000 --- a/source/unres/src_MD-restraints/COMMON.CACHE +++ /dev/null @@ -1,6 +0,0 @@ - integer ncache,CachSrc(max_cache),isent(max_cache), - & iused(max_cache) - logical cache_update - double precision ecache(max_cache),xcache(maxvar,max_cache) - common /cache/ ecache,xcache,ncache,CachSrc,isent,iused, - & cache_update diff --git a/source/unres/src_MD-restraints/COMMON.CALC b/source/unres/src_MD-restraints/COMMON.CALC deleted file mode 100644 index 67b4bb9..0000000 --- a/source/unres/src_MD-restraints/COMMON.CALC +++ /dev/null @@ -1,15 +0,0 @@ - integer i,j,k,l - double precision erij,rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg - common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, - & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, - & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, - & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, - & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, - & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j diff --git a/source/unres/src_MD-restraints/COMMON.CHAIN b/source/unres/src_MD-restraints/COMMON.CHAIN deleted file mode 100644 index 6e19f8d..0000000 --- a/source/unres/src_MD-restraints/COMMON.CHAIN +++ /dev/null @@ -1,13 +0,0 @@ - integer nres,nsup,nstart_sup,nz_start,nz_end,iz_sc, - & nres0,nstart_seq - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm,t,r, - & prod,rt,dc_work,cref,crefjlee,dc_norm2 - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_norm2(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), - & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), - & nsup,nstart_sup,nstart_seq - common /from_zscore/ nz_start,nz_end,iz_sc diff --git a/source/unres/src_MD-restraints/COMMON.CONTACTS b/source/unres/src_MD-restraints/COMMON.CONTACTS deleted file mode 100644 index 5b3a90d..0000000 --- a/source/unres/src_MD-restraints/COMMON.CONTACTS +++ /dev/null @@ -1,82 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -c 7/25/08 Commented out; not needed when cumulants used -C Interactions of pseudo-dipoles generated by loc-el interactions. -c double precision dip,dipderg,dipderx -c common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), -c & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ mu(2,maxres),muder(2,maxres),Ub2(2,maxres), - & Ub2der(2,maxres),Ctobr(2,maxres),Ctobrder(2,maxres), - & Dtobr2(2,maxres),Dtobr2der(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),Ug2DtEUg(2,2,maxres), - & Ug2DtEUgder(2,2,2,maxres),DtUg2EUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx,g_contij,ekont - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont -C 12/13/2008 (again Poland-Jaruzel war anniversary) -C RE: Parallelization of 4th and higher order loc-el correlations - integer ncont_sent,ncont_recv,iint_sent,iisent_local, - & itask_cont_from,itask_cont_to,ntask_cont_from,ntask_cont_to, - & nat_sent,iat_sent,iturn3_sent,iturn4_sent,iturn3_sent_local, - & iturn4_sent_local - common /contdistrib/ ncont_sent(maxres),ncont_recv(maxres), - & iint_sent(4,maxres,maxres),iint_sent_local(4,maxres,maxres), - & iturn3_sent(4,maxres),iturn4_sent(4,maxres), - & iturn3_sent_local(4,maxres),iturn4_sent_local(4,maxres), - & nat_sent,iat_sent(maxres),itask_cont_from(0:max_fg_procs-1), - & itask_cont_to(0:max_fg_procs-1),ntask_cont_from,ntask_cont_to diff --git a/source/unres/src_MD-restraints/COMMON.CONTACTS.moment b/source/unres/src_MD-restraints/COMMON.CONTACTS.moment deleted file mode 100644 index d07a0f0..0000000 --- a/source/unres/src_MD-restraints/COMMON.CONTACTS.moment +++ /dev/null @@ -1,68 +0,0 @@ -C Change 12/1/95 - common block CONTACTS1 included. - integer ncont,ncont_ref,icont,icont_ref,num_cont,jcont - double precision facont,gacont - common /contacts/ ncont,ncont_ref,icont(2,maxcont), - & icont_ref(2,maxcont) - common /contacts1/ facont(maxconts,maxres), - & gacont(3,maxconts,maxres), - & num_cont(maxres),jcont(maxconts,maxres) -C 12/26/95 - H-bonding contacts - common /contacts_hb/ - & gacontp_hb1(3,maxconts,maxres),gacontp_hb2(3,maxconts,maxres), - & gacontp_hb3(3,maxconts,maxres), - & gacontm_hb1(3,maxconts,maxres),gacontm_hb2(3,maxconts,maxres), - & gacontm_hb3(3,maxconts,maxres), - & gacont_hbr(3,maxconts,maxres), - & grij_hb_cont(3,maxconts,maxres), - & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), - & ees0m(maxconts,maxres),d_cont(maxconts,maxres), - & num_cont_hb(maxres),jcont_hb(maxconts,maxres) -C 9/23/99 Added improper rotation matrices and matrices of dipole-dipole -C interactions -C Interactions of pseudo-dipoles generated by loc-el interactions. - double precision dip,dipderg,dipderx - common /dipint/ dip(4,maxconts,maxres),dipderg(4,maxconts,maxres), - & dipderx(3,5,4,maxconts,maxres) -C 10/30/99 Added other pre-computed vectors and matrices needed -C to calculate three - six-order el-loc correlation terms - double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der - common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), - & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), - & obrot_der(2,maxres),obrot2_der(2,maxres) -C This common block contains vectors and matrices dependent on a single -C amino-acid residue. - common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), - & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), - & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), - & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) -C This common block contains vectors and matrices dependent on two -C consecutive amino-acid residues. - double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, - & EUgCder,EUgD,EUgDder,DtUg2EUg,DtUg2EUgder - common /precomp2/ Ug2Db1t(2,maxres),Ug2Db1tder(2,maxres), - & CUgb2(2,maxres),CUgb2der(2,maxres),EUgC(2,2,maxres), - & EUgCder(2,2,maxres),EUgD(2,2,maxres),EUgDder(2,2,maxres), - & DtUg2EUg(2,2,maxres),DtUg2EUgder(2,2,2,maxres), - & Ug2DtEUg(2,2,maxres),Ug2DtEUgder(2,2,2,maxres) - double precision costab,sintab,costab2,sintab2 - common /rotat_old/ costab(maxres),sintab(maxres), - & costab2(maxres),sintab2(maxres),muder(2,maxres) -C This common block contains dipole-interaction matrices and their -C Cartesian derivatives. - double precision a_chuj,a_chuj_der - common /dipmat/ a_chuj(2,2,maxconts,maxres), - & a_chuj_der(2,2,3,5,maxconts,maxres) - double precision AEA,AEAderg,AEAderx,AECA,AECAderg,AECAderx, - & ADtEA,ADtEAderg,ADtEAderx,AEAb1,AEAb1derg,AEAb1derx, - & AEAb2,AEAb2derg,AEAb2derx - common /diploc/ AEA(2,2,2),AEAderg(2,2,2),AEAderx(2,2,3,5,2,2), - & EAEA(2,2,2), EAEAderg(2,2,2,2), EAEAderx(2,2,3,5,2,2), - & AECA(2,2,2),AECAderg(2,2,2),AECAderx(2,2,3,5,2,2), - & ADtEA(2,2,2),ADtEAderg(2,2,2,2),ADtEAderx(2,2,3,5,2,2), - & ADtEA1(2,2,2),ADtEA1derg(2,2,2,2),ADtEA1derx(2,2,3,5,2,2), - & AEAb1(2,2,2),AEAb1derg(2,2,2),AEAb1derx(2,3,5,2,2,2), - & AEAb2(2,2,2),AEAb2derg(2,2,2,2),AEAb2derx(2,3,5,2,2,2), - & g_contij(3,2),ekont diff --git a/source/unres/src_MD-restraints/COMMON.CONTROL b/source/unres/src_MD-restraints/COMMON.CONTROL deleted file mode 100644 index 9fce3c5..0000000 --- a/source/unres/src_MD-restraints/COMMON.CONTROL +++ /dev/null @@ -1,15 +0,0 @@ - integer modecalc,iscode,indpdb,indback,indphi,iranconf,icheckgrad, - & inprint,i2ndstr,mucadyn,constr_dist,constr_homology - real*8 waga_dist, waga_angle - logical minim,refstr,pdbref,outpdb,outmol2,overlapsc,energy_dec, - & sideadd,lsecondary,read_cart,unres_pdb, - & vdisulf,searchsc,lmuca,dccart,extconf,out1file, - & gnorm_check,gradout,split_ene - common /cntrl/ modecalc,iscode,indpdb,indback,indphi,iranconf, - & icheckgrad,minim,i2ndstr,refstr,pdbref,outpdb,outmol2,iprint, - & overlapsc,energy_dec,sideadd,lsecondary,read_cart,unres_pdb - & ,vdisulf,searchsc,lmuca,dccart,mucadyn,extconf,out1file, - & constr_dist,gnorm_check,gradout,split_ene,constr_homology, - & waga_dist, waga_angle -C... minim = .true. means DO minimization. -C... energy_dec = .true. means print energy decomposition matrix diff --git a/source/unres/src_MD-restraints/COMMON.DBASE b/source/unres/src_MD-restraints/COMMON.DBASE deleted file mode 100644 index 4f07780..0000000 --- a/source/unres/src_MD-restraints/COMMON.DBASE +++ /dev/null @@ -1,3 +0,0 @@ - common /struct/ cart_base(3,maxres_base,maxseq),str_nam(maxseq), - & nres_base(3,maxseq),nseq - character*8 str_nam diff --git a/source/unres/src_MD-restraints/COMMON.DERIV b/source/unres/src_MD-restraints/COMMON.DERIV deleted file mode 100644 index 6fdb1aa..0000000 --- a/source/unres/src_MD-restraints/COMMON.DERIV +++ /dev/null @@ -1,36 +0,0 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, - & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, - & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT,gvdwx - integer nfl,icg - common /derivatT/ gvdwcT(3,maxres),gvdwxT(3,maxres) - common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gelc_long(3,maxres), - & gvdwpp(3,maxres),gvdwc_scpp(3,maxres), - & gradx_scp(3,maxres),gvdwc_scp(3,maxres),ghpbx(3,maxres), - & ghpbc(3,maxres),gloc(maxvar,2),gradcorr(3,maxres), - & gradcorr_long(3,maxres),gradcorr5_long(3,maxres), - & gradcorr6_long(3,maxres),gcorr6_turn_long(3,maxres), - & gradxorr(3,maxres),gradcorr5(3,maxres),gradcorr6(3,maxres), - & gloc_x(maxvar,2),gel_loc(3,maxres),gel_loc_long(3,maxres), - & gcorr3_turn(3,maxres), - & gcorr4_turn(3,maxres),gcorr6_turn(3,maxres),gradb(3,maxres), - & gradbx(3,maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), - & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), - & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg - double precision derx,derx_turn - common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) - double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), - & dZZ_C1tab(3,maxres),dXX_Ctab(3,maxres),dYY_Ctab(3,maxres), - & dZZ_Ctab(3,maxres),dXX_XYZtab(3,maxres),dYY_XYZtab(3,maxres), - & dZZ_XYZtab(3,maxres) - common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, - & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab - integer igrad_start,igrad_end,jgrad_start(maxres), - & jgrad_end(maxres) - common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/unres/src_MD-restraints/COMMON.DISTFIT b/source/unres/src_MD-restraints/COMMON.DISTFIT deleted file mode 100644 index 683228a..0000000 --- a/source/unres/src_MD-restraints/COMMON.DISTFIT +++ /dev/null @@ -1,14 +0,0 @@ -c parameter (maxres22=maxres*(maxres+1)/2) - parameter (maxres22=1) - double precision w,d0,DRDG,DD,H,XX - integer nbfrag,bfrag,nhfrag,hfrag,bvar_frag,hvar_frag,nhpb0, - 1 lvar_frag,svar_frag,avar_frag - COMMON /c_frag/ nbfrag,bfrag(4,maxres/3),nhfrag,hfrag(2,maxres/3) -csa COMMON /frag/ bvar_frag(mxio,6),hvar_frag(mxio,3), -csa 1 lvar_frag(mxio,3),svar_frag(mxio,3), -csa 2 avar_frag(mxio,5) - COMMON /WAGI/ w(MAXRES22),d0(MAXRES22) - COMMON /POCHODNE/ NX,NY,DRDG(MAXRES22,MAXRES),DD(MAXRES22), - 1 H(MAXRES,MAXRES),XX(MAXRES) - COMMON /frozen/ mask(maxres) - COMMON /store0/ nhpb0 diff --git a/source/unres/src_MD-restraints/COMMON.FFIELD b/source/unres/src_MD-restraints/COMMON.FFIELD deleted file mode 100644 index 2deca8e..0000000 --- a/source/unres/src_MD-restraints/COMMON.FFIELD +++ /dev/null @@ -1,25 +0,0 @@ -C----------------------------------------------------------------------- -C The following COMMON block selects the type of the force field used in -C calculations and defines weights of various energy terms. -C 12/1/95 wcorr added -C----------------------------------------------------------------------- - integer n_ene_comp,rescale_mode - common /ffield/ wsc,wscp,welec,wbond,wstrain,wtor,wtor_d,wang, - & wscloc,wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wsct,weights(n_ene),temp0, - & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp, - & rescale_mode - common /potentials/ potname(5) - character*3 potname -C----------------------------------------------------------------------- -C wlong,welec,wtor,wang,wscloc are the weight of the energy terms -C corresponding to side-chain, electrostatic, torsional, valence-angle, -C and local side-chain terms. -C -C IPOT determines which SC...SC interaction potential will be used: -C 1 - LJ: 2n-n Lennard-Jones -C 2 - LJK: 2n-n Kihara type (shifted Lennard-Jones) -C 3 - BP; Berne-Pechukas (angular dependence) -C 4 - GB; Gay-Berne (angular dependence) -C 5 - GBV; Gay-Berne-Vorobjev; angularly-dependent Kihara potential -C------------------------------------------------------------------------ diff --git a/source/unres/src_MD-restraints/COMMON.GEO b/source/unres/src_MD-restraints/COMMON.GEO deleted file mode 100644 index 8cfbbde..0000000 --- a/source/unres/src_MD-restraints/COMMON.GEO +++ /dev/null @@ -1,2 +0,0 @@ - double precision pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin - common /geo/ pi,dwapi,pipol,pi3,dwapi3,deg2rad,rad2deg,angmin diff --git a/source/unres/src_MD-restraints/COMMON.HAIRPIN b/source/unres/src_MD-restraints/COMMON.HAIRPIN deleted file mode 100644 index f103268..0000000 --- a/source/unres/src_MD-restraints/COMMON.HAIRPIN +++ /dev/null @@ -1,5 +0,0 @@ - integer nharp_seed(max_seed),nharp_tot, - & iharp_seed(4,maxres/3,max_seed),iharp_use(0:4,maxres/3,max_seed), - & nharp_use(max_seed) - common /spinka/ nharp_seed,nharp_tot,iharp_seed,iharp_use, - & nharp_use diff --git a/source/unres/src_MD-restraints/COMMON.HEADER b/source/unres/src_MD-restraints/COMMON.HEADER deleted file mode 100644 index 7154812..0000000 --- a/source/unres/src_MD-restraints/COMMON.HEADER +++ /dev/null @@ -1,2 +0,0 @@ - character*80 titel - common /header/ titel diff --git a/source/unres/src_MD-restraints/COMMON.INFO b/source/unres/src_MD-restraints/COMMON.INFO deleted file mode 100644 index 4f63708..0000000 --- a/source/unres/src_MD-restraints/COMMON.INFO +++ /dev/null @@ -1,21 +0,0 @@ -c NPROCS - total number of processors; -c MyID - processor's ID; -c MasterID - master processor's ID. - integer MyId,AllGrp,DontCare,MasterId,WhatsUp,ifinish - logical koniec - integer tag,status(MPI_STATUS_SIZE) - common /info/ myid,masterid,allgrp,dontcare, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1) -c... 5/12/96 - added variables for collective communication -c FGPROCS - Number of fine-grain processors per coarse-grain task; -c NCTASKS - Number of coarse-grain tasks; -c MYGROUP - label of the processor's FG group id; -c BOSSID - ID of group's master; -c FGLIST - list of group's FG processors. -c MSGLEN_VAR - length of the vector of variables passed to the fine-grain -c slave processors - integer fgprocs,nctasks,mygroup,bossid,cglabel, - & cglist(max_cg_procs),cgGroupID,fglist(max_fg_procs), - & fgGroupID,MyRank - common /info1/ fgprocs,nctasks,mygroup,bossid,cglabel,cglist, - & cgGroupID,fglist,fgGroupID,MyRank,msglen_var diff --git a/source/unres/src_MD-restraints/COMMON.INTERACT b/source/unres/src_MD-restraints/COMMON.INTERACT deleted file mode 100644 index fabad93..0000000 --- a/source/unres/src_MD-restraints/COMMON.INTERACT +++ /dev/null @@ -1,34 +0,0 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ale6,ael3,ael6 - integer expon,expon2 - integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro, - & ielstart,ielend,ielstart_vdw,ielend_vdw,nscp_gr,iscpstart, - & iscpend,iatsc_s,iatsc_e, - & iatel_s,iatel_e,iatscp_s,iatscp_e,iatel_s_vdw,iatel_e_vdw, - & ispp,iscp - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), - & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), - & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), - & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, - & ielstart(maxres),ielend(maxres),ielstart_vdw(maxres), - & ielend_vdw(maxres),nscp_gr(maxres), - & iscpstart(maxres,maxint_gr),iscpend(maxres,maxint_gr), - & iatsc_s,iatsc_e,iatel_s,iatel_e,iatel_s_vdw,iatel_e_vdw, - & iatscp_s,iatscp_e,ispp,iscp -C 12/1/95 Array EPS included in the COMMON block. - double precision eps,sigma,sigmaii,rs0,chi,chip,alp,sigma0,sigii, - & rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp - common /body/eps(ntyp,ntyp),sigma(0:ntyp1,0:ntyp1), - & sigmaii(ntyp,ntyp), - & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),alp(ntyp),sigma0(ntyp), - & sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp),r0d(ntyp,2), - & rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2),eps_scp(20,2),rscp(20,2) -c 12/5/03 modified 09/18/03 Bond stretching parameters. - double precision vbldp0,vbldsc0,akp,aksc,abond0 - integer nbondterm - common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, - & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp),nbondterm(ntyp) - double precision wdti,wdti2,wdti4,wdti8, - & wdtii,wdtii2,wdtii4,wdtii8 - common /nosehoover_dt/ - & wdti(maxyosh),wdti2(maxyosh),wdti4(maxyosh),wdti8(maxyosh), - & wdtii(maxyosh),wdtii2(maxyosh),wdtii4(maxyosh),wdtii8(maxyosh) diff --git a/source/unres/src_MD-restraints/COMMON.IOUNITS b/source/unres/src_MD-restraints/COMMON.IOUNITS deleted file mode 100644 index 49b6db3..0000000 --- a/source/unres/src_MD-restraints/COMMON.IOUNITS +++ /dev/null @@ -1,69 +0,0 @@ -C----------------------------------------------------------------------- -C I/O units used by the program -C----------------------------------------------------------------------- -C 9/18/99 - unit ifourier and filename fouriername included to identify -C the file from which the coefficients of second-order Fourier expansion -C of the local-interaction energy are read. -C 8/9/01 - file for SCP interaction constants named scpname (unit iscpp) -C included. -C----------------------------------------------------------------------- -C General I/O units & files - integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, - & itorp,itordp,ifourier,ielep,isidep,iscpp,icbase,istat, - & ientin,ientout,izs1,isecpred,ibond,irest2,iifrag,icart, - & irest1,isccor,ithep_pdb,irotam_pdb - common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, - & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,icbase, - & istat,ientin,ientout,izs1,isecpred,ibond,irest2,iifrag, - & icart,irest1,isccor,ithep_pdb,irotam_pdb - character*256 outname,intname,pdbname,mol2name,statname,intinname, - & entname,prefix,secpred,rest2name,qname,cartname,tmpdir, - & mremd_rst_name,curdir,pref_orig - character*4 liczba - common /fnames/ outname,intname,pdbname,mol2name,statname, - & intinname,entname,prefix,pot,secpred,rest2name,qname, - & cartname,tmpdir,mremd_rst_name,curdir,pref_orig,liczba -C CSA I/O units & files - character*256 csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - common /csafiles/ csa_rbank,csa_seed,csa_history,csa_bank, - & csa_bank1,csa_alpha,csa_alpha1,csa_bankt,csa_int, - & csa_bank_reminimized,csa_native_int,csa_in - integer icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb - common /csaunits/ icsa_rbank,icsa_seed,icsa_history,icsa_bank, - & icsa_bank1,icsa_alpha,icsa_alpha1,icsa_bankt,icsa_int, - & icsa_bank_reminimized,icsa_native_int,icsa_in,icsa_pdb -C Parameter files - character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - common /parfiles/ bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname, - & thetname_pdb,rotname_pdb - character*3 pot -C----------------------------------------------------------------------- -C INP - main input file -C IOUT - list file -C IGEOM - geometry output in the form of virtual-chain internal coordinates -C INTIN - geometry input (for multiple conformation processing) in int. coords. -C IPDB - Cartesian-coordinate output in PDB format -C IMOL2 - Cartesian-coordinate output in Tripos mol2 format -C IPDBIN - PDB input file -C ITHEP - virtual-bond torsional angle parametrs -C IROTAM - side-chain geometry and local-interaction parameters -C ITORP - torsional parameters -C ITORDP - double torsional parameters -C IFOURIER - coefficients of the expansion of local-interaction energy -C IELEP - electrostatic-interaction parameters -C ISIDEP - side-chain interaction parameters. -C ISCPP - SCp interaction parameters. -C IBOND - virtual-bond constant parameters and moments of inertia. -C ISCCOR - parameters of the potential of SCCOR term -C ICBASE - data base with Cartesian coords of known structures. -C ISTAT - energies and other conf. characteristics from an MCM run. -C IENTIN - entropy from preceeding simulation(s) to be read in. -C SECPRED - SECONDARY STRUCTURE PREDICTION for dihedral constraint generation. -C----------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/COMMON.LANGEVIN b/source/unres/src_MD-restraints/COMMON.LANGEVIN deleted file mode 100644 index 6a703e2..0000000 --- a/source/unres/src_MD-restraints/COMMON.LANGEVIN +++ /dev/null @@ -1,21 +0,0 @@ - double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2), - & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6), - & stoch_work(MAXRES6), - & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2), - & pfric_mat(MAXRES2,MAXRES2),vfric_mat(MAXRES2,MAXRES2), - & afric_mat(MAXRES2,MAXRES2),prand_mat(MAXRES2,MAXRES2), - & vrand_mat1(MAXRES2,MAXRES2),vrand_mat2(MAXRES2,MAXRES2), - & pfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & afric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & vfric0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & prand0_mat(MAXRES2,MAXRES2,0:maxflag_stoch), - & vrand0_mat1(MAXRES2,MAXRES2,0:maxflag_stoch), - & vrand0_mat2(MAXRES2,MAXRES2,0:maxflag_stoch), - & mt1(maxres2,maxres2),mt2(maxres2,maxres2),mt3(maxres2,maxres2) - logical flag_stoch(0:maxflag_stoch) - common /langforc/ friction,stochforc, - & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1, - & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat, - & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1, - & vrand0_mat2,flag_stoch - common /langmat/ mt1,mt2,mt3 diff --git a/source/unres/src_MD-restraints/COMMON.LANGEVIN.lang0 b/source/unres/src_MD-restraints/COMMON.LANGEVIN.lang0 deleted file mode 100644 index 354a0c4..0000000 --- a/source/unres/src_MD-restraints/COMMON.LANGEVIN.lang0 +++ /dev/null @@ -1,11 +0,0 @@ - double precision friction(3,0:MAXRES2),stochforc(3,0:MAXRES2), - & fricmat(MAXRES2,MAXRES2),fric_work(MAXRES6), - & stoch_work(MAXRES6), - & fricgam(MAXRES6),fricvec(MAXRES2,MAXRES2) - logical flag_stoch(0:maxflag_stoch) - common /langforc/ friction,stochforc, - & fricmat,fric_work,fricgam,stoch_work,fricvec,vrand_mat1, - & vrand_mat2,prand_mat,vfric_mat,afric_mat,pfric_mat, - & pfric0_mat,afric0_mat,vfric0_mat,prand0_mat,vrand0_mat1, - & vrand0_mat2,flag_stoch - common /langmat/ mt1,mt2,mt3 diff --git a/source/unres/src_MD-restraints/COMMON.LOCAL b/source/unres/src_MD-restraints/COMMON.LOCAL deleted file mode 100644 index a3f68dc..0000000 --- a/source/unres/src_MD-restraints/COMMON.LOCAL +++ /dev/null @@ -1,55 +0,0 @@ - double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0, - & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 - integer nlob -C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) -C Parameters of the side-chain probability distribution - common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), - & nlob(ntyp1) -C Parameters of ab initio-derived potential of virtual-bond-angle bending - integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) - common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, - & ffthet, - & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, - & ndouble,nntheterm -C Virtual-bond lenghts - double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv - integer loc_start,loc_end,ithet_start,ithet_end,iphi_start, - & iphi_end,iphid_start,iphid_end,itau_start,itau_end,ibond_start, - & ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end, - & ibond_displ(0:max_fg_procs-1),ibond_count(0:max_fg_procs-1), - & ithet_displ(0:max_fg_procs-1),ithet_count(0:max_fg_procs-1), - & iphi_displ(0:max_fg_procs-1),iphi_count(0:max_fg_procs-1), - & iphi1_displ(0:max_fg_procs-1),iphi1_count(0:max_fg_procs-1), - & ivec_displ(0:max_fg_procs-1),ivec_count(0:max_fg_procs-1), - & iset_displ(0:max_fg_procs-1),iset_count(0:max_fg_procs-1), - & iint_count(0:max_fg_procs-1),iint_displ(0:max_fg_procs-1) - common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 - common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end,iphid_start,iphid_end,itau_start,itau_end, - & ibond_start,ibond_end, - & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, - & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, - & iint_end,iphi1_start,iphi1_end,iint_count,iint_displ,ivec_displ, - & ivec_count,iset_displ, - & iset_count,ibond_displ,ibond_count,ithet_displ,ithet_count, - & iphi_displ,iphi_count,iphi1_displ,iphi1_count -C Inverses of the actual virtual bond lengths - common /invlen/ vbld_inv(maxres2) diff --git a/source/unres/src_MD-restraints/COMMON.LOCMOVE b/source/unres/src_MD-restraints/COMMON.LOCMOVE deleted file mode 100644 index 211516d..0000000 --- a/source/unres/src_MD-restraints/COMMON.LOCMOVE +++ /dev/null @@ -1,19 +0,0 @@ -c Variables (set in init routine) never modified by local_move - integer init_called - logical locmove_output - double precision min_theta, max_theta - double precision dmin2,dmax2 - double precision flag,small,small2 - - common /loc_const/ init_called,locmove_output,min_theta, - + max_theta,dmin2,dmax2,flag,small,small2 - -c Workspace for local_move - integer a_n,b_n,res_n - double precision a_ang,b_ang,res_ang - logical a_tab,b_tab,res_tab - - common /loc_work/ res_ang(0:11),a_ang(0:7),b_ang(0:3), - + res_n,res_tab(0:2,0:2,0:11), - + a_n,a_tab(0:2,0:7), - + b_n,b_tab(0:2,0:3) diff --git a/source/unres/src_MD-restraints/COMMON.MAP b/source/unres/src_MD-restraints/COMMON.MAP deleted file mode 100644 index 77e97e7..0000000 --- a/source/unres/src_MD-restraints/COMMON.MAP +++ /dev/null @@ -1,4 +0,0 @@ - integer nmap,res1,res2,nstep - double precision ang_from,ang_to - common /mapp/ ang_from(maxvar),ang_to(maxvar),nmap,kang(maxvar), - & res1(maxvar),res2(maxvar),nstep(maxvar) diff --git a/source/unres/src_MD-restraints/COMMON.MAXGRAD b/source/unres/src_MD-restraints/COMMON.MAXGRAD deleted file mode 100644 index 285241a..0000000 --- a/source/unres/src_MD-restraints/COMMON.MAXGRAD +++ /dev/null @@ -1,12 +0,0 @@ - double precision - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - common /maxgrad/ - & gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max diff --git a/source/unres/src_MD-restraints/COMMON.MCE b/source/unres/src_MD-restraints/COMMON.MCE deleted file mode 100644 index 2d79184..0000000 --- a/source/unres/src_MD-restraints/COMMON.MCE +++ /dev/null @@ -1,13 +0,0 @@ - double precision entropy(-max_ene-4:max_ene),nminima(maxsave), - & nhist(-max_ene:max_ene) - logical ent_read,multican - common /mce/ entropy,emin,emax,nhist,nminima,ent_read,multican, - & indminn,indmaxx - integer npool - double precision xpool,epool,pool_fraction - common /pool/ xpool(maxvar,max_pool),epool(max_pool), - & pool_fraction,npool - integer save_frequency,message_frequency,pool_read_freq, - & pool_save_freq,print_freq - common /mce_counters/ save_frequency,message_frequency, - & pool_read_freq,pool_save_freq,print_freq diff --git a/source/unres/src_MD-restraints/COMMON.MCM b/source/unres/src_MD-restraints/COMMON.MCM deleted file mode 100644 index 576f912..0000000 --- a/source/unres/src_MD-restraints/COMMON.MCM +++ /dev/null @@ -1,70 +0,0 @@ -C... Following COMMON block contains general variables controlling the MC/MCM -C... procedure -c----------------------------------------------------------------------------- - double precision Tcur,Tmin,Tmax,TstepH,TstepC,RanFract, - & overlap_cut,e_up,delte - integer nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter, - & maxrepm,ngen,ntrial,ntherm,nrepm,neneval,nsave,maxoverlap, - & nsave_part,max_mcm_it,nsweep,print_mc - logical print_stat,print_int - common /mcm/ Tcur,Tmin,Tmax,TstepH,TstepC,Rbol,betbol,RanFract, - & overlap_cut,e_up,delte, - & nstepH,nstepC,maxacc,maxgen,maxtrial,maxtrial_iter,maxrepm, - & maxoverlap,ntrial,max_mcm_it, - & ngen,ntherm,nrepm,neneval,nsave,nsave_part(max_cg_procs),nsweep, - & print_mc,print_stat,print_int -c----------------------------------------------------------------------------- -C... The meaning of the above variables is as follows: -C... Tcur,Tmin,Tmax - Current,minimum and maximum temperature, respectively; -C... NstepC,NStepH - Number of cooling and heating steps, respectively; -C... TstepH,TstepC - factors by which T is multiplied in order to be -C... increased or decreased. -C... betbol - Boltzmann's inverse temperature (1/(Rbol*Tcur)); -C... Rbol - the gas constant; -C... RanFract - the chance that a new conformation will be random-generated; -C... maxacc - maximum number of accepted conformations; -C... maxgen,ngen - Maximum and current number of generated conformations; -C... maxtrial,ntrial - maximum number of trials before temperature is increased -C... and current number of trials, respectively; -C... maxrepm,nrepm - maximum number of allowed minima repetition and current -C... number of minima repetitions, respectively; -C... maxoverlap - max. # of overlapping confs generated in a single iteration; -C... neneval - number of energy evaluations; -C... nsave - number of confs. in the backup array; -C... nsweep - the number of macroiterations in generating the distributions. -c------------------------------------------------------------------------------ -C... Following COMMON block contains variables controlling motion. -c------------------------------------------------------------------------------ - double precision sumpro_type,sumpro_bond - integer koniecl, Nbm,MaxSideMove,nmove,moves(-1:MaxMoveType+1), - & moves_acc(-1:MaxMoveType+1),nacc_tot,nacc_part(0:MaxProcs) - common /move/ sumpro_type(0:MaxMoveType),sumpro_bond(0:maxres), - & koniecl,Nbm,MaxSideMove,nmove,nbond_move(maxres), - & nbond_acc(maxres),moves,moves_acc - common /accept_stats/ nacc_tot,nacc_part - integer nwindow,winstart,winend,winlen - common /windows/ nwindow,winstart(maxres),winend(maxres), - & winlen(maxres) - character*16 MovTypID - common /moveID/ MovTypID(-1:MaxMoveType+1) -c------------------------------------------------------------------------------ -C... koniecl - the number of bonds to be considered "end bonds" subjected to -C... end moves; -C... Nbm - The maximum length of N-bond segment to be moved; -C... MaxSideMove - maximum number of side chains subjected to local moves -C... simultaneously; -C... nmove - the current number of attempted moves; -C... nbond_move(*) array that stores the total numbers of 2-bond,3-bond,... -C... moves; -C... nendmove - number of endmoves; -C... nbackmove - number of backbone moves; -C... nsidemove - number of local side chain moves; -C... sumpro_type(*) - array that stores the lower and upper boundary of the -C... random-number range that determines the type of move -C... (N-bond, backbone or side chain); -C... sumpro_bond(*) - array that stores the probabilities to perform bond -C... moves of consecutive segment length. -C... winstart(*) - the starting position of the perturbation window; -C... winend(*) - the end position of the perturbation window; -C... winlen(*) - length of the perturbation window; -C... nwindow - the number of perturbation windows (0 - entire chain). diff --git a/source/unres/src_MD-restraints/COMMON.MD b/source/unres/src_MD-restraints/COMMON.MD deleted file mode 100644 index bd38d1b..0000000 --- a/source/unres/src_MD-restraints/COMMON.MD +++ /dev/null @@ -1,87 +0,0 @@ - double precision gcart, gxcart, gradcag,gradxag - common /mdgrad/ gcart(3,0:MAXRES), gxcart(3,0:MAXRES), - & gradcag(3,MAXRES),gradxag(3,MAXRES) - integer dimen,dimen1, dimen3, ifrag(2,50,maxprocs/20), - & ipair(2,100,maxprocs/20),iset, - & mset(maxprocs/20),nset - double precision IP,ISC(ntyp+1),mp, - & msc(ntyp+1),d_t_work(MAXRES6), - & d_t_work_new(MAXRES6),d_t(3,0:MAXRES2),d_t_new(3,0:MAXRES2), - & d_af_work(MAXRES6),d_as_work(MAXRES6), - & d_t_old(3,0:MAXRES2),d_a_old(3,0:MAXRES2),d_a_short(3,0:MAXRES2), - & Gmat(MAXRES2,MAXRES2),Ginv(MAXRES2,MAXRES2),A(MAXRES2,MAXRES2), - & d_a(3,0:MAXRES2),d_a_work(6*MAXRES),kinetic_force(MAXRES6), - & Gsqrp(MAXRES2,MAXRES2),Gsqrm(MAXRES2,MAXRES2), - & vtot(MAXRES2),Gvec(maxres2,maxres2),Geigen(maxres2) - - real*8 odl(max_template,maxdim),sigma_odl(max_template,maxdim), - & dih(max_template,maxres),sigma_dih(max_template,maxres) - - integer ires_homo(maxdim),jres_homo(maxdim) - - double precision v_ini,d_time,d_time0,t_bath,tau_bath, - & EK,potE,potEcomp(0:n_ene+4),totE,totT,amax,kinetic_T,dvmax,damax, - & edriftmax, - & eq_time,wfrag(50,maxprocs/20),wpair(100,maxprocs/20), - & qfrag(50),qpair(100), - & qinfrag(50,maxprocs/20),qinpair(100,maxprocs/20), - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst, - & dUdxconst(3,0:MAXRES),dqwol(3,0:MAXRES),dxqwol(3,0:MAXRES), - & utheta(maxfrag_back),ugamma(maxfrag_back),uscdiff(maxfrag_back), - & dutheta(maxres),dugamma(maxres),duscdiff(3,maxres), - & duscdiffx(3,maxres),wfrag_back(3,maxfrag_back,maxprocs/20), - & uconst_back - integer n_timestep,ntwx,ntwe,lang,count_reset_moment, - & count_reset_vel,reset_fricmat,nfrag,npair,nfrag_back, - & ifrag_back(3,maxfrag_back,maxprocs/20),ntime_split,ntime_split0, - & maxtime_split,lim_odl,lim_dih,link_start_homo,link_end_homo, - & idihconstr_start_homo,idihconstr_end_homo - integer nresn,nyosh,nnos - double precision glogs,qmass,vlogs,xlogs - logical large,print_compon,tbf,rest,reset_moment,reset_vel, - & surfarea,rattle,usampl,mdpdb,RESPA,tnp,tnp1,tnh,xiresp - integer igmult_start,igmult_end,my_ng_count,ng_start,ng_counts, - & nginv_start,nginv_counts,myginv_ng_count - common /back_constr/ uconst_back,utheta,ugamma,uscdiff, - & dutheta,dugamma,duscdiff,duscdiffx, - & wfrag_back,nfrag_back,ifrag_back - common /homrestr/ odl,dih,sigma_dih,sigma_odl, - & lim_odl,lim_dih,ires_homo,jres_homo,link_start_homo, - & link_end_homo,idihconstr_start_homo,idihconstr_end_homo - common /qmeas/ qfrag,qpair,qinfrag,qinpair,wfrag,wpair,eq_time, - & Ucdfrag,Ucdpair,dUdconst,dUdxconst,dqwol,dxqwol,Uconst, - & iset,mset,nset,usampl,ifrag,ipair,npair,nfrag - common /mdpar/ v_ini,d_time,d_time0,scal_fric, - & t_bath,tau_bath,dvmax,damax,n_timestep,mdpdb, - & ntime_split,ntime_split0,maxtime_split, - & ntwx,ntwe,large,print_compon,tbf,rest,tnp,tnp1,tnh - common /MDcalc/ totT,totE,potE,potEcomp,EK,amax,edriftmax, - & kinetic_T - common /lagrange/ d_t,d_t_old,d_t_new,d_t_work, - & d_t_work_new,d_a,d_a_old,d_a_work,d_af_work,d_as_work,d_a_short, - & kinetic_force, - & A,Ginv,Gmat,Gvec,Geigen,Gsqrp,Gsqrm, - & vtot,dimen,dimen1,dimen3,lang, - & reset_moment,reset_vel,count_reset_moment,count_reset_vel, - & rattle,RESPA - common /inertia/ IP,ISC,MP,MSC - double precision scal_fric,rwat,etawat,gamp, - & gamsc(ntyp),stdfp,stdfsc(ntyp),stdforcp(MAXRES), - & stdforcsc(MAXRES),pstok,restok(ntyp+1),cPoise,Rb - common /langevin/ pstok,restok,gamp,gamsc, - & stdfp,stdfsc,stdforcp,stdforcsc,rwat,etawat,cPoise,Rb,surfarea, - & reset_fricmat - common /mdpmpi/ igmult_start,igmult_end,my_ng_count, - & myginv_ng_count, - & ng_start(0:MaxProcs-1),ng_counts(0:MaxProcs-1), - & nginv_start(0:MaxProcs),nginv_counts(0:MaxProcs-1) - double precision pi_np,pistar,s_np,s12_np,Q_np,E_old,H0,E_long, - & sold_np,d_t_half,Csplit,hhh - common /nosepoincare/ pi_np,pistar,s_np,s12_np,Q_np,E_old,H0, - & E_long,sold_np,d_t_half(3,0:MAXRES2),Csplit,hhh - common /nosehoover/ glogs(maxmnh),qmass(maxmnh), - & vlogs(maxmnh),xlogs(maxmnh), - & nresn,nyosh,nnos,xiresp - integer hmc,hmc_acc - double precision dc_hmc,hmc_etot,totThmc - common /hmc_md/ dc_hmc(3,0:maxres2),hmc_etot,totThmc,hmc,hmc_acc diff --git a/source/unres/src_MD-restraints/COMMON.MINIM b/source/unres/src_MD-restraints/COMMON.MINIM deleted file mode 100644 index e44f9cd..0000000 --- a/source/unres/src_MD-restraints/COMMON.MINIM +++ /dev/null @@ -1,5 +0,0 @@ - double precision tolf,rtolf - integer maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res - common /minimm/ tolf,rtolf,maxfun,maxmin,minfun,minmin, - & print_min_ini,print_min_stat,print_min_res diff --git a/source/unres/src_MD-restraints/COMMON.MUCA b/source/unres/src_MD-restraints/COMMON.MUCA deleted file mode 100644 index 7529c15..0000000 --- a/source/unres/src_MD-restraints/COMMON.MUCA +++ /dev/null @@ -1,10 +0,0 @@ - double precision emuca(4*maxres),nemuca(4*maxres), - & nemuca2(4*maxres),elow,ehigh,factor, - & elowi(maxprocs),ehighi(maxprocs),hbin, - & hist(4*maxres),factor_min - integer nmuca,imtime,muca_smooth - common /double_muca/ emuca,nemuca, - & nemuca2,elow,ehigh,factor,hbin,hist,factor_min - common /integer_muca/ nmuca,imtime,muca_smooth - common /mucarem/ elowi,ehighi - diff --git a/source/unres/src_MD-restraints/COMMON.NAMES b/source/unres/src_MD-restraints/COMMON.NAMES deleted file mode 100644 index e6f926b..0000000 --- a/source/unres/src_MD-restraints/COMMON.NAMES +++ /dev/null @@ -1,7 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(n_ene),wname(n_ene),nprint_ene, - & print_order(n_ene) diff --git a/source/unres/src_MD-restraints/COMMON.REMD b/source/unres/src_MD-restraints/COMMON.REMD deleted file mode 100644 index b283b5b..0000000 --- a/source/unres/src_MD-restraints/COMMON.REMD +++ /dev/null @@ -1,36 +0,0 @@ - integer nrep,nstex,hremd - logical remd_tlist,remd_mlist,mremdsync,restart1file,traj1file - double precision retmin,retmax,remd_t(maxprocs) - double precision hweights(maxprocs/20,n_ene) - integer remd_m(maxprocs),i_sync_step - integer*2 i2rep(0:maxprocs),i2set(0:maxprocs) - integer*2 ifirst(maxprocs) - integer*2 nupa(0:maxprocs/4,0:maxprocs), - & ndowna(0:maxprocs/4,0:maxprocs) - real t_restart1(5,maxprocs) - integer iset_restart1(maxprocs) - logical t_exchange_only - common /remdcommon/ nrep,nstex,retmin,retmax,remd_t,remd_tlist, - & remd_mlist,remd_m,mremdsync,restart1file, - & traj1file,i_sync_step,t_exchange_only - common /hamilt_remd/ hweights,hremd - common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, - & iset_restart1 - real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache,uscdiff_cache, - & ugamma_cache,utheta_cache - integer ntwx_cache,ii_write,max_cache_traj_use - common /traj1cache/ totT_cache(max_cache_traj), - & EK_cache(max_cache_traj), - & potE_cache(max_cache_traj), - & t_bath_cache(max_cache_traj), - & Uconst_cache(max_cache_traj), - & qfrag_cache(50,max_cache_traj), - & qpair_cache(100,max_cache_traj), - & ugamma_cache(maxfrag_back,max_cache_traj), - & utheta_cache(maxfrag_back,max_cache_traj), - & uscdiff_cache(maxfrag_back,max_cache_traj), - & c_cache(3,maxres2+2,max_cache_traj), - & iset_cache(max_cache_traj),ntwx_cache, - & ii_write,max_cache_traj_use - diff --git a/source/unres/src_MD-restraints/COMMON.SBRIDGE b/source/unres/src_MD-restraints/COMMON.SBRIDGE deleted file mode 100644 index 91dd2cd..0000000 --- a/source/unres/src_MD-restraints/COMMON.SBRIDGE +++ /dev/null @@ -1,17 +0,0 @@ - double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss - integer ns,nss,nfree,iss - common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, - & ns,nss,nfree,iss(maxss) - double precision dhpb,dhpb1,forcon - integer ihpb,jhpb,nhpb,idssb,jdssb - common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), - & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb - double precision weidis - common /restraints/ weidis - integer link_start,link_end - common /links_split/ link_start,link_end - double precision Ht,dyn_ssbond_ij - logical dyn_ss,dyn_ss_mask - common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), - & idssb(maxdim),jdssb(maxdim), - & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/unres/src_MD-restraints/COMMON.SCCOR b/source/unres/src_MD-restraints/COMMON.SCCOR deleted file mode 100644 index 8de6d3c..0000000 --- a/source/unres/src_MD-restraints/COMMON.SCCOR +++ /dev/null @@ -1,17 +0,0 @@ -cc Parameters of the SCCOR term - double precision v1sccor,v2sccor,vlor1sccor, - & vlor2sccor,vlor3sccor,gloc_sc, - & dcostau,dsintau,dtauangle,dcosomicron, - & domicron,v0sccor - integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor - common/sccor/v1sccor(maxterm_sccor,3,20,20), - & v2sccor(maxterm_sccor,3,20,20), - & vlor1sccor(maxterm_sccor,20,20), - & vlor2sccor(maxterm_sccor,20,20), - & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), - & v0sccor(ntyp,ntyp), - & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), - & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), - & domicron(3,3,3,maxres2), - & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp, - & nlor_sccor(ntyp,ntyp) diff --git a/source/unres/src_MD-restraints/COMMON.SCROT b/source/unres/src_MD-restraints/COMMON.SCROT deleted file mode 100644 index 2da7b8f..0000000 --- a/source/unres/src_MD-restraints/COMMON.SCROT +++ /dev/null @@ -1,3 +0,0 @@ -C Parameters of the SC rotamers (local) term - double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) diff --git a/source/unres/src_MD-restraints/COMMON.SETUP b/source/unres/src_MD-restraints/COMMON.SETUP deleted file mode 100644 index 5039116..0000000 --- a/source/unres/src_MD-restraints/COMMON.SETUP +++ /dev/null @@ -1,21 +0,0 @@ - integer king,idint,idreal,idchar,is_done - parameter (king=0,idint=1105,idreal=1729,idchar=1597,is_done=1) - integer me,cg_rank,fg_rank,fg_rank1,nodes,Nprocs,nfgtasks,kolor, - & koniec(0:maxprocs-1),WhatsUp,ifinish(maxprocs-1),CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp(0:maxprocs-1), - & kolor1,key1,nfgtasks1,MyRank, - & max_gs_size - logical yourjob, finished, cgdone - common/setup/me,MyRank,cg_rank,fg_rank,fg_rank1,nodes,Nprocs, - & nfgtasks,nfgtasks1, - & max_gs_size,kolor,koniec,WhatsUp,ifinish,CG_COMM,FG_COMM, - & FG_COMM1,CONT_FROM_COMM,CONT_TO_COMM,lentyp - integer MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1(0:1),MPI_ROTAT2(0:1),MPI_ROTAT_OLD(0:1), - & MPI_PRECOMP11(0:1),MPI_PRECOMP12(0:1),MPI_PRECOMP22(0:1), - & MPI_PRECOMP23(0:1) - common /types/ MPI_UYZ,MPI_UYZGRAD,MPI_MU,MPI_MAT1,MPI_MAT2, - & MPI_THET,MPI_GAM, - & MPI_ROTAT1,MPI_ROTAT2,MPI_ROTAT_OLD,MPI_PRECOMP11,MPI_PRECOMP12, - & MPI_PRECOMP22,MPI_PRECOMP23 diff --git a/source/unres/src_MD-restraints/COMMON.SPLITELE b/source/unres/src_MD-restraints/COMMON.SPLITELE deleted file mode 100644 index a2f0447..0000000 --- a/source/unres/src_MD-restraints/COMMON.SPLITELE +++ /dev/null @@ -1,2 +0,0 @@ - double precision r_cut,rlamb - common /splitele/ r_cut,rlamb diff --git a/source/unres/src_MD-restraints/COMMON.THREAD b/source/unres/src_MD-restraints/COMMON.THREAD deleted file mode 100644 index 5c814cc..0000000 --- a/source/unres/src_MD-restraints/COMMON.THREAD +++ /dev/null @@ -1,7 +0,0 @@ - integer nthread,nexcl,iexam,ipatt - double precision ener0,ener,max_time_for_thread, - & ave_time_for_thread - common /thread/ nthread,nexcl,iexam(2,maxthread), - & ipatt(2,maxthread) - common /thread1/ ener0(n_ene+2,maxthread),ener(n_ene+2,maxthread), - & max_time_for_thread,ave_time_for_thread diff --git a/source/unres/src_MD-restraints/COMMON.TIME1 b/source/unres/src_MD-restraints/COMMON.TIME1 deleted file mode 100644 index d6203a6..0000000 --- a/source/unres/src_MD-restraints/COMMON.TIME1 +++ /dev/null @@ -1,28 +0,0 @@ - DOUBLE PRECISION BATIME,TIMLIM,STIME,PREVTIM,SAFETY - DOUBLE PRECISION WALLTIME - INTEGER ISTOP -c FOUND_NAN - set by calcf to stop sumsl via stopx - logical FOUND_NAN - COMMON/TIME1/STIME,TIMLIM,BATIME,PREVTIM,SAFETY,WALLTIME - COMMON/STOPTIM/ISTOP - common /sumsl_flag/ FOUND_NAN - double precision t_init,t_MDsetup,t_langsetup,t_MD, - & t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_barrier_e,time_barrier_g,time_scatter, - & t_eelecij,time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_scatter_fmat,time_scatter_ginv, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_stoch,t_eshort,t_elong,t_etotal - common /timing/ t_init,t_MDsetup,t_langsetup, - & t_MD,t_enegrad,t_sdsetup,time_bcast,time_reduce,time_gather, - & time_sendrecv,time_scatter,time_barrier_e,time_barrier_g, - & time_bcast7,time_bcastc,time_bcastw,time_allreduce, - & t_eelecij,time_enecalc,time_sumene,time_lagrangian,time_cartgrad, - & time_sumgradient,time_intcartderiv,time_inttocart,time_intfcart, - & time_vec,time_mat,time_ginvmult,time_fricmatmult,time_fric, - & time_fsample,time_scatter_fmatmult,time_scatter_ginvmult, - & time_scatter_fmat,time_scatter_ginv, - & time_stoch,t_eshort,t_elong,t_etotal diff --git a/source/unres/src_MD-restraints/COMMON.TORCNSTR b/source/unres/src_MD-restraints/COMMON.TORCNSTR deleted file mode 100644 index e4af17c..0000000 --- a/source/unres/src_MD-restraints/COMMON.TORCNSTR +++ /dev/null @@ -1,6 +0,0 @@ - integer ndih_constr,idih_constr(maxdih_constr) - integer ndih_nconstr,idih_nconstr(maxdih_constr) - integer idihconstr_start,idihconstr_end - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end diff --git a/source/unres/src_MD-restraints/COMMON.TORSION b/source/unres/src_MD-restraints/COMMON.TORSION deleted file mode 100644 index 6b6605f..0000000 --- a/source/unres/src_MD-restraints/COMMON.TORSION +++ /dev/null @@ -1,23 +0,0 @@ -C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), - & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor),nlor(maxtor,maxtor) - & ,nterm_old -C 6/23/01 - constants for double torsionals - double precision v1c,v1s,v2c,v2s - integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) -C 9/18/99 - added Fourier coeffficients of the expansion of local energy -C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp diff --git a/source/unres/src_MD-restraints/COMMON.VAR b/source/unres/src_MD-restraints/COMMON.VAR deleted file mode 100644 index edc81d7..0000000 --- a/source/unres/src_MD-restraints/COMMON.VAR +++ /dev/null @@ -1,21 +0,0 @@ -C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, - & mask_theta,mask_phi,mask_side - double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, - & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,xxref,yyref,zzref,tauangle,omicron - common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & omicron(2,maxres),tauangle(3,maxres), - & vbld(2*maxres),thetaref(maxres),phiref(maxres), - & costtab(maxres), sinttab(maxres), cost2tab(maxres), - & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar -C Store the angles and variables corresponding to old conformations (for use -C in MCM). - common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), - & Origin(maxsave),nstore -C freeze some variables - logical mask_r - common /restr/ varall(maxvar),mask_r,mask_theta(maxres), - & mask_phi(maxres),mask_side(maxres) diff --git a/source/unres/src_MD-restraints/COMMON.VECTORS b/source/unres/src_MD-restraints/COMMON.VECTORS deleted file mode 100644 index d880c24..0000000 --- a/source/unres/src_MD-restraints/COMMON.VECTORS +++ /dev/null @@ -1,3 +0,0 @@ - common /vectors/ uy(3,maxres),uz(3,maxres), - & uygrad(3,3,2,maxres),uzgrad(3,3,2,maxres) - diff --git a/source/unres/src_MD-restraints/DIMENSIONS b/source/unres/src_MD-restraints/DIMENSIONS deleted file mode 100644 index 13b7789..0000000 --- a/source/unres/src_MD-restraints/DIMENSIONS +++ /dev/null @@ -1,142 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - integer maxprocs - parameter (maxprocs=2048) -C Max. number of fine-grain processors - integer max_fg_procs -c parameter (max_fg_procs=maxprocs) - parameter (max_fg_procs=512) -C Max. number of coarse-grain processors - integer max_cg_procs - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=800) -C Appr. max. number of interaction sites - integer maxres2,maxres6,mmaxres2 - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres2=(maxres2*(maxres2+1)/2)) -C Max. number of variables - integer maxvar - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres/4) -c parameter (maxconts=50) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=6) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=10) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=20) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=20) -C Max. number of energy intervals - integer max_ene - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=10) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=10) -C Number of energy components - integer n_ene,n_ene2 - parameter (n_ene=24,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -csaC Maximum number of generated conformations -csa integer mxio -csa parameter (mxio=2) -csaC Maximum number of n7 generated conformations -csa integer mxio2 -csa parameter (mxio2=2) -csaC Maximum number of moves (n1-n8) -csa integer mxmv -csa parameter (mxmv=18) -csaC Maximum number of seed -csa integer max_seed -csa parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) -C Maximum number of backbone fragments in restraining - integer maxfrag_back - parameter (maxfrag_back=4) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) -C Maximum number of conformation stored in cache on each CPU before sending -C to master; depends on nstex / ntwx ratio - integer max_cache_traj - parameter (max_cache_traj=10) -C Nose-Hoover chain - chain length and order of Yoshida algorithm - integer maxmnh,maxyosh - parameter(maxmnh=10,maxyosh=5) -C Maximum number of templates in homology-modeling restraints - integer max_template - parameter(max_template=19) diff --git a/source/unres/src_MD-restraints/DIMENSIONS.2100 b/source/unres/src_MD-restraints/DIMENSIONS.2100 deleted file mode 100644 index 7990793..0000000 --- a/source/unres/src_MD-restraints/DIMENSIONS.2100 +++ /dev/null @@ -1,80 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - parameter (maxprocs=2100) -C Max. number of fine-grain processors - parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - parameter (maxres=150) -C Appr. max. number of interaction sites - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres6=(maxres6*(maxres6+1)/2)) -C Max. number of variables - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - parameter (maxconts=maxres) -C Number of AA types (at present only natural AA's will be handled - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of lobes in SC distribution - parameter (maxlob=4) -C Max. number of S-S bridges - parameter (maxss=20) -C Max. number of dihedral angle constraints - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - parameter (maxres_base=10) -C Max. number of threading attempts - parameter (maxthread=20) -C Max. number of move types in MCM - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - parameter (maxsave=20) -C Max. number of energy intervals - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - parameter (max_cache=10) -C Max. number of conformations in the pool - parameter (max_pool=10) -C Number of energy components - parameter (n_ene=22,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - parameter (mxang=4) -C Maximum number of groups of angles - parameter (mxgr=2*maxres) -C Maximum number of chains - parameter (mxch=1) -C Maximum number of generated conformations - parameter (mxio=2) -C Maximum number of n7 generated conformations - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - parameter (mxmv=18) -C Maximum number of seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) diff --git a/source/unres/src_MD-restraints/DIMENSIONS.4100 b/source/unres/src_MD-restraints/DIMENSIONS.4100 deleted file mode 100644 index 2a68d39..0000000 --- a/source/unres/src_MD-restraints/DIMENSIONS.4100 +++ /dev/null @@ -1,80 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -C Max. number of processors. - parameter (maxprocs=4100) -C Max. number of fine-grain processors - parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors - parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - parameter (maxres=150) -C Appr. max. number of interaction sites - parameter (maxres2=2*maxres,maxres6=6*maxres) - parameter (mmaxres6=(maxres6*(maxres6+1)/2)) -C Max. number of variables - parameter (maxvar=6*maxres) -C Max. number of groups of interactions that a given SC is involved in - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - parameter (maxconts=maxres) -C Number of AA types (at present only natural AA's will be handled - parameter (ntyp=20,ntyp1=ntyp+1) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -C Max. number of lobes in SC distribution - parameter (maxlob=4) -C Max. number of S-S bridges - parameter (maxss=20) -C Max. number of dihedral angle constraints - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - parameter (maxseq=10) -C Max. number of residues in a peptide in the database - parameter (maxres_base=10) -C Max. number of threading attempts - parameter (maxthread=20) -C Max. number of move types in MCM - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - parameter (maxsave=20) -C Max. number of energy intervals - parameter (max_ene=10) -C Max. number of conformations in Master's cache array - parameter (max_cache=10) -C Max. number of conformations in the pool - parameter (max_pool=10) -C Number of energy components - parameter (n_ene=22,n_ene2=2*n_ene) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=4,max_thread2=2*max_thread) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=8,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - parameter (mxang=4) -C Maximum number of groups of angles - parameter (mxgr=2*maxres) -C Maximum number of chains - parameter (mxch=1) -C Maximum number of generated conformations - parameter (mxio=2) -C Maximum number of n7 generated conformations - parameter (mxio2=2) -C Maximum number of moves (n1-n8) - parameter (mxmv=18) -C Maximum number of seed - parameter (max_seed=1) -C Maximum number of timesteps for which stochastic MD matrices can be stored - integer maxflag_stoch - parameter (maxflag_stoch=0) diff --git a/source/unres/src_MD-restraints/MD_A-MTS.F b/source/unres/src_MD-restraints/MD_A-MTS.F deleted file mode 100644 index 95f174d..0000000 --- a/source/unres/src_MD-restraints/MD_A-MTS.F +++ /dev/null @@ -1,3461 +0,0 @@ - subroutine MD -c------------------------------------------------ -c The driver for molecular dynamics subroutines -c------------------------------------------------ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision cm(3),L(3),vcm(3) -#ifdef VOUT - double precision v_work(maxres6),v_transf(maxres6) -#endif - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -c -#ifdef MPI - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_" - & //liczba(:ilen(liczba))//'.rst') -#else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_"//'.rst') -#endif - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - do itime=1,n_timestep - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) - write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) -#ifdef VOUT - do j=1,3 - v_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - v_work(ind)=d_t(j,i+nres) - enddo - endif - enddo - - write (66,'(80f10.5)') - & ((d_t(j,i),j=1,3),i=0,nres-1),((d_t(j,i+nres),j=1,3),i=1,nres) - do i=1,ind - v_transf(i)=0.0d0 - do j=1,ind - v_transf(i)=v_transf(i)+gvec(j,i)*v_work(j) - enddo - v_transf(i)= v_transf(i)*dsqrt(geigen(i)) - enddo - write (67,'(80f10.5)') (v_transf(i),i=1,ind) -#endif - endif - if (mod(itime,ntwx).eq.0) then - write (tytul,'("time",f8.2)') totT - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (rstcount.eq.1000.or.itime.eq.n_timestep) then - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - close(irest2) - rstcount=0 - endif - enddo -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' -#ifdef TIMING_ENE - write (iout,*) "time for etotal",t_etotal," elong",t_elong, - & " eshort",t_eshort - write (iout,*) "time_fric",time_fric," time_stoch",time_stoch, - & " time_fricmatmult",time_fricmatmult," time_fsample ", - & time_fsample -#endif - return - end -c------------------------------------------------------------------------------- - subroutine velverlet_step(itime) -c------------------------------------------------------------------------------- -c Perform a single velocity Verlet step; the time step can be rescaled if -c increments in accelerations exceed the threshold -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror,ierrcode -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.MUCA' - double precision vcm(3),incr(3) - double precision cm(3),L(3) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /20/ - common /gucio/ cm - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - double precision HNose1,HNose,HNose_nh,H,vtnp(maxres6) - double precision vtnp_(maxres6),vtnp_a(maxres6) -c - scale=.true. - icount_scale=0 - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - itime_scal=0 - do while (scale) - icount_scale=icount_scale+1 - if (icount_scale.gt.maxcount_scale) then - write (iout,*) - & "ERROR: too many attempts at scaling down the time step. ", - & "amax=",amax,"epdrift=",epdrift, - & "damax=",damax,"edriftmax=",edriftmax, - & "d_time=",d_time - call flush(iout) -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,IERRCODE) -#endif - stop - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else if (tnp1) then - call tnp1_step1 - else if (tnp) then - call tnp_step1 - else - if (tnh) then - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)*scale_nh - enddo - enddo - endif - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "Cartesian and internal coordinates: step 1" - call cartprint - call intout - write (iout,*) "dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal(potEcomp) -#ifdef TIMING_ENE -#ifdef MPI - t_etotal=t_etotal+MPI_Wtime()-tt0 -#else - t_etotal=t_etotal+tcpu()-tt0 -#endif -#endif - E_old=potE - potE=potEcomp(0)-potEcomp(20) - call cartgrad -c Get the new accelerations - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/(itime_scal+1)**2 - call predict_edrift(epdrift) - if (amax/(itime_scal+1).gt.damax .or. epdrift.gt.edriftmax) then -c Maximum acceleration or maximum predicted energy drift exceeded, rescale the time step - scale=.true. - ifac_time=dmax1(dlog(amax/damax),dlog(epdrift/edriftmax)) - & /dlog(2.0d0)+1 - itime_scal=itime_scal+ifac_time -c fac_time=dmin1(damax/amax,0.5d0) - fac_time=0.5d0**ifac_time - d_time=d_time*fac_time - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 -c write (iout,*) "Calling sd_verlet_setup: 1" -c Rescale the stochastic forces and recalculate or restore -c the matrices of tinker integrator - if (itime_scal.gt.maxflag_stoch) then - if (large) write (iout,'(a,i5,a)') - & "Calculate matrices for stochastic step;", - & " itime_scal ",itime_scal - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - write (iout,'(2a,i3,a,i3,1h.)') - & "Warning: cannot store matrices for stochastic", - & " integration because the index",itime_scal, - & " is greater than",maxflag_stoch - write (iout,'(2a)')"Increase MAXFLAG_STOCH or use direct", - & " integration Langevin algorithm for better efficiency." - else if (flag_stoch(itime_scal)) then - if (large) write (iout,'(a,i5,a,l1)') - & "Restore matrices for stochastic step; itime_scal ", - & itime_scal," flag ",flag_stoch(itime_scal) - do i=1,dimen3 - do j=1,dimen3 - pfric_mat(i,j)=pfric0_mat(i,j,itime_scal) - afric_mat(i,j)=afric0_mat(i,j,itime_scal) - vfric_mat(i,j)=vfric0_mat(i,j,itime_scal) - prand_mat(i,j)=prand0_mat(i,j,itime_scal) - vrand_mat1(i,j)=vrand0_mat1(i,j,itime_scal) - vrand_mat2(i,j)=vrand0_mat2(i,j,itime_scal) - enddo - enddo - else - if (large) write (iout,'(2a,i5,a,l1)') - & "Calculate & store matrices for stochastic step;", - & " itime_scal ",itime_scal," flag ",flag_stoch(itime_scal) - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - flag_stoch(ifac_time)=.true. - do i=1,dimen3 - do j=1,dimen3 - pfric0_mat(i,j,itime_scal)=pfric_mat(i,j) - afric0_mat(i,j,itime_scal)=afric_mat(i,j) - vfric0_mat(i,j,itime_scal)=vfric_mat(i,j) - prand0_mat(i,j,itime_scal)=prand_mat(i,j) - vrand0_mat1(i,j,itime_scal)=vrand_mat1(i,j) - vrand0_mat2(i,j,itime_scal)=vrand_mat2(i,j) - enddo - enddo - endif - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen3 - stochforcvec(i)=fac_time*stochforcvec(i) - enddo -#endif - else if (lang.eq.1) then -c Rescale the accelerations due to stochastic forces - fac_time=1.0d0/dsqrt(fac_time) - do i=1,dimen3 - d_as_work(i)=d_as_work(i)*fac_time - enddo - endif - if (large) write (iout,'(a,i10,a,f8.6,a,i3,a,i3)') - & "itime",itime," Timestep scaled down to ", - & d_time," ifac_time",ifac_time," itime_scal",itime_scal - else -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else if (tnp1) then - call tnp1_step2 - else if (tnp) then - call tnp_step2 - else - call verlet2 - if (tnh) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - endif - if (rattle) call rattle2 - totT=totT+d_time - if (d_time.ne.d_time0) then - d_time=d_time0 -#ifndef LANG0 - if (lang.eq.2 .or. lang.eq.3) then - if (large) write (iout,'(a)') - & "Restore original matrices for stochastic step" -c write (iout,*) "Calling sd_verlet_setup: 2" -c Restore the matrices of tinker integrator if the time step has been restored - do i=1,dimen3 - do j=1,dimen3 - pfric_mat(i,j)=pfric0_mat(i,j,0) - afric_mat(i,j)=afric0_mat(i,j,0) - vfric_mat(i,j)=vfric0_mat(i,j,0) - prand_mat(i,j)=prand0_mat(i,j,0) - vrand_mat1(i,j)=vrand0_mat1(i,j,0) - vrand_mat2(i,j)=vrand0_mat2(i,j,0) - enddo - enddo - endif -#endif - endif - scale=.false. - endif - enddo -c Calculate the kinetic and the total energy and the kinetic temperature - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - d_t(j,i)=d_t(j,i)/s_np - enddo - enddo - endif - call kinetic(EK) - totE=EK+potE -c diagnostics -c call kinetic1(EK1) -c write (iout,*) "step",itime," EK",EK," EK1",EK1 -c end diagnostics -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) then - - if(tnp .or. tnp1) then - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H=(HNose1-H0)*s_np -cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 -cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H=HNose1-H0 - hhh=h -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - endif - - if (large) then - itnp=0 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,inres) - enddo - endif - enddo - -c Transform velocities from UNRES coordinate space to cartesian and Gvec -c eigenvector space - - do i=1,dimen3 - vtnp_(i)=0.0d0 - vtnp_a(i)=0.0d0 - do j=1,dimen3 - vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j) - vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j) - enddo - vtnp_(i)=vtnp_(i)*dsqrt(geigen(i)) - enddo - - do i=1,dimen3 - write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i) - enddo - - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif - endif - return - end -c------------------------------------------------------------------------------- - subroutine RESPA_step(itime) -c------------------------------------------------------------------------------- -c Perform a single RESPA step. -c------------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision energia_short(0:n_ene), - & energia_long(0:n_ene) - double precision cm(3),L(3),vcm(3),incr(3) - double precision dc_old0(3,0:maxres2),d_t_old0(3,0:maxres2), - & d_a_old0(3,0:maxres2) - integer ilen,count,rstcount - external ilen - character*50 tytul - integer maxcount_scale /10/ - common /gucio/ cm,energia_short - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - integer itime - logical scale - double precision vtnp(maxres6), vtnp_(maxres6), vtnp_a(maxres6) - common /cipiszcze/ itt - itt=itime - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***************** RESPA itime",itime - write (iout,*) "Cartesian and internal coordinates: step 0" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 0" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c -c Perform the initial RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA ini" - if (tnp1) then - call tnp_respa_step1 - else if (tnp) then - call tnp_respa_step1 - else - if (tnh.and..not.xiresp) then - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - call RESPA_vel - endif - -cd if(tnp .or. tnp1) then -cd write (iout,'(a,3f)') "EE1 NP S, pi",totT, s_np, pi_np -cd endif - - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the short-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif -C 7/2/2009 commented out -c call zerograd -c call etotal_short(energia_short) - if (tnp.or.tnp1) potE=energia_short(0) -c call cartgrad -c call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces from previous MD step - do i=0,2*nres - do j=1,3 - d_a(j,i)=d_a_short(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo -c 6/30/08 A-MTS: attempt at increasing the split number - do i=0,2*nres - do j=1,3 - dc_old0(j,i)=dc_old(j,i) - d_t_old0(j,i)=d_t_old(j,i) - d_a_old0(j,i)=d_a_old(j,i) - enddo - enddo - if (ntime_split.gt.ntime_split0) ntime_split=ntime_split/2 - if (ntime_split.lt.ntime_split0) ntime_split=ntime_split0 -c - scale=.true. - d_time0=d_time - do while (scale) - - scale=.false. -c write (iout,*) "itime",itime," ntime_split",ntime_split -c Split the time step - d_time=d_time0/ntime_split -c Perform the short-range RESPA steps (velocity Verlet increments of -c positions and velocities using short-range forces) -c write (iout,*) "*********************** RESPA split" - do itsplit=1,ntime_split - if (lang.eq.1) then - call sddir_precalc - else if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call stochastic_force(stochforcvec) -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif -c First step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet1 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet1_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet1 - else if (tnp1) then - call tnp1_respa_i_step1 - else if (tnp) then - call tnp_respa_i_step1 - else - if (tnh.and.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8) - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)*scale_nh - enddo - enddo -cd write(iout,*) "SSS1",itsplit,EK,scale_nh - endif - call verlet1 - endif -c Build the chain from the newly calculated coordinates - call chainbuild_cart - if (rattle) call rattle1 - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "***** ITSPLIT",itsplit - write (iout,*) "Cartesian and internal coordinates: step 1" - call pdbout(0.0d0,"cipiszcze",iout) -c call cartprint - call intout - write (iout,*) "Velocities, step 1" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Calculate energy and forces - call zerograd - call etotal_short(energia_short) - E_old=potE - potE=energia_short(0) -#ifdef TIMING_ENE -#ifdef MPI - t_eshort=t_eshort+MPI_Wtime()-tt0 -#else - t_eshort=t_eshort+tcpu()-tt0 -#endif -#endif - call cartgrad -c Get the new accelerations - call lagrangian -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*)"energia_short",energia_short(0) - write (iout,*) "Accelerations from short-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - endif -c 6/30/08 A-MTS -c Determine maximum acceleration and scale down the timestep if needed - call max_accel - amax=amax/ntime_split**2 - call predict_edrift(epdrift) - if (ntwe.gt.0 .and. large .and. mod(itime,ntwe).eq.0) - & write (iout,*) "amax",amax," damax",damax, - & " epdrift",epdrift," epdriftmax",epdriftmax -c Exit loop and try with increased split number if the change of -c acceleration is too big - if (amax.gt.damax .or. epdrift.gt.edriftmax) then - if (ntime_split.lt.maxtime_split) then - scale=.true. - ntime_split=ntime_split*2 - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc_old0(j,i) - d_t_old(j,i)=d_t_old0(j,i) - d_a_old(j,i)=d_a_old0(j,i) - enddo - enddo - write (iout,*) "acceleration/energy drift too large",amax, - & epdrift," split increased to ",ntime_split," itime",itime, - & " itsplit",itsplit - exit - else - write (iout,*) - & "Uh-hu. Bumpy landscape. Maximum splitting number", - & maxtime_split, - & " already reached!!! Trying to carry on!" - endif - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Second step of the velocity Verlet algorithm - if (lang.eq.2) then -#ifndef LANG0 - call sd_verlet2 -#endif - else if (lang.eq.3) then -#ifndef LANG0 - call sd_verlet2_ciccotti -#endif - else if (lang.eq.1) then - call sddir_verlet2 - else if (tnp1) then - call tnp1_respa_i_step2 - else if (tnp) then - call tnp_respa_i_step2 - else - call verlet2 - if (tnh.and.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdtii,wdtii2,wdtii4,wdtii8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo -cd write(iout,*) "SSS2",itsplit,EK,scale_nh - endif - endif - if (rattle) call rattle2 -c Backup the coordinates, velocities, and accelerations - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - if (tnp) d_t(j,i)=d_t(j,i)/s_np - if (tnp1) d_t(j,i)=d_t(j,i)/s_np - enddo - enddo - endif - - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - if(.not.(tnp .or. tnp1)) d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo - enddo - enddo - - enddo ! while scale - -c Restore the time step - d_time=d_time0 -c Compute long-range forces -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_long(energia_long) - E_long=energia_long(0) - potE=energia_short(0)+energia_long(0) -#ifdef TIMING_ENE -#ifdef MPI - t_elong=t_elong+MPI_Wtime()-tt0 -#else - t_elong=t_elong+tcpu()-tt0 -#endif -#endif - call cartgrad - call lagrangian -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif -c Compute accelerations from long-range forces - if (ntwe.ne.0) then - if (large.and. mod(itime,ntwe).eq.0) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Cartesian and internal coordinates: step 2" -c call cartprint - call pdbout(0.0d0,"cipiszcze",iout) - call intout - write (iout,*) "Accelerations from long-range forces" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - write (iout,*) "Velocities, step 2" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - endif -c Compute the final RESPA step (increment velocities) -c write (iout,*) "*********************** RESPA fin" - if (tnp1) then - call tnp_respa_step2 - else if (tnp) then - call tnp_respa_step2 - else - call RESPA_vel - if (tnh.and..not.xiresp) then - call kinetic(EK) - call nhcint(EK,scale_nh,wdti,wdti2,wdti4,wdti8) - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t(j,i)*scale_nh - enddo - enddo - endif - endif - - if (tnp .or. tnp1) then - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_old(j,i)/s_np - enddo - enddo - endif - -c Compute the complete potential energy - do i=0,n_ene - potEcomp(i)=energia_short(i)+energia_long(i) - enddo - potE=potEcomp(0)-potEcomp(20) -c potE=energia_short(0)+energia_long(0) - totT=totT+d_time -c Calculate the kinetic and the total energy and the kinetic temperature - call kinetic(EK) - totE=EK+potE -c Couple the system to Berendsen bath if needed - if (tbf .and. lang.eq.0) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK -c Backup the coordinates, velocities, and accelerations - if (ntwe.ne.0) then - if (mod(itime,ntwe).eq.0 .and. large) then - write (iout,*) "Velocities, end" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - endif - - if (mod(itime,ntwe).eq.0) then - - if(tnp .or. tnp1) then -#ifndef G77 - write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit, - & E_long,energia_short(0) -#else - write (iout,'(a3,7f20.10)') "TTT",EK,s_np,potE,pi_np,Csplit, - & E_long,energia_short(0) -#endif - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H=(HNose1-H0)*s_np -cd write (iout,'(a,10f)') "hhh",EK,s_np,potE,pi_np,H0 -cd & ,EK+potE+pi_np**2/(2*Q_np)+dimen3*0.001986d0*t_bath*log(s_np) -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h -cd write (iout,'(a,3f)') "EE2 NP S, pi",totT, s_np, pi_np - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H=HNose1-H0 -cd write (iout,*) "HHH H=",H,abs(HNose1-H0)/H0 - hhh=h - endif - - - if (large) then - itnp=0 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - itnp=itnp+1 - vtnp(itnp)=d_t(j,inres) - enddo - endif - enddo - -c Transform velocities from UNRES coordinate space to cartesian and Gvec -c eigenvector space - - do i=1,dimen3 - vtnp_(i)=0.0d0 - vtnp_a(i)=0.0d0 - do j=1,dimen3 - vtnp_(i)=vtnp_(i)+Gvec(j,i)*vtnp(j) - vtnp_a(i)=vtnp_a(i)+A(i,j)*vtnp(j) - enddo - vtnp_(i)=vtnp_(i)*dsqrt(geigen(i)) - enddo - - do i=1,dimen3 - write (iout,'("WWW",i3,3f10.5)') i,vtnp(i),vtnp_(i),vtnp_a(i) - enddo - - endif - endif - endif - - - return - end -c--------------------------------------------------------------------- - subroutine RESPA_vel -c First and last RESPA step (incrementing velocities using long-range -c forces). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine verlet1 -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2 - -#ifdef DEBUG - write (iout,*) "VELVERLET1 START: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - do j=1,3 - adt=d_a_old(j,0)*d_time - adt2=0.5d0*adt - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+adt2 - d_t(j,0)=d_t_old(j,0)+adt - enddo - do i=nnt,nct-1 - do j=1,3 - adt=d_a_old(j,i)*d_time - adt2=0.5d0*adt - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+adt2 - d_t(j,i)=d_t_old(j,i)+adt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=d_a_old(j,inres)*d_time - adt2=0.5d0*adt - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+adt2 - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - endif - enddo -#ifdef DEBUG - write (iout,*) "VELVERLET1 END: DC" - do i=0,nres - write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo -#endif - return - end -c--------------------------------------------------------------------- - subroutine verlet2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - do j=1,3 - d_t(j,0)=d_t_new(j,0)+0.5d0*d_a(j,0)*d_time - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+0.5d0*d_a(j,i)*d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+0.5d0*d_a(j,inres)*d_time - enddo - endif - enddo - return - end -c----------------------------------------------------------------- - subroutine sddir_precalc -c Applying velocity Verlet algorithm - step 1 to coordinates - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute friction and stochastic forces -c -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call friction_force -#ifdef MPI - time_fric=time_fric+MPI_Wtime()-time00 - time00=MPI_Wtime() -#else - time_fric=time_fric+tcpu()-time00 - time00=tcpu() -#endif - call stochastic_force(stochforcvec) -#ifdef MPI - time_stoch=time_stoch+MPI_Wtime()-time00 -#else - time_stoch=time_stoch+tcpu()-time00 -#endif -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(fric_work, d_af_work) - call ginv_mult(stochforcvec, d_as_work) - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet1 -c Applying velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. - double precision sqrt13 /0.57735026918962576451d0/ ! 1/sqrt(3) - double precision adt,adt2 -c -c Add the contribution from BOTH friction and stochastic force to the -c coordinates, but ONLY the contribution from the friction forces to velocities -c - do j=1,3 - adt=(d_a_old(j,0)+d_af_work(j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(j)*d_time - dc(j,0)=dc_old(j,0)+(d_t_old(j,0)+adt2)*d_time - d_t_new(j,0)=d_t_old(j,0)+0.5d0*adt - d_t(j,0)=d_t_old(j,0)+adt - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - adt=(d_a_old(j,i)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,i)=dc_old(j,i)+(d_t_old(j,i)+adt2)*d_time - d_t_new(j,i)=d_t_old(j,i)+0.5d0*adt - d_t(j,i)=d_t_old(j,i)+adt - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - adt=(d_a_old(j,inres)+d_af_work(ind+j))*d_time - adt2=0.5d0*adt+sqrt13*d_as_work(ind+j)*d_time - dc(j,inres)=dc_old(j,inres)+(d_t_old(j,inres)+adt2)*d_time - d_t_new(j,inres)=d_t_old(j,inres)+0.5d0*adt - d_t(j,inres)=d_t_old(j,inres)+adt - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine sddir_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),d_as_work1(MAXRES6) - double precision cos60 /0.5d0/, sin60 /0.86602540378443864676d0/ -c Revised 3/31/05 AL: correlation between random contributions to -c position and velocity increments included. -c The correlation coefficients are calculated at low-friction limit. -c Also, friction forces are now not calculated with new velocities. - -c call friction_force - call stochastic_force(stochforcvec) -c -c Compute the acceleration due to friction forces (d_af_work) and stochastic -c forces (d_as_work) -c - call ginv_mult(stochforcvec, d_as_work1) - -c -c Update velocities -c - do j=1,3 - d_t(j,0)=d_t_new(j,0)+(0.5d0*(d_a(j,0)+d_af_work(j)) - & +sin60*d_as_work(j)+cos60*d_as_work1(j))*d_time - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+(0.5d0*(d_a(j,i)+d_af_work(ind+j)) - & +sin60*d_as_work(ind+j)+cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+(0.5d0*(d_a(j,inres) - & +d_af_work(ind+j))+sin60*d_as_work(ind+j) - & +cos60*d_as_work1(ind+j))*d_time - enddo - ind=ind+3 - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine max_accel -c -c Find the maximum difference in the accelerations of the the sites -c at the beginning and the end of the time step. -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision aux(3),accel(3),accel_old(3),dacc - do j=1,3 -c aux(j)=d_a(j,0)-d_a_old(j,0) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - amax=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then -c 7/3/08 changed to asymmetric difference - do j=1,3 -c accel(j)=aux(j)+0.5d0*(d_a(j,i)-d_a_old(j,i)) - accel_old(j)=accel_old(j)+0.5d0*d_a_old(j,i) - accel(j)=accel(j)+0.5d0*d_a(j,i) -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - endif - enddo -c Side chains - do j=1,3 -c accel(j)=aux(j) - accel_old(j)=d_a_old(j,0) - accel(j)=d_a(j,0) - enddo - if (nnt.eq.2) then - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,1) - accel(j)=accel(j)+d_a(j,1) - enddo - endif - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 -c accel(j)=accel(j)+d_a(j,i+nres)-d_a_old(j,i+nres) - accel_old(j)=accel_old(j)+d_a_old(j,i+nres) - accel(j)=accel(j)+d_a(j,i+nres) - enddo - endif - do j=1,3 -c if (dabs(accel(j)).gt.amax) amax=dabs(accel(j)) - if (dabs(accel(j)).gt.dabs(accel_old(j))) then - dacc=dabs(accel(j)-accel_old(j)) - if (dacc.gt.amax) amax=dacc - endif - enddo - do j=1,3 - accel_old(j)=accel_old(j)+d_a_old(j,i) - accel(j)=accel(j)+d_a(j,i) -c aux(j)=aux(j)+d_a(j,i)-d_a_old(j,i) - enddo - enddo - return - end -c--------------------------------------------------------------------- - subroutine predict_edrift(epdrift) -c -c Predict the drift of the potential energy -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MUCA' - double precision epdrift,epdriftij -c Drift of the potential energy - epdrift=0.0d0 - do i=nnt,nct -c Backbone - if (i.lt.nct) then - do j=1,3 - epdriftij=dabs((d_a(j,i)-d_a_old(j,i))*gcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "back",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif -c Side chains - if (itype(i).ne.10) then - do j=1,3 - epdriftij= - & dabs((d_a(j,i+nres)-d_a_old(j,i+nres))*gxcart(j,i)) - if (lmuca) epdriftij=epdriftij*factor -c write (iout,*) "side",i,j,epdriftij - if (epdriftij.gt.epdrift) epdrift=epdriftij - enddo - endif - enddo - epdrift=0.5d0*epdrift*d_time*d_time -c write (iout,*) "epdrift",epdrift - return - end -c----------------------------------------------------------------------- - subroutine verlet_bath -c -c Coupling to the thermostat by using the Berendsen algorithm -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision T_half,fact -c - T_half=2.0d0/(dimen3*Rb)*EK - fact=dsqrt(1.0d0+(d_time/tau_bath)*(t_bath/T_half-1.0d0)) -c write(iout,*) "T_half", T_half -c write(iout,*) "EK", EK -c write(iout,*) "fact", fact - do j=1,3 - d_t(j,0)=fact*d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=fact*d_t(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=fact*d_t(j,inres) - enddo - endif - enddo - return - end -c--------------------------------------------------------- - subroutine init_MD -c Set up the initial conditions of a MD simulation - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - character*16 form - integer IERROR,ERRCODE -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.REMD' - real*8 energia_long(0:n_ene), - & energia_short(0:n_ene),vcm(3),incr(3),E_short - double precision cm(3),L(3),xv,sigv,lowb,highb - double precision varia(maxvar) - character*256 qstr - integer ilen - external ilen - character*50 tytul - logical file_exist - common /gucio/ cm - d_time0=d_time -c write(iout,*) "d_time", d_time -c Compute the standard deviations of stochastic forces for Langevin dynamics -c if the friction coefficients do not depend on surface area - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - endif -c Open the pdb file for snapshotshots -#ifdef MPI - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".pdb") - open(ipdb, - & file=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".pdb") - else -#ifdef NOXDR - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".x") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".x" -#else - if (ilen(tmpdir).gt.0 .and. (me.eq.king .or. .not.traj1file)) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD"// - & liczba(:ilen(liczba))//".cx") - cartname=prefix(:ilen(prefix))//"_MD"//liczba(:ilen(liczba)) - & //".cx" -#endif - endif -#else - if(mdpdb) then - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.pdb") - open(ipdb,file=prefix(:ilen(prefix))//"_MD.pdb") - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_MD.cx") - cartname=prefix(:ilen(prefix))//"_MD.cx" - endif -#endif - if (usampl) then - write (qstr,'(256(1h ))') - ipos=1 - do i=1,nfrag - iq = qinfrag(i,iset)*10 - iw = wfrag(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Frag",qinfrag(i,iset),wfrag(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_f,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo - do i=1,npair - iq = qinpair(i,iset)*10 - iw = wpair(i,iset)/100 - if (iw.gt.0) then - if(me.eq.king.or..not.out1file) - & write (iout,*) "Pair",i,qinpair(i,iset),wpair(i,iset),iq,iw - write (qstr(ipos:ipos+6),'(2h_p,i1,1h_,i1,1h_,i1)') i,iq,iw - ipos=ipos+7 - endif - enddo -c pdbname=pdbname(:ilen(pdbname)-4)//qstr(:ipos-1)//'.pdb' -#ifdef NOXDR -c cartname=cartname(:ilen(cartname)-2)//qstr(:ipos-1)//'.x' -#else -c cartname=cartname(:ilen(cartname)-3)//qstr(:ipos-1)//'.cx' -#endif -c statname=statname(:ilen(statname)-5)//qstr(:ipos-1)//'.stat' - endif - icg=1 - if (rest) then - if (restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) - write (*,*) me," Before broadcast: file_exist",file_exist -#ifdef MPI - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) - write (*,*) me," After broadcast: file_exist",file_exist -#endif -c inquire(file=mremd_rst_name,exist=file_exist) - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state read by master and distributed" - else - if (ilen(tmpdir).gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_' - & //liczba(:ilen(liczba))//'.rst') - inquire(file=rest2name,exist=file_exist) - endif - if(file_exist) then - if(.not.restart1file) then - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial state will be read from file ", - & rest2name(:ilen(rest2name)) - call readrst - endif - call rescale_weights(t_bath) - else - if(me.eq.king.or..not.out1file)then - if (restart1file) then - write(iout,*) "File ",mremd_rst_name(:ilen(mremd_rst_name)), - & " does not exist" - else - write(iout,*) "File ",rest2name(:ilen(rest2name)), - & " does not exist" - endif - write(iout,*) "Initial velocities randomly generated" - endif - call random_vel - totT=0.0d0 - endif - else -c Generate initial velocities - if(me.eq.king.or..not.out1file) - & write(iout,*) "Initial velocities randomly generated" - call random_vel - totT=0.0d0 - endif -c rest2name = prefix(:ilen(prefix))//'.rst' - if(me.eq.king.or..not.out1file)then - write (iout,*) "Initial velocities" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - call flush(iout) -c Zeroing the total angular momentum of the system - write(iout,*) "Calling the zero-angular - & momentum subroutine" - endif - call inertia_tensor -c Getting the potential energy and forces and velocities and accelerations - call vcm_vel(vcm) -c write (iout,*) "velocity of the center of the mass:" -c write (iout,*) (vcm(j),j=1,3) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo -c Removing the velocity of the center of mass - call vcm_vel(vcm) - if(me.eq.king.or..not.out1file)then - write (iout,*) "vcm right after adjustment:" - write (iout,*) (vcm(j),j=1,3) - call flush(iout) - endif - if (.not.rest) then - call chainbuild - if(iranconf.ne.0) then - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SC_move',nft_sc,etot - endif - - if(dccart)then - print *, 'Calling MINIM_DC' - call minim_dc(etot,iretcode,nfun) - else - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - endif - if(me.eq.king.or..not.out1file) - & write(iout,*) 'SUMSL return code is',iretcode,' eval ',nfun - endif - endif - call chainbuild_cart - call kinetic(EK) - if (tbf) then - call verlet_bath - endif - kinetic_T=2.0d0/(dimen3*Rb)*EK - if(me.eq.king.or..not.out1file)then - call cartprint - call intout - endif -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0=tcpu() -#endif - call zerograd - call etotal(potEcomp) -#ifdef TIMING_ENE -#ifdef MPI - t_etotal=t_etotal+MPI_Wtime()-tt0 -#else - t_etotal=t_etotal+tcpu()-tt0 -#endif -#endif - potE=potEcomp(0) - - if(tnp .or. tnp1) then - s_np=1.0 - pi_np=0.0 - HNose1=Hnose(EK,s_np,potE,pi_np,Q_np,t_bath,dimen3) - H0=Hnose1 - write(iout,*) 'H0= ',H0 - endif - - if(tnh) then - HNose1=Hnose_nh(EK,potE) - H0=HNose1 - write (iout,*) 'H0= ',H0 - endif - - if (hmc.gt.0) then - hmc_acc=0 - hmc_etot=potE+EK - if(me.eq.king.or..not.out1file) - & write(iout,*) 'HMC',hmc_etot,potE,EK - do i=1,2*nres - do j=1,3 - dc_hmc(j,i)=dc(j,i) - enddo - enddo - endif - - call cartgrad - call lagrangian - call max_accel - if (amax*d_time .gt. dvmax) then - d_time=d_time*dvmax/amax - if(me.eq.king.or..not.out1file) write (iout,*) - & "Time step reduced to",d_time, - & " because of too large initial acceleration." - endif - if(me.eq.king.or..not.out1file)then - write(iout,*) "Potential energy and its components" - call enerprint(potEcomp) -c write(iout,*) (potEcomp(i),i=0,n_ene) - endif - potE=potEcomp(0)-potEcomp(20) - totE=EK+potE - itime=0 - if (ntwe.ne.0) call statout(itime) - if(me.eq.king.or..not.out1file) - & write (iout,'(/a/3(a25,1pe14.5/))') "Initial:", - & " Kinetic energy",EK," potential energy",potE, - & " total energy",totE," maximum acceleration ", - & amax - if (large) then - write (iout,*) "Initial coordinates" - do i=1,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(c(j,i),j=1,3), - & (c(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial dC" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(dc(j,i),j=1,3), - & (dc(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial velocities" - write (iout,"(13x,' backbone ',23x,' side chain')") - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_t(j,i),j=1,3), - & (d_t(j,i+nres),j=1,3) - enddo - write (iout,*) "Initial accelerations" - do i=0,nres -c write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - write (iout,'(i3,3f15.10,3x,3f15.10)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif - do i=0,2*nres - do j=1,3 - dc_old(j,i)=dc(j,i) - d_t_old(j,i)=d_t(j,i) - d_a_old(j,i)=d_a(j,i) - enddo -c write (iout,*) "dc_old",i,(dc_old(j,i),j=1,3) - enddo - if (RESPA) then -#ifdef MPI - tt0 =MPI_Wtime() -#else - tt0 = tcpu() -#endif - call zerograd - call etotal_short(energia_short) -#ifdef TIMING_ENE -#ifdef MPI - t_eshort=t_eshort+MPI_Wtime()-tt0 -#else - t_eshort=t_eshort+tcpu()-tt0 -#endif -#endif - - if(tnp .or. tnp1) then - E_short=energia_short(0) - HNose1=Hnose(EK,s_np,E_short,pi_np,Q_np,t_bath,dimen3) - Csplit=Hnose1 -c Csplit =110 -c_new_var_csplit Csplit=H0-E_long -c Csplit = H0-energia_short(0) - write(iout,*) 'Csplit= ',Csplit - endif - - - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0), - & " energia_short",energia_short(0), - & " total",energia_long(0)+energia_short(0) - write (iout,*) "Initial fast-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -C 7/2/2009 Copy accelerations due to short-lange forces to an auxiliary array - do i=0,2*nres - do j=1,3 - d_a_short(j,i)=d_a(j,i) - enddo - enddo -#ifdef MPI - tt0=MPI_Wtime() -#else - tt0=tcpu() -#endif - call zerograd - call etotal_long(energia_long) -#ifdef TIMING_ENE -#ifdef MPI - t_elong=t_elong+MPI_Wtime()-tt0 -#else - t_elong=t_elong+tcpu()-tt0 -#endif -#endif - call cartgrad - call lagrangian - if(.not.out1file .and. large) then - write (iout,*) "energia_long",energia_long(0) - write (iout,*) "Initial slow-force accelerations" - do i=0,nres - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3), - & (d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef MPI - t_enegrad=t_enegrad+MPI_Wtime()-tt0 -#else - t_enegrad=t_enegrad+tcpu()-tt0 -#endif - endif - - - - return - end -c----------------------------------------------------------- - subroutine random_vel - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision xv,sigv,lowb,highb -c Generate random velocities from Gaussian distribution of mean 0 and std of KT/m -c First generate velocities in the eigenspace of the G matrix -c write (iout,*) "Calling random_vel dimen dimen3",dimen,dimen3 -c call flush(iout) -c write (iout,*) "RANDOM_VEL dimen",dimen - xv=0.0d0 - ii=0 - do i=1,dimen - do k=1,3 - ii=ii+1 - sigv=dsqrt((Rb*t_bath)/geigen(i)) - lowb=-5*sigv - highb=5*sigv - d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) -c write (iout,*) "i",i," ii",ii," geigen",geigen(i), -c & " d_t_work_new",d_t_work_new(ii) - enddo - enddo - call flush(iout) -c diagnostics -c Ek1=0.0d0 -c ii=0 -c do i=1,dimen -c do k=1,3 -c ii=ii+1 -c Ek1=Ek1+0.5d0*geigen(i)*d_t_work_new(ii)**2 -c enddo -c enddo -c write (iout,*) "Ek from eigenvectors",Ek1 -c end diagnostics -c Transform velocities to UNRES coordinate space - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_t_work(ind)=0.0d0 - do j=1,dimen - d_t_work(ind)=d_t_work(ind) - & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1) - enddo -c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) -c call flush(iout) - enddo - enddo -c Transfer to the d_t vector - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_t(j,i)=d_t_work(ind) - enddo - enddo -c do i=0,nres-1 -c write (iout,*) "d_t",i,(d_t(j,i),j=1,3) -c enddo -c call flush(iout) - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_t(j,i+nres)=d_t_work(ind) - enddo - endif - enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 -c call flush(iout) - return - end -#ifndef LANG0 -c----------------------------------------------------------- - subroutine sd_verlet_p_setup -c Sets up the parameters of stochastic Verlet algorithm - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0 * d_time * d_time - prand_vec(i) = 0.0d0 - vrand_vec1(i) = 0.0d0 - vrand_vec2(i) = 0.0d0 -c -c Analytical expressions when friction coefficient is large -c - else - if (gdt .ge. gdt_radius) then - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = (1.0d0-egdt) / fricgam(i) - afric_vec(i) = (d_time-vfric_vec(i)) / fricgam(i) - pterm = 2.0d0*gdt - 3.0d0 + (4.0d0-egdt)*egdt - vterm = 1.0d0 - egdt**2 - rho = (1.0d0-egdt)**2 / sqrt(pterm*vterm) -c -c Use series expansions when friction coefficient is small -c - else - gdt2 = gdt * gdt - gdt3 = gdt * gdt2 - gdt4 = gdt2 * gdt2 - gdt5 = gdt2 * gdt3 - gdt6 = gdt3 * gdt3 - gdt7 = gdt3 * gdt4 - gdt8 = gdt4 * gdt4 - gdt9 = gdt4 * gdt5 - afric_vec(i) = (gdt2/2.0d0 - gdt3/6.0d0 + gdt4/24.0d0 - & - gdt5/120.0d0 + gdt6/720.0d0 - & - gdt7/5040.0d0 + gdt8/40320.0d0 - & - gdt9/362880.0d0) / fricgam(i)**2 - vfric_vec(i) = d_time - fricgam(i)*afric_vec(i) - pfric_vec(i) = 1.0d0 - fricgam(i)*vfric_vec(i) - pterm = 2.0d0*gdt3/3.0d0 - gdt4/2.0d0 - & + 7.0d0*gdt5/30.0d0 - gdt6/12.0d0 - & + 31.0d0*gdt7/1260.0d0 - gdt8/160.0d0 - & + 127.0d0*gdt9/90720.0d0 - vterm = 2.0d0*gdt - 2.0d0*gdt2 + 4.0d0*gdt3/3.0d0 - & - 2.0d0*gdt4/3.0d0 + 4.0d0*gdt5/15.0d0 - & - 4.0d0*gdt6/45.0d0 + 8.0d0*gdt7/315.0d0 - & - 2.0d0*gdt8/315.0d0 + 4.0d0*gdt9/2835.0d0 - rho = sqrt(3.0d0) * (0.5d0 - 3.0d0*gdt/16.0d0 - & - 17.0d0*gdt2/1280.0d0 - & + 17.0d0*gdt3/6144.0d0 - & + 40967.0d0*gdt4/34406400.0d0 - & - 57203.0d0*gdt5/275251200.0d0 - & - 1429487.0d0*gdt6/13212057600.0d0) - end if -c -c Compute the scaling factors of random terms for the nonzero friction case -c - ktm = 0.5d0*d_time/fricgam(i) - psig = dsqrt(ktm*pterm) / fricgam(i) - vsig = dsqrt(ktm*vterm) - rhoc = dsqrt(1.0d0 - rho*rho) - prand_vec(i) = psig - vrand_vec1(i) = vsig * rho - vrand_vec2(i) = vsig * rhoc - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c -#ifndef LANG0 - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec1,vrand_mat1) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#endif -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine eigtransf1(n,ndim,ab,d,c) - implicit none - integer n,ndim - double precision ab(ndim,ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+ab(k,j,i)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine eigtransf(n,ndim,a,b,d,c) - implicit none - integer n,ndim - double precision a(ndim,n),b(ndim,n),c(ndim,n),d(ndim) - integer i,j,k - do i=1,n - do j=1,n - c(i,j)=0.0d0 - do k=1,n - c(i,j)=c(i,j)+a(i,k)*b(k,j)*d(k) - enddo - enddo - enddo - return - end -c------------------------------------------------------------- - subroutine sd_verlet1 -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2 -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) - -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) - ddt2=ddt2+vrand_mat1(i,j)*stochforcvec(j)+ - & vrand_mat2(i,j)*stochforcvecV(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c----------------------------------------------------------- - subroutine sd_verlet_ciccotti_setup -c Sets up the parameters of stochastic velocity Verlet algorithmi; Ciccotti's -c version - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision emgdt(MAXRES6), - & pterm,vterm,rho,rhoc,vsig, - & pfric_vec(MAXRES6),vfric_vec(MAXRES6), - & afric_vec(MAXRES6),prand_vec(MAXRES6), - & vrand_vec1(MAXRES6),vrand_vec2(MAXRES6) - logical lprn /.false./ - double precision zero /1.0d-8/, gdt_radius /0.05d0/ - double precision ktm -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c -c AL 8/17/04 Code adapted from tinker -c -c Get the frictional and random terms for stochastic dynamics in the -c eigenspace of mass-scaled UNRES friction matrix -c - do i = 1, dimen - write (iout,*) "i",i," fricgam",fricgam(i) - gdt = fricgam(i) * d_time -c -c Stochastic dynamics reduces to simple MD for zero friction -c - if (gdt .le. zero) then - pfric_vec(i) = 1.0d0 - vfric_vec(i) = d_time - afric_vec(i) = 0.5d0*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Analytical expressions when friction coefficient is large -c - else - egdt = dexp(-gdt) - pfric_vec(i) = egdt - vfric_vec(i) = dexp(-0.5d0*gdt)*d_time - afric_vec(i) = 0.5d0*dexp(-0.25d0*gdt)*d_time*d_time - prand_vec(i) = afric_vec(i) - vrand_vec2(i) = vfric_vec(i) -c -c Compute the scaling factors of random terms for the nonzero friction case -c -c ktm = 0.5d0*d_time/fricgam(i) -c psig = dsqrt(ktm*pterm) / fricgam(i) -c vsig = dsqrt(ktm*vterm) -c prand_vec(i) = psig*afric_vec(i) -c vrand_vec2(i) = vsig*vfric_vec(i) - end if - end do - if (lprn) then - write (iout,*) - & "pfric_vec, vfric_vec, afric_vec, prand_vec, vrand_vec1,", - & " vrand_vec2" - do i=1,dimen - write (iout,'(i5,6e15.5)') i,pfric_vec(i),vfric_vec(i), - & afric_vec(i),prand_vec(i),vrand_vec1(i),vrand_vec2(i) - enddo - endif -c -c Transform from the eigenspace of mass-scaled friction matrix to UNRES variables -c - call eigtransf(dimen,maxres2,mt3,mt2,pfric_vec,pfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,vfric_vec,vfric_mat) - call eigtransf(dimen,maxres2,mt3,mt2,afric_vec,afric_mat) - call eigtransf(dimen,maxres2,mt3,mt1,prand_vec,prand_mat) - call eigtransf(dimen,maxres2,mt3,mt1,vrand_vec2,vrand_mat2) -#ifdef MPI - t_sdsetup=t_sdsetup+MPI_Wtime() -#else - t_sdsetup=t_sdsetup+tcpu()-tt0 -#endif - return - end -c------------------------------------------------------------- - subroutine sd_verlet1_ciccotti -c Applying stochastic velocity Verlet algorithm - step 1 to velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6) - common /stochcalc/ stochforcvec - logical lprn /.false./ - -c write (iout,*) "dc_old" -c do i=0,nres -c write (iout,'(i5,3f10.5,5x,3f10.5)') -c & i,(dc_old(j,i),j=1,3),(dc_old(j,i+nres),j=1,3) -c enddo - do j=1,3 - dc_work(j)=dc_old(j,0) - d_t_work(j)=d_t_old(j,0) - d_a_work(j)=d_a_old(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc_work(ind+j)=dc_old(j,i) - d_t_work(ind+j)=d_t_old(j,i) - d_a_work(ind+j)=d_a_old(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc_work(ind+j)=dc_old(j,i+nres) - d_t_work(ind+j)=d_t_old(j,i+nres) - d_a_work(ind+j)=d_a_old(j,i+nres) - enddo - ind=ind+3 - endif - enddo - -#ifndef LANG0 - if (lprn) then - write (iout,*) - & "pfric_mat, vfric_mat, afric_mat, prand_mat, vrand_mat1,", - & " vrand_mat2" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,6e15.5)') i,j,pfric_mat(i,j), - & vfric_mat(i,j),afric_mat(i,j), - & prand_mat(i,j),vrand_mat1(i,j),vrand_mat2(i,j) - enddo - enddo - endif - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - dc_work(i)=dc_work(i)+vfric_mat(i,j)*d_t_work(j) - & +afric_mat(i,j)*d_a_work(j)+prand_mat(i,j)*stochforcvec(j) - ddt1=ddt1+pfric_mat(i,j)*d_t_work(j) - ddt2=ddt2+vfric_mat(i,j)*d_a_work(j) - enddo - d_t_work_new(i)=ddt1+0.5d0*ddt2 - d_t_work(i)=ddt1+ddt2 - enddo -#endif - do j=1,3 - dc(j,0)=dc_work(j) - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_work(ind+j) - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_work(ind+j) - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -c-------------------------------------------------------------------------- - subroutine sd_verlet2_ciccotti -c Calculating the adjusted velocities for accelerations - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision stochforcvec(MAXRES6),stochforcvecV(MAXRES6) - common /stochcalc/ stochforcvec -c -c Compute the stochastic forces which contribute to velocity change -c - call stochastic_force(stochforcvecV) -#ifndef LANG0 - do i=1,dimen - ddt1=0.0d0 - ddt2=0.0d0 - do j=1,dimen - - ddt1=ddt1+vfric_mat(i,j)*d_a_work(j) -c ddt2=ddt2+vrand_mat2(i,j)*stochforcvecV(j) - ddt2=ddt2+vrand_mat2(i,j)*stochforcvec(j) - enddo - d_t_work(i)=d_t_work_new(i)+0.5d0*ddt1+ddt2 - enddo -#endif - do j=1,3 - d_t(j,0)=d_t_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_work(ind+j) - enddo - ind=ind+3 - endif - enddo - return - end -#endif -c------------------------------------------------------ - double precision function HNose(ek,s,e,pi,Q,t_bath,dimenl) - implicit none - double precision ek,s,e,pi,Q,t_bath,Rb - integer dimenl - Rb=0.001986d0 - HNose=ek+e+pi**2/(2*Q)+dimenl*Rb*t_bath*log(s) -c print '(6f15.5,i5,a2,2f15.5)',ek,s,e,pi,Q,t_bath,dimenl,"--", -c & pi**2/(2*Q),dimenl*Rb*t_bath*log(s) - return - end -c----------------------------------------------------------------- - double precision function HNose_nh(eki,e) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MD' - HNose_nh=eki+e+dimen3*Rb*t_bath*xlogs(1)+qmass(1)*vlogs(1)**2/2 - do i=2,nnos - HNose_nh=HNose_nh+qmass(i)*vlogs(i)**2/2+Rb*t_bath*xlogs(i) - enddo -c write(4,'(5e15.5)') -c & vlogs(1),xlogs(1),HNose,eki,e - return - end -c----------------------------------------------------------------- - SUBROUTINE NHCINT(akin,scale,wdti,wdti2,wdti4,wdti8) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MD' - double precision akin,gnkt,dt,aa,gkt,scale - double precision wdti(maxyosh),wdti2(maxyosh), - & wdti4(maxyosh),wdti8(maxyosh) - integer i,iresn,iyosh,inos,nnos1 - - dt=d_time - nnos1=nnos+1 - GKT = Rb*t_bath - GNKT = dimen3*GKT - akin=akin*2 - - -C THIS ROUTINE DOES THE NOSE-HOOVER PART OF THE -C INTEGRATION FROM t=0 TO t=DT/2 -C GET THE TOTAL KINETIC ENERGY - SCALE = 1.D0 -c CALL GETKINP(MASS,VX,VY,VZ,AKIN) -C UPDATE THE FORCES - GLOGS(1) = (AKIN - GNKT)/QMASS(1) -C START THE MULTIPLE TIME STEP PROCEDURE - DO IRESN = 1,NRESN - DO IYOSH = 1,NYOSH -C UPDATE THE THERMOSTAT VELOCITIES - VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH) - DO INOS = 1,NNOS-1 - AA = EXP(-WDTI8(IYOSH)*VLOGS(NNOS1-INOS) ) - VLOGS(NNOS-INOS) = VLOGS(NNOS-INOS)*AA*AA - & + WDTI4(IYOSH)*GLOGS(NNOS-INOS)*AA - ENDDO -C UPDATE THE PARTICLE VELOCITIES - AA = EXP(-WDTI2(IYOSH)*VLOGS(1) ) - SCALE = SCALE*AA -C UPDATE THE FORCES - GLOGS(1) = (SCALE*SCALE*AKIN - GNKT)/QMASS(1) -C UPDATE THE THERMOSTAT POSITIONS - DO INOS = 1,NNOS - XLOGS(INOS) = XLOGS(INOS) + VLOGS(INOS)*WDTI2(IYOSH) - ENDDO -C UPDATE THE THERMOSTAT VELOCITIES - DO INOS = 1,NNOS-1 - AA = EXP(-WDTI8(IYOSH)*VLOGS(INOS+1) ) - VLOGS(INOS) = VLOGS(INOS)*AA*AA - & + WDTI4(IYOSH)*GLOGS(INOS)*AA - GLOGS(INOS+1) = (QMASS(INOS)*VLOGS(INOS)*VLOGS(INOS) - & -GKT)/QMASS(INOS+1) - ENDDO - VLOGS(NNOS) = VLOGS(NNOS) + GLOGS(NNOS)*WDTI4(IYOSH) - ENDDO - ENDDO -C UPDATE THE PARTICLE VELOCITIES -c outside of this subroutine -c DO I = 1,N -c VX(I) = VX(I)*SCALE -c VY(I) = VY(I)*SCALE -c VZ(I) = VZ(I)*SCALE -c ENDDO - RETURN - END -c----------------------------------------------------------------- - subroutine tnp1_respa_i_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c JPSJ 70 75 (2001) S. Nose -c -c d_t is not updated here -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2,tmp - - tmp=1+pi_np/(2*Q_np)*0.5*d_time - s12_np=s_np*tmp**2 - pistar=pi_np/tmp - s12_dt=d_time/s12_np - d_time_s12=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt - enddo - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine tnp1_respa_i_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s12 - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s12_np**2 - - d_time_s12=0.5d0*s12_np*d_time - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12 - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12 - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12 - enddo - endif - enddo - - pistar=pistar+(EK-0.5*(E_old+potE) - & -dimen3*Rb*t_bath*log(s12_np)+Csplit-dimen3*Rb*t_bath)*d_time - tmp=1+pistar/(2*Q_np)*0.5*d_time - s_np=s12_np*tmp**2 - pi_np=pistar/tmp - - return - end -c------------------------------------------------------- - - subroutine tnp1_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c JPSJ 70 75 (2001) S. Nose -c -c d_t is not updated here -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision adt,adt2,tmp - - tmp=1+pi_np/(2*Q_np)*0.5*d_time - s12_np=s_np*tmp**2 - pistar=pi_np/tmp - s12_dt=d_time/s12_np - d_time_s12=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s12 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*s12_dt - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s12 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*s12_dt - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s12 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*s12_dt - enddo - endif - enddo - return - end -c--------------------------------------------------------------------- - subroutine tnp1_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s12 - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s12_np**2 - - d_time_s12=0.5d0*s12_np*d_time - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s12 - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s12 - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s12 - enddo - endif - enddo - -cd write(iout,*) 'pistar',pistar,EK,E_old,potE,s12_np - pistar=pistar+(EK-0.5*(E_old+potE) - & -dimen3*Rb*t_bath*log(s12_np)+H0-dimen3*Rb*t_bath)*d_time - tmp=1+pistar/(2*Q_np)*0.5*d_time - s_np=s12_np*tmp**2 - pi_np=pistar/tmp - - return - end - -c----------------------------------------------------------------- - subroutine tnp_respa_i_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - - d_time_s=d_time*0.5*s_np -ct2 d_time_s=d_time*0.5*s12_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s - enddo - endif - enddo - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s_np**2 - - C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-Csplit) - & -pi_np - - pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) - tmp=0.5*d_time*pistar/Q_np - s12_np=s_np*(1.0+tmp)/(1.0-tmp) - - d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np) -ct2 d_time_ss=d_time/s12_np -c d_time_ss=0.5*d_time*(1.0/sold_np+1.0/s_np) - - do j=1,3 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss - enddo - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss - enddo - endif - enddo - - return - end -c--------------------------------------------------------------------- - - subroutine tnp_respa_i_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - - EK=EK*(s_np/s12_np)**2 - HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) - pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath - & -HNose1+Csplit) - -cr print '(a,5f)','i_step2',EK,potE,HNose1,pi_np,E_long - d_time_s=d_time*0.5*s12_np -c d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - s_np=s12_np - - return - end -c----------------------------------------------------------------- - subroutine tnp_respa_step1 -c Applying Nose-Poincare algorithm - step 1 to vel for RESPA -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - double precision energia(0:n_ene) - - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - -c C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0) -c & -pi_np -c -c pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) -c tmp=0.5*d_time*pistar/Q_np -c s12_np=s_np*(1.0+tmp)/(1.0-tmp) -c write(iout,*) 'tnp_respa_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp - -ct1 pi_np=pistar -c sold_np=s_np -c s_np=s12_np - -c------------------------------------- -c test of reviewer's comment - pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0) -cr print '(a,3f)','1 pi_np,s_np',pi_np,s_np,E_long -c------------------------------------- - - return - end -c--------------------------------------------------------------------- - subroutine tnp_respa_step2 -c Step 2 of the velocity Verlet algorithm: update velocities for RESPA - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - -ct1 s12_np=s_np -ct2 pistar=pi_np - -ct call kinetic(EK) -ct HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) -ct pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath) -ct & -0.5*d_time*(HNose1-H0) - -c------------------------------------- -c test of reviewer's comment - pi_np=pi_np-0.5*d_time*(E_long+Csplit-H0) -cr print '(a,3f)','2 pi_np,s_np',pi_np,s_np,E_long -c------------------------------------- - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_old(j,0)=d_t_old(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_old(j,i)=d_t_old(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_old(j,inres)=d_t_old(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - -cd s_np=s12_np - - return - end -c--------------------------------------------------------------------- - subroutine tnp_step1 -c Applying Nose-Poincare algorithm - step 1 to coordinates -c J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird -c -c d_t is not updated here, it is destroyed -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision C_np,d_time_s,tmp,d_time_ss - - d_time_s=d_time*0.5*s_np - - do j=1,3 - d_t_new(j,0)=d_t_old(j,0)+d_a_old(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t_new(j,i)=d_t_old(j,i)+d_a_old(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t_new(j,inres)=d_t_old(j,inres)+d_a_old(j,inres)*d_time_s - enddo - endif - enddo - - do i=0,2*nres - do j=1,3 - d_t(j,i)=d_t_new(j,i) - enddo - enddo - - call kinetic(EK) - EK=EK/s_np**2 - - C_np=0.5*d_time*(dimen3*Rb*t_bath*(1.0+log(s_np))-EK+potE-H0) - & -pi_np - - pistar=-2.0*C_np/(1.0+sqrt(1.0-C_np*d_time/Q_np)) - tmp=0.5*d_time*pistar/Q_np - s12_np=s_np*(1.0+tmp)/(1.0-tmp) -c write(iout,*) 'tnp_step1',s_np,s12_np,EK,potE,C_np,pistar,tmp - - d_time_ss=0.5*d_time*(1.0/s12_np+1.0/s_np) - - do j=1,3 - dc(j,0)=dc_old(j,0)+d_t_new(j,0)*d_time_ss - enddo - do i=nnt,nct-1 - do j=1,3 - dc(j,i)=dc_old(j,i)+d_t_new(j,i)*d_time_ss - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - dc(j,inres)=dc_old(j,inres)+d_t_new(j,inres)*d_time_ss - enddo - endif - enddo - - return - end -c----------------------------------------------------------------- - subroutine tnp_step2 -c Step 2 of the velocity Verlet algorithm: update velocities - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision d_time_s - - EK=EK*(s_np/s12_np)**2 - HNose1=Hnose(EK,s12_np,potE,pistar,Q_np,t_bath,dimen3) - pi_np=pistar+0.5*d_time*(2*EK-dimen3*Rb*t_bath) - & -0.5*d_time*(HNose1-H0) - -cd write(iout,'(a,4f)') 'mmm',EK,potE,HNose1,pi_np - d_time_s=d_time*0.5*s12_np - - do j=1,3 - d_t(j,0)=d_t_new(j,0)+d_a(j,0)*d_time_s - enddo - do i=nnt,nct-1 - do j=1,3 - d_t(j,i)=d_t_new(j,i)+d_a(j,i)*d_time_s - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - inres=i+nres - do j=1,3 - d_t(j,inres)=d_t_new(j,inres)+d_a(j,inres)*d_time_s - enddo - endif - enddo - - s_np=s12_np - - return - end - - subroutine hmc_test(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.CHAIN' - - hmc_acc=hmc_acc+1 - delta=-(potE+EK-hmc_etot)/(Rb*t_bath) - if (delta .lt. -50.0d0) then - delta=0.0d0 - else - delta=dexp(delta) - endif - xxx=ran_number(0.0d0,1.0d0) - - if (me.eq.king .or. .not. out1file) - & write(iout,'(a8,i5,6f10.4)') - & 'HMC',itime,potE+EK,potE,EK,hmc_etot,delta,xxx - - if (delta .le. xxx) then - do i=1,2*nres - do j=1,3 - dc(j,i)=dc_hmc(j,i) - enddo - enddo - itime=itime-hmc - totT=totThmc - else - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'HMC accepting new' - totThmc=totT - do i=1,2*nres - do j=1,3 - dc_hmc(j,i)=dc(j,i) - enddo - enddo - endif - - call chainbuild_cart - call random_vel - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - call etotal(potEcomp) - potE=potEcomp(0) - hmc_etot=potE+EK - if (me.eq.king .or. .not. out1file) - & write(iout,'(a8,i5,3f10.4)')'HMC new',itime,potE+EK,potE,EK - - - return - end diff --git a/source/unres/src_MD-restraints/MP.F b/source/unres/src_MD-restraints/MP.F deleted file mode 100644 index b08897c..0000000 --- a/source/unres/src_MD-restraints/MP.F +++ /dev/null @@ -1,516 +0,0 @@ -#ifdef MPI - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - logical lprn /.false./ -c real*8 text1 /'group_i '/,text2/'group_f '/, -c & text3/'initialb'/,text4/'initiale'/, -c & text5/'openb'/,text6/'opene'/ - integer cgtasks(0:max_cg_procs) - character*3 cfgprocs - integer cg_size,fg_size,fg_size1 -c start parallel processing -c print *,'Initializing MPI' - call mpi_init(ierr) - if (ierr.ne.0) then - print *, ' cannot initialize MPI' - stop - endif -c determine # of nodes and current node - call MPI_Comm_rank( MPI_COMM_WORLD, me, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine rank of all processes' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif - call MPI_Comm_size( MPI_Comm_world, nodes, ierr ) - if (ierr.ne.0) then - print *, ' cannot determine number of processes' - stop - endif - Nprocs=nodes - MyRank=me -C Determine the number of "fine-grain" tasks - call getenv_loc("FGPROCS",cfgprocs) - read (cfgprocs,'(i3)') nfgtasks - if (nfgtasks.eq.0) nfgtasks=1 - call getenv_loc("MAXGSPROCS",cfgprocs) - read (cfgprocs,'(i3)') max_gs_size - if (max_gs_size.eq.0) max_gs_size=2 - if (lprn) - & print *,"Processor",me," nfgtasks",nfgtasks, - & " max_gs_size",max_gs_size - if (nfgtasks.eq.1) then - CG_COMM = MPI_COMM_WORLD - fg_size=1 - fg_rank=0 - nfgtasks1=1 - fg_rank1=0 - else - nodes=nprocs/nfgtasks - if (nfgtasks*nodes.ne.nprocs) then - write (*,'(a)') 'ERROR: Number of processors assigned', - & ' to coarse-grained tasks must be divisor', - & ' of the total number of processors.' - call MPI_Finalize( MPI_COMM_WORLD, IERR ) - stop - endif -C Put the ranks of coarse-grain processes in one table and create -C the respective communicator. The processes with ranks "in between" -C the ranks of CG processes will perform fine graining for the CG -C process with the next lower rank. - do i=0,nprocs-1,nfgtasks - cgtasks(i/nfgtasks)=i - enddo - if (lprn) then - print*,"Processor",me," cgtasks",(cgtasks(i),i=0,nodes-1) -c print "(a,i5,a)","Processor",myrank," Before MPI_Comm_group" - endif -c call memmon_print_usage() - call MPI_Comm_group(MPI_COMM_WORLD,world_group,IERR) - call MPI_Group_incl(world_group,nodes,cgtasks,cg_group,IERR) - call MPI_Comm_create(MPI_COMM_WORLD,cg_group,CG_COMM,IERR) - call MPI_Group_rank(cg_group,me,ierr) - call MPI_Group_free(world_group,ierr) - call MPI_Group_free(cg_group,ierr) -c print "(a,i5,a)","Processor",myrank," After MPI_Comm_group" -c call memmon_print_usage() - if (me.ne.MPI_UNDEFINED) call MPI_Comm_Rank(CG_COMM,me,ierr) - if (lprn) print *," Processor",myrank," CG rank",me -C Create communicators containig processes doing "fine grain" tasks. -C The processes within each FG_COMM should have fast communication. - kolor=MyRank/nfgtasks - key=mod(MyRank,nfgtasks) - call MPI_Comm_split(MPI_COMM_WORLD,kolor,key,FG_COMM,ierr) - call MPI_Comm_size(FG_COMM,fg_size,ierr) - if (fg_size.ne.nfgtasks) then - write (*,*) "OOOOps... the number of fg tasks is",fg_size, - & " but",nfgtasks," was requested. MyRank=",MyRank - endif - call MPI_Comm_rank(FG_COMM,fg_rank,ierr) - if (fg_size.gt.max_gs_size) then - kolor1=fg_rank/max_gs_size - key1=mod(fg_rank,max_gs_size) - call MPI_Comm_split(FG_COMM,kolor1,key1,FG_COMM1,ierr) - call MPI_Comm_size(FG_COMM1,nfgtasks1,ierr) - call MPI_Comm_rank(FG_COMM1,fg_rank1,ierr) - else - FG_COMM1=FG_COMM - nfgtasks1=nfgtasks - fg_rank1=fg_rank - endif - endif - if (fg_rank.eq.0) then - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in CG_COMM",me," size of CG_COMM",nodes, - & " size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - else - write (*,*) "Processor",MyRank," out of",nprocs, - & " rank in FG_COMM",fg_rank," size of FG_COMM",fg_size, - & " rank in FG_COMM1",fg_rank1," size of FG_COMM1",nfgtasks1 - endif -C Initialize other variables. -c print '(a)','Before initialize' -c call memmon_print_usage() - call initialize -c print '(a,i5,a)','Processor',myrank,' After initialize' -c call memmon_print_usage() -C Open task-dependent files. -c print '(a,i5,a)','Processor',myrank,' Before openunits' -c call memmon_print_usage() - call openunits -c print '(a,i5,a)','Processor',myrank,' After openunits' -c call memmon_print_usage() - if (me.eq.king .or. fg_rank.eq.0 .and. .not. out1file) - & write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - parallel job.' -c print *,"Processor",myrank," exited OPENUNITS" - return - end -C----------------------------------------------------------------------------- - subroutine finish_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.REMD' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - include 'COMMON.MD' - integer ilen - external ilen -c - call MPI_Barrier(CG_COMM,ierr) - if (nfgtasks.gt.1) - & call MPI_Bcast(-1,1,MPI_INTEGER,king,FG_COMM,IERROR) - time1=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write (iout,'(a,i4,a)') 'CG processor',me,' is finishing work.' - write (iout,*) 'Total wall clock time',time1-walltime,' sec' - if (nfgtasks.gt.1) then - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (iout,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g,"TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - & +time_barrier_e+time_barrier_g - write (*,*) 'Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",me," BROADCAST time",time_bcast, - & " REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter," SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e," BARRIER grad",time_barrier_g - endif - endif - write (*,'(a,i4,a)') 'CG processor',me,' is finishing work.' - if (ilen(tmpdir).gt.0) then - write (*,*) "Processor",me, - & ": moving output files to the parent directory..." - close(inp) - close(istat,status='keep') - if (ntwe.gt.0) call move_from_tmp(statname) - close(irest2,status='keep') - if (modecalc.eq.12.or. - & (modecalc.eq.14 .and. .not.restart1file)) then - call move_from_tmp(rest2name) - else if (modecalc.eq.14.and. me.eq.king) then - call move_from_tmp(mremd_rst_name) - endif - if (mdpdb) then - close(ipdb,status='keep') - call move_from_tmp(pdbname) - else if (me.eq.king .or. .not.traj1file) then - close(icart,status='keep') - call move_from_tmp(cartname) - endif - if (me.eq.king .or. .not. out1file) then - close (iout,status='keep') - call move_from_tmp(outname) - endif - endif - return - end -c------------------------------------------------------------------------- - subroutine pattern_receive - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,ThreadType - logical flag - ThreadType=45 - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - do while (flag) - write (iout,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - write (*,*) 'Processor ',Me,' is receiving threading', - & ' pattern from processor',status(mpi_source) - nexcl=nexcl+1 - call mpi_irecv(iexam(1,nexcl),2,mpi_integer,status(mpi_source), - & ThreadType, CG_COMM,ireq,ierr) - write (iout,*) 'Received pattern:',nexcl,iexam(1,nexcl), - & iexam(2,nexcl) - source=mpi_any_source - call mpi_iprobe(source,ThreadType, - & CG_COMM,flag,status,ierr) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine pattern_send - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer source,ThreadType,ireq - ThreadType=45 - do iproc=0,nprocs-1 - if (iproc.ne.me .and. .not.Koniec(iproc) ) then - call mpi_isend(iexam(1,nexcl),2,mpi_integer,iproc, - & ThreadType, CG_COMM, ireq, ierr) - write (iout,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (*,*) 'CG processor ',me,' has sent pattern ', - & 'to processor',iproc - write (iout,*) 'Pattern:',nexcl,iexam(1,nexcl),iexam(2,nexcl) - endif - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer StopType,StopId,iproc,Kwita,NBytes - StopType=66 -c Kwita=-1 -C print *,'CG processor',me,' StopType=',StopType - Koniec(me)=.true. - if (me.eq.king) then -C Master sends the STOP signal to everybody. - write (iout,'(a,a)') - & 'Master is sending STOP signal to other processors.' - do iproc=1,nprocs-1 - print *,'Koniec(',iproc,')=',Koniec(iproc) - if (.not. Koniec(iproc)) then - call mpi_send(Kwita,1,mpi_integer,iproc,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'Iproc=',iproc,' StopID=',StopID - write (*,*) 'Iproc=',iproc,' StopID=',StopID - endif - enddo - else -C Else send the STOP signal to Master. - call mpi_send(Kwita,1,mpi_integer,MasterID,StopType, - & mpi_comm_world,ierr) - write (iout,*) 'CG processor=',me,' StopID=',StopID - write (*,*) 'CG processor=',me,' StopID=',StopID - endif - return - end -c----------------------------------------------------------------------------- - subroutine recv_stop_sig(Kwita) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.IOUNITS' - integer source,StopType,StopId,iproc,Kwita - logical flag - StopType=66 - Kwita=0 - source=mpi_any_source -c print *,'CG processor:',me,' StopType=',StopType - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - do while (flag) - Koniec(status(mpi_source))=.true. - write (iout,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - write (*,*) 'CG processor ',me,' is receiving STOP signal', - & ' from processor',status(mpi_source) - call mpi_irecv(Kwita,1,mpi_integer,status(mpi_source),StopType, - & mpi_comm_world,ireq,ierr) - call mpi_iprobe(source,StopType, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c----------------------------------------------------------------------------- - subroutine send_MCM_info(ione) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer MCM_info_Type,MCM_info_ID,iproc,one,NBytes - common /aaaa/ isend,irecv - integer nsend - save nsend - nsend=nsend+1 - MCM_info_Type=77 -cd write (iout,'(a,i4,a)') 'CG Processor',me, -cd & ' is sending MCM info to Master.' - write (*,'(a,i4,a,i8)') 'CG processor',me, - & ' is sending MCM info to Master, MCM_info_ID=',MCM_info_ID - call mpi_isend(ione,1,mpi_integer,MasterID, - & MCM_info_Type,mpi_comm_world, MCM_info_ID, ierr) -cd write (iout,*) 'CG processor',me,' has sent info to the master;', -cd & ' MCM_info_ID=',MCM_info_ID - write (*,*) 'CG processor',me,' has sent info to the master;', - & ' MCM_info_ID=',MCM_info_ID,' ierr ',ierr - isend=0 - irecv=0 - return - end -c---------------------------------------------------------------------------- - subroutine receive_MCM_info - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer source,MCM_info_Type,MCM_info_ID,iproc,ione - logical flag - MCM_info_Type=77 - source=mpi_any_source -c print *,'source=',source,' dontcare=',dontcare - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - do while (flag) - source=status(mpi_source) - itask=source/fgProcs+1 -cd write (iout,*) 'Master is receiving MCM info from processor ', -cd & source,' itask',itask - write (*,*) 'Master is receiving MCM info from processor ', - & source,' itask',itask - call mpi_irecv(ione,1,mpi_integer,source,MCM_info_type, - & mpi_comm_world,MCM_info_ID,ierr) -cd write (iout,*) 'Received from processor',source,' IONE=',ione - write (*,*) 'Received from processor',source,' IONE=',ione - nacc_tot=nacc_tot+1 - if (ione.eq.2) nsave_part(itask)=nsave_part(itask)+1 -cd print *,'nsave_part(',itask,')=',nsave_part(itask) -cd write (iout,*) 'Nacc_tot=',Nacc_tot -cd write (*,*) 'Nacc_tot=',Nacc_tot - source=mpi_any_source - call mpi_iprobe(source,MCM_info_Type, - & mpi_comm_world,flag,status,ierr) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine send_thread_results - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer tag,status(MPI_STATUS_SIZE) - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,msglen,nbytes - double precision buffer(20*maxthread+2) - ThreadType=444 - EnerType=555 - ipatt(1,nthread+1)=nthread - ipatt(2,nthread+1)=nexcl - do i=1,nthread - do j=1,n_ene - ener(j,i+nthread)=ener0(j,i) - enddo - enddo - ener(1,2*nthread+1)=max_time_for_thread - ener(2,2*nthread+1)=ave_time_for_thread -C Send the IPATT array - write (iout,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - write (*,*) 'CG processor',me, - & ' is sending IPATT array to master: NTHREAD=',nthread - msglen=2*nthread+2 - call mpi_send(ipatt(1,1),msglen,MPI_INTEGER,MasterID, - & ThreadType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen - write (*,*) 'CG processor',me, - & ' has sent IPATT array to master MSGLEN',msglen -C Send the energies. - msglen=n_ene2*nthread+2 - write (iout,*) 'CG processor',me,' is sending energies to master.' - write (*,*) 'CG processor',me,' is sending energies to master.' - call mpi_send(ener(1,1),msglen,MPI_DOUBLE_PRECISION,MasterID, - & EnerType,mpi_comm_world,ierror) - write (iout,*) 'CG processor',me,' has sent energies to master.' - write (*,*) 'CG processor',me,' has sent energies to master.' - return - end -c---------------------------------------------------------------------------- - subroutine receive_thread_results(iproc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.INFO' - include 'COMMON.THREAD' - include 'COMMON.IOUNITS' - integer ibuffer(2*maxthread+2),ThreadType,ThreadID,EnerType, - & EnerID,ReadyType,ReadyID,Ready,msglen,nbytes,nthread_temp - double precision buffer(20*maxthread+2),max_time_for_thread_t, - & ave_time_for_thread_t - logical flag - ThreadType=444 - EnerType=555 -C Receive the IPATT array - call mpi_probe(iproc,ThreadType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_INTEGER, MSGLEN, IERROR) - write (iout,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - write (*,*) 'Master is receiving IPATT array from processor:', - & iproc,' MSGLEN',msglen - call mpi_recv(ipatt(1,nthread+1),msglen,mpi_integer,iproc, - & ThreadType, - & mpi_comm_world,status,ierror) - write (iout,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - write (*,*) 'Master has received IPATT array from processor:', - & iproc,' MSGLEN=',msglen - nthread_temp=ipatt(1,nthread+msglen/2) - nexcl_temp=ipatt(2,nthread+msglen/2) -C Receive the energies. - call mpi_probe(iproc,EnerType, - & mpi_comm_world,status,ierr) - call MPI_GET_COUNT(STATUS, MPI_DOUBLE_PRECISION, MSGLEN, IERROR) - write (iout,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - write (*,*) 'Master is receiving energies from processor:', - & iproc,' MSGLEN=',MSGLEN - call mpi_recv(ener(1,nthread+1),msglen, - & MPI_DOUBLE_PRECISION,iproc, - & EnerType,MPI_COMM_WORLD,status,ierror) - write (iout,*) 'Msglen=',Msglen - write (*,*) 'Msglen=',Msglen - write (iout,*) 'Master has received energies from processor',iproc - write (*,*) 'Master has received energies from processor',iproc - write (iout,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - write (*,*) 'NTHREAD_TEMP=',nthread_temp,' NEXCL=',nexcl_temp - do i=1,nthread_temp - do j=1,n_ene - ener0(j,nthread+i)=ener(j,nthread+nthread_temp+i) - enddo - enddo - max_time_for_thread_t=ener(1,nthread+2*nthread_temp+1) - ave_time_for_thread_t=ener(2,nthread+2*nthread_temp+1) - write (iout,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (iout,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - write (*,*) 'MAX_TIME_FOR_THREAD:',max_time_for_thread_t - write (*,*) 'AVE_TIME_FOR_THREAD:',ave_time_for_thread_t - if (max_time_for_thread_t.gt.max_time_for_thread) - & max_time_for_thread=max_time_for_thread_t - ave_time_for_thread=(nthread*ave_time_for_thread+ - & nthread_temp*ave_time_for_thread_t)/(nthread+nthread_temp) - nthread=nthread+nthread_temp - return - end -#else - subroutine init_task - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SETUP' - me=0 - myrank=0 - fg_rank=0 - fg_size=1 - nodes=1 - nprocs=1 - call initialize - call openunits - write (iout,'(80(1h*)/a/80(1h*))') - & 'United-residue force field calculation - serial job.' - return - end -#endif diff --git a/source/unres/src_MD-restraints/MREMD.F b/source/unres/src_MD-restraints/MREMD.F deleted file mode 100644 index be6af9c..0000000 --- a/source/unres/src_MD-restraints/MREMD.F +++ /dev/null @@ -1,2117 +0,0 @@ -#ifdef MPI - subroutine MREMD - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.MUCA' - integer ERRCODE - double precision cm(3),L(3),vcm(3) - double precision energia(0:n_ene) - double precision remd_t_bath(maxprocs) - integer iremd_iset(maxprocs) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - double precision remd_ene(0:n_ene+4,maxprocs),t_bath_old - integer iremd_acc(maxprocs),iremd_tot(maxprocs) - integer iremd_acc_usa(maxprocs),iremd_tot_usa(maxprocs) - integer ilen,rstcount - external ilen - character*50 tytul - common /gucio/ cm - integer itime -cold integer nup(0:maxprocs),ndown(0:maxprocs) - integer rep2i(0:maxprocs),ireqi(maxprocs) - integer icache_all(maxprocs) - integer status(MPI_STATUS_SIZE),statusi(MPI_STATUS_SIZE,maxprocs) - logical synflag,end_of_run,file_exist /.false./,ovrtim - real ene_tol /1.0e-5/ - -cdeb imin_itime_old=0 - ntwx_cache=0 - time00=MPI_WTIME() - time01=time00 - if(me.eq.king.or..not.out1file) then - write (iout,*) 'MREMD',nodes,'time before',time00-walltime - write (iout,*) "NREP=",nrep - endif - - synflag=.false. - if (ilen(tmpdir).gt.0 .and. (me.eq.king)) then - call copy_to_tmp(pref_orig(:ilen(pref_orig))//"_mremd.rst") - endif - mremd_rst_name=prefix(:ilen(prefix))//"_mremd.rst" - -cd print *,'MREMD',nodes -cd print *,'mmm',me,remd_mlist,(remd_m(i),i=1,nrep) -cde write (iout,*) "Start MREMD: me",me," t_bath",t_bath - - if(hremd.gt.0) then - nset=hremd - do i=1,nset - mset(i)=1 - enddo - endif - - k=0 - rep2i(k)=-1 - do il=1,max0(nset,1) - do il1=1,max0(mset(il),1) - do i=1,nrep - iremd_acc(i)=0 - iremd_acc_usa(i)=0 - iremd_tot(i)=0 - do j=1,remd_m(i) - i2rep(k)=i - i2set(k)=il - rep2i(i)=k - k=k+1 - i_index(i,j,il,il1)=k - enddo - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write(iout,*) "i2rep",(i2rep(i),i=0,nodes-1) - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i,j,il,il1,i_index(i,j,il,il1)" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - -c print *,'i2rep',me,i2rep(me) -c print *,'rep2i',(rep2i(i),i=0,nrep) - -cold if (i2rep(me).eq.nrep) then -cold nup(0)=0 -cold else -cold nup(0)=remd_m(i2rep(me)+1) -cold k=rep2i(int(i2rep(me)))+1 -cold do i=1,nup(0) -cold nup(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a4,100i4)',me,' nup',(nup(i),i=0,nup(0)) - -cold if (i2rep(me).eq.1) then -cold ndown(0)=0 -cold else -cold ndown(0)=remd_m(i2rep(me)-1) -cold k=rep2i(i2rep(me)-2)+1 -cold do i=1,ndown(0) -cold ndown(i)=k -cold k=k+1 -cold enddo -cold endif - -cd print '(i4,a6,100i4)',me,' ndown',(ndown(i),i=0,ndown(0)) - - - write (*,*) "Processor",me," rest",rest," - & restart1fie",restart1file - if(rest.and.restart1file) then - if (me.eq.king) - & inquire(file=mremd_rst_name,exist=file_exist) -cd write (*,*) me," Before broadcast: file_exist",file_exist - call MPI_Bcast(file_exist,1,MPI_LOGICAL,king,CG_COMM, - & IERR) -cd write (*,*) me," After broadcast: file_exist",file_exist - if(file_exist) then - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Master is reading restart1file' - call read1restart(i_index) - else - if(me.eq.king.or..not.out1file) - & write (iout,*) 'WARNING : no restart1file' - endif - - if(me.eq.king.or..not.out1file) then - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - endif - - if(me.eq.king) then - if (rest.and..not.restart1file) - & inquire(file=mremd_rst_name,exist=file_exist) - if(.not.file_exist.and.rest.and..not.restart1file) - & write(iout,*) 'WARNING : no restart file',mremd_rst_name - IF (rest.and.file_exist.and..not.restart1file) THEN - write (iout,*) 'Master is reading restart file', - & mremd_rst_name - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl.or.hremd.gt.0) then - read (irest2,*) - read (irest2,*) nset - read (irest2,*) - read (irest2,*) (mset(i),i=1,nset) - read (irest2,*) - read (irest2,*) (i2set(i),i=0,nodes-1) - read (irest2,*) - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - read(irest2,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - write(iout,*) "i2set",(i2set(i),i=0,nodes-1) - write(iout,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - write(iout,*) i,j,il,il1,i_index(i,j,il,il1) - enddo - enddo - enddo - enddo - endif - - close(irest2) - - write (iout,'(a6,1000i5)') "i2rep",(i2rep(i),i=0,nodes-1) - write (iout,'(a6,1000i5)') "ifirst", - & (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", - & (nupa(i,il),i=1,nupa(0,il)) - write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - ELSE IF (.not.(rest.and.file_exist)) THEN - do il=1,remd_m(1) - ifirst(il)=il - enddo - - do il=1,nodes - if (i2rep(il-1).eq.nrep) then - nupa(0,il)=0 - else - nupa(0,il)=remd_m(i2rep(il-1)+1) - k=rep2i(int(i2rep(il-1)))+1 - do i=1,nupa(0,il) - nupa(i,il)=k+1 - k=k+1 - enddo - endif - if (i2rep(il-1).eq.1) then - ndowna(0,il)=0 - else - ndowna(0,il)=remd_m(i2rep(il-1)-1) - k=rep2i(i2rep(il-1)-2)+1 - do i=1,ndowna(0,il) - ndowna(i,il)=k+1 - k=k+1 - enddo - endif - enddo - - write (iout,'(a6,100i4)') "ifirst", - & (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (iout,'(a6,i4,a1,100i4)') "nupa",il,":", - & (nupa(i,il),i=1,nupa(0,il)) - write (iout,'(a6,i4,a1,100i4)') "ndowna",il,":", - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - - ENDIF - endif -c -c t_bath=retmin+(retmax-retmin)*me/(nodes-1) - if(.not.(rest.and.file_exist.and.restart1file)) then - if (me .eq. king) then - t_bath=retmin - else - t_bath=retmin+(retmax-retmin)*exp(float(i2rep(me)-nrep)) - endif -cd print *,'ttt',me,remd_tlist,(remd_t(i),i=1,nrep) - if (remd_tlist) t_bath=remd_t(int(i2rep(me))) - - endif - if(usampl.or.hremd.gt.0) then - iset=i2set(me) - if (hremd.gt.0) call set_hweights(iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) me,"iset=",iset,"t_bath=",t_bath - endif -c - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - -c print *,'irep',me,t_bath - if (.not.rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD Temperature:",t_bath - call rescale_weights(t_bath) - endif - - -c------copy MD-------------- -c The driver for molecular dynamics subroutines -c------------------------------------------------ - t_MDsetup=0.0d0 - t_langsetup=0.0d0 - t_MD=0.0d0 - t_enegrad=0.0d0 - t_sdsetup=0.0d0 - if(me.eq.king.or..not.out1file) - & write (iout,'(20(1h=),a20,20(1h=))') "MD calculation started" -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif -c Determine the inverse of the inertia matrix. - call setup_MD_matrices -c Initialize MD - call init_MD - if (rest) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a60,f10.5)') "REMD restart Temperature:",t_bath - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if (lang.gt.0 .and. .not.surfarea) then - do i=nnt,nct-1 - stdforcp(i)=stdfp*dsqrt(gamp) - enddo - do i=nnt,nct - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamsc(itype(i))) - enddo - elseif (lang.gt.0 .and. surfarea ) then - call setup_fricmat - endif - call rescale_weights(t_bath) - endif - -#ifdef MPI - t_MDsetup = MPI_Wtime()-tt0 -#else - t_MDsetup = tcpu()-tt0 -#endif - rstcount=0 -c Entering the MD loop -#ifdef MPI - tt0 = MPI_Wtime() -#else - tt0 = tcpu() -#endif - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#else - write (iout,*) - & "LANG=2 or 3 NOT SUPPORTED. Recompile without -DLANG0" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - time00=MPI_WTIME() - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'Setup time',time00-walltime -ctime call flush(iout) -#ifdef MPI - t_langsetup=MPI_Wtime()-tt0 - tt0=MPI_Wtime() -#else - t_langsetup=tcpu()-tt0 - tt0=tcpu() -#endif - itime=0 - end_of_run=.false. - do while(.not.end_of_run) - itime=itime+1 - if(itime.eq.n_timestep.and.me.eq.king) end_of_run=.true. - if(mremdsync.and.itime.eq.n_timestep) end_of_run=.true. - rstcount=rstcount+1 - if (lang.gt.0 .and. surfarea .and. - & mod(itime,reset_fricmat).eq.0) then - if (lang.eq.2 .or. lang.eq.3) then -#ifndef LANG0 - call setup_fricmat - if (lang.eq.2) then - call sd_verlet_p_setup - else - call sd_verlet_ciccotti_setup - endif - do i=1,dimen - do j=1,dimen - pfric0_mat(i,j,0)=pfric_mat(i,j) - afric0_mat(i,j,0)=afric_mat(i,j) - vfric0_mat(i,j,0)=vfric_mat(i,j) - prand0_mat(i,j,0)=prand_mat(i,j) - vrand0_mat1(i,j,0)=vrand_mat1(i,j) - vrand0_mat2(i,j,0)=vrand_mat2(i,j) - enddo - enddo - flag_stoch(0)=.true. - do i=1,maxflag_stoch - flag_stoch(i)=.false. - enddo -#endif - else if (lang.eq.1 .or. lang.eq.4) then - call setup_fricmat - endif - write (iout,'(a,i10)') - & "Friction matrix reset based on surface area, itime",itime - endif - if (reset_vel .and. tbf .and. lang.eq.0 - & .and. mod(itime,count_reset_vel).eq.0) then - call random_vel - if (me.eq.king .or. .not. out1file) - & write(iout,'(a,f20.2)') - & "Velocities reset to random values, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=d_t(j,i) - enddo - enddo - endif - if (reset_moment .and. mod(itime,count_reset_moment).eq.0) then - call inertia_tensor - call vcm_vel(vcm) - do j=1,3 - d_t(j,0)=d_t(j,0)-vcm(j) - enddo - call kinetic(EK) - kinetic_T=2.0d0/(dimen3*Rb)*EK - scalfac=dsqrt(T_bath/kinetic_T) -cd write(iout,'(a,f20.2)') "Momenta zeroed out, time",totT - do i=0,2*nres - do j=1,3 - d_t_old(j,i)=scalfac*d_t(j,i) - enddo - enddo - endif - if (lang.ne.4) then - if (RESPA) then -c Time-reversible RESPA algorithm -c (Tuckerman et al., J. Chem. Phys., 97, 1990, 1992) - call RESPA_step(itime) - else -c Variable time step algorithm. - call velverlet_step(itime) - endif - else -#ifdef BROWN - call brown_step(itime) -#else - print *,"Brown dynamics not here!" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop -#endif - endif - if(hmc.gt.0 .and. mod(itime,hmc).eq.0) then - call statout(itime) - call hmc_test(itime) - endif - if(ntwe.ne.0) then - if (mod(itime,ntwe).eq.0) call statout(itime) - endif - if (mod(itime,ntwx).eq.0.and..not.traj1file) then - write (tytul,'("time",f8.2," temp",f8.1)') totT,t_bath - if(mdpdb) then - call pdbout(potE,tytul,ipdb) - else - call cartout(totT) - endif - endif - if (mod(itime,ntwx).eq.0.and.traj1file) then - if(ntwx_cache.lt.max_cache_traj_use) then - ntwx_cache=ntwx_cache+1 - else - if (max_cache_traj_use.ne.1) - & print *,itime,"processor ",me," over cache ",ntwx_cache - do i=1,ntwx_cache-1 - - totT_cache(i)=totT_cache(i+1) - EK_cache(i)=EK_cache(i+1) - potE_cache(i)=potE_cache(i+1) - t_bath_cache(i)=t_bath_cache(i+1) - Uconst_cache(i)=Uconst_cache(i+1) - iset_cache(i)=iset_cache(i+1) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,i+1) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,i+1) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,i+1) - ugamma_cache(ii,i)=ugamma_cache(ii,i+1) - uscdiff_cache(ii,i)=uscdiff_cache(ii,i+1) - enddo - - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,i+1) - enddo - enddo - enddo - endif - - totT_cache(ntwx_cache)=totT - EK_cache(ntwx_cache)=EK - potE_cache(ntwx_cache)=potE - t_bath_cache(ntwx_cache)=t_bath - Uconst_cache(ntwx_cache)=Uconst - iset_cache(ntwx_cache)=iset - - do i=1,nfrag - qfrag_cache(i,ntwx_cache)=qfrag(i) - enddo - do i=1,npair - qpair_cache(i,ntwx_cache)=qpair(i) - enddo - do i=1,nfrag_back - utheta_cache(i,ntwx_cache)=utheta(i) - ugamma_cache(i,ntwx_cache)=ugamma(i) - uscdiff_cache(i,ntwx_cache)=uscdiff(i) - enddo - - do i=1,nres*2 - do j=1,3 - c_cache(j,i,ntwx_cache)=c(j,i) - enddo - enddo - - endif - if ((rstcount.eq.1000.or.itime.eq.n_timestep) - & .and..not.restart1file) then - - if(me.eq.king) then - open(irest1,file=mremd_rst_name,status='unknown') - write (irest1,*) "i2rep" - write (irest1,*) (i2rep(i),i=0,nodes-1) - write (irest1,*) "ifirst" - write (irest1,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - write (irest1,*) "nupa",il - write (irest1,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - write (irest1,*) "ndowna",il - write (irest1,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - if(usampl.or.hremd.gt.0) then - write (irest1,*) "nset" - write (irest1,*) nset - write (irest1,*) "mset" - write (irest1,*) (mset(i),i=1,nset) - write (irest1,*) "i2set" - write (irest1,*) (i2set(i),i=0,nodes-1) - write (irest1,*) "i_index" - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - write(irest1,*) (i_index(i,j,il,il1),j=1,remd_m(i)) - enddo - enddo - enddo - - endif - close(irest1) - endif - open(irest2,file=rest2name,status='unknown') - write(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - write (irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - write (irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl.or.hremd.gt.0) then - write (irest2,*) iset - endif - close(irest2) - rstcount=0 - endif - -c REMD - exchange -c forced synchronization - if (mod(itime,i_sync_step).eq.0 .and. me.ne.king - & .and. .not. mremdsync) then - synflag=.false. - call mpi_iprobe(0,101,CG_COMM,synflag,status,ierr) - if (synflag) then - call mpi_recv(itime_master, 1, MPI_INTEGER, - & 0,101,CG_COMM, status, ierr) - call mpi_barrier(CG_COMM, ierr) -cdeb if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) - if(traj1file) - & call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (.not.out1file) - & write(iout,*) 'REMD synchro at',itime_master,itime - if (itime_master.ge.n_timestep .or. ovrtim()) - & end_of_run=.true. -ctime call flush(iout) - endif - endif - -c REMD - exchange - if ((mod(itime,nstex).eq.0.and.me.eq.king - & .or.end_of_run.and.me.eq.king ) - & .and. .not. mremdsync ) then - synflag=.true. - time01_=MPI_WTIME() - do i=1,nodes-1 - call mpi_isend(itime,1,MPI_INTEGER,i,101, - & CG_COMM, ireqi(i), ierr) -cd write(iout,*) 'REMD synchro with',i -cd call flush(iout) - enddo - call mpi_waitall(nodes-1,ireqi,statusi,ierr) - call mpi_barrier(CG_COMM, ierr) - time01=MPI_WTIME() - write(iout,*) 'REMD synchro at',itime,'time=',time01-time01_ - if (out1file.or.traj1file) then -cdeb call mpi_gather(itime,1,mpi_integer, -cdeb & itime_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' REMD synchro itime', -cdeb & (itime_all(i),i=1,nodes) - if(traj1file) then -cdeb imin_itime=itime_all(1) -cdeb do i=2,nodes -cdeb if(itime_all(i).lt.imin_itime) imin_itime=itime_all(i) -cdeb enddo -cdeb ii_write=(imin_itime-imin_itime_old)/ntwx -cdeb imin_itime_old=int(imin_itime/ntwx)*ntwx -cdeb write(iout,*) imin_itime,imin_itime_old,ii_write - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) -c write(iout,'(a19,8000i8)') ' ntwx_cache', -c & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo -c write(iout,*) "MIN ii_write=",ii_write - endif - endif -ctime call flush(iout) - endif - if(mremdsync .and. mod(itime,nstex).eq.0) then - synflag=.true. - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'REMD synchro at',itime - - if(traj1file) then - call mpi_gather(ntwx_cache,1,mpi_integer, - & icache_all,1,mpi_integer,king, - & CG_COMM,ierr) - if (me.eq.king) then - write(iout,'(a19,8000i8)') ' ntwx_cache', - & (icache_all(i),i=1,nodes) - ii_write=icache_all(1) - do i=2,nodes - if(icache_all(i).lt.ii_write) ii_write=icache_all(i) - enddo - write(iout,*) "MIN ii_write=",ii_write - endif - endif -ctest call flush(iout) - endif - if (synflag) then -c Update the time safety limiy - if (time001-time00.gt.safety) then - safety=time001-time00+600 - if (me.eq.king .or. .not. out1file) - & write (iout,*) "****** SAFETY increased to",safety," s" - endif - if (ovrtim()) end_of_run=.true. - endif - if(synflag.and..not.end_of_run) then - time02=MPI_WTIME() - synflag=.false. - -c write(iout,*) 'REMD before',me,t_bath - -c call mpi_gather(t_bath,1,mpi_double_precision, -c & remd_t_bath,1,mpi_double_precision,king, -c & CG_COMM,ierr) - potEcomp(n_ene+1)=t_bath - t_bath_old=t_bath - if (usampl) then - potEcomp(n_ene+2)=iset - if (iset.lt.nset) then - i_set_temp=iset - iset=iset+1 - call EconstrQ - potEcomp(n_ene+3)=Uconst - iset=i_set_temp - endif - if (iset.gt.1) then - i_set_temp=iset - iset=iset-1 - call EconstrQ - potEcomp(n_ene+4)=Uconst - iset=i_set_temp - endif - endif - if(hremd.gt.0) potEcomp(n_ene+2)=iset - call mpi_gather(potEcomp(0),n_ene+5,mpi_double_precision, - & remd_ene(0,1),n_ene+5,mpi_double_precision,king, - & CG_COMM,ierr) - if(lmuca) then - call mpi_gather(elow,1,mpi_double_precision, - & elowi,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_gather(ehigh,1,mpi_double_precision, - & ehighi,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - - time03=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD gather times=',time03-time01 - & ,time03-time02 - endif - - if (restart1file) call write1rst(i_index) - - time04=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing rst time=',time04-time03 - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a19,8000i8)') ' ntwx_cache after traj1file', -cdeb & (icache_all(i),i=1,nodes) -cd end - - - time05=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD writing traj time=',time05-time04 -ctime call flush(iout) - endif - - - if (me.eq.king) then - do i=1,nodes - remd_t_bath(i)=remd_ene(n_ene+1,i) - iremd_iset(i)=remd_ene(n_ene+2,i) - enddo -#ifdef DEBUG - if(lmuca) then -co write(iout,*) 'REMD exchange temp,ene,elow,ehigh' - do i=1,nodes - write(iout,'(i4,4f12.5)') i,remd_t_bath(i),remd_ene(0,i), - & elowi(i),ehighi(i) - enddo - else - write(iout,*) 'REMD exchange temp,ene' - do i=1,nodes - write(iout,'(i4,2f12.5)') i,remd_t_bath(i),remd_ene(0,i) - write(iout,'(6f12.5)') (remd_ene(j,i),j=1,n_ene) - enddo - endif -#endif -c------------------------------------- - IF(.not.usampl.and.hremd.eq.0) THEN -#ifdef DEBUG - write (iout,*) "Enter exchnge, remd_m",remd_m(1), - & " nodes",nodes -ctime call flush(iout) - write (iout,*) "remd_m(1)",remd_m(1) -#endif - do irr=1,remd_m(1) - i=ifirst(iran_num(1,remd_m(1))) -#ifdef DEBUG - write (iout,*) "i",i -#endif -ctime call flush(iout) - - do ii=1,nodes-1 - -#ifdef DEBUG - write (iout,*) "i",i," nupa(0,i)",int(nupa(0,i)) -#endif - if(i.gt.0.and.nupa(0,i).gt.0) then - iex=i -c if (i.eq.1 .and. int(nupa(0,i)).eq.1) then -c write (iout,*) -c & "CHUJ ABSOLUTNY!!! No way to sample a distinct replica in MREMD" -c call flush(iout) -c call MPI_Abort(MPI_COMM_WORLD,ERRCODE,ierr) -c endif -c do while (iex.eq.i) -c write (iout,*) "upper",nupa(int(nupa(0,i)),i) - iex=nupa(iran_num(1,int(nupa(0,i))),i) -c enddo -c write (iout,*) "nupa(0,i)",nupa(0,i)," iex",iex - if (lmuca) then - call muca_delta(remd_t_bath,remd_ene,i,iex,delta) - else -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -c write (iout,*) "i",i," ene_i_i",ene_i_i, -c & " iex",iex," ene_iex_iex",ene_iex_iex -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(i) -c call flush(iout) - call rescale_weights(remd_t_bath(i)) - -c write (iout,*) "0,iex",remd_t_bath(i) -c call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -c write (iout,*) "ene_iex_i",remd_ene(0,iex) - -c write (iout,*) "0,i",remd_t_bath(i) -c call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -c write (iout,*) "ene_i_i",remd_ene(0,i) -c call flush(iout) -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(iex) - if (abs(ene_i_i-remd_ene(0,i)).gt.ene_tol) then - write (iout,*) "ERROR: inconsistent energies:",i, - & ene_i_i,remd_ene(0,i) - endif - call rescale_weights(remd_t_bath(iex)) - -c write (iout,*) "0,i",remd_t_bath(iex) -c call enerprint(remd_ene(0,i)) - - call sum_energy(remd_ene(0,i),.false.) -c write (iout,*) "ene_i_iex",remd_ene(0,i) -c call flush(iout) - ene_i_iex=remd_ene(0,i) - -c write (iout,*) "0,iex",remd_t_bath(iex) -c call enerprint(remd_ene(0,iex)) - - call sum_energy(remd_ene(0,iex),.false.) - if (abs(ene_iex_iex-remd_ene(0,iex)).gt.ene_tol) then - write (iout,*) "ERROR: inconsistent energies:",iex, - & ene_iex_iex,remd_ene(0,iex) - endif -c write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -c write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -c & " ene_i_iex",ene_i_iex, -c & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex -c call flush(iout) - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -c write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - endif - if (delta .gt. 50.0d0) then - delta=0.0d0 - else -#ifdef OSF - if(isnan(delta))then - delta=0.0d0 - else if (delta.lt.-50.0d0) then - delta=dexp(50.0d0) - else - delta=dexp(-delta) - endif -#else - delta=dexp(-delta) -#endif - endif - iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -c write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx -c call flush(iout) - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - if(lmuca) then - tmp=elowi(i) - elowi(i)=elowi(iex) - elowi(iex)=tmp - tmp=ehighi(i) - ehighi(i)=ehighi(iex) - ehighi(iex)=tmp - endif - - - do k=0,nodes - itmp=nupa(k,i) - nupa(k,i)=nupa(k,iex) - nupa(k,iex)=itmp - itmp=ndowna(k,i) - ndowna(k,i)=ndowna(k,iex) - ndowna(k,iex)=itmp - enddo - do il=1,nodes - if (ifirst(il).eq.i) ifirst(il)=iex - do k=1,nupa(0,il) - if (nupa(k,il).eq.i) then - nupa(k,il)=iex - elseif (nupa(k,il).eq.iex) then - nupa(k,il)=i - endif - enddo - do k=1,ndowna(0,il) - if (ndowna(k,il).eq.i) then - ndowna(k,il)=iex - elseif (ndowna(k,il).eq.iex) then - ndowna(k,il)=i - endif - enddo - enddo - - iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - -c write(iout,*) 'exchange',i,iex -c write (iout,'(a8,100i4)') "@ ifirst", -c & (ifirst(k),k=1,remd_m(1)) -c do il=1,nodes -c write (iout,'(a8,i4,a1,100i4)') "@ nupa",il,":", -c & (nupa(k,il),k=1,nupa(0,il)) -c write (iout,'(a8,i4,a1,100i4)') "@ ndowna",il,":", -c & (ndowna(k,il),k=1,ndowna(0,il)) -c enddo -c call flush(iout) - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - i=iex - endif - endif - enddo - enddo -cd write (iout,*) "exchange completed" -cd call flush(iout) - ELSEIF (usampl) THEN - do ii=1,nodes -cd write(iout,*) "########",ii - - i_temp=iran_num(1,nrep) - i_mult=iran_num(1,remd_m(i_temp)) - i_iset=iran_num(1,nset) - i_mset=iran_num(1,mset(i_iset)) - i=i_index(i_temp,i_mult,i_iset,i_mset) - -cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - - if(t_exchange_only)then - i_dir=1 - else - i_dir=iran_num(1,3) - endif -cd write(iout,*) "i_dir=",i_dir - - if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(i_dir.eq.2 .and. mset(i_iset+1).gt.0)then - - i_temp1=i_temp - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - elseif(remd_m(i_temp+1).gt.0.and.mset(i_iset+1).gt.0)then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset+1 - i_mset1=iran_num(1,mset(i_iset1)) - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - econstr_temp_i=remd_ene(20,i) - econstr_temp_iex=remd_ene(20,iex) - remd_ene(20,i)=remd_ene(n_ene+3,i) - remd_ene(20,iex)=remd_ene(n_ene+4,iex) - - else - goto 444 - endif - -cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 -ctime call flush(iout) - -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) -co write (iout,*) "rescaling weights with temperature", -co & remd_t_bath(i) - call rescale_weights(remd_t_bath(i)) - - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) -cd write (iout,*) "ene_iex_i",remd_ene(0,iex) -c call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_i",remd_ene(0,i) -c write (iout,*) "rescaling weights with temperature", -c & remd_t_bath(iex) -c if (real(ene_i_i).ne.real(remd_ene(0,i))) then -c write (iout,*) "ERROR: inconsistent energies:",i, -c & ene_i_i,remd_ene(0,i) -c endif - call rescale_weights(remd_t_bath(iex)) - call sum_energy(remd_ene(0,i),.false.) -cd write (iout,*) "ene_i_iex",remd_ene(0,i) - ene_i_iex=remd_ene(0,i) -c call sum_energy(remd_ene(0,iex),.false.) -c if (real(ene_iex_iex).ne.real(remd_ene(0,iex))) then -c write (iout,*) "ERROR: inconsistent energies:",iex, -c & ene_iex_iex,remd_ene(0,iex) -c endif -cd write (iout,*) "ene_iex_iex",remd_ene(0,iex) -c write (iout,*) "i",i," iex",iex -cd write (iout,'(4(a,e15.5))') "ene_i_i",ene_i_i, -cd & " ene_i_iex",ene_i_iex, -cd & " ene_iex_i",ene_iex_i," ene_iex_iex",ene_iex_iex - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta -cd write(iout,*) 'delta',delta -c delta=(remd_t_bath(i)-remd_t_bath(iex))* -c & (remd_ene(i)-remd_ene(iex))/Rb/ -c & (remd_t_bath(i)*remd_t_bath(iex)) - if (delta .gt. 50.0d0) then - delta=0.0d0 - else - delta=dexp(-delta) - endif - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_tot_usa(int(i2set(i-1)))= - & iremd_tot_usa(int(i2set(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx - if (delta .gt. xxx) then - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - - itmp=iremd_iset(i) - iremd_iset(i)=iremd_iset(iex) - iremd_iset(iex)=itmp - - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_acc_usa(int(i2set(i-1)))= - & iremd_acc_usa(int(i2set(i-1)))+1 - - itmp=i2set(i-1) - i2set(i-1)=i2set(iex-1) - i2set(iex-1)=itmp - - itmp=i_index(i_temp,i_mult,i_iset,i_mset) - i_index(i_temp,i_mult,i_iset,i_mset)= - & i_index(i_temp1,i_mult1,i_iset1,i_mset1) - i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - remd_ene(20,iex)=econstr_temp_iex - remd_ene(20,i)=econstr_temp_i - endif - -cd do il=1,nset -cd do il1=1,mset(il) -cd do i=1,nrep -cd do j=1,remd_m(i) -cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1) -cd enddo -cd enddo -cd enddo -cd enddo - - 444 continue - - enddo - - ELSEIF (hremd.gt.0) THEN - do ii=1,nodes -cd write(iout,*) "########",ii - - i_temp=iran_num(1,nrep) - i_mult=iran_num(1,remd_m(i_temp)) - i_iset=iran_num(1,nset) - i_mset=1 - i=i_index(i_temp,i_mult,i_iset,i_mset) - -cd write(iout,*) "i=",i,i_temp,i_mult,i_iset,i_mset - - if(t_exchange_only)then - i_dir=1 - else - i_dir=iran_num(1,3) - endif - -cd write(iout,*) "i_dir=",i_dir - - if(i_dir.eq.1 .and. remd_m(i_temp+1).gt.0 )then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=i_iset - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(i_dir.eq.2)then - - i_temp1=i_temp - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=iran_num(1,hremd) - do while(i_iset1.eq.i_iset) - i_iset1=iran_num(1,hremd) - enddo - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - elseif(remd_m(i_temp+1).gt.0)then - - i_temp1=i_temp+1 - i_mult1=iran_num(1,remd_m(i_temp1)) - i_iset1=iran_num(1,hremd) - do while(i_iset1.eq.i_iset) - i_iset1=iran_num(1,hremd) - enddo - i_mset1=1 - iex=i_index(i_temp1,i_mult1,i_iset1,i_mset1) - - else - goto 445 - endif - -cd write(iout,*) "iex=",iex,i_temp1,i_mult1,i_iset1,i_mset1 -ctime call flush(iout) - -c Swap temperatures between conformations i and iex with recalculating the free energies -c following temperature changes. - ene_iex_iex=remd_ene(0,iex) - ene_i_i=remd_ene(0,i) - - call set_hweights(i_iset) - call rescale_weights(remd_t_bath(i)) - call sum_energy(remd_ene(0,iex),.false.) - ene_iex_i=remd_ene(0,iex) - - call set_hweights(i_iset1) - call rescale_weights(remd_t_bath(iex)) - call sum_energy(remd_ene(0,i),.false.) - ene_i_iex=remd_ene(0,i) - -cd write(iout,*) ene_iex_iex,ene_i_i,ene_iex_i,ene_i_iex - - delta=(ene_iex_iex-ene_i_iex)/(Rb*remd_t_bath(iex))- - & (ene_iex_i-ene_i_i)/(Rb*remd_t_bath(i)) - delta=-delta - - if (delta .gt. 50.0d0) then - delta=0.0d0 - else - delta=dexp(-delta) - endif - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_tot(int(i2rep(i-1)))=iremd_tot(int(i2rep(i-1)))+1 - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_tot_usa(int(i2set(i-1)))= - & iremd_tot_usa(int(i2set(i-1)))+1 - xxx=ran_number(0.0d0,1.0d0) -cd write(iout,'(2i4,a6,2f12.5)') i,iex,' delta',delta,xxx - if (delta .gt. xxx) then - -cd write (iout,*) "exchange" - tmp=remd_t_bath(i) - remd_t_bath(i)=remd_t_bath(iex) - remd_t_bath(iex)=tmp - - itmp=iremd_iset(i) - iremd_iset(i)=iremd_iset(iex) - iremd_iset(iex)=itmp - - remd_ene(0,i)=ene_i_iex - remd_ene(0,iex)=ene_iex_i - - if (i_dir.eq.1.or.i_dir.eq.3) - & iremd_acc(int(i2rep(i-1)))=iremd_acc(int(i2rep(i-1)))+1 - - itmp=i2rep(i-1) - i2rep(i-1)=i2rep(iex-1) - i2rep(iex-1)=itmp - - if (i_dir.eq.2.or.i_dir.eq.3) - & iremd_acc_usa(int(i2set(i-1)))= - & iremd_acc_usa(int(i2set(i-1)))+1 - - itmp=i2set(i-1) - i2set(i-1)=i2set(iex-1) - i2set(iex-1)=itmp - - itmp=i_index(i_temp,i_mult,i_iset,i_mset) - i_index(i_temp,i_mult,i_iset,i_mset)= - & i_index(i_temp1,i_mult1,i_iset1,i_mset1) - i_index(i_temp1,i_mult1,i_iset1,i_mset1)=itmp - -cd do il=1,nset -cd do il1=1,mset(il) -cd do i=1,nrep -cd do j=1,remd_m(i) -cd write(iout,*) i,j,il,il1,i_index(i,j,il,il1) -cd enddo -cd enddo -cd enddo -cd enddo - - else - remd_ene(0,iex)=ene_iex_iex - remd_ene(0,i)=ene_i_i - endif - - - - 445 continue - - enddo - - ENDIF - -c------------------------------------- - write (iout,*) "NREP",nrep - do i=1,nrep - if(iremd_tot(i).ne.0) - & write(iout,'(a3,i4,2f12.5,i5)') 'ACC',i,remd_t(i) - & ,iremd_acc(i)/(1.0*iremd_tot(i)),iremd_tot(i) - enddo - - if(usampl) then - do i=1,nset - if(iremd_tot_usa(i).ne.0) - & write(iout,'(a10,i4,f12.5,i8)') 'ACC_usampl',i, - & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i) - enddo - endif - - if(hremd.gt.0) then - do i=1,nset - if(iremd_tot_usa(i).ne.0) - & write(iout,'(a10,i4,f12.5,i8)') 'ACC_hremd',i, - & iremd_acc_usa(i)/(1.0*iremd_tot_usa(i)),iremd_tot_usa(i) - enddo - endif - - -ctime call flush(iout) - -cd write (iout,'(a6,100i4)') "ifirst", -cd & (ifirst(i),i=1,remd_m(1)) -cd do il=1,nodes -cd write (iout,'(a5,i4,a1,100i4)') "nup",il,":", -cd & (nupa(i,il),i=1,nupa(0,il)) -cd write (iout,'(a5,i4,a1,100i4)') "ndown",il,":", -cd & (ndowna(i,il),i=1,ndowna(0,il)) -cd enddo - endif - - time06=MPI_WTIME() -cd write (iout,*) "Before scatter" -cd call flush(iout) - call mpi_scatter(remd_t_bath,1,mpi_double_precision, - & t_bath,1,mpi_double_precision,king, - & CG_COMM,ierr) -cd write (iout,*) "After scatter" -cd call flush(iout) - if(usampl.or.hremd.gt.0) - & call mpi_scatter(iremd_iset,1,mpi_integer, - & iset,1,mpi_integer,king, - & CG_COMM,ierr) - - time07=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD scatter time=',time07-time06 - endif - - if(lmuca) then - call mpi_scatter(elowi,1,mpi_double_precision, - & elow,1,mpi_double_precision,king, - & CG_COMM,ierr) - call mpi_scatter(ehighi,1,mpi_double_precision, - & ehigh,1,mpi_double_precision,king, - & CG_COMM,ierr) - endif - - if(hremd.gt.0) call set_hweights(iset) - call rescale_weights(t_bath) -co write (iout,*) "Processor",me, -co & " rescaling weights with temperature",t_bath - - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if (lang.gt.0) then - do i=nnt,nct-1 - stdforcp(i)=stdforcp(i)*sqrt(t_bath/t_bath_old) - enddo - do i=nnt,nct - stdforcsc(i)=stdforcsc(i)*sqrt(t_bath/t_bath_old) - enddo - endif -cde write(iout,*) 'REMD after',me,t_bath - time08=MPI_WTIME() - if (me.eq.king .or. .not. out1file) then - write(iout,*) 'REMD exchange time=',time08-time02 -ctime call flush(iout) - endif - endif - enddo - - if (restart1file) then - if (me.eq.king .or. .not. out1file) - & write(iout,*) 'writing restart at the end of run' - call write1rst(i_index) - endif - - if (traj1file) call write1traj -cd debugging -cdeb call mpi_gather(ntwx_cache,1,mpi_integer, -cdeb & icache_all,1,mpi_integer,king, -cdeb & CG_COMM,ierr) -cdeb write(iout,'(a40,8000i8)') -cdeb & ' ntwx_cache after traj1file at the end', -cdeb & (icache_all(i),i=1,nodes) -cd end - - -#ifdef MPI - t_MD=MPI_Wtime()-tt0 -#else - t_MD=tcpu()-tt0 -#endif - if (me.eq.king .or. .not. out1file) then - write (iout,'(//35(1h=),a10,35(1h=)/10(/a40,1pe15.5))') - & ' Timing ', - & 'MD calculations setup:',t_MDsetup, - & 'Energy & gradient evaluation:',t_enegrad, - & 'Stochastic MD setup:',t_langsetup, - & 'Stochastic MD step setup:',t_sdsetup, - & 'MD steps:',t_MD - write (iout,'(/28(1h=),a25,27(1h=))') - & ' End of MD calculation ' - if(hmc.gt.0) write (iout,*) 'HMC acceptance ratio', - & n_timestep*1.0d0/hmc/hmc_acc - endif - return - end - -c----------------------------------------------------------------------- - subroutine write1rst(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & d_restart2(3,2*maxres*maxprocs) - real t5_restart1(5) - integer iret,itmp - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - common /przechowalnia/ d_restart1,d_restart2 - - t5_restart1(1)=totT - t5_restart1(2)=EK - t5_restart1(3)=potE - t5_restart1(4)=t_bath - t5_restart1(5)=Uconst - - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=d_t(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart1,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - - do i=1,2*nres - do j=1,3 - r_d(j,i)=dc(j,i) - enddo - enddo - call mpi_gather(r_d,3*2*nres,mpi_real, - & d_restart2,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then -#ifdef AIX - call xdrfopen_(ixdrf,mremd_rst_name, "w", iret) - do i=0,nodes-1 - call xdrfint_(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint_(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - do i=0,nupa(0,il) - call xdrfint_(ixdrf, nupa(i,il), iret) - enddo - - do i=0,ndowna(0,il) - call xdrfint_(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes - do j=1,4 - call xdrffloat_(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat_(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo - - if(usampl) then - call xdrfint_(ixdrf, nset, iret) - do i=1,nset - call xdrfint_(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint_(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - itmp=i_index(i,j,il,il1) - call xdrfint_(ixdrf,itmp, iret) - enddo - enddo - enddo - enddo - - endif - call xdrfclose_(ixdrf, iret) -#else - call xdrfopen(ixdrf,mremd_rst_name, "w", iret) - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - do i=0,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - - do i=0,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - - do il=1,nodes - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo - - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) - enddo - enddo - enddo - do il=0,nodes-1 - do i=1,2*nres - do j=1,3 - call xdrffloat(ixdrf, d_restart2(j,i+2*nres*il), iret) - enddo - enddo - enddo - - - if(usampl) then - call xdrfint(ixdrf, nset, iret) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - itmp=i_index(i,j,il,il1) - call xdrfint(ixdrf,itmp, iret) - enddo - enddo - enddo - enddo - - endif - call xdrfclose(ixdrf, iret) -#endif - endif - return - end - - - subroutine write1traj - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - - real t5_restart1(5) - integer iret,itmp - real xcoord(3,maxres2+2),prec - real r_qfrag(50),r_qpair(100) - real r_utheta(50),r_ugamma(100),r_uscdiff(100) - real p_qfrag(50*maxprocs),p_qpair(100*maxprocs) - real p_utheta(50*maxprocs),p_ugamma(100*maxprocs), - & p_uscdiff(100*maxprocs) - real p_c(3,(maxres2+2)*maxprocs),r_c(3,maxres2+2) - common /przechowalnia/ p_c - - call mpi_bcast(ii_write,1,mpi_integer, - & king,CG_COMM,ierr) - -c debugging - print *,'traj1file',me,ii_write,ntwx_cache -c end debugging - -#ifdef AIX - if(me.eq.king) call xdrfopen_(ixdrf,cartname, "a", iret) -#else - if(me.eq.king) call xdrfopen(ixdrf,cartname, "a", iret) -#endif - do ii=1,ii_write - t5_restart1(1)=totT_cache(ii) - t5_restart1(2)=EK_cache(ii) - t5_restart1(3)=potE_cache(ii) - t5_restart1(4)=t_bath_cache(ii) - t5_restart1(5)=Uconst_cache(ii) - call mpi_gather(t5_restart1,5,mpi_real, - & t_restart1,5,mpi_real,king,CG_COMM,ierr) - - call mpi_gather(iset_cache(ii),1,mpi_integer, - & iset_restart1,1,mpi_integer,king,CG_COMM,ierr) - - do i=1,nfrag - r_qfrag(i)=qfrag_cache(i,ii) - enddo - do i=1,npair - r_qpair(i)=qpair_cache(i,ii) - enddo - do i=1,nfrag_back - r_utheta(i)=utheta_cache(i,ii) - r_ugamma(i)=ugamma_cache(i,ii) - r_uscdiff(i)=uscdiff_cache(i,ii) - enddo - - call mpi_gather(r_qfrag,nfrag,mpi_real, - & p_qfrag,nfrag,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_qpair,npair,mpi_real, - & p_qpair,npair,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_utheta,nfrag_back,mpi_real, - & p_utheta,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_ugamma,nfrag_back,mpi_real, - & p_ugamma,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - call mpi_gather(r_uscdiff,nfrag_back,mpi_real, - & p_uscdiff,nfrag_back,mpi_real,king, - & CG_COMM,ierr) - -#ifdef DEBUG - write (iout,*) "p_qfrag" - do i=1,nodes - write (iout,*) i,(p_qfrag((i-1)*nfrag+j),j=1,nfrag) - enddo - write (iout,*) "p_qpair" - do i=1,nodes - write (iout,*) i,(p_qpair((i-1)*npair+j),j=1,npair) - enddo -ctime call flush(iout) -#endif - do i=1,nres*2 - do j=1,3 - r_c(j,i)=c_cache(j,i,ii) - enddo - enddo - - call mpi_gather(r_c,3*2*nres,mpi_real, - & p_c,3*2*nres,mpi_real,king, - & CG_COMM,ierr) - - if(me.eq.king) then -#ifdef AIX - do il=1,nodes - call xdrffloat_(ixdrf, real(t_restart1(1,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(3,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(5,il)), iret) - call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret) - call xdrfint_(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint_(ixdrf, idssb(j)+nres, iret) - call xdrfint_(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) - call xdrfint_(ixdrf, iset_restart1(il), iret) - do i=1,nfrag - call xdrffloat_(ixdrf, p_qfrag(i+(il-1)*nfrag), iret) - enddo - do i=1,npair - call xdrffloat_(ixdrf, p_qpair(i+(il-1)*npair), iret) - enddo - do i=1,nfrag_back - call xdrffloat_(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret) - call xdrffloat_(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret) - call xdrffloat_(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret) - enddo - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=p_c(j,i+(il-1)*nres*2) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2) - enddo - enddo - itmp=nres+nct-nnt+1 - call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) - enddo -#else - do il=1,nodes - call xdrffloat(ixdrf, real(t_restart1(1,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(3,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(5,il)), iret) - call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - call xdrfint(ixdrf, iset_restart1(il), iret) - do i=1,nfrag - call xdrffloat(ixdrf, p_qfrag(i+(il-1)*nfrag), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, p_qpair(i+(il-1)*npair), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, p_utheta(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_ugamma(i+(il-1)*nfrag_back), iret) - call xdrffloat(ixdrf, p_uscdiff(i+(il-1)*nfrag_back), iret) - enddo - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=p_c(j,i+(il-1)*nres*2) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=p_c(j,i+nres+(il-1)*nres*2) - enddo - enddo - itmp=nres+nct-nnt+1 - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - enddo -#endif - endif - enddo -#ifdef AIX - if(me.eq.king) call xdrfclose_(ixdrf, iret) -#else - if(me.eq.king) call xdrfclose(ixdrf, iret) -#endif - do i=1,ntwx_cache-ii_write - - totT_cache(i)=totT_cache(ii_write+i) - EK_cache(i)=EK_cache(ii_write+i) - potE_cache(i)=potE_cache(ii_write+i) - t_bath_cache(i)=t_bath_cache(ii_write+i) - Uconst_cache(i)=Uconst_cache(ii_write+i) - iset_cache(i)=iset_cache(ii_write+i) - - do ii=1,nfrag - qfrag_cache(ii,i)=qfrag_cache(ii,ii_write+i) - enddo - do ii=1,npair - qpair_cache(ii,i)=qpair_cache(ii,ii_write+i) - enddo - do ii=1,nfrag_back - utheta_cache(ii,i)=utheta_cache(ii,ii_write+i) - ugamma_cache(ii,i)=ugamma_cache(ii,ii_write+i) - uscdiff_cache(ii,i)=uscdiff_cache(ii,ii_write+i) - enddo - - do ii=1,nres*2 - do j=1,3 - c_cache(j,ii,i)=c_cache(j,ii,ii_write+i) - enddo - enddo - enddo - ntwx_cache=ntwx_cache-ii_write - return - end - - - subroutine read1restart(i_index) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - integer*2 i_index - & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) - common /przechowalnia/ d_restart1 - write (*,*) "Processor",me," called read1restart" - - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read(irest2,*,err=334) i - write(iout,*) "Reading old rst in ASCI format" - close(irest2) - call read1restart_old - return - 334 continue -#ifdef AIX - call xdrfopen_(ixdrf,mremd_rst_name, "r", iret) - - do i=0,nodes-1 - call xdrfint_(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint_(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - call xdrfint_(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint_(ixdrf, nupa(i,il), iret) - enddo - - call xdrfint_(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint_(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes - do j=1,4 - call xdrffloat_(ixdrf, t_restart1(j,il), iret) - enddo - enddo -#else - call xdrfopen(ixdrf,mremd_rst_name, "r", iret) - - do i=0,nodes-1 - call xdrfint(ixdrf, i2rep(i), iret) - enddo - do i=1,remd_m(1) - call xdrfint(ixdrf, ifirst(i), iret) - enddo - do il=1,nodes - call xdrfint(ixdrf, nupa(0,il), iret) - do i=1,nupa(0,il) - call xdrfint(ixdrf, nupa(i,il), iret) - enddo - - call xdrfint(ixdrf, ndowna(0,il), iret) - do i=1,ndowna(0,il) - call xdrfint(ixdrf, ndowna(i,il), iret) - enddo - enddo - do il=1,nodes - do j=1,4 - call xdrffloat(ixdrf, t_restart1(j,il), iret) - enddo - enddo -#endif - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 -#ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) -#else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) -#endif - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres -c read(irest2,'(3e15.5)') -c & (d_restart1(j,i+2*nres*il),j=1,3) - do j=1,3 -#ifdef AIX - call xdrffloat_(ixdrf, d_restart1(j,i+2*nres*il), iret) -#else - call xdrffloat(ixdrf, d_restart1(j,i+2*nres*il), iret) -#endif - enddo - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - - - if(usampl) then -#ifdef AIX - if(me.eq.king)then - call xdrfint_(ixdrf, nset, iret) - do i=1,nset - call xdrfint_(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint_(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - call xdrfint_(ixdrf,itmp, iret) - i_index(i,j,il,il1)=itmp - enddo - enddo - enddo - enddo - endif -#else - if(me.eq.king)then - call xdrfint(ixdrf, nset, iret) - do i=1,nset - call xdrfint(ixdrf,mset(i), iret) - enddo - do i=0,nodes-1 - call xdrfint(ixdrf,i2set(i), iret) - enddo - do il=1,nset - do il1=1,mset(il) - do i=1,nrep - do j=1,remd_m(i) - call xdrfint(ixdrf,itmp, iret) - i_index(i,j,il,il1)=itmp - enddo - enddo - enddo - enddo - endif -#endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its -c own element -c call mpi_scatter(i2set,1,mpi_integer, -c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) - call mpi_bcast(i2set(0),nodes,mpi_integer,king, - & CG_COMM,ierr) - iset=i2set(me) - - endif - - - if(me.eq.king) close(irest2) - return - end - - subroutine read1restart_old - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.SBRIDGE' - include 'COMMON.INTERACT' - real d_restart1(3,2*maxres*maxprocs),r_d(3,2*maxres), - & t5_restart1(5) - common /przechowalnia/ d_restart1 - if(me.eq.king)then - open(irest2,file=mremd_rst_name,status='unknown') - read (irest2,*) (i2rep(i),i=0,nodes-1) - read (irest2,*) (ifirst(i),i=1,remd_m(1)) - do il=1,nodes - read (irest2,*) nupa(0,il),(nupa(i,il),i=1,nupa(0,il)) - read (irest2,*) ndowna(0,il), - & (ndowna(i,il),i=1,ndowna(0,il)) - enddo - do il=1,nodes - read(irest2,*) (t_restart1(j,il),j=1,4) - enddo - endif - call mpi_scatter(t_restart1,5,mpi_real, - & t5_restart1,5,mpi_real,king,CG_COMM,ierr) - totT=t5_restart1(1) - EK=t5_restart1(2) - potE=t5_restart1(3) - t_bath=t5_restart1(4) - - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - - do i=1,2*nres - do j=1,3 - d_t(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king)then - do il=0,nodes-1 - do i=1,2*nres - read(irest2,'(3e15.5)') - & (d_restart1(j,i+2*nres*il),j=1,3) - enddo - enddo - endif - call mpi_scatter(d_restart1,3*2*nres,mpi_real, - & r_d,3*2*nres,mpi_real,king,CG_COMM,ierr) - do i=1,2*nres - do j=1,3 - dc(j,i)=r_d(j,i) - enddo - enddo - if(me.eq.king) close(irest2) - return - end -c------------------------------------------------------------------- - subroutine set_hweights(iiset) - implicit real*8 (a-h,o-z) - integer i - include 'DIMENSIONS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - - do i=1,n_ene - weights(i)=hweights(iiset,i) - enddo - - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - return - end -#endif diff --git a/source/unres/src_MD-restraints/Makefile b/source/unres/src_MD-restraints/Makefile deleted file mode 120000 index 8453cdd..0000000 --- a/source/unres/src_MD-restraints/Makefile +++ /dev/null @@ -1 +0,0 @@ -Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/unres/src_MD-restraints/Makefile-intrepid-with-tau b/source/unres/src_MD-restraints/Makefile-intrepid-with-tau deleted file mode 100644 index eae1cc5..0000000 --- a/source/unres/src_MD-restraints/Makefile-intrepid-with-tau +++ /dev/null @@ -1,154 +0,0 @@ -# -FC1=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -FC=tau_f90.sh -OPT = -O3 -qarch=450 -qtune=450 -qfixed -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT = -O -qarch=450 -qtune=450 -qfixed -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT = -O0 -C -g -qarch=450 -qtune=450 -qfixed -OPT1 = -O0 -g -qarch=450 -qtune=450 -qfixed -OPT2 = -O2 -qarch=450 -qtune=450 -qfixed -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT2 = ${OPT} -OPTE = -O4 -qarch=450 -qtune=450 -qfixed -#OPTE = -O4 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPTE=${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-O4-test.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} --print-map ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o; /bin/rm *.pp.* - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -compinfo: compinfo.o - ${CC} ${CFLAGS} compfinfo.c - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -prng_32.o: prng_32.F - ${FC} -qfixed -O0 prng_32.F - -prng.o: prng.f - ${FC1} ${FFLAGS} prng.f - -readrtns_CSA.o: readrtns_CSA.F - ${FC1} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC1} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F diff --git a/source/unres/src_MD-restraints/Makefile.tau-mpi-f77-pdt b/source/unres/src_MD-restraints/Makefile.tau-mpi-f77-pdt deleted file mode 100644 index c8dc5fe..0000000 --- a/source/unres/src_MD-restraints/Makefile.tau-mpi-f77-pdt +++ /dev/null @@ -1,860 +0,0 @@ -#**************************************************************************** -#* TAU Portable Profiling Package ** -#* http://www.cs.uoregon.edu/research/tau ** -#**************************************************************************** -#* Copyright 1997-2002 ** -#* Department of Computer and Information Science, University of Oregon ** -#* Advanced Computing Laboratory, Los Alamos National Laboratory ** -#**************************************************************************** -####################################################################### -## pC++/Sage++ Copyright (C) 1993,1995 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -####################################################################### -# This is a sample Makefile that contains the Profiling and Tracing -# options. Makefiles of other applications and libraries (not included -# in this distribution) should include this Makefile. -# It defines the following variables that should be added to CFLAGS -# TAU_INCLUDE - Include path for tau headers -# TAU_DEFS - Defines that are needed for tracing and profiling only. -# And for linking add to LIBS -# TAU_LIBS - TAU Tracing and Profiling library libprof.a -# -# When the user needs to turn off tracing and profiling and run the -# application without any runtime overhead of instrumentation, simply -# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep -# TAUINC. -####################################################################### - -########### Automatically modified by the configure script ############ -CONFIG_ARCH=bgp -TAU_ARCH=bgp -CONFIG_CC=bgxlc_r -CONFIG_CXX=bgxlC_r -TAU_CC_FE=$(CONFIG_CC) -TAU_CXX_FE=$(CONFIG_CXX) - -# Front end C/C++ Compilers -#BGL#TAU_CC_FE=xlc #ENDIF# -#BGL#TAU_CXX_FE=xlC #ENDIF# -TAU_CC_FE=xlc #ENDIF##BGP# -TAU_CXX_FE=xlC #ENDIF##BGP# -#CATAMOUNT#TAU_CC_FE=gcc #ENDIF# -#CATAMOUNT#TAU_CXX_FE=g++ #ENDIF# -#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF# -#SC_GFORTRAN#TAU_CXX_FE=g++ #ENDIF# -#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF# -#SC_PATHSCALE#TAU_CXX_FE=g++ #ENDIF# - -PCXX_OPT=-g -USER_OPT= -EXTRADIR=/opt/ibmcmp/xlf/bg/11.1/bin/.. -EXTRADIRCXX=/opt/ibmcmp/vacpp/bg/9.0/bin/.. -TAUROOT=/soft/apps/tau/tau_latest -TULIPDIR= -TAUEXTRASHLIBOPTS= -TAUGCCLIBOPTS= -TAUGCCLIBDIR= -TAUGFORTRANLIBDIR= -PCLDIR= -PAPIDIR= -PAPISUBDIR= -CHARMDIR= -PDTDIR=/soft/apps/tau/pdtoolkit-3.12 -PDTCOMPDIR= -DYNINSTDIR= -JDKDIR= -SLOG2DIR= -OPARIDIR= -TAU_OPARI_TOOL= -EPILOGDIR= -EPILOGBINDIR= -EPILOGINCDIR= -EPILOGLIBDIR= -EPILOGEXTRALINKCMD= -VAMPIRTRACEDIR= -KTAU_INCDIR= -KTAU_INCUSERDIR= -KTAU_LIB= -KTAU_KALLSYMS_PATH= -PYTHON_INCDIR= -PYTHON_LIBDIR= -PERFINCDIR= -PERFLIBDIR= -PERFLIBRARY= -TAU_SHMEM_INC= -TAU_SHMEM_LIB= -TAU_CONFIG=-mpi-pdt -TAU_MPI_INC=-I/bgsys/drivers/ppcfloor/comm/include -TAU_MPI_LIB=-L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_FLIB=-lfmpich.cnk -L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPILIB_DIR=/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_LIB= -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_FLIB=-lfmpich.cnk -L/bgsys/drivers/ppcfloor/comm/lib -FULL_CXX=mpixlcxx_r -FULL_CC=mpixlc_r -TAU_PREFIX_INSTALL_DIR=/soft/apps/tau/tau_latest - -TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin -TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include -TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib - -####################################################################### - -#OPARI#TAU_OPARI_TOOL=$(TAU_BIN_DIR)/opari #ENDIF# -#ENABLE64BIT#ABI = -64 #ENDIF# -#ENABLEN32BIT#ABI = -n32 #ENDIF# -#ENABLE32BIT#ABI = -32 #ENDIF# - -####################################################################### -#SP1#IBM_XLC_ABI = -q32 #ENDIF# -#SP1#IBM_GNU_ABI = -maix32 #ENDIF# -#IBM64#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64#IBM_GNU_ABI = -maix64 #ENDIF# -#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF# -#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF# -#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF# -#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF# -#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF# -#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF# -#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF# -#MIPS32#ABI = $(SC_ABI) #ENDIF# -#MIPS64#ABI = $(SC_ABI) #ENDIF# - -IBM_ABI = $(IBM_XLC_ABI) #ENDIF##USE_IBMXLC# -#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF# -#SP1# ABI = $(IBM_ABI) #ENDIF# -#PPC64# ABI = $(IBM_ABI) #ENDIF# -#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF# -#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF# -#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF# -#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF# -#SOL2#ABI = $(SUN_ABI) #ENDIF# -#SUNX86_64#ABI = $(SUN_ABI) #ENDIF# -#FORCEIA32#ABI = -m32#ENDIF# -####################################################################### -F90_ABI = $(ABI) -#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF# -####################################################################### - -############# Standard Defines ############## -TAU_CC = $(CONFIG_CC) $(ABI) $(ISA) -TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA) -TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA) -TAU_INSTALL = /bin/cp -TAU_SHELL = /bin/sh -LSX = .a -############################################# -# JAVA DEFAULT ARCH -############################################# -JDKARCH = linux -#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF# -#SOL2#JDKARCH = solaris #ENDIF# -#SGIMP#JDKARCH = irix #ENDIF# -#SP1#JDKARCH = aix #ENDIF# -#T3E#JDKARCH = cray #ENDIF# -############################################# -# JAVA OBJECTS -############################################# -#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF# -#JAVA#TAUJAPI = Profile.class #ENDIF# - - -############################################# -# OpenMP OBJECTS -############################################# -#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF# - -############################################# -# Opari OBJECTS -############################################# -#OPARI#OPARI_O = TauOpari.o #ENDIF# -#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF# -#EPILOG#OPARI_O = #ENDIF# -#VAMPIRTRACE#OPARI_O = #ENDIF# -#GNU#OPARI_O = #ENDIF# - -############################################# -# CallPath OBJECTS -############################################# -#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF# -#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF# - -############################################# -# Python Binding OBJECTS -############################################# -#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF# - -############################################# -# DYNINST DEFAULT ARCH -############################################# -DYNINST_PLATFORM = $(PLATFORM) - - -#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF# - -############# OpenMP Fortran Option ######## -#OPENMP#TAU_F90_OPT = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF# -#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF# -#GUIDE#TAU_F90_OPT = #ENDIF# -#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF# -#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF# -#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF# - -TAU_R =_r #ENDIF##THREADSAFE_COMPILERS# - -############# Fortran Compiler ############# -#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = xlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##IBM_FORTRAN# -TAU_F90 = mpixlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##BGP# -#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_FORTRAN#TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_CATAMOUNT#TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# - - -############# Portable F90 Options ############# -#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -TAU_F90_FIXED = -qfixed #ENDIF##IBM_FORTRAN# -TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF##IBM_FORTRAN# -#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF# -#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# - -############# Profiling Options ############# -PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE# -#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF# -#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF# -#PCL#PCL_O = PclLayer.o #ENDIF# -#PAPI#PAPI_O = PapiLayer.o #ENDIF# -#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF# -#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF# -#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF# -#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF# -PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB# -#CRAYX1CC#PROFILEOPT7 = #ENDIF# -#CRAYCC#PROFILEOPT7 = #ENDIF# -#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF# -#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF# -#RTTI#PROFILEOPT9 = -DRTTI #ENDIF# -#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF# -#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF# -#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF# -#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF# -#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF# -#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF# -#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF# -#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF# -#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF# -#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF# -#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF# -#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF# -#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF# -#TRACE#TRACEOPT = -DTRACING_ON #ENDIF# -#TRACE#EVENTS_O = Tracer.o #ENDIF# -#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF# -#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF# -#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF# -#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF# -#MPITRACE#EVENTS_O = Tracer.o #ENDIF# -#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF# -#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF# -#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF# -#TAU_SPROC#THR_O = SprocLayer.o #ENDIF# -#JAVA#THR_O = JavaThreadLayer.o #ENDIF# -#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF# -#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF# -#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF# -#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF# -#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF# -#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#PGI#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF# -#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF# -#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF# -#HPGNU#PROFILEOPT21 = -fPIC #ENDIF# -#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF# -#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF# -#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF# -#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF# -PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF##USE_IBMXLC# -#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF# -#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF# -#JAVA#PROFILEOPT23 = -DJAVA #ENDIF# -#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF# -#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF# -PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI# -PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED# -#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF# -#GNU#PROFILEOPT27 = #ENDIF# -#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF# -#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF# -#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF# -#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF# -#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF# -#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF# -#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF# -#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF# -#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF# -#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF# -#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -#BGPTIMERS#PROFILEOPT30 = -DBGP_TIMERS -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF# -#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF# -#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF# -#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF# -#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF# -#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF# -#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF# -#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF# -#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#SCALASCA#PROFILEOPT36 = -DTAU_SCALASCA -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF# -#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF# -#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF# -#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF# -#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF# -#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF# -#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF# -#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF# -#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF# -#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF# -#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF# -#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF# -# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore -#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF# -PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST# -#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF# -PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP# -PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER# -#CATAMOUNT#PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF# -#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF# -PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR# -PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX# -PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR# -#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF# - -#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF# -#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF# -#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF# -#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE -D__xlc__ #ENDIF##BGP# -# Omit the -D_LARGETFILE64_SOURCE till we can check the IBM crash -#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF# -#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF# -#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF# -#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF# -#WEAKMPIINIT#PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF# -#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF# -#MPICH_IGNORE_CXX_SEEK#PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF# -PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##BGP# -#MPICH2_MPI_INPLACE#PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF# - - -############# RENCI Scalable Trace Lib Options ############# -STFF_DIR= -SDDF_DIR= -#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF# -#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF# -#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF# - -############# KTAU (again) ############# -#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF# - -#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF# - -#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -PROFILEOPT72 = -DTAU_BGP -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF##BGP# - -#For F90 support for all platforms -FWRAPPER = TauFMpi.o -MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2# -MPI2EXTENSIONS = #ENDIF##BGP# -#CRAYX1CC#MPI2EXTENSIONS = #ENDIF# - -#SGICOUNTERS#LEXTRA = -lperfex #ENDIF# -#ALPHATIMERS#LEXTRA = -lrt #ENDIF# -#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF# -#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF# -#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# -#Due to some problems with older versions of libpfm, we are using the static lib -#IA64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#PAPIPFM##LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF# -#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF# -#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF# -#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF# -#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF# -#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF# -#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF# -#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF# - -TAU_PAPI_EXTRA_FLAGS = $(LEXTRA) -#IA64PAPI#TAU_PAPI_EXTRA_FLAGS = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# - - -# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis. -#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#PAPI##TAU_PAPI_RPATH = #ENDIF# -#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF# -#BGLPAPI#TAU_PAPI_RPATH = #ENDIF# -#BGPPAPI#TAU_PAPI_RPATH = #ENDIF# -#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF# -#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF# -#PGI#TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF# - -# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath -# because they are likely going to link with ifort -#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF# -#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF# -#IBMPAPI#TAU_PAPI_RPATH = #ENDIF# -#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF# -#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF# - -#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF# -#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF# -#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF# -#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF# - -TAU_GCCLIB = -lgcc_s -TAU_GCCLIB = #ENDIF##BGP# -#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF# -#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF# -#BGL#TAU_GCCLIB = -lgcc #ENDIF# -#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF# -#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF# -#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF# -#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF# -#GNU_GFORTRAN#TAU_FORTRANLIBS = -L$(TAUGFORTRANLIBDIR) -lgfortran -lgfortranbegin #ENDIF# -#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF# -TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF##IBM_FORTRAN# - -TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF# -#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF# -TAU_FORLIBDIR=lib #ENDIF##IBM_FORTRAN# -#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF# -TAU_FORLIBDIR=bglib #ENDIF##BGP# -#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF# -#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF# - -TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF##BGP# -#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF# -TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF##BGP# -TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF##BGP# - -#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#PGI_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF# -#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF# -#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF# -#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF# -#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF# -#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF# -#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF# -# LINKER OPTIONS -TAU_LINKER_OPT2 = $(LEXTRA) - - -#ACC#TAUHELPER = -AA #ENDIF# -#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF# -#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF# -#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF# -#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF# -#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF# -#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF# -#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF# -#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF# -#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF# -#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF# -#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF# - - -#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF# - -## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add -#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF# -#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF# -#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#PGI#TAU_CXXLIBS = -lstd -lC #ENDIF# -#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF# -#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF# - -TAU_SGI_INIT = /usr/lib32/c++init.o -#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF# -#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF# -#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF# - -#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF# -#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF# -#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF# -#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF# -#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF# -#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF# -#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF# -#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF# -TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF##BGP# -#SP1#TAU_XLCLIBS = -lC #ENDIF# -TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF##USE_IBMXLC# -#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF# -#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF# - -# EXTERNAL PACKAGES: VAMPIRTRACE -#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# - -# EXTERNAL PACKAGES: EPILOG -#SCALASCA#TAU_ELG_SERIAL_SUFFIX =.ser #ENDIF# -#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg$(TAU_ELG_SERIAL_SUFFIX) $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# - -# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up -#FORCESHARED#TAU_LINKER_OPT3=#ENDIF# - -TAU_LINKER_OPT4 = $(LEXTRA1) -#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF# -#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF# -#GNU#TAU_LINKER_OPT5 = #ENDIF# -#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF# -#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#GUIDE#TAU_LINKER_OPT5 = #ENDIF# -#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF# - -# MALLINFO needs -lmalloc on sgi, sun -#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SOL2#TAU_LINKER_OPT6 = #ENDIF# -#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF# - -# We need -lCio with SGI CC 7.4+ -#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF# - -# charm -#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF# - -# extra libs -#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF# - -#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF# - -TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF# -#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF# - -TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF# -#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF# - - -#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF# -#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF# -#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF# -#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF# -#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF# -#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF# - -TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI# -#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# -#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# - -############################################## -# Build TAU_LINKER_SHOPTS -#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF# -TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF##USE_IBMXLC# -#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF# -#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF# - -############################################## -# MPI _r suffix check (as in libmpi_r) -#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF# - -############################################## -# Flags to build a shared object: TAU_SHFLAGS -#GNU#AR_SHFLAGS = -shared #ENDIF# -#PGI#AR_SHFLAGS = -shared #ENDIF# -#SGICC#AR_SHFLAGS = -shared #ENDIF# -#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF# -#SOL2#AR_SHFLAGS = -G #ENDIF# -#SUN386I#AR_SHFLAGS = -G #ENDIF# -#SUNX86_64#AR_SHFLAGS = -G #ENDIF# -AR_SHFLAGS = -G #ENDIF##USE_IBMXLC# -#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF# -#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF# -#ACC#AR_SHFLAGS = -b #ENDIF# -TAU_SHFLAGS = $(AR_SHFLAGS) -o - -############# RANLIB Options ############# -TAU_RANLIB = echo "Built" -#APPLECXX#TAU_RANLIB = ranlib #ENDIF# -#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF# - -############################################## -TAU_AR = ar #ENDIF# -#SP1#TAU_AR = ar -X32 #ENDIF# -#IBM64#TAU_AR = ar -X64 #ENDIF# -#PPC64#TAU_AR = ar #ENDIF# -#IBM64LINUX#TAU_AR = ar #ENDIF# - - -############################################## -# PDT OPTIONS -# You can specify -pdtcompdir=intel -pdtarchdir=x86_64 -# If nothing is specified, PDTARCHDIR uses TAU_ARCH -PDTARCHDIRORIG=$(TAU_ARCH) -PDTARCHITECTURE=x86_64 -PDTARCHDIRFINAL=$(PDTARCHDIRORIG) -#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF# -PDTARCHDIR=$(PDTARCHDIRFINAL) -#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF# - - -############################################## - -PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \ - $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \ - $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \ - $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \ - $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \ - $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \ - $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \ - $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \ - $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \ - $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \ - $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \ - $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \ - $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \ - $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \ - $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \ - $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \ - $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \ - $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \ - $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \ - $(TRACEOPT) - -############################################## - -TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \ - $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \ - $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \ - $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12) - -############################################## - -############# TAU Fortran #################### -TAU_LINKER=$(TAU_CXX) -#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -# Intel efc compiler acts as a linker - NO. Let C++ be the linker. - -############################################## -############# TAU Options #################### -TAUDEFS = $(PROFILEOPTS) - -TAUINC = -I$(TAU_INC_DIR) - -TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAUMPILIBS = $(TAU_MPI_LIB) - -TAUMPIFLIBS = $(TAU_MPI_FLIB) - -### ACL S/W requirement -TAU_DEFS = $(TAUDEFS) - -TAU_INCLUDE = -I$(TAU_INC_DIR) -#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF# -#PERFLIB#TAU_DEFS = #ENDIF# -#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF# - -TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory -#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# -#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# - -TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) -#PERFLIB#TAU_LIBS = #ENDIF# - -TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) -#PERFLIB#TAU_SHLIBS = #ENDIF# -TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) - -TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable - -TAU_MPI_INCLUDE = $(TAU_MPI_INC) - -TAU_MPI_LIBS = $(TAU_MPI_LIB) - -TAU_MPI_FLIBS = $(TAU_MPI_FLIB) - -## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL) -TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG) - -## Don't include -lpthread or -lsmarts. Let app. do that. -############################################# -## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS -#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF# -TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI# -#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF# -#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF# -TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI# -TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI# -TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI# -TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI# - -#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF# -#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF# -############################################# -#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF# -#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF# -#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF# - -TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC) - -TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB) -############################################# -# TAU COMPILER SHELL SCRIPT OPTIONS -TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\ - -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \ - -optNoMpi \ - -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \ - -optTauCC="$(TAU_CC)" \ - -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \ - -optTauDefs="$(TAU_DEFS)" \ - -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\ - -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - $(TAU_COMPILER_EXTRA_OPTIONS) \ - -optIncludeMemory="$(TAU_INCLUDE_MEMORY)" -############################################# - -TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) -SHAREDEXTRAS= -#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF# -TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS) -############################################# -# These options could be included in the application Makefile as -#CFLAGS = $(TAUDEFS) $(TAUINC) -# -#LIBS = $(TAULIBS) -# -# To run the application without Profiling/Tracing use -#CFLAGS = $(TAUINC) -# Don't use TAUDEFS but do include TAUINC -# Also ignore TAULIBS when Profiling/Tracing is not used. -############################################# - diff --git a/source/unres/src_MD-restraints/Makefile_MPICH_PGI b/source/unres/src_MD-restraints/Makefile_MPICH_PGI deleted file mode 100644 index f55b08f..0000000 --- a/source/unres/src_MD-restraints/Makefile_MPICH_PGI +++ /dev/null @@ -1,126 +0,0 @@ -FC= mpif90 -OPT = -fast - -FFLAGS = -c ${OPT} -#FFLAGS = -c -g -C -FFLAGS1 = -c -g -FFLAGS2 = -c -g -O0 -FFLAGSE = -c -fast -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 - -CFLAGS = -c -DLINUX -DPGI - -LIBS = xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - -LIBS = xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o proc_proc.o\ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = /users/adam/bin/unres_PGI_MPI_GAB-r.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = /users/adam/bin/unres_PGI_MPI_E0LL2Y-r.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_MPICH_ifort b/source/unres/src_MD-restraints/Makefile_MPICH_ifort deleted file mode 100644 index 1884373..0000000 --- a/source/unres/src_MD-restraints/Makefile_MPICH_ifort +++ /dev/null @@ -1,127 +0,0 @@ -################################################################### -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - - -FC= ifort - -OPT = -O3 -ip - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -O3 -ipo -opt_report -I$(INSTALL_DIR)/include - - -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - - -all: no_option - @echo "give optin GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -no_option: - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_GAB-restr.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_E0LL2Y-restr.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_aix_xlf b/source/unres/src_MD-restraints/Makefile_aix_xlf deleted file mode 100644 index b226425..0000000 --- a/source/unres/src_MD-restraints/Makefile_aix_xlf +++ /dev/null @@ -1,113 +0,0 @@ -CPPFLAGS = -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DSPLITELE -WF,-DISNAN -WF,-DAIX -#-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -INSTALL_DIR = -# -FC= mpxlf90 -qfixed -w - -OPT = -q64 - -FFLAGS = -c ${OPT} -O3 -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_MD.exe -LIBS = -qipa - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F diff --git a/source/unres/src_MD-restraints/Makefile_bigben b/source/unres/src_MD-restraints/Makefile_bigben deleted file mode 100644 index 261dd8e..0000000 --- a/source/unres/src_MD-restraints/Makefile_bigben +++ /dev/null @@ -1,138 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = ${OPT} -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \ -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DPARVEC #-DPARINT -DPARINTDER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_bigben-oldparm b/source/unres/src_MD-restraints/Makefile_bigben-oldparm deleted file mode 100644 index 87d66c7..0000000 --- a/source/unres/src_MD-restraints/Makefile_bigben-oldparm +++ /dev/null @@ -1,136 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-matgather-oldparm.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC -DPARINT -DPARINTDER \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_bigben-tau b/source/unres/src_MD-restraints/Makefile_bigben-tau deleted file mode 100644 index ee02905..0000000 --- a/source/unres/src_MD-restraints/Makefile_bigben-tau +++ /dev/null @@ -1,137 +0,0 @@ -# -#FC= ftn -TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi -FC=tau_f90.sh -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-noparint-barrier-tau.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.pp.[fF] *.pp.inst.[fF] - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_galera b/source/unres/src_MD-restraints/Makefile_galera deleted file mode 100644 index 899ec63..0000000 --- a/source/unres/src_MD-restraints/Makefile_galera +++ /dev/null @@ -1,147 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -#INSTALL_DIR = /users/software/mpich2.x86_64/ -#INSTALL_DIR = /opt/mpi/mvapich2 -INSTALL_DIR = /opt/mpi/mvapich - -FC= ifort -FCL= ${INSTALL_DIR}/bin/mpif77 - -OPT = -O3 -ip -w -xHost - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -xHost -O3 -ipo -ipo_obj -no-prec-div -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_hremd_mpich1.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FCL} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_intrepid b/source/unres/src_MD-restraints/Makefile_intrepid deleted file mode 100644 index 2b57f9e..0000000 --- a/source/unres/src_MD-restraints/Makefile_intrepid +++ /dev/null @@ -1,151 +0,0 @@ -# -FC=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -OPT = -O4 -qarch=450 -qtune=450 -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -#OPT = -O -qarch=450 -qtune=450 -#OPT = -O0 -C -g -qarch=450 -qtune=450 #-qdebug=function_trace -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT1 = -O -g -qarch=450 -qtune=450 -#OPT1 = -O -g -qarch=450 -qtune=450 -qdebug=function_trace -OPT1 = ${OPT} -#OPT2 = -O2 -qarch=450 -qtune=450 -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -OPT2 = ${OPT} -#OPTE = -O4 -qarch=450 -qtune=450 -#OPTE = -O4 -qarch=450 -qtune=450 -OPTE=${OPT} - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-O4-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-PARINT-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-parvecmatint-O4-notau1.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-notau1.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 -#-WF,-DPARINT -WF,-DPARINTDER -#-WF,-DPARVEC -WF,-DPARMAT -WF,-DMATGATHER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -obj: ${object} - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -compinfo: compinfo.c - ${CC} ${CFLAGS} compinfo.c diff --git a/source/unres/src_MD-restraints/Makefile_nostromo b/source/unres/src_MD-restraints/Makefile_nostromo deleted file mode 100644 index bcacd76..0000000 --- a/source/unres/src_MD-restraints/Makefile_nostromo +++ /dev/null @@ -1,135 +0,0 @@ -# -FC = mpixlf77 -#OPT = -O4 -qarch=qp -qtune=qp -qnocr -#OPT = -O3 -qarch=qp -qtune=qp -qdebug=function_trace -#OPT = -O -qarch=qp -qtune=qp -OPT = -O0 -C -g -qarch=qp -qtune=qp #-qdebug=function_trace -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT1 = -O -g -qarch=qp -qtune=qp -#OPT1 = -O -g -qarch=qp -qtune=qp -qdebug=function_trace -#OPT1 = ${OPT} -OPT2 = -O2 -qarch=qp -qtune=qp -#OPT2 = -O2 -qarch=qp -qtune=qp -qdebug=function_trace -#OPT2 = ${OPT} -#OPTE = -O4 -qarch=qp -qtune=qp -#OPTE = -O4 -qarch=qp -qtune=qp -OPTE=${OPT} - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -LIBS = xdrf/libxdrf.a - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -WF,-DAIX -WF,-DPROCOR -WF,-DLINUX -WF,-DPGI -WF,-DUNRES -WF,-DISNAN -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DLANG0 -WF,-DCRYST_BOND -WF,-DCRYST_THETA -WF,-DCRYST_SC -GAB: BIN = ../bin/unres_xlf77_MPI_GAB-r.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -WF,-DAIX -WF,-DPROCOR -WF,-DLINUX -WF,-DPGI -WF,-DUNRES -WF,-DISNAN -WF,-DMP -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DLANG0 -E0LL2Y: BIN = ../bin/unres_xlf77_MPI_E0LL2Y-r.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_single_gfortran b/source/unres/src_MD-restraints/Makefile_single_gfortran deleted file mode 100644 index 3ef2052..0000000 --- a/source/unres/src_MD-restraints/Makefile_single_gfortran +++ /dev/null @@ -1,130 +0,0 @@ -FC= gfortran -FFLAGS = -c ${OPT} -I. -FFLAGS1 = -c ${OPT1} -I. - -CC = cc - -CFLAGS = -DLINUX -DPGI -c - -OPT = -O -fbounds-check -g -OPT1 = -g - -#OPT = -fbounds-check -g -#OPT1 = -g - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -LIBS = -Lxdrf -lxdrf -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: - @echo "Specify force field: GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng_32.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_gfortran_single_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_gfortran_single_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -newconf.o: newconf.F - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.F - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS1} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS1} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS1} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -fitsq.o: fitsq.f - ${FC} ${FFLAGS1} ${CPPFLAGS} fitsq.f - -rmsd.o: rmsd.F - ${FC} ${FFLAGS1} ${CPPFLAGS} rmsd.F - -contact.o: contact.f - ${FC} ${FFLAGS1} ${CPPFLAGS} contact.f - -minim_jlee.o: minim_jlee.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minim_jlee.F - -minimize_p.o: minimize_p.F - ${FC} ${FFLAGS1} ${CPPFLAGS} minimize_p.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F - - -test.o: test.F - ${FC} ${FFLAGS1} ${CPPFLAGS} test.F - -elecont.o: elecont.f - ${FC} ${FFLAGS} ${CPPFLAGS} elecont.f - -eigen.o: eigen.f - ${FC} ${FFLAGS1} eigen.f - -blas.o: blas.f - ${FC} ${FFLAGS1} blas.f - -add.o: add.f - ${FC} ${FFLAGS1} add.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/Makefile_single_ifort b/source/unres/src_MD-restraints/Makefile_single_ifort deleted file mode 100644 index c651e39..0000000 --- a/source/unres/src_MD-restraints/Makefile_single_ifort +++ /dev/null @@ -1,127 +0,0 @@ -FC = ifort -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - -CC = cc - -CFLAGS = -DLINUX -DPGI -c - -OPT = -O3 -ip -w - -# -Mvect <---slows down -# -Minline=name:matmat2 <---false convergence - -LIBS = -Lxdrf -lxdrf -#-DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -ARCH = LINUX -PP = /lib/cpp -P - -all: - @echo "Specify force field: GAB or E0LL2Y" - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ - banach.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o ssMD.o - -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_ifort_single_GAB.exe -GAB: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ - -DSPLITELE -DLANG0 -E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_single_E0LL2Y.exe -E0LL2Y: ${object} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - -xdrf/libxdrf.a: - cd xdrf && make - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD-restraints/README b/source/unres/src_MD-restraints/README deleted file mode 100644 index 2b1d2be..0000000 --- a/source/unres/src_MD-restraints/README +++ /dev/null @@ -1,2 +0,0 @@ -The program will fail if there is no "Makefile" file. -You must copy (cp MakeXXXX Makefile) or use a symbolic link (ln -s MakeXXXX Makefile) before compiling. diff --git a/source/unres/src_MD-restraints/add.f b/source/unres/src_MD-restraints/add.f deleted file mode 100644 index fd91a70..0000000 --- a/source/unres/src_MD-restraints/add.f +++ /dev/null @@ -1,28 +0,0 @@ - SUBROUTINE ABRT - STOP 'IN ABRT' - END -C*MODULE MTHLIB *DECK VCLR - SUBROUTINE VCLR(A,INCA,N) -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) -C - DIMENSION A(*) -C - PARAMETER (ZERO=0.0D+00) -C -C ----- ZERO OUT VECTOR -A-, USING INCREMENT -INCA- ----- -C - IF (INCA .NE. 1) GO TO 200 - DO 110 L=1,N - A(L) = ZERO - 110 CONTINUE - RETURN -C - 200 CONTINUE - LA=1-INCA - DO 210 L=1,N - LA=LA+INCA - A(LA) = ZERO - 210 CONTINUE - RETURN - END diff --git a/source/unres/src_MD-restraints/arcos.f b/source/unres/src_MD-restraints/arcos.f deleted file mode 100644 index f054118..0000000 --- a/source/unres/src_MD-restraints/arcos.f +++ /dev/null @@ -1,9 +0,0 @@ - FUNCTION ARCOS(X) - implicit real*8 (a-h,o-z) - include 'COMMON.GEO' - IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=PIPOL*(1.0d0-DSIGN(1.0D0,X)) - RETURN - 1 ARCOS=DACOS(X) - RETURN - END diff --git a/source/unres/src_MD-restraints/banach.f b/source/unres/src_MD-restraints/banach.f deleted file mode 100644 index 7c43d77..0000000 --- a/source/unres/src_MD-restraints/banach.f +++ /dev/null @@ -1,99 +0,0 @@ -C -C********************** - SUBROUTINE BANACH(N,NMAX,A,X,osob) -C********************** -C Banachiewicz - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6) - COMMON /BANII/ D - logical osob - osob=.false. - if (dabs(a(1,1)).lt.1.0d-15) then - osob=.true. - return - endif - D(1)=1./A(1,1) - DO 80 I=2,N - A(I,1)=A(1,I) - DO 81 J=2,I-1 - XX=A(J,I) - DO 82 K=1,J-1 - XX=XX-A(I,K)*A(J,K) - 82 CONTINUE - A(I,J)=XX - 81 CONTINUE - XX=A(I,I) - JJJJ=I-1 - DO 83 J=1,JJJJ - AIJ=A(I,J) - AIJD=AIJ*D(J) - A(I,J)=AIJD - XX=XX-AIJ*AIJD - 83 CONTINUE - if (dabs(xx).lt.1.0d-15) then - osob=.true. - return - endif - D(I)=1./XX - 80 CONTINUE -C - CALL BANAII(N,NMAX,A,X) - RETURN - END -C************************ - SUBROUTINE BANAII(N,NMAX,A,X) -C************************ - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),X(NMAX),D(MAXRES6) - COMMON /BANII/ D - DO 90 I=1,N - Z=X(I) - JJJJ=I-1 - DO 91 J=JJJJ,1,-1 - Z=Z-A(I,J)*X(J) - 91 CONTINUE - X(I)=Z - 90 CONTINUE - DO 92 I=N,1,-1 - Z=X(I)*D(I) - JJJJ=I+1 - DO 93 J=JJJJ,N - Z=Z-A(J,I)*X(J) - 93 CONTINUE - X(I)=Z - 92 CONTINUE - RETURN - END -C - SUBROUTINE MATINVERT(N,NMAX,A,A1,osob) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A(NMAX,NMAX),A1(NMAX,NMAX),D(MAXRES6) - COMMON /BANII/ D - DIMENSION X(NMAX) - logical osob - DO I=1,N - X(I)=0.0 - ENDDO - X(1)=1.0 - CALL BANACH(N,NMAX,A,X,osob) - if (osob) return - DO I=1,N - A1(I,1)=X(I) - ENDDO - DO I=2,N - DO J=1,N - X(J)=0.0 - ENDDO - X(I)=1.0 - CALL BANAII(N,NMAX,A,X) - DO J=1,N - A1(J,I)=X(J) - ENDDO - ENDDO - RETURN - END - - diff --git a/source/unres/src_MD-restraints/blas.f b/source/unres/src_MD-restraints/blas.f deleted file mode 100644 index 142d821..0000000 --- a/source/unres/src_MD-restraints/blas.f +++ /dev/null @@ -1,575 +0,0 @@ -C 10 NOV 94 - MWS - DNRM2: REMOVE FTNCHECK WARNINGS -C 11 JUN 94 - MWS - INCLUDE A COPY OF DGEMV (LEVEL TWO ROUTINE) -C 11 AUG 87 - MWS - SANITIZE FLOATING POINT CONSTANTS IN DNRM2 -C 26 MAR 87 - MWS - USE GENERIC SIGN IN DROTG -C 28 NOV 86 - STE - SUPPLY ALL LEVEL ONE BLAS -C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS -C -C BASIC LINEAR ALGEBRA SUBPROGRAMS (BLAS) FROM LINPACK (LEVEL 1) -C -C THIS MODULE SHOULD BE COMPILED ONLY IF SPECIALLY CODED -C VERSIONS OF THESE ROUTINES ARE NOT AVAILABLE ON THE TARGET MACHINE -C -C*MODULE BLAS1 *DECK DASUM - DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) -C -C TAKES THE SUM OF THE ABSOLUTE VALUES. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DOUBLE PRECISION DX(1),DTEMP - INTEGER I,INCX,M,MP1,N,NINCX -C - DASUM = 0.0D+00 - DTEMP = 0.0D+00 - IF(N.LE.0)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DTEMP = DTEMP + ABS(DX(I)) - 10 CONTINUE - DASUM = DTEMP - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,6) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + ABS(DX(I)) - 30 CONTINUE - IF( N .LT. 6 ) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,6 - DTEMP = DTEMP + ABS(DX(I)) + ABS(DX(I + 1)) + ABS(DX(I + 2)) - * + ABS(DX(I + 3)) + ABS(DX(I + 4)) + ABS(DX(I + 5)) - 50 CONTINUE - 60 DASUM = DTEMP - RETURN - END -C*MODULE BLAS1 *DECK DAXPY - SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C CONSTANT TIMES A VECTOR PLUS A VECTOR. -C DY(I) = DY(I) + DA * DX(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF (DA .EQ. 0.0D+00) RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DY(IY) = DY(IY) + DA*DX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,4) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DY(I) = DY(I) + DA*DX(I) - 30 CONTINUE - IF( N .LT. 4 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,4 - DY(I) = DY(I) + DA*DX(I) - DY(I + 1) = DY(I + 1) + DA*DX(I + 1) - DY(I + 2) = DY(I + 2) + DA*DX(I + 2) - DY(I + 3) = DY(I + 3) + DA*DX(I + 3) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DCOPY - SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(*),DY(*) -C -C COPIES A VECTOR. -C DY(I) <== DX(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DY(IY) = DX(IX) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,7) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DY(I) = DX(I) - 30 CONTINUE - IF( N .LT. 7 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,7 - DY(I) = DX(I) - DY(I + 1) = DX(I + 1) - DY(I + 2) = DX(I + 2) - DY(I + 3) = DX(I + 3) - DY(I + 4) = DX(I + 4) - DY(I + 5) = DX(I + 5) - DY(I + 6) = DX(I + 6) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DDOT - DOUBLE PRECISION FUNCTION DDOT(N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C FORMS THE DOT PRODUCT OF TWO VECTORS. -C DOT = DX(I) * DY(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DDOT = 0.0D+00 - DTEMP = 0.0D+00 - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS -C NOT EQUAL TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = DTEMP + DX(IX)*DY(IY) - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - DDOT = DTEMP - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,5) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + DX(I)*DY(I) - 30 CONTINUE - IF( N .LT. 5 ) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - DTEMP = DTEMP + DX(I)*DY(I) + DX(I + 1)*DY(I + 1) + - * DX(I + 2)*DY(I + 2) + DX(I + 3)*DY(I + 3) + DX(I + 4)*DY(I + 4) - 50 CONTINUE - 60 DDOT = DTEMP - RETURN - END -C*MODULE BLAS1 *DECK DNRM2 - DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX) - INTEGER NEXT - DOUBLE PRECISION DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE - DATA ZERO, ONE /0.0D+00, 1.0D+00/ -C -C EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE -C INCREMENT INCX . -C IF N .LE. 0 RETURN WITH RESULT = 0. -C IF N .GE. 1 THEN INCX MUST BE .GE. 1 -C -C C.L.LAWSON, 1978 JAN 08 -C -C FOUR PHASE METHOD USING TWO BUILT-IN CONSTANTS THAT ARE -C HOPEFULLY APPLICABLE TO ALL MACHINES. -C CUTLO = MAXIMUM OF SQRT(U/EPS) OVER ALL KNOWN MACHINES. -C CUTHI = MINIMUM OF SQRT(V) OVER ALL KNOWN MACHINES. -C WHERE -C EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1. -C U = SMALLEST POSITIVE NO. (UNDERFLOW LIMIT) -C V = LARGEST NO. (OVERFLOW LIMIT) -C -C BRIEF OUTLINE OF ALGORITHM.. -C -C PHASE 1 SCANS ZERO COMPONENTS. -C MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO -C MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO -C MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M -C WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX. -C -C VALUES FOR CUTLO AND CUTHI.. -C FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER -C DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS.. -C CUTLO, S.P. U/EPS = 2**(-102) FOR HONEYWELL. CLOSE SECONDS ARE -C UNIVAC AND DEC AT 2**(-103) -C THUS CUTLO = 2**(-51) = 4.44089E-16 -C CUTHI, S.P. V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC. -C THUS CUTHI = 2**(63.5) = 1.30438E19 -C CUTLO, D.P. U/EPS = 2**(-67) FOR HONEYWELL AND DEC. -C THUS CUTLO = 2**(-33.5) = 8.23181D-11 -C CUTHI, D.P. SAME AS S.P. CUTHI = 1.30438D+19 -C DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 / -C DATA CUTLO, CUTHI / 4.441E-16, 1.304E19 / - DATA CUTLO, CUTHI / 8.232D-11, 1.304D+19 / -C - J=0 - IF(N .GT. 0) GO TO 10 - DNRM2 = ZERO - GO TO 300 -C - 10 ASSIGN 30 TO NEXT - SUM = ZERO - NN = N * INCX -C BEGIN MAIN LOOP - I = 1 - 20 GO TO NEXT,(30, 50, 70, 110) - 30 IF( ABS(DX(I)) .GT. CUTLO) GO TO 85 - ASSIGN 50 TO NEXT - XMAX = ZERO -C -C PHASE 1. SUM IS ZERO -C - 50 IF( DX(I) .EQ. ZERO) GO TO 200 - IF( ABS(DX(I)) .GT. CUTLO) GO TO 85 -C -C PREPARE FOR PHASE 2. - ASSIGN 70 TO NEXT - GO TO 105 -C -C PREPARE FOR PHASE 4. -C - 100 I = J - ASSIGN 110 TO NEXT - SUM = (SUM / DX(I)) / DX(I) - 105 XMAX = ABS(DX(I)) - GO TO 115 -C -C PHASE 2. SUM IS SMALL. -C SCALE TO AVOID DESTRUCTIVE UNDERFLOW. -C - 70 IF( ABS(DX(I)) .GT. CUTLO ) GO TO 75 -C -C COMMON CODE FOR PHASES 2 AND 4. -C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW. -C - 110 IF( ABS(DX(I)) .LE. XMAX ) GO TO 115 - SUM = ONE + SUM * (XMAX / DX(I))**2 - XMAX = ABS(DX(I)) - GO TO 200 -C - 115 SUM = SUM + (DX(I)/XMAX)**2 - GO TO 200 -C -C -C PREPARE FOR PHASE 3. -C - 75 SUM = (SUM * XMAX) * XMAX -C -C -C FOR REAL OR D.P. SET HITEST = CUTHI/N -C FOR COMPLEX SET HITEST = CUTHI/(2*N) -C - 85 HITEST = CUTHI/N -C -C PHASE 3. SUM IS MID-RANGE. NO SCALING. -C - DO 95 J =I,NN,INCX - IF(ABS(DX(J)) .GE. HITEST) GO TO 100 - 95 SUM = SUM + DX(J)**2 - DNRM2 = SQRT( SUM ) - GO TO 300 -C - 200 CONTINUE - I = I + INCX - IF ( I .LE. NN ) GO TO 20 -C -C END OF MAIN LOOP. -C -C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING. -C - DNRM2 = XMAX * SQRT(SUM) - 300 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DROT - SUBROUTINE DROT (N,DX,INCX,DY,INCY,C,S) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C APPLIES A PLANE ROTATION. -C DX(I) = C*DX(I) + S*DY(I) -C DY(I) = -S*DX(I) + C*DY(I) -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL -C TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = C*DX(IX) + S*DY(IY) - DY(IY) = C*DY(IY) - S*DX(IX) - DX(IX) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C - 20 DO 30 I = 1,N - DTEMP = C*DX(I) + S*DY(I) - DY(I) = C*DY(I) - S*DX(I) - DX(I) = DTEMP - 30 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DROTG - SUBROUTINE DROTG(DA,DB,C,S) -C -C CONSTRUCT GIVENS PLANE ROTATION. -C JACK DONGARRA, LINPACK, 3/11/78. -C - DOUBLE PRECISION DA,DB,C,S,ROE,SCALE,R,Z - DOUBLE PRECISION ZERO, ONE -C - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00) -C -C----------------------------------------------------------------------- -C -C - ROE = DB - IF( ABS(DA) .GT. ABS(DB) ) ROE = DA - SCALE = ABS(DA) + ABS(DB) - IF( SCALE .NE. ZERO ) GO TO 10 - C = ONE - S = ZERO - R = ZERO - GO TO 20 -C - 10 R = SCALE*SQRT((DA/SCALE)**2 + (DB/SCALE)**2) - R = SIGN(ONE,ROE)*R - C = DA/R - S = DB/R - 20 Z = ONE - IF( ABS(DA) .GT. ABS(DB) ) Z = S - IF( ABS(DB) .GE. ABS(DA) .AND. C .NE. ZERO ) Z = ONE/C - DA = R - DB = Z - RETURN - END -C*MODULE BLAS1 *DECK DSCAL - SUBROUTINE DSCAL(N,DA,DX,INCX) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1) -C -C SCALES A VECTOR BY A CONSTANT. -C DX(I) = DA * DX(I) -C USES UNROLLED LOOPS FOR INCREMENT EQUAL TO ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - NINCX = N*INCX - DO 10 I = 1,NINCX,INCX - DX(I) = DA*DX(I) - 10 CONTINUE - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,5) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DX(I) = DA*DX(I) - 30 CONTINUE - IF( N .LT. 5 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,5 - DX(I) = DA*DX(I) - DX(I + 1) = DA*DX(I + 1) - DX(I + 2) = DA*DX(I + 2) - DX(I + 3) = DA*DX(I + 3) - DX(I + 4) = DA*DX(I + 4) - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK DSWAP - SUBROUTINE DSWAP (N,DX,INCX,DY,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1),DY(1) -C -C INTERCHANGES TWO VECTORS. -C DX(I) <==> DY(I) -C USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IF(N.LE.0)RETURN - IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20 -C -C CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL -C TO 1 -C - IX = 1 - IY = 1 - IF(INCX.LT.0)IX = (-N+1)*INCX + 1 - IF(INCY.LT.0)IY = (-N+1)*INCY + 1 - DO 10 I = 1,N - DTEMP = DX(IX) - DX(IX) = DY(IY) - DY(IY) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN -C -C CODE FOR BOTH INCREMENTS EQUAL TO 1 -C -C -C CLEAN-UP LOOP -C - 20 M = MOD(N,3) - IF( M .EQ. 0 ) GO TO 40 - DO 30 I = 1,M - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - 30 CONTINUE - IF( N .LT. 3 ) RETURN - 40 MP1 = M + 1 - DO 50 I = MP1,N,3 - DTEMP = DX(I) - DX(I) = DY(I) - DY(I) = DTEMP - DTEMP = DX(I + 1) - DX(I + 1) = DY(I + 1) - DY(I + 1) = DTEMP - DTEMP = DX(I + 2) - DX(I + 2) = DY(I + 2) - DY(I + 2) = DTEMP - 50 CONTINUE - RETURN - END -C*MODULE BLAS1 *DECK IDAMAX - INTEGER FUNCTION IDAMAX(N,DX,INCX) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION DX(1) -C -C FINDS THE INDEX OF ELEMENT HAVING MAX. ABSOLUTE VALUE. -C JACK DONGARRA, LINPACK, 3/11/78. -C - IDAMAX = 0 - IF( N .LT. 1 ) RETURN - IDAMAX = 1 - IF(N.EQ.1)RETURN - IF(INCX.EQ.1)GO TO 20 -C -C CODE FOR INCREMENT NOT EQUAL TO 1 -C - IX = 1 - RMAX = ABS(DX(1)) - IX = IX + INCX - DO 10 I = 2,N - IF(ABS(DX(IX)).LE.RMAX) GO TO 5 - IDAMAX = I - RMAX = ABS(DX(IX)) - 5 IX = IX + INCX - 10 CONTINUE - RETURN -C -C CODE FOR INCREMENT EQUAL TO 1 -C - 20 RMAX = ABS(DX(1)) - DO 30 I = 2,N - IF(ABS(DX(I)).LE.RMAX) GO TO 30 - IDAMAX = I - RMAX = ABS(DX(I)) - 30 CONTINUE - RETURN - END -C*MODULE BLAS *DECK DGEMV - SUBROUTINE DGEMV(FORMA,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - CHARACTER*1 FORMA - DIMENSION A(LDA,*),X(*),Y(*) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00) -C -C CLONE OF -DGEMV- WRITTEN BY MIKE SCHMIDT -C - LOCY = 1 - IF(FORMA.EQ.'T') GO TO 200 -C -C Y = ALPHA * A * X + BETA * Y -C - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 110 I=1,M - Y(LOCY) = DDOT(N,A(I,1),LDA,X,INCX) - LOCY = LOCY+INCY - 110 CONTINUE - ELSE - DO 120 I=1,M - Y(LOCY) = ALPHA*DDOT(N,A(I,1),LDA,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 120 CONTINUE - END IF - RETURN -C -C Y = ALPHA * A-TRANSPOSE * X + BETA * Y -C - 200 CONTINUE - IF(ALPHA.EQ.ONE .AND. BETA.EQ.ZERO) THEN - DO 210 I=1,N - Y(LOCY) = DDOT(M,A(1,I),1,X,INCX) - LOCY = LOCY+INCY - 210 CONTINUE - ELSE - DO 220 I=1,N - Y(LOCY) = ALPHA*DDOT(M,A(1,I),1,X,INCX) + BETA*Y(LOCY) - LOCY = LOCY+INCY - 220 CONTINUE - END IF - RETURN - END diff --git a/source/unres/src_MD-restraints/bond_move.f b/source/unres/src_MD-restraints/bond_move.f deleted file mode 100644 index 4843f60..0000000 --- a/source/unres/src_MD-restraints/bond_move.f +++ /dev/null @@ -1,124 +0,0 @@ - subroutine bond_move(nbond,nstart,psi,lprint,error) -C Move NBOND fragment starting from the CA(nstart) by angle PSI. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nbond,nstart - double precision psi - logical fail,error,lprint - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - dimension x(3),e(3,3),e1(3),e2(3),e3(3),rot(3,3),trans(3,3) - error=.false. - nend=nstart+nbond - if (print_mc.gt.2) then - write (iout,*) 'nstart=',nstart,' nend=',nend,' nbond=',nbond - write (iout,*) 'psi=',psi - write (iout,'(a)') 'Original coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - if (nstart.lt.1 .or. nend .gt.nres .or. nbond.lt.2 .or. - & nbond.ge.nres-1) then - write (iout,'(a)') 'Bad data in BOND_MOVE.' - error=.true. - return - endif -C Generate the reference system. - i2=nend - i3=nstart - i4=nstart+1 - call refsys(i2,i3,i4,e1,e2,e3,error) -C Return, if couldn't define the reference system. - if (error) return -C Compute the transformation matrix. - cospsi=dcos(psi) - sinpsi=dsin(psi) - rot(1,1)=1.0D0 - rot(1,2)=0.0D0 - rot(1,3)=0.0D0 - rot(2,1)=0.0D0 - rot(2,2)=cospsi - rot(2,3)=-sinpsi - rot(3,1)=0.0D0 - rot(3,2)=sinpsi - rot(3,3)=cospsi - do i=1,3 - e(1,i)=e1(i) - e(2,i)=e2(i) - e(3,i)=e3(i) - enddo - - if (print_mc.gt.2) then - write (iout,'(a)') 'Reference system and matrix r:' - do i=1,3 - write(iout,'(i5,2(3f10.5,5x))')i,(e(i,j),j=1,3),(rot(i,j),j=1,3) - enddo - endif - - call matmult(rot,e,trans) - do i=1,3 - do j=1,3 - e(i,1)=e1(i) - e(i,2)=e2(i) - e(i,3)=e3(i) - enddo - enddo - call matmult(e,trans,trans) - - if (lprint) then - write (iout,'(a)') 'The trans matrix:' - do i=1,3 - write (iout,'(i5,3f10.5)') i,(trans(i,j),j=1,3) - enddo - endif - - do i=nstart,nend - do j=1,3 - rij=c(j,nstart) - do k=1,3 - rij=rij+trans(j,k)*(c(k,i)-c(k,nstart)) - enddo - x(j)=rij - enddo - do j=1,3 - c(j,i)=x(j) - enddo - enddo - - if (lprint) then - write (iout,'(a)') 'Rotated coordinates of the fragment' - do i=nstart,nend - write (iout,'(i5,3f10.5)') i,(c(j,i),j=1,3) - enddo - endif - -c call int_from_cart(.false.,lprint) - if (nstart.gt.1) then - theta(nstart+1)=alpha(nstart-1,nstart,nstart+1) - phi(nstart+2)=beta(nstart-1,nstart,nstart+1,nstart+2) - if (nstart.gt.2) phi(nstart+1)= - & beta(nstart-2,nstart-1,nstart,nstart+1) - endif - if (nend.lt.nres) then - theta(nend+1)=alpha(nend-1,nend,nend+1) - phi(nend+1)=beta(nend-2,nend-1,nend,nend+1) - if (nend.lt.nres-1) phi(nend+2)= - & beta(nend-1,nend,nend+1,nend+2) - endif - if (print_mc.gt.2) then - write (iout,'(/a,i3,a,i3,a/)') - & 'Moved internal coordinates of the ',nstart,'-',nend, - & ' fragment:' - do i=nstart+1,nstart+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - do i=nend+1,nend+2 - write (iout,'(i5,2f10.5)') i,rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end diff --git a/source/unres/src_MD-restraints/build.txt b/source/unres/src_MD-restraints/build.txt deleted file mode 100644 index a5eba7c..0000000 --- a/source/unres/src_MD-restraints/build.txt +++ /dev/null @@ -1 +0,0 @@ -cmake /users/czarek/UNRES/GIT/unres/ -DMPIF_LOCAL_DIR=/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh \ No newline at end of file diff --git a/source/unres/src_MD-restraints/cartder.F b/source/unres/src_MD-restraints/cartder.F deleted file mode 100644 index e2e8c1a..0000000 --- a/source/unres/src_MD-restraints/cartder.F +++ /dev/null @@ -1,314 +0,0 @@ - subroutine cartder -*********************************************************************** -* This subroutine calculates the derivatives of the consecutive virtual -* bond vectors and the SC vectors in the virtual-bond angles theta and -* virtual-torsional angles phi, as well as the derivatives of SC vectors -* in the angles alpha and omega, describing the location of a side chain -* in its local coordinate system. -* -* The derivatives are stored in the following arrays: -* -* DDCDV - the derivatives of virtual-bond vectors DC in theta and phi. -* The structure is as follows: -* -* dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0 -* dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4) -* . . . . . . . . . . . . . . . . . . -* dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4) -* . -* . -* . -* dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N) -* -* DXDV - the derivatives of the side-chain vectors in theta and phi. -* The structure is same as above. -* -* DCDS - the derivatives of the side chain vectors in the local spherical -* andgles alph and omega: -* -* dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2) -* dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3) -* . -* . -* . -* dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1) -* -* Version of March '95, based on an early version of November '91. -* -*********************************************************************** - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - dimension drt(3,3,maxres),rdt(3,3,maxres),dp(3,3),temp(3,3), - & fromto(3,3,maxdim),prordt(3,3,maxres),prodrt(3,3,maxres) - dimension xx(3),xx1(3) -c common /przechowalnia/ fromto -* get the position of the jth ijth fragment of the chain coordinate system -* in the fromto array. - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* calculate the derivatives of transformation matrix elements in theta -* - do i=1,nres-2 - rdt(1,1,i)=-rt(1,2,i) - rdt(1,2,i)= rt(1,1,i) - rdt(1,3,i)= 0.0d0 - rdt(2,1,i)=-rt(2,2,i) - rdt(2,2,i)= rt(2,1,i) - rdt(2,3,i)= 0.0d0 - rdt(3,1,i)=-rt(3,2,i) - rdt(3,2,i)= rt(3,1,i) - rdt(3,3,i)= 0.0d0 - enddo -* -* derivatives in phi -* - do i=2,nres-2 - drt(1,1,i)= 0.0d0 - drt(1,2,i)= 0.0d0 - drt(1,3,i)= 0.0d0 - drt(2,1,i)= rt(3,1,i) - drt(2,2,i)= rt(3,2,i) - drt(2,3,i)= rt(3,3,i) - drt(3,1,i)=-rt(2,1,i) - drt(3,2,i)=-rt(2,2,i) - drt(3,3,i)=-rt(2,3,i) - enddo -* -* generate the matrix products of type r(i)t(i)...r(j)t(j) -* - do i=2,nres-2 - ind=indmat(i,i+1) - do k=1,3 - do l=1,3 - temp(k,l)=rt(k,l,i) - enddo - enddo - do k=1,3 - do l=1,3 - fromto(k,l,ind)=temp(k,l) - enddo - enddo - do j=i+1,nres-2 - ind=indmat(i,j+1) - do k=1,3 - do l=1,3 - dpkl=0.0d0 - do m=1,3 - dpkl=dpkl+temp(k,m)*rt(m,l,j) - enddo - dp(k,l)=dpkl - fromto(k,l,ind)=dpkl - enddo - enddo - do k=1,3 - do l=1,3 - temp(k,l)=dp(k,l) - enddo - enddo - enddo - enddo -* -* Calculate derivatives. -* - ind1=0 - do i=1,nres-2 - ind1=ind1+1 -* -* Derivatives of DC(i+1) in theta(i+2) -* - do j=1,3 - do k=1,2 - dpjk=0.0D0 - do l=1,3 - dpjk=dpjk+prod(j,l,i)*rdt(l,k,i) - enddo - dp(j,k)=dpjk - prordt(j,k,i)=dp(j,k) - enddo - dp(j,3)=0.0D0 - dcdv(j,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in theta(i+2) -* - xx1(1)=-0.5D0*xloc(2,i+1) - xx1(2)= 0.5D0*xloc(1,i+1) - do j=1,3 - xj=0.0D0 - do k=1,2 - xj=xj+r(j,k,i)*xx1(k) - enddo - xx(j)=xj - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j,ind1)=rj - enddo -* -* Derivatives of SC(i+1) in theta(i+3). The have to be handled differently -* than the other off-diagonal derivatives. -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j,ind1+1)=dxoiij - enddo -cd print *,ind1+1,(dxdv(j,ind1+1),j=1,3) -* -* Derivatives of DC(i+1) in phi(i+2) -* - do j=1,3 - do k=1,3 - dpjk=0.0 - do l=2,3 - dpjk=dpjk+prod(j,l,i)*drt(l,k,i) - enddo - dp(j,k)=dpjk - prodrt(j,k,i)=dp(j,k) - enddo - dcdv(j+3,ind1)=vbld(i+1)*dp(j,1) - enddo -* -* Derivatives of SC(i+1) in phi(i+2) -* - xx(1)= 0.0D0 - xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i) - xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i) - do j=1,3 - rj=0.0D0 - do k=2,3 - rj=rj+prod(j,k,i)*xx(k) - enddo - dxdv(j+3,ind1)=-rj - enddo -* -* Derivatives of SC(i+1) in phi(i+3). -* - do j=1,3 - dxoiij=0.0D0 - do k=1,3 - dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) - enddo - dxdv(j+3,ind1+1)=dxoiij - enddo -* -* Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru -* theta(nres) and phi(i+3) thru phi(nres). -* - do j=i+1,nres-2 - ind1=ind1+1 - ind=indmat(i+1,j+1) -cd print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1 - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,2 - tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo -cd print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3) -cd print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3) -cd print '(9f8.3)',((temp(k,l),l=1,3),k=1,3) -* Derivatives of virtual-bond vectors in theta - do k=1,3 - dcdv(k,ind1)=vbld(i+1)*temp(k,1) - enddo -cd print '(3f8.3)',(dcdv(k,ind1),k=1,3) -* Derivatives of SC vectors in theta - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k,ind1+1)=dxoijk - enddo -* -*--- Calculate the derivatives in phi -* - do k=1,3 - do l=1,3 - tempkl=0.0D0 - do m=1,3 - tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind) - enddo - temp(k,l)=tempkl - enddo - enddo - do k=1,3 - dcdv(k+3,ind1)=vbld(i+1)*temp(k,1) - enddo - do k=1,3 - dxoijk=0.0D0 - do l=1,3 - dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) - enddo - dxdv(k+3,ind1+1)=dxoijk - enddo - enddo - enddo -* -* Derivatives in alpha and omega: -* - do i=2,nres-1 -c dsci=dsc(itype(i)) - dsci=vbld(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if(alphi.ne.alphi) alphi=100.0 - if(omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif -cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - temp(1,1)=-dsci*sinalphi - temp(2,1)= dsci*cosalphi*cosomegi - temp(3,1)=-dsci*cosalphi*sinomegi - temp(1,2)=0.0D0 - temp(2,2)=-dsci*sinalphi*sinomegi - temp(3,2)=-dsci*sinalphi*cosomegi - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - jjj=0 -cd print *,((temp(l,k),l=1,3),k=1,2) - do j=1,2 - xp=temp(1,j) - yp=temp(2,j) - xxp= xp*cost2+yp*sint2 - yyp=-xp*sint2+yp*cost2 - zzp=temp(3,j) - xx(1)=xxp - xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1) - xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1) - do k=1,3 - dj=0.0D0 - do l=1,3 - dj=dj+prod(k,l,i-1)*xx(l) - enddo - dxds(jjj+k,i)=dj - enddo - jjj=jjj+3 - enddo - enddo - return - end - diff --git a/source/unres/src_MD-restraints/cartprint.f b/source/unres/src_MD-restraints/cartprint.f deleted file mode 100644 index d79409e..0000000 --- a/source/unres/src_MD-restraints/cartprint.f +++ /dev/null @@ -1,19 +0,0 @@ - subroutine cartprint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - write (iout,100) - do i=1,nres - write (iout,110) restyp(itype(i)),i,c(1,i),c(2,i), - & c(3,i),c(1,nres+i),c(2,nres+i),c(3,nres+i) - enddo - 100 format (//' alpha-carbon coordinates ', - & ' centroid coordinates'/ - 1 ' ', 6X,'X',11X,'Y',11X,'Z', - & 10X,'X',11X,'Y',11X,'Z') - 110 format (a,'(',i3,')',6f12.5) - return - end diff --git a/source/unres/src_MD-restraints/chainbuild.F b/source/unres/src_MD-restraints/chainbuild.F deleted file mode 100644 index 45a1a53..0000000 --- a/source/unres/src_MD-restraints/chainbuild.F +++ /dev/null @@ -1,274 +0,0 @@ - subroutine chainbuild -C -C Build the virtual polypeptide chain. Side-chain centroids are moveable. -C As of 2/17/95. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - logical lprn -C Set lprn=.true. for debugging - lprn = .false. -C -C Define the origin and orientation of the coordinate system and locate the -C first three CA's and SC(2). -C - call orig_frame -* -* Build the alpha-carbon chain. -* - do i=4,nres - call locate_next_res(i) - enddo -C -C First and last SC must coincide with the corresponding CA. -C - do j=1,3 - dc(j,nres+1)=0.0D0 - dc_norm(j,nres+1)=0.0D0 - dc(j,nres+nres)=0.0D0 - dc_norm(j,nres+nres)=0.0D0 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo -* -* Temporary diagnosis -* - if (lprn) then - - call cartprint - write (iout,'(/a)') 'Recalculated internal coordinates' - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(c(j,i-1)+c(j,i+1)) - enddo - be=0.0D0 - if (i.gt.3) be=rad2deg*beta(i-3,i-2,i-1,i) - be1=rad2deg*beta(nres+i,i,maxres2,i+1) - alfai=0.0D0 - if (i.gt.2) alfai=rad2deg*alpha(i-2,i-1,i) - write (iout,1212) restyp(itype(i)),i,dist(i-1,i), - & alfai,be,dist(nres+i,i),rad2deg*alpha(nres+i,i,maxres2),be1 - enddo - 1212 format (a3,'(',i3,')',2(f10.5,2f10.2)) - - endif - - return - end -c------------------------------------------------------------------------- - subroutine orig_frame -C -C Define the origin and orientation of the coordinate system and locate -C the first three atoms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - cost=dcos(theta(3)) - sint=dsin(theta(3)) - t(1,1,1)=-cost - t(1,2,1)=-sint - t(1,3,1)= 0.0D0 - t(2,1,1)=-sint - t(2,2,1)= cost - t(2,3,1)= 0.0D0 - t(3,1,1)= 0.0D0 - t(3,2,1)= 0.0D0 - t(3,3,1)= 1.0D0 - r(1,1,1)= 1.0D0 - r(1,2,1)= 0.0D0 - r(1,3,1)= 0.0D0 - r(2,1,1)= 0.0D0 - r(2,2,1)= 1.0D0 - r(2,3,1)= 0.0D0 - r(3,1,1)= 0.0D0 - r(3,2,1)= 0.0D0 - r(3,3,1)= 1.0D0 - do i=1,3 - do j=1,3 - rt(i,j,1)=t(i,j,1) - enddo - enddo - do i=1,3 - do j=1,3 - prod(i,j,1)=0.0D0 - prod(i,j,2)=t(i,j,1) - enddo - prod(i,i,1)=1.0D0 - enddo - c(1,1)=0.0D0 - c(2,1)=0.0D0 - c(3,1)=0.0D0 - c(1,2)=vbld(2) - c(2,2)=0.0D0 - c(3,2)=0.0D0 - dc(1,0)=0.0d0 - dc(2,0)=0.0D0 - dc(3,0)=0.0D0 - dc(1,1)=vbld(2) - dc(2,1)=0.0D0 - dc(3,1)=0.0D0 - dc_norm(1,0)=0.0D0 - dc_norm(2,0)=0.0D0 - dc_norm(3,0)=0.0D0 - dc_norm(1,1)=1.0D0 - dc_norm(2,1)=0.0D0 - dc_norm(3,1)=0.0D0 - do j=1,3 - dc_norm(j,2)=prod(j,1,2) - dc(j,2)=vbld(3)*prod(j,1,2) - c(j,3)=c(j,2)+dc(j,2) - enddo - call locate_side_chain(2) - return - end -c----------------------------------------------------------------------------- - subroutine locate_next_res(i) -C -C Locate CA(i) and SC(i-1) -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' -C -C Define the rotation matrices corresponding to CA(i) -C -#ifdef OSF - theti=theta(i) - if (theti.ne.theti) theti=100.0 - phii=phi(i) - if (phii.ne.phii) phii=180.0 -#else - theti=theta(i) - phii=phi(i) -#endif - cost=dcos(theti) - sint=dsin(theti) - cosphi=dcos(phii) - sinphi=dsin(phii) -* Define the matrices of the rotation about the virtual-bond valence angles -* theta, T(i,j,k), virtual-bond dihedral angles gamma (miscalled PHI in this -* program), R(i,j,k), and, the cumulative matrices of rotation RT - t(1,1,i-2)=-cost - t(1,2,i-2)=-sint - t(1,3,i-2)= 0.0D0 - t(2,1,i-2)=-sint - t(2,2,i-2)= cost - t(2,3,i-2)= 0.0D0 - t(3,1,i-2)= 0.0D0 - t(3,2,i-2)= 0.0D0 - t(3,3,i-2)= 1.0D0 - r(1,1,i-2)= 1.0D0 - r(1,2,i-2)= 0.0D0 - r(1,3,i-2)= 0.0D0 - r(2,1,i-2)= 0.0D0 - r(2,2,i-2)=-cosphi - r(2,3,i-2)= sinphi - r(3,1,i-2)= 0.0D0 - r(3,2,i-2)= sinphi - r(3,3,i-2)= cosphi - rt(1,1,i-2)=-cost - rt(1,2,i-2)=-sint - rt(1,3,i-2)=0.0D0 - rt(2,1,i-2)=sint*cosphi - rt(2,2,i-2)=-cost*cosphi - rt(2,3,i-2)=sinphi - rt(3,1,i-2)=-sint*sinphi - rt(3,2,i-2)=cost*sinphi - rt(3,3,i-2)=cosphi - call matmult(prod(1,1,i-2),rt(1,1,i-2),prod(1,1,i-1)) - do j=1,3 - dc_norm(j,i-1)=prod(j,1,i-1) - dc(j,i-1)=vbld(i)*prod(j,1,i-1) - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo -cd print '(2i3,2(3f10.5,5x))', i-1,i,(dc(j,i-1),j=1,3),(c(j,i),j=1,3) -C -C Now calculate the coordinates of SC(i-1) -C - call locate_side_chain(i-1) - return - end -c----------------------------------------------------------------------------- - subroutine locate_side_chain(i) -C -C Locate the side-chain centroid i, 1 < i < NRES. Put in C(*,NRES+i). -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - dimension xx(3) - -c dsci=dsc(itype(i)) -c dsci_inv=dsc_inv(itype(i)) - dsci=vbld(i+nres) - dsci_inv=vbld_inv(i+nres) -#ifdef OSF - alphi=alph(i) - omegi=omeg(i) - if (alphi.ne.alphi) alphi=100.0 - if (omegi.ne.omegi) omegi=-100.0 -#else - alphi=alph(i) - omegi=omeg(i) -#endif - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - xp= dsci*cosalphi - yp= dsci*sinalphi*cosomegi - zp=-dsci*sinalphi*sinomegi -* Now we have to rotate the coordinate system by 180-theta(i)/2 so as to get its -* X-axis aligned with the vector DC(*,i) - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - xx(1)= xp*cost2+yp*sint2 - xx(2)=-xp*sint2+yp*cost2 - xx(3)= zp -cd print '(a3,i3,3f10.5,5x,3f10.5)',restyp(itype(i)),i, -cd & xp,yp,zp,(xx(k),k=1,3) - do j=1,3 - xloc(j,i)=xx(j) - enddo -* Bring the SC vectors to the common coordinate system. - xx(1)=xloc(1,i) - xx(2)=xloc(2,i)*r(2,2,i-1)+xloc(3,i)*r(2,3,i-1) - xx(3)=xloc(2,i)*r(3,2,i-1)+xloc(3,i)*r(3,3,i-1) - do j=1,3 - xrot(j,i)=xx(j) - enddo - do j=1,3 - rj=0.0D0 - do k=1,3 - rj=rj+prod(j,k,i-1)*xx(k) - enddo - dc(j,nres+i)=rj - dc_norm(j,nres+i)=rj*dsci_inv - c(j,nres+i)=c(j,i)+rj - enddo - return - end diff --git a/source/unres/src_MD-restraints/change.awk b/source/unres/src_MD-restraints/change.awk deleted file mode 100644 index d192a6e..0000000 --- a/source/unres/src_MD-restraints/change.awk +++ /dev/null @@ -1,11 +0,0 @@ -{ - if($0==" include 'COMMON.LANGEVIN'") { - print "#ifndef LANG0" - print " include 'COMMON.LANGEVIN'" - print "#else" - print " include 'COMMON.LANGEVIN.lang0'" - print "#endif" - }else{ - print $0 - } -} diff --git a/source/unres/src_MD-restraints/check_bond.f b/source/unres/src_MD-restraints/check_bond.f deleted file mode 100644 index c8a4ad1..0000000 --- a/source/unres/src_MD-restraints/check_bond.f +++ /dev/null @@ -1,20 +0,0 @@ - subroutine check_bond -C Subroutine is checking if the fitted function which describs sc_rot_pot -C is correct, printing, alpha,beta, energy, data - for some known theta. -C theta angle is read from the input file. Sc_rot_pot are printed -C for the second residue in sequance. - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision energia(0:n_ene) - it=itype(2) - do i=1,101 - vbld(nres+2)=0.5d0+0.05d0*(i-1) - call chainbuild - call etotal(energia) - write (2,*) vbld(nres+2),energia(17) - enddo - return - end diff --git a/source/unres/src_MD-restraints/check_sc_distr.f b/source/unres/src_MD-restraints/check_sc_distr.f deleted file mode 100644 index db2ed1b..0000000 --- a/source/unres/src_MD-restraints/check_sc_distr.f +++ /dev/null @@ -1,43 +0,0 @@ - subroutine check_sc_distr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - logical fail - double precision varia(maxvar) - double precision hrtime,mintime,sectime - parameter (MaxSample=10000000,delt=1.0D0/MaxSample) - dimension prob(0:72,0:90) - dV=2.0D0*5.0D0*deg2rad*deg2rad - print *,'dv=',dv - do 10 it=1,1 - if (it.eq.10) goto 10 - open (20,file=restyp(it)//'_distr.sdc',status='unknown') - call gen_side(it,90.0D0*deg2rad,al,om,fail) - close (20) - goto 10 - open (20,file=restyp(it)//'_distr1.sdc',status='unknown') - do i=0,90 - do j=0,72 - prob(j,i)=0.0D0 - enddo - enddo - do isample=1,MaxSample - call gen_side(it,90.0D0*deg2rad,al,om) - indal=rad2deg*al/2 - indom=(rad2deg*om+180.0D0)/5 - prob(indom,indal)=prob(indom,indal)+delt - enddo - do i=45,90 - do j=0,72 - write (20,'(2f10.3,1pd15.5)') 2*i+0.0D0,5*j-180.0D0, - & prob(j,i)/dV - enddo - enddo - 10 continue - return - end diff --git a/source/unres/src_MD-restraints/checkder_p.F b/source/unres/src_MD-restraints/checkder_p.F deleted file mode 100644 index 4d0379e..0000000 --- a/source/unres/src_MD-restraints/checkder_p.F +++ /dev/null @@ -1,713 +0,0 @@ - subroutine check_cartgrad -C Check the gradient of Cartesian coordinates in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.DERIV' - include 'COMMON.SCCOR' - dimension temp(6,maxres),xx(3),gg(3) - indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 -* -* Check the gradient of the virtual-bond and SC vectors in the internal -* coordinates. -* - aincr=1.0d-7 - aincr2=5.0d-8 - call cartder - write (iout,'(a)') '**************** dx/dalpha' - write (iout,'(a)') - do i=2,nres-1 - alphi=alph(i) - alph(i)=alph(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - alph(i)=alphi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/domega' - write (iout,'(a)') - do i=2,nres-1 - omegi=omeg(i) - omeg(i)=omeg(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) - enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k+3,i))/ - & (aincr*dabs(dxds(k+3,i))+aincr)) - enddo - write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') - & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - omeg(i)=omegi - call chainbuild - enddo - write (iout,'(a)') - write (iout,'(a)') '**************** dx/dtheta' - write (iout,'(a)') - do i=3,nres - theti=theta(i) - theta(i)=theta(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'i=',i-2,' j=',j-1,' ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k,ii))/ - & (aincr*dabs(dxdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - write (iout,'(a)') - theta(i)=theti - call chainbuild - enddo - write (iout,'(a)') '***************** dx/dphi' - write (iout,'(a)') - do i=4,nres - phi(i)=phi(i)+aincr - do j=i-1,nres-1 - do k=1,3 - temp(k,j)=dc(k,nres+j) - enddo - enddo - call chainbuild - do j=i-1,nres-1 - ii = indmat(i-2,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ - & (aincr*dabs(dxdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write(iout,'(a)') - enddo - phi(i)=phi(i)-aincr - call chainbuild - enddo - write (iout,'(a)') '****************** ddc/dtheta' - do i=1,nres-2 - thet=theta(i+2) - theta(i+2)=thet+aincr - do j=i,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+1,nres-1 - ii = indmat(i,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k,ii))/ - & (aincr*dabs(dcdv(k,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - theta(i+2)=thet - enddo - write (iout,'(a)') '******************* ddc/dphi' - do i=1,nres-3 - phii=phi(i+3) - phi(i+3)=phii+aincr - do j=1,nres - do k=1,3 - temp(k,j)=dc(k,j) - enddo - enddo - call chainbuild - do j=i+2,nres-1 - ii = indmat(i+1,j) -c print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ - & (aincr*dabs(dcdv(k+3,ii))+aincr)) - enddo - write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') - & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') - enddo - do j=1,nres - do k=1,3 - dc(k,j)=temp(k,j) - enddo - enddo - phi(i+3)=phii - enddo - return - end -C---------------------------------------------------------------------------- - subroutine check_ecart -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar) - dimension grad_s(6,maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - icg=1 - nf=0 - nfl=0 - call zerograd - aincr=1.0D-7 - print '(a)','CG processor',me,' calling CHECK_CART.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gradc(j,i,icg) - grad_s(j+3,i)=gradx(j,i,icg) - enddo - enddo - call flush(iout) - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=1,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - enddo - do j=1,3 - dc(j,i)=dc(j,i)+aincr - do k=i+1,nres - c(j,k)=c(j,k)+aincr - c(j,k+nres)=c(j,k+nres)+aincr - enddo - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j)=(etot1-etot)/aincr - dc(j,i)=ddc(j) - do k=i+1,nres - c(j,k)=c(j,k)-aincr - c(j,k+nres)=c(j,k+nres)-aincr - enddo - enddo - do j=1,3 - c(j,i+nres)=c(j,i+nres)+aincr - dc(j,i+nres)=dc(j,i+nres)+aincr - call etotal(energia1(0)) - etot1=energia1(0) - ggg(j+3)=(etot1-etot)/aincr - c(j,i+nres)=xx(j) - dc(j,i+nres)=ddx(j) - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine check_ecartint -C Check the gradient of the energy in Cartesian coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - include 'COMMON.LOCAL' - include 'COMMON.SPLITELE' - include 'COMMON.SCCOR' - common /srutu/ icall - dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar), - & g(maxvar) - dimension dcnorm_safe(3),dxnorm_safe(3) - dimension grad_s(6,0:maxres),grad_s1(6,0:maxres) - double precision phi_temp(maxres),theta_temp(maxres), - & alph_temp(maxres),omeg_temp(maxres) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - external fdum - r_cut=2.0d0 - rlambd=0.3d0 - icg=1 - nf=0 - nfl=0 - call intout -c call intcartderiv -c call checkintcartgrad - call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' - nf=0 - icall=0 - call geom_to_var(nvar,x) - if (.not.split_ene) then - call etotal(energia(0)) -c do i=1,nres -c write (iout,*) "atu?", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - etot=energia(0) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - do i=1,nres - write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - else -!- split gradient check - call zerograd - call etotal_long(energia(0)) - call enerprint(energia(0)) - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "longrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - call zerograd - call etotal_short(energia(0)) - call enerprint(energia(0)) -c do i=1,nres -c write (iout,*) gloc_sc(1,i,icg) -c enddo - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) - call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) - icall =1 - write (iout,*) "shortrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s1(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s1(j,i)=gcart(j,i) - grad_s1(j+3,i)=gxcart(j,i) - enddo - enddo - endif - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=0,nres - do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - do k=1,3 - dcnorm_safe(k)=dc_norm(k,i) - dxnorm_safe(k)=dc_norm(k,i+nres) - enddo - enddo - do j=1,3 - dc(j,i)=ddc(j)+aincr - call chainbuild_cart -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. -c if (nfgtasks.gt.1) -c & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) -c write (iout,*) "etot11",etot11," etot12",etot12 - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i)=ddc(j)-aincr - call chainbuild_cart -c call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j)=(etot12-etot22)/(2*aincr) -!- end split gradient -c write (iout,*) "etot21",etot21," etot22",etot22 - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i)=ddc(j) - call chainbuild_cart - enddo - do j=1,3 - dc(j,i+nres)=ddx(j)+aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm+ and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) -c write (iout,*) - if (.not.split_ene) then - call etotal(energia1(0)) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1(0)) - etot11=energia1(0) - call etotal_short(energia1(0)) - etot12=energia1(0) - endif -!- end split gradient -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i+nres)=ddx(j)-aincr - call chainbuild_cart -c write (iout,*) "i",i," j",j," dxnorm- and dxnorm" -c write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -c write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -c write (iout,*) -c write (iout,*) "dxnormnorm",dsqrt( -c & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -c write (iout,*) "dxnormnormsafe",dsqrt( -c & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) - if (.not.split_ene) then - call etotal(energia1(0)) - etot2=energia1(0) - ggg(j+3)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1(0)) - etot21=energia1(0) - ggg(j+3)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1(0)) - etot22=energia1(0) - ggg1(j+3)=(etot12-etot22)/(2*aincr) -!- end split gradient - endif -c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i+nres)=ddx(j) - call chainbuild_cart - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) - if (split_ene) then - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i), - & k=1,6) - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6), - & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6) - endif - enddo - return - end -c------------------------------------------------------------------------- - subroutine int_from_cart1(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.SETUP' - include 'COMMON.TIME1' - logical lprn - if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates' -#ifdef TIMING - time01=MPI_Wtime() -#endif -#if defined(PARINT) && defined(MPI) - do i=iint_start,iint_end+1 -#else - do i=2,nres -#endif - dnorm1=dist(i-1,i) - dnorm2=dist(i,i+1) - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1 - & +(c(j,i+1)-c(j,i))/dnorm2) - enddo - be=0.0D0 - if (i.gt.2) then - if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1) - if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then - tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) - endif - if (itype(i-1).ne.10) then - tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) - omicron(1,i)=alpha(i-2,i-1,i-1+nres) - omicron(2,i)=alpha(i-1+nres,i-1,i) - endif - if (itype(i).ne.10) then - tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) - endif - endif - omeg(i)=beta(nres+i,i,maxres2,i+1) - alph(i)=alpha(nres+i,i,maxres2) - theta(i+1)=alpha(i-1,i,i+1) - vbld(i)=dist(i-1,i) - vbld_inv(i)=1.0d0/vbld(i) - vbld(nres+i)=dist(nres+i,i) - if (itype(i).ne.10) then - vbld_inv(nres+i)=1.0d0/vbld(nres+i) - else - vbld_inv(nres+i)=0.0d0 - endif - enddo - -#if defined(PARINT) && defined(MPI) - if (nfgtasks1.gt.1) then -cd write(iout,*) "iint_start",iint_start," iint_count", -cd & (iint_count(i),i=0,nfgtasks-1)," iint_displ", -cd & (iint_displ(i),i=0,nfgtasks-1) -cd write (iout,*) "Gather vbld backbone" -cd call flush(iout) - time00=MPI_Wtime() - call MPI_Allgatherv(vbld(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld_inv(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld(iint_start+nres),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,vbld(nres+1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather vbld_inv side chain" -cd call flush(iout) - call MPI_Allgatherv(vbld_inv(iint_start+nres), - & iint_count(fg_rank1),MPI_DOUBLE_PRECISION,vbld_inv(nres+1), - & iint_count(0),iint_displ(0),MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather theta" -cd call flush(iout) - call MPI_Allgatherv(theta(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,theta(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather phi" -cd call flush(iout) - call MPI_Allgatherv(phi(iint_start+1),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,phi(2),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#ifdef CRYST_SC -cd write (iout,*) "Gather alph" -cd call flush(iout) - call MPI_Allgatherv(alph(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,alph(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -cd write (iout,*) "Gather omeg" -cd call flush(iout) - call MPI_Allgatherv(omeg(iint_start),iint_count(fg_rank1), - & MPI_DOUBLE_PRECISION,omeg(1),iint_count(0),iint_displ(0), - & MPI_DOUBLE_PRECISION,FG_COMM1,IERR) -#endif - time_gather=time_gather+MPI_Wtime()-time00 - endif -#endif - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - enddo - if (lprn) then - do i=2,nres - write (iout,1212) restyp(itype(i)),i,vbld(i), - &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i), - &rad2deg*alph(i),rad2deg*omeg(i) - enddo - endif - 1212 format (a3,'(',i3,')',2(f15.10,2f10.2)) -#ifdef TIMING - time_intfcart=time_intfcart+MPI_Wtime()-time01 -#endif - return - end -c---------------------------------------------------------------------------- - subroutine check_eint -C Check the gradient of energy in internal coordinates. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - common /srutu/ icall - dimension x(maxvar),gana(maxvar),gg(maxvar) - integer uiparm(1) - double precision urparm(1) - double precision energia(0:n_ene),energia1(0:n_ene), - & energia2(0:n_ene) - character*6 key - external fdum - call zerograd - aincr=1.0D-7 - print '(a)','Calling CHECK_INT.' - nf=0 - nfl=0 - icg=1 - call geom_to_var(nvar,x) - call var_to_geom(nvar,x) - call chainbuild - icall=1 - print *,'ICG=',ICG - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - print *,'ICG=',ICG -#ifdef MPL - if (MyID.ne.BossID) then - call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID) - nf=x(nvar+1) - nfl=x(nvar+2) - icg=x(nvar+3) - endif -#endif - nf=1 - nfl=3 -cd write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) - call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) -cd write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar) - icall=1 - do i=1,nvar - xi=x(i) - x(i)=xi-0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia1(0)) - etot1=energia1(0) - x(i)=xi+0.5D0*aincr - call var_to_geom(nvar,x) - call chainbuild - call etotal(energia2(0)) - etot2=energia2(0) - gg(i)=(etot2-etot1)/aincr - write (iout,*) i,etot1,etot2 - x(i)=xi - enddo - write (iout,'(/2a)')' Variable Numerical Analytical', - & ' RelDiff*100% ' - do i=1,nvar - if (i.le.nphi) then - ii=i - key = ' phi' - else if (i.le.nphi+ntheta) then - ii=i-nphi - key=' theta' - else if (i.le.nphi+ntheta+nside) then - ii=i-(nphi+ntheta) - key=' alpha' - else - ii=i-(nphi+ntheta+nside) - key=' omega' - endif - write (iout,'(i3,a,i3,3(1pd16.6))') - & i,key,ii,gg(i),gana(i), - & 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr) - enddo - return - end diff --git a/source/unres/src_MD-restraints/compare_s1.F b/source/unres/src_MD-restraints/compare_s1.F deleted file mode 100644 index 300e7ed..0000000 --- a/source/unres/src_MD-restraints/compare_s1.F +++ /dev/null @@ -1,188 +0,0 @@ - subroutine compare_s1(n_thr,num_thread_save,energyx,x, - & icomp,enetbss,coordss,rms_d,modif,iprint) -C This subroutine compares the new conformation, whose variables are in X -C with the previously accumulated conformations whose energies and variables -C are stored in ENETBSS and COORDSS, respectively. The meaning of other -C variables is as follows: -C -C N_THR - on input the previous # of accumulated confs, on output the current -C # of accumulated confs. -C N_REPEAT - an array that indicates how many times the structure has already -C been used to start the reversed-reversing procedure. Addition of -C a new structure replacement of a structure with a similar, but -C lower-energy structure resets the respective entry in N_REPEAT to zero -C I9 - output unit -C ENERGYX,X - the energy and variables of the new conformations. -C ICOMP - comparison result: -C 0 - the new structure is similar to one of the previous ones and does -C not have a remarkably lower energy and is therefore rejected; -C 1 - the new structure is different and is added to the set, because -C there is still room in the COORDSS and ENETBSS arrays; -C 2 - the new structure is different, but higher in energy than any -C previous one and is therefore rejected -C 3 - there is no more room in the COORDSS and ENETBSS arrays, but -C the new structure is lower in energy than at least the highest- -C energy previous structure and therefore replaces it. -C 9 - the new structure is similar to a number of previous structures, -C but has a remarkably lower energy than any of them; therefore -C replaces all these structures; -C MODIF - a logical variable that shows whether to include the new structure -C in the set of accumulated structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' -crc include 'COMMON.DEFORM' - include 'COMMON.IOUNITS' -#ifdef UNRES - include 'COMMON.CHAIN' -#endif - - dimension x(maxvar) - dimension x1(maxvar) - double precision przes(3),obrot(3,3) - integer list(max_thread) - logical non_conv,modif - double precision enetbss(max_threadss) - double precision coordss(maxvar,max_threadss) - - nlist=0 -#ifdef UNRES - call var_to_geom(nvar,x) - call chainbuild - do k=1,2*nres - do kk=1,3 - cref(kk,k)=c(kk,k) - enddo - enddo -#endif -c write(iout,*)'*ene=',energyx - j=0 - enex_jp=-1.0d+99 - do i=1,n_thr - do k=1,nvar - x1(k)=coordss(k,i) - enddo - if (iprint.gt.3) then - write (iout,*) 'Compare_ss, i=',i - write (iout,*) 'New structure Energy:',energyx - write (iout,'(10f8.3)') (rad2deg*x(k),k=1,nvar) - write (iout,*) 'Template structure Energy:',enetbss(i) - write (iout,'(10f8.3)') (rad2deg*x1(k),k=1,nvar) - endif - -#ifdef UNRES - call var_to_geom(nvar,x1) - call chainbuild -cd write(iout,*)'C and CREF' -cd write(iout,'(i5,3f10.5,5x,3f10.5)')(k,(c(j,k),j=1,3), -cd & (cref(j,k),j=1,3),k=1,nres) - call fitsq(roznica,c(1,1),cref(1,1),nres,przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!!' - print *,'X' - print '(10f8.3)',(x(k),k=1,nvar) - print *,'X1' - print '(10f8.3)',(x1(k),k=1,nvar) - print *,'C and CREF' - print '(i5,3f10.5,5x,3f10.5)',(k,(c(j,k),j=1,3), - & (cref(j,k),j=1,3),k=1,nres) - endif - roznica=dsqrt(dabs(roznica)) - iresult = 1 - if (roznica.lt.rms_d) iresult = 0 -#else - energyy=enetbss(i) - call cmprs(x,x1,roznica,energyx,energyy,iresult) -#endif - if (iprint.gt.1) write(iout,'(i5,f10.6,$)') i,roznica -c print '(i5,f8.3)',i,roznica - if(iresult.eq.0) then - nlist = nlist + 1 - list(nlist)=i - if (iprint.gt.1) write(iout,*) - if(energyx.ge.enetbss(i)) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - same as nr ',i, - & ' RMS',roznica - minimize_s_flag=0 - icomp=0 - go to 1106 - endif - endif - if(energyx.lt.enetbss(i).and.enex_jp.lt.enetbss(i))then - j=i - enex_jp=enetbss(i) - endif - enddo - if (iprint.gt.1) write(iout,*) - if(nlist.gt.0) then - if (modif) then - if (iprint.gt.1) - & write(iout,'(a,i3,$)')'s*>> structure accepted1 - repl nr ', - & list(1) - else - if (iprint.gt.1) - & write(iout,'(a,i3)') - & 's*>> structure accepted1 - would repl nr ',list(1) - endif - icomp=9 - if (.not. modif) goto 1106 - j=list(1) - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - do j=2,nlist - if (iprint.gt.1) write(iout,'(i3,$)')list(j) - do kk=list(j)+1,nlist - enetbss(kk-1)=enetbss(kk) - do i=1,nvar - coordss(i,kk-1)=coordss(i,kk) - enddo - enddo - enddo - if (iprint.gt.1) write(iout,*) - go to 1106 - endif - if(n_thr.lt.num_thread_save) then - icomp=1 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - add with nr ',n_thr+1 - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would add with nr ', - & n_thr+1 - goto 1106 - endif - n_thr=n_thr+1 - enetbss(n_thr)=energyx - do i=1,nvar - coordss(i,n_thr)=x(i) - enddo - else - if(j.eq.0) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure rejected - too high energy' - icomp=2 - go to 1106 - end if - icomp=3 - if (modif) then - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - repl nr ',j - else - if (iprint.gt.1) - & write(iout,*)'s*>> structure accepted - would repl nr ',j - goto 1106 - endif - enetbss(j)=energyx - do i=1,nvar - coordss(i,j)=x(i) - enddo - end if - -1106 continue - return - end diff --git a/source/unres/src_MD-restraints/compinfo.c b/source/unres/src_MD-restraints/compinfo.c deleted file mode 100644 index e28f686..0000000 --- a/source/unres/src_MD-restraints/compinfo.c +++ /dev/null @@ -1,82 +0,0 @@ -#include -#include -#include -#include -#include - -main() -{ -FILE *in, *in1, *out; -int i,j,k,iv1,iv2,iv3; -char *p1,buf[500],buf1[500],buf2[100],buf3[100]; -struct utsname Name; -time_t Tp; - -in=fopen("cinfo.f","r"); -out=fopen("cinfo.f.new","w"); -if (fgets(buf,498,in) != NULL) - fprintf(out,"C DO NOT EDIT THIS FILE - IT HAS BEEN GENERATED BY COMPINFO.C\n"); -if (fgets(buf,498,in) != NULL) - sscanf(&buf[1],"%d %d %d",&iv1,&iv2,&iv3); -iv3++; -fprintf(out,"C %d %d %d\n",iv1,iv2,iv3); -fprintf(out," subroutine cinfo\n"); -fprintf(out," include 'COMMON.IOUNITS'\n"); -fprintf(out," write(iout,*)'++++ Compile info ++++'\n"); -fprintf(out," write(iout,*)'Version %d.%-d build %d'\n",iv1,iv2,iv3); -uname(&Name); -time(&Tp); -system("whoami > tmptmp"); -in1=fopen("tmptmp","r"); -if (fscanf(in1,"%s",buf1) != EOF) -{ -p1=ctime(&Tp); -p1[strlen(p1)-1]='\0'; -fprintf(out," write(iout,*)'compiled %s'\n",p1); -fprintf(out," write(iout,*)'compiled by %s@%s'\n",buf1,Name.nodename); -fprintf(out," write(iout,*)'OS name: %s '\n",Name.sysname); -fprintf(out," write(iout,*)'OS release: %s '\n",Name.release); -fprintf(out," write(iout,*)'OS version:',\n"); -fprintf(out," & ' %s '\n",Name.version); -fprintf(out," write(iout,*)'flags:'\n"); -} -system("rm tmptmp"); -fclose(in1); -in1=fopen("Makefile","r"); -while(fgets(buf,498,in1) != NULL) - { - if((p1=strchr(buf,'=')) != NULL && buf[0] != '#') - { - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - else - { - while(buf[strlen(buf)-1]=='\\') - { - strcat(buf,"\\"); - fprintf(out," write(iout,*)'%s'\n",buf); - if (fgets(buf,498,in1) != NULL) - buf[strlen(buf)-1]='\0'; - if(strlen(buf) > 49) - { - buf[47]='\0'; - strcat(buf,"..."); - } - } - } - - fprintf(out," write(iout,*)'%s'\n",buf); - } - } -fprintf(out," write(iout,*)'++++ End of compile info ++++'\n"); -fprintf(out," return\n"); -fprintf(out," end\n"); -fclose(out); -fclose(in1); -fclose(in); -system("mv cinfo.f.new cinfo.f"); -} diff --git a/source/unres/src_MD-restraints/contact.f b/source/unres/src_MD-restraints/contact.f deleted file mode 100644 index a244d86..0000000 --- a/source/unres/src_MD-restraints/contact.f +++ /dev/null @@ -1,195 +0,0 @@ - subroutine contact(lprint,ncont,icont,co) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - real*8 facont /1.569D0/ ! facont = (2/(1-sqrt(1-1/4)))**(1/6) - integer ncont,icont(2,maxcont) - logical lprint - ncont=0 - kkk=3 - do i=nnt+kkk,nct - iti=itype(i) - do j=nnt,i-kkk - itj=itype(j) - if (ipot.ne.4) then -c rcomp=sigmaii(iti,itj)+1.0D0 - rcomp=facont*sigmaii(iti,itj) - else -c rcomp=sigma(iti,itj)+1.0D0 - rcomp=facont*sigma(iti,itj) - endif -c rcomp=6.5D0 -c print *,'rcomp=',rcomp,' dist=',dist(nres+i,nres+j) - if (dist(nres+i,nres+j).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'Contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif - co = 0.0d0 - do i=1,ncont - co = co + dfloat(iabs(icont(1,i)-icont(2,i))) - enddo - co = co / (nres*ncont) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract=dfloat(nmatch)/dfloat(ncont_ref) - return - end -c---------------------------------------------------------------------------- - double precision function contact_fract_nn(ncont,ncont_ref, - & icont,icont_ref) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer ncont,ncont_ref,icont(2,maxcont),icont_ref(2,maxcont) - nmatch=0 -c print *,'ncont=',ncont,' ncont_ref=',ncont_ref -c write (iout,'(20i4)') (icont_ref(1,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont_ref(2,i),i=1,ncont_ref) -c write (iout,'(20i4)') (icont(1,i),i=1,ncont) -c write (iout,'(20i4)') (icont(2,i),i=1,ncont) - do i=1,ncont - do j=1,ncont_ref - if (icont(1,i).eq.icont_ref(1,j) .and. - & icont(2,i).eq.icont_ref(2,j)) nmatch=nmatch+1 - enddo - enddo -c print *,' nmatch=',nmatch -c contact_fract=dfloat(nmatch)/dfloat(max0(ncont,ncont_ref)) - contact_fract_nn=dfloat(ncont-nmatch)/dfloat(ncont) - return - end -c---------------------------------------------------------------------------- - subroutine hairpin(lprint,nharp,iharp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - integer ncont,icont(2,maxcont) - integer nharp,iharp(4,maxres/3) - logical lprint,not_done - real*8 rcomp /6.0d0/ - ncont=0 - kkk=0 -c print *,'nnt=',nnt,' nct=',nct - do i=nnt,nct-3 - do k=1,3 - c(k,2*nres+1)=0.5d0*(c(k,i)+c(k,i+1)) - enddo - do j=i+2,nct-1 - do k=1,3 - c(k,2*nres+2)=0.5d0*(c(k,j)+c(k,j+1)) - enddo - if (dist(2*nres+1,2*nres+2).lt.rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - endif - enddo - enddo - if (lprint) then - write (iout,'(a)') 'PP contact map:' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4)') - & i,restyp(it1),i1,restyp(it2),i2 - enddo - endif -c finding hairpins - nharp=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+2 .and. i1.gt.nnt .and. j1.lt.nct) then -c write (iout,*) "found turn at ",i1,j1 - ii1=i1 - jj1=j1 - not_done=.true. - do while (not_done) - i1=i1-1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -c write (iout,*) i1,j1,not_done - enddo - i1=i1+1 - j1=j1-1 - if (j1-i1.gt.4) then - nharp=nharp+1 - iharp(1,nharp)=i1 - iharp(2,nharp)=j1 - iharp(3,nharp)=ii1 - iharp(4,nharp)=jj1 -c write (iout,*)'nharp',nharp,' iharp',(iharp(k,nharp),k=1,4) - endif - endif - enddo -c do i=1,nharp -c write (iout,*)'i',i,' iharp',(iharp(k,i),k=1,4) -c enddo - if (lprint) then - write (iout,*) "Hairpins:" - do i=1,nharp - i1=iharp(1,i) - j1=iharp(2,i) - ii1=iharp(3,i) - jj1=iharp(4,i) - write (iout,*) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=i1,ii1) - write (iout,'(20(a,i3,1x))') (restyp(itype(k)),k,k=j1,jj1,-1) -c do k=jj1,j1,-1 -c write (iout,'(a,i3,$)') restyp(itype(k)),k -c enddo - enddo - endif - return - end -c---------------------------------------------------------------------------- - diff --git a/source/unres/src_MD-restraints/convert.f b/source/unres/src_MD-restraints/convert.f deleted file mode 100644 index dc0cccd..0000000 --- a/source/unres/src_MD-restraints/convert.f +++ /dev/null @@ -1,196 +0,0 @@ - subroutine geom_to_var(n,x) -C -C Transfer the geometry parameters to the variable array. -C The positions of variables are as follows: -C 1. Virtual-bond torsional angles: 1 thru nres-3 -C 2. Virtual-bond valence angles: nres-2 thru 2*nres-5 -C 3. The polar angles alpha of local SC orientation: 2*nres-4 thru -C 2*nres-4+nside -C 4. The torsional angles omega of SC orientation: 2*nres-4+nside+1 -C thru 2*nre-4+2*nside -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - double precision x(n) -cd print *,'nres',nres,' nphi',nphi,' ntheta',ntheta,' nvar',nvar - do i=4,nres - x(i-3)=phi(i) -cd print *,i,i-3,phi(i) - enddo - if (n.eq.nphi) return - do i=3,nres - x(i-2+nphi)=theta(i) -cd print *,i,i-2+nphi,theta(i) - enddo - if (n.eq.nphi+ntheta) return - do i=2,nres-1 - if (ialph(i,1).gt.0) then - x(ialph(i,1))=alph(i) - x(ialph(i,1)+nside)=omeg(i) -cd print *,i,ialph(i,1),ialph(i,1)+nside,alph(i),omeg(i) - endif - enddo - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom(n,x) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(n) - logical change,reduce - change=reduce(x) - if (n.gt.nphi+ntheta) then - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - endif - do i=4,nres - phi(i)=x(i-3) - enddo - if (n.eq.nphi) return - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- - logical function convert_side(alphi,omegi) - implicit none - double precision alphi,omegi - double precision pinorm - include 'COMMON.GEO' - convert_side=.false. -C Apply periodicity restrictions. - if (alphi.gt.pi) then - alphi=dwapi-alphi - omegi=pinorm(omegi+pi) - convert_side=.true. - endif - return - end -c------------------------------------------------------------------------- - logical function reduce(x) -C -C Apply periodic restrictions to variables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - logical zm,zmiana,convert_side - dimension x(nvar) - zmiana=.false. - do i=4,nres - x(i-3)=pinorm(x(i-3)) - enddo - if (nvar.gt.nphi+ntheta) then - do i=1,nside - ii=nphi+ntheta+i - iii=ii+nside - x(ii)=thetnorm(x(ii)) - x(iii)=pinorm(x(iii)) -C Apply periodic restrictions. - zm=convert_side(x(ii),x(iii)) - zmiana=zmiana.or.zm - enddo - endif - if (nvar.eq.nphi) return - do i=3,nres - ii=i-2+nphi - iii=i-3 - x(ii)=dmod(x(ii),dwapi) -C Apply periodic restrictions. - if (x(ii).gt.pi) then - zmiana=.true. - x(ii)=dwapi-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.-pi) then - zmiana=.true. - x(ii)=dwapi+x(ii) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii)=dmod(pi-x(ii),dwapi) - x(ii+nside)=pinorm(-pi-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - else if (x(ii).lt.0.0d0) then - zmiana=.true. - x(ii)=-x(ii) - if (iii.gt.0) x(iii)=pinorm(x(iii)+pi) - if (i.lt.nres) x(iii+1)=pinorm(x(iii+1)+pi) - ii=ialph(i-1,1) - if (ii.gt.0) then - x(ii+nside)=pinorm(-x(ii+nside)) - zm=convert_side(x(ii),x(ii+nside)) - endif - endif - enddo - reduce=zmiana - return - end -c-------------------------------------------------------------------------- - double precision function thetnorm(x) -C This function puts x within [0,2Pi]. - implicit none - double precision x,xx - include 'COMMON.GEO' - xx=dmod(x,dwapi) - if (xx.lt.0.0d0) xx=xx+dwapi - if (xx.gt.0.9999d0*pi) xx=0.9999d0*pi - thetnorm=xx - return - end -C-------------------------------------------------------------------- - subroutine var_to_geom_restr(n,xx) -C -C Update geometry parameters according to the variable array. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - dimension x(maxvar),xx(maxvar) - logical change,reduce - - call xx2x(x,xx) - change=reduce(x) - do i=1,nside - ii=ialph(i,2) - alph(ii)=x(nphi+ntheta+i) - omeg(ii)=pinorm(x(nphi+ntheta+nside+i)) - enddo - do i=4,nres - phi(i)=x(i-3) - enddo - do i=3,nres - theta(i)=x(i-2+nphi) - if (theta(i).eq.pi) theta(i)=0.99d0*pi - x(i-2+nphi)=theta(i) - enddo - return - end -c------------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/cored.f b/source/unres/src_MD-restraints/cored.f deleted file mode 100644 index 1cf25e5..0000000 --- a/source/unres/src_MD-restraints/cored.f +++ /dev/null @@ -1,3151 +0,0 @@ - subroutine assst(iv, liv, lv, v) -c -c *** assess candidate step (***sol version 2.3) *** -c - integer liv, l - integer iv(liv) - double precision v(lv) -c -c *** purpose *** -c -c this subroutine is called by an unconstrained minimization -c routine to assess the next candidate step. it may recommend one -c of several courses of action, such as accepting the step, recom- -c puting it using the same or a new quadratic model, or halting due -c to convergence or false convergence. see the return code listing -c below. -c -c-------------------------- parameter usage -------------------------- -c -c iv (i/o) integer parameter and scratch vector -- see description -c below of iv values referenced. -c liv (in) length of iv array. -c lv (in) length of v array. -c v (i/o) real parameter and scratch vector -- see description -c below of v values referenced. -c -c *** iv values referenced *** -c -c iv(irc) (i/o) on input for the first step tried in a new iteration, -c iv(irc) should be set to 3 or 4 (the value to which it is -c set when step is definitely to be accepted). on input -c after step has been recomputed, iv(irc) should be -c unchanged since the previous return of assst. -c on output, iv(irc) is a return code having one of the -c following values... -c 1 = switch models or try smaller step. -c 2 = switch models or accept step. -c 3 = accept step and determine v(radfac) by gradient -c tests. -c 4 = accept step, v(radfac) has been determined. -c 5 = recompute step (using the same model). -c 6 = recompute step with radius = v(lmaxs) but do not -c evaulate the objective function. -c 7 = x-convergence (see v(xctol)). -c 8 = relative function convergence (see v(rfctol)). -c 9 = both x- and relative function convergence. -c 10 = absolute function convergence (see v(afctol)). -c 11 = singular convergence (see v(lmaxs)). -c 12 = false convergence (see v(xftol)). -c 13 = iv(irc) was out of range on input. -c return code i has precdence over i+1 for i = 9, 10, 11. -c iv(mlstgd) (i/o) saved value of iv(model). -c iv(model) (i/o) on input, iv(model) should be an integer identifying -c the current quadratic model of the objective function. -c if a previous step yielded a better function reduction, -c then iv(model) will be set to iv(mlstgd) on output. -c iv(nfcall) (in) invocation count for the objective function. -c iv(nfgcal) (i/o) value of iv(nfcall) at step that gave the biggest -c function reduction this iteration. iv(nfgcal) remains -c unchanged until a function reduction is obtained. -c iv(radinc) (i/o) the number of radius increases (or minus the number -c of decreases) so far this iteration. -c iv(restor) (out) set to 1 if v(f) has been restored and x should be -c restored to its initial value, to 2 if x should be saved, -c to 3 if x should be restored from the saved value, and to -c 0 otherwise. -c iv(stage) (i/o) count of the number of models tried so far in the -c current iteration. -c iv(stglim) (in) maximum number of models to consider. -c iv(switch) (out) set to 0 unless a new model is being tried and it -c gives a smaller function value than the previous model, -c in which case assst sets iv(switch) = 1. -c iv(toobig) (in) is nonzero if step was too big (e.g. if it caused -c overflow). -c iv(xirc) (i/o) value that iv(irc) would have in the absence of -c convergence, false convergence, and oversized steps. -c -c *** v values referenced *** -c -c v(afctol) (in) absolute function convergence tolerance. if the -c absolute value of the current function value v(f) is less -c than v(afctol), then assst returns with iv(irc) = 10. -c v(decfac) (in) factor by which to decrease radius when iv(toobig) is -c nonzero. -c v(dstnrm) (in) the 2-norm of d*step. -c v(dstsav) (i/o) value of v(dstnrm) on saved step. -c v(dst0) (in) the 2-norm of d times the newton step (when defined, -c i.e., for v(nreduc) .ge. 0). -c v(f) (i/o) on both input and output, v(f) is the objective func- -c tion value at x. if x is restored to a previous value, -c then v(f) is restored to the corresponding value. -c v(fdif) (out) the function reduction v(f0) - v(f) (for the output -c value of v(f) if an earlier step gave a bigger function -c decrease, and for the input value of v(f) otherwise). -c v(flstgd) (i/o) saved value of v(f). -c v(f0) (in) objective function value at start of iteration. -c v(gtslst) (i/o) value of v(gtstep) on saved step. -c v(gtstep) (in) inner product between step and gradient. -c v(incfac) (in) minimum factor by which to increase radius. -c v(lmaxs) (in) maximum reasonable step size (and initial step bound). -c if the actual function decrease is no more than twice -c what was predicted, if a return with iv(irc) = 7, 8, 9, -c or 10 does not occur, if v(dstnrm) .gt. v(lmaxs), and if -c v(preduc) .le. v(sctol) * abs(v(f0)), then assst re- -c turns with iv(irc) = 11. if so doing appears worthwhile, -c then assst repeats this test with v(preduc) computed for -c a step of length v(lmaxs) (by a return with iv(irc) = 6). -c v(nreduc) (i/o) function reduction predicted by quadratic model for -c newton step. if assst is called with iv(irc) = 6, i.e., -c if v(preduc) has been computed with radius = v(lmaxs) for -c use in the singular convervence test, then v(nreduc) is -c set to -v(preduc) before the latter is restored. -c v(plstgd) (i/o) value of v(preduc) on saved step. -c v(preduc) (i/o) function reduction predicted by quadratic model for -c current step. -c v(radfac) (out) factor to be used in determining the new radius, -c which should be v(radfac)*dst, where dst is either the -c output value of v(dstnrm) or the 2-norm of -c diag(newd)*step for the output value of step and the -c updated version, newd, of the scale vector d. for -c iv(irc) = 3, v(radfac) = 1.0 is returned. -c v(rdfcmn) (in) minimum value for v(radfac) in terms of the input -c value of v(dstnrm) -- suggested value = 0.1. -c v(rdfcmx) (in) maximum value for v(radfac) -- suggested value = 4.0. -c v(reldx) (in) scaled relative change in x caused by step, computed -c (e.g.) by function reldst as -c max (d(i)*abs(x(i)-x0(i)), 1 .le. i .le. p) / -c max (d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p). -c v(rfctol) (in) relative function convergence tolerance. if the -c actual function reduction is at most twice what was pre- -c dicted and v(nreduc) .le. v(rfctol)*abs(v(f0)), then -c assst returns with iv(irc) = 8 or 9. -c v(stppar) (in) marquardt parameter -- 0 means full newton step. -c v(tuner1) (in) tuning constant used to decide if the function -c reduction was much less than expected. suggested -c value = 0.1. -c v(tuner2) (in) tuning constant used to decide if the function -c reduction was large enough to accept step. suggested -c value = 10**-4. -c v(tuner3) (in) tuning constant used to decide if the radius -c should be increased. suggested value = 0.75. -c v(xctol) (in) x-convergence criterion. if step is a newton step -c (v(stppar) = 0) having v(reldx) .le. v(xctol) and giving -c at most twice the predicted function decrease, then -c assst returns iv(irc) = 7 or 9. -c v(xftol) (in) false convergence tolerance. if step gave no or only -c a small function decrease and v(reldx) .le. v(xftol), -c then assst returns with iv(irc) = 12. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine is called as part of the nl2sol (nonlinear -c least-squares) package. it may be used in any unconstrained -c minimization solver that uses dogleg, goldfeld-quandt-trotter, -c or levenberg-marquardt steps. -c -c *** algorithm notes *** -c -c see (1) for further discussion of the assessing and model -c switching strategies. while nl2sol considers only two models, -c assst is designed to handle any number of models. -c -c *** usage notes *** -c -c on the first call of an iteration, only the i/o variables -c step, x, iv(irc), iv(model), v(f), v(dstnrm), v(gtstep), and -c v(preduc) need have been initialized. between calls, no i/o -c values execpt step, x, iv(model), v(f) and the stopping toler- -c ances should be changed. -c after a return for convergence or false convergence, one can -c change the stopping tolerances and call assst again, in which -c case the stopping tests will be repeated. -c -c *** references *** -c -c (1) dennis, j.e., jr., gay, d.m., and welsch, r.e. (1981), -c an adaptive nonlinear least-squares algorithm, -c acm trans. math. software, vol. 7, no. 3. -c -c (2) powell, m.j.d. (1970) a fortran subroutine for solving -c systems of nonlinear algebraic equations, in numerical -c methods for nonlinear algebraic equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** history *** -c -c john dennis designed much of this routine, starting with -c ideas in (2). roy welsch suggested the model switching strategy. -c david gay and stephen peters cast this subroutine into a more -c portable form (winter 1977), and david gay cast it into its -c present form (fall 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** no external functions and subroutines *** -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1 -c/ -c *** no common blocks *** -c -c-------------------------- local variables -------------------------- -c - logical goodx - integer i, nfc - double precision emax, emaxs, gts, rfac1, xmax - double precision half, one, onep2, two, zero -c -c *** subscripts for iv and v *** -c - integer afctol, decfac, dstnrm, dstsav, dst0, f, fdif, flstgd, f0, - 1 gtslst, gtstep, incfac, irc, lmaxs, mlstgd, model, nfcall, - 2 nfgcal, nreduc, plstgd, preduc, radfac, radinc, rdfcmn, - 3 rdfcmx, reldx, restor, rfctol, sctol, stage, stglim, - 4 stppar, switch, toobig, tuner1, tuner2, tuner3, xctol, - 5 xftol, xirc -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, onep2/1.2d+0/, two/2.d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, onep2=1.2d+0, two=2.d+0, - 1 zero=0.d+0) -c/ -c -c/6 -c data irc/29/, mlstgd/32/, model/5/, nfcall/6/, nfgcal/7/, -c 1 radinc/8/, restor/9/, stage/10/, stglim/11/, switch/12/, -c 2 toobig/2/, xirc/13/ -c/7 - parameter (irc=29, mlstgd=32, model=5, nfcall=6, nfgcal=7, - 1 radinc=8, restor=9, stage=10, stglim=11, switch=12, - 2 toobig=2, xirc=13) -c/ -c/6 -c data afctol/31/, decfac/22/, dstnrm/2/, dst0/3/, dstsav/18/, -c 1 f/10/, fdif/11/, flstgd/12/, f0/13/, gtslst/14/, gtstep/4/, -c 2 incfac/23/, lmaxs/36/, nreduc/6/, plstgd/15/, preduc/7/, -c 3 radfac/16/, rdfcmn/24/, rdfcmx/25/, reldx/17/, rfctol/32/, -c 4 sctol/37/, stppar/5/, tuner1/26/, tuner2/27/, tuner3/28/, -c 5 xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, decfac=22, dstnrm=2, dst0=3, dstsav=18, - 1 f=10, fdif=11, flstgd=12, f0=13, gtslst=14, gtstep=4, - 2 incfac=23, lmaxs=36, nreduc=6, plstgd=15, preduc=7, - 3 radfac=16, rdfcmn=24, rdfcmx=25, reldx=17, rfctol=32, - 4 sctol=37, stppar=5, tuner1=26, tuner2=27, tuner3=28, - 5 xctol=33, xftol=34) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nfc = iv(nfcall) - iv(switch) = 0 - iv(restor) = 0 - rfac1 = one - goodx = .true. - i = iv(irc) - if (i .ge. 1 .and. i .le. 12) - 1 go to (20,30,10,10,40,280,220,220,220,220,220,170), i - iv(irc) = 13 - go to 999 -c -c *** initialize for new iteration *** -c - 10 iv(stage) = 1 - iv(radinc) = 0 - v(flstgd) = v(f0) - if (iv(toobig) .eq. 0) go to 110 - iv(stage) = -1 - iv(xirc) = i - go to 60 -c -c *** step was recomputed with new model or smaller radius *** -c *** first decide which *** -c - 20 if (iv(model) .ne. iv(mlstgd)) go to 30 -c *** old model retained, smaller radius tried *** -c *** do not consider any more new models this iteration *** - iv(stage) = iv(stglim) - iv(radinc) = -1 - go to 110 -c -c *** a new model is being tried. decide whether to keep it. *** -c - 30 iv(stage) = iv(stage) + 1 -c -c *** now we add the possibiltiy that step was recomputed with *** -c *** the same model, perhaps because of an oversized step. *** -c - 40 if (iv(stage) .gt. 0) go to 50 -c -c *** step was recomputed because it was too big. *** -c - if (iv(toobig) .ne. 0) go to 60 -c -c *** restore iv(stage) and pick up where we left off. *** -c - iv(stage) = -iv(stage) - i = iv(xirc) - go to (20, 30, 110, 110, 70), i -c - 50 if (iv(toobig) .eq. 0) go to 70 -c -c *** handle oversize step *** -c - if (iv(radinc) .gt. 0) go to 80 - iv(stage) = -iv(stage) - iv(xirc) = iv(irc) -c - 60 v(radfac) = v(decfac) - iv(radinc) = iv(radinc) - 1 - iv(irc) = 5 - iv(restor) = 1 - go to 999 -c - 70 if (v(f) .lt. v(flstgd)) go to 110 -c -c *** the new step is a loser. restore old model. *** -c - if (iv(model) .eq. iv(mlstgd)) go to 80 - iv(model) = iv(mlstgd) - iv(switch) = 1 -c -c *** restore step, etc. only if a previous step decreased v(f). -c - 80 if (v(flstgd) .ge. v(f0)) go to 110 - iv(restor) = 1 - v(f) = v(flstgd) - v(preduc) = v(plstgd) - v(gtstep) = v(gtslst) - if (iv(switch) .eq. 0) rfac1 = v(dstnrm) / v(dstsav) - v(dstnrm) = v(dstsav) - nfc = iv(nfgcal) - goodx = .false. -c - 110 v(fdif) = v(f0) - v(f) - if (v(fdif) .gt. v(tuner2) * v(preduc)) go to 140 - if(iv(radinc).gt.0) go to 140 -c -c *** no (or only a trivial) function decrease -c *** -- so try new model or smaller radius -c - if (v(f) .lt. v(f0)) go to 120 - iv(mlstgd) = iv(model) - v(flstgd) = v(f) - v(f) = v(f0) - iv(restor) = 1 - go to 130 - 120 iv(nfgcal) = nfc - 130 iv(irc) = 1 - if (iv(stage) .lt. iv(stglim)) go to 160 - iv(irc) = 5 - iv(radinc) = iv(radinc) - 1 - go to 160 -c -c *** nontrivial function decrease achieved *** -c - 140 iv(nfgcal) = nfc - rfac1 = one - v(dstsav) = v(dstnrm) - if (v(fdif) .gt. v(preduc)*v(tuner1)) go to 190 -c -c *** decrease was much less than predicted -- either change models -c *** or accept step with decreased radius. -c - if (iv(stage) .ge. iv(stglim)) go to 150 -c *** consider switching models *** - iv(irc) = 2 - go to 160 -c -c *** accept step with decreased radius *** -c - 150 iv(irc) = 4 -c -c *** set v(radfac) to fletcher*s decrease factor *** -c - 160 iv(xirc) = iv(irc) - emax = v(gtstep) + v(fdif) - v(radfac) = half * rfac1 - if (emax .lt. v(gtstep)) v(radfac) = rfac1 * dmax1(v(rdfcmn), - 1 half * v(gtstep)/emax) -c -c *** do false convergence test *** -c - 170 if (v(reldx) .le. v(xftol)) go to 180 - iv(irc) = iv(xirc) - if (v(f) .lt. v(f0)) go to 200 - go to 230 -c - 180 iv(irc) = 12 - go to 240 -c -c *** handle good function decrease *** -c - 190 if (v(fdif) .lt. (-v(tuner3) * v(gtstep))) go to 210 -c -c *** increasing radius looks worthwhile. see if we just -c *** recomputed step with a decreased radius or restored step -c *** after recomputing it with a larger radius. -c - if (iv(radinc) .lt. 0) go to 210 - if (iv(restor) .eq. 1) go to 210 -c -c *** we did not. try a longer step unless this was a newton -c *** step. -c - v(radfac) = v(rdfcmx) - gts = v(gtstep) - if (v(fdif) .lt. (half/v(radfac) - one) * gts) - 1 v(radfac) = dmax1(v(incfac), half*gts/(gts + v(fdif))) - iv(irc) = 4 - if (v(stppar) .eq. zero) go to 230 - if (v(dst0) .ge. zero .and. (v(dst0) .lt. two*v(dstnrm) - 1 .or. v(nreduc) .lt. onep2*v(fdif))) go to 230 -c *** step was not a newton step. recompute it with -c *** a larger radius. - iv(irc) = 5 - iv(radinc) = iv(radinc) + 1 -c -c *** save values corresponding to good step *** -c - 200 v(flstgd) = v(f) - iv(mlstgd) = iv(model) - if (iv(restor) .ne. 1) iv(restor) = 2 - v(dstsav) = v(dstnrm) - iv(nfgcal) = nfc - v(plstgd) = v(preduc) - v(gtslst) = v(gtstep) - go to 230 -c -c *** accept step with radius unchanged *** -c - 210 v(radfac) = one - iv(irc) = 3 - go to 230 -c -c *** come here for a restart after convergence *** -c - 220 iv(irc) = iv(xirc) - if (v(dstsav) .ge. zero) go to 240 - iv(irc) = 12 - go to 240 -c -c *** perform convergence tests *** -c - 230 iv(xirc) = iv(irc) - 240 if (iv(restor) .eq. 1 .and. v(flstgd) .lt. v(f0)) iv(restor) = 3 - if (half * v(fdif) .gt. v(preduc)) go to 999 - emax = v(rfctol) * dabs(v(f0)) - emaxs = v(sctol) * dabs(v(f0)) - if (v(dstnrm) .gt. v(lmaxs) .and. v(preduc) .le. emaxs) - 1 iv(irc) = 11 - if (v(dst0) .lt. zero) go to 250 - i = 0 - if ((v(nreduc) .gt. zero .and. v(nreduc) .le. emax) .or. - 1 (v(nreduc) .eq. zero. and. v(preduc) .eq. zero)) i = 2 - if (v(stppar) .eq. zero .and. v(reldx) .le. v(xctol) - 1 .and. goodx) i = i + 1 - if (i .gt. 0) iv(irc) = i + 6 -c -c *** consider recomputing step of length v(lmaxs) for singular -c *** convergence test. -c - 250 if (iv(irc) .gt. 5 .and. iv(irc) .ne. 12) go to 999 - if (v(dstnrm) .gt. v(lmaxs)) go to 260 - if (v(preduc) .ge. emaxs) go to 999 - if (v(dst0) .le. zero) go to 270 - if (half * v(dst0) .le. v(lmaxs)) go to 999 - go to 270 - 260 if (half * v(dstnrm) .le. v(lmaxs)) go to 999 - xmax = v(lmaxs) / v(dstnrm) - if (xmax * (two - xmax) * v(preduc) .ge. emaxs) go to 999 - 270 if (v(nreduc) .lt. zero) go to 290 -c -c *** recompute v(preduc) for use in singular convergence test *** -c - v(gtslst) = v(gtstep) - v(dstsav) = v(dstnrm) - if (iv(irc) .eq. 12) v(dstsav) = -v(dstsav) - v(plstgd) = v(preduc) - i = iv(restor) - iv(restor) = 2 - if (i .eq. 3) iv(restor) = 0 - iv(irc) = 6 - go to 999 -c -c *** perform singular convergence test with recomputed v(preduc) *** -c - 280 v(gtstep) = v(gtslst) - v(dstnrm) = dabs(v(dstsav)) - iv(irc) = iv(xirc) - if (v(dstsav) .le. zero) iv(irc) = 12 - v(nreduc) = -v(preduc) - v(preduc) = v(plstgd) - iv(restor) = 3 - 290 if (-v(nreduc) .le. v(sctol) * dabs(v(f0))) iv(irc) = 11 -c - 999 return -c -c *** last card of assst follows *** - end - subroutine deflt(alg, iv, liv, lv, v) -c -c *** supply ***sol (version 2.3) default values to iv and v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer liv, l - integer alg, iv(liv) - double precision v(lv) -c - external imdcon, vdflt - integer imdcon -c imdcon... returns machine-dependent integer constants. -c vdflt.... provides default values to v. -c - integer miv, m - integer miniv(2), minv(2) -c -c *** subscripts for iv *** -c - integer algsav, covprt, covreq, dtype, hc, ierr, inith, inits, - 1 ipivot, ivneed, lastiv, lastv, lmat, mxfcal, mxiter, - 2 nfcov, ngcov, nvdflt, outlev, parprt, parsav, perm, - 3 prunit, qrtyp, rdreq, rmat, solprt, statpr, vneed, - 4 vsave, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, covprt/14/, covreq/15/, dtype/16/, hc/71/, -c 1 ierr/75/, inith/25/, inits/25/, ipivot/76/, ivneed/3/, -c 2 lastiv/44/, lastv/45/, lmat/42/, mxfcal/17/, mxiter/18/, -c 3 nfcov/52/, ngcov/53/, nvdflt/50/, outlev/19/, parprt/20/, -c 4 parsav/49/, perm/58/, prunit/21/, qrtyp/80/, rdreq/57/, -c 5 rmat/78/, solprt/22/, statpr/23/, vneed/4/, vsave/60/, -c 6 x0prt/24/ -c/7 - parameter (algsav=51, covprt=14, covreq=15, dtype=16, hc=71, - 1 ierr=75, inith=25, inits=25, ipivot=76, ivneed=3, - 2 lastiv=44, lastv=45, lmat=42, mxfcal=17, mxiter=18, - 3 nfcov=52, ngcov=53, nvdflt=50, outlev=19, parprt=20, - 4 parsav=49, perm=58, prunit=21, qrtyp=80, rdreq=57, - 5 rmat=78, solprt=22, statpr=23, vneed=4, vsave=60, - 6 x0prt=24) -c/ - data miniv(1)/80/, miniv(2)/59/, minv(1)/98/, minv(2)/71/ -c -c------------------------------- body -------------------------------- -c - if (alg .lt. 1 .or. alg .gt. 2) go to 40 - miv = miniv(alg) - if (liv .lt. miv) go to 20 - mv = minv(alg) - if (lv .lt. mv) go to 30 - call vdflt(alg, lv, v) - iv(1) = 12 - iv(algsav) = alg - iv(ivneed) = 0 - iv(lastiv) = miv - iv(lastv) = mv - iv(lmat) = mv + 1 - iv(mxfcal) = 200 - iv(mxiter) = 150 - iv(outlev) = 1 - iv(parprt) = 1 - iv(perm) = miv + 1 - iv(prunit) = imdcon(1) - iv(solprt) = 1 - iv(statpr) = 1 - iv(vneed) = 0 - iv(x0prt) = 1 -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - iv(covprt) = 3 - iv(covreq) = 1 - iv(dtype) = 1 - iv(hc) = 0 - iv(ierr) = 0 - iv(inits) = 0 - iv(ipivot) = 0 - iv(nvdflt) = 32 - iv(parsav) = 67 - iv(qrtyp) = 1 - iv(rdreq) = 3 - iv(rmat) = 0 - iv(vsave) = 58 - go to 999 -c -c *** general optimization values -c - 10 iv(dtype) = 0 - iv(inith) = 1 - iv(nfcov) = 0 - iv(ngcov) = 0 - iv(nvdflt) = 25 - iv(parsav) = 47 - go to 999 -c - 20 iv(1) = 15 - go to 999 -c - 30 iv(1) = 16 - go to 999 -c - 40 iv(1) = 67 -c - 999 return -c *** last card of deflt follows *** - end - double precision function dotprd(p, x, y) -c -c *** return the inner product of the p-vectors x and y. *** -c - integer p - double precision x(p), y(p) -c - integer i - double precision one, sqteta, t, zero -c/+ - double precision dmax1, dabs -c/ - external rmdcon - double precision rmdcon -c -c *** rmdcon(2) returns a machine-dependent constant, sqteta, which -c *** is slightly larger than the smallest positive number that -c *** can be squared without underflowing. -c -c/6 -c data one/1.d+0/, sqteta/0.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - data sqteta/0.d+0/ -c/ -c - dotprd = zero - if (p .le. 0) go to 999 -crc if (sqteta .eq. zero) sqteta = rmdcon(2) - do 20 i = 1, p -crc t = dmax1(dabs(x(i)), dabs(y(i))) -crc if (t .gt. one) go to 10 -crc if (t .lt. sqteta) go to 20 -crc t = (x(i)/sqteta)*y(i) -crc if (dabs(t) .lt. sqteta) go to 20 - 10 dotprd = dotprd + x(i)*y(i) - 20 continue -c - 999 return -c *** last card of dotprd follows *** - end - subroutine itsum(d, g, iv, liv, lv, p, v, x) -c -c *** print iteration summary for ***sol (version 2.3) *** -c -c *** parameter declarations *** -c - integer liv, lv, p - integer iv(liv) - double precision d(p), g(p), v(lv), x(p) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer alg, i, iv1, m, nf, ng, ol, pu -c/6 -c real model1(6), model2(6) -c/7 - character*4 model1(6), model2(6) -c/ - double precision nreldf, oldf, preldf, reldf, zero -c -c *** intrinsic functions *** -c/+ - integer iabs - double precision dabs, dmax1 -c/ -c *** no external functions or subroutines *** -c -c *** subscripts for iv and v *** -c - integer algsav, dstnrm, f, fdif, f0, needhd, nfcall, nfcov, ngcov, - 1 ngcall, niter, nreduc, outlev, preduc, prntit, prunit, - 2 reldx, solprt, statpr, stppar, sused, x0prt -c -c *** iv subscript values *** -c -c/6 -c data algsav/51/, needhd/36/, nfcall/6/, nfcov/52/, ngcall/30/, -c 1 ngcov/53/, niter/31/, outlev/19/, prntit/39/, prunit/21/, -c 2 solprt/22/, statpr/23/, sused/64/, x0prt/24/ -c/7 - parameter (algsav=51, needhd=36, nfcall=6, nfcov=52, ngcall=30, - 1 ngcov=53, niter=31, outlev=19, prntit=39, prunit=21, - 2 solprt=22, statpr=23, sused=64, x0prt=24) -c/ -c -c *** v subscript values *** -c -c/6 -c data dstnrm/2/, f/10/, f0/13/, fdif/11/, nreduc/6/, preduc/7/, -c 1 reldx/17/, stppar/5/ -c/7 - parameter (dstnrm=2, f=10, f0=13, fdif=11, nreduc=6, preduc=7, - 1 reldx=17, stppar=5) -c/ -c -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c/6 -c data model1(1)/4h /, model1(2)/4h /, model1(3)/4h /, -c 1 model1(4)/4h /, model1(5)/4h g /, model1(6)/4h s /, -c 2 model2(1)/4h g /, model2(2)/4h s /, model2(3)/4hg-s /, -c 3 model2(4)/4hs-g /, model2(5)/4h-s-g/, model2(6)/4h-g-s/ -c/7 - data model1/' ',' ',' ',' ',' g ',' s '/, - 1 model2/' g ',' s ','g-s ','s-g ','-s-g','-g-s'/ -c/ -c -c------------------------------- body -------------------------------- -c - pu = iv(prunit) - if (pu .eq. 0) go to 999 - iv1 = iv(1) - if (iv1 .gt. 62) iv1 = iv1 - 51 - ol = iv(outlev) - alg = iv(algsav) - if (iv1 .lt. 2 .or. iv1 .gt. 15) go to 370 - if (iv1 .ge. 12) go to 120 - if (iv1 .eq. 2 .and. iv(niter) .eq. 0) go to 390 - if (ol .eq. 0) go to 120 - if (iv1 .ge. 10 .and. iv(prntit) .eq. 0) go to 120 - if (iv1 .gt. 2) go to 10 - iv(prntit) = iv(prntit) + 1 - if (iv(prntit) .lt. iabs(ol)) go to 999 - 10 nf = iv(nfcall) - iabs(iv(nfcov)) - iv(prntit) = 0 - reldf = zero - preldf = zero - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - if (oldf .le. zero) go to 20 - reldf = v(fdif) / oldf - preldf = v(preduc) / oldf - 20 if (ol .gt. 0) go to 60 -c -c *** print short summary line *** -c - if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,30) - 30 format(/10h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,40) - 40 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar) - iv(needhd) = 0 - if (alg .eq. 2) go to 50 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar) - go to 120 -c - 50 write(pu,110) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 v(stppar) - go to 120 -c -c *** print long summary line *** -c - 60 if (iv(needhd) .eq. 1 .and. alg .eq. 1) write(pu,70) - 70 format(/11h it nf,6x,1hf,7x,5hreldf,3x,6hpreldf,3x,5hreldx, - 1 2x,13hmodel stppar,2x,6hd*step,2x,7hnpreldf) - if (iv(needhd) .eq. 1 .and. alg .eq. 2) write(pu,80) - 80 format(/11h it nf,7x,1hf,8x,5hreldf,4x,6hpreldf,4x,5hreldx, - 1 3x,6hstppar,3x,6hd*step,3x,7hnpreldf) - iv(needhd) = 0 - nreldf = zero - if (oldf .gt. zero) nreldf = v(nreduc) / oldf - if (alg .eq. 2) go to 90 - m = iv(sused) - write(pu,100) iv(niter), nf, v(f), reldf, preldf, v(reldx), - 1 model1(m), model2(m), v(stppar), v(dstnrm), nreldf - go to 120 -c - 90 write(pu,110) iv(niter), nf, v(f), reldf, preldf, - 1 v(reldx), v(stppar), v(dstnrm), nreldf - 100 format(i6,i5,d10.3,2d9.2,d8.1,a3,a4,2d8.1,d9.2) - 110 format(i6,i5,d11.3,2d10.2,3d9.1,d10.2) -c - 120 if (iv(statpr) .lt. 0) go to 430 - go to (999, 999, 130, 150, 170, 190, 210, 230, 250, 270, 290, 310, - 1 330, 350, 520), iv1 -c - 130 write(pu,140) - 140 format(/26h ***** x-convergence *****) - go to 430 -c - 150 write(pu,160) - 160 format(/42h ***** relative function convergence *****) - go to 430 -c - 170 write(pu,180) - 180 format(/49h ***** x- and relative function convergence *****) - go to 430 -c - 190 write(pu,200) - 200 format(/42h ***** absolute function convergence *****) - go to 430 -c - 210 write(pu,220) - 220 format(/33h ***** singular convergence *****) - go to 430 -c - 230 write(pu,240) - 240 format(/30h ***** false convergence *****) - go to 430 -c - 250 write(pu,260) - 260 format(/38h ***** function evaluation limit *****) - go to 430 -c - 270 write(pu,280) - 280 format(/28h ***** iteration limit *****) - go to 430 -c - 290 write(pu,300) - 300 format(/18h ***** stopx *****) - go to 430 -c - 310 write(pu,320) - 320 format(/44h ***** initial f(x) cannot be computed *****) -c - go to 390 -c - 330 write(pu,340) - 340 format(/37h ***** bad parameters to assess *****) - go to 999 -c - 350 write(pu,360) - 360 format(/43h ***** gradient could not be computed *****) - if (iv(niter) .gt. 0) go to 480 - go to 390 -c - 370 write(pu,380) iv(1) - 380 format(/14h ***** iv(1) =,i5,6h *****) - go to 999 -c -c *** initial call on itsum *** -c - 390 if (iv(x0prt) .ne. 0) write(pu,400) (i, x(i), d(i), i = 1, p) - 400 format(/23h i initial x(i),8x,4hd(i)//(1x,i5,d17.6,d14.3)) -c *** the following are to avoid undefined variables when the -c *** function evaluation limit is 1... - v(dstnrm) = zero - v(fdif) = zero - v(nreduc) = zero - v(preduc) = zero - v(reldx) = zero - if (iv1 .ge. 12) go to 999 - iv(needhd) = 0 - iv(prntit) = 0 - if (ol .eq. 0) go to 999 - if (ol .lt. 0 .and. alg .eq. 1) write(pu,30) - if (ol .lt. 0 .and. alg .eq. 2) write(pu,40) - if (ol .gt. 0 .and. alg .eq. 1) write(pu,70) - if (ol .gt. 0 .and. alg .eq. 2) write(pu,80) - if (alg .eq. 1) write(pu,410) v(f) - if (alg .eq. 2) write(pu,420) v(f) - 410 format(/11h 0 1,d10.3) -c365 format(/11h 0 1,e11.3) - 420 format(/11h 0 1,d11.3) - go to 999 -c -c *** print various information requested on solution *** -c - 430 iv(needhd) = 1 - if (iv(statpr) .eq. 0) go to 480 - oldf = dmax1(dabs(v(f0)), dabs(v(f))) - preldf = zero - nreldf = zero - if (oldf .le. zero) go to 440 - preldf = v(preduc) / oldf - nreldf = v(nreduc) / oldf - 440 nf = iv(nfcall) - iv(nfcov) - ng = iv(ngcall) - iv(ngcov) - write(pu,450) v(f), v(reldx), nf, ng, preldf, nreldf - 450 format(/9h function,d17.6,8h reldx,d17.3/12h func. evals, - 1 i8,9x,11hgrad. evals,i8/7h preldf,d16.3,6x,7hnpreldf,d15.3) -c - if (iv(nfcov) .gt. 0) write(pu,460) iv(nfcov) - 460 format(/1x,i4,50h extra func. evals for covariance and diagnost - 1ics.) - if (iv(ngcov) .gt. 0) write(pu,470) iv(ngcov) - 470 format(1x,i4,50h extra grad. evals for covariance and diagnosti - 1cs.) -c - 480 if (iv(solprt) .eq. 0) go to 999 - iv(needhd) = 1 - write(pu,490) - 490 format(/22h i final x(i),8x,4hd(i),10x,4hg(i)/) - do 500 i = 1, p - write(pu,510) i, x(i), d(i), g(i) - 500 continue - 510 format(1x,i5,d16.6,2d14.3) - go to 999 -c - 520 write(pu,530) - 530 format(/24h inconsistent dimensions) - 999 return -c *** last card of itsum follows *** - end - subroutine litvmu(n, x, l, y) -c -c *** solve (l**t)*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - integer i, ii, ij, im1, i0, j, np1 - double precision xi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 i = 1, n - 10 x(i) = y(i) - np1 = n + 1 - i0 = n*(n+1)/2 - do 30 ii = 1, n - i = np1 - ii - xi = x(i)/l(i0) - x(i) = xi - if (i .le. 1) go to 999 - i0 = i0 - i - if (xi .eq. zero) go to 30 - im1 = i - 1 - do 20 j = 1, im1 - ij = i0 + j - x(j) = x(j) - xi*l(ij) - 20 continue - 30 continue - 999 return -c *** last card of litvmu follows *** - end - subroutine livmul(n, x, l, y) -c -c *** solve l*x = y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) - external dotprd - double precision dotprd - integer i, j, k - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - do 10 k = 1, n - if (y(k) .ne. zero) go to 20 - x(k) = zero - 10 continue - go to 999 - 20 j = k*(k+1)/2 - x(k) = y(k) / l(j) - if (k .ge. n) go to 999 - k = k + 1 - do 30 i = k, n - t = dotprd(i-1, l(j+1), x) - j = j + i - x(i) = (y(i) - t)/l(j) - 30 continue - 999 return -c *** last card of livmul follows *** - end - subroutine parck(alg, d, iv, liv, lv, n, v) -c -c *** check ***sol (version 2.3) parameters, print changed values *** -c -c *** alg = 1 for regression, alg = 2 for general unconstrained opt. -c - integer alg, liv, lv, n - integer iv(liv) - double precision d(n), v(lv) -c - external rmdcon, vcopy, vdflt - double precision rmdcon -c rmdcon -- returns machine-dependent constants. -c vcopy -- copies one vector to another. -c vdflt -- supplies default parameter values to v alone. -c/+ - integer max0 -c/ -c -c *** local variables *** -c - integer i, ii, iv1, j, k, l, m, miv1, miv2, ndfalt, parsv1, pu - integer ijmp, jlim(2), miniv(2), ndflt(2) -c/6 -c integer varnm(2), sh(2) -c real cngd(3), dflt(3), vn(2,34), which(3) -c/7 - character*1 varnm(2), sh(2) - character*4 cngd(3), dflt(3), vn(2,34), which(3) -c/ - double precision big, machep, tiny, vk, vm(34), vx(34), zero -c -c *** iv and v subscripts *** -c - integer algsav, dinit, dtype, dtype0, epslon, inits, ivneed, - 1 lastiv, lastv, lmat, nextiv, nextv, nvdflt, oldn, - 2 parprt, parsav, perm, prunit, vneed -c -c -c/6 -c data algsav/51/, dinit/38/, dtype/16/, dtype0/54/, epslon/19/, -c 1 inits/25/, ivneed/3/, lastiv/44/, lastv/45/, lmat/42/, -c 2 nextiv/46/, nextv/47/, nvdflt/50/, oldn/38/, parprt/20/, -c 3 parsav/49/, perm/58/, prunit/21/, vneed/4/ -c/7 - parameter (algsav=51, dinit=38, dtype=16, dtype0=54, epslon=19, - 1 inits=25, ivneed=3, lastiv=44, lastv=45, lmat=42, - 2 nextiv=46, nextv=47, nvdflt=50, oldn=38, parprt=20, - 3 parsav=49, perm=58, prunit=21, vneed=4) - save big, machep, tiny -c/ -c - data big/0.d+0/, machep/-1.d+0/, tiny/1.d+0/, zero/0.d+0/ -c/6 -c data vn(1,1),vn(2,1)/4hepsl,4hon../ -c data vn(1,2),vn(2,2)/4hphmn,4hfc../ -c data vn(1,3),vn(2,3)/4hphmx,4hfc../ -c data vn(1,4),vn(2,4)/4hdecf,4hac../ -c data vn(1,5),vn(2,5)/4hincf,4hac../ -c data vn(1,6),vn(2,6)/4hrdfc,4hmn../ -c data vn(1,7),vn(2,7)/4hrdfc,4hmx../ -c data vn(1,8),vn(2,8)/4htune,4hr1../ -c data vn(1,9),vn(2,9)/4htune,4hr2../ -c data vn(1,10),vn(2,10)/4htune,4hr3../ -c data vn(1,11),vn(2,11)/4htune,4hr4../ -c data vn(1,12),vn(2,12)/4htune,4hr5../ -c data vn(1,13),vn(2,13)/4hafct,4hol../ -c data vn(1,14),vn(2,14)/4hrfct,4hol../ -c data vn(1,15),vn(2,15)/4hxcto,4hl.../ -c data vn(1,16),vn(2,16)/4hxfto,4hl.../ -c data vn(1,17),vn(2,17)/4hlmax,4h0.../ -c data vn(1,18),vn(2,18)/4hlmax,4hs.../ -c data vn(1,19),vn(2,19)/4hscto,4hl.../ -c data vn(1,20),vn(2,20)/4hdini,4ht.../ -c data vn(1,21),vn(2,21)/4hdtin,4hit../ -c data vn(1,22),vn(2,22)/4hd0in,4hit../ -c data vn(1,23),vn(2,23)/4hdfac,4h..../ -c data vn(1,24),vn(2,24)/4hdltf,4hdc../ -c data vn(1,25),vn(2,25)/4hdltf,4hdj../ -c data vn(1,26),vn(2,26)/4hdelt,4ha0../ -c data vn(1,27),vn(2,27)/4hfuzz,4h..../ -c data vn(1,28),vn(2,28)/4hrlim,4hit../ -c data vn(1,29),vn(2,29)/4hcosm,4hin../ -c data vn(1,30),vn(2,30)/4hhube,4hrc../ -c data vn(1,31),vn(2,31)/4hrspt,4hol../ -c data vn(1,32),vn(2,32)/4hsigm,4hin../ -c data vn(1,33),vn(2,33)/4heta0,4h..../ -c data vn(1,34),vn(2,34)/4hbias,4h..../ -c/7 - data vn(1,1),vn(2,1)/'epsl','on..'/ - data vn(1,2),vn(2,2)/'phmn','fc..'/ - data vn(1,3),vn(2,3)/'phmx','fc..'/ - data vn(1,4),vn(2,4)/'decf','ac..'/ - data vn(1,5),vn(2,5)/'incf','ac..'/ - data vn(1,6),vn(2,6)/'rdfc','mn..'/ - data vn(1,7),vn(2,7)/'rdfc','mx..'/ - data vn(1,8),vn(2,8)/'tune','r1..'/ - data vn(1,9),vn(2,9)/'tune','r2..'/ - data vn(1,10),vn(2,10)/'tune','r3..'/ - data vn(1,11),vn(2,11)/'tune','r4..'/ - data vn(1,12),vn(2,12)/'tune','r5..'/ - data vn(1,13),vn(2,13)/'afct','ol..'/ - data vn(1,14),vn(2,14)/'rfct','ol..'/ - data vn(1,15),vn(2,15)/'xcto','l...'/ - data vn(1,16),vn(2,16)/'xfto','l...'/ - data vn(1,17),vn(2,17)/'lmax','0...'/ - data vn(1,18),vn(2,18)/'lmax','s...'/ - data vn(1,19),vn(2,19)/'scto','l...'/ - data vn(1,20),vn(2,20)/'dini','t...'/ - data vn(1,21),vn(2,21)/'dtin','it..'/ - data vn(1,22),vn(2,22)/'d0in','it..'/ - data vn(1,23),vn(2,23)/'dfac','....'/ - data vn(1,24),vn(2,24)/'dltf','dc..'/ - data vn(1,25),vn(2,25)/'dltf','dj..'/ - data vn(1,26),vn(2,26)/'delt','a0..'/ - data vn(1,27),vn(2,27)/'fuzz','....'/ - data vn(1,28),vn(2,28)/'rlim','it..'/ - data vn(1,29),vn(2,29)/'cosm','in..'/ - data vn(1,30),vn(2,30)/'hube','rc..'/ - data vn(1,31),vn(2,31)/'rspt','ol..'/ - data vn(1,32),vn(2,32)/'sigm','in..'/ - data vn(1,33),vn(2,33)/'eta0','....'/ - data vn(1,34),vn(2,34)/'bias','....'/ -c/ -c - data vm(1)/1.0d-3/, vm(2)/-0.99d+0/, vm(3)/1.0d-3/, vm(4)/1.0d-2/, - 1 vm(5)/1.2d+0/, vm(6)/1.d-2/, vm(7)/1.2d+0/, vm(8)/0.d+0/, - 2 vm(9)/0.d+0/, vm(10)/1.d-3/, vm(11)/-1.d+0/, vm(13)/0.d+0/, - 3 vm(15)/0.d+0/, vm(16)/0.d+0/, vm(19)/0.d+0/, vm(20)/-10.d+0/, - 4 vm(21)/0.d+0/, vm(22)/0.d+0/, vm(23)/0.d+0/, vm(27)/1.01d+0/, - 5 vm(28)/1.d+10/, vm(30)/0.d+0/, vm(31)/0.d+0/, vm(32)/0.d+0/, - 6 vm(34)/0.d+0/ - data vx(1)/0.9d+0/, vx(2)/-1.d-3/, vx(3)/1.d+1/, vx(4)/0.8d+0/, - 1 vx(5)/1.d+2/, vx(6)/0.8d+0/, vx(7)/1.d+2/, vx(8)/0.5d+0/, - 2 vx(9)/0.5d+0/, vx(10)/1.d+0/, vx(11)/1.d+0/, vx(14)/0.1d+0/, - 3 vx(15)/1.d+0/, vx(16)/1.d+0/, vx(19)/1.d+0/, vx(23)/1.d+0/, - 4 vx(24)/1.d+0/, vx(25)/1.d+0/, vx(26)/1.d+0/, vx(27)/1.d+10/, - 5 vx(29)/1.d+0/, vx(31)/1.d+0/, vx(32)/1.d+0/, vx(33)/1.d+0/, - 6 vx(34)/1.d+0/ -c -c/6 -c data varnm(1)/1hp/, varnm(2)/1hn/, sh(1)/1hs/, sh(2)/1hh/ -c data cngd(1),cngd(2),cngd(3)/4h---c,4hhang,4hed v/, -c 1 dflt(1),dflt(2),dflt(3)/4hnond,4hefau,4hlt v/ -c/7 - data varnm(1)/'p'/, varnm(2)/'n'/, sh(1)/'s'/, sh(2)/'h'/ - data cngd(1),cngd(2),cngd(3)/'---c','hang','ed v'/, - 1 dflt(1),dflt(2),dflt(3)/'nond','efau','lt v'/ -c/ - data ijmp/33/, jlim(1)/0/, jlim(2)/24/, ndflt(1)/32/, ndflt(2)/25/ - data miniv(1)/80/, miniv(2)/59/ -c -c............................... body ................................ -c - pu = 0 - if (prunit .le. liv) pu = iv(prunit) - if (alg .lt. 1 .or. alg .gt. 2) go to 340 - if (iv(1) .eq. 0) call deflt(alg, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .ne. 13 .and. iv1 .ne. 12) go to 10 - miv1 = miniv(alg) - if (perm .le. liv) miv1 = max0(miv1, iv(perm) - 1) - if (ivneed .le. liv) miv2 = miv1 + max0(iv(ivneed), 0) - if (lastiv .le. liv) iv(lastiv) = miv2 - if (liv .lt. miv1) go to 300 - iv(ivneed) = 0 - iv(lastv) = max0(iv(vneed), 0) + iv(lmat) - 1 - iv(vneed) = 0 - if (liv .lt. miv2) go to 300 - if (lv .lt. iv(lastv)) go to 320 - 10 if (alg .eq. iv(algsav)) go to 30 - if (pu .ne. 0) write(pu,20) alg, iv(algsav) - 20 format(/39h the first parameter to deflt should be,i3, - 1 12h rather than,i3) - iv(1) = 82 - go to 999 - 30 if (iv1 .lt. 12 .or. iv1 .gt. 14) go to 60 - if (n .ge. 1) go to 50 - iv(1) = 81 - if (pu .eq. 0) go to 999 - write(pu,40) varnm(alg), n - 40 format(/8h /// bad,a1,2h =,i5) - go to 999 - 50 if (iv1 .ne. 14) iv(nextiv) = iv(perm) - if (iv1 .ne. 14) iv(nextv) = iv(lmat) - if (iv1 .eq. 13) go to 999 - k = iv(parsav) - epslon - call vdflt(alg, lv-k, v(k+1)) - iv(dtype0) = 2 - alg - iv(oldn) = n - which(1) = dflt(1) - which(2) = dflt(2) - which(3) = dflt(3) - go to 110 - 60 if (n .eq. iv(oldn)) go to 80 - iv(1) = 17 - if (pu .eq. 0) go to 999 - write(pu,70) varnm(alg), iv(oldn), n - 70 format(/5h /// ,1a1,14h changed from ,i5,4h to ,i5) - go to 999 -c - 80 if (iv1 .le. 11 .and. iv1 .ge. 1) go to 100 - iv(1) = 80 - if (pu .ne. 0) write(pu,90) iv1 - 90 format(/13h /// iv(1) =,i5,28h should be between 0 and 14.) - go to 999 -c - 100 which(1) = cngd(1) - which(2) = cngd(2) - which(3) = cngd(3) -c - 110 if (iv1 .eq. 14) iv1 = 12 - if (big .gt. tiny) go to 120 - tiny = rmdcon(1) - machep = rmdcon(3) - big = rmdcon(6) - vm(12) = machep - vx(12) = big - vx(13) = big - vm(14) = machep - vm(17) = tiny - vx(17) = big - vm(18) = tiny - vx(18) = big - vx(20) = big - vx(21) = big - vx(22) = big - vm(24) = machep - vm(25) = machep - vm(26) = machep - vx(28) = rmdcon(5) - vm(29) = machep - vx(30) = big - vm(33) = machep - 120 m = 0 - i = 1 - j = jlim(alg) - k = epslon - ndfalt = ndflt(alg) - do 150 l = 1, ndfalt - vk = v(k) - if (vk .ge. vm(i) .and. vk .le. vx(i)) go to 140 - m = k - if (pu .ne. 0) write(pu,130) vn(1,i), vn(2,i), k, vk, - 1 vm(i), vx(i) - 130 format(/6h /// ,2a4,5h.. v(,i2,3h) =,d11.3,7h should, - 1 11h be between,d11.3,4h and,d11.3) - 140 k = k + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 150 continue -c - if (iv(nvdflt) .eq. ndfalt) go to 170 - iv(1) = 51 - if (pu .eq. 0) go to 999 - write(pu,160) iv(nvdflt), ndfalt - 160 format(/13h iv(nvdflt) =,i5,13h rather than ,i5) - go to 999 - 170 if ((iv(dtype) .gt. 0 .or. v(dinit) .gt. zero) .and. iv1 .eq. 12) - 1 go to 200 - do 190 i = 1, n - if (d(i) .gt. zero) go to 190 - m = 18 - if (pu .ne. 0) write(pu,180) i, d(i) - 180 format(/8h /// d(,i3,3h) =,d11.3,19h should be positive) - 190 continue - 200 if (m .eq. 0) go to 210 - iv(1) = m - go to 999 -c - 210 if (pu .eq. 0 .or. iv(parprt) .eq. 0) go to 999 - if (iv1 .ne. 12 .or. iv(inits) .eq. alg-1) go to 230 - m = 1 - write(pu,220) sh(alg), iv(inits) - 220 format(/22h nondefault values..../5h init,a1,14h..... iv(25) =, - 1 i3) - 230 if (iv(dtype) .eq. iv(dtype0)) go to 250 - if (m .eq. 0) write(pu,260) which - m = 1 - write(pu,240) iv(dtype) - 240 format(20h dtype..... iv(16) =,i3) - 250 i = 1 - j = jlim(alg) - k = epslon - l = iv(parsav) - ndfalt = ndflt(alg) - do 290 ii = 1, ndfalt - if (v(k) .eq. v(l)) go to 280 - if (m .eq. 0) write(pu,260) which - 260 format(/1h ,3a4,9halues..../) - m = 1 - write(pu,270) vn(1,i), vn(2,i), k, v(k) - 270 format(1x,2a4,5h.. v(,i2,3h) =,d15.7) - 280 k = k + 1 - l = l + 1 - i = i + 1 - if (i .eq. j) i = ijmp - 290 continue -c - iv(dtype0) = iv(dtype) - parsv1 = iv(parsav) - call vcopy(iv(nvdflt), v(parsv1), v(epslon)) - go to 999 -c - 300 iv(1) = 15 - if (pu .eq. 0) go to 999 - write(pu,310) liv, miv2 - 310 format(/10h /// liv =,i5,17h must be at least,i5) - if (liv .lt. miv1) go to 999 - if (lv .lt. iv(lastv)) go to 320 - go to 999 -c - 320 iv(1) = 16 - if (pu .eq. 0) go to 999 - write(pu,330) lv, iv(lastv) - 330 format(/9h /// lv =,i5,17h must be at least,i5) - go to 999 -c - 340 iv(1) = 67 - if (pu .eq. 0) go to 999 - write(pu,350) alg - 350 format(/10h /// alg =,i5,15h must be 1 or 2) -c - 999 return -c *** last card of parck follows *** - end - double precision function reldst(p, d, x, x0) -c -c *** compute and return relative difference between x and x0 *** -c *** nl2sol version 2.2 *** -c - integer p - double precision d(p), x(p), x0(p) -c/+ - double precision dabs -c/ - integer i - double precision emax, t, xmax, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - emax = zero - xmax = zero - do 10 i = 1, p - t = dabs(d(i) * (x(i) - x0(i))) - if (emax .lt. t) emax = t - t = d(i) * (dabs(x(i)) + dabs(x0(i))) - if (xmax .lt. t) xmax = t - 10 continue - reldst = zero - if (xmax .gt. zero) reldst = emax / xmax - 999 return -c *** last card of reldst follows *** - end -c logical function stopx(idummy) -c *****parameters... -c integer idummy -c -c .................................................................. -c -c *****purpose... -c this function may serve as the stopx (asynchronous interruption) -c function for the nl2sol (nonlinear least-squares) package at -c those installations which do not wish to implement a -c dynamic stopx. -c -c *****algorithm notes... -c at installations where the nl2sol system is used -c interactively, this dummy stopx should be replaced by a -c function that returns .true. if and only if the interrupt -c (break) key has been pressed since the last call on stopx. -c -c .................................................................. -c -c stopx = .false. -c return -c end - subroutine vaxpy(p, w, a, x, y) -c -c *** set w = a*x + y -- w, x, y = p-vectors, a = scalar *** -c - integer p - double precision a, w(p), x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 w(i) = a*x(i) + y(i) - return - end - subroutine vcopy(p, y, x) -c -c *** set y = x, where x and y are p-vectors *** -c - integer p - double precision x(p), y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = x(i) - return - end - subroutine vdflt(alg, lv, v) -c -c *** supply ***sol (version 2.3) default values to v *** -c -c *** alg = 1 means regression constants. -c *** alg = 2 means general unconstrained optimization constants. -c - integer alg, l - double precision v(lv) -c/+ - double precision dmax1 -c/ - external rmdcon - double precision rmdcon -c rmdcon... returns machine-dependent constants -c - double precision machep, mepcrt, one, sqteps, three -c -c *** subscripts for v *** -c - integer afctol, bias, cosmin, decfac, delta0, dfac, dinit, dltfdc, - 1 dltfdj, dtinit, d0init, epslon, eta0, fuzz, huberc, - 2 incfac, lmax0, lmaxs, phmnfc, phmxfc, rdfcmn, rdfcmx, - 3 rfctol, rlimit, rsptol, sctol, sigmin, tuner1, tuner2, - 4 tuner3, tuner4, tuner5, xctol, xftol -c -c/6 -c data one/1.d+0/, three/3.d+0/ -c/7 - parameter (one=1.d+0, three=3.d+0) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/, bias/43/, cosmin/47/, decfac/22/, delta0/44/, -c 1 dfac/41/, dinit/38/, dltfdc/42/, dltfdj/43/, dtinit/39/, -c 2 d0init/40/, epslon/19/, eta0/42/, fuzz/45/, huberc/48/, -c 3 incfac/23/, lmax0/35/, lmaxs/36/, phmnfc/20/, phmxfc/21/, -c 4 rdfcmn/24/, rdfcmx/25/, rfctol/32/, rlimit/46/, rsptol/49/, -c 5 sctol/37/, sigmin/50/, tuner1/26/, tuner2/27/, tuner3/28/, -c 6 tuner4/29/, tuner5/30/, xctol/33/, xftol/34/ -c/7 - parameter (afctol=31, bias=43, cosmin=47, decfac=22, delta0=44, - 1 dfac=41, dinit=38, dltfdc=42, dltfdj=43, dtinit=39, - 2 d0init=40, epslon=19, eta0=42, fuzz=45, huberc=48, - 3 incfac=23, lmax0=35, lmaxs=36, phmnfc=20, phmxfc=21, - 4 rdfcmn=24, rdfcmx=25, rfctol=32, rlimit=46, rsptol=49, - 5 sctol=37, sigmin=50, tuner1=26, tuner2=27, tuner3=28, - 6 tuner4=29, tuner5=30, xctol=33, xftol=34) -c/ -c -c------------------------------- body -------------------------------- -c - machep = rmdcon(3) - v(afctol) = 1.d-20 - if (machep .gt. 1.d-10) v(afctol) = machep**2 - v(decfac) = 0.5d+0 - sqteps = rmdcon(4) - v(dfac) = 0.6d+0 - v(delta0) = sqteps - v(dtinit) = 1.d-6 - mepcrt = machep ** (one/three) - v(d0init) = 1.d+0 - v(epslon) = 0.1d+0 - v(incfac) = 2.d+0 - v(lmax0) = 1.d+0 - v(lmaxs) = 1.d+0 - v(phmnfc) = -0.1d+0 - v(phmxfc) = 0.1d+0 - v(rdfcmn) = 0.1d+0 - v(rdfcmx) = 4.d+0 - v(rfctol) = dmax1(1.d-10, mepcrt**2) - v(sctol) = v(rfctol) - v(tuner1) = 0.1d+0 - v(tuner2) = 1.d-4 - v(tuner3) = 0.75d+0 - v(tuner4) = 0.5d+0 - v(tuner5) = 0.75d+0 - v(xctol) = sqteps - v(xftol) = 1.d+2 * machep -c - if (alg .ge. 2) go to 10 -c -c *** regression values -c - v(cosmin) = dmax1(1.d-6, 1.d+2 * machep) - v(dinit) = 0.d+0 - v(dltfdc) = mepcrt - v(dltfdj) = sqteps - v(fuzz) = 1.5d+0 - v(huberc) = 0.7d+0 - v(rlimit) = rmdcon(5) - v(rsptol) = 1.d-3 - v(sigmin) = 1.d-4 - go to 999 -c -c *** general optimization values -c - 10 v(bias) = 0.8d+0 - v(dinit) = -1.0d+0 - v(eta0) = 1.0d+3 * machep -c - 999 return -c *** last card of vdflt follows *** - end - subroutine vscopy(p, y, s) -c -c *** set p-vector y to scalar s *** -c - integer p - double precision s, y(p) -c - integer i -c - do 10 i = 1, p - 10 y(i) = s - return - end - double precision function v2norm(p, x) -c -c *** return the 2-norm of the p-vector x, taking *** -c *** care to avoid the most likely underflows. *** -c - integer p - double precision x(p) -c - integer i, j - double precision one, r, scale, sqteta, t, xi, zero -c/+ - double precision dabs, dsqrt -c/ - external rmdcon - double precision rmdcon -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) - save sqteta -c/ - data sqteta/0.d+0/ -c - if (p .gt. 0) go to 10 - v2norm = zero - go to 999 - 10 do 20 i = 1, p - if (x(i) .ne. zero) go to 30 - 20 continue - v2norm = zero - go to 999 -c - 30 scale = dabs(x(i)) - if (i .lt. p) go to 40 - v2norm = scale - go to 999 - 40 t = one - if (sqteta .eq. zero) sqteta = rmdcon(2) -c -c *** sqteta is (slightly larger than) the square root of the -c *** smallest positive floating point number on the machine. -c *** the tests involving sqteta are done to prevent underflows. -c - j = i + 1 - do 60 i = j, p - xi = dabs(x(i)) - if (xi .gt. scale) go to 50 - r = xi / scale - if (r .gt. sqteta) t = t + r*r - go to 60 - 50 r = scale / xi - if (r .le. sqteta) r = zero - t = one + t * r*r - scale = xi - 60 continue -c - v2norm = scale * dsqrt(t) - 999 return -c *** last card of v2norm follows *** - end - subroutine humsl(n, d, x, calcf, calcgh, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** (analytic) gradient and hessian provided by the caller. *** -c - integer liv, lv, n - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(78 + n*(n+12)), uiparm(*), urparm(*) - external calcf, calcgh, ufparm -c -c------------------------------ discussion --------------------------- -c -c this routine is like sumsl, except that the subroutine para- -c meter calcg of sumsl (which computes the gradient of the objec- -c tive function) is replaced by the subroutine parameter calcgh, -c which computes both the gradient and (lower triangle of the) -c hessian of the objective function. the calling sequence is... -c call calcgh(n, x, nf, g, h, uiparm, urparm, ufparm) -c parameters n, x, nf, g, uiparm, urparm, and ufparm are the same -c as for sumsl, while h is an array of length n*(n+1)/2 in which -c calcgh must store the lower triangle of the hessian at x. start- -c ing at h(1), calcgh must store the hessian entries in the order -c (1,1), (2,1), (2,2), (3,1), (3,2), (3,3), ... -c the value printed (by itsum) in the column labelled stppar -c is the levenberg-marquardt used in computing the current step. -c zero means a full newton step. if the special case described in -c ref. 1 is detected, then stppar is negated. the value printed -c in the column labelled npreldf is zero if the current hessian -c is not positive definite. -c it sometimes proves worthwhile to let d be determined from the -c diagonal of the hessian matrix by setting iv(dtype) = 1 and -c v(dinit) = 0. the following iv and v components are relevant... -c -c iv(dtol)..... iv(59) gives the starting subscript in v of the dtol -c array used when d is updated. (iv(dtol) can be -c initialized by calling humsl with iv(1) = 13.) -c iv(dtype).... iv(16) tells how the scale vector d should be chosen. -c iv(dtype) .le. 0 means that d should not be updated, and -c iv(dtype) .ge. 1 means that d should be updated as -c described below with v(dfac). default = 0. -c v(dfac)..... v(41) and the dtol and d0 arrays (see v(dtinit) and -c v(d0init)) are used in updating the scale vector d when -c iv(dtype) .gt. 0. (d is initialized according to -c v(dinit), described in sumsl.) let -c d1(i) = max(sqrt(abs(h(i,i))), v(dfac)*d(i)), -c where h(i,i) is the i-th diagonal element of the current -c hessian. if iv(dtype) = 1, then d(i) is set to d1(i) -c unless d1(i) .lt. dtol(i), in which case d(i) is set to -c max(d0(i), dtol(i)). -c if iv(dtype) .ge. 2, then d is updated during the first -c iteration as for iv(dtype) = 1 (after any initialization -c due to v(dinit)) and is left unchanged thereafter. -c default = 0.6. -c v(dtinit)... v(39), if positive, is the value to which all components -c of the dtol array (see v(dfac)) are initialized. if -c v(dtinit) = 0, then it is assumed that the caller has -c stored dtol in v starting at v(iv(dtol)). -c default = 10**-6. -c v(d0init)... v(40), if positive, is the value to which all components -c of the d0 vector (see v(dfac)) are initialized. if -c v(dfac) = 0, then it is assumed that the caller has -c stored d0 in v starting at v(iv(dtol)+n). default = 1.0. -c -c *** reference *** -c -c 1. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. comput. 2, pp. 186-197. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c---------------------------- declarations --------------------------- -c - external deflt, humit -c -c deflt... provides default input values for iv and v. -c humit... reverse-communication routine that does humsl algorithm. -c - integer g1, h1, iv1, lh, nf - double precision f -c -c *** subscripts for iv *** -c - integer g, h, nextv, nfcall, nfgcal, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, h/56/, toobig/2/, -c 1 vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, h=56, toobig=2, - 1 vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - lh = n * (n + 1) / 2 - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+3)/2 - iv1 = iv(1) - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - h1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) - h1 = iv(h) -c - 20 call humit(d, f, v(g1), v(h1), iv, lh, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcgh(n, x, iv(nfgcal), v(g1), v(h1), uiparm, urparm, - 1 ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(h) = iv(g) + n - iv(nextv) = iv(h) + n*(n+1)/2 - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of humsl follows *** - end - subroutine humit(d, fx, g, h, iv, lh, liv, lv, n, v, x) -c -c *** carry out humsl (unconstrained minimization) iterations, using -c *** hessian matrix provided by the caller. -c -c *** parameter declarations *** -c - integer lh, liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), h(lh), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c h.... lower triangle of the hessian, stored rowwise. -c iv... integer value array. -c lh... length of h = p*(p+1)/2. -c liv.. length of iv (at least 60). -c lv... length of v (at least 78 + n*(n+21)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... parameter vector. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to humsl (which see), except that v can be shorter (since -c the part of v that humsl uses for storing g and h is not needed). -c moreover, compared with humsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from humsl, is not referenced by humit or the -c subroutines it calls. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call humit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c computed (e.g. if overflow would occur), which may happen -c because of an oversized step. in this case the caller -c should set iv(toobig) = iv(2) to 1, which will cause -c humit to ignore fx and try a smaller step. the para- -c meter nf that humsl passes to calcf (for possible use by -c calcgh) is a copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient of f at -c x, and h to the lower triangle of h(x), the hessian of f -c at x, and call humit again, having changed none of the -c other parameters except perhaps the scale vector d. -c the parameter nf that humsl passes to calcg is -c iv(nfgcal) = iv(7). if g(x) and h(x) cannot be evaluated, -c then the caller may set iv(nfgcal) to 0, in which case -c humit will return with iv(1) = 65. -c note -- humit overwrites h with the lower triangle -c of diag(d)**-1 * h(x) * diag(d)**-1. -c. -c *** general *** -c -c coded by david m. gay (winter 1980). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl and humsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, i, j, k, l, lstgst, nn1o2, step1, - 1 temp1, w1, x01 - double precision t -c -c *** constants *** -c - double precision one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, deflt, dotprd, dupdu, gqtst, itsum, parck, - 1 reldst, slvmul, stopx, vaxpy, vcopy, vscopy, v2norm - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c deflt.... provides default iv and v input values. -c dotprd... returns inner product of two vectors. -c dupdu.... updates scale vector d. -c gqtst.... computes optimally locally constrained step. -c itsum.... prints iteration summary and info on initial and final x. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c slvmul... multiplies symmetric matrix times vector, given the lower -c triangle of the matrix. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c v2norm... returns the 2-norm of a vector. -c -c *** subscripts for iv and v *** -c - integer cnvcod, dg, dgnorm, dinit, dstnrm, dtinit, dtol, - 1 dtype, d0init, f, f0, fdif, gtstep, incfac, irc, kagqt, - 2 lmat, lmax0, lmaxs, mode, model, mxfcal, mxiter, nextv, - 3 nfcall, nfgcal, ngcall, niter, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, stppar, - 5 toobig, tuner4, tuner5, vneed, w, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, dtol/59/, dtype/16/, irc/29/, kagqt/33/, -c 1 lmat/42/, mode/35/, model/5/, mxfcal/17/, mxiter/18/, -c 2 nextv/47/, nfcall/6/, nfgcal/7/, ngcall/30/, niter/31/, -c 3 radinc/8/, restor/9/, step/40/, stglim/11/, stlstg/41/, -c 4 toobig/2/, vneed/4/, w/34/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, dtol=59, dtype=16, irc=29, kagqt=33, - 1 lmat=42, mode=35, model=5, mxfcal=17, mxiter=18, - 2 nextv=47, nfcall=6, nfgcal=7, ngcall=30, niter=31, - 3 radinc=8, restor=9, step=40, stglim=11, stlstg=41, - 4 toobig=2, vneed=4, w=34, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data dgnorm/1/, dinit/38/, dstnrm/2/, dtinit/39/, d0init/40/, -c 1 f/10/, f0/13/, fdif/11/, gtstep/4/, incfac/23/, lmax0/35/, -c 2 lmaxs/36/, preduc/7/, radfac/16/, radius/8/, rad0/9/, -c 3 reldx/17/, stppar/5/, tuner4/29/, tuner5/30/ -c/7 - parameter (dgnorm=1, dinit=38, dstnrm=2, dtinit=39, d0init=40, - 1 f=10, f0=13, fdif=11, gtstep=4, incfac=23, lmax0=35, - 2 lmaxs=36, preduc=7, radfac=16, radius=8, rad0=9, - 3 reldx=17, stppar=5, tuner4=29, tuner5=30) -c/ -c -c/6 -c data one/1.d+0/, onep2/1.2d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, onep2=1.2d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - i = iv(1) - if (i .eq. 1) go to 30 - if (i .eq. 2) go to 40 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+21)/2 + 7 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - nn1o2 = n * (n + 1) / 2 - if (lh .ge. nn1o2) go to (210,210,210,210,210,210,160,120,160, - 1 10,10,20), i - iv(1) = 66 - go to 350 -c -c *** storage allocation *** -c - 10 iv(dtol) = iv(lmat) + nn1o2 - iv(x0) = iv(dtol) + 2*n - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(dg) = iv(stlstg) + n - iv(w) = iv(dg) + n - iv(nextv) = iv(w) + 4*n + 7 - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - v(stppar) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - k = iv(dtol) - if (v(dtinit) .gt. zero) call vscopy(n, v(k), v(dtinit)) - k = k + n - if (v(d0init) .gt. zero) call vscopy(n, v(k), v(d0init)) - iv(1) = 1 - go to 999 -c - 30 v(f) = fx - if (iv(mode) .ge. 0) go to 210 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 350 -c -c *** make sure gradient could be computed *** -c - 40 if (iv(nfgcal) .ne. 0) go to 50 - iv(1) = 65 - go to 350 -c -c *** update the scale vector d *** -c - 50 dg1 = iv(dg) - if (iv(dtype) .le. 0) go to 70 - k = dg1 - j = 0 - do 60 i = 1, n - j = j + i - v(k) = h(j) - k = k + 1 - 60 continue - call dupdu(d, v(dg1), iv, liv, lv, n, v) -c -c *** compute scaled gradient and its norm *** -c - 70 dg1 = iv(dg) - k = dg1 - do 80 i = 1, n - v(k) = g(i) / d(i) - k = k + 1 - 80 continue - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** compute scaled hessian *** -c - k = 1 - do 100 i = 1, n - t = one / d(i) - do 90 j = 1, i - h(k) = t * h(k) / d(j) - k = k + 1 - 90 continue - 100 continue -c - if (iv(cnvcod) .ne. 0) go to 340 - if (iv(mode) .eq. 0) go to 300 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 110 call itsum(d, g, iv, liv, lv, n, v, x) - 120 k = iv(niter) - if (k .lt. iv(mxiter)) go to 130 - iv(1) = 10 - go to 350 -c - 130 iv(niter) = k + 1 -c -c *** initialize for start of next iteration *** -c - dg1 = iv(dg) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0 *** -c - call vcopy(n, v(x01), x) -c -c *** update radius *** -c - if (k .eq. 0) go to 150 - step1 = iv(step) - k = step1 - do 140 i = 1, n - v(k) = d(i) * v(k) - k = k + 1 - 140 continue - v(radius) = v(radfac) * v2norm(n, v(step1)) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 150 if (.not. stopx(dummy)) go to 170 - iv(1) = 11 - go to 180 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 160 if (v(f) .ge. v(f0)) go to 170 - v(radfac) = one - k = iv(niter) - go to 130 -c - 170 if (iv(nfcall) .lt. iv(mxfcal)) go to 190 - iv(1) = 9 - 180 if (v(f) .ge. v(f0)) go to 350 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 290 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 190 step1 = iv(step) - dg1 = iv(dg) - l = iv(lmat) - w1 = iv(w) - call gqtst(d, v(dg1), h, iv(kagqt), v(l), n, v(step1), v, v(w1)) - if (iv(irc) .eq. 6) go to 210 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 210 - if (iv(irc) .ne. 5) go to 200 - if (v(radfac) .le. one) go to 200 - if (v(preduc) .le. onep2 * v(fdif)) go to 210 -c -c *** compute f(x0 + step) *** -c - 200 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 210 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 220 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 220 k = iv(irc) - go to (230,260,260,260,230,240,250,250,250,250,250,250,330,300), k -c -c *** recompute step with new radius *** -c - 230 v(radius) = v(radfac) * v(dstnrm) - go to 150 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 240 v(radius) = v(lmaxs) - go to 190 -c -c *** convergence or false convergence *** -c - 250 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 340 - if (iv(xirc) .eq. 14) go to 340 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 260 if (iv(irc) .ne. 3) go to 290 - temp1 = lstgst -c -c *** prepare for gradient tests *** -c *** set temp1 = hessian * step + g(x0) -c *** = diag(d) * (h * step + g(x0)) -c -c use x0 vector as temporary. - k = x01 - do 270 i = 1, n - v(k) = d(i) * v(step1) - k = k + 1 - step1 = step1 + 1 - 270 continue - call slvmul(n, v(temp1), h, v(x01)) - do 280 i = 1, n - v(temp1) = d(i) * v(temp1) + g(i) - temp1 = temp1 + 1 - 280 continue -c -c *** compute gradient and hessian *** -c - 290 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c - 300 iv(1) = 2 - if (iv(irc) .ne. 3) go to 110 -c -c *** set v(radfac) by gradient tests *** -c - temp1 = iv(stlstg) - step1 = iv(step) -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - k = temp1 - do 310 i = 1, n - v(k) = (v(k) - g(i)) / d(i) - k = k + 1 - 310 continue -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) go to 320 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 110 - 320 v(radfac) = v(incfac) - go to 110 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 330 iv(1) = 64 - go to 350 -c -c *** print summary of final iteration and other requested items *** -c - 340 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 350 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last card of humit follows *** - end - subroutine dupdu(d, hdiag, iv, liv, lv, n, v) -c -c *** update scale vector d for humsl *** -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), hdiag(n), v(lv) -c -c *** local variables *** -c - integer dtoli, d0i, i - double precision t, vdfac -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dsqrt -c/ -c *** subscripts for iv and v *** -c - integer dfac, dtol, dtype, niter -c/6 -c data dfac/41/, dtol/59/, dtype/16/, niter/31/ -c/7 - parameter (dfac=41, dtol=59, dtype=16, niter=31) -c/ -c -c------------------------------- body -------------------------------- -c - i = iv(dtype) - if (i .eq. 1) go to 10 - if (iv(niter) .gt. 0) go to 999 -c - 10 dtoli = iv(dtol) - d0i = dtoli + n - vdfac = v(dfac) - do 20 i = 1, n - t = dmax1(dsqrt(dabs(hdiag(i))), vdfac*d(i)) - if (t .lt. v(dtoli)) t = dmax1(v(dtoli), v(d0i)) - d(i) = t - dtoli = dtoli + 1 - d0i = d0i + 1 - 20 continue -c - 999 return -c *** last card of dupdu follows *** - end - subroutine gqtst(d, dig, dihdi, ka, l, p, step, v, w) -c -c *** compute goldfeld-quandt-trotter step by more-hebden technique *** -c *** (nl2sol version 2.2), modified a la more and sorensen *** -c -c *** parameter declarations *** -c - integer ka, p -cal double precision d(p), dig(p), dihdi(1), l(1), v(21), step(p), -cal 1 w(1) - double precision d(p), dig(p), dihdi(p*(p+1)/2), l(p*(p+1)/2), - 1 v(21), step(p),w(4*p+7) -c dimension dihdi(p*(p+1)/2), l(p*(p+1)/2), w(4*p+7) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c given the (compactly stored) lower triangle of a scaled -c hessian (approximation) and a nonzero scaled gradient vector, -c this subroutine computes a goldfeld-quandt-trotter step of -c approximate length v(radius) by the more-hebden technique. in -c other words, step is computed to (approximately) minimize -c psi(step) = (g**t)*step + 0.5*(step**t)*h*step such that the -c 2-norm of d*step is at most (approximately) v(radius), where -c g is the gradient, h is the hessian, and d is a diagonal -c scale matrix whose diagonal is stored in the parameter d. -c (gqtst assumes dig = d**-1 * g and dihdi = d**-1 * h * d**-1.) -c -c *** parameter description *** -c -c d (in) = the scale vector, i.e. the diagonal of the scale -c matrix d mentioned above under purpose. -c dig (in) = the scaled gradient vector, d**-1 * g. if g = 0, then -c step = 0 and v(stppar) = 0 are returned. -c dihdi (in) = lower triangle of the scaled hessian (approximation), -c i.e., d**-1 * h * d**-1, stored compactly by rows., i.e., -c in the order (1,1), (2,1), (2,2), (3,1), (3,2), etc. -c ka (i/o) = the number of hebden iterations (so far) taken to deter- -c mine step. ka .lt. 0 on input means this is the first -c attempt to determine step (for the present dig and dihdi) -c -- ka is initialized to 0 in this case. output with -c ka = 0 (or v(stppar) = 0) means step = -(h**-1)*g. -c l (i/o) = workspace of length p*(p+1)/2 for cholesky factors. -c p (in) = number of parameters -- the hessian is a p x p matrix. -c step (i/o) = the step computed. -c v (i/o) contains various constants and variables described below. -c w (i/o) = workspace of length 4*p + 6. -c -c *** entries in v *** -c -c v(dgnorm) (i/o) = 2-norm of (d**-1)*g. -c v(dstnrm) (output) = 2-norm of d*step. -c v(dst0) (i/o) = 2-norm of d*(h**-1)*g (for pos. def. h only), or -c overestimate of smallest eigenvalue of (d**-1)*h*(d**-1). -c v(epslon) (in) = max. rel. error allowed for psi(step). for the -c step returned, psi(step) will exceed its optimal value -c by less than -v(epslon)*psi(step). suggested value = 0.1. -c v(gtstep) (out) = inner product between g and step. -c v(nreduc) (out) = psi(-(h**-1)*g) = psi(newton step) (for pos. def. -c h only -- v(nreduc) is set to zero otherwise). -c v(phmnfc) (in) = tol. (together with v(phmxfc)) for accepting step -c (more*s sigma). the error v(dstnrm) - v(radius) must lie -c between v(phmnfc)*v(radius) and v(phmxfc)*v(radius). -c v(phmxfc) (in) (see v(phmnfc).) -c suggested values -- v(phmnfc) = -0.25, v(phmxfc) = 0.5. -c v(preduc) (out) = psi(step) = predicted obj. func. reduction for step. -c v(radius) (in) = radius of current (scaled) trust region. -c v(rad0) (i/o) = value of v(radius) from previous call. -c v(stppar) (i/o) is normally the marquardt parameter, i.e. the alpha -c described below under algorithm notes. if h + alpha*d**2 -c (see algorithm notes) is (nearly) singular, however, -c then v(stppar) = -alpha. -c -c *** usage notes *** -c -c if it is desired to recompute step using a different value of -c v(radius), then this routine may be restarted by calling it -c with all parameters unchanged except v(radius). (this explains -c why step and w are listed as i/o). on an initial call (one with -c ka .lt. 0), step and w need not be initialized and only compo- -c nents v(epslon), v(stppar), v(phmnfc), v(phmxfc), v(radius), and -c v(rad0) of v must be initialized. -c -c *** algorithm notes *** -c -c the desired g-q-t step (ref. 2, 3, 4, 6) satisfies -c (h + alpha*d**2)*step = -g for some nonnegative alpha such that -c h + alpha*d**2 is positive semidefinite. alpha and step are -c computed by a scheme analogous to the one described in ref. 5. -c estimates of the smallest and largest eigenvalues of the hessian -c are obtained from the gerschgorin circle theorem enhanced by a -c simple form of the scaling described in ref. 7. cases in which -c h + alpha*d**2 is nearly (or exactly) singular are handled by -c the technique discussed in ref. 2. in these cases, a step of -c (exact) length v(radius) is returned for which psi(step) exceeds -c its optimal value by less than -v(epslon)*psi(step). the test -c suggested in ref. 6 for detecting the special case is performed -c once two matrix factorizations have been done -- doing so sooner -c seems to degrade the performance of optimization routines that -c call this routine. -c -c *** functions and subroutines called *** -c -c dotprd - returns inner product of two vectors. -c litvmu - applies inverse-transpose of compact lower triang. matrix. -c livmul - applies inverse of compact lower triang. matrix. -c lsqrt - finds cholesky factor (of compactly stored lower triang.). -c lsvmin - returns approx. to min. sing. value of lower triang. matrix. -c rmdcon - returns machine-dependent constants. -c v2norm - returns 2-norm of a vector. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), an adaptive -c nonlinear least-squares algorithm, acm trans. math. -c software, vol. 7, no. 3. -c 2. gay, d.m. (1981), computing optimal locally constrained steps, -c siam j. sci. statist. computing, vol. 2, no. 2, pp. -c 186-197. -c 3. goldfeld, s.m., quandt, r.e., and trotter, h.f. (1966), -c maximization by quadratic hill-climbing, econometrica 34, -c pp. 541-551. -c 4. hebden, m.d. (1973), an algorithm for minimization using exact -c second derivatives, report t.p. 515, theoretical physics -c div., a.e.r.e. harwell, oxon., england. -c 5. more, j.j. (1978), the levenberg-marquardt algorithm, implemen- -c tation and theory, pp.105-116 of springer lecture notes -c in mathematics no. 630, edited by g.a. watson, springer- -c verlag, berlin and new york. -c 6. more, j.j., and sorensen, d.c. (1981), computing a trust region -c step, technical report anl-81-83, argonne national lab. -c 7. varga, r.s. (1965), minimal gerschgorin sets, pacific j. math. 15, -c pp. 719-729. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, and -c mcs-7906671. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - logical restrt - integer dggdmx, diag, diag0, dstsav, emax, emin, i, im1, inc, irc, - 1 j, k, kalim, kamin, k1, lk0, phipin, q, q0, uk0, x - double precision alphak, aki, akk, delta, dst, eps, gtsta, lk, - 1 oldphi, phi, phimax, phimin, psifac, rad, radsq, - 2 root, si, sk, sw, t, twopsi, t1, t2, uk, wi -c -c *** constants *** - double precision big, dgxfac, epsfac, four, half, kappa, negone, - 1 one, p001, six, three, two, zero -c -c *** intrinsic functions *** -c/+ - double precision dabs, dmax1, dmin1, dsqrt -c/ -c *** external functions and subroutines *** -c - external dotprd, litvmu, livmul, lsqrt, lsvmin, rmdcon, v2norm - double precision dotprd, lsvmin, rmdcon, v2norm -c -c *** subscripts for v *** -c - integer dgnorm, dstnrm, dst0, epslon, gtstep, stppar, nreduc, - 1 phmnfc, phmxfc, preduc, radius, rad0 -c/6 -c data dgnorm/1/, dstnrm/2/, dst0/3/, epslon/19/, gtstep/4/, -c 1 nreduc/6/, phmnfc/20/, phmxfc/21/, preduc/7/, radius/8/, -c 2 rad0/9/, stppar/5/ -c/7 - parameter (dgnorm=1, dstnrm=2, dst0=3, epslon=19, gtstep=4, - 1 nreduc=6, phmnfc=20, phmxfc=21, preduc=7, radius=8, - 2 rad0=9, stppar=5) -c/ -c -c/6 -c data epsfac/50.0d+0/, four/4.0d+0/, half/0.5d+0/, -c 1 kappa/2.0d+0/, negone/-1.0d+0/, one/1.0d+0/, p001/1.0d-3/, -c 2 six/6.0d+0/, three/3.0d+0/, two/2.0d+0/, zero/0.0d+0/ -c/7 - parameter (epsfac=50.0d+0, four=4.0d+0, half=0.5d+0, - 1 kappa=2.0d+0, negone=-1.0d+0, one=1.0d+0, p001=1.0d-3, - 2 six=6.0d+0, three=3.0d+0, two=2.0d+0, zero=0.0d+0) - save dgxfac -c/ - data big/0.d+0/, dgxfac/0.d+0/ -c -c *** body *** -c -c *** store largest abs. entry in (d**-1)*h*(d**-1) at w(dggdmx). - dggdmx = p + 1 -c *** store gerschgorin over- and underestimates of the largest -c *** and smallest eigenvalues of (d**-1)*h*(d**-1) at w(emax) -c *** and w(emin) respectively. - emax = dggdmx + 1 - emin = emax + 1 -c *** for use in recomputing step, the final values of lk, uk, dst, -c *** and the inverse derivative of more*s phi at 0 (for pos. def. -c *** h) are stored in w(lk0), w(uk0), w(dstsav), and w(phipin) -c *** respectively. - lk0 = emin + 1 - phipin = lk0 + 1 - uk0 = phipin + 1 - dstsav = uk0 + 1 -c *** store diag of (d**-1)*h*(d**-1) in w(diag),...,w(diag0+p). - diag0 = dstsav - diag = diag0 + 1 -c *** store -d*step in w(q),...,w(q0+p). - q0 = diag0 + p - q = q0 + 1 -c *** allocate storage for scratch vector x *** - x = q + p - rad = v(radius) - radsq = rad**2 -c *** phitol = max. error allowed in dst = v(dstnrm) = 2-norm of -c *** d*step. - phimax = v(phmxfc) * rad - phimin = v(phmnfc) * rad - psifac = two * v(epslon) / (three * (four * (v(phmnfc) + one) * - 1 (kappa + one) + kappa + two) * rad**2) -c *** oldphi is used to detect limits of numerical accuracy. if -c *** we recompute step and it does not change, then we accept it. - oldphi = zero - eps = v(epslon) - irc = 0 - restrt = .false. - kalim = ka + 50 -c -c *** start or restart, depending on ka *** -c - if (ka .ge. 0) go to 290 -c -c *** fresh start *** -c - k = 0 - uk = negone - ka = 0 - kalim = 50 - v(dgnorm) = v2norm(p, dig) - v(nreduc) = zero - v(dst0) = zero - kamin = 3 - if (v(dgnorm) .eq. zero) kamin = 0 -c -c *** store diag(dihdi) in w(diag0+1),...,w(diag0+p) *** -c - j = 0 - do 10 i = 1, p - j = j + i - k1 = diag0 + i - w(k1) = dihdi(j) - 10 continue -c -c *** determine w(dggdmx), the largest element of dihdi *** -c - t1 = zero - j = p * (p + 1) / 2 - do 20 i = 1, j - t = dabs(dihdi(i)) - if (t1 .lt. t) t1 = t - 20 continue - w(dggdmx) = t1 -c -c *** try alpha = 0 *** -c - 30 call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 50 -c *** indef. h -- underestimate smallest eigenvalue, use this -c *** estimate to initialize lower bound lk on alpha. - j = irc*(irc+1)/2 - t = l(j) - l(j) = one - do 40 i = 1, irc - 40 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = -t / t1 / t1 - v(dst0) = -lk - if (restrt) go to 210 - go to 70 -c -c *** positive definite h -- compute unmodified newton step. *** - 50 lk = zero - t = lsvmin(p, l, w(q), w(q)) - if (t .ge. one) go to 60 - if (big .le. zero) big = rmdcon(6) - if (v(dgnorm) .ge. t*t*big) go to 70 - 60 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - v(nreduc) = half * gtsta - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - v(dst0) = dst - phi = dst - rad - if (phi .le. phimax) go to 260 - if (restrt) go to 210 -c -c *** prepare to compute gerschgorin estimates of largest (and -c *** smallest) eigenvalues. *** -c - 70 k = 0 - do 100 i = 1, p - wi = zero - if (i .eq. 1) go to 90 - im1 = i - 1 - do 80 j = 1, im1 - k = k + 1 - t = dabs(dihdi(k)) - wi = wi + t - w(j) = w(j) + t - 80 continue - 90 w(i) = wi - k = k + 1 - 100 continue -c -c *** (under-)estimate smallest eigenvalue of (d**-1)*h*(d**-1) *** -c - k = 1 - t1 = w(diag) - w(1) - if (p .le. 1) go to 120 - do 110 i = 2, p - j = diag0 + i - t = w(j) - w(i) - if (t .ge. t1) go to 110 - t1 = t - k = i - 110 continue -c - 120 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 150 i = 1, p - if (i .eq. k) go to 130 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (akk - w(j) + si - aki) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 140 - 130 inc = i - 140 k1 = k1 + inc - 150 continue -c - w(emin) = akk - t - uk = v(dgnorm)/rad - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 -c -c *** compute gerschgorin (over-)estimate of largest eigenvalue *** -c - k = 1 - t1 = w(diag) + w(1) - if (p .le. 1) go to 170 - do 160 i = 2, p - j = diag0 + i - t = w(j) + w(i) - if (t .le. t1) go to 160 - t1 = t - k = i - 160 continue -c - 170 sk = w(k) - j = diag0 + k - akk = w(j) - k1 = k*(k-1)/2 + 1 - inc = 1 - t = zero - do 200 i = 1, p - if (i .eq. k) go to 180 - aki = dabs(dihdi(k1)) - si = w(i) - j = diag0 + i - t1 = half * (w(j) + si - aki - akk) - t1 = t1 + dsqrt(t1*t1 + sk*aki) - if (t .lt. t1) t = t1 - if (i .lt. k) go to 190 - 180 inc = i - 190 k1 = k1 + inc - 200 continue -c - w(emax) = akk + t - lk = dmax1(lk, v(dgnorm)/rad - w(emax)) -c -c *** alphak = current value of alpha (see alg. notes above). we -c *** use more*s scheme for initializing it. - alphak = dabs(v(stppar)) * v(rad0)/rad -c - if (irc .ne. 0) go to 210 -c -c *** compute l0 for positive definite h *** -c - call livmul(p, w, l, w(q)) - t = v2norm(p, w) - w(phipin) = dst / t / t - lk = dmax1(lk, phi*w(phipin)) -c -c *** safeguard alphak and add alphak*i to (d**-1)*h*(d**-1) *** -c - 210 ka = ka + 1 - if (-v(dst0) .ge. alphak .or. alphak .lt. lk .or. alphak .ge. uk) - 1 alphak = uk * dmax1(p001, dsqrt(lk/uk)) - if (alphak .le. zero) alphak = half * uk - if (alphak .le. zero) alphak = uk - k = 0 - do 220 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) + alphak - 220 continue -c -c *** try computing cholesky decomposition *** -c - call lsqrt(1, p, l, dihdi, irc) - if (irc .eq. 0) go to 240 -c -c *** (d**-1)*h*(d**-1) + alphak*i is indefinite -- overestimate -c *** smallest eigenvalue for use in updating lk *** -c - j = (irc*(irc+1))/2 - t = l(j) - l(j) = one - do 230 i = 1, irc - 230 w(i) = zero - w(irc) = one - call litvmu(irc, w, l, w) - t1 = v2norm(irc, w) - lk = alphak - t/t1/t1 - v(dst0) = -lk - go to 210 -c -c *** alphak makes (d**-1)*h*(d**-1) positive definite. -c *** compute q = -d*step, check for convergence. *** -c - 240 call livmul(p, w(q), l, dig) - gtsta = dotprd(p, w(q), w(q)) - call litvmu(p, w(q), l, w(q)) - dst = v2norm(p, w(q)) - phi = dst - rad - if (phi .le. phimax .and. phi .ge. phimin) go to 270 - if (phi .eq. oldphi) go to 270 - oldphi = phi - if (phi .lt. zero) go to 330 -c -c *** unacceptable alphak -- update lk, uk, alphak *** -c - 250 if (ka .ge. kalim) go to 270 -c *** the following dmin1 is necessary because of restarts *** - if (phi .lt. zero) uk = dmin1(uk, alphak) -c *** kamin = 0 only iff the gradient vanishes *** - if (kamin .eq. 0) go to 210 - call livmul(p, w, l, w(q)) - t1 = v2norm(p, w) - alphak = alphak + (phi/t1) * (dst/t1) * (dst/rad) - lk = dmax1(lk, alphak) - go to 210 -c -c *** acceptable step on first try *** -c - 260 alphak = zero -c -c *** successful step in general. compute step = -(d**-1)*q *** -c - 270 do 280 i = 1, p - j = q0 + i - step(i) = -w(j)/d(i) - 280 continue - v(gtstep) = -gtsta - v(preduc) = half * (dabs(alphak)*dst*dst + gtsta) - go to 410 -c -c -c *** restart with new radius *** -c - 290 if (v(dst0) .le. zero .or. v(dst0) - rad .gt. phimax) go to 310 -c -c *** prepare to return newton step *** -c - restrt = .true. - ka = ka + 1 - k = 0 - do 300 i = 1, p - k = k + i - j = diag0 + i - dihdi(k) = w(j) - 300 continue - uk = negone - go to 30 -c - 310 kamin = ka + 3 - if (v(dgnorm) .eq. zero) kamin = 0 - if (ka .eq. 0) go to 50 -c - dst = w(dstsav) - alphak = dabs(v(stppar)) - phi = dst - rad - t = v(dgnorm)/rad - uk = t - w(emin) - if (v(dgnorm) .eq. zero) uk = uk + p001 + p001*uk - if (uk .le. zero) uk = p001 - if (rad .gt. v(rad0)) go to 320 -c -c *** smaller radius *** - lk = zero - if (alphak .gt. zero) lk = w(lk0) - lk = dmax1(lk, t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** bigger radius *** - 320 if (alphak .gt. zero) uk = dmin1(uk, w(uk0)) - lk = dmax1(zero, -v(dst0), t - w(emax)) - if (v(dst0) .gt. zero) lk = dmax1(lk, (v(dst0)-rad)*w(phipin)) - go to 250 -c -c *** decide whether to check for special case... in practice (from -c *** the standpoint of the calling optimization code) it seems best -c *** not to check until a few iterations have failed -- hence the -c *** test on kamin below. -c - 330 delta = alphak + dmin1(zero, v(dst0)) - twopsi = alphak*dst*dst + gtsta - if (ka .ge. kamin) go to 340 -c *** if the test in ref. 2 is satisfied, fall through to handle -c *** the special case (as soon as the more-sorensen test detects -c *** it). - if (delta .ge. psifac*twopsi) go to 370 -c -c *** check for the special case of h + alpha*d**2 (nearly) -c *** singular. use one step of inverse power method with start -c *** from lsvmin to obtain approximate eigenvector corresponding -c *** to smallest eigenvalue of (d**-1)*h*(d**-1). lsvmin returns -c *** x and w with l*w = x. -c - 340 t = lsvmin(p, l, w(x), w) -c -c *** normalize w *** - do 350 i = 1, p - 350 w(i) = t*w(i) -c *** complete current inv. power iter. -- replace w by (l**-t)*w. - call litvmu(p, w, l, w) - t2 = one/v2norm(p, w) - do 360 i = 1, p - 360 w(i) = t2*w(i) - t = t2 * t -c -c *** now w is the desired approximate (unit) eigenvector and -c *** t*x = ((d**-1)*h*(d**-1) + alphak*i)*w. -c - sw = dotprd(p, w(q), w) - t1 = (rad + dst) * (rad - dst) - root = dsqrt(sw*sw + t1) - if (sw .lt. zero) root = -root - si = t1 / (sw + root) -c -c *** the actual test for the special case... -c - if ((t2*si)**2 .le. eps*(dst**2 + alphak*radsq)) go to 380 -c -c *** update upper bound on smallest eigenvalue (when not positive) -c *** (as recommended by more and sorensen) and continue... -c - if (v(dst0) .le. zero) v(dst0) = dmin1(v(dst0), t2**2 - alphak) - lk = dmax1(lk, -v(dst0)) -c -c *** check whether we can hope to detect the special case in -c *** the available arithmetic. accept step as it is if not. -c -c *** if not yet available, obtain machine dependent value dgxfac. - 370 if (dgxfac .eq. zero) dgxfac = epsfac * rmdcon(3) -c - if (delta .gt. dgxfac*w(dggdmx)) go to 250 - go to 270 -c -c *** special case detected... negate alphak to indicate special case -c - 380 alphak = -alphak - v(preduc) = half * twopsi -c -c *** accept current step if adding si*w would lead to a -c *** further relative reduction in psi of less than v(epslon)/3. -c - t1 = zero - t = si*(alphak*sw - half*si*(alphak + t*dotprd(p,w(x),w))) - if (t .lt. eps*twopsi/six) go to 390 - v(preduc) = v(preduc) + t - dst = rad - t1 = -si - 390 do 400 i = 1, p - j = q0 + i - w(j) = t1*w(i) - w(j) - step(i) = w(j) / d(i) - 400 continue - v(gtstep) = dotprd(p, dig, w(q)) -c -c *** save values for use in a possible restart *** -c - 410 v(dstnrm) = dst - v(stppar) = alphak - w(lk0) = lk - w(uk0) = uk - v(rad0) = rad - w(dstsav) = dst -c -c *** restore diagonal of dihdi *** -c - j = 0 - do 420 i = 1, p - j = j + i - k = diag0 + i - dihdi(j) = w(k) - 420 continue -c - 999 return -c -c *** last card of gqtst follows *** - end - subroutine lsqrt(n1, n, l, a, irc) -c -c *** compute rows n1 through n of the cholesky factor l of -c *** a = l*(l**t), where l and the lower triangle of a are both -c *** stored compactly by rows (and may occupy the same storage). -c *** irc = 0 means all went well. irc = j means the leading -c *** principal j x j submatrix of a is not positive definite -- -c *** and l(j*(j+1)/2) contains the (nonpos.) reduced j-th diagonal. -c -c *** parameters *** -c - integer n1, n, irc -cal double precision l(1), a(1) - double precision l(n*(n+1)/2), a(n*(n+1)/2) -c dimension l(n*(n+1)/2), a(n*(n+1)/2) -c -c *** local variables *** -c - integer i, ij, ik, im1, i0, j, jk, jm1, j0, k - double precision t, td, zero -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c -c *** body *** -c - i0 = n1 * (n1 - 1) / 2 - do 50 i = n1, n - td = zero - if (i .eq. 1) go to 40 - j0 = 0 - im1 = i - 1 - do 30 j = 1, im1 - t = zero - if (j .eq. 1) go to 20 - jm1 = j - 1 - do 10 k = 1, jm1 - ik = i0 + k - jk = j0 + k - t = t + l(ik)*l(jk) - 10 continue - 20 ij = i0 + j - j0 = j0 + j - t = (a(ij) - t) / l(j0) - l(ij) = t - td = td + t*t - 30 continue - 40 i0 = i0 + i - t = a(i0) - td - if (t .le. zero) go to 60 - l(i0) = dsqrt(t) - 50 continue -c - irc = 0 - go to 999 -c - 60 l(i0) = t - irc = i -c - 999 return -c -c *** last card of lsqrt *** - end - double precision function lsvmin(p, l, x, y) -c -c *** estimate smallest sing. value of packed lower triang. matrix l -c -c *** parameter declarations *** -c - integer p -cal double precision l(1), x(p), y(p) - double precision l(p*(p+1)/2), x(p), y(p) -c dimension l(p*(p+1)/2) -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** purpose *** -c -c this function returns a good over-estimate of the smallest -c singular value of the packed lower triangular matrix l. -c -c *** parameter description *** -c -c p (in) = the order of l. l is a p x p lower triangular matrix. -c l (in) = array holding the elements of l in row order, i.e. -c l(1,1), l(2,1), l(2,2), l(3,1), l(3,2), l(3,3), etc. -c x (out) if lsvmin returns a positive value, then x is a normalized -c approximate left singular vector corresponding to the -c smallest singular value. this approximation may be very -c crude. if lsvmin returns zero, then some components of x -c are zero and the rest retain their input values. -c y (out) if lsvmin returns a positive value, then y = (l**-1)*x is an -c unnormalized approximate right singular vector correspond- -c ing to the smallest singular value. this approximation -c may be crude. if lsvmin returns zero, then y retains its -c input value. the caller may pass the same vector for x -c and y (nonstandard fortran usage), in which case y over- -c writes x (for nonzero lsvmin returns). -c -c *** algorithm notes *** -c -c the algorithm is based on (1), with the additional provision that -c lsvmin = 0 is returned if the smallest diagonal element of l -c (in magnitude) is not more than the unit roundoff times the -c largest. the algorithm uses a random number generator proposed -c in (4), which passes the spectral test with flying colors -- see -c (2) and (3). -c -c *** subroutines and functions called *** -c -c v2norm - function, returns the 2-norm of a vector. -c -c *** references *** -c -c (1) cline, a., moler, c., stewart, g., and wilkinson, j.h.(1977), -c an estimate for the condition number of a matrix, report -c tm-310, applied math. div., argonne national laboratory. -c -c (2) hoaglin, d.c. (1976), theoretical properties of congruential -c random-number generators -- an empirical view, -c memorandum ns-340, dept. of statistics, harvard univ. -c -c (3) knuth, d.e. (1969), the art of computer programming, vol. 2 -c (seminumerical algorithms), addison-wesley, reading, mass. -c -c (4) smith, c.s. (1971), multiplicative pseudo-random number -c generators with prime modulus, j. assoc. comput. mach. 18, -c pp. 586-593. -c -c *** history *** -c -c designed and coded by david m. gay (winter 1977/summer 1978). -c -c *** general *** -c -c this subroutine was written in connection with research -c supported by the national science foundation under grants -c mcs-7600324, dcr75-10143, 76-14311dss, and mcs76-11989. -c -c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer i, ii, ix, j, ji, jj, jjj, jm1, j0, pm1 - double precision b, sminus, splus, t, xminus, xplus -c -c *** constants *** -c - double precision half, one, r9973, zero -c -c *** intrinsic functions *** -c/+ - integer mod - real float - double precision dabs -c/ -c *** external functions and subroutines *** -c - external dotprd, v2norm, vaxpy - double precision dotprd, v2norm -c -c/6 -c data half/0.5d+0/, one/1.d+0/, r9973/9973.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, r9973=9973.d+0, zero=0.d+0) -c/ -c -c *** body *** -c - ix = 2 - pm1 = p - 1 -c -c *** first check whether to return lsvmin = 0 and initialize x *** -c - ii = 0 - j0 = p*pm1/2 - jj = j0 + p - if (l(jj) .eq. zero) go to 110 - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = b / l(jj) - x(p) = xplus - if (p .le. 1) go to 60 - do 10 i = 1, pm1 - ii = ii + i - if (l(ii) .eq. zero) go to 110 - ji = j0 + i - x(i) = xplus * l(ji) - 10 continue -c -c *** solve (l**t)*x = b, where the components of b have randomly -c *** chosen magnitudes in (.5,1) with signs chosen to make x large. -c -c do j = p-1 to 1 by -1... - do 50 jjj = 1, pm1 - j = p - jjj -c *** determine x(j) in this iteration. note for i = 1,2,...,j -c *** that x(i) holds the current partial sum for row i. - ix = mod(3432*ix, 9973) - b = half*(one + float(ix)/r9973) - xplus = (b - x(j)) - xminus = (-b - x(j)) - splus = dabs(xplus) - sminus = dabs(xminus) - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - xplus = xplus/l(jj) - xminus = xminus/l(jj) - if (jm1 .eq. 0) go to 30 - do 20 i = 1, jm1 - ji = j0 + i - splus = splus + dabs(x(i) + l(ji)*xplus) - sminus = sminus + dabs(x(i) + l(ji)*xminus) - 20 continue - 30 if (sminus .gt. splus) xplus = xminus - x(j) = xplus -c *** update partial sums *** - if (jm1 .gt. 0) call vaxpy(jm1, x, xplus, l(j0+1), x) - 50 continue -c -c *** normalize x *** -c - 60 t = one/v2norm(p, x) - do 70 i = 1, p - 70 x(i) = t*x(i) -c -c *** solve l*y = x and return lsvmin = 1/twonorm(y) *** -c - do 100 j = 1, p - jm1 = j - 1 - j0 = j*jm1/2 - jj = j0 + j - t = zero - if (jm1 .gt. 0) t = dotprd(jm1, l(j0+1), y) - y(j) = (x(j) - t) / l(jj) - 100 continue -c - lsvmin = one/v2norm(p, y) - go to 999 -c - 110 lsvmin = zero - 999 return -c *** last card of lsvmin follows *** - end - subroutine slvmul(p, y, s, x) -c -c *** set y = s * x, s = p x p symmetric matrix. *** -c *** lower triangle of s stored rowwise. *** -c -c *** parameter declarations *** -c - integer p -cal double precision s(1), x(p), y(p) - double precision s(p*(p+1)/2), x(p), y(p) -c dimension s(p*(p+1)/2) -c -c *** local variables *** -c - integer i, im1, j, k - double precision xi -c -c *** no intrinsic functions *** -c -c *** external function *** -c - external dotprd - double precision dotprd -c -c----------------------------------------------------------------------- -c - j = 1 - do 10 i = 1, p - y(i) = dotprd(i, s(j), x) - j = j + i - 10 continue -c - if (p .le. 1) go to 999 - j = 1 - do 40 i = 2, p - xi = x(i) - im1 = i - 1 - j = j + 1 - do 30 k = 1, im1 - y(k) = y(k) + s(j)*xi - j = j + 1 - 30 continue - 40 continue -c - 999 return -c *** last card of slvmul follows *** - end diff --git a/source/unres/src_MD-restraints/dihed_cons.F b/source/unres/src_MD-restraints/dihed_cons.F deleted file mode 100644 index e45405f..0000000 --- a/source/unres/src_MD-restraints/dihed_cons.F +++ /dev/null @@ -1,185 +0,0 @@ - subroutine secstrp2dihc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' - include 'COMMON.CHAIN' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - character*80 line - logical errflag - external ilen - -cdr call getenv_loc('SECPREDFIL',secpred) - lenpre=ilen(prefix) - secpred=prefix(:lenpre)//'.spred' - -#if defined(WINIFL) || defined(WINPGI) - open(isecpred,file=secpred,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(isecpred,file=secpred,status='old',action='read') -#elif (defined G77) - open(isecpred,file=secpred,status='old') -#else - open(isecpred,file=secpred,status='old',action='read') -#endif -C read secondary structure prediction from JPRED here! -! read(isecpred,'(A80)',err=100,end=100) line -! read(line,'(f10.3)',err=110) ftors - read(isecpred,'(f10.3)',err=110) ftors - - write (iout,*) 'FTORS factor =',ftors -! initialize secstruc to any - do i=1,nres - secstruc(i) ='-' - enddo - ndih_constr=0 - ndih_nconstr=0 - - call read_secstr_pred(isecpred,iout,errflag) - if (errflag) then - write(iout,*)'There is a problem with the list of secondary-', - & 'structure prediction' - goto 100 - endif -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - - ii=0 - do i=1,nres - if ( secstruc(i) .eq. 'H') then -C Helix restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 45.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else if (secstruc(i) .eq. 'E') then -C strand restraints for this residue - ii=ii+1 - idih_constr(ii)=i - phi0(ii) = 180.0D0*deg2rad - drange(ii)= 5.0D0*deg2rad - phibound(1,i) = phi0(ii)-drange(ii) - phibound(2,i) = phi0(ii)+drange(ii) - else -C no restraints for this residue - ndih_nconstr=ndih_nconstr+1 - idih_nconstr(ndih_nconstr)=i - endif - enddo - ndih_constr=ii - return -100 continue - write(iout,'(A30,A80)')'Error reading file SECPRED',secpred - return - 110 continue - write(iout,'(A20)')'Error reading FTORS' - return - end - - subroutine read_secstr_pred(jin,jout,errors) - - implicit real*8 (a-h,o-z) - INCLUDE 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - character*1 secstruc(maxres) - COMMON/SECONDARYS/secstruc - EXTERNAL ILEN - character*80 line,line1,ucase - logical errflag,errors,blankline - - errors=.false. - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) -C Remember that we number full residues starting from 2, then, iseq=1 and iseq=nres -C correspond to the end-groups. ADD to the secondary structure prediction "-" for the -C end-groups in the input file "*.spred" - - iseq=1 - do while (index(line1,'$END').eq.0) -* Override commented lines. - ipos=1 - blankline=.false. - do while (.not.blankline) - line1=' ' - call mykey(line,line1,ipos,blankline,errflag) - if (errflag) write (jout,'(2a)') - & 'Error when reading sequence in line: ',line - errors=errors .or. errflag - if (.not. blankline .and. .not. errflag) then - ipos1=2 - iend=ilen(line1) - if (iseq.le.maxres) then - if (line1(1:1).eq.'-' ) then - secstruc(iseq)=line1(1:1) - else if ( ( ucase(line1(1:1)).eq.'E' ) .or. - & ( ucase(line1(1:1)).eq.'H' ) ) then - secstruc(iseq)=ucase(line1(1:1)) - else - errors=.true. - write (jout,1010) line1(1:1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - do while (ipos1.le.iend) - - iseq=iseq+1 - il=1 - ipos1=ipos1+1 - if (iseq.le.maxres) then - if (line1(ipos1-1:ipos1-1).eq.'-' ) then - secstruc(iseq)=line1(ipos1-1:ipos1-1) - else if((ucase(line1(ipos1-1:ipos1-1)).eq.'E').or. - & (ucase(line1(ipos1-1:ipos1-1)).eq.'H') ) then - secstruc(iseq)=ucase(line1(ipos1-1:ipos1-1)) - else - errors=.true. - write (jout,1010) line1(ipos1-1:ipos1-1), iseq - goto 80 - endif - else - errors=.true. - write (jout,1000) iseq,maxres - goto 80 - endif - enddo - iseq=iseq+1 - endif - enddo - read (jin,'(a)') line - write (jout,'(2a)') '> ',line(1:78) - line1=ucase(line) - enddo - -cd write (jout,'(10a8)') (sequence(i),i=1,iseq-1) - -cd check whether the found length of the chain is correct. - length_of_chain=iseq-1 - if (length_of_chain .ne. nres) then -! errors=.true. - write (jout,'(a,i4,a,i4,a)') - & 'Error: the number of labels specified in $SEC_STRUC_PRED (' - & ,length_of_chain,') does not match with the number of residues (' - & ,nres,').' - endif - 80 continue - - 1000 format('Error - the number of residues (',i4, - & ') has exceeded maximum (',i4,').') - 1010 format ('Error - unrecognized secondary structure label',a4, - & ' in position',i4) - return - end diff --git a/source/unres/src_MD-restraints/djacob.f b/source/unres/src_MD-restraints/djacob.f deleted file mode 100644 index e3f46bc..0000000 --- a/source/unres/src_MD-restraints/djacob.f +++ /dev/null @@ -1,107 +0,0 @@ - SUBROUTINE DJACOB(N,NMAX,MAXJAC,E,A,C,AII) - IMPLICIT REAL*8 (A-H,O-Z) -C THE JACOBI DIAGONALIZATION PROCEDURE - COMMON INP,IOUT,IPN - DIMENSION A(NMAX,N),C(NMAX,N),AII(150),AJJ(150) - SIN45 = .70710678 - COS45 = .70710678 - S45SQ = 0.50 - C45SQ = 0.50 -C UNIT EIGENVECTOR MATRIX - DO 70 I = 1,N - DO 7 J = I,N - A(J,I)=A(I,J) - C(I,J) = 0.0 - 7 C(J,I) = 0.0 - 70 C(I,I) = 1.0 -C DETERMINATION OF SEARCH ARGUMENT, TEST - AMAX = 0.0 - DO 1 I = 1,N - DO 1 J = 1,I - TEMPA=DABS(A(I,J)) - IF (AMAX-TEMPA) 2,1,1 - 2 AMAX = TEMPA - 1 CONTINUE - TEST = AMAX*E -C SEARCH FOR LARGEST OFF DIAGONAL ELEMENT - DO 72 IJAC=1,MAXJAC - AIJMAX = 0.0 - DO 3 I = 2,N - LIM = I-1 - DO 3 J = 1,LIM - TAIJ=DABS(A(I,J)) - IF (AIJMAX-TAIJ) 4,3,3 - 4 AIJMAX = TAIJ - IPIV = I - JPIV = J - 3 CONTINUE - IF(AIJMAX-TEST)300,300,5 -C PARAMETERS FOR ROTATION - 5 TAII = A(IPIV,IPIV) - TAJJ = A(JPIV,JPIV) - TAIJ = A(IPIV,JPIV) - TMT = TAII-TAJJ - IF(DABS(TMT/TAIJ)-1.0D-12) 60,60,6 - 60 IF(TAIJ) 10,10,11 - 6 ZAMMA=TAIJ/(2.0*TMT) - 90 IF(DABS(ZAMMA)-0.38268)8,8,9 - 9 IF(ZAMMA)10,10,11 - 10 SINT = -SIN45 - GO TO 12 - 11 SINT = SIN45 - 12 COST = COS45 - SINSQ = S45SQ - COSSQ = C45SQ - GO TO 120 - 8 GAMSQ=ZAMMA*ZAMMA - SINT=2.0*ZAMMA/(1.0+GAMSQ) - COST = (1.0-GAMSQ)/(1.0+GAMSQ) - SINSQ=SINT*SINT - COSSQ=COST*COST -C ROTATION - 120 DO 13 K = 1,N - TAIK = A(IPIV,K) - TAJK = A(JPIV,K) - A(IPIV,K) = TAIK*COST+TAJK*SINT - A(JPIV,K) = TAJK*COST-TAIK*SINT - TCIK = C(IPIV,K) - TCJK = C(JPIV,K) - C(IPIV,K) = TCIK*COST+TCJK*SINT - 13 C(JPIV,K) = TCJK*COST-TCIK*SINT - A(IPIV,IPIV) = TAII*COSSQ+TAJJ*SINSQ+2.0*TAIJ*SINT*COST - A(JPIV,JPIV) = TAII*SINSQ+TAJJ*COSSQ-2.0*TAIJ*SINT*COST - A(IPIV,JPIV) = TAIJ*(COSSQ-SINSQ)-SINT*COST*TMT - A(JPIV,IPIV) = A(IPIV,JPIV) - DO 30 K = 1,N - A(K,IPIV) = A(IPIV,K) - 30 A(K,JPIV) = A(JPIV,K) - 72 CONTINUE - WRITE (IOUT,1000) AIJMAX - 1000 FORMAT (/1X,'NONCONVERGENT JACOBI. LARGEST OFF-DIAGONAL ELE', - 1 'MENT = ',1PE14.7) -C ARRANGEMENT OF EIGENVALUES IN ASCENDING ORDER - 300 DO 14 I=1,N - 14 AJJ(I)=A(I,I) - LT=N+1 - DO15 L=1,N - LT=LT-1 - AIIMIN=1.0E+30 - DO16 I=1,N - IF(AJJ(I)-AIIMIN)17,16,16 - 17 AIIMIN=AJJ(I) - IT=I - 16 CONTINUE - IN=L - AII(IN)=AIIMIN - AJJ(IT)=1.0E+30 - DO15 K=1,N - 15 A(IN,K)=C(IT,K) - DO 18 I=1,N - IF(A(I,1))19,22,22 - 19 T=-1.0 - GO TO 91 - 22 T=1.0 - 91 DO 18 J=1,N - 18 C(J,I)=T*A(I,J) - RETURN - END diff --git a/source/unres/src_MD-restraints/econstr_local.F b/source/unres/src_MD-restraints/econstr_local.F deleted file mode 100644 index f11acfb..0000000 --- a/source/unres/src_MD-restraints/econstr_local.F +++ /dev/null @@ -1,91 +0,0 @@ - subroutine Econstr_back -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - Uconst_back=0.0d0 - do i=1,nres - dutheta(i)=0.0d0 - dugamma(i)=0.0d0 - do j=1,3 - duscdiff(j,i)=0.0d0 - duscdiffx(j,i)=0.0d0 - enddo - enddo - do i=1,nfrag_back - ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) -c -c Deviations from theta angles -c - utheta_i=0.0d0 - do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) - dtheta_i=theta(j)-thetaref(j) - utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i - dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) - enddo - utheta(i)=utheta_i/(ii-1) -c -c Deviations from gamma angles -c - ugamma_i=0.0d0 - do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset) - dgamma_i=pinorm(phi(j)-phiref(j)) -c write (iout,*) j,phi(j),phi(j)-phiref(j) - ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i - dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2) -c write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3) - enddo - ugamma(i)=ugamma_i/(ii-2) -c -c Deviations from local SC geometry -c - uscdiff(i)=0.0d0 - do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 - dxx=xxtab(j)-xxref(j) - dyy=yytab(j)-yyref(j) - dzz=zztab(j)-zzref(j) - uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz - do k=1,3 - duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* - & (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ - & (ii-1) - duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* - & (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ - & (ii-1) - duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* - & (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) - & /(ii-1) - enddo -c write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), -c & xxref(j),yyref(j),zzref(j) - enddo - uscdiff(i)=0.5d0*uscdiff(i)/(ii-1) -c write (iout,*) i," uscdiff",uscdiff(i) -c -c Put together deviations from local geometry -c - Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ - & wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i) -c write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i), -c & " uconst_back",uconst_back - utheta(i)=dsqrt(utheta(i)) - ugamma(i)=dsqrt(ugamma(i)) - uscdiff(i)=dsqrt(uscdiff(i)) - enddo - return - end diff --git a/source/unres/src_MD-restraints/eigen.f b/source/unres/src_MD-restraints/eigen.f deleted file mode 100644 index e4088ee..0000000 --- a/source/unres/src_MD-restraints/eigen.f +++ /dev/null @@ -1,2351 +0,0 @@ -C 10 AUG 94 - MWS - INCREASE NUMBER OF DAF RECORDS -C 31 MAR 94 - MWS - ADD A VARIABLE TO END OF MACHSW COMMON -C 26 JUN 93 - MWS - ETRED3: ADD RETURN FOR SPECIAL CASE N=1 -C 4 JAN 92 - TLW - MAKE WRITES PARALLEL;ADD COMMON PAR -C 30 AUG 91 - MWS - JACDIA: LIMIT ITERATIONS, USE EPSLON IN TEST. -C 14 JUL 91 - MWS - JACOBI DIAGONALIZATION ALLOWS FOR LDVEC.NE.N -C 29 JAN 91 - TLW - GLDIAG: CHANGED COMMON DIAGSW TO MACHSW -C 29 OCT 90 - STE - FIX JACDIA UNDEFINED VARIABLE BUG -C 14 SEP 90 - MK - NEW JACOBI DIAGONALIZATION (KDIAG=3) -C 27 MAR 88 - MWS - ALLOW FOR VECTOR ROUTINE IN GLDIAG -C 11 AUG 87 - MWS - SANITIZE CONSTANTS IN EQLRAT -C 15 FEB 87 - STE - FIX EINVIT SUB-MATRIX LOOP LIMIT -C SCRATCH ARRAYS ARE N*8 REAL AND N INTEGER -C 8 DEC 86 - STE - USE PERF INDEX FROM ESTPI1 TO JUDGE EINVIT FAILURE -C 30 NOV 86 - STE - DELETE LIGENB, MAKE EVVRSP DEFAULT -C (GIVEIS FAILS ON CRAY FOR BENCHMC AND BENCHCI) -C 7 JUL 86 - JAB - SANITIZE FLOATING POINT CONSTANTS -C 11 OCT 85 - STE - LIGENB,TQL2: USE DROT,DSWAP; TINVTB: SCALE VECTOR -C BEFORE NORMALIZING; GENERIC FUNCTIONS -C 24 FEB 84 - STE - INITIALIZE INDEX ARRAY FOR LIGENB IN GLDIAG -C 1 DEC 83 - STE - CHANGE MACHEP FROM 2**-54 TO 2**-50 -C 28 SEP 82 - MWS - CONVERT TO IBM -C -C*MODULE EIGEN *DECK EINVIT - SUBROUTINE EINVIT(NM,N,D,E,E2,M,W,IND,Z,IERR,RV1,RV2,RV3,RV4,RV6) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF TINVIT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TINVIT IS A TRANSLATION OF THE INVERSE ITERATION TECHNIQUE -C* IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C* SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES. -C* -C* METHOD - -C* INVERSE ITERATION. -C* -C* ON ENTRY - -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C* IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF CORRESPONDING ELEMENTS OF E, -C* WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C* E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C* THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE -C* SUM OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST -C* CONTAIN 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, -C* OR 2.0 IF THE EIGENVALUES ARE IN DESCENDING ORDER. -C* IF TQLRAT, BISECT, TRIDIB, OR IMTQLV -C* HAS BEEN USED TO FIND THE EIGENVALUES, THEIR -C* OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE. -C* M - INTEGER -C* THE NUMBER OF SPECIFIED EIGENVECTORS. -C* W - W.P. REAL (M) -C* CONTAINS THE M EIGENVALUES IN ASCENDING -C* OR DESCENDING ORDER. -C* IND - INTEGER (M) -C* CONTAINS IN FIRST M POSITIONS THE SUBMATRIX INDICES -C* ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C* 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX -C* FROM THE TOP, 2 FOR THOSE BELONGING TO THE SECOND -C* SUBMATRIX, ETC. -C* IERR - INTEGER (LOGICAL UNIT NUMBER) -C* LOGICAL UNIT FOR ERROR MESSAGES -C* -C* ON EXIT - -C* ALL INPUT ARRAYS ARE UNALTERED. -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE ASSOCIATED SET OF ORTHONORMAL -C* EIGENVECTORS. ANY VECTOR WHICH WHICH FAILS TO CONVERGE -C* IS LEFT AS IS (BUT NORMALIZED) WHEN ITERATING STOPPED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C* EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS. -C* (ONLY LAST FAILURE TO CONVERGE IS REPORTED) -C* -C* RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C* -C* RV1 - W.P. REAL (N) -C* DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV2 - W.P. REAL (N) -C* SUPER(1)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV3 - W.P. REAL (N) -C* SUPER(2)-DIAGONAL ELEMENTS OF U FROM LU DECOMPOSITION -C* RV4 - W.P. REAL (N) -C* ELEMENTS DEFINING L IN LU DECOMPOSITION -C* RV6 - W.P. REAL (N) -C* APPROXIMATE EIGENVECTOR -C* -C* DIFFERENCES FROM EISPACK 3 - -C* EPS3 IS SCALED BY EPSCAL (ENHANCES CONVERGENCE, BUT -C* LOWERS ACCURACY)! -C* ONE MORE ITERATION (MINIMUM 2) IS PERFORMED AFTER CONVERGENCE -C* (ENHANCES ACCURACY)! -C* REPLACE LOOP WITH PYTHAG WITH SINGLE CALL TO DNRM2! -C* IF NOT CONVERGED, USE PERFORMANCE INDEX TO DECIDE ON ERROR -C* VALUE SETTING, BUT DO NOT STOP! -C* L.U. FOR ERROR MESSAGES PASSED THROUGH IERR -C* USE PARAMETER STATEMENTS AND GENERIC INTRINSIC FUNCTIONS -C* USE LEVEL 1 BLAS -C* USE IF-THEN-ELSE TO CLARIFY LOGIC -C* LOOP OVER SUBSPACES MADE INTO DO LOOP. -C* LOOP OVER INVERSE ITERATIONS MADE INTO DO LOOP -C* ZERO ONLY REQUIRED PORTIONS OF OUTPUT VECTOR -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C* -C - LOGICAL CONVGD,GOPARR,DSKWRK,MASWRK -C - INTEGER GROUP,I,IERR,ITS,J,JJ,M,N,NM,P,Q,R,S,SUBMAT,TAG - INTEGER IND(M) -C - DOUBLE PRECISION D(N),E(N),E2(N),W(M),Z(NM,M) - DOUBLE PRECISION RV1(N),RV2(N),RV3(N),RV4(N),RV6(N) - DOUBLE PRECISION ANORM,EPS2,EPS3,EPS4,NORM,ORDER,RHO,U,UK,V - DOUBLE PRECISION X0,X1,XU - DOUBLE PRECISION EPSCAL,GRPTOL,HUNDRD,ONE,TEN,ZERO - DOUBLE PRECISION EPSLON, ESTPI1, DASUM, DDOT, DNRM2 -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00, GRPTOL = 0.001D+00) - PARAMETER (EPSCAL = 0.5D+00, HUNDRD = 100.0D+00, TEN = 10.0D+00) -C - 001 FORMAT(' EIGENVECTOR ROUTINE EINVIT DID NOT CONVERGE FOR VECTOR' - * ,I5,'. NORM =',1P,E10.2,' PERFORMANCE INDEX =',E10.2/ - * ' (AN ERROR HALT WILL OCCUR IF THE PI IS GREATER THAN 100)') -C -C----------------------------------------------------------------------- -C - LUEMSG = IERR - IERR = 0 - X0 = ZERO - UK = ZERO - NORM = ZERO - EPS2 = ZERO - EPS3 = ZERO - EPS4 = ZERO - GROUP = 0 - TAG = 0 - ORDER = ONE - E2(1) - Q = 0 - DO 930 SUBMAT = 1, N - P = Q + 1 -C -C .......... ESTABLISH AND PROCESS NEXT SUBMATRIX .......... -C - DO 120 Q = P, N-1 - IF (E2(Q+1) .EQ. ZERO) GO TO 140 - 120 CONTINUE - Q = N -C -C .......... FIND VECTORS BY INVERSE ITERATION .......... -C - 140 CONTINUE - TAG = TAG + 1 - ANORM = ZERO - S = 0 -C - DO 920 R = 1, M - IF (IND(R) .NE. TAG) GO TO 920 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 510 -C -C .......... CHECK FOR ISOLATED ROOT .......... -C - XU = ONE - IF (P .EQ. Q) THEN - RV6(P) = ONE - CONVGD = .TRUE. - GO TO 860 -C - END IF - NORM = ABS(D(P)) - DO 500 I = P+1, Q - NORM = MAX( NORM, ABS(D(I)) + ABS(E(I)) ) - 500 CONTINUE -C -C .......... EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ......... -C - EPS2 = GRPTOL * NORM - EPS3 = EPSCAL * EPSLON(NORM) - UK = Q - P + 1 - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - GROUP = 0 - GO TO 520 -C -C .......... LOOK FOR CLOSE OR COINCIDENT ROOTS .......... -C - 510 IF (ABS(X1-X0) .GE. EPS2) THEN -C -C ROOTS ARE SEPERATE -C - GROUP = 0 - ELSE -C -C ROOTS ARE CLOSE -C - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. EPS3) X1 = X0 + ORDER * EPS3 - END IF -C -C .......... ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR .......... -C - 520 CONTINUE -C - U = D(P) - X1 - V = E(P+1) - RV6(P) = UK - DO 550 I = P+1, Q - RV6(I) = UK - IF (ABS(E(I)) .GT. ABS(U)) THEN -C -C EXCHANGE ROWS BEFORE ELIMINATION -C -C *** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ....... -C - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) -C - ELSE -C -C STRAIGHT ELIMINATION -C - XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = ZERO - U = D(I) - X1 - XU * V - V = E(I+1) - END IF - 550 CONTINUE -C - IF (ABS(U) .LE. EPS3) U = EPS3 - RV1(Q) = U - RV2(Q) = ZERO - RV3(Q) = ZERO -C -C DO INVERSE ITERATIONS -C - CONVGD = .FALSE. - DO 800 ITS = 1, 5 - IF (ITS .EQ. 1) GO TO 600 -C -C .......... FORWARD SUBSTITUTION .......... -C - IF (NORM .EQ. ZERO) THEN - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - ELSE - XU = EPS4 / NORM - CALL DSCAL (Q-P+1, XU, RV6(P), 1) - END IF -C -C ... ELIMINATION OPERATIONS ON NEXT VECTOR -C - DO 590 I = P+1, Q - U = RV6(I) -C -C IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS .......... -C - IF (RV1(I-1) .EQ. E(I)) THEN - U = RV6(I-1) - RV6(I-1) = RV6(I) - ELSE - U = RV6(I) - END IF - RV6(I) = U - RV4(I) * RV6(I-1) - 590 CONTINUE - 600 CONTINUE -C -C .......... BACK SUBSTITUTION -C - RV6(Q) = RV6(Q) / RV1(Q) - V = U - U = RV6(Q) - NORM = ABS(U) - DO 620 I = Q-1, P, -1 - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - NORM = NORM + ABS(U) - 620 CONTINUE - IF (GROUP .EQ. 0) GO TO 700 -C -C ....... ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP .......... -C - J = R - DO 680 JJ = 1, GROUP - 630 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 630 - CALL DAXPY(Q-P+1, -DDOT(Q-P+1,RV6(P),1,Z(P,J),1), - * Z(P,J),1,RV6(P),1) - 680 CONTINUE - NORM = DASUM(Q-P+1, RV6(P), 1) - 700 CONTINUE -C - IF (CONVGD) GO TO 840 - IF (NORM .GE. ONE) CONVGD = .TRUE. - 800 CONTINUE -C -C .......... NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER .......... -C - 840 CONTINUE -C - XU = ONE / DNRM2(Q-P+1,RV6(P),1) -C - 860 CONTINUE - DO 870 I = 1, P-1 - Z(I,R) = ZERO - 870 CONTINUE - DO 890 I = P,Q - Z(I,R) = RV6(I) * XU - 890 CONTINUE - DO 900 I = Q+1, N - Z(I,R) = ZERO - 900 CONTINUE -C - IF (.NOT.CONVGD) THEN - RHO = ESTPI1(Q-P+1,X1,D(P),E(P),Z(P,R),ANORM) - IF (RHO .GE. TEN .AND. LUEMSG .GT. 0 .AND. MASWRK) - * WRITE(LUEMSG,001) R,NORM,RHO -C -C *** SET ERROR -- NON-CONVERGED EIGENVECTOR .......... -C - IF (RHO .GT. HUNDRD) IERR = -R - END IF -C - X0 = X1 - 920 CONTINUE -C - IF (Q .EQ. N) GO TO 940 - 930 CONTINUE - 940 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ELAUM - SUBROUTINE ELAU(HINV,L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G - DOUBLE PRECISION HALF - DOUBLE PRECISION HH - DOUBLE PRECISION HINV - DOUBLE PRECISION ZERO -C - PARAMETER (ZERO = 0.0D+00, HALF = 0.5D+00) -C - JL = L - E(1) = A(1) * D(1) - JK = 2 - DO 210 J = 2, JL - F = D(J) - G = ZERO - JM1 = J - 1 -C - DO 200 K = 1, JM1 - G = G + A(JK) * D(K) - E(K) = E(K) + A(JK) * F - JK = JK + 1 - 200 CONTINUE -C - E(J) = G + A(JK) * F - JK = JK + 1 - 210 CONTINUE -C -C .......... FORM P .......... -C - F = ZERO - DO 245 J = 1, L - E(J) = E(J) * HINV - F = F + E(J) * D(J) - 245 CONTINUE -C -C .......... FORM Q .......... -C - HH = F * HALF * HINV - DO 250 J = 1, L - 250 E(J) = E(J) - HH * D(J) -C - RETURN - END -C*MODULE EIGEN *DECK EPSLON - DOUBLE PRECISION FUNCTION EPSLON (X) -C* -C* AUTHORS - -C* THIS ROUTINE WAS TAKEN FROM EISPACK EDITION 3 DATED 4/6/83 -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE NOV 1986 -C* -C* PURPOSE - -C* ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X. -C* -C* ON ENTRY - -C* X - WORKING PRECISION REAL -C* VALUES TO FIND EPSLON FOR -C* -C* ON EXIT - -C* EPSLON - WORKING PRECISION REAL -C* SMALLEST POSITIVE VALUE SUCH THAT X+EPSLON .NE. ZERO -C* -C* QUALIFICATIONS - -C* THIS ROUTINE SHOULD PERFORM PROPERLY ON ALL SYSTEMS -C* SATISFYING THE FOLLOWING TWO ASSUMPTIONS, -C* 1. THE BASE USED IN REPRESENTING FLOATING POINT -C* NUMBERS IS NOT A POWER OF THREE. -C* 2. THE QUANTITY A IN STATEMENT 10 IS REPRESENTED TO -C* THE ACCURACY USED IN FLOATING POINT VARIABLES -C* THAT ARE STORED IN MEMORY. -C* THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO -C* FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING -C* ASSUMPTION 2. -C* UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT, -C* A IS NOT EXACTLY EQUAL TO FOUR-THIRDS, -C* B HAS A ZERO FOR ITS LAST BIT OR DIGIT, -C* C IS NOT EXACTLY EQUAL TO ONE, -C* EPS MEASURES THE SEPARATION OF 1.0 FROM -C* THE NEXT LARGER FLOATING POINT NUMBER. -C* THE DEVELOPERS OF EISPACK WOULD APPRECIATE BEING INFORMED -C* ABOUT ANY SYSTEMS WHERE THESE ASSUMPTIONS DO NOT HOLD. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* USE IS MADE OF PARAMETER STATEMENTS AND INTRINSIC FUNCTIONS -C* --NO EXECUTEABLE CODE CHANGES-- -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - DOUBLE PRECISION A,B,C,EPS,X - DOUBLE PRECISION ZERO, ONE, THREE, FOUR -C - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, THREE=3.0D+00, FOUR=4.0D+00) -C -C----------------------------------------------------------------------- -C - A = FOUR/THREE - 10 B = A - ONE - C = B + B + B - EPS = ABS(C - ONE) - IF (EPS .EQ. ZERO) GO TO 10 - EPSLON = EPS*ABS(X) - RETURN - END -C*MODULE EIGEN *DECK EQLRAT - SUBROUTINE EQLRAT(N,DIAG,E,E2IN,D,IND,IERR,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE EQLRAT FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* TQLRAT IS A TRANSLATION OF THE ALGOL PROCEDURE TQLRAT, -C* ALGORITHM 464, COMM. ACM 16, 689(1973) BY REINSCH. -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC -C* TRIDIAGONAL MATRIX -C* -C* METHOD - -C* RATIONAL QL -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX. -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE SUBDIAGONAL ELEMENTS OF -C* THE INPUT MATRIX IN ITS LAST N-1 POSITIONS. -C* E2(1) IS ARBITRARY. -C* -C* ON EXIT - -C* D - W.P. REAL (N) -C* CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C* ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C* ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C* THE SMALLEST EIGENVALUES. -C* E2 - W.P. REAL (N) -C* DESTROYED. -C* IERR - INTEGER -C* SET TO -C* ZERO FOR NORMAL RETURN, -C* J IF THE J-TH EIGENVALUE HAS NOT BEEN -C* DETERMINED AFTER 30 ITERATIONS. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* G=G+B INSTEAD OF IF(G.EQ.0) G=B ; B=B/4 -C* F77 BACKWARD LOOPS INSTEAD OF F66 CONSTRUCT -C* GENERIC INTRINSIC FUNCTIONS -C* ARRARY IND ADDED FOR USE BY EINVIT -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,J,L,M,N,II,L1,IERR - INTEGER IND(N) -C - DOUBLE PRECISION D(N),E(N),E2(N),DIAG(N),E2IN(N) - DOUBLE PRECISION B,C,F,G,H,P,R,S,T,EPSLON - DOUBLE PRECISION SCALE,ZERO,ONE -C - PARAMETER (ZERO = 0.0D+00, SCALE= 1.0D+00/64.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- - IERR = 0 - D(1)=DIAG(1) - IND(1) = 1 - K = 0 - ITAG = 0 - IF (N .EQ. 1) GO TO 1001 -C - DO 100 I = 2, N - D(I)=DIAG(I) - 100 E2(I-1) = E2IN(I) -C - F = ZERO - T = ZERO - B = EPSLON(ONE) - C = B *B - B = B * SCALE - E2(N) = ZERO -C - DO 290 L = 1, N - H = ABS(D(L)) + ABS(E(L)) - IF (T .GE. H) GO TO 105 - T = H - B = EPSLON(T) - C = B * B - B = B * SCALE - 105 CONTINUE -C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT .......... - M = L - 1 - 110 M = M + 1 - IF (E2(M) .GT. C) GO TO 110 -C .......... E2(N) IS ALWAYS ZERO, SO THERE IS AN EXIT -C FROM THE LOOP .......... -C - IF (M .LE. K) GO TO 125 - IF (M .NE. N) E2IN(M+1) = ZERO - K = M - ITAG = ITAG + 1 - 125 CONTINUE - IF (M .EQ. L) GO TO 210 -C -C ITERATE -C - DO 205 J = 1, 30 -C .......... FORM SHIFT .......... - L1 = L + 1 - S = SQRT(E2(L)) - G = D(L) - P = (D(L1) - G) / (2.0D+00 * S) - R = SQRT(P*P+1.0D+00) - D(L) = S / (P + SIGN(R,P)) - H = G - D(L) -C - DO 140 I = L1, N - 140 D(I) = D(I) - H -C - F = F + H -C .......... RATIONAL QL TRANSFORMATION .......... - G = D(M) + B - H = G - S = ZERO - DO 200 I = M-1,L,-1 - P = G * H - R = P + E2(I) - E2(I+1) = S * R - S = E2(I) / R - D(I+1) = H + S * (H + D(I)) - G = D(I) - E2(I) / G + B - H = G * P / R - 200 CONTINUE -C - E2(L) = S * G - D(L) = H -C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST - IF (H .EQ. ZERO) GO TO 210 - IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210 - E2(L) = H * E2(L) - IF (E2(L) .EQ. ZERO) GO TO 210 - 205 CONTINUE -C .......... SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS .......... - IERR = L - GO TO 1001 -C -C CONVERGED -C - 210 P = D(L) + F -C .......... ORDER EIGENVALUES .......... - I = 1 - IF (L .EQ. 1) GO TO 250 - IF (P .LT. D(1)) GO TO 230 - I = L -C .......... LOOP TO FIND ORDERED POSITION - 220 I = I - 1 - IF (P .LT. D(I)) GO TO 220 -C - I = I + 1 - IF (I .EQ. L) GO TO 250 - 230 CONTINUE - DO 240 II = L, I+1, -1 - D(II) = D(II-1) - IND(II) = IND(II-1) - 240 CONTINUE -C - 250 CONTINUE - D(I) = P - IND(I) = ITAG - 290 CONTINUE -C - 1001 RETURN - END -C*MODULE EIGEN *DECK ESTPI1 - DOUBLE PRECISION FUNCTION ESTPI1 (N,EVAL,D,E,X,ANORM) -C* -C* AUTHOR - -C* STEPHEN T. ELBERT (AMES LABORATORY-USDOE) DATE: 5 DEC 1986 -C* -C* PURPOSE - -C* EVALUATE SYMMETRIC TRIDIAGONAL MATRIX PERFORMANCE INDEX -C* * * * * * -C* FOR 1 EIGENVECTOR -C* * -C* -C* METHOD - -C* THIS ROUTINE FORMS THE 1-NORM OF THE RESIDUAL MATRIX A*X-X*EVAL -C* WHERE A IS A SYMMETRIC TRIDIAGONAL MATRIX STORED -C* IN THE DIAGONAL (D) AND SUB-DIAGONAL (E) VECTORS, EVAL IS THE -C* EIGENVALUE OF AN EIGENVECTOR OF A, NAMELY X. -C* THIS NORM IS SCALED BY MACHINE ACCURACY FOR THE PROBLEM SIZE. -C* ALL NORMS APPEARING IN THE COMMENTS BELOW ARE 1-NORMS. -C* -C* ON ENTRY - -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* EVAL - W.P. REAL -C* THE EIGENVALUE CORRESPONDING TO VECTOR X. -C* D - W.P. REAL (N) -C* THE DIAGONAL VECTOR OF A. -C* E - W.P. REAL (N) -C* THE SUB-DIAGONAL VECTOR OF A. -C* X - W.P. REAL (N) -C* AN EIGENVECTOR OF A. -C* ANORM - W.P. REAL -C* THE NORM OF A IF IT HAS BEEN PREVIOUSLY COMPUTED. -C* -C* ON EXIT - -C* ANORM - W.P. REAL -C* THE NORM OF A, COMPUTED IF INITIALLY ZERO. -C* ESTPI1 - W.P. REAL -C* !!A*X-X*EVAL!! / (EPSLON(10*N)*!!A!!*!!X!!); -C* WHERE EPSLON(X) IS THE SMALLEST NUMBER SUCH THAT -C* X + EPSLON(X) .NE. X -C* -C* ESTPI1 .LT. 1 == SATISFACTORY PERFORMANCE -C* .GE. 1 AND .LE. 100 == MARGINAL PERFORMANCE -C* .GT. 100 == POOR PERFORMANCE -C* (SEE LECT. NOTES IN COMP. SCI. VOL.6 PP 124-125) -C - DOUBLE PRECISION ANORM,EVAL,RNORM,SIZE,XNORM - DOUBLE PRECISION D(N), E(N), X(N) - DOUBLE PRECISION EPSLON, ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - ESTPI1 = ZERO - IF( N .LE. 1 ) RETURN - SIZE = 10 * N - IF (ANORM .EQ. ZERO) THEN -C -C COMPUTE NORM OF A -C - ANORM = MAX( ABS(D(1)) + ABS(E(2)) - * ,ABS(D(N)) + ABS(E(N))) - DO 110 I = 2, N-1 - ANORM = MAX( ANORM, ABS(E(I))+ABS(D(I))+ABS(E(I+1))) - 110 CONTINUE - IF(ANORM .EQ. ZERO) ANORM = ONE - END IF -C -C COMPUTE NORMS OF RESIDUAL AND EIGENVECTOR -C - XNORM = ABS(X(1)) + ABS(X(N)) - RNORM = ABS( (D(1)-EVAL)*X(1) + E(2)*X(2)) - * +ABS( (D(N)-EVAL)*X(N) + E(N)*X(N-1)) - DO 120 I = 2, N-1 - XNORM = XNORM + ABS(X(I)) - RNORM = RNORM + ABS(E(I)*X(I-1) + (D(I)-EVAL)*X(I) - * + E(I+1)*X(I+1)) - 120 CONTINUE -C - ESTPI1 = RNORM / (EPSLON(SIZE)*ANORM*XNORM) - RETURN - END -C*MODULE EIGEN *DECK ETRBK3 - SUBROUTINE ETRBK3(NM,N,NV,A,M,Z) -C* -C* AUTHORS- -C* THIS IS A MODIFICATION OF ROUTINE TRBAK3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRBAK3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT (AMES LABORATORY-USDOE) -C* -C* PURPOSE - -C* THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C* MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C* SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY ETRED3. -C* -C* METHOD - -C* THE CALCULATION IS CARRIED OUT BY FORMING THE MATRIX PRODUCT -C* Q*Z -C* WHERE Q IS A PRODUCT OF THE ORTHOGONAL SYMMETRIC MATRICES -C* Q = PROD(I)[1 - U(I)*.TRANSPOSE.U(I)*H(I)] -C* U IS THE AUGMENTED SUB-DIAGONAL ROWS OF A AND -C* Z IS THE SET OF EIGENVECTORS OF THE TRIDIAGONAL -C* MATRIX F WHICH WAS FORMED FROM THE ORIGINAL SYMMETRIC -C* MATRIX C BY THE SIMILARITY TRANSFORMATION -C* F = Q(TRANSPOSE) C Q -C* NOTE THAT ETRBK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C* -C* -C* COMPLEXITY - -C* M*N**2 -C* -C* ON ENTRY- -C* NM - INTEGER -C* MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C* ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C* DIMENSION STATEMENT. -C* N - INTEGER -C* THE ORDER OF THE MATRIX A. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY A AS -C* DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT. -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION BY ETRED3 IN -C* ITS FIRST NV = N*(N+1)/2 POSITIONS. -C* M - INTEGER -C* THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. -C* Z - W.P REAL (NM,M) -C* CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C* IN ITS FIRST M COLUMNS. -C* -C* ON EXIT- -C* Z - W.P. REAL (NM,M) -C* CONTAINS THE TRANSFORMED EIGENVECTORS -C* IN ITS FIRST M COLUMNS. -C* -C* DIFFERENCES WITH EISPACK 3 - -C* THE TWO INNER LOOPS ARE REPLACED BY DDOT AND DAXPY. -C* MULTIPLICATION USED INSTEAD OF DIVISION TO FIND S. -C* OUTER LOOP RANGE CHANGED FROM 2,N TO 3,N. -C* ADDRESS POINTERS FOR A SIMPLIFIED. -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,II,IM1,IZ,J,M,N,NM,NV -C - DOUBLE PRECISION A(NV),Z(NM,M) - DOUBLE PRECISION H,S,DDOT,ZERO -C - PARAMETER (ZERO = 0.0D+00) -C -C----------------------------------------------------------------------- -C - IF (M .EQ. 0) RETURN - IF (N .LE. 2) RETURN -C - II=3 - DO 140 I = 3, N - IZ=II+1 - II=II+I - H = A(II) - IF (H .EQ. ZERO) GO TO 140 - IM1 = I - 1 - DO 130 J = 1, M - S = -( DDOT(IM1,A(IZ),1,Z(1,J),1) * H) * H - CALL DAXPY(IM1,S,A(IZ),1,Z(1,J),1) - 130 CONTINUE - 140 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK ETRED3 - SUBROUTINE ETRED3(N,NV,A,D,E,E2) -C* -C* AUTHORS - -C* THIS IS A MODIFICATION OF ROUTINE TRED3 FROM EISPACK EDITION 3 -C* DATED AUGUST 1983. -C* EISPACK TRED3 IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C* NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C* THIS VERSION IS BY S. T. ELBERT, AMES LABORATORY-USDOE JUN 1986 -C* -C* PURPOSE - -C* THIS ROUTINE REDUCES A REAL SYMMETRIC (PACKED) MATRIX, STORED -C* AS A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C* USING ORTHOGONAL SIMILARITY TRANSFORMATIONS, PRESERVING THE -C* INFORMATION ABOUT THE TRANSFORMATIONS IN A. -C* -C* METHOD - -C* THE TRIDIAGONAL REDUCTION IS PERFORMED IN THE FOLLOWING WAY. -C* STARTING WITH J=N, THE ELEMENTS IN THE J-TH ROW TO THE -C* LEFT OF THE DIAGONAL ARE FIRST SCALED, TO AVOID POSSIBLE -C* UNDERFLOW IN THE TRANSFORMATION THAT MIGHT RESULT IN SEVERE -C* DEPARTURE FROM ORTHOGONALITY. THE SUM OF SQUARES SIGMA OF -C* THESE SCALED ELEMENTS IS NEXT FORMED. THEN, A VECTOR U AND -C* A SCALAR -C* H = U(TRANSPOSE) * U / 2 -C* DEFINE A REFLECTION OPERATOR -C* P = I - U * U(TRANSPOSE) / H -C* WHICH IS ORTHOGONAL AND SYMMETRIC AND FOR WHICH THE -C* SIMILIARITY TRANSFORMATION PAP ELIMINATES THE ELEMENTS IN -C* THE J-TH ROW OF A TO THE LEFT OF THE SUBDIAGONAL AND THE -C* SYMMETRICAL ELEMENTS IN THE J-TH COLUMN. -C* -C* THE NON-ZERO COMPONENTS OF U ARE THE ELEMENTS OF THE J-TH -C* ROW TO THE LEFT OF THE DIAGONAL WITH THE LAST OF THEM -C* AUGMENTED BY THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE SUBDIAGONAL ELEMENT. BY STORING THE TRANSFORMED SUB- -C* DIAGONAL ELEMENT IN E(J) AND NOT OVERWRITING THE ROW -C* ELEMENTS ELIMINATED IN THE TRANSFORMATION, FULL INFORMATION -C* ABOUT P IS SAVE FOR LATER USE IN ETRBK3. -C* -C* THE TRANSFORMATION SETS E2(J) EQUAL TO SIGMA AND E(J) -C* EQUAL TO THE SQUARE ROOT OF SIGMA PREFIXED BY THE SIGN -C* OF THE REPLACED SUBDIAGONAL ELEMENT. -C* -C* THE ABOVE STEPS ARE REPEATED ON FURTHER ROWS OF THE -C* TRANSFORMED A IN REVERSE ORDER UNTIL A IS REDUCED TO TRI- -C* DIAGONAL FORM, THAT IS, REPEATED FOR J = N-1,N-2,...,3. -C* -C* COMPLEXITY - -C* 2/3 N**3 -C* -C* ON ENTRY- -C* N - INTEGER -C* THE ORDER OF THE MATRIX. -C* NV - INTEGER -C* MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C* AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT -C* A - W.P. REAL (NV) -C* CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C* INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C* ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C* -C* ON EXIT- -C* A - W.P. REAL (NV) -C* CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C* TRANSFORMATIONS USED IN THE REDUCTION. -C* D - W.P. REAL (N) -C* CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX. -C* E - W.P. REAL (N) -C* CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO -C* E2 - W.P. REAL (N) -C* CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF -C* E. MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C* -C* DIFFERENCES FROM EISPACK 3 - -C* OUTER LOOP CHANGED FROM II=1,N TO I=N,3,-1 -C* PARAMETER STATEMENT AND GENERIC INTRINSIC FUNCTIONS USED -C* SCALE.NE.0 TEST NOW SPOTS TRI-DIAGONAL FORM -C* VALUES LESS THAN EPSLON CLEARED TO ZERO -C* USE BLAS(1) -C* U NOT COPIED TO D, LEFT IN A -C* E2 COMPUTED FROM E -C* INNER LOOPS SPLIT INTO ROUTINES ELAU AND FREDA -C* INVERSE OF H STORED INSTEAD OF H -C* -C* NOTE - -C* QUESTIONS AND COMMENTS CONCERNING EISPACK SHOULD BE DIRECTED TO -C* B. S. GARBOW, APPLIED MATH. DIVISION, ARGONNE NATIONAL LAB. -C - INTEGER I,IIA,IZ0,L,N,NV -C - DOUBLE PRECISION A(NV),D(N),E(N),E2(N) - DOUBLE PRECISION AIIMAX,F,G,H,HROOT,SCALE,SCALEI - DOUBLE PRECISION DASUM, DNRM2 - DOUBLE PRECISION ONE, ZERO -C - PARAMETER (ZERO = 0.0D+00, ONE = 1.0D+00) -C -C----------------------------------------------------------------------- -C - IF (N .LE. 2) GO TO 310 - IZ0 = (N*N+N)/2 - AIIMAX = ABS(A(IZ0)) - DO 300 I = N, 3, -1 - L = I - 1 - IIA = IZ0 - IZ0 = IZ0 - I - AIIMAX = MAX(AIIMAX, ABS(A(IIA))) - SCALE = DASUM (L, A(IZ0+1), 1) - IF(SCALE .EQ. ABS(A(IIA-1)) .OR. AIIMAX+SCALE .EQ. AIIMAX) THEN -C -C THIS ROW IS ALREADY IN TRI-DIAGONAL FORM -C - D(I) = A(IIA) - IF (AIIMAX+D(I) .EQ. AIIMAX) D(I) = ZERO - E(I) = A(IIA-1) - IF (AIIMAX+E(I) .EQ. AIIMAX) E(I) = ZERO - E2(I) = E(I)*E(I) - A(IIA) = ZERO - GO TO 300 -C - END IF -C - SCALEI = ONE / SCALE - CALL DSCAL(L,SCALEI,A(IZ0+1),1) - HROOT = DNRM2(L,A(IZ0+1),1) -C - F = A(IZ0+L) - G = -SIGN(HROOT,F) - E(I) = SCALE * G - E2(I) = E(I)*E(I) - H = HROOT*HROOT - F * G - A(IZ0+L) = F - G - D(I) = A(IIA) - A(IIA) = ONE / SQRT(H) -C .......... FORM P THEN Q IN E(1:L) .......... - CALL ELAU(ONE/H,L,A(IZ0+1),A,E) -C .......... FORM REDUCED A .......... - CALL FREDA(L,A(IZ0+1),A,E) -C - 300 CONTINUE - 310 CONTINUE - E(1) = ZERO - E2(1)= ZERO - D(1) = A(1) - IF(N.EQ.1) RETURN -C - E(2) = A(2) - E2(2)= A(2)*A(2) - D(2) = A(3) - RETURN - END -C*MODULE EIGEN *DECK EVVRSP - SUBROUTINE EVVRSP(MSGFL,N,NVECT,LENA,NV,A,B,IND,ROOT, - * VECT,IORDER,IERR) -C* -C* AUTHOR: S. T. ELBERT, AMES LABORATORY-USDOE, JUNE 1985 -C* -C* PURPOSE - -C* FINDS (ALL) EIGENVALUES AND (SOME OR ALL) EIGENVECTORS -C* * * * -C* OF A REAL SYMMETRIC PACKED MATRIX. -C* * * * -C* -C* METHOD - -C* THE METHOD AS PRESENTED IN THIS ROUTINE CONSISTS OF FOUR STEPS: -C* FIRST, THE INPUT MATRIX IS REDUCED TO TRIDIAGONAL FORM BY THE -C* HOUSEHOLDER TECHNIQUE (ORTHOGONAL SIMILARITY TRANSFORMATIONS). -C* SECOND, THE ROOTS ARE LOCATED USING THE RATIONAL QL METHOD. -C* THIRD, THE VECTORS OF THE TRIDIAGONAL FORM ARE EVALUATED BY THE -C* INVERSE ITERATION TECHNIQUE. VECTORS FOR DEGENERATE OR NEAR- -C* DEGENERATE ROOTS ARE FORCED TO BE ORTHOGONAL. -C* FOURTH, THE TRIDIAGONAL VECTORS ARE ROTATED TO VECTORS OF THE -C* ORIGINAL ARRAY. -C* -C* THESE ROUTINES ARE MODIFICATIONS OF THE EISPACK 3 -C* ROUTINES TRED3, TQLRAT, TINVIT AND TRBAK3 -C* -C* FOR FURTHER DETAILS, SEE EISPACK USERS GUIDE, B. T. SMITH -C* ET AL, SPRINGER-VERLAG, LECTURE NOTES IN COMPUTER SCIENCE, -C* VOL. 6, 2-ND EDITION, 1976. ANOTHER GOOD REFERENCE IS -C* THE SYMMETRIC EIGENVALUE PROBLEM BY B. N. PARLETT -C* PUBLISHED BY PRENTICE-HALL, INC., ENGLEWOOD CLIFFS, N.J. (1980) -C* -C* ON ENTRY - -C* MSGFL - INTEGER (LOGICAL UNIT NO.) -C* FILE WHERE ERROR MESSAGES WILL BE PRINTED. -C* IF MSGFL IS 0, ERROR MESSAGES WILL BE PRINTED ON LU 6. -C* IF MSGFL IS NEGATIVE, NO ERROR MESSAGES PRINTED. -C* N - INTEGER -C* ORDER OF MATRIX A. -C* NVECT - INTEGER -C* NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N. -C* LENA - INTEGER -C* DIMENSION OF A IN CALLING ROUTINE. MUST NOT BE LESS -C* THAN (N*N+N)/2. -C* NV - INTEGER -C* ROW DIMENSION OF VECT IN CALLING ROUTINE. N .LE. NV. -C* A - WORKING PRECISION REAL (LENA) -C* INPUT MATRIX, ROWS OF THE LOWER TRIANGLE PACKED INTO -C* LINEAR ARRAY OF DIMENSION N*(N+1)/2. THE PACKED ORDER -C* IS A(1,1), A(2,1), A(2,2), A(3,1), A(3,2), ... -C* B - WORKING PRECISION REAL (N,8) -C* SCRATCH ARRAY, 8*N ELEMENTS -C* IND - INTEGER (N) -C* SCRATCH ARRAY OF LENGTH N. -C* IORDER - INTEGER -C* ROOT ORDERING FLAG. -C* = 0, ROOTS WILL BE PUT IN ASCENDING ORDER. -C* = 2, ROOTS WILL BE PUT IN DESCENDING ORDER. -C* -C* ON EXIT - -C* A - DESTORYED. NOW HOLDS REFLECTION OPERATORS. -C* ROOT - WORKING PRECISION REAL (N) -C* ALL EIGENVALUES IN ASCENDING OR DESCENDING ORDER. -C* IF IORDER = 0, ROOT(1) .LE. ... .LE. ROOT(N) -C* IF IORDER = 2, ROOT(1) .GE. ... .GE. ROOT(N) -C* VECT - WORKING PRECISION REAL (NV,NVECT) -C* EIGENVECTORS FOR ROOT(1), ..., ROOT(NVECT). -C* IERR - INTEGER -C* = 0 IF NO ERROR DETECTED, -C* = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C* = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C* (FAILURES SHOULD BE VERY RARE. CONTACT C. MOLER.) -C* -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DOUBLE PRECISION A(LENA) - DOUBLE PRECISION B(N,8) - DOUBLE PRECISION ROOT(N) - DOUBLE PRECISION T - DOUBLE PRECISION VECT(NV,*) -C - INTEGER IND(N) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - 900 FORMAT(26H0*** EVVRSP PARAMETERS ***/ - + 14H *** N = ,I8,4H ***/ - + 14H *** NVECT = ,I8,4H ***/ - + 14H *** LENA = ,I8,4H ***/ - + 14H *** NV = ,I8,4H ***/ - + 14H *** IORDER = ,I8,4H ***/ - + 14H *** IERR = ,I8,4H ***) - 901 FORMAT(37H VALUE OF LENA IS LESS THAN (N*N+N)/2) - 902 FORMAT(39H EQLRAT HAS FAILED TO CONVERGE FOR ROOT,I5) - 903 FORMAT(18H NV IS LESS THAN N) - 904 FORMAT(41H EINVIT HAS FAILED TO CONVERGE FOR VECTOR,I5) - 905 FORMAT(51H VALUE OF IORDER MUST BE 0 (SMALLEST ROOT FIRST) OR - * ,23H 2 (LARGEST ROOT FIRST)) - 906 FORMAT(' VALUE OF N IS LESS THAN OR EQUAL ZERO') -C -C----------------------------------------------------------------------- -C - LMSGFL=MSGFL - IF (MSGFL .EQ. 0) LMSGFL=6 - IERR = N - 1 - IF (N .LE. 0) GO TO 800 - IERR = N + 1 - IF ( (N*N+N)/2 .GT. LENA) GO TO 810 -C -C REDUCE REAL SYMMETRIC MATRIX A TO TRIDIAGONAL FORM -C - CALL ETRED3(N,LENA,A,B(1,1),B(1,2),B(1,3)) -C -C FIND ALL EIGENVALUES OF TRIDIAGONAL MATRIX -C - CALL EQLRAT(N,B(1,1),B(1,2),B(1,3),ROOT,IND,IERR,B(1,4)) - IF (IERR .NE. 0) GO TO 820 -C -C CHECK THE DESIRED ORDER OF THE EIGENVALUES -C - B(1,3) = IORDER - IF (IORDER .EQ. 0) GO TO 300 - IF (IORDER .NE. 2) GO TO 850 -C -C ORDER ROOTS IN DESCENDING ORDER (LARGEST FIRST)... -C TURN ROOT AND IND ARRAYS END FOR END -C - DO 210 I = 1, N/2 - J = N+1-I - T = ROOT(I) - ROOT(I) = ROOT(J) - ROOT(J) = T - L = IND(I) - IND(I) = IND(J) - IND(J) = L - 210 CONTINUE -C -C FIND I AND J MARKING THE START AND END OF A SEQUENCE -C OF DEGENERATE ROOTS -C - I=0 - 220 CONTINUE - I = I+1 - IF (I .GT. N) GO TO 300 - DO 230 J=I,N - IF (ROOT(J) .NE. ROOT(I)) GO TO 240 - 230 CONTINUE - J = N+1 - 240 CONTINUE - J = J-1 - IF (J .EQ. I) GO TO 220 -C -C TURN AROUND IND BETWEEN I AND J -C - JSV = J - KLIM = (J-I+1)/2 - DO 250 K=1,KLIM - L = IND(J) - IND(J) = IND(I) - IND(I) = L - I = I+1 - J = J-1 - 250 CONTINUE - I = JSV - GO TO 220 -C - 300 CONTINUE -C - IF (NVECT .LE. 0) RETURN - IF (NV .LT. N) GO TO 830 -C -C FIND EIGENVECTORS OF TRI-DIAGONAL MATRIX VIA INVERSE ITERATION -C - IERR = LMSGFL - CALL EINVIT(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,IND, - + VECT,IERR,B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .NE. 0) GO TO 840 -C -C FIND EIGENVECTORS OF SYMMETRIC MATRIX VIA BACK TRANSFORMATION -C - 400 CONTINUE - CALL ETRBK3(NV,N,LENA,A,NVECT,VECT) - RETURN -C -C ERROR MESSAGE SECTION -C - 800 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,906) - GO TO 890 -C - 810 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,901) - GO TO 890 -C - 820 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,902) IERR - GO TO 890 -C - 830 IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,903) - GO TO 890 -C - 840 CONTINUE - IF ((LMSGFL .GT. 0).AND.MASWRK) WRITE(LMSGFL,904) -IERR - GO TO 400 -C - 850 IERR=-1 - IF (LMSGFL .LT. 0) RETURN - IF (MASWRK) WRITE(LMSGFL,905) - GO TO 890 -C - 890 CONTINUE - IF (MASWRK) WRITE(LMSGFL,900) N,NVECT,LENA,NV,IORDER,IERR - RETURN - END -C*MODULE EIGEN *DECK FREDA - SUBROUTINE FREDA(L,D,A,E) -C - DOUBLE PRECISION A(*) - DOUBLE PRECISION D(L) - DOUBLE PRECISION E(L) - DOUBLE PRECISION F - DOUBLE PRECISION G -C - JK = 1 -C -C .......... FORM REDUCED A .......... -C - DO 280 J = 1, L - F = D(J) - G = E(J) -C - DO 260 K = 1, J - A(JK) = A(JK) - F * E(K) - G * D(K) - JK = JK + 1 - 260 CONTINUE -C - 280 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK GIVEIS - SUBROUTINE GIVEIS(N,NVECT,NV,A,B,INDB,ROOT,VECT,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(*),B(N,8),INDB(N),ROOT(N),VECT(NV,NVECT) -C -C EISPACK-BASED SUBSTITUTE FOR QCPE ROUTINE GIVENS. -C FINDS ALL EIGENVALUES AND SOME EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX. AUTHOR.. C. MOLER AND D. SPANGLER, N.R.C.C., 4/1/79. -C -C INPUT.. -C N = ORDER OF MATRIX . -C NVECT = NUMBER OF VECTORS DESIRED. 0 .LE. NVECT .LE. N . -C NV = LEADING DIMENSION OF VECT . -C A = INPUT MATRIX, COLUMNS OF THE UPPER TRIANGLE PACKED INTO -C LINEAR ARRAY OF DIMENSION N*(N+1)/2 . -C B = SCRATCH ARRAY, 8*N ELEMENTS (NOTE THIS IS MORE THAN -C PREVIOUS VERSIONS OF GIVENS.) -C IND = INDEX ARRAY OF N ELEMENTS -C -C OUTPUT.. -C A DESTROYED . -C ROOT = ALL EIGENVALUES, ROOT(1) .LE. ... .LE. ROOT(N) . -C (FOR OTHER ORDERINGS, SEE BELOW.) -C VECT = EIGENVECTORS FOR ROOT(1),..., ROOT(NVECT) . -C IERR = 0 IF NO ERROR DETECTED, -C = K IF ITERATION FOR K-TH EIGENVALUE FAILED, -C = -K IF ITERATION FOR K-TH EIGENVECTOR FAILED. -C (FAILURES SHOULD BE VERY RARE. CONTACT MOLER.) -C -C CALLS MODIFIED EISPACK ROUTINES TRED3B, IMTQLV, TINVTB, AND -C TRBK3B. THE ROUTINES TRED3B, TINVTB, AND TRBK3B. -C THE ORIGINAL EISPACK ROUTINES TRED3, TINVIT, AND TRBAK3 -C WERE MODIFIED BY THE INTRODUCTION OF TWO ROUTINES FROM THE -C BLAS LIBRARY - DDOT AND DAXPY. -C -C IF TINVIT FAILS TO CONVERGE, TQL2 IS CALLED -C -C SEE EISPACK USERS GUIDE, B. T. SMITH ET AL, SPRINGER-VERLAG -C LECTURE NOTES IN COMPUTER SCIENCE, VOL. 6, 2-ND EDITION, 1976 . -C NOTE THAT IMTQLV AND TINVTB HAVE INTERNAL MACHINE -C DEPENDENT CONSTANTS. -C - DATA ONE, ZERO /1.0D+00, 0.0D+00/ - CALL TRED3B(N,(N*N+N)/2,A,B(1,1),B(1,2),B(1,3)) - CALL IMTQLV(N,B(1,1),B(1,2),B(1,3),ROOT,INDB,IERR,B(1,4)) - IF (IERR .NE. 0) RETURN -C -C TO REORDER ROOTS... -C K = N/2 -C B(1,3) = 2.0D+00 -C DO 50 I = 1, K -C J = N+1-I -C T = ROOT(I) -C ROOT(I) = ROOT(J) -C ROOT(J) = T -C 50 CONTINUE -C - IF (NVECT .LE. 0) RETURN - CALL TINVTB(NV,N,B(1,1),B(1,2),B(1,3),NVECT,ROOT,INDB,VECT,IERR, - + B(1,4),B(1,5),B(1,6),B(1,7),B(1,8)) - IF (IERR .EQ. 0) GO TO 160 -C -C IF INVERSE ITERATION GIVES AN ERROR IN DETERMINING THE -C EIGENVECTORS, TRY THE QL ALGORITHM IF ALL THE EIGENVECTORS -C ARE DESIRED. -C - IF (NVECT .NE. N) RETURN - DO 120 I = 1, NVECT - DO 100 J = 1, N - VECT(I,J) = ZERO - 100 CONTINUE - VECT(I,I) = ONE - 120 CONTINUE - CALL TQL2 (NV,N,B(1,1),B(1,2),VECT,IERR) - DO 140 I = 1, NVECT - ROOT(I) = B(I,1) - 140 CONTINUE - IF (IERR .NE. 0) RETURN - 160 CALL TRBK3B(NV,N,(N*N+N)/2,A,NVECT,VECT) - RETURN - END -C*MODULE EIGEN *DECK GLDIAG - SUBROUTINE GLDIAG(LDVECT,NVECT,N,H,WRK,EIG,VECTOR,IERR,IWRK) -C - IMPLICIT DOUBLE PRECISION (A-H,O-Z) -C - LOGICAL GOPARR,DSKWRK,MASWRK -C - DIMENSION H(*),WRK(N,8),EIG(N),VECTOR(LDVECT,NVECT),IWRK(N) -C - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C -C ----- GENERAL ROUTINE TO DIAGONALIZE A SYMMETRIC MATRIX ----- -C IF KDIAG = 0, USE A ROUTINE FROM THE VECTOR LIBRARY, -C IF AVAILABLE (SEE THE SUBROUTINE 'GLDIAG' -C IN VECTOR.SRC), OR EVVRSP OTHERWISE -C = 1, USE EVVRSP -C = 2, USE GIVEIS -C = 3, USE JACOBI -C -C N = DIMENSION (ORDER) OF MATRIX TO BE SOLVED -C LDVECT = LEADING DIMENSION OF VECTOR -C NVECT = NUMBER OF VECTORS DESIRED -C H = MATRIX TO BE DIAGONALIZED -C WRK = N*8 W.P. REAL WORDS OF SCRATCH SPACE -C EIG = EIGENVECTORS (OUTPUT) -C VECTOR = EIGENVECTORS (OUTPUT) -C IERR = ERROR FLAG (OUTPUT) -C IWRK = N INTEGER WORDS OF SCRATCH SPACE -C - IERR = 0 -C -C ----- USE STEVE ELBERT'S ROUTINE ----- -C - IF(KDIAG.LE.1 .OR. KDIAG.GT.3) THEN - LENH = (N*N+N)/2 - KORDER =0 - CALL EVVRSP(IW,N,NVECT,LENH,LDVECT,H,WRK,IWRK,EIG,VECTOR - * ,KORDER,IERR) - END IF -C -C ----- USE MODIFIED EISPAK ROUTINE ----- -C - IF(KDIAG.EQ.2) - * CALL GIVEIS(N,NVECT,LDVECT,H,WRK,IWRK,EIG,VECTOR,IERR) -C -C ----- USE JACOBI ROTATION ROUTINE ----- -C - IF(KDIAG.EQ.3) THEN - IF(NVECT.EQ.N) THEN - CALL JACDG(H,VECTOR,EIG,IWRK,WRK,LDVECT,N) - ELSE - IF (MASWRK) WRITE(IW,9000) N,NVECT,LDVECT - CALL ABRT - END IF - END IF - RETURN -C - 9000 FORMAT(1X,'IN -GLDIAG-, N,NVECT,LDVECT=',3I8/ - * 1X,'THE JACOBI CODE CANNOT COPE WITH N.NE.NVECT!'/ - * 1X,'SO THIS RUN DOES NOT PERMIT KDIAG=3.') - END -C*MODULE EIGEN *DECK IMTQLV - SUBROUTINE IMTQLV(N,D,E,E2,W,IND,IERR,RV1) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - INTEGER TAG - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),E2(N),W(N),RV1(N),IND(N) -C -C THIS ROUTINE IS A VARIANT OF IMTQL1 WHICH IS A TRANSLATION OF -C ALGOL PROCEDURE IMTQL1, NUM. MATH. 12, 377-383(1968) BY MARTIN AND -C WILKINSON, AS MODIFIED IN NUM. MATH. 15, 450(1970) BY DUBRULLE. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 241-248(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES OF A SYMMETRIC TRIDIAGONAL -C MATRIX BY THE IMPLICIT QL METHOD AND ASSOCIATES WITH THEM -C THEIR CORRESPONDING SUBMATRIX INDICES. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2(1) IS ARBITRARY. -C -C ON OUTPUT- -C -C D AND E ARE UNALTERED, -C -C ELEMENTS OF E2, CORRESPONDING TO ELEMENTS OF E REGARDED -C AS NEGLIGIBLE, HAVE BEEN REPLACED BY ZERO CAUSING THE -C MATRIX TO SPLIT INTO A DIRECT SUM OF SUBMATRICES. -C E2(1) IS ALSO SET TO ZERO, -C -C W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT AND -C ORDERED FOR INDICES 1,2,...IERR-1, BUT MAY NOT BE -C THE SMALLEST EIGENVALUES, -C -C IND CONTAINS THE SUBMATRIX INDICES ASSOCIATED WITH THE -C CORRESPONDING EIGENVALUES IN W -- 1 FOR EIGENVALUES -C BELONGING TO THE FIRST SUBMATRIX FROM THE TOP, -C 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC., -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS, -C -C RV1 IS A TEMPORARY STORAGE ARRAY. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - K = 0 - TAG = 0 -C - DO 100 I = 1, N - W(I) = D(I) - IF (I .NE. 1) RV1(I-1) = E(I) - 100 CONTINUE -C - E2(1) = 0.0D+00 - RV1(N) = 0.0D+00 -C - DO 360 L = 1, N - J = 0 -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - 120 DO 140 M = L, N - IF (M .EQ. N) GO TO 160 - IF (ABS(RV1(M)) .LE. MACHEP * (ABS(W(M)) + ABS(W(M+1)))) GO TO - + 160 -C ********** GUARD AGAINST UNDERFLOWED ELEMENT OF E2 ********** - IF (E2(M+1) .EQ. 0.0D+00) GO TO 180 - 140 CONTINUE -C - 160 IF (M .LE. K) GO TO 200 - IF (M .NE. N) E2(M+1) = 0.0D+00 - 180 K = M - TAG = TAG + 1 - 200 P = W(L) - IF (M .EQ. L) GO TO 280 - IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - G = (W(L+1) - P) / (2.0D+00 * RV1(L)) - R = SQRT(G*G+1.0D+00) - G = W(M) - P + RV1(L) / (G + SIGN(R,G)) - S = 1.0D+00 - C = 1.0D+00 - P = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - F = S * RV1(I) - B = C * RV1(I) - IF (ABS(F) .LT. ABS(G)) GO TO 220 - C = G / F - R = SQRT(C*C+1.0D+00) - RV1(I+1) = F * R - S = 1.0D+00 / R - C = C * S - GO TO 240 - 220 S = F / G - R = SQRT(S*S+1.0D+00) - RV1(I+1) = G * R - C = 1.0D+00 / R - S = S * C - 240 G = W(I+1) - P - R = (W(I) - G) * S + 2.0D+00 * C * B - P = S * R - W(I+1) = G + P - G = C * R - B - 260 CONTINUE -C - W(L) = W(L) - P - RV1(L) = G - RV1(M) = 0.0D+00 - GO TO 120 -C ********** ORDER EIGENVALUES ********** - 280 IF (L .EQ. 1) GO TO 320 -C ********** FOR I=L STEP -1 UNTIL 2 DO -- ********** - DO 300 II = 2, L - I = L + 2 - II - IF (P .GE. W(I-1)) GO TO 340 - W(I) = W(I-1) - IND(I) = IND(I-1) - 300 CONTINUE -C - 320 I = 1 - 340 W(I) = P - IND(I) = TAG - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF IMTQLV ********** - END -C*MODULE EIGEN *DECK JACDG - SUBROUTINE JACDG(A,VEC,EIG,JBIG,BIG,LDVEC,N) -C - IMPLICIT DOUBLE PRECISION(A-H,O-Z) -C - DIMENSION A(*),VEC(LDVEC,N),EIG(N),JBIG(N),BIG(N) -C - PARAMETER (ONE=1.0D+00) -C -C ----- JACOBI DIAGONALIZATION OF SYMMETRIC MATRIX ----- -C SYMMETRIC MATRIX -A- OF DIMENSION -N- IS DESTROYED ON EXIT. -C ALL EIGENVECTORS ARE FOUND, SO -VEC- MUST BE SQUARE, -C UNLESS SOMEONE TAKES THE TROUBLE TO LOOK AT -NMAX- BELOW. -C -BIG- AND -JBIG- ARE SCRATCH WORK ARRAYS. -C - CALL VCLR(VEC,1,LDVEC*N) - DO 20 I = 1,N - VEC(I,I) = ONE - 20 CONTINUE -C - NB1 = N - NB2 = (NB1*NB1+NB1)/2 - NMIN = 1 - NMAX = NB1 -C - CALL JACDIA(A,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) -C - DO 30 I=1,N - EIG(I) = A((I*I+I)/2) - 30 CONTINUE -C - CALL JACORD(VEC,EIG,NB1,LDVEC) - RETURN - END -C*MODULE EIGEN *DECK JACDIA - SUBROUTINE JACDIA(F,VEC,NB1,NB2,LDVEC,NMIN,NMAX,BIG,JBIG) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - LOGICAL GOPARR,DSKWRK,MASWRK - DIMENSION F(NB2),VEC(LDVEC,NB1),BIG(NB1),JBIG(NB1) -C - COMMON /PAR / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK -C - PARAMETER (ROOT2=0.707106781186548D+00 ) - PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, D1050=1.05D+00, - * D1500=1.5D+00, D3875=3.875D+00, - * D0500=0.5D+00, D1375=1.375D+00, D0250=0.25D+00 ) - PARAMETER (C2=1.0D-12, C3=4.0D-16, - * C4=2.0D-16, C5=8.0D-09, C6=3.0D-06 ) -C -C F IS THE MATRIX TO BE DIAGONALIZED, F IS STORED TRIANGULAR -C VEC IS THE ARRAY OF EIGENVECTORS, DIMENSION NB1*NB1 -C BIG AND JBIG ARE TEMPORARY SCRATCH AREAS OF DIMENSION NB1 -C THE ROTATIONS AMONG THE FIRST NMIN BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C THE ROTATIONS AMONG THE LAST NB1-NMAX BASIS FUNCTIONS ARE NOT -C ACCOUNTED FOR. -C - IEAA=0 - IEAB=0 - TT=ZERO - EPS = 64.0D+00*EPSLON(ONE) -C -C LOOP OVER COLUMNS (K) OF TRIANGULAR MATRIX TO DETERMINE -C LARGEST OFF-DIAGONAL ELEMENTS IN ROW(I). -C - DO 20 I=1,NB1 - BIG(I)=ZERO - JBIG(I)=0 - IF(I.LT.NMIN .OR. I.EQ.1) GO TO 20 - II = (I*I-I)/2 - J=MIN(I-1,NMAX) - DO 10 K=1,J - IF(ABS(BIG(I)).GE.ABS(F(II+K))) GO TO 10 - BIG(I)=F(II+K) - JBIG(I)=K - 10 CONTINUE - 20 CONTINUE -C -C ----- 2X2 JACOBI ITERATIONS BEGIN HERE ----- -C - MAXIT=MAX(NB2*20,500) - ITER=0 - 30 CONTINUE - ITER=ITER+1 -C -C FIND SMALLEST DIAGONAL ELEMENT -C - SD=D1050 - JJ=0 - DO 40 J=1,NB1 - JJ=JJ+J - SD= MIN(SD,ABS(F(JJ))) - 40 CONTINUE - TEST = MAX(EPS, C2*MAX(SD,C6)) -C -C FIND LARGEST OFF-DIAGONAL ELEMENT -C - T=ZERO - I1=MAX(2,NMIN) - IB = I1 - DO 50 I=I1,NB1 - IF(T.GE.ABS(BIG(I))) GO TO 50 - T= ABS(BIG(I)) - IB=I - 50 CONTINUE -C -C TEST FOR CONVERGENCE, THEN DETERMINE ROTATION. -C - IF(T.LT.TEST) RETURN -C ****** -C - IF(ITER.GT.MAXIT) THEN - IF (MASWRK) THEN - WRITE(6,*) 'JACOBI DIAGONALIZATION FAILS, DIMENSION=',NB1 - WRITE(6,9020) ITER,T,TEST,SD - ENDIF - CALL ABRT - STOP - END IF -C - IA=JBIG(IB) - IAA=IA*(IA-1)/2 - IBB=IB*(IB-1)/2 - DIF=F(IAA+IA)-F(IBB+IB) - IF(ABS(DIF).GT.C3*T) GO TO 70 - SX=ROOT2 - CX=ROOT2 - GO TO 110 - 70 T2X2=BIG(IB)/DIF - T2X25=T2X2*T2X2 - IF(T2X25 . GT . C4) GO TO 80 - CX=ONE - SX=T2X2 - GO TO 110 - 80 IF(T2X25 . GT . C5) GO TO 90 - SX=T2X2*(ONE-D1500*T2X25) - CX=ONE-D0500*T2X25 - GO TO 110 - 90 IF(T2X25 . GT . C6) GO TO 100 - CX=ONE+T2X25*(T2X25*D1375 - D0500) - SX= T2X2*(ONE + T2X25*(T2X25*D3875 - D1500)) - GO TO 110 - 100 T=D0250 / SQRT(D0250 + T2X25) - CX= SQRT(D0500 + T) - SX= SIGN( SQRT(D0500 - T),T2X2) - 110 IEAR=IAA+1 - IEBR=IBB+1 -C - DO 230 IR=1,NB1 - T=F(IEAR)*SX - F(IEAR)=F(IEAR)*CX+F(IEBR)*SX - F(IEBR)=T-F(IEBR)*CX - IF(IR-IA) 220,120,130 - 120 TT=F(IEBR) - IEAA=IEAR - IEAB=IEBR - F(IEBR)=BIG(IB) - IEAR=IEAR+IR-1 - IF(JBIG(IR)) 200,220,200 - 130 T=F(IEAR) - IT=IA - IEAR=IEAR+IR-1 - IF(IR-IB) 180,150,160 - 150 F(IEAA)=F(IEAA)*CX+F(IEAB)*SX - F(IEAB)=TT*CX+F(IEBR)*SX - F(IEBR)=TT*SX-F(IEBR)*CX - IEBR=IEBR+IR-1 - GO TO 200 - 160 IF( ABS(T) . GE . ABS(F(IEBR))) GO TO 170 - IF(IB.GT.NMAX) GO TO 170 - T=F(IEBR) - IT=IB - 170 IEBR=IEBR+IR-1 - 180 IF( ABS(T) . LT . ABS(BIG(IR))) GO TO 190 - BIG(IR) = T - JBIG(IR) = IT - GO TO 220 - 190 IF(IA . NE . JBIG(IR) . AND . IB . NE . JBIG(IR)) GO TO 220 - 200 KQ=IEAR-IR-IA+1 - BIG(IR)=ZERO - IR1=MIN(IR-1,NMAX) - DO 210 I=1,IR1 - K=KQ+I - IF(ABS(BIG(IR)) . GE . ABS(F(K))) GO TO 210 - BIG(IR) = F(K) - JBIG(IR)=I - 210 CONTINUE - 220 IEAR=IEAR+1 - 230 IEBR=IEBR+1 -C - DO 240 I=1,NB1 - T1=VEC(I,IA)*CX + VEC(I,IB)*SX - T2=VEC(I,IA)*SX - VEC(I,IB)*CX - VEC(I,IA)=T1 - VEC(I,IB)=T2 - 240 CONTINUE - GO TO 30 -C - 9020 FORMAT(1X,'ITER=',I6,' T,TEST,SD=',1P,3E20.10) - END -C*MODULE EIGEN *DECK JACORD - SUBROUTINE JACORD(VEC,EIG,N,LDVEC) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION VEC(LDVEC,N),EIG(N) -C -C ---- SORT EIGENDATA INTO ASCENDING ORDER ----- -C - DO 290 I = 1, N - JJ = I - DO 270 J = I, N - IF (EIG(J) .LT. EIG(JJ)) JJ = J - 270 CONTINUE - IF (JJ .EQ. I) GO TO 290 - T = EIG(JJ) - EIG(JJ) = EIG(I) - EIG(I) = T - DO 280 J = 1, N - T = VEC(J,JJ) - VEC(J,JJ) = VEC(J,I) - VEC(J,I) = T - 280 CONTINUE - 290 CONTINUE - RETURN - END -C*MODULE EIGEN *DECK TINVTB - SUBROUTINE TINVTB(NM,N,D,E,E2,M,W,IND,Z, - * IERR,RV1,RV2,RV3,RV4,RV6) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION D(N),E(N),E2(N),W(M),Z(NM,M), - * RV1(N),RV2(N),RV3(N),RV4(N),RV6(N),IND(M) - DOUBLE PRECISION MACHEP,NORM - INTEGER P,Q,R,S,TAG,GROUP -C ------------------------------------------------------------------ -C -C THIS ROUTINE IS A TRANSLATION OF THE INVERSE ITERATION TECH- -C NIQUE IN THE ALGOL PROCEDURE TRISTURM BY PETERS AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 418-439(1971). -C -C THIS ROUTINE FINDS THOSE EIGENVECTORS OF A TRIDIAGONAL -C SYMMETRIC MATRIX CORRESPONDING TO SPECIFIED EIGENVALUES, -C USING INVERSE ITERATION. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E, -C WITH ZEROS CORRESPONDING TO NEGLIGIBLE ELEMENTS OF E. -C E(I) IS CONSIDERED NEGLIGIBLE IF IT IS NOT LARGER THAN -C THE PRODUCT OF THE RELATIVE MACHINE PRECISION AND THE SUM -C OF THE MAGNITUDES OF D(I) AND D(I-1). E2(1) MUST CONTAIN -C 0.0 IF THE EIGENVALUES ARE IN ASCENDING ORDER, OR 2.0 -C IF THE EIGENVALUES ARE IN DESCENDING ORDER. IF BISECT, -C TRIDIB, OR IMTQLV HAS BEEN USED TO FIND THE EIGENVALUES, -C THEIR OUTPUT E2 ARRAY IS EXACTLY WHAT IS EXPECTED HERE, -C -C M IS THE NUMBER OF SPECIFIED EIGENVALUES, -C -C W CONTAINS THE M EIGENVALUES IN ASCENDING OR DESCENDING ORDER, -C -C IND CONTAINS IN ITS FIRST M POSITIONS THE SUBMATRIX INDICES -C ASSOCIATED WITH THE CORRESPONDING EIGENVALUES IN W -- -C 1 FOR EIGENVALUES BELONGING TO THE FIRST SUBMATRIX FROM -C THE TOP, 2 FOR THOSE BELONGING TO THE SECOND SUBMATRIX, ETC. -C -C ON OUTPUT- -C -C ALL INPUT ARRAYS ARE UNALTERED, -C -C Z CONTAINS THE ASSOCIATED SET OF ORTHONORMAL EIGENVECTORS. -C ANY VECTOR WHICH FAILS TO CONVERGE IS SET TO ZERO, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C -R IF THE EIGENVECTOR CORRESPONDING TO THE R-TH -C EIGENVALUE FAILS TO CONVERGE IN 5 ITERATIONS, -C -C RV1, RV2, RV3, RV4, AND RV6 ARE TEMPORARY STORAGE ARRAYS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (M .EQ. 0) GO TO 680 - TAG = 0 - ORDER = 1.0D+00 - E2(1) - XU = 0.0D+00 - UK = 0.0D+00 - X0 = 0.0D+00 - U = 0.0D+00 - EPS2 = 0.0D+00 - EPS3 = 0.0D+00 - EPS4 = 0.0D+00 - GROUP = 0 - Q = 0 -C ********** ESTABLISH AND PROCESS NEXT SUBMATRIX ********** - 100 P = Q + 1 - IP = P + 1 -C - DO 120 Q = P, N - IF (Q .EQ. N) GO TO 140 - IF (E2(Q+1) .EQ. 0.0D+00) GO TO 140 - 120 CONTINUE -C ********** FIND VECTORS BY INVERSE ITERATION ********** - 140 TAG = TAG + 1 - IQMP = Q - P + 1 - S = 0 -C - DO 660 R = 1, M - IF (IND(R) .NE. TAG) GO TO 660 - ITS = 1 - X1 = W(R) - IF (S .NE. 0) GO TO 220 -C ********** CHECK FOR ISOLATED ROOT ********** - XU = 1.0D+00 - IF (P .NE. Q) GO TO 160 - RV6(P) = 1.0D+00 - GO TO 600 - 160 NORM = ABS(D(P)) -C - DO 180 I = IP, Q - 180 NORM = NORM + ABS(D(I)) + ABS(E(I)) -C ********** EPS2 IS THE CRITERION FOR GROUPING, -C EPS3 REPLACES ZERO PIVOTS AND EQUAL -C ROOTS ARE MODIFIED BY EPS3, -C EPS4 IS TAKEN VERY SMALL TO AVOID OVERFLOW ********** - EPS2 = 1.0D-03 * NORM - EPS3 = MACHEP * NORM - UK = IQMP - EPS4 = UK * EPS3 - UK = EPS4 / SQRT(UK) - S = P - 200 GROUP = 0 - GO TO 240 -C ********** LOOK FOR CLOSE OR COINCIDENT ROOTS ********** - 220 IF (ABS(X1-X0) .GE. EPS2) GO TO 200 - GROUP = GROUP + 1 - IF (ORDER * (X1 - X0) .LE. 0.0D+00) X1 = X0 + ORDER * EPS3 -C ********** ELIMINATION WITH INTERCHANGES AND -C INITIALIZATION OF VECTOR ********** - 240 V = 0.0D+00 -C - DO 300 I = P, Q - RV6(I) = UK - IF (I .EQ. P) GO TO 280 - IF (ABS(E(I)) .LT. ABS(U)) GO TO 260 -C ********** WARNING -- A DIVIDE CHECK MAY OCCUR HERE IF -C E2 ARRAY HAS NOT BEEN SPECIFIED CORRECTLY ********** - XU = U / E(I) - RV4(I) = XU - RV1(I-1) = E(I) - RV2(I-1) = D(I) - X1 - RV3(I-1) = 0.0D+00 - IF (I .NE. Q) RV3(I-1) = E(I+1) - U = V - XU * RV2(I-1) - V = -XU * RV3(I-1) - GO TO 300 - 260 XU = E(I) / U - RV4(I) = XU - RV1(I-1) = U - RV2(I-1) = V - RV3(I-1) = 0.0D+00 - 280 U = D(I) - X1 - XU * V - IF (I .NE. Q) V = E(I+1) - 300 CONTINUE -C - IF (U .EQ. 0.0D+00) U = EPS3 - RV1(Q) = U - RV2(Q) = 0.0D+00 - RV3(Q) = 0.0D+00 -C ********** BACK SUBSTITUTION -C FOR I=Q STEP -1 UNTIL P DO -- ********** - 320 DO 340 II = P, Q - I = P + Q - II - RV6(I) = (RV6(I) - U * RV2(I) - V * RV3(I)) / RV1(I) - V = U - U = RV6(I) - 340 CONTINUE -C ********** ORTHOGONALIZE WITH RESPECT TO PREVIOUS -C MEMBERS OF GROUP ********** - IF (GROUP .EQ. 0) GO TO 400 - J = R -C - DO 380 JJ = 1, GROUP - 360 J = J - 1 - IF (IND(J) .NE. TAG) GO TO 360 - XU = DDOT(IQMP,RV6(P),1,Z(P,J),1) -C - CALL DAXPY(IQMP,-XU,Z(P,J),1,RV6(P),1) -C - 380 CONTINUE -C - 400 NORM = 0.0D+00 -C - DO 420 I = P, Q - 420 NORM = NORM + ABS(RV6(I)) -C - IF (NORM .GE. 1.0D+00) GO TO 560 -C ********** FORWARD SUBSTITUTION ********** - IF (ITS .EQ. 5) GO TO 540 - IF (NORM .NE. 0.0D+00) GO TO 440 - RV6(S) = EPS4 - S = S + 1 - IF (S .GT. Q) S = P - GO TO 480 - 440 XU = EPS4 / NORM -C - DO 460 I = P, Q - 460 RV6(I) = RV6(I) * XU -C ********** ELIMINATION OPERATIONS ON NEXT VECTOR -C ITERATE ********** - 480 DO 520 I = IP, Q - U = RV6(I) -C ********** IF RV1(I-1) .EQ. E(I), A ROW INTERCHANGE -C WAS PERFORMED EARLIER IN THE -C TRIANGULARIZATION PROCESS ********** - IF (RV1(I-1) .NE. E(I)) GO TO 500 - U = RV6(I-1) - RV6(I-1) = RV6(I) - 500 RV6(I) = U - RV4(I) * RV6(I-1) - 520 CONTINUE -C - ITS = ITS + 1 - GO TO 320 -C ********** SET ERROR -- NON-CONVERGED EIGENVECTOR ********** - 540 IERR = -R - XU = 0.0D+00 - GO TO 600 -C ********** NORMALIZE SO THAT SUM OF SQUARES IS -C 1 AND EXPAND TO FULL ORDER ********** - 560 U = 0.0D+00 -C - DO 580 I = P, Q - RV6(I) = RV6(I) / NORM - 580 U = U + RV6(I)**2 -C - XU = 1.0D+00 / SQRT(U) -C - 600 DO 620 I = 1, N - 620 Z(I,R) = 0.0D+00 -C - DO 640 I = P, Q - 640 Z(I,R) = RV6(I) * XU -C - X0 = X1 - 660 CONTINUE -C - IF (Q .LT. N) GO TO 100 - 680 RETURN -C ********** LAST CARD OF TINVIT ********** - END -C*MODULE EIGEN *DECK TQL2 -C -C ------------------------------------------------------------------ -C - SUBROUTINE TQL2(NM,N,D,E,Z,IERR) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DOUBLE PRECISION MACHEP - DIMENSION D(N),E(N),Z(NM,N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TQL2, -C NUM. MATH. 11, 293-306(1968) BY BOWDLER, MARTIN, REINSCH, AND -C WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971). -C -C THIS ROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS -C OF A SYMMETRIC TRIDIAGONAL MATRIX BY THE QL METHOD. -C THE EIGENVECTORS OF A FULL SYMMETRIC MATRIX CAN ALSO -C BE FOUND IF TRED2 HAS BEEN USED TO REDUCE THIS -C FULL MATRIX TO TRIDIAGONAL FORM. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE INPUT MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE INPUT MATRIX -C IN ITS LAST N-1 POSITIONS. E(1) IS ARBITRARY, -C -C Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE -C REDUCTION BY TRED2, IF PERFORMED. IF THE EIGENVECTORS -C OF THE TRIDIAGONAL MATRIX ARE DESIRED, Z MUST CONTAIN -C THE IDENTITY MATRIX. -C -C ON OUTPUT- -C -C D CONTAINS THE EIGENVALUES IN ASCENDING ORDER. IF AN -C ERROR EXIT IS MADE, THE EIGENVALUES ARE CORRECT BUT -C UNORDERED FOR INDICES 1,2,...,IERR-1, -C -C E HAS BEEN DESTROYED, -C -C Z CONTAINS ORTHONORMAL EIGENVECTORS OF THE SYMMETRIC -C TRIDIAGONAL (OR FULL) MATRIX. IF AN ERROR EXIT IS MADE, -C Z CONTAINS THE EIGENVECTORS ASSOCIATED WITH THE STORED -C EIGENVALUES, -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE J-TH EIGENVALUE HAS NOT BEEN -C DETERMINED AFTER 30 ITERATIONS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** MACHEP IS A MACHINE DEPENDENT PARAMETER SPECIFYING -C THE RELATIVE PRECISION OF FLOATING POINT ARITHMETIC. -C -C ********** - MACHEP = 2.0D+00**(-50) -C - IERR = 0 - IF (N .EQ. 1) GO TO 400 -C - DO 100 I = 2, N - 100 E(I-1) = E(I) -C - F = 0.0D+00 - B = 0.0D+00 - E(N) = 0.0D+00 -C - DO 300 L = 1, N - J = 0 - H = MACHEP * (ABS(D(L)) + ABS(E(L))) - IF (B .LT. H) B = H -C ********** LOOK FOR SMALL SUB-DIAGONAL ELEMENT ********** - DO 120 M = L, N - IF (ABS(E(M)) .LE. B) GO TO 140 -C ********** E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT -C THROUGH THE BOTTOM OF THE LOOP ********** - 120 CONTINUE -C - 140 IF (M .EQ. L) GO TO 280 - 160 IF (J .EQ. 30) GO TO 380 - J = J + 1 -C ********** FORM SHIFT ********** - L1 = L + 1 - G = D(L) - P = (D(L1) - G) / (2.0D+00 * E(L)) - R = SQRT(P*P+1.0D+00) - D(L) = E(L) / (P + SIGN(R,P)) - H = G - D(L) -C - DO 180 I = L1, N - 180 D(I) = D(I) - H -C - F = F + H -C ********** QL TRANSFORMATION ********** - P = D(M) - C = 1.0D+00 - S = 0.0D+00 - MML = M - L -C ********** FOR I=M-1 STEP -1 UNTIL L DO -- ********** - DO 260 II = 1, MML - I = M - II - G = C * E(I) - H = C * P - IF (ABS(P) .LT. ABS(E(I))) GO TO 200 - C = E(I) / P - R = SQRT(C*C+1.0D+00) - E(I+1) = S * P * R - S = C / R - C = 1.0D+00 / R - GO TO 220 - 200 C = P / E(I) - R = SQRT(C*C+1.0D+00) - E(I+1) = S * E(I) * R - S = 1.0D+00 / R - C = C * S - 220 P = C * D(I) - S * G - D(I+1) = H + S * (C * G + S * D(I)) -C ********** FORM VECTOR ********** - CALL DROT(N,Z(1,I+1),1,Z(1,I),1,C,S) -C - 260 CONTINUE -C - E(L) = S * P - D(L) = C * P - IF (ABS(E(L)) .GT. B) GO TO 160 - 280 D(L) = D(L) + F - 300 CONTINUE -C ********** ORDER EIGENVALUES AND EIGENVECTORS ********** - DO 360 II = 2, N - I = II - 1 - K = I - P = D(I) -C - DO 320 J = II, N - IF (D(J) .GE. P) GO TO 320 - K = J - P = D(J) - 320 CONTINUE -C - IF (K .EQ. I) GO TO 360 - D(K) = D(I) - D(I) = P -C - CALL DSWAP(N,Z(1,I),1,Z(1,K),1) -C - 360 CONTINUE -C - GO TO 400 -C ********** SET ERROR -- NO CONVERGENCE TO AN -C EIGENVALUE AFTER 30 ITERATIONS ********** - 380 IERR = L - 400 RETURN -C ********** LAST CARD OF TQL2 ********** - END -C*MODULE EIGEN *DECK TRBK3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRBK3B(NM,N,NV,A,M,Z) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),Z(NM,M) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC -C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY TRED3B. -C -C ON INPUT- -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING ROUTINE -C DIMENSION STATEMENT, -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANSFORMATIONS -C USED IN THE REDUCTION BY TRED3B IN ITS FIRST -C N*(N+1)/2 POSITIONS, -C -C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED, -C -C Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED -C IN ITS FIRST M COLUMNS. -C -C ON OUTPUT- -C -C Z CONTAINS THE TRANSFORMED EIGENVECTORS -C IN ITS FIRST M COLUMNS. -C -C NOTE THAT TRBAK3 PRESERVES VECTOR EUCLIDEAN NORMS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C - IF (M .EQ. 0) GO TO 140 - IF (N .EQ. 1) GO TO 140 -C - DO 120 I = 2, N - L = I - 1 - IZ = (I * L) / 2 - IK = IZ + I - H = A(IK) - IF (H .EQ. 0.0D+00) GO TO 120 -C - DO 100 J = 1, M - S = -DDOT(L,A(IZ+1),1,Z(1,J),1) -C -C ********** DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW ********** - S = (S / H) / H -C - CALL DAXPY(L,S,A(IZ+1),1,Z(1,J),1) -C - 100 CONTINUE -C - 120 CONTINUE -C - 140 RETURN -C ********** LAST CARD OF TRBAK3 ********** - END -C*MODULE EIGEN *DECK TRED3B -C -C ------------------------------------------------------------------ -C - SUBROUTINE TRED3B(N,NV,A,D,E,E2) - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - DIMENSION A(NV),D(N),E(N),E2(N) -C -C THIS ROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRED3, -C NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). -C -C THIS ROUTINE REDUCES A REAL SYMMETRIC MATRIX, STORED AS -C A ONE-DIMENSIONAL ARRAY, TO A SYMMETRIC TRIDIAGONAL MATRIX -C USING ORTHOGONAL SIMILARITY TRANSFORMATIONS. -C -C ON INPUT- -C -C N IS THE ORDER OF THE MATRIX, -C -C NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A -C AS DECLARED IN THE CALLING ROUTINE DIMENSION STATEMENT, -C -C A CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC -C INPUT MATRIX, STORED ROW-WISE AS A ONE-DIMENSIONAL -C ARRAY, IN ITS FIRST N*(N+1)/2 POSITIONS. -C -C ON OUTPUT- -C -C A CONTAINS INFORMATION ABOUT THE ORTHOGONAL -C TRANSFORMATIONS USED IN THE REDUCTION, -C -C D CONTAINS THE DIAGONAL ELEMENTS OF THE TRIDIAGONAL MATRIX, -C -C E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE TRIDIAGONAL -C MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS SET TO ZERO, -C -C E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. -C E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO B. S. GARBOW, -C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY -C -C ------------------------------------------------------------------ -C -C ********** FOR I=N STEP -1 UNTIL 1 DO -- ********** - DO 300 II = 1, N - I = N + 1 - II - L = I - 1 - IZ = (I * L) / 2 - H = 0.0D+00 - SCALE = 0.0D+00 - IF (L .LT. 1) GO TO 120 -C ********** SCALE ROW (ALGOL TOL THEN NOT NEEDED) ********** - DO 100 K = 1, L - IZ = IZ + 1 - D(K) = A(IZ) - SCALE = SCALE + ABS(D(K)) - 100 CONTINUE -C - IF (SCALE .NE. 0.0D+00) GO TO 140 - 120 E(I) = 0.0D+00 - E2(I) = 0.0D+00 - GO TO 280 -C - 140 DO 160 K = 1, L - D(K) = D(K) / SCALE - H = H + D(K) * D(K) - 160 CONTINUE -C - E2(I) = SCALE * SCALE * H - F = D(L) - G = -SIGN(SQRT(H),F) - E(I) = SCALE * G - H = H - F * G - D(L) = F - G - A(IZ) = SCALE * D(L) - IF (L .EQ. 1) GO TO 280 - F = 0.0D+00 -C - JK = 1 - DO 220 J = 1, L - JM1 = J - 1 - DT = D(J) - G = 0.0D+00 -C ********** FORM ELEMENT OF A*U ********** - IF (JM1 .EQ. 0) GO TO 200 - DO 180 K = 1, JM1 - E(K) = E(K) + DT * A(JK) - G = G + D(K) * A(JK) - JK = JK + 1 - 180 CONTINUE - 200 E(J) = G + A(JK) * DT - JK = JK + 1 -C ********** FORM ELEMENT OF P ********** - 220 CONTINUE - F = 0.0D+00 - DO 240 J = 1, L - E(J) = E(J) / H - F = F + E(J) * D(J) - 240 CONTINUE -C - HH = F / (H + H) - JK = 0 -C ********** FORM REDUCED A ********** - DO 260 J = 1, L - F = D(J) - G = E(J) - HH * F - E(J) = G -C - DO 260 K = 1, J - JK = JK + 1 - A(JK) = A(JK) - F * E(K) - G * D(K) - 260 CONTINUE -C - 280 D(I) = A(IZ+1) - A(IZ+1) = SCALE * SQRT(H) - 300 CONTINUE -C - RETURN -C ********** LAST CARD OF TRED3 ********** - END diff --git a/source/unres/src_MD-restraints/elecont.f b/source/unres/src_MD-restraints/elecont.f deleted file mode 100644 index e9ed067..0000000 --- a/source/unres/src_MD-restraints/elecont.f +++ /dev/null @@ -1,509 +0,0 @@ - subroutine elecont(lprint,ncont,icont) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - logical lprint - double precision elpp_6(2,2),elpp_3(2,2),ael6_(2,2),ael3_(2,2) - double precision app_(2,2),bpp_(2,2),rpp_(2,2) - integer ncont,icont(2,maxcont) - double precision econt(maxcont) -* -* Load the constants of peptide bond - peptide bond interactions. -* Type 1 - ordinary peptide bond, type 2 - alkylated peptide bond (e.g. -* proline) - determined by averaging ECEPP energy. -* -* as of 7/06/91. -* -c data epp / 0.3045d0, 0.3649d0, 0.3649d0, 0.5743d0/ - data rpp_ / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ - data elpp_6 /-0.2379d0,-0.2056d0,-0.2056d0,-0.0610d0/ - data elpp_3 / 0.0503d0, 0.0000d0, 0.0000d0, 0.0692d0/ - data elcutoff /-0.3d0/,elecutoff_14 /-0.5d0/ - if (lprint) write (iout,'(a)') - & "Constants of electrostatic interaction energy expression." - do i=1,2 - do j=1,2 - rri=rpp_(i,j)**6 - app_(i,j)=epp(i,j)*rri*rri - bpp_(i,j)=-2.0*epp(i,j)*rri - ael6_(i,j)=elpp_6(i,j)*4.2**6 - ael3_(i,j)=elpp_3(i,j)*4.2**3 - if (lprint) - & write (iout,'(2i2,4e15.4)') i,j,app_(i,j),bpp_(i,j),ael6_(i,j), - & ael3_(i,j) - enddo - enddo - ncont=0 - ees=0.0 - evdw=0.0 - do 1 i=nnt,nct-2 - xi=c(1,i) - yi=c(2,i) - zi=c(3,i) - dxi=c(1,i+1)-c(1,i) - dyi=c(2,i+1)-c(2,i) - dzi=c(3,i+1)-c(3,i) - xmedi=xi+0.5*dxi - ymedi=yi+0.5*dyi - zmedi=zi+0.5*dzi - do 4 j=i+2,nct-1 - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - if (iteli.eq.2 .and. itelj.eq.2) goto 4 - aaa=app_(iteli,itelj) - bbb=bpp_(iteli,itelj) - ael6_i=ael6_(iteli,itelj) - ael3_i=ael3_(iteli,itelj) - dxj=c(1,j+1)-c(1,j) - dyj=c(2,j+1)-c(2,j) - dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi - rrmij=1.0/(xj*xj+yj*yj+zj*zj) - rmij=sqrt(rrmij) - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - vrmij=vblinv*rmij - cosa=(dxi*dxj+dyi*dyj+dzi*dzj)*vblinv2 - cosb=(xj*dxi+yj*dyi+zj*dzi)*vrmij - cosg=(xj*dxj+yj*dyj+zj*dzj)*vrmij - fac=cosa-3.0*cosb*cosg - ev1=aaa*r6ij*r6ij - ev2=bbb*r6ij - fac3=ael6_i*r6ij - fac4=ael3_i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0+fac*fac-3.0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 - if (j.gt.i+2 .and. eesij.le.elcutoff .or. - & j.eq.i+2 .and. eesij.le.elecutoff_14) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - econt(ncont)=eesij - endif - ees=ees+eesij - evdw=evdw+evdwij - 4 continue - 1 continue - if (lprint) then - write (iout,*) 'Total average electrostatic energy: ',ees - write (iout,*) 'VDW energy between peptide-group centers: ',evdw - write (iout,*) - write (iout,*) 'Electrostatic contacts before pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif -c For given residues keep only the contacts with the greatest energy. - i=0 - do while (i.lt.ncont) - i=i+1 - ene=econt(i) - ic1=icont(1,i) - ic2=icont(2,i) - j=i - do while (j.lt.ncont) - j=j+1 - if (ic1.eq.icont(1,j).and.iabs(icont(2,j)-ic2).le.2 .or. - & ic2.eq.icont(2,j).and.iabs(icont(1,j)-ic1).le.2) then -c write (iout,*) "i",i," j",j," ic1",ic1," ic2",ic2, -c & " jc1",icont(1,j)," jc2",icont(2,j)," ncont",ncont - if (econt(j).lt.ene .and. icont(2,j).ne.icont(1,j)+2) then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.icont(2,j) - & .and. iabs(icont(1,k)-ic1).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.icont(1,j) - & .and. iabs(icont(2,k)-ic2).le.2 .and. - & econt(k).lt.econt(j) ) goto 21 - enddo - endif -c Remove ith contact - do k=i+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - i=i-1 - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - goto 20 - else if (econt(j).gt.ene .and. ic2.ne.ic1+2) - & then - if (ic1.eq.icont(1,j)) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(2,k).eq.ic2 - & .and. iabs(icont(1,k)-icont(1,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - else if (ic2.eq.icont(2,j) ) then - do k=1,ncont - if (k.ne.i .and. k.ne.j .and. icont(1,k).eq.ic1 - & .and. iabs(icont(2,k)-icont(2,j)).le.2 .and. - & econt(k).lt.econt(i) ) goto 21 - enddo - endif -c Remove jth contact - do k=j+1,ncont - icont(1,k-1)=icont(1,k) - icont(2,k-1)=icont(2,k) - econt(k-1)=econt(k) - enddo - ncont=ncont-1 -c write (iout,*) "ncont",ncont -c do k=1,ncont -c write (iout,*) icont(1,k),icont(2,k) -c enddo - j=j-1 - endif - endif - 21 continue - enddo - 20 continue - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Electrostatic contacts after pruning: ' - do i=1,ncont - i1=icont(1,i) - i2=icont(2,i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(i3,2x,a,i4,2x,a,i4,f10.5)') - & i,restyp(it1),i1,restyp(it2),i2,econt(i) - enddo - endif - return - end -c-------------------------------------------- - subroutine secondary2(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - integer ncont,icont(2,maxcont),isec(maxres,4),nsec(maxres) - logical lprint,not_done,freeres - double precision p1,p2 - external freeres - - if(.not.dccart) call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - nsec(i)=0 - enddo - - call elecont(lprint,ncont,icont) - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(j1-i1.gt.5 .and. freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,'(a,i3,4i4)')'parallel beta', - & nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1+1 - bfrag(2,nbfrag)=i1+1 - bfrag(3,nbfrag)=jj1+1 - bfrag(4,nbfrag)=min0(j1+1,nres) - - do ij=ii1,i1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - do ij=jj1,j1 - nsec(ij)=nsec(ij)+1 - isec(ij,nsec(ij))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - p1=phi(i1+2)*rad2deg - p2=0.0 - if (j1+2.le.nres) p2=phi(j1+2)*rad2deg - - - if (j1.eq.i1+3 .and. - & ((p1.ge.10.and.p1.le.80).or.i1.le.2).and. - & ((p2.ge.10.and.p2.le.80).or.j1.le.2.or.j1.ge.nres-3) )then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,p1,p2 -co if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,p1,p2 - ii1=i1 - jj1=j1 - if (nsec(ii1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue - p1=phi(i1+2)*rad2deg - p2=phi(j1+2)*rad2deg - if (p1.lt.10.or.p1.gt.80.or.p2.lt.10.or.p2.gt.80) - & not_done=.false. -cd write (iout,*) i1,j1,not_done,p1,p2 - enddo - j1=j1+1 - if (j1-ii1.gt.5) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=j1 - - do ij=ii1,j1 - nsec(ij)=-1 - enddo - if (lprint) then - write (iout,'(a,i3,2i4)') "Helix",nhelix,ii1-1,j1-1 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (freeres(i1,j1,nsec,isec)) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1 - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & freeres(i1,j1,nsec,isec)) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=min0(i1+1,nres) - bfrag(3,nbfrag)=min0(jj1+1,nres) - bfrag(4,nbfrag)=j1 - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2) then - isec(ij,nsec(ij))=nbeta - endif - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - nsec(ij)=nsec(ij)+1 - if (nsec(ij).le.2 .and. nsec(ij).gt.0) then - isec(ij,nsec(ij))=nbeta - endif - enddo - - - if (lprint) then - write (iout,'(a,i3,4i4)')'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - - - write(iout,*) 'UNRES seq:' - do j=1,nbfrag - write(iout,*) 'beta ',(bfrag(i,j),i=1,4) - enddo - - do j=1,nhfrag - write(iout,*) 'helix ',(hfrag(i,j),i=1,2) - enddo - endif - - return - end -c------------------------------------------------- - logical function freeres(i,j,nsec,isec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer isec(maxres,4),nsec(maxres) - freeres=.false. - - if (nsec(i).lt.0.or.nsec(j).lt.0) return - if (nsec(i).gt.1.or.nsec(j).gt.1) return - do k=1,nsec(i) - do l=1,nsec(j) - if (isec(i,k).eq.isec(j,l)) return - enddo - enddo - freeres=.true. - return - end - diff --git a/source/unres/src_MD-restraints/energy_p_new-sep_barrier.F b/source/unres/src_MD-restraints/energy_p_new-sep_barrier.F deleted file mode 100644 index c89aee2..0000000 --- a/source/unres/src_MD-restraints/energy_p_new-sep_barrier.F +++ /dev/null @@ -1,2322 +0,0 @@ -C----------------------------------------------------------------------- - double precision function sscale(r) - double precision r,gamm - include "COMMON.SPLITELE" - if(r.lt.r_cut-rlamb) then - sscale=1.0d0 - else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then - gamm=(r-(r_cut-rlamb))/rlamb - sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) - else - sscale=0d0 - endif - return - end -C----------------------------------------------------------------------- - subroutine elj_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------- - subroutine elj_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - rrij=1.0D0/rij - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij)*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time, the factor of EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine eljk_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.lt.1.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+(1.0d0-sss)*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*(1.0d0-sss) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine eljk_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJK potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - dimension gg(3) - logical scheck -c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - r_inv_ij=dsqrt(rrij) - rij=1.0D0/r_inv_ij - sss=sscale(rij/sigma(itypi,itypj)) - if (sss.gt.0.0d0) then - r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) - fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e_augm+e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, -cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - evdw=evdw+sss*evdwij -C -C Calculate the components of the gradient in DC and X -C - fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) - fac=fac*sss - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - endif - enddo ! j - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc(j,i)=expon*gvdwc(j,i) - gvdwx(j,i)=expon*gvdwx(j,i) - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine ebp_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine ebp_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Berne-Pechukas potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall -c double precision rrsave(maxdim) - logical lprn - evdw=0.0D0 -c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 -c if (icall.eq.0) then -c lprn=.true. -c else - lprn=.false. -c endif - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate the angle-dependent terms of energy & contributions to derivatives. - call sc_angular -C Calculate whole angle-dependent part of epsilon and contributions -C to its derivatives - fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), -cd & om1,om2,om12,1.0D0/dsqrt(rrij), -cd & evdwij - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij) - sigder=fac/sigsq - fac=rrij*fac -C Calculate radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate the angular part of the gradient and sum add the contributions -C to the appropriate components of the Cartesian gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i -c stop - return - end -C----------------------------------------------------------------------------- - subroutine egb_long(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*(1.0d0-sss) - else - evdw_m=evdw_m+evdwij*(1.0d0-sss) - endif -#else - evdw=evdw+evdwij*(1.0d0-sss) -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(1.0d0-sss) - else - call sc_grad_scale(1.0d0-sss) - endif -#else - call sc_grad_scale(1.0d0-sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egb_short(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 - evdw_p=0.0D0 - evdw_m=0.0D0 -ccccc energy_dec=.false. -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.false. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) -c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c & 1.0d0/vbld(j+nres) -c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -c for diagnostics; uncomment -c rij_shift=1.2*sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt -c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 - evdwij=evdwij*eps2rt*eps3rt -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij*sss - else - evdw_m=evdw_m+evdwij*sss - endif -#else - evdw=evdw+evdwij*sss -#endif - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -c fac=0.0d0 -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - call sc_grad_scale_T(sss) - else - call sc_grad_scale(sss) - endif -#else - call sc_grad_scale(sss) -#endif - endif - enddo ! j - enddo ! iint - enddo ! i -c write (iout,*) "Number of loop steps in EGB:",ind -cccc energy_dec=.false. - return - end -C----------------------------------------------------------------------------- - subroutine egbv_long(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.lt.1.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*(1.0d0-sss) - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(1.0d0-sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- - subroutine egbv_short(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne-Vorobjev potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - common /srutu/ icall - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(j+nres) - sig0ij=sigma(itypi,itypj) - r0ij=r0(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - - sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) - - if (sss.gt.0.0d0) then - -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+r0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - fac_augm=rrij**expon - e_augm=augm(itypi,itypj)*fac_augm - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+(evdwij+e_augm)*sss - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) - write (iout,'(2(a3,i3,2x),17(0pf7.3))') - & restyp(itypi),i,restyp(itypj),j, - & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), - & chi1,chi2,chip1,chip2, - & eps1,eps2rt**2,eps3rt**2, - & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, - & evdwij+e_augm - endif -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad_scale(sss) - endif - enddo ! j - enddo ! iint - enddo ! i - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - return - end -C---------------------------------------------------------------------------- - subroutine sc_grad_scale_T(scalfac) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.CALC' - include 'COMMON.IOUNITS' - double precision dcosom1(3),dcosom2(3) - double precision scalfac - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 -c diagnostics only -c eom1=0.0d0 -c eom2=0.0d0 -c eom12=evdwij*eps1_om12 -c end diagnostics -c write (iout,*) "eps2der",eps2der," eps3der",eps3der, -c & " sigder",sigder -c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 -c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac - enddo -c write (iout,*) "gg",(gg(k),k=1,3) - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac -c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) -c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv -c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) -c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -C -C Calculate the components of the gradient in DC and X -C - do l=1,3 - gvdwcT(l,i)=gvdwcT(l,i)-gg(l) - gvdwcT(l,j)=gvdwcT(l,j)+gg(l) - enddo - return - end - -C-------------------------------------------------------------------------- - subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C -C This subroutine calculates the average interaction energy and its gradient -C in the virtual-bond vectors between non-adjacent peptide groups, based on -C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. -C The potential depends both on the distance of peptide-group centers and on -C the orientation of the CA-CA virtual bonds. -C - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -cd write(iout,*) 'In EELEC' -cd do i=1,nloctyp -cd write(iout,*) 'Type',i -cd write(iout,*) 'B1',B1(:,i) -cd write(iout,*) 'B2',B2(:,i) -cd write(iout,*) 'CC',CC(:,:,i) -cd write(iout,*) 'DD',DD(:,:,i) -cd write(iout,*) 'EE',EE(:,:,i) -cd enddo -cd call check_vecgrad -cd stop - if (icheckgrad.eq.1) then - do i=1,nres-1 - fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) - do k=1,3 - dc_norm(k,i)=dc(k,i)*fac - enddo -c write (iout,*) 'i',i,' fac',fac - enddo - endif - if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. - & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -c call vec_and_deriv -#ifdef TIMING - time01=MPI_Wtime() -#endif - call set_matrices -#ifdef TIMING - time_mat=time_mat+MPI_Wtime()-time01 -#endif - endif -cd do i=1,nres-1 -cd write (iout,*) 'i=',i -cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) -cd enddo -cd do k=1,3 -cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') -cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) -cd enddo -cd enddo - t_eelecij=0.0d0 - ees=0.0D0 - evdw1=0.0D0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - ind=0 - do i=1,nres - num_cont_hb(i)=0 - enddo -cd print '(a)','Enter EELEC' -cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - enddo -c -c -c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms -C -C Loop over i,i+2 and i,i+3 pairs of the peptide groups -C - do i=iturn3_start,iturn3_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 - call eelecij_scale(i,i+2,ees,evdw1,eel_loc) - if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) - num_cont_hb(i)=num_conti - enddo - do i=iturn4_start,iturn4_end - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=num_cont_hb(i) - call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) - num_cont_hb(i)=num_conti - enddo ! i -c -c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 -c - do i=iatel_s,iatel_e - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi -c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) - num_conti=num_cont_hb(i) - do j=ielstart(i),ielend(i) - call eelecij_scale(i,j,ees,evdw1,eel_loc) - enddo ! j - num_cont_hb(i)=num_conti - enddo ! i -c write (iout,*) "Number of loop steps in EELEC:",ind -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 -cd print *,"Processor",fg_rank," t_eelecij",t_eelecij - return - end -C------------------------------------------------------------------------------- - subroutine eelecij_scale(i,j,ees,evdw1,eel_loc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - include 'COMMON.TIME1' - dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), - & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) - double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, - & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, - & num_conti,j1,j2 -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif -C 12/13/98 -C 13-go grudnia roku pamietnego... - double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, - & 0.0d0,1.0d0,0.0d0, - & 0.0d0,0.0d0,1.0d0/ -c time00=MPI_Wtime() -cd write (iout,*) "eelecij",i,j - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - ael6i=ael6(iteli,itelj) - ael3i=ael3(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - rmij=1.0D0/rij -c For extracting the short-range part of Evdwpp - sss=sscale(rij/rpp(iteli,itelj)) - - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj - cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij - cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij - fac=cosa-3.0D0*cosb*cosg - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - fac3=ael6i*r6ij - fac4=ael3i*r3ij - evdwij=ev1+ev2 - el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) - el2=fac4*fac - eesij=el1+el2 -C 12/26/95 - for the evaluation of multi-body H-bonding interactions - ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) - ees=ees+eesij - evdw1=evdw1+evdwij*(1.0d0-sss) -cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, -cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, -cd & xmedi,ymedi,zmedi,xj,yj,zj - - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij - endif - -C -C Calculate contributions to the Cartesian gradient. -C -#ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) - facel=-3*rrmij*(el1+eesij) - fac1=fac - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gvdwpp(k,i)=gvdwpp(k,i)+ghalf -c gvdwpp(k,j)=gvdwpp(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) -cgrad enddo -cgrad enddo -#else - facvdw=ev1+evdwij*(1.0d0-sss) - facel=el1+eesij - fac1=fac - fac=-3*rrmij*(facvdw+facvdw+facel) - erij(1)=xj*rmij - erij(2)=yj*rmij - erij(3)=zj*rmij -* -* Radial derivatives. First process both termini of the fragment (i,j) -* - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c gelc(k,j)=gelc(k,j)+ghalf -c enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - do k=1,3 - gelc_long(k,j)=gelc(k,j)+ggg(k) - gelc_long(k,i)=gelc(k,i)-ggg(k) - enddo -* -* Loop over residues i+1 thru j-1. -* -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -c 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo -#endif -* -* Angular part -* - ecosa=2.0D0*fac3*fac1+fac4 - fac4=-3.0D0*fac4 - fac3=-6.0D0*fac3 - ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4) - ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4) - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo -cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), -cd & (dcosg(k),k=1,3) - do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) - enddo -c do k=1,3 -c ghalf=0.5D0*ggg(k) -c gelc(k,i)=gelc(k,i)+ghalf -c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) -c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) -c gelc(k,j)=gelc(k,j)+ghalf -c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) -c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) -c enddo -cgrad do k=i+1,j-1 -cgrad do l=1,3 -cgrad gelc(l,k)=gelc(l,k)+ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gelc(k,i)=gelc(k,i) - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j) - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gelc_long(k,j)=gelc_long(k,j)+ggg(k) - gelc_long(k,i)=gelc_long(k,i)-ggg(k) - enddo - IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 - & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 - & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C -C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction -C energy of a peptide unit is assumed in the form of a second-order -C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. -C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms -C are computed for EVERY pair of non-contiguous peptide groups. -C - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - kkk=0 - do k=1,2 - do l=1,2 - kkk=kkk+1 - muij(kkk)=mu(k,i)*mu(l,j) - enddo - enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij - ury=scalar(uy(1,i),erij) - urz=scalar(uz(1,i),erij) - vry=scalar(uy(1,j),erij) - vrz=scalar(uz(1,j),erij) - a22=scalar(uy(1,i),uy(1,j))-3*ury*vry - a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz - a32=scalar(uz(1,i),uy(1,j))-3*urz*vry - a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz - fac=dsqrt(-ael6i)*r3ij - a22=a22*fac - a23=a23*fac - a32=a32*fac - a33=a33*fac -cd write (iout,'(4i5,4f10.5)') -cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 -cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), -cd & uy(:,j),uz(:,j) -cd write (iout,'(4f10.5)') -cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), -cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) -cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(9f10.5/)') -cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij -C Derivatives of the elements of A in virtual-bond vectors - call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) - do k=1,3 - uryg(k,1)=scalar(erder(1,k),uy(1,i)) - uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) - uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1)) - urzg(k,1)=scalar(erder(1,k),uz(1,i)) - urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1)) - urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1)) - vryg(k,1)=scalar(erder(1,k),uy(1,j)) - vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1)) - vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1)) - vrzg(k,1)=scalar(erder(1,k),uz(1,j)) - vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) - vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) - enddo -C Compute radial contributions to the gradient - facr=-3.0d0*rrmij - a22der=a22*facr - a23der=a23*facr - a32der=a32*facr - a33der=a33*facr - agg(1,1)=a22der*xj - agg(2,1)=a22der*yj - agg(3,1)=a22der*zj - agg(1,2)=a23der*xj - agg(2,2)=a23der*yj - agg(3,2)=a23der*zj - agg(1,3)=a32der*xj - agg(2,3)=a32der*yj - agg(3,3)=a32der*zj - agg(1,4)=a33der*xj - agg(2,4)=a33der*yj - agg(3,4)=a33der*zj -C Add the contributions coming from er - fac3=-3.0d0*fac - do k=1,3 - agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury) - agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury) - agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz) - agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz) - enddo - do k=1,3 -C Derivatives in DC(i) -cgrad ghalf1=0.5d0*agg(k,1) -cgrad ghalf2=0.5d0*agg(k,2) -cgrad ghalf3=0.5d0*agg(k,3) -cgrad ghalf4=0.5d0*agg(k,4) - aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)!+ghalf1 - aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)!+ghalf2 - aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)!+ghalf3 - aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)!+ghalf4 -C Derivatives in DC(i+1) - aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)!+agg(k,1) - aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) - aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)!+agg(k,3) - aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) -C Derivatives in DC(j) - aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)!+ghalf1 - aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)!+ghalf2 - aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)!+ghalf3 - aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)!+ghalf4 -C Derivatives in DC(j+1) or DC(nres-1) - aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) - & -3.0d0*vryg(k,3)*ury) - aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) - & -3.0d0*vrzg(k,3)*ury) - aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) - & -3.0d0*vryg(k,3)*urz) - aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) - & -3.0d0*vrzg(k,3)*urz) -cgrad if (j.eq.nres-1 .and. i.lt.j-2) then -cgrad do l=1,4 -cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) -cgrad enddo -cgrad endif - enddo - acipa(1,1)=a22 - acipa(1,2)=a23 - acipa(2,1)=a32 - acipa(2,2)=a33 - a22=-a22 - a23=-a23 - do l=1,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - if (j.lt.nres-1) then - a22=-a22 - a32=-a32 - do l=1,3,2 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - else - a22=-a22 - a23=-a23 - a32=-a32 - a33=-a33 - do l=1,4 - do k=1,3 - agg(k,l)=-agg(k,l) - aggi(k,l)=-aggi(k,l) - aggi1(k,l)=-aggi1(k,l) - aggj(k,l)=-aggj(k,l) - aggj1(k,l)=-aggj1(k,l) - enddo - enddo - endif - ENDIF ! WCORR - IF (wel_loc.gt.0.0d0) THEN -C Contribution to the local-electrostatic energy coming from the i-j pair - eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) - & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'eelloc',i,j,eel_loc_ij - - eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma - if (i.gt.1) - & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) - gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) -cgrad ghalf=0.5d0*ggg(l) -cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf -cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf - enddo -cgrad do k=i+1,j2 -cgrad do l=1,3 -cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) -cgrad enddo -cgrad enddo -C Remaining derivatives of eello - do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) - enddo - ENDIF -C Change 12/26/95 to calculate four-body contributions to H-bonding energy -c if (j.gt.i+1 .and. num_conti.le.maxconts) then - if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 - & .and. num_conti.le.maxconts) then -c write (iout,*) i,j," entered corr" -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -c r0ij=1.02D0*rpp(iteli,itelj) -c r0ij=1.11D0*rpp(iteli,itelj) - r0ij=2.20D0*rpp(iteli,itelj) -c r0ij=1.55D0*rpp(iteli,itelj) - call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) - if (fcont.gt.0.0D0) then - num_conti=num_conti+1 - if (num_conti.gt.maxconts) then - write (iout,*) 'WARNING - max. # of contacts exceeded;', - & ' will skip next contacts for this conf.' - else - jcont_hb(num_conti,i)=j -cd write (iout,*) "i",i," j",j," num_conti",num_conti, -cd & " jcont_hb",jcont_hb(num_conti,i) - IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. - & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN -C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el -C terms. - d_cont(num_conti,i)=rij -cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij -C --- Electrostatic-interaction matrix --- - a_chuj(1,1,num_conti,i)=a22 - a_chuj(1,2,num_conti,i)=a23 - a_chuj(2,1,num_conti,i)=a32 - a_chuj(2,2,num_conti,i)=a33 -C --- Gradient of rij - do kkk=1,3 - grij_hb_cont(kkk,num_conti,i)=erij(kkk) - enddo - kkll=0 - do k=1,2 - do l=1,2 - kkll=kkll+1 - do m=1,3 - a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll) - a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll) - a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) - a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) - a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) - enddo - enddo - enddo - ENDIF - IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN -C Calculate contact energies - cosa4=4.0D0*cosa - wij=cosa-3.0D0*cosb*cosg - cosbg1=cosb+cosg - cosbg2=cosb-cosg -c fac3=dsqrt(-ael6i)/r0ij**3 - fac3=dsqrt(-ael6i)*r3ij -c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 - if (ees0tmp.gt.0) then - ees0pij=dsqrt(ees0tmp) - else - ees0pij=0 - endif -c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) - ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 - if (ees0tmp.gt.0) then - ees0mij=dsqrt(ees0tmp) - else - ees0mij=0 - endif -c ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) -C Diagnostics. Comment out or remove after debugging! -c ees0p(num_conti,i)=0.5D0*fac3*ees0pij -c ees0m(num_conti,i)=0.5D0*fac3*ees0mij -c ees0m(num_conti,i)=0.0D0 -C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont -C Angular derivatives of the contact function - ees0pij1=fac3/ees0pij - ees0mij1=fac3/ees0mij - fac3p=-3.0D0*fac3*rrmij - ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) - ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) -c ees0mij1=0.0D0 - ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) - ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) - ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) - ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) - ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) - ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) - ecosap=ecosa1+ecosa2 - ecosbp=ecosb1+ecosb2 - ecosgp=ecosg1+ecosg2 - ecosam=ecosa1-ecosa2 - ecosbm=ecosb1-ecosb2 - ecosgm=ecosg1-ecosg2 -C Diagnostics -c ecosap=ecosa1 -c ecosbp=ecosb1 -c ecosgp=ecosg1 -c ecosam=0.0D0 -c ecosbm=0.0D0 -c ecosgm=0.0D0 -C End diagnostics - facont_hb(num_conti,i)=fcont - fprimcont=fprimcont/rij -cd facont_hb(num_conti,i)=1.0D0 -C Following line is for diagnostics. -cd fprimcont=0.0D0 - do k=1,3 - dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb) - dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg) - enddo - do k=1,3 - gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) - gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) - enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj -C Derivatives due to the contact function - gacont_hbr(1,num_conti,i)=fprimcont*xj - gacont_hbr(2,num_conti,i)=fprimcont*yj - gacont_hbr(3,num_conti,i)=fprimcont*zj - do k=1,3 -c -c 10/24/08 cgrad and ! comments indicate the parts of the code removed -c following the change of gradient-summation algorithm. -c -cgrad ghalfp=0.5D0*gggp(k) -cgrad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=!ghalfp - & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=!ghalfm - & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) - enddo - ENDIF ! wcorr - endif ! num_conti.le.maxconts - endif ! fcont.gt.0 - endif ! j.gt.i+1 - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then - do k=1,4 - do l=1,3 - ghalf=0.5d0*agg(l,k) - aggi(l,k)=aggi(l,k)+ghalf - aggi1(l,k)=aggi1(l,k)+agg(l,k) - aggj(l,k)=aggj(l,k)+ghalf - enddo - enddo - if (j.eq.nres-1 .and. i.lt.j-2) then - do k=1,4 - do l=1,3 - aggj1(l,k)=aggj1(l,k)+agg(l,k) - enddo - enddo - endif - endif -c t_eelecij=t_eelecij+MPI_Wtime()-time00 - return - end -C----------------------------------------------------------------------- - subroutine evdwpp_short(evdw1) -C -C Compute Evdwpp -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VECTORS' - include 'COMMON.FFIELD' - dimension ggg(3) -c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions -#ifdef MOMENT - double precision scal_el /1.0d0/ -#else - double precision scal_el /0.5d0/ -#endif - evdw1=0.0D0 -c write (iout,*) "iatel_s_vdw",iatel_s_vdw, -c & " iatel_e_vdw",iatel_e_vdw - call flush(iout) - do i=iatel_s_vdw,iatel_e_vdw - dxi=dc(1,i) - dyi=dc(2,i) - dzi=dc(3,i) - dx_normi=dc_norm(1,i) - dy_normi=dc_norm(2,i) - dz_normi=dc_norm(3,i) - xmedi=c(1,i)+0.5d0*dxi - ymedi=c(2,i)+0.5d0*dyi - zmedi=c(3,i)+0.5d0*dzi - num_conti=0 -c write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), -c & ' ielend',ielend_vdw(i) - call flush(iout) - do j=ielstart_vdw(i),ielend_vdw(i) - ind=ind+1 - iteli=itel(i) - itelj=itel(j) - if (j.eq.i+2 .and. itelj.eq.2) iteli=2 - aaa=app(iteli,itelj) - bbb=bpp(iteli,itelj) - dxj=dc(1,j) - dyj=dc(2,j) - dzj=dc(3,j) - dx_normj=dc_norm(1,j) - dy_normj=dc_norm(2,j) - dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi - rij=xj*xj+yj*yj+zj*zj - rrmij=1.0D0/rij - rij=dsqrt(rij) - sss=sscale(rij/rpp(iteli,itelj)) - if (sss.gt.0.0d0) then - rmij=1.0D0/rij - r3ij=rrmij*rmij - r6ij=r3ij*r3ij - ev1=aaa*r6ij*r6ij -c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions - if (j.eq.i+2) ev1=scal_el*ev1 - ev2=bbb*r6ij - evdwij=ev1+ev2 - if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss - endif - evdw1=evdw1+evdwij*sss -C -C Calculate contributions to the Cartesian gradient. -C - facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj - do k=1,3 - gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) - enddo - endif - enddo ! j - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp_long(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.lt.1.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss) - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*(1.0d0-sss) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*(1.0d0-sss) - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C----------------------------------------------------------------------------- - subroutine escp_short(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - - if (sss.gt.0.0d0) then - - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*sss - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij*sss - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij*sss - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -C Uncomment following three lines for SC-p interactions -c do k=1,3 -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -c enddo -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - endif - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end diff --git a/source/unres/src_MD-restraints/energy_p_new_barrier.F b/source/unres/src_MD-restraints/energy_p_new_barrier.F deleted file mode 100644 index 4949a87..0000000 --- a/source/unres/src_MD-restraints/energy_p_new_barrier.F +++ /dev/null @@ -1,9431 +0,0 @@ - subroutine etotal(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.LOCAL' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' -#ifdef MPI -c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, -c & " nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) -c print *,"Processor",myrank," BROADCAST iorder" -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor - weights_(22)=wsct -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - wsct=weights(22) - endif - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart - endif -c print *,'Processor',myrank,' calling etotal ipot=',ipot -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#else -c if (modecalc.eq.12.or.modecalc.eq.14) then -c call int_from_cart1(.false.) -c endif -#endif -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj(evdw,evdw_p,evdw_m) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw,evdw_p,evdw_m) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw,evdw_p,evdw_m) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -cmc -cmc Sep-06: egb takes care of dynamic ss bonds too -cmc -c if (dyn_ss) call dyn_set_nss - -c print *,"Processor",myrank," computed USCSC" -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif - call vec_and_deriv -#ifdef TIMING -#ifdef MPI - time_vec=time_vec+MPI_Wtime()-time01 -#else - time_vec=time_vec+tcpu()-time01 -#endif -#endif -c print *,"Processor",myrank," left VEC_AND_DERIV" - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0.0d0 - evdw1=0.0d0 - eel_loc=0.0d0 - eello_turn3=0.0d0 - eello_turn4=0.0d0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -c print *,"Processor",myrank," computed UELEC" -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else -c write (iout,*) "Soft-sphere SCP potential" - call escp_soft_sphere(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. -cd print *,'Calling EHPB' - call edis(ehpb) -cd print *,'EHPB exitted succesfully.' -C -C Calculate the virtual-bond-angle energy. -C - if (wang.gt.0d0) then - call ebend(ebe) - else - ebe=0 - endif -c print *,"Processor",myrank," computed UB" -C -C Calculate the SC local energy. -C - call esc(escloc) -c print *,"Processor",myrank," computed USC" -C -C Calculate the virtual-bond torsional energy. -C -cd print *,'nterm=',nterm - if (wtor.gt.0) then - call etor(etors,edihcnstr) - else - etors=0 - edihcnstr=0 - endif - - if (constr_homology.ge.1) then - call e_modeller(ehomology_constr) - else - ehomology_constr=0.0d0 - endif - - -c write(iout,*) ehomology_constr -c print *,"Processor",myrank," computed Utor" -C -C 6/23/01 Calculate double-torsional energy -C - if (wtor_d.gt.0) then - call etor_d(etors_d) - else - etors_d=0 - endif -c print *,"Processor",myrank," computed Utord" -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -c print *,"Processor",myrank," computed Usccorr" -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1, -cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -cd write (iout,*) "multibody_hb ecorr",ecorr - endif -c print *,"Processor",myrank," computed Ucorr" -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -#ifdef TIMING -#ifdef MPI - time_enecalc=time_enecalc+MPI_Wtime()-time00 -#else - time_enecalc=time_enecalc+tcpu()-time00 -#endif -#endif -c print *,"Processor",myrank," computed Uconstr" -#ifdef TIMING -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -#endif -c -C Sum the energies -C - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(19)=edihcnstr - energia(17)=estr - energia(20)=Uconst+Uconst_back - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m - energia(24)=ehomology_constr -c print *," Processor",myrank," calls SUM_ENERGY" - call sum_energy(energia,.true.) - if (dyn_ss) call dyn_set_nss -c print *," Processor",myrank," left SUM_ENERGY" -#ifdef TIMING -#ifdef MPI - time_sumene=time_sumene+MPI_Wtime()-time00 -#else - time_sumene=time_sumene+tcpu()-time00 -#endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_energy(energia,reduce) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene),enebuff(0:n_ene+1) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - logical reduce -#ifdef MPI - if (nfgtasks.gt.1 .and. reduce) then -#ifdef DEBUG - write (iout,*) "energies before REDUCE" - call enerprint(energia) - call flush(iout) -#endif - do i=0,n_ene - enebuff(i)=energia(i) - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_e=time_barrier_e+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(enebuff(0),energia(0),n_ene+1, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) -#ifdef DEBUG - write (iout,*) "energies after REDUCE" - call enerprint(energia) - call flush(iout) -#endif - time_Reduce=time_Reduce+MPI_Wtime()-time00 - endif - if (fg_rank.eq.0) then -#endif -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif -#ifdef SCP14 - evdw2=energia(2)+energia(18) - evdw2_14=energia(18) -#else - evdw2=energia(2) -#endif -#ifdef SPLITELE - ees=energia(3) - evdw1=energia(16) -#else - ees=energia(3) - evdw1=0.0d0 -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eturn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - ehomology_constr=energia(24) -#ifdef SPLITELE - etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr -#else - etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) - & +wang*ebe+wtor*etors+wscloc*escloc - & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 - & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 - & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d - & +wbond*estr+Uconst+wsccor*esccor+ehomology_constr -#endif - energia(0)=etot -c detecting NaNQ -#ifdef ISNAN -#ifdef AIX - if (isnan(etot).ne.0) energia(0)=1.0d+99 -#else - if (isnan(etot)) energia(0)=1.0d+99 -#endif -#else - i=0 -#ifdef WINPGI - idumm=proc_proc(etot,i) -#else - call proc_proc(etot,i) -#endif - if(i.eq.1)energia(0)=1.0d+99 -#endif -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sum_gradient - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include 'mpif.h' -#endif - double precision gradbufc(3,maxres),gradbufx(3,maxres), - & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres) - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.TIME1' - include 'COMMON.MAXGRAD' - include 'COMMON.SCCOR' -#ifdef TIMING -#ifdef MPI - time01=MPI_Wtime() -#else - time01=tcpu() -#endif -#endif -#ifdef DEBUG - write (iout,*) "sum_gradient gvdwc, gvdwx" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)') - & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3), - & (gvdwcT(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (nfgtasks.gt.1 .and. fg_rank.eq.0) - & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -C -C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient -C in virtual-bond-vector coordinates -C -#ifdef DEBUG -c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)') -c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i) -c enddo -c write (iout,*) "gel_loc_tur3 gel_loc_turn4" -c do i=1,nres-1 -c write (iout,'(i5,3f10.5,2x,f10.5)') -c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i) -c enddo - write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc" - do i=1,nres - write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3), - & g_corr5_loc(i) - enddo - call flush(iout) -#endif -#ifdef SPLITELE -#ifdef TSCSC - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#else - do i=1,nct - do j=1,3 - gradbufc(j,i)=wsc*gvdwc(j,i)+ - & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ - & welec*gelc_long(j,i)+ - & wbond*gradb(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i)+ - & wstrain*ghpbc(j,i) - enddo - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -#ifdef DEBUG - write (iout,*) "gradbufc before allreduce" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - enddo - enddo -c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres, -c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR) -c time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG -c write (iout,*) "gradbufc_sum after allreduce" -c do i=1,nres -c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3) -c enddo -c call flush(iout) -#endif -#ifdef TIMING -c time_allreduce=time_allreduce+MPI_Wtime()-time00 -#endif - do i=nnt,nres - do k=1,3 - gradbufc(k,i)=0.0d0 - enddo - enddo -#ifdef DEBUG - write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end - write (iout,*) (i," jgrad_start",jgrad_start(i), - & " jgrad_end ",jgrad_end(i), - & i=igrad_start,igrad_end) -#endif -c -c Obsolete and inefficient code; we can make the effort O(n) and, therefore, -c do not parallelize this part. -c -c do i=igrad_start,igrad_end -c do j=jgrad_start(i),jgrad_end(i) -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j) -c enddo -c enddo -c enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - else -#endif -#ifdef DEBUG - write (iout,*) "gradbufc" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif - do i=1,nres - do j=1,3 - gradbufc_sum(j,i)=gradbufc(j,i) - gradbufc(j,i)=0.0d0 - enddo - enddo - do j=1,3 - gradbufc(j,nres-1)=gradbufc_sum(j,nres) - enddo - do i=nres-2,nnt,-1 - do j=1,3 - gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) - enddo - enddo -c do i=nnt,nres-1 -c do k=1,3 -c gradbufc(k,i)=0.0d0 -c enddo -c do j=i+1,nres -c do k=1,3 -c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j) -c enddo -c enddo -c enddo -#ifdef DEBUG - write (iout,*) "gradbufc after summing" - do i=1,nres - write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3) - enddo - call flush(iout) -#endif -#ifdef MPI - endif -#endif - do k=1,3 - gradbufc(k,nres)=0.0d0 - enddo - do i=1,nct - do j=1,3 -#ifdef SPLITELE - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gradcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#else - gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ - & wel_loc*gel_loc(j,i)+ - & 0.5d0*(wscp*gvdwc_scpp(j,i)+ - & welec*gelc_long(j,i)+ - & wel_loc*gel_loc_long(j,i)+ - & wcorr*gcorr_long(j,i)+ - & wcorr5*gradcorr5_long(j,i)+ - & wcorr6*gradcorr6_long(j,i)+ - & wturn6*gcorr6_turn_long(j,i))+ - & wbond*gradb(j,i)+ - & wcorr*gradcorr(j,i)+ - & wturn3*gcorr3_turn(j,i)+ - & wturn4*gcorr4_turn(j,i)+ - & wcorr5*gradcorr5(j,i)+ - & wcorr6*gradcorr6(j,i)+ - & wturn6*gcorr6_turn(j,i)+ - & wsccor*gsccorc(j,i) - & +wscloc*gscloc(j,i) -#endif -#ifdef TSCSC - gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+ - & wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#else - gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ - & wbond*gradbx(j,i)+ - & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ - & wsccor*gsccorx(j,i) - & +wscloc*gsclocx(j,i) -#endif - enddo - enddo -#ifdef DEBUG - write (iout,*) "gloc before adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) - & +wcorr5*g_corr5_loc(i) - & +wcorr6*g_corr6_loc(i) - & +wturn4*gel_loc_turn4(i) - & +wturn3*gel_loc_turn3(i) - & +wturn6*gel_loc_turn6(i) - & +wel_loc*gel_loc_loc(i) - enddo -#ifdef DEBUG - write (iout,*) "gloc after adding corr" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif -#ifdef MPI - if (nfgtasks.gt.1) then - do j=1,3 - do i=1,nres - gradbufc(j,i)=gradc(j,i,icg) - gradbufx(j,i)=gradx(j,i,icg) - enddo - enddo - do i=1,4*nres - glocbuf(i)=gloc(i,icg) - enddo -#ifdef DEBUG - write (iout,*) "gloc_sc before reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif - do i=1,nres - do j=1,3 - gloc_scbuf(j,i)=gloc_sc(j,i,icg) - enddo - enddo - time00=MPI_Wtime() - call MPI_Barrier(FG_COMM,IERR) - time_barrier_g=time_barrier_g+MPI_Wtime()-time00 - time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres, - & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -#ifdef DEBUG - write (iout,*) "gloc_sc after reduce" - do i=1,nres - do j=1,3 - write (iout,*) i,j,gloc_sc(j,i,icg) - enddo - enddo -#endif -#ifdef DEBUG - write (iout,*) "gloc after reduce" - do i=1,4*nres - write (iout,*) i,gloc(i,icg) - enddo -#endif - endif -#endif - if (gnorm_check) then -c -c Compute the maximum elements of the gradient -c - gvdwc_max=0.0d0 - gvdwc_scp_max=0.0d0 - gelc_max=0.0d0 - gvdwpp_max=0.0d0 - gradb_max=0.0d0 - ghpbc_max=0.0d0 - gradcorr_max=0.0d0 - gel_loc_max=0.0d0 - gcorr3_turn_max=0.0d0 - gcorr4_turn_max=0.0d0 - gradcorr5_max=0.0d0 - gradcorr6_max=0.0d0 - gcorr6_turn_max=0.0d0 - gsccorc_max=0.0d0 - gscloc_max=0.0d0 - gvdwx_max=0.0d0 - gradx_scp_max=0.0d0 - ghpbx_max=0.0d0 - gradxorr_max=0.0d0 - gsccorx_max=0.0d0 - gsclocx_max=0.0d0 - do i=1,nct - gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#ifdef TSCSC - gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i))) - if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm -#endif - gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) - if (gvdwc_scp_norm.gt.gvdwc_scp_max) - & gvdwc_scp_max=gvdwc_scp_norm - gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) - if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm - gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) - if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm - gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) - if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm - ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) - if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm - gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) - if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm - gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) - if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm - gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), - & gcorr3_turn(1,i))) - if (gcorr3_turn_norm.gt.gcorr3_turn_max) - & gcorr3_turn_max=gcorr3_turn_norm - gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), - & gcorr4_turn(1,i))) - if (gcorr4_turn_norm.gt.gcorr4_turn_max) - & gcorr4_turn_max=gcorr4_turn_norm - gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) - if (gradcorr5_norm.gt.gradcorr5_max) - & gradcorr5_max=gradcorr5_norm - gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) - if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm - gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), - & gcorr6_turn(1,i))) - if (gcorr6_turn_norm.gt.gcorr6_turn_max) - & gcorr6_turn_max=gcorr6_turn_norm - gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) - if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm - gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) - if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm - gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#ifdef TSCSC - gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i))) - if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm -#endif - gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) - if (gradx_scp_norm.gt.gradx_scp_max) - & gradx_scp_max=gradx_scp_norm - ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) - if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm - gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) - if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm - gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) - if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm - gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) - if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm - enddo - if (gradout) then -#ifdef AIX - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif - write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, - & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, - & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, - & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, - & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, - & gsccorx_max,gsclocx_max - close(istat) - if (gvdwc_max.gt.1.0d4) then - write (iout,*) "gvdwc gvdwx gradb gradbx" - do i=nnt,nct - write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), - & gradb(j,i),gradbx(j,i),j=1,3) - enddo - call pdbout(0.0d0,'cipiszcze',iout) - call flush(iout) - endif - endif - endif -#ifdef DEBUG - write (iout,*) "gradc gradx gloc" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') - & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) - enddo -#endif -#ifdef TIMING -#ifdef MPI - time_sumgradient=time_sumgradient+MPI_Wtime()-time01 -#else - time_sumgradient=time_sumgradient+tcpu()-time01 -#endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine rescale_weights(t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - double precision kfac /2.4d0/ - double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ -c facT=temp0/t_bath -c facT=2*temp0/(t_bath+temp0) - if (rescale_mode.eq.0) then - facT=1.0d0 - facT2=1.0d0 - facT3=1.0d0 - facT4=1.0d0 - facT5=1.0d0 - else if (rescale_mode.eq.1) then - facT=kfac/(kfac-1.0d0+t_bath/temp0) - facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) - facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) - facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) - facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) - else if (rescale_mode.eq.2) then - x=t_bath/temp0 - x2=x*x - x3=x2*x - x4=x3*x - x5=x4*x - facT=licznik/dlog(dexp(x)+dexp(-x)) - facT2=licznik/dlog(dexp(x2)+dexp(-x2)) - facT3=licznik/dlog(dexp(x3)+dexp(-x3)) - facT4=licznik/dlog(dexp(x4)+dexp(-x4)) - facT5=licznik/dlog(dexp(x5)+dexp(-x5)) - else - write (iout,*) "Wrong RESCALE_MODE",rescale_mode - write (*,*) "Wrong RESCALE_MODE",rescale_mode -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) -#endif - stop 555 - endif - welec=weights(3)*fact - wcorr=weights(4)*fact3 - wcorr5=weights(5)*fact4 - wcorr6=weights(6)*fact5 - wel_loc=weights(7)*fact2 - wturn3=weights(8)*fact2 - wturn4=weights(9)*fact3 - wturn6=weights(10)*fact5 - wtor=weights(13)*fact - wtor_d=weights(14)*fact2 - wsccor=weights(21)*fact -#ifdef TSCSC -c wsct=t_bath/temp0 - wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 -#endif - return - end -C------------------------------------------------------------------------ - subroutine enerprint(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - double precision energia(0:n_ene) - etot=energia(0) -#ifdef TSCSC - evdw=energia(22)+wsct*energia(23) -#else - evdw=energia(1) -#endif - evdw2=energia(2) -#ifdef SCP14 - evdw2=energia(2)+energia(18) -#else - evdw2=energia(2) -#endif - ees=energia(3) -#ifdef SPLITELE - evdw1=energia(16) -#endif - ecorr=energia(4) - ecorr5=energia(5) - ecorr6=energia(6) - eel_loc=energia(7) - eello_turn3=energia(8) - eello_turn4=energia(9) - eello_turn6=energia(10) - ebe=energia(11) - escloc=energia(12) - etors=energia(13) - etors_d=energia(14) - ehpb=energia(15) - edihcnstr=energia(19) - estr=energia(17) - Uconst=energia(20) - esccor=energia(21) - ehomology_constr=energia(24) - -#ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, - & edihcnstr,ehomology_constr, ebr*nss, - & Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ - & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST= ',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, - & ehomology_constr,ebr*nss,Uconst,etot - 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, - & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ - & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ - & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ - & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' (Constraint energy)'/ - & 'ETOT= ',1pE16.6,' (total)') -#endif - return - end -C----------------------------------------------------------------------- - subroutine elj(evdw,evdw_p,evdw_m) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the LJ potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (accur=1.0d-10) - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.TORSION' - include 'COMMON.SBRIDGE' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.CONTACTS' - dimension gg(3) -c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) -C Change 12/1/95 - num_conti=0 -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) -cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), -cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi -C Change 12/1/95 to calculate four-body interactions - rij=xj*xj+yj*yj+zj*zj - rrij=1.0D0/rij -c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj - eps0ij=eps(itypi,itypj) - fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=e1+e2 -cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), -cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, -cd & (c(k,i),k=1,3),(c(k,j),k=1,3) -#ifdef TSCSC - if (bb(itypi,itypj).gt.0) then - evdw_p=evdw_p+evdwij - else - evdw_m=evdw_m+evdwij - endif -#else - evdw=evdw+evdwij -#endif -C -C Calculate the components of the gradient in DC and X -C - fac=-rrij*(e1+evdwij) - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -#ifdef TSCSC - if (bb(itypi,itypj).gt.0.0d0) then - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo - else - do k=1,3 - gvdwxT(k,i)=gvdwxT(k,i)-gg(k) - gvdwxT(k,j)=gvdwxT(k,j)+gg(k) - gvdwcT(k,i)=gvdwcT(k,i)-gg(k) - gvdwcT(k,j)=gvdwcT(k,j)+gg(k) - enddo - endif -#else - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - gvdwx(k,j)=gvdwx(k,j)+gg(k) - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) - enddo -#endif -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo -C -C 12/1/95, revised on 5/20/97 -C -C Calculate the contact function. The ith column of the array JCONT will -C contain the numbers of atoms that make contacts with the atom I (of numbers -C greater than I). The arrays FACONT and GACONT will contain the values of -C the contact function and its derivative. -C -C Uncomment next line, if the correlation interactions include EVDW explicitly. -c if (j.gt.i+1 .and. evdwij.le.0.0D0) then -C Uncomment next line, if the correlation interactions are contact function only - if (j.gt.i+1.and. eps0ij.gt.0.0D0) then - rij=dsqrt(rij) - sigij=sigma(itypi,itypj) - r0ij=rs0(itypi,itypj) -C -C Check whether the SC's are not too far to make a contact. -C - rcut=1.5d0*r0ij - call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) -C Add a new contact, if the SC's are close enough, but not too close (ri' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - return - end -C----------------------------------------------------------------------------- - subroutine escp(evdw2,evdw2_14) -C -C This subroutine calculates the excluded-volume interaction energy between -C peptide-group centers and side chains and its gradient in virtual-bond and -C side-chain vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - dimension ggg(3) - evdw2=0.0D0 - evdw2_14=0.0d0 -cd print '(a)','Enter ESCP' -cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e - do i=iatscp_s,iatscp_e - iteli=itel(i) - xi=0.5D0*(c(1,i)+c(1,i+1)) - yi=0.5D0*(c(2,i)+c(2,i+1)) - zi=0.5D0*(c(3,i)+c(3,i+1)) - - do iint=1,nscp_gr(i) - - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) -C Uncomment following three lines for SC-p interactions -c xj=c(1,nres+j)-xi -c yj=c(2,nres+j)-yi -c zj=c(3,nres+j)-zi -C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - fac=rrij**expon2 - e1=fac*fac*aad(itypj,iteli) - e2=fac*bad(itypj,iteli) - if (iabs(j-i) .le. 2) then - e1=scal14*e1 - e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 - endif - evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw2',i,j,evdwij -C -C Calculate contributions to the gradient in the virtual-bond and SC vectors. -C - fac=-(evdwij+e1)*rrij - ggg(1)=xj*fac - ggg(2)=yj*fac - ggg(3)=zj*fac -cgrad if (j.lt.i) then -cd write (iout,*) 'ji' -cgrad do k=1,3 -cgrad ggg(k)=-ggg(k) -C Uncomment following line for SC-p interactions -ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) -c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k) -cgrad enddo -cgrad endif -cgrad do k=1,3 -cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) -cgrad enddo -cgrad kstart=min0(i+1,j) -cgrad kend=max0(i-1,j-1) -cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend -cd write (iout,*) ggg(1),ggg(2),ggg(3) -cgrad do k=kstart,kend -cgrad do l=1,3 -cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) -cgrad enddo -cgrad enddo - do k=1,3 - gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) - gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) - enddo - enddo - - enddo ! iint - enddo ! i - do i=1,nct - do j=1,3 - gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) - gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i) - gradx_scp(j,i)=expon*gradx_scp(j,i) - enddo - enddo -C****************************************************************************** -C -C N O T E !!! -C -C To save time the factor EXPON has been extracted from ALL components -C of GVDWC and GRADX. Remember to multiply them by this factor before further -C use! -C -C****************************************************************************** - return - end -C-------------------------------------------------------------------------- - subroutine edis(ehpb) -C -C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - dimension ggg(3) - ehpb=0.0D0 -cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -cd write(iout,*)'link_start=',link_start,' link_end=',link_end - if (link_end.eq.0) return - do i=link_start,link_end -C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a -C CA-CA distance used in regularization of structure. - ii=ihpb(i) - jj=jhpb(i) -C iii and jjj point to the residues for which the distance is assigned. - if (ii.gt.nres) then - iii=ii-nres - jjj=jj-nres - else - iii=ii - jjj=jj - endif -c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, -c & dhpb(i),dhpb1(i),forcon(i) -C 24/11/03 AL: SS bridges handled separately because of introducing a specific -C distance and angle dependent SS bond potential. -cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then -C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds - if (.not.dyn_ss .and. i.le.nss) then -C 15/02/13 CC dynamic SSbond - additional check - if (ii.gt.nres - & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then - call ssbond_ene(iii,jjj,eij) - ehpb=ehpb+2*eij - endif -cd write (iout,*) "eij",eij - else if (ii.gt.nres .and. jj.gt.nres) then -c Restraints from contact prediction - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "beta nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - dd=dist(ii,jj) - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "beta reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - if (dhpb1(i).gt.0.0d0) then - ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -c write (iout,*) "alph nmr", -c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) - else - rdis=dd-dhpb(i) -C Get the force constant corresponding to this distance. - waga=forcon(i) -C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -c write (iout,*) "alpha reg",dd,waga*rdis*rdis -C -C Evaluate gradient. -C - fac=waga*rdis/dd - endif -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -C If this is a SC-SC distance, we need to calculate the contributions to the -C Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then - do j=1,3 - ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) - ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) - enddo - endif -cgrad do j=iii,jjj-1 -cgrad do k=1,3 -cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -cgrad enddo -cgrad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo - endif - enddo - ehpb=0.5D0*ehpb - return - end -C-------------------------------------------------------------------------- - subroutine ssbond_ene(i,j,eij) -C -C Calculate the distance and angle dependent SS-bond potential energy -C using a free-energy function derived based on RHF/6-31G** ab initio -C calculations of diethyl disulfide. -C -C A. Liwo and U. Kozlowska, 11/24/03 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) -c dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(nres+i) - itypj=itype(j) -c dscj_inv=dsc_inv(itypj) - dscj_inv=vbld_inv(nres+j) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - erij(1)=xj*rij - erij(2)=yj*rij - erij(3)=zj*rij - om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) - om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) - om12=dxi*dxj+dyi*dyj+dzi*dzj - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) - dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) - enddo - rij=1.0d0/rij - deltad=rij-d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12+ebr - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij - ed=2*akcm*deltad+akct*deltat12 - pom1=akct*deltad - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - do k=1,3 - ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - ghpbx(k,i)=ghpbx(k,i)-ggk - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - ghpbx(k,j)=ghpbx(k,j)+ggk - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - ghpbc(k,i)=ghpbc(k,i)-ggk - ghpbc(k,j)=ghpbc(k,j)+ggk - enddo -C -C Calculate the components of the gradient in DC and X -C -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l) -cgrad enddo -cgrad enddo - return - end -C-------------------------------------------------------------------------- - subroutine ebond(estr) -c -c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision u(3),ud(3) - estr=0.0d0 - do i=ibondp_start,ibondp_end - diff = vbld(i)-vbldp0 -c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff - estr=estr+diff*diff - do j=1,3 - gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) - enddo -c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - enddo - estr=0.5d0*AKP*estr -c -c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included -c - do i=ibond_start,ibond_end - iti=itype(i) - if (iti.ne.10) then - nbi=nbondterm(iti) - if (nbi.eq.1) then - diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff - estr=estr+0.5d0*AKSC(1,iti)*diff*diff - do j=1,3 - gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) - enddo - else - do j=1,nbi - diff=vbld(i+nres)-vbldsc0(j,iti) - ud(j)=aksc(j,iti)*diff - u(j)=abond0(j,iti)+0.5d0*ud(j)*diff - enddo - uprod=u(1) - do j=2,nbi - uprod=uprod*u(j) - enddo - usum=0.0d0 - usumsqder=0.0d0 - do j=1,nbi - uprod1=1.0d0 - uprod2=1.0d0 - do k=1,nbi - if (k.ne.j) then - uprod1=uprod1*u(k) - uprod2=uprod2*u(k)*u(k) - endif - enddo - usum=usum+uprod1 - usumsqder=usumsqder+ud(j)*uprod2 - enddo - estr=estr+uprod/usum - do j=1,3 - gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) - enddo - endif - endif - enddo - return - end -#ifdef CRYST_THETA -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - double precision y(2),z(2) - delta=0.02d0*pi -c time11=dexp(-2*time) -c time12=1.0d0 - etheta=0.0D0 -c write (*,'(a,i2)') 'EBEND ICG=',icg - do i=ithet_start,ithet_end -C Zero the energy function and its derivative at 0 or pi. - call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - y(1)=dcos(phii) - y(2)=dsin(phii) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) - z(1)=cos(phii1) -#else - phii1=phi(i+1) - z(1)=dcos(phii1) -#endif - z(2)=dsin(phii1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif -C Calculate the "mean" value of theta from the part of the distribution -C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). -C In following comments this theta will be referred to as t_c. - thet_pred_mean=0.0d0 - do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) - thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) - enddo - dthett=thet_pred_mean*ssd - thet_pred_mean=thet_pred_mean*ss+a0thet(it) -C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss - if (theta(i).gt.pi-delta) then - call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, - & E_tc0) - call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) - call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, - & E_theta) - call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else if (theta(i).lt.delta) then - call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) - call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) - call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, - & E_theta) - call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) - call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, - & E_tc) - else - call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, - & E_theta,E_tc) - endif - etheta=etheta+ethetai - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'ebend',i,ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 - gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg) - enddo -C Ufff.... We've done all this!!! - return - end -C--------------------------------------------------------------------------- - subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, - & E_tc) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it -C Calculate the contributions to both Gaussian lobes. -C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) -C The "polynomial part" of the "standard deviation" of this part of -C the distribution. - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo -C Derivative of the "interior part" of the "standard deviation of the" -C gamma-dependent Gaussian lobe in t_c. - sigtc=3*polthet(3,it) - do j=2,1,-1 - sigtc=sigtc*thet_pred_mean+j*polthet(j,it) - enddo - sigtc=sig*sigtc -C Set the parameters of both Gaussian lobes of the distribution. -C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) - fac=sig*sig+sigc0(it) - sigcsq=fac+fac - sigc=1.0D0/sigcsq -C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c - sigsqtc=-4.0D0*sigcsq*sigtc -c print *,i,sig,sigtc,sigsqtc -C Following variable (sigtc) is d[sigma(t_c)]/dt_c - sigtc=-sigtc/(fac*fac) -C Following variable is sigma(t_c)**(-2) - sigcsq=sigcsq*sigcsq - sig0i=sig0(it) - sig0inv=1.0D0/sig0i**2 - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i - term1=-0.5D0*sigcsq*delthec*delthec - term2=-0.5D0*sig0inv*delthe0*delthe0 -C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and -C NaNs in taking the logarithm. We extract the largest exponent which is added -C to the energy (this being the log of the distribution) at the end of energy -C term evaluation for this virtual-bond angle. - if (term1.gt.term2) then - termm=term1 - term2=dexp(term2-termm) - term1=1.0d0 - else - termm=term2 - term1=dexp(term1-termm) - term2=1.0d0 - endif -C The ratio between the gamma-independent and gamma-dependent lobes of -C the distribution is a Gaussian function of thet_pred_mean too. - diffak=gthet(2,it)-thet_pred_mean - ratak=diffak/gthet(3,it)**2 - ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) -C Let's differentiate it in thet_pred_mean NOW. - aktc=ak*ratak -C Now put together the distribution terms to make complete distribution. - termexp=term1+ak*term2 - termpre=sigc+ak*sig0i -C Contribution of the bending energy from this theta is just the -log of -C the sum of the contributions from the two lobes and the pre-exponential -C factor. Simple enough, isn't it? - ethetai=(-dlog(termexp)-termm+dlog(termpre)) -C NOW the derivatives!!! -C 6/6/97 Take into account the deformation. - E_theta=(delthec*sigcsq*term1 - & +ak*delthe0*sig0inv*term2)/termexp - E_tc=((sigtc+aktc*sig0i)/termpre - & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ - & aktc*term2)/termexp) - return - end -c----------------------------------------------------------------------------- - subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /calcthet/ term1,term2,termm,diffak,ratak, - & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, - & delthe0,sig0inv,sigtc,sigsqtc,delthec,it - delthec=thetai-thet_pred_mean - delthe0=thetai-theta0i -C "Thank you" to MAPLE (probably spared one day of hand-differentiation). - t3 = thetai-thet_pred_mean - t6 = t3**2 - t9 = term1 - t12 = t3*sigcsq - t14 = t12+t6*sigsqtc - t16 = 1.0d0 - t21 = thetai-theta0i - t23 = t21**2 - t26 = term2 - t27 = t21*t26 - t32 = termexp - t40 = t32**2 - E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 - & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 - & *(-t12*t9-ak*sig0inv*t27) - return - end -#else -C-------------------------------------------------------------------------- - subroutine ebend(etheta) -C -C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral -C angles gamma and its derivatives in consecutive thetas and gammas. -C ab initio-derived potentials from -c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), - & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), - & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), - & sinph1ph2(maxdouble,maxdouble) - logical lprn /.false./, lprn1 /.false./ - etheta=0.0D0 - do i=ithet_start,ithet_end - dethetai=0.0d0 - dephii=0.0d0 - dephii1=0.0d0 - theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) - do k=1,nntheterm - coskt(k)=dcos(k*theti2) - sinkt(k)=dsin(k*theti2) - enddo - if (i.gt.3) then -#ifdef OSF - phii=phi(i) - if (phii.ne.phii) phii=150.0 -#else - phii=phi(i) -#endif - ityp1=ithetyp(itype(i-2)) - do k=1,nsingle - cosph1(k)=dcos(k*phii) - sinph1(k)=dsin(k*phii) - enddo - else - phii=0.0d0 - ityp1=nthetyp+1 - do k=1,nsingle - cosph1(k)=0.0d0 - sinph1(k)=0.0d0 - enddo - endif - if (i.lt.nres) then -#ifdef OSF - phii1=phi(i+1) - if (phii1.ne.phii1) phii1=150.0 - phii1=pinorm(phii1) -#else - phii1=phi(i+1) -#endif - ityp3=ithetyp(itype(i)) - do k=1,nsingle - cosph2(k)=dcos(k*phii1) - sinph2(k)=dsin(k*phii1) - enddo - else - phii1=0.0d0 - ityp3=nthetyp+1 - do k=1,nsingle - cosph2(k)=0.0d0 - sinph2(k)=0.0d0 - enddo - endif - ethetai=aa0thet(ityp1,ityp2,ityp3) - do k=1,ndouble - do l=1,k-1 - ccl=cosph1(l)*cosph2(k-l) - ssl=sinph1(l)*sinph2(k-l) - scl=sinph1(l)*cosph2(k-l) - csl=cosph1(l)*sinph2(k-l) - cosph1ph2(l,k)=ccl-ssl - cosph1ph2(k,l)=ccl+ssl - sinph1ph2(l,k)=scl+csl - sinph1ph2(k,l)=scl-csl - enddo - enddo - if (lprn) then - write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, - & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 - write (iout,*) "coskt and sinkt" - do k=1,nntheterm - write (iout,*) k,coskt(k),sinkt(k) - enddo - endif - do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) - & *coskt(k) - if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), - & " ethetai",ethetai - enddo - if (lprn) then - write (iout,*) "cosph and sinph" - do k=1,nsingle - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) - enddo - write (iout,*) "cosph1ph2 and sinph2ph2" - do k=2,ndouble - do l=1,k-1 - write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), - & sinph1ph2(l,k),sinph1ph2(k,l) - enddo - enddo - write(iout,*) "ethetai",ethetai - endif - do m=1,ntheterm2 - do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*aux*coskt(m) - dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) - dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) - if (lprn) - & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai - enddo - enddo - if (lprn) - & write(iout,*) "ethetai",ethetai - do m=1,ntheterm3 - do k=2,ndouble - do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) - ethetai=ethetai+sinkt(m)*aux - dethetai=dethetai+0.5d0*m*coskt(m)*aux - dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) - if (lprn) then - write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai - write (iout,*) cosph1ph2(l,k)*sinkt(m), - & cosph1ph2(k,l)*sinkt(m), - & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) - endif - enddo - enddo - enddo -10 continue -c lprn1=.true. - if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)') - & 'ebe', i,theta(i)*rad2deg,phii*rad2deg, - & phii1*rad2deg,ethetai -c lprn1=.false. - etheta=etheta+ethetai - if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii - if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai - enddo - return - end -#endif -#ifdef CRYST_SC -c----------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), - & ddersc0(3),ddummy(3),xtemp(3),temp(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 -c write (iout,'(a)') 'ESC' - do i=loc_start,loc_end - it=itype(i) - if (it.eq.10) goto 1 - nlobit=nlob(it) -c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad - theti=theta(i+1)-pipol - x(1)=dtan(theti) - x(2)=alph(i) - x(3)=omeg(i) - - if (x(2).gt.pi-delta) then - xtemp(1)=x(1) - xtemp(2)=pi-delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=pi - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=pi-delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=pi - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - call splinthet(x(2),0.5d0*delta,ss,ssd) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c escloci=esclocbi -c write (iout,*) escloci - else if (x(2).lt.delta) then - xtemp(1)=x(1) - xtemp(2)=delta - xtemp(3)=x(3) - call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) - xtemp(2)=0.0d0 - call enesc(xtemp,escloci1,dersc1,ddummy,.false.) - call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), - & escloci,dersc(2)) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & ddersc0(1),dersc(1)) - call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), - & ddersc0(3),dersc(3)) - xtemp(2)=delta - call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) - xtemp(2)=0.0d0 - call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) - call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, - & dersc0(2),esclocbi,dersc02) - call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), - & dersc12,dersc01) - dersc0(1)=dersc01 - dersc0(2)=dersc02 - dersc0(3)=0.0d0 - call splinthet(x(2),0.5d0*delta,ss,ssd) - do k=1,3 - dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) - enddo - dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd - escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci - else - call enesc(x,escloci,dersc,ddummy,.false.) - endif - - escloc=escloc+escloci - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'escloc',i,escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc - - gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ - & wscloc*dersc(1) - gloc(ialph(i,1),icg)=wscloc*dersc(2) - gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) - 1 continue - enddo - return - end -C--------------------------------------------------------------------------- - subroutine enesc(x,escloci,dersc,ddersc,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) - double precision contr(maxlob,-1:1) - logical mixed -c write (iout,*) 'it=',it,' nlobit=',nlobit - escloc_i=0.0D0 - do j=1,3 - dersc(j)=0.0D0 - if (mixed) ddersc(j)=0.0d0 - enddo - x3=x(3) - -C Because of periodicity of the dependence of the SC energy in omega we have -C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). -C To avoid underflows, first compute & store the exponents. - - do iii=-1,1 - - x(3)=x3+iii*dwapi - - do j=1,nlobit - do k=1,3 - z(k)=x(k)-censc(k,j,it) - enddo - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j,iii)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j,iii)*z(k) - enddo - contr(j,iii)=expfac - enddo ! j - - enddo ! iii - - x(3)=x3 -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1,-1) - do iii=-1,1 - do j=1,nlobit - if (emin.gt.contr(j,iii)) emin=contr(j,iii) - enddo - enddo - emin=0.5D0*emin -cd print *,'it=',it,' emin=',emin - -C Compute the contribution to SC energy and derivatives - do iii=-1,1 - - do j=1,nlobit -#ifdef OSF - adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin - if(adexp.ne.adexp) adexp=1.0 - expfac=dexp(adexp) -#else - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) -#endif -cd print *,'j=',j,' expfac=',expfac - escloc_i=escloc_i+expfac - do k=1,3 - dersc(k)=dersc(k)+Ax(k,j,iii)*expfac - enddo - if (mixed) then - do k=1,3,2 - ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) - & +gaussc(k,2,j,it))*expfac - enddo - endif - enddo - - enddo ! iii - - dersc(1)=dersc(1)/cos(theti)**2 - ddersc(1)=ddersc(1)/cos(theti)**2 - ddersc(3)=ddersc(3) - - escloci=-(dlog(escloc_i)-emin) - do j=1,3 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) then - do j=1,3,2 - ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) - enddo - endif - return - end -C------------------------------------------------------------------------------ - subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - common /sccalc/ time11,time12,time112,theti,it,nlobit - double precision x(3),z(3),Ax(3,maxlob),dersc(3) - double precision contr(maxlob) - logical mixed - - escloc_i=0.0D0 - - do j=1,3 - dersc(j)=0.0D0 - enddo - - do j=1,nlobit - do k=1,2 - z(k)=x(k)-censc(k,j,it) - enddo - z(3)=dwapi - do k=1,3 - Axk=0.0D0 - do l=1,3 - Axk=Axk+gaussc(l,k,j,it)*z(l) - enddo - Ax(k,j)=Axk - enddo - expfac=0.0D0 - do k=1,3 - expfac=expfac+Ax(k,j)*z(k) - enddo - contr(j)=expfac - enddo ! j - -C As in the case of ebend, we want to avoid underflows in exponentiation and -C subsequent NaNs and INFs in energy calculation. -C Find the largest exponent - emin=contr(1) - do j=1,nlobit - if (emin.gt.contr(j)) emin=contr(j) - enddo - emin=0.5D0*emin - -C Compute the contribution to SC energy and derivatives - - dersc12=0.0d0 - do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) - escloc_i=escloc_i+expfac - do k=1,2 - dersc(k)=dersc(k)+Ax(k,j)*expfac - enddo - if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) - & +gaussc(1,2,j,it))*expfac - dersc(3)=0.0d0 - enddo - - dersc(1)=dersc(1)/cos(theti)**2 - dersc12=dersc12/cos(theti)**2 - escloci=-(dlog(escloc_i)-emin) - do j=1,2 - dersc(j)=dersc(j)/escloc_i - enddo - if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) - return - end -#else -c---------------------------------------------------------------------------------- - subroutine esc(escloc) -C Calculate the local energy of a side chain and its derivatives in the -C corresponding virtual-bond valence angles THETA and the spherical angles -C ALPHA and OMEGA derived from AM1 all-atom calculations. -C added by Urszula Kozlowska. 07/11/2007 -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.SCROT' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - include 'COMMON.VECTORS' - double precision x_prime(3),y_prime(3),z_prime(3) - & , sumene,dsc_i,dp2_i,x(65), - & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, - & de_dxx,de_dyy,de_dzz,de_dt - double precision s1_t,s1_6_t,s2_t,s2_6_t - double precision - & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), - & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), - & dt_dCi(3),dt_dCi1(3) - common /sccalc/ time11,time12,time112,theti,it,nlobit - delta=0.02d0*pi - escloc=0.0D0 - do i=loc_start,loc_end - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.eq.10) goto 1 -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo -C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), -C & dc_norm(3,i+nres) - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - do j = 1,3 - z_prime(j) = -uz(j,i-1) - enddo -c write (2,*) "i",i -c write (2,*) "x_prime",(x_prime(j),j=1,3) -c write (2,*) "y_prime",(y_prime(j),j=1,3) -c write (2,*) "z_prime",(z_prime(j),j=1,3) -c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), -c & " xy",scalar(x_prime(1),y_prime(1)), -c & " xz",scalar(x_prime(1),z_prime(1)), -c & " yy",scalar(y_prime(1),y_prime(1)), -c & " yz",scalar(y_prime(1),z_prime(1)), -c & " zz",scalar(z_prime(1),z_prime(1)) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxtab(i)=xx - yytab(i)=yy - zztab(i)=zz -C -C Compute the energy of the ith side cbain -C -c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) - do j = 1,65 - x(j) = sc_parmin(j,it) - enddo -#ifdef CHECK_COORD -Cc diagnostics - remove later - xx1 = dcos(alph(2)) - yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) - write(2,'(3f8.1,3f9.3,1x,3f9.3)') - & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, - & xx1,yy1,zz1 -C," --- ", xx_w,yy_w,zz_w -c end diagnostics -#endif - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) - & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) -c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, -c & sumene4, -c & dscp1,dscp2,sumene -c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - escloc = escloc + sumene -c write (2,*) "i",i," escloc",sumene,escloc -#ifdef DEBUG -C -C This section to check the numerical derivatives of the energy of ith side -C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert -C #define DEBUG in the code to turn it on. -C - write (2,*) "sumene =",sumene - aincr=1.0d-7 - xxsave=xx - xx=xx+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dxx_num=(sumenep-sumene)/aincr - xx=xxsave - write (2,*) "xx+ sumene from enesc=",sumenep - yysave=yy - yy=yy+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dyy_num=(sumenep-sumene)/aincr - yy=yysave - write (2,*) "yy+ sumene from enesc=",sumenep - zzsave=zz - zz=zz+aincr - write (2,*) xx,yy,zz - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dzz_num=(sumenep-sumene)/aincr - zz=zzsave - write (2,*) "zz+ sumene from enesc=",sumenep - costsave=cost2tab(i+1) - sintsave=sint2tab(i+1) - cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) - sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) - sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) - de_dt_num=(sumenep-sumene)/aincr - write (2,*) " t+ sumene from enesc=",sumenep - cost2tab(i+1)=costsave - sint2tab(i+1)=sintsave -C End of diagnostics section. -#endif -C -C Compute the gradient of esc -C - pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 - pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 - pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 - pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 - pom_dx=dsc_i*dp2_i*cost2tab(i+1) - pom_dy=dsc_i*dp2_i*sint2tab(i+1) - pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) - pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) - pom1=(sumene3*sint2tab(i+1)+sumene1) - & *(pom_s1/dscp1+pom_s16*dscp1**4) - pom2=(sumene4*cost2tab(i+1)+sumene2) - & *(pom_s2/dscp2+pom_s26*dscp2**4) - sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy - sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 - & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) - & +x(40)*yy*zz - sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy - sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 - & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) - & +x(60)*yy*zz - de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) - & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) - & +(pom1+pom2)*pom_dx -#ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num -#endif -C - sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz - sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 - & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) - & +x(40)*xx*zz - sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz - sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz - & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz - & +x(59)*zz**2 +x(60)*xx*zz - de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) - & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) - & +(pom1-pom2)*pom_dy -#ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num -#endif -C - de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy - & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx - & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) - & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) - & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 - & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy - & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) - & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) -#ifdef DEBUG - write(2,*), "de_dzz = ", de_dzz,de_dzz_num -#endif -C - de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) - & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) - & +pom1*pom_dt1+pom2*pom_dt2 -#ifdef DEBUG - write(2,*), "de_dt = ", de_dt,de_dt_num -#endif -c -C - cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - cosfac2xx=cosfac2*xx - sinfac2yy=sinfac2*yy - do k = 1,3 - dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* - & vbld_inv(i+1) - dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* - & vbld_inv(i) - pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) - pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) -c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, -c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) -c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), -c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) - dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx - dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx - dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy - dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy - dZZ_Ci1(k)=0.0d0 - dZZ_Ci(k)=0.0d0 - do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) - enddo - - dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) - dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) - dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) -c - dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) - dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) - enddo - - do k=1,3 - dXX_Ctab(k,i)=dXX_Ci(k) - dXX_C1tab(k,i)=dXX_Ci1(k) - dYY_Ctab(k,i)=dYY_Ci(k) - dYY_C1tab(k,i)=dYY_Ci1(k) - dZZ_Ctab(k,i)=dZZ_Ci(k) - dZZ_C1tab(k,i)=dZZ_Ci1(k) - dXX_XYZtab(k,i)=dXX_XYZ(k) - dYY_XYZtab(k,i)=dYY_XYZ(k) - dZZ_XYZtab(k,i)=dZZ_XYZ(k) - enddo - - do k = 1,3 -c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", -c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) -c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", -c & dyy_ci(k)," dzz_ci",dzz_ci(k) -c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", -c & dt_dci(k) -c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", -c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) - gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) - & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) - gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) - & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) - gsclocx(k,i)= de_dxx*dxx_XYZ(k) - & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) - enddo -c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), -c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) - -C to check gradient call subroutine check_grad - - 1 continue - enddo - return - end -c------------------------------------------------------------------------------ - double precision function enesc(x,xx,yy,zz,cost2,sint2) - implicit none - double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, - & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 - sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 - & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy - & + x(10)*yy*zz - sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 - & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy - & + x(20)*yy*zz - sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 - & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy - & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 - & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx - & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy - & +x(40)*xx*yy*zz - sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 - & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy - & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 - & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx - & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy - & +x(60)*xx*yy*zz - dsc_i = 0.743d0+x(61) - dp2_i = 1.9d0+x(62) - dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2+yy*sint2)) - dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i - & *(xx*cost2-yy*sint2)) - s1=(1+x(63))/(0.1d0 + dscp1) - s1_6=(1+x(64))/(0.1d0 + dscp1**6) - s2=(1+x(65))/(0.1d0 + dscp2) - s2_6=(1+x(65))/(0.1d0 + dscp2**6) - sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) - & + (sumene4*cost2 +sumene2)*(s2+s2_6) - enesc=sumene - return - end -#endif -c------------------------------------------------------------------------------ - subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) -C -C This procedure calculates two-body contact function g(rij) and its derivative: -C -C eps0ij ! x < -1 -C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 -C 0 ! x > 1 -C -C where x=(rij-r0ij)/delta -C -C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy -C - implicit none - double precision rij,r0ij,eps0ij,fcont,fprimcont - double precision x,x2,x4,delta -c delta=0.02D0*r0ij -c delta=0.2D0*r0ij - x=(rij-r0ij)/delta - if (x.lt.-1.0D0) then - fcont=eps0ij - fprimcont=0.0D0 - else if (x.le.1.0D0) then - x2=x*x - x4=x2*x2 - fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) - fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta - else - fcont=0.0D0 - fprimcont=0.0D0 - endif - return - end -c------------------------------------------------------------------------------ - subroutine splinthet(theti,delta,ss,ssder) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - thetup=pi-delta - thetlow=delta - if (theti.gt.pipol) then - call gcont(theti,thetup,1.0d0,delta,ss,ssder) - else - call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) - ssder=-ssder - endif - return - end -c------------------------------------------------------------------------------ - subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) - implicit none - double precision x,x0,delta,f0,f1,fprim0,f,fprim - double precision ksi,ksi2,ksi3,a1,a2,a3 - a1=fprim0*delta/(f1-f0) - a2=3.0d0-2.0d0*a1 - a3=a1-2.0d0 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) - fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) - return - end -c------------------------------------------------------------------------------ - subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) - implicit none - double precision x,x0,delta,f0x,f1x,fprim0x,fx - double precision ksi,ksi2,ksi3,a1,a2,a3 - ksi=(x-x0)/delta - ksi2=ksi*ksi - ksi3=ksi2*ksi - a1=fprim0x*delta - a2=3*(f1x-f0x)-2*fprim0x*delta - a3=fprim0x*delta-2*(f1x-f0x) - fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 - return - end -C----------------------------------------------------------------------------- -#ifdef CRYST_TOR -C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Proline-Proline pair is a special case... - if (itori.eq.3 .and. itori1.eq.3) then - if (phii.gt.-dwapi3) then - cosphi=dcos(3*phii) - fac=1.0D0/(1.0D0-cosphi) - etorsi=v1(1,3,3)*fac - etorsi=etorsi+etorsi - etors=etors+etorsi-v1(1,3,3) - if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) - gloci=gloci-3*fac*etorsi*dsin(3*phii) - endif - do j=1,3 - v1ij=v1(j+1,itori,itori1) - v2ij=v2(j+1,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - else - do j=1,nterm_old - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci - write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr - return - end -c------------------------------------------------------------------------------ -c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA - subroutine e_modeller(ehomology_constr) - ehomology_constr=0.0 - write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!" - return - end -C !!!!!!!! NIE CZYTANE !!!!!!!!!!! - -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) - etors_d=0.0d0 - return - end -c---------------------------------------------------------------------------- -#else - subroutine etor(etors,edihcnstr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors=0.0D0 - do i=iphi_start,iphi_end - etors_ii=0.0D0 - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - phii=phi(i) - gloci=0.0D0 -C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - etors=etors+v1ij*cosphi+v2ij*sinphi - if (energy_dec) etors_ii=etors_ii+ - & v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo -C Lorentz terms -C v1 -C E = SUM ----------------------------------- - v1 -C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 -C - cosphi=dcos(0.5d0*phii) - sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) - vl1ij=vlor1(j,itori,itori1) - vl2ij=vlor2(j,itori,itori1) - vl3ij=vlor3(j,itori,itori1) - pom=vl2ij*cosphi+vl3ij*sinphi - pom1=1.0d0/(pom*pom+1.0d0) - etors=etors+vl1ij*pom1 - if (energy_dec) etors_ii=etors_ii+ - & vl1ij*pom1 - pom=-pom*pom1*pom1 - gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom - enddo -C Subtract the constant term - etors=etors-v0(itori,itori1) - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') - & 'etor',i,etors_ii-v0(itori,itori1) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) - gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci -c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) - enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 -c do i=1,ndih_constr - do i=idihconstr_start,idihconstr_end - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else - difi=0.0 - endif -c write (iout,*) "gloci", gloc(i-3,icg) -cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, -cd & rad2deg*phi0(i), rad2deg*drange(i), -cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -cd write (iout,*) 'edihcnstr',edihcnstr - return - end -c---------------------------------------------------------------------------- -c MODELLER restraint function - subroutine e_modeller(ehomology_constr) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - integer nnn, i, j, k, ki, irec, l - integer katy, odleglosci, test7 - real*8 odleg, odleg2, odleg3, kat, kat2, kat3, gdih(max_template) - real*8 distance(max_template),distancek(max_template), - & min_odl,godl(max_template),dih_diff(max_template) - - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - - - do i=1,19 - distancek(i)=9999999.9 - enddo - - - odleg=0.0d0 - -c Pseudo-energy and gradient from homology restraints (MODELLER-like -c function) -C AL 5/2/14 - Introduce list of restraints - do ii = link_start_homo,link_end_homo - i = ires_homo(ii) - j = jres_homo(ii) - dij=dist(i,j) - do k=1,constr_homology - distance(k)=odl(k,ii)-dij - distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii) - enddo - - min_odl=minval(distancek) -#ifdef DEBUG - write (iout,*) "ij dij",i,j,dij - write (iout,*) "distance",(distance(k),k=1,constr_homology) - write (iout,*) "distancek",(distancek(k),k=1,constr_homology) - write (iout,* )"min_odl",min_odl -#endif - odleg2=0.0d0 - do k=1,constr_homology -c Nie wiem po co to liczycie jeszcze raz! -c odleg3=-waga_dist*((distance(i,j,k)**2)/ -c & (2*(sigma_odl(i,j,k))**2)) - godl(k)=dexp(-distancek(k)+min_odl) - odleg2=odleg2+godl(k) - -ccc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3, -ccc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=", -ccc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1), -ccc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k) - - enddo -#ifdef DEBUG - write (iout,*) "godl",(godl(k),k=1,constr_homology) - write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 -#endif - odleg=odleg-dLOG(odleg2/constr_homology)+min_odl -c Gradient - sum_godl=odleg2 - sum_sgodl=0.0 - do k=1,constr_homology -c godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) -c & *waga_dist)+min_odl - sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist - sum_sgodl=sum_sgodl+sgodl - -c sgodl2=sgodl2+sgodl -c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1" -c write(iout,*) "constr_homology=",constr_homology -c write(iout,*) i, j, k, "TEST K" - enddo - - grad_odl3=sum_sgodl/(sum_godl*dij) - - -c write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2" -c write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2), -c & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) - -ccc write(iout,*) godl, sgodl, grad_odl3 - -c grad_odl=grad_odl+grad_odl3 - - do jik=1,3 - ggodl=grad_odl3*(c(jik,i)-c(jik,j)) -ccc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1)) -ccc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl, -ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) - ghpbc(jik,i)=ghpbc(jik,i)+ggodl - ghpbc(jik,j)=ghpbc(jik,j)-ggodl -ccc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl, -ccc & ghpbc(jik,i+1), ghpbc(jik,j+1) - - enddo -ccc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=", -ccc & dLOG(odleg2),"-odleg=", -odleg - - enddo ! ii -c Pseudo-energy and gradient from dihedral-angle restraints from -c homology templates -c write (iout,*) "End of distance loop" -c call flush(iout) - kat=0.0d0 -c write (iout,*) idihconstr_start_homo,idihconstr_end_homo - do i=idihconstr_start_homo,idihconstr_end_homo - kat2=0.0d0 -c betai=beta(i,i+1,i+2,i+3) - betai = phi(i+3) - do k=1,constr_homology - dih_diff(k)=pinorm(dih(k,i)-betai) -c if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)= -c & -(6.28318-dih_diff(i,k)) -c if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)= -c & 6.28318+dih_diff(i,k) - - kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i) - gdih(k)=dexp(kat3) - kat2=kat2+gdih(k) -c write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3) -c write(*,*)"" - enddo -#ifdef DEBUG - write (iout,*) "i",i," betai",betai," kat2",kat2 - write (iout,*) "gdih",(gdih(k),k=1,constr_homology) -#endif - if (kat2.le.1.0d-14) cycle - kat=kat-dLOG(kat2/constr_homology) - -ccc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=", -ccc & dLOG(kat2), "-kat=", -kat - -c ---------------------------------------------------------------------- -c Gradient -c ---------------------------------------------------------------------- - - sum_gdih=kat2 - sum_sgdih=0.0 - do k=1,constr_homology - sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle - sum_sgdih=sum_sgdih+sgdih - enddo - grad_dih3=sum_sgdih/sum_gdih - -c write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3 -ccc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3, -ccc & gloc(nphi+i-3,icg) - gloc(i,icg)=gloc(i,icg)+grad_dih3 -ccc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3, -ccc & gloc(nphi+i-3,icg) - - enddo - - -c Total energy from homology restraints -#ifdef DEBUG - write (iout,*) "odleg",odleg," kat",kat -#endif - ehomology_constr=odleg+kat - return - - 748 format(a8,f12.3,a6,f12.3,a7,f12.3) - 747 format(a12,i4,i4,i4,f8.3,f8.3) - 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3) - 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3) - 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, - & f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3) - end - -c------------------------------------------------------------------------------ - subroutine etor_d(etors_d) -C 6/23/01 Compute double torsional energy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.TORCNSTR' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. - etors_d=0.0D0 - do i=iphid_start,iphid_end - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) - phii=phi(i) - phii1=phi(i+1) - gloci1=0.0D0 - gloci2=0.0D0 - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) - cosphi1=dcos(j*phii) - sinphi1=dsin(j*phii) - cosphi2=dcos(j*phii1) - sinphi2=dsin(j*phii1) - etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ - & v2cij*cosphi2+v2sij*sinphi2 - gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) - gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) - enddo - do k=2,ntermd_2(itori,itori1,itori2) - do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) - cosphi1p2=dcos(l*phii+(k-l)*phii1) - cosphi1m2=dcos(l*phii-(k-l)*phii1) - sinphi1p2=dsin(l*phii+(k-l)*phii1) - sinphi1m2=dsin(l*phii-(k-l)*phii1) - etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ - & v1sdij*sinphi1p2+v2sdij*sinphi1m2 - gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) - gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) - enddo - enddo - gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 - gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 -c write (iout,*) "gloci", gloc(i-3,icg) - enddo - return - end -#endif -c------------------------------------------------------------------------------ - subroutine eback_sc_corr(esccor) -c 7/21/2007 Correlations between the backbone-local and side-chain-local -c conformational states; temporarily implemented as differences -c between UNRES torsional potentials (dependent on three types of -c residues) and the torsional potentials dependent on all 20 types -c of residues computed from AM1 energy surfaces of terminally-blocked -c amino-acid residues. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.CONTROL' - logical lprn -C Set lprn=.true. for debugging - lprn=.false. -c lprn=.true. -c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor - esccor=0.0D0 - do i=itau_start,itau_end - esccor_ii=0.0D0 - isccori=isccortyp(itype(i-2)) - isccori1=isccortyp(itype(i-1)) - phii=phi(i) -cccc Added 9 May 2012 -cc Tauangle is torsional engle depending on the value of first digit -c(see comment below) -cc Omicron is flat angle depending on the value of first digit -c(see comment below) - - - do intertyp=1,3 !intertyp -cc Added 09 May 2012 (Adasko) -cc Intertyp means interaction type of backbone mainchain correlation: -c 1 = SC...Ca...Ca...Ca -c 2 = Ca...Ca...Ca...SC -c 3 = SC...Ca...Ca...SCi - gloci=0.0D0 - if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. - & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or. - & (itype(i-1).eq.21))) - & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) - & .or.(itype(i-2).eq.21))) - & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. - & (itype(i-1).eq.21)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21)) - & cycle - do j=1,nterm_sccor(isccori,isccori1) - v1ij=v1sccor(j,intertyp,isccori,isccori1) - v2ij=v2sccor(j,intertyp,isccori,isccori1) - cosphi=dcos(j*tauangle(intertyp,i)) - sinphi=dsin(j*tauangle(intertyp,i)) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo - gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci -c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi -c &gloc_sc(intertyp,i-3,icg) - if (lprn) - & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,intertyp,itori,itori1),j=1,6) - & ,(v2sccor(j,intertyp,itori,itori1),j=1,6) - gsccor_loc(i-3)=gsccor_loc(i-3)+gloci - enddo !intertyp - enddo -c do i=1,nres -c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - return - end -c---------------------------------------------------------------------------- - subroutine multibody(ecorr) -C This subroutine calculates multi-body contributions to energy following -C the idea of Skolnick et al. If side chains I and J make a contact and -C at the same time side chains I+1 and J+1 make a contact, an extra -C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - -C Set lprn=.true. for debugging - lprn=.false. - - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(i2,20(1x,i2,f10.5))') - & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) - enddo - endif - ecorr=0.0D0 - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo - do i=nnt,nct-2 - - DO ISHIFT = 3,4 - - i1=i+ishift - num_conti=num_cont(i) - num_conti1=num_cont(i1) - do jj=1,num_conti - j=jcont(jj,i) - do kk=1,num_conti1 - j1=jcont(kk,i1) - if (j1.eq.j+ishift .or. j1.eq.j-ishift) then -cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, -cd & ' ishift=',ishift -C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) - endif ! j1==j+-ishift - enddo ! kk - enddo ! jj - - ENDDO ! ISHIFT - - enddo ! i - return - end -c------------------------------------------------------------------------------ - double precision function esccorr(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont(jj,i) - ekl=facont(kk,k) -cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl -C Calculate the multi-body contribution to energy. -C Calculate multi-body contributions to the gradient. -cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), -cd & k,l,(gacont(m,kk,k),m=1,3) - do m=1,3 - gx(m) =ekl*gacont(m,jj,i) - gx1(m)=eij*gacont(m,kk,k) - gradxorr(m,i)=gradxorr(m,i)-gx(m) - gradxorr(m,j)=gradxorr(m,j)+gx(m) - gradxorr(m,k)=gradxorr(m,k)-gx1(m) - gradxorr(m,l)=gradxorr(m,l)+gx1(m) - enddo - do m=i,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) - enddo - enddo - do m=k,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) - enddo - enddo - esccorr=-eij*ekl - return - end -c------------------------------------------------------------------------------ - subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=26) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - double precision gx(3),gx1(3),time00 - logical lprn,ldone - -C Set lprn=.true. for debugging - lprn=.false. -#ifdef MPI - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors -c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end -c call flush(iout) - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.gt.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,i) - zapas(4,nn,iproc)=ees0p(j,i) - zapas(5,nn,iproc)=ees0m(j,i) - zapas(6,nn,iproc)=gacont_hbr(1,j,i) - zapas(7,nn,iproc)=gacont_hbr(2,j,i) - zapas(8,nn,iproc)=gacont_hbr(3,j,i) - zapas(9,nn,iproc)=gacontm_hb1(1,j,i) - zapas(10,nn,iproc)=gacontm_hb1(2,j,i) - zapas(11,nn,iproc)=gacontm_hb1(3,j,i) - zapas(12,nn,iproc)=gacontp_hb1(1,j,i) - zapas(13,nn,iproc)=gacontp_hb1(2,j,i) - zapas(14,nn,iproc)=gacontp_hb1(3,j,i) - zapas(15,nn,iproc)=gacontm_hb2(1,j,i) - zapas(16,nn,iproc)=gacontm_hb2(2,j,i) - zapas(17,nn,iproc)=gacontm_hb2(3,j,i) - zapas(18,nn,iproc)=gacontp_hb2(1,j,i) - zapas(19,nn,iproc)=gacontp_hb2(2,j,i) - zapas(20,nn,iproc)=gacontp_hb2(3,j,i) - zapas(21,nn,iproc)=gacontm_hb3(1,j,i) - zapas(22,nn,iproc)=gacontm_hb3(2,j,i) - zapas(23,nn,iproc)=gacontm_hb3(3,j,i) - zapas(24,nn,iproc)=gacontp_hb3(1,j,i) - zapas(25,nn,iproc)=gacontp_hb3(2,j,i) - zapas(26,nn,iproc)=gacontp_hb3(3,j,i) - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - facont_hb(nnn,ii)=zapas_recv(3,i,iii) - ees0p(nnn,ii)=zapas_recv(4,i,iii) - ees0m(nnn,ii)=zapas_recv(5,i,iii) - gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii) - gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii) - gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii) - gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii) - gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii) - gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii) - gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii) - gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii) - gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii) - gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii) - gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii) - gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii) - gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii) - gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii) - gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii) - gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii) - gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii) - gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii) - gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii) - gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii) - gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii) - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the local-electrostatic correlation terms - do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end) - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0) - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) - n_corr=n_corr+1 - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 - enddo ! kk - enddo ! jj - enddo ! i - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=26) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=facont_hb(j,ii) - zapas(4,nn,iproc)=ees0p(j,ii) - zapas(5,nn,iproc)=ees0m(j,ii) - zapas(6,nn,iproc)=gacont_hbr(1,j,ii) - zapas(7,nn,iproc)=gacont_hbr(2,j,ii) - zapas(8,nn,iproc)=gacont_hbr(3,j,ii) - zapas(9,nn,iproc)=gacontm_hb1(1,j,ii) - zapas(10,nn,iproc)=gacontm_hb1(2,j,ii) - zapas(11,nn,iproc)=gacontm_hb1(3,j,ii) - zapas(12,nn,iproc)=gacontp_hb1(1,j,ii) - zapas(13,nn,iproc)=gacontp_hb1(2,j,ii) - zapas(14,nn,iproc)=gacontp_hb1(3,j,ii) - zapas(15,nn,iproc)=gacontm_hb2(1,j,ii) - zapas(16,nn,iproc)=gacontm_hb2(2,j,ii) - zapas(17,nn,iproc)=gacontm_hb2(3,j,ii) - zapas(18,nn,iproc)=gacontp_hb2(1,j,ii) - zapas(19,nn,iproc)=gacontp_hb2(2,j,ii) - zapas(20,nn,iproc)=gacontp_hb2(3,j,ii) - zapas(21,nn,iproc)=gacontm_hb3(1,j,ii) - zapas(22,nn,iproc)=gacontm_hb3(2,j,ii) - zapas(23,nn,iproc)=gacontm_hb3(3,j,ii) - zapas(24,nn,iproc)=gacontp_hb3(1,j,ii) - zapas(25,nn,iproc)=gacontp_hb3(2,j,ii) - zapas(26,nn,iproc)=gacontp_hb3(3,j,ii) - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, - & n_corr1) -C This subroutine calculates multi-body contributions to hydrogen-bonding - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPI - include "mpif.h" - parameter (max_cont=maxconts) - parameter (max_dim=70) - integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer status(MPI_STATUS_SIZE),req(maxconts*2), - & status_array(MPI_STATUS_SIZE,maxconts*2) -#endif - include 'COMMON.SETUP' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.CONTROL' - double precision gx(3),gx1(3) - integer num_cont_hb_old(maxres) - logical lprn,ldone - double precision eello4,eello5,eelo6,eello_turn6 - external eello4,eello5,eello6,eello_turn6 -C Set lprn=.true. for debugging - lprn=.false. - eturn6=0.0d0 -#ifdef MPI - do i=1,nres - num_cont_hb_old(i)=num_cont_hb(i) - enddo - n_corr=0 - n_corr1=0 - if (nfgtasks.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values before RECEIVE:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif - call flush(iout) - do i=1,ntask_cont_from - ncont_recv(i)=0 - enddo - do i=1,ntask_cont_to - ncont_sent(i)=0 - enddo -c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to", -c & ntask_cont_to -C Make the list of contacts to send to send to other procesors - do i=iturn3_start,iturn3_end -c write (iout,*) "make contact list turn3",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i)) - enddo - do i=iturn4_start,iturn4_end -c write (iout,*) "make contact list turn4",i," num_cont", -c & num_cont_hb(i) - call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i)) - enddo - do ii=1,nat_sent - i=iat_sent(ii) -c write (iout,*) "make contact list longrange",i,ii," num_cont", -c & num_cont_hb(i) - do j=1,num_cont_hb(i) - do k=1,4 - jjc=jcont_hb(j,i) - iproc=iint_sent_local(k,jjc,ii) -c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc - if (iproc.ne.0) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=i - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,i) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i) - enddo - enddo - enddo - enddo - endif - enddo - enddo - enddo - if (lprn) then - write (iout,*) - & "Numbers of contacts to be sent to other processors", - & (ncont_sent(i),i=1,ntask_cont_to) - write (iout,*) "Contacts sent" - do ii=1,ntask_cont_to - nn=ncont_sent(ii) - iproc=itask_cont_to(ii) - write (iout,*) nn," contacts to processor",iproc, - & " of CONT_TO_COMM group" - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10) - enddo - enddo - call flush(iout) - endif - CorrelType=477 - CorrelID=fg_rank+1 - CorrelType1=478 - CorrelID1=nfgtasks+fg_rank+1 - ireq=0 -C Receive the numbers of needed contacts from other processors - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - ireq=ireq+1 - call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "IRECV ended" -c call flush(iout) -C Send the number of contacts needed by other processors - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - ireq=ireq+1 - call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType, - & FG_COMM,req(ireq),IERR) - enddo -c write (iout,*) "ISEND ended" -c write (iout,*) "number of requests (nn)",ireq - call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) -c write (iout,*) -c & "Numbers of contacts to be received from other processors", -c & (ncont_recv(i),i=1,ntask_cont_from) -c call flush(iout) -C Receive contacts - ireq=0 - do ii=1,ntask_cont_from - iproc=itask_cont_from(ii) - nn=ncont_recv(ii) -c write (iout,*) "Receiving",nn," contacts from processor",iproc, -c & " of CONT_TO_COMM group" - call flush(iout) - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim, - & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) - endif - enddo -C Send the contacts to processors that need them - do ii=1,ntask_cont_to - iproc=itask_cont_to(ii) - nn=ncont_sent(ii) -c write (iout,*) nn," contacts to processor",iproc, -c & " of CONT_TO_COMM group" - if (nn.gt.0) then - ireq=ireq+1 - call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION, - & iproc,CorrelType1,FG_COMM,req(ireq),IERR) -c write (iout,*) "ireq,req",ireq,req(ireq) -c do i=1,nn -c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5) -c enddo - endif - enddo -c write (iout,*) "number of requests (contacts)",ireq -c write (iout,*) "req",(req(i),i=1,4) -c call flush(iout) - if (ireq.gt.0) - & call MPI_Waitall(ireq,req,status_array,ierr) - do iii=1,ntask_cont_from - iproc=itask_cont_from(iii) - nn=ncont_recv(iii) - if (lprn) then - write (iout,*) "Received",nn," contacts from processor",iproc, - & " of CONT_FROM_COMM group" - call flush(iout) - do i=1,nn - write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10) - enddo - call flush(iout) - endif - do i=1,nn - ii=zapas_recv(1,i,iii) -c Flag the received contacts to prevent double-counting - jj=-zapas_recv(2,i,iii) -c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj -c call flush(iout) - nnn=num_cont_hb(ii)+1 - num_cont_hb(ii)=nnn - jcont_hb(nnn,ii)=jj - d_cont(nnn,ii)=zapas_recv(3,i,iii) - ind=3 - do kk=1,3 - ind=ind+1 - grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - if (lprn) then - write (iout,'(a)') 'Contact function values after receive:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i3,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - call flush(iout) - endif - 30 continue -#endif - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,5f6.3))') - & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), - & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) - enddo - endif - ecorr=0.0D0 - ecorr5=0.0d0 - ecorr6=0.0d0 -C Remove the loop below after debugging !!! - do i=nnt,nct - do j=1,3 - gradcorr(j,i)=0.0D0 - gradxorr(j,i)=0.0D0 - enddo - enddo -C Calculate the dipole-dipole interaction energies - if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then - do i=iatel_s,iatel_e+1 - num_conti=num_cont_hb(i) - do jj=1,num_conti - j=jcont_hb(jj,i) -#ifdef MOMENT - call dipole(i,j,jj) -#endif - enddo - enddo - endif -C Calculate the local-electrostatic correlation terms -c write (iout,*) "gradcorr5 in eello5 before loop" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) -c write (iout,*) "corr loop i",i - i1=i+1 - num_conti=num_cont_hb(i) - num_conti1=num_cont_hb(i+1) - do jj=1,num_conti - j=jcont_hb(jj,i) - jp=iabs(j) - do kk=1,num_conti1 - j1=jcont_hb(kk,i1) - jp1=iabs(j1) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk -c if (j1.eq.j+1 .or. j1.eq.j-1) then - if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 - & .or. j.lt.0 .and. j1.gt.0) .and. - & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then -C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. -C The system gains extra energy. - n_corr=n_corr+1 - sqd1=dsqrt(d_cont(jj,i)) - sqd2=dsqrt(d_cont(kk,i1)) - sred_geom = sqd1*sqd2 - IF (sred_geom.lt.cutoff_corr) THEN - call gcont(sred_geom,r0_corr,1.0D0,delt_corr, - & ekont,fprimcont) -cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, -cd & ' jj=',jj,' kk=',kk - fac_prim1=0.5d0*sqd2/sqd1*fprimcont - fac_prim2=0.5d0*sqd1/sqd2*fprimcont - do l=1,3 - g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) - g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) - enddo - n_corr1=n_corr1+1 -cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont, -cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 -cd write (iout,*) "g_contij",g_contij -cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) -cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) - call calc_eello(i,jp,i+1,jp1,jj,kk) - if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) - if (energy_dec.and.wcorr4.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 before eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) -c write (iout,*) "gradcorr5 after eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - if (energy_dec.and.wcorr5.gt.0.0d0) - 1 write (iout,'(a6,4i5,0pf7.3)') - 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) -cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,jp,i+1,jp1 - if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 - & .or. wturn6.eq.0.0d0))then -cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) -cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, -cd & 'ecorr6=',ecorr6 -cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), -cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) - else if (wturn6.gt.0.0d0 - & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 - eturn6=eturn6+eello_turn6(i,jj,kk) - if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') - 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - endif - enddo ! kk - enddo ! jj - enddo ! i - do i=1,nres - num_cont_hb(i)=num_cont_hb_old(i) - enddo -c write (iout,*) "gradcorr5 in eello5" -c do iii=1,nres -c write (iout,'(i5,3f10.5)') -c & iii,(gradcorr5(jjj,iii),jjj=1,3) -c enddo - return - end -c------------------------------------------------------------------------------ - subroutine add_hb_contact_eello(ii,jj,itask) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.IOUNITS" - integer max_cont - integer max_dim - parameter (max_cont=maxconts) - parameter (max_dim=70) - include "COMMON.CONTACTS" - double precision zapas(max_dim,maxconts,max_fg_procs), - & zapas_recv(max_dim,maxconts,max_fg_procs) - common /przechowalnia/ zapas - integer i,j,ii,jj,iproc,itask(4),nn -c write (iout,*) "itask",itask - do i=1,2 - iproc=itask(i) - if (iproc.gt.0) then - do j=1,num_cont_hb(ii) - jjc=jcont_hb(j,ii) -c write (iout,*) "send turns i",ii," j",jj," jjc",jjc - if (jjc.eq.jj) then - ncont_sent(iproc)=ncont_sent(iproc)+1 - nn=ncont_sent(iproc) - zapas(1,nn,iproc)=ii - zapas(2,nn,iproc)=jjc - zapas(3,nn,iproc)=d_cont(j,ii) - ind=3 - do kk=1,3 - ind=ind+1 - zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii) - enddo - do kk=1,2 - do ll=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii) - enddo - enddo - do jj=1,5 - do kk=1,3 - do ll=1,2 - do mm=1,2 - ind=ind+1 - zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii) - enddo - enddo - enddo - enddo - exit - endif - enddo - endif - enddo - return - end -c------------------------------------------------------------------------------ - double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - double precision gx(3),gx1(3) - logical lprn - lprn=.false. - eij=facont_hb(jj,i) - ekl=facont_hb(kk,k) - ees0pij=ees0p(jj,i) - ees0pkl=ees0p(kk,k) - ees0mij=ees0m(jj,i) - ees0mkl=ees0m(kk,k) - ekont=eij*ekl - ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) -cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) -C Following 4 lines for diagnostics. -cd ees0pkl=0.0D0 -cd ees0pij=1.0D0 -cd ees0mkl=0.0D0 -cd ees0mij=1.0D0 -c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') -c & 'Contacts ',i,j, -c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, -c & 'gradcorr_long' -C Calculate the multi-body contribution to energy. -c ecorr=ecorr+ekont*ees -C Calculate multi-body contributions to the gradient. - coeffpees0pij=coeffp*ees0pij - coeffmees0mij=coeffm*ees0mij - coeffpees0pkl=coeffp*ees0pkl - coeffmees0mkl=coeffm*ees0mkl - do ll=1,3 -cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi - & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb2(ll,jj,i)) -cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ - & coeffmees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk - & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ - & coeffmees0mij*gacontm_hb2(ll,kk,k)) - gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffmees0mkl*gacontm_hb3(ll,jj,i)) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij - gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ - & coeffmees0mij*gacontm_hb3(ll,kk,k)) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl -c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl - enddo -c write (iout,*) -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*ekl*gacont_hbr(ll,jj,i)- -cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ -cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ -cgrad & ees*eij*gacont_hbr(ll,kk,k)- -cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ -cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) -cgrad enddo -cgrad enddo -c write (iout,*) "ehbcorr",ekont*ees - ehbcorr=ekont*ees - return - end -#ifdef MOMENT -C--------------------------------------------------------------------------- - subroutine dipole(i,j,jj) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), - & auxmat(2,2) - iti1 = itortyp(itype(i+1)) - if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - do iii=1,2 - dipi(iii,1)=Ub2(iii,i) - dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) - dipj(iii,1)=Ub2(iii,j) - dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) - enddo - kkk=0 - do iii=1,2 - call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) - do jjj=1,2 - kkk=kkk+1 - dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - do kkk=1,5 - do lll=1,3 - mmm=0 - do iii=1,2 - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), - & auxvec(1)) - do jjj=1,2 - mmm=mmm+1 - dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) - enddo - enddo - enddo - enddo - call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) - call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) - do iii=1,2 - dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) - enddo - call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) - do iii=1,2 - dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) - enddo - return - end -#endif -C--------------------------------------------------------------------------- - subroutine calc_eello(i,j,k,l,jj,kk) -C -C This subroutine computes matrices and vectors needed to calculate -C the fourth-, fifth-, and sixth-order local-electrostatic terms. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), - & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) - logical lprn - common /kutas/ lprn -cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, -cd & ' jj=',jj,' kk=',kk -cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return -cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) -cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) - do iii=1,2 - do jjj=1,2 - aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) - aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) - enddo - enddo - call transpose2(aa1(1,1),aa1t(1,1)) - call transpose2(aa2(1,1),aa2t(1,1)) - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), - & aa1tder(1,1,lll,kkk)) - call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), - & aa2tder(1,1,lll,kkk)) - enddo - enddo - if (l.eq.j+1) then -C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -C A1 kernel(j+1) A2T -cd do iii=1,2 -cd write (iout,'(3f10.5,5x,3f10.5)') -cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) -cd enddo - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), - & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - lprn=.false. - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), - & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants -cd lprn=.false. -cd if (lprn) then -cd write (2,*) 'In calc_eello6' -cd do iii=1,2 -cd write (2,*) 'iii=',iii -cd do kkk=1,5 -cd write (2,*) 'kkk=',kkk -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) -cd enddo -cd enddo -cd enddo -cd endif - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A1T kernel(i+1) A2 - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0) THEN - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), - & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - else -C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1) then - iti=itortyp(itype(i)) - else - iti=ntortyp+1 - endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif -C A2 kernel(j-1)T A1T - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), - & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), - & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) - call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), - & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), - & ADtEAderx(1,1,1,1,1,1)) - call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), - & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), - & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), - & ADtEA1derx(1,1,1,1,1,1)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & EAEAderx(1,1,lll,kkk,iii,1)) - enddo - enddo - enddo -C A2T kernel(i+1)T A1 - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), - & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) -C Following matrices are needed only for 6-th order cumulants - IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. - & j.eq.i+4 .and. l.eq.i+3)) THEN - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), - & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), - & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), - & ADtEAderx(1,1,1,1,1,2)) - call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), - & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), - & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), - & ADtEA1derx(1,1,1,1,1,2)) - ENDIF -C End 6-th order cumulants - call transpose2(EUgder(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & EAEAderx(1,1,lll,kkk,iii,2)) - enddo - enddo - enddo -C AEAb1 and AEAb2 -C Calculate the vectors and their derivatives in virtual-bond dihedral angles. -C They are needed only when the fifth- or the sixth-order cumulants are -C indluded. - IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. - & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) - call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) - call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) - call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) - call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) - call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) - call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) - call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) - call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) - call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) - call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) - call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) -C Calculate the Cartesian derivatives of the vectors. - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), - & AEAb1derx(1,lll,kkk,iii,1,1)) - call matvec2(auxmat(1,1),Ub2(1,i), - & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & AEAb1derx(1,lll,kkk,iii,2,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), - & AEAb2derx(1,lll,kkk,iii,2,1)) - call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), - & AEAb1derx(1,lll,kkk,iii,1,2)) - call matvec2(auxmat(1,1),Ub2(1,l), - & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), - & AEAb1derx(1,lll,kkk,iii,2,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), - & AEAb2derx(1,lll,kkk,iii,2,2)) - enddo - enddo - enddo - ENDIF -C End vectors - endif - return - end -C--------------------------------------------------------------------------- - subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, - & KK,KKderg,AKA,AKAderg,AKAderx) - implicit none - integer nderg - logical transp - double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), - & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), - & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) - integer iii,kkk,lll - integer jjj,mmm - logical lprn - common /kutas/ lprn - call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) - do iii=1,nderg - call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, - & AKAderg(1,1,iii)) - enddo -cd if (lprn) write (2,*) 'In kernel' - do kkk=1,5 -cd if (lprn) write (2,*) 'kkk=',kkk - do lll=1,3 - call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=1' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) -cd enddo -cd endif - call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), - & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) -cd if (lprn) then -cd write (2,*) 'lll=',lll -cd write (2,*) 'iii=2' -cd do jjj=1,2 -cd write (2,'(3(2f10.5),5x)') -cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) -cd enddo -cd endif - enddo - enddo - return - end -C--------------------------------------------------------------------------- - double precision function eello4(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then -cd eello4=0.0d0 -cd return -cd endif -cd print *,'eello4:',i,j,k,l,jj,kk -cd write (2,*) 'i',i,' j',j,' k',k,' l',l -cd call checkint4(i,j,k,l,jj,kk,eel4_num) -cold eij=facont_hb(jj,i) -cold ekl=facont_hb(kk,k) -cold ekont=eij*ekl - eel4=-EAEA(1,1,1)-EAEA(2,2,1) -cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) - gcorr_loc(k-1)=gcorr_loc(k-1) - & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) - if (l.eq.j+1) then - gcorr_loc(l-1)=gcorr_loc(l-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - else - gcorr_loc(j-1)=gcorr_loc(j-1) - & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) - & -EAEAderx(2,2,lll,kkk,iii,1) -cd derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd gcorr_loc(l-1)=0.0d0 -cd gcorr_loc(j-1)=0.0d0 -cd gcorr_loc(k-1)=0.0d0 -cd eel4=1.0d0 -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l, -cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel4*g_contij(ll,1) -cgrad ggg2(ll)=eel4*g_contij(ll,2) - glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) - glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) -cgrad ghalf=0.5d0*ggg1(ll) - gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) - gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) - gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) - gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij - gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij -cgrad ghalf=0.5d0*ggg2(ll) - gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) - gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) - gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) - gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl - gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl - enddo -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,gcorr_loc(iii) -cd enddo - eello4=ekont*eel4 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello4',ekont*eel4 - return - end -C--------------------------------------------------------------------------- - double precision function eello5(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) - double precision ggg1(3),ggg2(3) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel chains C -C C -C o o o o C -C /l\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j| o |l1 | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C Antiparallel chains C -C C -C o o o o C -C /j\ / \ \ / \ / \ / C -C / \ / \ \ / \ / \ / C -C j1| o |l | o | o| o | | o |o C -C \ |/k\| |/ \| / |/ \| |/ \| C -C \i/ \ / \ / / \ / \ C -C o k1 o C -C (I) (II) (III) (IV) C -C C -C eello5_1 eello5_2 eello5_3 eello5_4 C -C C -C o denotes a local interaction, vertical lines an electrostatic interaction. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then -cd eello5=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - eello5_1=0.0d0 - eello5_2=0.0d0 - eello5_3=0.0d0 - eello5_4=0.0d0 -cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, -cd & eel5_3_num,eel5_4_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd write (iout,*)'Contacts have occurred for peptide groups', -cd & i,j,' fcont:',eij,' eij',' and ',k,l -cd goto 1111 -C Contribution from the graph I. -cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) -cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) -C Explicit gradient in virtual-dihedral angles. - if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - if (l.eq.j+1) then - if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - else - if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - enddo - enddo - enddo -c goto 1112 -c1111 continue -C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) - call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - if (l.eq.j+1) then - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - else - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k))) - endif -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) - & -0.5d0*scalar2(vv(1),Ctobr(1,k)) - enddo - enddo - enddo -cd goto 1112 -cd1111 continue - if (l.eq.j+1) then -cd goto 1110 -C Parallel orientation -C Contribution from graph III - call transpose2(EUg(1,1,l),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) - call transpose2(EUgder(1,1,l),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) - & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - enddo - enddo - enddo - else -C Antiparallel orientation -C Contribution from graph III -c goto 1110 - call transpose2(EUg(1,1,j),auxmat(1,1)) - call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) - call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) - call transpose2(EUgder(1,1,j),auxmat1(1,1)) - call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) - & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) - enddo - enddo - enddo -cd goto 1112 -C Contribution from graph IV -1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) - call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) -C Explicit gradient in virtual-dihedral angles. - g_corr5_loc(j-1)=g_corr5_loc(j-1) - & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) - call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j))) -C Cartesian gradient - do iii=1,2 - do kkk=1,5 - do lll=1,3 - call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) - & -0.5d0*scalar2(vv(1),Ctobr(1,j)) - enddo - enddo - enddo - endif -1112 continue - eel5=eello5_1+eello5_2+eello5_3+eello5_4 -cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then -cd write (2,*) 'ijkl',i,j,k,l -cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, -cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 -cd endif -cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num -cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num -cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num -cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 -cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont -C 2/11/08 AL Gradients over DC's connecting interacting sites will be -C summed up outside the subrouine as for the other subroutines -C handling long-range interactions. The old code is commented out -C with "cgrad" to keep track of changes. - do ll=1,3 -cgrad ggg1(ll)=eel5*g_contij(ll,1) -cgrad ggg2(ll)=eel5*g_contij(ll,2) - gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) -c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') -c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), -c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), -c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont -c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') -c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), -c & gradcorr5ij, -c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl -cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) - gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) - gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) - gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij - gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij -cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) - gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) - gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) - gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl - gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -c1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr5_loc(iii) -cd enddo - eello5=ekont*eel5 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello5',ekont*eel5 - return - end -c-------------------------------------------------------------------------- - double precision function eello6(i,j,k,l,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision ggg1(3),ggg2(3) -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l - eello6_1=0.0d0 - eello6_2=0.0d0 - eello6_3=0.0d0 - eello6_4=0.0d0 - eello6_5=0.0d0 - eello6_6=0.0d0 -cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, -cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=facont_hb(jj,i) -cd ekl=facont_hb(kk,k) -cd ekont=eij*ekl -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - if (l.eq.j+1) then - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(j,i,l,k,2,.false.) - eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) - eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) - else - eello6_1=eello6_graph1(i,j,k,l,1,.false.) - eello6_2=eello6_graph1(l,k,j,i,2,.true.) - eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) - eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) - if (wturn6.eq.0.0d0 .or. j.ne.i+4) then - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) - else - eello6_5=0.0d0 - endif - eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) - endif -C If turn contributions are considered, they will be handled separately. - eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel6*g_contij(ll,1) -cgrad ggg2(ll)=eel6*g_contij(ll,2) -cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) - gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) - gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) - gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) - gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij - gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij -cgrad ghalf=0.5d0*ggg2(ll) -cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) -cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) - gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) - gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) - gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl - gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello6=ekont*eel6 -cd write (2,*) 'ekont',ekont -cd write (iout,*) 'eello6',ekont*eel6 - return - end -c-------------------------------------------------------------------------- - double precision function eello6_graph1(i,j,k,l,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) - logical swap - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C Parallel Antiparallel -C -C o o -C /l\ /j\ -C / \ / \ -C /| o | | o |\ -C \ j|/k\| / \ |/k\|l / -C \ / \ / \ / \ / -C o o o o -C i i -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) - s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 - eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) - & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) - & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) - & +scalar2(vv(1),Dtobr2der(1,i))) - call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) - if (l.eq.j+1) then - g_corr6_loc(l-1)=g_corr6_loc(l-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1) - & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) - & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) - & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) - endif - call transpose2(EUgCder(1,1,k),auxmat(1,1)) - call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) - & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) - & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) - & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) - do iii=1,2 - if (swap) then - ind=3-iii - else - ind=iii - endif - do kkk=1,5 - do lll=1,3 - s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) - s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) - s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) - call transpose2(EUgC(1,1,k),auxmat(1,1)) - call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda1(1,1)) - vv1(1)=pizda1(1,1)-pizda1(2,2) - vv1(2)=pizda1(1,2)+pizda1(2,1) - s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) - s5=scalar2(vv(1),Dtobr2(1,i)) - derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph2(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - logical swap - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(2),auxmat1(2,2) - logical lprn - common /kutas/ lprn -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C \ /l\ /j\ / C -C \ / \ / \ / C -C o| o | | o |o C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l -C AL 7/4/01 s1 would occur in the sixth-order moment, -C but not in a cluster cumulant -#ifdef MOMENT - s1=dip(1,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph2=-(s1+s2+s3+s4) -#else - eello6_graph2=-(s2+s3+s4) -#endif -c eello6_graph2=-s3 -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - s1=dipderg(1,jj,i)*dip(1,kk,k) -#endif - s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(1,kk,k) -#endif - call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif -c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 -C Derivatives in gamma(j-1) or gamma(l-1) - if (j.gt.1) then -#ifdef MOMENT - s1=dipderg(3,jj,i)*dip(1,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) - call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - endif -#endif - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) -c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 - endif -C Derivatives in gamma(l-1) or gamma(j-1) - if (l.gt.1) then -#ifdef MOMENT - s1=dip(1,jj,i)*dipderg(3,kk,k) -#endif - call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) - call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) - call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -#ifdef MOMENT - if (swap) then - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 - else - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 - endif -#endif - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) -c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 - endif -C Cartesian derivatives. - if (lprn) then - write (2,*) 'In eello6_graph2' - do iii=1,2 - write (2,*) 'iii=',iii - do kkk=1,5 - write (2,*) 'kkk=',kkk - do jjj=1,2 - write (2,'(3(2f10.5),5x)') - & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) - enddo - enddo - enddo - endif - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) - else - s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) - endif -#endif - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), - & auxvec(1)) - s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), - & auxvec(1)) - s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(1,2)+pizda(2,1) - s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph3(i,j,k,l,jj,kk,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C j|/k\| / |/k\|l / C -C / \ / / \ / C -C / o / o C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -#ifdef MOMENT - s1=dip(4,jj,i)*dip(4,kk,k) -#endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) - call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, -cd & "sum",-(s2+s3+s4) -#ifdef MOMENT - eello6_graph3=-(s1+s2+s3+s4) -#else - eello6_graph3=-(s2+s3+s4) -#endif -c eello6_graph3=-s4 -C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) -C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) - else - s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), - & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), - & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), - & pizda(1,1)) - vv(1)=pizda(1,1)+pizda(2,2) - vv(2)=pizda(2,1)-pizda(1,2) - s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (swap) then - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif -c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxmat1(2,2) - logical swap -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C Parallel Antiparallel C -C C -C o o C -C /l\ / \ /j\ C -C / \ / \ / \ C -C /| o |o o| o |\ C -C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C -C o \ o \ C -C i i C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C 4/7/01 AL Component s1 was removed, because it pertains to the respective -C energy moment and not to the cluster cumulant. -cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) - else - itj1=ntortyp+1 - endif - itk=itortyp(itype(k)) - if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) - else - itk1=ntortyp+1 - endif - itl=itortyp(itype(l)) - if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) - else - itl1=ntortyp+1 - endif -cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l -cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, -cd & ' itl',itl,' itl1',itl1 -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dip(3,kk,k) - else - s1=dip(2,jj,j)*dip(2,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUg(1,1,k),auxmat(1,1)) - call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) -cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 -#ifdef MOMENT - eello6_graph4=-(s1+s2+s3+s4) -#else - eello6_graph4=-(s2+s3+s4) -#endif -C Derivatives in gamma(i-1) - if (i.gt.1) then -#ifdef MOMENT - if (imat.eq.1) then - s1=dipderg(2,jj,i)*dip(3,kk,k) - else - s1=dipderg(4,jj,j)*dip(2,kk,l) - endif -#endif - s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -cd write (2,*) 'turn6 derivatives' -#ifdef MOMENT - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) -#endif - endif - endif -C Derivatives in gamma(k-1) -#ifdef MOMENT - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderg(2,kk,k) - else - s1=dip(2,jj,j)*dipderg(4,kk,l) - endif -#endif - call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) - else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) - endif - call transpose2(EUgder(1,1,k),auxmat1(1,1)) - call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) -#else - gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) -#endif - else -#ifdef MOMENT - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) -#else - g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) -#endif - endif -C Derivatives in gamma(j-1) or gamma(l-1) - if (l.eq.j+1 .and. l.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) - else if (j.gt.1) then - call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then - gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) - else - g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) - endif - endif -C Cartesian derivatives. - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - if (iii.eq.1) then - if (imat.eq.1) then - s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) - else - s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) - endif - else - if (imat.eq.1) then - s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) - else - s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) - endif - endif -#endif - call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), - & auxvec(1)) - s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) - if (j.eq.l+1) then - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) - else - call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) - endif - call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), - & pizda(1,1)) - vv(1)=pizda(1,1)-pizda(2,2) - vv(2)=pizda(2,1)+pizda(1,2) - s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) - if (swap) then - if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then -#ifdef MOMENT - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s1+s2+s4) -#else - derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) - & -(s2+s4) -#endif - derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 - else -#ifdef MOMENT - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) -#else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) -#endif - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - endif - else -#ifdef MOMENT - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) -#else - derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) -#endif - if (l.eq.j+1) then - derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 - else - derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 - endif - endif - enddo - enddo - enddo - return - end -c---------------------------------------------------------------------------- - double precision function eello_turn6(i,jj,kk) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' - include 'COMMON.VAR' - include 'COMMON.GEO' - double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), - & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), - & ggg1(3),ggg2(3) - double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), - & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) -C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to -C the respective energy moment and not to the cluster cumulant. - s1=0.0d0 - s8=0.0d0 - s13=0.0d0 -c - eello_turn6=0.0d0 - j=i+4 - k=i+1 - l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) -cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj -cd write (2,*) 'i',i,' k',k,' j',j,' l',l -cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then -cd eello6=0.0d0 -cd return -cd endif -cd write (iout,*) -cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, -cd & ' and',k,l -cd call checkint_turn6(i,jj,kk,eel_turn6_num) - do iii=1,2 - do kkk=1,5 - do lll=1,3 - derx_turn(lll,kkk,iii)=0.0d0 - enddo - enddo - enddo -cd eij=1.0d0 -cd ekl=1.0d0 -cd ekont=1.0d0 - eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) -cd eello6_5=0.0d0 -cd write (2,*) 'eello6_5',eello6_5 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmat(1,1)) - call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) - s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atemp(1,1)) - call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) - s12 = scalar2(Ub2(1,i+2),vtemp3(1)) -#ifdef MOMENT - call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) - call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) - call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) - s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#endif -c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 -c s1=0.0d0 -c s2=0.0d0 -c s8=0.0d0 -c s12=0.0d0 -c s13=0.0d0 - eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) -C Derivatives in gamma(i+2) - s1d =0.0d0 - s8d =0.0d0 -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 - call transpose2(AEAderg(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 - gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) -C Derivatives in gamma(i+3) -#ifdef MOMENT - call transpose2(AEA(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) -#endif - s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+1)=gel_loc_turn6(i+1) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Derivatives in gamma(i+4) - call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) - s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -C s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) -#else - gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) -#endif -C Derivatives in gamma(i+5) -#ifdef MOMENT - call transpose2(AEAderg(1,1,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) - call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEA(1,1,2),atempd(1,1)) - call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -#ifdef MOMENT - call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#endif -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) -#else - gel_loc_turn6(i+3)=gel_loc_turn6(i+3) - & -0.5d0*ekont*(s2d+s12d) -#endif -C Cartesian derivatives - do iii=1,2 - do kkk=1,5 - do lll=1,3 -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) - call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), - & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) -#ifdef MOMENT - call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) - call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#endif - call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), - & auxmatd(1,1)) - call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) - s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) -c s1d=0.0d0 -c s2d=0.0d0 -c s8d=0.0d0 -c s12d=0.0d0 -c s13d=0.0d0 -#ifdef MOMENT - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*(s1d+s2d) -#else - derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) - & - 0.5d0*s2d -#endif -#ifdef MOMENT - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*(s8d+s12d) -#else - derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) - & - 0.5d0*s12d -#endif - enddo - enddo - enddo -#ifdef MOMENT - do kkk=1,5 - do lll=1,3 - call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), - & achuj_tempd(1,1)) - call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) - call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) - s13d=(gtempd(1,1)+gtempd(2,2))*ss13 - derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d - call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), - & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) - s13d = (gtemp(1,1)+gtemp(2,2))*ss13d - derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d - enddo - enddo -#endif -cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', -cd & 16*eel_turn6_num -cd goto 1112 - if (j.lt.nres-1) then - j1=j+1 - j2=j-1 - else - j1=j-1 - j2=j-2 - endif - if (l.lt.nres-1) then - l1=l+1 - l2=l-1 - else - l1=l-1 - l2=l-2 - endif - do ll=1,3 -cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) -cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) -cgrad ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) - gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf - & +ekont*derx_turn(ll,2,1) - gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf - & +ekont*derx_turn(ll,4,1) - gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij - gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij -cgrad ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf - & +ekont*derx_turn(ll,2,2) - gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf - & +ekont*derx_turn(ll,4,2) - gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) - gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl - gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl - enddo -cd goto 1112 -cgrad do m=i+1,j-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) -cgrad enddo -cgrad enddo -cgrad do m=k+1,l-1 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) -cgrad enddo -cgrad enddo -cgrad1112 continue -cgrad do m=i+2,j2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) -cgrad enddo -cgrad enddo -cgrad do m=k+2,l2 -cgrad do ll=1,3 -cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) -cgrad enddo -cgrad enddo -cd do iii=1,nres-3 -cd write (2,*) iii,g_corr6_loc(iii) -cd enddo - eello_turn6=ekont*eel_turn6 -cd write (2,*) 'ekont',ekont -cd write (2,*) 'eel_turn6',ekont*eel_turn6 - return - end - -C----------------------------------------------------------------------------- - double precision function scalar(u,v) -!DIR$ INLINEALWAYS scalar -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::scalar -#endif - implicit none - double precision u(3),v(3) -cd double precision sc -cd integer i -cd sc=0.0d0 -cd do i=1,3 -cd sc=sc+u(i)*v(i) -cd enddo -cd scalar=sc - - scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -crc------------------------------------------------- - SUBROUTINE MATVEC2(A1,V1,V2) -!DIR$ INLINEALWAYS MATVEC2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),V1(2),V2(2) -c DO 1 I=1,2 -c VI=0.0 -c DO 3 K=1,2 -c 3 VI=VI+A1(I,K)*V1(K) -c Vaux(I)=VI -c 1 CONTINUE - - vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) - vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) - - v2(1)=vaux1 - v2(2)=vaux2 - END -C--------------------------------------- - SUBROUTINE MATMAT2(A1,A2,A3) -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(2,2),A2(2,2),A3(2,2) -c DIMENSION AI3(2,2) -c DO J=1,2 -c A3IJ=0.0 -c DO K=1,2 -c A3IJ=A3IJ+A1(I,K)*A2(K,J) -c enddo -c A3(I,J)=A3IJ -c enddo -c enddo - - ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) - ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) - ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) - ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) - - A3(1,1)=AI3_11 - A3(2,1)=AI3_21 - A3(1,2)=AI3_12 - A3(2,2)=AI3_22 - END - -c------------------------------------------------------------------------- - double precision function scalar2(u,v) -!DIR$ INLINEALWAYS scalar2 - implicit none - double precision u(2),v(2) - double precision sc - integer i - scalar2=u(1)*v(1)+u(2)*v(2) - return - end - -C----------------------------------------------------------------------------- - - subroutine transpose2(a,at) -!DIR$ INLINEALWAYS transpose2 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::transpose2 -#endif - implicit none - double precision a(2,2),at(2,2) - at(1,1)=a(1,1) - at(1,2)=a(2,1) - at(2,1)=a(1,2) - at(2,2)=a(2,2) - return - end -c-------------------------------------------------------------------------- - subroutine transpose(n,a,at) - implicit none - integer n,i,j - double precision a(n,n),at(n,n) - do i=1,n - do j=1,n - at(j,i)=a(i,j) - enddo - enddo - return - end -C--------------------------------------------------------------------------- - subroutine prodmat3(a1,a2,kk,transp,prod) -!DIR$ INLINEALWAYS prodmat3 -#ifndef OSF -cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 -#endif - implicit none - integer i,j - double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) - logical transp -crc double precision auxmat(2,2),prod_(2,2) - - if (transp) then -crc call transpose2(kk(1,1),auxmat(1,1)) -crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) - & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) - & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) - - else -crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) -crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) - - prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) - prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) - & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) - prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) - prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) - & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) - - endif -c call transpose2(a2(1,1),a2t(1,1)) - -crc print *,transp -crc print *,((prod_(i,j),i=1,2),j=1,2) -crc print *,((prod(i,j),i=1,2),j=1,2) - - return - end - diff --git a/source/unres/src_MD-restraints/energy_split-sep.F b/source/unres/src_MD-restraints/energy_split-sep.F deleted file mode 100644 index 714825c..0000000 --- a/source/unres/src_MD-restraints/energy_split-sep.F +++ /dev/null @@ -1,486 +0,0 @@ - subroutine etotal_long(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the long-range slow-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.MD' -c write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI -c if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_LONG Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks - call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif - call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - time_Bcastw=time_Bcastw+MPI_Wtime()-time00 -c call chainbuild_cart -c call int_from_cart1(.false.) - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -cd print *,'nnt=',nnt,' nct=',nct -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_long(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_long(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_long(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_long(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_long(evdw) - goto 107 -C Soft-sphere potential - 106 call e_softsphere(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue - call vec_and_deriv - if (ipot.lt.6) then -#ifdef SPLITELE - if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#else - if (welec.gt.0d0.or.wel_loc.gt.0d0.or. - & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 - & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 - & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then -#endif - call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) - else - ees=0 - evdw1=0 - eel_loc=0 - eello_turn3=0 - eello_turn4=0 - endif - else -c write (iout,*) "Soft-spheer ELEC potential" - call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, - & eello_turn4) - endif -C -C Calculate excluded-volume interaction energy between peptide groups -C and side chains. -C - if (ipot.lt.6) then - if(wscp.gt.0d0) then - call escp_long(evdw2,evdw2_14) - else - evdw2=0 - evdw2_14=0 - endif - else - call escp_soft_sphere(evdw2,evdw2_14) - endif -C -C 12/1/95 Multi-body terms -C - n_corr=0 - n_corr1=0 - if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 - & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then - call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, -c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 - else - ecorr=0.0d0 - ecorr5=0.0d0 - ecorr6=0.0d0 - eturn6=0.0d0 - endif - if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then - call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) - endif -C -C If performing constraint dynamics, call the constraint energy -C after the equilibration time - if(usampl.and.totT.gt.eq_time) then - call EconstrQ - call Econstr_back - else - Uconst=0.0d0 - Uconst_back=0.0d0 - endif -C -C Sum the energies -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(3)=ees - energia(16)=evdw1 -#else - energia(3)=ees+evdw1 - energia(16)=0.0d0 -#endif - energia(4)=ecorr - energia(5)=ecorr5 - energia(6)=ecorr6 - energia(7)=eel_loc - energia(8)=eello_turn3 - energia(9)=eello_turn4 - energia(10)=eturn6 - energia(20)=Uconst+Uconst_back - energia(22)=evdw_p - energia(23)=evdw_m - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_LONG" - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine etotal_short(energia) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c -c Compute the short-range fast-varying contributions to the energy -c -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif -#ifdef MPI - include "mpif.h" - double precision weights_(n_ene) -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energia(0:n_ene) - include 'COMMON.FFIELD' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CONTROL' - -c write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot -c call flush(iout) - if (modecalc.eq.12.or.modecalc.eq.14) then -#ifdef MPI - if (fg_rank.eq.0) call int_from_cart1(.false.) -#else - call int_from_cart1(.false.) -#endif - endif -#ifdef MPI -c write(iout,*) "ETOTAL_SHORT Processor",fg_rank, -c & " absolute rank",myrank," nfgtasks",nfgtasks -c call flush(iout) - if (nfgtasks.gt.1) then - time00=MPI_Wtime() -C FG slaves call the following matching MPI_Bcast in ERGASTULUM - if (fg_rank.eq.0) then - call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR) -c write (iout,*) "Processor",myrank," BROADCAST iorder" -c call flush(iout) -C FG master sets up the WEIGHTS_ array which will be broadcast to the -C FG slaves as WEIGHTS array. - weights_(1)=wsc - weights_(2)=wscp - weights_(3)=welec - weights_(4)=wcorr - weights_(5)=wcorr5 - weights_(6)=wcorr6 - weights_(7)=wel_loc - weights_(8)=wturn3 - weights_(9)=wturn4 - weights_(10)=wturn6 - weights_(11)=wang - weights_(12)=wscloc - weights_(13)=wtor - weights_(14)=wtor_d - weights_(15)=wstrain - weights_(16)=wvdwpp - weights_(17)=wbond - weights_(18)=scal14 - weights_(21)=wsccor -C FG Master broadcasts the WEIGHTS_ array - call MPI_Bcast(weights_(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - else -C FG slaves receive the WEIGHTS array - call MPI_Bcast(weights(1),n_ene, - & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) - wsc=weights(1) - wscp=weights(2) - welec=weights(3) - wcorr=weights(4) - wcorr5=weights(5) - wcorr6=weights(6) - wel_loc=weights(7) - wturn3=weights(8) - wturn4=weights(9) - wturn6=weights(10) - wang=weights(11) - wscloc=weights(12) - wtor=weights(13) - wtor_d=weights(14) - wstrain=weights(15) - wvdwpp=weights(16) - wbond=weights(17) - scal14=weights(18) - wsccor=weights(21) - endif -c write (iout,*),"Processor",myrank," BROADCAST weights" - call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST c" - call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc" - call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST dc_norm" - call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST theta" - call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST phi" - call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST alph" - call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST omeg" - call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "Processor",myrank," BROADCAST vbld" - call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c write (iout,*) "Processor",myrank," BROADCAST vbld_inv" - endif -c write (iout,*) 'Processor',myrank, -c & ' calling etotal_short ipot=',ipot -c call flush(iout) -c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct -#endif -c call int_from_cart1(.false.) -C -C Compute the side-chain and electrostatic interaction energy -C - goto (101,102,103,104,105,106) ipot -C Lennard-Jones potential. - 101 call elj_short(evdw) -cd print '(a)','Exit ELJ' - goto 107 -C Lennard-Jones-Kihara potential (shifted). - 102 call eljk_short(evdw) - goto 107 -C Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp_short(evdw) - goto 107 -C Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb_short(evdw,evdw_p,evdw_m) - goto 107 -C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv_short(evdw) - goto 107 -C Soft-sphere potential - already dealt with in the long-range part - 106 evdw=0.0d0 -c 106 call e_softsphere_short(evdw) -C -C Calculate electrostatic (H-bonding) energy of the main chain. -C - 107 continue -c -c Calculate the short-range part of Evdwpp -c - call evdwpp_short(evdw1) -c -c Calculate the short-range part of ESCp -c - if (ipot.lt.6) then - call escp_short(evdw2,evdw2_14) - endif -c -c Calculate the bond-stretching energy -c - call ebond(estr) -C -C Calculate the disulfide-bridge and other energy and the contributions -C from other distance constraints. - call edis(ehpb) -C -C Calculate the virtual-bond-angle energy. -C - call ebend(ebe) -C -C Calculate the SC local energy. -C - call vec_and_deriv - call esc(escloc) -C -C Calculate the virtual-bond torsional energy. -C - call etor(etors,edihcnstr) -c -c Homology restraints -c - if (constr_homology.ge.1) then - call e_modeller(ehomology_constr) - else - ehomology_constr=0.0d0 - endif -C -C 6/23/01 Calculate double-torsional energy -C - call etor_d(etors_d) -C -C 21/5/07 Calculate local sicdechain correlation energy -C - if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) - else - esccor=0.0d0 - endif -C -C Put energy components into an array -C - do i=1,n_ene - energia(i)=0.0d0 - enddo - energia(1)=evdw -#ifdef SCP14 - energia(2)=evdw2-evdw2_14 - energia(18)=evdw2_14 -#else - energia(2)=evdw2 - energia(18)=0.0d0 -#endif -#ifdef SPLITELE - energia(16)=evdw1 -#else - energia(3)=evdw1 -#endif - energia(11)=ebe - energia(12)=escloc - energia(13)=etors - energia(14)=etors_d - energia(15)=ehpb - energia(17)=estr - energia(19)=edihcnstr - energia(21)=esccor - energia(22)=evdw_p - energia(23)=evdw_m - energia(24)=ehomology_constr -c write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" - call flush(iout) - call sum_energy(energia,.true.) -c write (iout,*) "Exit ETOTAL_SHORT" - call flush(iout) - return - end diff --git a/source/unres/src_MD-restraints/entmcm.F b/source/unres/src_MD-restraints/entmcm.F deleted file mode 100644 index 3c2dc5a..0000000 --- a/source/unres/src_MD-restraints/entmcm.F +++ /dev/null @@ -1,684 +0,0 @@ - subroutine entmcm -C Does modified entropic sampling in the space of minima. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,ehighest,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - double precision energia(0:n_ene),energia_ave(0:n_ene) -C -cd write (iout,*) 'print_mc=',print_mc - WhatsUp=0 - maxtrial_iter=50 -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - indminn=-max_ene - indmaxx=max_ene - delte=0.5D0 - facee=1.0D0/(maxacc*delte) - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else - call gen_rand_conf(1,*20) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 -#ifdef MPL - if (MyID.eq.MasterID) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif -#endif - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) - call minimize(etot,varia,iretcode,nfun) - call etotal(energia(0)) - etot = energia(0) - write (iout,'(/80(1h*)/a/80(1h*))') - & 'Results of the first energy minimization:' - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - write (istat,'(i5,11(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot,rms,frac,co - else - write (istat,'(i5,9(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - neneval=neneval+nfun+1 - if (.not. ent_read) then -C Initialize the entropy array - do i=-max_ene,max_ene - emin=etot -C Uncomment the line below for actual entropic sampling (start with uniform -C energy distribution). -c entropy(i)=0.0D0 -C Uncomment the line below for multicanonical sampling (start with Boltzmann -C distribution). - entropy(i)=(emin+i*delte)*betbol - enddo - emax=10000000.0D0 - emin=etot - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done = (iretcode.ne.11) -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - indeold=(eold-emin)/delte - deix=eold-(emin+indeold*delte) - dent=entropy(indeold+1)-entropy(indeold) -cd write (iout,*) 'indeold=',indeold,' deix=',deix,' dent=',dent -cd write (*,*) 'Processor',MyID,' indeold=',indeold,' deix=',deix, -cd & ' dent=',dent - sold=entropy(indeold)+(dent/delte)*deix - elowest=etot - write (iout,*) 'eold=',eold,' sold=',sold,' elowest=',etot - write (*,*) 'Processor',MyID,' eold=',eold,' sold=',sold, - & ' elowest=',etot - if (minim) call zapis(varia,etot) - nminima(1)=1.0D0 -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - else - call send_MCM_info(2) - endif -#endif - do iene=indminn,indmaxx - nhist(iene)=0.0D0 - enddo - do i=2,maxsave - nminima(i)=0.0D0 - enddo -C Main loop. -c---------------------------------------------------------------------------- - elowest=1.0D10 - ehighest=-1.0D10 - it=0 - do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0) write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0) write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+1 - endif - if (print_mc.gt.2) then - write (iout,'(a)') 'Total energies of trial conf:' - call enerprint(energia(0)) - else if (print_mc.eq.1) then - write (iout,'(a,i6,a,1pe16.6)') - & 'Trial conformation:',ngen,' energy:',etot - endif -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accepting(etot,eold,scur,sold,varia,varold, - & accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irep=conf_comp(varia,etot) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup, - & przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - if (print_mc.gt.0) - & write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,11(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,co - elseif (print_stat) then - write (istat,'(i5,10(1pe14.5))') it, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - close(istat) - if (print_mc.gt.1) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) -#ifdef MPL - if (MyID.ne.MasterID) then - call recv_stop_sig(Kwita) -cd print *,'Processor:',MyID,' STOP=',Kwita - if (irep.eq.0) then - call send_MCM_info(2) - else - call send_MCM_info(1) - endif - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo - if (irep.eq.0) then - irep=nsave+1 -cd write (iout,*) 'Accepted conformation:' -cd write (iout,*) (rad2deg*varia(i),i=1,nphi) - if (minim) call zapis(varia,etot) - do i=1,n_ene - ener(i,nsave)=energia(i) - enddo - ener(n_ene+1,nsave)=etot - ener(n_ene+2,nsave)=frac - endif - nminima(irep)=nminima(irep)+1.0D0 -c print *,'irep=',irep,' nminima=',nminima(irep) -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif - if (ntrial.gt.maxtrial_iter .and. npool.gt.0) then -C Take a conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Iteration',it,' max. # of trials exceeded.' - write (iout,*) - & 'Take conformation',ii,' from the pool energy=',epool(ii) - if (print_mc.gt.2) - & write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - ntrial=0 - endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID) then - call receive_MCM_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) -#endif - 21 continue -#ifdef MPL - if (MyID.eq.MasterID) then -c call receive_MCM_results - call receive_energies -#endif - do i=1,nsave - if (esave(i).lt.elowest) elowest=esave(i) - if (esave(i).gt.ehighest) ehighest=esave(i) - enddo - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - if (isweep.eq.1 .and. .not.ent_read) then - emin=elowest - emax=ehighest - write (iout,*) 'EMAX=',emax - indminn=0 - indmaxx=(ehighest-emin)/delte - indmin=indminn - indmax=indmaxx - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ent_read=.true. - else - indmin=(elowest-emin)/delte - indmax=(ehighest-emin)/delte - if (indmin.lt.indminn) indminn=indmin - if (indmax.gt.indmaxx) indmaxx=indmax - endif - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Construct energy histogram - do i=1,nsave - inde=(esave(i)-emin)/delte - nhist(inde)=nhist(inde)+nminima(i) - enddo -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo -Cd do i=indmaxx+1 -Cd entropy(i)=1.0D+10 -Cd enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - entropy(-max_ene-4)=dfloat(indminn) - entropy(-max_ene-3)=dfloat(indmaxx) - entropy(-max_ene-2)=emin - entropy(-max_ene-1)=emax - call send_MCM_update -cd print *,entname,ientout - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - else - write (iout,'(a)') 'Frequecies of minima' - do i=1,nsave - write (iout,'(i5,f5.0,f10.5)') i,nminima(i),esave(i) - enddo -c call send_MCM_results - call send_energies - call receive_MCM_update - indminn=entropy(-max_ene-4) - indmaxx=entropy(-max_ene-3) - emin=entropy(-max_ene-2) - emax=entropy(-max_ene-1) - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif - if (WhatsUp.lt.-1) return -#else - if (ovrtim() .or. WhatsUp.lt.0) return -#endif - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - write (iout,'(a,i10)') 'Number of chain regrowths:',nregrow - write (iout,'(a,i10)') 'Accepted chain regrowths:',nregrow_acc - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accepting(ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - double precision tole /1.0D-1/, tola /5.0D0/ - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - else if (dabs(ecur-eold).lt.tole .and. - & dif_ang(nphi,x,xold).lt.tola) then - accepted=.false. - if (print_mc.gt.0) - & write (iout,'(a)') 'Conformation rejected as too similar' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - indecur=(ecur-emin)/delte - if (iabs(indecur).gt.max_ene) then - write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.eq.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0) write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.1) then - write(iout,*)'ecur=',ecur,' indecur=',indecur,' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0) write (iout,'(a)') - & 'Conformation rejected.' - endif - endif - return - end -c----------------------------------------------------------------------------- - subroutine read_pool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.VAR' - double precision varia(maxvar) - print '(a)','Call READ_POOL' - do npool=1,max_pool - print *,'i=',i - read (intin,'(i5,f10.5)',end=10,err=10) iconf,epool(npool) - if (epool(npool).eq.0.0D0) goto 10 - call read_angles(intin,*10) - call geom_to_var(nvar,xpool(1,npool)) - enddo - goto 11 - 10 npool=npool-1 - 11 write (iout,'(a,i5)') 'Number of pool conformations:',npool - if (print_mc.gt.2) then - do i=1,npool - write (iout,'(a,i5,a,1pe14.5)') 'Pool conformation',i,' energy', - & epool(i) - write (iout,'(10f8.3)') (rad2deg*xpool(j,i),j=1,nvar) - enddo - endif ! (print_mc.gt.2) - return - end diff --git a/source/unres/src_MD-restraints/fitsq.f b/source/unres/src_MD-restraints/fitsq.f deleted file mode 100644 index 36cbd30..0000000 --- a/source/unres/src_MD-restraints/fitsq.f +++ /dev/null @@ -1,364 +0,0 @@ - subroutine fitsq(rms,x,y,nn,t,b,non_conv) - implicit real*8 (a-h,o-z) - include 'COMMON.IOUNITS' -c x and y are the vectors of coordinates (dimensioned (3,n)) of the two -c structures to be superimposed. nn is 3*n, where n is the number of -c points. t and b are respectively the translation vector and the -c rotation matrix that transforms the second set of coordinates to the -c frame of the first set. -c eta = machine-specific variable - - dimension x(3*nn),y(3*nn),t(3) - dimension b(3,3),q(3,3),r(3,3),v(3),xav(3),yav(3),e(3),c(3,3) - logical non_conv -c eta = z00100000 -c small=25.0*rmdcon(3) -c small=25.0*eta -c small=25.0*10.e-10 -c the following is a very lenient value for 'small' - small = 0.0001D0 - non_conv=.false. - fn=nn - do 10 i=1,3 - xav(i)=0.0D0 - yav(i)=0.0D0 - do 10 j=1,3 - 10 b(j,i)=0.0D0 - nc=0 -c - do 30 n=1,nn - do 20 i=1,3 -c write(iout,*)'x = ',x(nc+i),' y = ',y(nc+i) - xav(i)=xav(i)+x(nc+i)/fn - 20 yav(i)=yav(i)+y(nc+i)/fn - 30 nc=nc+3 -c - do i=1,3 - t(i)=yav(i)-xav(i) - enddo - - rms=0.0d0 - do n=1,nn - do i=1,3 - rms=rms+(y(3*(n-1)+i)-x(3*(n-1)+i)-t(i))**2 - enddo - enddo - rms=dabs(rms/fn) - -c write(iout,*)'xav = ',(xav(j),j=1,3) -c write(iout,*)'yav = ',(yav(j),j=1,3) -c write(iout,*)'t = ',(t(j),j=1,3) -c write(iout,*)'rms=',rms - if (rms.lt.small) return - - - nc=0 - rms=0.0D0 - do 50 n=1,nn - do 40 i=1,3 - rms=rms+((x(nc+i)-xav(i))**2+(y(nc+i)-yav(i))**2)/fn - do 40 j=1,3 - b(j,i)=b(j,i)+(x(nc+i)-xav(i))*(y(nc+j)-yav(j))/fn - 40 c(j,i)=b(j,i) - 50 nc=nc+3 - call sivade(b,q,r,d,non_conv) - sn3=dsign(1.0d0,d) - do 120 i=1,3 - do 120 j=1,3 - 120 b(j,i)=-q(j,1)*r(i,1)-q(j,2)*r(i,2)-sn3*q(j,3)*r(i,3) - call mvvad(b,xav,yav,t) - do 130 i=1,3 - do 130 j=1,3 - rms=rms+2.0*c(j,i)*b(j,i) - 130 b(j,i)=-b(j,i) - if (dabs(rms).gt.small) go to 140 -* write (6,301) - return - 140 if (rms.gt.0.0d0) go to 150 -c write (iout,303) rms - rms=0.0d0 -* stop -c 150 write (iout,302) dsqrt(rms) - 150 continue - return - 301 format (5x,'rms deviation negligible') - 302 format (5x,'rms deviation ',f14.6) - 303 format (//,5x,'negative ms deviation - ',f14.6) - end -c - subroutine sivade(x,q,r,dt,non_conv) - implicit real*8(a-h,o-z) -c computes q,e and r such that q(t)xr = diag(e) - dimension x(3,3),q(3,3),r(3,3),e(3) - dimension h(3,3),p(3,3),u(3,3),d(3) - logical non_conv -c eta = z00100000 -c write (2,*) "SIVADE" - nit = 0 - small=25.0*10.d-10 -c small=25.0*eta -c small=2.0*rmdcon(3) - xnrm=0.0d0 - do 20 i=1,3 - do 10 j=1,3 - xnrm=xnrm+x(j,i)*x(j,i) - u(j,i)=0.0d0 - r(j,i)=0.0d0 - 10 h(j,i)=0.0d0 - u(i,i)=1.0 - 20 r(i,i)=1.0 - xnrm=dsqrt(xnrm) - do 110 n=1,2 - xmax=0.0d0 - do 30 j=n,3 - 30 if (dabs(x(j,n)).gt.xmax) xmax=dabs(x(j,n)) - a=0.0d0 - do 40 j=n,3 - h(j,n)=x(j,n)/xmax - 40 a=a+h(j,n)*h(j,n) - a=dsqrt(a) - den=a*(a+dabs(h(n,n))) - d(n)=1.0/den - h(n,n)=h(n,n)+dsign(a,h(n,n)) - do 70 i=n,3 - s=0.0d0 - do 50 j=n,3 - 50 s=s+h(j,n)*x(j,i) - s=d(n)*s - do 60 j=n,3 - 60 x(j,i)=x(j,i)-s*h(j,n) - 70 continue - if (n.gt.1) go to 110 - xmax=dmax1(dabs(x(1,2)),dabs(x(1,3))) - h(2,3)=x(1,2)/xmax - h(3,3)=x(1,3)/xmax - a=dsqrt(h(2,3)*h(2,3)+h(3,3)*h(3,3)) - den=a*(a+dabs(h(2,3))) - d(3)=1.0/den - h(2,3)=h(2,3)+sign(a,h(2,3)) - do 100 i=1,3 - s=0.0d0 - do 80 j=2,3 - 80 s=s+h(j,3)*x(i,j) - s=d(3)*s - do 90 j=2,3 - 90 x(i,j)=x(i,j)-s*h(j,3) - 100 continue - 110 continue - do 130 i=1,3 - do 120 j=1,3 - 120 p(j,i)=-d(1)*h(j,1)*h(i,1) - 130 p(i,i)=1.0+p(i,i) - do 140 i=2,3 - do 140 j=2,3 - u(j,i)=u(j,i)-d(2)*h(j,2)*h(i,2) - 140 r(j,i)=r(j,i)-d(3)*h(j,3)*h(i,3) - call mmmul(p,u,q) - 150 np=1 - nq=1 - nit=nit+1 -c write (2,*) "nit",nit," e",(x(i,i),i=1,3) - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif - if (dabs(x(2,3)).gt.small*(dabs(x(2,2))+abs(x(3,3)))) go to 160 - x(2,3)=0.0d0 - nq=nq+1 - 160 if (dabs(x(1,2)).gt.small*(dabs(x(1,1))+dabs(x(2,2)))) go to 180 - x(1,2)=0.0d0 - if (x(2,3).ne.0.0d0) go to 170 - nq=nq+1 - go to 180 - 170 np=np+1 - 180 if (nq.eq.3) go to 310 - npq=4-np-nq -c write (2,*) "np",np," npq",npq - if (np.gt.npq) go to 230 - n0=0 - do 220 n=np,npq - nn=n+np-1 -c write (2,*) "nn",nn - if (dabs(x(nn,nn)).gt.small*xnrm) go to 220 - x(nn,nn)=0.0d0 - if (x(nn,nn+1).eq.0.0d0) go to 220 - n0=n0+1 -c write (2,*) "nn",nn - go to (190,210,220),nn - 190 do 200 j=2,3 - 200 call givns(x,q,1,j) - go to 220 - 210 call givns(x,q,2,3) - 220 continue -c write (2,*) "nn",nn," np",np," nq",nq," n0",n0 -c write (2,*) "x",(x(i,i),i=1,3) - if (n0.ne.0) go to 150 - 230 nn=3-nq - a=x(nn,nn)*x(nn,nn) - if (nn.gt.1) a=a+x(nn-1,nn)*x(nn-1,nn) - b=x(nn+1,nn+1)*x(nn+1,nn+1)+x(nn,nn+1)*x(nn,nn+1) - c=x(nn,nn)*x(nn,nn+1) - dd=0.5*(a-b) - xn2=c*c - rt=b-xn2/(dd+sign(dsqrt(dd*dd+xn2),dd)) - y=x(np,np)*x(np,np)-rt - z=x(np,np)*x(np,np+1) - do 300 n=np,nn -c write (2,*) "n",n," a",a," b",b," c",c," y",y," z",z - if (dabs(y).lt.dabs(z)) go to 240 - t=z/y - c=1.0/dsqrt(1.0d0+t*t) - s=c*t - go to 250 - 240 t=y/z - s=1.0/dsqrt(1.0d0+t*t) - c=s*t - 250 do 260 j=1,3 - v=x(j,n) - w=x(j,n+1) - x(j,n)=c*v+s*w - x(j,n+1)=-s*v+c*w - a=r(j,n) - b=r(j,n+1) - r(j,n)=c*a+s*b - 260 r(j,n+1)=-s*a+c*b - y=x(n,n) - z=x(n+1,n) - if (dabs(y).lt.dabs(z)) go to 270 - t=z/y - c=1.0/dsqrt(1.0+t*t) - s=c*t - go to 280 - 270 t=y/z - s=1.0/dsqrt(1.0+t*t) - c=s*t - 280 do 290 j=1,3 - v=x(n,j) - w=x(n+1,j) - a=q(j,n) - b=q(j,n+1) - x(n,j)=c*v+s*w - x(n+1,j)=-s*v+c*w - q(j,n)=c*a+s*b - 290 q(j,n+1)=-s*a+c*b - if (n.ge.nn) go to 300 - y=x(n,n+1) - z=x(n,n+2) - 300 continue - go to 150 - 310 do 320 i=1,3 - 320 e(i)=x(i,i) - nit=0 - 330 n0=0 - nit=nit+1 - if (nit.gt.10000) then - print '(a)','!!!! Over 10000 iterations in SIVADE!!!!!' - non_conv=.true. - return - endif -c write (2,*) "e",(e(i),i=1,3) - do 360 i=1,3 - if (e(i).ge.0.0d0) go to 350 - e(i)=-e(i) - do 340 j=1,3 - 340 q(j,i)=-q(j,i) - 350 if (i.eq.1) go to 360 - if (dabs(e(i)).lt.dabs(e(i-1))) go to 360 - call switch(i,1,q,r,e) - n0=n0+1 - 360 continue - if (n0.ne.0) go to 330 -c write (2,*) "e",(e(i),i=1,3) - if (dabs(e(3)).gt.small*xnrm) go to 370 - e(3)=0.0d0 - if (dabs(e(2)).gt.small*xnrm) go to 370 - e(2)=0.0d0 - 370 dt=det(q(1,1),q(1,2),q(1,3))*det(r(1,1),r(1,2),r(1,3)) -c write (2,*) "nit",nit -c write (2,501) (e(i),i=1,3) - return - 501 format (/,5x,'singular values - ',3e15.5) - end - subroutine givns(a,b,m,n) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3) - if (dabs(a(m,n)).lt.dabs(a(n,n))) go to 10 - t=a(n,n)/a(m,n) - s=1.0/dsqrt(1.0+t*t) - c=s*t - go to 20 - 10 t=a(m,n)/a(n,n) - c=1.0/dsqrt(1.0+t*t) - s=c*t - 20 do 30 j=1,3 - v=a(m,j) - w=a(n,j) - x=b(j,m) - y=b(j,n) - a(m,j)=c*v-s*w - a(n,j)=s*v+c*w - b(j,m)=c*x-s*y - 30 b(j,n)=s*x+c*y - return - end - subroutine switch(n,m,u,v,d) - implicit real*8 (a-h,o-z) - dimension u(3,3),v(3,3),d(3) - do 10 i=1,3 - tem=u(i,n) - u(i,n)=u(i,n-1) - u(i,n-1)=tem - if (m.eq.0) go to 10 - tem=v(i,n) - v(i,n)=v(i,n-1) - v(i,n-1)=tem - 10 continue - tem=d(n) - d(n)=d(n-1) - d(n-1)=tem - return - end - subroutine mvvad(b,xav,yav,t) - implicit real*8 (a-h,o-z) - dimension b(3,3),xav(3),yav(3),t(3) -c dimension a(3,3),b(3),c(3),d(3) -c do 10 j=1,3 -c d(j)=c(j) -c do 10 i=1,3 -c 10 d(j)=d(j)+a(j,i)*b(i) - do 10 j=1,3 - t(j)=yav(j) - do 10 i=1,3 - 10 t(j)=t(j)+b(j,i)*xav(i) - return - end - double precision function det (a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3),b(3),c(3) - det=a(1)*(b(2)*c(3)-b(3)*c(2))+a(2)*(b(3)*c(1)-b(1)*c(3)) - 1 +a(3)*(b(1)*c(2)-b(2)*c(1)) - return - end - subroutine mmmul(a,b,c) - implicit real*8 (a-h,o-z) - dimension a(3,3),b(3,3),c(3,3) - do 10 i=1,3 - do 10 j=1,3 - c(i,j)=0.0d0 - do 10 k=1,3 - 10 c(i,j)=c(i,j)+a(i,k)*b(k,j) - return - end - subroutine matvec(uvec,tmat,pvec,nback) - implicit real*8 (a-h,o-z) - real*8 tmat(3,3),uvec(3,nback), pvec(3,nback) -c - do 2 j=1,nback - do 1 i=1,3 - uvec(i,j) = 0.0d0 - do 1 k=1,3 - 1 uvec(i,j)=uvec(i,j)+tmat(i,k)*pvec(k,j) - 2 continue - return - end diff --git a/source/unres/src_MD-restraints/gauss.f b/source/unres/src_MD-restraints/gauss.f deleted file mode 100644 index 7ba6e1d..0000000 --- a/source/unres/src_MD-restraints/gauss.f +++ /dev/null @@ -1,69 +0,0 @@ - subroutine gauss(RO,AP,MT,M,N,*) -c -c CALCULATES (RO**(-1))*AP BY GAUSS ELIMINATION -c RO IS A SQUARE MATRIX -c THE CALCULATED PRODUCT IS STORED IN AP -c ABNORMAL EXIT IF RO IS SINGULAR -c - integer MT, M, N, M1,I,J,IM, - & I1,MI,MI1 - double precision RO(MT,M),AP(MT,N),X,RM,PR, - & Y - if(M.ne.1)goto 10 - X=RO(1,1) - if(dabs(X).le.1.0D-13) return 1 - X=1.0/X - do 16 I=1,N -16 AP(1,I)=AP(1,I)*X - return -10 continue - M1=M-1 - DO1 I=1,M1 - IM=I - RM=DABS(RO(I,I)) - I1=I+1 - do 2 J=I1,M - if(DABS(RO(J,I)).LE.RM) goto 2 - RM=DABS(RO(J,I)) - IM=J -2 continue - If(IM.eq.I)goto 17 - do 3 J=1,N - PR=AP(I,J) - AP(I,J)=AP(IM,J) -3 AP(IM,J)=PR - do 4 J=I,M - PR=RO(I,J) - RO(I,J)=RO(IM,J) -4 RO(IM,J)=PR -17 X=RO(I,I) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 5 J=1,N -5 AP(I,J)=X*AP(I,J) - do 6 J=I1,M -6 RO(I,J)=X*RO(I,J) - do 7 J=I1,M - Y=RO(J,I) - do 8 K=1,N -8 AP(J,K)=AP(J,K)-Y*AP(I,K) - do 9 K=I1,M -9 RO(J,K)=RO(J,K)-Y*RO(I,K) -7 continue -1 continue - X=RO(M,M) - if(dabs(X).le.1.0E-13) return 1 - X=1.0/X - do 11 J=1,N -11 AP(M,J)=X*AP(M,J) - do 12 I=1,M1 - MI=M-I - MI1=MI+1 - do 14 J=1,N - X=AP(MI,J) - do 15 K=MI1,M -15 X=X-AP(K,J)*RO(MI,K) -14 AP(MI,J)=X -12 continue - return - end diff --git a/source/unres/src_MD-restraints/gen_rand_conf.F b/source/unres/src_MD-restraints/gen_rand_conf.F deleted file mode 100644 index 6cc31ba..0000000 --- a/source/unres/src_MD-restraints/gen_rand_conf.F +++ /dev/null @@ -1,910 +0,0 @@ - subroutine gen_rand_conf(nstart,*) -C Generate random conformation or chain cut and regrowth. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.GEO' - include 'COMMON.CONTROL' - logical overlap,back,fail -cd print *,' CG Processor',me,' maxgen=',maxgen - maxsi=100 -cd write (iout,*) 'Gen_Rand_conf: nstart=',nstart - if (nstart.lt.5) then - it1=itype(2) - phi(4)=gen_phi(4,itype(2),itype(3)) -c write(iout,*)'phi(4)=',rad2deg*phi(4) - if (nstart.lt.3) theta(3)=gen_theta(itype(2),pi,phi(4)) -c write(iout,*)'theta(3)=',rad2deg*theta(3) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(3),alph(2),omeg(2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif ! it1.ne.10 - call orig_frame - i=4 - nstart=4 - else - i=nstart - nstart=max0(i,4) - endif - - maxnit=0 - - nit=0 - niter=0 - back=.false. - do while (i.le.nres .and. niter.lt.maxgen) - if (i.lt.nstart) then - if(iprint.gt.1) then - write (iout,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - write (*,'(/80(1h*)/2a/80(1h*))') - & 'Generation procedure went down to ', - & 'chain beginning. Cannot continue...' - endif - return1 - endif - it1=itype(i-1) - it2=itype(i-2) - it=itype(i) -c print *,'Gen_Rand_Conf: i=',i,' it=',it,' it1=',it1,' it2=',it2, -c & ' nit=',nit,' niter=',niter,' maxgen=',maxgen - phi(i+1)=gen_phi(i+1,it1,it) - if (back) then - phi(i)=gen_phi(i+1,it2,it1) -c print *,'phi(',i,')=',phi(i) - theta(i-1)=gen_theta(it2,phi(i-1),phi(i)) - if (it2.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it2,theta(i-1),alph(i-2),omeg(i-2),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i-1) - endif - theta(i)=gen_theta(it1,phi(i),phi(i+1)) - if (it1.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(it1,theta(i),alph(i-1),omeg(i-1),fail) - nsi=nsi+1 - enddo - if (nsi.gt.maxsi) return1 - endif - call locate_next_res(i) - if (overlap(i-1)) then - if (nit.lt.maxnit) then - back=.true. - nit=nit+1 - else - nit=0 - if (i.gt.3) then - back=.true. - i=i-1 - else - write (iout,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - write (*,'(a)') - & 'Cannot generate non-overlaping conformation. Increase MAXNIT.' - return1 - endif - endif - else - back=.false. - nit=0 - i=i+1 - endif - niter=niter+1 - enddo - if (niter.ge.maxgen) then - write (iout,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - write (*,'(a,2i5)') - & 'Too many trials in conformation generation',niter,maxgen - return1 - endif - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,nres+nres)=c(j,nres) - enddo - return - end -c------------------------------------------------------------------------- - logical function overlap(i) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - data redfac /0.5D0/ - overlap=.false. - iti=itype(i) - if (iti.gt.ntyp) return -C Check for SC-SC overlaps. -cd print *,'nnt=',nnt,' nct=',nct - do j=nnt,i-1 - itj=itype(j) - if (j.lt.i-1 .or. ipot.ne.4) then - rcomp=sigmaii(iti,itj) - else - rcomp=sigma(iti,itj) - endif -cd print *,'j=',j - if (dist(nres+i,nres+j).lt.redfac*rcomp) then - overlap=.true. -c print *,'overlap, SC-SC: i=',i,' j=',j, -c & ' dist=',dist(nres+i,nres+j),' rcomp=', -c & rcomp - return - endif - enddo -C Check for overlaps between the added peptide group and the preceding -C SCs. - iteli=itel(i) - do j=1,3 - c(j,maxres2+1)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itj=itype(j) -cd print *,'overlap, p-Sc: i=',i,' j=',j, -cd & ' dist=',dist(nres+j,maxres2+1) - if (dist(nres+j,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for overlaps between the added side chain and the preceding peptide -C groups. - do j=1,nnt-2 - do k=1,3 - c(k,maxres2+1)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, SC-p: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,maxres2+1) - if (dist(nres+i,maxres2+1).lt.4.0D0*redfac) then - overlap=.true. - return - endif - enddo -C Check for p-p overlaps - do j=1,3 - c(j,maxres2+2)=0.5D0*(c(j,i)+c(j,i+1)) - enddo - do j=nnt,i-2 - itelj=itel(j) - do k=1,3 - c(k,maxres2+2)=0.5D0*(c(k,j)+c(k,j+1)) - enddo -cd print *,'overlap, p-p: i=',i,' j=',j, -cd & ' dist=',dist(maxres2+1,maxres2+2) - if(iteli.ne.0.and.itelj.ne.0)then - if (dist(maxres2+1,maxres2+2).lt.rpp(iteli,itelj)*redfac) then - overlap=.true. - return - endif - endif - enddo - return - end -c-------------------------------------------------------------------------- - double precision function gen_phi(i,it1,it2) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.BOUNDS' -c gen_phi=ran_number(-pi,pi) -C 8/13/98 Generate phi using pre-defined boundaries - gen_phi=ran_number(phibound(1,i),phibound(2,i)) - return - end -c--------------------------------------------------------------------------- - double precision function gen_theta(it,gama,gama1) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - double precision y(2),z(2) - double precision theta_max,theta_min -c print *,'gen_theta: it=',it - theta_min=0.05D0*pi - theta_max=0.95D0*pi - if (dabs(gama).gt.dwapi) then - y(1)=dcos(gama) - y(2)=dsin(gama) - else - y(1)=0.0D0 - y(2)=0.0D0 - endif - if (dabs(gama1).gt.dwapi) then - z(1)=dcos(gama1) - z(2)=dsin(gama1) - else - z(1)=0.0D0 - z(2)=0.0D0 - endif - thet_pred_mean=a0thet(it) - do k=1,2 - thet_pred_mean=thet_pred_mean+athet(k,it)*y(k)+bthet(k,it)*z(k) - enddo - sig=polthet(3,it) - do j=2,0,-1 - sig=sig*thet_pred_mean+polthet(j,it) - enddo - sig=0.5D0/(sig*sig+sigc0(it)) - ak=dexp(gthet(1,it)- - &0.5D0*((gthet(2,it)-thet_pred_mean)/gthet(3,it))**2) -c print '(i5,5(1pe14.4))',it,(gthet(j,it),j=1,3) -c print '(5(1pe14.4))',thet_pred_mean,theta0(it),sig,sig0(it),ak - theta_temp=binorm(thet_pred_mean,theta0(it),sig,sig0(it),ak) - if (theta_temp.lt.theta_min) theta_temp=theta_min - if (theta_temp.gt.theta_max) theta_temp=theta_max - gen_theta=theta_temp -c print '(a)','Exiting GENTHETA.' - return - end -c------------------------------------------------------------------------- - subroutine gen_side(it,the,al,om,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision MaxBoxLen /10.0D0/ - double precision Ap_inv(3,3),a(3,3),z(3,maxlob),W1(maxlob), - & sumW(0:maxlob),y(2),cm(2),eig(2),box(2,2),work(100),detAp(maxlob) - double precision eig_limit /1.0D-8/ - double precision Big /10.0D0/ - double precision vec(3,3) - logical lprint,fail,lcheck - lcheck=.false. - lprint=.false. - fail=.false. - if (the.eq.0.0D0 .or. the.eq.pi) then -#ifdef MPI - write (*,'(a,i4,a,i3,a,1pe14.5)') - & 'CG Processor:',me,' Error in GenSide: it=',it,' theta=',the -#else -cd write (iout,'(a,i3,a,1pe14.5)') -cd & 'Error in GenSide: it=',it,' theta=',the -#endif - fail=.true. - return - endif - tant=dtan(the-pipol) - nlobit=nlob(it) - if (lprint) then -#ifdef MPI - print '(a,i4,a)','CG Processor:',me,' Enter Gen_Side.' - write (iout,'(a,i4,a)') 'Processor:',me,' Enter Gen_Side.' -#endif - print *,'it=',it,' nlobit=',nlobit,' the=',the,' tant=',tant - write (iout,*) 'it=',it,' nlobit=',nlobit,' the=',the, - & ' tant=',tant - endif - do i=1,nlobit - zz1=tant-censc(1,i,it) - do k=1,3 - do l=1,3 - a(k,l)=gaussc(k,l,i,it) - enddo - enddo - detApi=a(2,2)*a(3,3)-a(2,3)**2 - Ap_inv(2,2)=a(3,3)/detApi - Ap_inv(2,3)=-a(2,3)/detApi - Ap_inv(3,2)=Ap_inv(2,3) - Ap_inv(3,3)=a(2,2)/detApi - if (lprint) then - write (*,'(/a,i2/)') 'Cluster #',i - write (*,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - write (iout,'(/a,i2/)') 'Cluster #',i - write (iout,'(3(1pe14.5),5x,1pe14.5)') - & ((a(l,k),l=1,3),censc(k,i,it),k=1,3) - endif - W1i=0.0D0 - do k=2,3 - do l=2,3 - W1i=W1i+a(k,1)*a(l,1)*Ap_inv(k,l) - enddo - enddo - W1i=a(1,1)-W1i - W1(i)=dexp(bsc(i,it)-0.5D0*W1i*zz1*zz1) -c if (lprint) write(*,'(a,3(1pe15.5)/)') -c & 'detAp, W1, anormi',detApi,W1i,anormi - do k=2,3 - zk=censc(k,i,it) - do l=2,3 - zk=zk+zz1*Ap_inv(k,l)*a(l,1) - enddo - z(k,i)=zk - enddo - detAp(i)=dsqrt(detApi) - enddo - - if (lprint) then - print *,'W1:',(w1(i),i=1,nlobit) - print *,'detAp:',(detAp(i),i=1,nlobit) - print *,'Z' - do i=1,nlobit - print '(i2,3f10.5)',i,(rad2deg*z(j,i),j=2,3) - enddo - write (iout,*) 'W1:',(w1(i),i=1,nlobit) - write (iout,*) 'detAp:',(detAp(i),i=1,nlobit) - write (iout,*) 'Z' - do i=1,nlobit - write (iout,'(i2,3f10.5)') i,(rad2deg*z(j,i),j=2,3) - enddo - endif - if (lcheck) then -C Writing the distribution just to check the procedure - fac=0.0D0 - dV=deg2rad**2*10.0D0 - sum=0.0D0 - sum1=0.0D0 - do i=1,nlobit - fac=fac+W1(i)/detAp(i) - enddo - fac=1.0D0/(2.0D0*fac*pi) -cd print *,it,'fac=',fac - do ial=90,180,2 - y(1)=deg2rad*ial - do iom=-180,180,5 - y(2)=deg2rad*iom - wart=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo - y2=y(2) - - do iii=-1,1 - - y(2)=y2+iii*dwapi - - wykl=0.0D0 - do j=1,2 - do k=1,2 - wykl=wykl+a(j,k)*(y(j)-z(j+1,i))*(y(k)-z(k+1,i)) - enddo - enddo - wart=wart+W1(i)*dexp(-0.5D0*wykl) - - enddo - - y(2)=y2 - - enddo -c print *,'y',y(1),y(2),' fac=',fac - wart=fac*wart - write (20,'(2f10.3,1pd15.5)') y(1)*rad2deg,y(2)*rad2deg,wart - sum=sum+wart - sum1=sum1+1.0D0 - enddo - enddo -c print *,'it=',it,' sum=',sum*dV,' sum1=',sum1*dV - return - endif - -C Calculate the CM of the system -C - do i=1,nlobit - W1(i)=W1(i)/detAp(i) - enddo - sumW(0)=0.0D0 - do i=1,nlobit - sumW(i)=sumW(i-1)+W1(i) - enddo - cm(1)=z(2,1)*W1(1) - cm(2)=z(3,1)*W1(1) - do j=2,nlobit - cm(1)=cm(1)+z(2,j)*W1(j) - cm(2)=cm(2)+W1(j)*(z(3,1)+pinorm(z(3,j)-z(3,1))) - enddo - cm(1)=cm(1)/sumW(nlobit) - cm(2)=cm(2)/sumW(nlobit) - if (cm(1).gt.Big .or. cm(1).lt.-Big .or. - & cm(2).gt.Big .or. cm(2).lt.-Big) then -cd write (iout,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (iout,'(i5,2(1pe14.5))') it,cm(1),cm(2) -cd write (*,'(a)') -cd & 'Unexpected error in GenSide - CM coordinates too large.' -cd write (*,'(i5,2(1pe14.5))') it,cm(1),cm(2) - fail=.true. - return - endif -cd print *,'CM:',cm(1),cm(2) -C -C Find the largest search distance from CM -C - radmax=0.0D0 - do i=1,nlobit - do j=2,3 - do k=2,3 - a(j-1,k-1)=gaussc(j,k,i,it) - enddo - enddo -#ifdef NAG - call f02faf('N','U',2,a,3,eig,work,100,ifail) -#else - call djacob(2,3,10000,1.0d-10,a,vec,eig) -#endif -#ifdef MPI - if (lprint) then - print *,'*************** CG Processor',me - print *,'CM:',cm(1),cm(2) - write (iout,*) '*************** CG Processor',me - write (iout,*) 'CM:',cm(1),cm(2) - print '(A,8f10.5)','Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - write (iout,'(A,8f10.5)') - & 'Eigenvalues: ',(1.0/dsqrt(eig(k)),k=1,2) - endif -#endif - if (eig(1).lt.eig_limit) then - write(iout,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - write(*,'(a)') - & 'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif - radius=0.0D0 -cd print *,'i=',i - do j=1,2 - radius=radius+pinorm(z(j+1,i)-cm(j))**2 - enddo - radius=dsqrt(radius)+3.0D0/dsqrt(eig(1)) - if (radius.gt.radmax) radmax=radius - enddo - if (radmax.gt.pi) radmax=pi -C -C Determine the boundaries of the search rectangle. -C - if (lprint) then - print '(a,4(1pe14.4))','W1: ',(W1(i),i=1,nlob(it) ) - print '(a,4(1pe14.4))','radmax: ',radmax - endif - box(1,1)=dmax1(cm(1)-radmax,0.0D0) - box(2,1)=dmin1(cm(1)+radmax,pi) - box(1,2)=cm(2)-radmax - box(2,2)=cm(2)+radmax - if (lprint) then -#ifdef MPI - print *,'CG Processor',me,' Array BOX:' -#else - print *,'Array BOX:' -#endif - print '(4(1pe14.4))',((box(k,j),k=1,2),j=1,2) - print '(a,4(1pe14.4))','sumW: ',(sumW(i),i=0,nlob(it) ) -#ifdef MPI - write (iout,*)'CG Processor',me,' Array BOX:' -#else - write (iout,*)'Array BOX:' -#endif - write(iout,'(4(1pe14.4))') ((box(k,j),k=1,2),j=1,2) - write(iout,'(a,4(1pe14.4))')'sumW: ',(sumW(i),i=0,nlob(it) ) - endif - if (box(1,2).lt.-MaxBoxLen .or. box(2,2).gt.MaxBoxLen) then -#ifdef MPI - write (iout,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' - write (*,'(a,i4,a)') 'CG Processor:',me,': bad sampling box.' -#else -c write (iout,'(a)') 'Bad sampling box.' -#endif - fail=.true. - return - endif - which_lobe=ran_number(0.0D0,sumW(nlobit)) -c print '(a,1pe14.4)','which_lobe=',which_lobe - do i=1,nlobit - if (sumW(i-1).le.which_lobe .and. sumW(i).ge.which_lobe) goto 1 - enddo - 1 ilob=i -c print *,'ilob=',ilob,' nlob=',nlob(it) - do i=2,3 - cm(i-1)=z(i,ilob) - do j=2,3 - a(i-1,j-1)=gaussc(i,j,ilob,it) - enddo - enddo -cd print '(a,i4,a)','CG Processor',me,' Calling MultNorm1.' - call mult_norm1(3,2,a,cm,box,y,fail) - if (fail) return - al=y(1) - om=pinorm(y(2)) -cd print *,'al=',al,' om=',om -cd stop - return - end -c--------------------------------------------------------------------------- - double precision function ran_number(x1,x2) -C Calculate a random real number from the range (x1,x2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - double precision x1,x2,fctor - data fctor /2147483647.0D0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ran_number=x1+(x2-x1)*prng_next(me) -#else - call vrnd(ix,1) - ran_number=x1+(x2-x1)*ix/fctor -#endif - return - end -c-------------------------------------------------------------------------- - integer function iran_num(n1,n2) -C Calculate a random integer number from the range (n1,n2). - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer n1,n2,ix - real fctor /2147483647.0/ -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - ix=n1+(n2-n1+1)*prng_next(me) - if (ix.lt.n1) ix=n1 - if (ix.gt.n2) ix=n2 - iran_num=ix -#else - call vrnd(ix,1) - ix=n1+(n2-n1+1)*(ix/fctor) - if (ix.gt.n2) ix=n2 - iran_num=ix -#endif - return - end -c-------------------------------------------------------------------------- - double precision function binorm(x1,x2,sigma1,sigma2,ak) - implicit real*8 (a-h,o-z) -c print '(a)','Enter BINORM.' - alowb=dmin1(x1-3.0D0*sigma1,x2-3.0D0*sigma2) - aupb=dmax1(x1+3.0D0*sigma1,x2+3.0D0*sigma2) - seg=sigma1/(sigma1+ak*sigma2) - alen=ran_number(0.0D0,1.0D0) - if (alen.lt.seg) then - binorm=anorm_distr(x1,sigma1,alowb,aupb) - else - binorm=anorm_distr(x2,sigma2,alowb,aupb) - endif -c print '(a)','Exiting BINORM.' - return - end -c----------------------------------------------------------------------- -c double precision function anorm_distr(x,sigma,alowb,aupb) -c implicit real*8 (a-h,o-z) -c print '(a)','Enter ANORM_DISTR.' -c 10 y=ran_number(alowb,aupb) -c expon=dexp(-0.5D0*((y-x)/sigma)**2) -c ran=ran_number(0.0D0,1.0D0) -c if (expon.lt.ran) goto 10 -c anorm_distr=y -c print '(a)','Exiting ANORM_DISTR.' -c return -c end -c----------------------------------------------------------------------- - double precision function anorm_distr(x,sigma,alowb,aupb) - implicit real*8 (a-h,o-z) -c to make a normally distributed deviate with zero mean and unit variance -c - integer iset - real fac,gset,rsq,v1,v2,ran1 - save iset,gset - data iset/0/ - if(iset.eq.0) then -1 v1=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - v2=2.0d0*ran_number(0.0d0,1.0d0)-1.0d0 - rsq=v1**2+v2**2 - if(rsq.ge.1.d0.or.rsq.eq.0.0d0) goto 1 - fac=sqrt(-2.0d0*log(rsq)/rsq) - gset=v1*fac - gaussdev=v2*fac - iset=1 - else - gaussdev=gset - iset=0 - endif - anorm_distr=x+gaussdev*sigma - return - end -c------------------------------------------------------------------------ - subroutine mult_norm(lda,n,a,x,fail) -C -C Generate the vector X whose elements obey the multiple-normal distribution -C from exp(-0.5*X'AX). LDA is the leading dimension of the moment matrix A, -C n is the dimension of the problem. FAIL is set at .TRUE., if the smallest -C eigenvalue of the matrix A is close to 0. -C - implicit double precision (a-h,o-z) - double precision a(lda,n),x(n),eig(100),vec(3,3),work(100) - double precision eig_limit /1.0D-8/ - logical fail - fail=.false. -c print '(a)','Enter MULT_NORM.' -C -C Find the smallest eigenvalue of the matrix A. -C -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo -#ifdef NAG - call f02faf('V','U',2,a,lda,eig,work,100,ifail) -#else - call djacob(2,lda,10000,1.0d-10,a,vec,eig) -#endif -c print '(8f10.5)',(eig(i),i=1,n) -C print '(a)' -c do i=1,n -c print '(8f10.5)',(a(i,j),j=1,n) -c enddo - if (eig(1).lt.eig_limit) then - print *,'From Mult_Norm: Eigenvalues of A are too small.' - fail=.true. - return - endif -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C - do i=1,n - sigma=1.0D0/dsqrt(eig(i)) - alim=-3.0D0*sigma - work(i)=anorm_distr(0.0D0,sigma,-alim,alim) - enddo -C -C Transform the vector of normal variables back to the original basis. -C - do i=1,n - xi=0.0D0 - do j=1,n - xi=xi+a(i,j)*work(j) - enddo - x(i)=xi - enddo - return - end -c------------------------------------------------------------------------ - subroutine mult_norm1(lda,n,a,z,box,x,fail) -C -C Generate the vector X whose elements obey the multi-gaussian multi-dimensional -C distribution from sum_{i=1}^m W(i)exp[-0.5*X'(i)A(i)X(i)]. LDA is the -C leading dimension of the moment matrix A, n is the dimension of the -C distribution, nlob is the number of lobes. FAIL is set at .TRUE., if the -C smallest eigenvalue of the matrix A is close to 0. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - double precision a(lda,n),z(n),x(n),box(n,n) - double precision etmp - include 'COMMON.IOUNITS' -#ifdef MP - include 'COMMON.SETUP' -#endif - logical fail -C -C Generate points following the normal distributions along the principal -C axes of the moment matrix. Store in WORK. -C -cd print *,'CG Processor',me,' entered MultNorm1.' -cd print '(2(1pe14.4),3x,1pe14.4)',((a(i,j),j=1,2),z(i),i=1,2) -cd do i=1,n -cd print *,i,box(1,i),box(2,i) -cd enddo - istep = 0 - 10 istep = istep + 1 - if (istep.gt.10000) then -c write (iout,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (*,'(a,i4,2a)') 'CG Processor: ',me,': too many steps', -c & ' in MultNorm1.' -c write (iout,*) 'box',box -c write (iout,*) 'a',a -c write (iout,*) 'z',z - fail=.true. - return - endif - do i=1,n - x(i)=ran_number(box(1,i),box(2,i)) - enddo - ww=0.0D0 - do i=1,n - xi=pinorm(x(i)-z(i)) - ww=ww+0.5D0*a(i,i)*xi*xi - do j=i+1,n - ww=ww+a(i,j)*xi*pinorm(x(j)-z(j)) - enddo - enddo - dec=ran_number(0.0D0,1.0D0) -c print *,(x(i),i=1,n),ww,dexp(-ww),dec -crc if (dec.gt.dexp(-ww)) goto 10 - if(-ww.lt.100) then - etmp=dexp(-ww) - else - return - endif - if (dec.gt.etmp) goto 10 -cd print *,'CG Processor',me,' exitting MultNorm1.' - return - end -c -crc-------------------------------------- - subroutine overlap_sc(scfail) -c Internal and cartesian coordinates must be consistent as input, -c and will be up-to-date on return. -c At the end of this procedure, scfail is true if there are -c overlapping residues left, or false otherwise (success) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical had_overlaps,fail,scfail - integer ioverlap(maxres),ioverlap_last - - had_overlaps=.false. - call overlap_sc_list(ioverlap,ioverlap_last) - if (ioverlap_last.gt.0) then - write (iout,*) '#OVERLAPing residues ',ioverlap_last - write (iout,'(20i4)') (ioverlap(k),k=1,ioverlap_last) - had_overlaps=.true. - endif - - maxsi=1000 - do k=1,1000 - if (ioverlap_last.eq.0) exit - - do ires=1,ioverlap_last - i=ioverlap(ires) - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) goto 999 - endif - enddo - - call chainbuild - call overlap_sc_list(ioverlap,ioverlap_last) -c write (iout,*) 'Overlaping residues ',ioverlap_last, -c & (ioverlap(j),j=1,ioverlap_last) - enddo - - if (k.le.1000.and.ioverlap_last.eq.0) then - scfail=.false. - if (had_overlaps) then - write (iout,*) '#OVERLAPing all corrected after ',k, - & ' random generation' - endif - else - scfail=.true. - write (iout,*) '#OVERLAPing NOT all corrected ',ioverlap_last - write (iout,'(20i4)') (ioverlap(j),j=1,ioverlap_last) - endif - - return - - 999 continue - write (iout,'(a30,i5,a12,i4)') - & '#OVERLAP FAIL in gen_side after',maxsi, - & 'iter for RES',i - scfail=.true. - return - end - - subroutine overlap_sc_list(ioverlap,ioverlap_last) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.VAR' - include 'COMMON.CALC' - logical fail - integer ioverlap(maxres),ioverlap_last - data redfac /0.5D0/ - - ioverlap_last=0 -C Check for SC-SC overlaps and mark residues -c print *,'>>overlap_sc nnt=',nnt,' nct=',nct - ind=0 - do i=iatsc_s,iatsc_e - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -c - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - if (j.gt.i+1) then - rcomp=sigmaii(itypi,itypj) - else - rcomp=sigma(itypi,itypj) - endif -c print '(2(a3,2i3),a3,2f10.5)', -c & ' i=',i,iti,' j=',j,itj,' d=',dist(nres+i,nres+j) -c & ,rcomp - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij - -ct if ( 1.0/rij .lt. redfac*rcomp .or. -ct & rij_shift.le.0.0D0 ) then - if ( rij_shift.le.0.0D0 ) then -cd write (iout,'(a,i3,a,i3,a,f10.5,a,3f10.5)') -cd & 'overlap SC-SC: i=',i,' j=',j, -cd & ' dist=',dist(nres+i,nres+j),' rcomp=', -cd & rcomp,1.0/rij,rij_shift - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=i - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.i) ioverlap_last=ioverlap_last-1 - enddo - ioverlap_last=ioverlap_last+1 - ioverlap(ioverlap_last)=j - do k=1,ioverlap_last-1 - if (ioverlap(k).eq.j) ioverlap_last=ioverlap_last-1 - enddo - endif - enddo - enddo - enddo - return - end diff --git a/source/unres/src_MD-restraints/geomout.F b/source/unres/src_MD-restraints/geomout.F deleted file mode 100644 index df698f5..0000000 --- a/source/unres/src_MD-restraints/geomout.F +++ /dev/null @@ -1,522 +0,0 @@ - subroutine pdbout(etot,tytul,iunit) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - character*50 tytul - dimension ica(maxres) - write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot -cmodel write (iunit,'(a5,i6)') 'MODEL',1 - if (nhfrag.gt.0) then - do j=1,nhfrag - iti=itype(hfrag(1,j)) - itj=itype(hfrag(2,j)) - if (j.lt.10) then - write (iunit,'(a5,i5,1x,a1,i1,2x,a3,i7,2x,a3,i7,i3,t76,i5)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - else - write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') - & 'HELIX',j,'H',j, - & restyp(iti),hfrag(1,j)-1, - & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) - endif - enddo - endif - - if (nbfrag.gt.0) then - - do j=1,nbfrag - - iti=itype(bfrag(1,j)) - itj=itype(bfrag(2,j)-1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3)') - & 'SHEET',1,'B',j,2, - & restyp(iti),bfrag(1,j)-1, - & restyp(itj),bfrag(2,j)-2,0 - - if (bfrag(3,j).gt.bfrag(4,j)) then - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)+1) - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itl),bfrag(4,j), - & restyp(itk),bfrag(3,j)-1,-1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - else - - itk=itype(bfrag(3,j)) - itl=itype(bfrag(4,j)-1) - - - write (iunit,'(a5,i5,1x,a1,i1,i3,1x,a3,i6,2x,a3,i6,i3, - & 2x,a1,2x,a3,i6,3x,a1,2x,a3,i6)') - & 'SHEET',2,'B',j,2, - & restyp(itk),bfrag(3,j)-1, - & restyp(itl),bfrag(4,j)-2,1, - & "N",restyp(itk),bfrag(3,j)-1, - & "O",restyp(iti),bfrag(1,j)-1 - - - - endif - - enddo - endif - - if (nss.gt.0) then - do i=1,nss - if (dyn_ss) then - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',idssb(i)-nnt+1, - & 'CYS',jdssb(i)-nnt+1 - else - write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, - & 'CYS',jhpb(i)-nnt+1-nres - endif - enddo - endif - - iatom=0 - do i=nnt,nct - ires=i-nnt+1 - iatom=iatom+1 - ica(i)=iatom - iti=itype(i) - write (iunit,10) iatom,restyp(iti),ires,(c(j,i),j=1,3),vtot(i) - if (iti.ne.10) then - iatom=iatom+1 - write (iunit,20) iatom,restyp(iti),ires,(c(j,nres+i),j=1,3), - & vtot(i+nres) - endif - enddo - write (iunit,'(a)') 'TER' - do i=nnt,nct-1 - if (itype(i).eq.10) then - write (iunit,30) ica(i),ica(i+1) - else - write (iunit,30) ica(i),ica(i+1),ica(i)+1 - endif - enddo - if (itype(nct).ne.10) then - write (iunit,30) ica(nct),ica(nct)+1 - endif - do i=1,nss - if (dyn_ss) then - write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 - else - write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 - endif - enddo - write (iunit,'(a6)') 'ENDMDL' - 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) - 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3,f15.3) - 30 FORMAT ('CONECT',8I5) - return - end -c------------------------------------------------------------------------------ - subroutine MOL2out(etot,tytul) -C Prints the Cartesian coordinates of the alpha-carbons in the Tripos mol2 -C format. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - character*32 tytul,fd - character*3 zahl - character*6 res_num,pom,ucase -#ifdef AIX - call fdate_(fd) -#elif (defined CRAY) - call date(fd) -#else - call fdate(fd) -#endif - write (imol2,'(a)') '#' - write (imol2,'(a)') - & '# Creating user name: unres' - write (imol2,'(2a)') '# Creation time: ', - & fd - write (imol2,'(/a)') '\@MOLECULE' - write (imol2,'(a)') tytul - write (imol2,'(5i5)') nct-nnt+1,nct-nnt+nss+1,nct-nnt+nss+1,0,0 - write (imol2,'(a)') 'SMALL' - write (imol2,'(a)') 'USER_CHARGES' - write (imol2,'(a)') '\@ATOM' - do i=nnt,nct - write (zahl,'(i3)') i - pom=ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,10) i,(c(j,i),j=1,3),i,res_num,0.0 - enddo - write (imol2,'(a)') '\@BOND' - do i=nnt,nct-1 - write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 - enddo - do i=1,nss - write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 - enddo - write (imol2,'(a)') '\@SUBSTRUCTURE' - do i=nnt,nct - write (zahl,'(i3)') i - pom = ucase(restyp(itype(i))) - res_num = pom(:3)//zahl(2:) - write (imol2,30) i-nnt+1,res_num,i-nnt+1,0 - enddo - 10 FORMAT (I7,' CA ',3F10.4,' C.3',I8,1X,A,F11.4,' ****') - 30 FORMAT (I7,1x,A,I14,' RESIDUE',I13,' **** ****') - return - end -c------------------------------------------------------------------------ - subroutine intout - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - write (iout,'(/a)') 'Geometry of the virtual chain.' - write (iout,'(7a)') ' Res ',' d',' Theta', - & ' Gamma',' Dsc',' Alpha',' Beta ' - do i=1,nres - iti=itype(i) - write (iout,'(a3,i4,6f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),rad2deg*alph(i), - & rad2deg*omeg(i) - enddo - return - end -c--------------------------------------------------------------------------- - subroutine briefout(it,ener) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SBRIDGE' -c print '(a,i5)',intname,igeom -#if defined(AIX) || defined(PGI) - open (igeom,file=intname,position='append') -#else - open (igeom,file=intname,access='append') -#endif - IF (NSS.LE.9) THEN - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,NSS) - ELSE - WRITE (igeom,180) IT,ENER,NSS,(IHPB(I),JHPB(I),I=1,9) - WRITE (igeom,190) (IHPB(I),JHPB(I),I=10,NSS) - ENDIF -c IF (nvar.gt.nphi) WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*THETA(I),I=3,NRES) - WRITE (igeom,200) (RAD2DEG*PHI(I),I=4,NRES) -c if (nvar.gt.nphi+ntheta) then - write (igeom,200) (rad2deg*alph(i),i=2,nres-1) - write (igeom,200) (rad2deg*omeg(i),i=2,nres-1) -c endif - close(igeom) - 180 format (I5,F12.3,I2,9(1X,2I3)) - 190 format (3X,11(1X,2I3)) - 200 format (8F10.4) - return - end -#ifdef WINIFL - subroutine fdate(fd) - character*32 fd - write(fd,'(32x)') - return - end -#endif -c---------------------------------------------------------------- -#ifdef NOXDR - subroutine cartout(time) -#else - subroutine cartoutx(time) -#endif - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time -#if defined(AIX) || defined(PGI) - open(icart,file=cartname,position="append") -#else - open(icart,file=cartname,access="append") -#endif - write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - if (dyn_ss) then - write (icart,'(i4,$)') - & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) - else - write (icart,'(i4,$)') - & nss,(ihpb(j),jhpb(j),j=1,nss) - endif - write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, - & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write (icart,'(8f10.5)') - & ((c(k,j),k=1,3),j=1,nres), - & ((c(k,j+nres),k=1,3),j=nnt,nct) - close(icart) - return - end -c----------------------------------------------------------------- -#ifndef NOXDR - subroutine cartout(time) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#else - parameter (me=0) -#endif - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - double precision time - integer iret,itmp - real xcoord(3,maxres2+2),prec - -#ifdef AIX - call xdrfopen_(ixdrf,cartname, "a", iret) - call xdrffloat_(ixdrf, real(time), iret) - call xdrffloat_(ixdrf, real(potE), iret) - call xdrffloat_(ixdrf, real(uconst), iret) - call xdrffloat_(ixdrf, real(uconst_back), iret) - call xdrffloat_(ixdrf, real(t_bath), iret) - call xdrfint_(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint_(ixdrf, idssb(j)+nres, iret) - call xdrfint_(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat_(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat_(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat_(ixdrf, real(utheta(i)), iret) - call xdrffloat_(ixdrf, real(ugamma(i)), iret) - call xdrffloat_(ixdrf, real(uscdiff(i)), iret) - enddo -#else - call xdrfopen(ixdrf,cartname, "a", iret) - call xdrffloat(ixdrf, real(time), iret) - call xdrffloat(ixdrf, real(potE), iret) - call xdrffloat(ixdrf, real(uconst), iret) - call xdrffloat(ixdrf, real(uconst_back), iret) - call xdrffloat(ixdrf, real(t_bath), iret) - call xdrfint(ixdrf, nss, iret) - do j=1,nss - if (dyn_ss) then - call xdrfint(ixdrf, idssb(j)+nres, iret) - call xdrfint(ixdrf, jdssb(j)+nres, iret) - else - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - endif - enddo - call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) - do i=1,nfrag - call xdrffloat(ixdrf, real(qfrag(i)), iret) - enddo - do i=1,npair - call xdrffloat(ixdrf, real(qpair(i)), iret) - enddo - do i=1,nfrag_back - call xdrffloat(ixdrf, real(utheta(i)), iret) - call xdrffloat(ixdrf, real(ugamma(i)), iret) - call xdrffloat(ixdrf, real(uscdiff(i)), iret) - enddo -#endif - prec=10000.0 - do i=1,nres - do j=1,3 - xcoord(j,i)=c(j,i) - enddo - enddo - do i=nnt,nct - do j=1,3 - xcoord(j,nres+i-nnt+1)=c(j,i+nres) - enddo - enddo - - itmp=nres+nct-nnt+1 -#ifdef AIX - call xdrf3dfcoord_(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose_(ixdrf, iret) -#else - call xdrf3dfcoord(ixdrf, xcoord, itmp, prec, iret) - call xdrfclose(ixdrf, iret) -#endif - return - end -#endif -c----------------------------------------------------------------- - subroutine statout(itime) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.DISTFIT' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - integer itime - double precision energia(0:n_ene) - double precision gyrate - external gyrate - common /gucio/ cm - character*256 line1,line2 - character*4 format1,format2 - character*30 format -#ifdef AIX - if(itime.eq.0) then - open(istat,file=statname,position="append") - endif -#else -#ifdef PGI - open(istat,file=statname,position="append") -#else - open(istat,file=statname,access="append") -#endif -#endif - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.false.) - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,3f12.3,f12.6,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a145" - else - write (line1,'(i10,f15.2,3f12.3,f7.2,4f6.3,3f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & rms,frac,frac_nn,co,amax,kinetic_T,t_bath,gyrate(),me - format1="a133" - endif - else - if(tnp .or. tnp1 .or. tnh) then - write (line1,'(i10,f15.2,7f12.3,f12.6,i5,$)') - & itime,totT,EK,potE,totE,hhh, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a126" - else - write (line1,'(i10,f15.2,7f12.3,i5,$)') - & itime,totT,EK,potE,totE, - & amax,kinetic_T,t_bath,gyrate(),me - format1="a114" - endif - endif - if(usampl.and.totT.gt.eq_time) then - write(line2,'(i5,2f9.4,300f7.4)') iset,uconst,uconst_back, - & (qfrag(ii1),ii1=1,nfrag),(qpair(ii2),ii2=1,npair), - & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) - write(format2,'(a1,i3.3)') "a",23+7*nfrag+7*npair - & +21*nfrag_back - elseif(hremd.gt.0) then - write(line2,'(i5)') iset - format2="a005" - else - format2="a001" - line2=' ' - endif - if (print_compon) then - if(itime.eq.0) then - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",20a12)" - write (istat,format) "#","", - & (ename(print_order(i)),i=1,nprint_ene) - endif - write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, - & ",20f12.3)" - write (istat,format) line1,line2, - & (potEcomp(print_order(i)),i=1,nprint_ene) - else - write(format,'(a1,a4,a1,a4,a1)') "(",format1,",",format2,")" - write (istat,format) line1,line2 - endif -#if defined(AIX) - call flush(istat) -#else - close(istat) -#endif - return - end -c--------------------------------------------------------------- - double precision function gyrate() - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - double precision cen(3),rg - - do j=1,3 - cen(j)=0.0d0 - enddo - - do i=nnt,nct - do j=1,3 - cen(j)=cen(j)+c(j,i) - enddo - enddo - do j=1,3 - cen(j)=cen(j)/dble(nct-nnt+1) - enddo - rg = 0.0d0 - do i = nnt, nct - do j=1,3 - rg = rg + (c(j,i)-cen(j))**2 - enddo - end do - gyrate = sqrt(rg/dble(nct-nnt+1)) - return - end - diff --git a/source/unres/src_MD-restraints/gnmr1.f b/source/unres/src_MD-restraints/gnmr1.f deleted file mode 100644 index 905e746..0000000 --- a/source/unres/src_MD-restraints/gnmr1.f +++ /dev/null @@ -1,43 +0,0 @@ - double precision function gnmr1(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1=(ymin-y)**wykl/wykl - else if (y.gt.ymax) then - gnmr1=(y-ymax)**wykl/wykl - else - gnmr1=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function gnmr1prim(y,ymin,ymax) - implicit none - double precision y,ymin,ymax - double precision wykl /4.0d0/ - if (y.lt.ymin) then - gnmr1prim=-(ymin-y)**(wykl-1) - else if (y.gt.ymax) then - gnmr1prim=(y-ymax)**(wykl-1) - else - gnmr1prim=0.0d0 - endif - return - end -c------------------------------------------------------------------------------ - double precision function harmonic(y,ymax) - implicit none - double precision y,ymax - double precision wykl /2.0d0/ - harmonic=(y-ymax)**wykl - return - end -c------------------------------------------------------------------------------- - double precision function harmonicprim(y,ymax) - double precision y,ymin,ymax - double precision wykl /2.0d0/ - harmonicprim=(y-ymax)*wykl - return - end -c--------------------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/gradient_p.F b/source/unres/src_MD-restraints/gradient_p.F deleted file mode 100644 index 7fec1e8..0000000 --- a/source/unres/src_MD-restraints/gradient_p.F +++ /dev/null @@ -1,421 +0,0 @@ - subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c This subroutine calculates total internal coordinate gradient. -c Depending on the number of function evaluations, either whole energy -c is evaluated beforehand, Cartesian coordinates and their derivatives in -c internal coordinates are reevaluated or only the cartesian-in-internal -c coordinate derivatives are evaluated. The subroutine was designed to work -c with SUMSL. -c -c - icg=mod(nf,2)+1 - -cd print *,'grad',nf,icg - if (nf-nfl+1) 20,30,40 - 20 call func(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom(n,x) - call chainbuild -c write (iout,*) 'grad 30' -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -c write (iout,*) 'grad 40' -c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - ind=0 - ind1=0 - do i=1,nres-2 - gthetai=0.0D0 - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 -c ind=indmat(i,j) -c print *,'GRAD: i=',i,' jc=',j,' ind=',ind - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - enddo - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - enddo - enddo - do j=i+1,nres-1 - ind1=ind1+1 -c ind1=indmat(i,j) -c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 - do k=1,3 - gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) - gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) - enddo - enddo - if (i.gt.1) g(i-1)=gphii - if (n.gt.nphi) g(nphi+i)=gthetai - enddo - if (n.le.nphi+ntheta) goto 10 - do i=2,nres-1 - if (itype(i).ne.10) then - galphai=0.0D0 - gomegai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ialph(i,1))=galphai - g(ialph(i,1)+nside)=gomegai - endif - enddo -C -C Add the components corresponding to local energy terms. -C - 10 continue - do i=1,nvar -cd write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg) - g(i)=g(i)+gloc(i,icg) - enddo -C Uncomment following three lines for diagnostics. -cd call intout -cd call briefout(0,0.0d0) -cd write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n) - return - end -C------------------------------------------------------------------------- - subroutine grad_restr(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 continue -#ifdef OSF -c Intercept NaNs in the coordinates -c write(iout,*) (var(i),i=1,nvar) - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - if (x_sum.ne.x_sum) then - write(iout,*)" *** grad_restr : Found NaN in coordinates" - call flush(iout) - print *," *** grad_restr : Found NaN in coordinates" - return - endif -#endif - call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C------------------------------------------------------------------------- - subroutine cartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SCCOR' -c -c This subrouting calculates total Cartesian coordinate gradient. -c The subroutine chainbuild_cart and energy MUST be called beforehand. -c -c do i=1,nres -c write (iout,*) "przed sum_grad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo - -#ifdef TIMING - time00=MPI_Wtime() -#endif - icg=1 - call sum_gradient -#ifdef TIMING -#endif -c do i=1,nres -c write (iout,*) "checkgrad", gloc_sc(1,i,icg),gloc(i,icg) -c enddo -cd write (iout,*) "After sum_gradient" -cd do i=1,nres-1 -cd write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) -cd write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) -cd enddo -c If performing constraint dynamics, add the gradients of the constraint energy - if(usampl.and.totT.gt.eq_time) then - do i=1,nct - do j=1,3 - gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i) - gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i) - enddo - enddo - do i=1,nres-3 - gloc(i,icg)=gloc(i,icg)+dugamma(i) - enddo - do i=1,nres-2 - gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) - enddo - endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - call intcartderiv -#ifdef TIMING - time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 -#endif -cd call checkintcartgrad -cd write(iout,*) 'calling int_to_cart' -cd write (iout,*) "gcart, gxcart, gloc before int_to_cart" - do i=1,nct - do j=1,3 - gcart(j,i)=gradc(j,i,icg) - gxcart(j,i)=gradx(j,i,icg) - enddo -cd write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3),gloc(i,icg) - enddo -#ifdef TIMING - time01=MPI_Wtime() -#endif - call int_to_cart -#ifdef TIMING - time_inttocart=time_inttocart+MPI_Wtime()-time01 -#endif -cd write (iout,*) "gcart and gxcart after int_to_cart" -cd do i=0,nres-1 -cd write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), -cd & (gxcart(j,i),j=1,3) -cd enddo -#ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 -#endif - return - end -C------------------------------------------------------------------------- - subroutine zerograd - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.SCCOR' -C -C Initialize Cartesian-coordinate gradient -C - do i=1,nres - do j=1,3 - gvdwx(j,i)=0.0D0 - gvdwxT(j,i)=0.0D0 - gradx_scp(j,i)=0.0D0 - gvdwc(j,i)=0.0D0 - gvdwcT(j,i)=0.0D0 - gvdwc_scp(j,i)=0.0D0 - gvdwc_scpp(j,i)=0.0d0 - gelc (j,i)=0.0D0 - gelc_long(j,i)=0.0D0 - gradb(j,i)=0.0d0 - gradbx(j,i)=0.0d0 - gvdwpp(j,i)=0.0d0 - gel_loc(j,i)=0.0d0 - gel_loc_long(j,i)=0.0d0 - ghpbc(j,i)=0.0D0 - ghpbx(j,i)=0.0D0 - gcorr3_turn(j,i)=0.0d0 - gcorr4_turn(j,i)=0.0d0 - gradcorr(j,i)=0.0d0 - gradcorr_long(j,i)=0.0d0 - gradcorr5_long(j,i)=0.0d0 - gradcorr6_long(j,i)=0.0d0 - gcorr6_turn_long(j,i)=0.0d0 - gradcorr5(j,i)=0.0d0 - gradcorr6(j,i)=0.0d0 - gcorr6_turn(j,i)=0.0d0 - gsccorc(j,i)=0.0d0 - gsccorx(j,i)=0.0d0 - gradc(j,i,icg)=0.0d0 - gradx(j,i,icg)=0.0d0 - gscloc(j,i)=0.0d0 - gsclocx(j,i)=0.0d0 - do intertyp=1,3 - gloc_sc(intertyp,i,icg)=0.0d0 - enddo - enddo - enddo -C -C Initialize the gradient of local energy terms. -C - do i=1,4*nres - gloc(i,icg)=0.0D0 - enddo - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - g_corr5_loc(i)=0.0d0 - g_corr6_loc(i)=0.0d0 - gel_loc_turn3(i)=0.0d0 - gel_loc_turn4(i)=0.0d0 - gel_loc_turn6(i)=0.0d0 - gsccor_loc(i)=0.0d0 - enddo -c initialize gcart and gxcart - do i=0,nres - do j=1,3 - gcart(j,i)=0.0d0 - gxcart(j,i)=0.0d0 - enddo - enddo - return - end -c------------------------------------------------------------------------- - double precision function fdum() - fdum=0.0D0 - return - end diff --git a/source/unres/src_MD-restraints/initialize_p.F b/source/unres/src_MD-restraints/initialize_p.F deleted file mode 100644 index 4073802..0000000 --- a/source/unres/src_MD-restraints/initialize_p.F +++ /dev/null @@ -1,1439 +0,0 @@ - block data - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MD' - data MovTypID - & /'pool','chain regrow','multi-bond','phi','theta','side chain', - & 'total'/ -c Conversion from poises to molecular unit and the gas constant - data cPoise /2.9361d0/, Rb /0.001986d0/ - end -c-------------------------------------------------------------------------- - subroutine initialize -C -C Define constants and zero out tables. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif -#ifndef ISNAN - external proc_proc -#ifdef WINPGI -cMS$ATTRIBUTES C :: proc_proc -#endif -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.MCM' - include 'COMMON.MINIM' - include 'COMMON.DERIV' - include 'COMMON.SPLITELE' -c Common blocks from the diagonalization routines - COMMON /IOFILE/ IR,IW,IP,IJK,IPK,IDAF,NAV,IODA(400) - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - logical mask_r -c real*8 text1 /'initial_i'/ - - mask_r=.false. -#ifndef ISNAN -c NaNQ initialization - i=-1 - arg=100.0d0 - rr=dacos(arg) -#ifdef WINPGI - idumm=proc_proc(rr,i) -#else - call proc_proc(rr,i) -#endif -#endif - - kdiag=0 - icorfl=0 - iw=2 -C -C The following is just to define auxiliary variables used in angle conversion -C - pi=4.0D0*datan(1.0D0) - dwapi=2.0D0*pi - dwapi3=dwapi/3.0D0 - pipol=0.5D0*pi - deg2rad=pi/180.0D0 - rad2deg=1.0D0/deg2rad - angmin=10.0D0*deg2rad -C -C Define I/O units. -C - inp= 1 - iout= 2 - ipdbin= 3 - ipdb= 7 - icart = 30 - imol2= 4 - igeom= 8 - intin= 9 - ithep= 11 - ithep_pdb=51 - irotam=12 - irotam_pdb=52 - itorp= 13 - itordp= 23 - ielep= 14 - isidep=15 - iscpp=25 - icbase=16 - ifourier=20 - istat= 17 - irest1=55 - irest2=56 - iifrag=57 - ientin=18 - ientout=19 - ibond = 28 - isccor = 29 -crc for write_rmsbank1 - izs1=21 -cdr include secondary structure prediction bias - isecpred=27 -C -C CSA I/O units (separated from others especially for Jooyoung) -C - icsa_rbank=30 - icsa_seed=31 - icsa_history=32 - icsa_bank=33 - icsa_bank1=34 - icsa_alpha=35 - icsa_alpha1=36 - icsa_bankt=37 - icsa_int=39 - icsa_bank_reminimized=38 - icsa_native_int=41 - icsa_in=40 -crc for ifc error 118 - icsa_pdb=42 -C -C Set default weights of the energy terms. -C - wlong=1.0D0 - welec=1.0D0 - wtor =1.0D0 - wang =1.0D0 - wscloc=1.0D0 - wstrain=1.0D0 -C -C Zero out tables. -C - print '(a,$)','Inside initialize' -c call memmon_print_usage() - do i=1,maxres2 - do j=1,3 - c(j,i)=0.0D0 - dc(j,i)=0.0D0 - enddo - enddo - do i=1,maxres - do j=1,3 - xloc(j,i)=0.0D0 - enddo - enddo - do i=1,ntyp - do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 - augm(i,j)=0.0D0 - sigma(i,j)=0.0D0 - r0(i,j)=0.0D0 - chi(i,j)=0.0D0 - enddo - do j=1,2 - bad(i,j)=0.0D0 - enddo - chip(i)=0.0D0 - alp(i)=0.0D0 - sigma0(i)=0.0D0 - sigii(i)=0.0D0 - rr0(i)=0.0D0 - a0thet(i)=0.0D0 - do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 - enddo - do j=0,3 - polthet(j,i)=0.0D0 - enddo - do j=1,3 - gthet(j,i)=0.0D0 - enddo - theta0(i)=0.0D0 - sig0(i)=0.0D0 - sigc0(i)=0.0D0 - do j=1,maxlob - bsc(j,i)=0.0D0 - do k=1,3 - censc(k,j,i)=0.0D0 - enddo - do k=1,3 - do l=1,3 - gaussc(l,k,j,i)=0.0D0 - enddo - enddo - nlob(i)=0 - enddo - enddo - nlob(ntyp1)=0 - dsc(ntyp1)=0.0D0 - do i=1,maxtor - itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 - enddo - enddo - enddo - do i=1,maxres - itype(i)=0 - itel(i)=0 - enddo -C Initialize the bridge arrays - ns=0 - nss=0 - nhpb=0 - do i=1,maxss - iss(i)=0 - enddo - do i=1,maxdim - dhpb(i)=0.0D0 - enddo - do i=1,maxres - ihpb(i)=0 - jhpb(i)=0 - enddo -C -C Initialize timing. -C - call set_timers -C -C Initialize variables used in minimization. -C -c maxfun=5000 -c maxit=2000 - maxfun=500 - maxit=200 - tolf=1.0D-2 - rtolf=5.0D-4 -C -C Initialize the variables responsible for the mode of gradient storage. -C - nfl=0 - icg=1 -C -C Initialize constants used to split the energy into long- and short-range -C components -C - r_cut=2.0d0 - rlamb=0.3d0 -#ifndef SPLITELE - nprint_ene=nprint_ene-1 -#endif - return - end -c------------------------------------------------------------------------- - block data nazwy - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.FFIELD' - data restyp / - &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ - data onelet / - &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ - data potname /'LJ','LJK','BP','GB','GBV'/ - data ename / - & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", - & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", - & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB ","EVDWPP ", - & "ESTR ","EVDW2_14 ","UCONST ", " ","ESCCOR"," "," ", - & "Ehomology"/ - data wname / - & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", - & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WSTRAIN","WVDWPP","WBOND","SCAL14"," "," ","WSCCOR", - & " "," ","EHOMO"/ - data nprint_ene /20/ - data print_order/1,2,3,11,12,13,14,4,5,6,7,8,9,10,19,18,15,17,16, - & 21,24,0,0,0/ - end -c--------------------------------------------------------------------------- - subroutine init_int_table - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer blocklengths(15),displs(15) -#endif - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.SBRIDGE' - include 'COMMON.TORCNSTR' - include 'COMMON.IOUNITS' - include 'COMMON.DERIV' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1), - & ntask_cont_from_all(0:max_fg_procs-1), - & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), - & ntask_cont_to_all(0:max_fg_procs-1), - & itask_cont_to_all(0:max_fg_procs-1,0:max_fg_procs-1) - integer FG_GROUP,CONT_FROM_GROUP,CONT_TO_GROUP - logical scheck,lprint,flag -#ifdef MPI - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - do i=0,nfgtasks-1 - itask_cont_from(i)=fg_rank - itask_cont_to(i)=fg_rank - enddo - lprint=.false. - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif -c lprint=.false. - do i=1,maxres - nint_gr(i)=0 - nscp_gr(i)=0 - do j=1,maxint_gr - istart(i,1)=0 - iend(i,1)=0 - ielstart(i)=0 - ielend(i)=0 - iscpstart(i,1)=0 - iscpend(i,1)=0 - enddo - enddo - ind_scint=0 - ind_scint_old=0 -cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', -cd & (ihpb(i),jhpb(i),i=1,nss) - do i=nnt,nct-1 - scheck=.false. - if (dyn_ss) goto 10 - do ii=1,nss - if (ihpb(ii).eq.i+nres) then - scheck=.true. - jj=jhpb(ii)-nres - goto 10 - endif - enddo - 10 continue -cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj - if (scheck) then - if (jj.eq.i+1) then -#ifdef MPI -c write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+2 - iend(i,1)=nct -#endif - else if (jj.eq.nct) then -#ifdef MPI -c write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct-1 -#endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else - nint_gr(i)=2 - istart(i,1)=i+1 - iend(i,1)=jj-1 - istart(i,2)=jj+1 - iend(i,2)=nct -#endif - endif - else -#ifdef MPI - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else - nint_gr(i)=1 - istart(i,1)=i+1 - iend(i,1)=nct - ind_scint=ind_scint+nct-i -#endif - endif -#ifdef MPI - ind_scint_old=ind_scint -#endif - enddo - 12 continue -#ifndef MPI - iatsc_s=nnt - iatsc_e=nct-1 -#endif -#ifdef MPI - if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor, - & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e -#endif - if (lprint) then - write (iout,'(a)') 'Interaction array:' - do i=iatsc_s,iatsc_e - write (iout,'(i3,2(2x,2i3))') - & i,(istart(i,iint),iend(i,iint),iint=1,nint_gr(i)) - enddo - endif - ispp=4 -#ifdef MPI -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue - if (iatel_s.eq.0) iatel_s=1 - nele_int_tot_vdw=(npept-2)*(npept-2+1)/2 -c write (iout,*) "nele_int_tot_vdw",nele_int_tot_vdw - call int_bounds(nele_int_tot_vdw,my_ele_inds_vdw,my_ele_inde_vdw) -c write (iout,*) "my_ele_inds_vdw",my_ele_inds_vdw, -c & " my_ele_inde_vdw",my_ele_inde_vdw - ind_eleint_vdw=0 - ind_eleint_vdw_old=0 - iatel_s_vdw=0 - iatel_e_vdw=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint_vdw,my_ele_inds_vdw, - & my_ele_inde_vdw,i, - & iatel_s_vdw,iatel_e_vdw,i+2,nct-1,ijunk,ielstart_vdw(i), - & ielend_vdw(i),*15) -c write (iout,*) i," ielstart_vdw",ielstart_vdw(i), -c & " ielend_vdw",ielend_vdw(i) - enddo ! i - if (iatel_s_vdw.eq.0) iatel_s_vdw=1 - 15 continue -#else - iatel_s=nnt - iatel_e=nct-5 - do i=iatel_s,iatel_e - ielstart(i)=i+4 - ielend(i)=nct-1 - enddo - iatel_s_vdw=nnt - iatel_e_vdw=nct-3 - do i=iatel_s_vdw,iatel_e_vdw - ielstart_vdw(i)=i+2 - ielend_vdw(i)=nct-1 - enddo -#endif - if (lprint) then - write (*,'(a)') 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank - write (iout,*) 'Electrostatic interaction array:' - do i=iatel_s,iatel_e - write (iout,'(i3,2(2x,2i3))') i,ielstart(i),ielend(i) - enddo - endif ! lprint -c iscp=3 - iscp=2 -C Partition the SC-p interaction array -#ifdef MPI - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else - iatscp_s=nnt - iatscp_e=nct-1 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=i+iscp - iscpend(i,1)=nct - elseif (i.gt.nct-iscp) then - nscp_gr(i)=1 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - else - nscp_gr(i)=2 - iscpstart(i,1)=nnt - iscpend(i,1)=i-iscp - iscpstart(i,2)=i+iscp - iscpend(i,2)=nct - endif - enddo ! i -#endif - if (lprint) then - write (iout,'(a)') 'SC-p interaction array:' - do i=iatscp_s,iatscp_e - write (iout,'(i3,2(2x,2i3))') - & i,(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) - enddo - endif ! lprint -C Partition local interactions -#ifdef MPI - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iturn3_start,iturn3_end) - iturn3_start=iturn3_start+nnt - iphi_start=iturn3_start+2 - iturn3_end=iturn3_end+nnt - iphi_end=iturn3_end+2 - iturn3_start=iturn3_start-1 - iturn3_end=iturn3_end-1 - call int_bounds(nres-3,itau_start,itau_end) - itau_start=itau_start+3 - itau_end=itau_end+3 - call int_bounds(nres-3,iphi1_start,iphi1_end) - iphi1_start=iphi1_start+3 - iphi1_end=iphi1_end+3 - call int_bounds(nct-nnt-3,iturn4_start,iturn4_end) - iturn4_start=iturn4_start+nnt - iphid_start=iturn4_start+2 - iturn4_end=iturn4_end+nnt - iphid_end=iturn4_end+2 - iturn4_start=iturn4_start-1 - iturn4_end=iturn4_end-1 - call int_bounds(nres-2,ibond_start,ibond_end) - ibond_start=ibond_start+1 - ibond_end=ibond_end+1 - call int_bounds(nct-nnt,ibondp_start,ibondp_end) - ibondp_start=ibondp_start+nnt - ibondp_end=ibondp_end+nnt - call int_bounds1(nres-1,ivec_start,ivec_end) - print *,"Processor",myrank,fg_rank,fg_rank1, - & " ivec_start",ivec_start," ivec_end",ivec_end - iset_start=loc_start+2 - iset_end=loc_end+2 - if (ndih_constr.eq.0) then - idihconstr_start=1 - idihconstr_end=0 - else - call int_bounds(ndih_constr,idihconstr_start,idihconstr_end) - endif - nsumgrad=(nres-nnt)*(nres-nnt+1)/2 - nlen=nres-nnt+1 - call int_bounds(nsumgrad,ngrad_start,ngrad_end) - igrad_start=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_start-1))))/2 - jgrad_start(igrad_start)= - & ngrad_start-(2*nlen-igrad_start)*(igrad_start-1)/2 - & +igrad_start - jgrad_end(igrad_start)=nres - igrad_end=((2*nlen+1) - & -sqrt(float((2*nlen-1)**2-8*(ngrad_end-1))))/2 - if (igrad_end.gt.igrad_start) jgrad_start(igrad_end)=igrad_end+1 - jgrad_end(igrad_end)=ngrad_end-(2*nlen-igrad_end)*(igrad_end-1)/2 - & +igrad_end - do i=igrad_start+1,igrad_end-1 - jgrad_start(i)=i+1 - jgrad_end(i)=nres - enddo - if (lprint) then - write (*,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end, - & ' iphid_start',iphid_start,' iphid_end',iphid_end, - & ' ibond_start',ibond_start,' ibond_end',ibond_end, - & ' ibondp_start',ibondp_start,' ibondp_end',ibondp_end, - & ' iturn3_start',iturn3_start,' iturn3_end',iturn3_end, - & ' iturn4_start',iturn4_start,' iturn4_end',iturn4_end, - & ' ivec_start',ivec_start,' ivec_end',ivec_end, - & ' iset_start',iset_start,' iset_end',iset_end, - & ' idihconstr_start',idihconstr_start,' idihconstr_end', - & idihconstr_end - write (*,*) 'Processor:',fg_rank,myrank,' igrad_start', - & igrad_start,' igrad_end',igrad_end,' ngrad_start',ngrad_start, - & ' ngrad_end',ngrad_end - do i=igrad_start,igrad_end - write(*,*) 'Processor:',fg_rank,myrank,i, - & jgrad_start(i),jgrad_end(i) - enddo - endif - if (nfgtasks.gt.1) then - call MPI_Allgather(ivec_start,1,MPI_INTEGER,ivec_displ(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - iaux=ivec_end-ivec_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ivec_count(0),1, - & MPI_INTEGER,FG_COMM1,IERROR) - call MPI_Allgather(iset_start-2,1,MPI_INTEGER,iset_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iset_end-iset_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iset_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ibond_start,1,MPI_INTEGER,ibond_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ibond_end-ibond_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ibond_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ithet_start,1,MPI_INTEGER,ithet_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=ithet_end-ithet_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,ithet_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi_start,1,MPI_INTEGER,iphi_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi_end-iphi_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iphi1_start,1,MPI_INTEGER,iphi1_displ(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - iaux=iphi1_end-iphi1_start+1 - call MPI_Allgather(iaux,1,MPI_INTEGER,iphi1_count(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - do i=0,maxprocs-1 - do j=1,maxres - ielstart_all(j,i)=0 - ielend_all(j,i)=0 - enddo - enddo - call MPI_Allgather(iturn3_start,1,MPI_INTEGER, - & iturn3_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_start,1,MPI_INTEGER, - & iturn4_start_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn3_end,1,MPI_INTEGER, - & iturn3_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iturn4_end,1,MPI_INTEGER, - & iturn4_end_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_s,1,MPI_INTEGER, - & iatel_s_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(iatel_e,1,MPI_INTEGER, - & iatel_e_all(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielstart(1),maxres,MPI_INTEGER, - & ielstart_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(ielend(1),maxres,MPI_INTEGER, - & ielend_all(1,0),maxres,MPI_INTEGER,FG_COMM,IERROR) - if (lprint) then - write (iout,*) "iatel_s_all",(iatel_s_all(i),i=0,nfgtasks) - write (iout,*) "iatel_e_all",(iatel_e_all(i),i=0,nfgtasks) - write (iout,*) "iturn3_start_all", - & (iturn3_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn3_end_all", - & (iturn3_end_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_start_all", - & (iturn4_start_all(i),i=0,nfgtasks-1) - write (iout,*) "iturn4_end_all", - & (iturn4_end_all(i),i=0,nfgtasks-1) - write (iout,*) "The ielstart_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielstart_all(i,j),j=0,nfgtasks-1) - enddo - write (iout,*) "The ielend_all array" - do i=nnt,nct - write (iout,'(20i4)') i,(ielend_all(i,j),j=0,nfgtasks-1) - enddo - call flush(iout) - endif - ntask_cont_from=0 - ntask_cont_to=0 - itask_cont_from(0)=fg_rank - itask_cont_to(0)=fg_rank - flag=.false. - do ii=iturn3_start,iturn3_end - call add_int(ii,ii+2,iturn3_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn4_start,iturn4_end - call add_int(ii,ii+3,iturn4_sent(1,ii), - & ntask_cont_to,itask_cont_to,flag) - enddo - do ii=iturn3_start,iturn3_end - call add_int_from(ii,ii+2,ntask_cont_from,itask_cont_from) - enddo - do ii=iturn4_start,iturn4_end - call add_int_from(ii,ii+3,ntask_cont_from,itask_cont_from) - enddo - if (lprint) then - write (iout,*) "After turn3 ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - endif -c write (iout,*) "Loop forward" -c call flush(iout) - do i=iatel_s,iatel_e -c write (iout,*) "from loop i=",i -c call flush(iout) - do j=ielstart(i),ielend(i) - call add_int_from(i,j,ntask_cont_from,itask_cont_from) - enddo - enddo -c write (iout,*) "Loop backward iatel_e-1",iatel_e-1, -c & " iatel_e",iatel_e -c call flush(iout) - nat_sent=0 - do i=iatel_s,iatel_e -c write (iout,*) "i",i," ielstart",ielstart(i), -c & " ielend",ielend(i) -c call flush(iout) - flag=.false. - do j=ielstart(i),ielend(i) - call add_int(i,j,iint_sent(1,j,nat_sent+1),ntask_cont_to, - & itask_cont_to,flag) - enddo - if (flag) then - nat_sent=nat_sent+1 - iat_sent(nat_sent)=i - endif - enddo - if (lprint) then - write (iout,*)"After longrange ntask_cont_from",ntask_cont_from, - & " ntask_cont_to",ntask_cont_to - write (iout,*) "itask_cont_from", - & (itask_cont_from(i),i=1,ntask_cont_from) - write (iout,*) "itask_cont_to", - & (itask_cont_to(i),i=1,ntask_cont_to) - call flush(iout) - write (iout,*) "iint_sent" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - enddo - write (iout,*) "iturn3_sent iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Gather(ntask_cont_from,1,MPI_INTEGER, - & ntask_cont_from_all,1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_from ended" -c call flush(iout) - call MPI_Gather(itask_cont_from(0),max_fg_procs,MPI_INTEGER, - & itask_cont_from_all(0,0),max_fg_procs,MPI_INTEGER,king, - & FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_from ended" -c call flush(iout) - call MPI_Gather(ntask_cont_to,1,MPI_INTEGER,ntask_cont_to_all, - & 1,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather ntask_cont_to ended" -c call flush(iout) - call MPI_Gather(itask_cont_to,max_fg_procs,MPI_INTEGER, - & itask_cont_to_all,max_fg_procs,MPI_INTEGER,king,FG_COMM,IERR) -c write (iout,*) "Gather itask_cont_to ended" -c call flush(iout) - if (fg_rank.eq.king) then - write (iout,*)"Contact receive task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_from_all(i), - & (itask_cont_from_all(j,i),j=1,ntask_cont_from_all(i)) - enddo - write (iout,*) - call flush(iout) - write (iout,*) "Contact send task map (proc, #tasks, tasks)" - do i=0,nfgtasks-1 - write (iout,'(20i4)') i,ntask_cont_to_all(i), - & (itask_cont_to_all(j,i),j=1,ntask_cont_to_all(i)) - enddo - write (iout,*) - call flush(iout) -C Check if every send will have a matching receive - ncheck_to=0 - ncheck_from=0 - do i=0,nfgtasks-1 - ncheck_to=ncheck_to+ntask_cont_to_all(i) - ncheck_from=ncheck_from+ntask_cont_from_all(i) - enddo - write (iout,*) "Control sums",ncheck_from,ncheck_to - if (ncheck_from.ne.ncheck_to) then - write (iout,*) "Error: #receive differs from #send." - write (iout,*) "Terminating program...!" - call flush(iout) - flag=.false. - else - flag=.true. - do i=0,nfgtasks-1 - do j=1,ntask_cont_to_all(i) - ii=itask_cont_to_all(j,i) - do k=1,ntask_cont_from_all(ii) - if (itask_cont_from_all(k,ii).eq.i) then - if(lprint)write(iout,*)"Matching send/receive",i,ii - exit - endif - enddo - if (k.eq.ntask_cont_from_all(ii)+1) then - flag=.false. - write (iout,*) "Error: send by",j," to",ii, - & " would have no matching receive" - endif - enddo - enddo - endif - if (.not.flag) then - write (iout,*) "Unmatched sends; terminating program" - call flush(iout) - endif - endif - call MPI_Bcast(flag,1,MPI_LOGICAL,king,FG_COMM,IERROR) -c write (iout,*) "flag broadcast ended flag=",flag -c call flush(iout) - if (.not.flag) then - call MPI_Finalize(IERROR) - stop "Error in INIT_INT_TABLE: unmatched send/receive." - endif - call MPI_Comm_group(FG_COMM,fg_group,IERR) -c write (iout,*) "MPI_Comm_group ended" -c call flush(iout) - call MPI_Group_incl(fg_group,ntask_cont_from+1, - & itask_cont_from(0),CONT_FROM_GROUP,IERR) - call MPI_Group_incl(fg_group,ntask_cont_to+1,itask_cont_to(0), - & CONT_TO_GROUP,IERR) - do i=1,nat_sent - ii=iat_sent(i) - iaux=4*(ielend(ii)-ielstart(ii)+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iint_sent(1,ielstart(ii),i),CONT_TO_GROUP, - & iint_sent_local(1,ielstart(ii),i),IERR ) -c write (iout,*) "Ranks translated i=",i -c call flush(iout) - enddo - iaux=4*(iturn3_end-iturn3_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn3_sent(1,iturn3_start),CONT_TO_GROUP, - & iturn3_sent_local(1,iturn3_start),IERR) - iaux=4*(iturn4_end-iturn4_start+1) - call MPI_Group_translate_ranks(fg_group,iaux, - & iturn4_sent(1,iturn4_start),CONT_TO_GROUP, - & iturn4_sent_local(1,iturn4_start),IERR) - if (lprint) then - write (iout,*) "iint_sent_local" - do i=1,nat_sent - ii=iat_sent(i) - write (iout,'(20i4)') ii,(j,(iint_sent_local(k,j,i),k=1,4), - & j=ielstart(ii),ielend(ii)) - call flush(iout) - enddo - write (iout,*) "iturn3_sent_local iturn3_start",iturn3_start, - & " iturn3_end",iturn3_end - write (iout,'(20i4)') (i,(iturn3_sent_local(j,i),j=1,4), - & i=iturn3_start,iturn3_end) - write (iout,*) "iturn4_sent_local iturn4_start",iturn4_start, - & " iturn4_end",iturn4_end - write (iout,'(20i4)') (i,(iturn4_sent_local(j,i),j=1,4), - & i=iturn4_start,iturn4_end) - call flush(iout) - endif - call MPI_Group_free(fg_group,ierr) - call MPI_Group_free(cont_from_group,ierr) - call MPI_Group_free(cont_to_group,ierr) - call MPI_Type_contiguous(3,MPI_DOUBLE_PRECISION,MPI_UYZ,IERROR) - call MPI_Type_commit(MPI_UYZ,IERROR) - call MPI_Type_contiguous(18,MPI_DOUBLE_PRECISION,MPI_UYZGRAD, - & IERROR) - call MPI_Type_commit(MPI_UYZGRAD,IERROR) - call MPI_Type_contiguous(2,MPI_DOUBLE_PRECISION,MPI_MU,IERROR) - call MPI_Type_commit(MPI_MU,IERROR) - call MPI_Type_contiguous(4,MPI_DOUBLE_PRECISION,MPI_MAT1,IERROR) - call MPI_Type_commit(MPI_MAT1,IERROR) - call MPI_Type_contiguous(8,MPI_DOUBLE_PRECISION,MPI_MAT2,IERROR) - call MPI_Type_commit(MPI_MAT2,IERROR) - call MPI_Type_contiguous(6,MPI_DOUBLE_PRECISION,MPI_THET,IERROR) - call MPI_Type_commit(MPI_THET,IERROR) - call MPI_Type_contiguous(9,MPI_DOUBLE_PRECISION,MPI_GAM,IERROR) - call MPI_Type_commit(MPI_GAM,IERROR) -#ifndef MATGATHER -c 9/22/08 Derived types to send matrices which appear in correlation terms - do i=0,nfgtasks-1 - if (ivec_count(i).eq.ivec_count(0)) then - lentyp(i)=0 - else - lentyp(i)=1 - endif - enddo - do ind_typ=lentyp(0),lentyp(nfgtasks-1) - if (ind_typ.eq.0) then - ichunk=ivec_count(0) - else - ichunk=ivec_count(1) - endif -c do i=1,4 -c blocklengths(i)=4 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT1(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT1(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT1",MPI_ROTAT1 -c do i=1,4 -c blocklengths(i)=2 -c enddo -c displs(1)=0 -c do i=2,4 -c displs(i)=displs(i-1)+blocklengths(i-1)*maxres -c enddo -c do i=1,4 -c blocklengths(i)=blocklengths(i)*ichunk -c enddo -c write (iout,*) "blocklengths and displs" -c do i=1,4 -c write (iout,*) i,blocklengths(i),displs(i) -c enddo -c call flush(iout) -c call MPI_Type_indexed(4,blocklengths(1),displs(1), -c & MPI_DOUBLE_PRECISION,MPI_ROTAT2(ind_typ),IERROR) -c call MPI_Type_commit(MPI_ROTAT2(ind_typ),IERROR) -c write (iout,*) "MPI_ROTAT2",MPI_ROTAT2 - do i=1,8 - blocklengths(i)=2 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP11(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP11(ind_typ),IERROR) - do i=1,8 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,8 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,15 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(8,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP12(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP12(ind_typ),IERROR) - do i=1,6 - blocklengths(i)=4 - enddo - displs(1)=0 - do i=2,6 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,6 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(6,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP22(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP22(ind_typ),IERROR) - do i=1,2 - blocklengths(i)=8 - enddo - displs(1)=0 - do i=2,2 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,2 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(2,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_PRECOMP23(ind_typ),IERROR) - call MPI_Type_commit(MPI_PRECOMP23(ind_typ),IERROR) - do i=1,4 - blocklengths(i)=1 - enddo - displs(1)=0 - do i=2,4 - displs(i)=displs(i-1)+blocklengths(i-1)*maxres - enddo - do i=1,4 - blocklengths(i)=blocklengths(i)*ichunk - enddo - call MPI_Type_indexed(4,blocklengths,displs, - & MPI_DOUBLE_PRECISION,MPI_ROTAT_OLD(ind_typ),IERROR) - call MPI_Type_commit(MPI_ROTAT_OLD(ind_typ),IERROR) - enddo -#endif - endif - iint_start=ivec_start+1 - iint_end=ivec_end+1 - do i=0,nfgtasks-1 - iint_count(i)=ivec_count(i) - iint_displ(i)=ivec_displ(i) - ivec_displ(i)=ivec_displ(i)-1 - iset_displ(i)=iset_displ(i)-1 - ithet_displ(i)=ithet_displ(i)-1 - iphi_displ(i)=iphi_displ(i)-1 - iphi1_displ(i)=iphi1_displ(i)-1 - ibond_displ(i)=ibond_displ(i)-1 - enddo - if (nfgtasks.gt.1 .and. fg_rank.eq.king - & .and. (me.eq.0 .or. out1file)) then - write (iout,*) "IVEC_DISPL, IVEC_COUNT, ISET_START, ISET_COUNT" - do i=0,nfgtasks-1 - write (iout,*) i,ivec_displ(i),ivec_count(i),iset_displ(i), - & iset_count(i) - enddo - write (iout,*) "iphi_start",iphi_start," iphi_end",iphi_end, - & " iphi1_start",iphi1_start," iphi1_end",iphi1_end - write (iout,*)"IPHI_COUNT, IPHI_DISPL, IPHI1_COUNT, IPHI1_DISPL" - do i=0,nfgtasks-1 - write (iout,*) i,iphi_count(i),iphi_displ(i),iphi1_count(i), - & iphi1_displ(i) - enddo - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',nfgtasks, - & ' fine-grain processors.' - endif -#else - loc_start=2 - loc_end=nres-1 - ithet_start=3 - ithet_end=nres - iturn3_start=nnt - iturn3_end=nct-3 - iturn4_start=nnt - iturn4_end=nct-4 - iphi_start=nnt+3 - iphi_end=nct - iphi1_start=4 - iphi1_end=nres - idihconstr_start=1 - idihconstr_end=ndih_constr - iphid_start=iphi_start - iphid_end=iphi_end-1 - itau_start=4 - itau_end=nres - ibond_start=2 - ibond_end=nres-1 - ibondp_start=nnt+1 - ibondp_end=nct - ivec_start=1 - ivec_end=nres-1 - iset_start=3 - iset_end=nres+1 - iint_start=2 - iint_end=nres-1 -#endif - return - end -#ifdef MPI -c--------------------------------------------------------------------------- - subroutine add_int(ii,jj,itask,ntask_cont_to,itask_cont_to,flag) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(4), - & ntask_cont_to,itask_cont_to(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,isent,k,l -c Determines whether to send interaction ii,jj to other processors; a given -c interaction can be sent to at most 2 processors. -c Sets flag=.true. if interaction ii,jj needs to be sent to at least -c one processor, otherwise flag is unchanged from the input value. - isent=0 - itask(1)=fg_rank - itask(2)=fg_rank - itask(3)=fg_rank - itask(4)=fg_rank -c write (iout,*) "ii",ii," jj",jj -c Loop over processors to check if anybody could need interaction ii,jj - do iproc=0,fg_rank-1 -c Check if the interaction matches any turn3 at iproc - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj,"kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo -C Check if the interaction matches any turn4 at iproc - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1 - & .or. k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1 .and. l.eq.jj-1) - & then -c write (iout,*) "turn3 to iproc",iproc," ij",ii,jj," kl",k,l -c call flush(iout) - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0 .and. - & iatel_s_all(iproc).le.ii-1 .and. iatel_e_all(iproc).ge.ii-1)then - if (ielstart_all(ii-1,iproc).le.jj-1.and. - & ielend_all(ii-1,iproc).ge.jj-1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - if (ielstart_all(ii-1,iproc).le.jj+1.and. - & ielend_all(ii-1,iproc).ge.jj+1) then - flag=.true. - if (iproc.ne.itask(1).and.iproc.ne.itask(2) - & .and.iproc.ne.itask(3).and.iproc.ne.itask(4)) then - isent=isent+1 - itask(isent)=iproc - call add_task(iproc,ntask_cont_to,itask_cont_to) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_int_from(ii,jj,ntask_cont_from,itask_cont_from) - implicit none - include "DIMENSIONS" - include "COMMON.INTERACT" - include "COMMON.SETUP" - include "COMMON.IOUNITS" - integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:max_fg_procs-1) - logical flag - integer iturn3_start_all,iturn3_end_all,iturn4_start_all, - & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:max_fg_procs), - & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), - & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), - &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), - & ielend_all(maxres,0:max_fg_procs-1) - integer iproc,k,l - do iproc=fg_rank+1,nfgtasks-1 - do k=iturn3_start_all(iproc),iturn3_end_all(iproc) - l=k+2 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn3 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - do k=iturn4_start_all(iproc),iturn4_end_all(iproc) - l=k+3 - if (k.eq.ii+1 .and. l.eq.jj+1 .or. k.eq.ii+1.and.l.eq.jj-1 - & .or. k.eq.ii-1 .and. l.eq.jj-1 .or. k.eq.ii-1 .and. l.eq.jj+1) - & then -c write (iout,*)"turn4 from iproc",iproc," ij",ii,jj," kl",k,l - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - enddo - if (iatel_s_all(iproc).gt.0 .and. iatel_e_all(iproc).gt.0) then - if (ii+1.ge.iatel_s_all(iproc).and.ii+1.le.iatel_e_all(iproc)) - & then - if (jj+1.ge.ielstart_all(ii+1,iproc).and. - & jj+1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj-1.ge.ielstart_all(ii+1,iproc).and. - & jj-1.le.ielend_all(ii+1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - if (ii-1.ge.iatel_s_all(iproc).and.ii-1.le.iatel_e_all(iproc)) - & then - if (jj-1.ge.ielstart_all(ii-1,iproc).and. - & jj-1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - if (jj+1.ge.ielstart_all(ii-1,iproc).and. - & jj+1.le.ielend_all(ii-1,iproc)) then - call add_task(iproc,ntask_cont_from,itask_cont_from) - endif - endif - endif - enddo - return - end -c--------------------------------------------------------------------------- - subroutine add_task(iproc,ntask_cont,itask_cont) - implicit none - include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) - integer ii - do ii=1,ntask_cont - if (itask_cont(ii).eq.iproc) return - enddo - ntask_cont=ntask_cont+1 - itask_cont(ntask_cont)=iproc - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks - do i=1,nfgtasks - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks - do i=1,nexcess - int4proc(nfgtasks-i)=int4proc(nfgtasks-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_bounds1(total_ints,lower_bound,upper_bound) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.SETUP' - integer total_ints,lower_bound,upper_bound - integer int4proc(0:max_fg_procs),sint4proc(0:max_fg_procs) - nint=total_ints/nfgtasks1 - do i=1,nfgtasks1 - int4proc(i-1)=nint - enddo - nexcess=total_ints-nint*nfgtasks1 - do i=1,nexcess - int4proc(nfgtasks1-i)=int4proc(nfgtasks1-i)+1 - enddo - lower_bound=0 - do i=0,fg_rank1-1 - lower_bound=lower_bound+int4proc(i) - enddo - upper_bound=lower_bound+int4proc(fg_rank1) - lower_bound=lower_bound+1 - return - end -c--------------------------------------------------------------------------- - subroutine int_partition(int_index,lower_index,upper_index,atom, - & at_start,at_end,first_atom,last_atom,int_gr,jat_start,jat_end,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - integer int_index,lower_index,upper_index,atom,at_start,at_end, - & first_atom,last_atom,int_gr,jat_start,jat_end - logical lprn - lprn=.false. - if (lprn) write (iout,*) 'int_index=',int_index - int_index_old=int_index - int_index=int_index+last_atom-first_atom+1 - if (lprn) - & write (iout,*) 'int_index=',int_index, - & ' int_index_old',int_index_old, - & ' lower_index=',lower_index, - & ' upper_index=',upper_index, - & ' atom=',atom,' first_atom=',first_atom, - & ' last_atom=',last_atom - if (int_index.ge.lower_index) then - int_gr=int_gr+1 - if (at_start.eq.0) then - at_start=atom - jat_start=first_atom-1+lower_index-int_index_old - else - jat_start=first_atom - endif - if (lprn) write (iout,*) 'jat_start',jat_start - if (int_index.ge.upper_index) then - at_end=atom - jat_end=first_atom-1+upper_index-int_index_old - return1 - else - jat_end=last_atom - endif - if (lprn) write (iout,*) 'jat_end',jat_end - endif - return - end -#endif -c------------------------------------------------------------------------------ - subroutine hpb_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' -c write(2,*)"hpb_partition: nhpb=",nhpb -#ifdef MPI - call int_bounds(nhpb,link_start,link_end) - if (.not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' nhpb',nhpb,' link_start=',link_start, - & ' link_end',link_end -#else - link_start=1 - link_end=nhpb -#endif -c write(2,*)"hpb_partition: link_start=",nhpb," link_end=",link_end - return - end -c------------------------------------------------------------------------------ - subroutine homology_partition - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.INTERACT' - write(iout,*)"homology_partition: lim_odl=",lim_odl, - & " lim_dih",lim_dih -#ifdef MPI - write (iout,*) "MPI" - call int_bounds(lim_odl,link_start_homo,link_end_homo) - call int_bounds(lim_dih-nnt+1,idihconstr_start_homo, - & idihconstr_end_homo) - idihconstr_start_homo=idihconstr_start_homo+nnt-1 - idihconstr_end_homo=idihconstr_end_homo+nnt-1 - if (me.eq.king .or. .not. out1file) - & write (iout,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',MyRank, - & ' lim_odl',lim_odl,' link_start=',link_start_homo, - & ' link_end',link_end_homo,' lim_dih',lim_dih, - & ' idihconstr_start_homo',idihconstr_start_homo, - & ' idihconstr_end_homo',idihconstr_end_homo -#else - write (iout,*) "Not MPI" - link_start_homo=1 - link_end_homo=lim_odl - idihconstr_start_homo=nnt - idihconstr_end_homo=lim_dih - write (iout,*) - & ' lim_odl',lim_odl,' link_start=',link_start_homo, - & ' link_end',link_end_homo,' lim_dih',lim_dih, - & ' idihconstr_start_homo',idihconstr_start_homo, - & ' idihconstr_end_homo',idihconstr_end_homo -#endif - return - end diff --git a/source/unres/src_MD-restraints/int_to_cart.f b/source/unres/src_MD-restraints/int_to_cart.f deleted file mode 100644 index 73e8384..0000000 --- a/source/unres/src_MD-restraints/int_to_cart.f +++ /dev/null @@ -1,278 +0,0 @@ - subroutine int_to_cart -c-------------------------------------------------------------- -c This subroutine converts the energy derivatives from internal -c coordinates to cartesian coordinates -c------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SCCOR' -c calculating dE/ddc1 - if (nres.lt.3) goto 18 -c do i=1,nres -c c do intertyp=1,3 -c write (iout,*) "przed tosyjnymi",i,intertyp,gcart(intertyp,i) -c &,gloc_sc(1,i,icg),gloc(i,icg) -c enddo -c enddo - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc(1,icg)*dphi(j,1,4) - & +gloc(nres-2,icg)*dtheta(j,1,3) - if(itype(2).ne.10) then - gcart(j,1)=gcart(j,1)+gloc(ialph(2,1),icg)*dalpha(j,1,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,1,2) - endif - enddo -c Calculating the remainder of dE/ddc2 - do j=1,3 - gcart(j,2)=gcart(j,2)+gloc(1,icg)*dphi(j,2,4)+ - & gloc(nres-2,icg)*dtheta(j,2,3)+gloc(nres-1,icg)*dtheta(j,1,4) - if(itype(2).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(2,1),icg)*dalpha(j,2,2)+ - & gloc(ialph(2,1)+nside,icg)*domega(j,2,2) - endif - if(itype(3).ne.10) then - gcart(j,2)=gcart(j,2)+gloc(ialph(3,1),icg)*dalpha(j,1,3)+ - & gloc(ialph(3,1)+nside,icg)*domega(j,1,3) - endif - if(nres.gt.4) then - gcart(j,2)=gcart(j,2)+gloc(2,icg)*dphi(j,1,5) - endif - enddo -c If there are only five residues - if(nres.eq.5) then - do j=1,3 - gcart(j,3)=gcart(j,3)+gloc(1,icg)*dphi(j,3,4)+gloc(2,icg)* - & dphi(j,2,5)+gloc(nres-1,icg)*dtheta(j,2,4)+gloc(nres,icg)* - & dtheta(j,1,5) - if(itype(3).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(3,1),icg)* - & dalpha(j,2,3)+gloc(ialph(3,1)+nside,icg)*domega(j,2,3) - endif - if(itype(4).ne.10) then - gcart(j,3)=gcart(j,3)+gloc(ialph(4,1),icg)* - & dalpha(j,1,4)+gloc(ialph(4,1)+nside,icg)*domega(j,1,4) - endif - enddo - endif -c If there are more than five residues - if(nres.gt.5) then - do i=3,nres-3 - do j=1,3 - gcart(j,i)=gcart(j,i)+gloc(i-2,icg)*dphi(j,3,i+1) - & +gloc(i-1,icg)*dphi(j,2,i+2)+ - & gloc(i,icg)*dphi(j,1,i+3)+gloc(nres+i-4,icg)*dtheta(j,2,i+1)+ - & gloc(nres+i-3,icg)*dtheta(j,1,i+2) - if(itype(i).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,2,i)+ - & gloc(ialph(i,1)+nside,icg)*domega(j,2,i) - endif - if(itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc(ialph(i+1,1),icg)*dalpha(j,1,i+1) - & +gloc(ialph(i+1,1)+nside,icg)*domega(j,1,i+1) - endif - enddo - enddo - endif -c Setting dE/ddnres-2 - if(nres.gt.5) then - do j=1,3 - gcart(j,nres-2)=gcart(j,nres-2)+gloc(nres-4,icg)* - & dphi(j,3,nres-1)+gloc(nres-3,icg)*dphi(j,2,nres) - & +gloc(2*nres-6,icg)* - & dtheta(j,2,nres-1)+gloc(2*nres-5,icg)*dtheta(j,1,nres) - if(itype(nres-2).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-2,1),icg)* - & dalpha(j,2,nres-2)+gloc(ialph(nres-2,1)+nside,icg)* - & domega(j,2,nres-2) - endif - if(itype(nres-1).ne.10) then - gcart(j,nres-2)=gcart(j,nres-2)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,1,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,1,nres-1) - endif - enddo - endif -c Settind dE/ddnres-1 - do j=1,3 - gcart(j,nres-1)=gcart(j,nres-1)+gloc(nres-3,icg)*dphi(j,3,nres)+ - & gloc(2*nres-5,icg)*dtheta(j,2,nres) - if(itype(nres-1).ne.10) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc(ialph(nres-1,1),icg)* - & dalpha(j,2,nres-1)+gloc(ialph(nres-1,1)+nside,icg)* - & domega(j,2,nres-1) - endif - enddo -c The side-chain vector derivatives - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - gxcart(j,i)=gxcart(j,i)+gloc(ialph(i,1),icg)*dalpha(j,3,i) - & +gloc(ialph(i,1)+nside,icg)*domega(j,3,i) - enddo - endif - enddo -c---------------------------------------------------------------------- -C INTERTYP=1 SC...Ca...Ca...Ca -C INTERTYP=2 Ca...Ca...Ca...SC -C INTERTYP=3 SC...Ca...Ca...SC -c calculating dE/ddc1 - 18 continue -c do i=1,nres -c gloc(i,icg)=0.0D0 -c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) -c enddo - if (nres.lt.2) return - if ((nres.lt.3).and.(itype(1).eq.10)) return - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - do j=1,3 -cc Derviative was calculated for oposite vector of side chain therefore -c there is "-" sign before gloc_sc - gxcart(j,1)=gxcart(j,1)-gloc_sc(1,0,icg)* - & dtauangle(j,1,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(1,0,icg)* - & dtauangle(j,1,2,3) - if ((itype(2).ne.10).and.(itype(2).ne.21)) then - gxcart(j,1)= gxcart(j,1) - & -gloc_sc(3,0,icg)*dtauangle(j,3,1,3) - gcart(j,1)=gcart(j,1)+gloc_sc(3,0,icg)* - & dtauangle(j,3,2,3) - endif - enddo - endif - if ((nres.ge.3).and.(itype(3).ne.10).and.(itype(3).ne.21)) - & then - do j=1,3 - gcart(j,1)=gcart(j,1)+gloc_sc(2,1,icg)*dtauangle(j,2,1,4) - enddo - endif -c As potetnial DO NOT depend on omicron anlge their derivative is -c ommited -c & +gloc_sc(intertyp,nres-2,icg)*dtheta(j,1,3) - -c Calculating the remainder of dE/ddc2 - do j=1,3 - if((itype(2).ne.10).and.(itype(2).ne.21)) then - if (itype(1).ne.10) gxcart(j,2)=gxcart(j,2)+ - & gloc_sc(3,0,icg)*dtauangle(j,3,3,3) - if ((itype(3).ne.10).and.(nres.ge.3).and.(itype(3).ne.21)) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(3,1,icg)*dtauangle(j,3,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(3,1,icg)*dtauangle(j,3,2,4) - endif - if (nres.gt.3) then - gxcart(j,2)=gxcart(j,2)-gloc_sc(1,1,icg)*dtauangle(j,1,1,4) -cc the - above is due to different vector direction - gcart(j,2)=gcart(j,2)+gloc_sc(1,1,icg)*dtauangle(j,1,2,4) -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,2,4),"gcart" -c write(iout,*) gloc_sc(1,1,icg),dtauangle(j,1,1,4),"gx" - endif - endif - if ((itype(1).ne.10).and.(itype(1).ne.21)) then - gcart(j,2)=gcart(j,2)+gloc_sc(1,0,icg)*dtauangle(j,1,3,3) -c write(iout,*) gloc_sc(1,0,icg),dtauangle(j,1,3,3) - endif - if ((itype(3).ne.10).and.(nres.ge.3)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,1,icg)*dtauangle(j,2,2,4) -c write(iout,*) gloc_sc(2,1,icg),dtauangle(j,2,2,4) - endif - if ((itype(4).ne.10).and.(nres.ge.4)) then - gcart(j,2)=gcart(j,2)+gloc_sc(2,2,icg)*dtauangle(j,2,1,5) -c write(iout,*) gloc_sc(2,2,icg),dtauangle(j,2,1,5) - endif - -c write(iout,*) gcart(j,2),itype(2),itype(1),itype(3), "gcart2" - enddo -c If there are more than five residues - if(nres.ge.5) then - do i=3,nres-2 - do j=1,3 -c write(iout,*) "before", gcart(j,i) - if (itype(i).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(2,i-2,icg) - & *dtauangle(j,2,3,i+1) - & -gloc_sc(1,i-1,icg)*dtauangle(j,1,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-1,icg) - & *dtauangle(j,1,2,i+2) -c write(iout,*) "new",j,i, -c & gcart(j,i),gloc_sc(1,i-1,icg),dtauangle(j,1,2,i+2) - - if (itype(i-1).ne.10) then - gxcart(j,i)=gxcart(j,i)+gloc_sc(3,i-2,icg) - &*dtauangle(j,3,3,i+1) - endif - if (itype(i+1).ne.10) then - gxcart(j,i)=gxcart(j,i)-gloc_sc(3,i-1,icg) - &*dtauangle(j,3,1,i+2) - gcart(j,i)=gcart(j,i)+gloc_sc(3,i-1,icg) - &*dtauangle(j,3,2,i+2) - endif - endif - if (itype(i-1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(1,i-2,icg)* - & dtauangle(j,1,3,i+1) - endif - if (itype(i+1).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i-1,icg)* - & dtauangle(j,2,2,i+2) -c write(iout,*) "numer",i,gloc_sc(2,i-1,icg), -c & dtauangle(j,2,2,i+2) - endif - if (itype(i+2).ne.10) then - gcart(j,i)=gcart(j,i)+gloc_sc(2,i,icg)* - & dtauangle(j,2,1,i+3) - endif - enddo - enddo - endif -c Setting dE/ddnres-1 - if(nres.ge.4) then - do j=1,3 - if ((itype(nres-1).ne.10).and.(itype(nres-1).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(2,nres-3,icg) - & *dtauangle(j,2,3,nres) -c write (iout,*) "gxcart(nres-1)", gloc_sc(2,nres-3,icg), -c & dtauangle(j,2,3,nres), gxcart(j,nres-1) - if (itype(nres-2).ne.10) then - gxcart(j,nres-1)=gxcart(j,nres-1)+gloc_sc(3,nres-3,icg) - & *dtauangle(j,3,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gxcart(j,nres-1)=gxcart(j,nres-1)-gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,1,nres+1) - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,2,nres+1) - endif - endif - if ((itype(nres-2).ne.10).and.(itype(nres-2).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(1,nres-3,icg)* - & dtauangle(j,1,3,nres) - endif - if ((itype(nres).ne.10).and.(itype(nres).ne.21)) then - gcart(j,nres-1)=gcart(j,nres-1)+gloc_sc(2,nres-2,icg)* - & dtauangle(j,2,2,nres+1) -c write (iout,*) "gcart(nres-1)", gloc_sc(2,nres-2,icg), -c & dtauangle(j,2,2,nres+1), itype(nres-1),itype(nres) - endif - enddo - endif -c Settind dE/ddnres - if ((nres.ge.3).and.(itype(nres).ne.10))then - do j=1,3 - gxcart(j,nres)=gxcart(j,nres)+gloc_sc(3,nres-2,icg) - & *dtauangle(j,3,3,nres+1)+gloc_sc(2,nres-2,icg) - & *dtauangle(j,2,3,nres+1) - enddo - endif -c The side-chain vector derivatives - return - end - - diff --git a/source/unres/src_MD-restraints/intcartderiv.F b/source/unres/src_MD-restraints/intcartderiv.F deleted file mode 100644 index c220540..0000000 --- a/source/unres/src_MD-restraints/intcartderiv.F +++ /dev/null @@ -1,725 +0,0 @@ - subroutine intcartderiv - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.LOCAL' - include 'COMMON.SCCOR' - double precision dcostheta(3,2,maxres), - & dcosphi(3,3,maxres),dsinphi(3,3,maxres), - & dcosalpha(3,3,maxres),dcosomega(3,3,maxres), - & dsinomega(3,3,maxres),vo1(3),vo2(3),vo3(3), - & dummy(3),vp1(3),vp2(3),vp3(3),vpp1(3),n(3) - -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1 .and. me.eq.king) - & call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - pi4 = 0.5d0*pipol - pi34 = 3*pi4 - -c write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end -c Derivatives of theta's -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) - do j=1,3 - dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ - & vbld(i-1) - dtheta(j,1,i)=-1/sint*dcostheta(j,1,i) - dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/ - & vbld(i) - dtheta(j,2,i)=-1/sint*dcostheta(j,2,i) - enddo - enddo - -#if defined(MPI) && defined(PARINTDER) -c We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end -#else - do i=3,nres -#endif - if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then - cost1=dcos(omicron(1,i)) - sint1=sqrt(1-cost1*cost1) - cost2=dcos(omicron(2,i)) - sint2=sqrt(1-cost2*cost2) - do j=1,3 -CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) - dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ - & cost1*dc_norm(j,i-2))/ - & vbld(i-1) - domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i) - dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) - & +cost1*(dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) - domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i) -CC Calculate derivative over second omicron Sci-1,Cai-1 Cai -CC Looks messy but better than if in loop - dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) - & +cost2*dc_norm(j,i-1))/ - & vbld(i) - domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i) - dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) - & +cost2*(-dc_norm(j,i-1+nres)))/ - & vbld(i-1+nres) -c write(iout,*) "vbld", i,itype(i),vbld(i-1+nres) - domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i) - enddo - endif - enddo - - - -c Derivatives of phi: -c If phi is 0 or 180 degrees, then the formulas -c have to be derived by power series expansion of the -c conventional formulas around 0 and 180. -#ifdef PARINTDER - do i=iphi1_start,iphi1_end -#else - do i=4,nres -#endif -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(theta(i-1)) - sing=dsin(phi(i)) - cost=dcos(theta(i)) - cost1=dcos(theta(i-1)) - cosg=dcos(phi(i)) - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. - & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) - dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) - dsinphi(j,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) -c Bug fixed 3/24/05 (AL) - dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dphi(j,1,i)=-1/sing*dcosphi(j,1,i) - dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcostheta(j,1,i) - dphi(j,2,i)=-1/sing*dcosphi(j,2,i) - dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1))/vbld(i) - dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - enddo - endif - enddo - -Calculate derivative of Tauangle -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=3,nres -#endif - if ((itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle -cc dtauangle(j,intertyp,dervityp,residue number) -cc INTERTYP=1 SC...Ca...Ca..Ca -c the conventional case - sint=dsin(theta(i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(1,i)) - cost=dcos(theta(i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(1,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 -c Obtaining the gamma derivatives from sine derivative - if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. - & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. - & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - &-(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) - & *vbld_inv(i-2+nres) - dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) - dsintau(j,1,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "dsintau", dsintau(j,1,2,i) - dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* - & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) - dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) - dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcostheta(j,1,i) - dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) - dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* - & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* - & dc_norm(j,i-1))/vbld(i) - dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) -c write (iout,*) "else",i - enddo - endif -c do k=1,3 -c write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) -c enddo - enddo -CC Second case Ca...Ca...Ca...SC -#ifdef PARINTDER - do i=itau_start,itau_end -#else - do i=4,nres -#endif - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10)) cycle -c the conventional case - sint=dsin(omicron(1,i)) - sint1=dsin(theta(i-1)) - sing=dsin(tauangle(2,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(theta(i-1)) - cosg=dcos(tauangle(2,i)) -c do j=1,3 -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) -c enddo - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. - & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. - & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then - call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) - & +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) -c write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), -c &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" - dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) - dsintau(j,2,2,i)= - & -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -c write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), -c & sing*ctgt*domicron(j,1,2,i), -c & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* - & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm(j,i-3))/vbld(i-2) - dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) - dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) - dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) -c write(iout,*) i,j,"else", dtauangle(j,2,3,i) - enddo - endif - enddo - - -CCC third case SC...Ca...Ca...SC -#ifdef PARINTDER - - do i=itau_start,itau_end -#else - do i=3,nres -#endif -c the conventional case - if ((itype(i-1).eq.21).or.(itype(i-1).eq.10).or. - &(itype(i-2).eq.21).or.(itype(i-2).eq.10)) cycle - sint=dsin(omicron(1,i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(3,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(3,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -c Obtaining the gamma derivatives from sine derivative - if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. - & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. - & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then - call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) - & -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) - & *vbld_inv(i-2+nres) - dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) - dsintau(j,3,2,i)= - & -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) - & -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) -c Bug fixed 3/24/05 (AL) - dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) - & +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) - & *vbld_inv(i-1+nres) -c & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) - enddo -c Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* - & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* - & dc_norm2(j,i-2+nres))/vbld(i-2+nres) - dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) - dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* - & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* - & dcosomicron(j,1,1,i) - dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) - dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* - & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* - & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) -c write(iout,*) "else",i - enddo - endif - enddo -#ifdef CRYST_SC -c Derivatives of side-chain angles alpha and omega -#if defined(MPI) && defined(PARINTDER) - do i=ibond_start,ibond_end -#else - do i=2,nres-1 -#endif - if(itype(i).ne.10) then - fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) - fac6=fac5/vbld(i) - fac7=fac5*fac5 - fac8=fac5/vbld(i+1) - fac9=fac5/vbld(i+nres) - scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))*( - & scalar(dC_norm(1,i),dC_norm(1,i+nres)) - & -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) - sina=sqrt(1-cosa*cosa) - sino=dsin(omeg(i)) - do j=1,3 - dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- - & dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) - dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) - dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- - & scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) - dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) - dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- - & dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ - & vbld(i+nres)) - dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) - enddo -c obtaining the derivatives of omega from sines - if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. - & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then - fac15=dcos(theta(i+1))/(dsin(theta(i+1))* - & dsin(theta(i+1))) - fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) - fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) - call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) - coso_inv=1.0d0/dcos(omeg(i)) - do j=1,3 - dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) - & +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)-( - & sino*dc_norm(j,i-1))/vbld(i) - domega(j,1,i)=coso_inv*dsinomega(j,1,i) - dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) - & +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) - & -sino*dc_norm(j,i)/vbld(i+1) - domega(j,2,i)=coso_inv*dsinomega(j,2,i) - dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- - & fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ - & vbld(i+nres) - domega(j,3,i)=coso_inv*dsinomega(j,3,i) - enddo - else -c obtaining the derivatives of omega from cosines - fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) - fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) - fac12=fac10*sina - fac13=fac12*fac12 - fac14=sina*sina - do j=1,3 - dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* - & dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ - & (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* - & fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 - domega(j,1,i)=-1/sino*dcosomega(j,1,i) - dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* - & dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* - & dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ - & (scala2-fac11*cosa)*(0.25d0*sina/fac10* - & dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i) - & ))/fac13 - domega(j,2,i)=-1/sino*dcosomega(j,2,i) - dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- - & scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ - & (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 - domega(j,3,i)=-1/sino*dcosomega(j,3,i) - enddo - endif - endif - enddo -#endif -#if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1) then -#ifdef DEBUG - write (iout,*) "Gather dtheta" -cd call flush(iout) -c write (iout,*) "dtheta before gather" -c do i=1,nres -c write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) -c enddo -#endif - call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank), - & MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET, - & king,FG_COMM,IERROR) -#ifdef DEBUG -cd write (iout,*) "Gather dphi" -cd call flush(iout) - write (iout,*) "dphi before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) - enddo -#endif - call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank), - & MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather dalpha" -cd call flush(iout) -#ifdef CRYST_SC - call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -cd write (iout,*) "Gather domega" -cd call flush(iout) - call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank), - & MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM, - & king,FG_COMM,IERROR) -#endif - endif -#endif -#ifdef DEBUG - write (iout,*) "dtheta after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),j=1,2) - enddo - write (iout,*) "dphi after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) - enddo -#endif - return - end - - subroutine checkintcartgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - double precision dthetanum(3,2,maxres),dphinum(3,3,maxres) - & ,dalphanum(3,3,maxres), domeganum(3,3,maxres) - double precision theta_s(maxres),phi_s(maxres),alph_s(maxres), - & omeg_s(maxres),dc_norm_s(3) - double precision aincr /1.0d-5/ - - do i=1,nres - phi_s(i)=phi(i) - theta_s(i)=theta(i) - alph_s(i)=alph(i) - omeg_s(i)=omeg(i) - enddo -c Check theta gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of theta" - write (iout,*) - do i=3,nres - do j=1,3 - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - call int_from_cart1(.false.) - dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3), - & (dtheta(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3), - & (dthetanum(j,2,i),j=1,3) - write (iout,'(5x,3f10.5,5x,3f10.5)') - & (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3), - & (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3) - write (iout,*) - enddo -c Check gamma gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of gamma" - do i=4,nres - do j=1,3 - dcji=dc(j,i-3) - dc(j,i-3)=dcji+aincr - call chainbuild_cart - dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-2)=dcji - dcji=dc(j,i-1) - dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart - dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-1)=dcji - enddo - write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3), - & (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3), - & (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dphinum(j,1,i)/dphi(j,1,i),j=1,3), - & (dphinum(j,2,i)/dphi(j,2,i),j=1,3), - & (dphinum(j,3,i)/dphi(j,3,i),j=1,3) - write (iout,*) - enddo -c Check alpha gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of alpha" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - dalphanum(j,1,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - dalphanum(j,2,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - dalphanum(j,3,i)=(alph(i)-alph_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3), - & (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3), - & (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3), - & (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3), - & (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3) - write (iout,*) - enddo -c Check omega gradient - write (iout,*) - & "Analytical (upper) and numerical (lower) gradient of omega" - do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr - call chainbuild_cart - domeganum(j,1,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i-1)=dcji - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - domeganum(j,2,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i)=dcji - dcji=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+aincr - call chainbuild_cart - domeganum(j,3,i)=(omeg(i)-omeg_s(i)) - & /aincr - dc(j,i+nres)=dcji - enddo - endif - write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3), - & (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3), - & (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3) - write (iout,'(5x,3(3f10.5,5x))') - & (domeganum(j,1,i)/domega(j,1,i),j=1,3), - & (domeganum(j,2,i)/domega(j,2,i),j=1,3), - & (domeganum(j,3,i)/domega(j,3,i),j=1,3) - write (iout,*) - enddo - return - end - - subroutine chainbuild_cart - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.LOCAL' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' - -#ifdef MPI - if (nfgtasks.gt.1) then -c write (iout,*) "BCAST in chainbuild_cart" -c call flush(iout) -c Broadcast the order to build the chain and compute internal coordinates -c to the slaves. The slaves receive the order in ERGASTULUM. - time00=MPI_Wtime() -c write (iout,*) "CHAINBUILD_CART: DC before BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo - if (fg_rank.eq.0) - & call MPI_Bcast(7,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_bcast7=time_bcast7+MPI_Wtime()-time00 - time01=MPI_Wtime() - call MPI_Bcast(dc(1,0),6*(nres+1),MPI_DOUBLE_PRECISION, - & king,FG_COMM,IERR) -c write (iout,*) "CHAINBUILD_CART: DC after BCAST" -c do i=0,nres -c write (iout,'(i3,3f10.5,5x,3f10.5)') i,(dc(j,i),j=1,3), -c & (dc(j,i+nres),j=1,3) -c enddo -c write (iout,*) "End BCAST in chainbuild_cart" -c call flush(iout) - time_bcast=time_bcast+MPI_Wtime()-time00 - time_bcastc=time_bcastc+MPI_Wtime()-time01 - endif -#endif - do j=1,3 - c(j,1)=dc(j,0) - enddo - do i=2,nres - do j=1,3 - c(j,i)=c(j,i-1)+dc(j,i-1) - enddo - enddo - do i=1,nres - do j=1,3 - c(j,i+nres)=c(j,i)+dc(j,i+nres) - enddo - enddo -c write (iout,*) "CHAINBUILD_CART" -c call cartprint - call int_from_cart1(.false.) - return - end diff --git a/source/unres/src_MD-restraints/intcor.f b/source/unres/src_MD-restraints/intcor.f deleted file mode 100644 index a3cd5d0..0000000 --- a/source/unres/src_MD-restraints/intcor.f +++ /dev/null @@ -1,91 +0,0 @@ -C -C------------------------------------------------------------------------------ -C - double precision function alpha(i1,i2,i3) -c -c Calculates the planar angle between atoms (i1), (i2), and (i3). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - vnorm=dsqrt(x12*x12+y12*y12+z12*z12) - wnorm=dsqrt(x23*x23+y23*y23+z23*z23) - scalar=(x12*x23+y12*y23+z12*z23)/(vnorm*wnorm) - alpha=arcos(scalar) - return - end -C -C------------------------------------------------------------------------------ -C - double precision function beta(i1,i2,i3,i4) -c -c Calculates the dihedral angle between atoms (i1), (i2), (i3) and (i4) -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - x23=c(1,i3)-c(1,i2) - x34=c(1,i4)-c(1,i3) - y12=c(2,i1)-c(2,i2) - y23=c(2,i3)-c(2,i2) - y34=c(2,i4)-c(2,i3) - z12=c(3,i1)-c(3,i2) - z23=c(3,i3)-c(3,i2) - z34=c(3,i4)-c(3,i3) -cd print '(2i3,3f10.5)',i1,i2,x12,y12,z12 -cd print '(2i3,3f10.5)',i2,i3,x23,y23,z23 -cd print '(2i3,3f10.5)',i3,i4,x34,y34,z34 - wx=-y23*z34+y34*z23 - wy=x23*z34-z23*x34 - wz=-x23*y34+y23*x34 - wnorm=dsqrt(wx*wx+wy*wy+wz*wz) - vx=y12*z23-z12*y23 - vy=-x12*z23+z12*x23 - vz=x12*y23-y12*x23 - vnorm=dsqrt(vx*vx+vy*vy+vz*vz) - if (vnorm.gt.1.0D-13 .and. wnorm.gt.1.0D-13) then - scalar=(vx*wx+vy*wy+vz*wz)/(vnorm*wnorm) - if (dabs(scalar).gt.1.0D0) - &scalar=0.99999999999999D0*scalar/dabs(scalar) - angle=dacos(scalar) -cd print '(2i4,10f7.3)',i2,i3,vx,vy,vz,wx,wy,wz,vnorm,wnorm, -cd &scalar,angle - else - angle=pi - endif -c if (angle.le.0.0D0) angle=pi+angle - tx=vy*wz-vz*wy - ty=-vx*wz+vz*wx - tz=vx*wy-vy*wx - scalar=tx*x23+ty*y23+tz*z23 - if (scalar.lt.0.0D0) angle=-angle - beta=angle - return - end -C -C------------------------------------------------------------------------------ -C - function dist(i1,i2) -c -c Calculates the distance between atoms (i1) and (i2). -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - x12=c(1,i1)-c(1,i2) - y12=c(2,i1)-c(2,i2) - z12=c(3,i1)-c(3,i2) - dist=dsqrt(x12*x12+y12*y12+z12*z12) - return - end -C diff --git a/source/unres/src_MD-restraints/intlocal.f b/source/unres/src_MD-restraints/intlocal.f deleted file mode 100644 index 2dbcc88..0000000 --- a/source/unres/src_MD-restraints/intlocal.f +++ /dev/null @@ -1,517 +0,0 @@ - subroutine integral(gamma1,gamma2,gamma3,gamma4,ity1,ity2,a1,a2, - & si1,si2,si3,si4,transp,q) - implicit none - integer ity1,ity2 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4 - logical transp - double precision elocal,ele - double precision delta,delta2,sum,ene,sumene,boltz - double precision q,a1(2,2),a2(2,2),si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=20 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) gamma1,gamma2,ity1,ity2,a1,a2,si1,si2,si3,si4,transp - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum=0.0d0 - sumene=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - ene= - & -elocal(ity1,lambda1,lambda2,.false.)* - & elocal(ity2,lambda3,lambda4,transp)* - & ele(si1*lambda1+gamma1,si3*lambda3+gamma3,a1)* - & ele(si2*lambda2+gamma2,si4*lambda4+gamma4,a2) -cd write (2,*) elocal(ity1,lambda1,gamma1-pi-lambda2), -cd & elocal(ity2,lambda3,gamma2-pi-lambda4), -cd & ele(lambda1,lambda2,a1,si1,si3), -cd & ele(lambda3,lambda4,a2,si2,si4) - sum=sum+ene - enddo - enddo - enddo - enddo - q=sum/(2*pi)**4*delta**4 - write (2,* )'sum',sum,' q',q - return - end -c--------------------------------------------------------------------------- - subroutine integral3(gamma1,gamma2,ity1,ity2,ity3,ity4, - & a1,koniec,q1,q2,q3,q4) - implicit none - integer ity1,ity2,ity3,ity4 - integer ilam1,ilam2,ilam3,ilam4,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,lambda1, - & lambda2,lambda3,lambda4 - logical koniec - double precision elocal,ele - double precision delta,delta2,sum1,sum2,sum3,sum4, - & ene1,ene2,ene3,ene4,boltz - double precision q1,q2,q3,q4,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) gamma1,gamma2,ity1,ity2,ity3,ity4,a1,koniec - -cd do ilam1=-180,180,5 -cd do ilam2=-180,180,5 -cd lambda1=ilam1*conv+delta2 -cd lambda2=ilam2*conv+delta2 -cd write(2,'(2i5,2f10.5)') ilam1,ilam2,elocal(2,lambda1,lambda2), -cd & ele(lambda1,lambda2,a1,1.0d0,1.d00) -cd enddo -cd enddo -cd stop - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 -cd write (2,*) ilam1,ilam2,ilam3,ilam4 -cd write (2,*) lambda1,lambda2,lambda3,lambda4 - if (.not.koniec) then - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda2,lambda4,a1) - else - ene1= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda2,-lambda4,a1) - endif - ene2= - & elocal(ity1,lambda1,gamma1-pi-lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda2,lambda3,a1) - if (.not.koniec) then - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,gamma2-pi-lambda4,.false.)* - & ele(lambda1,lambda4,a1) - else - ene3= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity3,lambda3,lambda4,.false.)* - & ele(lambda1,-lambda4,a1) - endif - ene4= - & elocal(ity2,lambda1,lambda2,.false.)* - & elocal(ity4,lambda3,lambda4,.false.)* - & ele(lambda1,lambda3,a1) - sum1=sum1+ene1 - sum2=sum2+ene2 - sum3=sum3+ene3 - sum4=sum4+ene4 - enddo - enddo - enddo - enddo - q1=sum1/(2*pi)**4*delta**4 - q2=sum2/(2*pi)**4*delta**4 - q3=sum3/(2*pi)**4*delta**4 - q4=sum4/(2*pi)**4*delta**4 - write (2,* )'sum',sum1,sum2,sum3,sum4,' q',q1,q2,q3,q4 - return - end -c------------------------------------------------------------------------- - subroutine integral5(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc5,eloc6,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,sum1,sum2,sum3,sum4, - & a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - sum1=sum1+pom*eloc1 - endif - eloc3=elocal(ity3,lambda2,lambda5,.false.) - sum2=sum2+pom*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc4 - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda5,.false.) - sum4=sum4+pom*eloc6 - endif - enddo - enddo - enddo - enddo - enddo - pom=1.0d0/(2*pi)**5*delta**5 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom -c write (2,* )'sum',sum1,sum2,sum3,sum4,' q',ene1,ene2,ene3,ene4 - return - end -c------------------------------------------------------------------------- - subroutine integral_turn6(gamma1,gamma2,gamma3,gamma4,ity1,ity2, - & ity3,ity4,ity5,ity6,a1,a2,ene_turn6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom,ene5 - double precision ene_turn6,sum5,a1(2,2),a2(2,2) - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta - write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, - & ' gamma3=',gamma3,' gamma4=',gamma4 - write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 - write(2,*) 'a1=',a1 - write(2,*) 'a2=',a2 - - sum5=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - ele1=ele(lambda1,-lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - eloc3=elocal(ity3,lambda2,gamma3-pi-lambda5,.false.) - eloc4=elocal(ity4,lambda5,gamma4-pi-lambda3,.false.) - sum5=sum5+pom*eloc3*eloc4 - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**5*delta**5 - ene_turn6=sum5*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral6(gamma1,gamma2,gamma3,gamma4,ity1,ity2,ity3, - & ity4,ity5,ity6,a1,a2,si1,si2,si3,si4,transp,ene1,ene2,ene3,ene4, - & ene5,ene6) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3,' gamma4=',gamma4 -cd write(2,*) ity1,ity2,ity3,ity4,ity5,ity6 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'a2=',a2 -cd write(2,*) si1,si2,si3,si4,transp - - sum1=0.0d0 - sum2=0.0d0 - sum3=0.0d0 - sum4=0.0d0 - sum5=0.0d0 - sum6=0.0d0 - eloc1=0.0d0 - eloc6=0.0d0 - eloc61=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - do ilam5=-180,179,iincr - do ilam6=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - lambda5=ilam5*conv+delta2 - lambda6=ilam6*conv+delta2 - if (transp) then - ele1=ele(lambda1,si4*lambda4,a1) - ele2=ele(lambda2,lambda3,a2) - else - ele1=ele(lambda1,lambda3,a1) - ele2=ele(lambda2,si4*lambda4,a2) - endif - eloc2=elocal(ity2,lambda1,gamma2-pi-lambda2,.false.) - eloc5=elocal(ity5,lambda3,gamma4-pi-si4*lambda4,.false.) - pom=ele1*ele2*eloc2*eloc5 - if (si1.gt.0) then - eloc1=elocal(ity1,lambda5,gamma1-pi-lambda1,.false.) - endif - eloc3=elocal(ity3,lambda2,lambda6,.false.) - sum1=sum1+pom*eloc1*eloc3 - eloc4=elocal(ity4,lambda5,gamma3-pi-lambda3,.false.) - if (si4.gt.0) then - eloc6=elocal(ity6,lambda4,lambda6,.false.) - eloc61=elocal(ity6,lambda4,lambda5,.false.) - endif - sum2=sum2+pom*eloc4*eloc6 - eloc41=elocal(ity4,lambda6,gamma3-pi-lambda3,.false.) - sum3=sum3+pom*eloc1*eloc41 - sum4=sum4+pom*eloc1*eloc6 - sum5=sum5+pom*eloc3*eloc4 - sum6=sum6+pom*eloc3*eloc61 - enddo - enddo - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**6*delta**6 - ene1=sum1*pom - ene2=sum2*pom - ene3=sum3*pom - ene4=sum4*pom - ene5=sum5*pom - ene6=sum6*pom -c print *,'sum6',sum6,' ene6',ene6 - return - end -c------------------------------------------------------------------------- - subroutine integral3a(gamma1,gamma2,ity1,ity2,a1,si1,ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2 -cd write(2,*) ity1,ity2 -cd write(2,*) 'a1=',a1 -cd write(2,*) si1, - - sum1=0.0d0 - eloc1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - ele1=ele(lambda1,si1*lambda3,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - if (si1.gt.0) then - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - else - eloc2=elocal(ity2,lambda2,lambda3,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2 - enddo - enddo - enddo - pom=1.0d0/(2*pi)**3*delta**3 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - subroutine integral4a(gamma1,gamma2,gamma3,ity1,ity2,ity3,a1,si1, - & ene1) - implicit none - integer ity1,ity2,ity3,ity4,ity5,ity6 - integer ilam1,ilam2,ilam3,ilam4,ilam5,ilam6,iincr - double precision gamma1,gamma2,gamma3,gamma4,beta,b(2,90),lambda1, - & lambda2,lambda3,lambda4,lambda5,lambda6 - logical transp - double precision elocal,ele - double precision eloc1,eloc2,eloc3,eloc4,eloc41,eloc5,eloc6, - & eloc61,ele1,ele2 - double precision delta,delta2,sum,ene,sumene,pom - double precision ene1,ene2,ene3,ene4,ene5,ene6,sum1,sum2,sum3, - & sum4,sum5,sum6,a1(2,2),a2(2,2) - integer si1,si2,si3,si4 - double precision conv /.01745329252d0/,pi /3.141592654d0/ - - iincr=60 - delta=iincr*conv - delta2=0.5d0*delta -cd print *,'iincr',iincr,' delta',delta -cd write(2,*) 'gamma1=',gamma1,' gamma2=',gamma2, -cd & ' gamma3=',gamma3 -cd write(2,*) ity1,ity2,ity3 -cd write(2,*) 'a1=',a1 -cd write(2,*) 'si1=',si1 - sum1=0.0d0 - do ilam1=-180,179,iincr - do ilam2=-180,179,iincr - do ilam3=-180,179,iincr - do ilam4=-180,179,iincr - lambda1=ilam1*conv+delta2 - lambda2=ilam2*conv+delta2 - lambda3=ilam3*conv+delta2 - lambda4=ilam4*conv+delta2 - ele1=ele(lambda1,si1*lambda4,a1) - eloc1=elocal(ity1,lambda1,gamma1-pi-lambda2,.false.) - eloc2=elocal(ity2,lambda2,gamma2-pi-lambda3,.false.) - if (si1.gt.0) then - eloc3=elocal(ity3,lambda3,gamma3-pi-lambda4,.false.) - else - eloc3=elocal(ity3,lambda3,lambda4,.false.) - endif - sum1=sum1+ele1*eloc1*eloc2*eloc3 - enddo - enddo - enddo - enddo - pom=-1.0d0/(2*pi)**4*delta**4 - ene1=sum1*pom - return - end -c------------------------------------------------------------------------- - double precision function elocal(i,x,y,transp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.TORSION' - integer i - double precision x,y,u(2),v(2),cu(2),dv(2),ev(2) - double precision scalar2 - logical transp - u(1)=dcos(x) - u(2)=dsin(x) - v(1)=dcos(y) - v(2)=dsin(y) - if (transp) then - call matvec2(cc(1,1,i),v,cu) - call matvec2(dd(1,1,i),u,dv) - call matvec2(ee(1,1,i),u,ev) - elocal=scalar2(b1(1,i),v)+scalar2(b2(1,i),u)+scalar2(cu,v)+ - & scalar2(dv,u)+scalar2(ev,v) - else - call matvec2(cc(1,1,i),u,cu) - call matvec2(dd(1,1,i),v,dv) - call matvec2(ee(1,1,i),v,ev) - elocal=scalar2(b1(1,i),u)+scalar2(b2(1,i),v)+scalar2(cu,u)+ - & scalar2(dv,v)+scalar2(ev,u) - endif - return - end -c------------------------------------------------------------------------- - double precision function ele(x,y,a) - implicit none - double precision x,y,a(2,2),si1,si2,u(2),v(2),av(2) - double precision scalar2 - u(1)=-cos(x) - u(2)= sin(x) - v(1)=-cos(y) - v(2)= sin(y) - call matvec2(a,v,av) - ele=scalar2(u,av) - return - end diff --git a/source/unres/src_MD-restraints/kinetic_lesyng.f b/source/unres/src_MD-restraints/kinetic_lesyng.f deleted file mode 100644 index 8535f5d..0000000 --- a/source/unres/src_MD-restraints/kinetic_lesyng.f +++ /dev/null @@ -1,104 +0,0 @@ - subroutine kinetic(KE_total) -c---------------------------------------------------------------- -c This subroutine calculates the total kinetic energy of the chain -c----------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - double precision KE_total - - integer i,j,k - double precision KEt_p,KEt_sc,KEr_p,KEr_sc,incr(3), - & mag1,mag2,v(3) - - KEt_p=0.0d0 - KEt_sc=0.0d0 -c write (iout,*) "ISC",(isc(itype(i)),i=1,nres) -c The translational part for peptide virtual bonds - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 -c write (iout,*) "Kinetic trp:",i,(incr(j),j=1,3) - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - vtot(i)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - KEt_p=KEt_p+(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c write(iout,*) 'KEt_p', KEt_p -c The translational part for the side chain virtual bond -c Only now we can initialize incr with zeros. It must be equal -c to the velocities of the first Calpha. - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - if (itype(i).eq.10) then - do j=1,3 - v(j)=incr(j) - enddo - else - do j=1,3 - v(j)=incr(j)+d_t(j,nres+i) - enddo - endif -c write (iout,*) "Kinetic trsc:",i,(incr(j),j=1,3) -c write (iout,*) "i",i," msc",msc(iti)," v",(v(j),j=1,3) - KEt_sc=KEt_sc+msc(iti)*(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)) - vtot(i+nres)=v(1)*v(1)+v(2)*v(2)+v(3)*v(3) - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo -c goto 111 -c write(iout,*) 'KEt_sc', KEt_sc -c The part due to stretching and rotation of the peptide groups - KEr_p=0.0D0 - do i=nnt,nct-1 -c write (iout,*) "i",i -c write (iout,*) "i",i," mag1",mag1," mag2",mag2 - do j=1,3 - incr(j)=d_t(j,i) - enddo -c write (iout,*) "Kinetic rotp:",i,(incr(j),j=1,3) - KEr_p=KEr_p+(incr(1)*incr(1)+incr(2)*incr(2) - & +incr(3)*incr(3)) - enddo -c goto 111 -c write(iout,*) 'KEr_p', KEr_p -c The rotational part of the side chain virtual bond - KEr_sc=0.0D0 - do i=nnt,nct - iti=itype(i) - if (itype(i).ne.10) then - do j=1,3 - incr(j)=d_t(j,nres+i) - enddo -c write (iout,*) "Kinetic rotsc:",i,(incr(j),j=1,3) - KEr_sc=KEr_sc+Isc(iti)*(incr(1)*incr(1)+incr(2)*incr(2)+ - & incr(3)*incr(3)) - endif - enddo -c The total kinetic energy - 111 continue -c write(iout,*) 'KEr_sc', KEr_sc - KE_total=0.5d0*(mp*KEt_p+KEt_sc+0.25d0*Ip*KEr_p+KEr_sc) -c write (iout,*) "KE_total",KE_total - return - end - - - - diff --git a/source/unres/src_MD-restraints/lagrangian_lesyng.F b/source/unres/src_MD-restraints/lagrangian_lesyng.F deleted file mode 100644 index 8a9163a..0000000 --- a/source/unres/src_MD-restraints/lagrangian_lesyng.F +++ /dev/null @@ -1,726 +0,0 @@ - subroutine lagrangian -c------------------------------------------------------------------------- -c This subroutine contains the total lagrangain from which the accelerations -c are obtained. For numerical gradient checking, the derivetive of the -c lagrangian in the velocities and coordinates are calculated seperately -c------------------------------------------------------------------------- - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MUCA' - include 'COMMON.TIME1' - - integer i,j,ind - double precision zapas(MAXRES6),muca_factor - logical lprn /.false./ - common /cipiszcze/ itime - -#ifdef TIMING - time00=MPI_Wtime() -#endif - do j=1,3 - zapas(j)=-gcart(j,0) - enddo - ind=3 - if (lprn) then - write (iout,*) "Potential forces backbone" - endif - do i=nnt,nct-1 - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gcart(j,i) - enddo - enddo - if (lprn) write (iout,*) "Potential forces sidechain" - do i=nnt,nct - if (itype(i).ne.10) then - if (lprn) write (iout,'(i5,3e15.5,5x,3e15.5)') - & i,(-gcart(j,i),j=1,3) - do j=1,3 - ind=ind+1 - zapas(ind)=-gxcart(j,i) - enddo - endif - enddo - - call ginv_mult(zapas,d_a_work) - - do j=1,3 - d_a(j,0)=d_a_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - ind=ind+1 - d_a(j,i)=d_a_work(ind) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - ind=ind+1 - d_a(j,i+nres)=d_a_work(ind) - enddo - endif - enddo - - if(lmuca) then - imtime=imtime+1 - if(mucadyn.gt.0) call muca_update(potE) - factor=muca_factor(potE)*t_bath*Rb - -cd print *,'lmuca ',factor,potE - do j=1,3 - d_a(j,0)=d_a(j,0)*factor - enddo - do i=nnt,nct-1 - do j=1,3 - d_a(j,i)=d_a(j,i)*factor - enddo - enddo - do i=nnt,nct - do j=1,3 - d_a(j,i+nres)=d_a(j,i+nres)*factor - enddo - enddo - - endif - - if (lprn) then - write(iout,*) 'acceleration 3D' - write (iout,'(i3,3f10.5,3x,3f10.5)') 0,(d_a(j,0),j=1,3) - do i=nnt,nct-1 - write (iout,'(i3,3f10.5,3x,3f10.5)') i,(d_a(j,i),j=1,3) - enddo - do i=nnt,nct - write (iout,'(i3,3f10.5,3x,3f10.5)') - & i+nres,(d_a(j,i+nres),j=1,3) - enddo - endif -#ifdef TIMING - time_lagrangian=time_lagrangian+MPI_Wtime()-time00 -#endif - return - end -c------------------------------------------------------------------ - subroutine setup_MD_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierror -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer i,j - logical lprn /.false./ - logical osob - double precision dtdi,massvec(maxres2),Gcopy(maxres2,maxres2), - & Ghalf(mmaxres2),sqreig(maxres2), invsqreig(maxres2), Gcopytmp, - & Gsqrptmp, Gsqrmtmp, Gvec2tmp,Gvectmp(maxres2,maxres2) - double precision work(8*maxres6) - integer iwork(maxres6) - common /przechowalnia/ Gcopy,Ghalf,invsqreig,Gvectmp -c -c Set up the matrix of the (dC,dX)-->(C,X) transformation (A), the -c inertia matrix (Gmat) and the inverse of the inertia matrix (Ginv) -c -c Determine the number of degrees of freedom (dimen) and the number of -c sites (dimen1) - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -#ifdef MPI - if (nfgtasks.gt.1) then - time00=MPI_Wtime() - call MPI_Bcast(5,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) - write (iout,*) 'Processor:',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' igmult_start',igmult_start, - & ' igmult_end',igmult_end,' count',my_ng_count - write (iout,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) - write (iout,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - call flush(iout) - else -#endif - igmult_start=1 - igmult_end=dimen - my_ng_count=dimen -#ifdef MPI - endif -#endif -c write (iout,*) "dimen",dimen," dimen1",dimen1," dimen3",dimen3 -c Zeroing out A and fricmat - do i=1,dimen - do j=1,dimen - A(i,j)=0.0D0 - enddo - enddo -c Diagonal elements of the dC part of A and the respective friction coefficients - ind=1 - ind1=0 - do i=nnt,nct-1 - ind=ind+1 - ind1=ind1+1 - coeff=0.25d0*IP - massvec(ind1)=mp - Gmat(ind,ind)=coeff - A(ind1,ind)=0.5d0 - enddo - -c Off-diagonal elements of the dC part of A - k=3 - do i=1,nct-nnt - do j=1,i - A(i,j)=1.0d0 - enddo - enddo -c Diagonal elements of the dX part of A and the respective friction coefficients - m=nct-nnt - m1=nct-nnt+1 - ind=0 - ind1=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - massvec(ii)=msc(iti) - if (iti.ne.10) then - ind1=ind1+1 - ii1= ind1+m1 - A(ii,ii1)=1.0d0 - Gmat(ii1,ii1)=ISC(iti) - endif - enddo -c Off-diagonal elements of the dX part of A - ind=0 - k=nct-nnt - do i=nnt,nct - iti=itype(i) - ind=ind+1 - do j=nnt,i - ii = ind - jj = j-nnt+1 - A(k+ii,jj)=1.0d0 - enddo - enddo - if (lprn) then - write (iout,*) - write (iout,*) "Vector massvec" - do i=1,dimen1 - write (iout,*) i,massvec(i) - enddo - write (iout,'(//a)') "A" - call matout(dimen,dimen1,maxres2,maxres2,A) - endif - -c Calculate the G matrix (store in Gmat) - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*massvec(j) - enddo - Gmat(k,i)=Gmat(k,i)+dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Gmat" - call matout(dimen,dimen,maxres2,maxres2,Gmat) - endif - do i=1,dimen - do j=1,dimen - Ginv(i,j)=0.0d0 - Gcopy(i,j)=Gmat(i,j) - enddo - Ginv(i,i)=1.0d0 - enddo -c Invert the G matrix - call MATINVERT(dimen,maxres2,Gcopy,Ginv,osob) - if (lprn) then - write (iout,'(//a)') "Ginv" - call matout(dimen,dimen,maxres2,maxres2,Ginv) - endif -#ifdef MPI - if (nfgtasks.gt.1) then - myginv_ng_count=maxres2*my_ng_count - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) - if (lprn .and. (me.eq.king .or. .not. out1file) ) then - write (iout,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) - write (iout,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) - call flush(iout) - endif -c call MPI_Scatterv(ginv(1,1),nginv_counts(0), -c & nginv_start(0),MPI_DOUBLE_PRECISION,ginv, -c & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c call MPI_Barrier(FG_COMM,IERR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (iout,*) "Master's chunk of ginv" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,ginv) - endif -#endif - if (osob) then - write (iout,*) "The G matrix is singular." - stop - endif -c Compute G**(-1/2) and G**(1/2) - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Gmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,Geigen,Gvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//a)') - & "Eigenvectors and eigenvalues of the G matrix" - call eigout(dimen,dimen,maxres2,maxres2,Gvec,Geigen) - endif - - do i=1,dimen - sqreig(i)=dsqrt(Geigen(i)) - invsqreig(i)=1.d0/sqreig(i) - enddo - do i=1,dimen - do j=1,dimen - Gvectmp(i,j)=Gvec(j,i) - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gsqrptmp=0.0d0 - Gsqrmtmp=0.0d0 - Gcopytmp=0.0d0 - do k=1,dimen -c Gvec2tmp=Gvec(i,k)*Gvec(j,k) - Gvec2tmp=Gvec(k,i)*Gvec(k,j) - Gsqrptmp=Gsqrptmp+Gvec2tmp*sqreig(k) - Gsqrmtmp=Gsqrmtmp+Gvec2tmp*invsqreig(k) - Gcopytmp=Gcopytmp+Gvec2tmp*Geigen(k) - enddo - Gsqrp(i,j)=Gsqrptmp - Gsqrm(i,j)=Gsqrmtmp - Gcopy(i,j)=Gcopytmp - enddo - enddo - - do i=1,dimen - do j=1,dimen - Gvec(i,j)=Gvectmp(j,i) - enddo - enddo - - if (lprn) then - write (iout,*) "Comparison of original and restored G" - do i=1,dimen - do j=1,dimen - write (iout,'(2i5,5f10.5)') i,j,Gmat(i,j),Gcopy(i,j), - & Gmat(i,j)-Gcopy(i,j),Gsqrp(i,j),Gsqrm(i,j) - enddo - enddo - endif - return - end -c------------------------------------------------------------------------------- - SUBROUTINE EIGOUT(NC,NR,LM2,LM3,A,B) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3),B(LM2) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,601) (B(I),I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (// 9H ROOT NO.,I4,9I11) - 601 FORMAT (/5X,10(1PE11.4)) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.5) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=6 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.10) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+6 - GO TO 1 - 600 FORMAT (//5x,9I11) - 602 FORMAT (2H ) - 603 FORMAT (I5,10F11.3) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT1(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=21 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+21 - GO TO 1 - 600 FORMAT (//5x,7(3I5,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,7(3F5.1,2x)) - 604 FORMAT (1H1) - END -c------------------------------------------------------------------------------- - SUBROUTINE MATOUT2(NC,NR,LM2,LM3,A) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - double precision A(LM2,LM3) - KA=1 - KC=12 - 1 KB=MIN0(KC,NC) - WRITE(IOUT,600) (I,I=KA,KB) - WRITE(IOUT,602) - 2 N=0 - DO 3 I=1,NR - WRITE(IOUT,603) I,(A(I,J),J=KA,KB) - N=N+1 - IF(N.LT.3) GO TO 3 - WRITE(IOUT,602) - N=0 - 3 CONTINUE - 4 IF (KB.EQ.NC) RETURN - KA=KC+1 - KC=KC+12 - GO TO 1 - 600 FORMAT (//5x,4(3I9,2x)) - 602 FORMAT (2H ) - 603 FORMAT (I5,4(3F9.3,2x)) - 604 FORMAT (1H1) - END -c--------------------------------------------------------------------------- - SUBROUTINE ginv_mult(z,d_a_tmp) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer ierr -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.MD' - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(4,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in GINV_MULT" - endif -c write (2,*) "time00",time00 -c write (2,*) "Before Scatterv" -c call flush(2) -c write (2,*) "Whole z (for FG master)" -c do i=1,dimen -c write (2,*) i,z(i) -c enddo -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo -c write (2,*) "After SCATTERV" -c call flush(2) -c write (2,*) "MPI_Wtime",MPI_Wtime() - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_ginvmult=time_scatter_ginvmult+MPI_Wtime()-time00 -#endif -c write (2,*) "time_scatter",time_scatter -c write (2,*) "dimen",dimen," dimen3",dimen3," my_ng_count", -c & my_ng_count -c call flush(2) - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1, -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) -c temp(ind)=temp(ind)+Ginv(i,j)*z((j-1)*3+k+1) - temp(ind)=temp(ind)+Ginv(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c call flush(2) -c write (2,*) "z before reduce" -c do i=1,dimen -c write (2,*) i,temp(i) -c enddo - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen -c write (2,*) "k,i,j,ind",k,i,j,ind,(j-1)*3+k+1 -c call flush(2) -c & Ginv(i,j),z((j-1)*3+k+1), -c & Ginv(i,j)*z((j-1)*3+k+1) - d_a_tmp(ind)=d_a_tmp(ind) - & +Ginv(j,i)*z((j-1)*3+k+1) -c d_a_tmp(ind)=d_a_tmp(ind) -c & +Ginv(i,j)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_ginvmult=time_ginvmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif - return - end -c--------------------------------------------------------------------------- -#ifdef GINV_MULT - SUBROUTINE ginv_mult_test(z,d_a_tmp) - include 'DIMENSIONS' - integer dimen -c include 'COMMON.MD' - double precision z(dimen),d_a_tmp(dimen) - double precision ztmp(dimen/3),dtmp(dimen/3) - -c do i=1,dimen -c d_a_tmp(i)=0.0d0 -c do j=1,dimen -c d_a_tmp(i)=d_a_tmp(i)+Ginv(i,j)*z(j) -c enddo -c enddo -c -c return - -!ibm* unroll(3) - do k=0,2 - do j=1,dimen/3 - ztmp(j)=z((j-1)*3+k+1) - enddo - - call alignx(16,ztmp(1)) - call alignx(16,dtmp(1)) - call alignx(16,Ginv(1,1)) - - do i=1,dimen/3 - dtmp(i)=0.0d0 - do j=1,dimen/3 - dtmp(i)=dtmp(i)+Ginv(i,j)*ztmp(j) - enddo - enddo - do i=1,dimen/3 - ind=(i-1)*3+k+1 - d_a_tmp(ind)=dtmp(i) - enddo - enddo - return - end -#endif -c--------------------------------------------------------------------------- - SUBROUTINE fricmat_mult(z,d_a_tmp) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer IERROR -#endif - include 'COMMON.MD' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 -#ifdef MPI - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM - time00=MPI_Wtime() - call MPI_Bcast(9,1,MPI_INTEGER,king,FG_COMM,IERROR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 -c print *,"Processor",myrank," BROADCAST iorder in FRICMAT_MULT" - endif -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(z,ng_counts(0),ng_start(0), - & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -c write (2,*) "My chunk of z" -c do i=1,3*my_ng_count -c write (2,*) i,z(i) -c enddo - time_scatter=time_scatter+MPI_Wtime()-time00 -#ifdef TIMING - time_scatter_fmatmult=time_scatter_fmatmult+MPI_Wtime()-time00 -#endif - time01=MPI_Wtime() - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - temp(ind)=0.0d0 - do j=1,my_ng_count - temp(ind)=temp(ind)-fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -c write (2,*) "Before REDUCE" -c write (2,*) "d_a_tmp before reduce" -c do i=1,dimen3 -c write (2,*) i,temp(i) -c enddo -c call flush(2) - time00=MPI_Wtime() - call MPI_Reduce(temp(1),d_a_tmp(1),dimen3,MPI_DOUBLE_PRECISION, - & MPI_SUM,king,FG_COMM,IERR) - time_reduce=time_reduce+MPI_Wtime()-time00 -c write (2,*) "After REDUCE" -c call flush(2) - else -#endif -#ifdef TIMING - time01=MPI_Wtime() -#endif - do k=0,2 - do i=1,dimen - ind=(i-1)*3+k+1 - d_a_tmp(ind)=0.0d0 - do j=1,dimen - d_a_tmp(ind)=d_a_tmp(ind) - & -fricmat(j,i)*z((j-1)*3+k+1) - enddo - enddo - enddo -#ifdef TIMING - time_fricmatmult=time_fricmatmult+MPI_Wtime()-time01 -#endif -#ifdef MPI - endif -#endif -c write (iout,*) "Vector d_a" -c do i=1,dimen3 -c write (2,*) i,d_a_tmp(i) -c enddo - return - end diff --git a/source/unres/src_MD-restraints/local_move.f b/source/unres/src_MD-restraints/local_move.f deleted file mode 100644 index 7a7e125..0000000 --- a/source/unres/src_MD-restraints/local_move.f +++ /dev/null @@ -1,972 +0,0 @@ -c------------------------------------------------------------- - - subroutine local_move_init(debug) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' ! Needed by COMMON.LOCAL - include 'COMMON.GEO' ! For pi, deg2rad - include 'COMMON.LOCAL' ! For vbl - include 'COMMON.LOCMOVE' - -c INPUT arguments - logical debug - - -c Determine wheter to do some debugging output - locmove_output=debug - -c Set the init_called flag to 1 - init_called=1 - -c The following are never changed - min_theta=60.D0*deg2rad ! (0,PI) - max_theta=175.D0*deg2rad ! (0,PI) - dmin2=vbl*vbl*2.*(1.-cos(min_theta)) - dmax2=vbl*vbl*2.*(1.-cos(max_theta)) - flag=1.0D300 - small=1.0D-5 - small2=0.5*small*small - -c Not really necessary... - a_n=0 - b_n=0 - res_n=0 - - return - end - -c------------------------------------------------------------- - - subroutine local_move(n_start, n_end, PHImin, PHImax) -c Perform a local move between residues m and n (inclusive) -c PHImin and PHImax [0,PI] determine the size of the move -c Works on whatever structure is in the variables theta and phi, -c sidechain variables are left untouched -c The final structure is NOT minimized, but both the cartesian -c variables c and the angles are up-to-date at the end (no further -c chainbuild is required) -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.MINIM' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - double precision ran_number - external ran_number - -c INPUT arguments - integer n_start, n_end ! First and last residues to move - double precision PHImin, PHImax ! min/max angles [0,PI] - -c Local variables - integer i,j - double precision min,max - integer iretcode - - -c Check if local_move_init was called. This assumes that it -c would not be 1 if not explicitely initialized - if (init_called.ne.1) then - write(6,*)' *** local_move_init not called!!!' - stop - endif - -c Quick check for crazy range - if (n_start.gt.n_end .or. n_start.lt.1 .or. n_end.gt.nres) then - write(6,'(a,i3,a,i3)') - + ' *** Cannot make local move between n_start = ', - + n_start,' and n_end = ',n_end - return - endif - -c Take care of end residues first... - if (n_start.eq.1) then -c Move residue 1 (completely random) - theta(3)=ran_number(min_theta,max_theta) - phi(4)=ran_number(-PI,PI) - i=2 - else - i=n_start - endif - if (n_end.eq.nres) then -c Move residue nres (completely random) - theta(nres)=ran_number(min_theta,max_theta) - phi(nres)=ran_number(-PI,PI) - j=nres-1 - else - j=n_end - endif - -c ...then go through all other residues one by one -c Start from the two extremes and converge - call chainbuild - do while (i.le.j) - min=PHImin - max=PHImax -c$$$c Move the first two residues by less than the others -c$$$ if (i-n_start.lt.3) then -c$$$ if (i-n_start.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (i-n_start.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (i-n_start.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue i - iretcode=move_res(min,max,i) ! Discard iretcode - i=i+1 - - if (i.le.j) then - min=PHImin - max=PHImax -c$$$c Move the last two residues by less than the others -c$$$ if (n_end-j.lt.3) then -c$$$ if (n_end-j.eq.0) then -c$$$ min=0.4*PHImin -c$$$ max=0.4*PHImax -c$$$ else if (n_end-j.eq.1) then -c$$$ min=0.8*PHImin -c$$$ max=0.8*PHImax -c$$$ else if (n_end-j.eq.2) then -c$$$ min=PHImin -c$$$ max=PHImax -c$$$ endif -c$$$ endif - -c The actual move, on residue j - iretcode=move_res(min,max,j) ! Discard iretcode - j=j-1 - endif - enddo - - call int_from_cart(.false.,.false.) - - return - end - -c------------------------------------------------------------- - - subroutine output_tabs -c Prints out the contents of a_..., b_..., res_... - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Local variables - integer i,j - - - write(6,*)'a_...' - write(6,'(8f7.1)')(a_ang(i)*rad2deg,i=0,a_n-1) - write(6,'(8(2x,3l1,2x))')((a_tab(i,j),i=0,2),j=0,a_n-1) - - write(6,*)'b_...' - write(6,'(4f7.1)')(b_ang(i)*rad2deg,i=0,b_n-1) - write(6,'(4(2x,3l1,2x))')((b_tab(i,j),i=0,2),j=0,b_n-1) - - write(6,*)'res_...' - write(6,'(12f7.1)')(res_ang(i)*rad2deg,i=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(0,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(1,i,j),i=0,2),j=0,res_n-1) - write(6,'(12(2x,3l1,2x))')((res_tab(2,i,j),i=0,2),j=0,res_n-1) - - return - end - -c------------------------------------------------------------- - - subroutine angles2tab(PHImin,PHImax,n,ang,tab) -c Only uses angles if [0,PI] (but PHImin cannot be 0., -c and PHImax cannot be PI) - implicit none - -c Includes - include 'COMMON.GEO' - -c INPUT arguments - double precision PHImin,PHImax - -c OUTPUT arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - - - if (PHImin .eq. PHImax) then -c Special case with two 010's - n = 2; - ang(0) = -PHImin; - ang(1) = PHImin; - tab(0,0) = .false. - tab(2,0) = .false. - tab(0,1) = .false. - tab(2,1) = .false. - tab(1,0) = .true. - tab(1,1) = .true. - else if (PHImin .eq. PI) then -c Special case with one 010 - n = 1 - ang(0) = PI - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else if (PHImax .eq. 0.) then -c Special case with one 010 - n = 1 - ang(0) = 0. - tab(0,0) = .false. - tab(2,0) = .false. - tab(1,0) = .true. - else -c Standard cases - n = 0 - if (PHImin .gt. 0.) then -c Start of range (011) - ang(n) = PHImin - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = -PHImin - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - if (PHImax .lt. PI) then -c Start of range (011) - ang(n) = -PHImax - tab(0,n) = .false. - tab(1,n) = .true. - tab(2,n) = .true. -c End of range (110) - ang(n+1) = PHImax - tab(0,n+1) = .true. - tab(1,n+1) = .true. - tab(2,n+1) = .false. - n = n+2 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine minmax_angles(x,y,z,r,n,ang,tab) -c When solutions do not exist, assume all angles -c are acceptable - i.e., initial geometry must be correct - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Input arguments - double precision x,y,z,r - -c Output arguments - integer n - double precision ang(0:3) - logical tab(0:2,0:3) - -c Local variables - double precision num, denom, phi - double precision Kmin, Kmax - integer i - - - num = x*x + y*y + z*z - denom = x*x + y*y - n = 0 - if (denom .gt. 0.) then - phi = atan2(y,x) - denom = 2.*r*sqrt(denom) - num = num+r*r - Kmin = (num - dmin2)/denom - Kmax = (num - dmax2)/denom - -c Allowed values of K (else all angles are acceptable) -c -1 <= Kmin < 1 -c -1 < Kmax <= 1 - if (Kmin .gt. 1. .or. abs(Kmin-1.) .lt. small2) then - Kmin = -flag - else if (Kmin .lt. -1. .or. abs(Kmin+1.) .lt. small2) then - Kmin = PI - else - Kmin = acos(Kmin) - endif - - if (Kmax .lt. -1. .or. abs(Kmax+1.) .lt. small2) then - Kmax = flag - else if (Kmax .gt. 1. .or. abs(Kmax-1.) .lt. small2) then - Kmax = 0. - else - Kmax = acos(Kmax) - endif - - if (Kmax .lt. Kmin) Kmax = Kmin - - call angles2tab(Kmin, Kmax, n, ang, tab) - -c Add phi and check that angles are within range (-PI,PI] - do i=0,n-1 - ang(i) = ang(i)+phi - if (ang(i) .le. -PI) then - ang(i) = ang(i)+2.*PI - else if (ang(i) .gt. PI) then - ang(i) = ang(i)-2.*PI - endif - enddo - endif - - return - end - -c------------------------------------------------------------- - - subroutine construct_tab -c Take a_... and b_... values and produces the results res_... -c x_ang are assumed to be all different (diff > small) -c x_tab(1,i) must be 1 for all i (i.e., all x_ang are acceptable) - implicit none - -c Includes - include 'COMMON.LOCMOVE' - -c Local variables - integer n_max,i,j,index - logical done - double precision phi - - - n_max = a_n + b_n - if (n_max .eq. 0) then - res_n = 0 - return - endif - - do i=0,n_max-1 - do j=0,1 - res_tab(j,0,i) = .true. - res_tab(j,2,i) = .true. - res_tab(j,1,i) = .false. - enddo - enddo - - index = 0 - phi = -flag - done = .false. - do while (.not.done) - res_ang(index) = flag - -c Check a first... - do i=0,a_n-1 - if ((a_ang(i)-phi).gt.small .and. - + a_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = a_ang(i) -c Copy the values from a_tab into res_tab(0,,) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) -c Set default values for res_tab(1,,) - res_tab(1,0,index) = .true. - res_tab(1,1,index) = .false. - res_tab(1,2,index) = .true. - else if (abs(a_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to a b_ang) - res_tab(0,0,index) = a_tab(0,i) - res_tab(0,1,index) = a_tab(1,i) - res_tab(0,2,index) = a_tab(2,i) - endif - enddo -c ...then check b - do i=0,b_n-1 - if ((b_ang(i)-phi).gt.small .and. - + b_ang(i) .lt. res_ang(index)) then -c Found a lower angle - res_ang(index) = b_ang(i) -c Copy the values from b_tab into res_tab(1,,) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) -c Set default values for res_tab(0,,) - res_tab(0,0,index) = .true. - res_tab(0,1,index) = .false. - res_tab(0,2,index) = .true. - else if (abs(b_ang(i)-res_ang(index)).lt.small) then -c Found an equal angle (can only be equal to an a_ang) - res_tab(1,0,index) = b_tab(0,i) - res_tab(1,1,index) = b_tab(1,i) - res_tab(1,2,index) = b_tab(2,i) - endif - enddo - - if (res_ang(index) .eq. flag) then - res_n = index - done = .true. - else if (index .eq. n_max-1) then - res_n = n_max - done = .true. - else - phi = res_ang(index) ! Store previous angle - index = index+1 - endif - enddo - -c Fill the gaps -c First a... - index = 0 - if (a_n .gt. 0) then - do while (.not.res_tab(0,1,index)) - index=index+1 - enddo - done = res_tab(0,2,index) - do i=index+1,res_n-1 - if (res_tab(0,1,i)) then - done = res_tab(0,2,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - done = res_tab(0,0,index) - do i=index-1,0,-1 - if (res_tab(0,1,i)) then - done = res_tab(0,0,i) - else - res_tab(0,0,i) = done - res_tab(0,1,i) = done - res_tab(0,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(0,0,i) = .true. - res_tab(0,1,i) = .true. - res_tab(0,2,i) = .true. - enddo - endif -c ...then b - index = 0 - if (b_n .gt. 0) then - do while (.not.res_tab(1,1,index)) - index=index+1 - enddo - done = res_tab(1,2,index) - do i=index+1,res_n-1 - if (res_tab(1,1,i)) then - done = res_tab(1,2,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - done = res_tab(1,0,index) - do i=index-1,0,-1 - if (res_tab(1,1,i)) then - done = res_tab(1,0,i) - else - res_tab(1,0,i) = done - res_tab(1,1,i) = done - res_tab(1,2,i) = done - endif - enddo - else - do i=0,res_n-1 - res_tab(1,0,i) = .true. - res_tab(1,1,i) = .true. - res_tab(1,2,i) = .true. - enddo - endif - -c Finally fill the last row with AND operation - do i=0,res_n-1 - do j=0,2 - res_tab(2,j,i) = (res_tab(0,j,i) .and. res_tab(1,j,i)) - enddo - enddo - - return - end - -c------------------------------------------------------------- - - subroutine construct_ranges(phi_n,phi_start,phi_end) -c Given the data in res_..., construct a table of -c min/max allowed angles - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - -c Local variables - logical done - integer index - - - if (res_n .eq. 0) then -c Any move is allowed - phi_n = 1 - phi_start(0) = -PI - phi_end(0) = PI - else - phi_n = 0 - index = 0 - done = .false. - do while (.not.done) -c Find start of range (01x) - done = .false. - do while (.not.done) - if (res_tab(2,0,index).or.(.not.res_tab(2,1,index))) then - index=index+1 - else - done = .true. - phi_start(phi_n) = res_ang(index) - endif - if (index .eq. res_n) done = .true. - enddo -c If a start was found (index < res_n), find the end of range (x10) -c It may not be found without wrapping around - if (index .lt. res_n) then - done = .false. - do while (.not.done) - if ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) then - index=index+1 - else - done = .true. - endif - if (index .eq. res_n) done = .true. - enddo - if (index .lt. res_n) then -c Found the end of the range - phi_end(phi_n) = res_ang(index) - phi_n=phi_n+1 - index=index+1 - if (index .eq. res_n) then - done = .true. - else - done = .false. - endif - else -c Need to wrap around - done = .true. - phi_end(phi_n) = flag - endif - endif - enddo -c Take care of the last one if need to wrap around - if (phi_end(phi_n) .eq. flag) then - index = 0 - do while ((.not.res_tab(2,1,index)).or.res_tab(2,2,index)) - index=index+1 - enddo - phi_end(phi_n) = res_ang(index) + 2.*PI - phi_n=phi_n+1 - endif - endif - - return - end - -c------------------------------------------------------------- - - subroutine fix_no_moves(phi) - implicit none - -c Includes - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c Output arguments - double precision phi - -c Local variables - integer index - double precision diff,temp - - -c Look for first 01x in gammas (there MUST be at least one) - diff = flag - index = 0 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index+1 - enddo - if (res_ang(index) .le. 0.D0) then ! Make sure it's from PHImax -c Try to increase PHImax - if (index .gt. 0) then - phi = res_ang(index-1) - diff = abs(res_ang(index) - res_ang(index-1)) - endif -c Look for last (corresponding) x10 - index = res_n - 1 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index-1 - enddo - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif - endif - -c If increasing PHImax didn't work, decreasing PHImin -c will (with one exception) -c Look for first x10 (there MUST be at least one) - index = 0 - do while ((.not.res_tab(1,1,index)) .or. res_tab(1,2,index)) - index=index+1 - enddo - if (res_ang(index) .lt. 0.D0) then ! Make sure it's from PHImin -c Try to decrease PHImin - if (index .lt. res_n-1) then - temp = abs(res_ang(index) - res_ang(index+1)) - if (res_ang(index+1) .le. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index+1) - diff = temp - endif - endif -c Look for last (corresponding) 01x - index = res_n - 1 - do while (res_tab(1,0,index) .or. (.not.res_tab(1,1,index))) - index=index-1 - enddo - if (index .gt. 0) then - temp = abs(res_ang(index) - res_ang(index-1)) - if (res_ang(index-1) .ge. 0.D0 .and. temp .lt. diff) then - phi = res_ang(index-1) - diff = temp - endif - endif - endif - -c If it still didn't work, it must be PHImax == 0. or PHImin == PI - if (diff .eq. flag) then - index = 0 - if (res_tab(index,1,0) .or. (.not.res_tab(index,1,1)) .or. - + res_tab(index,1,2)) index = res_n - 1 -c This MUST work at this point - if (index .eq. 0) then - phi = res_ang(1) - else - phi = res_ang(index - 1) - endif - endif - - return - end - -c------------------------------------------------------------- - - integer function move_res(PHImin,PHImax,i_move) -c Moves residue i_move (in array c), leaving everything else fixed -c Starting geometry is not checked, it should be correct! -c R(,i_move) is the only residue that will move, but must have -c 1 < i_move < nres (i.e., cannot move ends) -c Whether any output is done is controlled by locmove_output -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.GEO' - include 'COMMON.LOCMOVE' - -c External functions - double precision ran_number - external ran_number - -c Input arguments - double precision PHImin,PHImax - integer i_move - -c RETURN VALUES: -c 0: move successfull -c 1: Dmin or Dmax had to be modified -c 2: move failed - check your input geometry - - -c Local variables - double precision X(0:2),Y(0:2),Z(0:2),Orig(0:2) - double precision P(0:2) - logical no_moves,done - integer index,i,j - double precision phi,temp,radius - double precision phi_start(0:11), phi_end(0:11) - integer phi_n - -c Set up the coordinate system - do i=0,2 - Orig(i)=0.5*(c(i+1,i_move-1)+c(i+1,i_move+1)) ! Position of origin - enddo - - do i=0,2 - Z(i)=c(i+1,i_move+1)-c(i+1,i_move-1) - enddo - temp=sqrt(Z(0)*Z(0)+Z(1)*Z(1)+Z(2)*Z(2)) - do i=0,2 - Z(i)=Z(i)/temp - enddo - - do i=0,2 - X(i)=c(i+1,i_move)-Orig(i) - enddo -c radius is the radius of the circle on which c(,i_move) can move - radius=sqrt(X(0)*X(0)+X(1)*X(1)+X(2)*X(2)) - do i=0,2 - X(i)=X(i)/radius - enddo - - Y(0)=Z(1)*X(2)-X(1)*Z(2) - Y(1)=X(0)*Z(2)-Z(0)*X(2) - Y(2)=Z(0)*X(1)-X(0)*Z(1) - -c Calculate min, max angles coming from dmin, dmax to c(,i_move-2) - if (i_move.gt.2) then - do i=0,2 - P(i)=c(i+1,i_move-2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,a_n,a_ang,a_tab) - else - a_n=0 - endif - -c Calculate min, max angles coming from dmin, dmax to c(,i_move+2) - if (i_move.lt.nres-2) then - do i=0,2 - P(i)=c(i+1,i_move+2)-Orig(i) - enddo - call minmax_angles(P(0)*X(0)+P(1)*X(1)+P(2)*X(2), - + P(0)*Y(0)+P(1)*Y(1)+P(2)*Y(2), - + P(0)*Z(0)+P(1)*Z(1)+P(2)*Z(2), - + radius,b_n,b_ang,b_tab) - else - b_n=0 - endif - -c Construct the resulting table for alpha and beta - call construct_tab() - - if (locmove_output) then - print *,'ALPHAS & BETAS TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - if (no_moves) then - if (locmove_output) print *,' *** Cannot move anywhere' - move_res=2 - return - endif - -c Transfer res_... into a_... - a_n = 0 - do i=0,res_n-1 - if ( (res_tab(2,0,i).neqv.res_tab(2,1,i)) .or. - + (res_tab(2,0,i).neqv.res_tab(2,2,i)) ) then - a_ang(a_n) = res_ang(i) - do j=0,2 - a_tab(j,a_n) = res_tab(2,j,i) - enddo - a_n=a_n+1 - endif - enddo - -c Check that the PHI's are within [0,PI] - if (PHImin .lt. 0. .or. abs(PHImin) .lt. small) PHImin = -flag - if (PHImin .gt. PI .or. abs(PHImin-PI) .lt. small) PHImin = PI - if (PHImax .gt. PI .or. abs(PHImax-PI) .lt. small) PHImax = flag - if (PHImax .lt. 0. .or. abs(PHImax) .lt. small) PHImax = 0. - if (PHImax .lt. PHImin) PHImax = PHImin -c Calculate min and max angles coming from PHImin and PHImax, -c and put them in b_... - call angles2tab(PHImin, PHImax, b_n, b_ang, b_tab) -c Construct the final table - call construct_tab() - - if (locmove_output) then - print *,'FINAL TABLE' - call output_tabs() - endif - -c Check that there is at least one possible move - no_moves = .true. - if (res_n .eq. 0) then - no_moves = .false. - else - index = 0 - do while ((index .lt. res_n) .and. no_moves) - if (res_tab(2,1,index)) no_moves = .false. - index=index+1 - enddo - endif - - if (no_moves) then -c Take care of the case where no solution exists... - call fix_no_moves(phi) - if (locmove_output) then - print *,' *** Had to modify PHImin or PHImax' - print *,'phi: ',phi*rad2deg - endif - move_res=1 - else -c ...or calculate the solution -c Construct phi_start/phi_end arrays - call construct_ranges(phi_n, phi_start, phi_end) -c Choose random angle phi in allowed range(s) - temp = 0. - do i=0,phi_n-1 - temp = temp + phi_end(i) - phi_start(i) - enddo - phi = ran_number(phi_start(0),phi_start(0)+temp) - index = 0 - done = .false. - do while (.not.done) - if (phi .lt. phi_end(index)) then - done = .true. - else - index=index+1 - endif - if (index .eq. phi_n) then - done = .true. - else if (.not.done) then - phi = phi + phi_start(index) - phi_end(index-1) - endif - enddo - if (index.eq.phi_n) phi=phi_end(phi_n-1) ! Fix numerical errors - if (phi .gt. PI) phi = phi-2.*PI - - if (locmove_output) then - print *,'ALLOWED RANGE(S)' - do i=0,phi_n-1 - print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg - enddo - print *,'phi: ',phi*rad2deg - endif - move_res=0 - endif - -c Re-use radius as temp variable - temp=radius*cos(phi) - radius=radius*sin(phi) - do i=0,2 - c(i+1,i_move)=Orig(i)+temp*X(i)+radius*Y(i) - enddo - - return - end - -c------------------------------------------------------------- - - subroutine loc_test -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.LOCMOVE' - -c External functions - integer move_res - external move_res - -c Local variables - integer i,j - integer phi_n - double precision phi_start(0:11),phi_end(0:11) - double precision phi - double precision R(0:2,0:5) - - locmove_output=.true. - -c call angles2tab(30.*deg2rad,70.*deg2rad,a_n,a_ang,a_tab) -c call angles2tab(80.*deg2rad,130.*deg2rad,b_n,b_ang,b_tab) -c call minmax_angles(0.D0,3.8D0,0.D0,3.8D0,b_n,b_ang,b_tab) -c call construct_tab -c call output_tabs - -c call construct_ranges(phi_n,phi_start,phi_end) -c do i=0,phi_n-1 -c print *,phi_start(i)*rad2deg,phi_end(i)*rad2deg -c enddo - -c call fix_no_moves(phi) -c print *,'NO MOVES FOUND, BEST PHI IS',phi*rad2deg - - R(0,0)=0.D0 - R(1,0)=0.D0 - R(2,0)=0.D0 - R(0,1)=0.D0 - R(1,1)=-cos(28.D0*deg2rad) - R(2,1)=-0.5D0-sin(28.D0*deg2rad) - R(0,2)=0.D0 - R(1,2)=0.D0 - R(2,2)=-0.5D0 - R(0,3)=cos(30.D0*deg2rad) - R(1,3)=0.D0 - R(2,3)=0.D0 - R(0,4)=0.D0 - R(1,4)=0.D0 - R(2,4)=0.5D0 - R(0,5)=0.D0 - R(1,5)=cos(26.D0*deg2rad) - R(2,5)=0.5D0+sin(26.D0*deg2rad) - do i=1,5 - do j=0,2 - R(j,i)=vbl*R(j,i) - enddo - enddo -c i=move_res(R(0,1),0.D0*deg2rad,180.D0*deg2rad) - imov=nnt - i=move_res(0.D0*deg2rad,180.D0*deg2rad,imov) - print *,'RETURNED ',i - print *,(R(i,3)/vbl,i=0,2) - - return - end - -c------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/log b/source/unres/src_MD-restraints/log deleted file mode 100644 index 75dbb96..0000000 --- a/source/unres/src_MD-restraints/log +++ /dev/null @@ -1,956 +0,0 @@ -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 unres.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o arcos.o arcos.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o cartprint.o cartprint.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 chainbuild.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o convert.o convert.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 initialize_p.F -./COMMON.MD(28): remark #7784: Symbol in BLOCK DATA program unit is not in a COMMON block. [EHOMOLOGY_CONSTR] - & Ucdfrag,Ucdpair,dUdconst(3,0:MAXRES),Uconst,ehomology_constr, ----------------------------------------------------^ -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 matmult.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 readrtns.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 parmread.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 gen_rand_conf.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o printmat.o printmat.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o map.o map.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o pinorm.o pinorm.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o randgens.o randgens.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o rescode.o rescode.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 intcor.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 timing.F -timing.F(168): warning #6178: The return value of this FUNCTION has not been defined. [TCPU] - double precision function tcpu() ---------------------------------^ -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o misc.o misc.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o intlocal.o intlocal.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 cartder.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 checkder_p.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 econstr_local.F -ifort -c -O3 -ipo -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 energy_p_new_barrier.F - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (etotal_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;sum_energy_;0> - PACK MERGE (sum_energy_): VARS(21) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sum_energy_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;sum_gradient_;0> - PACK MERGE (sum_gradient_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sum_gradient_): VARS(19), PACKS (19) - - -<;-1:-1;IPO PACK MERGE;rescale_weights_;0> - PACK MERGE (rescale_weights_): VARS(13) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (rescale_weights_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;enerprint_;0> - PACK MERGE (enerprint_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (enerprint_): VARS(1), PACKS (1) - - -<;-1:-1;IPO PACK MERGE;elj_;0> - PACK MERGE (elj_): VARS(4) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (elj_): VARS(7), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;eljk_;0> - PACK MERGE (eljk_): VARS(14) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eljk_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;ebp_;0> - PACK MERGE (ebp_): VARS(12) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ebp_): VARS(10), PACKS (10) - - -<;-1:-1;IPO PACK MERGE;egb_;0> - PACK MERGE (egb_): VARS(50) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egb_): VARS(56), PACKS (55) - - -<;-1:-1;IPO PACK MERGE;egbv_;0> - PACK MERGE (egbv_): VARS(51) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egbv_): VARS(54), PACKS (54) - - -<;-1:-1;IPO PACK MERGE;sc_angular_;0> - PACK MERGE (sc_angular_): VARS(23) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sc_angular_): VARS(3), PACKS (3) - - -<;-1:-1;IPO PACK MERGE;sc_grad_t_;0> - PACK MERGE (sc_grad_t_): VARS(26) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sc_grad_t_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;sc_grad_;0> - PACK MERGE (sc_grad_): VARS(31) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sc_grad_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;e_softsphere_;0> - PACK MERGE (e_softsphere_): VARS(11) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (e_softsphere_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;eelec_soft_sphere_;0> - PACK MERGE (eelec_soft_sphere_): VARS(2) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eelec_soft_sphere_): VARS(8), PACKS (8) - - -<;-1:-1;IPO PACK MERGE;vec_and_deriv_;0> - PACK MERGE (vec_and_deriv_): VARS(3) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (vec_and_deriv_): VARS(7), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;check_vecgrad_;0> - PACK MERGE (check_vecgrad_): VARS(6) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (check_vecgrad_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;set_matrices_;0> - PACK MERGE (set_matrices_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (set_matrices_): VARS(12), PACKS (12) - - -<;-1:-1;IPO PACK MERGE;eelec_;0> - PACK MERGE (eelec_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eelec_): VARS(27), PACKS (27) - - -<;-1:-1;IPO PACK MERGE;eelecij_;0> - PACK MERGE (eelecij_): VARS(36) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eelecij_): VARS(10), PACKS (10) - - -<;-1:-1;IPO PACK MERGE;eturn3_;0> - PACK MERGE (eturn3_): VARS(15) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eturn3_): VARS(18), PACKS (18) - - -<;-1:-1;IPO PACK MERGE;eturn4_;0> - PACK MERGE (eturn4_): VARS(23) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eturn4_): VARS(10), PACKS (10) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (vecpr_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (unormderiv_): VARS(1), PACKS (1) - - -<;-1:-1;IPO PACK MERGE;escp_soft_sphere_;0> - PACK MERGE (escp_soft_sphere_): VARS(3) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (escp_soft_sphere_): VARS(8), PACKS (8) - - -<;-1:-1;IPO PACK MERGE;escp_;0> - PACK MERGE (escp_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (escp_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;edis_;0> - PACK MERGE (edis_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (edis_): VARS(3), PACKS (3) - - -<;-1:-1;IPO PACK MERGE;ssbond_ene_;0> - PACK MERGE (ssbond_ene_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ssbond_ene_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;ebond_;0> - PACK MERGE (ebond_): VARS(5) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ebond_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;ebend_;0> - PACK MERGE (ebend_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ebend_): VARS(183), PACKS (183) - - -<;-1:-1;IPO PACK MERGE;esc_;0> - PACK MERGE (esc_): VARS(9) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (esc_): VARS(9), PACKS (9) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (enesc_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (gcont_): VARS(1), PACKS (1) - - -<;-1:-1;IPO PACK MERGE;splinthet_;0> - PACK MERGE (splinthet_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (splinthet_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (spline1_): VARS(3), PACKS (3) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (spline2_): VARS(1), PACKS (1) - - -<;-1:-1;IPO PACK MERGE;etor_;0> - PACK MERGE (etor_): VARS(8) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (etor_): VARS(24), PACKS (23) - - -<;-1:-1;IPO PACK MERGE;e_modeller_;0> - PACK MERGE (e_modeller_): VARS(6) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (e_modeller_): VARS(19), PACKS (15) - - -<;-1:-1;IPO PACK MERGE;etor_d_;0> - PACK MERGE (etor_d_): VARS(6) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (etor_d_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;eback_sc_corr_;0> - PACK MERGE (eback_sc_corr_): VARS(5) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eback_sc_corr_): VARS(28), PACKS (28) - - -<;-1:-1;IPO PACK MERGE;multibody_;0> - PACK MERGE (multibody_): VARS(6) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (multibody_): VARS(22), PACKS (21) - - -<;-1:-1;IPO PACK MERGE;esccorr_;0> - PACK MERGE (esccorr_): VARS(4) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (esccorr_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;multibody_hb_;0> - PACK MERGE (multibody_hb_): VARS(26) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (multibody_hb_): VARS(112), PACKS (104) - - -<;-1:-1;IPO PACK MERGE;add_hb_contact_;0> - PACK MERGE (add_hb_contact_): VARS(14) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (add_hb_contact_): VARS(3), PACKS (3) - - -<;-1:-1;IPO PACK MERGE;multibody_eello_;0> - PACK MERGE (multibody_eello_): VARS(36) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (multibody_eello_): VARS(120), PACKS (112) - - -<;-1:-1;IPO PACK MERGE;add_hb_contact_eello_;0> - PACK MERGE (add_hb_contact_eello_): VARS(8) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (add_hb_contact_eello_): VARS(3), PACKS (3) - - -<;-1:-1;IPO PACK MERGE;ehbcorr_;0> - PACK MERGE (ehbcorr_): VARS(13) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ehbcorr_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;calc_eello_;0> - PACK MERGE (calc_eello_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (calc_eello_): VARS(5), PACKS (5) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (kernel_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;eello4_;0> - PACK MERGE (eello4_): VARS(9) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello4_): VARS(10), PACKS (10) - - -<;-1:-1;IPO PACK MERGE;eello5_;0> - PACK MERGE (eello5_): VARS(28) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello5_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;eello6_;0> - PACK MERGE (eello6_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello6_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;eello6_graph1_;0> - PACK MERGE (eello6_graph1_): VARS(23) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello6_graph1_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;eello6_graph2_;0> - PACK MERGE (eello6_graph2_): VARS(16) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello6_graph2_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;eello6_graph3_;0> - PACK MERGE (eello6_graph3_): VARS(14) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello6_graph3_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;eello6_graph4_;0> - PACK MERGE (eello6_graph4_): VARS(22) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello6_graph4_): VARS(8), PACKS (8) - - -<;-1:-1;IPO PACK MERGE;eello_turn6_;0> - PACK MERGE (eello_turn6_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eello_turn6_): VARS(26), PACKS (26) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (scalar_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (matvec2_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (matmat2_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (scalar2_): VARS(3), PACKS (3) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (transpose2_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (transpose_): VARS(3), PACKS (3) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (prodmat3_): VARS(4), PACKS (4) - -ifort -c -O3 -ipo -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 energy_p_new-sep_barrier.F - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sscale_): VARS(1), PACKS (1) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (elj_long_): VARS(7), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;elj_short_;0> - PACK MERGE (elj_short_): VARS(16) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (elj_short_): VARS(8), PACKS (8) - - -<;-1:-1;IPO PACK MERGE;eljk_long_;0> - PACK MERGE (eljk_long_): VARS(15) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eljk_long_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;eljk_short_;0> - PACK MERGE (eljk_short_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eljk_short_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;ebp_long_;0> - PACK MERGE (ebp_long_): VARS(12) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ebp_long_): VARS(10), PACKS (10) - - -<;-1:-1;IPO PACK MERGE;ebp_short_;0> - PACK MERGE (ebp_short_): VARS(50) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ebp_short_): VARS(10), PACKS (10) - - -<;-1:-1;IPO PACK MERGE;egb_long_;0> - PACK MERGE (egb_long_): VARS(50) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egb_long_): VARS(55), PACKS (54) - - -<;-1:-1;IPO PACK MERGE;egb_short_;0> - PACK MERGE (egb_short_): VARS(52) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egb_short_): VARS(55), PACKS (54) - - -<;-1:-1;IPO PACK MERGE;egbv_long_;0> - PACK MERGE (egbv_long_): VARS(52) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egbv_long_): VARS(54), PACKS (54) - - -<;-1:-1;IPO PACK MERGE;egbv_short_;0> - PACK MERGE (egbv_short_): VARS(52) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (egbv_short_): VARS(54), PACKS (54) - - -<;-1:-1;IPO PACK MERGE;sc_grad_scale_;0> - PACK MERGE (sc_grad_scale_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sc_grad_scale_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;sc_grad_scale_t_;0> - PACK MERGE (sc_grad_scale_t_): VARS(29) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sc_grad_scale_t_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;eelec_scale_;0> - PACK MERGE (eelec_scale_): VARS(3) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eelec_scale_): VARS(27), PACKS (27) - - -<;-1:-1;IPO PACK MERGE;eelecij_scale_;0> - PACK MERGE (eelecij_scale_): VARS(22) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eelecij_scale_): VARS(11), PACKS (11) - - -<;-1:-1;IPO PACK MERGE;evdwpp_short_;0> - PACK MERGE (evdwpp_short_): VARS(9) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (evdwpp_short_): VARS(14), PACKS (14) - - -<;-1:-1;IPO PACK MERGE;escp_long_;0> - PACK MERGE (escp_long_): VARS(8) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (escp_long_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;escp_short_;0> - PACK MERGE (escp_short_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (escp_short_): VARS(4), PACKS (4) - -ifort -c -O3 -ipo -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 gradient_p.F - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (gradient_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;grad_restr_;0> - PACK MERGE (grad_restr_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (grad_restr_): VARS(3), PACKS (3) - - -<;-1:-1;IPO PACK MERGE;cartgrad_;0> - PACK MERGE (cartgrad_): VARS(6) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (cartgrad_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;zerograd_;0> - PACK MERGE (zerograd_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (zerograd_): VARS(3), PACKS (3) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (fdum_): VARS(1), PACKS (1) - -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 minimize_p.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 sumsld.f -ifort -c -g -CA -CB -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 cored.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 rmdd.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 geomout.F -ifort -c -g -O0 -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 readpdb.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 regularize.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 thread.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o fitsq.o fitsq.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 mcm.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 mc.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o bond_move.o bond_move.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o refsys.o refsys.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o check_sc_distr.o check_sc_distr.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o check_bond.o check_bond.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o contact.o contact.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o djacob.o djacob.f -ifort -c -g -O0 -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include eigen.f -ifort -c -g -CA -CB -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include blas.f -ifort -c -g -CA -CB -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include add.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 entmcm.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 minim_mcmf.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 MP.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 compare_s1.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o prng.o prng.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o banach.o banach.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 rmsd.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o elecont.o elecont.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 dihed_cons.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 sc_move.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o local_move.o local_move.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 intcartderiv.F -ifort -c -O3 -ipo -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 lagrangian_lesyng.F - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (lagrangian_): VARS(53), PACKS (49) - - -<;-1:-1;IPO PACK MERGE;setup_md_matrices_;0> - PACK MERGE (setup_md_matrices_): VARS(3) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (setup_md_matrices_): VARS(72), PACKS (68) - - -<;-1:-1;IPO PACK MERGE;eigout_;0> - PACK MERGE (eigout_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (eigout_): VARS(8), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;matout_;0> - PACK MERGE (matout_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (matout_): VARS(7), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;matout1_;0> - PACK MERGE (matout1_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (matout1_): VARS(7), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;matout2_;0> - PACK MERGE (matout2_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (matout2_): VARS(7), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;ginv_mult_;0> - PACK MERGE (ginv_mult_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (ginv_mult_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;fricmat_mult_;0> - PACK MERGE (fricmat_mult_): VARS(11) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (fricmat_mult_): VARS(9), PACKS (9) - -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 stochfric.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o kinetic_lesyng.o kinetic_lesyng.f -ifort -c -O3 -ipo -opt_report -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 MD_A-MTS.F - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (md_): VARS(24), PACKS (24) - - -<;-1:-1;IPO PACK MERGE;velverlet_step_;0> - PACK MERGE (velverlet_step_): VARS(17) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (velverlet_step_): VARS(28), PACKS (28) - - -<;-1:-1;IPO PACK MERGE;respa_step_;0> - PACK MERGE (respa_step_): VARS(47) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (respa_step_): VARS(48), PACKS (48) - - -<;-1:-1;IPO PACK MERGE;respa_vel_;0> - PACK MERGE (respa_vel_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (respa_vel_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;verlet1_;0> - PACK MERGE (verlet1_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (verlet1_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;verlet2_;0> - PACK MERGE (verlet2_): VARS(8) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (verlet2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;sddir_precalc_;0> - PACK MERGE (sddir_precalc_): VARS(1) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sddir_precalc_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;sddir_verlet1_;0> - PACK MERGE (sddir_verlet1_): VARS(13) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sddir_verlet1_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;sddir_verlet2_;0> - PACK MERGE (sddir_verlet2_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (sddir_verlet2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;max_accel_;0> - PACK MERGE (max_accel_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (max_accel_): VARS(6), PACKS (6) - - -<;-1:-1;IPO PACK MERGE;predict_edrift_;0> - PACK MERGE (predict_edrift_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (predict_edrift_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;verlet_bath_;0> - PACK MERGE (verlet_bath_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (verlet_bath_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;init_md_;0> - PACK MERGE (init_md_): VARS(44) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (init_md_): VARS(70), PACKS (70) - - -<;-1:-1;IPO PACK MERGE;random_vel_;0> - PACK MERGE (random_vel_): VARS(10) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (random_vel_): VARS(5), PACKS (5) - - UNREF VAR REMOVAL ROUTINE-SYMTAB (hnose_): VARS(1), PACKS (1) - - -<;-1:-1;IPO PACK MERGE;hnose_nh_;0> - PACK MERGE (hnose_nh_): VARS(3) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (hnose_nh_): VARS(2), PACKS (2) - - -<;-1:-1;IPO PACK MERGE;nhcint_;0> - PACK MERGE (nhcint_): VARS(7) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (nhcint_): VARS(4), PACKS (4) - - -<;-1:-1;IPO PACK MERGE;tnp1_respa_i_step1_;0> - PACK MERGE (tnp1_respa_i_step1_): VARS(13) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp1_respa_i_step1_): VARS(7), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;tnp1_respa_i_step2_;0> - PACK MERGE (tnp1_respa_i_step2_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp1_respa_i_step2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp1_step1_;0> - PACK MERGE (tnp1_step1_): VARS(15) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp1_step1_): VARS(7), PACKS (7) - - -<;-1:-1;IPO PACK MERGE;tnp1_step2_;0> - PACK MERGE (tnp1_step2_): VARS(20) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp1_step2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp_respa_i_step1_;0> - PACK MERGE (tnp_respa_i_step1_): VARS(22) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_respa_i_step1_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp_respa_i_step2_;0> - PACK MERGE (tnp_respa_i_step2_): VARS(19) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_respa_i_step2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp_respa_step1_;0> - PACK MERGE (tnp_respa_step1_): VARS(12) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_respa_step1_): VARS(9), PACKS (9) - - -<;-1:-1;IPO PACK MERGE;tnp_respa_step2_;0> - PACK MERGE (tnp_respa_step2_): VARS(12) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_respa_step2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp_step1_;0> - PACK MERGE (tnp_step1_): VARS(22) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_step1_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;tnp_step2_;0> - PACK MERGE (tnp_step2_): VARS(19) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (tnp_step2_): VARS(5), PACKS (5) - - -<;-1:-1;IPO PACK MERGE;hmc_test_;0> - PACK MERGE (hmc_test_): VARS(16) - - -<;-1:-1;IPO UNREFERENCED VAR REMOVING;;0> - UNREF VAR REMOVAL ROUTINE-SYMTAB (hmc_test_): VARS(9), PACKS (9) - -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o moments.o moments.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o int_to_cart.o int_to_cart.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o surfatom.o surfatom.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o sort.o sort.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o muca_md.o muca_md.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 MREMD.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 rattle.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o gauss.o gauss.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 energy_split-sep.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 q_measure.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -c -o gnmr1.o gnmr1.f -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 test.F -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI -DSPLITELE -DLANG0 ssMD.F -cd xdrf && make -make[1]: Entering directory `/scheraga/users/adam/unres/source/lib/xdrf' -m4 underscore.m4 libxdrf.m4 > libxdrf.c -gcc -O -c libxdrf.c -rm -f libxdrf.c -gcc -O -c ftocstr.c -ar cr libxdrf.a libxdrf.o ftocstr.o -make[1]: Leaving directory `/scheraga/users/adam/unres/source/lib/xdrf' -cc -o compinfo compinfo.c -./compinfo | true -ifort -c -O3 -ip -I/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/include cinfo.f -ifort -O3 -ip unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o matmult.o readrtns.o parmread.o gen_rand_conf.o printmat.o map.o pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o eigen.o blas.o add.o entmcm.o minim_mcmf.o MP.o compare_s1.o prng.o banach.o rmsd.o elecont.o dihed_cons.o sc_move.o local_move.o intcartderiv.o lagrangian_lesyng.o stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o q_measure.o gnmr1.o test.o ssMD.o cinfo.o -L/users/software/mpich-1.2.7p1_intel-10.1_em64_ssh/lib -lmpich xdrf/libxdrf.a -o ../../../bin/unres/MD/unres_ifort_MPICH_E0LL2Y-restr.exe -ipo: remark #11000: performing multi-file optimizations -ipo: remark #11005: generating object file /tmp/ipo_ifortPw54uW.o diff --git a/source/unres/src_MD-restraints/map.f b/source/unres/src_MD-restraints/map.f deleted file mode 100644 index 9dbe64e..0000000 --- a/source/unres/src_MD-restraints/map.f +++ /dev/null @@ -1,90 +0,0 @@ - subroutine map - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.TORCNSTR' - double precision energia(0:n_ene) - character*5 angid(4) /'PHI','THETA','ALPHA','OMEGA'/ - double precision ang_list(10) - double precision g(maxvar),x(maxvar) - integer nn(10) - write (iout,'(a,i3,a)')'Energy map constructed in the following ', - & nmap,' groups of variables:' - do i=1,nmap - write (iout,'(2a,i3,a,i3)') angid(kang(i)),' of residues ', - & res1(i),' to ',res2(i) - enddo - nmax=nstep(1) - do i=2,nmap - if (nmax.lt.nstep(i)) nmax=nstep(i) - enddo - ntot=nmax**nmap - iii=0 - write (istat,'(1h#,a14,29a15)') (" ",k=1,nmap), - & (ename(print_order(k)),k=1,nprint_ene),"ETOT","GNORM" - do i=0,ntot-1 - ii=i - do j=1,nmap - nn(j)=mod(ii,nmax)+1 - ii=ii/nmax - enddo - do j=1,nmap - if (nn(j).gt.nstep(j)) goto 10 - enddo - iii=iii+1 -Cd write (iout,*) i,iii,(nn(j),j=1,nmap) - do j=1,nmap - ang_list(j)=ang_from(j) - & +(nn(j)-1)*(ang_to(j)-ang_from(j))/nstep(j) - do k=res1(j),res2(j) - goto (1,2,3,4), kang(j) - 1 phi(k)=deg2rad*ang_list(j) - if (minim) phi0(k-res1(j)+1)=deg2rad*ang_list(j) - goto 5 - 2 theta(k)=deg2rad*ang_list(j) - goto 5 - 3 alph(k)=deg2rad*ang_list(j) - goto 5 - 4 omeg(k)=deg2rad*ang_list(j) - 5 continue - enddo ! k - enddo ! j - call chainbuild - call int_from_cart1(.false.) - if (minim) then - call geom_to_var(nvar,x) - call minimize(etot,x,iretcode,nfun) - print *,'SUMSL return code is',iretcode,' eval ',nfun -c call intout - else - call zerograd - call geom_to_var(nvar,x) - endif - call etotal(energia(0)) - etot = energia(0) - nf=1 - nfl=3 - call gradient(nvar,x,nf,g,uiparm,urparm,fdum) - gnorm=0.0d0 - do k=1,nvar - gnorm=gnorm+g(k)**2 - enddo - etot=energia(0) - - gnorm=dsqrt(gnorm) -c write (iout,'(6(1pe15.5))') (ang_list(k),k=1,nmap),etot,gnorm - write (istat,'(30e15.5)') (ang_list(k),k=1,nmap), - & (energia(print_order(ii)),ii=1,nprint_ene),etot,gnorm -c write (iout,*) 'POINT',I,' ANGLES:',(ang_list(k),k=1,nmap) -c call intout -c call enerprint(energia) - 10 continue - enddo ! i - return - end diff --git a/source/unres/src_MD-restraints/matmult.f b/source/unres/src_MD-restraints/matmult.f deleted file mode 100644 index e9257cf..0000000 --- a/source/unres/src_MD-restraints/matmult.f +++ /dev/null @@ -1,18 +0,0 @@ - SUBROUTINE MATMULT(A1,A2,A3) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - DIMENSION A1(3,3),A2(3,3),A3(3,3) - DIMENSION AI3(3,3) - DO 1 I=1,3 - DO 2 J=1,3 - A3IJ=0.0 - DO 3 K=1,3 - 3 A3IJ=A3IJ+A1(I,K)*A2(K,J) - AI3(I,J)=A3IJ - 2 CONTINUE - 1 CONTINUE - DO 4 I=1,3 - DO 4 J=1,3 - 4 A3(I,J)=AI3(I,J) - RETURN - END diff --git a/source/unres/src_MD-restraints/mc.F b/source/unres/src_MD-restraints/mc.F deleted file mode 100644 index 0f39d48..0000000 --- a/source/unres/src_MD-restraints/mc.F +++ /dev/null @@ -1,819 +0,0 @@ - subroutine monte_carlo -C Does Boltzmann and entropic sampling without energy minimization - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.THREAD' - include 'COMMON.NAMES' - logical accepted,not_done,over,ovrtim,error,lprint - integer MoveType,nbond,nbins - integer conf_comp - double precision RandOrPert - double precision varia(maxvar),elowest,elowest1, - & ehighest,ehighest1,eold - double precision przes(3),obr(3,3) - double precision varold(maxvar) - logical non_conv - integer moves1(-1:MaxMoveType+1,0:MaxProcs-1), - & moves_acc1(-1:MaxMoveType+1,0:MaxProcs-1) -#ifdef MPL - double precision etot_temp,etot_all(0:MaxProcs) - external d_vadd,d_vmin,d_vmax - double precision entropy1(-max_ene:max_ene), - & nhist1(-max_ene:max_ene) - integer nbond_move1(maxres*(MaxProcs+1)), - & nbond_acc1(maxres*(MaxProcs+1)),itemp(2) -#endif - double precision var_lowest(maxvar) - double precision energia(0:n_ene),energia_ave(0:n_ene) -C - write(iout,'(a,i8,2x,a,f10.5)') - & 'pool_read_freq=',pool_read_freq,' pool_fraction=',pool_fraction - open (istat,file=statname) - WhatsUp=0 - indminn=-max_ene - indmaxx=max_ene - facee=1.0D0/(maxacc*delte) -C Number of bins in energy histogram - nbins=e_up/delte-1 - write (iout,*) 'NBINS=',nbins - conste=dlog(facee) -C Read entropy from previous simulations. - if (ent_read) then - read (ientin,*) indminn,indmaxx,emin,emax - print *,'indminn=',indminn,' indmaxx=',indmaxx,' emin=',emin, - & ' emax=',emax - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - read (ientin,*) (ijunk,ejunk,entropy(i),i=indminn,indmaxx) - indmin=indminn - indmax=indmaxx - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - endif ! ent_read -C Read the pool of conformations - call read_pool - elowest=1.0D+10 - ehighest=-1.0D+10 -C---------------------------------------------------------------------------- -C Entropy-sampling simulations with continually updated entropy; -C set NSWEEP=1 for Boltzmann sampling. -C Loop thru simulations -C---------------------------------------------------------------------------- - DO ISWEEP=1,NSWEEP -C -C Initialize the IFINISH array. -C -#ifdef MPL - do i=1,nctasks - ifinish(i)=0 - enddo -#endif -c--------------------------------------------------------------------------- -C Initialize counters. -c--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - do i=1,nres - nbond_move(i)=0 - nbond_acc(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=-1,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 -C---------------------------------------------------------------------------- -C Take a conformation from the pool -C---------------------------------------------------------------------------- - rewind(istat) - write (iout,*) 'emin=',emin,' emax=',emax - if (npool.gt.0) then - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - write (iout,*) 'Took conformation',ii,' from the pool energy=', - & epool(ii) - call var_to_geom(nvar,varia) -C Print internal coordinates of the initial conformation - call intout - else if (isweep.gt.1) then - if (eold.lt.emax) then - do i=1,nvar - varia(i)=varold(i) - enddo - else - do i=1,nvar - varia(i)=var_lowest(i) - enddo - endif - call var_to_geom(nvar,varia) - endif -C---------------------------------------------------------------------------- -C Compute and print initial energies. -C---------------------------------------------------------------------------- - nsave=0 - Kwita=0 - WhatsUp=0 - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') 'MCE iteration #',isweep - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - call geom_to_var(nvar,varia) - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - write (istat,'(i10,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - write (istat,'(i10,14(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif -c close(istat) - neneval=neneval+1 - if (.not. ent_read) then -C Initialize the entropy array -#ifdef MPL -C Collect total energies from other processors. - etot_temp=etot - etot_all(0)=etot - call mp_gather(etot_temp,etot_all,8,MasterID,cgGroupID) - if (MyID.eq.MasterID) then -C Get the lowest and the highest energy. - print *,'MASTER: etot_temp: ',(etot_all(i),i=0,nprocs-1), - & ' emin=',emin,' emax=',emax - emin=1.0D10 - emax=-1.0D10 - do i=0,nprocs - if (emin.gt.etot_all(i)) emin=etot_all(i) - if (emax.lt.etot_all(i)) emax=etot_all(i) - enddo - emax=emin+e_up - endif ! MyID.eq.MasterID - etot_all(1)=emin - etot_all(2)=emax - print *,'Processor',MyID,' calls MP_BCAST to send/recv etot_all' - call mp_bcast(etot_all(1),16,MasterID,cgGroupID) - print *,'Processor',MyID,' MP_BCAST to send/recv etot_all ended' - if (MyID.ne.MasterID) then - print *,'Processor:',MyID,etot_all(1),etot_all(2), - & etot_all(1),etot_all(2) - emin=etot_all(1) - emax=etot_all(2) - endif ! MyID.ne.MasterID - write (iout,*) 'After MP_GATHER etot_temp=', - & etot_temp,' emin=',emin -#else - emin=etot - emax=emin+e_up - indminn=0 - indmin=0 -#endif - IF (MULTICAN) THEN -C Multicanonical sampling - start from Boltzmann distribution - do i=-max_ene,max_ene - entropy(i)=(emin+i*delte)*betbol - enddo - ELSE -C Entropic sampling - start from uniform distribution of the density of states - do i=-max_ene,max_ene - entropy(i)=0.0D0 - enddo - ENDIF ! MULTICAN - write (iout,'(/a)') 'Initial entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - if (isweep.eq.1) then - emax=emin+e_up - indminn=0 - indmin=0 - indmaxx=indminn+nbins - indmax=indmaxx - endif ! isweep.eq.1 - endif ! .not. ent_read -#ifdef MPL - call recv_stop_sig(Kwita) - if (whatsup.eq.1) then - call send_stop_sig(-2) - not_done=.false. - else if (whatsup.le.-2) then - not_done=.false. - else if (whatsup.eq.2) then - not_done=.false. - else - not_done=.true. - endif -#else - not_done=.true. -#endif - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - close(igeom) - call briefout(0,etot) - do i=1,nvar - varold(i)=varia(i) - enddo - eold=etot - call entropia(eold,sold,indeold) -C NACC is the counter for the accepted conformations of a given processor - nacc=0 -C NACC_TOT counts the total number of accepted conformations - nacc_tot=0 -C Main loop. -c---------------------------------------------------------------------------- -C Zero out average energies - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo -C Initialize energy histogram - do i=-max_ene,max_ene - nhist(i)=0.0D0 - enddo ! i -C Zero out iteration counter. - it=0 - do j=1,nvar - varold(j)=varia(j) - enddo -C Begin MC iteration loop. - do while (not_done) - it=it+1 -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - do while (.not. accepted .and. WhatsUp.eq.0 .and. Kwita.eq.0) - ntrial=ntrial+1 -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild - MoveType=0 - nbond=0 - lprint=.true. -C Decide whether to take a conformation from the pool or generate/perturb one -C randomly - from_pool=ran_number(0.0D0,1.0D0) - if (npool.gt.0 .and. from_pool.lt.pool_fraction) then -C Throw a dice to choose the conformation from the pool - ii=iran_num(1,npool) - do i=1,nvar - varia(i)=xpool(i,ii) - enddo - call var_to_geom(nvar,varia) - call chainbuild -cd call intout -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i3,a,f10.5)') - & 'Try conformation',ii,' from the pool energy=',epool(ii) - MoveType=-1 - moves(-1)=moves(-1)+1 - else -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,0.1D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - endif ! pool -Cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (*,'(a,i5,a,i10,a,i10)') - & 'Processor',MyId,' trial move',ntrial,' total generated:',ngen - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+1 -cd call enerprint(energia(0)) -cd write(iout,*)'it=',it,' etot=',etot - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a,i5,a,1pe14.5)') 'Iteration',it, - & ' Overlap detected in the current conf.; energy is',etot - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else -C-------------------------------------------------------------------------- -C... Acceptance test -C-------------------------------------------------------------------------- - accepted=.false. - if (WhatsUp.eq.0) - & call accept_mc(it,etot,eold,scur,sold,varia,varold,accepted) - if (accepted) then - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) then - elowest=etot - do i=1,nvar - var_lowest(i)=varia(i) - enddo - endif - if (ehighest.lt.etot) ehighest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Compare with reference structure. - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - endif ! refstr -C -C Periodically save average energies and confs. -C - do i=0,n_ene - energia_ave(i)=energia_ave(i)+energia(i) - enddo - moves(MaxMoveType+1)=nmove - moves_acc(MaxMoveType+1)=nacc - IF ((it/save_frequency)*save_frequency.eq.it) THEN - do i=0,n_ene - energia_ave(i)=energia_ave(i)/save_frequency - enddo - etot_ave=energia_ave(0) -C#ifdef AIX -C open (istat,file=statname,position='append') -C#else -C open (istat,file=statname,access='append') -Cendif - if (print_mc.gt.0) - & write (iout,'(80(1h*)/20x,a,i20)') - & 'Iteration #',it - if (refstr .and. print_mc.gt.0) then - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif - if (print_stat) then - if (refstr) then - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave,rms_ave,frac_ave - else - write (istat,'(i10,10(1pe14.5))') it, - & (energia_ave(print_order(i)),i=1,nprint_ene), - & etot_ave - endif - endif -c close(istat) - if (print_mc.gt.0) - & call statprint(nacc,nfun,iretcode,etot,elowest) -C Print internal coordinates. - if (print_int) call briefout(nacc,etot) - do i=0,n_ene - energia_ave(i)=0.0d0 - enddo - ENDIF ! ( (it/save_frequency)*save_frequency.eq.it) -C Update histogram - inde=icialosc((etot-emin)/delte) - nhist(inde)=nhist(inde)+1.0D0 -#ifdef MPL - if ( (it/message_frequency)*message_frequency.eq.it - & .and. (MyID.ne.MasterID) ) then - call recv_stop_sig(Kwita) - call send_MCM_info(message_frequency) - endif -#endif -C Store the accepted conf. and its energy. - eold=etot - sold=scur - do i=1,nvar - varold(i)=varia(i) - enddo -#ifdef MPL - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - endif ! accepted - endif ! overlap -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - if (nacc_tot.ge.maxacc) accepted=.true. - endif -#endif -C if ((ntrial.gt.maxtrial_iter -C & .or. (it/pool_read_freq)*pool_read_freq.eq.it) -C & .and. npool.gt.0) then -C Take a conformation from the pool -C ii=iran_num(1,npool) -C do i=1,nvar -C varold(i)=xpool(i,ii) -C enddo -C if (ntrial.gt.maxtrial_iter) -C & write (iout,*) 'Iteration',it,' max. # of trials exceeded.' -C write (iout,*) -C & 'Take conformation',ii,' from the pool energy=',epool(ii) -C if (print_mc.gt.2) -C & write (iout,'(10f8.3)') (rad2deg*varold(i),i=1,nvar) -C ntrial=0 -C eold=epool(ii) -C call entropia(eold,sold,indeold) -C accepted=.true. -C endif ! (ntrial.gt.maxtrial_iter .and. npool.gt.0) - 30 continue - enddo ! accepted -#ifdef MPL - if (MyID.eq.MasterID .and. - & (it/message_frequency)*message_frequency.eq.it) then - call receive_MC_info - endif - if (Kwita.eq.0) call recv_stop_sig(kwita) -#endif - if (ovrtim()) WhatsUp=-1 -cd write (iout,*) 'WhatsUp=',WhatsUp,' Kwita=',Kwita - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) -cd write (iout,*) 'not_done=',not_done -#ifdef MPL - if (Kwita.lt.0) then - print *,'Processor',MyID, - & ' has received STOP signal =',Kwita,' in EntSamp.' -cd print *,'not_done=',not_done - if (Kwita.lt.-1) WhatsUp=Kwita - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (nacc_tot.ge.maxacc) then - print *,'Processor',MyID,' calls send_stop_sig,', - & ' because a sufficient # of confs. have been collected.' -cd print *,'not_done=',not_done - call send_stop_sig(-1) - if (MyID.ne.MasterID) call send_MCM_info(-1) - else if (WhatsUp.eq.-1) then - print *,'Processor',MyID, - & ' calls send_stop_sig because of timeout.' -cd print *,'not_done=',not_done - call send_stop_sig(-2) - if (MyID.ne.MasterID) call send_MCM_info(-1) - endif -#endif - enddo ! not_done - -C----------------------------------------------------------------- -C... Construct energy histogram & update entropy -C----------------------------------------------------------------- - go to 21 - 20 WhatsUp=-3 -#ifdef MPL - write (iout,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - write (*,*) 'Processor',MyID, - & ' is broadcasting ERROR-STOP signal.' - call send_stop_sig(-3) - if (MyID.ne.MasterID) call send_MCM_info(-1) -#endif - 21 continue - write (iout,'(/a)') 'Energy histogram' - do i=-100,100 - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo -#ifdef MPL -C Wait until every processor has sent complete MC info. - if (MyID.eq.MasterID) then - not_done=.true. - do while (not_done) -C write (*,*) 'The IFINISH array:' -C write (*,*) (ifinish(i),i=1,nctasks) - not_done=.false. - do i=2,nctasks - not_done=not_done.or.(ifinish(i).ge.0) - enddo - if (not_done) call receive_MC_info - enddo - endif -C Make collective histogram from the work of all processors. - msglen=(2*max_ene+1)*8 - print *, - & 'Processor',MyID,' calls MP_REDUCE to send/receive histograms', - & ' msglen=',msglen - call mp_reduce(nhist,nhist1,msglen,MasterID,d_vadd, - & cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for histogr.' - do i=-max_ene,max_ene - nhist(i)=nhist1(i) - enddo -C Collect min. and max. energy - print *, - &'Processor',MyID,' calls MP_REDUCE to send/receive energy borders' - call mp_reduce(elowest,elowest1,8,MasterID,d_vmin,cgGroupID) - call mp_reduce(ehighest,ehighest1,8,MasterID,d_vmax,cgGroupID) - print *,'Processor',MyID,' MP_REDUCE accomplished for energies.' - IF (MyID.eq.MasterID) THEN - elowest=elowest1 - ehighest=ehighest1 -#endif - write (iout,'(a,i10)') '# of accepted confs:',nacc_tot - write (iout,'(a,f10.5,a,f10.5)') 'Lowest energy:',elowest, - & ' Highest energy',ehighest - indmin=icialosc((elowest-emin)/delte) - imdmax=icialosc((ehighest-emin)/delte) - if (indmin.lt.indminn) then - emax=emin+indmin*delte+e_up - indmaxx=indmin+nbins - indminn=indmin - endif - if (.not.ent_read) ent_read=.true. - write(iout,*)'indminn=',indminn,' indmaxx=',indmaxx -C Update entropy (density of states) - do i=indmin,indmax - if (nhist(i).gt.0) then - entropy(i)=entropy(i)+dlog(nhist(i)+0.0D0) - endif - enddo - write (iout,'(/80(1h*)/a,i2/80(1h*)/)') - & 'End of macroiteration',isweep - write (iout,'(a,f10.5,a,f10.5)') 'Elowest=',elowest, - & ' Ehighest=',ehighest - write (iout,'(/a)') 'Energy histogram' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,nhist(i) - enddo - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f20.5)') i,emin+i*delte,entropy(i) - enddo -C----------------------------------------------------------------- -C... End of energy histogram construction -C----------------------------------------------------------------- -#ifdef MPL - ELSE - if (.not. ent_read) ent_read=.true. - ENDIF ! MyID .eq. MaterID - if (MyID.eq.MasterID) then - itemp(1)=indminn - itemp(2)=indmaxx - endif - print *,'before mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - call mp_bcast(itemp(1),8,MasterID,cgGroupID) - call mp_bcast(emax,8,MasterID,cgGroupID) - print *,'after mp_bcast processor',MyID,' indminn=',indminn, - & ' indmaxx=',indmaxx,' itemp=',itemp(1),itemp(2) - if (MyID .ne. MasterID) then - indminn=itemp(1) - indmaxx=itemp(2) - endif - msglen=(indmaxx-indminn+1)*8 - print *,'processor',MyID,' calling mp_bcast msglen=',msglen, - & ' indminn=',indminn,' indmaxx=',indmaxx,' isweep=',isweep - call mp_bcast(entropy(indminn),msglen,MasterID,cgGroupID) - IF(MyID.eq.MasterID .and. .not. ovrtim() .and. WhatsUp.ge.0)THEN - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) - ELSE - write (iout,*) 'Received from master:' - write (iout,*) 'indminn=',indminn,' indmaxx=',indmaxx, - & ' emin=',emin,' emax=',emax - write (iout,'(/a)') 'Entropy' - do i=indminn,indmaxx - write (iout,'(i5,2f10.5)') i,emin+i*delte,entropy(i) - enddo - ENDIF ! MyID.eq.MasterID - print *,'Processor',MyID,' calls MP_GATHER' - call mp_gather(nbond_move,nbond_move1,4*Nbm,MasterID, - & cgGroupID) - call mp_gather(nbond_acc,nbond_acc1,4*Nbm,MasterID, - & cgGroupID) - print *,'Processor',MyID,' MP_GATHER call accomplished' - if (MyID.eq.MasterID) then - - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - - write (iout,'(a)') - & 'Statistics of multi-bond moves of respective processors:' - do iproc=1,Nprocs-1 - do i=1,Nbm - ind=iproc*nbm+i - nbond_move(i)=nbond_move(i)+nbond_move1(ind) - nbond_acc(i)=nbond_acc(i)+nbond_acc1(ind) - enddo - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' nbond_move:', - & (nbond_move1(iproc*nbm+i),i=1,Nbm), - & ' nbond_acc:',(nbond_acc1(iproc*nbm+i),i=1,Nbm) - enddo - endif - call mp_gather(moves,moves1,4*(MaxMoveType+3),MasterID, - & cgGroupID) - call mp_gather(moves_acc,moves_acc1,4*(MaxMoveType+3), - & MasterID,cgGroupID) - if (MyID.eq.MasterID) then - do iproc=1,Nprocs-1 - do i=-1,MaxMoveType+1 - moves(i)=moves(i)+moves1(i,iproc) - moves_acc(i)=moves_acc(i)+moves_acc1(i,iproc) - enddo - enddo - nmove=0 - do i=0,MaxMoveType+1 - nmove=nmove+moves(i) - enddo - do iproc=0,NProcs-1 - write (iout,*) 'Processor',iproc,' moves', - & (moves1(i,iproc),i=0,MaxMoveType+1), - & ' moves_acc:',(moves_acc1(i,iproc),i=0,MaxMoveType+1) - enddo - endif -#else - open (ientout,file=entname,status='unknown') - write (ientout,'(2i5,2e25.17)') indminn,indmaxx,emin,emax - do i=indminn,indmaxx - write (ientout,'(i5,f10.5,f20.15)') i,emin+i*delte,entropy(i) - enddo - close(ientout) -#endif - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc_tot,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(8i10)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(8i10)') (nbond_acc(i),i=1,Nbm) - if (ovrtim() .or. WhatsUp.lt.0) return - -C--------------------------------------------------------------------------- - ENDDO ! ISWEEP -C--------------------------------------------------------------------------- - - runtime=tcpu() - - if (isweep.eq.nsweep .and. it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - return - end -c------------------------------------------------------------------------------ - subroutine accept_mc(it,ecur,eold,scur,sold,x,xold,accepted) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' -#ifdef MPL - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - double precision ecur,eold,xx,ran_number,bol - double precision x(maxvar),xold(maxvar) - logical accepted -C Check if the conformation is similar. -cd write (iout,*) 'Enter ACCEPTING' -cd write (iout,*) 'Old PHI angles:' -cd write (iout,*) (rad2deg*xold(i),i=1,nphi) -cd write (iout,*) 'Current angles' -cd write (iout,*) (rad2deg*x(i),i=1,nphi) -cd ddif=dif_ang(nphi,x,xold) -cd write (iout,*) 'Angle norm:',ddif -cd write (iout,*) 'ecur=',ecur,' emax=',emax - if (ecur.gt.emax) then - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected as too high in energy' - return - endif -C Else evaluate the entropy of the conf and compare it with that of the previous -C one. - call entropia(ecur,scur,indecur) -cd print *,'Processor',MyID,' ecur=',ecur,' indecur=',indecur, -cd & ' scur=',scur,' eold=',eold,' sold=',sold -cd print *,'deix=',deix,' dent=',dent,' delte=',delte - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) then - write(iout,*)'it=',it,'ecur=',ecur,' indecur=',indecur, - & ' scur=',scur - write(iout,*)'eold=',eold,' sold=',sold - endif - if (scur.le.sold) then - accepted=.true. - else -C Else carry out acceptance test - xx=ran_number(0.0D0,1.0D0) - xxh=scur-sold - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (bol.gt.xx) then - accepted=.true. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation accepted.' - else - accepted=.false. - if (print_mc.gt.0 .and. (it/print_freq)*print_freq.eq.it) - & write (iout,'(a)') 'Conformation rejected.' - endif - endif - return - end -c-------------------------------------------------------------------------- - integer function icialosc(x) - double precision x - if (x.lt.0.0D0) then - icialosc=dint(x)-1 - else - icialosc=dint(x) - endif - return - end -c-------------------------------------------------------------------------- - subroutine entropia(ecur,scur,indecur) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - double precision ecur,scur - integer indecur - indecur=icialosc((ecur-emin)/delte) - if (iabs(indecur).gt.max_ene) then - if ((it/print_freq)*it.eq.it) write (iout,'(a,2i5)') - & 'Accepting: Index out of range:',indecur - scur=1000.0D0 - else if (indecur.ge.indmaxx) then - scur=entropy(indecur) - if (print_mc.gt.0 .and. (it/print_freq)*it.eq.it) - & write (iout,*)'Energy boundary reached', - & indmaxx,indecur,entropy(indecur) - else - deix=ecur-(emin+indecur*delte) - dent=entropy(indecur+1)-entropy(indecur) - scur=entropy(indecur)+(dent/delte)*deix - endif - return - end diff --git a/source/unres/src_MD-restraints/mcm.F b/source/unres/src_MD-restraints/mcm.F deleted file mode 100644 index d9ca9ad..0000000 --- a/source/unres/src_MD-restraints/mcm.F +++ /dev/null @@ -1,1481 +0,0 @@ - subroutine mcm_setup - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.MCM' - include 'COMMON.CONTROL' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.VAR' -C -C Set up variables used in MC/MCM. -C - write (iout,'(80(1h*)/20x,a/80(1h*))') 'MCM control parameters:' - write (iout,'(5(a,i7))') 'Maxacc:',maxacc,' MaxTrial:',MaxTrial, - & ' MaxRepm:',MaxRepm,' MaxGen:',MaxGen,' MaxOverlap:',MaxOverlap - write (iout,'(4(a,f8.1)/2(a,i3))') - & 'Tmin:',Tmin,' Tmax:',Tmax,' TstepH:',TstepH, - & ' TstepC:',TstepC,'NstepH:',NstepH,' NstepC:',NstepC - if (nwindow.gt.0) then - write (iout,'(a)') 'Perturbation windows:' - do i=1,nwindow - i1=winstart(i) - i2=winend(i) - it1=itype(i1) - it2=itype(i2) - write (iout,'(a,i3,a,i3,a,i3)') restyp(it1),i1,restyp(it2),i2, - & ' length',winlen(i) - enddo - endif -C Rbolt=8.3143D-3*2.388459D-01 kcal/(mol*K) - RBol=1.9858D-3 -C Number of "end bonds". - koniecl=0 -c koniecl=nphi - print *,'koniecl=',koniecl - write (iout,'(a)') 'Probabilities of move types:' - write (*,'(a)') 'Probabilities of move types:' - do i=1,MaxMoveType - write (iout,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - write (*,'(a,f10.5)') MovTypID(i), - & sumpro_type(i)-sumpro_type(i-1) - enddo - write (iout,*) -C Maximum length of N-bond segment to be moved -c nbm=nres-1-(2*koniecl-1) - if (nwindow.gt.0) then - maxwinlen=winlen(1) - do i=2,nwindow - if (winlen(i).gt.maxwinlen) maxwinlen=winlen(i) - enddo - nbm=min0(maxwinlen,6) - write (iout,'(a,i3,a,i3)') 'Nbm=',Nbm,' Maxwinlen=',Maxwinlen - else - nbm=min0(6,nres-2) - endif - sumpro_bond(0)=0.0D0 - sumpro_bond(1)=0.0D0 - do i=2,nbm - sumpro_bond(i)=sumpro_bond(i-1)+1.0D0/dfloat(i) - enddo - write (iout,'(a)') 'The SumPro_Bond array:' - write (iout,'(8f10.5)') (sumpro_bond(i),i=1,nbm) - write (*,'(a)') 'The SumPro_Bond array:' - write (*,'(8f10.5)') (sumpro_bond(i),i=1,nbm) -C Maximum number of side chains moved simultaneously -c print *,'nnt=',nnt,' nct=',nct - ngly=0 - do i=nnt,nct - if (itype(i).eq.10) ngly=ngly+1 - enddo - mmm=nct-nnt-ngly+1 - if (mmm.gt.0) then - MaxSideMove=min0((nct-nnt+1)/2,mmm) - endif -c print *,'MaxSideMove=',MaxSideMove -C Max. number of generated confs (not used at present). - maxgen=10000 -C Set initial temperature - Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - write (iout,'(a,f8.1,a,f10.5)') 'Initial temperature:',Tcur, - & ' BetBol:',betbol - write (iout,*) 'RanFract=',ranfract - return - end -c------------------------------------------------------------------------------ -#ifndef MPI - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - serial code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,my_conf, - & enelower,non_conv - integer MoveType,nbond,conf_comp - integer ifeed(max_cache) - double precision varia(maxvar),varold(maxvar),elowest,eold, - & przes(3),obr(3,3) - double precision energia(0:n_ene) - double precision coord1(maxres,3) - -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won't be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 - - write (iout,*) 'RanFract=',RanFract - - WhatsUp=0 - Kwita=0 - -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - - call etotal(energia(0)) - etot = energia(0) -C Minimize the energy of the first conformation. - if (minim) then - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - endif - if (refstr) then - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, - & obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,co - else - if (print_stat) write (istat,'(i5,16(1pe14.5))') 0, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif - if (print_stat) close(istat) - neneval=neneval+nfun+1 - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_int) then - close(igeom) - call briefout(0,etot) - endif - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - - not_done = (iretcode.ne.11) - -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - do while (not_done) - it=it+1 - write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - accepted=.false. - do while (.not. accepted) - -C Retrieve the angles of previously accepted conformation - noverlap=0 ! # of overlapping confs. - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) goto 20 - MoveType=0 - nbond=0 - lprint=.true. -cd write (iout,'(a)') 'Old variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) - if (error) goto 20 - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - goto 20 - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) -cd write (iout,'(a)') 'New variables:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - ngen=ngen+1 - - call etotal(energia(0)) - etot=energia(0) -c call enerprint(energia(0)) -c write (iout,'(2(a,1pe14.5))') 'Etot=',Etot,' Elowest=',Elowest - if (etot-elowest.gt.overlap_cut) then - if(iprint.gt.1.or.etot.lt.1d20) - & write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,'(a)') 'Too many overlapping confs.' - goto 20 - endif - else - if (minim) then - call minimize(etot,varia,iretcode,nfun) -cd write (iout,*) 'etot from MINIMIZE:',etot -cd write (iout,'(a)') 'Variables after minimization:' -cd write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) - - call etotal(energia(0)) - etot = energia(0) - neneval=neneval+nfun+2 - endif -c call enerprint(energia(0)) - write (iout,'(a,i6,a,1pe16.6)') 'Conformation:',ngen, - & ' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - accepted=.false. - my_conf=.false. - - if (WhatsUp.eq.0 .and. Kwita.eq.0) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & my_conf,EneLower) - endif - write (iout,*) 'My_Conf=',My_Conf,' EneLower=',EneLower - if (accepted) then - - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (print_stat) then -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - endif - call statprint(nacc,nfun,iretcode,etot,elowest) - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order',co - endif ! refstr - if (My_Conf) then - nout=nout+1 - write (iout,*) 'Writing new conformation',nout - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - if (print_stat) - & write (istat,'(i5,17(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - if (print_stat) close(istat) -C Print internal coordinates. - if (print_int) call briefout(nout,etot) -C Accumulate the newly accepted conf in the coord1 array, if it is different -C from all confs that are already there. - call compare_s1(n_thr,max_thread2,etot,varia,ii, - & enetb1,coord1,rms_deform,.true.,iprint) - write (iout,*) 'After compare_ss: n_thr=',n_thr - if (ii.eq.1 .or. ii.eq.3) then - write (iout,'(8f10.4)') - & (rad2deg*coord1(i,n_thr),i=1,nvar) - endif - else - write (iout,*) 'Conformation from cache, not written.' - endif ! My_Conf - - if (nrepm.gt.maxrepm) then - write (iout,'(a)') 'Too many conformation repetitions.' - goto 20 - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - - else - - ntrial=ntrial+1 - endif ! accepted - endif ! overlap - - 30 continue - enddo ! accepted -C Check for time limit. - if (ovrtim()) WhatsUp=-1 - not_done = (nacc_tot.lt.maxacc) .and. (WhatsUp.eq.0) - & .and. (Kwita.eq.0) - - enddo ! not_done - goto 21 - 20 WhatsUp=-3 - - 21 continue - runtime=tcpu() - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - - return - end -#endif -#ifdef MPI -c------------------------------------------------------------------------------ - subroutine do_mcm(i_orig) -C Monte-Carlo-with-Minimization calculations - parallel code. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.MCM' - include 'COMMON.CONTACTS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.INFO' - include 'COMMON.CACHE' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.MINIM' - include 'COMMON.NAMES' - logical accepted,over,ovrtim,error,lprint,not_done,similar, - & enelower,non_conv,flag,finish - integer MoveType,nbond,conf_comp - double precision varia(maxvar),varold(maxvar),elowest,eold, - & x1(maxvar), varold1(maxvar), przes(3),obr(3,3) - integer iparentx(max_threadss2) - integer iparentx1(max_threadss2) - integer imtasks(150),imtasks_n - double precision energia(0:n_ene) - - print *,'Master entered DO_MCM' - nodenum = nprocs - - finish=.false. - imtasks_n=0 - do i=1,nodenum-1 - imtasks(i)=0 - enddo -C--------------------------------------------------------------------------- -C Initialize counters. -C--------------------------------------------------------------------------- -C Total number of generated confs. - ngen=0 -C Total number of moves. In general this won`t be equal to the number of -C attempted moves, because we may want to reject some "bad" confs just by -C overlap check. - nmove=0 -C Total number of temperature jumps. - ntherm=0 -C Total number of shift (nbond_move(1)), spike, crankshaft, three-bond,... -C motions. - ncache=0 - do i=1,nres - nbond_move(i)=0 - enddo -C Initialize total and accepted number of moves of various kind. - do i=0,MaxMoveType - moves(i)=0 - moves_acc(i)=0 - enddo -C Total number of energy evaluations. - neneval=0 - nfun=0 - nsave=0 -c write (iout,*) 'RanFract=',RanFract - WhatsUp=0 - Kwita=0 -c---------------------------------------------------------------------------- -C Compute and print initial energies. -c---------------------------------------------------------------------------- - call intout - write (iout,'(/80(1h*)/a)') 'Initial energies:' - call chainbuild - nf=0 - call etotal(energia(0)) - etot = energia(0) - call enerprint(energia(0)) -C Request energy computation from slave processors. - call geom_to_var(nvar,varia) -! write (iout,*) 'The VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - call minimize(etot,varia,iretcode,nfun) - call var_to_geom(nvar,varia) - call chainbuild - write (iout,*) 'etot from MINIMIZE:',etot -! write (iout,*) 'Tha VARIA array' -! write (iout,'(8f10.4)') (rad2deg*varia(i),i=1,nvar) - neneval=0 - eneglobal=1.0d99 - if (print_mc .gt. 0) write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Enter Monte Carlo procedure.' - if (print_mc .gt. 0) write (iout,'(i5,1pe14.5)' ) i_orig,etot - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - elowest=etot - call zapis(varia,etot) -c diagnostics - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energia(0)) - if (print_mc.gt.0) write (iout,*) 'Initial energy:',etot -c end diagnostics - nacc=0 ! total # of accepted confs of the current processor. - nacc_tot=0 ! total # of accepted confs of all processors. - not_done=.true. -C---------------------------------------------------------------------------- -C Main loop. -c---------------------------------------------------------------------------- - it=0 - nout=0 - LOOP1:do while (not_done) - it=it+1 - if (print_mc.gt.0) write (iout,'(80(1h*)/20x,a,i7)') - & 'Beginning iteration #',it -C Initialize local counter. - ntrial=0 ! # of generated non-overlapping confs. - noverlap=0 ! # of overlapping confs. - accepted=.false. - LOOP2:do while (.not. accepted) - - LOOP3:do while (imtasks_n.lt.nodenum-1.and..not.finish) - do i=1,nodenum-1 - if(imtasks(i).eq.0) then - is=i - exit - endif - enddo -C Retrieve the angles of previously accepted conformation - do j=1,nvar - varia(j)=varold(j) - enddo - call var_to_geom(nvar,varia) -C Rebuild the chain. - call chainbuild -C Heat up the system, if necessary. - call heat(over) -C If temperature cannot be further increased, stop. - if (over) then - finish=.true. - endif - MoveType=0 - nbond=0 -c write (iout,'(a)') 'Old variables:' -c write (iout,'(10f8.1)') (rad2deg*varia(i),i=1,nvar) -C Decide whether to generate a random conformation or perturb the old one - RandOrPert=ran_number(0.0D0,1.0D0) - if (RandOrPert.gt.RanFract) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Perturbation-generated conformation.' - call perturb(error,lprint,MoveType,nbond,1.0D0) -c print *,'after perturb',error,finish - if (error) finish = .true. - if (MoveType.lt.1 .or. MoveType.gt.MaxMoveType) then - write (iout,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - finish=.true. - write (*,'(/a,i7,a/)') 'Error - unknown MoveType=', - & MoveType,' returned from PERTURB.' - endif - call chainbuild - else - MoveType=0 - moves(0)=moves(0)+1 - nstart_grow=iran_num(3,nres) - if (print_mc.gt.0) - & write (iout,'(2a,i3)') 'Random-generated conformation', - & ' - chain regrown from residue',nstart_grow - call gen_rand_conf(nstart_grow,*30) - endif - call geom_to_var(nvar,varia) - ngen=ngen+1 -c print *,'finish=',finish - if (etot-elowest.gt.overlap_cut) then - if (print_mc.gt.1) write (iout,'(a,1pe14.5)') - & 'Overlap detected in the current conf.; energy is',etot - if(iprint.gt.1.or.etot.lt.1d19) print *, - & 'Overlap detected in the current conf.; energy is',etot - neneval=neneval+1 - accepted=.false. - noverlap=noverlap+1 - if (noverlap.gt.maxoverlap) then - write (iout,*) 'Too many overlapping confs.', - & ' etot, elowest, overlap_cut', etot, elowest, overlap_cut - finish=.true. - endif - else if (.not. finish) then -C Distribute tasks to processors -c print *,'Master sending order' - call MPI_SEND(12, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) '12: tag=',tag -c print *,'Master sent order to processor',is - call MPI_SEND(it, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'it: tag=',tag - call MPI_SEND(eold, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, ierr) -c write (iout,*) 'eold: tag=',tag - call MPI_SEND(varia(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varia: tag=',tag - call MPI_SEND(varold(1), nvar, MPI_DOUBLE_PRECISION, - & is, tag, - & CG_COMM, ierr) -c write (iout,*) 'varold: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - imtasks(is)=1 - imtasks_n=imtasks_n+1 -C End distribution - endif ! overlap - enddo LOOP3 - - flag = .false. - LOOP_RECV:do while(.not.flag) - do is=1, nodenum-1 - call MPI_IPROBE(is,tag,CG_COMM,flag,status,ierr) - if(flag) then - call MPI_RECV(iitt, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(eold1, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(etot, 1, MPI_DOUBLE_PRECISION, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(varia(1), nvar, MPI_DOUBLE_PRECISION,is,tag, - & CG_COMM, status, ierr) - call MPI_RECV(varold1(1), nvar, MPI_DOUBLE_PRECISION, is, - & tag, CG_COMM, status, ierr) - call MPI_RECV(ii_grnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_ennum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - call MPI_RECV(ii_hesnum_d, 1, MPI_INTEGER, is, tag, - & CG_COMM, status, ierr) - i_grnum_d=i_grnum_d+ii_grnum_d - i_ennum_d=i_ennum_d+ii_ennum_d - neneval = neneval+ii_ennum_d - i_hesnum_d=i_hesnum_d+ii_hesnum_d - i_minimiz=i_minimiz+1 - imtasks(is)=0 - imtasks_n=imtasks_n-1 - exit - endif - enddo - enddo LOOP_RECV - - if(print_mc.gt.0) write (iout,'(a,i6,a,i6,a,i6,a,1pe16.6)') - & 'From Worker #',is,' iitt',iitt, - & ' Conformation:',ngen,' energy:',etot -C-------------------------------------------------------------------------- -C... Do Metropolis test -C-------------------------------------------------------------------------- - call metropolis(nvar,varia,varold1,etot,eold1,accepted, - & similar,EneLower) - if(iitt.ne.it.and..not.similar) then - call metropolis(nvar,varia,varold,etot,eold,accepted, - & similar,EneLower) - accepted=enelower - endif - if(etot.lt.eneglobal)eneglobal=etot -c if(mod(it,100).eq.0) - write(iout,*)'CHUJOJEB ',neneval,eneglobal - if (accepted) then -C Write the accepted conformation. - nout=nout+1 - if (refstr) then - call var_to_geom(nvar,varia) - call chainbuild - call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup), - & nsup,przes,obr,non_conv) - rms=dsqrt(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - write (iout,'(a,f8.3,a,f8.3,a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100,' contact order:',co - endif ! refstr - if (print_mc.gt.0) - & write (iout,*) 'Writing new conformation',nout - if (print_stat) then - call var_to_geom(nvar,varia) -#if defined(AIX) || defined(PGI) - open (istat,file=statname,position='append') -#else - open (istat,file=statname,access='append') -#endif - if (refstr) then - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rms,frac - else - write (istat,'(i5,16(1pe14.5))') nout, - & (energia(print_order(i)),i=1,nprint_ene),etot - endif ! refstr - close(istat) - endif ! print_stat -C Print internal coordinates. - if (print_int) call briefout(nout,etot) - nacc=nacc+1 - nacc_tot=nacc_tot+1 - if (elowest.gt.etot) elowest=etot - moves_acc(MoveType)=moves_acc(MoveType)+1 - if (MoveType.eq.1) then - nbond_acc(nbond)=nbond_acc(nbond)+1 - endif -C Check against conformation repetitions. - irepet=conf_comp(varia,etot) - if (nrepm.gt.maxrepm) then - if (print_mc.gt.0) - & write (iout,'(a)') 'Too many conformation repetitions.' - finish=.true. - endif -C Store the accepted conf. and its energy. - eold=etot - do i=1,nvar - varold(i)=varia(i) - enddo - if (irepet.eq.0) call zapis(varia,etot) -C Lower the temperature, if necessary. - call cool - else - ntrial=ntrial+1 - endif ! accepted - 30 continue - if(finish.and.imtasks_n.eq.0)exit LOOP2 - enddo LOOP2 ! accepted -C Check for time limit. - not_done = (it.lt.max_mcm_it) .and. (nacc_tot.lt.maxacc) - if(.not.not_done .or. finish) then - if(imtasks_n.gt.0) then - not_done=.true. - else - not_done=.false. - endif - finish=.true. - endif - enddo LOOP1 ! not_done - runtime=tcpu() - if (print_mc.gt.0) then - write (iout,'(/80(1h*)/20x,a)') 'Summary run statistics:' - call statprint(nacc,nfun,iretcode,etot,elowest) - write (iout,'(a)') - & 'Statistics of multiple-bond motions. Total motions:' - write (iout,'(16i5)') (nbond_move(i),i=1,Nbm) - write (iout,'(a)') 'Accepted motions:' - write (iout,'(16i5)') (nbond_acc(i),i=1,Nbm) - if (it.ge.maxacc) - &write (iout,'(/80(1h*)/20x,a/80(1h*)/)') 'All iterations done.' - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - do is=1,nodenum-1 - call MPI_SEND(999, 1, MPI_INTEGER, is, tag, - & CG_COMM, ierr) - enddo - return - end -c------------------------------------------------------------------------------ - subroutine execute_slave(nodeinfo,iprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'mpif.h' - include 'COMMON.TIME1' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM' -crc include 'COMMON.DEFORM1' -crc include 'COMMON.DEFORM2' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.INFO' - include 'COMMON.MINIM' - character*10 nodeinfo - double precision x(maxvar),x1(maxvar) - nodeinfo='chujwdupe' -c print *,'Processor:',MyID,' Entering execute_slave' - tag=0 -c call MPI_SEND(nodeinfo, 10, MPI_CHARACTER, 0, tag, -c & CG_COMM, ierr) - -1001 call MPI_RECV(i_switch, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - if(iprint.ge.2)print *, MyID,' recv order ',i_switch - if (i_switch.eq.12) then - i_grnum_d=0 - i_ennum_d=0 - i_hesnum_d=0 - call MPI_RECV(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'12: tag=',tag - call MPI_RECV(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'ener: tag=',tag - call MPI_RECV(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x: tag=',tag - call MPI_RECV(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, status, ierr) -c write(iout,*)'x1: tag=',tag -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif -c print *,'calling minimize' - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.0) - & write(iout,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - write(*,100)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - 100 format(a20,f10.5,a12,i5,a6,i2) - if(iretcode.eq.10) then - do iminrep=2,3 - if(iprint.gt.1) - & write(iout,*)' ... not converged - trying again ',iminrep - call minimize(energyx,x,iretcode,nfun) - if(iprint.gt.1) - & write(iout,*)'minimized energy = ',energyx, - & ' # funeval:',nfun,' iret ',iretcode - if(iretcode.ne.10)go to 812 - enddo - if(iretcode.eq.10) then - if(iprint.gt.1) - & write(iout,*)' ... not converged again - giving up' - go to 812 - endif - endif -812 continue -c print *,'Sending results' - call MPI_SEND(iitt, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(ener, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(energyx, 1, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(x1(1), nvar, MPI_DOUBLE_PRECISION, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_grnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(nfun, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) - call MPI_SEND(i_hesnum_d, 1, MPI_INTEGER, 0, tag, - & CG_COMM, ierr) -c print *,'End sending' - go to 1001 - endif - - return - end -#endif -c------------------------------------------------------------------------------ - subroutine statprint(it,nfun,iretcode,etot,elowest) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - if (minim) then - write (iout, - & '(80(1h*)/a,i5,a,1pe14.5,a,1pe14.5/a,i3,a,i10,a,i5,a,i5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest, - & 'SUMSL return code:',iretcode, - & ' # of energy evaluations:',neneval, - & '# of temperature jumps:',ntherm, - & ' # of minima repetitions:',nrepm - else - write (iout,'(80(1h*)/a,i8,a,1pe14.5,a,1pe14.5)') - & 'Finished iteration #',it,' energy is',etot, - & ' lowest energy:',elowest - endif - write (iout,'(/4a)') - & 'Kind of move ',' total',' accepted', - & ' fraction' - write (iout,'(58(1h-))') - do i=-1,MaxMoveType - if (moves(i).eq.0) then - fr_mov_i=0.0d0 - else - fr_mov_i=dfloat(moves_acc(i))/dfloat(moves(i)) - endif - write(iout,'(a,2i15,f10.5)')MovTypID(i),moves(i),moves_acc(i), - & fr_mov_i - enddo - write (iout,'(a,2i15,f10.5)') 'total ',nmove,nacc_tot, - & dfloat(nacc_tot)/dfloat(nmove) - write (iout,'(58(1h-))') - write (iout,'(a,1pe12.4)') 'Elapsed time:',tcpu() - return - end -c------------------------------------------------------------------------------ - subroutine heat(over) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - logical over -C Check if there`s a need to increase temperature. - if (ntrial.gt.maxtrial) then - if (NstepH.gt.0) then - if (dabs(Tcur-TMax).lt.1.0D-7) then - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a/80(1h*))') - & 'Upper limit of temperature reached. Terminating.' - over=.true. - Tcur=Tmin - else - Tcur=Tcur*TstepH - if (Tcur.gt.Tmax) Tcur=Tmax - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System heated up to ',Tcur,' K; BetBol:',betbol - ntherm=ntherm+1 - ntrial=0 - over=.false. - endif - else - if (print_mc.gt.0) - & write (iout,'(a)') - & 'Maximum number of trials in a single MCM iteration exceeded.' - over=.true. - Tcur=Tmin - endif - else - over=.false. - endif - return - end -c------------------------------------------------------------------------------ - subroutine cool - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - if (nstepC.gt.0 .and. dabs(Tcur-Tmin).gt.1.0D-7) then - Tcur=Tcur/TstepC - if (Tcur.lt.Tmin) Tcur=Tmin - betbol=1.0D0/(Rbol*Tcur) - if (print_mc.gt.0) - & write (iout,'(/80(1h*)/a,f8.3,a,f10.5/80(1h*))') - & 'System cooled down up to ',Tcur,' K; BetBol:',betbol - endif - return - end -C--------------------------------------------------------------------------- - subroutine zapis(varia,etot) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - integer itemp(maxsave) - double precision varia(maxvar) - logical lprint - lprint=.false. - if (lprint) then - write (iout,'(a,i5,a,i5)') 'Enter ZAPIS NSave=',Nsave, - & ' MaxSave=',MaxSave - write (iout,'(a)') 'Current energy and conformation:' - write (iout,'(1pe14.5)') etot - write (iout,'(10f8.3)') (rad2deg*varia(i),i=1,nvar) - endif -C Shift the contents of the esave and varsave arrays if filled up. - call add2cache(maxvar,maxsave,nsave,nvar,MyID,itemp, - & etot,varia,esave,varsave) - if (lprint) then - write (iout,'(a)') 'Energies and the VarSave array.' - do i=1,nsave - write (iout,'(i5,1pe14.5)') i,esave(i) - write (iout,'(10f8.3)') (rad2deg*varsave(j,i),j=1,nvar) - enddo - endif - return - end -C--------------------------------------------------------------------------- - subroutine perturb(error,lprint,MoveType,nbond,max_phi) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (MMaxSideMove=100) - include 'COMMON.MCM' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' -crc include 'COMMON.DEFORM1' - logical error,lprint,fail - integer MoveType,nbond,end_select,ind_side(MMaxSideMove) - double precision max_phi - double precision psi,gen_psi - external iran_num - integer iran_num - integer ifour - data ifour /4/ - error=.false. - lprint=.false. -C Perturb the conformation according to a randomly selected move. - call SelectMove(MoveType) -c write (iout,*) 'MoveType=',MoveType - itrial=0 - goto (100,200,300,400,500) MoveType -C------------------------------------------------------------------------------ -C Backbone N-bond move. -C Select the number of bonds (length of the segment to perturb). - 100 continue - if (itrial.gt.1000) then - write (iout,'(a)') 'Too many attempts at multiple-bond move.' - error=.true. - return - endif - bond_prob=ran_number(0.0D0,sumpro_bond(nbm)) -c print *,'sumpro_bond(nbm)=',sumpro_bond(nbm), -c & ' Bond_prob=',Bond_Prob - do i=1,nbm-1 -c print *,i,Bond_Prob,sumpro_bond(i),sumpro_bond(i+1) - if (bond_prob.ge.sumpro_bond(i) .and. - & bond_prob.le.sumpro_bond(i+1)) then - nbond=i+1 - goto 10 - endif - enddo - write (iout,'(2a)') 'In PERTURB: Error - number of bonds', - & ' to move out of range.' - error=.true. - return - 10 continue - if (nwindow.gt.0) then -C Select the first residue to perturb - iwindow=iran_num(1,nwindow) - print *,'iwindow=',iwindow - iiwin=1 - do while (winlen(iwindow).lt.nbond) - iwindow=iran_num(1,nwindow) - iiwin=iiwin+1 - if (iiwin.gt.1000) then - write (iout,'(a)') 'Cannot select moveable residues.' - error=.true. - return - endif - enddo - nstart=iran_num(winstart(iwindow),winend(iwindow)) - else - nstart = iran_num(koniecl+2,nres-nbond-koniecl) -cd print *,'nres=',nres,' nbond=',nbond,' koniecl=',koniecl, -cd & ' nstart=',nstart - endif - psi = gen_psi() - if (psi.eq.0.0) then - error=.true. - return - endif - if (print_mc.gt.1) write (iout,'(a,i4,a,i4,a,f8.3)') - & 'PERTURB: nbond=',nbond,' nstart=',nstart,' psi=',psi*rad2deg -cd print *,'nstart=',nstart - call bond_move(nbond,nstart,psi,.false.,error) - if (error) then - write (iout,'(2a)') - & 'Could not define reference system in bond_move, ', - & 'choosing ahother segment.' - itrial=itrial+1 - goto 100 - endif - nbond_move(nbond)=nbond_move(nbond)+1 - moves(1)=moves(1)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Backbone endmove. Perturb a SINGLE angle of a residue close to the end of -C the chain. - 200 continue - lprint=.true. -c end_select=iran_num(1,2*koniecl) -c if (end_select.gt.koniecl) then -c end_select=nphi-(end_select-koniecl) -c else -c end_select=koniecl+3 -c endif -c if (nwindow.gt.0) then -c iwin=iran_num(1,nwindow) -c i1=max0(4,winstart(iwin)) -c i2=min0(winend(imin)+2,nres) -c end_select=iran_num(i1,i2) -c else -c iselect = iran_num(1,nmov_var) -c jj = 0 -c do i=1,nphi -c if (isearch_tab(i).eq.1) jj = jj+1 -c if (jj.eq.iselect) then -c end_select=i+3 -c exit -c endif -c enddo -c endif - end_select = iran_num(4,nres) - psi=max_phi*gen_psi() - if (psi.eq.0.0D0) then - error=.true. - return - endif - phi(end_select)=pinorm(phi(end_select)+psi) - if (print_mc.gt.1) write (iout,'(a,i4,a,f8.3,a,f8.3)') - & 'End angle',end_select,' moved by ',psi*rad2deg,' new angle:', - & phi(end_select)*rad2deg -c if (end_select.gt.3) -c & theta(end_select-1)=gen_theta(itype(end_select-2), -c & phi(end_select-1),phi(end_select)) -c if (end_select.lt.nres) -c & theta(end_select)=gen_theta(itype(end_select-1), -c & phi(end_select),phi(end_select+1)) -cd print *,'nres=',nres,' end_select=',end_select -cd print *,'theta',end_select-1,theta(end_select-1) -cd print *,'theta',end_select,theta(end_select) - moves(2)=moves(2)+1 - nmove=nmove+1 - lprint=.false. - return -C------------------------------------------------------------------------------ -C Side chain move. -C Select the number of SCs to perturb. - 300 isctry=0 - 301 nside_move=iran_num(1,MaxSideMove) -c print *,'nside_move=',nside_move,' MaxSideMove',MaxSideMove -C Select the indices. - do i=1,nside_move - icount=0 - 111 inds=iran_num(nnt,nct) - icount=icount+1 - if (icount.gt.1000) then - write (iout,'(a)')'Error - cannot select side chains to move.' - error=.true. - return - endif - if (itype(inds).eq.10) goto 111 - do j=1,i-1 - if (inds.eq.ind_side(j)) goto 111 - enddo - do j=1,i-1 - if (inds.lt.ind_side(j)) then - indx=j - goto 112 - endif - enddo - indx=i - 112 do j=i,indx+1,-1 - ind_side(j)=ind_side(j-1) - enddo - 113 ind_side(indx)=inds - enddo -C Carry out perturbation. - do i=1,nside_move - ii=ind_side(i) - iti=itype(ii) - call gen_side(iti,theta(ii+1),alph(ii),omeg(ii),fail) - if (fail) then - isctry=isctry+1 - if (isctry.gt.1000) then - write (iout,'(a)') 'Too many errors in SC generation.' - error=.true. - return - endif - goto 301 - endif - if (print_mc.gt.1) write (iout,'(2a,i4,a,2f8.3)') - & 'Side chain ',restyp(iti),ii,' moved to ', - & alph(ii)*rad2deg,omeg(ii)*rad2deg - enddo - moves(3)=moves(3)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C THETA move - 400 end_select=iran_num(3,nres) - theta_new=gen_theta(itype(end_select),phi(end_select), - & phi(end_select+1)) - if (print_mc.gt.1) write (iout,'(a,i3,a,f8.3,a,f8.3)') - & 'Theta ',end_select,' moved from',theta(end_select)*rad2deg, - & ' to ',theta_new*rad2deg - theta(end_select)=theta_new - moves(4)=moves(4)+1 - nmove=nmove+1 - return -C------------------------------------------------------------------------------ -C Error returned from SelectMove. - 500 error=.true. - return - end -C------------------------------------------------------------------------------ - subroutine SelectMove(MoveType) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - what_move=ran_number(0.0D0,sumpro_type(MaxMoveType)) - do i=1,MaxMoveType - if (what_move.ge.sumpro_type(i-1).and. - & what_move.lt.sumpro_type(i)) then - MoveType=i - return - endif - enddo - write (iout,'(a)') - & 'Fatal error in SelectMoveType: cannot select move.' - MoveType=MaxMoveType+1 - return - end -c---------------------------------------------------------------------------- - double precision function gen_psi() - implicit none - integer i - double precision x,ran_number - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - x=0.0D0 - do i=1,100 - x=ran_number(-pi,pi) - if (dabs(x).gt.angmin) then - gen_psi=x - return - endif - enddo - write (iout,'(a)')'From Gen_Psi: Cannot generate angle increment.' - gen_psi=0.0D0 - return - end -c---------------------------------------------------------------------------- - subroutine metropolis(n,xcur,xold,ecur,eold,accepted,similar, - & enelower) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' -crc include 'COMMON.DEFORM' - double precision ecur,eold,xx,ran_number,bol - double precision xcur(n),xold(n) - double precision ecut1 ,ecut2 ,tola - logical accepted,similar,not_done,enelower - logical lprn - data ecut1 /-1.0D-5/,ecut2 /5.0D-3/,tola/5.0D0/ -! ecut1=-5*enedif -! ecut2=50*enedif -! tola=5.0d0 -C Set lprn=.true. for debugging. - lprn=.false. - if (lprn) - &write(iout,*)'enedif',enedif,' ecut1',ecut1,' ecut2',ecut2 - similar=.false. - enelower=.false. - accepted=.false. -C Check if the conformation is similar. - difene=ecur-eold - reldife=difene/dmax1(dabs(eold),dabs(ecur),1.0D0) - if (lprn) then - write (iout,*) 'Metropolis' - write(iout,*)'ecur,eold,difene,reldife',ecur,eold,difene,reldife - endif -C If energy went down remarkably, we accept the new conformation -C unconditionally. -cjp if (reldife.lt.ecut1) then - if (difene.lt.ecut1) then - accepted=.true. - EneLower=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because energy has lowered remarkably.' -! elseif (reldife.lt.ecut2 .and. dif_ang(nphi,xcur,xold).lt.tola) -cjp elseif (reldife.lt.ecut2) - elseif (difene.lt.ecut2) - & then -C Reject the conf. if energy has changed insignificantly and there is not -C much change in conformation. - if (lprn) - & write (iout,'(2a)') 'Conformation rejected, because it is', - & ' similar to the preceding one.' - accepted=.false. - similar=.true. - else -C Else carry out Metropolis test. - EneLower=.false. - xx=ran_number(0.0D0,1.0D0) - xxh=betbol*difene - if (lprn) - & write (iout,*) 'betbol=',betbol,' difene=',difene,' xxh=',xxh - if (xxh.gt.50.0D0) then - bol=0.0D0 - else - bol=exp(-xxh) - endif - if (lprn) write (iout,*) 'bol=',bol,' xx=',xx - if (bol.gt.xx) then - accepted=.true. - if (lprn) write (iout,'(a)') - & 'Conformation accepted, because it passed Metropolis test.' - else - accepted=.false. - if (lprn) write (iout,'(a)') - & 'Conformation rejected, because it did not pass Metropolis test.' - endif - endif -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - return - end -c------------------------------------------------------------------------------ - integer function conf_comp(x,ene) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - double precision etol , angtol - double precision x(maxvar) - double precision dif_ang,difa - data etol /0.1D0/, angtol /20.0D0/ - do ii=nsave,1,-1 -c write (iout,*) 'ii=',ii,'ene=',ene,esave(ii),dabs(ene-esave(ii)) - if (dabs(ene-esave(ii)).lt.etol) then - difa=dif_ang(nphi,x,varsave(1,ii)) -c do i=1,nphi -c write(iout,'(i3,3f8.3)')i,rad2deg*x(i), -c & rad2deg*varsave(i,ii) -c enddo -c write(iout,*) 'ii=',ii,' difa=',difa,' angtol=',angtol - if (difa.le.angtol) then - if (print_mc.gt.0) then - write (iout,'(a,i5,2(a,1pe15.4))') - & 'Current conformation matches #',ii, - & ' in the store array ene=',ene,' esave=',esave(ii) -c write (*,'(a,i5,a)') 'Current conformation matches #',ii, -c & ' in the store array.' - endif ! print_mc.gt.0 - if (print_mc.gt.1) then - do i=1,nphi - write(iout,'(i3,3f8.3)')i,rad2deg*x(i), - & rad2deg*varsave(i,ii) - enddo - endif ! print_mc.gt.1 - nrepm=nrepm+1 - conf_comp=ii - return - endif - endif - enddo - conf_comp=0 - return - end -C---------------------------------------------------------------------------- - double precision function dif_ang(n,x,y) - implicit none - integer i,n - double precision x(n),y(n) - double precision w,wa,dif,difa - double precision pinorm - include 'COMMON.GEO' - wa=0.0D0 - difa=0.0D0 - do i=1,n - dif=dabs(pinorm(y(i)-x(i))) - if (dabs(dif-dwapi).lt.dif) dif=dabs(dif-dwapi) - w=1.0D0-(2.0D0*(i-1)/(n-1)-1.0D0)**2+1.0D0/n - wa=wa+w - difa=difa+dif*dif*w - enddo - dif_ang=rad2deg*dsqrt(difa/wa) - return - end -c-------------------------------------------------------------------------- - subroutine add2cache(n1,n2,ncache,nvar,SourceID,CachSrc, - & ecur,xcur,ecache,xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,SourceID,CachSrc(n2) - integer i,ii,j - double precision ecur,xcur(nvar),ecache(n2),xcache(n1,n2) -cd write (iout,*) 'Enter ADD2CACHE ncache=',ncache ,' ecur',ecur -cd write (iout,'(10f8.3)') (rad2deg*xcur(i),i=1,nvar) -cd write (iout,*) 'Old CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - - i=ncache - do while (i.gt.0 .and. ecur.lt.ecache(i)) - i=i-1 - enddo - i=i+1 -cd write (iout,*) 'i=',i,' ncache=',ncache - if (ncache.eq.n2) then - write (iout,*) 'Cache dimension exceeded',ncache,n2 - write (iout,*) 'Highest-energy conformation will be removed.' - ncache=ncache-1 - endif - do ii=ncache,i,-1 - ecache(ii+1)=ecache(ii) - CachSrc(ii+1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii+1)=xcache(j,ii) - enddo - enddo - ecache(i)=ecur - CachSrc(i)=SourceID - do j=1,nvar - xcache(j,i)=xcur(j) - enddo - ncache=ncache+1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end -c-------------------------------------------------------------------------- - subroutine rm_from_cache(i,n1,n2,ncache,nvar,CachSrc,ecache, - & xcache) - implicit none - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer n1,n2,ncache,nvar,CachSrc(n2) - integer i,ii,j - double precision ecache(n2),xcache(n1,n2) - -cd write (iout,*) 'Enter RM_FROM_CACHE' -cd write (iout,*) 'Old CACHE array:' -cd do ii=1,ncache -cd write (iout,*)'i=',ii,' ecache=',ecache(ii),' CachSrc',CachSrc(ii) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,ii),j=1,nvar) -cd enddo - - do ii=i+1,ncache - ecache(ii-1)=ecache(ii) - CachSrc(ii-1)=CachSrc(ii) - do j=1,nvar - xcache(j,ii-1)=xcache(j,ii) - enddo - enddo - ncache=ncache-1 -cd write (iout,*) 'New CACHE array:' -cd do i=1,ncache -cd write (iout,*) 'i=',i,' ecache=',ecache(i),' CachSrc',CachSrc(i) -cd write (iout,'(10f8.3)') (rad2deg*xcache(j,i),j=1,nvar) -cd enddo - return - end diff --git a/source/unres/src_MD-restraints/minim_mcmf.F b/source/unres/src_MD-restraints/minim_mcmf.F deleted file mode 100644 index beb3d4c..0000000 --- a/source/unres/src_MD-restraints/minim_mcmf.F +++ /dev/null @@ -1,121 +0,0 @@ -#ifdef MPI - subroutine minim_mcmf - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - include 'mpif.h' - external func,gradient,fdum - real ran1,ran2,ran3 - include 'COMMON.SETUP' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - dimension muster(mpi_status_size) - dimension var(maxvar),erg(mxch*(mxch+1)/2+1) - double precision d(maxvar),v(1:lv+1),garbage(maxvar) - dimension indx(6) - dimension iv(liv) - dimension idum(1),rdum(1) - double precision przes(3),obrot(3,3) - logical non_conv - data rad /1.745329252d-2/ - common /przechowalnia/ v - - ichuj=0 - 10 continue - ichuj = ichuj + 1 - call mpi_recv(indx,6,mpi_integer,king,idint,CG_COMM, - * muster,ierr) - if (indx(1).eq.0) return -c print *, 'worker ',me,' received order ',n,ichuj - call mpi_recv(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene0,1,mpi_double_precision, - * king,idreal,CG_COMM,muster,ierr) -c print *, 'worker ',me,' var read ' - - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -c minimize energy - - call func(nvar,var,nf,eee,idum,rdum,fdum) - if(eee.gt.1.0d18) then -c print *,'MINIM_JLEE: ',me,' CHUJ NASTAPIL' -c print *,' energy before SUMSL =',eee -c print *,' aborting local minimization' - iv(1)=-1 - v(10)=eee - nf=1 - go to 201 - endif - - call sumsl(nvar,d,var,func,gradient,iv,liv,lv,v,idum,rdum,fdum) -c find which conformation was returned from sumsl - nf=iv(7)+1 - 201 continue -c total # of ftn evaluations (for iwf=0, it includes all minimizations). - indx(4)=nf - indx(5)=iv(1) - eee=v(10) - - call mpi_send(indx,6,mpi_integer,king,idint,CG_COMM, - * ierr) -c print '(a5,i3,15f10.5)', 'ENEX0',indx(1),v(10) - call mpi_send(var,nvar,mpi_double_precision, - * king,idreal,CG_COMM,ierr) - call mpi_send(eee,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,king,idreal, - * CG_COMM,ierr) - go to 10 - - return - end -#endif diff --git a/source/unres/src_MD-restraints/minimize_p.F b/source/unres/src_MD-restraints/minimize_p.F deleted file mode 100644 index c7922c7..0000000 --- a/source/unres/src_MD-restraints/minimize_p.F +++ /dev/null @@ -1,641 +0,0 @@ - subroutine minimize(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -********************************************************************* -* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -* the calling subprogram. * -* when d(i)=1.0, then v(35) is the length of the initial step, * -* calculated in the usual pythagorean way. * -* absolute convergence occurs when the function is within v(31) of * -* zero. unless you know the minimum value in advance, abs convg * -* is probably not useful. * -* relative convergence is when the model predicts that the function * -* will decrease by less than v(32)*abs(fun). * -********************************************************************* - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr,grad_restr - logical not_done,change,reduce -c common /przechowalnia/ v - - icall = 1 - - NOT_DONE=.TRUE. - -c DO WHILE (NOT_DONE) - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo -cd print *,'Calling SUMSL' -c call var_to_geom(nvar,x) -c call chainbuild -c call etotal(energia(0)) -c etot = energia(0) - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr,grad_restr, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) -cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot -cd write (iout,'(/a,i4/)') 'SUMSL return code:',iv(1) -c call intout -c change=reduce(x) - call var_to_geom(nvar,x) -c if (change) then -c write (iout,'(a)') 'Reduction worked, minimizing again...' -c else -c not_done=.false. -c endif - call chainbuild -c call etotal(energia(0)) -c etot=energia(0) -c call enerprint(energia(0)) - nfun=iv(6) - -c write (*,*) 'Processor',MyID,' leaves MINIMIZE.' - -c ENDDO ! NOT_DONE - - return - end -#ifdef MPI -c---------------------------------------------------------------------------- - subroutine ergastulum - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' - double precision z(maxres6),d_a_tmp(maxres6) - double precision edum(0:n_ene),time_order(0:10) - double precision Gcopy(maxres2,maxres2) - common /przechowalnia/ Gcopy - integer icall /0/ -C Workers wait for variables and NF, and NFL from the boss - iorder=0 - do while (iorder.ge.0) -c write (*,*) 'Processor',fg_rank,' CG group',kolor, -c & ' receives order from Master' - time00=MPI_Wtime() - call MPI_Bcast(iorder,1,MPI_INTEGER,king,FG_COMM,IERR) - time_Bcast=time_Bcast+MPI_Wtime()-time00 - if (icall.gt.4 .and. iorder.ge.0) - & time_order(iorder)=time_order(iorder)+MPI_Wtime()-time00 - icall=icall+1 -c write (*,*) -c & 'Processor',fg_rank,' completed receive MPI_BCAST order',iorder - if (iorder.eq.0) then - call zerograd - call etotal(edum) -c write (2,*) "After etotal" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.2) then - call zerograd - call etotal_short(edum) -c write (2,*) "After etotal_short" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.3) then - call zerograd - call etotal_long(edum) -c write (2,*) "After etotal_long" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.1) then - call sum_gradient -c write (2,*) "After sum_gradient" -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - else if (iorder.eq.4) then - call ginv_mult(z,d_a_tmp) - else if (iorder.eq.5) then -c Setup MD things for a slave - dimen=(nct-nnt+1)+nside - dimen1=(nct-nnt)+(nct-nnt+1) - dimen3=dimen*3 -c write (2,*) "dimen",dimen," dimen3",dimen3 -c call flush(2) - call int_bounds(dimen,igmult_start,igmult_end) - igmult_start=igmult_start-1 - call MPI_Allgather(3*igmult_start,1,MPI_INTEGER, - & ng_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - my_ng_count=igmult_end-igmult_start - call MPI_Allgather(3*my_ng_count,1,MPI_INTEGER,ng_counts(0),1, - & MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "ng_start",(ng_start(i),i=0,nfgtasks-1) -c write (2,*) "ng_counts",(ng_counts(i),i=0,nfgtasks-1) - myginv_ng_count=maxres2*my_ng_count -c write (2,*) "igmult_start",igmult_start," igmult_end", -c & igmult_end," my_ng_count",my_ng_count -c call flush(2) - call MPI_Allgather(maxres2*igmult_start,1,MPI_INTEGER, - & nginv_start(0),1,MPI_INTEGER,FG_COMM,IERROR) - call MPI_Allgather(myginv_ng_count,1,MPI_INTEGER, - & nginv_counts(0),1,MPI_INTEGER,FG_COMM,IERROR) -c write (2,*) "nginv_start",(nginv_start(i),i=0,nfgtasks-1) -c write (2,*) "nginv_counts",(nginv_counts(i),i=0,nfgtasks-1) -c call flush(2) -c call MPI_Barrier(FG_COMM,IERROR) - time00=MPI_Wtime() - call MPI_Scatterv(ginv(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,gcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) -#ifdef TIMING - time_scatter_ginv=time_scatter_ginv+MPI_Wtime()-time00 -#endif - do i=1,dimen - do j=1,2*my_ng_count - ginv(j,i)=gcopy(i,j) - enddo - enddo -c write (2,*) "dimen",dimen," dimen3",dimen3 -c write (2,*) "End MD setup" -c call flush(2) -c write (iout,*) "My chunk of ginv_block" -c call MATOUT2(my_ng_count,dimen3,maxres2,maxers2,ginv_block) - else if (iorder.eq.6) then - call int_from_cart1(.false.) - else if (iorder.eq.7) then - call chainbuild_cart - else if (iorder.eq.8) then - call intcartderiv - else if (iorder.eq.9) then - call fricmat_mult(z,d_a_tmp) - else if (iorder.eq.10) then - call setup_fricmat - endif - enddo - write (*,*) 'Processor',fg_rank,' CG group',kolor, - & ' absolute rank',myrank,' leves ERGASTULUM.' - write(*,*)'Processor',fg_rank,' wait times for respective orders', - & (' order[',i,']',time_order(i),i=0,10) - return - end -#endif -************************************************************************ - subroutine func(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 -cd print *,'func',nf,nfl,icg - call var_to_geom(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -************************************************************************ - subroutine func_restr(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - common /chuju/ jjj - double precision energia(0:n_ene) - integer jjj - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c endif - nfl=nf - icg=mod(nf,2)+1 - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call etotal(energia(0)) - call sum_gradient - f=energia(0) -c if (jjj.gt.0) then -c write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) -c write (iout,*) 'f=',etot -c jjj=0 -c endif - return - end -c------------------------------------------------------- - subroutine x2xx(x,xx,n) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - varall(i)=x(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - xx(ig)=x(igall) - endif - endif - enddo - enddo - - n=ig - - return - end - - subroutine xx2x(x,xx) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - double precision xx(maxvar),x(maxvar) - - do i=1,nvar - x(i)=varall(i) - enddo - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - x(igall)=xx(ig) - endif - endif - enddo - enddo - - return - end - -c---------------------------------------------------------- - subroutine minim_dc(etot,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) -c common /przechowalnia/ v - - double precision energia(0:n_ene) - external func_dc,grad_dc,fdum - logical not_done,change,reduce - double precision g(maxvar),f1 - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit - iv(21)=0 - if (print_min_ini+print_min_stat+print_min_res.gt.0) iv(21)=iout -* 1 means to print out result - iv(22)=print_min_res -* 1 means to print out summary stats - iv(23)=print_min_stat -* 1 means to print initial x and d - iv(24)=print_min_ini -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,6*nres - d(i)=1.0D-1 - enddo - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - x(k)=dc(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - x(k)=dc(j,i+nres) - enddo - endif - enddo - - call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -cd call zerograd -cd nf=0 -cd call func_dc(k,x,nf,f,idum,rdum,fdum) -cd call grad_dc(k,x,nf,g,idum,rdum,fdum) -cd -cd do i=1,k -cd x(i)=x(i)+1.0D-5 -cd call func_dc(k,x,nf,f1,idum,rdum,fdum) -cd x(i)=x(i)-1.0D-5 -cd print '(i5,2f15.5)',i,g(i),(f1-f)/1.0D-5 -cd enddo - - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - return - end - - subroutine func_dc(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - double precision energia(0:n_ene) - double precision ufparm - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf -cbad icg=mod(nf,2)+1 - icg=1 - - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - - call zerograd - call etotal(energia(0)) - f=energia(0) - -cd print *,'func_dc ',nf,nfl,f - - return - end - - subroutine grad_dc(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.MD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1),k - double precision urparm(1) - dimension x(maxvar),g(maxvar) -c -c -c -cbad icg=mod(nf,2)+1 - icg=1 -cd print *,'grad_dc ',nf,nfl,nf-nfl+1,icg - if (nf-nfl+1) 20,30,40 - 20 call func_dc(n,x,nf,f,uiparm,urparm,ufparm) -cd print *,20 - if (nf.eq.0) return - goto 40 - 30 continue -cd print *,30 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - dc(j,i)=x(k) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - dc(j,i+nres)=x(k) - enddo - endif - enddo - call chainbuild_cart - -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartgrad -cd print *,40 - k=0 - do i=1,nres-1 - do j=1,3 - k=k+1 - g(k)=gcart(j,i) - enddo - enddo - do i=2,nres-1 - if (ialph(i,1).gt.0) then - do j=1,3 - k=k+1 - g(k)=gxcart(j,i) - enddo - endif - enddo - - return - end diff --git a/source/unres/src_MD-restraints/misc.f b/source/unres/src_MD-restraints/misc.f deleted file mode 100644 index e189839..0000000 --- a/source/unres/src_MD-restraints/misc.f +++ /dev/null @@ -1,203 +0,0 @@ -C $Date: 1994/10/12 17:24:21 $ -C $Revision: 2.5 $ -C -C -C - logical function find_arg(ipos,line,errflag) - parameter (maxlen=80) - character*80 line - character*1 empty /' '/,equal /'='/ - logical errflag -* This function returns .TRUE., if an argument follows keyword keywd; if so -* IPOS will point to the first non-blank character of the argument. Returns -* .FALSE., if no argument follows the keyword; in this case IPOS points -* to the first non-blank character of the next keyword. - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - errflag=.false. - if (line(ipos:ipos).eq.equal) then - find_arg=.true. - ipos=ipos+1 - do while (line(ipos:ipos) .eq. empty .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen) errflag=.true. - else - find_arg=.false. - endif - return - end - logical function find_group(iunit,jout,key1) - character*(*) key1 - character*80 karta,ucase - integer ilen - external ilen - logical lcom - rewind (iunit) - karta=' ' - ll=ilen(key1) - do while (index(ucase(karta),key1(1:ll)).eq.0.or.lcom(1,karta)) - read (iunit,'(a)',end=10) karta - enddo - write (jout,'(2a)') '> ',karta(1:78) - find_group=.true. - return - 10 find_group=.false. - return - end - logical function iblnk(charc) - character*1 charc - integer n - n = ichar(charc) - iblnk = (n.eq.9) .or. (n.eq.10) .or. (charc.eq. ' ') - return - end - integer function ilen(string) - character*(*) string - logical iblnk - - ilen = len(string) -1 if ( ilen .gt. 0 ) then - if ( iblnk( string(ilen:ilen) ) ) then - ilen = ilen - 1 - goto 1 - endif - endif - return - end - integer function in_keywd_set(nkey,ikey,narg,keywd,keywdset) - character*16 keywd,keywdset(1:nkey,0:nkey) - character*16 ucase - do i=1,narg - if (ucase(keywd).eq.keywdset(i,ikey)) then -* Match found - in_keywd_set=i - return - endif - enddo -* No match to the allowed set of keywords if this point is reached. - in_keywd_set=0 - return - end - character*(*) function lcase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(lcase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - lcase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'A') .and. lle(c,'Z')) then - lcase(i:i) = char(ichar(c) + idiff) - endif - 99 continue - return - end - logical function lcom(ipos,karta) - character*80 karta - character koment(2) /'!','#'/ - lcom=.false. - do i=1,2 - if (karta(ipos:ipos).eq.koment(i)) lcom=.true. - enddo - return - end - logical function lower_case(ch) - character*(*) ch - lower_case=(ch.ge.'a' .and. ch.le.'z') - return - end - subroutine mykey(line,keywd,ipos,blankline,errflag) -* This subroutine seeks a non-empty substring keywd in the string LINE. -* The substring begins with the first character different from blank and -* "=" encountered right to the pointer IPOS (inclusively) and terminates -* at the character left to the first blank or "=". When the subroutine is -* exited, the pointer IPOS is moved to the position of the terminator in LINE. -* The logical variable BLANKLINE is set at .TRUE., if LINE(IPOS:) contains -* only separators or the maximum length of the data line (80) has been reached. -* The logical variable ERRFLAG is set at .TRUE. if the string -* consists only from a "=". - parameter (maxlen=80) - character*1 empty /' '/,equal /'='/,comma /','/ - character*(*) keywd - character*80 line - logical blankline,errflag,lcom - errflag=.false. - do while (line(ipos:ipos).eq.empty .and. (ipos.le.maxlen)) - ipos=ipos+1 - enddo - if (ipos.gt.maxlen .or. lcom(ipos,line) ) then -* At this point the rest of the input line turned out to contain only blanks -* or to be commented out. - blankline=.true. - return - endif - blankline=.false. - istart=ipos -* Checks whether the current char is a separator. - do while (line(ipos:ipos).ne.empty .and. line(ipos:ipos).ne.equal - & .and. line(ipos:ipos).ne.comma .and. ipos.le.maxlen) - ipos=ipos+1 - enddo - iend=ipos-1 -* Error flag set to .true., if the length of the keyword was found less than 1. - if (iend.lt.istart) then - errflag=.true. - return - endif - keywd=line(istart:iend) - return - end - subroutine numstr(inum,numm) - character*10 huj /'0123456789'/ - character*(*) numm - inumm=inum - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(3:3)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(2:2)=huj(inum2+1:inum2+1) - inum1=inumm/10 - inum2=inumm-10*inum1 - inumm=inum1 - numm(1:1)=huj(inum2+1:inum2+1) - return - end - character*(*) function ucase(string) - integer i, k, idiff - character*(*) string - character*1 c - character*40 chtmp -c - i = len(ucase) - k = len(string) - if (i .lt. k) then - k = i - if (string(k+1:) .ne. ' ') then - chtmp = string - endif - endif - idiff = ichar('a') - ichar('A') - ucase = string - do 99 i = 1, k - c = string(i:i) - if (lge(c,'a') .and. lle(c,'z')) then - ucase(i:i) = char(ichar(c) - idiff) - endif - 99 continue - return - end diff --git a/source/unres/src_MD-restraints/moments.f b/source/unres/src_MD-restraints/moments.f deleted file mode 100644 index 5adbf21..0000000 --- a/source/unres/src_MD-restraints/moments.f +++ /dev/null @@ -1,328 +0,0 @@ - subroutine inertia_tensor -c Calculating the intertia tensor for the entire protein in order to -c remove the perpendicular components of velocity matrix which cause -c the molecule to rotate. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision Im(3,3),Imcp(3,3),cm(3),pr(3),M_SC, - & eigvec(3,3),Id(3,3),eigval(3),L(3),vp(3),vrot(3), - & vpp(3,0:MAXRES),vs_p(3),pr1(3,3), - & pr2(3,3),pp(3),incr(3),v(3),mag,mag2 - common /gucio/ cm - integer iti,inres - do i=1,3 - do j=1,3 - Im(i,j)=0.0d0 - pr1(i,j)=0.0d0 - pr2(i,j)=0.0d0 - enddo - L(i)=0.0d0 - cm(i)=0.0d0 - vrot(i)=0.0d0 - enddo -c calculating the center of the mass of the protein - do i=nnt,nct-1 - do j=1,3 - cm(j)=cm(j)+c(j,i)+0.5d0*dc(j,i) - enddo - enddo - do j=1,3 - cm(j)=mp*cm(j) - enddo - M_SC=0.0d0 - do i=nnt,nct - iti=itype(i) - M_SC=M_SC+msc(iti) - inres=i+nres - do j=1,3 - cm(j)=cm(j)+msc(iti)*c(j,inres) - enddo - enddo - do j=1,3 - cm(j)=cm(j)/(M_SC+(nct-nnt)*mp) - enddo - - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - Im(1,1)=Im(1,1)+mp*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-mp*pr(1)*pr(2) - Im(1,3)=Im(1,3)-mp*pr(1)*pr(3) - Im(2,3)=Im(2,3)-mp*pr(2)*pr(3) - Im(2,2)=Im(2,2)+mp*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+mp*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - Im(1,1)=Im(1,1)+msc(iti)*(pr(2)*pr(2)+pr(3)*pr(3)) - Im(1,2)=Im(1,2)-msc(iti)*pr(1)*pr(2) - Im(1,3)=Im(1,3)-msc(iti)*pr(1)*pr(3) - Im(2,3)=Im(2,3)-msc(iti)*pr(2)*pr(3) - Im(2,2)=Im(2,2)+msc(iti)*(pr(3)*pr(3)+pr(1)*pr(1)) - Im(3,3)=Im(3,3)+msc(iti)*(pr(1)*pr(1)+pr(2)*pr(2)) - enddo - - do i=nnt,nct-1 - Im(1,1)=Im(1,1)+Ip*(1-dc_norm(1,i)*dc_norm(1,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,2)=Im(1,2)+Ip*(-dc_norm(1,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(1,3)=Im(1,3)+Ip*(-dc_norm(1,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,3)=Im(2,3)+Ip*(-dc_norm(2,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(2,2)=Im(2,2)+Ip*(1-dc_norm(2,i)*dc_norm(2,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - Im(3,3)=Im(3,3)+Ip*(1-dc_norm(3,i)*dc_norm(3,i))* - & vbld(i+1)*vbld(i+1)*0.25d0 - enddo - - - do i=nnt,nct - if (itype(i).ne.10) then - iti=itype(i) - inres=i+nres - Im(1,1)=Im(1,1)+Isc(iti)*(1-dc_norm(1,inres)* - & dc_norm(1,inres))*vbld(inres)*vbld(inres) - Im(1,2)=Im(1,2)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(1,3)=Im(1,3)-Isc(iti)*(dc_norm(1,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,3)=Im(2,3)-Isc(iti)*(dc_norm(2,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - Im(2,2)=Im(2,2)+Isc(iti)*(1-dc_norm(2,inres)* - & dc_norm(2,inres))*vbld(inres)*vbld(inres) - Im(3,3)=Im(3,3)+Isc(iti)*(1-dc_norm(3,inres)* - & dc_norm(3,inres))*vbld(inres)*vbld(inres) - endif - enddo - - call angmom(cm,L) -c write(iout,*) "The angular momentum before adjustment:" -c write(iout,*) (L(j),j=1,3) - - Im(2,1)=Im(1,2) - Im(3,1)=Im(1,3) - Im(3,2)=Im(2,3) - -c Copying the Im matrix for the djacob subroutine - do i=1,3 - do j=1,3 - Imcp(i,j)=Im(i,j) - Id(i,j)=0.0d0 - enddo - enddo - -c Finding the eigenvectors and eignvalues of the inertia tensor - call djacob(3,3,10000,1.0d-10,Imcp,eigvec,eigval) -c write (iout,*) "Eigenvalues & Eigenvectors" -c write (iout,'(5x,3f10.5)') (eigval(i),i=1,3) -c write (iout,*) -c do i=1,3 -c write (iout,'(i5,3f10.5)') i,(eigvec(i,j),j=1,3) -c enddo -c Constructing the diagonalized matrix - do i=1,3 - if (dabs(eigval(i)).gt.1.0d-15) then - Id(i,i)=1.0d0/eigval(i) - else - Id(i,i)=0.0d0 - endif - enddo - do i=1,3 - do j=1,3 - Imcp(i,j)=eigvec(j,i) - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr1(i,j)=pr1(i,j)+Id(i,k)*Imcp(k,j) - enddo - enddo - enddo - do i=1,3 - do j=1,3 - do k=1,3 - pr2(i,j)=pr2(i,j)+eigvec(i,k)*pr1(k,j) - enddo - enddo - enddo -c Calculating the total rotational velocity of the molecule - do i=1,3 - do j=1,3 - vrot(i)=vrot(i)+pr2(i,j)*L(j) - enddo - enddo -c Resetting the velocities - do i=nnt,nct-1 - call vecpr(vrot(1),dc(1,i),vp) - do j=1,3 - d_t(j,i)=d_t(j,i)-vp(j) - enddo - enddo - do i=nnt,nct - if(itype(i).ne.10) then - inres=i+nres - call vecpr(vrot(1),dc(1,inres),vp) - do j=1,3 - d_t(j,inres)=d_t(j,inres)-vp(j) - enddo - endif - enddo - call angmom(cm,L) -c write(iout,*) "The angular momentum after adjustment:" -c write(iout,*) (L(j),j=1,3) - return - end -c---------------------------------------------------------------------------- - subroutine angmom(cm,L) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - - double precision L(3),cm(3),pr(3),vp(3),vrot(3),incr(3),v(3), - & pp(3) - integer iti,inres -c Calculate the angular momentum - do j=1,3 - L(j)=0.0d0 - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct-1 - do j=1,3 - pr(j)=c(j,i)+0.5d0*dc(j,i)-cm(j) - enddo - do j=1,3 - v(j)=incr(j)+0.5d0*d_t(j,i) - enddo - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - call vecpr(pr(1),v(1),vp) - do j=1,3 - L(j)=L(j)+mp*vp(j) - enddo - do j=1,3 - pr(j)=0.5d0*dc(j,i) - pp(j)=0.5d0*d_t(j,i) - enddo - call vecpr(pr(1),pp(1),vp) - do j=1,3 - L(j)=L(j)+Ip*vp(j) - enddo - enddo - do j=1,3 - incr(j)=d_t(j,0) - enddo - do i=nnt,nct - iti=itype(i) - inres=i+nres - do j=1,3 - pr(j)=c(j,inres)-cm(j) - enddo - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - else - do j=1,3 - v(j)=incr(j) - enddo - endif - call vecpr(pr(1),v(1),vp) -c write (iout,*) "i",i," iti",iti," pr",(pr(j),j=1,3), -c & " v",(v(j),j=1,3)," vp",(vp(j),j=1,3) - do j=1,3 - L(j)=L(j)+msc(iti)*vp(j) - enddo -c write (iout,*) "L",(l(j),j=1,3) - if (itype(i).ne.10) then - do j=1,3 - v(j)=incr(j)+d_t(j,inres) - enddo - call vecpr(dc(1,inres),d_t(1,inres),vp) - do j=1,3 - L(j)=L(j)+Isc(iti)*vp(j) - enddo - endif - do j=1,3 - incr(j)=incr(j)+d_t(j,i) - enddo - enddo - return - end -c------------------------------------------------------------------------------ - subroutine vcm_vel(vcm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.MD' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision vcm(3),vv(3),summas,amas - do j=1,3 - vcm(j)=0.0d0 - vv(j)=d_t(j,0) - enddo - summas=0.0d0 - do i=nnt,nct - if (i.lt.nct) then - summas=summas+mp - do j=1,3 - vcm(j)=vcm(j)+mp*(vv(j)+0.5d0*d_t(j,i)) - enddo - endif - amas=msc(itype(i)) - summas=summas+amas - if (itype(i).ne.10) then - do j=1,3 - vcm(j)=vcm(j)+amas*(vv(j)+d_t(j,i+nres)) - enddo - else - do j=1,3 - vcm(j)=vcm(j)+amas*vv(j) - enddo - endif - do j=1,3 - vv(j)=vv(j)+d_t(j,i) - enddo - enddo -c write (iout,*) "vcm",(vcm(j),j=1,3)," summas",summas - do j=1,3 - vcm(j)=vcm(j)/summas - enddo - return - end diff --git a/source/unres/src_MD-restraints/muca_md.f b/source/unres/src_MD-restraints/muca_md.f deleted file mode 100644 index c10a6a7..0000000 --- a/source/unres/src_MD-restraints/muca_md.f +++ /dev/null @@ -1,334 +0,0 @@ - subroutine muca_delta(remd_t_bath,remd_ene,i,iex,delta) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision remd_t_bath(maxprocs) - double precision remd_ene(maxprocs) - double precision muca_ene - double precision betai,betaiex,delta - - betai=1.0/(Rb*remd_t_bath(i)) - betaiex=1.0/(Rb*remd_t_bath(iex)) - - delta=betai*(muca_ene(remd_ene(iex),i,remd_t_bath)- - & muca_ene(remd_ene(i),i,remd_t_bath)) - & -betaiex*(muca_ene(remd_ene(iex),iex,remd_t_bath)- - & muca_ene(remd_ene(i),iex,remd_t_bath)) - - return - end - - double precision function muca_ene(energy,i,remd_t_bath) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.MD' - double precision y,yp,energy - double precision remd_t_bath(maxprocs) - integer i - - if (energy.lt.elowi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,elowi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-elowi(i))+y) - elseif (energy.gt.ehighi(i)) then - call splint(emuca,nemuca,nemuca2,nmuca,ehighi(i),y,yp) - muca_ene=remd_t_bath(i)*Rb*(yp*(energy-ehighi(i))+y) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - muca_ene=remd_t_bath(i)*Rb*y - endif - return - end - - subroutine read_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - imtime=0 - do i=1,4*maxres - hist(i)=0 - enddo - if (modecalc.eq.14.and..not.remd_tlist) then - print *,"MUCAREMD works only with TLIST" - stop - endif - open(89,file='muca.input') - read(89,*) - read(89,*) - if (modecalc.eq.14) then - read(89,*) (elowi(i),ehighi(i),i=1,nrep) - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - elow=elowi(i2rep(me)) - ehigh=ehighi(i2rep(me)) - elowi(me+1)=elow - ehighi(me+1)=ehigh - else - elow=elowi(me+1) - ehigh=ehighi(me+1) - endif - else - read(89,*) elow,ehigh - elowi(1)=elow - ehighi(1)=ehigh - endif - i=0 - do while(.true.) - i=i+1 - read(89,*,end=100) emuca(i),nemuca(i) -cd nemuca(i)=nemuca(i)*remd_t(me+1)*Rb - enddo - 100 continue - nmuca=i-1 - hbin=emuca(nmuca)-emuca(nmuca-1) - write (iout,*) 'hbin',hbin - write (iout,*) me,'elow,ehigh',elow,ehigh - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - factor_min=0.0d0 - factor_min=muca_factor(ehigh) - call print_muca - return - end - - - subroutine print_muca - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision yp1,ypn,yp,x,muca_factor,y,muca_ene - double precision dummy(maxprocs) - - if (remd_mlist) then - k=0 - do i=1,nrep - do j=1,remd_m(i) - i2rep(k)=i - k=k+1 - enddo - enddo - endif - - do i=1,nmuca -c print *,'nemuca ',emuca(i),nemuca(i) - do j=0,4 - x=emuca(i)+hbin/5*j - if (modecalc.eq.14) then - if (remd_mlist) then - yp=muca_factor(x)*remd_t(i2rep(me))*Rb - dummy(me+1)=remd_t(i2rep(me)) - y=muca_ene(x,me+1,dummy) - else - yp=muca_factor(x)*remd_t(me+1)*Rb - y=muca_ene(x,me+1,remd_t) - endif - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - else - yp=muca_factor(x)*t_bath*Rb - dummy(1)=t_bath - y=muca_ene(x,1,dummy) - write (iout,'(i4,i12,a12,2f15.5,a10,f15.5)') me,imtime, - & 'muca factor ',x,yp,' muca ene',y - endif - enddo - enddo - if(mucadyn.gt.0) then - do i=1,nmuca - write(iout,'(a13,i8,2f12.5)') 'nemuca after ', - & imtime,emuca(i),nemuca(i) - enddo - endif - return - end - - subroutine muca_update(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - include 'COMMON.CONTROL' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - double precision energy - double precision yp1,ypn - integer k - logical lnotend - - k=int((energy-emuca(1))/hbin)+1 - - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN - if(energy.ge.ehigh) - & write (iout,*) 'MUCA reject',energy,emuca(k) - if(energy.ge.ehigh.and.(energy-ehigh).lt.hbin) then - write (iout,*) 'MUCA ehigh',energy,emuca(k) - do i=k,nmuca - hist(i)=hist(i)+1 - enddo - endif - if(k.gt.0.and.energy.lt.ehigh) hist(k)=hist(k)+1 - ELSE - if(k.gt.0.and.k.lt.4*maxres) hist(k)=hist(k)+1 - ENDIF - if(mod(imtime,mucadyn).eq.0) then - - do i=1,nmuca - IF(muca_smooth.eq.2.or.muca_smooth.eq.3) THEN - nemuca(i)=nemuca(i)+dlog(hist(i)+1) - ELSE - if (hist(i).gt.0) hist(i)=dlog(hist(i)) - nemuca(i)=nemuca(i)+hist(i) - ENDIF - hist(i)=0 - write(iout,'(a24,i8,2f12.5)')'nemuca before smoothing ', - & imtime,emuca(i),nemuca(i) - enddo - - - lnotend=.true. - ismooth=0 - ist=2 - ien=nmuca-1 - IF(muca_smooth.eq.1.or.muca_smooth.eq.3) THEN -c lnotend=.false. -c do i=1,nmuca-1 -c do j=i+1,nmuca -c if(nemuca(j).lt.nemuca(i)) lnotend=.true. -c enddo -c enddo - do while(lnotend) - ismooth=ismooth+1 - write (iout,*) 'MUCA update smoothing',ist,ien - do i=ist,ien - nemuca(i)=(nemuca(i-1)+nemuca(i)+nemuca(i+1))/3 - enddo - lnotend=.false. - ist=0 - ien=0 - do i=1,nmuca-1 - do j=i+1,nmuca - if(nemuca(j).lt.nemuca(i)) then - lnotend=.true. - if(ist.eq.0) ist=i-1 - if(ien.lt.j+1) ien=j+1 - endif - enddo - enddo - enddo - ENDIF - - write (iout,*) 'MUCA update ',imtime,' smooth= ',ismooth - yp1=0 - ypn=0 - call spline(emuca,nemuca,nmuca,yp1,ypn,nemuca2) - call print_muca - - endif - return - end - - double precision function muca_factor(energy) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MUCA' - double precision y,yp,energy - - if (energy.lt.elow) then - call splint(emuca,nemuca,nemuca2,nmuca,elow,y,yp) - elseif (energy.gt.ehigh) then - call splint(emuca,nemuca,nemuca2,nmuca,ehigh,y,yp) - else - call splint(emuca,nemuca,nemuca2,nmuca,energy,y,yp) - endif - - if(yp.ge.factor_min) then - muca_factor=yp - else - muca_factor=factor_min - endif -cd print *,'energy, muca_factor',energy,muca_factor - return - end - - - SUBROUTINE spline(x,y,n,yp1,ypn,y2) - INTEGER n,NMAX - REAL*8 yp1,ypn,x(n),y(n),y2(n) - PARAMETER (NMAX=500) - INTEGER i,k - REAL*8 p,qn,sig,un,u(NMAX) - if (yp1.gt..99e30) then - y2(1)=0. - u(1)=0. - else - y2(1)=-0.5 - u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1) - endif - do i=2,n-1 - sig=(x(i)-x(i-1))/(x(i+1)-x(i-1)) - p=sig*y2(i-1)+2. - y2(i)=(sig-1.)/p - u(i)=(6.*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1)) - * /(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p - enddo - if (ypn.gt..99e30) then - qn=0. - un=0. - else - qn=0.5 - un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1))) - endif - y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.) - do k=n-1,1,-1 - y2(k)=y2(k)*y2(k+1)+u(k) - enddo - return - END - - - SUBROUTINE splint(xa,ya,y2a,n,x,y,yp) - INTEGER n - REAL*8 x,y,xa(n),y2a(n),ya(n),yp - INTEGER k,khi,klo - REAL*8 a,b,h - klo=1 - khi=n - 1 if (khi-klo.gt.1) then - k=(khi+klo)/2 - if (xa(k).gt.x) then - khi=k - else - klo=k - endif - goto 1 - endif - h=xa(khi)-xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' - a=(xa(khi)-x)/h - b=(x-xa(klo))/h - y=a*ya(klo)+b*ya(khi)+ - * ((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h**2)/6. - yp=-ya(klo)/h+ya(khi)/h-3*(a**2)*y2a(klo)*h/6. - + +(3*(b**2)-1)*y2a(khi)*h/6. - return - END diff --git a/source/unres/src_MD-restraints/parmread.F b/source/unres/src_MD-restraints/parmread.F deleted file mode 100644 index 030d64e..0000000 --- a/source/unres/src_MD-restraints/parmread.F +++ /dev/null @@ -1,1036 +0,0 @@ - subroutine parmread -C -C Read the parameters of the probability distributions of the virtual-bond -C valence angles and the side chains and energy parameters. -C -C Important! Energy-term weights ARE NOT read here; they are read from the -C main input file instead, because NO defaults have yet been set for these -C parameters. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - integer IERROR -#endif - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.TORSION' - include 'COMMON.SCCOR' - include 'COMMON.SCROT' - include 'COMMON.FFIELD' - include 'COMMON.NAMES' - include 'COMMON.SBRIDGE' - include 'COMMON.MD' - include 'COMMON.SETUP' - character*1 t1,t2,t3 - character*1 onelett(4) /"G","A","P","D"/ - logical lprint,LaTeX - dimension blower(3,3,maxlob) - dimension b(13) - character*3 lancuch,ucase -C -C For printing parameters after they are read set the following in the UNRES -C C-shell script: -C -C setenv PRINT_PARM YES -C -C To print parameters in LaTeX format rather than as ASCII tables: -C -C setenv LATEX YES -C - call getenv_loc("PRINT_PARM",lancuch) - lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - call getenv_loc("LATEX",lancuch) - LaTeX = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") -C - dwa16=2.0d0**(1.0d0/6.0d0) - itypro=20 -C Assign virtual-bond length - vbl=3.8D0 - vblinv=1.0D0/vbl - vblinv2=vblinv*vblinv -c -c Read the virtual-bond parameters, masses, and moments of inertia -c and Stokes' radii of the peptide group and side chains -c -#ifdef CRYST_BOND - read (ibond,*) vbldp0,akp,mp,ip,pstok - do i=1,ntyp - nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#else - read (ibond,*) junk,vbldp0,akp,rjunk,mp,ip,pstok - do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)),msc(i),isc(i),restok(i) - dsc(i) = vbldsc0(1,i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - enddo -#endif - if (lprint) then - write(iout,'(/a/)')"Dynamic constants of the interaction sites:" - write (iout,'(a10,a3,6a10)') 'Type','N','VBL','K','A0','mass', - & 'inertia','Pstok' - write(iout,'(a10,i3,6f10.5)') "p",1,vbldp0,akp,0.0d0,mp,ip,pstok - do i=1,ntyp - write (iout,'(a10,i3,6f10.5)') restyp(i),nbondterm(i), - & vbldsc0(1,i),aksc(1,i),abond0(1,i),msc(i),isc(i),restok(i) - do j=2,nbondterm(i) - write (iout,'(13x,3f10.5)') - & vbldsc0(j,i),aksc(j,i),abond0(j,i) - enddo - enddo - endif -#ifdef CRYST_THETA -C -C Read the parameters of the probability distribution/energy expression -C of the virtual-bond valence angles theta -C - do i=1,ntyp - read (ithep,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - close (ithep) - if (lprint) then - if (.not.LaTeX) then - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') 'Fourier coefficients:', - & ' ATHETA0 ',' A1 ',' A2 ', - & ' B1 ',' B2 ' - do i=1,ntyp - write(iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' ALPH0 ',' ALPH1 ',' ALPH2 ', - & ' ALPH3 ',' SIGMA0C ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i, - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' THETA0 ',' SIGMA0 ',' G1 ', - & ' G2 ',' G3 ' - do i=1,ntyp - write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), - & sig0(i),(gthet(j,i),j=1,3) - enddo - else - write (iout,'(a)') - & 'Parameters of the virtual-bond valence angles:' - write (iout,'(/a/9x,5a/79(1h-))') - & 'Coefficients of expansion', - & ' theta0 ',' a1*10^2 ',' a2*10^2 ', - & ' b1*10^1 ',' b2*10^1 ' - do i=1,ntyp - write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the expression for sigma(theta_c):', - & ' alpha0 ',' alph1 ',' alph2 ', - & ' alhp3 ',' sigma0c ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(1pe12.3,1h&))') restyp(i), - & (polthet(j,i),j=0,3),sigc0(i) - enddo - write (iout,'(/a/9x,5a/79(1h-))') - & 'Parameters of the second gaussian:', - & ' theta0 ',' sigma0*10^2 ',' G1*10^-1', - & ' G2 ',' G3*10^1 ' - do i=1,ntyp - write (iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i),theta0(i), - & 100*sig0(i),gthet(1,i)*0.1D0,gthet(2,i),gthet(3,i)*10.0D0 - enddo - endif - endif -#else -C -C Read the parameters of Utheta determined from ab initio surfaces -C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 -C - read (ithep,*,err=111,end=111) nthetyp,ntheterm,ntheterm2, - & ntheterm3,nsingle,ndouble - nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*,err=111,end=111) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 - do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 - enddo - do l=1,ntheterm2 - do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 - enddo - enddo - do l=1,ntheterm3 - do m=1,ndouble - do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 - enddo - enddo - enddo - enddo - enddo - enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)',end=111,err=111) res1,res2,res3 - read (ithep,*,end=111,err=111) aa0thet(i,j,k) - read (ithep,*,end=111,err=111)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*,end=111,err=111) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*,end=111,err=111) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), - & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) - enddo - enddo - enddo -C -C For dummy ends assign glycine-type coefficients of theta-only terms; the -C coefficients of theta-and-gamma-dependent terms are zero. -C - do i=1,nthetyp - do j=1,nthetyp - do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) - enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) - enddo - do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) - enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) - enddo -C -C Control printout of the coefficients of virtual-bond-angle potentials -C - if (lprint) then - write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' - do i=1,nthetyp+1 - do j=1,nthetyp+1 - do k=1,nthetyp+1 - write (iout,'(//4a)') - & 'Type ',onelett(i),onelett(j),onelett(k) - write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) - write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) - do l=1,ntheterm2 - write (iout,'(//2h m,4(9x,a,3h[m,,i1,1h]))') - & "b",l,"c",l,"d",l,"e",l - do m=1,nsingle - write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) - enddo - enddo - do l=1,ntheterm3 - write (iout,'(//3hm,n,4(6x,a,5h[m,n,,i1,1h]))') - & "f+",l,"f-",l,"g+",l,"g-",l - do m=2,ndouble - do n=1,m-1 - write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) - enddo - enddo - enddo - enddo - enddo - enddo - call flush(iout) - endif - write (2,*) "Start reading THETA_PDB" - do i=1,ntyp - read (ithep_pdb,*,err=111,end=111) a0thet(i),(athet(j,i),j=1,2), - & (bthet(j,i),j=1,2) - read (ithep_pdb,*,err=111,end=111) (polthet(j,i),j=0,3) - read (ithep_pdb,*,err=111,end=111) (gthet(j,i),j=1,3) - read (ithep_pdb,*,err=111,end=111) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 - enddo - write (2,*) "End reading THETA_PDB" - close (ithep_pdb) -#endif - close(ithep) -#ifdef CRYST_SC -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam,*,end=112,err=112) bsc(j,i) - read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam) - if (lprint) then - write (iout,'(/a)') 'Parameters of side-chain local geometry' - do i=1,ntyp - nlobi=nlob(i) - if (nlobi.gt.0) then - if (LaTeX) then - write (iout,'(/3a,i2,a,f8.3)') 'Residue type: ',restyp(i), - & ' # of gaussian lobes:',nlobi,' dsc:',dsc(i) - write (iout,'(1h&,a,3(2h&&,f8.3,2h&&))') - & 'log h',(bsc(j,i),j=1,nlobi) - write (iout,'(1h&,a,3(1h&,f8.3,1h&,f8.3,1h&,f8.3,1h&))') - & 'x',((censc(k,j,i),k=1,3),j=1,nlobi) - do k=1,3 - write (iout,'(2h& ,5(2x,1h&,3(f7.3,1h&)))') - & ((gaussc(k,l,j,i),l=1,3),j=1,nlobi) - enddo - else - write (iout,'(/a,8x,i1,4(25x,i1))') 'Lobe:',(j,j=1,nlobi) - write (iout,'(a,f10.4,4(16x,f10.4))') - & 'Center ',(bsc(j,i),j=1,nlobi) - write (iout,'(5(2x,3f8.4))') ((censc(k,j,i),k=1,3), - & j=1,nlobi) - write (iout,'(a)') - endif - endif - enddo - endif -#else -C -C Read scrot parameters for potentials determined from all-atom AM1 calculations -C added by Urszula Kozlowska 07/11/2007 -C - do i=1,ntyp - read (irotam,*,end=112,err=112) - if (i.eq.10) then - read (irotam,*,end=112,err=112) - else - do j=1,65 - read(irotam,*,end=112,err=112) sc_parmin(j,i) - enddo - endif - enddo -C -C Read the parameters of the probability distribution/energy expression -C of the side chains. -C - do i=1,ntyp - read (irotam_pdb,'(3x,i3,f8.3)',end=112,err=112) nlob(i),dsc(i) - if (i.eq.10) then - dsc_inv(i)=0.0D0 - else - dsc_inv(i)=1.0D0/dsc(i) - endif - if (i.ne.10) then - do j=1,nlob(i) - do k=1,3 - do l=1,3 - blower(l,k,j)=0.0D0 - enddo - enddo - enddo - bsc(1,i)=0.0D0 - read(irotam_pdb,*,end=112,err=112)(censc(k,1,i),k=1,3), - & ((blower(k,l,1),l=1,k),k=1,3) - do j=2,nlob(i) - read (irotam_pdb,*,end=112,err=112) bsc(j,i) - read (irotam_pdb,*,end=112,err=112) (censc(k,j,i),k=1,3), - & ((blower(k,l,j),l=1,k),k=1,3) - enddo - do j=1,nlob(i) - do k=1,3 - do l=1,k - akl=0.0D0 - do m=1,3 - akl=akl+blower(k,m,j)*blower(l,m,j) - enddo - gaussc(k,l,j,i)=akl - gaussc(l,k,j,i)=akl - enddo - enddo - enddo - endif - enddo - close (irotam_pdb) -#endif - close(irotam) - -#ifdef CRYST_TOR -C -C Read torsional parameters in old format -C - read (itorp,*,end=113,err=113) ntortyp,nterm_old - if (lprint)write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) - do i=1,ntortyp - do j=1,ntortyp - read (itorp,'(a)') - do k=1,nterm_old - read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) - enddo - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,'(2i3,6f10.5)') i,j,(v1(k,i,j),k=1,nterm_old) - write (iout,'(6x,6f10.5)') (v2(k,i,j),k=1,nterm_old) - enddo - enddo - endif -#else -C -C Read torsional parameters -C - read (itorp,*,end=113,err=113) ntortyp - read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*,end=113,err=113) nterm(i,j),nlor(i,j) - v0ij=0.0d0 - si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*,end=113,err=113) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) - si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), - & vlor2(k,i,j),vlor3(k,i,j) - v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) - enddo - v0(i,j)=v0ij - enddo - enddo - close (itorp) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) - enddo - enddo - enddo - endif -C -C 6/23/01 Read parameters for double torsionals -C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then - write (iout,*) "Error in double torsional parameter file", - & i,j,k,t1,t2,t3 -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop "Error in double torsional parameter file" - endif - read (itordp,*,end=114,err=114) ntermd_1(i,j,k), - & ntermd_2(i,j,k) - read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k),l=1, - & ntermd_1(i,j,k)) - read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k), - & v2c(m,l,i,j,k),v2s(l,m,i,j,k),v2s(m,l,i,j,k), - & m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) - write (iout,*) - write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) - enddo - write (iout,*) - write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) - enddo - write (iout,*) - enddo - enddo - enddo - endif -#endif -C Read of Side-chain backbone correlation parameters -C Modified 11 May 2012 by Adasko -CCC -C - read (isccor,*,end=1113,err=1113) nsccortyp - read (isccor,*,end=1113,err=1113) (isccortyp(i),i=1,ntyp) -c write (iout,*) 'ntortyp',ntortyp - maxinter=3 -cc maxinter is maximum interaction sites - do l=1,maxinter - do i=1,nsccortyp - do j=1,nsccortyp - read (isccor,*,end=1113,err=1113) nterm_sccor(i,j), - & nlor_sccor(i,j) - v0ijsccor=0.0d0 - si=-1.0d0 - - do k=1,nterm_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk,v1sccor(k,l,i,j) - & ,v2sccor(k,l,i,j) - v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) - si=-si - enddo - do k=1,nlor_sccor(i,j) - read (isccor,*,end=1113,err=1113) kk,vlor1sccor(k,i,j), - & vlor2sccor(k,i,j),vlor3sccor(k,i,j) - v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ - &(1+vlor3sccor(k,i,j)**2) - enddo - v0sccor(i,j)=v0ijsccor - enddo - enddo - enddo - close (isccor) - - if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,nsccortyp - do j=1,nsccortyp - write (iout,*) 'ityp',i,' jtyp',j - write (iout,*) 'Fourier constants' - do k=1,nterm_sccor(i,j) - write (iout,'(2(1pe15.5))') v1sccor(k,l,i,j),v2sccor(k,l,i,j) - enddo - write (iout,*) 'Lorenz constants' - do k=1,nlor_sccor(i,j) - write (iout,'(3(1pe15.5))') - & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) - enddo - enddo - enddo - endif -C -C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - if (lprint) then - write (iout,*) - write (iout,*) "Coefficients of the cumulants" - endif - read (ifourier,*) nloctyp - do i=1,nloctyp - read (ifourier,*,end=115,err=115) - read (ifourier,*,end=115,err=115) (b(ii),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii),ii=1,13) - endif - B1(1,i) = b(3) - B1(2,i) = b(5) -c b1(1,i)=0.0d0 -c b1(2,i)=0.0d0 - B1tilde(1,i) = b(3) - B1tilde(2,i) =-b(5) -c b1tilde(1,i)=0.0d0 -c b1tilde(2,i)=0.0d0 - B2(1,i) = b(2) - B2(2,i) = b(4) -c b2(1,i)=0.0d0 -c b2(2,i)=0.0d0 - CC(1,1,i)= b(7) - CC(2,2,i)=-b(7) - CC(2,1,i)= b(9) - CC(1,2,i)= b(9) -c CC(1,1,i)=0.0d0 -c CC(2,2,i)=0.0d0 -c CC(2,1,i)=0.0d0 -c CC(1,2,i)=0.0d0 - Ctilde(1,1,i)=b(7) - Ctilde(1,2,i)=b(9) - Ctilde(2,1,i)=-b(9) - Ctilde(2,2,i)=b(7) -c Ctilde(1,1,i)=0.0d0 -c Ctilde(1,2,i)=0.0d0 -c Ctilde(2,1,i)=0.0d0 -c Ctilde(2,2,i)=0.0d0 - DD(1,1,i)= b(6) - DD(2,2,i)=-b(6) - DD(2,1,i)= b(8) - DD(1,2,i)= b(8) -c DD(1,1,i)=0.0d0 -c DD(2,2,i)=0.0d0 -c DD(2,1,i)=0.0d0 -c DD(1,2,i)=0.0d0 - Dtilde(1,1,i)=b(6) - Dtilde(1,2,i)=b(8) - Dtilde(2,1,i)=-b(8) - Dtilde(2,2,i)=b(6) -c Dtilde(1,1,i)=0.0d0 -c Dtilde(1,2,i)=0.0d0 -c Dtilde(2,1,i)=0.0d0 -c Dtilde(2,2,i)=0.0d0 - EE(1,1,i)= b(10)+b(11) - EE(2,2,i)=-b(10)+b(11) - EE(2,1,i)= b(12)-b(13) - EE(1,2,i)= b(12)+b(13) -c ee(1,1,i)=1.0d0 -c ee(2,2,i)=1.0d0 -c ee(2,1,i)=0.0d0 -c ee(1,2,i)=0.0d0 -c ee(2,1,i)=ee(1,2,i) - enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) - enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) - enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) - enddo - enddo - endif -C -C Read electrostatic-interaction parameters -C - if (lprint) then - write (iout,*) - write (iout,'(/a)') 'Electrostatic interaction constants:' - write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') - & 'IT','JT','APP','BPP','AEL6','AEL3' - endif - read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) - close (ielep) - do i=1,2 - do j=1,2 - rri=rpp(i,j)**6 - app (i,j)=epp(i,j)*rri*rri - bpp (i,j)=-2.0D0*epp(i,j)*rri - ael6(i,j)=elpp6(i,j)*4.2D0**6 - ael3(i,j)=elpp3(i,j)*4.2D0**3 - if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), - & ael6(i,j),ael3(i,j) - enddo - enddo -C -C Read side-chain interaction parameters. -C - read (isidep,*,end=117,err=117) ipot,expon - if (ipot.lt.1 .or. ipot.gt.5) then - write (iout,'(2a)') 'Error while reading SC interaction', - & 'potential file - unknown potential type.' -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - endif - expon2=expon/2 - if(me.eq.king) - & write(iout,'(/3a,2i3)') 'Potential is ',potname(ipot), - & ', exponents are ',expon,2*expon - goto (10,20,30,30,40) ipot -C----------------------- LJ potential --------------------------------- - 10 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJ potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,a)') 'residue','sigma' - write (iout,'(a3,6x,f10.5)') (restyp(i),sigma0(i),i=1,ntyp) - endif - goto 50 -C----------------------- LJK potential -------------------------------- - 20 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the LJK potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,2a)') 'residue',' sigma ',' r0 ' - write (iout,'(a3,6x,2f10.5)') (restyp(i),sigma0(i),rr0(i), - & i=1,ntyp) - endif - goto 50 -C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip(i),i=1,ntyp), - & (alp(i),i=1,ntyp) -C For the GB potential convert sigma'**2 into chi' - if (ipot.eq.4) then - do i=1,ntyp - chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) - enddo - endif - if (lprint) then - write (iout,'(/a/)') 'Parameters of the BP potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,4a)') 'residue',' sigma ','s||/s_|_^2', - & ' chip ',' alph ' - write (iout,'(a3,6x,4f10.5)') (restyp(i),sigma0(i),sigii(i), - & chip(i),alp(i),i=1,ntyp) - endif - goto 50 -C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*,end=116,err=116)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) - if (lprint) then - write (iout,'(/a/)') 'Parameters of the GBV potential:' - write (iout,'(a/)') 'The epsilon array:' - call printmat(ntyp,ntyp,ntyp,iout,restyp,eps) - write (iout,'(/a)') 'One-body parameters:' - write (iout,'(a,4x,5a)') 'residue',' sigma ',' r0 ', - & 's||/s_|_^2',' chip ',' alph ' - write (iout,'(a3,6x,5f10.5)') (restyp(i),sigma0(i),rr0(i), - & sigii(i),chip(i),alp(i),i=1,ntyp) - endif - 50 continue - close (isidep) -C----------------------------------------------------------------------- -C Calculate the "working" parameters of SC interactions. - do i=2,ntyp - do j=1,i-1 - eps(i,j)=eps(j,i) - enddo - enddo - do i=1,ntyp - do j=i,ntyp - sigma(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2) - sigma(j,i)=sigma(i,j) - rs0(i,j)=dwa16*sigma(i,j) - rs0(j,i)=rs0(i,j) - enddo - enddo - if (lprint) write (iout,'(/a/10x,7a/72(1h-))') - & 'Working parameters of the SC interactions:', - & ' a ',' b ',' augm ',' sigma ',' r0 ', - & ' chi1 ',' chi2 ' - do i=1,ntyp - do j=i,ntyp - epsij=eps(i,j) - if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - rrij=sigma(i,j) - else - rrij=rr0(i)+rr0(j) - endif - r0(i,j)=rrij - r0(j,i)=rrij - rrij=rrij**expon - epsij=eps(i,j) - sigeps=dsign(1.0D0,epsij) - epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) - if (ipot.gt.2) then - sigt1sq=sigma0(i)**2 - sigt2sq=sigma0(j)**2 - sigii1=sigii(i) - sigii2=sigii(j) - ratsig1=sigt2sq/sigt1sq - ratsig2=1.0D0/ratsig1 - chi(i,j)=(sigii1-1.0D0)/(sigii1+ratsig1) - if (j.gt.i) chi(j,i)=(sigii2-1.0D0)/(sigii2+ratsig2) - rsum_max=dsqrt(sigii1*sigt1sq+sigii2*sigt2sq) - else - rsum_max=sigma(i,j) - endif -c if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then - sigmaii(i,j)=rsum_max - sigmaii(j,i)=rsum_max -c else -c sigmaii(i,j)=r0(i,j) -c sigmaii(j,i)=r0(i,j) -c endif -cd write (iout,*) i,j,r0(i,j),sigma(i,j),rsum_max - if ((ipot.eq.2 .or. ipot.eq.5) .and. r0(i,j).gt.rsum_max) then - r_augm=sigma(i,j)*(rrij-sigma(i,j))/rrij - augm(i,j)=epsij*r_augm**(2*expon) -c augm(i,j)=0.5D0**(2*expon)*aa(i,j) - augm(j,i)=augm(i,j) - else - augm(i,j)=0.0D0 - augm(j,i)=0.0D0 - endif - if (lprint) then - write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), - & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) - endif - enddo - enddo -#ifdef OLDSCP -C -C Define the SC-p interaction constants (hard-coded; old style) -C - do i=1,20 -C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates -C helix formation) -c aad(i,1)=0.3D0*4.0D0**12 -C Following line for constants currently implemented -C "Hard" SC-p repulsion (gives correct turn spacing in helices) - aad(i,1)=1.5D0*4.0D0**12 -c aad(i,1)=0.17D0*5.6D0**12 - aad(i,2)=aad(i,1) -C "Soft" SC-p repulsion - bad(i,1)=0.0D0 -C Following line for constants currently implemented -c aad(i,1)=0.3D0*4.0D0**6 -C "Hard" SC-p repulsion - bad(i,1)=3.0D0*4.0D0**6 -c bad(i,1)=-2.0D0*0.17D0*5.6D0**6 - bad(i,2)=bad(i,1) -c aad(i,1)=0.0D0 -c aad(i,2)=0.0D0 -c bad(i,1)=1228.8D0 -c bad(i,2)=1228.8D0 - enddo -#else -C -C 8/9/01 Read the SC-p interaction constants from file -C - do i=1,ntyp - read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) - enddo - do i=1,ntyp - aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 - aad(i,2)=dabs(eps_scp(i,2))*rscp(i,2)**12 - bad(i,1)=-2*eps_scp(i,1)*rscp(i,1)**6 - bad(i,2)=-2*eps_scp(i,2)*rscp(i,2)**6 - enddo - - if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" - do i=1,20 - write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), - & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) - enddo - endif -#endif -C -C Define the constants of the disulfide bridge -C - ebr=-5.50D0 -c -c Old arbitrary potential - commented out. -c -c dbr= 4.20D0 -c fbr= 3.30D0 -c -c Constants of the disulfide-bond potential determined based on the RHF/6-31G** -c energy surface of diethyl disulfide. -c A. Liwo and U. Kozlowska, 11/24/03 -c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 -c akcm=0.0d0 -c akth=0.0d0 -c akct=0.0d0 -c v1ss=0.0d0 -c v2ss=0.0d0 -c v3ss=0.0d0 - - if(me.eq.king) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif - return - 111 write (iout,*) "Error reading bending energy parameters." - goto 999 - 112 write (iout,*) "Error reading rotamer energy parameters." - goto 999 - 113 write (iout,*) "Error reading torsional energy parameters." - goto 999 - 1113 write (iout,*) - & "Error reading side-chain torsional energy parameters." - goto 999 - 114 write (iout,*) "Error reading double torsional energy parameters." - goto 999 - 115 write (iout,*) - & "Error reading cumulant (multibody energy) parameters." - goto 999 - 116 write (iout,*) "Error reading electrostatic energy parameters." - goto 999 - 117 write (iout,*) "Error reading side chain interaction parameters." - goto 999 - 118 write (iout,*) "Error reading SCp interaction parameters." - goto 999 - 119 write (iout,*) "Error reading SCCOR parameters" - 999 continue -#ifdef MPI - call MPI_Finalize(Ierror) -#endif - stop - return - end - - - subroutine getenv_loc(var, val) - character(*) var, val - -#ifdef WINIFL - character(2000) line - external ilen - - open (196,file='env',status='old',readonly,shared) - iread=0 -c write(*,*)'looking for ',var -10 read(196,*,err=11,end=11)line - iread=index(line,var) -c write(*,*)iread,' ',var,' ',line - if (iread.eq.0) go to 10 -c write(*,*)'---> ',line -11 continue - if(iread.eq.0) then -c write(*,*)'CHUJ' - val='' - else - iread=iread+ilen(var)+1 - read (line(iread:),*,err=12,end=12) val -c write(*,*)'OK: ',var,' = ',val - endif - close(196) - return -12 val='' - close(196) -#elif (defined CRAY) - integer lennam,lenval,ierror -c -c getenv using a POSIX call, useful on the T3D -c Sept 1996, comment out error check on advice of H. Pritchard -c - lennam = len(var) - if(lennam.le.0) stop '--error calling getenv--' - call pxfgetenv(var,lennam,val,lenval,ierror) -c-HP- if(ierror.ne.0) stop '--error returned by pxfgetenv--' -#else - call getenv(var,val) -#endif - - return - end diff --git a/source/unres/src_MD-restraints/pinorm.f b/source/unres/src_MD-restraints/pinorm.f deleted file mode 100644 index 91392bf..0000000 --- a/source/unres/src_MD-restraints/pinorm.f +++ /dev/null @@ -1,17 +0,0 @@ - double precision function pinorm(x) - implicit real*8 (a-h,o-z) -c -c this function takes an angle (in radians) and puts it in the range of -c -pi to +pi. -c - integer n - include 'COMMON.GEO' - n = x / dwapi - pinorm = x - n * dwapi - if ( pinorm .gt. pi ) then - pinorm = pinorm - dwapi - else if ( pinorm .lt. - pi ) then - pinorm = pinorm + dwapi - end if - return - end diff --git a/source/unres/src_MD-restraints/printmat.f b/source/unres/src_MD-restraints/printmat.f deleted file mode 100644 index be2b38f..0000000 --- a/source/unres/src_MD-restraints/printmat.f +++ /dev/null @@ -1,16 +0,0 @@ - subroutine printmat(ldim,m,n,iout,key,a) - character*3 key(n) - double precision a(ldim,n) - do 1 i=1,n,8 - nlim=min0(i+7,n) - write (iout,1000) (key(k),k=i,nlim) - write (iout,1020) - 1000 format (/5x,8(6x,a3)) - 1020 format (/80(1h-)/) - do 2 j=1,n - write (iout,1010) key(j),(a(j,k),k=i,nlim) - 2 continue - 1 continue - 1010 format (a3,2x,8(f9.4)) - return - end diff --git a/source/unres/src_MD-restraints/prng.f b/source/unres/src_MD-restraints/prng.f deleted file mode 100644 index 73f6766..0000000 --- a/source/unres/src_MD-restraints/prng.f +++ /dev/null @@ -1,525 +0,0 @@ - real*8 function prng_next(me) - implicit none - integer me -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end diff --git a/source/unres/src_MD-restraints/prng_32.F b/source/unres/src_MD-restraints/prng_32.F deleted file mode 100644 index 9448f31..0000000 --- a/source/unres/src_MD-restraints/prng_32.F +++ /dev/null @@ -1,1077 +0,0 @@ -#if defined(AIX) || defined(AMD64) - real*8 function prng_next(mel) - implicit none - integer me,mel -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (mel, iseed) - implicit none - integer me,mel - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if(mel.gt.nmax) then - me=mod(mel,nmax) - else - me=mel - endif - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end -#else - real function prng_next(me) -crc logical prng_restart, prng_chkpnt -c -c Calling sequence: -c = prng_next ( ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses 4 16-bit packets, and uses a block data common -c area for the initial seeds and constants. A 64-bit floating point -c number is returned. -c -c The arrays "l" and "n" are full-word aligned, being padded by zeros -c That is, rows 1-4 in a given column are for real, rows 5-16 are bogus -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c - real tpm12 - integer iseed(4) - parameter(tpm12 = 1.d0/65536.d0) - parameter(nmax=1021) -c external prngblk - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - data m1,m2,m3,m4 / 0, 8037, 61950, 30779/ - if (me .lt. 0 .or. me .gt. nmax) then - prng_next=-1.0 - return - endif - l1=l(1,me) - l2=l(2,me) - l3=l(3,me) - l4=l(4,me) - i1=l1*m4+l2*m3+l3*m2+l4*m1 + n(1,me) - i2=l2*m4+l3*m3+l4*m2 + n(2,me) - i3=l3*m4+l4*m3 + n(3,me) - i4=l4*m4 + n(4,me) - l4=and(i4,65535) - i3=i3+ishft(i4,-16) - l3=and(i3,65535) - i2=i2+ishft(i3,-16) - l2=and(i2,65535) - l1=and(i1+ishft(i2,-16),65535) - prng_next=tpm12*(l1+tpm12*(l2+tpm12*(l3+tpm12*l4))) - l(1,me)=l1 - l(2,me)=l2 - l(3,me)=l3 - l(4,me)=l4 - return - end -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c -crc entry prng_chkpnt (me, iseed) - logical function prng_chkpnt (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed(1)=l(1,me) - iseed(2)=l(2,me) - iseed(3)=l(3,me) - iseed(4)=l(4,me) - endif - return - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c seed is an 4-element integer array containing the "l"-values -c -crc entry prng_restart (me, iseed) - logical function prng_restart (me, iseed) - integer iseed(4) - parameter(nmax=1021) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - l(1,me)=iseed(1) - l(2,me)=iseed(2) - l(3,me)=iseed(3) - l(4,me)=iseed(4) - endif - return - end - - block data prngblk -c -c Sequence of prime numbers represented as pairs of 16-bit integers -c modulo 2**16, obtained from Mal Kalos August 28, 1992. Only 98 -c continuation cards are allowed by ksr Fortran, so several DATA -c statements are used to initialize 1022 generators. -c -c @cornell university, 1992 -c - parameter(nmax=1021,nmax1=2*nmax+2) - common/ksrprng/l(16,0:nmax),n(16,0:nmax) -c*ksr*subpage /ksrprng/ - -c High order quads in arrays "l" and "n" are initialized to zero : rows 1-2 -c Rows 5-16 remain uninitialized. They are just pads, never used. - DATA ((l(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - DATA ((n(i,j),i=1,2),j=0,nmax)/nmax1*0.0/ - -c The rest of array "l" and "n" are initialized to a 20-bit seed - DATA ((l(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180,51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((l(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((l(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181,1015,181,1021,181,1023,181,1041,181,1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - DATA ((n(i,j),i=3,4),j=0,489)/ - .180, 51739,180, 51757,180, 51761,180, 51767,180, 51773, - .180, 51791,180, 51817,180, 51833,180, 51859,180, 51871, - .180, 51877,180, 51883,180, 51887,180, 51893,180, 51899, - .180, 51913,180, 51953,180, 51971,180, 51989,180, 51997, - .180, 52009,180, 52013,180, 52033,180, 52043,180, 52051, - .180, 52057,180, 52073,180, 52109,180, 52111,180, 52121, - .180, 52139,180, 52157,180, 52183,180, 52193,180, 52199, - .180, 52211,180, 52219,180, 52229,180, 52237,180, 52241, - .180, 52249,180, 52261,180, 52271,180, 52277,180, 52307, - .180, 52321,180, 52349,180, 52373,180, 52381,180, 52387, - .180, 52393,180, 52411,180, 52429,180, 52439,180, 52451, - .180, 52457,180, 52481,180, 52501,180, 52541,180, 52559, - .180, 52573,180, 52579,180, 52589,180, 52597,180, 52607, - .180, 52613,180, 52627,180, 52631,180, 52649,180, 52657, - .180, 52697,180, 52703,180, 52723,180, 52751,180, 52757, - .180, 52759,180, 52769,180, 52771,180, 52789,180, 52793, - .180, 52811,180, 52817,180, 52829,180, 52859,180, 52879, - .180, 52883,180, 52919,180, 52921,180, 52933,180, 52937, - .180, 52957,180, 52963,180, 52993,180, 53011,180, 53023, - .180, 53027,180, 53077,180, 53087,180, 53089,180, 53093, - .180, 53107,180, 53119,180, 53153,180, 53161,180, 53173, - .180, 53179,180, 53191,180, 53203,180, 53209,180, 53213, - .180, 53219,180, 53221,180, 53227,180, 53233,180, 53243, - .180, 53261,180, 53263,180, 53279,180, 53287,180, 53291, - .180, 53311,180, 53321,180, 53329,180, 53333,180, 53389, - .180, 53401,180, 53411,180, 53429,180, 53443,180, 53453, - .180, 53467,180, 53507,180, 53521,180, 53531,180, 53539, - .180, 53543,180, 53551,180, 53569,180, 53581,180, 53593, - .180, 53597,180, 53623,180, 53629,180, 53641,180, 53647, - .180, 53653,180, 53669,180, 53681,180, 53689,180, 53711, - .180, 53753,180, 53767,180, 53779,180, 53789,180, 53803, - .180, 53821,180, 53861,180, 53867,180, 53887,180, 53893, - .180, 53899,180, 53909,180, 53927,180, 53947,180, 53957, - .180, 53989,180, 54001,180, 54031,180, 54049,180, 54061, - .180, 54077,180, 54127,180, 54131,180, 54187,180, 54197, - .180, 54199,180, 54221,180, 54251,180, 54259,180, 54269, - .180, 54311,180, 54323,180, 54349,180, 54353,180, 54379, - .180, 54397,180, 54419,180, 54427,180, 54433,180, 54439, - .180, 54451,180, 54461,180, 54467,180, 54473,180, 54481, - .180, 54503,180, 54511,180, 54517,180, 54551,180, 54553, - .180, 54571,180, 54581,180, 54587,180, 54613,180, 54629, - .180, 54643,180, 54647,180, 54659,180, 54677,180, 54683, - .180, 54701,180, 54721,180, 54739,180, 54811,180, 54823, - .180, 54829,180, 54833,180, 54839,180, 54869,180, 54871, - .180, 54881,180, 54893,180, 54923,180, 54929,180, 54943, - .180, 54967,180, 54971,180, 55001,180, 55013,180, 55039, - .180, 55043,180, 55049,180, 55067,180, 55069,180, 55079, - .180, 55097,180, 55109,180, 55111,180, 55117,180, 55123, - .180, 55127,180, 55133,180, 55141,180, 55147,180, 55159, - .180, 55193,180, 55201,180, 55247,180, 55273,180, 55279, - .180, 55307,180, 55313,180, 55319,180, 55333,180, 55361, - .180, 55379,180, 55387,180, 55411,180, 55429,180, 55439, - .180, 55447,180, 55453,180, 55469,180, 55487,180, 55517, - .180, 55537,180, 55571,180, 55573,180, 55579,180, 55603, - .180, 55609,180, 55649,180, 55667,180, 55669,180, 55681, - .180, 55691,180, 55697,180, 55729,180, 55741,180, 55757, - .180, 55771,180, 55783,180, 55793,180, 55799,180, 55807, - .180, 55813,180, 55817,180, 55823,180, 55831,180, 55847, - .180, 55859,180, 55861,180, 55879,180, 55889,180, 55957, - .180, 55973,180, 55979,180, 55993,180, 56033,180, 56051, - .180, 56057,180, 56059,180, 56077,180, 56093,180, 56099, - .180, 56111,180, 56129,180, 56131,180, 56143,180, 56161, - .180, 56167,180, 56177,180, 56183,180, 56237,180, 56239, - .180, 56261,180, 56279,180, 56287,180, 56293,180, 56323, - .180, 56327,180, 56329,180, 56351,180, 56353,180, 56357, - .180, 56377,180, 56393,180, 56399,180, 56411,180, 56437, - .180, 56441,180, 56477,180, 56479,180, 56489,180, 56503, - .180, 56509,180, 56521,180, 56533,180, 56539,180, 56551, - .180, 56609,180, 56653,180, 56677,180, 56681,180, 56701, - .180, 56723,180, 56737,180, 56741,180, 56747,180, 56761, - .180, 56827,180, 56839,180, 56843,180, 56849,180, 56887, - .180, 56903,180, 56939,180, 56941,180, 56947,180, 56969, - .180, 56971,180, 56983,180, 57049,180, 57077,180, 57091, - .180, 57121,180, 57133,180, 57137,180, 57149,180, 57169, - .180, 57179,180, 57199,180, 57209,180, 57239,180, 57251, - .180, 57277,180, 57281,180, 57293,180, 57311,180, 57337, - .180, 57359,180, 57367,180, 57377,180, 57389,180, 57403, - .180, 57407,180, 57409,180, 57413,180, 57419,180, 57431, - .180, 57451,180, 57463,180, 57499,180, 57511,180, 57521, - .180, 57529,180, 57539,180, 57577,180, 57581,180, 57667, - .180, 57679,180, 57683,180, 57689,180, 57731,180, 57767, - .180, 57781,180, 57787,180, 57799,180, 57823,180, 57847, - .180, 57851,180, 57853,180, 57883,180, 57899,180, 57919, - .180, 57931,180, 57949,180, 57953,180, 57959,180, 57961, - .180, 57983,180, 57997,180, 58009,180, 58037,180, 58039, - .180, 58043,180, 58049,180, 58087,180, 58091,180, 58093, - .180, 58123,180, 58127,180, 58201,180, 58211,180, 58229, - .180, 58243,180, 58277,180, 58303,180, 58313,180, 58333, - .180, 58367,180, 58373,180, 58393,180, 58397,180, 58403, - .180, 58411,180, 58417,180, 58421,180, 58439,180, 58457, - .180, 58481,180, 58483,180, 58499,180, 58523,180, 58537, - .180, 58543,180, 58549,180, 58553,180, 58631,180, 58661, - .180, 58667,180, 58669,180, 58679,180, 58697,180, 58723, - .180, 58733,180, 58739,180, 58751,180, 58787,180, 58789, - .180, 58823,180, 58829,180, 58841,180, 58849,180, 58859, - .180, 58871,180, 58873,180, 58877,180, 58879,180, 58901, - .180, 58903,180, 58907,180, 58919,180, 58927,180, 58933, - .180, 59009,180, 59011,180, 59027,180, 59041,180, 59051/ - DATA ((n(i,j),i=3,4),j=490,979)/ - .180, 59069,180, 59071,180, 59087,180, 59101,180, 59107, - .180, 59113,180, 59153,180, 59173,180, 59183,180, 59207, - .180, 59209,180, 59219,180, 59233,180, 59251,180, 59257, - .180, 59263,180, 59267,180, 59279,180, 59293,180, 59321, - .180, 59327,180, 59333,180, 59347,180, 59359,180, 59389, - .180, 59401,180, 59423,180, 59431,180, 59453,180, 59479, - .180, 59509,180, 59513,180, 59519,180, 59521,180, 59543, - .180, 59569,180, 59591,180, 59621,180, 59627,180, 59633, - .180, 59659,180, 59671,180, 59681,180, 59699,180, 59713, - .180, 59719,180, 59743,180, 59759,180, 59783,180, 59789, - .180, 59801,180, 59807,180, 59827,180, 59831,180, 59849, - .180, 59863,180, 59879,180, 59891,180, 59893,180, 59929, - .180, 59939,180, 59981,180, 59989,180, 59993,180, 59999, - .180, 60031,180, 60037,180, 60061,180, 60067,180, 60073, - .180, 60103,180, 60149,180, 60161,180, 60173,180, 60179, - .180, 60193,180, 60217,180, 60229,180, 60247,180, 60251, - .180, 60283,180, 60329,180, 60331,180, 60341,180, 60361, - .180, 60377,180, 60397,180, 60403,180, 60419,180, 60439, - .180, 60467,180, 60473,180, 60499,180, 60523,180, 60553, - .180, 60557,180, 60559,180, 60569,180, 60581,180, 60587, - .180, 60593,180, 60601,180, 60611,180, 60613,180, 60619, - .180, 60643,180, 60647,180, 60667,180, 60671,180, 60713, - .180, 60737,180, 60749,180, 60763,180, 60769,180, 60787, - .180, 60797,180, 60811,180, 60823,180, 60829,180, 60847, - .180, 60851,180, 60853,180, 60881,180, 60887,180, 60889, - .180, 60913,180, 60919,180, 60929,180, 60941,180, 60943, - .180, 60971,180, 60973,180, 60977,180, 60997,180, 61001, - .180, 61013,180, 61019,180, 61039,180, 61043,180, 61049, - .180, 61063,180, 61081,180, 61109,180, 61111,180, 61133, - .180, 61141,180, 61181,180, 61187,180, 61213,180, 61217, - .180, 61229,180, 61231,180, 61271,180, 61273,180, 61279, - .180, 61283,180, 61297,180, 61307,180, 61313,180, 61321, - .180, 61337,180, 61339,180, 61351,180, 61357,180, 61393, - .180, 61397,180, 61403,180, 61409,180, 61427,180, 61433, - .180, 61451,180, 61489,180, 61511,180, 61519,180, 61529, - .180, 61537,180, 61543,180, 61549,180, 61559,180, 61571, - .180, 61577,180, 61579,180, 61621,180, 61631,180, 61651, - .180, 61669,180, 61679,180, 61697,180, 61711,180, 61721, - .180, 61747,180, 61763,180, 61787,180, 61789,180, 61799, - .180, 61801,180, 61811,180, 61831,180, 61843,180, 61879, - .180, 61897,180, 61901,180, 61907,180, 61943,180, 61963, - .180, 61967,180, 61999,180, 62053,180, 62063,180, 62071, - .180, 62077,180, 62089,180, 62093,180, 62099,180, 62117, - .180, 62119,180, 62149,180, 62177,180, 62179,180, 62203, - .180, 62221,180, 62239,180, 62243,180, 62249,180, 62267, - .180, 62299,180, 62303,180, 62321,180, 62327,180, 62333, - .180, 62359,180, 62371,180, 62413,180, 62417,180, 62441, - .180, 62467,180, 62473,180, 62489,180, 62491,180, 62509, - .180, 62537,180, 62551,180, 62569,180, 62581,180, 62593, - .180, 62597,180, 62599,180, 62603,180, 62621,180, 62629, - .180, 62657,180, 62659,180, 62671,180, 62677,180, 62683, - .180, 62687,180, 62699,180, 62707,180, 62749,180, 62753, - .180, 62761,180, 62767,180, 62789,180, 62813,180, 62827, - .180, 62831,180, 62869,180, 62879,180, 62891,180, 62897, - .180, 62903,180, 62947,180, 62953,180, 62971,180, 62977, - .180, 62981,180, 62993,180, 63001,180, 63007,180, 63013, - .180, 63023,180, 63029,180, 63059,180, 63061,180, 63083, - .180, 63089,180, 63091,180, 63103,180, 63119,180, 63131, - .180, 63163,180, 63227,180, 63233,180, 63239,180, 63259, - .180, 63271,180, 63311,180, 63337,180, 63341,180, 63353, - .180, 63367,180, 63373,180, 63397,180, 63409,180, 63413, - .180, 63421,180, 63427,180, 63437,180, 63443,180, 63449, - .180, 63481,180, 63499,180, 63509,180, 63517,180, 63541, - .180, 63551,180, 63559,180, 63569,180, 63601,180, 63607, - .180, 63617,180, 63623,180, 63629,180, 63637,180, 63653, - .180, 63671,180, 63691,180, 63727,180, 63743,180, 63751, - .180, 63763,180, 63787,180, 63821,180, 63827,180, 63847, - .180, 63899,180, 63917,180, 63931,180, 63989,180, 63997, - .180, 64003,180, 64007,180, 64009,180, 64013,180, 64037, - .180, 64067,180, 64087,180, 64093,180, 64133,180, 64139, - .180, 64147,180, 64157,180, 64163,180, 64169,180, 64181, - .180, 64189,180, 64207,180, 64211,180, 64217,180, 64219, - .180, 64223,180, 64247,180, 64261,180, 64273,180, 64297, - .180, 64307,180, 64309,180, 64331,180, 64357,180, 64379, - .180, 64387,180, 64409,180, 64417,180, 64483,180, 64489, - .180, 64493,180, 64513,180, 64531,180, 64553,180, 64591, - .180, 64601,180, 64609,180, 64613,180, 64619,180, 64627, - .180, 64651,180, 64661,180, 64679,180, 64687,180, 64711, - .180, 64717,180, 64727,180, 64739,180, 64741,180, 64751, - .180, 64757,180, 64793,180, 64813,180, 64819,180, 64823, - .180, 64847,180, 64871,180, 64877,180, 64883,180, 64891, - .180, 64921,180, 64927,180, 64931,180, 64933,180, 64949, - .180, 64961,180, 64987,180, 65047,180, 65059,180, 65063, - .180, 65077,180, 65089,180, 65093,180, 65099,180, 65101, - .180, 65119,180, 65131,180, 65137,180, 65147,180, 65159, - .180, 65171,180, 65179,180, 65191,180, 65203,180, 65207, - .180, 65213,180, 65221,180, 65231,180, 65233,180, 65269, - .180, 65311,180, 65323,180, 65339,180, 65347,180, 65369, - .180, 65393,180, 65399,180, 65407,180, 65431,180, 65437, - .180, 65441,180, 65443,180, 65473,180, 65479,180, 65507, - .180, 65527,180, 65533,181, 13,181, 15,181, 33, - .181, 61,181, 67,181, 141,181, 151,181, 183, - .181, 187,181, 201,181, 207,181, 213,181, 217, - .181, 223,181, 225,181, 243,181, 253,181, 255, - .181, 277,181, 291,181, 297,181, 301,181, 327, - .181, 337,181, 357,181, 375,181, 423,181, 453, - .181, 477,181, 511,181, 531,181, 547,181, 553, - .181, 561,181, 565,181, 595,181, 607,181, 645/ - DATA ((n(i,j),i=3,4),j=980,nmax)/ - .181, 657,181, 663,181, 685,181, 687,181, 697, - .181, 745,181, 775,181, 787,181, 823,181, 825, - .181, 841,181, 853,181, 865,181, 895,181, 903, - .181, 943,181, 963,181, 973,181, 981,181, 1005, - .181, 1015,181, 1021,181, 1023,181, 1041,181, 1051, - .181, 1057,181, 1083,181, 1093,181, 1105,181, 1107, - .181, 1117,181, 1135,181, 1137,181, 1155,181, 1167, - .181, 1191,181, 1197,181, 1221,181, 1233,181, 1237, - .181, 1243,181, 1263/ - end -#endif diff --git a/source/unres/src_MD-restraints/proc_proc.c b/source/unres/src_MD-restraints/proc_proc.c deleted file mode 100644 index d77c5a4..0000000 --- a/source/unres/src_MD-restraints/proc_proc.c +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include - -#ifdef CRAY -void PROC_PROC(long int *f, int *i) -#else -#ifdef LINUX -#ifdef PGI -void proc_proc_(long int *f, int *i) -#else -void proc_proc__(long int *f, int *i) -#endif -#endif -#ifdef SGI -void proc_proc_(long int *f, int *i) -#endif -#if defined(WIN) && !defined(WINIFL) -void _stdcall PROC_PROC(long int *f, int *i) -#endif -#ifdef WINIFL -void proc_proc(long int *f, int *i) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_proc(long int *f, int *i) -#endif -#endif - -{ -static long int NaNQ; -static long int NaNQm; - -if(*i==-1) - { - NaNQ=*f; - NaNQm=0xffffffff; - return; - } -*i=0; -if(*f==NaNQ) - *i=1; -if(*f==NaNQm) - *i=1; -} - -#ifdef CRAY -void PROC_CONV(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV(char *buf, int *i, int n) -#endif -{ -int j; - -sscanf(buf,"%d",&j); -*i=j; -return; -} - -#ifdef CRAY -void PROC_CONV_R(char *buf, int *i, int n) -#endif -#ifdef LINUX -void proc_conv_r__(char *buf, int *i, int n) -#endif -#ifdef SGI -void proc_conv_r_(char *buf, int *i, int n) -#endif -#if defined(AIX) || defined(WINPGI) -void proc_conv_r(char *buf, int *i, int n) -#endif -#ifdef WIN -void _stdcall PROC_CONV_R(char *buf, int *i, int n) -#endif - -{ - -/* sprintf(buf,"%d",*i); */ - -return; -} - - -#ifndef IMSL -#ifdef CRAY -void DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef LINUX -void dsvrgp__(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef SGI -void dsvrgp_(int *n, double *tab1, double *tab2, int *itab) -#endif -#if defined(AIX) || defined(WINPGI) -void dsvrgp(int *n, double *tab1, double *tab2, int *itab) -#endif -#ifdef WIN -void _stdcall DSVRGP(int *n, double *tab1, double *tab2, int *itab) -#endif -{ -double t; -int i,j,k; - -if(tab1 != tab2) - { - for(i=0; i<*n; i++) - tab2[i]=tab1[i]; - } -k=0; -while(k<*n-1) - { - j=k; - t=tab2[k]; - for(i=k+1; i<*n; i++) - if(t>tab2[i]) - { - j=i; - t=tab2[i]; - } - if(j!=k) - { - tab2[j]=tab2[k]; - tab2[k]=t; - i=itab[j]; - itab[j]=itab[k]; - itab[k]=i; - } - k++; - } -} -#endif diff --git a/source/unres/src_MD-restraints/q_measure.F b/source/unres/src_MD-restraints/q_measure.F deleted file mode 100644 index 417cf35..0000000 --- a/source/unres/src_MD-restraints/q_measure.F +++ /dev/null @@ -1,487 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x - sigm(x)=0.25d0*x - qq = 0.0d0 - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl - endif - qwolynes=1.0d0-qq - return - end -c------------------------------------------------------------------- - subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4, - & secseg - integer nsep /3/ - double precision dist - double precision dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - double precision sigm,x,sim,dd0,fac,ddqij - sigm(x)=0.25d0*x - - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - nl=0 - if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim = sim*sim - dd0=dijCM-d0ijCM - fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (itype(il).ne.10 .or. itype(jl).ne.10) then - nl=nl+1 - d0ijCM=dsqrt( - & (cref(1,jl+nres)-cref(1,il+nres))**2+ - & (cref(2,jl+nres)-cref(2,il+nres))**2+ - & (cref(3,jl+nres)-cref(3,il+nres))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim=sim*sim - dd0 = dijCM-d0ijCM - fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo - endif - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-10/ - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=(q2-q1)/delta - c(j,i)=cdummy(j,i) - enddo - enddo - do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo -c write(iout,*) "Numerical Q carteisan gradients backbone: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) -c enddo -c write(iout,*) "Numerical Q carteisan gradients side-chain: " -c do i=0,nct -c write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) -c enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i), - & qinfrag(i,iset)) -c hm1=harmonic(qfrag(i,iset),qinfrag(i,iset)) -c hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset), -c & qinfrag(i,iset)) -c write(iout,*) "harmonicnum frag", hmnum -c Calculating the derivatives of Q with respect to cartesian coordinates - call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dU/dQi and dQi/dxi -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true. -c & ,idummy,idummy) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c hm1=harmonic(qpair(i),qinpair(i,iset)) -c hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) -c hmnum=(hm2-hm1)/delta -c write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i), -c & qinpair(i,iset)) -c write(iout,*) "harmonicnum pair ", hmnum -c Calculating dQ/dXi - call qwolynes_prim(kstart,kend,.false. - & ,lstart,lend) -c write(iout,*) "dqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) -c enddo -c write(iout,*) "dxqwol " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3) -c enddo -c Calculating numerical gradients -c call qwol_num(kstart,kend,.false. -c & ,lstart,lend) -c The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - duxcartan(j,i)=0.0d0 - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true. - & ,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset), - & ifrag(2,ii,iset),.true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii), - & qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo -c write(iout,*) "Numerical dUconst/ddx side-chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) -c enddo - return - end -c--------------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/q_measure1.F b/source/unres/src_MD-restraints/q_measure1.F deleted file mode 100644 index 9c1546d..0000000 --- a/source/unres/src_MD-restraints/q_measure1.F +++ /dev/null @@ -1,470 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i),ifrag(2,i),.true.,idummy,idummy) - enddo - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii), - & qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - integer i,j,k,il,jl,il1,jl1,nd - double precision dist - external dist - double precision dij1,dij2,dij3,dij4,d0ij1,d0ij2,d0ij3,d0ij4,fac, - & fac1,ddave,ssij,ddqij - logical lprn /.false./ - d0ij1=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij1=dist(il,jl) - ddave=(dij1-d0ij1)**2 - nd=1 - if (jl1.ne.jl) then - d0ij2=dsqrt((cref(1,jl1)-cref(1,il))**2+ - & (cref(2,jl1)-cref(2,il))**2+ - & (cref(3,jl1)-cref(3,il))**2) - dij2=dist(il,jl1) - ddave=ddave+(dij2-d0ij2)**2 - nd=nd+1 - endif - if (il1.ne.il) then - d0ij3=dsqrt((cref(1,jl)-cref(1,il1))**2+ - & (cref(2,jl)-cref(2,il1))**2+ - & (cref(3,jl)-cref(3,il1))**2) - dij3=dist(il1,jl) - ddave=ddave+(dij3-d0ij3)**2 - nd=nd+1 - endif - if (il1.ne.il .and. jl1.ne.jl) then - d0ij4=dsqrt((cref(1,jl1)-cref(1,il1))**2+ - & (cref(2,jl1)-cref(2,il1))**2+ - & (cref(3,jl1)-cref(3,il1))**2) - dij4=dist(il1,jl1) - ddave=ddave+(dij4-d0ij4)**2 - nd=nd+1 - endif - ddave=ddave/nd - if (lprn) then - write (iout,*) "il",il," jl",jl, - & " itype",itype(il),itype(jl)," nd",nd - write (iout,*)"d0ij",d0ij1,d0ij2,d0ij3,d0ij4, - & " dij",dij1,dij2,dij3,dij4," ddave",ddave - call flush(iout) - endif -c ssij = (0.25d0*d0ij1)**2 - if (il.ne.il1 .and. jl.ne.jl1) then - ssij = 16.0d0/(d0ij1*d0ij4) - else - ssij = 16.0d0/(d0ij1*d0ij1) - endif - qcontrib = dexp(-0.5d0*ddave*ssij) -c Compute gradient - fac1 = qcontrib*ssij/nd - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (jl1.ne.jl) then - fac = fac1*(dij2-d0ij2)/dij2 - do k=1,3 - ddqij = (c(k,il)-c(k,jl1))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il) then - fac = fac1*(dij3-d0ij3)/dij3 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - endif - if (il1.ne.il .and. jl1.ne.jl) then - fac = fac1*(dij4-d0ij4)/dij4 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - return - end diff --git a/source/unres/src_MD-restraints/q_measure3.F b/source/unres/src_MD-restraints/q_measure3.F deleted file mode 100644 index f0a030e..0000000 --- a/source/unres/src_MD-restraints/q_measure3.F +++ /dev/null @@ -1,529 +0,0 @@ - double precision function qwolynes(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer i,j,jl,k,l,il,kl,nl,np,seg1,seg2,seg3,seg4,secseg - integer nsep /3/ - double precision dist,qm - double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM - logical lprn /.false./ - logical flag - qq = 0.0d0 - nl=0 - do i=0,nres - do j=1,3 - dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 - enddo - enddo - if (lprn) then - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4, - & " flag",flag - call flush(iout) - endif - if (flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - if (lprn) then - write (iout,*) "nl",nl," qq",qq - call flush(iout) - endif - else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 - nl=nl+1 - if (itype(il).ne.10) then - ilnres=il+nres - else - ilnres=il - endif - if (itype(jl).ne.10) then - jlnres=jl+nres - else - jlnres=jl - endif - qqijCM = qcontrib(il,jl,ilnres,jlnres) - qq = qq+qqijCM - if (lprn) then - write (iout,*) "qqijCM",qqijCM - call flush(iout) - endif - enddo - enddo - endif - qq = qq/nl - qwolynes=1.0d0-qq - do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo - enddo - return - end -c------------------------------------------------------------------- - subroutine qwol_num(seg1,seg2,flag,seg3,seg4) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.MD' - integer seg1,seg2,seg3,seg4 - logical flag - double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), - & qwolxan(3,0:maxres),q1,q2 - double precision delta /1.0d-7/ - write (iout,*) "seg1",seg1," seg2",seg2," seg3",seg3," seg4",seg4 - write(iout,*) "dQ/dc backbone " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (dqwol(j,i),j=1,3) - enddo - write(iout,*) "dQ/dX side chain " - do i=1,nres - write(iout,'(i5,3e15.5)') i,(dxqwol(j,i),j=1,3) - enddo - do i=1,nres - do j=1,3 - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i)=cdummy(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=0.5d0*(q2-q1)/delta - c(j,i)=cdummy(j,i) -c write (iout,*) "i",i," j",j," q1",q1," a2",q2 - enddo - enddo - do i=1,nres - do j=1,3 - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)-delta - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - c(j,i+nres)=cdummy(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=0.5d0*(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo - enddo - write(iout,*) "Numerical Q cartesian gradients backbone: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) - enddo - write(iout,*) "Numerical Q cartesian gradients side-chain: " - do i=0,nres - write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) - enddo - return - end -c------------------------------------------------------------------------ - subroutine EconstrQ -c MD with umbrella_sampling using Wolyne's distance measure as a constraint - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2,hm1,hm2,hmnum - double precision ucdelan,dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES), - & duconst(3,0:MAXRES),duxconst(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ - do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo - enddo - Uconst=0.0d0 - do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true. - & ,idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),qinfrag(i,iset)) -c Calculating the derivatives of Q with respect to cartesian coordinates - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo -c write (iout,*) "Calling qwol_num" -c call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.,idummy,idummy) - enddo -c stop - do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) -c Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) -c Calculating dQ/dXi - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo - enddo -c write(iout,*) "Uconst inside subroutine ", Uconst -c Transforming the gradients from Cs to dCs for the backbone - do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo - enddo - enddo -c Transforming the gradients from Cs to dCs for the side chains - do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo - enddo -c write(iout,*) "dU/dc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (duconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/dX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddc backbone " -c do ii=0,nres -c write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) -c enddo -c write(iout,*) "dU/ddX side chain " -c do ii=1,nres -c write(iout,'(i5,3e15.5)') ii,(dudxconst(j,ii),j=1,3) -c enddo -c Calculating numerical gradients of dUconst/ddc and dUconst/ddx -c call dEconstrQ_num - return - end -c----------------------------------------------------------------------- - subroutine dEconstrQ_num -c Calculating numerical dUconst/ddc and dUconst/ddx - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision uzap1,uzap2 - double precision dUcartan(3,0:MAXRES) - & ,dUxcartan(3,0:MAXRES),cdummy(3,0:MAXRES) - integer kstart,kend,lstart,lend,idummy - double precision delta /1.0d-7/ -c For the backbone - do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo -c Calculating numerical gradients for dU/ddx - do i=0,nres-1 - do j=1,3 - duxcartan(j,i)=0.0d0 - enddo - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset), - & .true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)* - & harmonic(qfrag(ii),qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)* - & harmonic(qpair(ii),qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo - enddo - write(iout,*) "Numerical dUconst/ddc backbone " - do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) - enddo - write(iout,*) "Numerical dUconst/ddx side-chain " - do ii=1,nres - write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3) - enddo - return - end -c--------------------------------------------------------------------------- - double precision function qcontrib(il,jl,il1,jl1) - implicit none - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.LOCAL' - integer i,j,k,il,jl,il1,jl1,nd,itl,jtl - double precision dist - external dist - double precision dij,dij1,d0ij,d0ij1,om1,om2,om12,om10,om20,om120 - & ,fac,fac1,ddave,ssij,ddqij,d0ii1,d0jj1,rij,eom1,eom2,eom12 - double precision u(3),v(3),er(3),er0(3),dcosom1(3),dcosom2(3), - & aux1,aux2 - double precision scalar - external scalar - logical lprn /.false./ - if (lprn) write (iout,*) "il",il," jl",jl," il1",il1," jl1",jl1 - d0ij=dsqrt((cref(1,jl)-cref(1,il))**2+ - & (cref(2,jl)-cref(2,il))**2+ - & (cref(3,jl)-cref(3,il))**2) - dij=dist(il,jl) - dij1=dist(il1,jl1) - do i=1,3 - er(i)=(c(i,jl1)-c(i,il1))/dij1 - enddo - do i=1,3 - er0(i)=cref(i,jl1)-cref(i,il1) - enddo - d0ij1=dsqrt(scalar(er0,er0)) - do i=1,3 - er0(i)=er0(i)/d0ij1 - enddo - if (il.ne.il1 .or. jl.ne.jl1) then - ddave=0.5d0*((dij-d0ij)**2+(dij1-d0ij1)**2) - nd=2 - else - ddave=(dij-d0ij)**2 - nd=1 - endif - if (il.ne.il1) then - do i=1,3 - u(i)=cref(i,il1)-cref(i,il) - enddo - d0ii1=dsqrt(scalar(u,u)) - do i=1,3 - u(i)=u(i)/d0ii1 - enddo - if (lprn) then - write (iout,*) "u",(u(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om10=scalar(er0,u) - om1=scalar(er,dc_norm(1,il1)) - write (iout,*) "om10",om10," om1",om1 - endif - else - om1=0.0d0 - om10=0.0d0 - endif - if (jl.ne.jl1) then - do i=1,3 - v(i)=cref(i,jl1)-cref(i,jl) - enddo - d0jj1=dsqrt(scalar(v,v)) - do i=1,3 - v(i)=v(i)/d0jj1 - enddo - if (lprn) then - write (iout,*) "v",(v(i),i=1,3) - write (iout,*) "er0",(er0(i),i=1,3) - om20=scalar(er,v) - om2=scalar(er,dc_norm(1,jl1)) - write (iout,*) "om20",om20," om2",om2 - endif - else - om2=0.0d0 - om20=0.0d0 - endif - if (il.ne.il1 .and. jl.ne.jl1) then - om120=scalar(u,v) - om12=scalar(dc_norm(1,il1),dc_norm(1,jl1)) - else - om12=0.0d0 - om120=0.0d0 - endif - if (lprn) then - write (iout,*) "il",il," jl",jl,itype(il),itype(jl) - write (iout,*)"d0ij",d0ij," om10",om10," om20",om20, - & " om120",om120, - & " dij",dij," om1",om1," om2",om2," om12",om12 - call flush(iout) - endif - ssij = 16.0d0/(d0ij*d0ij) - qcontrib = dexp(-0.5d0*(ddave*ssij+((om1-om10)**2 - & +(om2-om20)**2+(om12-om120)**2))) - if (lprn) write (iout,*) "ssij",ssij," qcontrib",qcontrib -c qcontrib = dexp(-0.5d0*(ddave*ssij)+(om1-om10)**2+(om2-om20)**2) -c qcontrib = dexp(-0.5d0*(ddave*ssij)) -c Compute gradient - radial component - fac1 = qcontrib*ssij/nd - fac = fac1*(dij-d0ij)/dij - do k=1,3 - ddqij = (c(k,il)-c(k,jl))*fac - dqwol(k,il)=dqwol(k,il)+ddqij - dqwol(k,jl)=dqwol(k,jl)-ddqij - enddo - if (il1.ne.il .or. jl1.ne.jl) then - fac = fac1*(dij1-d0ij1)/dij1 - do k=1,3 - ddqij = (c(k,il1)-c(k,jl1))*fac - if (il1.ne.il) then - dxqwol(k,il)=dxqwol(k,il)+ddqij - else - dqwol(k,il)=dqwol(k,il)+ddqij - endif - if (jl1.ne.jl) then - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - else - dqwol(k,jl)=dqwol(k,jl)-ddqij - endif - enddo - endif -c return -c Orientational contributions - rij=1.0d0/dij1 - eom1=qcontrib*(om1-om10) - eom2=qcontrib*(om2-om20) - eom12=qcontrib*(om12-om120) - do k=1,3 - dcosom1(k)=rij*(dc_norm(k,il1)-om1*er(k)) - dcosom2(k)=rij*(dc_norm(k,jl1)-om2*er(k)) - enddo - do k=1,3 - ddqij=eom1*dcosom1(k)+eom2*dcosom2(k) - aux1=(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) - & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - aux2=(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) - & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - dqwol(k,il)=dqwol(k,il)-ddqij-aux1 - dqwol(k,jl)=dqwol(k,jl)+ddqij-aux2 - dxqwol(k,il)=dxqwol(k,il)-ddqij+aux1 -c & +(eom12*(dc_norm(k,jl1)-om12*dc_norm(k,il1)) -c & +eom1*(er(k)-om1*dc_norm(k,il1)))*vbld_inv(il1) - dxqwol(k,jl)=dxqwol(k,jl)+ddqij+aux2 -c & +(eom12*(dc_norm(k,il1)-om12*dc_norm(k,jl1)) -c & +eom2*(er(k)-om2*dc_norm(k,jl1)))*vbld_inv(jl1) - enddo - return - end diff --git a/source/unres/src_MD-restraints/randgens.f b/source/unres/src_MD-restraints/randgens.f deleted file mode 100644 index 0daeb35..0000000 --- a/source/unres/src_MD-restraints/randgens.f +++ /dev/null @@ -1,99 +0,0 @@ -C $Date: 1994/10/04 16:19:52 $ -C $Revision: 2.1 $ -C -C -C See help for RANDOMV on the PSFSHARE disk to understand these -C subroutines. This is the VS Fortran version of this code. -C -C - SUBROUTINE VRND(VEC,N) - INTEGER A(250) - COMMON /VRANDD/ A, I, I147 - INTEGER LOOP,I,I147,VEC(N) - DO 23000 LOOP=1,N - I=I+1 - IF(.NOT.(I.GE.251))GOTO 23002 - I=1 -23002 CONTINUE - I147=I147+1 - IF(.NOT.(I147.GE.251))GOTO 23004 - I147=1 -23004 CONTINUE - A(I)=IEOR(A(I147),A(I)) - VEC(LOOP)=A(I) -23000 CONTINUE - RETURN - END -C -C - DOUBLE PRECISION FUNCTION RNDV(IDUM) - DOUBLE PRECISION RM1,RM2,R(99) - INTEGER IA1,IC1,M1, IA2,IC2,M2, IA3,IC3,M3, IDUM - SAVE - DATA IA1,IC1,M1/1279,351762,1664557/ - DATA IA2,IC2,M2/2011,221592,1048583/ - DATA IA3,IC3,M3/15551,6150,29101/ - IF(.NOT.(IDUM.LT.0))GOTO 23006 - IX1 = MOD(-IDUM,M1) - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IX1,M2) - IX1 = MOD(IA1*IX1+IC1,M1) - IX3 = MOD(IX1,M3) - RM1 = 1./DBLE(M1) - RM2 = 1./DBLE(M2) - DO 23008 J = 1,99 - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 -23008 CONTINUE -23006 CONTINUE - IX1 = MOD(IA1*IX1+IC1,M1) - IX2 = MOD(IA2*IX2+IC2,M2) - IX3 = MOD(IA3*IX3+IC3,M3) - J = 1+(99*IX3)/M3 - RNDV = R(J) - R(J) = (DBLE(IX1)+DBLE(IX2)*RM2)*RM1 - IDUM = IX1 - RETURN - END -C -C - SUBROUTINE VRNDST(SEED) - INTEGER A(250),LOOP,IDUM,SEED - DOUBLE PRECISION RNDV - COMMON /VRANDD/ A, I, I147 - I=0 - I147=103 - IDUM=SEED - DO 23010 LOOP=1,250 - A(LOOP)=INT(RNDV(IDUM)*2147483647) -23010 CONTINUE - RETURN - END -C -C - SUBROUTINE VRNDIN(IODEV) - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - READ(IODEV) A, I, I147 - RETURN - END -C -C - SUBROUTINE VRNDOU(IODEV) -C This corresponds to VRNDOUT in the APFTN64 version - INTEGER IODEV, A(250) - COMMON/VRANDD/ A, I, I147 - WRITE(IODEV) A, I, I147 - RETURN - END - FUNCTION RNUNF(N) - INTEGER IRAN1(2000) - DATA FCTOR /2147483647.0D0/ -C We get only one random number, here! DR 9/1/92 - CALL VRND(IRAN1,1) - RNUNF= DBLE( IRAN1(1) ) / FCTOR -C****************************** -C write(6,*) 'rnunf in rnunf = ',rnunf - RETURN - END diff --git a/source/unres/src_MD-restraints/rattle.F b/source/unres/src_MD-restraints/rattle.F deleted file mode 100644 index a2e5034..0000000 --- a/source/unres/src_MD-restraints/rattle.F +++ /dev/null @@ -1,706 +0,0 @@ - subroutine rattle1 -c RATTLE algorithm for velocity Verlet - step 1, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2),xcorr(3,MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE1" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=Ginv(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i)=dC(j,i)-xx - d_t_new(j,i)=d_t_new(j,i)-xx/d_time - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=0.5d0*xx - dC(j,i+nres)=dC(j,i+nres)-xx - d_t_new(j,i+nres)=d_t_new(j,i+nres)-xx/d_time - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle2 -c RATTLE algorithm for velocity Verlet - step 2, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.false./, lprn1 /.false./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE2" - if (lprn) write (iout,*) "Velocity correction" -c Calculate the matrix G dC - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC(j,k+nres) - enddo - endif - enddo - enddo -c if (lprn) then -c write (iout,*) "gdc" -c do i=1,nbond -c write (iout,*) "i",i -c do j=1,nbond -c write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) -c enddo -c enddo -c endif -c Calculate the matrix of the system of equations - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i)*gdc(k,ind,j) - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,nbond - Cmat(ind,j)=0.0d0 - do k=1,3 - Cmat(ind,j)=Cmat(ind,j)+dC(k,i+nres)*gdc(k,ind,j) - enddo - enddo - endif - enddo -c Calculate the scalar product dC o d_t_new - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - if (lprn) then - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind) - endif - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to velocities - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i)=d_t(j,i)-xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - d_t(j,i+nres)=d_t(j,i+nres)-xx - enddo - endif - enddo - if (lprn) then - write (iout,*) - & "New velocities, Lagrange multipliers violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - if (lprn) write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i,ind,(d_t(j,i),j=1,3),x(ind),scalar(d_t(1,i),dC(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,2e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3),x(ind), - & scalar(d_t(1,i+nres),dC(1,i+nres)) - endif - enddo - endif - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end -c------------------------------------------------------------------------------ - subroutine rattle_brown -c RATTLE/LINCS algorithm for Brownian dynamics, UNRES -c AL 9/24/04 - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - include 'COMMON.TIME1' - double precision gginv(maxres2,maxres2), - & gdc(3,MAXRES2,MAXRES2),dC_uncor(3,MAXRES2), - & Cmat(MAXRES2,MAXRES2),x(MAXRES2) - common /przechowalnia/ GGinv,gdc,Cmat,nbond - integer max_rattle /5/ - logical lprn /.true./, lprn1 /.true./,not_done - double precision tol_rattle /1.0d-5/ - if (lprn) write (iout,*) "RATTLE_BROWN" - nbond=nct-nnt - do i=nnt,nct - if (itype(i).ne.10) nbond=nbond+1 - enddo -c Make a folded form of the Ginv-matrix - ind=0 - ii=0 - do i=nnt,nct-1 - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ii=ii+1 - do j=1,3 - ind=ind+1 - ind1=0 - jj=0 - do k=nnt,nct-1 - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1) GGinv(ii,jj)=fricmat(ind,ind1) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - jj=jj+1 - do l=1,3 - ind1=ind1+1 - if (j.eq.1 .and. l.eq.1)GGinv(ii,jj)=fricmat(ind,ind1) - enddo - endif - enddo - enddo - endif - enddo - if (lprn1) then - write (iout,*) "Matrix GGinv" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,GGinv) - endif - not_done=.true. - iter=0 - do while (not_done) - iter=iter+1 - if (iter.gt.max_rattle) then - write (iout,*) "Error - too many iterations in RATTLE." - stop - endif -c Calculate the matrix C = GG**(-1) dC_old o dC - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind1=ind1+1 - do j=1,3 - dC_uncor(j,ind1)=dC(j,i+nres) - enddo - endif - enddo - do i=1,nbond - ind=0 - do k=nnt,nct-1 - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k) - enddo - enddo - do k=nnt,nct - if (itype(k).ne.10) then - ind=ind+1 - do j=1,3 - gdc(j,i,ind)=GGinv(i,ind)*dC_old(j,k+nres) - enddo - endif - enddo - enddo -c Calculate deviations from standard virtual-bond lengths - ind=0 - do i=nnt,nct-1 - ind=ind+1 - x(ind)=vbld(i+1)**2-vbl**2 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - x(ind)=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - endif - enddo - if (lprn) then - write (iout,*) "Coordinates and violations" - do i=1,nbond - write(iout,'(i5,3f10.5,5x,e15.5)') - & i,(dC_uncor(j,i),j=1,3),x(i) - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t(j,i),j=1,3),scalar(d_t(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t(j,i+nres),j=1,3), - & scalar(d_t(1,i+nres),dC_old(1,i+nres)) - endif - enddo - write (iout,*) "gdc" - do i=1,nbond - write (iout,*) "i",i - do j=1,nbond - write (iout,'(i5,3f10.5)') j,(gdc(k,j,i),k=1,3) - enddo - enddo - endif - xmax=dabs(x(1)) - do i=2,nbond - if (dabs(x(i)).gt.xmax) then - xmax=dabs(x(i)) - endif - enddo - if (xmax.lt.tol_rattle) then - not_done=.false. - goto 100 - endif -c Calculate the matrix of the system of equations - do i=1,nbond - do j=1,nbond - Cmat(i,j)=0.0d0 - do k=1,3 - Cmat(i,j)=Cmat(i,j)+dC_uncor(k,i)*gdc(k,i,j) - enddo - enddo - enddo - if (lprn1) then - write (iout,*) "Matrix Cmat" - call MATOUT(nbond,nbond,MAXRES2,MAXRES2,Cmat) - endif - call gauss(Cmat,X,MAXRES2,nbond,1,*10) -c Add constraint term to positions - ind=0 - do i=nnt,nct-1 - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i)=d_t(j,i)+xx/d_time - dC(j,i)=dC(j,i)+xx - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - do j=1,3 - xx=0.0d0 - do ii=1,nbond - xx = xx+x(ii)*gdc(j,ind,ii) - enddo - xx=-0.5d0*xx - d_t(j,i+nres)=d_t(j,i+nres)+xx/d_time - dC(j,i+nres)=dC(j,i+nres)+xx - enddo - endif - enddo -c Rebuild the chain using the new coordinates - call chainbuild_cart - if (lprn) then - write (iout,*) "New coordinates, Lagrange multipliers,", - & " and differences between actual and standard bond lengths" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - xx=vbld(i+1)**2-vbl**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i),j=1,3),x(ind),xx - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - xx=vbld(i+nres)**2-vbldsc0(1,itype(i))**2 - write (iout,'(i5,3f10.5,5x,f10.5,e15.5)') - & i,(dC(j,i+nres),j=1,3),x(ind),xx - endif - enddo - write (iout,*) "Velocities and violations" - ind=0 - do i=nnt,nct-1 - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i,ind,(d_t_new(j,i),j=1,3),scalar(d_t_new(1,i),dC_old(1,i)) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - ind=ind+1 - write (iout,'(2i5,3f10.5,5x,e15.5)') - & i+nres,ind,(d_t_new(j,i+nres),j=1,3), - & scalar(d_t_new(1,i+nres),dC_old(1,i+nres)) - endif - enddo - endif - enddo - 100 continue - return - 10 write (iout,*) "Error - singularity in solving the system", - & " of equations for Lagrange multipliers." - stop - end diff --git a/source/unres/src_MD-restraints/readpdb.F b/source/unres/src_MD-restraints/readpdb.F deleted file mode 100644 index 48e0abd..0000000 --- a/source/unres/src_MD-restraints/readpdb.F +++ /dev/null @@ -1,432 +0,0 @@ - subroutine readpdb -C Read the PDB file and convert the peptide geometry into virtual-chain -C geometry. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.DISTFIT' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - double precision e1(3),e2(3),e3(3) - logical fail - integer rescode - ibeg=1 - lsecondary=.false. - nhfrag=0 - nbfrag=0 - do i=1,10000 - read (ipdbin,'(a80)',end=10) card - if (card(:5).eq.'HELIX') then - nhfrag=nhfrag+1 - lsecondary=.true. - read(card(22:25),*) hfrag(1,nhfrag) - read(card(34:37),*) hfrag(2,nhfrag) - endif - if (card(:5).eq.'SHEET') then - nbfrag=nbfrag+1 - lsecondary=.true. - read(card(24:26),*) bfrag(1,nbfrag) - read(card(35:37),*) bfrag(2,nbfrag) -crc---------------------------------------- -crc to be corrected !!! - bfrag(3,nbfrag)=bfrag(1,nbfrag) - bfrag(4,nbfrag)=bfrag(2,nbfrag) -crc---------------------------------------- - endif - if (card(:3).eq.'END' .or. card(:3).eq.'TER') goto 10 -C Fish out the ATOM cards. - if (index(card(1:4),'ATOM').gt.0) then - read (card(14:16),'(a3)') atom - if (atom.eq.'CA' .or. atom.eq.'CH3') then -C Calculate the CM of the preceding residue. - if (ibeg.eq.0) then - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - endif -C Start new residue. - read (card(24:26),*) ires - read (card(18:20),'(a3)') res - if (ibeg.eq.1) then - ishift=ires-1 - if (res.ne.'GLY' .and. res.ne. 'ACE') then - ishift=ishift-1 - itype(1)=21 - endif - ibeg=0 - endif - ires=ires-ishift - if (res.eq.'ACE') then - ity=10 - else - itype(ires)=rescode(ires,res,0) - endif - read(card(31:54),'(3f8.3)') (c(j,ires),j=1,3) -c if(me.eq.king.or..not.out1file) -c & write (iout,'(2i3,2x,a,3f8.3)') -c & ires,itype(ires),res,(c(j,ires),j=1,3) - iii=1 - do j=1,3 - sccor(j,iii)=c(j,ires) - enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. - & atom.ne.'N ' .and. atom.ne.'C ') then - iii=iii+1 - read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) - endif - endif - enddo - 10 if(me.eq.king.or..not.out1file) - & write (iout,'(a,i5)') ' Nres: ',ires -C Calculate the CM of the last side chain. - if (unres_pdb) then - do j=1,3 - dc(j,ires+nres)=sccor(j,iii) - enddo - else - call sccenter(ires,iii,sccor) - endif - nres=ires - nsup=nres - nstart_sup=1 - if (itype(nres).ne.10) then - nres=nres+1 - itype(nres)=21 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the last dummy residue - call refsys(nres-3,nres-2,nres-1,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,nres)=c(j,nres-1)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - endif - do i=2,nres-1 - do j=1,3 - c(j,i+nres)=dc(j,i) - enddo - enddo - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - if (itype(1).eq.21) then - nsup=nsup-1 - nstart_sup=2 - if (unres_pdb) then -C 2/15/2013 by Adam: corrected insertion of the first dummy residue - call refsys(2,3,4,e1,e2,e3,fail) - if (fail) then - e2(1)=0.0d0 - e2(2)=1.0d0 - e2(3)=0.0d0 - endif - do j=1,3 - c(j,1)=c(j,2)-3.8d0*e2(j) - enddo - else - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - endif -C Calculate internal coordinates. - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') - & "Backbone and SC coordinates as read from the PDB" - do ires=1,nres - write (iout,'(2i3,2x,a,3f8.3,5x,3f8.3)') - & ires,itype(ires),restyp(itype(ires)),(c(j,ires),j=1,3), - & (c(j,nres+ires),j=1,3) - enddo - endif - call int_from_cart(.true.,.false.) - call sc_loc_geom(.false.) - do i=1,nres - thetaref(i)=theta(i) - phiref(i)=phi(i) - enddo - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=2,nres-1 - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo -c write (iout,*) i,(dc(j,i+nres),j=1,3),(dc_norm(j,i+nres),j=1,3), -c & vbld_inv(i+nres) - enddo -c call chainbuild -C Copy the coordinates to reference coordinates - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - - - do j=1,nbfrag - do i=1,4 - bfrag(i,j)=bfrag(i,j)-ishift - enddo - enddo - - do j=1,nhfrag - do i=1,2 - hfrag(i,j)=hfrag(i,j)-ishift - enddo - enddo - - return - end -c--------------------------------------------------------------------------- - subroutine int_from_cart(lside,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*3 seq,atom,res - character*80 card - dimension sccor(3,20) - integer rescode - logical lside,lprn - if(me.eq.king.or..not.out1file)then - if (lprn) then - write (iout,'(/a)') - & 'Internal coordinates calculated from crystal structure.' - if (lside) then - write (iout,'(8a)') ' Res ',' dvb',' Theta', - & ' Gamma',' Dsc_id',' Dsc',' Alpha', - & ' Beta ' - else - write (iout,'(4a)') ' Res ',' dvb',' Theta', - & ' Gamma' - endif - endif - endif - do i=1,nres-1 - iti=itype(i) - if (dist(i,i+1).lt.2.0D0 .or. dist(i,i+1).gt.5.0D0) then - write (iout,'(a,i4)') 'Bad Cartesians for residue',i -ctest stop - endif - vbld(i+1)=dist(i,i+1) - vbld_inv(i+1)=1.0d0/vbld(i+1) - if (i.gt.1) theta(i+1)=alpha(i-1,i,i+1) - if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) - enddo -c if (unres_pdb) then -c if (itype(1).eq.21) then -c theta(3)=90.0d0*deg2rad -c phi(4)=180.0d0*deg2rad -c vbld(2)=3.8d0 -c vbld_inv(2)=1.0d0/vbld(2) -c endif -c if (itype(nres).eq.21) then -c theta(nres)=90.0d0*deg2rad -c phi(nres)=180.0d0*deg2rad -c vbld(nres)=3.8d0 -c vbld_inv(nres)=1.0d0/vbld(2) -c endif -c endif - if (lside) then - do i=2,nres-1 - do j=1,3 - c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))*vbld_inv(i) - & +(c(j,i+1)-c(j,i))*vbld_inv(i+1)) - enddo - iti=itype(i) - di=dist(i,nres+i) -C 10/03/12 Adam: Correction for zero SC-SC bond length - if (itype(i).ne.10 .and. itype(i).ne.21. and. di.eq.0.0d0) - & di=dsc(itype(i)) - vbld(i+nres)=di - if (itype(i).ne.10) then - vbld_inv(i+nres)=1.0d0/di - else - vbld_inv(i+nres)=0.0d0 - endif - if (iti.ne.10) then - alph(i)=alpha(nres+i,i,maxres2) - omeg(i)=beta(nres+i,i,maxres2,i+1) - endif - if(me.eq.king.or..not.out1file)then - if (lprn) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,vbld(i), - & rad2deg*theta(i),rad2deg*phi(i),dsc(iti),vbld(nres+i), - & rad2deg*alph(i),rad2deg*omeg(i) - endif - enddo - else if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,7f10.3)') restyp(iti),i,dist(i,i-1), - & rad2deg*theta(i),rad2deg*phi(i) - enddo - endif - return - end -c------------------------------------------------------------------------------- - subroutine sc_loc_geom(lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.LOCAL' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.NAMES' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - double precision x_prime(3),y_prime(3),z_prime(3) - logical lprn - do i=1,nres-1 - do j=1,3 - dc_norm(j,i)=vbld_inv(i+1)*(c(j,i+1)-c(j,i)) - enddo - enddo - do i=2,nres-1 - if (itype(i).ne.10) then - do j=1,3 - dc_norm(j,i+nres)=vbld_inv(i+nres)*(c(j,i+nres)-c(j,i)) - enddo - else - do j=1,3 - dc_norm(j,i+nres)=0.0d0 - enddo - endif - enddo - do i=2,nres-1 - costtab(i+1) =dcos(theta(i+1)) - sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) - cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) - sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) - cosfac2=0.5d0/(1.0d0+costtab(i+1)) - cosfac=dsqrt(cosfac2) - sinfac2=0.5d0/(1.0d0-costtab(i+1)) - sinfac=dsqrt(sinfac2) - it=itype(i) - if (it.ne.10) then -c -C Compute the axes of tghe local cartesian coordinates system; store in -c x_prime, y_prime and z_prime -c - do j=1,3 - x_prime(j) = 0.00 - y_prime(j) = 0.00 - z_prime(j) = 0.00 - enddo - do j = 1,3 - x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac - y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac - enddo - call vecpr(x_prime,y_prime,z_prime) -c -C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), -C to local coordinate system. Store in xx, yy, zz. -c - xx=0.0d0 - yy=0.0d0 - zz=0.0d0 - do j = 1,3 - xx = xx + x_prime(j)*dc_norm(j,i+nres) - yy = yy + y_prime(j)*dc_norm(j,i+nres) - zz = zz + z_prime(j)*dc_norm(j,i+nres) - enddo - - xxref(i)=xx - yyref(i)=yy - zzref(i)=zz - else - xxref(i)=0.0d0 - yyref(i)=0.0d0 - zzref(i)=0.0d0 - endif - enddo - if (lprn) then - do i=2,nres - iti=itype(i) - if(me.eq.king.or..not.out1file) - & write (iout,'(a3,i4,3f10.5)') restyp(iti),i,xxref(i), - & yyref(i),zzref(i) - enddo - endif - return - end -c--------------------------------------------------------------------------- - subroutine sccenter(ires,nscat,sccor) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - dimension sccor(3,20) - do j=1,3 - sccmj=0.0D0 - do i=1,nscat - sccmj=sccmj+sccor(j,i) - enddo - dc(j,ires)=sccmj/nscat - enddo - return - end -c--------------------------------------------------------------------------- - subroutine bond_regular - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CALC' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - do i=1,nres-1 - vbld(i+1)=vbl - vbld_inv(i+1)=1.0d0/vbld(i+1) - vbld(i+1+nres)=dsc(itype(i+1)) - vbld_inv(i+1+nres)=dsc_inv(itype(i+1)) -c print *,vbld(i+1),vbld(i+1+nres) - enddo - return - end diff --git a/source/unres/src_MD-restraints/readrtns.F b/source/unres/src_MD-restraints/readrtns.F deleted file mode 100644 index 0ce1ba2..0000000 --- a/source/unres/src_MD-restraints/readrtns.F +++ /dev/null @@ -1,2835 +0,0 @@ - subroutine readrtns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical file_exist -C Read force-field parameters except weights - call parmread -C Read job setup parameters - call read_control -C Read control parameters for energy minimzation if required - if (minim) call read_minim -C Read MCM control parameters if required - if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread -C Read MD control parameters if reqjuired - if (modecalc.eq.12) call read_MDpar -C Read MREMD control parameters if required - if (modecalc.eq.14) then - call read_MDpar - call read_REMDpar - endif -C Read MUCA control parameters if required - if (lmuca) call read_muca -C Read CSA control parameters if required (from fort.40 if exists -C otherwise from general input file) -csa if (modecalc.eq.8) then -csa inquire (file="fort.40",exist=file_exist) -csa if (.not.file_exist) call csaread -csa endif -cfmc if (modecalc.eq.10) call mcmfread -C Read molecule information, molecule geometry, energy-term weights, and -C restraints if requested - call molread -C Print restraint information -#ifdef MPI - if (.not. out1file .or. me.eq.king) then -#endif - if (nhpb.gt.nss) - &write (iout,'(a,i5,a)') "The following",nhpb-nss, - & " distance constraints have been imposed" - do i=nss+1,nhpb - write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i), - & ibecarb(i),dhpb(i),dhpb1(i),forcon(i) - enddo -#ifdef MPI - endif -#endif -c print *,"Processor",myrank," leaves READRTNS" - return - end -C------------------------------------------------------------------------------- - subroutine read_control -C -C Read contorl data -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/ - character*80 ucase - character*320 controlcard - - nglob_csa=0 - eglob_csa=1d99 - nmin_csa=0 - read (INP,'(a)') titel - call card_concat(controlcard) -c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0 -c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file - call reada(controlcard,'SEED',seed,0.0D0) - call random_init(seed) -C Set up the time limit (caution! The time must be input in minutes!) - read_cart=index(controlcard,'READ_CART').gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - call readi(controlcard,'CONSTR_HOMOL',constr_homology,0) - call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours - unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 - call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes - call reada(controlcard,'RMSDBC',rmsdbc,3.0D0) - call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0) - call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0) - call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0) - call reada(controlcard,'DRMS',drms,0.1D0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc - write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1 - write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max - write (iout,'(a,f10.1)')'DRMS = ',drms - write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm - write (iout,'(a,f10.1)') 'Time limit (min):',timlim - endif - call readi(controlcard,'NZ_START',nz_start,0) - call readi(controlcard,'NZ_END',nz_end,0) - call readi(controlcard,'IZ_SC',iz_sc,0) - timlim=60.0D0*timlim - safety = 60.0d0*safety - timem=timlim - modecalc=0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - minim=(index(controlcard,'MINIMIZE').gt.0) - dccart=(index(controlcard,'CART').gt.0) - overlapsc=(index(controlcard,'OVERLAP').gt.0) - overlapsc=.not.overlapsc - searchsc=(index(controlcard,'NOSEARCHSC').gt.0) - searchsc=.not.searchsc - sideadd=(index(controlcard,'SIDEADD').gt.0) - energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) - outpdb=(index(controlcard,'PDBOUT').gt.0) - outmol2=(index(controlcard,'MOL2OUT').gt.0) - pdbref=(index(controlcard,'PDBREF').gt.0) - refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) - indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) - call readi(controlcard,'IPRINT',iprint,0) - call readi(controlcard,'MAXGEN',maxgen,10000) - call readi(controlcard,'MAXOVERLAP',maxoverlap,1000) - call readi(controlcard,"KDIAG",kdiag,0) - call readi(controlcard,"RESCALE_MODE",rescale_mode,2) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) - & write (iout,*) "RESCALE_MODE",rescale_mode - split_ene=index(controlcard,'SPLIT_ENE').gt.0 - if (index(controlcard,'REGULAR').gt.0.0D0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - modecalc=1 - refstr=.true. - endif - if (index(controlcard,'CHECKGRAD').gt.0) then - modecalc=5 - if (index(controlcard,'CART').gt.0) then - icheckgrad=1 - elseif (index(controlcard,'CARINT').gt.0) then - icheckgrad=2 - else - icheckgrad=3 - endif - elseif (index(controlcard,'THREAD').gt.0) then - modecalc=2 - call readi(controlcard,'THREAD',nthread,0) - if (nthread.gt.0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - else - if (fg_rank.eq.0) - & write (iout,'(a)')'A number has to follow the THREAD keyword.' - stop 'Error termination in Read_Control.' - endif - else if (index(controlcard,'MCMA').gt.0) then - modecalc=3 - else if (index(controlcard,'MCEE').gt.0) then - modecalc=6 - else if (index(controlcard,'MULTCONF').gt.0) then - modecalc=4 - else if (index(controlcard,'MAP').gt.0) then - modecalc=7 - call readi(controlcard,'MAP',nmap,0) - else if (index(controlcard,'CSA').gt.0) then - write(*,*) "CSA not supported in this version" - stop -csa modecalc=8 -crc else if (index(controlcard,'ZSCORE').gt.0) then -crc -crc ZSCORE is rm from UNRES, modecalc=9 is available -crc -crc modecalc=9 -cfcm else if (index(controlcard,'MCMF').gt.0) then -cfmc modecalc=10 - else if (index(controlcard,'SOFTREG').gt.0) then - modecalc=11 - else if (index(controlcard,'CHECK_BOND').gt.0) then - modecalc=-1 - else if (index(controlcard,'TEST').gt.0) then - modecalc=-2 - else if (index(controlcard,'MD').gt.0) then - modecalc=12 - else if (index(controlcard,'RE ').gt.0) then - modecalc=14 - endif - - lmuca=index(controlcard,'MUCA').gt.0 - call readi(controlcard,'MUCADYN',mucadyn,0) - call readi(controlcard,'MUCASMOOTH',muca_smooth,0) - if (lmuca .and. (me.eq.king .or. .not.out1file )) - & then - write (iout,*) 'MUCADYN=',mucadyn - write (iout,*) 'MUCASMOOTH=',muca_smooth - endif - - iscode=index(controlcard,'ONE_LETTER') - indphi=index(controlcard,'PHI') - indback=index(controlcard,'BACK') - iranconf=index(controlcard,'RAND_CONF') - i2ndstr=index(controlcard,'USE_SEC_PRED') - gradout=index(controlcard,'GRADOUT').gt.0 - gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 - - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') diagmeth(kdiag), - & ' routine used to diagonalize matrices.' - return - end -c-------------------------------------------------------------------------- - subroutine read_REMDpar -C -C Read REMD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.REMD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*80 ucase - character*320 controlcard - character*3200 controlcard1 - integer iremd_m_total - - if(me.eq.king.or..not.out1file) - & write (iout,*) "REMD setup" - - call card_concat(controlcard) - call readi(controlcard,"NREP",nrep,3) - call readi(controlcard,"NSTEX",nstex,1000) - call reada(controlcard,"RETMIN",retmin,10.0d0) - call reada(controlcard,"RETMAX",retmax,1000.0d0) - mremdsync=(index(controlcard,'SYNC').gt.0) - call readi(controlcard,"NSYN",i_sync_step,100) - restart1file=(index(controlcard,'REST1FILE').gt.0) - traj1file=(index(controlcard,'TRAJ1FILE').gt.0) - call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1) - if(max_cache_traj_use.gt.max_cache_traj) - & max_cache_traj_use=max_cache_traj - if(me.eq.king.or..not.out1file) then -cd if (traj1file) then -crc caching is in testing - NTWX is not ignored -cd write (iout,*) "NTWX value is ignored" -cd write (iout,*) " trajectory is stored to one file by master" -cd write (iout,*) " before exchange at NSTEX intervals" -cd endif - write (iout,*) "NREP= ",nrep - write (iout,*) "NSTEX= ",nstex - write (iout,*) "SYNC= ",mremdsync - write (iout,*) "NSYN= ",i_sync_step - write (iout,*) "TRAJCACHE= ",max_cache_traj_use - endif - - t_exchange_only=(index(controlcard,'TONLY').gt.0) - call readi(controlcard,"HREMD",hremd,0) - if((me.eq.king.or..not.out1file).and.hremd.gt.0) then - write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights" - endif - if(usampl.and.hremd.gt.0) then - write (iout,'(//a)') - & "========== ERROR: USAMPL and HREMD cannot be used together" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop - endif - - - remd_tlist=.false. - if (index(controlcard,'TLIST').gt.0) then - remd_tlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_t(i),i=1,nrep) - if(me.eq.king.or..not.out1file) - & write (iout,*)'tlist',(remd_t(i),i=1,nrep) - endif - remd_mlist=.false. - if (index(controlcard,'MLIST').gt.0) then - remd_mlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_m(i),i=1,nrep) - if(me.eq.king.or..not.out1file) then - write (iout,*)'mlist',(remd_m(i),i=1,nrep) - iremd_m_total=0 - do i=1,nrep - iremd_m_total=iremd_m_total+remd_m(i) - enddo - if(hremd.gt.1)then - write (iout,*) 'Total number of replicas ', - & iremd_m_total*hremd - else - write (iout,*) 'Total number of replicas ',iremd_m_total - endif - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup " - return - end -c-------------------------------------------------------------------------- - subroutine read_MDpar -C -C Read MD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - character*80 ucase - character*320 controlcard - - call card_concat(controlcard) - call readi(controlcard,"NSTEP",n_timestep,1000000) - call readi(controlcard,"NTWE",ntwe,100) - call readi(controlcard,"NTWX",ntwx,1000) - call reada(controlcard,"DT",d_time,1.0d-1) - call reada(controlcard,"DVMAX",dvmax,2.0d1) - call reada(controlcard,"DAMAX",damax,1.0d1) - call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1) - call readi(controlcard,"LANG",lang,0) - RESPA = index(controlcard,"RESPA") .gt. 0 - call readi(controlcard,"NTIME_SPLIT",ntime_split,1) - ntime_split0=ntime_split - call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64) - ntime_split0=ntime_split - call reada(controlcard,"R_CUT",r_cut,2.0d0) - call reada(controlcard,"LAMBDA",rlamb,0.3d0) - rest = index(controlcard,"REST").gt.0 - tbf = index(controlcard,"TBF").gt.0 - call readi(controlcard,"HMC",hmc,0) - tnp = index(controlcard,"NOSEPOINCARE99").gt.0 - tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0 - tnh = index(controlcard,"NOSEHOOVER96").gt.0 - if (RESPA.and.tnh)then - xiresp = index(controlcard,"XIRESP").gt.0 - endif - call reada(controlcard,"Q_NP",Q_np,0.1d0) - usampl = index(controlcard,"USAMPL").gt.0 - - mdpdb = index(controlcard,"MDPDB").gt.0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1) - call reada(controlcard,"EQ_TIME",eq_time,1.0d+4) - call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000) - if (count_reset_moment.eq.0) count_reset_moment=1000000000 - call readi(controlcard,"RESET_VEL",count_reset_vel,1000) - reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0 - reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0 - if (count_reset_vel.eq.0) count_reset_vel=1000000000 - large = index(controlcard,"LARGE").gt.0 - print_compon = index(controlcard,"PRINT_COMPON").gt.0 - rattle = index(controlcard,"RATTLE").gt.0 -c if performing umbrella sampling, fragments constrained are read from the fragment file - nset=0 - if(usampl) then - call read_fragments - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) - write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run " - write (iout,*) - write (iout,'(a)') "The units are:" - write (iout,'(a)') "positions: angstrom, time: 48.9 fs" - write (iout,'(2a)') "velocity: angstrom/(48.9 fs),", - & " acceleration: angstrom/(48.9 fs)**2" - write (iout,'(a)') "energy: kcal/mol, temperature: K" - write (iout,*) - write (iout,'(a60,i10)') "Number of time steps:",n_timestep - write (iout,'(a60,f10.5,a)') - & "Initial time step of numerical integration:",d_time, - & " natural units" - write (iout,'(60x,f10.5,a)') d_time*48.9," fs" - if (RESPA) then - write (iout,'(2a,i4,a)') - & "A-MTS algorithm used; initial time step for fast-varying", - & " short-range forces split into",ntime_split," steps." - write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff", - & r_cut," lambda",rlamb - endif - write (iout,'(2a,f10.5)') - & "Maximum acceleration threshold to reduce the time step", - & "/increase split number:",damax - write (iout,'(2a,f10.5)') - & "Maximum predicted energy drift to reduce the timestep", - & "/increase split number:",edriftmax - write (iout,'(a60,f10.5)') - & "Maximum velocity threshold to reduce velocities:",dvmax - write (iout,'(a60,i10)') "Frequency of property output:",ntwe - write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx - if (rattle) write (iout,'(a60)') - & "Rattle algorithm used to constrain the virtual bonds" - endif - reset_fricmat=1000 - if (lang.gt.0) then - call reada(controlcard,"ETAWAT",etawat,0.8904d0) - call reada(controlcard,"RWAT",rwat,1.4d0) - call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2) - surfarea=index(controlcard,"SURFAREA").gt.0 - call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000) - if(me.eq.king.or..not.out1file)then - write (iout,'(/a,$)') "Langevin dynamics calculation" - if (lang.eq.1) then - write (iout,'(a/)') - & " with direct integration of Langevin equations" - else if (lang.eq.2) then - write (iout,'(a/)') " with TINKER stochasic MD integrator" - else if (lang.eq.3) then - write (iout,'(a/)') " with Ciccotti's stochasic MD integrator" - else if (lang.eq.4) then - write (iout,'(a/)') " in overdamped mode" - else - write (iout,'(//a,i5)') - & "=========== ERROR: Unknown Langevin dynamics mode:",lang - stop - endif - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat - write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat - write (iout,'(a60,f10.5)') - & "Scaling factor of the friction forces:",scal_fric - if (surfarea) write (iout,'(2a,i10,a)') - & "Friction coefficients will be scaled by solvent-accessible", - & " surface area every",reset_fricmat," steps." - endif -c Calculate friction coefficients and bounds of stochastic forces - eta=6*pi*cPoise*etawat - if(me.eq.king.or..not.out1file) - & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:" - & ,eta - gamp=scal_fric*(pstok+rwat)*eta - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - gamsc(i)=scal_fric*(restok(i)+rwat)*eta - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if(me.eq.king.or..not.out1file)then - write (iout,'(/2a/)') - & "Radii of site types and friction coefficients and std's of", - & " stochastic forces of fully exposed sites" - write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp) - do i=1,ntyp - write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i), - & gamsc(i),stdfsc(i)*dsqrt(gamsc(i)) - enddo - endif - else if (tbf) then - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') "Berendsen bath calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - endif - else if (tnp .or. tnp1 .or. tnh) then - if (tnp .or. tnp1) then - write (iout,'(a)') "Nose-Poincare bath calculation" - if (tnp) write (iout,'(a)') - & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird" - if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose" - else - write (iout,'(a)') "Nose-Hoover bath calculation" - write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al." - nresn=1 - nyosh=1 - nnos=1 - do i=1,nnos - qmass(i)=Q_np - xlogs(i)=1.0 - vlogs(i)=0.0 - enddo - do i=1,nyosh - WDTI(i) = 1.0*d_time/nresn - WDTI2(i)=WDTI(i)/2 - WDTI4(i)=WDTI(i)/4 - WDTI8(i)=WDTI(i)/8 - enddo - if (RESPA) then - if(xiresp) then - write (iout,'(a)') "NVT-XI-RESPA algorithm" - else - write (iout,'(a)') "NVT-XO-RESPA algorithm" - endif - do i=1,nyosh - WDTIi(i) = 1.0*d_time/nresn/ntime_split - WDTIi2(i)=WDTIi(i)/2 - WDTIi4(i)=WDTIi(i)/4 - WDTIi8(i)=WDTIi(i)/8 - enddo - endif - endif - - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Q =",Q_np - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - - else if (hmc.gt.0) then - write (iout,'(a)') "Hybrid Monte Carlo calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,i10)') - & "Number of MD steps between Metropolis tests:",hmc - - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a31)') "Microcanonical mode calculation" - endif - if(me.eq.king.or..not.out1file)then - if (rest) write (iout,'(/a/)') "===== Calculation restarted ====" - if (usampl) then - write(iout,*) "MD running with constraints." - write(iout,*) "Equilibration time ", eq_time, " mtus." - write(iout,*) "Constraining ", nfrag," fragments." - write(iout,*) "Length of each fragment, weight and q0:" - do iset=1,nset - write (iout,*) "Set of restraints #",iset - do i=1,nfrag - write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset), - & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset) - enddo - write(iout,*) "constraints between ", npair, "fragments." - write(iout,*) "constraint pairs, weights and q0:" - do i=1,npair - write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset), - & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset) - enddo - write(iout,*) "angle constraints within ", nfrag_back, - & "backbone fragments." - write(iout,*) "fragment, weights:" - do i=1,nfrag_back - write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset), - & ifrag_back(2,i,iset),wfrag_back(1,i,iset), - & wfrag_back(2,i,iset),wfrag_back(3,i,iset) - enddo - enddo - iset=mod(kolor,nset)+1 - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup " - return - end -c------------------------------------------------------------------------------ - subroutine molread -C -C Read molecular data. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer error_msg -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.CONTACTS' - include 'COMMON.TORCNSTR' - include 'COMMON.TIME1' - include 'COMMON.BOUNDS' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - character*4 sequence(maxres) - integer rescode - double precision x(maxvar) - character*256 pdbfile - character*320 weightcard - character*80 weightcard_t,ucase - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - logical seq_comp,fail - double precision energia(0:n_ene) - integer ilen - external ilen -C -C Body -C -C Read weights of the subsequent energy terms. - if(hremd.gt.0) then - - k=0 - do il=1,hremd - do i=1,nrep - do j=1,remd_m(i) - i2set(k)=il - k=k+1 - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write (iout,*) 'Reading ',hremd,' sets of weights for HREMD' - write (iout,*) 'Current weights for processor ', - & me,' set ',i2set(me) - endif - - do i=1,hremd - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - - hweights(i,1)=wsc - hweights(i,2)=wscp - hweights(i,3)=welec - hweights(i,4)=wcorr - hweights(i,5)=wcorr5 - hweights(i,6)=wcorr6 - hweights(i,7)=wel_loc - hweights(i,8)=wturn3 - hweights(i,9)=wturn4 - hweights(i,10)=wturn6 - hweights(i,11)=wang - hweights(i,12)=wscloc - hweights(i,13)=wtor - hweights(i,14)=wtor_d - hweights(i,15)=wstrain - hweights(i,16)=wvdwpp - hweights(i,17)=wbond - hweights(i,18)=scal14 - hweights(i,21)=wsccor - - enddo - - do i=1,n_ene - weights(i)=hweights(i2set(me),i) - enddo - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - - else - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - weights(1)=wsc - weights(2)=wscp - weights(3)=welec - weights(4)=wcorr - weights(5)=wcorr5 - weights(6)=wcorr6 - weights(7)=wel_loc - weights(8)=wturn3 - weights(9)=wturn4 - weights(10)=wturn6 - weights(11)=wang - weights(12)=wscloc - weights(13)=wtor - weights(14)=wtor_d - weights(15)=wstrain - weights(16)=wvdwpp - weights(17)=wbond - weights(18)=scal14 - weights(21)=wsccor - endif - - if(me.eq.king.or..not.out1file) - & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 10 format (/'Energy-term weights (unscaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file)then - if (wcorr4.gt.0.0d0) then - write (iout,'(/2a/)') 'Local-electrostatic type correlation ', - & 'between contact pairs of peptide groups' - write (iout,'(2(a,f5.3/))') - & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr, - & 'Range of quenching the correlation terms:',2*delt_corr - else if (wcorr.gt.0.0d0) then - write (iout,'(/2a/)') 'Hydrogen-bonding correlation ', - & 'between contact pairs of peptide groups' - endif - write (iout,'(a,f8.3)') - & 'Scaling factor of 1,4 SC-p interactions:',scal14 - write (iout,'(a,f8.3)') - & 'General scaling factor of SC-p interactions:',scalscp - endif - r0_corr=cutoff_corr-delt_corr - do i=1,20 - aad(i,1)=scalscp*aad(i,1) - aad(i,2)=scalscp*aad(i,2) - bad(i,1)=scalscp*bad(i,1) - bad(i,2)=scalscp*bad(i,2) - enddo - call rescale_weights(t_bath) - if(me.eq.king.or..not.out1file) - & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 22 format (/'Energy-term weights (scaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file) - & write (iout,*) "Reference temperature for weights calculation:", - & temp0 - call reada(weightcard,"D0CM",d0cm,3.78d0) - call reada(weightcard,"AKCM",akcm,15.1d0) - call reada(weightcard,"AKTH",akth,11.0d0) - call reada(weightcard,"AKCT",akct,12.0d0) - call reada(weightcard,"V1SS",v1ss,-1.08d0) - call reada(weightcard,"V2SS",v2ss,7.61d0) - call reada(weightcard,"V3SS",v3ss,13.7d0) - call reada(weightcard,"EBR",ebr,-5.50D0) - dyn_ss=(index(weightcard,'DYN_SS').gt.0) - do i=1,maxres - dyn_ss_mask(i)=.false. - enddo - do i=1,maxres-1 - do j=i+1,maxres - dyn_ssbond_ij(i,j)=1.0d300 - enddo - enddo - call reada(weightcard,"HT",Ht,0.0D0) - if (dyn_ss) then - ss_depth=ebr/wsc-0.25*eps(1,1) - Ht=Ht/wsc-0.25*eps(1,1) - akcm=akcm*wstrain/wsc - akth=akth*wstrain/wsc - akct=akct*wstrain/wsc - v1ss=v1ss*wstrain/wsc - v2ss=v2ss*wstrain/wsc - v3ss=v3ss*wstrain/wsc - else - ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) "Parameters of the SS-bond potential:" - write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, - & " AKCT",akct - write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth - write (iout,*)" HT",Ht - print *,'indpdb=',indpdb,' pdbref=',pdbref - endif - if (indpdb.gt.0 .or. pdbref) then - read(inp,'(a)') pdbfile - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') 'PDB data will be read from file ', - & pdbfile(:ilen(pdbfile)) - open(ipdbin,file=pdbfile,status='old',err=33) - goto 34 - 33 write (iout,'(a)') 'Error opening PDB file.' - stop - 34 continue -c print *,'Begin reading pdb data' - call readpdb -c print *,'Finished reading pdb data' - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3,a,i3)')'nsup=',nsup, - & ' nstart_sup=',nstart_sup - do i=1,nres - itype_pdb(i)=itype(i) - enddo - close (ipdbin) - nnt=nstart_sup - nct=nstart_sup+nsup-1 - call contact(.false.,ncont_ref,icont_ref,co) - - if (sideadd) then -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "Before sideadd" - call intout - if(me.eq.king.or..not.out1file) - & write(iout,*)'Adding sidechains' - maxsi=1000 - do i=2,nres-1 - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) write(iout,*)'Adding sidechain failed for res ', - & i,' after ',nsi,' trials' - endif - enddo -C 10/03/12 Adam: Recalculate coordinates with new side chain positions - call chainbuild - endif -C Following 2 lines for diagnostics; comment out if not needed -c write (iout,*) "After sideadd" -c call intout - endif - if (indpdb.eq.0) then -C Read sequence if not taken from the pdb file. - read (inp,*) nres -c print *,'nres=',nres - if (iscode.gt.0) then - read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres) - else - read (inp,'(20(1x,a3))') (sequence(i),i=1,nres) - endif -C Convert sequence to numeric code - do i=1,nres - itype(i)=rescode(i,sequence(i),iscode) - enddo -C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(itype(i)) - vbld_inv(i+nres)=dsc_inv(itype(i)) -c write (iout,*) "i",i," itype",itype(i), -c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo - endif -c print *,nres -c print '(20i4)',(itype(i),i=1,nres) - do i=1,nres -#ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then -#else - if (itype(i).eq.21) then -#endif - itel(i)=0 -#ifdef PROCOR - else if (itype(i+1).ne.20) then -#else - else if (itype(i).ne.20) then -#endif - itel(i)=1 - else - itel(i)=2 - endif - enddo - if(me.eq.king.or..not.out1file)then - write (iout,*) "ITEL" - do i=1,nres-1 - write (iout,*) i,itype(i),itel(i) - enddo - print *,'Call Read_Bridge.' - endif - call read_bridge -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - read (inp,*) ndih_constr - if (ndih_constr.gt.0) then - read (inp,*) ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) - if(me.eq.king.or..not.out1file)then - write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' - do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) - enddo - endif - do i=1,ndih_constr - phi0(i)=deg2rad*phi0(i) - drange(i)=deg2rad*drange(i) - enddo - if(me.eq.king.or..not.out1file) - & write (iout,*) 'FTORS',ftors - do i=1,ndih_constr - ii = idih_constr(i) - phibound(1,ii) = phi0(i)-drange(i) - phibound(2,ii) = phi0(i)+drange(i) - enddo - endif - nnt=1 -#ifdef MPI - if (me.eq.king) then -#endif - write (iout,'(a)') 'Boundaries in phi angle sampling:' - do i=1,nres - write (iout,'(a3,i5,2f10.1)') - & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg - enddo -#ifdef MP - endif -#endif - nct=nres -cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3)') 'nsup=',nsup - nstart_seq=nnt - if (nsup.le.(nct-nnt+1)) then - do i=0,nct-nnt+1-nsup - if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then - nstart_seq=nnt+i - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - stop - else - do i=0,nsup-(nct-nnt+1) - if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1)) - & then - nstart_sup=nstart_sup+i - nsup=nct-nnt+1 - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - endif - 111 continue - if (nsup.eq.0) nsup=nct-nnt - if (nstart_sup.eq.0) nstart_sup=nnt - if (nstart_seq.eq.0) nstart_seq=nnt - if(me.eq.king.or..not.out1file) - & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, - & ' nstart_seq=',nstart_seq - endif -c--- Zscore rms ------- - if (nz_start.eq.0) nz_start=nnt - if (nz_end.eq.0 .and. nsup.gt.0) then - nz_end=nnt+nsup-1 - else if (nz_end.eq.0) then - nz_end=nct - endif - if(me.eq.king.or..not.out1file)then - write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end - write (iout,*) 'IZ_SC=',iz_sc - endif -c---------------------- - call init_int_table - if (refstr) then - if (.not.pdbref) then - call read_angles(inp,*38) - goto 39 - 38 write (iout,'(a)') 'Error reading reference structure.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) - stop 'Error reading reference structure' -#endif - 39 call chainbuild - call setup_var -czscore call geom_to_var(nvar,coord_exp_zs(1,1)) - nstart_sup=nnt - nstart_seq=nnt - nsup=nct-nnt+1 - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - call contact(.true.,ncont_ref,icont_ref,co) - endif - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Contact order:',co - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup - do i=1,ncont_ref - do j=1,2 - icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup - enddo - if(me.eq.king.or..not.out1file) - & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ', - & icont_ref(1,i),' ', - & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i) - enddo - endif - endif -c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup - if (constr_dist.gt.0) then - call read_dist_constr - endif - - - if (constr_homology.gt.0) then - call read_constr_homology - endif - - - if (nhpb.gt.0) call hpb_partition -c write (iout,*) "After read_dist_constr nhpb",nhpb -c call flush(iout) - if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 - & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. - & modecalc.ne.10) then -C If input structure hasn't been supplied from the PDB file read or generate -C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then - if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) - & write (iout,'(a)') 'Initial geometry will be read in.' - if (read_cart) then - read(inp,'(8f10.5)',end=36,err=36) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - return - else - call read_angles(inp,*36) - endif - goto 37 - 36 write (iout,'(a)') 'Error reading angle file.' -#ifdef MPI - call mpi_finalize( MPI_COMM_WORLD,IERR ) -#endif - stop 'Error reading angle file.' - 37 continue - else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - enddo - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a)') 'Random-generated initial geometry.' - - -#ifdef MPI - if (me.eq.king .or. fg_rank.eq.0 .and. ( - & modecalc.eq.12 .or. modecalc.eq.14) ) then -#endif - do itrial=1,100 - itmp=1 - call gen_rand_conf(itmp,*30) - goto 40 - 30 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Processor:',me, - & ' Failed to generate random conformation', - & ' itrial=',itrial - call intout - -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - call flush(iout) -#ifdef MPI - call MPI_Abort(mpi_comm_world,error_msg,ierrcode) - 40 continue - endif -#else - 40 continue -#endif - endif - elseif (modecalc.eq.4) then - read (inp,'(a)') intinname - open (intin,file=intinname,status='old',err=333) - if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0) - & write (iout,'(a)') 'intinname',intinname - write (*,'(a)') 'Processor',myrank,' intinname',intinname - goto 334 - 333 write (iout,'(2a)') 'Error opening angle file ',intinname -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERR) -#endif - stop 'Error opening angle file.' - 334 continue - - endif -C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif - call setup_var - if (me.eq.king .or. .not. out1file) - & call intout - if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then - write (iout,'(/a,i3,a)') - & 'The chain contains',ns,' disulfide-bridging cysteines.' - write (iout,'(20i4)') (iss(i),i=1,ns) - if (dyn_ss) then - write(iout,*)"Running with dynamic disulfide-bond formation" - else - write (iout,'(/a/)') 'Pre-formed links are:' - do i=1,nss - i1=ihpb(i)-nres - i2=jhpb(i)-nres - it1=itype(i1) - it2=itype(i2) - write (iout,'(2a,i3,3a,i3,a,3f10.3)') - & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), - & ebr,forcon(i) - enddo - write (iout,'(a)') - endif - endif - if (ns.gt.0.and.dyn_ss) then - do i=nss+1,nhpb - ihpb(i-nss)=ihpb(i) - jhpb(i-nss)=jhpb(i) - forcon(i-nss)=forcon(i) - dhpb(i-nss)=dhpb(i) - enddo - nhpb=nhpb-nss - nss=0 - call hpb_partition - do i=1,ns - dyn_ss_mask(iss(i))=.true. - enddo - endif - if (i2ndstr.gt.0) call secstrp2dihc -c call geom_to_var(nvar,x) -c call etotal(energia(0)) -c call enerprint(energia(0)) -c call briefout(0,etot) -c stop -cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT -cd write (iout,'(a)') 'Variable list:' -cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar) -#ifdef MPI - if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file)) - & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') - & 'Processor',myrank,': end reading molecular data.' -#endif - return - end -c-------------------------------------------------------------------------- - logical function seq_comp(itypea,itypeb,length) - implicit none - integer length,itypea(length),itypeb(length) - integer i - do i=1,length - if (itypea(i).ne.itypeb(i)) then - seq_comp=.false. - return - endif - enddo - seq_comp=.true. - return - end -c----------------------------------------------------------------------------- - subroutine read_bridge -C Read information about disulfide bridges. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -C Read bridging residues. - read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns - if(me.eq.king.or..not.out1file) - & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) -C Check whether the specified bridging residues are cystines. - do i=1,ns - if (itype(iss(i)).ne.1) then - if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' - write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ', - & restyp(itype(iss(i))),i, - & ' can form a disulfide bridge?!!!' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo -C Read preformed bridges. - if (ns.gt.0) then - read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - if(fg_rank.eq.0) - & write(iout,*)'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) - if (nss.gt.0) then - nhpb=nss -C Check if the residues involved in bridges are in the specified list of -C bridging residues. - do i=1,nss - do j=1,i-1 - if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j) - & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then - write (iout,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' - write (*,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo - do j=1,ns - if (ihpb(i).eq.iss(j)) goto 10 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 10 continue - do j=1,ns - if (jhpb(i).eq.iss(j)) goto 20 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 20 continue - dhpb(i)=dbr - forcon(i)=fbr - enddo - do i=1,nss - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - enddo - endif - endif - return - end -c---------------------------------------------------------------------------- - subroutine read_x(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' -c Read coordinates from input -c - read(kanal,'(8f10.5)',end=10,err=10) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine read_threadbase - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Read pattern database for threading. - read (icbase,*) nseq - do i=1,nseq - read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), - & nres_base(2,i),nres_base(3,i) - read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, - & nres_base(1,i)) -c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), -c & nres_base(2,i),nres_base(3,i) -c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, -c & nres_base(1,i)) - enddo - close (icbase) - if (weidis.eq.0.0D0) weidis=0.1D0 - do i=nnt,nct - do j=i+2,nct - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=weidis - enddo - enddo - read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl) - write (iout,'(a,i5)') 'nexcl: ',nexcl - write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl) - return - end -c------------------------------------------------------------------------------ - subroutine setup_var - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Set up variable list. - ntheta=nres-2 - nphi=nres-3 - nvar=ntheta+nphi - nside=0 - do i=2,nres-1 - if (itype(i).ne.10) then - nside=nside+1 - ialph(i,1)=nvar+nside - ialph(nside,2)=i - endif - enddo - if (indphi.gt.0) then - nvar=nphi - else if (indback.gt.0) then - nvar=nphi+ntheta - else - nvar=nvar+2*nside - endif -cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1) - return - end -c---------------------------------------------------------------------------- - subroutine gen_dist_constr -C Generate CA distance constraints. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - character*2 iden -cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct -cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct, -cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq, -cd & ' nsup',nsup - do i=nstart_sup,nstart_sup+nsup-1 -cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), -cd & ' seq_pdb', restyp(itype_pdb(i)) - do j=i+2,nstart_sup+nsup-1 - nhpb=nhpb+1 - ihpb(nhpb)=i+nstart_seq-nstart_sup - jhpb(nhpb)=j+nstart_seq-nstart_sup - forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) - enddo - enddo -cd write (iout,'(a)') 'Distance constraints:' -cd do i=nss+1,nhpb -cd ii=ihpb(i) -cd jj=jhpb(i) -cd iden='CA' -cd if (ii.gt.nres) then -cd iden='SC' -cd ii=ii-nres -cd jj=jj-nres -cd endif -cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)') -cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, -cd & dhpb(i),forcon(i) -cd enddo - return - end -c---------------------------------------------------------------------------- - subroutine map_read - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.IOUNITS' - character*3 angid(4) /'THE','PHI','ALP','OME'/ - character*80 mapcard,ucase - do imap=1,nmap - read (inp,'(a)') mapcard - mapcard=ucase(mapcard) - if (index(mapcard,'PHI').gt.0) then - kang(imap)=1 - else if (index(mapcard,'THE').gt.0) then - kang(imap)=2 - else if (index(mapcard,'ALP').gt.0) then - kang(imap)=3 - else if (index(mapcard,'OME').gt.0) then - kang(imap)=4 - else - write(iout,'(a)')'Error - illegal variable spec in MAP card.' - stop 'Error - illegal variable spec in MAP card.' - endif - call readi (mapcard,'RES1',res1(imap),0) - call readi (mapcard,'RES2',res2(imap),0) - if (res1(imap).eq.0) then - res1(imap)=res2(imap) - else if (res2(imap).eq.0) then - res2(imap)=res1(imap) - endif - if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then - write (iout,'(a)') - & 'Error - illegal definition of variable group in MAP.' - stop 'Error - illegal definition of variable group in MAP.' - endif - call reada(mapcard,'FROM',ang_from(imap),0.0D0) - call reada(mapcard,'TO',ang_to(imap),0.0D0) - call readi(mapcard,'NSTEP',nstep(imap),0) - if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then - write (iout,'(a)') - & 'Illegal boundary and/or step size specification in MAP.' - stop 'Illegal boundary and/or step size specification in MAP.' - endif - enddo ! imap - return - end -c---------------------------------------------------------------------------- -csa subroutine csaread -csa implicit real*8 (a-h,o-z) -csa include 'DIMENSIONS' -csa include 'COMMON.IOUNITS' -csa include 'COMMON.GEO' -csa include 'COMMON.CSA' -csa include 'COMMON.BANK' -csa include 'COMMON.CONTROL' -csa character*80 ucase -csa character*620 mcmcard -csa call card_concat(mcmcard) -csa -csa call readi(mcmcard,'NCONF',nconf,50) -csa call readi(mcmcard,'NADD',nadd,0) -csa call readi(mcmcard,'JSTART',jstart,1) -csa call readi(mcmcard,'JEND',jend,1) -csa call readi(mcmcard,'NSTMAX',nstmax,500000) -csa call readi(mcmcard,'N0',n0,1) -csa call readi(mcmcard,'N1',n1,6) -csa call readi(mcmcard,'N2',n2,4) -csa call readi(mcmcard,'N3',n3,0) -csa call readi(mcmcard,'N4',n4,0) -csa call readi(mcmcard,'N5',n5,0) -csa call readi(mcmcard,'N6',n6,10) -csa call readi(mcmcard,'N7',n7,0) -csa call readi(mcmcard,'N8',n8,0) -csa call readi(mcmcard,'N9',n9,0) -csa call readi(mcmcard,'N14',n14,0) -csa call readi(mcmcard,'N15',n15,0) -csa call readi(mcmcard,'N16',n16,0) -csa call readi(mcmcard,'N17',n17,0) -csa call readi(mcmcard,'N18',n18,0) -csa -csa vdisulf=(index(mcmcard,'DYNSS').gt.0) -csa -csa call readi(mcmcard,'NDIFF',ndiff,2) -csa call reada(mcmcard,'DIFFCUT',diffcut,0.0d0) -csa call readi(mcmcard,'IS1',is1,1) -csa call readi(mcmcard,'IS2',is2,8) -csa call readi(mcmcard,'NRAN0',nran0,4) -csa call readi(mcmcard,'NRAN1',nran1,2) -csa call readi(mcmcard,'IRR',irr,1) -csa call readi(mcmcard,'NSEED',nseed,20) -csa call readi(mcmcard,'NTOTAL',ntotal,10000) -csa call reada(mcmcard,'CUT1',cut1,2.0d0) -csa call reada(mcmcard,'CUT2',cut2,5.0d0) -csa call reada(mcmcard,'ESTOP',estop,-3000.0d0) -csa call readi(mcmcard,'ICMAX',icmax,3) -csa call readi(mcmcard,'IRESTART',irestart,0) -csac!bankt call readi(mcmcard,'NBANKTM',ntbankm,0) -csa ntbankm=0 -csac!bankt -csa call reada(mcmcard,'DELE',dele,20.0d0) -csa call reada(mcmcard,'DIFCUT',difcut,720.0d0) -csa call readi(mcmcard,'IREF',iref,0) -csa call reada(mcmcard,'RMSCUT',rmscut,4.0d0) -csa call reada(mcmcard,'PNCCUT',pnccut,0.5d0) -csa call readi(mcmcard,'NCONF_IN',nconf_in,0) -csa call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0) -csa write (iout,*) "NCONF_IN",nconf_in -csa return -csa end -c---------------------------------------------------------------------------- -cfmc subroutine mcmfread -cfmc implicit real*8 (a-h,o-z) -cfmc include 'DIMENSIONS' -cfmc include 'COMMON.MCMF' -cfmc include 'COMMON.IOUNITS' -cfmc include 'COMMON.GEO' -cfmc character*80 ucase -cfmc character*620 mcmcard -cfmc call card_concat(mcmcard) -cfmc -cfmc call readi(mcmcard,'MAXRANT',maxrant,1000) -cfmc write(iout,*)'MAXRANT=',maxrant -cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p) -cfmc write(iout,*)'MAXFAM=',maxfam -cfmc call readi(mcmcard,'NNET1',nnet1,5) -cfmc write(iout,*)'NNET1=',nnet1 -cfmc call readi(mcmcard,'NNET2',nnet2,4) -cfmc write(iout,*)'NNET2=',nnet2 -cfmc call readi(mcmcard,'NNET3',nnet3,4) -cfmc write(iout,*)'NNET3=',nnet3 -cfmc call readi(mcmcard,'ILASTT',ilastt,0) -cfmc write(iout,*)'ILASTT=',ilastt -cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf) -cfmc write(iout,*)'MAXSTR=',maxstr -cfmc maxstr_f=maxstr/maxfam -cfmc write(iout,*)'MAXSTR_F=',maxstr_f -cfmc call readi(mcmcard,'NMCMF',nmcmf,10) -cfmc write(iout,*)'NMCMF=',nmcmf -cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf) -cfmc write(iout,*)'IFOCUS=',ifocus -cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000) -cfmc write(iout,*)'NLOCMCMF=',nlocmcmf -cfmc call readi(mcmcard,'INTPRT',intprt,1000) -cfmc write(iout,*)'INTPRT=',intprt -cfmc call readi(mcmcard,'IPRT',iprt,100) -cfmc write(iout,*)'IPRT=',iprt -cfmc call readi(mcmcard,'IMAXTR',imaxtr,100) -cfmc write(iout,*)'IMAXTR=',imaxtr -cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000) -cfmc write(iout,*)'MAXEVEN=',maxeven -cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3) -cfmc write(iout,*)'MAXEVEN1=',maxeven1 -cfmc call readi(mcmcard,'INIMIN',inimin,200) -cfmc write(iout,*)'INIMIN=',inimin -cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10) -cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf -cfmc call readi(mcmcard,'NTHREAD',nthread,5) -cfmc write(iout,*)'NTHREAD=',nthread -cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500) -cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf -cfmc call readi(mcmcard,'MAXPERT',maxpert,9) -cfmc write(iout,*)'MAXPERT=',maxpert -cfmc call readi(mcmcard,'IRMSD',irmsd,1) -cfmc write(iout,*)'IRMSD=',irmsd -cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0) -cfmc write(iout,*)'DENEMIN=',denemin -cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0) -cfmc write(iout,*)'RCUT1S=',rcut1s -cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0) -cfmc write(iout,*)'RCUT1E=',rcut1e -cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0) -cfmc write(iout,*)'RCUT2S=',rcut2s -cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0) -cfmc write(iout,*)'RCUT2E=',rcut2e -cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0) -cfmc write(iout,*)'DPERT1=',d_pert1 -cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0) -cfmc write(iout,*)'DPERT1A=',d_pert1a -cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0) -cfmc write(iout,*)'DPERT2=',d_pert2 -cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0) -cfmc write(iout,*)'DPERT2A=',d_pert2a -cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0) -cfmc write(iout,*)'DPERT2B=',d_pert2b -cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0) -cfmc write(iout,*)'DPERT2C=',d_pert2c -cfmc d_pert1=deg2rad*d_pert1 -cfmc d_pert1a=deg2rad*d_pert1a -cfmc d_pert2=deg2rad*d_pert2 -cfmc d_pert2a=deg2rad*d_pert2a -cfmc d_pert2b=deg2rad*d_pert2b -cfmc d_pert2c=deg2rad*d_pert2c -cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0) -cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1 -cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0) -cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2 -cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0) -cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1 -cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0) -cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2 -cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0) -cfmc write(iout,*)'RCUTINI=',rcutini -cfmc call reada(mcmcard,'GRAT',grat,0.5D0) -cfmc write(iout,*)'GRAT=',grat -cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0) -cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf -cfmc -cfmc return -cfmc end -c---------------------------------------------------------------------------- - subroutine mcmread - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 mcmcard - call card_concat(mcmcard) - call readi(mcmcard,'MAXACC',maxacc,100) - call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000) - call readi(mcmcard,'MAXTRIAL',maxtrial,100) - call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000) - call readi(mcmcard,'MAXREPM',maxrepm,200) - call reada(mcmcard,'RANFRACT',RanFract,0.5D0) - call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0) - call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3) - call reada(mcmcard,'E_UP',e_up,5.0D0) - call reada(mcmcard,'DELTE',delte,0.1D0) - call readi(mcmcard,'NSWEEP',nsweep,5) - call readi(mcmcard,'NSTEPH',nsteph,0) - call readi(mcmcard,'NSTEPC',nstepc,0) - call reada(mcmcard,'TMIN',tmin,298.0D0) - call reada(mcmcard,'TMAX',tmax,298.0D0) - call readi(mcmcard,'NWINDOW',nwindow,0) - call readi(mcmcard,'PRINT_MC',print_mc,0) - print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0) - print_int=(index(mcmcard,'NO_PRINT_INT').le.0) - ent_read=(index(mcmcard,'ENT_READ').gt.0) - call readi(mcmcard,'SAVE_FREQ',save_frequency,1000) - call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000) - call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000) - call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000) - call readi(mcmcard,'PRINT_FREQ',print_freq,1000) - if (nwindow.gt.0) then - read (inp,*) (winstart(i),winend(i),i=1,nwindow) - do i=1,nwindow - winlen(i)=winend(i)-winstart(i)+1 - enddo - endif - if (tmax.lt.tmin) tmax=tmin - if (tmax.eq.tmin) then - nstepc=0 - nsteph=0 - endif - if (nstepc.gt.0 .and. nsteph.gt.0) then - tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0)) - tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0)) - endif -C Probabilities of different move types - sumpro_type(0)=0.0D0 - call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0) - call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0) - sumpro_type(2)=sumpro_type(1)+sumpro_type(2) - call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0) - sumpro_type(3)=sumpro_type(2)+sumpro_type(3) - call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0) - sumpro_type(4)=sumpro_type(3)+sumpro_type(4) - do i=1,MaxMoveType - print *,'i',i,' sumprotype',sumpro_type(i) - sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType) - print *,'i',i,' sumprotype',sumpro_type(i) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine read_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MINIM' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 minimcard - call card_concat(minimcard) - call readi(minimcard,'MAXMIN',maxmin,2000) - call readi(minimcard,'MAXFUN',maxfun,5000) - call readi(minimcard,'MINMIN',minmin,maxmin) - call readi(minimcard,'MINFUN',minfun,maxmin) - call reada(minimcard,'TOLF',tolf,1.0D-2) - call reada(minimcard,'RTOLF',rtolf,1.0D-4) - print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1) - print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1) - print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1) - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Options in energy minimization:' - write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') - & 'MaxMin:',MaxMin,' MaxFun:',MaxFun, - & 'MinMin:',MinMin,' MinFun:',MinFun, - & ' TolF:',TolF,' RTolF:',RTolF - return - end -c---------------------------------------------------------------------------- - subroutine read_angles(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' -c Read angles from input -c - read (kanal,*,err=10,end=10) (theta(i),i=3,nres) - read (kanal,*,err=10,end=10) (phi(i),i=4,nres) - read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1) - read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1) - - do i=1,nres -c 9/7/01 avoid 180 deg valence angle - if (theta(i).gt.179.99d0) theta(i)=179.99d0 -c - theta(i)=deg2rad*theta(i) - phi(i)=deg2rad*phi(i) - alph(i)=deg2rad*alph(i) - omeg(i)=deg2rad*omeg(i) - enddo - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine openunits - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - character*16 form,nodename - integer nodelen -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - integer lenpre,lenpot,ilen,lentmp - external ilen - character*3 out1file_text,ucase - character*3 ll - external ucase -c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits" - call getenv_loc("PREFIX",prefix) - pref_orig = prefix - call getenv_loc("POT",pot) - call getenv_loc("DIRTMP",tmpdir) - call getenv_loc("CURDIR",curdir) - call getenv_loc("OUT1FILE",out1file_text) -c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV" - out1file_text=ucase(out1file_text) - if (out1file_text(1:1).eq."Y") then - out1file=.true. - else - out1file=fg_rank.gt.0 - endif - lenpre=ilen(prefix) - lenpot=ilen(pot) - lentmp=ilen(tmpdir) - if (lentmp.gt.0) then - write (*,'(80(1h!))') - write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!" - write (*,'(80(1h!))') - write (*,*)"All output files will be on node /tmp directory." -#ifdef MPI - call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR ) - if (me.eq.king) then - write (*,*) "The master node is ",nodename - else if (fg_rank.eq.0) then - write (*,*) "I am the CG slave node ",nodename - else - write (*,*) "I am the FG slave node ",nodename - endif -#endif - PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre) - lenpre = lentmp+lenpre+1 - endif - entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' -C Get the names and open the input files -#if defined(WINIFL) || defined(WINPGI) - open(1,file=pref_orig(:ilen(pref_orig))// - & '.inp',status='old',readonly,shared) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly,shared) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly,shared) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly,shared) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly,shared) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly,shared) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly,shared) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly,shared) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & action='read') -c print *,"Processor",myrank," opened file 1" - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -c print *,"Processor",myrank," opened file 9" -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') -c print *,"Processor",myrank," opened file IBOND" - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -c print *,"Processor",myrank," opened file ITHEP" -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',action='read') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -c print *,"Processor",myrank," opened file IROTAM" -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORP" - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORDP" - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') -c print *,"Processor",myrank," opened file ISCCOR" - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') -c print *,"Processor",myrank," opened file IFOURIER" - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') -c print *,"Processor",myrank," opened file IELEP" - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -c print *,"Processor",myrank," opened file ISIDEP" -c print *,"Processor",myrank," opened parameter files" -#elif (defined G77) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') -#else - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - &action='read') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - print *,"thetname_pdb ",thetname_pdb - open (ithep_pdb,file=thetname_pdb,status='old',action='read') - print *,ithep_pdb," opened" -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -#endif -#ifndef OLDSCP -C -C 8/9/01 In the newest version SCp interaction constants are read from a file -C Use -DOLDSCP to use hard-coded constants instead. -C - call getenv_loc('SCPPAR',scpname) -#if defined(WINIFL) || defined(WINPGI) - open (iscpp,file=scpname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (iscpp,file=scpname,status='old',action='read') -#elif (defined G77) - open (iscpp,file=scpname,status='old') -#else - open (iscpp,file=scpname,status='old',action='read') -#endif -#endif - call getenv_loc('PATTERN',patname) -#if defined(WINIFL) || defined(WINPGI) - open (icbase,file=patname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (icbase,file=patname,status='old',action='read') -#elif (defined G77) - open (icbase,file=patname,status='old') -#else - open (icbase,file=patname,status='old',action='read') -#endif -#ifdef MPI -C Open output file only for CG processes -c print *,"Processor",myrank," fg_rank",fg_rank - if (fg_rank.eq.0) then - - if (nodes.eq.1) then - npos=3 - else - npos = dlog10(dfloat(nodes-1))+1 - endif - if (npos.lt.3) npos=3 - write (liczba,'(i1)') npos - form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) - & //')' - write (liczba,form) me - outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// - & liczba(:ilen(liczba)) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //liczba(:ilen(liczba))//'.stat') - rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) - & //'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.const' - endif - - endif -#else - outname=prefix(:lenpre)//'.out_'//pot(:lenpot) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //'.stat') - rest2name=prefix(:ilen(prefix))//'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const' - endif -#endif -#if defined(AIX) || defined(PGI) - if (me.eq.king .or. .not. out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',position='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',position='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#else - if (me.eq.king .or. .not.out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - print "Processor",fg_rank," opening output file" - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',access='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',access='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#endif -csa csa_rbank=prefix(:lenpre)//'.CSA.rbank' -csa csa_seed=prefix(:lenpre)//'.CSA.seed' -csa csa_history=prefix(:lenpre)//'.CSA.history' -csa csa_bank=prefix(:lenpre)//'.CSA.bank' -csa csa_bank1=prefix(:lenpre)//'.CSA.bank1' -csa csa_alpha=prefix(:lenpre)//'.CSA.alpha' -csa csa_alpha1=prefix(:lenpre)//'.CSA.alpha1' -csac!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt' -csa csa_int=prefix(:lenpre)//'.int' -csa csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized' -csa csa_native_int=prefix(:lenpre)//'.CSA.native.int' -csa csa_in=prefix(:lenpre)//'.CSA.in' -c print *,"Processor",myrank,"fg_rank",fg_rank," opened files" -C Write file names - if (me.eq.king)then - write (iout,'(80(1h-))') - write (iout,'(30x,a)') "FILE ASSIGNMENT" - write (iout,'(80(1h-))') - write (iout,*) "Input file : ", - & pref_orig(:ilen(pref_orig))//'.inp' - write (iout,*) "Output file : ", - & outname(:ilen(outname)) - write (iout,*) - write (iout,*) "Sidechain potential file : ", - & sidename(:ilen(sidename)) -#ifndef OLDSCP - write (iout,*) "SCp potential file : ", - & scpname(:ilen(scpname)) -#endif - write (iout,*) "Electrostatic potential file : ", - & elename(:ilen(elename)) - write (iout,*) "Cumulant coefficient file : ", - & fouriername(:ilen(fouriername)) - write (iout,*) "Torsional parameter file : ", - & torname(:ilen(torname)) - write (iout,*) "Double torsional parameter file : ", - & tordname(:ilen(tordname)) - write (iout,*) "SCCOR parameter file : ", - & sccorname(:ilen(sccorname)) - write (iout,*) "Bond & inertia constant file : ", - & bondname(:ilen(bondname)) - write (iout,*) "Bending parameter file : ", - & thetname(:ilen(thetname)) - write (iout,*) "Rotamer parameter file : ", - & rotname(:ilen(rotname)) - write (iout,*) "Threading database : ", - & patname(:ilen(patname)) - if (lentmp.ne.0) - &write (iout,*)" DIRTMP : ", - & tmpdir(:lentmp) - write (iout,'(80(1h-))') - endif - return - end -c---------------------------------------------------------------------------- - subroutine card_concat(card) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*(*) card - character*80 karta,ucase - external ilen - read (inp,'(a)') karta - karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end -c---------------------------------------------------------------------------------- - subroutine readrst - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - open(irest2,file=rest2name,status='unknown') - read(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - read(irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl) then - read (irest2,*) iset - endif - close(irest2) - return - end -c--------------------------------------------------------------------------------- - subroutine read_fragments - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - read(inp,*) nset,nfrag,npair,nfrag_back - if(me.eq.king.or..not.out1file) - & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair, - & " nfrag_back",nfrag_back - do iset=1,nset - read(inp,*) mset(iset) - do i=1,nfrag - read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset), - & qinfrag(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset), - & ifrag(2,i,iset), qinfrag(i,iset) - enddo - do i=1,npair - read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset), - & qinpair(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset), - & ipair(2,i,iset), qinpair(i,iset) - enddo - do i=1,nfrag_back - read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset), - & ifrag_back(1,i,iset),ifrag_back(2,i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset) - enddo - enddo - return - end -c------------------------------------------------------------------------------- - subroutine read_dist_constr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - integer ifrag_(2,100),ipair_(2,100) - double precision wfrag_(100),wpair_(100) - character*500 controlcard -c write (iout,*) "Calling read_dist_constr" -c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup -c call flush(iout) - call card_concat(controlcard) - call readi(controlcard,"NFRAG",nfrag_,0) - call readi(controlcard,"NPAIR",npair_,0) - call readi(controlcard,"NDIST",ndist_,0) - call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) - call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) - call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) - call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) - call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) -c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ -c write (iout,*) "IFRAG" -c do i=1,nfrag_ -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) -c enddo -c write (iout,*) "IPAIR" -c do i=1,npair_ -c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) -c enddo - if (.not.refstr .and. nfrag.gt.0) then - write (iout,*) - & "ERROR: no reference structure to compute distance restraints" - write (iout,*) - & "Restraints must be specified explicitly (NDIST=number)" - stop - endif - if (nfrag.lt.2 .and. npair.gt.0) then - write (iout,*) "ERROR: Less than 2 fragments specified", - & " but distance restraints between pairs requested" - stop - endif - call flush(iout) - do i=1,nfrag_ - if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup - if (ifrag_(2,i).gt.nstart_sup+nsup-1) - & ifrag_(2,i)=nstart_sup+nsup-1 -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) - call flush(iout) - if (wfrag_(i).gt.0.0d0) then - do j=ifrag_(1,i),ifrag_(2,i)-1 - do k=j+1,ifrag_(2,i) -c write (iout,*) "j",j," k",k - ddjk=dist(j,k) - if (constr_dist.eq.1) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - else if (constr_dist.eq.2) then - if (ddjk.le.dist_cut) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - endif - else - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) - endif -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,npair_ - if (wpair_(i).gt.0.0d0) then - ii = ipair_(1,i) - jj = ipair_(2,i) - if (ii.gt.jj) then - itemp=ii - ii=jj - jj=itemp - endif - do j=ifrag_(1,ii),ifrag_(2,ii) - do k=ifrag_(1,jj),ifrag_(2,jj) - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - forcon(nhpb)=wpair_(i) - dhpb(nhpb)=dist(j,k) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,ndist_ - read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), - & ibecarb(i),forcon(nhpb+1) - if (forcon(nhpb+1).gt.0.0d0) then - nhpb=nhpb+1 - if (ibecarb(i).gt.0) then - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - endif - if (dhpb(nhpb).eq.0.0d0) - & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) - endif - enddo -#ifdef MPI - if (.not.out1file .or. me.eq.king) then -#endif - do i=1,nhpb - write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ", - & i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i) - enddo - call flush(iout) -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- - - subroutine read_constr_homology - - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.GEO' - include 'COMMON.INTERACT' - double precision odl_temp,sigma_odl_temp - common /przechowalnia/ odl_temp(maxres,maxres,max_template), - & sigma_odl_temp(maxres,maxres,max_template) - character*2 kic2 - character*24 model_ki_dist, model_ki_angle - character*500 controlcard - integer ki, i, j, k, l - logical lprn /.true./ - - call card_concat(controlcard) - call reada(controlcard,"HOMOL_DIST",waga_dist,1.0d0) - call reada(controlcard,"HOMOL_ANGLE",waga_angle,1.0d0) - - write (iout,*) "nnt",nnt," nct",nct - call flush(iout) - lim_odl=0 - lim_dih=0 - do i=1,nres - do j=i+2,nres - do ki=1,constr_homology - sigma_odl_temp(i,j,ki)=0.0d0 - odl_temp(i,j,ki)=0.0d0 - enddo - enddo - enddo - do i=1,nres-3 - do ki=1,constr_homology - dih(ki,i)=0.0d0 - sigma_dih(ki,i)=0.0d0 - enddo - enddo - do ki=1,constr_homology - write(kic2,'(i2)') ki - if (ki.le.9) kic2="0"//kic2(2:2) - - model_ki_dist="model"//kic2//".dist" - model_ki_angle="model"//kic2//".angle" - open (ientin,file=model_ki_dist,status='old') - do irec=1,maxdim !petla do czytania wiezow na odleglosc - read (ientin,*,end=1401) i, j, odl_temp(i+nnt-1,j+nnt-1,ki), - & sigma_odl_temp(i+nnt-1,j+nnt-1,ki) - odl_temp(j+nnt-1,i+nnt-1,ki)=odl_temp(i+nnt-1,j+nnt-1,ki) - sigma_odl_temp(j+nnt-1,i+nnt-1,ki)= - & sigma_odl_temp(i+nnt-1,j+nnt-1,ki) - enddo - 1401 continue - close (ientin) - open (ientin,file=model_ki_angle,status='old') - do irec=1,maxres-3 !petla do czytania wiezow na katy torsyjne - read (ientin,*,end=1402) i, j, k,l,dih(ki,i+nnt-1), - & sigma_dih(ki,i+nnt-1) - if (i+nnt-1.gt.lim_dih) lim_dih=i+nnt-1 - sigma_dih(ki,i+nnt-1)=1.0d0/sigma_dih(ki,i+nnt-1)**2 - enddo - 1402 continue - close (ientin) - enddo - ii=0 - write (iout,*) "nnt",nnt," nct",nct - do i=nnt,nct-2 - do j=i+2,nct - ki=1 -c write (iout,*) "i",i," j",j," constr_homology",constr_homology - do while (ki.le.constr_homology .and. - & sigma_odl_temp(i,j,ki).le.0.0d0) -c write (iout,*) "ki",ki," sigma_odl",sigma_odl_temp(i,j,ki) - ki=ki+1 - enddo -c write (iout,*) "ki",ki - if (ki.gt.constr_homology) cycle - ii=ii+1 - ires_homo(ii)=i - jres_homo(ii)=j - do ki=1,constr_homology - odl(ki,ii)=odl_temp(i,j,ki) - sigma_odl(ki,ii)=1.0d0/sigma_odl_temp(i,j,ki)**2 - enddo - enddo - enddo - lim_odl=ii - if (constr_homology.gt.0) call homology_partition -c Print restraints - if (.not.lprn) return - write (iout,*) "Distance restraints from templates" - do ii=1,lim_odl - write(iout,'(3i5,10(2f8.2,4x))') ii,ires_homo(ii),jres_homo(ii), - & (odl(ki,ii),1.0d0/dsqrt(sigma_odl(ki,ii)),ki=1,constr_homology) - enddo - write (iout,*) "Dihedral angle restraints from templates" - do i=nnt,lim_dih - write (iout,'(i5,10(2f8.2,4x))') i,(rad2deg*dih(ki,i), - & rad2deg/dsqrt(sigma_dih(ki,i)),ki=1,constr_homology) - enddo -c write(iout,*) "TEST CZYTANIA1",odl(1,2,1),odl(1,3,1),odl(1,4,1) -c write(iout,*) "TEST CZYTANIA2",dih(1,1),dih(2,1),dih(3,1) - - - return - end -c---------------------------------------------------------------------- - -#ifdef WINIFL - subroutine flush(iu) - return - end -#endif -#ifdef AIX - subroutine flush(iu) - call flush_(iu) - return - end -#endif - -c------------------------------------------------------------------------------ - subroutine copy_to_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - character* 256 tmpfile - integer ilen - external ilen - logical ex - tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source)) - inquire(file=tmpfile,exist=ex) - if (ex) then - write (*,*) "Copying ",tmpfile(:ilen(tmpfile)), - & " to temporary directory..." - write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir - call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir) - endif - return - end -c------------------------------------------------------------------------------ - subroutine move_from_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - integer ilen - external ilen - write (*,*) "Moving ",source(:ilen(source)), - & " from temporary directory to working directory" - write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir - call system("/bin/mv "//source(:ilen(source))//" "//curdir) - return - end -c------------------------------------------------------------------------------ - subroutine random_init(seed) -C -C Initialize random number generator -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef AMD64 - integer*8 iseedi8 -#endif -#ifdef MPI - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 - integer iseed_array(4) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - iseed=-dint(dabs(seed)) - if (iseed.eq.0) then - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' - write (*,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' -#ifdef MPI - call mpi_finalize(mpi_comm_world,ierr) -#endif - stop 'Bad random seed.' - endif -#ifdef MPI - if (fg_rank.eq.0) then - seed=seed*(me+1)+1 -#ifdef AMD64 - iseedi8=dint(seed) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - OKRandom = prng_restart(me,iseedi8) -#else - do i=1,4 - tmp=65536.0d0**(4-i) - iseed_array(i) = dint(seed/tmp) - seed=seed-iseed_array(i)*tmp - enddo - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - write (*,*) 'MPI: node= ',me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - OKRandom = prng_restart(me,iseed_array) -#endif - if (OKRandom) then - r1=ran_number(0.0D0,1.0D0) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'ran_num',r1 - if (r1.lt.0.0d0) OKRandom=.false. - endif - if (.not.OKRandom) then - write (iout,*) 'PRNG IS NOT WORKING!!!' - print *,'PRNG IS NOT WORKING!!!' - if (me.eq.0) then - call flush(iout) - call mpi_abort(mpi_comm_world,error_msg,ierr) - stop - else - write (iout,*) 'too many processors for parallel prng' - write (*,*) 'too many processors for parallel prng' - call flush(iout) - stop - endif - endif - endif -#else - call vrndst(iseed) - write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0) -#endif - return - end diff --git a/source/unres/src_MD-restraints/refsys.f b/source/unres/src_MD-restraints/refsys.f deleted file mode 100644 index b57c201..0000000 --- a/source/unres/src_MD-restraints/refsys.f +++ /dev/null @@ -1,60 +0,0 @@ - subroutine refsys(i2,i3,i4,e1,e2,e3,fail) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -c this subroutine calculates unity vectors of a local reference system -c defined by atoms (i2), (i3), and (i4). the x axis is the axis from -c atom (i3) to atom (i2), and the xy plane is the plane defined by atoms -c (i2), (i3), and (i4). z axis is directed according to the sign of the -c vector product (i3)-(i2) and (i3)-(i4). sets fail to .true. if atoms -c (i2) and (i3) or (i3) and (i4) coincide or atoms (i2), (i3), and (i4) -c form a linear fragment. returns vectors e1, e2, and e3. - logical fail - double precision e1(3),e2(3),e3(3) - double precision u(3),z(3) - include 'COMMON.IOUNITS' - include "COMMON.CHAIN" - data coinc /1.0d-13/,align /1.0d-13/ - fail=.false. - s1=0.0d0 - s2=0.0d0 - do 1 i=1,3 - zi=c(i,i2)-c(i,i3) - ui=c(i,i4)-c(i,i3) - s1=s1+zi*zi - s2=s2+ui*ui - z(i)=zi - 1 u(i)=ui - s1=sqrt(s1) - s2=sqrt(s2) - if (s1.gt.coinc) goto 2 - write (iout,1000) i2,i3,i1 - fail=.true. - return - 2 if (s2.gt.coinc) goto 4 - write(iout,1000) i3,i4,i1 - fail=.true. - return - 4 s1=1.0/s1 - s2=1.0/s2 - v1=z(2)*u(3)-z(3)*u(2) - v2=z(3)*u(1)-z(1)*u(3) - v3=z(1)*u(2)-z(2)*u(1) - anorm=sqrt(v1*v1+v2*v2+v3*v3) - if (anorm.gt.align) goto 6 - write (iout,1010) i2,i3,i4,i1 - fail=.true. - return - 6 anorm=1.0/anorm - e3(1)=v1*anorm - e3(2)=v2*anorm - e3(3)=v3*anorm - e1(1)=z(1)*s1 - e1(2)=z(2)*s1 - e1(3)=z(3)*s1 - e2(1)=e1(3)*e3(2)-e1(2)*e3(3) - e2(2)=e1(1)*e3(3)-e1(3)*e3(1) - e2(3)=e1(2)*e3(1)-e1(1)*e3(2) - 1000 format (/1x,' * * * error - atoms',i4,' and',i4,' coincide.') - 1010 format (/1x,' * * * error - atoms',2(i4,2h, ),i4,' form a linear') - return - end diff --git a/source/unres/src_MD-restraints/regularize.F b/source/unres/src_MD-restraints/regularize.F deleted file mode 100644 index c506b8a..0000000 --- a/source/unres/src_MD-restraints/regularize.F +++ /dev/null @@ -1,76 +0,0 @@ - subroutine regularize(ncart,etot,rms,cref0,iretcode) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.MINIM' - double precision przes(3),obrot(3,3),fhpb0(maxdim),varia(maxvar) - double precision cref0(3,ncart) - double precision energia(0:n_ene) - logical non_conv - link_end0=link_end - do i=1,nhpb - fhpb0(i)=forcon(i) - enddo - maxit_reg=2 - print *,'Enter REGULARIZE: nnt=',nnt,' nct=',nct,' nsup=',nsup, - & ' nstart_seq=',nstart_seq,' nstart_sup',nstart_sup - write (iout,'(/a/)') 'Initial energies:' - call geom_to_var(nvar,varia) - call chainbuild - call etotal(energia(0)) - etot=energia(0) - call enerprint(energia(0)) - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - write (iout,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - write (*,'(a,f10.5)') - & 'Enter REGULARIZE: Initial RMS deviation:',dsqrt(dabs(rms)) - maxit0=maxit - maxfun0=maxfun - rtolf0=rtolf - maxit=100 - maxfun=200 - rtolf=1.0D-2 - do it=1,maxit_reg - print *,'Regularization: pass:',it -C Minimize with distance constraints, gradually relieving the weight. - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - if (iretcode.eq.11) return - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1), - & nsup,przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,i2,a,f10.5,a,1pe14.5,a,i3/)') - & 'Finish pass',it,', RMS deviation:',rms,', energy',etot, - & ' SUMSL convergence',iretcode - do i=nss+1,nhpb - forcon(i)=0.1D0*forcon(i) - enddo - enddo -C Turn off the distance constraints and re-minimize energy. - print *,'Final minimization ... ' - maxit=maxit0 - maxfun=maxfun0 - rtolf=rtolf0 - link_end=min0(link_end,nss) - call minimize(etot,varia,iretcode,nfun) - print *,'Etot=',Etot - call fitsq(rms,c(1,nstart_seq),cref0(1,nstart_sup-1),nsup, - & przes,obrot,non_conv) - rms=dsqrt(rms) - write (iout,'(a,f10.5,a,1pe14.5,a,i3/)') - & 'Final RMS deviation:',rms,' energy',etot,' SUMSL convergence', - & iretcode - link_end=link_end0 - do i=nss+1,nhpb - forcon(i)=fhpb0(i) - enddo - call var_to_geom(nvar,varia) - call chainbuild - return - end diff --git a/source/unres/src_MD-restraints/rescode.f b/source/unres/src_MD-restraints/rescode.f deleted file mode 100644 index 2973ef9..0000000 --- a/source/unres/src_MD-restraints/rescode.f +++ /dev/null @@ -1,32 +0,0 @@ - integer function rescode(iseq,nam,itype) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - character*3 nam,ucase - - if (itype.eq.0) then - - do i=1,ntyp1 - if (ucase(nam).eq.restyp(i)) then - rescode=i - return - endif - enddo - - else - - do i=1,ntyp1 - if (nam(1:1).eq.onelet(i)) then - rescode=i - return - endif - enddo - - endif - - write (iout,10) iseq,nam - stop - 10 format ('**** Error - residue',i4,' has an unresolved name ',a3) - end - diff --git a/source/unres/src_MD-restraints/rmdd.f b/source/unres/src_MD-restraints/rmdd.f deleted file mode 100644 index 799ab47..0000000 --- a/source/unres/src_MD-restraints/rmdd.f +++ /dev/null @@ -1,159 +0,0 @@ -c algorithm 611, collected algorithms from acm. -c algorithm appeared in acm-trans. math. software, vol.9, no. 4, -c dec., 1983, p. 503-524. - integer function imdcon(k) -c - integer k -c -c *** return integer machine-dependent constants *** -c -c *** k = 1 means return standard output unit number. *** -c *** k = 2 means return alternate output unit number. *** -c *** k = 3 means return input unit number. *** -c (note -- k = 2, 3 are used only by test programs.) -c -c +++ port version follows... -c external i1mach -c integer i1mach -c integer mdperm(3) -c data mdperm(1)/2/, mdperm(2)/4/, mdperm(3)/1/ -c imdcon = i1mach(mdperm(k)) -c +++ end of port version +++ -c -c +++ non-port version follows... - integer mdcon(3) - data mdcon(1)/6/, mdcon(2)/8/, mdcon(3)/5/ - imdcon = mdcon(k) -c +++ end of non-port version +++ -c - 999 return -c *** last card of imdcon follows *** - end - double precision function rmdcon(k) -c -c *** return machine dependent constants used by nl2sol *** -c -c +++ comments below contain data statements for various machines. +++ -c +++ to convert to another machine, place a c in column 1 of the +++ -c +++ data statement line(s) that correspond to the current machine +++ -c +++ and remove the c from column 1 of the data statement line(s) +++ -c +++ that correspond to the new machine. +++ -c - integer k -c -c *** the constant returned depends on k... -c -c *** k = 1... smallest pos. eta such that -eta exists. -c *** k = 2... square root of eta. -c *** k = 3... unit roundoff = smallest pos. no. machep such -c *** that 1 + machep .gt. 1 .and. 1 - machep .lt. 1. -c *** k = 4... square root of machep. -c *** k = 5... square root of big (see k = 6). -c *** k = 6... largest machine no. big such that -big exists. -c - double precision big, eta, machep - integer bigi(4), etai(4), machei(4) -c/+ - double precision dsqrt -c/ - equivalence (big,bigi(1)), (eta,etai(1)), (machep,machei(1)) -c -c +++ ibm 360, ibm 370, or xerox +++ -c -c data big/z7fffffffffffffff/, eta/z0010000000000000/, -c 1 machep/z3410000000000000/ -c -c +++ data general +++ -c -c data big/0.7237005577d+76/, eta/0.5397605347d-78/, -c 1 machep/2.22044605d-16/ -c -c +++ dec 11 +++ -c -c data big/1.7d+38/, eta/2.938735878d-39/, machep/2.775557562d-17/ -c -c +++ hp3000 +++ -c -c data big/1.157920892d+77/, eta/8.636168556d-78/, -c 1 machep/5.551115124d-17/ -c -c +++ honeywell +++ -c -c data big/1.69d+38/, eta/5.9d-39/, machep/2.1680435d-19/ -c -c +++ dec10 +++ -c -c data big/"377777100000000000000000/, -c 1 eta/"002400400000000000000000/, -c 2 machep/"104400000000000000000000/ -c -c +++ burroughs +++ -c -c data big/o0777777777777777,o7777777777777777/, -c 1 eta/o1771000000000000,o7770000000000000/, -c 2 machep/o1451000000000000,o0000000000000000/ -c -c +++ control data +++ -c -c data big/37767777777777777777b,37167777777777777777b/, -c 1 eta/00014000000000000000b,00000000000000000000b/, -c 2 machep/15614000000000000000b,15010000000000000000b/ -c -c +++ prime +++ -c -c data big/1.0d+9786/, eta/1.0d-9860/, machep/1.4210855d-14/ -c -c +++ univac +++ -c -c data big/8.988d+307/, eta/1.2d-308/, machep/1.734723476d-18/ -c -c +++ vax +++ -c - data big/1.7d+38/, eta/2.939d-39/, machep/1.3877788d-17/ -c -c +++ cray 1 +++ -c -c data bigi(1)/577767777777777777777b/, -c 1 bigi(2)/000007777777777777776b/, -c 2 etai(1)/200004000000000000000b/, -c 3 etai(2)/000000000000000000000b/, -c 4 machei(1)/377224000000000000000b/, -c 5 machei(2)/000000000000000000000b/ -c -c +++ port library -- requires more than just a data statement... +++ -c -c external d1mach -c double precision d1mach, zero -c data big/0.d+0/, eta/0.d+0/, machep/0.d+0/, zero/0.d+0/ -c if (big .gt. zero) go to 1 -c big = d1mach(2) -c eta = d1mach(1) -c machep = d1mach(4) -c1 continue -c -c +++ end of port +++ -c -c------------------------------- body -------------------------------- -c - go to (10, 20, 30, 40, 50, 60), k -c - 10 rmdcon = eta - go to 999 -c - 20 rmdcon = dsqrt(256.d+0*eta)/16.d+0 - go to 999 -c - 30 rmdcon = machep - go to 999 -c - 40 rmdcon = dsqrt(machep) - go to 999 -c - 50 rmdcon = dsqrt(big/256.d+0)*16.d+0 - go to 999 -c - 60 rmdcon = big -c - 999 return -c *** last card of rmdcon follows *** - end diff --git a/source/unres/src_MD-restraints/rmsd.F b/source/unres/src_MD-restraints/rmsd.F deleted file mode 100644 index 52e7b37..0000000 --- a/source/unres/src_MD-restraints/rmsd.F +++ /dev/null @@ -1,140 +0,0 @@ - subroutine rms_nac_nnc(rms,frac,frac_nn,co,lprn) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.CONTACTS' - include 'COMMON.IOUNITS' - double precision przes(3),obr(3,3) - logical non_conv,lprn -c call fitsq(rms,c(1,nstart_seq),cref(1,nstart_sup),nsup,przes, -c & obr,non_conv) -c rms=dsqrt(rms) - call rmsd(rms) - call contact(.false.,ncont,icont,co) - frac=contact_fract(ncont,ncont_ref,icont,icont_ref) - frac_nn=contact_fract_nn(ncont,ncont_ref,icont,icont_ref) - if (lprn) write (iout,'(a,f8.3/a,f8.3/a,f8.3/a,f8.3)') - & 'RMS deviation from the reference structure:',rms, - & ' % of native contacts:',frac*100, - & ' % of nonnative contacts:',frac_nn*100, - & ' contact order:',co - - return - end -c--------------------------------------------------------------------------- - subroutine rmsd(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 -c print *,"nz_start",nz_start," nz_end",nz_end - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i+nstart_seq-nstart_sup) - crefcopy(k,iatom)=cref(k,nres+i) - enddo - endif - enddo - -c ----- diagnostics -c write (iout,*) 'Ccopy and CREFcopy' -c print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), -c & (crefcopy(j,k),j=1,3),k=1,iatom) -c ----- end diagnostics - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd' - write (iout,*) 'Problems in FITSQ!!! rmsd' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI -c call mpi_abort(mpi_comm_world,ierror,ierrcode) - roznica=100.0 -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) -c ---- diagnostics -c write (iout,*) "rms",drms -c ---- end diagnostics - return - end - -c-------------------------------------------- - subroutine rmsd_csa(drms) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.INTERACT' - logical non_conv - double precision przes(3),obrot(3,3) - double precision ccopy(3,maxres2+2),crefcopy(3,maxres2+2) - - iatom=0 - do i=nz_start,nz_end - iatom=iatom+1 - iti=itype(i) - do k=1,3 - ccopy(k,iatom)=c(k,i) - crefcopy(k,iatom)=crefjlee(k,i) - enddo - if (iz_sc.eq.1.and.iti.ne.10) then - iatom=iatom+1 - do k=1,3 - ccopy(k,iatom)=c(k,nres+i) - crefcopy(k,iatom)=crefjlee(k,nres+i) - enddo - endif - enddo - - call fitsq(roznica,ccopy(1,1),crefcopy(1,1),iatom, - & przes,obrot,non_conv) - if (non_conv) then - print *,'Problems in FITSQ!!! rmsd_csa' - write (iout,*) 'Problems in FITSQ!!! rmsd_csa' - print *,'Ccopy and CREFcopy' - write (iout,*) 'Ccopy and CREFcopy' - print '(i5,3f10.5,5x,3f10.5)',(k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) - write (iout,'(i5,3f10.5,5x,3f10.5)') (k,(ccopy(j,k),j=1,3), - & (crefcopy(j,k),j=1,3),k=1,iatom) -#ifdef MPI - call mpi_abort(mpi_comm_world,ierror,ierrcode) -#else - stop -#endif - endif - drms=dsqrt(dabs(roznica)) - return - end - diff --git a/source/unres/src_MD-restraints/sc_move.F b/source/unres/src_MD-restraints/sc_move.F deleted file mode 100644 index b6837fd..0000000 --- a/source/unres/src_MD-restraints/sc_move.F +++ /dev/null @@ -1,823 +0,0 @@ - subroutine sc_move(n_start,n_end,n_maxtry,e_drop, - + n_fun,etot) -c Perform a quick search over side-chain arrangments (over -c residues n_start to n_end) for a given (frozen) CA trace -c Only side-chains are minimized (at most n_maxtry times each), -c not CA positions -c Stops if energy drops by e_drop, otherwise tries all residues -c in the given range -c If there is an energy drop, full minimization may be useful -c n_start, n_end CAN be modified by this routine, but only if -c out of bounds (n_start <= 1, n_end >= nres, n_start < n_end) -c NOTE: this move should never increase the energy -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c External functions - integer iran_num - external iran_num - -c Input arguments - integer n_start,n_end,n_maxtry - double precision e_drop - -c Output arguments - integer n_fun - double precision etot - -c Local variables - double precision energy(0:n_ene) - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision orig_e,cur_e - integer n,n_steps,n_first,n_cur,n_tot,i - double precision orig_w(n_ene) - double precision wtime - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - orig_w(15)=wvdwpp - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - wvdwpp=0.D0 - -c Make sure n_start, n_end are within proper range - if (n_start.lt.2) n_start=2 - if (n_end.gt.nres-1) n_end=nres-1 -crc if (n_start.lt.n_end) then - if (n_start.gt.n_end) then - n_start=2 - n_end=nres-1 - endif - -c Save the initial values of energy and coordinates -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'start sc ene',energy(0) -cd call enerprint(energy(0)) -crc etot=energy(0) - n_fun=0 -crc orig_e=etot -crc cur_e=orig_e -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo - -ct wtime=MPI_WTIME() -c Try (one by one) all specified residues, starting from a -c random position in sequence -c Stop early if the energy has decreased by at least e_drop - n_tot=n_end-n_start+1 - n_first=iran_num(0,n_tot-1) - n_steps=0 - n=0 -crc do while (n.lt.n_tot .and. orig_e-etot.lt.e_drop) - do while (n.lt.n_tot) - n_cur=n_start+mod(n_first+n,n_tot) - call single_sc_move(n_cur,n_maxtry,e_drop, - + n_steps,n_fun,etot) -c If a lower energy was found, update the current structure... -crc if (etot.lt.cur_e) then -crc cur_e=etot -crc do i=2,nres-1 -crc cur_alph(i)=alph(i) -crc cur_omeg(i)=omeg(i) -crc enddo -crc else -c ...else revert to the previous one -crc etot=cur_e -crc do i=2,nres-1 -crc alph(i)=cur_alph(i) -crc omeg(i)=cur_omeg(i) -crc enddo -crc endif - n=n+1 -cd -cd call chainbuild -cd call etotal(energy) -cd print *,'running',n,energy(0) - enddo - -cd call chainbuild -cd call etotal(energy) -cd write (iout,*) 'end sc ene',energy(0) - -c Put the original weights back to calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - wvdwpp=orig_w(15) - -crc n_fun=n_fun+1 -ct write (iout,*) 'sc_local time= ',MPI_WTIME()-wtime - return - end - -c------------------------------------------------------------- - - subroutine single_sc_move(res_pick,n_maxtry,e_drop, - + n_steps,n_fun,e_sc) -c Perturb one side-chain (res_pick) and minimize the -c neighbouring region, keeping all CA's and non-neighbouring -c side-chains fixed -c Try until e_drop energy improvement is achieved, or n_maxtry -c attempts have been made -c At the start, e_sc should contain the side-chain-only energy(0) -c nsteps and nfun for this move are ADDED to n_steps and n_fun -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.CHAIN' - include 'COMMON.MINIM' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - -c External functions - double precision dist - external dist - -c Input arguments - integer res_pick,n_maxtry - double precision e_drop - -c Input/Output arguments - integer n_steps,n_fun - double precision e_sc - -c Local variables - logical fail - integer i,j - integer nres_moved - integer iretcode,loc_nfun,orig_maxfun,n_try - double precision sc_dist,sc_dist_cutoff - double precision energy(0:n_ene),orig_e,cur_e - double precision evdw,escloc - double precision cur_alph(2:nres-1),cur_omeg(2:nres-1) - double precision var(maxvar) - - double precision orig_theta(1:nres),orig_phi(1:nres), - + orig_alph(1:nres),orig_omeg(1:nres) - - -c Define what is meant by "neighbouring side-chain" - sc_dist_cutoff=5.0D0 - -c Don't do glycine or ends - i=itype(res_pick) - if (i.eq.10 .or. i.eq.21) return - -c Freeze everything (later will relax only selected side-chains) - mask_r=.true. - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=0 - enddo - -c Find the neighbours of the side-chain to move -c and save initial variables -crc orig_e=e_sc -crc cur_e=orig_e - nres_moved=0 - do i=2,nres-1 -c Don't do glycine (itype(j)==10) - if (itype(i).ne.10) then - sc_dist=dist(nres+i,nres+res_pick) - else - sc_dist=sc_dist_cutoff - endif - if (sc_dist.lt.sc_dist_cutoff) then - nres_moved=nres_moved+1 - mask_side(i)=1 - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - - call chainbuild - call egb1(evdw) - call esc(escloc) - e_sc=wsc*evdw+wscloc*escloc -cd call etotal(energy) -cd print *,'new ',(energy(k),k=0,n_ene) - orig_e=e_sc - cur_e=orig_e - - n_try=0 - do while (n_try.lt.n_maxtry .and. orig_e-cur_e.lt.e_drop) -c Move the selected residue (don't worry if it fails) - call gen_side(itype(res_pick),theta(res_pick+1), - + alph(res_pick),omeg(res_pick),fail) - -c Minimize the side-chains starting from the new arrangement - call geom_to_var(nvar,var) - orig_maxfun=maxfun - maxfun=7 - -crc do i=1,nres -crc orig_theta(i)=theta(i) -crc orig_phi(i)=phi(i) -crc orig_alph(i)=alph(i) -crc orig_omeg(i)=omeg(i) -crc enddo - - call minimize_sc1(e_sc,var,iretcode,loc_nfun) - -cv write(*,'(2i3,2f12.5,2i3)') -cv & res_pick,nres_moved,orig_e,e_sc-cur_e, -cv & iretcode,loc_nfun - -c$$$ if (iretcode.eq.8) then -c$$$ write(iout,*)'Coordinates just after code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ do i=1,nres -c$$$ theta(i)=orig_theta(i) -c$$$ phi(i)=orig_phi(i) -c$$$ alph(i)=orig_alph(i) -c$$$ omeg(i)=orig_omeg(i) -c$$$ enddo -c$$$ write(iout,*)'Coordinates just before code 8' -c$$$ call chainbuild -c$$$ call all_varout -c$$$ call flush(iout) -c$$$ endif - - n_fun=n_fun+loc_nfun - maxfun=orig_maxfun - call var_to_geom(nvar,var) - -c If a lower energy was found, update the current structure... - if (e_sc.lt.cur_e) then -cv call chainbuild -cv call etotal(energy) -cd call egb1(evdw) -cd call esc(escloc) -cd e_sc1=wsc*evdw+wscloc*escloc -cd print *,' new',e_sc1,energy(0) -cv print *,'new ',energy(0) -cd call enerprint(energy(0)) - cur_e=e_sc - do i=2,nres-1 - if (mask_side(i).eq.1) then - cur_alph(i)=alph(i) - cur_omeg(i)=omeg(i) - endif - enddo - else -c ...else revert to the previous one - e_sc=cur_e - do i=2,nres-1 - if (mask_side(i).eq.1) then - alph(i)=cur_alph(i) - omeg(i)=cur_omeg(i) - endif - enddo - endif - n_try=n_try+1 - - enddo - n_steps=n_steps+n_try - -c Reset the minimization mask_r to false - mask_r=.false. - - return - end - -c------------------------------------------------------------- - - subroutine sc_minimize(etot,iretcode,nfun) -c Minimizes side-chains only, leaving backbone frozen -crc implicit none - -c Includes - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - -c Output arguments - double precision etot - integer iretcode,nfun - -c Local variables - integer i - double precision orig_w(n_ene),energy(0:n_ene) - double precision var(maxvar) - - -c Set non side-chain weights to zero (minimization is faster) -c NOTE: e(2) does not actually depend on the side-chain, only CA - orig_w(2)=wscp - orig_w(3)=welec - orig_w(4)=wcorr - orig_w(5)=wcorr5 - orig_w(6)=wcorr6 - orig_w(7)=wel_loc - orig_w(8)=wturn3 - orig_w(9)=wturn4 - orig_w(10)=wturn6 - orig_w(11)=wang - orig_w(13)=wtor - orig_w(14)=wtor_d - - wscp=0.D0 - welec=0.D0 - wcorr=0.D0 - wcorr5=0.D0 - wcorr6=0.D0 - wel_loc=0.D0 - wturn3=0.D0 - wturn4=0.D0 - wturn6=0.D0 - wang=0.D0 - wtor=0.D0 - wtor_d=0.D0 - -c Prepare to freeze backbone - do i=1,nres - mask_phi(i)=0 - mask_theta(i)=0 - mask_side(i)=1 - enddo - -c Minimize the side-chains - mask_r=.true. - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - call var_to_geom(nvar,var) - mask_r=.false. - -c Put the original weights back and calculate the full energy - wscp=orig_w(2) - welec=orig_w(3) - wcorr=orig_w(4) - wcorr5=orig_w(5) - wcorr6=orig_w(6) - wel_loc=orig_w(7) - wturn3=orig_w(8) - wturn4=orig_w(9) - wturn6=orig_w(10) - wang=orig_w(11) - wtor=orig_w(13) - wtor_d=orig_w(14) - - call chainbuild - call etotal(energy) - etot=energy(0) - - return - end - -c------------------------------------------------------------- - subroutine minimize_sc1(etot,x,iretcode,nfun) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.MINIM' - common /srutu/ icall - dimension iv(liv) - double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) - double precision energia(0:n_ene) - external func,gradient,fdum - external func_restr1,grad_restr1 - logical not_done,change,reduce - common /przechowalnia/ v - - call deflt(2,iv,liv,lv,v) -* 12 means fresh start, dont call deflt - iv(1)=12 -* max num of fun calls - if (maxfun.eq.0) maxfun=500 - iv(17)=maxfun -* max num of iterations - if (maxmin.eq.0) maxmin=1000 - iv(18)=maxmin -* controls output - iv(19)=2 -* selects output unit -c iv(21)=iout - iv(21)=0 -* 1 means to print out result - iv(22)=0 -* 1 means to print out summary stats - iv(23)=0 -* 1 means to print initial x and d - iv(24)=0 -* min val for v(radfac) default is 0.1 - v(24)=0.1D0 -* max val for v(radfac) default is 4.0 - v(25)=2.0D0 -c v(25)=4.0D0 -* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -* the sumsl default is 0.1 - v(26)=0.1D0 -* false conv if (act fnctn decrease) .lt. v(34) -* the sumsl default is 100*machep - v(34)=v(34)/100.0D0 -* absolute convergence - if (tolf.eq.0.0D0) tolf=1.0D-4 - v(31)=tolf -* relative convergence - if (rtolf.eq.0.0D0) rtolf=1.0D-4 - v(32)=rtolf -* controls initial step size - v(35)=1.0D-1 -* large vals of d correspond to small components of step - do i=1,nphi - d(i)=1.0D-1 - enddo - do i=nphi+1,nvar - d(i)=1.0D-1 - enddo - IF (mask_r) THEN - call x2xx(x,xx,nvar_restr) - call sumsl(nvar_restr,d,xx,func_restr1,grad_restr1, - & iv,liv,lv,v,idum,rdum,fdum) - call xx2x(x,xx) - ELSE - call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) - ENDIF - etot=v(10) - iretcode=iv(1) - nfun=iv(6) - - return - end -************************************************************************ - subroutine func_restr1(n,x,nf,f,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.FFIELD' - include 'COMMON.INTERACT' - include 'COMMON.TIME1' - common /chuju/ jjj - double precision energia(0:n_ene),evdw,escloc - integer jjj - double precision ufparm,e1,e2 - external ufparm - integer uiparm(1) - real*8 urparm(1) - dimension x(maxvar) - nfl=nf - icg=mod(nf,2)+1 - -#ifdef OSF -c Intercept NaNs in the coordinates, before calling etotal - x_sum=0.D0 - do i=1,n - x_sum=x_sum+x(i) - enddo - FOUND_NAN=.false. - if (x_sum.ne.x_sum) then - write(iout,*)" *** func_restr1 : Found NaN in coordinates" - f=1.0D+73 - FOUND_NAN=.true. - return - endif -#endif - - call var_to_geom_restr(n,x) - call zerograd - call chainbuild -cd write (iout,*) 'ETOTAL called from FUNC' - call egb1(evdw) - call esc(escloc) - f=wsc*evdw+wscloc*escloc -cd call etotal(energia(0)) -cd f=wsc*energia(1)+wscloc*energia(12) -cd print *,f,evdw,escloc,energia(0) -C -C Sum up the components of the Cartesian gradient. -C - do i=1,nct - do j=1,3 - gradx(j,i,icg)=wsc*gvdwx(j,i) - enddo - enddo - - return - end -c------------------------------------------------------- - subroutine grad_restr1(n,x,nf,g,uiparm,urparm,ufparm) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.FFIELD' - include 'COMMON.IOUNITS' - external ufparm - integer uiparm(1) - double precision urparm(1) - dimension x(maxvar),g(maxvar) - - icg=mod(nf,2)+1 - if (nf-nfl+1) 20,30,40 - 20 call func_restr1(n,x,nf,f,uiparm,urparm,ufparm) -c write (iout,*) 'grad 20' - if (nf.eq.0) return - goto 40 - 30 call var_to_geom_restr(n,x) - call chainbuild -C -C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -C - 40 call cartder -C -C Convert the Cartesian gradient into internal-coordinate gradient. -C - - ig=0 - ind=nres-2 - do i=2,nres-2 - IF (mask_phi(i+2).eq.1) THEN - gphii=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) - gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) - enddo - enddo - ig=ig+1 - g(ig)=gphii - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - - ind=0 - do i=1,nres-2 - IF (mask_theta(i+2).eq.1) THEN - ig=ig+1 - gthetai=0.0D0 - do j=i+1,nres-1 - ind=ind+1 - do k=1,3 - gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) - gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) - enddo - enddo - g(ig)=gthetai - ELSE - ind=ind+nres-1-i - ENDIF - enddo - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - galphai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) - enddo - g(ig)=galphai - ENDIF - endif - enddo - - - do i=2,nres-1 - if (itype(i).ne.10) then - IF (mask_side(i).eq.1) THEN - ig=ig+1 - gomegai=0.0D0 - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) - enddo - g(ig)=gomegai - ENDIF - endif - enddo - -C -C Add the components corresponding to local energy terms. -C - - ig=0 - igall=0 - do i=4,nres - igall=igall+1 - if (mask_phi(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do i=3,nres - igall=igall+1 - if (mask_theta(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - enddo - - do ij=1,2 - do i=2,nres-1 - if (itype(i).ne.10) then - igall=igall+1 - if (mask_side(i).eq.1) then - ig=ig+1 - g(ig)=g(ig)+gloc(igall,icg) - endif - endif - enddo - enddo - -cd do i=1,ig -cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -cd enddo - return - end -C----------------------------------------------------------------------------- - subroutine egb1(evdw) -C -C This subroutine calculates the interaction energy of nonbonded side chains -C assuming the Gay-Berne potential of interaction. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.NAMES' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' - include 'COMMON.CONTROL' - logical lprn - evdw=0.0D0 -c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon - evdw=0.0D0 - lprn=.false. -c if (icall.eq.0) lprn=.true. - ind=0 - do i=iatsc_s,iatsc_e - - - itypi=itype(i) - itypi1=itype(i+1) - xi=c(1,nres+i) - yi=c(2,nres+i) - zi=c(3,nres+i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=dsc_inv(itypi) -C -C Calculate SC interaction energy. -C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN - ind=ind+1 - itypj=itype(j) - dscj_inv=dsc_inv(itypj) - sig0ij=sigma(itypi,itypj) - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) -C For diagnostics only!!! -c chi1=0.0D0 -c chi2=0.0D0 -c chi12=0.0D0 -c chip1=0.0D0 -c chip2=0.0D0 -c chip12=0.0D0 -c alf1=0.0D0 -c alf2=0.0D0 -c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) -C Calculate angle-dependent terms of energy and contributions to their -C derivatives. - call sc_angular - sigsq=1.0D0/sigsq - sig=sig0ij*dsqrt(sigsq) - rij_shift=1.0D0/rij-sig+sig0ij -C I hate to put IF's in the loops, but here don't have another choice!!!! - if (rij_shift.le.0.0D0) then - evdw=1.0D20 -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) - return - endif - sigder=-sig*sigsq -c--------------------------------------------------------------- - rij_shift=1.0D0/rij_shift - fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - evdwij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=evdwij*eps3rt - eps3der=evdwij*eps2rt - evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij - if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -cd & restyp(itypi),i,restyp(itypj),j, -cd & epsi,sigm,chi1,chi2,chip1,chip2, -cd & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -cd & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -cd & evdwij - endif - - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - -C Calculate gradient components. - e1=e1*eps1*eps2rt**2*eps3rt**2 - fac=-expon*(e1+evdwij)*rij_shift - sigder=fac*sigder - fac=rij*fac -C Calculate the radial part of the gradient - gg(1)=xj*fac - gg(2)=yj*fac - gg(3)=zj*fac -C Calculate angular part of the gradient. - call sc_grad - ENDIF - enddo ! j - enddo ! iint - enddo ! i - end -C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/sizes.i b/source/unres/src_MD-restraints/sizes.i deleted file mode 100644 index 45c44ff..0000000 --- a/source/unres/src_MD-restraints/sizes.i +++ /dev/null @@ -1,83 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1992 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ############################################################# -c ## ## -c ## sizes.i -- parameter values to set array dimensions ## -c ## ## -c ############################################################# -c -c -c "sizes.i" sets values for critical array dimensions used -c throughout the software; these parameters will fix the size -c of the largest systems that can be handled; values too large -c for the computer's memory and/or swap space to accomodate -c will result in poor performance or outright failure -c -c parameter: maximum allowed number of: -c -c maxatm atoms in the molecular system -c maxval atoms directly bonded to an atom -c maxgrp user-defined groups of atoms -c maxtyp force field atom type definitions -c maxclass force field atom class definitions -c maxkey lines in the keyword file -c maxrot bonds for torsional rotation -c maxvar optimization variables (vector storage) -c maxopt optimization variables (matrix storage) -c maxhess off-diagonal Hessian elements -c maxlight sites for method of lights neighbors -c maxvib vibrational frequencies -c maxgeo distance geometry points -c maxcell unit cells in replicated crystal -c maxring 3-, 4-, or 5-membered rings -c maxfix geometric restraints -c maxbio biopolymer atom definitions -c maxres residues in the macromolecule -c maxamino amino acid residue types -c maxnuc nucleic acid residue types -c maxbnd covalent bonds in molecular system -c maxang bond angles in molecular system -c maxtors torsional angles in molecular system -c maxpi atoms in conjugated pisystem -c maxpib covalent bonds involving pisystem -c maxpit torsional angles involving pisystem -c -c - integer maxatm,maxval,maxgrp - integer maxtyp,maxclass,maxkey - integer maxrot,maxopt - integer maxhess,maxlight,maxvib - integer maxgeo,maxcell,maxring - integer maxfix,maxbio - integer maxamino,maxnuc,maxbnd - integer maxang,maxtors,maxpi - integer maxpib,maxpit - parameter (maxatm=maxres2) - parameter (maxval=8) - parameter (maxgrp=1000) - parameter (maxtyp=3000) - parameter (maxclass=500) - parameter (maxkey=10000) - parameter (maxrot=1000) - parameter (maxopt=1000) - parameter (maxhess=1000000) - parameter (maxlight=8*maxatm) - parameter (maxvib=1000) - parameter (maxgeo=1000) - parameter (maxcell=10000) - parameter (maxring=10000) - parameter (maxfix=10000) - parameter (maxbio=10000) - parameter (maxamino=31) - parameter (maxnuc=12) - parameter (maxbnd=2*maxatm) - parameter (maxang=3*maxatm) - parameter (maxtors=4*maxatm) - parameter (maxpi=100) - parameter (maxpib=2*maxpi) - parameter (maxpit=4*maxpi) diff --git a/source/unres/src_MD-restraints/sort.f b/source/unres/src_MD-restraints/sort.f deleted file mode 100644 index 46b43d9..0000000 --- a/source/unres/src_MD-restraints/sort.f +++ /dev/null @@ -1,589 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1990 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ######################################################### -c ## ## -c ## subroutine sort -- heapsort of an integer array ## -c ## ## -c ######################################################### -c -c -c "sort" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm -c -c - subroutine sort (n,list) - implicit none - integer i,j,k,n - integer index,lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################## -c ## ## -c ## subroutine sort2 -- heapsort of real array with keys ## -c ## ## -c ############################################################## -c -c -c "sort2" takes an input list of reals and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort2 (n,list,key) - implicit none - integer i,j,k,n - integer index,keys - integer key(*) - real*8 lists - real*8 list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort3 -- heapsort of integer array with keys ## -c ## ## -c ################################################################# -c -c -c "sort3" takes an input list of integers and sorts it -c into ascending order using the Heapsort algorithm; -c it also returns a key into the original ordering -c -c - subroutine sort3 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer lists - integer keys - integer list(*) - integer key(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ################################################################# -c ## ## -c ## subroutine sort4 -- heapsort of integer absolute values ## -c ## ## -c ################################################################# -c -c -c "sort4" takes an input list of integers and sorts it into -c ascending absolute value using the Heapsort algorithm -c -c - subroutine sort4 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (abs(list(j)) .lt. abs(list(j+1))) j = j + 1 - end if - if (abs(lists) .lt. abs(list(j))) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort5 -- heapsort of integer array modulo m ## -c ## ## -c ################################################################ -c -c -c "sort5" takes an input list of integers and sorts it -c into ascending order based on each value modulo "m" -c -c - subroutine sort5 (n,list,m) - implicit none - integer i,j,k,m,n - integer index,smod - integer jmod,j1mod - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - jmod = mod(list(j),m) - j1mod = mod(list(j+1),m) - if (jmod .lt. j1mod) then - j = j + 1 - else if (jmod.eq.j1mod .and. list(j).lt.list(j+1)) then - j = j + 1 - end if - end if - smod = mod(lists,m) - jmod = mod(list(j),m) - if (smod .lt. jmod) then - list(i) = list(j) - i = j - j = j + j - else if (smod.eq.jmod .and. lists.lt.list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort6 -- heapsort of a text string array ## -c ## ## -c ############################################################# -c -c -c "sort6" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm -c -c - subroutine sort6 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ################################################################ -c ## ## -c ## subroutine sort7 -- heapsort of text strings with keys ## -c ## ## -c ################################################################ -c -c -c "sort7" takes an input list of character strings and sorts it -c into alphabetical order using the Heapsort algorithm; it also -c returns a key into the original ordering -c -c - subroutine sort7 (n,list,key) - implicit none - integer i,j,k,n - integer index - integer keys - integer key(*) - character*256 lists - character*(*) list(*) -c -c -c initialize index into the original ordering -c - do i = 1, n - key(i) = i - end do -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - keys = key(k) - else - lists = list(index) - keys = key(index) - list(index) = list(1) - key(index) = key(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists - key(1) = keys - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - key(i) = key(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - key(i) = keys - end do - return - end -c -c -c ######################################################### -c ## ## -c ## subroutine sort8 -- heapsort to unique integers ## -c ## ## -c ######################################################### -c -c -c "sort8" takes an input list of integers and sorts it into -c ascending order using the Heapsort algorithm, duplicate -c values are removed from the final sorted list -c -c - subroutine sort8 (n,list) - implicit none - integer i,j,k,n - integer index - integer lists - integer list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end -c -c -c ############################################################# -c ## ## -c ## subroutine sort9 -- heapsort to unique text strings ## -c ## ## -c ############################################################# -c -c -c "sort9" takes an input list of character strings and sorts -c it into alphabetical order using the Heapsort algorithm, -c duplicate values are removed from the final sorted list -c -c - subroutine sort9 (n,list) - implicit none - integer i,j,k,n - integer index - character*256 lists - character*(*) list(*) -c -c -c perform the heapsort of the input list -c - k = n/2 + 1 - index = n - dowhile (n .gt. 1) - if (k .gt. 1) then - k = k - 1 - lists = list(k) - else - lists = list(index) - list(index) = list(1) - index = index - 1 - if (index .le. 1) then - list(1) = lists -c -c remove duplicate values from final list -c - j = 1 - do i = 2, n - if (list(i-1) .ne. list(i)) then - j = j + 1 - list(j) = list(i) - end if - end do - if (j .lt. n) n = j - return - end if - end if - i = k - j = k + k - dowhile (j .le. index) - if (j .lt. index) then - if (list(j) .lt. list(j+1)) j = j + 1 - end if - if (lists .lt. list(j)) then - list(i) = list(j) - i = j - j = j + j - else - j = index + 1 - end if - end do - list(i) = lists - end do - return - end diff --git a/source/unres/src_MD-restraints/ssMD.F b/source/unres/src_MD-restraints/ssMD.F deleted file mode 100644 index 15800ae..0000000 --- a/source/unres/src_MD-restraints/ssMD.F +++ /dev/null @@ -1,1951 +0,0 @@ -c---------------------------------------------------------------------------- - subroutine check_energies -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - include 'COMMON.LOCAL' - include 'COMMON.GEO' - -c External functions - double precision ran_number - external ran_number - -c Local variables - integer i,j,k,l,lmax,p,pmax - double precision rmin,rmax - double precision eij - - double precision d - double precision wi,rij,tj,pj - - -c return - - i=5 - j=14 - - d=dsc(1) - rmin=2.0D0 - rmax=12.0D0 - - lmax=10000 - pmax=1 - - do k=1,3 - c(k,i)=0.0D0 - c(k,j)=0.0D0 - c(k,nres+i)=0.0D0 - c(k,nres+j)=0.0D0 - enddo - - do l=1,lmax - -ct wi=ran_number(0.0D0,pi) -c wi=ran_number(0.0D0,pi/6.0D0) -c wi=0.0D0 -ct tj=ran_number(0.0D0,pi) -ct pj=ran_number(0.0D0,pi) -c pj=ran_number(0.0D0,pi/6.0D0) -c pj=0.0D0 - - do p=1,pmax -ct rij=ran_number(rmin,rmax) - - c(1,j)=d*sin(pj)*cos(tj) - c(2,j)=d*sin(pj)*sin(tj) - c(3,j)=d*cos(pj) - - c(3,nres+i)=-rij - - c(1,i)=d*sin(wi) - c(3,i)=-rij-d*cos(wi) - - do k=1,3 - dc(k,nres+i)=c(k,nres+i)-c(k,i) - dc_norm(k,nres+i)=dc(k,nres+i)/d - dc(k,nres+j)=c(k,nres+j)-c(k,j) - dc_norm(k,nres+j)=dc(k,nres+j)/d - enddo - - call dyn_ssbond_ene(i,j,eij) - enddo - enddo - - call exit(1) - - return - end - -C----------------------------------------------------------------------------- - - subroutine dyn_ssbond_ene(resi,resj,eij) -c implicit none - -c Includes - include 'DIMENSIONS' - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.CALC' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c External functions - double precision h_base - external h_base - -c Input arguments - integer resi,resj - -c Output arguments - double precision eij - -c Local variables - logical havebond -c integer itypi,itypj,k,l - double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi - double precision sig0ij,ljd,sig,fac,e1,e2 - double precision dcosom1(3),dcosom2(3),ed - double precision pom1,pom2 - double precision ljA,ljB,ljXs - double precision d_ljB(1:3) - double precision ssA,ssB,ssC,ssXs - double precision ssxm,ljxm,ssm,ljm - double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3) - double precision f1,f2,h1,h2,hd1,hd2 - double precision omega,delta_inv,deltasq_inv,fac1,fac2 -c-------FIRST METHOD - double precision xm,d_xm(1:3) -c-------END FIRST METHOD -c-------SECOND METHOD -c$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3) -c-------END SECOND METHOD - -c-------TESTING CODE - logical checkstop,transgrad - common /sschecks/ checkstop,transgrad - - integer icheck,nicheck,jcheck,njcheck - double precision echeck(-1:1),deps,ssx0,ljx0 -c-------END TESTING CODE - - - i=resi - j=resj - - itypi=itype(i) - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=vbld_inv(i+nres) - - itypj=itype(j) - xj=c(1,nres+j)-c(1,nres+i) - yj=c(2,nres+j)-c(2,nres+i) - zj=c(3,nres+j)-c(3,nres+i) - dxj=dc_norm(1,nres+j) - dyj=dc_norm(2,nres+j) - dzj=dc_norm(3,nres+j) - dscj_inv=vbld_inv(j+nres) - - chi1=chi(itypi,itypj) - chi2=chi(itypj,itypi) - chi12=chi1*chi2 - chip1=chip(itypi) - chip2=chip(itypj) - chip12=chip1*chip2 - alf1=alp(itypi) - alf2=alp(itypj) - alf12=0.5D0*(alf1+alf2) - - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse -c The following are set in sc_angular -c erij(1)=xj*rij -c erij(2)=yj*rij -c erij(3)=zj*rij -c om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) -c om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) -c om12=dxi*dxj+dyi*dyj+dzi*dzj - call sc_angular - rij=1.0D0/rij ! Reset this so it makes sense - - sig0ij=sigma(itypi,itypj) - sig=sig0ij*dsqrt(1.0D0/sigsq) - - ljXs=sig-sig0ij - ljA=eps1*eps2rt**2*eps3rt**2 - ljB=ljA*bb(itypi,itypj) - ljA=ljA*aa(itypi,itypj) - ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - - ssXs=d0cm - deltat1=1.0d0-om1 - deltat2=1.0d0+om2 - deltat12=om2-om1+2.0d0 - cosphi=om12-om1*om2 - ssA=akcm - ssB=akct*deltat12 - ssC=ss_depth - & +akth*(deltat1*deltat1+deltat2*deltat2) - & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi - ssxm=ssXs-0.5D0*ssB/ssA - -c-------TESTING CODE -c$$$c Some extra output -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC -c$$$ if (ssx0.gt.0.0d0) then -c$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA -c$$$ else -c$$$ ssx0=ssxm -c$$$ endif -c$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ", -c$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12 -c$$$ return -c-------END TESTING CODE - -c-------TESTING CODE -c Stop and plot energy and derivative as a function of distance - if (checkstop) then - ssm=ssC-0.25D0*ssB*ssB/ssA - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - if (ssm.lt.ljm .and. - & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then - nicheck=1000 - njcheck=1 - deps=0.5d-7 - else - checkstop=.false. - endif - endif - if (.not.checkstop) then - nicheck=0 - njcheck=-1 - endif - - do icheck=0,nicheck - do jcheck=-1,njcheck - if (checkstop) rij=(ssxm-1.0d0)+ - & ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps -c-------END TESTING CODE - - if (rij.gt.ljxm) then - havebond=.false. - ljd=rij-ljXs - fac=(1.0D0/ljd)**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) - eij=eps1*eps2rt*eps3rt*(e1+e2) - eps2der=eij*eps3rt - eps3der=eij*eps2rt - eij=eij*eps2rt*eps3rt - - sigder=-sig/sigsq - e1=e1*eps1*eps2rt**2*eps3rt**2 - ed=-expon*(e1+eij)/ljd - sigder=ed*sigder - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=eij*eps1_om12+eps2der*eps2rt_om12 - & -2.0D0*alf12*eps3der+sigder*sigsq_om12 - else if (rij.lt.ssxm) then - havebond=.true. - ssd=rij-ssXs - eij=ssA*ssd*ssd+ssB*ssd+ssC - - ed=2*akcm*ssd+akct*deltat12 - pom1=akct*ssd - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 - else - omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi - - d_ssxm(1)=0.5D0*akct/ssA - d_ssxm(2)=-d_ssxm(1) - d_ssxm(3)=0.0D0 - - d_ljxm(1)=sig0ij/sqrt(sigsq**3) - d_ljxm(2)=d_ljxm(1)*sigsq_om2 - d_ljxm(3)=d_ljxm(1)*sigsq_om12 - d_ljxm(1)=d_ljxm(1)*sigsq_om1 - -c-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - xm=0.5d0*(ssxm+ljxm) - do k=1,3 - d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k)) - enddo - if (rij.lt.xm) then - havebond=.true. - ssm=ssC-0.25D0*ssB*ssB/ssA - d_ssm(1)=0.5D0*akct*ssB/ssA - d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) - d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) - d_ssm(3)=omega - f1=(rij-xm)/(ssxm-xm) - f2=(rij-ssxm)/(xm-ssxm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=ssm*h1+Ht*h2 - delta_inv=1.0d0/(xm-ssxm) - deltasq_inv=delta_inv*delta_inv - fac=ssm*hd1-Ht*hd2 - fac1=deltasq_inv*fac*(xm-rij) - fac2=deltasq_inv*fac*(rij-ssxm) - ed=delta_inv*(Ht*hd2-ssm*hd1) - eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) - eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) - eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) - else - havebond=.false. - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB - d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt) - d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- - + alf12/eps3rt) - d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt) - f1=(rij-ljxm)/(xm-ljxm) - f2=(rij-xm)/(ljxm-xm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=Ht*h1+ljm*h2 - delta_inv=1.0d0/(ljxm-xm) - deltasq_inv=delta_inv*delta_inv - fac=Ht*hd1-ljm*hd2 - fac1=deltasq_inv*fac*(ljxm-rij) - fac2=deltasq_inv*fac*(rij-xm) - ed=delta_inv*(ljm*hd2-Ht*hd1) - eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) - eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) - eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) - endif -c-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - -c-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE -c$$$ ssd=rij-ssXs -c$$$ ljd=rij-ljXs -c$$$ fac1=rij-ljxm -c$$$ fac2=rij-ssxm -c$$$ -c$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt) -c$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt) -c$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt) -c$$$ -c$$$ ssm=ssC-0.25D0*ssB*ssB/ssA -c$$$ d_ssm(1)=0.5D0*akct*ssB/ssA -c$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) -c$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) -c$$$ d_ssm(3)=omega -c$$$ -c$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj) -c$$$ do k=1,3 -c$$$ d_ljm(k)=ljm*d_ljB(k) -c$$$ enddo -c$$$ ljm=ljm*ljB -c$$$ -c$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC -c$$$ d_ss(0)=2.0d0*ssA*ssd+ssB -c$$$ d_ss(2)=akct*ssd -c$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega -c$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega -c$$$ d_ss(3)=omega -c$$$ -c$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj) -c$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0) -c$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1 -c$$$ do k=1,3 -c$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1- -c$$$ & 2.0d0*ljB*fac1*d_ljxm(k)) -c$$$ enddo -c$$$ ljf=ljm+ljf*ljB*fac1*fac1 -c$$$ -c$$$ f1=(rij-ljxm)/(ssxm-ljxm) -c$$$ f2=(rij-ssxm)/(ljxm-ssxm) -c$$$ h1=h_base(f1,hd1) -c$$$ h2=h_base(f2,hd2) -c$$$ eij=ss*h1+ljf*h2 -c$$$ delta_inv=1.0d0/(ljxm-ssxm) -c$$$ deltasq_inv=delta_inv*delta_inv -c$$$ fac=ljf*hd2-ss*hd1 -c$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac -c$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1))) -c$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2))) -c$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac* -c$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3))) -c$$$ -c$$$ havebond=.false. -c$$$ if (ed.gt.0.0d0) havebond=.true. -c-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE - - endif - - if (havebond) then -#ifndef CLUST -#ifndef WHAM -c if (dyn_ssbond_ij(i,j).eq.1.0d300) then -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_FORM",totT,t_bath,i,j -c endif -#endif -#endif - dyn_ssbond_ij(i,j)=eij - else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then - dyn_ssbond_ij(i,j)=1.0d300 -#ifndef CLUST -#ifndef WHAM -c write(iout,'(a15,f12.2,f8.1,2i5)') -c & "SSBOND_E_BREAK",totT,t_bath,i,j -#endif -#endif - endif - -c-------TESTING CODE - if (checkstop) then - if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') - & "CHECKSTOP",rij,eij,ed - echeck(jcheck)=eij - endif - enddo - if (checkstop) then - write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps - endif - enddo - if (checkstop) then - transgrad=.true. - checkstop=.false. - endif -c-------END TESTING CODE - - do k=1,3 - dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij - dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij - enddo - do k=1,3 - gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo - do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) - & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) - & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) - & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) - & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv - enddo -cgrad do k=i,j-1 -cgrad do l=1,3 -cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) -cgrad enddo -cgrad enddo - - do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) - enddo - - return - end - -C----------------------------------------------------------------------------- - - double precision function h_base(x,deriv) -c A smooth function going 0->1 in range [0,1] -c It should NOT be called outside range [0,1], it will not work there. - implicit none - -c Input arguments - double precision x - -c Output arguments - double precision deriv - -c Local variables - double precision xsq - - -c Two parabolas put together. First derivative zero at extrema -c$$$ if (x.lt.0.5D0) then -c$$$ h_base=2.0D0*x*x -c$$$ deriv=4.0D0*x -c$$$ else -c$$$ deriv=1.0D0-x -c$$$ h_base=1.0D0-2.0D0*deriv*deriv -c$$$ deriv=4.0D0*deriv -c$$$ endif - -c Third degree polynomial. First derivative zero at extrema - h_base=x*x*(3.0d0-2.0d0*x) - deriv=6.0d0*x*(1.0d0-x) - -c Fifth degree polynomial. First and second derivatives zero at extrema -c$$$ xsq=x*x -c$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0) -c$$$ deriv=x-1.0d0 -c$$$ deriv=deriv*deriv -c$$$ deriv=30.0d0*xsq*deriv - - return - end - -c---------------------------------------------------------------------------- - - subroutine dyn_set_nss -c Adjust nss and other relevant variables based on dyn_ssbond_ij -c implicit none - -c Includes - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SBRIDGE' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SETUP' -#ifndef CLUST -#ifndef WHAM - include 'COMMON.MD' -#endif -#endif - -c Local variables - double precision emin - integer i,j,imin - integer diff,allflag(maxdim),allnss, - & allihpb(maxdim),alljhpb(maxdim), - & newnss,newihpb(maxdim),newjhpb(maxdim) - logical found - integer i_newnss(max_fg_procs),displ(0:max_fg_procs) - integer g_newihpb(maxdim),g_newjhpb(maxdim),g_newnss - - allnss=0 - do i=1,nres-1 - do j=i+1,nres - if (dyn_ssbond_ij(i,j).lt.1.0d300) then - allnss=allnss+1 - allflag(allnss)=0 - allihpb(allnss)=i - alljhpb(allnss)=j - endif - enddo - enddo - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - 1 emin=1.0d300 - do i=1,allnss - if (allflag(i).eq.0 .and. - & dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then - emin=dyn_ssbond_ij(allihpb(i),alljhpb(i)) - imin=i - endif - enddo - if (emin.lt.1.0d300) then - allflag(imin)=1 - do i=1,allnss - if (allflag(i).eq.0 .and. - & (allihpb(i).eq.allihpb(imin) .or. - & alljhpb(i).eq.allihpb(imin) .or. - & allihpb(i).eq.alljhpb(imin) .or. - & alljhpb(i).eq.alljhpb(imin))) then - allflag(i)=-1 - endif - enddo - goto 1 - endif - -cmc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) - - newnss=0 - do i=1,allnss - if (allflag(i).eq.1) then - newnss=newnss+1 - newihpb(newnss)=allihpb(i) - newjhpb(newnss)=alljhpb(i) - endif - enddo - -#ifdef MPI - if (nfgtasks.gt.1)then - - call MPI_Reduce(newnss,g_newnss,1, - & MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - call MPI_Gather(newnss,1,MPI_INTEGER, - & i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_newnss(i-1)+displ(i-1) - enddo - call MPI_Gatherv(newihpb,newnss,MPI_INTEGER, - & g_newihpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER, - & g_newjhpb,i_newnss,displ,MPI_INTEGER, - & king,FG_COMM,IERR) - if(fg_rank.eq.0) then -c print *,'g_newnss',g_newnss -c print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss) -c print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss) - newnss=g_newnss - do i=1,newnss - newihpb(i)=g_newihpb(i) - newjhpb(i)=g_newjhpb(i) - enddo - endif - endif -#endif - - diff=newnss-nss - -cmc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss) - - do i=1,nss - found=.false. - do j=1,newnss - if (idssb(i).eq.newihpb(j) .and. - & jdssb(i).eq.newjhpb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i) -#endif -#endif - enddo - - do i=1,newnss - found=.false. - do j=1,nss - if (newihpb(i).eq.idssb(j) .and. - & newjhpb(i).eq.jdssb(j)) found=.true. - enddo -#ifndef CLUST -#ifndef WHAM - if (.not.found.and.fg_rank.eq.0) - & write(iout,'(a15,f12.2,f8.1,2i5)') - & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) -#endif -#endif - enddo - - nss=newnss - do i=1,nss - idssb(i)=newihpb(i) - jdssb(i)=newjhpb(i) - enddo - - return - end - -c---------------------------------------------------------------------------- - -#ifdef WHAM - subroutine read_ssHist - implicit none - -c Includes - include 'DIMENSIONS' - include "DIMENSIONS.FREE" - include 'COMMON.FREE' - -c Local variables - integer i,j - character*80 controlcard - - do i=1,dyn_nssHist - call card_concat(controlcard,.true.) - read(controlcard,*) - & dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) - enddo - - return - end -#endif - -c---------------------------------------------------------------------------- - - -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- -C----------------------------------------------------------------------------- - -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ integer i,iretcode,nfun_sc -c$$$ logical scfail -c$$$ double precision var(maxvar),e_sc,etot -c$$$ -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$c Minimize the two selected side-chains -c$$$ call overlap_sc(scfail) ! Better not fail! -c$$$ call minimize_sc(e_sc,var,iretcode,nfun_sc) -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------------- -c$$$ -c$$$ subroutine minimize_sc(etot_sc,iretcode,nfun) -c$$$c Minimize side-chains only, starting from geom but without modifying -c$$$c bond lengths. -c$$$c If mask_r is already set, only the selected side-chains are minimized, -c$$$c otherwise all side-chains are minimized keeping the backbone frozen. -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ integer icall -c$$$ common /srutu/ icall -c$$$ -c$$$c Output arguments -c$$$ double precision etot_sc -c$$$ integer iretcode,nfun -c$$$ -c$$$c External functions/subroutines -c$$$ external func_sc,grad_sc,fdum -c$$$ -c$$$c Local variables -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxvar*(maxvar+17)/2)) -c$$$ integer iv(liv) -c$$$ double precision rdum(1) -c$$$ double precision d(maxvar),v(1:lv),x(maxvar),xx(maxvar) -c$$$ integer idum(1) -c$$$ integer i,nvar_restr -c$$$ -c$$$ -c$$$cmc start_minim=.true. -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=1 -c$$$* selects output unit -c$$$ iv(21)=0 -c$$$c iv(21)=iout ! DEBUG -c$$$c iv(21)=8 ! DEBUG -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$c iv(22)=1 ! DEBUG -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$c iv(23)=1 ! DEBUG -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$c iv(24)=1 ! DEBUG -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-1 -c$$$ v(32)=rtolf -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,nphi -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ do i=nphi+1,nvar -c$$$ d(i)=1.0D-1 -c$$$ enddo -c$$$ -c$$$ call geom_to_var(nvar,x) -c$$$ IF (mask_r) THEN -c$$$ do i=1,nres ! Just in case... -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ELSE -c$$$c When minimizing ALL side-chains, etotal_sc is a little -c$$$c faster if we don't set mask_r -c$$$ do i=1,nres -c$$$ mask_phi(i)=0 -c$$$ mask_theta(i)=0 -c$$$ mask_side(i)=1 -c$$$ enddo -c$$$ call x2xx(x,xx,nvar_restr) -c$$$ call sumsl(nvar_restr,d,xx,func_sc,grad_sc, -c$$$ & iv,liv,lv,v,idum,rdum,fdum) -c$$$ call xx2x(x,xx) -c$$$ ENDIF -c$$$ call var_to_geom(nvar,x) -c$$$ call chainbuild_sc -c$$$ etot_sc=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6) -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine chainbuild_sc -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c Local variables -c$$$ integer i -c$$$ -c$$$ -c$$$ do i=nnt,nct -c$$$ if (.not.mask_r .or. mask_side(i).eq.1) then -c$$$ call locate_side_chain(i) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C-------------------------------------------------------------------------- -c$$$ -c$$$ subroutine func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision f -c$$$ -c$$$c Local variables -c$$$ double precision energia(0:n_ene) -c$$$#ifdef OSF -c$$$c Variables used to intercept NaNs -c$$$ double precision x_sum -c$$$ integer i_NAN -c$$$#endif -c$$$ -c$$$ -c$$$ nfl=nf -c$$$ icg=mod(nf,2)+1 -c$$$ -c$$$#ifdef OSF -c$$$c Intercept NaNs in the coordinates, before calling etotal_sc -c$$$ x_sum=0.D0 -c$$$ do i_NAN=1,n -c$$$ x_sum=x_sum+x(i_NAN) -c$$$ enddo -c$$$c Calculate the energy only if the coordinates are ok -c$$$ if ((.not.(x_sum.lt.0.D0)) .and. (.not.(x_sum.ge.0.D0))) then -c$$$ write(iout,*)" *** func_restr_sc : Found NaN in coordinates" -c$$$ f=1.0D+77 -c$$$ nf=0 -c$$$ else -c$$$#endif -c$$$ -c$$$ call var_to_geom_restr(n,x) -c$$$ call zerograd -c$$$ call chainbuild_sc -c$$$ call etotal_sc(energia(0)) -c$$$ f=energia(0) -c$$$ if (energia(1).eq.1.0D20 .or. energia(0).eq.1.0D99) nf=0 -c$$$ -c$$$#ifdef OSF -c$$$ endif -c$$$#endif -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c------------------------------------------------------- -c$$$ -c$$$ subroutine grad_sc(n,x,nf,g,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.MINIM' -c$$$ -c$$$c Input arguments -c$$$ integer n -c$$$ double precision x(maxvar) -c$$$ double precision ufparm -c$$$ external ufparm -c$$$ -c$$$c Input/Output arguments -c$$$ integer nf -c$$$ integer uiparm(1) -c$$$ double precision urparm(1) -c$$$ -c$$$c Output arguments -c$$$ double precision g(maxvar) -c$$$ -c$$$c Local variables -c$$$ double precision f,gphii,gthetai,galphai,gomegai -c$$$ integer ig,ind,i,j,k,igall,ij -c$$$ -c$$$ -c$$$ icg=mod(nf,2)+1 -c$$$ if (nf-nfl+1) 20,30,40 -c$$$ 20 call func_sc(n,x,nf,f,uiparm,urparm,ufparm) -c$$$c write (iout,*) 'grad 20' -c$$$ if (nf.eq.0) return -c$$$ goto 40 -c$$$ 30 call var_to_geom_restr(n,x) -c$$$ call chainbuild_sc -c$$$C -c$$$C Evaluate the derivatives of virtual bond lengths and SC vectors in variables. -c$$$C -c$$$ 40 call cartder -c$$$C -c$$$C Convert the Cartesian gradient into internal-coordinate gradient. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ ind=nres-2 -c$$$ do i=2,nres-2 -c$$$ IF (mask_phi(i+2).eq.1) THEN -c$$$ gphii=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) -c$$$ gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ ig=ig+1 -c$$$ g(ig)=gphii -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ -c$$$ ind=0 -c$$$ do i=1,nres-2 -c$$$ IF (mask_theta(i+2).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gthetai=0.0D0 -c$$$ do j=i+1,nres-1 -c$$$ ind=ind+1 -c$$$ do k=1,3 -c$$$ gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) -c$$$ gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg) -c$$$ enddo -c$$$ enddo -c$$$ g(ig)=gthetai -c$$$ ELSE -c$$$ ind=ind+nres-1-i -c$$$ ENDIF -c$$$ enddo -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ galphai=0.0D0 -c$$$ do k=1,3 -c$$$ galphai=galphai+dxds(k,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=galphai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$ -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ ig=ig+1 -c$$$ gomegai=0.0D0 -c$$$ do k=1,3 -c$$$ gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) -c$$$ enddo -c$$$ g(ig)=gomegai -c$$$ ENDIF -c$$$ endif -c$$$ enddo -c$$$ -c$$$C -c$$$C Add the components corresponding to local energy terms. -c$$$C -c$$$ -c$$$ ig=0 -c$$$ igall=0 -c$$$ do i=4,nres -c$$$ igall=igall+1 -c$$$ if (mask_phi(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do i=3,nres -c$$$ igall=igall+1 -c$$$ if (mask_theta(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ enddo -c$$$ -c$$$ do ij=1,2 -c$$$ do i=2,nres-1 -c$$$ if (itype(i).ne.10) then -c$$$ igall=igall+1 -c$$$ if (mask_side(i).eq.1) then -c$$$ ig=ig+1 -c$$$ g(ig)=g(ig)+gloc(igall,icg) -c$$$ endif -c$$$ endif -c$$$ enddo -c$$$ enddo -c$$$ -c$$$cd do i=1,ig -c$$$cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) -c$$$cd enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine etotal_sc(energy_sc) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.FFIELD' -c$$$ -c$$$c Output arguments -c$$$ double precision energy_sc(0:n_ene) -c$$$ -c$$$c Local variables -c$$$ double precision evdw,escloc -c$$$ integer i,j -c$$$ -c$$$ -c$$$ do i=1,n_ene -c$$$ energy_sc(i)=0.0D0 -c$$$ enddo -c$$$ -c$$$ if (mask_r) then -c$$$ call egb_sc(evdw) -c$$$ call esc_sc(escloc) -c$$$ else -c$$$ call egb(evdw) -c$$$ call esc(escloc) -c$$$ endif -c$$$ -c$$$ if (evdw.eq.1.0D20) then -c$$$ energy_sc(0)=evdw -c$$$ else -c$$$ energy_sc(0)=wsc*evdw+wscloc*escloc -c$$$ endif -c$$$ energy_sc(1)=evdw -c$$$ energy_sc(12)=escloc -c$$$ -c$$$C -c$$$C Sum up the components of the Cartesian gradient. -c$$$C -c$$$ do i=1,nct -c$$$ do j=1,3 -c$$$ gradx(j,i,icg)=wsc*gvdwx(j,i) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_sc(evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$c if (icall.eq.0) lprn=.false. -c$$$ ind=0 -c$$$ do i=iatsc_s,iatsc_e -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$ do iint=1,nint_gr(i) -c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ IF (mask_side(j).eq.1.or.mask_side(i).eq.1) THEN -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$ ENDIF -c$$$ enddo ! j -c$$$ enddo ! iint -c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$c----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine esc_sc(escloc) -c$$$C Calculate the local energy of a side chain and its derivatives in the -c$$$C corresponding virtual-bond valence angles THETA and the spherical angles -c$$$C ALPHA and OMEGA. -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.FFIELD' -c$$$ include 'COMMON.CONTROL' -c$$$ double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), -c$$$ & ddersc0(3),ddummy(3),xtemp(3),temp(3) -c$$$ common /sccalc/ time11,time12,time112,theti,it,nlobit -c$$$ delta=0.02d0*pi -c$$$ escloc=0.0D0 -c$$$c write (iout,'(a)') 'ESC' -c$$$ do i=loc_start,loc_end -c$$$ IF (mask_side(i).eq.1) THEN -c$$$ it=itype(i) -c$$$ if (it.eq.10) goto 1 -c$$$ nlobit=nlob(it) -c$$$c print *,'i=',i,' it=',it,' nlobit=',nlobit -c$$$c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad -c$$$ theti=theta(i+1)-pipol -c$$$ x(1)=dtan(theti) -c$$$ x(2)=alph(i) -c$$$ x(3)=omeg(i) -c$$$ -c$$$ if (x(2).gt.pi-delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=pi-delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=pi-delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=pi -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c escloci=esclocbi -c$$$c write (iout,*) escloci -c$$$ else if (x(2).lt.delta) then -c$$$ xtemp(1)=x(1) -c$$$ xtemp(2)=delta -c$$$ xtemp(3)=x(3) -c$$$ call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc(xtemp,escloci1,dersc1,ddummy,.false.) -c$$$ call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), -c$$$ & escloci,dersc(2)) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & ddersc0(1),dersc(1)) -c$$$ call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), -c$$$ & ddersc0(3),dersc(3)) -c$$$ xtemp(2)=delta -c$$$ call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) -c$$$ xtemp(2)=0.0d0 -c$$$ call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) -c$$$ call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, -c$$$ & dersc0(2),esclocbi,dersc02) -c$$$ call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), -c$$$ & dersc12,dersc01) -c$$$ dersc0(1)=dersc01 -c$$$ dersc0(2)=dersc02 -c$$$ dersc0(3)=0.0d0 -c$$$ call splinthet(x(2),0.5d0*delta,ss,ssd) -c$$$ do k=1,3 -c$$$ dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) -c$$$ enddo -c$$$ dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c$$$c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c$$$c & esclocbi,ss,ssd -c$$$ escloci=ss*escloci+(1.0d0-ss)*esclocbi -c$$$c write (iout,*) escloci -c$$$ else -c$$$ call enesc(x,escloci,dersc,ddummy,.false.) -c$$$ endif -c$$$ -c$$$ escloc=escloc+escloci -c$$$ if (energy_dec) write (iout,'(a6,i,0pf7.3)') -c$$$ & 'escloc',i,escloci -c$$$c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc -c$$$ -c$$$ gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ -c$$$ & wscloc*dersc(1) -c$$$ gloc(ialph(i,1),icg)=wscloc*dersc(2) -c$$$ gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) -c$$$ 1 continue -c$$$ ENDIF -c$$$ enddo -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine egb_ij(i_sc,j_sc,evdw) -c$$$C -c$$$C This subroutine calculates the interaction energy of nonbonded side chains -c$$$C assuming the Gay-Berne potential of interaction. -c$$$C -c$$$ implicit real*8 (a-h,o-z) -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.NAMES' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.CALC' -c$$$ include 'COMMON.CONTROL' -c$$$ logical lprn -c$$$ evdw=0.0D0 -c$$$ energy_dec=.false. -c$$$c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon -c$$$ evdw=0.0D0 -c$$$ lprn=.false. -c$$$ ind=0 -c$$$c$$$ do i=iatsc_s,iatsc_e -c$$$ i=i_sc -c$$$ itypi=itype(i) -c$$$ itypi1=itype(i+1) -c$$$ xi=c(1,nres+i) -c$$$ yi=c(2,nres+i) -c$$$ zi=c(3,nres+i) -c$$$ dxi=dc_norm(1,nres+i) -c$$$ dyi=dc_norm(2,nres+i) -c$$$ dzi=dc_norm(3,nres+i) -c$$$c dsci_inv=dsc_inv(itypi) -c$$$ dsci_inv=vbld_inv(i+nres) -c$$$c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) -c$$$c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi -c$$$C -c$$$C Calculate SC interaction energy. -c$$$C -c$$$c$$$ do iint=1,nint_gr(i) -c$$$c$$$ do j=istart(i,iint),iend(i,iint) -c$$$ j=j_sc -c$$$ ind=ind+1 -c$$$ itypj=itype(j) -c$$$c dscj_inv=dsc_inv(itypj) -c$$$ dscj_inv=vbld_inv(j+nres) -c$$$c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -c$$$c & 1.0d0/vbld(j+nres) -c$$$c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) -c$$$ sig0ij=sigma(itypi,itypj) -c$$$ chi1=chi(itypi,itypj) -c$$$ chi2=chi(itypj,itypi) -c$$$ chi12=chi1*chi2 -c$$$ chip1=chip(itypi) -c$$$ chip2=chip(itypj) -c$$$ chip12=chip1*chip2 -c$$$ alf1=alp(itypi) -c$$$ alf2=alp(itypj) -c$$$ alf12=0.5D0*(alf1+alf2) -c$$$C For diagnostics only!!! -c$$$c chi1=0.0D0 -c$$$c chi2=0.0D0 -c$$$c chi12=0.0D0 -c$$$c chip1=0.0D0 -c$$$c chip2=0.0D0 -c$$$c chip12=0.0D0 -c$$$c alf1=0.0D0 -c$$$c alf2=0.0D0 -c$$$c alf12=0.0D0 -c$$$ xj=c(1,nres+j)-xi -c$$$ yj=c(2,nres+j)-yi -c$$$ zj=c(3,nres+j)-zi -c$$$ dxj=dc_norm(1,nres+j) -c$$$ dyj=dc_norm(2,nres+j) -c$$$ dzj=dc_norm(3,nres+j) -c$$$c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -c$$$c write (iout,*) "j",j," dc_norm", -c$$$c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) -c$$$ rrij=1.0D0/(xj*xj+yj*yj+zj*zj) -c$$$ rij=dsqrt(rrij) -c$$$C Calculate angle-dependent terms of energy and contributions to their -c$$$C derivatives. -c$$$ call sc_angular -c$$$ sigsq=1.0D0/sigsq -c$$$ sig=sig0ij*dsqrt(sigsq) -c$$$ rij_shift=1.0D0/rij-sig+sig0ij -c$$$c for diagnostics; uncomment -c$$$c rij_shift=1.2*sig0ij -c$$$C I hate to put IF's in the loops, but here don't have another choice!!!! -c$$$ if (rij_shift.le.0.0D0) then -c$$$ evdw=1.0D20 -c$$$cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$cd & restyp(itypi),i,restyp(itypj),j, -c$$$cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) -c$$$ return -c$$$ endif -c$$$ sigder=-sig*sigsq -c$$$c--------------------------------------------------------------- -c$$$ rij_shift=1.0D0/rij_shift -c$$$ fac=rij_shift**expon -c$$$ e1=fac*fac*aa(itypi,itypj) -c$$$ e2=fac*bb(itypi,itypj) -c$$$ evdwij=eps1*eps2rt*eps3rt*(e1+e2) -c$$$ eps2der=evdwij*eps3rt -c$$$ eps3der=evdwij*eps2rt -c$$$c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, -c$$$c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 -c$$$ evdwij=evdwij*eps2rt*eps3rt -c$$$ evdw=evdw+evdwij -c$$$ if (lprn) then -c$$$ sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c$$$ epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c$$$ write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c$$$ & restyp(itypi),i,restyp(itypj),j, -c$$$ & epsi,sigm,chi1,chi2,chip1,chip2, -c$$$ & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, -c$$$ & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c$$$ & evdwij -c$$$ endif -c$$$ -c$$$ if (energy_dec) write (iout,'(a6,2i,0pf7.3)') -c$$$ & 'evdw',i,j,evdwij -c$$$ -c$$$C Calculate gradient components. -c$$$ e1=e1*eps1*eps2rt**2*eps3rt**2 -c$$$ fac=-expon*(e1+evdwij)*rij_shift -c$$$ sigder=fac*sigder -c$$$ fac=rij*fac -c$$$c fac=0.0d0 -c$$$C Calculate the radial part of the gradient -c$$$ gg(1)=xj*fac -c$$$ gg(2)=yj*fac -c$$$ gg(3)=zj*fac -c$$$C Calculate angular part of the gradient. -c$$$ call sc_grad -c$$$c$$$ enddo ! j -c$$$c$$$ enddo ! iint -c$$$c$$$ enddo ! i -c$$$ energy_dec=.false. -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine perturb_side_chain(i,angle) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.LOCAL' -c$$$ include 'COMMON.IOUNITS' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i -c$$$ double precision angle ! In degrees -c$$$ -c$$$c Local variables -c$$$ integer i_sc -c$$$ double precision rad_ang,rand_v(3),length,cost,sint -c$$$ -c$$$ -c$$$ i_sc=i+nres -c$$$ rad_ang=angle*deg2rad -c$$$ -c$$$ length=0.0 -c$$$ do while (length.lt.0.01) -c$$$ rand_v(1)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(2)=ran_number(0.01D0,1.0D0) -c$$$ rand_v(3)=ran_number(0.01D0,1.0D0) -c$$$ length=rand_v(1)*rand_v(1)+rand_v(2)*rand_v(2)+ -c$$$ + rand_v(3)*rand_v(3) -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ cost=rand_v(1)*dc_norm(1,i_sc)+rand_v(2)*dc_norm(2,i_sc)+ -c$$$ + rand_v(3)*dc_norm(3,i_sc) -c$$$ length=1.0D0-cost*cost -c$$$ if (length.lt.0.0D0) length=0.0D0 -c$$$ length=sqrt(length) -c$$$ rand_v(1)=rand_v(1)-cost*dc_norm(1,i_sc) -c$$$ rand_v(2)=rand_v(2)-cost*dc_norm(2,i_sc) -c$$$ rand_v(3)=rand_v(3)-cost*dc_norm(3,i_sc) -c$$$ enddo -c$$$ rand_v(1)=rand_v(1)/length -c$$$ rand_v(2)=rand_v(2)/length -c$$$ rand_v(3)=rand_v(3)/length -c$$$ -c$$$ cost=dcos(rad_ang) -c$$$ sint=dsin(rad_ang) -c$$$ dc(1,i_sc)=vbld(i_sc)*(dc_norm(1,i_sc)*cost+rand_v(1)*sint) -c$$$ dc(2,i_sc)=vbld(i_sc)*(dc_norm(2,i_sc)*cost+rand_v(2)*sint) -c$$$ dc(3,i_sc)=vbld(i_sc)*(dc_norm(3,i_sc)*cost+rand_v(3)*sint) -c$$$ dc_norm(1,i_sc)=dc(1,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(2,i_sc)=dc(2,i_sc)*vbld_inv(i_sc) -c$$$ dc_norm(3,i_sc)=dc(3,i_sc)*vbld_inv(i_sc) -c$$$ c(1,i_sc)=c(1,i)+dc(1,i_sc) -c$$$ c(2,i_sc)=c(2,i)+dc(2,i_sc) -c$$$ c(3,i_sc)=c(3,i)+dc(3,i_sc) -c$$$ -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax3(i_in,j_in) -c$$$ implicit none -c$$$ -c$$$c Includes -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.INTERACT' -c$$$ -c$$$c External functions -c$$$ external ran_number -c$$$ double precision ran_number -c$$$ -c$$$c Input arguments -c$$$ integer i_in,j_in -c$$$ -c$$$c Local variables -c$$$ double precision energy_sc(0:n_ene),etot -c$$$ double precision org_dc(3),org_dc_norm(3),org_c(3) -c$$$ double precision ang_pert,rand_fact,exp_fact,beta -c$$$ integer n,i_pert,i -c$$$ logical notdone -c$$$ -c$$$ -c$$$ beta=1.0D0 -c$$$ -c$$$ mask_r=.true. -c$$$ do i=nnt,nct -c$$$ mask_side(i)=0 -c$$$ enddo -c$$$ mask_side(i_in)=1 -c$$$ mask_side(j_in)=1 -c$$$ -c$$$ call etotal_sc(energy_sc) -c$$$ etot=energy_sc(0) -c$$$c write(iout,'(a,3d15.5)')" SS_MC_START ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ -c$$$ notdone=.true. -c$$$ n=0 -c$$$ do while (notdone) -c$$$ if (mod(n,2).eq.0) then -c$$$ i_pert=i_in -c$$$ else -c$$$ i_pert=j_in -c$$$ endif -c$$$ n=n+1 -c$$$ -c$$$ do i=1,3 -c$$$ org_dc(i)=dc(i,i_pert+nres) -c$$$ org_dc_norm(i)=dc_norm(i,i_pert+nres) -c$$$ org_c(i)=c(i,i_pert+nres) -c$$$ enddo -c$$$ ang_pert=ran_number(0.0D0,3.0D0) -c$$$ call perturb_side_chain(i_pert,ang_pert) -c$$$ call etotal_sc(energy_sc) -c$$$ exp_fact=exp(beta*(etot-energy_sc(0))) -c$$$ rand_fact=ran_number(0.0D0,1.0D0) -c$$$ if (rand_fact.lt.exp_fact) then -c$$$c write(iout,'(a,3d15.5)')" SS_MC_ACCEPT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ etot=energy_sc(0) -c$$$ else -c$$$c write(iout,'(a,3d15.5)')" SS_MC_REJECT ",energy_sc(0), -c$$$c + energy_sc(1),energy_sc(12) -c$$$ do i=1,3 -c$$$ dc(i,i_pert+nres)=org_dc(i) -c$$$ dc_norm(i,i_pert+nres)=org_dc_norm(i) -c$$$ c(i,i_pert+nres)=org_c(i) -c$$$ enddo -c$$$ endif -c$$$ -c$$$ if (n.eq.10000.or.etot.lt.30.0D0) notdone=.false. -c$$$ enddo -c$$$ -c$$$ mask_r=.false. -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$c---------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_relax2(etot,iretcode,nfun,i_in,j_in) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ integer liv,lv -c$$$ parameter (liv=60,lv=(77+maxres6*(maxres6+17)/2)) -c$$$********************************************************************* -c$$$* OPTIMIZE sets up SUMSL or DFP and provides a simple interface for * -c$$$* the calling subprogram. * -c$$$* when d(i)=1.0, then v(35) is the length of the initial step, * -c$$$* calculated in the usual pythagorean way. * -c$$$* absolute convergence occurs when the function is within v(31) of * -c$$$* zero. unless you know the minimum value in advance, abs convg * -c$$$* is probably not useful. * -c$$$* relative convergence is when the model predicts that the function * -c$$$* will decrease by less than v(32)*abs(fun). * -c$$$********************************************************************* -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.GEO' -c$$$ include 'COMMON.MINIM' -c$$$ include 'COMMON.CHAIN' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ double precision etot -c$$$ integer iretcode,nfun,i_in,j_in -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ external ss_func,fdum -c$$$ double precision ss_func,fdum -c$$$ -c$$$ integer iv(liv),uiparm(2) -c$$$ double precision v(lv),x(maxres6),d(maxres6),rdum -c$$$ integer i,j,k -c$$$ -c$$$ -c$$$ call deflt(2,iv,liv,lv,v) -c$$$* 12 means fresh start, dont call deflt -c$$$ iv(1)=12 -c$$$* max num of fun calls -c$$$ if (maxfun.eq.0) maxfun=500 -c$$$ iv(17)=maxfun -c$$$* max num of iterations -c$$$ if (maxmin.eq.0) maxmin=1000 -c$$$ iv(18)=maxmin -c$$$* controls output -c$$$ iv(19)=2 -c$$$* selects output unit -c$$$c iv(21)=iout -c$$$ iv(21)=0 -c$$$* 1 means to print out result -c$$$ iv(22)=0 -c$$$* 1 means to print out summary stats -c$$$ iv(23)=0 -c$$$* 1 means to print initial x and d -c$$$ iv(24)=0 -c$$$* min val for v(radfac) default is 0.1 -c$$$ v(24)=0.1D0 -c$$$* max val for v(radfac) default is 4.0 -c$$$ v(25)=2.0D0 -c$$$c v(25)=4.0D0 -c$$$* check false conv if (act fnctn decrease) .lt. v(26)*(exp decrease) -c$$$* the sumsl default is 0.1 -c$$$ v(26)=0.1D0 -c$$$* false conv if (act fnctn decrease) .lt. v(34) -c$$$* the sumsl default is 100*machep -c$$$ v(34)=v(34)/100.0D0 -c$$$* absolute convergence -c$$$ if (tolf.eq.0.0D0) tolf=1.0D-4 -c$$$ v(31)=tolf -c$$$ v(31)=1.0D-1 -c$$$* relative convergence -c$$$ if (rtolf.eq.0.0D0) rtolf=1.0D-4 -c$$$ v(32)=rtolf -c$$$ v(32)=1.0D-1 -c$$$* controls initial step size -c$$$ v(35)=1.0D-1 -c$$$* large vals of d correspond to small components of step -c$$$ do i=1,6*nres -c$$$ d(i)=1.0D0 -c$$$ enddo -c$$$ -c$$$ do i=0,2*nres -c$$$ do j=1,3 -c$$$ orig_ss_dc(j,i)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ call geom_to_var(nvar,orig_ss_var) -c$$$ -c$$$ do i=1,nres -c$$$ do j=i,nres -c$$$ orig_ss_dist(j,i)=dist(j,i) -c$$$ orig_ss_dist(j+nres,i)=dist(j+nres,i) -c$$$ orig_ss_dist(j,i+nres)=dist(j,i+nres) -c$$$ orig_ss_dist(j+nres,i+nres)=dist(j+nres,i+nres) -c$$$ enddo -c$$$ enddo -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ x(k)=dc(j,i+nres) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ -c$$$ uiparm(1)=i_in -c$$$ uiparm(2)=j_in -c$$$ call smsno(k,d,x,ss_func,iv,liv,lv,v,uiparm,rdum,fdum) -c$$$ etot=v(10) -c$$$ iretcode=iv(1) -c$$$ nfun=iv(6)+iv(30) -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- -c$$$ -c$$$ subroutine ss_func(n,x,nf,f,uiparm,urparm,ufparm) -c$$$ implicit none -c$$$ include 'DIMENSIONS' -c$$$ include 'COMMON.DERIV' -c$$$ include 'COMMON.IOUNITS' -c$$$ include 'COMMON.VAR' -c$$$ include 'COMMON.CHAIN' -c$$$ include 'COMMON.INTERACT' -c$$$ include 'COMMON.SBRIDGE' -c$$$ -c$$$ double precision orig_ss_dc,orig_ss_var,orig_ss_dist -c$$$ common /orig_ss/ orig_ss_dc(3,0:maxres2),orig_ss_var(maxvar), -c$$$ + orig_ss_dist(maxres2,maxres2) -c$$$ -c$$$ integer n -c$$$ double precision x(maxres6) -c$$$ integer nf -c$$$ double precision f -c$$$ integer uiparm(2) -c$$$ real*8 urparm(1) -c$$$ external ufparm -c$$$ double precision ufparm -c$$$ -c$$$ external dist -c$$$ double precision dist -c$$$ -c$$$ integer i,j,k,ss_i,ss_j -c$$$ double precision tempf,var(maxvar) -c$$$ -c$$$ -c$$$ ss_i=uiparm(1) -c$$$ ss_j=uiparm(2) -c$$$ f=0.0D0 -c$$$ -c$$$ k=0 -c$$$ do i=1,nres-1 -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i)=x(k) -c$$$ enddo -c$$$ enddo -c$$$ do i=2,nres-1 -c$$$ if (ialph(i,1).gt.0) then -c$$$ do j=1,3 -c$$$ k=k+1 -c$$$ dc(j,i+nres)=x(k) -c$$$ enddo -c$$$ endif -c$$$ enddo -c$$$ call chainbuild_cart -c$$$ -c$$$ call geom_to_var(nvar,var) -c$$$ -c$$$c Constraints on all angles -c$$$ do i=1,nvar -c$$$ tempf=var(i)-orig_ss_var(i) -c$$$ f=f+tempf*tempf -c$$$ enddo -c$$$ -c$$$c Constraints on all distances -c$$$ do i=1,nres-1 -c$$$ if (i.gt.1) then -c$$$ tempf=dist(i+nres,i)-orig_ss_dist(i+nres,i) -c$$$ f=f+tempf*tempf -c$$$ endif -c$$$ do j=i+1,nres -c$$$ tempf=dist(j,i)-orig_ss_dist(j,i) -c$$$ if (tempf.lt.0.0D0 .or. j.eq.i+1) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i)-orig_ss_dist(j+nres,i) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j,i+nres)-orig_ss_dist(j,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ tempf=dist(j+nres,i+nres)-orig_ss_dist(j+nres,i+nres) -c$$$ if (tempf.lt.0.0D0) f=f+tempf*tempf -c$$$ enddo -c$$$ enddo -c$$$ -c$$$c Constraints for the relevant CYS-CYS -c$$$ tempf=dist(nres+ss_i,nres+ss_j)-8.0D0 -c$$$ f=f+tempf*tempf -c$$$CCCCCCCCCCCCCCCCC ADD SOME ANGULAR STUFF -c$$$ -c$$$c$$$ if (nf.ne.nfl) then -c$$$c$$$ write(iout,'(a,i10,2d15.5)')"IN DIST_FUNC (NF,F,DIST)",nf, -c$$$c$$$ + f,dist(5+nres,14+nres) -c$$$c$$$ endif -c$$$ -c$$$ nfl=nf -c$$$ -c$$$ return -c$$$ end -c$$$ -c$$$C----------------------------------------------------------------------------- diff --git a/source/unres/src_MD-restraints/stochfric.F b/source/unres/src_MD-restraints/stochfric.F deleted file mode 100644 index 74eda61..0000000 --- a/source/unres/src_MD-restraints/stochfric.F +++ /dev/null @@ -1,626 +0,0 @@ - subroutine friction_force - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - double precision gamvec(MAXRES6) - common /syfek/ gamvec - double precision vv(3),vvtot(3,maxres),v_work(MAXRES6), - & ginvfric(maxres2,maxres2) - common /przechowalnia/ ginvfric - - logical lprn /.false./, checkmode /.false./ - - do i=0,MAXRES2 - do j=1,3 - friction(j,i)=0.0d0 - enddo - enddo - - do j=1,3 - d_t_work(j)=d_t(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - d_t_work(ind+j)=d_t(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - d_t_work(ind+j)=d_t(j,i+nres) - enddo - ind=ind+3 - endif - enddo - - call fricmat_mult(d_t_work,fric_work) - - if (.not.checkmode) return - - if (lprn) then - write (iout,*) "d_t_work and fric_work" - do i=1,3*dimen - write (iout,'(i3,2e15.5)') i,d_t_work(i),fric_work(i) - enddo - endif - do j=1,3 - friction(j,0)=fric_work(j) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - friction(j,i)=fric_work(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - friction(j,i+nres)=fric_work(ind+j) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write(iout,*) "Friction backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i),j=1,3),(d_t(j,i),j=1,3) - enddo - write(iout,*) "Friction side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5,5x,3e15.5)') - & i,(friction(j,i+nres),j=1,3),(d_t(j,i+nres),j=1,3) - enddo - endif - if (lprn) then - do j=1,3 - vv(j)=d_t(j,0) - enddo - do i=nnt,nct - do j=1,3 - vvtot(j,i)=vv(j)+0.5d0*d_t(j,i) - vvtot(j,i+nres)=vv(j)+d_t(j,i+nres) - vv(j)=vv(j)+d_t(j,i) - enddo - enddo - write (iout,*) "vvtot backbone and sidechain" - do i=nnt,nct - write (iout,'(i5,3e15.5,5x,3e15.5)') i,(vvtot(j,i),j=1,3), - & (vvtot(j,i+nres),j=1,3) - enddo - ind=0 - do i=nnt,nct-1 - do j=1,3 - v_work(ind+j)=vvtot(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - v_work(ind+j)=vvtot(j,i+nres) - enddo - ind=ind+3 - enddo - write (iout,*) "v_work gamvec and site-based friction forces" - do i=1,dimen1 - write (iout,'(i5,3e15.5)') i,v_work(i),gamvec(i), - & gamvec(i)*v_work(i) - enddo -c do i=1,dimen -c fric_work1(i)=0.0d0 -c do j=1,dimen1 -c fric_work1(i)=fric_work1(i)-A(j,i)*gamvec(j)*v_work(j) -c enddo -c enddo -c write (iout,*) "fric_work and fric_work1" -c do i=1,dimen -c write (iout,'(i5,2e15.5)') i,fric_work(i),fric_work1(i) -c enddo - do i=1,dimen - do j=1,dimen - ginvfric(i,j)=0.0d0 - do k=1,dimen - ginvfric(i,j)=ginvfric(i,j)+ginv(i,k)*fricmat(k,j) - enddo - enddo - enddo - write (iout,*) "ginvfric" - do i=1,dimen - write (iout,'(i5,100f8.3)') i,(ginvfric(i,j),j=1,dimen) - enddo - write (iout,*) "symmetry check" - do i=1,dimen - do j=1,i-1 - write (iout,*) i,j,ginvfric(i,j)-ginvfric(j,i) - enddo - enddo - endif - return - end -c----------------------------------------------------- - subroutine stochastic_force(stochforcvec) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.TIME1' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - - double precision x,sig,lowb,highb, - & ff(3),force(3,0:MAXRES2),zeta2,lowb2, - & highb2,sig2,forcvec(MAXRES6),stochforcvec(MAXRES6) - logical lprn /.false./ - do i=0,MAXRES2 - do j=1,3 - stochforc(j,i)=0.0d0 - enddo - enddo - x=0.0d0 - -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Compute the stochastic forces acting on bodies. Store in force. - do i=nnt,nct-1 - sig=stdforcp(i) - lowb=-5*sig - highb=5*sig - do j=1,3 - force(j,i)=anorm_distr(x,sig,lowb,highb) - enddo - enddo - do i=nnt,nct - sig2=stdforcsc(i) - lowb2=-5*sig2 - highb2=5*sig2 - do j=1,3 - force(j,i+nres)=anorm_distr(x,sig2,lowb2,highb2) - enddo - enddo -#ifdef MPI - time_fsample=time_fsample+MPI_Wtime()-time00 -#else - time_fsample=time_fsample+tcpu()-time00 -#endif -c Compute the stochastic forces acting on virtual-bond vectors. - do j=1,3 - ff(j)=0.0d0 - enddo - do i=nct-1,nnt,-1 - do j=1,3 - stochforc(j,i)=ff(j)+0.5d0*force(j,i) - enddo - do j=1,3 - ff(j)=ff(j)+force(j,i) - enddo - if (itype(i+1).ne.21) then - do j=1,3 - stochforc(j,i)=stochforc(j,i)+force(j,i+nres+1) - ff(j)=ff(j)+force(j,i+nres+1) - enddo - endif - enddo - do j=1,3 - stochforc(j,0)=ff(j)+force(j,nnt+nres) - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforc(j,i+nres)=force(j,i+nres) - enddo - endif - enddo - - do j=1,3 - stochforcvec(j)=stochforc(j,0) - enddo - ind=3 - do i=nnt,nct-1 - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - stochforcvec(ind+j)=stochforc(j,i+nres) - enddo - ind=ind+3 - endif - enddo - if (lprn) then - write (iout,*) "stochforcvec" - do i=1,3*dimen - write(iout,'(i5,e15.5)') i,stochforcvec(i) - enddo - write(iout,*) "Stochastic forces backbone" - do i=0,nct-1 - write(iout,'(i5,3e15.5)') i,(stochforc(j,i),j=1,3) - enddo - write(iout,*) "Stochastic forces side chain" - do i=nnt,nct - write(iout,'(i5,3e15.5)') - & i,(stochforc(j,i+nres),j=1,3) - enddo - endif - - if (lprn) then - - ind=0 - do i=nnt,nct-1 - write (iout,*) i,ind - do j=1,3 - forcvec(ind+j)=force(j,i) - enddo - ind=ind+3 - enddo - do i=nnt,nct - write (iout,*) i,ind - do j=1,3 - forcvec(j+ind)=force(j,i+nres) - enddo - ind=ind+3 - enddo - - write (iout,*) "forcvec" - ind=0 - do i=nnt,nct-1 - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - do i=nnt,nct - do j=1,3 - write (iout,'(2i3,2f10.5)') i,j,force(j,i+nres), - & forcvec(ind+j) - enddo - ind=ind+3 - enddo - - endif - - return - end -c------------------------------------------------------------------ - subroutine setup_fricmat - implicit real*8 (a-h,o-z) -#ifdef MPI - include 'mpif.h' -#endif - include 'DIMENSIONS' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.MD' - include 'COMMON.SETUP' - include 'COMMON.TIME1' -c integer licznik /0/ -c save licznik -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.IOUNITS' - integer IERROR - integer i,j,ind,ind1,m - logical lprn /.false./ - double precision dtdi,gamvec(MAXRES2), - & ginvfric(maxres2,maxres2),Ghalf(mmaxres2),fcopy(maxres2,maxres2) - common /syfek/ gamvec - double precision work(8*maxres2) - integer iwork(maxres2) - common /przechowalnia/ ginvfric,Ghalf,fcopy -#ifdef MPI - if (fg_rank.ne.king) goto 10 -#endif -c Zeroing out fricmat - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - enddo - enddo -c Load the friction coefficients corresponding to peptide groups - ind1=0 - do i=nnt,nct-1 - ind1=ind1+1 - gamvec(ind1)=gamp - enddo -c Load the friction coefficients corresponding to side chains - m=nct-nnt - ind=0 - do i=nnt,nct - ind=ind+1 - ii = ind+m - iti=itype(i) - gamvec(ii)=gamsc(iti) - enddo - if (surfarea) call sdarea(gamvec) -c if (lprn) then -c write (iout,*) "Matrix A and vector gamma" -c do i=1,dimen1 -c write (iout,'(i2,$)') i -c do j=1,dimen -c write (iout,'(f4.1,$)') A(i,j) -c enddo -c write (iout,'(f8.3)') gamvec(i) -c enddo -c endif - if (lprn) then - write (iout,*) "Vector gamvec" - do i=1,dimen1 - write (iout,'(i5,f10.5)') i, gamvec(i) - enddo - endif - -c The friction matrix - do k=1,dimen - do i=1,dimen - dtdi=0.0d0 - do j=1,dimen1 - dtdi=dtdi+A(j,k)*A(j,i)*gamvec(j) - enddo - fricmat(k,i)=dtdi - enddo - enddo - - if (lprn) then - write (iout,'(//a)') "Matrix fricmat" - call matout2(dimen,dimen,maxres2,maxres2,fricmat) - endif - if (lang.eq.2 .or. lang.eq.3) then -c Mass-scale the friction matrix if non-direct integration will be performed - do i=1,dimen - do j=1,dimen - Ginvfric(i,j)=0.0d0 - do k=1,dimen - do l=1,dimen - Ginvfric(i,j)=Ginvfric(i,j)+ - & Gsqrm(i,k)*Gsqrm(l,j)*fricmat(k,l) - enddo - enddo - enddo - enddo -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=Ginvfric(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " mass-scaled friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Precompute matrices for tinker stochastic integrator -#ifndef LANG0 - do i=1,dimen - do j=1,dimen - mt1(i,j)=0.0d0 - mt2(i,j)=0.0d0 - do k=1,dimen - mt1(i,j)=mt1(i,j)+fricvec(k,i)*gsqrm(k,j) - mt2(i,j)=mt2(i,j)+fricvec(k,i)*gsqrp(k,j) - enddo - mt3(j,i)=mt1(i,j) - enddo - enddo -#endif - else if (lang.eq.4) then -c Diagonalize the friction matrix - ind=0 - do i=1,dimen - do j=1,i - ind=ind+1 - Ghalf(ind)=fricmat(i,j) - enddo - enddo - call gldiag(maxres2,dimen,dimen,Ghalf,work,fricgam,fricvec, - & ierr,iwork) - if (lprn) then - write (iout,'(//2a)') "Eigenvectors and eigenvalues of the", - & " friction matrix" - call eigout(dimen,dimen,maxres2,maxres2,fricvec,fricgam) - endif -c Determine the number of zero eigenvalues of the friction matrix - nzero=max0(dimen-dimen1,0) -c do while (fricgam(nzero+1).le.1.0d-5 .and. nzero.lt.dimen) -c nzero=nzero+1 -c enddo - write (iout,*) "Number of zero eigenvalues:",nzero - do i=1,dimen - do j=1,dimen - fricmat(i,j)=0.0d0 - do k=nzero+1,dimen - fricmat(i,j)=fricmat(i,j) - & +fricvec(i,k)*fricvec(j,k)/fricgam(k) - enddo - enddo - enddo - if (lprn) then - write (iout,'(//a)') "Generalized inverse of fricmat" - call matout(dimen,dimen,maxres6,maxres6,fricmat) - endif - endif -#ifdef MPI - 10 continue - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then -c The matching BROADCAST for fg processors is called in ERGASTULUM -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call MPI_Bcast(10,1,MPI_INTEGER,king,FG_COMM,IERROR) -#ifdef MPI - time_Bcast=time_Bcast+MPI_Wtime()-time00 -#else - time_Bcast=time_Bcast+tcpu()-time00 -#endif -c print *,"Processor",myrank, -c & " BROADCAST iorder in SETUP_FRICMAT" - endif -c licznik=licznik+1 -c write (iout,*) "setup_fricmat licznik",licznik -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif -c Scatter the friction matrix - call MPI_Scatterv(fricmat(1,1),nginv_counts(0), - & nginv_start(0),MPI_DOUBLE_PRECISION,fcopy(1,1), - & myginv_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) -#ifdef TIMING -#ifdef MPI - time_scatter=time_scatter+MPI_Wtime()-time00 - time_scatter_fmat=time_scatter_fmat+MPI_Wtime()-time00 -#else - time_scatter=time_scatter+tcpu()-time00 - time_scatter_fmat=time_scatter_fmat+tcpu()-time00 -#endif -#endif - do i=1,dimen - do j=1,2*my_ng_count - fricmat(j,i)=fcopy(i,j) - enddo - enddo -c write (iout,*) "My chunk of fricmat" -c call MATOUT2(my_ng_count,dimen,maxres2,maxres2,fcopy) - endif -#endif - return - end -c------------------------------------------------------------------------------- - subroutine sdarea(gamvec) -c -c Scale the friction coefficients according to solvent accessible surface areas -c Code adapted from TINKER -c AL 9/3/04 -c - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.VAR' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.GEO' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.NAMES' - double precision radius(maxres2),gamvec(maxres2) - parameter (twosix=1.122462048309372981d0) - logical lprn /.false./ -c -c determine new friction coefficients every few SD steps -c -c set the atomic radii to estimates of sigma values -c -c print *,"Entered sdarea" - probe = 0.0d0 - - do i=1,2*nres - radius(i)=0.0d0 - enddo -c Load peptide group radii - do i=nnt,nct-1 - radius(i)=pstok - enddo -c Load side chain radii - do i=nnt,nct - iti=itype(i) - radius(i+nres)=restok(iti) - enddo -c do i=1,2*nres -c write (iout,*) "i",i," radius",radius(i) -c enddo - do i = 1, 2*nres - radius(i) = radius(i) / twosix - if (radius(i) .ne. 0.0d0) radius(i) = radius(i) + probe - end do -c -c scale atomic friction coefficients by accessible area -c - if (lprn) write (iout,*) - & "Original gammas, surface areas, scaling factors, new gammas, ", - & "std's of stochastic forces" - ind=0 - do i=nnt,nct-1 - if (radius(i).gt.0.0d0) then - call surfatom (i,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcp(i)=stdfp*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcp(i) - endif - enddo - do i=nnt,nct - if (radius(i+nres).gt.0.0d0) then - call surfatom (i+nres,area,radius) - ratio = dmax1(area/(4.0d0*pi*radius(i+nres)**2),1.0d-1) - if (lprn) write (iout,'(i5,3f10.5,$)') - & i,gamvec(ind+1),area,ratio - do j=1,3 - ind=ind+1 - gamvec(ind) = ratio * gamvec(ind) - enddo - stdforcsc(i)=stdfsc(itype(i))*dsqrt(gamvec(ind)) - if (lprn) write (iout,'(2f10.5)') gamvec(ind),stdforcsc(i) - endif - enddo - - return - end diff --git a/source/unres/src_MD-restraints/sumsld.f b/source/unres/src_MD-restraints/sumsld.f deleted file mode 100644 index 1ce7b78..0000000 --- a/source/unres/src_MD-restraints/sumsld.f +++ /dev/null @@ -1,1446 +0,0 @@ - subroutine sumsl(n, d, x, calcf, calcg, iv, liv, lv, v, - 1 uiparm, urparm, ufparm) -c -c *** minimize general unconstrained objective function using *** -c *** analytic gradient and hessian approx. from secant update *** -c - integer n, liv, lv - integer iv(liv), uiparm(1) - double precision d(n), x(n), v(lv), urparm(1) -c dimension v(71 + n*(n+15)/2), uiparm(*), urparm(*) - external calcf, calcg, ufparm -c -c *** purpose *** -c -c this routine interacts with subroutine sumit in an attempt -c to find an n-vector x* that minimizes the (unconstrained) -c objective function computed by calcf. (often the x* found is -c a local minimizer rather than a global one.) -c -c-------------------------- parameter usage -------------------------- -c -c n........ (input) the number of variables on which f depends, i.e., -c the number of components in x. -c d........ (input/output) a scale vector such that d(i)*x(i), -c i = 1,2,...,n, are all in comparable units. -c d can strongly affect the behavior of sumsl. -c finding the best choice of d is generally a trial- -c and-error process. choosing d so that d(i)*x(i) -c has about the same value for all i often works well. -c the defaults provided by subroutine deflt (see i -c below) require the caller to supply d. -c x........ (input/output) before (initially) calling sumsl, the call- -c er should set x to an initial guess at x*. when -c sumsl returns, x contains the best point so far -c found, i.e., the one that gives the least value so -c far seen for f(x). -c calcf.... (input) a subroutine that, given x, computes f(x). calcf -c must be declared external in the calling program. -c it is invoked by -c call calcf(n, x, nf, f, uiparm, urparm, ufparm) -c when calcf is called, nf is the invocation -c count for calcf. nf is included for possible use -c with calcg. if x is out of bounds (e.g., if it -c would cause overflow in computing f(x)), then calcf -c should set nf to 0. this will cause a shorter step -c to be attempted. (if x is in bounds, then calcf -c should not change nf.) the other parameters are as -c described above and below. calcf should not change -c n, p, or x. -c calcg.... (input) a subroutine that, given x, computes g(x), the gra- -c dient of f at x. calcg must be declared external in -c the calling program. it is invoked by -c call calcg(n, x, nf, g, uiparm, urparm, ufaprm) -c when calcg is called, nf is the invocation -c count for calcf at the time f(x) was evaluated. the -c x passed to calcg is usually the one passed to calcf -c on either its most recent invocation or the one -c prior to it. if calcf saves intermediate results -c for use by calcg, then it is possible to tell from -c nf whether they are valid for the current x (or -c which copy is valid if two copies are kept). if g -c cannot be computed at x, then calcg should set nf to -c 0. in this case, sumsl will return with iv(1) = 65. -c (if g can be computed at x, then calcg should not -c changed nf.) the other parameters to calcg are as -c described above and below. calcg should not change -c n or x. -c iv....... (input/output) an integer value array of length liv (see -c below) that helps control the sumsl algorithm and -c that is used to store various intermediate quanti- -c ties. of particular interest are the initialization/ -c return code iv(1) and the entries in iv that control -c printing and limit the number of iterations and func- -c tion evaluations. see the section on iv input -c values below. -c liv...... (input) length of iv array. must be at least 60. if li -c is too small, then sumsl returns with iv(1) = 15. -c when sumsl returns, the smallest allowed value of -c liv is stored in iv(lastiv) -- see the section on -c iv output values below. (this is intended for use -c with extensions of sumsl that handle constraints.) -c lv....... (input) length of v array. must be at least 71+n*(n+15)/2. -c (at least 77+n*(n+17)/2 for smsno, at least -c 78+n*(n+12) for humsl). if lv is too small, then -c sumsl returns with iv(1) = 16. when sumsl returns, -c the smallest allowed value of lv is stored in -c iv(lastv) -- see the section on iv output values -c below. -c v........ (input/output) a floating-point value array of length l -c (see below) that helps control the sumsl algorithm -c and that is used to store various intermediate -c quantities. of particular interest are the entries -c in v that limit the length of the first step -c attempted (lmax0) and specify convergence tolerances -c (afctol, lmaxs, rfctol, sctol, xctol, xftol). -c uiparm... (input) user integer parameter array passed without change -c to calcf and calcg. -c urparm... (input) user floating-point parameter array passed without -c change to calcf and calcg. -c ufparm... (input) user external subroutine or function passed without -c change to calcf and calcg. -c -c *** iv input values (from subroutine deflt) *** -c -c iv(1)... on input, iv(1) should have a value between 0 and 14...... -c 0 and 12 mean this is a fresh start. 0 means that -c deflt(2, iv, liv, lv, v) -c is to be called to provide all default values to iv and -c v. 12 (the value that deflt assigns to iv(1)) means the -c caller has already called deflt and has possibly changed -c some iv and/or v entries to non-default values. -c 13 means deflt has been called and that sumsl (and -c sumit) should only do their storage allocation. that is, -c they should set the output components of iv that tell -c where various subarrays arrays of v begin, such as iv(g) -c (and, for humsl and humit only, iv(dtol)), and return. -c 14 means that a storage has been allocated (by a call -c with iv(1) = 13) and that the algorithm should be -c started. when called with iv(1) = 13, sumsl returns -c iv(1) = 14 unless liv or lv is too small (or n is not -c positive). default = 12. -c iv(inith).... iv(25) tells whether the hessian approximation h should -c be initialized. 1 (the default) means sumit should -c initialize h to the diagonal matrix whose i-th diagonal -c element is d(i)**2. 0 means the caller has supplied a -c cholesky factor l of the initial hessian approximation -c h = l*(l**t) in v, starting at v(iv(lmat)) = v(iv(42)) -c (and stored compactly by rows). note that iv(lmat) may -c be initialized by calling sumsl with iv(1) = 13 (see -c the iv(1) discussion above). default = 1. -c iv(mxfcal)... iv(17) gives the maximum number of function evaluations -c (calls on calcf) allowed. if this number does not suf- -c fice, then sumsl returns with iv(1) = 9. default = 200. -c iv(mxiter)... iv(18) gives the maximum number of iterations allowed. -c it also indirectly limits the number of gradient evalua- -c tions (calls on calcg) to iv(mxiter) + 1. if iv(mxiter) -c iterations do not suffice, then sumsl returns with -c iv(1) = 10. default = 150. -c iv(outlev)... iv(19) controls the number and length of iteration sum- -c mary lines printed (by itsum). iv(outlev) = 0 means do -c not print any summary lines. otherwise, print a summary -c line after each abs(iv(outlev)) iterations. if iv(outlev) -c is positive, then summary lines of length 78 (plus carri- -c age control) are printed, including the following... the -c iteration and function evaluation counts, f = the current -c function value, relative difference in function values -c achieved by the latest step (i.e., reldf = (f0-v(f))/f01, -c where f01 is the maximum of abs(v(f)) and abs(v(f0)) and -c v(f0) is the function value from the previous itera- -c tion), the relative function reduction predicted for the -c step just taken (i.e., preldf = v(preduc) / f01, where -c v(preduc) is described below), the scaled relative change -c in x (see v(reldx) below), the step parameter for the -c step just taken (stppar = 0 means a full newton step, -c between 0 and 1 means a relaxed newton step, between 1 -c and 2 means a double dogleg step, greater than 2 means -c a scaled down cauchy step -- see subroutine dbldog), the -c 2-norm of the scale vector d times the step just taken -c (see v(dstnrm) below), and npreldf, i.e., -c v(nreduc)/f01, where v(nreduc) is described below -- if -c npreldf is positive, then it is the relative function -c reduction predicted for a newton step (one with -c stppar = 0). if npreldf is negative, then it is the -c negative of the relative function reduction predicted -c for a step computed with step bound v(lmaxs) for use in -c testing for singular convergence. -c if iv(outlev) is negative, then lines of length 50 -c are printed, including only the first 6 items listed -c above (through reldx). -c default = 1. -c iv(parprt)... iv(20) = 1 means print any nondefault v values on a -c fresh start or any changed v values on a restart. -c iv(parprt) = 0 means skip this printing. default = 1. -c iv(prunit)... iv(21) is the output unit number on which all printing -c is done. iv(prunit) = 0 means suppress all printing. -c default = standard output unit (unit 6 on most systems). -c iv(solprt)... iv(22) = 1 means print out the value of x returned (as -c well as the gradient and the scale vector d). -c iv(solprt) = 0 means skip this printing. default = 1. -c iv(statpr)... iv(23) = 1 means print summary statistics upon return- -c ing. these consist of the function value, the scaled -c relative change in x caused by the most recent step (see -c v(reldx) below), the number of function and gradient -c evaluations (calls on calcf and calcg), and the relative -c function reductions predicted for the last step taken and -c for a newton step (or perhaps a step bounded by v(lmaxs) -c -- see the descriptions of preldf and npreldf under -c iv(outlev) above). -c iv(statpr) = 0 means skip this printing. -c iv(statpr) = -1 means skip this printing as well as that -c of the one-line termination reason message. default = 1. -c iv(x0prt).... iv(24) = 1 means print the initial x and scale vector d -c (on a fresh start only). iv(x0prt) = 0 means skip this -c printing. default = 1. -c -c *** (selected) iv output values *** -c -c iv(1)........ on output, iv(1) is a return code.... -c 3 = x-convergence. the scaled relative difference (see -c v(reldx)) between the current parameter vector x and -c a locally optimal parameter vector is very likely at -c most v(xctol). -c 4 = relative function convergence. the relative differ- -c ence between the current function value and its lo- -c cally optimal value is very likely at most v(rfctol). -c 5 = both x- and relative function convergence (i.e., the -c conditions for iv(1) = 3 and iv(1) = 4 both hold). -c 6 = absolute function convergence. the current function -c value is at most v(afctol) in absolute value. -c 7 = singular convergence. the hessian near the current -c iterate appears to be singular or nearly so, and a -c step of length at most v(lmaxs) is unlikely to yield -c a relative function decrease of more than v(sctol). -c 8 = false convergence. the iterates appear to be converg- -c ing to a noncritical point. this may mean that the -c convergence tolerances (v(afctol), v(rfctol), -c v(xctol)) are too small for the accuracy to which -c the function and gradient are being computed, that -c there is an error in computing the gradient, or that -c the function or gradient is discontinuous near x. -c 9 = function evaluation limit reached without other con- -c vergence (see iv(mxfcal)). -c 10 = iteration limit reached without other convergence -c (see iv(mxiter)). -c 11 = stopx returned .true. (external interrupt). see the -c usage notes below. -c 14 = storage has been allocated (after a call with -c iv(1) = 13). -c 17 = restart attempted with n changed. -c 18 = d has a negative component and iv(dtype) .le. 0. -c 19...43 = v(iv(1)) is out of range. -c 63 = f(x) cannot be computed at the initial x. -c 64 = bad parameters passed to assess (which should not -c occur). -c 65 = the gradient could not be computed at x (see calcg -c above). -c 67 = bad first parameter to deflt. -c 80 = iv(1) was out of range. -c 81 = n is not positive. -c iv(g)........ iv(28) is the starting subscript in v of the current -c gradient vector (the one corresponding to x). -c iv(lastiv)... iv(44) is the least acceptable value of liv. (it is -c only set if liv is at least 44.) -c iv(lastv).... iv(45) is the least acceptable value of lv. (it is -c only set if liv is large enough, at least iv(lastiv).) -c iv(nfcall)... iv(6) is the number of calls so far made on calcf (i.e., -c function evaluations). -c iv(ngcall)... iv(30) is the number of gradient evaluations (calls on -c calcg). -c iv(niter).... iv(31) is the number of iterations performed. -c -c *** (selected) v input values (from subroutine deflt) *** -c -c v(bias)..... v(43) is the bias parameter used in subroutine dbldog -- -c see that subroutine for details. default = 0.8. -c v(afctol)... v(31) is the absolute function convergence tolerance. -c if sumsl finds a point where the function value is less -c than v(afctol) in absolute value, and if sumsl does not -c return with iv(1) = 3, 4, or 5, then it returns with -c iv(1) = 6. this test can be turned off by setting -c v(afctol) to zero. default = max(10**-20, machep**2), -c where machep is the unit roundoff. -c v(dinit).... v(38), if nonnegative, is the value to which the scale -c vector d is initialized. default = -1. -c v(lmax0).... v(35) gives the maximum 2-norm allowed for d times the -c very first step that sumsl attempts. this parameter can -c markedly affect the performance of sumsl. -c v(lmaxs).... v(36) is used in testing for singular convergence -- if -c the function reduction predicted for a step of length -c bounded by v(lmaxs) is at most v(sctol) * abs(f0), where -c f0 is the function value at the start of the current -c iteration, and if sumsl does not return with iv(1) = 3, -c 4, 5, or 6, then it returns with iv(1) = 7. default = 1. -c v(rfctol)... v(32) is the relative function convergence tolerance. -c if the current model predicts a maximum possible function -c reduction (see v(nreduc)) of at most v(rfctol)*abs(f0) -c at the start of the current iteration, where f0 is the -c then current function value, and if the last step attempt- -c ed achieved no more than twice the predicted function -c decrease, then sumsl returns with iv(1) = 4 (or 5). -c default = max(10**-10, machep**(2/3)), where machep is -c the unit roundoff. -c v(sctol).... v(37) is the singular convergence tolerance -- see the -c description of v(lmaxs) above. -c v(tuner1)... v(26) helps decide when to check for false convergence. -c this is done if the actual function decrease from the -c current step is no more than v(tuner1) times its predict- -c ed value. default = 0.1. -c v(xctol).... v(33) is the x-convergence tolerance. if a newton step -c (see v(nreduc)) is tried that has v(reldx) .le. v(xctol) -c and if this step yields at most twice the predicted func- -c tion decrease, then sumsl returns with iv(1) = 3 (or 5). -c (see the description of v(reldx) below.) -c default = machep**0.5, where machep is the unit roundoff. -c v(xftol).... v(34) is the false convergence tolerance. if a step is -c tried that gives no more than v(tuner1) times the predict- -c ed function decrease and that has v(reldx) .le. v(xftol), -c and if sumsl does not return with iv(1) = 3, 4, 5, 6, or -c 7, then it returns with iv(1) = 8. (see the description -c of v(reldx) below.) default = 100*machep, where -c machep is the unit roundoff. -c v(*)........ deflt supplies to v a number of tuning constants, with -c which it should ordinarily be unnecessary to tinker. see -c section 17 of version 2.2 of the nl2sol usage summary -c (i.e., the appendix to ref. 1) for details on v(i), -c i = decfac, incfac, phmnfc, phmxfc, rdfcmn, rdfcmx, -c tuner2, tuner3, tuner4, tuner5. -c -c *** (selected) v output values *** -c -c v(dgnorm)... v(1) is the 2-norm of (diag(d)**-1)*g, where g is the -c most recently computed gradient. -c v(dstnrm)... v(2) is the 2-norm of diag(d)*step, where step is the -c current step. -c v(f)........ v(10) is the current function value. -c v(f0)....... v(13) is the function value at the start of the current -c iteration. -c v(nreduc)... v(6), if positive, is the maximum function reduction -c possible according to the current model, i.e., the func- -c tion reduction predicted for a newton step (i.e., -c step = -h**-1 * g, where g is the current gradient and -c h is the current hessian approximation). -c if v(nreduc) is negative, then it is the negative of -c the function reduction predicted for a step computed with -c a step bound of v(lmaxs) for use in testing for singular -c convergence. -c v(preduc)... v(7) is the function reduction predicted (by the current -c quadratic model) for the current step. this (divided by -c v(f0)) is used in testing for relative function -c convergence. -c v(reldx).... v(17) is the scaled relative change in x caused by the -c current step, computed as -c max(abs(d(i)*(x(i)-x0(i)), 1 .le. i .le. p) / -c max(d(i)*(abs(x(i))+abs(x0(i))), 1 .le. i .le. p), -c where x = x0 + step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c this routine uses a hessian approximation computed from the -c bfgs update (see ref 3). only a cholesky factor of the hessian -c approximation is stored, and this is updated using ideas from -c ref. 4. steps are computed by the double dogleg scheme described -c in ref. 2. the steps are assessed as in ref. 1. -c -c *** usage notes *** -c -c after a return with iv(1) .le. 11, it is possible to restart, -c i.e., to change some of the iv and v input values described above -c and continue the algorithm from the point where it was interrupt- -c ed. iv(1) should not be changed, nor should any entries of i -c and v other than the input values (those supplied by deflt). -c those who do not wish to write a calcg which computes the -c gradient analytically should call smsno rather than sumsl. -c smsno uses finite differences to compute an approximate gradient. -c those who would prefer to provide f and g (the function and -c gradient) by reverse communication rather than by writing subrou- -c tines calcf and calcg may call on sumit directly. see the com- -c ments at the beginning of sumit. -c those who use sumsl interactively may wish to supply their -c own stopx function, which should return .true. if the break key -c has been pressed since stopx was last invoked. this makes it -c possible to externally interrupt sumsl (which will return with -c iv(1) = 11 if stopx returns .true.). -c storage for g is allocated at the end of v. thus the caller -c may make v longer than specified above and may allow calcg to use -c elements of g beyond the first n as scratch storage. -c -c *** portability notes *** -c -c the sumsl distribution tape contains both single- and double- -c precision versions of the sumsl source code, so it should be un- -c necessary to change precisions. -c only the functions imdcon and rmdcon contain machine-dependent -c constants. to change from one machine to another, it should -c suffice to change the (few) relevant lines in these functions. -c intrinsic functions are explicitly declared. on certain com- -c puters (e.g. univac), it may be necessary to comment out these -c declarations. so that this may be done automatically by a simple -c program, such declarations are preceded by a comment having c/+ -c in columns 1-3 and blanks in columns 4-72 and are followed by -c a comment having c/ in columns 1 and 2 and blanks in columns 3-72. -c the sumsl source code is expressed in 1966 ansi standard -c fortran. it may be converted to fortran 77 by commenting out all -c lines that fall between a line having c/6 in columns 1-3 and a -c line having c/7 in columns 1-3 and by removing (i.e., replacing -c by a blank) the c in column 1 of the lines that follow the c/7 -c line and precede a line having c/ in columns 1-2 and blanks in -c columns 3-72. these changes convert some data statements into -c parameter statements, convert some variables from real to -c character*4, and make the data statements that initialize these -c variables use character strings delimited by primes instead -c of hollerith constants. (such variables and data statements -c appear only in modules itsum and parck. parameter statements -c appear nearly everywhere.) these changes also add save state- -c ments for variables given machine-dependent constants by rmdcon. -c -c *** references *** -c -c 1. dennis, j.e., gay, d.m., and welsch, r.e. (1981), algorithm 573 -- -c an adaptive nonlinear least-squares algorithm, acm trans. -c math. software 7, pp. 369-383. -c -c 2. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c -c 3. dennis, j.e., and more, j.j. (1977), quasi-newton methods, motiva- -c tion and theory, siam rev. 19, pp. 46-89. -c -c 4. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (winter 1980). revised summer 1982. -c this subroutine was written in connection with research -c supported in part by the national science foundation under -c grants mcs-7600324, dcr75-10143, 76-14311dss, mcs76-11989, -c and mcs-7906671. -c. -c -c---------------------------- declarations --------------------------- -c - external deflt, sumit -c -c deflt... supplies default iv and v input components. -c sumit... reverse-communication routine that carries out sumsl algo- -c rithm. -c - integer g1, iv1, nf - double precision f -c -c *** subscripts for iv *** -c - integer nextv, nfcall, nfgcal, g, toobig, vneed -c -c/6 -c data nextv/47/, nfcall/6/, nfgcal/7/, g/28/, toobig/2/, vneed/4/ -c/7 - parameter (nextv=47, nfcall=6, nfgcal=7, g=28, toobig=2, vneed=4) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - iv1 = iv(1) - if (iv1 .eq. 12 .or. iv1 .eq. 13) iv(vneed) = iv(vneed) + n - if (iv1 .eq. 14) go to 10 - if (iv1 .gt. 2 .and. iv1 .lt. 12) go to 10 - g1 = 1 - if (iv1 .eq. 12) iv(1) = 13 - go to 20 -c - 10 g1 = iv(g) -c - 20 call sumit(d, f, v(g1), iv, liv, lv, n, v, x) - if (iv(1) - 2) 30, 40, 50 -c - 30 nf = iv(nfcall) - call calcf(n, x, nf, f, uiparm, urparm, ufparm) - if (nf .le. 0) iv(toobig) = 1 - go to 20 -c - 40 call calcg(n, x, iv(nfgcal), v(g1), uiparm, urparm, ufparm) - go to 20 -c - 50 if (iv(1) .ne. 14) go to 999 -c -c *** storage allocation -c - iv(g) = iv(nextv) - iv(nextv) = iv(g) + n - if (iv1 .ne. 13) go to 10 -c - 999 return -c *** last card of sumsl follows *** - end - subroutine sumit(d, fx, g, iv, liv, lv, n, v, x) -c -c *** carry out sumsl (unconstrained minimization) iterations, using -c *** double-dogleg/bfgs steps. -c -c *** parameter declarations *** -c - integer liv, lv, n - integer iv(liv) - double precision d(n), fx, g(n), v(lv), x(n) -c -c-------------------------- parameter usage -------------------------- -c -c d.... scale vector. -c fx... function value. -c g.... gradient vector. -c iv... integer value array. -c liv.. length of iv (at least 60). -c lv... length of v (at least 71 + n*(n+13)/2). -c n.... number of variables (components in x and g). -c v.... floating-point value array. -c x.... vector of parameters to be optimized. -c -c *** discussion *** -c -c parameters iv, n, v, and x are the same as the corresponding -c ones to sumsl (which see), except that v can be shorter (since -c the part of v that sumsl uses for storing g is not needed). -c moreover, compared with sumsl, iv(1) may have the two additional -c output values 1 and 2, which are explained below, as is the use -c of iv(toobig) and iv(nfgcal). the value iv(g), which is an -c output value from sumsl (and smsno), is not referenced by -c sumit or the subroutines it calls. -c fx and g need not have been initialized when sumit is called -c with iv(1) = 12, 13, or 14. -c -c iv(1) = 1 means the caller should set fx to f(x), the function value -c at x, and call sumit again, having changed none of the -c other parameters. an exception occurs if f(x) cannot be -c (e.g. if overflow would occur), which may happen because -c of an oversized step. in this case the caller should set -c iv(toobig) = iv(2) to 1, which will cause sumit to ig- -c nore fx and try a smaller step. the parameter nf that -c sumsl passes to calcf (for possible use by calcg) is a -c copy of iv(nfcall) = iv(6). -c iv(1) = 2 means the caller should set g to g(x), the gradient vector -c of f at x, and call sumit again, having changed none of -c the other parameters except possibly the scale vector d -c when iv(dtype) = 0. the parameter nf that sumsl passes -c to calcg is iv(nfgcal) = iv(7). if g(x) cannot be -c evaluated, then the caller may set iv(nfgcal) to 0, in -c which case sumit will return with iv(1) = 65. -c. -c *** general *** -c -c coded by david m. gay (december 1979). revised sept. 1982. -c this subroutine was written in connection with research supported -c in part by the national science foundation under grants -c mcs-7600324 and mcs-7906671. -c -c (see sumsl for references.) -c -c+++++++++++++++++++++++++++ declarations ++++++++++++++++++++++++++++ -c -c *** local variables *** -c - integer dg1, dummy, g01, i, k, l, lstgst, nwtst1, step1, - 1 temp1, w, x01, z - double precision t -c -c *** constants *** -c - double precision half, negone, one, onep2, zero -c -c *** no intrinsic functions *** -c -c *** external functions and subroutines *** -c - external assst, dbdog, deflt, dotprd, itsum, litvmu, livmul, - 1 ltvmul, lupdat, lvmul, parck, reldst, stopx, vaxpy, - 2 vcopy, vscopy, vvmulp, v2norm, wzbfgs - logical stopx - double precision dotprd, reldst, v2norm -c -c assst.... assesses candidate step. -c dbdog.... computes double-dogleg (candidate) step. -c deflt.... supplies default iv and v input components. -c dotprd... returns inner product of two vectors. -c itsum.... prints iteration summary and info on initial and final x. -c litvmu... multiplies inverse transpose of lower triangle times vector. -c livmul... multiplies inverse of lower triangle times vector. -c ltvmul... multiplies transpose of lower triangle times vector. -c lupdt.... updates cholesky factor of hessian approximation. -c lvmul.... multiplies lower triangle times vector. -c parck.... checks validity of input iv and v values. -c reldst... computes v(reldx) = relative step size. -c stopx.... returns .true. if the break key has been pressed. -c vaxpy.... computes scalar times one vector plus another. -c vcopy.... copies one vector to another. -c vscopy... sets all elements of a vector to a scalar. -c vvmulp... multiplies vector by vector raised to power (componentwise). -c v2norm... returns the 2-norm of a vector. -c wzbfgs... computes w and z for lupdat corresponding to bfgs update. -c -c *** subscripts for iv and v *** -c - integer afctol - integer cnvcod, dg, dgnorm, dinit, dstnrm, dst0, f, f0, fdif, - 1 gthg, gtstep, g0, incfac, inith, irc, kagqt, lmat, lmax0, - 2 lmaxs, mode, model, mxfcal, mxiter, nextv, nfcall, nfgcal, - 3 ngcall, niter, nreduc, nwtstp, preduc, radfac, radinc, - 4 radius, rad0, reldx, restor, step, stglim, stlstg, toobig, - 5 tuner4, tuner5, vneed, xirc, x0 -c -c *** iv subscript values *** -c -c/6 -c data cnvcod/55/, dg/37/, g0/48/, inith/25/, irc/29/, kagqt/33/, -c 1 mode/35/, model/5/, mxfcal/17/, mxiter/18/, nfcall/6/, -c 2 nfgcal/7/, ngcall/30/, niter/31/, nwtstp/34/, radinc/8/, -c 3 restor/9/, step/40/, stglim/11/, stlstg/41/, toobig/2/, -c 4 vneed/4/, xirc/13/, x0/43/ -c/7 - parameter (cnvcod=55, dg=37, g0=48, inith=25, irc=29, kagqt=33, - 1 mode=35, model=5, mxfcal=17, mxiter=18, nfcall=6, - 2 nfgcal=7, ngcall=30, niter=31, nwtstp=34, radinc=8, - 3 restor=9, step=40, stglim=11, stlstg=41, toobig=2, - 4 vneed=4, xirc=13, x0=43) -c/ -c -c *** v subscript values *** -c -c/6 -c data afctol/31/ -c data dgnorm/1/, dinit/38/, dstnrm/2/, dst0/3/, f/10/, f0/13/, -c 1 fdif/11/, gthg/44/, gtstep/4/, incfac/23/, lmat/42/, -c 2 lmax0/35/, lmaxs/36/, nextv/47/, nreduc/6/, preduc/7/, -c 3 radfac/16/, radius/8/, rad0/9/, reldx/17/, tuner4/29/, -c 4 tuner5/30/ -c/7 - parameter (afctol=31) - parameter (dgnorm=1, dinit=38, dstnrm=2, dst0=3, f=10, f0=13, - 1 fdif=11, gthg=44, gtstep=4, incfac=23, lmat=42, - 2 lmax0=35, lmaxs=36, nextv=47, nreduc=6, preduc=7, - 3 radfac=16, radius=8, rad0=9, reldx=17, tuner4=29, - 4 tuner5=30) -c/ -c -c/6 -c data half/0.5d+0/, negone/-1.d+0/, one/1.d+0/, onep2/1.2d+0/, -c 1 zero/0.d+0/ -c/7 - parameter (half=0.5d+0, negone=-1.d+0, one=1.d+0, onep2=1.2d+0, - 1 zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c -C Following SAVE statement inserted. - save l - i = iv(1) - if (i .eq. 1) go to 50 - if (i .eq. 2) go to 60 -c -c *** check validity of iv and v input values *** -c - if (iv(1) .eq. 0) call deflt(2, iv, liv, lv, v) - if (iv(1) .eq. 12 .or. iv(1) .eq. 13) - 1 iv(vneed) = iv(vneed) + n*(n+13)/2 - call parck(2, d, iv, liv, lv, n, v) - i = iv(1) - 2 - if (i .gt. 12) go to 999 - go to (180, 180, 180, 180, 180, 180, 120, 90, 120, 10, 10, 20), i -c -c *** storage allocation *** -c -10 l = iv(lmat) - iv(x0) = l + n*(n+1)/2 - iv(step) = iv(x0) + n - iv(stlstg) = iv(step) + n - iv(g0) = iv(stlstg) + n - iv(nwtstp) = iv(g0) + n - iv(dg) = iv(nwtstp) + n - iv(nextv) = iv(dg) + n - if (iv(1) .ne. 13) go to 20 - iv(1) = 14 - go to 999 -c -c *** initialization *** -c - 20 iv(niter) = 0 - iv(nfcall) = 1 - iv(ngcall) = 1 - iv(nfgcal) = 1 - iv(mode) = -1 - iv(model) = 1 - iv(stglim) = 1 - iv(toobig) = 0 - iv(cnvcod) = 0 - iv(radinc) = 0 - v(rad0) = zero - if (v(dinit) .ge. zero) call vscopy(n, d, v(dinit)) - if (iv(inith) .ne. 1) go to 40 -c -c *** set the initial hessian approximation to diag(d)**-2 *** -c - l = iv(lmat) - call vscopy(n*(n+1)/2, v(l), zero) - k = l - 1 - do 30 i = 1, n - k = k + i - t = d(i) - if (t .le. zero) t = one - v(k) = t - 30 continue -c -c *** compute initial function value *** -c - 40 iv(1) = 1 - go to 999 -c - 50 v(f) = fx - if (iv(mode) .ge. 0) go to 180 - iv(1) = 2 - if (iv(toobig) .eq. 0) go to 999 - iv(1) = 63 - go to 300 -c -c *** make sure gradient could be computed *** -c - 60 if (iv(nfgcal) .ne. 0) go to 70 - iv(1) = 65 - go to 300 -c - 70 dg1 = iv(dg) - call vvmulp(n, v(dg1), g, d, -1) - v(dgnorm) = v2norm(n, v(dg1)) -c -c *** test norm of gradient *** -c - if (v(dgnorm) .gt. v(afctol)) go to 75 - iv(irc) = 10 - iv(cnvcod) = iv(irc) - 4 -c - 75 if (iv(cnvcod) .ne. 0) go to 290 - if (iv(mode) .eq. 0) go to 250 -c -c *** allow first step to have scaled 2-norm at most v(lmax0) *** -c - v(radius) = v(lmax0) -c - iv(mode) = 0 -c -c -c----------------------------- main loop ----------------------------- -c -c -c *** print iteration summary, check iteration limit *** -c - 80 call itsum(d, g, iv, liv, lv, n, v, x) - 90 k = iv(niter) - if (k .lt. iv(mxiter)) go to 100 - iv(1) = 10 - go to 300 -c -c *** update radius *** -c - 100 iv(niter) = k + 1 - if(k.gt.0)v(radius) = v(radfac) * v(dstnrm) -c -c *** initialize for start of next iteration *** -c - g01 = iv(g0) - x01 = iv(x0) - v(f0) = v(f) - iv(irc) = 4 - iv(kagqt) = -1 -c -c *** copy x to x0, g to g0 *** -c - call vcopy(n, v(x01), x) - call vcopy(n, v(g01), g) -c -c *** check stopx and function evaluation limit *** -c -C AL 4/30/95 - dummy=iv(nfcall) - 110 if (.not. stopx(dummy)) go to 130 - iv(1) = 11 - go to 140 -c -c *** come here when restarting after func. eval. limit or stopx. -c - 120 if (v(f) .ge. v(f0)) go to 130 - v(radfac) = one - k = iv(niter) - go to 100 -c - 130 if (iv(nfcall) .lt. iv(mxfcal)) go to 150 - iv(1) = 9 - 140 if (v(f) .ge. v(f0)) go to 300 -c -c *** in case of stopx or function evaluation limit with -c *** improved v(f), evaluate the gradient at x. -c - iv(cnvcod) = iv(1) - go to 240 -c -c. . . . . . . . . . . . . compute candidate step . . . . . . . . . . -c - 150 step1 = iv(step) - dg1 = iv(dg) - nwtst1 = iv(nwtstp) - if (iv(kagqt) .ge. 0) go to 160 - l = iv(lmat) - call livmul(n, v(nwtst1), v(l), g) - v(nreduc) = half * dotprd(n, v(nwtst1), v(nwtst1)) - call litvmu(n, v(nwtst1), v(l), v(nwtst1)) - call vvmulp(n, v(step1), v(nwtst1), d, 1) - v(dst0) = v2norm(n, v(step1)) - call vvmulp(n, v(dg1), v(dg1), d, -1) - call ltvmul(n, v(step1), v(l), v(dg1)) - v(gthg) = v2norm(n, v(step1)) - iv(kagqt) = 0 - 160 call dbdog(v(dg1), lv, n, v(nwtst1), v(step1), v) - if (iv(irc) .eq. 6) go to 180 -c -c *** check whether evaluating f(x0 + step) looks worthwhile *** -c - if (v(dstnrm) .le. zero) go to 180 - if (iv(irc) .ne. 5) go to 170 - if (v(radfac) .le. one) go to 170 - if (v(preduc) .le. onep2 * v(fdif)) go to 180 -c -c *** compute f(x0 + step) *** -c - 170 x01 = iv(x0) - step1 = iv(step) - call vaxpy(n, x, one, v(step1), v(x01)) - iv(nfcall) = iv(nfcall) + 1 - iv(1) = 1 - iv(toobig) = 0 - go to 999 -c -c. . . . . . . . . . . . . assess candidate step . . . . . . . . . . . -c - 180 x01 = iv(x0) - v(reldx) = reldst(n, d, x, v(x01)) - call assst(iv, liv, lv, v) - step1 = iv(step) - lstgst = iv(stlstg) - if (iv(restor) .eq. 1) call vcopy(n, x, v(x01)) - if (iv(restor) .eq. 2) call vcopy(n, v(lstgst), v(step1)) - if (iv(restor) .ne. 3) go to 190 - call vcopy(n, v(step1), v(lstgst)) - call vaxpy(n, x, one, v(step1), v(x01)) - v(reldx) = reldst(n, d, x, v(x01)) -c - 190 k = iv(irc) - go to (200,230,230,230,200,210,220,220,220,220,220,220,280,250), k -c -c *** recompute step with changed radius *** -c - 200 v(radius) = v(radfac) * v(dstnrm) - go to 110 -c -c *** compute step of length v(lmaxs) for singular convergence test. -c - 210 v(radius) = v(lmaxs) - go to 150 -c -c *** convergence or false convergence *** -c - 220 iv(cnvcod) = k - 4 - if (v(f) .ge. v(f0)) go to 290 - if (iv(xirc) .eq. 14) go to 290 - iv(xirc) = 14 -c -c. . . . . . . . . . . . process acceptable step . . . . . . . . . . . -c - 230 if (iv(irc) .ne. 3) go to 240 - step1 = iv(step) - temp1 = iv(stlstg) -c -c *** set temp1 = hessian * step for use in gradient tests *** -c - l = iv(lmat) - call ltvmul(n, v(temp1), v(l), v(step1)) - call lvmul(n, v(temp1), v(l), v(temp1)) -c -c *** compute gradient *** -c - 240 iv(ngcall) = iv(ngcall) + 1 - iv(1) = 2 - go to 999 -c -c *** initializations -- g0 = g - g0, etc. *** -c - 250 g01 = iv(g0) - call vaxpy(n, v(g01), negone, v(g01), g) - step1 = iv(step) - temp1 = iv(stlstg) - if (iv(irc) .ne. 3) go to 270 -c -c *** set v(radfac) by gradient tests *** -c -c *** set temp1 = diag(d)**-1 * (hessian*step + (g(x0)-g(x))) *** -c - call vaxpy(n, v(temp1), negone, v(g01), v(temp1)) - call vvmulp(n, v(temp1), v(temp1), d, -1) -c -c *** do gradient tests *** -c - if (v2norm(n, v(temp1)) .le. v(dgnorm) * v(tuner4)) - 1 go to 260 - if (dotprd(n, g, v(step1)) - 1 .ge. v(gtstep) * v(tuner5)) go to 270 - 260 v(radfac) = v(incfac) -c -c *** update h, loop *** -c - 270 w = iv(nwtstp) - z = iv(x0) - l = iv(lmat) - call wzbfgs(v(l), n, v(step1), v(w), v(g01), v(z)) -c -c ** use the n-vectors starting at v(step1) and v(g01) for scratch.. - call lupdat(v(temp1), v(step1), v(l), v(g01), v(l), n, v(w), v(z)) - iv(1) = 2 - go to 80 -c -c. . . . . . . . . . . . . . misc. details . . . . . . . . . . . . . . -c -c *** bad parameters to assess *** -c - 280 iv(1) = 64 - go to 300 -c -c *** print summary of final iteration and other requested items *** -c - 290 iv(1) = iv(cnvcod) - iv(cnvcod) = 0 - 300 call itsum(d, g, iv, liv, lv, n, v, x) -c - 999 return -c -c *** last line of sumit follows *** - end - subroutine dbdog(dig, lv, n, nwtstp, step, v) -c -c *** compute double dogleg step *** -c -c *** parameter declarations *** -c - integer lv, n - double precision dig(n), nwtstp(n), step(n), v(lv) -c -c *** purpose *** -c -c this subroutine computes a candidate step (for use in an uncon- -c strained minimization code) by the double dogleg algorithm of -c dennis and mei (ref. 1), which is a variation on powell*s dogleg -c scheme (ref. 2, p. 95). -c -c-------------------------- parameter usage -------------------------- -c -c dig (input) diag(d)**-2 * g -- see algorithm notes. -c g (input) the current gradient vector. -c lv (input) length of v. -c n (input) number of components in dig, g, nwtstp, and step. -c nwtstp (input) negative newton step -- see algorithm notes. -c step (output) the computed step. -c v (i/o) values array, the following components of which are -c used here... -c v(bias) (input) bias for relaxed newton step, which is v(bias) of -c the way from the full newton to the fully relaxed newton -c step. recommended value = 0.8 . -c v(dgnorm) (input) 2-norm of diag(d)**-1 * g -- see algorithm notes. -c v(dstnrm) (output) 2-norm of diag(d) * step, which is v(radius) -c unless v(stppar) = 0 -- see algorithm notes. -c v(dst0) (input) 2-norm of diag(d) * nwtstp -- see algorithm notes. -c v(grdfac) (output) the coefficient of dig in the step returned -- -c step(i) = v(grdfac)*dig(i) + v(nwtfac)*nwtstp(i). -c v(gthg) (input) square-root of (dig**t) * (hessian) * dig -- see -c algorithm notes. -c v(gtstep) (output) inner product between g and step. -c v(nreduc) (output) function reduction predicted for the full newton -c step. -c v(nwtfac) (output) the coefficient of nwtstp in the step returned -- -c see v(grdfac) above. -c v(preduc) (output) function reduction predicted for the step returned. -c v(radius) (input) the trust region radius. d times the step returned -c has 2-norm v(radius) unless v(stppar) = 0. -c v(stppar) (output) code telling how step was computed... 0 means a -c full newton step. between 0 and 1 means v(stppar) of the -c way from the newton to the relaxed newton step. between -c 1 and 2 means a true double dogleg step, v(stppar) - 1 of -c the way from the relaxed newton to the cauchy step. -c greater than 2 means 1 / (v(stppar) - 1) times the cauchy -c step. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c let g and h be the current gradient and hessian approxima- -c tion respectively and let d be the current scale vector. this -c routine assumes dig = diag(d)**-2 * g and nwtstp = h**-1 * g. -c the step computed is the same one would get by replacing g and h -c by diag(d)**-1 * g and diag(d)**-1 * h * diag(d)**-1, -c computing step, and translating step back to the original -c variables, i.e., premultiplying it by diag(d)**-1. -c -c *** references *** -c -c 1. dennis, j.e., and mei, h.h.w. (1979), two new unconstrained opti- -c mization algorithms which use function and gradient -c values, j. optim. theory applic. 28, pp. 453-482. -c 2. powell, m.j.d. (1970), a hybrid method for non-linear equations, -c in numerical methods for non-linear equations, edited by -c p. rabinowitz, gordon and breach, london. -c -c *** general *** -c -c coded by david m. gay. -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, v2norm - double precision dotprd, v2norm -c -c dotprd... returns inner product of two vectors. -c v2norm... returns 2-norm of a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cfact, cnorm, ctrnwt, ghinvg, femnsq, gnorm, - 1 nwtnrm, relax, rlambd, t, t1, t2 - double precision half, one, two, zero -c -c *** v subscripts *** -c - integer bias, dgnorm, dstnrm, dst0, grdfac, gthg, gtstep, - 1 nreduc, nwtfac, preduc, radius, stppar -c -c *** data initializations *** -c -c/6 -c data half/0.5d+0/, one/1.d+0/, two/2.d+0/, zero/0.d+0/ -c/7 - parameter (half=0.5d+0, one=1.d+0, two=2.d+0, zero=0.d+0) -c/ -c -c/6 -c data bias/43/, dgnorm/1/, dstnrm/2/, dst0/3/, grdfac/45/, -c 1 gthg/44/, gtstep/4/, nreduc/6/, nwtfac/46/, preduc/7/, -c 2 radius/8/, stppar/5/ -c/7 - parameter (bias=43, dgnorm=1, dstnrm=2, dst0=3, grdfac=45, - 1 gthg=44, gtstep=4, nreduc=6, nwtfac=46, preduc=7, - 2 radius=8, stppar=5) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nwtnrm = v(dst0) - rlambd = one - if (nwtnrm .gt. zero) rlambd = v(radius) / nwtnrm - gnorm = v(dgnorm) - ghinvg = two * v(nreduc) - v(grdfac) = zero - v(nwtfac) = zero - if (rlambd .lt. one) go to 30 -c -c *** the newton step is inside the trust region *** -c - v(stppar) = zero - v(dstnrm) = nwtnrm - v(gtstep) = -ghinvg - v(preduc) = v(nreduc) - v(nwtfac) = -one - do 20 i = 1, n - 20 step(i) = -nwtstp(i) - go to 999 -c - 30 v(dstnrm) = v(radius) - cfact = (gnorm / v(gthg))**2 -c *** cauchy step = -cfact * g. - cnorm = gnorm * cfact - relax = one - v(bias) * (one - gnorm*cnorm/ghinvg) - if (rlambd .lt. relax) go to 50 -c -c *** step is between relaxed newton and full newton steps *** -c - v(stppar) = one - (rlambd - relax) / (one - relax) - t = -rlambd - v(gtstep) = t * ghinvg - v(preduc) = rlambd * (one - half*rlambd) * ghinvg - v(nwtfac) = t - do 40 i = 1, n - 40 step(i) = t * nwtstp(i) - go to 999 -c - 50 if (cnorm .lt. v(radius)) go to 70 -c -c *** the cauchy step lies outside the trust region -- -c *** step = scaled cauchy step *** -c - t = -v(radius) / gnorm - v(grdfac) = t - v(stppar) = one + cnorm / v(radius) - v(gtstep) = -v(radius) * gnorm - v(preduc) = v(radius)*(gnorm - half*v(radius)*(v(gthg)/gnorm)**2) - do 60 i = 1, n - 60 step(i) = t * dig(i) - go to 999 -c -c *** compute dogleg step between cauchy and relaxed newton *** -c *** femur = relaxed newton step minus cauchy step *** -c - 70 ctrnwt = cfact * relax * ghinvg / gnorm -c *** ctrnwt = inner prod. of cauchy and relaxed newton steps, -c *** scaled by gnorm**-1. - t1 = ctrnwt - gnorm*cfact**2 -c *** t1 = inner prod. of femur and cauchy step, scaled by -c *** gnorm**-1. - t2 = v(radius)*(v(radius)/gnorm) - gnorm*cfact**2 - t = relax * nwtnrm - femnsq = (t/gnorm)*t - ctrnwt - t1 -c *** femnsq = square of 2-norm of femur, scaled by gnorm**-1. - t = t2 / (t1 + dsqrt(t1**2 + femnsq*t2)) -c *** dogleg step = cauchy step + t * femur. - t1 = (t - one) * cfact - v(grdfac) = t1 - t2 = -t * relax - v(nwtfac) = t2 - v(stppar) = two - t - v(gtstep) = t1*gnorm**2 + t2*ghinvg - v(preduc) = -t1*gnorm * ((t2 + one)*gnorm) - 1 - t2 * (one + half*t2)*ghinvg - 2 - half * (v(gthg)*t1)**2 - do 80 i = 1, n - 80 step(i) = t1*dig(i) + t2*nwtstp(i) -c - 999 return -c *** last line of dbdog follows *** - end - subroutine ltvmul(n, x, l, y) -c -c *** compute x = (l**t)*y, where l is an n x n lower -c *** triangular matrix stored compactly by rows. x and y may -c *** occupy the same storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ij, i0, j - double precision yi, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - i0 = 0 - do 20 i = 1, n - yi = y(i) - x(i) = zero - do 10 j = 1, i - ij = i0 + j - x(j) = x(j) + yi*l(ij) - 10 continue - i0 = i0 + i - 20 continue - 999 return -c *** last card of ltvmul follows *** - end - subroutine lupdat(beta, gamma, l, lambda, lplus, n, w, z) -c -c *** compute lplus = secant update of l *** -c -c *** parameter declarations *** -c - integer n -cal double precision beta(n), gamma(n), l(1), lambda(n), lplus(1), - double precision beta(n), gamma(n), l(n*(n+1)/2), lambda(n), - 1 lplus(n*(n+1)/2),w(n), z(n) -c dimension l(n*(n+1)/2), lplus(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c beta = scratch vector. -c gamma = scratch vector. -c l (input) lower triangular matrix, stored rowwise. -c lambda = scratch vector. -c lplus (output) lower triangular matrix, stored rowwise, which may -c occupy the same storage as l. -c n (input) length of vector parameters and order of matrices. -c w (input, destroyed on output) right singular vector of rank 1 -c correction to l. -c z (input, destroyed on output) left singular vector of rank 1 -c correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** application and usage restrictions *** -c -c this routine updates the cholesky factor l of a symmetric -c positive definite matrix to which a secant update is being -c applied -- it computes a cholesky factor lplus of -c l * (i + z*w**t) * (i + w*z**t) * l**t. it is assumed that w -c and z have been chosen so that the updated matrix is strictly -c positive definite. -c -c *** algorithm notes *** -c -c this code uses recurrence 3 of ref. 1 (with d(j) = 1 for all j) -c to compute lplus of the form l * (i + z*w**t) * q, where q -c is an orthogonal matrix that makes the result lower triangular. -c lplus may have some negative diagonal elements. -c -c *** references *** -c -c 1. goldfarb, d. (1976), factorized variable metric methods for uncon- -c strained optimization, math. comput. 30, pp. 796-811. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i, ij, j, jj, jp1, k, nm1, np1 - double precision a, b, bj, eta, gj, lj, lij, ljj, nu, s, theta, - 1 wj, zj - double precision one, zero -c -c *** data initializations *** -c -c/6 -c data one/1.d+0/, zero/0.d+0/ -c/7 - parameter (one=1.d+0, zero=0.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - nu = one - eta = zero - if (n .le. 1) go to 30 - nm1 = n - 1 -c -c *** temporarily store s(j) = sum over k = j+1 to n of w(k)**2 in -c *** lambda(j). -c - s = zero - do 10 i = 1, nm1 - j = n - i - s = s + w(j+1)**2 - lambda(j) = s - 10 continue -c -c *** compute lambda, gamma, and beta by goldfarb*s recurrence 3. -c - do 20 j = 1, nm1 - wj = w(j) - a = nu*z(j) - eta*wj - theta = one + a*wj - s = a*lambda(j) - lj = dsqrt(theta**2 + a*s) - if (theta .gt. zero) lj = -lj - lambda(j) = lj - b = theta*wj + s - gamma(j) = b * nu / lj - beta(j) = (a - b*eta) / lj - nu = -nu / lj - eta = -(eta + (a**2)/(theta - lj)) / lj - 20 continue - 30 lambda(n) = one + (nu*z(n) - eta*w(n))*w(n) -c -c *** update l, gradually overwriting w and z with l*w and l*z. -c - np1 = n + 1 - jj = n * (n + 1) / 2 - do 60 k = 1, n - j = np1 - k - lj = lambda(j) - ljj = l(jj) - lplus(jj) = lj * ljj - wj = w(j) - w(j) = ljj * wj - zj = z(j) - z(j) = ljj * zj - if (k .eq. 1) go to 50 - bj = beta(j) - gj = gamma(j) - ij = jj + j - jp1 = j + 1 - do 40 i = jp1, n - lij = l(ij) - lplus(ij) = lj*lij + bj*w(i) + gj*z(i) - w(i) = w(i) + lij*wj - z(i) = z(i) + lij*zj - ij = ij + i - 40 continue - 50 jj = jj - j - 60 continue -c - 999 return -c *** last card of lupdat follows *** - end - subroutine lvmul(n, x, l, y) -c -c *** compute x = l*y, where l is an n x n lower triangular -c *** matrix stored compactly by rows. x and y may occupy the same -c *** storage. *** -c - integer n -cal double precision x(n), l(1), y(n) - double precision x(n), l(n*(n+1)/2), y(n) -c dimension l(n*(n+1)/2) - integer i, ii, ij, i0, j, np1 - double precision t, zero -c/6 -c data zero/0.d+0/ -c/7 - parameter (zero=0.d+0) -c/ -c - np1 = n + 1 - i0 = n*(n+1)/2 - do 20 ii = 1, n - i = np1 - ii - i0 = i0 - i - t = zero - do 10 j = 1, i - ij = i0 + j - t = t + l(ij)*y(j) - 10 continue - x(i) = t - 20 continue - 999 return -c *** last card of lvmul follows *** - end - subroutine vvmulp(n, x, y, z, k) -c -c *** set x(i) = y(i) * z(i)**k, 1 .le. i .le. n (for k = 1 or -1) *** -c - integer n, k - double precision x(n), y(n), z(n) - integer i -c - if (k .ge. 0) go to 20 - do 10 i = 1, n - 10 x(i) = y(i) / z(i) - go to 999 -c - 20 do 30 i = 1, n - 30 x(i) = y(i) * z(i) - 999 return -c *** last card of vvmulp follows *** - end - subroutine wzbfgs (l, n, s, w, y, z) -c -c *** compute y and z for lupdat corresponding to bfgs update. -c - integer n -cal double precision l(1), s(n), w(n), y(n), z(n) - double precision l(n*(n+1)/2), s(n), w(n), y(n), z(n) -c dimension l(n*(n+1)/2) -c -c-------------------------- parameter usage -------------------------- -c -c l (i/o) cholesky factor of hessian, a lower triang. matrix stored -c compactly by rows. -c n (input) order of l and length of s, w, y, z. -c s (input) the step just taken. -c w (output) right singular vector of rank 1 correction to l. -c y (input) change in gradients corresponding to s. -c z (output) left singular vector of rank 1 correction to l. -c -c------------------------------- notes ------------------------------- -c -c *** algorithm notes *** -c -c when s is computed in certain ways, e.g. by gqtstp or -c dbldog, it is possible to save n**2/2 operations since (l**t)*s -c or l*(l**t)*s is then known. -c if the bfgs update to l*(l**t) would reduce its determinant to -c less than eps times its old value, then this routine in effect -c replaces y by theta*y + (1 - theta)*l*(l**t)*s, where theta -c (between 0 and 1) is chosen to make the reduction factor = eps. -c -c *** general *** -c -c coded by david m. gay (fall 1979). -c this subroutine was written in connection with research supported -c by the national science foundation under grants mcs-7600324 and -c mcs-7906671. -c -c------------------------ external quantities ------------------------ -c -c *** functions and subroutines called *** -c - external dotprd, livmul, ltvmul - double precision dotprd -c dotprd returns inner product of two vectors. -c livmul multiplies l**-1 times a vector. -c ltvmul multiplies l**t times a vector. -c -c *** intrinsic functions *** -c/+ - double precision dsqrt -c/ -c-------------------------- local variables -------------------------- -c - integer i - double precision cs, cy, eps, epsrt, one, shs, ys, theta -c -c *** data initializations *** -c -c/6 -c data eps/0.1d+0/, one/1.d+0/ -c/7 - parameter (eps=0.1d+0, one=1.d+0) -c/ -c -c+++++++++++++++++++++++++++++++ body ++++++++++++++++++++++++++++++++ -c - call ltvmul(n, w, l, s) - shs = dotprd(n, w, w) - ys = dotprd(n, y, s) - if (ys .ge. eps*shs) go to 10 - theta = (one - eps) * shs / (shs - ys) - epsrt = dsqrt(eps) - cy = theta / (shs * epsrt) - cs = (one + (theta-one)/epsrt) / shs - go to 20 - 10 cy = one / (dsqrt(ys) * dsqrt(shs)) - cs = one / shs - 20 call livmul(n, z, l, y) - do 30 i = 1, n - 30 z(i) = cy * z(i) - cs * w(i) -c - 999 return -c *** last card of wzbfgs follows *** - end diff --git a/source/unres/src_MD-restraints/surfatom.f b/source/unres/src_MD-restraints/surfatom.f deleted file mode 100644 index 9974842..0000000 --- a/source/unres/src_MD-restraints/surfatom.f +++ /dev/null @@ -1,494 +0,0 @@ -c -c -c ################################################### -c ## COPYRIGHT (C) 1996 by Jay William Ponder ## -c ## All Rights Reserved ## -c ################################################### -c -c ################################################################ -c ## ## -c ## subroutine surfatom -- exposed surface area of an atom ## -c ## ## -c ################################################################ -c -c -c "surfatom" performs an analytical computation of the surface -c area of a specified atom; a simplified version of "surface" -c -c literature references: -c -c T. J. Richmond, "Solvent Accessible Surface Area and -c Excluded Volume in Proteins", Journal of Molecular Biology, -c 178, 63-89 (1984) -c -c L. Wesson and D. Eisenberg, "Atomic Solvation Parameters -c Applied to Molecular Dynamics of Proteins in Solution", -c Protein Science, 1, 227-235 (1992) -c -c variables and parameters: -c -c ir number of atom for which area is desired -c area accessible surface area of the atom -c radius radii of each of the individual atoms -c -c - subroutine surfatom (ir,area,radius) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'sizes.i' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - integer nres,nsup,nstart_sup - double precision c,dc,dc_old,d_c_work,xloc,xrot,dc_norm - common /chain/ c(3,maxres2+2),dc(3,0:maxres2),dc_old(3,0:maxres2), - & xloc(3,maxres),xrot(3,maxres),dc_norm(3,0:maxres2), - & dc_work(MAXRES6),nres,nres0 - integer maxarc - parameter (maxarc=300) - integer i,j,k,m - integer ii,ib,jb - integer io,ir - integer mi,ni,narc - integer key(maxarc) - integer intag(maxarc) - integer intag1(maxarc) - real*8 area,arcsum - real*8 arclen,exang - real*8 delta,delta2 - real*8 eps,rmove - real*8 xr,yr,zr - real*8 rr,rrsq - real*8 rplus,rminus - real*8 axx,axy,axz - real*8 ayx,ayy - real*8 azx,azy,azz - real*8 uxj,uyj,uzj - real*8 tx,ty,tz - real*8 txb,tyb,td - real*8 tr2,tr,txr,tyr - real*8 tk1,tk2 - real*8 thec,the,t,tb - real*8 txk,tyk,tzk - real*8 t1,ti,tf,tt - real*8 txj,tyj,tzj - real*8 ccsq,cc,xysq - real*8 bsqk,bk,cosine - real*8 dsqj,gi,pix2 - real*8 therk,dk,gk - real*8 risqk,rik - real*8 radius(maxatm) - real*8 ri(maxarc),risq(maxarc) - real*8 ux(maxarc),uy(maxarc),uz(maxarc) - real*8 xc(maxarc),yc(maxarc),zc(maxarc) - real*8 xc1(maxarc),yc1(maxarc),zc1(maxarc) - real*8 dsq(maxarc),bsq(maxarc) - real*8 dsq1(maxarc),bsq1(maxarc) - real*8 arci(maxarc),arcf(maxarc) - real*8 ex(maxarc),lt(maxarc),gr(maxarc) - real*8 b(maxarc),b1(maxarc),bg(maxarc) - real*8 kent(maxarc),kout(maxarc) - real*8 ther(maxarc) - logical moved,top - logical omit(maxarc) -c -c -c zero out the surface area for the sphere of interest -c - area = 0.0d0 -c write (2,*) "ir",ir," radius",radius(ir) - if (radius(ir) .eq. 0.0d0) return -c -c set the overlap significance and connectivity shift -c - pix2 = 2.0d0 * pi - delta = 1.0d-8 - delta2 = delta * delta - eps = 1.0d-8 - moved = .false. - rmove = 1.0d-8 -c -c store coordinates and radius of the sphere of interest -c - xr = c(1,ir) - yr = c(2,ir) - zr = c(3,ir) - rr = radius(ir) - rrsq = rr * rr -c -c initialize values of some counters and summations -c - 10 continue - io = 0 - jb = 0 - ib = 0 - arclen = 0.0d0 - exang = 0.0d0 -c -c test each sphere to see if it overlaps the sphere of interest -c - do i = 1, 2*nres - if (i.eq.ir .or. radius(i).eq.0.0d0) goto 30 - rplus = rr + radius(i) - tx = c(1,i) - xr - if (abs(tx) .ge. rplus) goto 30 - ty = c(2,i) - yr - if (abs(ty) .ge. rplus) goto 30 - tz = c(3,i) - zr - if (abs(tz) .ge. rplus) goto 30 -c -c check for sphere overlap by testing distance against radii -c - xysq = tx*tx + ty*ty - if (xysq .lt. delta2) then - tx = delta - ty = 0.0d0 - xysq = delta2 - end if - ccsq = xysq + tz*tz - cc = sqrt(ccsq) - if (rplus-cc .le. delta) goto 30 - rminus = rr - radius(i) -c -c check to see if sphere of interest is completely buried -c - if (cc-abs(rminus) .le. delta) then - if (rminus .le. 0.0d0) goto 170 - goto 30 - end if -c -c check for too many overlaps with sphere of interest -c - if (io .ge. maxarc) then - write (iout,20) - 20 format (/,' SURFATOM -- Increase the Value of MAXARC') - stop - end if -c -c get overlap between current sphere and sphere of interest -c - io = io + 1 - xc1(io) = tx - yc1(io) = ty - zc1(io) = tz - dsq1(io) = xysq - bsq1(io) = ccsq - b1(io) = cc - gr(io) = (ccsq+rplus*rminus) / (2.0d0*rr*b1(io)) - intag1(io) = i - omit(io) = .false. - 30 continue - end do -c -c case where no other spheres overlap the sphere of interest -c - if (io .eq. 0) then - area = 4.0d0 * pi * rrsq - return - end if -c -c case where only one sphere overlaps the sphere of interest -c - if (io .eq. 1) then - area = pix2 * (1.0d0 + gr(1)) - area = mod(area,4.0d0*pi) * rrsq - return - end if -c -c case where many spheres intersect the sphere of interest; -c sort the intersecting spheres by their degree of overlap -c - call sort2 (io,gr,key) - do i = 1, io - k = key(i) - intag(i) = intag1(k) - xc(i) = xc1(k) - yc(i) = yc1(k) - zc(i) = zc1(k) - dsq(i) = dsq1(k) - b(i) = b1(k) - bsq(i) = bsq1(k) - end do -c -c get radius of each overlap circle on surface of the sphere -c - do i = 1, io - gi = gr(i) * rr - bg(i) = b(i) * gi - risq(i) = rrsq - gi*gi - ri(i) = sqrt(risq(i)) - ther(i) = 0.5d0*pi - asin(min(1.0d0,max(-1.0d0,gr(i)))) - end do -c -c find boundary of inaccessible area on sphere of interest -c - do k = 1, io-1 - if (.not. omit(k)) then - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - bk = b(k) - therk = ther(k) -c -c check to see if J circle is intersecting K circle; -c get distance between circle centers and sum of radii -c - do j = k+1, io - if (omit(j)) goto 60 - cc = (txk*xc(j)+tyk*yc(j)+tzk*zc(j))/(bk*b(j)) - cc = acos(min(1.0d0,max(-1.0d0,cc))) - td = therk + ther(j) -c -c check to see if circles enclose separate regions -c - if (cc .ge. td) goto 60 -c -c check for circle J completely inside circle K -c - if (cc+ther(j) .lt. therk) goto 40 -c -c check for circles that are essentially parallel -c - if (cc .gt. delta) goto 50 - 40 continue - omit(j) = .true. - goto 60 -c -c check to see if sphere of interest is completely buried -c - 50 continue - if (pix2-cc .le. td) goto 170 - 60 continue - end do - end if - end do -c -c find T value of circle intersections -c - do k = 1, io - if (omit(k)) goto 110 - omit(k) = .true. - narc = 0 - top = .false. - txk = xc(k) - tyk = yc(k) - tzk = zc(k) - dk = sqrt(dsq(k)) - bsqk = bsq(k) - bk = b(k) - gk = gr(k) * rr - risqk = risq(k) - rik = ri(k) - therk = ther(k) -c -c rotation matrix elements -c - t1 = tzk / (bk*dk) - axx = txk * t1 - axy = tyk * t1 - axz = dk / bk - ayx = tyk / dk - ayy = txk / dk - azx = txk / bk - azy = tyk / bk - azz = tzk / bk - do j = 1, io - if (.not. omit(j)) then - txj = xc(j) - tyj = yc(j) - tzj = zc(j) -c -c rotate spheres so K vector colinear with z-axis -c - uxj = txj*axx + tyj*axy - tzj*axz - uyj = tyj*ayy - txj*ayx - uzj = txj*azx + tyj*azy + tzj*azz - cosine = min(1.0d0,max(-1.0d0,uzj/b(j))) - if (acos(cosine) .lt. therk+ther(j)) then - dsqj = uxj*uxj + uyj*uyj - tb = uzj*gk - bg(j) - txb = uxj * tb - tyb = uyj * tb - td = rik * dsqj - tr2 = risqk*dsqj - tb*tb - tr2 = max(eps,tr2) - tr = sqrt(tr2) - txr = uxj * tr - tyr = uyj * tr -c -c get T values of intersection for K circle -c - tb = (txb+tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk1 = acos(tb) - if (tyb-txr .lt. 0.0d0) tk1 = pix2 - tk1 - tb = (txb-tyr) / td - tb = min(1.0d0,max(-1.0d0,tb)) - tk2 = acos(tb) - if (tyb+txr .lt. 0.0d0) tk2 = pix2 - tk2 - thec = (rrsq*uzj-gk*bg(j)) / (rik*ri(j)*b(j)) - if (abs(thec) .lt. 1.0d0) then - the = -acos(thec) - else if (thec .ge. 1.0d0) then - the = 0.0d0 - else if (thec .le. -1.0d0) then - the = -pi - end if -c -c see if "tk1" is entry or exit point; check t=0 point; -c "ti" is exit point, "tf" is entry point -c - cosine = min(1.0d0,max(-1.0d0, - & (uzj*gk-uxj*rik)/(b(j)*rr))) - if ((acos(cosine)-ther(j))*(tk2-tk1) .le. 0.0d0) then - ti = tk2 - tf = tk1 - else - ti = tk2 - tf = tk1 - end if - narc = narc + 1 - if (narc .ge. maxarc) then - write (iout,70) - 70 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - if (tf .le. ti) then - arcf(narc) = tf - arci(narc) = 0.0d0 - tf = pix2 - lt(narc) = j - ex(narc) = the - top = .true. - narc = narc + 1 - end if - arcf(narc) = tf - arci(narc) = ti - lt(narc) = j - ex(narc) = the - ux(j) = uxj - uy(j) = uyj - uz(j) = uzj - end if - end if - end do - omit(k) = .false. -c -c special case; K circle without intersections -c - if (narc .le. 0) goto 90 -c -c general case; sum up arclength and set connectivity code -c - call sort2 (narc,arci,key) - arcsum = arci(1) - mi = key(1) - t = arcf(mi) - ni = mi - if (narc .gt. 1) then - do j = 2, narc - m = key(j) - if (t .lt. arci(j)) then - arcsum = arcsum + arci(j) - t - exang = exang + ex(ni) - jb = jb + 1 - if (jb .ge. maxarc) then - write (iout,80) - 80 format (/,' SURFATOM -- Increase the Value', - & ' of MAXARC') - stop - end if - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(m) - kout(jb) = maxarc*k + i - end if - tt = arcf(m) - if (tt .ge. t) then - t = tt - ni = m - end if - end do - end if - arcsum = arcsum + pix2 - t - if (.not. top) then - exang = exang + ex(ni) - jb = jb + 1 - i = lt(ni) - kent(jb) = maxarc*i + k - i = lt(mi) - kout(jb) = maxarc*k + i - end if - goto 100 - 90 continue - arcsum = pix2 - ib = ib + 1 - 100 continue - arclen = arclen + gr(k)*arcsum - 110 continue - end do - if (arclen .eq. 0.0d0) goto 170 - if (jb .eq. 0) goto 150 -c -c find number of independent boundaries and check connectivity -c - j = 0 - do k = 1, jb - if (kout(k) .ne. 0) then - i = k - 120 continue - m = kout(i) - kout(i) = 0 - j = j + 1 - do ii = 1, jb - if (m .eq. kent(ii)) then - if (ii .eq. k) then - ib = ib + 1 - if (j .eq. jb) goto 150 - goto 130 - end if - i = ii - goto 120 - end if - end do - 130 continue - end if - end do - ib = ib + 1 -c -c attempt to fix connectivity error by moving atom slightly -c - if (moved) then - write (iout,140) ir - 140 format (/,' SURFATOM -- Connectivity Error at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if -c -c compute the exposed surface area for the sphere of interest -c - 150 continue - area = ib*pix2 + exang + arclen - area = mod(area,4.0d0*pi) * rrsq -c -c attempt to fix negative area by moving atom slightly -c - if (area .lt. 0.0d0) then - if (moved) then - write (iout,160) ir - 160 format (/,' SURFATOM -- Negative Area at Atom',i6) - else - moved = .true. - xr = xr + rmove - yr = yr + rmove - zr = zr + rmove - goto 10 - end if - end if - 170 continue - return - end diff --git a/source/unres/src_MD-restraints/test.F b/source/unres/src_MD-restraints/test.F deleted file mode 100644 index 0140ee5..0000000 --- a/source/unres/src_MD-restraints/test.F +++ /dev/null @@ -1,863 +0,0 @@ - subroutine test - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.CHAIN' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar),var1(maxvar) - integer j1,j2 - logical debug,accepted - debug=.true. - - - call geom_to_var(nvar,var1) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',0,etot,rms - call secondary2(.false.) - - call write_pdb(0,'first structure',etot) - - j1=13 - j2=21 - da=180.0*deg2rad - - - - temp=3000.0d0 - betbol=1.0D0/(1.9858D-3*temp) - jr=iran_num(j1,j2) - d=ran_number(-pi,pi) -c phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot0=energy(0) - call rmsd(rms) - write(iout,*) 'etot=',1,etot0,rms - call write_pdb(1,'perturb structure',etot0) - - do i=2,500,2 - jr=iran_num(j1,j2) - d=ran_number(-da,da) - phiold=phi(jr) - phi(jr)=pinorm(phi(jr)+d) - call chainbuild - call etotal(energy(0)) - etot=energy(0) - - if (etot.lt.etot0) then - accepted=.true. - else - accepted=.false. - xxr=ran_number(0.0D0,1.0D0) - xxh=betbol*(etot-etot0) - if (xxh.lt.50.0D0) then - xxh=dexp(-xxh) - if (xxh.gt.xxr) accepted=.true. - endif - endif - accepted=.true. -c print *,etot0,etot,accepted - if (accepted) then - etot0=etot - call rmsd(rms) - write(iout,*) 'etot=',i,etot,rms - call write_pdb(i,'MC structure',etot) -c minimize -c call geom_to_var(nvar,var1) - call sc_move(2,nres-1,1,10d0,nft_sc,etot) - call geom_to_var(nvar,var) - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun - call var_to_geom(nvar,var) - call chainbuild - call rmsd(rms) - write(iout,*) 'etot mcm=',i,etot,rms - call write_pdb(i+1,'MCM structure',etot) - call var_to_geom(nvar,var1) -c -------- - else - phi(jr)=phiold - endif - enddo - -c minimize -c call sc_move(2,nres-1,1,10d0,nft_sc,etot) -c call geom_to_var(nvar,var) -c -c call chainbuild -c call write_pdb(998 ,'sc min',etot) -c -c call minimize(etot,var,iretcode,nfun) -c write(iout,*)'------------------------------------------------' -c write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun -c -c call var_to_geom(nvar,var) -c call chainbuild -c call write_pdb(999,'full min',etot) - - - return - end - - - - - subroutine test_local - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling local_move' - call local_move_init(.false.) - call local_move(24,29,20d0,50d0) - call chainbuild - call write_pdb(3,'third structure',etot) - - write(iout,*) 'calling sc_move' - call sc_move(24,29,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'last structure',etot) - - - return - end - - subroutine test_sc - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.IOUNITS' - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision varia(maxvar) -c - call chainbuild -c call geom_to_var(nvar,varia) - call write_pdb(1,'first structure',0d0) - - call etotal(energy(0)) - etot=energy(0) - write(iout,*) nnt,nct,etot - - write(iout,*) 'calling sc_move' - - call sc_move(nnt,nct,5,10d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(2,'second structure',etot) - - write(iout,*) 'calling sc_move 2nd time' - - call sc_move(nnt,nct,5,1d0,nft_sc,etot) - write(iout,*) nft_sc,etot - call write_pdb(3,'last structure',etot) - return - end -c-------------------------------------------------------- - subroutine bgrow(bstrand,nbstrand,in,ind,new) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - integer bstrand(maxres/3,6) - - ishift=iabs(bstrand(in,ind+4)-new) - - print *,'bgrow',bstrand(in,ind+4),new,ishift - - bstrand(in,ind)=new - - if(ind.eq.1)then - bstrand(nbstrand,5)=bstrand(nbstrand,1) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,5).lt.bstrand(i,6)) then - bstrand(i,5)=bstrand(i,5)-ishift - else - bstrand(i,5)=bstrand(i,5)+ishift - endif - ENDIF - enddo - else - bstrand(nbstrand,6)=bstrand(nbstrand,2) - do i=1,nbstrand-1 - IF (bstrand(nbstrand,3).eq.bstrand(i,3)) THEN - if (bstrand(i,6).lt.bstrand(i,5)) then - bstrand(i,6)=bstrand(i,6)-ishift - else - bstrand(i,6)=bstrand(i,6)+ishift - endif - ENDIF - enddo - endif - - - return - end - - -c------------------------------------------------- - - subroutine secondary(lprint) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.DISTFIT' - - integer ncont,icont(2,maxres*maxres/2),isec(maxres,3) - logical lprint,not_done - real dcont(maxres*maxres/2),d - real rcomp /7.0/ - real rbeta /5.2/ - real ralfa /5.2/ - real r310 /6.6/ - double precision xpi(3),xpj(3) - - - - call chainbuild -cd call write_pdb(99,'sec structure',0d0) - ncont=0 - nbfrag=0 - nhfrag=0 - do i=1,nres - isec(i,1)=0 - isec(i,2)=0 - isec(i,3)=0 - enddo - - do i=2,nres-3 - do k=1,3 - xpi(k)=0.5d0*(c(k,i-1)+c(k,i)) - enddo - do j=i+2,nres - do k=1,3 - xpj(k)=0.5d0*(c(k,j-1)+c(k,j)) - enddo -cd d = (c(1,i)-c(1,j))*(c(1,i)-c(1,j)) + -cd & (c(2,i)-c(2,j))*(c(2,i)-c(2,j)) + -cd & (c(3,i)-c(3,j))*(c(3,i)-c(3,j)) -cd print *,'CA',i,j,d - d = (xpi(1)-xpj(1))*(xpi(1)-xpj(1)) + - & (xpi(2)-xpj(2))*(xpi(2)-xpj(2)) + - & (xpi(3)-xpj(3))*(xpi(3)-xpj(3)) - if ( d.lt.rcomp*rcomp) then - ncont=ncont+1 - icont(1,ncont)=i - icont(2,ncont)=j - dcont(ncont)=sqrt(d) - endif - enddo - enddo - if (lprint) then - write (iout,*) - write (iout,'(a)') '#PP contact map distances:' - do i=1,ncont - write (iout,'(3i4,f10.5)') - & i,icont(1,i),icont(2,i),dcont(i) - enddo - endif - -c finding parallel beta -cd write (iout,*) '------- looking for parallel beta -----------' - nbeta=0 - nstrand=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if(dcont(i).le.rbeta .and. j1-i1.gt.4 .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j) - & .and. dcont(j).le.rbeta .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) goto 5 - enddo - not_done=.false. - 5 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - j1=j1-1 - i1=i1-1 - if (i1-ii1.gt.1) then - ii1=max0(ii1-1,1) - jj1=max0(jj1-1,1) - nbeta=nbeta+1 - if(lprint)write(iout,*)'parallel beta',nbeta,ii1,i1,jj1,j1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=ii1 - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=j1 - - do ij=ii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - do ij=jj1,j1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - if(lprint) then - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-1,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nbeta.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",jj1-1,"..",j1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-1,i1-1,jj1-1,j1-1 - endif - endif - endif - enddo - -c finding antiparallel beta -cd write (iout,*) '--------- looking for antiparallel beta ---------' - - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (dcont(i).le.rbeta.and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & ) then - ii1=i1 - jj1=j1 -cd write (iout,*) i1,j1,dcont(i) - - not_done=.true. - do while (not_done) - i1=i1+1 - j1=j1-1 - do j=1,ncont - if (i1.eq.icont(1,j).and.j1.eq.icont(2,j) .and. - & isec(i1,1).le.1.and.isec(j1,1).le.1.and. - & (isec(i1,2).ne.isec(j1,2).or.isec(i1,2)*isec(j1,2).eq.0).and. - & (isec(i1,3).ne.isec(j1,3).or.isec(i1,3)*isec(j1,3).eq.0).and. - & (isec(i1,2).ne.isec(j1,3).or.isec(i1,2)*isec(j1,3).eq.0).and. - & (isec(i1,3).ne.isec(j1,2).or.isec(i1,3)*isec(j1,2).eq.0) - & .and. dcont(j).le.rbeta ) goto 6 - enddo - not_done=.false. - 6 continue -cd write (iout,*) i1,j1,dcont(j),not_done - enddo - i1=i1-1 - j1=j1+1 - if (i1-ii1.gt.1) then - if(lprint)write (iout,*)'antiparallel beta', - & nbeta,ii1-1,i1,jj1,j1-1 - - nbfrag=nbfrag+1 - bfrag(1,nbfrag)=max0(ii1-1,1) - bfrag(2,nbfrag)=i1 - bfrag(3,nbfrag)=jj1 - bfrag(4,nbfrag)=max0(j1-1,1) - - nbeta=nbeta+1 - iii1=max0(ii1-1,1) - do ij=iii1,i1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - jjj1=max0(j1-1,1) - do ij=jjj1,jj1 - isec(ij,1)=isec(ij,1)+1 - isec(ij,1+isec(ij,1))=nbeta - enddo - - - if (lprint) then - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",ii1-2,"..",i1-1,"'" - endif - nstrand=nstrand+1 - if (nstrand.le.9) then - write(12,'(a18,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - else - write(12,'(a18,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'strand",nstrand, - & "' 'num = ",j1-2,"..",jj1-1,"'" - endif - write(12,'(a8,4i4)') - & "SetNeigh",ii1-2,i1-1,jj1-1,j1-2 - endif - endif - endif - enddo - - if (nstrand.gt.0.and.lprint) then - write(12,'(a27,$)') "DefPropRes 'sheet' 'strand1" - do i=2,nstrand - if (i.le.9) then - write(12,'(a9,i1,$)') " | strand",i - else - write(12,'(a9,i2,$)') " | strand",i - endif - enddo - write(12,'(a1)') "'" - endif - - -c finding alpha or 310 helix - - nhelix=0 - do i=1,ncont - i1=icont(1,i) - j1=icont(2,i) - if (j1.eq.i1+3.and.dcont(i).le.r310 - & .or.j1.eq.i1+4.and.dcont(i).le.ralfa ) then -cd if (j1.eq.i1+3) write (iout,*) "found 1-4 ",i1,j1,dcont(i) -cd if (j1.eq.i1+4) write (iout,*) "found 1-5 ",i1,j1,dcont(i) - ii1=i1 - jj1=j1 - if (isec(ii1,1).eq.0) then - not_done=.true. - else - not_done=.false. - endif - do while (not_done) - i1=i1+1 - j1=j1+1 - do j=1,ncont - if (i1.eq.icont(1,j) .and. j1.eq.icont(2,j)) goto 10 - enddo - not_done=.false. - 10 continue -cd write (iout,*) i1,j1,not_done - enddo - j1=j1-1 - if (j1-ii1.gt.4) then - nhelix=nhelix+1 -cd write (iout,*)'helix',nhelix,ii1,j1 - - nhfrag=nhfrag+1 - hfrag(1,nhfrag)=ii1 - hfrag(2,nhfrag)=max0(j1-1,1) - - do ij=ii1,j1 - isec(ij,1)=-1 - enddo - if (lprint) then - write (iout,'(a6,i3,2i4)') "Helix",nhelix,ii1-1,j1-2 - if (nhelix.le.9) then - write(12,'(a17,i1,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - else - write(12,'(a17,i2,a9,i3,a2,i3,a1)') - & "DefPropRes 'helix",nhelix, - & "' 'num = ",ii1-1,"..",j1-2,"'" - endif - endif - endif - endif - enddo - - if (nhelix.gt.0.and.lprint) then - write(12,'(a26,$)') "DefPropRes 'helix' 'helix1" - do i=2,nhelix - if (nhelix.le.9) then - write(12,'(a8,i1,$)') " | helix",i - else - write(12,'(a8,i2,$)') " | helix",i - endif - enddo - write(12,'(a1)') "'" - endif - - if (lprint) then - write(12,'(a37)') "DefPropRes 'coil' '! (helix | sheet)'" - write(12,'(a20)') "XMacStand ribbon.mac" - endif - - - return - end -c---------------------------------------------------------------------------- - - subroutine write_pdb(npdb,titelloc,ee) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*50 titelloc1 - character*(*) titelloc - character*3 zahl - character*5 liczba5 - double precision ee - integer npdb,ilen - external ilen - - titelloc1=titelloc - lenpre=ilen(prefix) - if (npdb.lt.1000) then - call numstr(npdb,zahl) - open(ipdb,file=prefix(:lenpre)//'@@'//zahl//'.pdb') - else - if (npdb.lt.10000) then - write(liczba5,'(i1,i4)') 0,npdb - else - write(liczba5,'(i5)') npdb - endif - open(ipdb,file=prefix(:lenpre)//'@@'//liczba5//'.pdb') - endif - call pdbout(ee,titelloc1,ipdb) - close(ipdb) - return - end - -c-------------------------------------------------------- - subroutine softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.GEO' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.FFIELD' - include 'COMMON.MINIM' - include 'COMMON.INTERACT' -c - include 'COMMON.DISTFIT' - integer iff(maxres) - double precision time0,time1 - double precision energy(0:n_ene),ee - double precision var(maxvar) - integer ieval -c - logical debug,ltest,fail - character*50 linia -c - linia='test' - debug=.true. - in_pdb=0 - - - -c------------------------ -c -c freeze sec.elements -c - do i=1,nres - mask_phi(i)=1 - mask_theta(i)=1 - mask_side(i)=1 - iff(i)=0 - enddo - - do j=1,nbfrag - do i=bfrag(1,j),bfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - if (bfrag(3,j).le.bfrag(4,j)) then - do i=bfrag(3,j),bfrag(4,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - else - do i=bfrag(4,j),bfrag(3,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - endif - enddo - do j=1,nhfrag - do i=hfrag(1,j),hfrag(2,j) - mask_phi(i)=0 - mask_theta(i)=0 - iff(i)=1 - enddo - enddo - mask_r=.true. - - - - nhpb0=nhpb -c -c store dist. constrains -c - do i=1,nres-3 - do j=i+3,nres - if ( iff(i).eq.1.and.iff(j).eq.1 ) then - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=0.1 - dhpb(nhpb)=DIST(i,j) - endif - enddo - enddo - call hpb_partition - - if (debug) then - call chainbuild - call write_pdb(100+in_pdb,'input reg. structure',0d0) - endif - - - ipot0=ipot - maxmin0=maxmin - maxfun0=maxfun - wstrain0=wstrain - wang0=wang -c -c run soft pot. optimization -c - ipot=6 - wang=3.0 - maxmin=2000 - maxfun=4000 - call geom_to_var(nvar,var) -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - - write(iout,*)'SUMSL return code is',iretcode,' eval SOFT',nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for soft min.',time1-time0, - & nfun/(time1-time0),' SOFT eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(300+in_pdb,'soft structure',etot) - endif -c -c run full UNRES optimization with constrains and frozen 2D -c the same variables as soft pot. optimizatio -c - ipot=ipot0 - wang=wang0 - maxmin=maxmin0 - maxfun=maxfun0 -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK DIST return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for mask dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(400+in_pdb,'mask & dist',etot) - endif -c -c switch off constrains and -c run full UNRES optimization with frozen 2D -c - -c -c reset constrains -c - nhpb_c=nhpb - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'SUMSL MASK return code is',iretcode,' eval ',nfun - ieval=ieval+nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for mask min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(500+in_pdb,'mask 2d frozen',etot) - endif - - mask_r=.false. - - -c -c run full UNRES optimization with constrains and NO frozen 2D -c - - nhpb=nhpb_c - link_start=1 - link_end=nhpb - maxfun=maxfun0/5 - - do ico=1,5 - - wstrain=wstrain0/ico -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,'(a10,f6.3,a14,i3,a6,i5)') - & ' SUMSL DIST',wstrain,' return code is',iretcode, - & ' eval ',nfun - ieval=nfun -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)') - & ' Time for dist min.',time1-time0, - & nfun/(time1-time0),' eval/s' - if (debug) then - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(600+in_pdb+ico,'dist cons',etot) - endif - - enddo -c - nhpb=nhpb0 - link_start=1 - link_end=nhpb - wstrain=wstrain0 - maxfun=maxfun0 - - -c - if (minim) then -#ifdef MPI - time0=MPI_WTIME() -#else - time0=tcpu() -#endif - call minimize(etot,var,iretcode,nfun) - write(iout,*)'------------------------------------------------' - write(iout,*)'SUMSL return code is',iretcode,' eval ',nfun, - & '+ DIST eval',ieval -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - write (iout,'(a,f6.2,f8.2,a)')' Time for full min.',time1-time0, - & nfun/(time1-time0),' eval/s' - - - call var_to_geom(nvar,var) - call chainbuild - call write_pdb(999,'full min',etot) - endif - - return - end - - diff --git a/source/unres/src_MD-restraints/thread.F b/source/unres/src_MD-restraints/thread.F deleted file mode 100644 index 9f169a0..0000000 --- a/source/unres/src_MD-restraints/thread.F +++ /dev/null @@ -1,549 +0,0 @@ - subroutine thread_seq -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.CONTACTS' - include 'COMMON.MCM' - include 'COMMON.NAMES' -#ifdef MPI - include 'COMMON.INFO' - integer ThreadId,ThreadType,Kwita -#endif - double precision varia(maxvar) - double precision przes(3),obr(3,3) - double precision time_for_thread - logical found_pattern,non_conv - character*32 head_pdb - double precision energia(0:n_ene) - n_ene_comp=nprint_ene -C -C Body -C -#ifdef MPI - if (me.eq.king) then - do i=1,nctasks - nsave_part(i)=0 - enddo - endif - nacc_tot=0 -#endif - Kwita=0 - close(igeom) - close(ipdb) - close(istat) - do i=1,maxthread - do j=1,14 - ener0(j,i)=0.0D0 - ener(j,i)=0.0D0 - enddo - enddo - nres0=nct-nnt+1 - ave_time_for_thread=0.0D0 - max_time_for_thread=0.0D0 -cd print *,'nthread=',nthread,' nseq=',nseq,' nres0=',nres0 - nthread=nexcl+nthread - do ithread=1,nthread - found_pattern=.false. - itrial=0 - do while (.not.found_pattern) - itrial=itrial+1 - if (itrial.gt.1000) then - write (iout,'(/a/)') 'Too many attempts to find pattern.' - nthread=ithread-1 -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-3) -#endif - goto 777 - endif -C Find long enough chain in the database - ii=iran_num(1,nseq) - nres_t=nres_base(1,ii) -C Select the starting position to thread. - print *,'nseq',nseq,' ii=',ii,' nres_t=', - & nres_t,' nres0=',nres0 - if (nres_t.ge.nres0) then - ist=iran_num(0,nres_t-nres0) -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_receive -#endif - do i=1,nexcl - if (iexam(1,i).eq.ii .and. iexam(2,i).eq.ist) goto 10 - enddo - found_pattern=.true. - endif -C If this point is reached, the pattern has not yet been examined. - 10 continue -c print *,'found_pattern:',found_pattern - enddo - nexcl=nexcl+1 - iexam(1,nexcl)=ii - iexam(2,nexcl)=ist -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - nthread=ithread-1 - write (*,*) 'ithread=',ithread,' nthread=',nthread - goto 777 - endif - call pattern_send -#endif - ipatt(1,ithread)=ii - ipatt(2,ithread)=ist -#ifdef MPI - write (iout,'(/80(1h*)/a,i4,a,i5,2a,i3,a,i3,a,i3/)') - & 'Processor:',me,' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i4,a,i5,2a,i3,a,i3,a,i3)') 'Processor:',me, - & ' Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#else - write (iout,'(/80(1h*)/a,i5,2a,i3,a,i3,a,i3/)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 - write (*,'(a,i5,2a,i3,a,i3,a,i3)') - & 'Attempt:',ithread, - & ' pattern: ',str_nam(ii),nres_base(2,ii),':',nres_base(3,ii), - & ' start at res.',ist+1 -#endif - ipattern=ii -C Copy coordinates from the database. - ist=ist-(nnt-1) - do i=nnt,nct - do j=1,3 - c(j,i)=cart_base(j,i+ist,ii) -c cref(j,i)=c(j,i) - enddo -cd write (iout,'(a,i4,3f10.5)') restyp(itype(i)),i,(c(j,i),j=1,3) - enddo -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr, -cd non_conv) -cd write (iout,'(a,f10.5)') -cd & 'Initial RMS deviation from reference structure:',rms - if (itype(nres).eq.21) then - do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) - c(j,nres)=c(j,nres-1)+dcj - c(j,2*nres)=c(j,nres) - enddo - endif - if (itype(1).eq.21) then - do j=1,3 - dcj=c(j,4)-c(j,3) - c(j,1)=c(j,2)-dcj - c(j,nres+1)=c(j,1) - enddo - endif - call int_from_cart(.false.,.false.) -cd print *,'Exit INT_FROM_CART.' -cd print *,'nhpb=',nhpb - do i=nss+1,nhpb - ii=ihpb(i) - jj=jhpb(i) - dhpb(i)=dist(ii,jj) -c write (iout,'(2i5,2f10.5)') ihpb(i),jhpb(i),dhpb(i),forcon(i) - enddo -c stop 'End generate' -C Generate SC conformations. - call sc_conf -c call intout -#ifdef MPI -cd print *,'Processor:',me,': exit GEN_SIDE.' -#else -cd print *,'Exit GEN_SIDE.' -#endif -C Calculate initial energy. - call chainbuild - call etotal(energia(0)) - etot=energia(0) - do i=1,n_ene_comp - ener0(i,ithread)=energia(i) - enddo - ener0(n_ene_comp+1,ithread)=energia(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener0(n_ene_comp+3,ithread)=contact_fract(ncont,ncont_ref, - & icont,icont_ref) - ener0(n_ene_comp+2,ithread)=rms - ener0(n_ene_comp+4,ithread)=frac - ener0(n_ene_comp+5,ithread)=frac_nn - endif - ener0(n_ene_comp+3,ithread)=0.0d0 -C Minimize energy. -#ifdef MPI - print*,'Processor:',me,' ithread=',ithread,' Start REGULARIZE.' -#else - print*,'ithread=',ithread,' Start REGULARIZE.' -#endif - curr_tim=tcpu() - call regularize(nct-nnt+1,etot,rms, - & cart_base(1,ist+nnt,ipattern),iretcode) - curr_tim1=tcpu() - time_for_thread=curr_tim1-curr_tim - ave_time_for_thread= - & ((ithread-1)*ave_time_for_thread+time_for_thread)/ithread - if (time_for_thread.gt.max_time_for_thread) - & max_time_for_thread=time_for_thread -#ifdef MPI - print *,'Processor',me,': Exit REGULARIZE.' - if (WhatsUp.eq.2) then - write (iout,*) - & 'Sufficient number of confs. collected. Terminating.' - nthread=ithread-1 - goto 777 - else if (WhatsUp.eq.-1) then - nthread=ithread-1 - write (iout,*) 'Time up in REGULARIZE. Call SEND_STOP_SIG.' - if (Kwita.eq.0) call recv_stop_sig(Kwita) - call send_stop_sig(-2) - goto 777 - else if (WhatsUp.eq.-2) then - nthread=ithread-1 - write (iout,*) 'Timeup signal received. Terminating.' - goto 777 - else if (WhatsUp.eq.-3) then - nthread=ithread-1 - write (iout,*) 'Error stop signal received. Terminating.' - goto 777 - endif -#else - print *,'Exit REGULARIZE.' - if (iretcode.eq.11) then - write (iout,'(/a/)') - &'******* Allocated time exceeded in SUMSL. The program will stop.' - nthread=ithread-1 - goto 777 - endif -#endif - head_pdb=titel(:24)//':'//str_nam(ipattern) - if (outpdb) call pdbout(etot,head_pdb,ipdb) - if (outmol2) call mol2out(etot,head_pdb) -c call intout - call briefout(ithread,etot) - link_end0=link_end - link_end=min0(link_end,nss) - write (iout,*) 'link_end=',link_end,' link_end0=',link_end0, - & ' nss=',nss - call etotal(energia(0)) -c call enerprint(energia(0)) - link_end=link_end0 -cd call chainbuild -cd call fitsq(rms,c(1,nnt),cref(1,nnt),nct-nnt+1,przes,obr,non_conv) -cd write (iout,'(a,f10.5)') -cd & 'RMS deviation from reference structure:',dsqrt(rms) - do i=1,n_ene_comp - ener(i,ithread)=energia(i) - enddo - ener(n_ene_comp+1,ithread)=energia(0) - ener(n_ene_comp+3,ithread)=rms - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - ener(n_ene_comp+2,ithread)=rms - ener(n_ene_comp+4,ithread)=frac - ener(n_ene_comp+5,ithread)=frac_nn - endif - call write_stat_thread(ithread,ipattern,ist) -c write (istat,'(i4,2x,a8,i4,11(1pe14.5),2(0pf8.3),f8.5)') -c & ithread,str_nam(ipattern),ist+1,(ener(k,ithread),k=1,11), -c & (ener(k,ithread),k=12,14) -#ifdef MPI - if (me.eq.king) then - nacc_tot=nacc_tot+1 - call pattern_receive - call receive_MCM_info - if (nacc_tot.ge.nthread) then - write (iout,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - write (*,*) - & 'Sufficient number of conformations collected nacc_tot=', - & nacc_tot,'. Stopping other processors and terminating.' - call recv_stop_sig(Kwita) - if (Kwita.eq.0) call send_stop_sig(-1) - nthread=ithread - goto 777 - endif - else - call send_MCM_info(2) - endif -#endif - if (timlim-curr_tim1-safety .lt. max_time_for_thread) then - write (iout,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (*,'(/2a)') - & '********** There would be not enough time for another thread. ', - & 'The program will stop.' - write (iout,'(a,1pe14.4/)') - & 'Elapsed time for last threading step: ',time_for_thread - nthread=ithread -#ifdef MPI - call recv_stop_sig(Kwita) - call send_stop_sig(-2) -#endif - goto 777 - else - curr_tim=curr_tim1 - write (iout,'(a,1pe14.4)') - & 'Elapsed time for this threading step: ',time_for_thread - endif -#ifdef MPI - if (Kwita.eq.0) call recv_stop_sig(Kwita) - if (Kwita.lt.0) then - write (iout,*) 'Stop signal received. Terminating.' - write (*,*) 'Stop signal received. Terminating.' - nthread=ithread - write (*,*) 'nthread=',nthread,' ithread=',ithread - goto 777 - endif -#endif - enddo -#ifdef MPI - call send_stop_sig(-1) -#endif - 777 continue -#ifdef MPI -C Any messages left for me? - call pattern_receive - if (Kwita.eq.0) call recv_stop_sig(Kwita) -#endif - call write_thread_summary -#ifdef MPI - if (king.eq.king) then - Kwita=1 - do while (Kwita.ne.0 .or. nacc_tot.ne.0) - Kwita=0 - nacc_tot=0 - call recv_stop_sig(Kwita) - call receive_MCM_info - enddo - do iproc=1,nprocs-1 - call receive_thread_results(iproc) - enddo - call write_thread_summary - else - call send_thread_results - endif -#endif - return - end -c-------------------------------------------------------------------------- - subroutine write_thread_summary -C Thread the sequence through a database of known structures - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' -#ifdef MPI - include 'COMMON.INFO' -#endif - dimension ip(maxthread) - double precision energia(0:n_ene) - write (iout,'(30x,a/)') - & ' *********** Summary threading statistics ************' - write (iout,'(a)') 'Initial energies:' - write (iout,'(a4,2x,a12,14a14,3a8)') - & 'No','seq',(ename(print_order(i)),i=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' -C Energy sort patterns - do i=1,nthread - ip(i)=i - enddo - do i=1,nthread-1 - enet=ener(n_ene-1,ip(i)) - jj=i - do j=i+1,nthread - if (ener(n_ene-1,ip(j)).lt.enet) then - jj=j - enet=ener(n_ene-1,ip(j)) - endif - enddo - if (jj.ne.i) then - ipj=ip(jj) - ip(jj)=ip(i) - ip(i)=ipj - endif - enddo - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(i)=ener0(kk,i) - enddo - etot=ener0(n_ene_comp+1,i) - rmsnat=ener0(n_ene_comp+2,i) - rms=ener0(n_ene_comp+3,i) - frac=ener0(n_ene_comp+4,i) - frac_nn=ener0(n_ene_comp+5,i) - - if (refstr) then - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - else - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene),etot - endif - enddo - write (iout,'(//a)') 'Final energies:' - write (iout,'(a4,2x,a12,17a14,3a8)') - & 'No','seq',(ename(print_order(kk)),kk=1,nprint_ene),'ETOT', - & 'RMSnat','NatCONT','NNCONT','RMS' - do ik=1,nthread - i=ip(ik) - ii=ipatt(1,i) - ist=nres_base(2,ii)+ipatt(2,i) - do kk=1,n_ene_comp - energia(kk)=ener(kk,ik) - enddo - etot=ener(n_ene_comp+1,i) - rmsnat=ener(n_ene_comp+2,i) - rms=ener(n_ene_comp+3,i) - frac=ener(n_ene_comp+4,i) - frac_nn=ener(n_ene_comp+5,i) - write (iout,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & i,str_nam(ii),ist+1, - & (energia(print_order(kk)),kk=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - enddo - write (iout,'(/a/)') 'IEXAM array:' - write (iout,'(i5)') nexcl - do i=1,nexcl - write (iout,'(2i5)') iexam(1,i),iexam(2,i) - enddo - write (iout,'(/a,1pe14.4/a,1pe14.4/)') - & 'Max. time for threading step ',max_time_for_thread, - & 'Average time for threading step: ',ave_time_for_thread - return - end -c---------------------------------------------------------------------------- - subroutine sc_conf -C Sample (hopefully) optimal SC orientations given backcone conformation. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.DBASE' - include 'COMMON.INTERACT' - include 'COMMON.VAR' - include 'COMMON.THREAD' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.GEO' - include 'COMMON.IOUNITS' - double precision varia(maxvar) - common /srutu/ icall - double precision energia(0:n_ene) - logical glycine,fail - maxsample=10 - link_end0=link_end - link_end=min0(link_end,nss) - do i=nnt,nct - if (itype(i).ne.10) then -cd print *,'i=',i,' itype=',itype(i),' theta=',theta(i+1) - call gen_side(itype(i),theta(i+1),alph(i),omeg(i),fail) - endif - enddo - call chainbuild - call etotal(energia(0)) - do isample=1,maxsample -C Choose a non-glycine side chain. - glycine=.true. - do while(glycine) - ind_sc=iran_num(nnt,nct) - glycine=(itype(ind_sc).eq.10) - enddo - alph0=alph(ind_sc) - omeg0=omeg(ind_sc) - call gen_side(itype(ind_sc),theta(ind_sc+1),alph(ind_sc), - & omeg(ind_sc),fail) - call chainbuild - call etotal(energia(0)) -cd write (iout,'(a,i5,a,i4,2(a,f8.3),2(a,1pe14.5))') -cd & 'Step:',isample,' SC',ind_sc,' alpha',alph(ind_sc)*rad2deg, -cd & ' omega',omeg(ind_sc)*rad2deg,' old energy',e0,' new energy',e1 - e1=0.0d0 - if (e0.le.e1) then - alph(ind_sc)=alph0 - omeg(ind_sc)=omeg0 - else - e0=e1 - endif - enddo - link_end=link_end0 - return - end -c--------------------------------------------------------------------------- - subroutine write_stat_thread(ithread,ipattern,ist) - implicit real*8 (a-h,o-z) - include "DIMENSIONS" - include "COMMON.CONTROL" - include "COMMON.IOUNITS" - include "COMMON.THREAD" - include "COMMON.FFIELD" - include "COMMON.DBASE" - include "COMMON.NAMES" - double precision energia(0:n_ene) - -#if defined(AIX) || defined(PGI) - open(istat,file=statname,position='append') -#else - open(istat,file=statname,access='append') -#endif - do i=1,n_ene_comp - energia(i)=ener(i,ithread) - enddo - etot=ener(n_ene_comp+1,ithread) - rmsnat=ener(n_ene_comp+2,ithread) - rms=ener(n_ene_comp+3,ithread) - frac=ener(n_ene_comp+4,ithread) - frac_nn=ener(n_ene_comp+5,ithread) - write (istat,'(i4,2x,a8,i4,14(1pe14.5),0pf8.3,f8.5,f8.5,f8.3)') - & ithread,str_nam(ipattern),ist+1, - & (energia(print_order(i)),i=1,nprint_ene), - & etot,rmsnat,frac,frac_nn,rms - close (istat) - return - end diff --git a/source/unres/src_MD-restraints/timing.F b/source/unres/src_MD-restraints/timing.F deleted file mode 100644 index 5a81655..0000000 --- a/source/unres/src_MD-restraints/timing.F +++ /dev/null @@ -1,344 +0,0 @@ -C $Date: 1994/10/05 16:41:52 $ -C $Revision: 2.2 $ -C -C -C - subroutine set_timers -c - implicit none - double precision tcpu - include 'COMMON.TIME1' -#ifdef MP - include 'mpif.h' -#endif -C Diminish the assigned time limit a little so that there is some time to -C end a batch job -c timlim=batime-150.0 -C Calculate the initial time, if it is not zero (e.g. for the SUN). - stime=tcpu() -#ifdef MPI - walltime=MPI_WTIME() - time_reduce=0.0d0 - time_allreduce=0.0d0 - time_bcast=0.0d0 - time_gather=0.0d0 - time_sendrecv=0.0d0 - time_scatter=0.0d0 - time_scatter_fmat=0.0d0 - time_scatter_ginv=0.0d0 - time_scatter_fmatmult=0.0d0 - time_scatter_ginvmult=0.0d0 - time_barrier_e=0.0d0 - time_barrier_g=0.0d0 - time_enecalc=0.0d0 - time_sumene=0.0d0 - time_lagrangian=0.0d0 - time_sumgradient=0.0d0 - time_intcartderiv=0.0d0 - time_inttocart=0.0d0 - time_ginvmult=0.0d0 - time_fricmatmult=0.0d0 - time_cartgrad=0.0d0 - time_bcastc=0.0d0 - time_bcast7=0.0d0 - time_bcastw=0.0d0 - time_intfcart=0.0d0 - time_vec=0.0d0 - time_mat=0.0d0 - time_fric=0.0d0 - time_stoch=0.0d0 - time_fricmatmult=0.0d0 - time_fsample=0.0d0 -#endif -cd print *,' in SET_TIMERS stime=',stime - return - end -C------------------------------------------------------------------------------ - logical function stopx(nf) -C This function returns .true. if one of the following reasons to exit SUMSL -C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: -C -C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false. -C... 1 - Time up in current node; -C... 2 - STOP signal was received from another node because the -C... node's task was accomplished (parallel only); -C... -1 - STOP signal was received from another node because of error; -C... -2 - STOP signal was received from another node, because -C... the node's time was up. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer nf - logical ovrtim -#ifdef MP - include 'mpif.h' - include 'COMMON.INFO' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - integer Kwita - -cd print *,'Processor',MyID,' NF=',nf -#ifndef MPI - if (ovrtim()) then -C Finish if time is up. - stopx = .true. - WhatsUp=1 -#ifdef MPL - else if (mod(nf,100).eq.0) then -C Other processors might have finished. Check this every 100th function -C evaluation. -C Master checks if any other processor has sent accepted conformation(s) to it. - if (MyID.ne.MasterID) call receive_mcm_info - if (MyID.eq.MasterID) call receive_conf -cd print *,'Processor ',MyID,' is checking STOP: nf=',nf - call recv_stop_sig(Kwita) - if (Kwita.eq.-1) then - write (iout,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - write (*,'(a,i4,a,i5)') 'Processor', - & MyID,' has received STOP signal in STOPX; NF=',nf - stopx=.true. - WhatsUp=2 - elseif (Kwita.eq.-2) then - write (iout,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' - WhatsUp=-2 - stopx=.true. - else if (Kwita.eq.-3) then - write (iout,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - write (*,*) - & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' - WhatsUp=-1 - stopx=.true. - else - stopx=.false. - WhatsUp=0 - endif -#endif - else - stopx = .false. - WhatsUp=0 - endif -#else - stopx=.false. -#endif - -#ifdef OSF -c Check for FOUND_NAN flag - if (FOUND_NAN) then - write(iout,*)" *** stopx : Found a NaN" - stopx=.true. - endif -#endif - - return - end -C-------------------------------------------------------------------------- - logical function ovrtim() - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - real*8 tcpu -#ifdef MPI - include "mpif.h" - curtim = MPI_Wtime()-walltime -#else - curtim= tcpu() -#endif -C curtim is the current time in seconds. -c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety - if (curtim .ge. timlim - safety) then - if (me.eq.king .or. .not. out1file) - & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') - & "***************** Elapsed time (",curtim, - & " s) is within the safety limit (",safety, - & " s) of the allocated time (",timlim," s). Terminating." - ovrtim=.true. - else - ovrtim=.false. - endif - return - end -************************************************************************** - double precision function tcpu() - include 'COMMON.TIME1' -#ifdef ES9000 -**************************** -C Next definition for EAGLE (ibm-es9000) - real*8 micseconds - integer rcode - tcpu=cputime(micseconds,rcode) - tcpu=(micseconds/1.0E6) - stime -**************************** -#endif -#ifdef SUN -**************************** -C Next definitions for sun - REAL*8 ECPU,ETIME,ETCPU - dimension tarray(2) - tcpu=etime(tarray) - tcpu=tarray(1) -**************************** -#endif -#ifdef KSR -**************************** -C Next definitions for ksr -C this function uses the ksr timer ALL_SECONDS from the PMON library to -C return the elapsed time in seconds - tcpu= all_seconds() - stime -**************************** -#endif -#ifdef SGI -**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime -C usrsec = timar(1) -C syssec = timar(2) - tcpu=seconds - stime -**************************** -#endif - -#ifdef LINUX -c**************************** -C Next definitions for sgi - real timar(2), etime - seconds = etime(timar) -Cd print *,'seconds=',seconds,' stime=',stime - usrsec = timar(1) - syssec = timar(2) - tcpu=seconds - stime -c**************************** -#endif - - -#ifdef CRAY -**************************** -C Next definitions for Cray -C call date(curdat) -C curdat=curdat(1:9) -C call clock(curtim) -C curtim=curtim(1:8) - cpusec = second() - tcpu=cpusec - stime -**************************** -#endif -#ifdef AIX -**************************** -C Next definitions for RS6000 -c integer*4 i1,mclock - i1 = mclock() - tcpu = (i1+0.0D0)/100.0D0 -#endif -#ifdef WINPGI -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif -#ifdef WINIFL -**************************** -c next definitions for windows NT Digital fortran - real time_real - call cpu_time(time_real) - tcpu = time_real -#endif - - return - end -C--------------------------------------------------------------------------- - subroutine dajczas(rntime,hrtime,mintime,sectime) - include 'COMMON.IOUNITS' - real*8 rntime,hrtime,mintime,sectime - hrtime=rntime/3600.0D0 - hrtime=aint(hrtime) - mintime=aint((rntime-3600.0D0*hrtime)/60.0D0) - sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0) - if (sectime.eq.60.0D0) then - sectime=0.0D0 - mintime=mintime+1.0D0 - endif - ihr=hrtime - imn=mintime - isc=sectime - write (iout,328) ihr,imn,isc - 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 , - 1 ' minutes ', I2 ,' seconds *****') - return - end -C--------------------------------------------------------------------------- - subroutine print_detailed_timing - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -#ifdef MPI - time1=MPI_WTIME() - write (iout,'(80(1h=)/a/(80(1h=)))') - & "Details of FG communication time" - write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') - & "BROADCAST:",time_bcast,"REDUCE:",time_reduce, - & "GATHER:",time_gather, - & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv, - & "BARRIER ene",time_barrier_e, - & "BARRIER grad",time_barrier_g, - & "TOTAL:", - & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv - write (*,*) fg_rank,myrank, - & ': Total wall clock time',time1-walltime,' sec' - write (*,*) "Processor",fg_rank,myrank, - & ": BROADCAST time",time_bcast," REDUCE time", - & time_reduce," GATHER time",time_gather," SCATTER time", - & time_scatter, - & " SCATTER fmatmult",time_scatter_fmatmult, - & " SCATTER ginvmult",time_scatter_ginvmult, - & " SCATTER fmat",time_scatter_fmat, - & " SCATTER ginv",time_scatter_ginv, - & " SENDRECV",time_sendrecv, - & " BARRIER ene",time_barrier_e, - & " BARRIER GRAD",time_barrier_g, - & " BCAST7",time_bcast7," BCASTC",time_bcastc, - & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce, - & " TOTAL", - & time_bcast+time_reduce+time_gather+time_scatter+ - & time_sendrecv+time_barrier+time_bcastc -#else - time1=tcpu() -#endif - write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc - write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene - write (*,*) "Processor",fg_rank,myrank," intfromcart", - & time_intfcart - write (*,*) "Processor",fg_rank,myrank," vecandderiv", - & time_vec - write (*,*) "Processor",fg_rank,myrank," setmatrices", - & time_mat - write (*,*) "Processor",fg_rank,myrank," ginvmult", - & time_ginvmult - write (*,*) "Processor",fg_rank,myrank," fricmatmult", - & time_fricmatmult - write (*,*) "Processor",fg_rank,myrank," inttocart", - & time_inttocart - write (*,*) "Processor",fg_rank,myrank," sumgradient", - & time_sumgradient - write (*,*) "Processor",fg_rank,myrank," intcartderiv", - & time_intcartderiv - if (fg_rank.eq.0) then - write (*,*) "Processor",fg_rank,myrank," lagrangian", - & time_lagrangian - write (*,*) "Processor",fg_rank,myrank," cartgrad", - & time_cartgrad - endif - return - end diff --git a/source/unres/src_MD-restraints/unres.F b/source/unres/src_MD-restraints/unres.F deleted file mode 100644 index 632374b..0000000 --- a/source/unres/src_MD-restraints/unres.F +++ /dev/null @@ -1,796 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C U N R E S C -C C -C Program to carry out conformational search of proteins in an united-residue C -C approximation. C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - - -#ifdef MPI - include 'mpif.h' - include 'COMMON.SETUP' -#endif - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision hrtime,mintime,sectime - character*64 text_mode_calc(-2:14) /'test', - & 'SC rotamer distribution', - & 'Energy evaluation or minimization', - & 'Regularization of PDB structure', - & 'Threading of a sequence on PDB structures', - & 'Monte Carlo (with minimization) ', - & 'Energy minimization of multiple conformations', - & 'Checking energy gradient', - & 'Entropic sampling Monte Carlo (with minimization)', - & 'Energy map', - & 'CSA calculations', - & 'Not used 9', - & 'Not used 10', - & 'Soft regularization of PDB structure', - & 'Mesoscopic molecular dynamics (MD) ', - & 'Not used 13', - & 'Replica exchange molecular dynamics (REMD)'/ - external ilen - -c call memmon_print_usage() - - call init_task - if (me.eq.king) - & write(iout,*)'### LAST MODIFIED 03/28/12 23:29 by czarek' - if (me.eq.king) call cinfo -C Read force field parameters and job setup data - call readrtns - if (me.eq.king .or. .not. out1file) then - write (iout,'(2a/)') - & text_mode_calc(modecalc)(:ilen(text_mode_calc(modecalc))), - & ' calculation.' - if (minim) write (iout,'(a)') - & 'Conformations will be energy-minimized.' - write (iout,'(80(1h*)/)') - endif - call flush(iout) -C - if (modecalc.eq.-2) then - call test - stop - else if (modecalc.eq.-1) then - write(iout,*) "call check_sc_map next" - call check_bond - stop - endif -#ifdef MPI - if (fg_rank.gt.0) then -C Fine-grain slaves just do energy and gradient components. - call ergastulum ! slave workhouse in Latin - else -#endif - if (modecalc.eq.0) then - call exec_eeval_or_minim - else if (modecalc.eq.1) then - call exec_regularize - else if (modecalc.eq.2) then - call exec_thread - else if (modecalc.eq.3 .or. modecalc .eq.6) then - call exec_MC - else if (modecalc.eq.4) then - call exec_mult_eeval_or_minim - else if (modecalc.eq.5) then - call exec_checkgrad - else if (ModeCalc.eq.7) then - call exec_map - else if (ModeCalc.eq.8) then - call exec_CSA - else if (modecalc.eq.11) then - call exec_softreg - else if (modecalc.eq.12) then - call exec_MD - else if (modecalc.eq.14) then - call exec_MREMD - else - write (iout,'(a)') 'This calculation type is not supported', - & ModeCalc - endif -#ifdef MPI - endif -C Finish task. - if (fg_rank.eq.0) call finish_task -c call memmon_print_usage() -#ifdef TIMING - call print_detailed_timing -#endif - call MPI_Finalize(ierr) - stop 'Bye Bye...' -#else - call dajczas(tcpu(),hrtime,mintime,sectime) - stop '********** Program terminated normally.' -#endif - end -c-------------------------------------------------------------------------- - subroutine exec_MD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - call MD - return - end -c--------------------------------------------------------------------------- - subroutine exec_MREMD - include 'DIMENSIONS' -#ifdef MPI - include "mpif.h" - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.IOUNITS' - include 'COMMON.REMD' - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling chainbuild" - call chainbuild - if (me.eq.king .or. .not. out1file) - & write (iout,*) "Calling REMD" - if (remd_mlist) then - call MREMD - else - do i=1,nrep - remd_m(i)=1 - enddo - call MREMD - endif -#else - write (iout,*) "MREMD works on parallel machines only" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:n_ene) - double precision energy_long(0:n_ene),energy_short(0:n_ene) - double precision varia(maxvar) - if (indpdb.eq.0) call chainbuild -#ifdef MPI - time00=MPI_Wtime() -#else - time00=tcpu() -#endif - call chainbuild_cart - if (split_ene) then - print *,"Processor",myrank," after chainbuild" - icall=1 - call etotal_long(energy_long(0)) - write (iout,*) "Printing long range energy" - call enerprint(energy_long(0)) - call etotal_short(energy_short(0)) - write (iout,*) "Printing short range energy" - call enerprint(energy_short(0)) - do i=0,n_ene - energy(i)=energy_long(i)+energy_short(i) - write (iout,*) i,energy_long(i),energy_short(i),energy(i) - enddo - write (iout,*) "Printing long+short range energy" - call enerprint(energy(0)) - endif - call etotal(energy(0)) -#ifdef MPI - time_ene=MPI_Wtime()-time00 -#else - time_ene=tcpu()-time00 -#endif - write (iout,*) "Time for energy evaluation",time_ene - print *,"after etotal" - etota = energy(0) - etot =etota - call enerprint(energy(0)) - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - if (minim) then -crc overlap test - if (overlapsc) then - print *, 'Calling OVERLAP_SC' - call overlap_sc(fail) - endif - - if (searchsc) then - call sc_move(2,nres-1,10,1d10,nft_sc,etot) - print *,'SC_move',nft_sc,etot - write(iout,*) 'SC_move',nft_sc,etot - endif - - if (dccart) then - print *, 'Calling MINIM_DC' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minim_dc(etot,iretcode,nfun) - else - if (indpdb.ne.0) then - call bond_regular - call chainbuild - endif - call geom_to_var(nvar,varia) - print *,'Calling MINIMIZE.' -#ifdef MPI - time1=MPI_WTIME() -#else - time1=tcpu() -#endif - call minimize(etot,varia,iretcode,nfun) - endif - print *,'SUMSL return code is',iretcode,' eval ',nfun -#ifdef MPI - evals=nfun/(MPI_WTIME()-time1) -#else - evals=nfun/(tcpu()-time1) -#endif - print *,'# eval/s',evals - print *,'refstr=',refstr - call hairpin(.true.,nharp,iharp) - call secondary2(.true.) - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - - call intout - call briefout(0,etot) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - write (iout,'(a,i20)') '# of energy evaluations:',nfun+1 - write (iout,'(a,f16.3)')'# of energy evaluations/sec:',evals - else - print *,'refstr=',refstr - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - call briefout(0,etot) - endif - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - return - end -c--------------------------------------------------------------------------- - subroutine exec_regularize - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision energy(0:n_ene) - - call gen_dist_constr - call sc_conf - call intout - call regularize(nct-nnt+1,etot,rms,cref(1,nnt),iretcode) - call etotal(energy(0)) - energy(0)=energy(0)-energy(14) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - if (outpdb) call pdbout(etot,titel(:32),ipdb) - if (outmol2) call mol2out(etot,titel(:32)) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (iout,'(a,i3)') 'SUMSL return code:',iretcode - return - end -c--------------------------------------------------------------------------- - subroutine exec_thread - include 'DIMENSIONS' -#ifdef MP - include "mpif.h" -#endif - include "COMMON.SETUP" - call thread_seq - return - end -c--------------------------------------------------------------------------- - subroutine exec_MC - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - character*10 nodeinfo - double precision varia(maxvar) -#ifdef MPI - include "mpif.h" -#endif - include "COMMON.SETUP" - include 'COMMON.CONTROL' - call mcm_setup - if (minim) then -#ifdef MPI - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#else - if (modecalc.eq.3) then - call do_mcm(ipar) - else - call entmcm - endif -#endif - else - call monte_carlo - endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_mult_eeval_or_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - dimension muster(mpi_status_size) -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - double precision varia(maxvar) - dimension ind(6) - double precision energy(0:n_ene) - logical eof - eof=.false. -#ifdef MPI - if(me.ne.king) then - call minim_mcmf - return - endif - - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,30a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact","cont.order" - else - write (istat,'(a5,30a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - - if (.not.minim) then - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - call etotal(energy(0)) - call briefout(iconf,energy(0)) - call enerprint(energy(0)) - etot=energy(0) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo -1100 continue - goto 1101 - endif - - mm=0 - imm=0 - nft=0 - ene0=0.0d0 - n=0 - iconf=0 -c do n=1,nzsc - do while (.not. eof) - mm=mm+1 - if (mm.lt.nodes) then - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - ene0=0.0d0 - call mpi_send(ind,6,mpi_integer,mm,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,mm, - * idreal,CG_COMM,ierr) -c print *,'task ',n,' sent to worker ',mm,nvar - else - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) -c print *,'receiving result from worker ',man,' (',iii1,iii,')' - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) -c print *,'result received from worker ',man,' sending now' - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) -c if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - - imm=imm-1 - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=11,err=11) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - n=n+1 - write (iout,*) 'Conformation #',iconf,' read' - imm=imm+1 - ind(1)=1 - ind(2)=n - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,man,idint,CG_COMM, - * ierr) - call mpi_send(varia,nvar,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - call mpi_send(ene0,1,mpi_double_precision,man, - * idreal,CG_COMM,ierr) - nf_mcmf=nf_mcmf+ind(4) - nmin=nmin+1 - endif - enddo -11 continue - do j=1,imm - call mpi_recv(ind,6,mpi_integer,mpi_any_source,idint, - * CG_COMM,muster,ierr) - man=muster(mpi_source) - call mpi_recv(varia,nvar,mpi_double_precision, - * man,idreal,CG_COMM,muster,ierr) - call mpi_recv(ene,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - call mpi_recv(ene0,1, - * mpi_double_precision,man,idreal, - * CG_COMM,muster,ierr) - - call var_to_geom(nvar,varia) - call chainbuild - call etotal(energy(0)) - iconf=ind(2) - write (iout,*) - write (iout,*) - write (iout,*) 'Conformation #',iconf," sumsl return code ", - & ind(5) - - etot=energy(0) - call enerprint(energy(0)) - call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot, - & rms,frac,frac_nn,co - else - write (istat,'(i5,30(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - nmin=nmin+1 - enddo -1101 continue - do i=1, nodes-1 - ind(1)=0 - ind(2)=0 - ind(3)=0 - ind(4)=0 - ind(5)=0 - ind(6)=0 - call mpi_send(ind,6,mpi_integer,i,idint,CG_COMM, - * ierr) - enddo -#else - close (intin) - open(intin,file=intinname,status='old') - write (istat,'(a5,20a12)')"# ", - & (wname(print_order(i)),i=1,nprint_ene) - write (istat,'("# ",20(1pe12.4))') - & (weights(print_order(i)),i=1,nprint_ene) - if (refstr) then - write (istat,'(a5,20a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact" - else - write (istat,'(a5,14a12)')"# ", - & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" - endif - do while (.not. eof) - if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1100,err=1100) time,ene - call read_x(intin,*11) -#ifdef MPI -c Broadcast the order to compute internal coordinates to the slaves. - if (nfgtasks.gt.1) - & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif - call int_from_cart1(.false.) - else - read (intin,'(i5)',end=1100,err=1100) iconf - call read_angles(intin,*11) - call geom_to_var(nvar,varia) - call chainbuild - endif - write (iout,'(a,i7)') 'Conformation #',iconf - if (minim) call minimize(etot,varia,iretcode,nfun) - call etotal(energy(0)) - - etot=energy(0) - call enerprint(energy(0)) - if (minim) call briefout(it,etot) - if (refstr) then - call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,18(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene), - & etot,rms,frac,frac_nn,co -cjlee end - else - write (istat,'(i5,14(f12.3))') iconf, - & (energy(print_order(i)),i=1,nprint_ene),etot - endif - enddo - 11 continue - 1100 continue -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_checkgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.TIME1' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.CONTACTS' - include 'COMMON.CHAIN' - include 'COMMON.VAR' - include 'COMMON.IOUNITS' - include 'COMMON.FFIELD' - include 'COMMON.REMD' - include 'COMMON.MD' - include 'COMMON.SBRIDGE' - common /srutu/ icall - double precision energy(0:max_ene) -c do i=2,nres -c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0) -c if (itype(i).ne.10) -c & vbld(i+nres)=vbld(i+nres)+ran_number(-0.001d0,0.001d0) -c enddo - if (indpdb.eq.0) call chainbuild -c do i=0,nres -c do j=1,3 -c dc(j,i)=dc(j,i)+ran_number(-0.2d0,0.2d0) -c enddo -c enddo -c do i=1,nres-1 -c if (itype(i).ne.10) then -c do j=1,3 -c dc(j,i+nres)=dc(j,i+nres)+ran_number(-0.2d0,0.2d0) -c enddo -c endif -c enddo -c do j=1,3 -c dc(j,0)=ran_number(-0.2d0,0.2d0) -c enddo - usampl=.true. - totT=1.d0 - eq_time=0.0d0 - call read_fragments - read(inp,*) t_bath - call rescale_weights(t_bath) - call chainbuild_cart - call cartprint - call intout - icall=1 - call etotal(energy(0)) - etot = energy(0) - call enerprint(energy(0)) - write (iout,*) "Uconst",Uconst," Uconst_back",uconst_back - print *,'icheckgrad=',icheckgrad - goto (10,20,30) icheckgrad - 10 call check_ecartint - return - 20 call check_cartgrad - return - 30 call check_eint - return - end -c--------------------------------------------------------------------------- - subroutine exec_map -C Energy maps - call map_read - call map - return - end -c--------------------------------------------------------------------------- - subroutine exec_CSA -#ifdef MPI - include "mpif.h" -#endif - include 'DIMENSIONS' - include 'COMMON.IOUNITS' -C Conformational Space Annealling programmed by Jooyoung Lee. -C This method works only with parallel machines! -#ifdef MPI -csa call together - write (iout,*) "CSA is not supported in this version" -#else -csa write (iout,*) "CSA works on parallel machines only" - write (iout,*) "CSA is not supported in this version" -#endif - return - end -c--------------------------------------------------------------------------- - subroutine exec_softreg - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - double precision energy(0:max_ene) - logical debug /.false./ - call chainbuild - call etotal(energy(0)) - call enerprint(energy(0)) - if (.not.lsecondary) then - write(iout,*) 'Calling secondary structure recognition' - call secondary2(debug) - else - write(iout,*) 'Using secondary structure supplied in pdb' - endif - - call softreg - - call etotal(energy(0)) - etot=energy(0) - call enerprint(energy(0)) - call intout - call briefout(0,etot) - call secondary2(.true.) - if (refstr) call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - return - end diff --git a/source/unres/src_MD-restraints/xdrf b/source/unres/src_MD-restraints/xdrf deleted file mode 120000 index 3b7d662..0000000 --- a/source/unres/src_MD-restraints/xdrf +++ /dev/null @@ -1 +0,0 @@ -../../../source/lib/xdrf \ No newline at end of file diff --git a/source/unres/src_MD/CMakeLists.txt b/source/unres/src_MD/CMakeLists.txt index b041904..c310760 100644 --- a/source/unres/src_MD/CMakeLists.txt +++ b/source/unres/src_MD/CMakeLists.txt @@ -59,6 +59,7 @@ set(UNRES_MD_SRC0 parmread.F pinorm.f printmat.f + prng_32.F q_measure.F randgens.f rattle.F @@ -78,17 +79,9 @@ set(UNRES_MD_SRC0 timing.F thread.F unres.F + ssMD.F ) -if(Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -else() - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - set(UNRES_MD_SRC3 energy_p_new_barrier.F energy_p_new-sep_barrier.F @@ -119,6 +112,7 @@ set(UNRES_MD_PP_SRC MP.F MREMD.F parmread.F + prng_32.F q_measure1.F q_measure3.F q_measure.F @@ -136,11 +130,6 @@ set(UNRES_MD_PP_SRC proc_proc.c ) - -if(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_PP_SRC ${UNRES_MD_PP_SRC} prng_32.F) -endif(NOT Fortran_COMPILER_NAME STREQUAL "ifort") - #================================================ # Set comipiler flags for different sourcefiles #================================================ @@ -161,10 +150,10 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_MD_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -177,7 +166,7 @@ set_property(SOURCE ${UNRES_MD_SRC3} PROPERTY COMPILE_FLAGS ${FFLAGS3} ) #========================================= if(UNRES_MD_FF STREQUAL "GAB" ) # set preprocesor flags - set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC") #========================================= # Settings for E0LL2Y force field @@ -185,6 +174,8 @@ if(UNRES_MD_FF STREQUAL "GAB" ) elseif(UNRES_MD_FF STREQUAL "E0LL2Y") # set preprocesor flags set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DLANG0" ) +elseif(UNRES_MD_FF STREQUAL "4P") + set(CPPFLAGS "UNRES -DISNAN -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) endif(UNRES_MD_FF STREQUAL "GAB") #========================================= @@ -206,7 +197,11 @@ elseif (Fortran_COMPILER_NAME STREQUAL "f95") set(CPPFLAGS "${CPPFLAGS} -DG77") elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") # Add old gfortran flags - set(CPPFLAGS "${CPPFLAGS} -DG77") + set(CPPFLAGS "${CPPFLAGS} -DG77") +elseif (Fortran_COMPILER_NAME STREQUAL "pgf90") + set(CPPFLAGS "${CPPFLAGS} -DPGI") + FILE(COPY ${CMAKE_SOURCE_DIR}/source/lib/isnan_pgi.f DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + list(APPEND UNRES_MD_SRC0 ${CMAKE_CURRENT_BINARY_DIR}/isnan_pgi.f) endif (Fortran_COMPILER_NAME STREQUAL "ifort") #========================================= @@ -217,6 +212,13 @@ if (UNRES_WITH_MPI) endif(UNRES_WITH_MPI) #========================================= +# Add 64-bit specific preprocessor flags +#========================================= +if (architektura STREQUAL "64") + set(CPPFLAGS "${CPPFLAGS} -DAMD64") +endif (architektura STREQUAL "64") + +#========================================= # Apply preprocesor flags to *.F files #========================================= set_property(SOURCE ${UNRES_MD_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) @@ -227,10 +229,10 @@ set_property(SOURCE ${UNRES_MD_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} #======================================== if(UNRES_WITH_MPI) # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") + set(UNRES_BIN "unresMD_${Fortran_COMPILER_NAME}_MPI_${UNRES_MD_FF}.exe") else(UNRES_WITH_MPI) # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") + set(UNRES_BIN "unresMD_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") endif(UNRES_WITH_MPI) #========================================= @@ -276,7 +278,7 @@ set(UNRES_MD_SRCS ${UNRES_MD_SRC0} ${UNRES_MD_SRC3} ${CMAKE_CURRENT_BINARY_DIR}/ #========================================= add_executable(UNRES_BIN-MD ${UNRES_MD_SRCS} ) set_target_properties(UNRES_BIN-MD PROPERTIES OUTPUT_NAME ${UNRES_BIN}) -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_BIN-MD PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) @@ -285,13 +287,18 @@ set_target_properties(UNRES_BIN-MD PROPERTIES OUTPUT_NAME ${UNRES_BIN}) #========================================= # link MPI library (libmpich.a) if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_BIN-MD ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a #message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") target_link_libraries( UNRES_BIN-MD xdrf ) #========================================= +# Install Path +#========================================= +install(TARGETS UNRES_BIN-MD DESTINATION ${CMAKE_INSTALL_PREFIX}/unres/MD) + +#========================================= # TESTS #========================================= @@ -321,7 +328,7 @@ FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh export POT=GB export PREFIX=ala10 #----------------------------------------------------------------------------- -UNRES_BIN=./${UNRES_BIN} +UNRES_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_BIN} #----------------------------------------------------------------------------- DD=${CMAKE_SOURCE_DIR}/PARAM export BONDPAR=$DD/bond.parm @@ -333,7 +340,7 @@ export ELEPAR=$DD/electr_631Gdp.parm export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 export SCPPAR=$DD/scp.parm -export SCCORPAR=$DD/rotcorr_AM1.parm +export SCCORPAR=$DD/sccor_pdb_shelly.dat export PATTERN=$DD/patterns.cart #----------------------------------------------------------------------------- $UNRES_BIN @@ -377,17 +384,219 @@ XAAAAAAAAAAX -120.0000 -120.0000 ") +if(UNRES_MD_FF STREQUAL "E0LL2Y") + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota_unres.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota_ENE.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota_MIN_CART.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1l2y_micro.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1l2y_MIN_INT.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1l2y_MIN_REGULAR_INT.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_B.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_L.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_NH.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_remd.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1ei0_min.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1ei0.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota_unres_energy_check.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/matplotlib_fit_hist.py + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/matplotlib_hist.py + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/checkgrad.awk + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/prota_CHECKGRAD.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + + + + +#========================================= +# test_prota_E0LL2Y.sh +#========================================= + +FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_prota_E0LL2Y.sh +"#!/bin/sh +export POT=GB +export FGPROCS=$2 +export PREFIX=$1 +#----------------------------------------------------------------------------- +UNRES_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_BIN} +#----------------------------------------------------------------------------- +DD=${CMAKE_SOURCE_DIR}/PARAM +export BONDPAR=$DD/bond_AM1.parm +export THETPAR=$DD/theta_abinitio.parm +export ROTPAR=$DD/rotamers_AM1_aura.10022007.parm +export TORPAR=$DD/torsion_631Gdp.parm +export TORDPAR=$DD/torsion_double_631Gdp.parm +export ELEPAR=$DD/electr_631Gdp.parm +export SIDEPAR=$DD/scinter_$POT.parm +export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +export SCPPAR=$DD/scp.parm +export SCCORPAR=$DD/sccor_am1_pawel.dat +export THETPARPDB=$DD/thetaml.5parm +export ROTPARPDB=$DD/scgauss.parm +export PATTERN=$DD/patterns.cart +#----------------------------------------------------------------------------- +echo CTEST_FULL_OUTPUT +$UNRES_BIN +./prota_unres_energy_check.sh $1 ${UNRES_BIN} +") + +# +# File permissions workaround +# +FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_prota_E0LL2Y.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +# MESSAGE (STATUS "${MPI_Fortran_LIBRARIES}") + if ("${MPI_Fortran_LIBRARIES}" MATCHES "lam") + MESSAGE (STATUS "LAM MPI library detected") + set (boot_lam "-boot") + else() + set (boot_lam "") + endif() + + if (UNRES_SRUN) + set (np "-n") + set (mpiexec "srun") + elseif(UNRES_MPIRUN) + set (np "-np") + set (mpiexec "mpirun") + else() + set (np "-np") + set (mpiexec "mpiexec") + endif() + + +FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_mpi_E0LL2Y.sh +"#!/bin/sh +export POT=GB +export FGPROCS=$2 +export PREFIX=$1 +#----------------------------------------------------------------------------- +UNRES_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_BIN} +#----------------------------------------------------------------------------- +DD=${CMAKE_SOURCE_DIR}/PARAM +export BONDPAR=$DD/bond_AM1.parm +export THETPAR=$DD/theta_abinitio.parm +export ROTPAR=$DD/rotamers_AM1_aura.10022007.parm +export TORPAR=$DD/torsion_631Gdp.parm +export TORDPAR=$DD/torsion_double_631Gdp.parm +export ELEPAR=$DD/electr_631Gdp.parm +export SIDEPAR=$DD/scinter_$POT.parm +export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +export SCPPAR=$DD/scp.parm +export SCCORPAR=$DD/sccor_am1_pawel.dat +export THETPARPDB=$DD/thetaml.5parm +export ROTPARPDB=$DD/scgauss.parm +export PATTERN=$DD/patterns.cart +#----------------------------------------------------------------------------- +echo CTEST_FULL_OUTPUT +${mpiexec} ${boot_lam} ${np} $3 $UNRES_BIN | grep -v traj1file +./prota_unres_energy_check.sh $1 ${UNRES_BIN} +") + +# +# File permissions workaround +# +FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_mpi_E0LL2Y.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + + +endif(UNRES_MD_FF STREQUAL "E0LL2Y") + + # Add tests if(NOT UNRES_WITH_MPI) - add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + if(UNRES_MD_FF STREQUAL "GAB") + add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + endif(UNRES_MD_FF STREQUAL "GAB") + + if(UNRES_MD_FF STREQUAL "E0LL2Y") + add_test(NAME UNRES_ENE_prota COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_ENE 1 ) + add_test(NAME UNRES_CHECKGRAD_prota COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_CHECKGRAD 1 ) + add_test(NAME UNRES_MIN_prota COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_MIN_CART 1 ) + add_test(NAME UNRES_MIN_INT COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_MIN_INT 1 ) + add_test(NAME UNRES_REGULAR COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_MIN_REGULAR_INT 1 ) + add_test(NAME UNRES_MD_microcanonical COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_micro 1 ) + add_test(NAME UNRES_Langevin COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1L2Y_L 1 ) + add_test(NAME UNRES_NoseHoover COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1L2Y_NH 1 ) + add_test(NAME UNRES_Berendsen COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1L2Y_B 1 ) + add_test(NAME UNRES_ss_static_min COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1ei0_min 1 ) + endif(UNRES_MD_FF STREQUAL "E0LL2Y") else(NOT UNRES_WITH_MPI) - add_test(NAME UNRES_MD_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + if(UNRES_MD_FF STREQUAL "GAB") + add_test(NAME UNRES_MD_MPI_Ala10 COMMAND ${mpiexec} ${boot_lam} ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + endif(UNRES_MD_FF STREQUAL "GAB") + + if(UNRES_MD_FF STREQUAL "E0LL2Y") + add_test(NAME UNRES_ENE_prota COMMAND ${mpiexec} ${boot_lam} ${np} 2 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_ENE 2 ) + add_test(NAME UNRES_ENE1_prota COMMAND ${mpiexec} ${boot_lam} ${np} 1 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_ENE 1 ) + add_test(NAME UNRES_CHECKGRAD_prota COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh prota_CHECKGRAD 2 2 ) + add_test(NAME UNRES_CHECKGRAD1_prota COMMAND ${mpiexec} ${boot_lam} ${np} 1 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_CHECKGRAD 1 ) + add_test(NAME UNRES_MIN_prota COMMAND ${mpiexec} ${boot_lam} ${np} 2 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh prota_MIN_CART 2 ) + add_test(NAME UNRES_MIN_INT COMMAND ${mpiexec} ${boot_lam} ${np} 1 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_MIN_INT 1 ) + add_test(NAME UNRES_REGULAR COMMAND ${mpiexec} ${boot_lam} ${np} 1 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_MIN_REGULAR_INT 1 ) + add_test(NAME UNRES_MD_microcanonical COMMAND ${mpiexec} ${boot_lam} ${np} 2 ${CMAKE_CURRENT_BINARY_DIR}/test_prota_E0LL2Y.sh 1l2y_micro 2 ) + add_test(NAME UNRES_Langevin COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh 1L2Y_L 2 2 ) + add_test(NAME UNRES_NoseHoover COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh 1L2Y_NH 2 2 ) + add_test(NAME UNRES_Berendsen COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh 1L2Y_B 2 2 ) + add_test(NAME UNRES_remd COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh 1L2Y_remd 1 8 ) + add_test(NAME UNRES_ss_static_min COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_mpi_E0LL2Y.sh 1ei0_min 1 2 ) + endif(UNRES_MD_FF STREQUAL "E0LL2Y") endif(NOT UNRES_WITH_MPI) diff --git a/source/unres/src_MD/COMMON.DERIV b/source/unres/src_MD/COMMON.DERIV index 2a5ddcf..e4c39c5 100644 --- a/source/unres/src_MD/COMMON.DERIV +++ b/source/unres/src_MD/COMMON.DERIV @@ -2,7 +2,9 @@ & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp, & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, - & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT + & gradcorr6_long,gcorr6_turn_long,gvdwcT,gvdwxT,gvdwx,gloc_sc, + & dcostau,dsintau,dtauangle,dcosomicron, + & domicron integer nfl,icg common /derivatT/ gvdwcT(3,maxres),gvdwxT(3,maxres) common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), @@ -21,7 +23,10 @@ & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar),gcorr_loc(maxvar), & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), & gsccorx(3,maxres),gsccor_loc(maxres),dtheta(3,2,maxres), - & gscloc(3,maxres),gsclocx(3,maxres), + & gscloc(3,maxres),gsclocx(3,maxres),gloc_sc(3,0:maxres2,10), + & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), + & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), + & domicron(3,3,3,maxres2), & dphi(3,3,maxres),dalpha(3,3,maxres),domega(3,3,maxres),nfl,icg double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) diff --git a/source/unres/src_MD/COMMON.REMD b/source/unres/src_MD/COMMON.REMD index 182acae..b283b5b 100644 --- a/source/unres/src_MD/COMMON.REMD +++ b/source/unres/src_MD/COMMON.REMD @@ -17,7 +17,7 @@ common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, & iset_restart1 real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache, + & qfrag_cache,qpair_cache,c_cache,uscdiff_cache, & ugamma_cache,utheta_cache integer ntwx_cache,ii_write,max_cache_traj_use common /traj1cache/ totT_cache(max_cache_traj), diff --git a/source/unres/src_MD/COMMON.SBRIDGE b/source/unres/src_MD/COMMON.SBRIDGE index d75482c..91dd2cd 100644 --- a/source/unres/src_MD/COMMON.SBRIDGE +++ b/source/unres/src_MD/COMMON.SBRIDGE @@ -1,12 +1,17 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss integer ns,nss,nfree,iss - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, & ns,nss,nfree,iss(maxss) double precision dhpb,dhpb1,forcon - integer ihpb,jhpb,nhpb + integer ihpb,jhpb,nhpb,idssb,jdssb common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb double precision weidis common /restraints/ weidis integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim), + & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/unres/src_MD/COMMON.SCCOR b/source/unres/src_MD/COMMON.SCCOR index 395e4e2..623bbad 100644 --- a/source/unres/src_MD/COMMON.SCCOR +++ b/source/unres/src_MD/COMMON.SCCOR @@ -1,17 +1,20 @@ cc Parameters of the SCCOR term double precision v1sccor,v2sccor,vlor1sccor, - & vlor2sccor,vlor3sccor,gloc_sc, - & dcostau,dsintau,dtauangle,dcosomicron, - & domicron + & vlor2sccor,vlor3sccor,v0sccor +C,gloc_sc, +C & dcostau,dsintau,dtauangle,dcosomicron, +C & domicron,v0sccor integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor - common/sccor/v1sccor(maxterm_sccor,3,20,20), - & v2sccor(maxterm_sccor,3,20,20), + common/sccor/v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v0sccor(-ntyp:ntyp,-ntyp:ntyp), + & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), + & nsccortyp, + & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp), & vlor1sccor(maxterm_sccor,20,20), & vlor2sccor(maxterm_sccor,20,20), - & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), - & v0sccor(ntyp,ntyp), - & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), - & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), - & domicron(3,3,3,maxres2), - & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp, - & nlor_sccor(ntyp,ntyp) + & vlor3sccor(maxterm_sccor,20,20) +C,gloc_sc(3,0:maxres2,10), +C & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), +C & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), +C & domicron(3,3,3,maxres2) diff --git a/source/unres/src_MD/MD_A-MTS.F b/source/unres/src_MD/MD_A-MTS.F index 95f174d..ffafe1d 100644 --- a/source/unres/src_MD/MD_A-MTS.F +++ b/source/unres/src_MD/MD_A-MTS.F @@ -2076,8 +2076,8 @@ c write (iout,*) "RANDOM_VEL dimen",dimen lowb=-5*sigv highb=5*sigv d_t_work_new(ii)=anorm_distr(xv,sigv,lowb,highb) -c write (iout,*) "i",i," ii",ii," geigen",geigen(i), -c & " d_t_work_new",d_t_work_new(ii) + write (iout,*) "i",i," ii",ii," geigen",geigen(i), + & " d_t_work_new",d_t_work_new(ii) enddo enddo call flush(iout) @@ -2101,8 +2101,8 @@ c Transform velocities to UNRES coordinate space d_t_work(ind)=d_t_work(ind) & +Gvec(i,j)*d_t_work_new((j-1)*3+k+1) enddo -c write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) -c call flush(iout) + write (iout,*) "i",i," ind",ind," d_t_work",d_t_work(ind) + call flush(iout) enddo enddo c Transfer to the d_t vector @@ -2128,10 +2128,10 @@ c call flush(iout) enddo endif enddo -c call kinetic(EK) -c write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", -c & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 -c call flush(iout) + call kinetic(EK) + write (iout,*) "Kinetic energy",Ek,EK1," kinetic temperature", + & 2.0d0/(dimen3*Rb)*EK,2.0d0/(dimen3*Rb)*EK1 + call flush(iout) return end #ifndef LANG0 diff --git a/source/unres/src_MD/MREMD.F b/source/unres/src_MD/MREMD.F index 0e4045f..c440bb7 100644 --- a/source/unres/src_MD/MREMD.F +++ b/source/unres/src_MD/MREMD.F @@ -1704,8 +1704,13 @@ ctime call flush(iout) call xdrffloat_(ixdrf, real(t_restart1(4,il)), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint_(ixdrf, idssb(j)+nres, iret) + call xdrfint_(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint_(ixdrf, iset_restart1(il), iret) @@ -1742,8 +1747,13 @@ ctime call flush(iout) call xdrffloat(ixdrf, real(t_restart1(4,il)), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) call xdrfint(ixdrf, iset_restart1(il), iret) @@ -1828,7 +1838,6 @@ ctime call flush(iout) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) common /przechowalnia/ d_restart1 - integer i2set_(0:maxprocs) write (*,*) "Processor",me," called read1restart" if(me.eq.king)then @@ -1987,16 +1996,18 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) enddo endif #endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its +Corrected AL 8/19/2014: each processor needs whole iset array not only its c own element c call mpi_scatter(i2set,1,mpi_integer, c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) +c & CG_COMM,ierr) call mpi_bcast(i2set(0),nodes,mpi_integer,king, & CG_COMM,ierr) iset=i2set(me) + endif + if(me.eq.king) close(irest2) return end diff --git a/source/unres/src_MD/Makefile-intrepid-with-tau b/source/unres/src_MD/Makefile-intrepid-with-tau deleted file mode 100644 index eae1cc5..0000000 --- a/source/unres/src_MD/Makefile-intrepid-with-tau +++ /dev/null @@ -1,154 +0,0 @@ -# -FC1=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -FC=tau_f90.sh -OPT = -O3 -qarch=450 -qtune=450 -qfixed -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT = -O -qarch=450 -qtune=450 -qfixed -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT = -O0 -C -g -qarch=450 -qtune=450 -qfixed -OPT1 = -O0 -g -qarch=450 -qtune=450 -qfixed -OPT2 = -O2 -qarch=450 -qtune=450 -qfixed -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPT2 = ${OPT} -OPTE = -O4 -qarch=450 -qtune=450 -qfixed -#OPTE = -O4 -qarch=450 -qtune=450 -qdebug=function_trace -qfixed -#OPTE=${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-gnivpar-O4-test.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} --print-map ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o; /bin/rm *.pp.* - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS1} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -compinfo: compinfo.o - ${CC} ${CFLAGS} compfinfo.c - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -prng_32.o: prng_32.F - ${FC} -qfixed -O0 prng_32.F - -prng.o: prng.f - ${FC1} ${FFLAGS} prng.f - -readrtns_CSA.o: readrtns_CSA.F - ${FC1} ${FFLAGS} ${CPPFLAGS} readrtns_CSA.F - -gen_rand_conf.o: gen_rand_conf.F - ${FC1} ${FFLAGS} ${CPPFLAGS} gen_rand_conf.F diff --git a/source/unres/src_MD/Makefile.tau-mpi-f77-pdt b/source/unres/src_MD/Makefile.tau-mpi-f77-pdt deleted file mode 100644 index c8dc5fe..0000000 --- a/source/unres/src_MD/Makefile.tau-mpi-f77-pdt +++ /dev/null @@ -1,860 +0,0 @@ -#**************************************************************************** -#* TAU Portable Profiling Package ** -#* http://www.cs.uoregon.edu/research/tau ** -#**************************************************************************** -#* Copyright 1997-2002 ** -#* Department of Computer and Information Science, University of Oregon ** -#* Advanced Computing Laboratory, Los Alamos National Laboratory ** -#**************************************************************************** -####################################################################### -## pC++/Sage++ Copyright (C) 1993,1995 ## -## Indiana University University of Oregon University of Rennes ## -####################################################################### - -####################################################################### -# This is a sample Makefile that contains the Profiling and Tracing -# options. Makefiles of other applications and libraries (not included -# in this distribution) should include this Makefile. -# It defines the following variables that should be added to CFLAGS -# TAU_INCLUDE - Include path for tau headers -# TAU_DEFS - Defines that are needed for tracing and profiling only. -# And for linking add to LIBS -# TAU_LIBS - TAU Tracing and Profiling library libprof.a -# -# When the user needs to turn off tracing and profiling and run the -# application without any runtime overhead of instrumentation, simply -# remove TAUDEFS and TAULIBS from CFLAGS and LIBS respectively but keep -# TAUINC. -####################################################################### - -########### Automatically modified by the configure script ############ -CONFIG_ARCH=bgp -TAU_ARCH=bgp -CONFIG_CC=bgxlc_r -CONFIG_CXX=bgxlC_r -TAU_CC_FE=$(CONFIG_CC) -TAU_CXX_FE=$(CONFIG_CXX) - -# Front end C/C++ Compilers -#BGL#TAU_CC_FE=xlc #ENDIF# -#BGL#TAU_CXX_FE=xlC #ENDIF# -TAU_CC_FE=xlc #ENDIF##BGP# -TAU_CXX_FE=xlC #ENDIF##BGP# -#CATAMOUNT#TAU_CC_FE=gcc #ENDIF# -#CATAMOUNT#TAU_CXX_FE=g++ #ENDIF# -#SC_GFORTRAN#TAU_CC_FE=gcc #ENDIF# -#SC_GFORTRAN#TAU_CXX_FE=g++ #ENDIF# -#SC_PATHSCALE#TAU_CC_FE=gcc #ENDIF# -#SC_PATHSCALE#TAU_CXX_FE=g++ #ENDIF# - -PCXX_OPT=-g -USER_OPT= -EXTRADIR=/opt/ibmcmp/xlf/bg/11.1/bin/.. -EXTRADIRCXX=/opt/ibmcmp/vacpp/bg/9.0/bin/.. -TAUROOT=/soft/apps/tau/tau_latest -TULIPDIR= -TAUEXTRASHLIBOPTS= -TAUGCCLIBOPTS= -TAUGCCLIBDIR= -TAUGFORTRANLIBDIR= -PCLDIR= -PAPIDIR= -PAPISUBDIR= -CHARMDIR= -PDTDIR=/soft/apps/tau/pdtoolkit-3.12 -PDTCOMPDIR= -DYNINSTDIR= -JDKDIR= -SLOG2DIR= -OPARIDIR= -TAU_OPARI_TOOL= -EPILOGDIR= -EPILOGBINDIR= -EPILOGINCDIR= -EPILOGLIBDIR= -EPILOGEXTRALINKCMD= -VAMPIRTRACEDIR= -KTAU_INCDIR= -KTAU_INCUSERDIR= -KTAU_LIB= -KTAU_KALLSYMS_PATH= -PYTHON_INCDIR= -PYTHON_LIBDIR= -PERFINCDIR= -PERFLIBDIR= -PERFLIBRARY= -TAU_SHMEM_INC= -TAU_SHMEM_LIB= -TAU_CONFIG=-mpi-pdt -TAU_MPI_INC=-I/bgsys/drivers/ppcfloor/comm/include -TAU_MPI_LIB=-L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_FLIB=-lfmpich.cnk -L/soft/apps/tau/tau_latest/bgp/lib -lTauMpi$(TAU_CONFIG) -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPILIB_DIR=/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_LIB= -L/bgsys/drivers/ppcfloor/comm/lib -TAU_MPI_NOWRAP_FLIB=-lfmpich.cnk -L/bgsys/drivers/ppcfloor/comm/lib -FULL_CXX=mpixlcxx_r -FULL_CC=mpixlc_r -TAU_PREFIX_INSTALL_DIR=/soft/apps/tau/tau_latest - -TAU_BIN_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/bin -TAU_INC_DIR=$(TAU_PREFIX_INSTALL_DIR)/include -TAU_LIB_DIR=$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/lib - -####################################################################### - -#OPARI#TAU_OPARI_TOOL=$(TAU_BIN_DIR)/opari #ENDIF# -#ENABLE64BIT#ABI = -64 #ENDIF# -#ENABLEN32BIT#ABI = -n32 #ENDIF# -#ENABLE32BIT#ABI = -32 #ENDIF# - -####################################################################### -#SP1#IBM_XLC_ABI = -q32 #ENDIF# -#SP1#IBM_GNU_ABI = -maix32 #ENDIF# -#IBM64#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64#IBM_GNU_ABI = -maix64 #ENDIF# -#IBM64LINUX#IBM_XLC_ABI = -q64 #ENDIF# -#IBM64LINUX#IBM_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_GNU_ABI = -m64 #ENDIF# -#SUNX86_64#SUN_CC_ABI = -xarch=amd64 #ENDIF# -#MIPS32LINUX#SC_GNU_ABI = -mabi=n32 #ENDIF# -#MIPS32LINUX#SC_PATH_ABI = -n32 #ENDIF# -#MIPS64LINUX#SC_GNU_ABI = -mabi=64 #ENDIF# -#MIPS64LINUX#SC_PATH_ABI = -64 #ENDIF# -#GNU#SC_ABI = $(SC_GNU_ABI) #ENDIF# -#USE_PATHCC#SC_ABI = $(SC_PATH_ABI) #ENDIF# -#MIPS32#ABI = $(SC_ABI) #ENDIF# -#MIPS64#ABI = $(SC_ABI) #ENDIF# - -IBM_ABI = $(IBM_XLC_ABI) #ENDIF##USE_IBMXLC# -#GNU#IBM_ABI = $(IBM_GNU_ABI) #ENDIF# -#SP1# ABI = $(IBM_ABI) #ENDIF# -#PPC64# ABI = $(IBM_ABI) #ENDIF# -#SOLARIS64#SUN_GNU_ABI = -mcpu=v9 -m64 #ENDIF# -#SOLARIS64#SUN_CC_ABI = -xarch=v9 -xcode=pic32 #ENDIF# -#SOL2CC#SUN_ABI = $(SUN_CC_ABI) #ENDIF# -#GNU#SUN_ABI = $(SUN_GNU_ABI) #ENDIF# -#SOL2#ABI = $(SUN_ABI) #ENDIF# -#SUNX86_64#ABI = $(SUN_ABI) #ENDIF# -#FORCEIA32#ABI = -m32#ENDIF# -####################################################################### -F90_ABI = $(ABI) -#IBM64_FORTRAN#F90_ABI = -q64 #ENDIF# -####################################################################### - -############# Standard Defines ############## -TAU_CC = $(CONFIG_CC) $(ABI) $(ISA) -TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -TAU_RUN_CC = $(FULL_CC) $(ABI) $(ISA) -TAU_RUN_CXX = $(FULL_CXX) $(ABI) $(ISA) -TAU_INSTALL = /bin/cp -TAU_SHELL = /bin/sh -LSX = .a -############################################# -# JAVA DEFAULT ARCH -############################################# -JDKARCH = linux -#COMPAQ_ALPHA#JDKARCH = alpha #ENDIF# -#SOL2#JDKARCH = solaris #ENDIF# -#SGIMP#JDKARCH = irix #ENDIF# -#SP1#JDKARCH = aix #ENDIF# -#T3E#JDKARCH = cray #ENDIF# -############################################# -# JAVA OBJECTS -############################################# -#JAVA#TAU_JAVA_O = TauJava.o TauJAPI.o #ENDIF# -#JAVA#TAUJAPI = Profile.class #ENDIF# - - -############################################# -# OpenMP OBJECTS -############################################# -#OPENMP#OPENMP_O = OpenMPLayer.o #ENDIF# - -############################################# -# Opari OBJECTS -############################################# -#OPARI#OPARI_O = TauOpari.o #ENDIF# -#KOJAKOPARI#OPARI_O = TauKojakOpari.o #ENDIF# -#EPILOG#OPARI_O = #ENDIF# -#VAMPIRTRACE#OPARI_O = #ENDIF# -#GNU#OPARI_O = #ENDIF# - -############################################# -# CallPath OBJECTS -############################################# -#PROFILECALLPATH#CALLPATH_O = TauCallPath.o #ENDIF# -#PROFILEPARAM#PARAM_O = ProfileParam.o #ENDIF# - -############################################# -# Python Binding OBJECTS -############################################# -#PYTHON#PYTHON_O = PyGroups.o PyExceptions.o PyDatabase.o PyBindings.o PyTimer.o PyTau.o #ENDIF# - -############################################# -# DYNINST DEFAULT ARCH -############################################# -DYNINST_PLATFORM = $(PLATFORM) - - -#PCL##include $(TAU_INC_DIR)/makefiles/PCLMakefile.stub #ENDIF# - -############# OpenMP Fortran Option ######## -#OPENMP#TAU_F90_OPT = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_F90_OPT = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_F90_OPT = -xopenmp=parallel #ENDIF# -#COMPAQCXX_OPENMP#TAU_F90_OPT = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_F90_OPT = -qsmp=omp #ENDIF# -#GUIDE#TAU_F90_OPT = #ENDIF# -#PGIOPENMP#TAU_F90_OPT = -mp #ENDIF# -#INTELOPENMP#TAU_F90_OPT = -openmp #ENDIF# -#HITACHI_OPENMP#TAU_F90_OPT = #ENDIF# - -TAU_R =_r #ENDIF##THREADSAFE_COMPILERS# - -############# Fortran Compiler ############# -#GNU_FORTRAN#TAU_F90 = g77 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#GNU_GFORTRAN#TAU_F90 = gfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#G95_FORTRAN#TAU_F90 = g95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_GFORTRAN#TAU_F90 = scgfortran $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SGI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -TAU_F90 = xlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##IBM_FORTRAN# -TAU_F90 = mpixlf77$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF##BGP# -#BGL#TAU_F90 = blrts_xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBM64_FORTRAN#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#IBMXLFAPPLE#TAU_F90 = xlf90$(TAU_R) $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAY_X1_FORTRAN#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_FORTRAN#TAU_F90 = pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#CRAYCNL#TAU_F90 = ftn $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PGI_CATAMOUNT#TAU_F90 = qk-pgf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#ABSOFT_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#LAHEY64_FORTRAN#TAU_F90 = lf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NAGWARE_FORTRAN#TAU_F90 = f95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_FORTRAN#TAU_F90 = F90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#FUJITSU_SOLARIS#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SUN_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#COMPAQ_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#KAI_FORTRAN#TAU_F90 = guidef90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HP_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#HITACHI_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL_FORTRAN#TAU_F90 = efc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTEL32_FORTRAN#TAU_F90 = ifc $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#INTELIFORT#TAU_F90 = ifort $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#PATHSCALE_FORTRAN#TAU_F90 = pathf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#SC_PATHSCALE#TAU_F90 = scpathf95 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_F90 = orf90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# -#NEC_FORTRAN#TAU_F90 = f90 $(F90_ABI) $(TAU_F90_OPT) #ENDIF# - - -############# Portable F90 Options ############# -#IBM64_FORTRAN#TAU_F90_FIXED = -qfixed #ENDIF# -TAU_F90_FIXED = -qfixed #ENDIF##IBM_FORTRAN# -TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF##IBM_FORTRAN# -#IBMXLFAPPLE#TAU_F90_FIXED = -qfixed #ENDIF# -#IBMXLFAPPLE#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# -#IBM64_FORTRAN#TAU_F90_SUFFIX = -qsuffix=f=f90 #ENDIF# - -############# Profiling Options ############# -PROFILEOPT1 = -DPROFILING_ON #ENDIF##PROFILE# -#PCL#PROFILEOPT3 = -DTAU_PCL -I$(PCLDIR)/include #ENDIF# -#PAPI#PROFILEOPT3 = -DTAU_PAPI -I$(PAPIDIR)/src -I$(PAPIDIR)/include #ENDIF# -#PCL#PCL_O = PclLayer.o #ENDIF# -#PAPI#PAPI_O = PapiLayer.o #ENDIF# -#MULTIPLECOUNTERS#MULT_O = MultipleCounters.o #ENDIF# -#PROFILECALLS#PROFILEOPT4 = -DPROFILE_CALLS #ENDIF# -#PROFILESTATS#PROFILEOPT5 = -DPROFILE_STATS #ENDIF# -#DEBUGPROF#PROFILEOPT6 = -DDEBUG_PROF #ENDIF# -PROFILEOPT7 = -DTAU_STDCXXLIB #ENDIF##STDCXXLIB# -#CRAYX1CC#PROFILEOPT7 = #ENDIF# -#CRAYCC#PROFILEOPT7 = #ENDIF# -#INTELTFLOP#PROFILEOPT8 = -DPOOMA_TFLOP #ENDIF# -#NORTTI#PROFILEOPT9 = -DNO_RTTI #ENDIF# -#RTTI#PROFILEOPT9 = -DRTTI #ENDIF# -#GNU#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#APPLECXX#PROFILEOPT10 = -DTAU_GNU -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#SOL2CC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SUNCC#PROFILEOPT10 = -DTAU_SOL2CC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_PATHCC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -fPIC -DTAU_PATHSCALE #ENDIF# -#OPEN64ORC#PROFILEOPT10 = -DTAU_DOT_H_LESS_HEADERS -DTAU_OPEN64ORC -fpic #ENDIF# -#CALLSTACK#PROFILEOPT11 = -DPROFILE_CALLSTACK #ENDIF# -#PGI1.7#PROFILEOPT12 = -DPGI #ENDIF# -#CRAYKAI#PROFILEOPT12 = -DCRAYKAI #ENDIF# -#HP_FORTRAN#PROFILEOPT12 = -DHP_FORTRAN #ENDIF# -#CRAYCC#PROFILEOPT13 = -h instantiate=used -DCRAYCC -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#CRAYX1CC#PROFILEOPT13 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -LANG:std #ENDIF# -#INTELCXXLIBICC#TAU_CXX = $(CONFIG_CXX) $(ABI) $(ISA) $(USER_OPT) -cxxlib-icc #ENDIF# -#PTHREAD_AVAILABLE#PROFILEOPT15 = -DPTHREADS #ENDIF# -#COMPAQCXX_PTHREAD#PROFILEOPT15 = -DPTHREADS -pthread #ENDIF# -#TAU_SPROC#PROFILEOPT15 = -DTAU_SPROC #ENDIF# -#TAU_PAPI_THREADS#PROFILEOPT15 = -DTAU_PAPI_THREADS #ENDIF# -#TULIPTHREADS#PROFILEOPT16 = -DTULIPTHREADS #ENDIF# -#TRACE#TRACEOPT = -DTRACING_ON #ENDIF# -#TRACE#EVENTS_O = Tracer.o #ENDIF# -#KTAU#KTAU_O = TauKtau.o KtauProfiler.o KtauSymbols.o #ENDIF# -#KTAU_MERGE#KTAU_MERGE_O = KtauFuncInfo.o KtauMergeInfo.o ktau_syscall.o #ENDIF# -#KTAU_SHCTR#KTAU_SHCTR_O = KtauCounters.o #ENDIF# -#MPITRACE#TRACEOPT = -DTAU_MPITRACE -DTRACING_ON #ENDIF# -#MPITRACE#EVENTS_O = Tracer.o #ENDIF# -#MUSE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_EVENT#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#MUSE_MULTIPLE#MUSE_O = TauMuse.o TauMuseFilters.o TauMuseHandlers.o TauMusePackages.o #ENDIF# -#COMPENSATE#COMPENSATE_O = TauCompensate.o #ENDIF# -#PTHREAD_AVAILABLE#THR_O = PthreadLayer.o #ENDIF# -#TAU_PAPI_THREADS#THR_O = PapiThreadLayer.o #ENDIF# -#TAU_SPROC#THR_O = SprocLayer.o #ENDIF# -#JAVA#THR_O = JavaThreadLayer.o #ENDIF# -#TULIPTHREADS#THR_O = TulipThreadLayer.o #ENDIF# -#LINUXTIMERS#PLATFORM_O = TauLinuxTimers.o #ENDIF# -#TULIPTHREADS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/Tuliplib #ENDIF# -#SMARTS#PROFILEOPT17 = -I$(TULIPDIR)/include -I$(TULIPDIR)/lib -I$(TULIPDIR)/machine-specific/$(HOSTTYPE) #ENDIF# -#SMARTS#PROFILEOPT18 = -DSMARTS #ENDIF# -#KAI#PROFILEOPT19 = -DKAI -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_DECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#SGICC#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#USE_INTELCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#USE_NECCXX#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#PGI#PROFILEOPT19 = -DTAU_DOT_H_LESS_HEADERS -fPIC #ENDIF# -#ACC#PROFILEOPT19 = -AA +z -DTAU_DOT_H_LESS_HEADERS -DTAU_HPUX #ENDIF# -#FUJITSU#PROFILEOPT19 = -DFUJITSU -DTAU_DOT_H_LESS_HEADERS #ENDIF# -#KAINOEX#PROFILEOPT20 = --no_exceptions #ENDIF# -#SGICCNOEX#PROFILEOPT20 = -LANG:exceptions=off #ENDIF# -#HPGNU#PROFILEOPT21 = -fPIC #ENDIF# -#HITACHI#PROFILEOPT21 = -DTAU_HITACHI #ENDIF# -#SP1#PROFILEOPT21 = -D_POSIX_SOURCE -DTAU_AIX #ENDIF# -#PPC64#TAU_PIC_PROFILEOPT21 = -qpic=large #ENDIF# -#BGL#TAU_PIC_PROFILEOPT21 = #ENDIF# -PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC $(TAU_PIC_PROFILEOPT21) #ENDIF##USE_IBMXLC# -#IBMXLCAPPLE#PROFILEOPT21 = -DTAU_DOT_H_LESS_HEADERS -DTAU_XLC -DTAU_APPLE_XLC #ENDIF# -#PCLPTHREAD#PROFILEOPT22 = -DPCL_MUTEX_LOCK #ENDIF# -#JAVA#PROFILEOPT23 = -DJAVA #ENDIF# -#MONITOR#PROFILEOPT24 = -DMONITORING_ON #ENDIF# -#JAVA#PROFILEOPT25 = -I$(JDKDIR)/include -I$(JDKDIR)/include/$(JDKARCH) #ENDIF# -PROFILEOPT26 = -DTAU_MPI #ENDIF##MPI# -PROFILEOPT26 = -DTAU_MPI -DTAU_MPI_THREADED #ENDIF##MPI_THREADED# -#OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP#ENDIF# -#GNU#PROFILEOPT27 = #ENDIF# -#SOL2CC_OPENMP#PROFILEOPT27 = -xopenmp -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#SUNCC_OPENMP#PROFILEOPT27 = -xopenmp=parallel -DTAU_OPENMP#ENDIF# -#HITACHI_OPENMP#PROFILEOPT27 = -DTAU_OPENMP#ENDIF# -#COMPAQCXX_OPENMP#PROFILEOPT27 = -omp -DTAU_OPENMP#ENDIF# -#IBMXLC_OPENMP#PROFILEOPT27 = -qsmp=omp -DTAU_OPENMP #ENDIF# -#OPEN64_OPENMP#PROFILEOPT27 = -mp -DTAU_OPENMP #ENDIF# -#GUIDE#PROFILEOPT27 = -DTAU_OPENMP #ENDIF# -#PGIOPENMP#PROFILEOPT27 = -mp -D_OPENMP -DTAU_OPENMP -U_RWSTD_MULTI_THREAD -U_REENTRANT #ENDIF# -#INTELOPENMP#PROFILEOPT27 = -openmp -DTAU_OPENMP #ENDIF# -#GNUOPENMP#PROFILEOPT27 = -fopenmp -DTAU_OPENMP #ENDIF# -#OPARI#PROFILEOPT28 = -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_REGION#PROFILEOPT28 = -DTAU_OPARI_REGION -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#OPARI_CONSTRUCT#PROFILEOPT28 = -DTAU_OPARI_CONSTRUCT -I$(OPARIDIR)/lib -I$(OPARIDIR)/include #ENDIF# -#MULTIPLECOUNTERS#PROFILEOPT29 = -DTAU_MULTIPLE_COUNTERS #ENDIF# -#SGITIMERS#PROFILEOPT30 = -DSGI_TIMERS #ENDIF# -#BGLTIMERS#PROFILEOPT30 = -DBGL_TIMERS -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -#BGPTIMERS#PROFILEOPT30 = -DBGP_TIMERS -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF# -#CRAYTIMERS#PROFILEOPT30 = -DCRAY_TIMERS #ENDIF# -#LINUXTIMERS#PROFILEOPT31 = -DTAU_LINUX_TIMERS #ENDIF# -#ALPHATIMERS#PROFILEOPT31 = -DTAU_ALPHA_TIMERS #ENDIF# -#CPUTIME#PROFILEOPT32 = -DCPU_TIME #ENDIF# -#PAPIWALLCLOCK#PROFILEOPT33 = -DTAU_PAPI_WALLCLOCKTIME #ENDIF# -#PAPIVIRTUAL#PROFILEOPT34 = -DTAU_PAPI_VIRTUAL #ENDIF# -#SGICOUNTERS#PROFILEOPT35 = -DSGI_HW_COUNTERS #ENDIF# -#EPILOG#PROFILEOPT36 = -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#SCALASCA#PROFILEOPT36 = -DTAU_SCALASCA -DTAU_EPILOG -I$(EPILOGINCDIR) #ENDIF# -#VAMPIRTRACEINTS#TAU_VAMPIRTRACEOPTS = -DTAU_64BITTYPES_NEEDED -DHAVE_INTTYPES_H #ENDIF# -#VAMPIRTRACE#PROFILEOPT36 = -DTAU_VAMPIRTRACE -I$(VAMPIRTRACEDIR)/vtlib -I$(VAMPIRTRACEDIR)/include $(TAU_VAMPIRTRACEOPTS)#ENDIF# -#PROFILECALLPATH#PROFILEOPT36 = -DTAU_CALLPATH #ENDIF# -#PROFILEPHASE#PROFILEOPT36 = -DTAU_CALLPATH -DTAU_PROFILEPHASE#ENDIF# -#PYTHON#PROFILEOPT37 = -I$(PYTHON_INCDIR) #ENDIF# -#NOCOMM#PROFILEOPT38 = -DTAU_NOCOMM #ENDIF# -#MUSE#PROFILEOPT39 = -DTAU_MUSE #ENDIF# -#SETNODE0#PROFILEOPT40 = -DTAU_SETNODE0 #ENDIF# -#COMPENSATE#PROFILEOPT41 = -DTAU_COMPENSATE #ENDIF# -#MUSE_EVENT#PROFILEOPT42 = -DTAU_MUSE_EVENT #ENDIF# -#MUSE_MULTIPLE#PROFILEOPT43 = -DTAU_MUSE_MULTIPLE #ENDIF# -#DYNINST41##PROFILEOPT44 = -DTAU_DYNINST41BUGFIX #ENDIF# -# DyninstAPI v4.2.1 fixes the bug, so we don't need OPT44 anymore -#PROFILEMEMORY#PROFILEOPT45 = -DTAU_PROFILEMEMORY #ENDIF# -PROFILEOPT46 = -DTAU_MPIGREQUEST #ENDIF##MPIGREQUEST# -#MPIOREQUEST#PROFILEOPT47 = -DTAU_MPIOREQUEST #ENDIF# -PROFILEOPT48 = -DTAU_MPIDATAREP #ENDIF##MPIDATAREP# -PROFILEOPT49 = -DTAU_MPIERRHANDLER #ENDIF##MPIERRHANDLER# -#CATAMOUNT#PROFILEOPT50 = -DTAU_CATAMOUNT #ENDIF# -#MPICONSTCHAR#PROFILEOPT51 = -DTAU_MPICONSTCHAR #ENDIF# -PROFILEOPT52 = -DTAU_MPIATTRFUNCTION #ENDIF##MPIATTR# -PROFILEOPT53 = -DTAU_MPITYPEEX #ENDIF##MPITYPEEX# -PROFILEOPT54 = -DTAU_MPIADDERROR #ENDIF##MPIADDERROR# -#MPINEEDSTATUSCONV#PROFILEOPT55 = -DTAU_MPI_NEEDS_STATUS #ENDIF# - -#DEPTHLIMIT#PROFILEOPT56 = -DTAU_DEPTH_LIMIT #ENDIF# -#TAU_CHARM#PROFILEOPT57 = -DTAU_CHARM -I$(CHARMDIR)/include #ENDIF# -#PROFILEHEADROOM#PROFILEOPT58 = -DTAU_PROFILEHEADROOM #ENDIF# -#JAVACPUTIME#PROFILEOPT59 = -DJAVA_CPU_TIME #ENDIF# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE #ENDIF##TAU_LARGEFILE# -PROFILEOPT60 = -DTAU_LARGEFILE -D_LARGEFILE64_SOURCE -D__xlc__ #ENDIF##BGP# -# Omit the -D_LARGETFILE64_SOURCE till we can check the IBM crash -#SHMEM#PROFILEOPT61 = -DTAU_SHMEM #ENDIF# -#KTAU#PROFILEOPT62 = -DTAUKTAU -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -I$(KTAU_INCUSERDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU_MERGE#PROFILEOPT63 = -DTAUKTAU_MERGE -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#FREEBSD#PROFILEOPT64 = -DTAU_FREEBSD #ENDIF# -#PROFILEPARAM#PROFILEOPT65 = -DTAU_PROFILEPARAM #ENDIF# -#IBMMPI#PROFILEOPT66 = -DTAU_IBM_MPI #ENDIF# -#WEAKMPIINIT#PROFILEOPT67 = -DTAU_WEAK_MPI_INIT #ENDIF# -#LAMPI#PROFILEOPT68 = -DTAU_LAMPI #ENDIF# -#MPICH_IGNORE_CXX_SEEK#PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF# -PROFILEOPT68 = -DMPICH_IGNORE_CXX_SEEK #ENDIF##BGP# -#MPICH2_MPI_INPLACE#PROFILEOPT73 = -DTAU_MPICH2_MPI_IN_PLACE #ENDIF# - - -############# RENCI Scalable Trace Lib Options ############# -STFF_DIR= -SDDF_DIR= -#RENCI_STFF#PROFILEOPT69 = -DRENCI_STFF -I$(STFF_DIR)/include #ENDIF# -#RENCI_STFF#TAU_LINKER_OPT11 = -L$(STFF_DIR)/lib -lstff -L$(SDDF_DIR)/lib -lPablo $(TAU_MPI_LIB) #ENDIF# -#RENCI_STFF#RENCI_STFF_O = RenciSTFF.o #ENDIF# - -############# KTAU (again) ############# -#KTAU_SHCTR#PROFILEOPT70 = -DTAUKTAU_SHCTR -DKTAU_USER_SRC_COMPILE -I$(KTAU_INCDIR) -DKTAU_INCUSERDIR=\"$(KTAU_INCUSERDIR)\" -DKTAU_KALLSYMS_PATH=\"$(KTAU_KALLSYMS_PATH)\" #ENDIF# -#KTAU#TAU_LINKER_OPT12 = -L$(KTAU_LIB) -lktau #ENDIF# - -#MIPS32LINUX#PROFILEOPT71 = -D_ABIN32=2 -D_MIPS_SIM=_ABIN32 #ENDIF# - -#BGL#PROFILEOPT72 = -DTAU_BGL -I/bgl/BlueLight/ppcfloor/bglsys/include #ENDIF# -PROFILEOPT72 = -DTAU_BGP -I/bgsys/drivers/ppcfloor/arch/include/common -I/bgsys/drivers/ppcfloor/arch/include -I/bgsys/drivers/ppcfloor/arch/include/spi #ENDIF##BGP# - -#For F90 support for all platforms -FWRAPPER = TauFMpi.o -MPI2EXTENSIONS = TauMpiExtensions.o #ENDIF##MPI2# -MPI2EXTENSIONS = #ENDIF##BGP# -#CRAYX1CC#MPI2EXTENSIONS = #ENDIF# - -#SGICOUNTERS#LEXTRA = -lperfex #ENDIF# -#ALPHATIMERS#LEXTRA = -lrt #ENDIF# -#SOL2#PCL_EXTRA_LIBS = -lcpc #ENDIF# -#PCL#LEXTRA = -L$(PCLDIR)/lib -lpcl $(PCL_EXTRA_LIBS) #ENDIF# -#PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#IA64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# -#Due to some problems with older versions of libpfm, we are using the static lib -#IA64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#PAPIPFM##LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpfm -lpapi -lpfm #ENDIF# -#X86_64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR)/ -L$(PAPIDIR)/lib64/ -lpapi -lperfctr #ENDIF# -#SOL2PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -lcpc #ENDIF# -#IBMPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi#ENDIF# -#PPC64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#BGLPAPI_RTS#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.rts.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGLPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgl/BlueLight/ppcfloor/bglsys/lib -lbgl_perfctr.rts -lrts.rts -ldevices.rts #ENDIF# -#BGPPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a -L/bgsys/drivers/ppcfloor/runtime/SPI -lSPI.cna #ENDIF# -#IBM64PAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi64.a -L/usr/lpp/pmtoolkit/lib -L/usr/pmapi/lib -lpmapi #ENDIF# -#IBM64PAPILINUX#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a #ENDIF# -#SGI64PAPI#LEXTRA = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi64 #ENDIF# -#ALPHAPAPI#LEXTRA = $(PAPIDIR)/$(PAPISUBDIR)/libpapi.a /usr/lib/dcpi/dadd.a -lclu -lrt #ENDIF# - -TAU_PAPI_EXTRA_FLAGS = $(LEXTRA) -#IA64PAPI#TAU_PAPI_EXTRA_FLAGS = -L$(PAPIDIR)/$(PAPISUBDIR) -lpapi #ENDIF# - - -# By default make TAU_PAPI_RPATH null. Support it on a compiler by compiler basis. -#PAPI###TAU_PAPI_RPATH = -rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#PAPI##TAU_PAPI_RPATH = #ENDIF# -#PPC64PAPI#TAU_PAPI_RPATH = #ENDIF# -#BGLPAPI#TAU_PAPI_RPATH = #ENDIF# -#BGPPAPI#TAU_PAPI_RPATH = #ENDIF# -#USE_INTELCXX#TAU_PAPI_RPATH = #ENDIF# -#CRAYX1CC#TAU_PAPI_RPATH = #ENDIF# -#PGI#TAU_PAPI_RPATH = -R$(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#GNU#TAU_PAPI_RPATH = -Wl,-rpath $(PAPIDIR)/$(PAPISUBDIR) #ENDIF# -#USE_PATHCC#TAU_PAPI_RPATH = #ENDIF# - -# if the user has specified -cc=gcc -c++=g++ -fortran=intel, we shouldn't use -rpath -# because they are likely going to link with ifort -#INTEL32_FORTRAN#TAU_PAPI_RPATH = #ENDIF# -#SOL2PAPI#TAU_PAPI_RPATH = #ENDIF# -#IBMPAPI#TAU_PAPI_RPATH = #ENDIF# -#IBM64PAPI#TAU_PAPI_RPATH = #ENDIF# -#PAPI#TAU_LINKER_OPT1 = $(TAU_PAPI_RPATH) #ENDIF# - -#PTHREAD_AVAILABLE#LEXTRA1 = -lpthread #ENDIF# -#TULIPTHREADS#LEXTRA1 = -L$(TULIPDIR)/Tuliplib -ltulip #ENDIF# -#SMARTS##include $(TAU_INC_DIR)/makefiles/GNUmakefile-$(HOSTTYPE) #ENDIF# -#SMARTS#LEXTRA1 = $(LSMARTS) #ENDIF# - -TAU_GCCLIB = -lgcc_s -TAU_GCCLIB = #ENDIF##BGP# -#INTEL32_ON_64#TAU_GCCLIB = -lgcc #ENDIF# -#FREEBSD#TAU_GCCLIB = -lgcc #ENDIF# -#BGL#TAU_GCCLIB = -lgcc #ENDIF# -#GNU#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC_FORTRAN#TAU_FORTRANLIBS = -lfortran -lffio #ENDIF# -#PATHSCALE_FORTRAN#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#SC_PATHSCALE#TAU_FORTRANLIBS = -lpathfstart -lpathfortran #ENDIF# -#NAGWARE_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/quickfit.o -L$(EXTRADIR)/lib -lf96 #ENDIF# -#G95_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR) -lf95 #ENDIF# -#GNU_FORTRAN#TAU_FORTRANLIBS = -lg2c #ENDIF# -#GNU_GFORTRAN#TAU_FORTRANLIBS = -L$(TAUGFORTRANLIBDIR) -lgfortran -lgfortranbegin #ENDIF# -#SC_GFORTRAN#TAU_FORTRANLIBS = -lgfortran -lgfortranbegin #ENDIF# -#SGI_FORTRAN#TAU_FORTRANLIBS = -lfortran -lftn #ENDIF# -TAU_IBM_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 /lib/crt0.o -lxlf90 -lm -lc #ENDIF# -TAU_FORTRANLIBS = $(TAU_IBM_FORTRANLIBS) #ENDIF##IBM_FORTRAN# - -TAU_IBM64_FORTRANLIBS = -bh:4 -bpT:0x10000000 -bpD:0x20000000 -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM64_FORTRANLIBS = -Wl,-bh:4 -Wl,-bpT:0x10000000 -Wl,-bpD:0x20000000 -Wl,-b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#KAI#TAU_IBM64_FORTRANLIBS = --backend -bh:4 --backend -bpT:0x10000000 --backend -bpD:0x20000000 --backend -b64 /lib/crt0_64.o -lxlf90 -lm -lc #ENDIF# -#IBM64_FORTRAN#TAU_FORTRANLIBS = $(TAU_IBM64_FORTRANLIBS) #ENDIF# -#IBM64_FORTRAN#TAU_FORLIBDIR=lib64 #ENDIF# -TAU_FORLIBDIR=lib #ENDIF##IBM_FORTRAN# -#BGL#TAU_FORLIBDIR=blrts_dev_lib #ENDIF# -TAU_FORLIBDIR=bglib #ENDIF##BGP# -#PPC64#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath -lxl #ENDIF# -#BGL#TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -L$(EXTRADIR)/blrts_lib -lxlf90 -lxlfmath -lxl #ENDIF# - -TAU_BGL_OMP_SERIAL= -lxlomp_ser #ENDIF##BGP# -#OPENMP#TAU_BGL_OMP_SERIAL= #ENDIF# -TAU_OMP_SERIAL=$(TAU_BGL_OMP_SERIAL) #ENDIF##BGP# -TAU_FORTRANLIBS = -L$(EXTRADIR)/$(TAU_FORLIBDIR) -lxlf90 -lxlfmath $(TAU_OMP_SERIAL) #ENDIF##BGP# - -#IBMXLFAPPLE#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lxlf90 -lxlfmath -lxl #ENDIF# - -#CRAY_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#CRAY_X1_FORTRAN#TAU_FORTRANLIBS = #ENDIF# -#PGI_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/f90main.o -lpgf90 -lpgf90rtl -lpgf90_rpm1 -lpgf902 -lpgftnrtl -lrt #ENDIF# -#HP_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib/pa2.0 -lF90 -lcl #ENDIF# -#INTEL_FORTRAN#TAU_FORTRANLIBS = -lcprts -lPEPCF90 #ENDIF# -#INTEL32_FORTRAN#TAU_FORTRANLIBS = -lcprts -lCEPCF90 -lF90 #ENDIF# -#INTELIFORT#TAU_FORTRANLIBS = -lcprts #ENDIF# -#INTEL81FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTEL10FIX#TAU_FORTRANLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#INTELCXXLIBICC#TAU_FORTRANLIBS = -lcprts -L$(EXTRADIR)/lib -lifcore $(EXTRADIR)/lib/for_main.o #ENDIF# -#PGI1.7#LEXTRA = -lstd -lstrm#ENDIF# -#PGI1.7#TAUHELPER = $(TAUROOT)/src/Profile/TauPGIHelper.cpp #ENDIF# -# LINKER OPTIONS -TAU_LINKER_OPT2 = $(LEXTRA) - - -#ACC#TAUHELPER = -AA #ENDIF# -#FUJITSU_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 #ENDIF# -#FUJITSU_SOLARIS#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj90l -lfj90f #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS = -lfui -lfsumai -lfprodai -lfminlai -lfmaxlai -lfminvai -lfmaxvai -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUN_OPTERON = -lfsu -lsunmath #ENDIF# -#SUN_FORTRAN#TAU_FORTRANLIBS_SUNCC = -lfsu #ENDIF# -#SUN386I#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNX86_64#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_FORTRANLIBS = $(TAU_FORTRANLIBS_SUNCC) #ENDIF# -#SOL2#EXTRALIBS = -lsocket -lnsl #ENDIF# -#SUN386I#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#SUNX86_64#EXTRALIBS = -lsocket -lnsl -lrt #ENDIF# -#COMPAQ_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -L$(EXTRADIR)/lib -L$(EXTRADIR)/lib/cmplrs/fort90 -L$(EXTRADIR)/lib/cmplrs/fort90 -lUfor -lfor -lFutil -lm -lmld -lexc -lc #ENDIF# -#ABSOFT_FORTRAN#TAU_FORTRANLIBS = -L$(EXTRADIR)/lib -lfio -lf90math -lU77 -lf77math -lfio #ENDIF# -#LAHEY_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib/fj90rt0.o -L$(EXTRADIR)/lib -lfj9i6 -lfj9f6 -lfj9e6 -lfccx86_6a #ENDIF# -#LAHEY64_FORTRAN#TAU_FORTRANLIBS = $(EXTRADIR)/lib64/fj90rt0.o -L$(EXTRADIR)/lib64 -lfj90f -lfj90i -lelf #ENDIF# -#HITACHI_FORTRAN#TAU_FORTRANLIBS = -lf90 -lhf90math #ENDIF# -#NEC_FORTRAN#TAU_FORTRANLIBS = -f90lib #ENDIF# -#COMPAQ_GUIDEF90#TAU_FORTRANLIBS = $(EXTRADIR)/lib/cmplrs/fort90/for_main.o -lfor #ENDIF# - - -#HITACHI#TAU_HITACHI_EXTRA = -L/usr/local/lib -llrz32 #ENDIF# - -## To use the standard F90 linker instead of TAU_LINKER + TAU_FORTRANLIBS, add -#GNU#TAU_CXXLIBS = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#GNU#TAU_GNUCXXLIBS = -L$(TAUGCCLIBDIR) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#OPEN64ORC#TAU_CXXLIBS = -lstdc++ #ENDIF# -#PATHSCALE_FORTRAN#TAU_CXXLIBS = -lstdc++ #ENDIF# -#LAHEY_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#NAGWARE_FORTRAN#TAU_CXXLIBS = $(TAU_GNUCXXLIBS) /usr/lib/libc.a #ENDIF# -#PGI#TAU_CXXLIBS = -lstd -lC #ENDIF# -#CRAYCNL#TAU_CXXLIBS = -L$(EXTRADIR)/lib -lstd -lC -lpgc #ENDIF# -#CRAYX1CC#TAU_CXXLIBS = -L/opt/ctl/CC/CC/lib -lC #ENDIF# - -TAU_SGI_INIT = /usr/lib32/c++init.o -#ENABLE64BIT#TAU_SGI_INIT = /usr/lib64/c++init.o #ENDIF# -#ENABLEN32BIT#TAU_SGI_INIT = /usr/lib32/c++init.o #ENDIF# -#ENABLE32BIT#TAU_SGI_INIT = /usr/lib/c++init.o #ENDIF# - -#SGICC#TAU_CXXLIBS = $(TAU_SGI_INIT) -lC #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstd -lC #ENDIF# -#SOL2#TAU_CXXLIBS = -lCstd -lCrun #ENDIF# -#SOL2CC#TAU_CXXLIBS_SUN_OPTERON = -lCstd -lCrun -lm #ENDIF# -#SUNCC#TAU_CXXLIBS_SUNCC = -lCstd -lCrun #ENDIF# -#SUN386I#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#SUNCC#TAU_CXXLIBS = $(TAU_CXXLIBS_SUNCC) #ENDIF# -#SUNX86_64#TAU_CXXLIBS = $(TAU_CXXLIBS_SUN_OPTERON) #ENDIF# -#FUJITSU_SOLARIS#TAU_CXXLIBS = -lstd -lstdm #ENDIF# -#PPC64#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#IBMXLCAPPLE#TAU_FORLIBDIR =lib #ENDIF# -#IBMXLCAPPLE#TAU_XLCLIBS = -L$(EXTRADIRCXX)/$(TAU_FORLIBDIR) -libmc++ -lstdc++ #ENDIF# -#BGL#TAU_XLCLIBS = -L$(EXTRADIRCXX)/blrts_dev_lib -L$(EXTRADIRCXX)/blrts_lib -libmc++ -L/bgl/BlueLight/ppcfloor/blrts-gnu/powerpc-bgl-blrts-gnu/lib -lstdc++ #ENDIF# -TAU_XLCLIBS = -L$(EXTRADIRCXX)/bglib -libmc++ -lstdc++ #ENDIF##BGP# -#SP1#TAU_XLCLIBS = -lC #ENDIF# -TAU_CXXLIBS = $(TAU_XLCLIBS) #ENDIF##USE_IBMXLC# -#USE_DECCXX#TAU_CXXLIBS = -lcxxstd -lcxx #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts -lPEPCF90 #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTELIFORT#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#INTEL81FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) -lcxa -lunwind#ENDIF# -#INTEL10FIX#TAU_CXXLIBS_INTEL = -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lstdc++ $(TAU_GCCLIB) #ENDIF# -#INTELCXXLIBICC#TAU_CXXLIBS_INTEL = -lcprts #ENDIF# -#USE_INTELCXX#TAU_CXXLIBS = $(TAU_CXXLIBS_INTEL) #ENDIF# -#APPLECXX#TAU_CXXLIBS = -lstdc++ -L$(TAUGCCLIBDIR) $(TAUGCCLIBOPTS) -lgcc_s.1 -lSystemStubs #ENDIF# - -# EXTERNAL PACKAGES: VAMPIRTRACE -#VAMPIRTRACE#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.mpi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMPI#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.ompi -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# -#VAMPIRTRACEOMP#TAU_LINKER_OPT3 = -L$(VAMPIRTRACEDIR)/lib -L$(VAMPIRTRACEDIR)/vtlib -lvt.omp -lotf -lz $(TAU_HITACHI_EXTRA) #ENDIF# - -# EXTERNAL PACKAGES: EPILOG -#SCALASCA#TAU_ELG_SERIAL_SUFFIX =.ser #ENDIF# -#EPILOG#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg$(TAU_ELG_SERIAL_SUFFIX) $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.mpi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMPI#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.ompi $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# -#EPILOGOMP#TAU_LINKER_OPT3 = -L$(EPILOGLIBDIR) -lelg.omp $(EPILOGEXTRALINKCMD) $(TAU_HITACHI_EXTRA) #ENDIF# - -# When using shared, we don't want -lelg.mpi or -lvt.mpi showing up -#FORCESHARED#TAU_LINKER_OPT3=#ENDIF# - -TAU_LINKER_OPT4 = $(LEXTRA1) -#HITACHI_OPENMP#TAU_LINKER_OPT4 = -lcompas -lpthreads -lc_r #ENDIF# -#OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#SOL2CC_OPENMP#TAU_LINKER_OPT5 = -xopenmp #ENDIF# -#SUNCC_OPENMP#TAU_LINKER_OPT5 = -xopenmp=parallel #ENDIF# -#GNU#TAU_LINKER_OPT5 = #ENDIF# -#COMPAQCXX_OPENMP#TAU_LINKER_OPT5 = -omp #ENDIF# -#IBMXLC_OPENMP#TAU_LINKER_OPT5 = -qsmp=omp #ENDIF# -#OPEN64_OPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#GUIDE#TAU_LINKER_OPT5 = #ENDIF# -#PGIOPENMP#TAU_LINKER_OPT5 = -mp #ENDIF# -#INTELOPENMP#TAU_LINKER_OPT5 = -openmp #ENDIF# - -# MALLINFO needs -lmalloc on sgi, sun -#SGIMP#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SOL2#TAU_LINKER_OPT6 = #ENDIF# -#SUN386I#TAU_LINKER_OPT6 = -lmalloc #ENDIF# -#SUNX86_64#TAU_LINKER_OPT6 = -lmalloc #ENDIF# - -# We need -lCio with SGI CC 7.4+ -#SGICC#TAU_LINKER_OPT7 = -lCio #ENDIF# - -# charm -#TAU_CHARM#TAU_LINKER_OPT8 = -lconv-core #ENDIF# - -# extra libs -#SUN386I#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SUNX86_64#TAU_LINKER_OPT9 = $(EXTRALIBS) #ENDIF# -#SOL2#TAU_LINKER_OPT9 = $(ExTRALIBS) #ENDIF# - -#BGL#TAU_LINKER_OPT10 = -L/bgl/BlueLight/ppcfloor/bglsys/lib -lrts.rts #ENDIF# - -TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_PYTHON_SHFLAG = -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp -Wl,-einitpytau#ENDIF# -#KAI#TAU_IBM_PYTHON_SHFLAG = --backend -Wl,-bI:$(PYTHON_LIBDIR)/config/python.exp --backend -Wl,-einitpytau#ENDIF# -#ACC#TAU_HPUX_PYTHON_SHFLAG = -lstd_v2 -lCsup_v2 -lm -lcl -lc #ENDIF# - -TAU_IBM_LD_FLAGS = -binitfini:poe_remote_main #ENDIF##USE_IBMXLC# -#GNU#TAU_IBM_LD_FLAGS = -Wl,-binitfini:poe_remote_main #ENDIF# -#KAI#TAU_IBM_LD_FLAGS = --backend -binitfini:poe_remote_main #ENDIF# - - -#PYTHON#TAU_IBM_SHFLAGS = $(TAU_IBM_PYTHON_SHFLAG) #ENDIF# -#PYTHON#TAU_HPUX_SHFLAGS = $(TAU_HPUX_PYTHON_SHFLAG) #ENDIF# -#SP1#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_IBM_SHFLAGS) #ENDIF# -#SOL2#TAU_EXTRA_LIBRARY_FLAGS = #ENDIF# -#SGIMP#TAU_EXTRA_LIBRARY_FLAGS = -lmalloc #ENDIF# -#HP#TAU_EXTRA_LIBRARY_FLAGS = $(TAU_HPUX_SHFLAGS) #ENDIF# - -TAU_MPI_WRAPPER_LIB= -L$(TAU_LIB_DIR) -lTauMpi$(TAU_CONFIG) #ENDIF##MPI# -#EPILOGMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# -#EPILOGOMPI#TAU_MPI_WRAPPER_LIB= #ENDIF# - -############################################## -# Build TAU_LINKER_SHOPTS -#GNU#TAU_IBM_LINKER_SHOPTS=-Wl,-brtl -Wl,-bexpall #ENDIF# -TAU_IBM_LINKER_SHOPTS= -brtl -bexpall #ENDIF##USE_IBMXLC# -#KAI#TAU_IBM_LINKER_SHOPTS= --backend -brtl #ENDIF# -#SP1#TAU_LINKER_SHOPTS= $(TAU_IBM_LINKER_SHOPTS) #ENDIF# - -############################################## -# MPI _r suffix check (as in libmpi_r) -#MPI_R_SUFFIX#TAU_MPI_R_SUFFIX=_r #ENDIF# - -############################################## -# Flags to build a shared object: TAU_SHFLAGS -#GNU#AR_SHFLAGS = -shared #ENDIF# -#PGI#AR_SHFLAGS = -shared #ENDIF# -#SGICC#AR_SHFLAGS = -shared #ENDIF# -#APPLECXX#AR_SHFLAGS = -dynamiclib -flat_namespace -undefined suppress #ENDIF# -#SOL2#AR_SHFLAGS = -G #ENDIF# -#SUN386I#AR_SHFLAGS = -G #ENDIF# -#SUNX86_64#AR_SHFLAGS = -G #ENDIF# -AR_SHFLAGS = -G #ENDIF##USE_IBMXLC# -#USE_DECCXX#AR_SHFLAGS = -shared #ENDIF# -#USE_INTELCXX#AR_SHFLAGS = -shared #ENDIF# -#ACC#AR_SHFLAGS = -b #ENDIF# -TAU_SHFLAGS = $(AR_SHFLAGS) -o - -############# RANLIB Options ############# -TAU_RANLIB = echo "Built" -#APPLECXX#TAU_RANLIB = ranlib #ENDIF# -#IBMXLCAPPLE#TAU_RANLIB = ranlib #ENDIF# - -############################################## -TAU_AR = ar #ENDIF# -#SP1#TAU_AR = ar -X32 #ENDIF# -#IBM64#TAU_AR = ar -X64 #ENDIF# -#PPC64#TAU_AR = ar #ENDIF# -#IBM64LINUX#TAU_AR = ar #ENDIF# - - -############################################## -# PDT OPTIONS -# You can specify -pdtcompdir=intel -pdtarchdir=x86_64 -# If nothing is specified, PDTARCHDIR uses TAU_ARCH -PDTARCHDIRORIG=$(TAU_ARCH) -PDTARCHITECTURE=x86_64 -PDTARCHDIRFINAL=$(PDTARCHDIRORIG) -#PDTARCHITECTURE#PDTARCHDIRFINAL=$(PDTARCHITECTURE)#ENDIF# -PDTARCHDIR=$(PDTARCHDIRFINAL) -#PDTARCH#PDTARCHDIR=$(PDTARCHDIRFINAL)/$(PDTCOMPDIR)#ENDIF# - - -############################################## - -PROFILEOPTS = $(PROFILEOPT1) $(PROFILEOPT2) $(PROFILEOPT3) $(PROFILEOPT4) \ - $(PROFILEOPT5) $(PROFILEOPT6) $(PROFILEOPT7) $(PROFILEOPT8) \ - $(PROFILEOPT9) $(PROFILEOPT10) $(PROFILEOPT11) $(PROFILEOPT12) \ - $(PROFILEOPT13) $(PROFILEOPT14) $(PROFILEOPT15) $(PROFILEOPT16) \ - $(PROFILEOPT17) $(PROFILEOPT18) $(PROFILEOPT19) $(PROFILEOPT20) \ - $(PROFILEOPT21) $(PROFILEOPT22) $(PROFILEOPT23) $(PROFILEOPT24) \ - $(PROFILEOPT25) $(PROFILEOPT26) $(PROFILEOPT27) $(PROFILEOPT28) \ - $(PROFILEOPT29) $(PROFILEOPT30) $(PROFILEOPT31) $(PROFILEOPT32) \ - $(PROFILEOPT33) $(PROFILEOPT34) $(PROFILEOPT35) $(PROFILEOPT36) \ - $(PROFILEOPT37) $(PROFILEOPT38) $(PROFILEOPT39) $(PROFILEOPT40) \ - $(PROFILEOPT41) $(PROFILEOPT42) $(PROFILEOPT43) $(PROFILEOPT44) \ - $(PROFILEOPT45) $(PROFILEOPT46) $(PROFILEOPT47) $(PROFILEOPT48) \ - $(PROFILEOPT49) $(PROFILEOPT50) $(PROFILEOPT51) $(PROFILEOPT52) \ - $(PROFILEOPT53) $(PROFILEOPT54) $(PROFILEOPT55) $(PROFILEOPT56) \ - $(PROFILEOPT57) $(PROFILEOPT58) $(PROFILEOPT59) $(PROFILEOPT60) \ - $(PROFILEOPT61) $(PROFILEOPT62) $(PROFILEOPT63) $(PROFILEOPT64) \ - $(PROFILEOPT65) $(PROFILEOPT66) $(PROFILEOPT67) $(PROFILEOPT68) \ - $(PROFILEOPT69) $(PROFILEOPT70) $(PROFILEOPT71) $(PROFILEOPT72) \ - $(PROFILEOPT73) $(PROFILEOPT74) $(PROFILEOPT75) $(PROFILEOPT76) \ - $(TRACEOPT) - -############################################## - -TAU_LINKER_OPTS = $(TAU_LINKER_OPT1) $(TAU_LINKER_OPT2) $(TAU_LINKER_OPT3) \ - $(TAU_LINKER_OPT4) $(TAU_LINKER_OPT5) $(TAU_LINKER_OPT6) \ - $(TAU_LINKER_OPT7) $(TAU_LINKER_OPT8) $(TAU_LINKER_OPT9) \ - $(TAU_LINKER_OPT10) $(TAU_LINKER_OPT11) $(TAU_LINKER_OPT12) - -############################################## - -############# TAU Fortran #################### -TAU_LINKER=$(TAU_CXX) -#INTEL_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -#INTEL32_FORTRAN##TAU_LINKER=$(TAU_F90) #ENDIF# -# Intel efc compiler acts as a linker - NO. Let C++ be the linker. - -############################################## -############# TAU Options #################### -TAUDEFS = $(PROFILEOPTS) - -TAUINC = -I$(TAU_INC_DIR) - -TAULIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAUMPILIBS = $(TAU_MPI_LIB) - -TAUMPIFLIBS = $(TAU_MPI_FLIB) - -### ACL S/W requirement -TAU_DEFS = $(TAUDEFS) - -TAU_INCLUDE = -I$(TAU_INC_DIR) -#PERFLIB#TAU_INCLUDE = -I$(PERFINCDIR) #ENDIF# -#PERFLIB#TAU_DEFS = #ENDIF# -#PERFLIB#TAU_COMPILER_EXTRA_OPTIONS=-optTau=-p #ENDIF# - -TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/Memory -#IBMXLCAPPLE#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# -#APPLECXX#TAU_INCLUDE_MEMORY = -I$(TAU_INC_DIR)/MemoryWrapper #ENDIF# - -TAU_LIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -ltau$(TAU_CONFIG) $(TAU_LINKER_OPTS) -#PERFLIB#TAU_LIBS = #ENDIF# - -TAU_SHLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) -#PERFLIB#TAU_SHLIBS = #ENDIF# -TAU_EXLIBS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) $(TAU_MPI_LIB) - -TAU_SHLIBS_NOSHOPTS = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTAUsh$(TAU_CONFIG) $(TAU_LINKER_OPTS) - -TAU_DISABLE = $(TAUHELPER) -L$(TAU_LIB_DIR) -lTauDisable - -TAU_MPI_INCLUDE = $(TAU_MPI_INC) - -TAU_MPI_LIBS = $(TAU_MPI_LIB) - -TAU_MPI_FLIBS = $(TAU_MPI_FLIB) - -## TAU TRACE INPUT LIBRARY (can build a trace converter using TAU TIL) -TAU_TRACE_INPUT_LIB = -L$(TAU_LIB_DIR) -lTAU_traceinput$(TAU_CONFIG) - -## Don't include -lpthread or -lsmarts. Let app. do that. -############################################# -## IBM SPECIFIC CHANGES TO TAU_MPI_LIBS -#SP1#TAU_MPI_LDFLAGS = $(TAU_IBM_LD_FLAGS) #ENDIF# -TAU_LDFLAGS = $(TAU_MPI_LDFLAGS) #ENDIF##MPI# -#SP1#TAU_IBM_MPI_LIBS = $(TAU_MPI_LIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_IBM_FMPI_LIBS = $(TAU_MPI_FLIB) -L$(TAU_MPILIB_DIR)/ip -lvtd$(TAU_MPI_R_SUFFIX) #ENDIF# -#SP1#TAU_MPI_LIBS_FLAGS= $(TAU_IBM_MPI_LIBS) #ENDIF# -#SP1#TAU_MPI_FLIBS_FLAGS = $(TAU_IBM_MPI_FLIBS) #ENDIF# -TAU_MPI_LIBS_FLAGS = $(TAU_MPI_LIB) #ENDIF##MPI# -TAU_MPI_FLIBS_FLAGS = $(TAU_MPI_FLIB) #ENDIF##MPI# -TAU_MPI_LIBS = $(TAU_MPI_LIBS_FLAGS) #ENDIF##MPI# -TAU_MPI_FLIBS = $(TAU_MPI_FLIBS_FLAGS) #ENDIF##MPI# - -#SP1#TAUMPILIBS = $(TAU_MPI_LIBS) #ENDIF# -#SP1#TAUMPIFLIBS = $(TAU_MPI_FLIBS) #ENDIF# -############################################# -#SHMEM#TAU_SHMEM_OBJS = TauShmemCray.o #ENDIF# -#SP1#TAU_SHMEM_OBJS = TauShmemTurbo.o #ENDIF# -#GPSHMEM#TAU_SHMEM_OBJS = TauShmemGpshmem.o #ENDIF# - -TAU_SHMEM_INCLUDE = $(TAU_SHMEM_INC) - -TAU_SHMEM_LIBS = -L$(TAU_PREFIX_INSTALL_DIR)/$(CONFIG_ARCH)/ -lTauShmem$(TAU_CONFIG) $(TAU_SHMEM_LIB) -############################################# -# TAU COMPILER SHELL SCRIPT OPTIONS -TAUCOMPILEROPTS= -optPdtDir="$(PDTDIR)/${PDTARCHDIR}"\ - -optPdtCOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optPdtCxxOpts="$(TAU_INCLUDE) $(TAU_DEFS) $(TAU_MPI_INCLUDE)"\ - -optTauInstr="$(TAU_BIN_DIR)/tau_instrumentor" \ - -optNoMpi \ - -optOpariDir="$(OPARIDIR)" -optOpariTool="$(TAU_OPARI_TOOL)" \ - -optTauCC="$(TAU_CC)" \ - -optTauIncludes="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE)" \ - -optTauDefs="$(TAU_DEFS)" \ - -optTauCompile="$(TAU_INCLUDE) $(TAU_MPI_INCLUDE) $(TAU_DEFS) "\ - -optLinking="$(TAU_MPI_FLIBS) $(TAU_LIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - -optSharedLinking="$(TAU_MPI_FLIBS) $(TAU_EXLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS)"\ - $(TAU_COMPILER_EXTRA_OPTIONS) \ - -optIncludeMemory="$(TAU_INCLUDE_MEMORY)" -############################################# - -TAU_SHAREDLIBS=$(TAUHELPER) -L$(TAU_LIB_DIR) -lTAU $(TAU_LINKER_OPTS) $(TAU_LINKER_SHOPTS) -SHAREDEXTRAS= -#FORCESHARED#SHAREDEXTRAS=-optSharedLinkReset="$(TAU_SHAREDLIBS) $(TAU_LDFLAGS) $(TAU_CXXLIBS) $(TAU_MPI_NOWRAP_FLIB)" -optShared #ENDIF# -TAU_COMPILER=$(TAU_BIN_DIR)/tau_compiler.sh $(TAUCOMPILEROPTS) $(SHAREDEXTRAS) -############################################# -# These options could be included in the application Makefile as -#CFLAGS = $(TAUDEFS) $(TAUINC) -# -#LIBS = $(TAULIBS) -# -# To run the application without Profiling/Tracing use -#CFLAGS = $(TAUINC) -# Don't use TAUDEFS but do include TAUINC -# Also ignore TAULIBS when Profiling/Tracing is not used. -############################################# - diff --git a/source/unres/src_MD/Makefile_MPICH_ifort b/source/unres/src_MD/Makefile_MPICH_ifort index 4505541..9661fdd 100644 --- a/source/unres/src_MD/Makefile_MPICH_ifort +++ b/source/unres/src_MD/Makefile_MPICH_ifort @@ -1,24 +1,31 @@ ################################################################### -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 -FC= ifort +CC = gcc +FC = /opt/cray/craype/2.5.3/bin/ftn -OPT = -g -ip -w -CB +OPT = -O3 -ip +#OPT = -g -CA -CB -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include +FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include +#FFLAGS1 = -c -g -CA -CB -I$(INSTALL_DIR)/include +#FFLAGS = ${FFLAGS1} +FFLAGS1 = ${FFLAGS} +FFLAGS2 = -c -g -O0 -I$(INSTALL_DIR)/include +FFLAGSE = -c -O3 -ipo -opt_report -I$(INSTALL_DIR)/include +#FFLAGSE = ${FFLAGS} LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a +#/opt/cray/mpt/7.3.2/gni/mpich-intel/15.0/lib/libmpich.a ARCH = LINUX PP = /lib/cpp -P +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" -all: unres .SUFFIXES: .F .F.o: @@ -33,24 +40,25 @@ object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ + MP.o compare_s1.o prng_32.o \ banach.o rmsd.o elecont.o dihed_cons.o \ sc_move.o local_move.o \ intcartderiv.o lagrangian_lesyng.o\ stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o + q_measure.o gnmr1.o test.o ssMD.o -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ - -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_GAB.exe +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC\ + -DSCCORPDB +GAB: BIN = /lustre/tetyda/home/liwo/bin/unres_intel_MPI_GAB.exe GAB: ${object} xdrf/libxdrf.a cc -o compinfo compinfo.c ./compinfo | true ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN -DMP -DMPI \ +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMP -DMPI \ -DSPLITELE -DLANG0 E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_MPICH_E0LL2Y.exe E0LL2Y: ${object} xdrf/libxdrf.a @@ -60,7 +68,7 @@ E0LL2Y: ${object} xdrf/libxdrf.a ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} xdrf/libxdrf.a: - cd xdrf && make + cd ../../lib/xdrf && make clean: diff --git a/source/unres/src_MD/Makefile_aix_xlf b/source/unres/src_MD/Makefile_aix_xlf deleted file mode 100644 index b226425..0000000 --- a/source/unres/src_MD/Makefile_aix_xlf +++ /dev/null @@ -1,113 +0,0 @@ -CPPFLAGS = -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DSPLITELE -WF,-DISNAN -WF,-DAIX -#-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -INSTALL_DIR = -# -FC= mpxlf90 -qfixed -w - -OPT = -q64 - -FFLAGS = -c ${OPT} -O3 -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/unres_MD.exe -LIBS = -qipa - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - - -unresCSA: ${objectCSA} - cc -o compinfo compinfo.c - ./compinfo - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objectCSA} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - /bin/rm *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F diff --git a/source/unres/src_MD/Makefile_bigben b/source/unres/src_MD/Makefile_bigben deleted file mode 100644 index 261dd8e..0000000 --- a/source/unres/src_MD/Makefile_bigben +++ /dev/null @@ -1,138 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = ${OPT} -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-novec-noparint_barrier_corr-split.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 \ -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DPARVEC #-DPARINT -DPARINTDER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_bigben-oldparm b/source/unres/src_MD/Makefile_bigben-oldparm deleted file mode 100644 index 87d66c7..0000000 --- a/source/unres/src_MD/Makefile_bigben-oldparm +++ /dev/null @@ -1,136 +0,0 @@ -# -FC= ftn -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-matgather-oldparm.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC -DPARINT -DPARINTDER \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_bigben-tau b/source/unres/src_MD/Makefile_bigben-tau deleted file mode 100644 index ee02905..0000000 --- a/source/unres/src_MD/Makefile_bigben-tau +++ /dev/null @@ -1,137 +0,0 @@ -# -#FC= ftn -TAU_MAKEFILE=/usr/local/packages/TAU-2.17/tau-2.17/xt3/lib/Makefile.tau-mpi-pdt-pgi -FC=tau_f90.sh -OPT = -fast \ --Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ --Mprefetch=distance:8,nta - -#OPT = -C -g -#OPT1 = -g -fast -OPT1 = -fast -OPT2 = -fast -OPT2 = ${OPT} -OPTE = ${OPT} - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = ${FFLAGS} - -CFLAGS = -DSGI -c - -BIN = ../bin/unres_MD_Tc_procor-newmat-noparint-barrier-tau.exe -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -DLINUX -DUNRES -DMP -DMPI -DPGI \ - -DSPLITELE -DPROCOR -DAMD64 -DLANG0 -DPARVEC - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} proc_proc.o - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} proc_proc.o cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.pp.[fF] *.pp.inst.[fF] - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_galera b/source/unres/src_MD/Makefile_galera deleted file mode 100644 index 899ec63..0000000 --- a/source/unres/src_MD/Makefile_galera +++ /dev/null @@ -1,147 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -#INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1/ -#INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -#INSTALL_DIR = /users/software/mpich2.x86_64/ -#INSTALL_DIR = /opt/mpi/mvapich2 -INSTALL_DIR = /opt/mpi/mvapich - -FC= ifort -FCL= ${INSTALL_DIR}/bin/mpif77 - -OPT = -O3 -ip -w -xHost - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -xHost -O3 -ipo -ipo_obj -no-prec-div -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_hremd_mpich1.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FCL} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_intrepid b/source/unres/src_MD/Makefile_intrepid deleted file mode 100644 index 2b57f9e..0000000 --- a/source/unres/src_MD/Makefile_intrepid +++ /dev/null @@ -1,151 +0,0 @@ -# -FC=/bgsys/drivers/ppcfloor/comm/bin/mpixlf77 -OPT = -O4 -qarch=450 -qtune=450 -#OPT = -O3 -qarch=450 -qtune=450 -qdebug=function_trace -#OPT = -O -qarch=450 -qtune=450 -#OPT = -O0 -C -g -qarch=450 -qtune=450 #-qdebug=function_trace -#-Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 \ -#-Mprefetch=distance:8,nta - -#OPT1 = -O -g -qarch=450 -qtune=450 -#OPT1 = -O -g -qarch=450 -qtune=450 -qdebug=function_trace -OPT1 = ${OPT} -#OPT2 = -O2 -qarch=450 -qtune=450 -#OPT2 = -O2 -qarch=450 -qtune=450 -qdebug=function_trace -OPT2 = ${OPT} -#OPTE = -O4 -qarch=450 -qtune=450 -#OPTE = -O4 -qarch=450 -qtune=450 -OPTE=${OPT} - -CFLAGS = -c -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c ${OPT1} -I$(INSTALL_DIR)/include -FFLAGS2 = -c ${OPT2} -I$(INSTALL_DIR)/include -FFLAGSE = -c ${OPTE} -I$(INSTALL_DIR)/include - -BIN = ../bin/unres_MD_Tc_procor-newparm-O4-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-PARINT-parcorr.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-parvecmatint-O4-notau1.exe -#BIN = ../bin/unres_MD_Tc_procor-newparm-O4-notau1.exe -#LIBS = xdrf/libxdrf.a /home/liwo/UNRES/LIB/libmemmon.a -LIBS = xdrf/libxdrf.a - -CPPFLAGS = -WF,-DAIX -WF,-DISNAN -WF,-DUNRES -WF,-DMP -WF,-DMPI -WF,-DPGI \ - -WF,-DSPLITELE -WF,-DPROCOR -WF,-DAMD64 -WF,-DLANG0 -#-WF,-DPARINT -WF,-DPARINTDER -#-WF,-DPARVEC -WF,-DPARMAT -WF,-DMATGATHER - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -obj: ${object} - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - ${CC} -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.f - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.f - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -eigen.o : eigen.f - ${FC} ${FFLAGS1} ${CPPFLAGS} eigen.f - -blas.o : blas.f - ${FC} ${FFLAGS1} ${CPPFLAGS} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} ${CPPFLAGS} add.f - -energy_p_new.o : energy_p_new.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new.F - -energy_p_new-sep.o : energy_p_new-sep.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c - -compinfo: compinfo.c - ${CC} ${CFLAGS} compinfo.c diff --git a/source/unres/src_MD/Makefile_lnx_ifc10_opteron b/source/unres/src_MD/Makefile_lnx_ifc10_opteron deleted file mode 100644 index 13c3249..0000000 --- a/source/unres/src_MD/Makefile_lnx_ifc10_opteron +++ /dev/null @@ -1,143 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_new_em64_nh_hremd_92110.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_lnx_ifc10_opteron_oldparm b/source/unres/src_MD/Makefile_lnx_ifc10_opteron_oldparm deleted file mode 100644 index d155fa2..0000000 --- a/source/unres/src_MD/Makefile_lnx_ifc10_opteron_oldparm +++ /dev/null @@ -1,143 +0,0 @@ -CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DMP -DMPI -DPGI -DISNAN \ - -DSPLITELE -DAMD64 -DLANG0 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -#-DCRYST_TOR -# -DPROCOR -# -DTSCSC -#-DTIMING \ -# -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -# -DMOMENT -#-DPARVEC -#-DPARINT -DPARINTDER - -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh - - -FC= ifort - -OPT = -O3 -ip -w - -FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include -FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include -FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include -FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include - - -BIN = ../bin/unres_Tc_procor_old_em64_nh_hremd_92110.exe -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf_em64/libxdrf.a -lpthread - -ARCH = LINUX -PP = /lib/cpp -P - - -all: unres - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ - matmult.o readrtns_CSA.o parmread.o gen_rand_conf.o printmat.o map.o \ - pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ - cartder.o checkder_p.o econstr_local.o energy_p_new_barrier.o \ - energy_p_new-sep_barrier.o gradient_p.o minimize_p.o sumsld.o \ - cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ - mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ - eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - together.o csa.o minim_jlee.o shift.o diff12.o bank.o newconf.o ran.o \ - indexx.o MP.o compare_s1.o prng_32.o \ - test.o banach.o distfit.o rmsd.o elecont.o dihed_cons.o \ - sc_move.o local_move.o \ - intcartderiv.o lagrangian_lesyng.o\ - stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ - surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o - -unres: ${object} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o *.il - -newconf.o: newconf.f - ${FC} ${FFLAGS} ${CPPFLAGS} newconf.f - -bank.o: bank.F - ${FC} ${FFLAGS} ${CPPFLAGS} bank.F - -diff12.o: diff12.f - ${FC} ${FFLAGS} ${CPPFLAGS} diff12.f - -csa.o: csa.f - ${FC} ${FFLAGS} ${CPPFLAGS} csa.f - -shift.o: shift.F - ${FC} ${FFLAGS} ${CPPFLAGS} shift.F - -ran.o: ran.f - ${FC} ${FFLAGS} ${CPPFLAGS} ran.f - -together.o: together.F - ${FC} ${FFLAGS} ${CPPFLAGS} together.F - -test.o: test.F - ${FC} ${FFLAGS} ${CPPFLAGS} test.F - -chainbuild.o: chainbuild.F - ${FC} ${FFLAGS} ${CPPFLAGS} chainbuild.F - -matmult.o: matmult.f - ${FC} ${FFLAGS} ${CPPFLAGS} matmult.f - -parmread.o : parmread.F - ${FC} ${FFLAGS} ${CPPFLAGS} parmread.F - -intcor.o : intcor.f - ${FC} ${FFLAGS} ${CPPFLAGS} intcor.f - -cartder.o : cartder.F - ${FC} ${FFLAGS} ${CPPFLAGS} cartder.F - -readpdb.o : readpdb.F - ${FC} ${FFLAGS2} ${CPPFLAGS} readpdb.F - -sumsld.o : sumsld.f - ${FC} ${FFLAGS} ${CPPFLAGS} sumsld.f - -cored.o : cored.f - ${FC} ${FFLAGS1} ${CPPFLAGS} cored.f - -rmdd.o : rmdd.f - ${FC} ${FFLAGS} ${CPPFLAGS} rmdd.f - -energy_p_new_barrier.o : energy_p_new_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new_barrier.F - -gradient_p.o : gradient_p.F - ${FC} ${FFLAGSE} ${CPPFLAGS} gradient_p.F - -energy_p_new-sep_barrier.o : energy_p_new-sep_barrier.F - ${FC} ${FFLAGSE} ${CPPFLAGS} energy_p_new-sep_barrier.F - -lagrangian_lesyng.o : lagrangian_lesyng.F - ${FC} ${FFLAGSE} ${CPPFLAGS} lagrangian_lesyng.F - -MD_A-MTS.o : MD_A-MTS.F - ${FC} ${FFLAGSE} ${CPPFLAGS} MD_A-MTS.F - -blas.o : blas.f - ${FC} ${FFLAGS1} blas.f - -add.o : add.f - ${FC} ${FFLAGS1} add.f - -eigen.o : eigen.f - ${FC} ${FFLAGS2} eigen.f - -proc_proc.o: proc_proc.c - ${CC} ${CFLAGS} proc_proc.c diff --git a/source/unres/src_MD/Makefile_single_gfortran b/source/unres/src_MD/Makefile_single_gfortran index 8e393f8..3f29731 100644 --- a/source/unres/src_MD/Makefile_single_gfortran +++ b/source/unres/src_MD/Makefile_single_gfortran @@ -6,11 +6,11 @@ CC = cc CFLAGS = -DLINUX -DPGI -c -OPT = -O -#OPT1 = -fbounds-check -g -O +OPT = -O -fbounds-check -g +OPT1 = -g #OPT = -fbounds-check -g -OPT1 = -g +#OPT1 = -g # -Mvect <---slows down # -Minline=name:matmat2 <---false convergence @@ -25,7 +25,7 @@ ARCH = LINUX PP = /lib/cpp -P all: - @echo "Specify force field: GAB or E0LL2Y" + @echo "Specify force field: GAB, 4P or E0LL2Y" .SUFFIXES: .F .F.o: @@ -45,9 +45,11 @@ object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ intcartderiv.o lagrangian_lesyng.o\ stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o + q_measure.o gnmr1.o test.o ssMD.o -GAB: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DAMD64 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC GAB: BIN = ../../../bin/unres/MD/unres_gfortran_single_GAB.exe GAB: ${object} xdrf/libxdrf.a @@ -56,7 +58,16 @@ GAB: ${object} xdrf/libxdrf.a ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ +4P: CPPFLAGS = -DLINUX -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ../../../bin/unres/MD/unres_gfortran_single_4P.exe +4P: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DAMD64 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 E0LL2Y: BIN = ../../../bin/unres/MD/unres_gfortran_single_E0LL2Y.exe E0LL2Y: ${object} xdrf/libxdrf.a diff --git a/source/unres/src_MD/Makefile_single_ifort b/source/unres/src_MD/Makefile_single_ifort index 245206b..44fc475 100644 --- a/source/unres/src_MD/Makefile_single_ifort +++ b/source/unres/src_MD/Makefile_single_ifort @@ -3,6 +3,9 @@ FFLAGS = -c ${OPT} -I$(INSTALL_DIR)/include FFLAGS1 = -c -w -g -d2 -CA -CB -I$(INSTALL_DIR)/include FFLAGS2 = -c -w -g -O0 -I$(INSTALL_DIR)/include FFLAGSE = -c -w -O3 -ipo -ipo_obj -opt_report -I$(INSTALL_DIR)/include +FFLAGS = ${FFLAGS1} +FFLAGS2 = ${FFLAGS1} +FFLAGSE = ${FFLAGS1} CC = cc @@ -23,7 +26,7 @@ ARCH = LINUX PP = /lib/cpp -P all: - @echo "Specify force field: GAB or E0LL2Y" + @echo "Specify force field: GAB, 4P or E0LL2Y" .SUFFIXES: .F .F.o: @@ -37,15 +40,17 @@ object = unres.o arcos.o cartprint.o chainbuild.o convert.o initialize_p.o \ cored.o rmdd.o geomout.o readpdb.o regularize.o thread.o fitsq.o mcm.o \ mc.o bond_move.o refsys.o check_sc_distr.o check_bond.o contact.o djacob.o \ eigen.o blas.o add.o entmcm.o minim_mcmf.o \ - MP.o compare_s1.o prng.o \ + MP.o compare_s1.o \ banach.o rmsd.o elecont.o dihed_cons.o \ sc_move.o local_move.o \ intcartderiv.o lagrangian_lesyng.o\ stochfric.o kinetic_lesyng.o MD_A-MTS.o moments.o int_to_cart.o \ surfatom.o sort.o muca_md.o MREMD.o rattle.o gauss.o energy_split-sep.o \ - q_measure.o gnmr1.o test.o + q_measure.o gnmr1.o test.o ssMD.o -GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ +no_option: + +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC GAB: BIN = ../../../bin/unres/MD/unres_ifort_single_GAB.exe GAB: ${object} xdrf/libxdrf.a @@ -54,7 +59,16 @@ GAB: ${object} xdrf/libxdrf.a ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ +4P: CPPFLAGS = -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ../../../bin/unres/MD/unres_ifort_single_4P.exe +4P: ${object} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 E0LL2Y: BIN = ../../../bin/unres/MD/unres_ifort_single_E0LL2Y.exe E0LL2Y: ${object} xdrf/libxdrf.a diff --git a/source/unres/src_MD/Makefile~HEAD b/source/unres/src_MD/Makefile~HEAD deleted file mode 120000 index 8453cdd..0000000 --- a/source/unres/src_MD/Makefile~HEAD +++ /dev/null @@ -1 +0,0 @@ -Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/unres/src_MD/Makefile~adam b/source/unres/src_MD/Makefile~adam deleted file mode 120000 index 8453cdd..0000000 --- a/source/unres/src_MD/Makefile~adam +++ /dev/null @@ -1 +0,0 @@ -Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/unres/src_MD/checkder_p.F b/source/unres/src_MD/checkder_p.F index 4d0379e..fc11c2e 100644 --- a/source/unres/src_MD/checkder_p.F +++ b/source/unres/src_MD/checkder_p.F @@ -284,7 +284,7 @@ C Check the gradient of the energy in Cartesian coordinates. c call intcartderiv c call checkintcartgrad call zerograd - aincr=1.0D-5 + aincr=1.0D-4 write(iout,*) 'Calling CHECK_ECARTINT.' nf=0 icall=0 @@ -534,11 +534,14 @@ c------------------------------------------------------------------------- tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) omicron(1,i)=alpha(i-2,i-1,i-1+nres) omicron(2,i)=alpha(i-1+nres,i-1,i) +C print *,i,omicron(1,i),omicron(2,i) endif if (itype(i).ne.10) then tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) endif endif +c write (2,*) "i",i,tauangle(1,i+1),tauangle(2,i+1), +c & omicron(1,i),omicron(2,i) omeg(i)=beta(nres+i,i,maxres2,i+1) alph(i)=alpha(nres+i,i,maxres2) theta(i+1)=alpha(i-1,i,i+1) diff --git a/source/unres/src_MD/energy_p_new_barrier.F b/source/unres/src_MD/energy_p_new_barrier.F index 07445bc..4bccdf3 100644 --- a/source/unres/src_MD/energy_p_new_barrier.F +++ b/source/unres/src_MD/energy_p_new_barrier.F @@ -131,6 +131,11 @@ C C Calculate electrostatic (H-bonding) energy of the main chain. C 107 continue +cmc +cmc Sep-06: egb takes care of dynamic ss bonds too +cmc +c if (dyn_ss) call dyn_set_nss + c print *,"Processor",myrank," computed USCSC" #ifdef TIMING #ifdef MPI @@ -326,6 +331,7 @@ C energia(23)=evdw_m c print *," Processor",myrank," calls SUM_ENERGY" call sum_energy(energia,.true.) + if (dyn_ss) call dyn_set_nss c print *," Processor",myrank," left SUM_ENERGY" #ifdef TIMING #ifdef MPI @@ -1552,6 +1558,7 @@ C include 'COMMON.IOUNITS' include 'COMMON.CALC' include 'COMMON.CONTROL' + include 'COMMON.SBRIDGE' logical lprn evdw=0.0D0 ccccc energy_dec=.false. @@ -1580,6 +1587,12 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') + & 'evdw',i,j,evdwij,' ss' + ELSE ind=ind+1 itypj=itype(j) c dscj_inv=dsc_inv(itypj) @@ -1666,9 +1679,10 @@ c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 & evdwij endif - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') - & 'evdw',i,j,evdwij - + if (energy_dec) then + write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij + call flush(iout) + endif C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift @@ -1689,6 +1703,7 @@ C Calculate angular part of the gradient. #else call sc_grad #endif + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -3009,6 +3024,9 @@ C C Loop over i,i+2 and i,i+3 pairs of the peptide groups C do i=iturn3_start,iturn3_end +C if (itype(i).eq.21 .or. itype(i+1).eq.21 +C & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21.or.itype(i+4).eq.21) +C & cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -3024,6 +3042,10 @@ C num_cont_hb(i)=num_conti enddo do i=iturn4_start,iturn4_end +C if (itype(i).eq.21 .or. itype(i+1).eq.21 +C & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21.or.itype(i+4).eq.21 +C & .or. itype(i+5).eq.21) +C & cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -3042,6 +3064,8 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c do i=iatel_s,iatel_e +C if (itype(i).eq.21 .or. itype(i+1).eq.21 +C &.or.itype(i+2)) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -3054,6 +3078,8 @@ c c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) +C if (itype(j).eq.21 .or. itype(j+1).eq.21 +C &.or.itype(j+2)) cycle call eelecij(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -4266,9 +4292,15 @@ c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, c & dhpb(i),dhpb1(i),forcon(i) C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds + if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond - additional check + if (ii.gt.nres + & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij + endif cd write (iout,*) "eij",eij else if (ii.gt.nres .and. jj.gt.nres) then c Restraints from contact prediction @@ -4462,6 +4494,8 @@ c do i=ibondp_start,ibondp_end diff = vbld(i)-vbldp0 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff + if (energy_dec) write (iout,'(a7,i5,4f7.3)') + & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff estr=estr+diff*diff do j=1,3 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) @@ -4480,6 +4514,12 @@ c diff=vbld(i+nres)-vbldsc0(1,iti) c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, c & AKSC(1,iti),AKSC(1,iti)*diff*diff + if (energy_dec) then + write (iout,*) + & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff, + & AKSC(1,iti),AKSC(1,iti)*diff*diff + call flush(iout) + endif estr=estr+0.5d0*AKSC(1,iti)*diff*diff do j=1,3 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) @@ -4758,6 +4798,8 @@ C logical lprn /.false./, lprn1 /.false./ etheta=0.0D0 do i=ithet_start,ithet_end + if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + &(itype(i).eq.ntyp1)) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -4767,7 +4809,8 @@ C coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3) then +C if (i.gt.3) then + if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -4781,13 +4824,13 @@ C enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres) then + if ((i.lt.nres).and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4802,7 +4845,7 @@ C enddo else phii1=0.0d0 - ityp3=nthetyp+1 + ityp3=ithetyp(itype(i)) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -4908,10 +4951,12 @@ C enddo enddo 10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, + if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)') + & 'ebe', i,theta(i)*rad2deg,phii*rad2deg, & phii1*rad2deg,ethetai etheta=etheta+ethetai + if (energy_dec) write (iout,'(a6,i5,0pf7.3)') + & 'ebend',i,ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 gloc(nphi+i-2,icg)=wang*dethetai @@ -5853,12 +5898,14 @@ C 6/23/01 Compute double torsional energy include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' logical lprn C Set lprn=.true. for debugging lprn=.false. c lprn=.true. etors_d=0.0D0 do i=iphid_start,iphid_end + etors_d_ii=0.0D0 itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) itori2=itortyp(itype(i)) @@ -5877,6 +5924,8 @@ c lprn=.true. sinphi2=dsin(j*phii1) etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ & v2cij*cosphi2+v2sij*sinphi2 + if (energy_dec) etors_d_ii=etors_d_ii+ + & v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) enddo @@ -5892,12 +5941,17 @@ c lprn=.true. sinphi1m2=dsin(l*phii-(k-l)*phii1) etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ & v1sdij*sinphi1p2+v2sdij*sinphi1m2 + if (energy_dec) etors_d_ii=etors_d_ii+ + & v1cdij*cosphi1p2+v2cdij*cosphi1m2+ + & v1sdij*sinphi1p2+v2sdij*sinphi1m2 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) enddo enddo + if (energy_dec) write (iout,'(a6,i5,0pf7.3)') + & 'etor_d',i,etors_d_ii gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 c write (iout,*) "gloci", gloc(i-3,icg) @@ -5934,18 +5988,22 @@ c lprn=.true. c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor esccor=0.0D0 do i=itau_start,itau_end - esccor_ii=0.0D0 +C do i=42,42 + + if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle isccori=isccortyp(itype(i-2)) isccori1=isccortyp(itype(i-1)) phii=phi(i) + cccc Added 9 May 2012 cc Tauangle is torsional engle depending on the value of first digit c(see comment below) cc Omicron is flat angle depending on the value of first digit c(see comment below) - +C print *,i,tauangle(1,i) do intertyp=1,3 !intertyp + esccor_ii=0.0D0 cc Added 09 May 2012 (Adasko) cc Intertyp means interaction type of backbone mainchain correlation: c 1 = SC...Ca...Ca...Ca @@ -5967,9 +6025,13 @@ c 3 = SC...Ca...Ca...SCi v2ij=v2sccor(j,intertyp,isccori,isccori1) cosphi=dcos(j*tauangle(intertyp,i)) sinphi=dsin(j*tauangle(intertyp,i)) + if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi esccor=esccor+v1ij*cosphi+v2ij*sinphi gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo + if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') + & 'esccor',i,intertyp,esccor_ii +C print *,i,tauangle(1,i),gloci gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi c &gloc_sc(intertyp,i-3,icg) @@ -5982,7 +6044,8 @@ c &gloc_sc(intertyp,i-3,icg) enddo !intertyp enddo c do i=1,nres -c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg) +c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc_sc(2,i,icg), +c & gloc_sc(3,i,icg) c enddo return end diff --git a/source/unres/src_MD/geomout.F b/source/unres/src_MD/geomout.F index 69d7802..f27391b 100644 --- a/source/unres/src_MD/geomout.F +++ b/source/unres/src_MD/geomout.F @@ -9,7 +9,7 @@ include 'COMMON.SBRIDGE' include 'COMMON.DISTFIT' include 'COMMON.MD' - character*50 tytul + character*(*) tytul dimension ica(maxres) write (iunit,'(3a,1pe15.5)') 'REMARK ',tytul,' ENERGY ',etot cmodel write (iunit,'(a5,i6)') 'MODEL',1 @@ -23,7 +23,7 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) else - write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3)') + write (iunit,'(a5,i5,1x,a1,i2,1x,a3,i7,2x,a3,i7,i3,t76,i5)') & 'HELIX',j,'H',j, & restyp(iti),hfrag(1,j)-1, & restyp(itj),hfrag(2,j)-1,1,hfrag(2,j)-hfrag(1,j) @@ -79,9 +79,15 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 if (nss.gt.0) then do i=1,nss + if (dyn_ss) then write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') - & 'SSBOND',i,'CYS',ihpb(i)-1-nres, - & 'CYS',jhpb(i)-1-nres + & 'SSBOND',i,'CYS',idssb(i)-nnt+1, + & 'CYS',jdssb(i)-nnt+1 + else + write(iunit,'(a6,i4,1x,a3,i7,4x,a3,i7)') + & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, + & 'CYS',jhpb(i)-nnt+1-nres + endif enddo endif @@ -110,7 +116,11 @@ cmodel write (iunit,'(a5,i6)') 'MODEL',1 write (iunit,30) ica(nct),ica(nct)+1 endif do i=1,nss + if (dyn_ss) then + write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 + else write (iunit,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 + endif enddo write (iunit,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3,f15.3) @@ -264,8 +274,13 @@ c---------------------------------------------------------------- open(icart,file=cartname,access="append") #endif write (icart,'(e15.8,2e15.5,f12.5,$)') time,potE,uconst,t_bath - write (icart,'(i4,$)') + if (dyn_ss) then + write (icart,'(i4,$)') + & nss,(idssb(j)+nres,jdssb(j)+nres,j=1,nss) + else + write (icart,'(i4,$)') & nss,(ihpb(j),jhpb(j),j=1,nss) + endif write (icart,'(i4,20f7.4)') nfrag+npair+3*nfrag_back, & (qfrag(i),i=1,nfrag),(qpair(i),i=1,npair), & (utheta(i),ugamma(i),uscdiff(i),i=1,nfrag_back) @@ -307,8 +322,13 @@ c----------------------------------------------------------------- call xdrffloat_(ixdrf, real(t_bath), iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss + if (dyn_ss) then + call xdrfint_(ixdrf, idssb(j)+nres, iret) + call xdrfint_(ixdrf, jdssb(j)+nres, iret) + else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag @@ -331,8 +351,13 @@ c----------------------------------------------------------------- call xdrffloat(ixdrf, real(t_bath), iret) call xdrfint(ixdrf, nss, iret) do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nfrag+npair+3*nfrag_back, iret) do i=1,nfrag @@ -444,6 +469,12 @@ c----------------------------------------------------------------- line2=' ' endif if (print_compon) then + if(itime.eq.0) then + write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, + & ",20a12)" + write (istat,format) "#","", + & (ename(print_order(i)),i=1,nprint_ene) + endif write(format,'(a1,a4,a1,a4,a10)') "(",format1,",",format2, & ",20f12.3)" write (istat,format) line1,line2, diff --git a/source/unres/src_MD/initialize_p.F b/source/unres/src_MD/initialize_p.F index 3434131..565ccaf 100644 --- a/source/unres/src_MD/initialize_p.F +++ b/source/unres/src_MD/initialize_p.F @@ -292,11 +292,11 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.DERIV' include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1), + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1), & ntask_cont_from_all(0:max_fg_procs-1), & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), & ntask_cont_to_all(0:max_fg_procs-1), @@ -312,7 +312,7 @@ C... to deal with by current processor. itask_cont_from(i)=fg_rank itask_cont_to(i)=fg_rank enddo - lprint=energy_dec + lprint=.false. if (lprint) &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss @@ -345,6 +345,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) goto 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. @@ -410,7 +411,6 @@ c write (iout,*) 'jj=nct' iatsc_s=nnt iatsc_e=nct-1 #endif - if (iatsc_s.eq.0) iatsc_s=1 #ifdef MPI if (lprint) write (*,*) 'Processor',fg_rank,' CG Group',kolor, & ' absolute rank',myrank,' iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e @@ -543,7 +543,6 @@ cd write (iout,*) 'i.gt.nct-iscp' endif enddo ! i #endif - if (iatscp_s.eq.0) iatscp_s=1 if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e @@ -1118,15 +1117,16 @@ c--------------------------------------------------------------------------- include "COMMON.INTERACT" include "COMMON.SETUP" include "COMMON.IOUNITS" - integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1) + integer ii,jj,itask(4), + & ntask_cont_to,itask_cont_to(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,isent,k,l c Determines whether to send interaction ii,jj to other processors; a given c interaction can be sent to at most 2 processors. @@ -1208,15 +1208,15 @@ c--------------------------------------------------------------------------- include "COMMON.SETUP" include "COMMON.IOUNITS" integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:MaxProcs-1) + & itask_cont_from(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,k,l do iproc=fg_rank+1,nfgtasks-1 do k=iturn3_start_all(iproc),iturn3_end_all(iproc) @@ -1268,7 +1268,7 @@ c--------------------------------------------------------------------------- subroutine add_task(iproc,ntask_cont,itask_cont) implicit none include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:MaxProcs-1) + integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) integer ii do ii=1,ntask_cont if (itask_cont(ii).eq.iproc) return diff --git a/source/unres/src_MD/int_to_cart.f b/source/unres/src_MD/int_to_cart.f index 73e8384..6d0fb1b 100644 --- a/source/unres/src_MD/int_to_cart.f +++ b/source/unres/src_MD/int_to_cart.f @@ -129,6 +129,15 @@ c do i=1,nres c gloc(i,icg)=0.0D0 c write (iout,*) "poczotkoawy",i,gloc_sc(1,i,icg) c enddo +c write (iout,*) "dtauangle" +c do i=1,nres +c write (iout,*) i +c do j=1,3 +c do k=1,3 +c write (iout,*) (dtauangle(l,k,j,i),l=1,3) +c enddo +c enddo +c enddo if (nres.lt.2) return if ((nres.lt.3).and.(itype(1).eq.10)) return if ((itype(1).ne.10).and.(itype(1).ne.21)) then diff --git a/source/unres/src_MD/intcartderiv.F b/source/unres/src_MD/intcartderiv.F index c220540..d0c1e84 100644 --- a/source/unres/src_MD/intcartderiv.F +++ b/source/unres/src_MD/intcartderiv.F @@ -35,7 +35,7 @@ c We need dtheta(:,:,i-1) to compute dphi(:,:,i) do i=3,nres #endif cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) + sint=dsqrt(1-cost*cost) do j=1,3 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/ & vbld(i-1) @@ -54,9 +54,9 @@ c We need dtheta(:,:,i-1) to compute dphi(:,:,i) #endif if ((itype(i-1).ne.10).and.(itype(i-1).ne.21)) then cost1=dcos(omicron(1,i)) - sint1=sqrt(1-cost1*cost1) + sint1=dsqrt(1-cost1*cost1) cost2=dcos(omicron(2,i)) - sint2=sqrt(1-cost2*cost2) + sint2=dsqrt(1-cost2*cost2) do j=1,3 CC Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ @@ -109,7 +109,7 @@ c the conventional case c Obtaining the gamma derivatives from sine derivative if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. & phi(i).gt.pi34.and.phi(i).le.pi.or. - & phi(i).gt.-pi.and.phi(i).le.-pi34) then + & phi(i).ge.-pi.and.phi(i).le.-pi34) then call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) @@ -149,6 +149,11 @@ c Obtaining the gamma derivatives from cosine derivative endif enddo + do i=1,nres + do j=1,3 + dc_norm2(j,i+nres)=-dc_norm(j,i+nres) + enddo + enddo Calculate derivative of Tauangle #ifdef PARINTDER do i=itau_start,itau_end @@ -165,10 +170,10 @@ c the conventional case cost=dcos(theta(i)) cost1=dcos(omicron(2,i-1)) cosg=dcos(tauangle(1,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) +C do j=1,3 +C dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) cc write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" - enddo +C enddo scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) fac0=1.0d0/(sint1*sint) fac1=cost*fac0 @@ -179,7 +184,7 @@ cc write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 c Obtaining the gamma derivatives from sine derivative if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. & tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. - & tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then + & tauangle(1,i).ge.-pi.and.tauangle(1,i).le.-pi34) then call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) @@ -208,15 +213,15 @@ c Obtaining the gamma derivatives from cosine derivative dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* & (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) - dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) + dtauangle(j,1,1,i)=-1.0d0/sing*dcostau(j,1,1,i) dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & dcostheta(j,1,i) - dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) + dtauangle(j,1,2,i)=-1.0d0/sing*dcostau(j,1,2,i) dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* & dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* & dc_norm(j,i-1))/vbld(i) - dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) + dtauangle(j,1,3,i)=-1.0d0/sing*dcostau(j,1,3,i) c write (iout,*) "else",i enddo endif @@ -250,7 +255,7 @@ c enddo c Obtaining the gamma derivatives from sine derivative if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. & tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. - & tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then + & tauangle(2,i).ge.-pi.and.tauangle(2,i).le.-pi34) then call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) @@ -282,15 +287,15 @@ c Obtaining the gamma derivatives from cosine derivative dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & dc_norm(j,i-3))/vbld(i-2) - dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) + dtauangle(j,2,1,i)=-1.0d0/sing*dcostau(j,2,1,i) dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* & dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* & dcosomicron(j,1,1,i) - dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) + dtauangle(j,2,2,i)=-1.0d0/sing*dcostau(j,2,2,i) dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) + dtauangle(j,2,3,i)=-1.0d0/sing*dcostau(j,2,3,i) c write(iout,*) i,j,"else", dtauangle(j,2,3,i) enddo endif @@ -313,10 +318,10 @@ c the conventional case cost=dcos(omicron(1,i)) cost1=dcos(omicron(2,i-1)) cosg=dcos(tauangle(3,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) +C do j=1,3 +C dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) - enddo +C enddo scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) fac0=1.0d0/(sint1*sint) fac1=cost*fac0 @@ -326,7 +331,7 @@ c dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) c Obtaining the gamma derivatives from sine derivative if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. & tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. - & tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then + & tauangle(3,i).ge.-pi.and.tauangle(3,i).le.-pi34) then call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) @@ -355,15 +360,15 @@ c Obtaining the gamma derivatives from cosine derivative dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & dc_norm2(j,i-2+nres))/vbld(i-2+nres) - dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) + dtauangle(j,3,1,i)=-1.0d0/sing*dcostau(j,3,1,i) dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & dcosomicron(j,1,1,i) - dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) + dtauangle(j,3,2,i)=-1.0d0/sing*dcostau(j,3,2,i) dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* & dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) + dtauangle(j,3,3,i)=-1.0d0/sing*dcostau(j,3,3,i) c write(iout,*) "else",i enddo endif @@ -403,7 +408,7 @@ c Derivatives of side-chain angles alpha and omega c obtaining the derivatives of omega from sines if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. & omeg(i).gt.pi34.and.omeg(i).le.pi.or. - & omeg(i).gt.-pi.and.omeg(i).le.-pi34) then + & omeg(i).ge.-pi.and.omeg(i).le.-pi34) then fac15=dcos(theta(i+1))/(dsin(theta(i+1))* & dsin(theta(i+1))) fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) diff --git a/source/unres/src_MD/lagrangian_lesyng.F b/source/unres/src_MD/lagrangian_lesyng.F index 8a9163a..0c188a9 100644 --- a/source/unres/src_MD/lagrangian_lesyng.F +++ b/source/unres/src_MD/lagrangian_lesyng.F @@ -184,6 +184,7 @@ c sites (dimen1) endif #endif c write (iout,*) "dimen",dimen," dimen1",dimen1," dimen3",dimen3 + write (iout,*) "The number of degrees of freedom ",dimen3 c Zeroing out A and fricmat do i=1,dimen do j=1,dimen @@ -499,7 +500,7 @@ c--------------------------------------------------------------------------- include 'COMMON.TIME1' include 'COMMON.MD' double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 + &,time01,zcopy(dimen3) #ifdef MPI if (nfgtasks.gt.1) then if (fg_rank.eq.0) then @@ -520,7 +521,10 @@ c call MPI_Barrier(FG_COMM,IERROR) time00=MPI_Wtime() call MPI_Scatterv(z,ng_counts(0),ng_start(0), & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + & zcopy,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + do i=1,3*my_ng_count + z(i)=zcopy(i) + enddo c write (2,*) "My chunk of z" c do i=1,3*my_ng_count c write (2,*) i,z(i) @@ -651,7 +655,7 @@ c--------------------------------------------------------------------------- include 'COMMON.LANGEVIN.lang0' #endif double precision z(dimen3),d_a_tmp(dimen3),temp(maxres6),time00 - &time01 + &,time01,zcopy(dimen3) #ifdef MPI if (nfgtasks.gt.1) then if (fg_rank.eq.0) then @@ -665,7 +669,11 @@ c call MPI_Barrier(FG_COMM,IERROR) time00=MPI_Wtime() call MPI_Scatterv(z,ng_counts(0),ng_start(0), & MPI_DOUBLE_PRECISION, - & z,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + & zcopy,3*my_ng_count,MPI_DOUBLE_PRECISION,king,FG_COMM,IERR) + + do i=1,3*my_ng_count + z(i)=zcopy(i) + enddo c write (2,*) "My chunk of z" c do i=1,3*my_ng_count c write (2,*) i,z(i) diff --git a/source/unres/src_MD/minimize_p.F b/source/unres/src_MD/minimize_p.F index c7922c7..da97f60 100644 --- a/source/unres/src_MD/minimize_p.F +++ b/source/unres/src_MD/minimize_p.F @@ -17,6 +17,7 @@ include 'COMMON.VAR' include 'COMMON.GEO' include 'COMMON.MINIM' + include 'COMMON.CONTROL' common /srutu/ icall dimension iv(liv) double precision minval,x(maxvar),d(maxvar),v(1:lv),xx(maxvar) @@ -83,6 +84,8 @@ c call var_to_geom(nvar,x) c call chainbuild c call etotal(energia(0)) c etot = energia(0) +c icheckgrad=3 +c call exec_checkgrad IF (mask_r) THEN call x2xx(x,xx,nvar_restr) call sumsl(nvar_restr,d,xx,func_restr,grad_restr, @@ -91,6 +94,8 @@ c etot = energia(0) ELSE call sumsl(nvar,d,x,func,gradient,iv,liv,lv,v,idum,rdum,fdum) ENDIF +c icheckgrad=3 +c call exec_checkgrad etot=v(10) iretcode=iv(1) cd print *,'Exit SUMSL; return code:',iretcode,' energy:',etot @@ -482,6 +487,9 @@ c v(25)=4.0D0 enddo endif enddo + print *,"check_ecart before sumsl" +c icheckgrad=2 +c call exec_checkgrad call sumsl(k,d,x,func_dc,grad_dc,iv,liv,lv,v,idum,rdum,fdum) @@ -517,6 +525,9 @@ cd enddo etot=v(10) iretcode=iv(1) nfun=iv(6) + print *,"check_ecart" +c icheckgrad=2 +c call exec_checkgrad return end diff --git a/source/unres/src_MD/parmread.F b/source/unres/src_MD/parmread.F index cd9bda2..030d64e 100644 --- a/source/unres/src_MD/parmread.F +++ b/source/unres/src_MD/parmread.F @@ -565,8 +565,8 @@ cc maxinter is maximum interaction sites do l=1,maxinter do i=1,nsccortyp do j=1,nsccortyp - read (isccor,*,end=1113,err=1113) - & nterm_sccor(i,j),nlor_sccor(i,j) + read (isccor,*,end=1113,err=1113) nterm_sccor(i,j), + & nlor_sccor(i,j) v0ijsccor=0.0d0 si=-1.0d0 diff --git a/source/unres/src_MD/prng.f b/source/unres/src_MD/prng.f deleted file mode 100644 index 73f6766..0000000 --- a/source/unres/src_MD/prng.f +++ /dev/null @@ -1,525 +0,0 @@ - real*8 function prng_next(me) - implicit none - integer me -c -c Calling sequence: -c = prng_next ( ) -c = vprng ( , , ) -c -c This code is based on a sequential algorithm provided by Mal Kalos. -c This version uses a single 64-bit word to store the initial seeds -c and additive constants. -c A 64-bit floating point number is returned. -c -c The array "iparam" is full-word aligned, being padded by zeros to -c let each generator be on a subpage boundary. -c That is, rows 1 and 2 in a given column of the array are for real, -c rows 3-16 are bogus. -c -c July 12, 1993: double the number of sequences. We should have been -c using two packets per seed, rather than four -c October 31, 1993: merge the two arrays of seeds and constants, -c and switch to 64-bit arithmetic. -c June 1994: port to RS6K. Internal state is kept as 2 64-bit integers -c The ishft function is defined only on 32-bit integers, so we will -c shift numbers by dividing by 2**11 and then adding on 2**53-1. -c -c November 1994: ishift now works on 64-bit numbers (though it gives a -c warning). Thus we go back to using it. John Zollweg also added the -c vprng() routine to return vectors of real*8 random numbers. -c - real*8 recip53 - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 two - parameter ( two = 2**11) - integer*8 m,ishift -c parameter ( m = 34522712143931 ) ! 11**13 -c parameter ( ishift = 9007199254740991 ) ! 2**53-1 - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - ishift = dint(9007199254740991.0d0) - -c RS6K porting note: ishift now takes 64-bit integers , with a warning - if ( 0.le.me .and. me.le.nmax ) then - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - prng_next = recip53 * ishft( next, -11 ) - else - prng_next=-1.0D0 - endif - - end -c -c vprng(me, rn, num) Get a vector of random numbers -c - subroutine vprng(me,rn,num) - real*8 recip53, rn(1) - parameter ( recip53 = 2.0D0**(-53) ) - integer*8 m,iparam -c parameter ( m = 34522712143931 ) ! 11**13 - integer nmax, num, me - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - integer*8 next - -crc g77 doesn't support integer*8 constants - m = dint(34522712143931.0d0) - - if ( 0.le.me .and. me.le.nmax ) then - do 1 i=1,num - next = iparam(1,me)*m + iparam(2,me) - iparam(1,me) = next - rn(i) = recip53 * ishft( next, -11 ) - 1 continue - else - rn(1)=-1.0D0 - endif - return - end - -c -c prng_chkpnt Get the current state of a generator -c -c Calling sequence: -c logical prng_chkpnt, status -c status = prng_chkpnt (me, iseed) where -c -c me is the particular generator whose state is being gotten -c seed is an 4-element integer array where the "l"-values will be saved -c - logical function prng_chkpnt (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_chkpnt=.false. - else - prng_chkpnt=.true. - iseed=iparam(1,me) - endif - end -c -c prng_restart Restart generator from a saved state -c -c Calling sequence: -c logical prng_restart, status -c status = prng_restart (me, iseed) where -c -c me is the particular generator being restarted -c iseed is a 8-byte integer containing the "l"-values -c - logical function prng_restart (me, iseed) - implicit none - integer me - integer*8 iseed - - integer nmax - integer*8 iparam - parameter(nmax=1021) - common/ksrprng/iparam(2,0:nmax) - - if (me .lt. 0 .or. me .gt. nmax) then - prng_restart=.false. - return - else - prng_restart=.true. - iparam(1,me)=iseed - endif - end - - block data prngblk - parameter(nmax=1021) - integer*8 iparam - common/ksrprng/iparam(2,0:nmax) - data (iparam(1,i),iparam(2,i),i= 0, 29) / - + 11848219, 11848219, 11848237, 11848237, 11848241, 11848241, - + 11848247, 11848247, 11848253, 11848253, 11848271, 11848271, - + 11848297, 11848297, 11848313, 11848313, 11848339, 11848339, - + 11848351, 11848351, 11848357, 11848357, 11848363, 11848363, - + 11848367, 11848367, 11848373, 11848373, 11848379, 11848379, - + 11848393, 11848393, 11848433, 11848433, 11848451, 11848451, - + 11848469, 11848469, 11848477, 11848477, 11848489, 11848489, - + 11848493, 11848493, 11848513, 11848513, 11848523, 11848523, - + 11848531, 11848531, 11848537, 11848537, 11848553, 11848553, - + 11848589, 11848589, 11848591, 11848591, 11848601, 11848601 / - data (iparam(1,i),iparam(2,i),i= 30, 59) / - + 11848619, 11848619, 11848637, 11848637, 11848663, 11848663, - + 11848673, 11848673, 11848679, 11848679, 11848691, 11848691, - + 11848699, 11848699, 11848709, 11848709, 11848717, 11848717, - + 11848721, 11848721, 11848729, 11848729, 11848741, 11848741, - + 11848751, 11848751, 11848757, 11848757, 11848787, 11848787, - + 11848801, 11848801, 11848829, 11848829, 11848853, 11848853, - + 11848861, 11848861, 11848867, 11848867, 11848873, 11848873, - + 11848891, 11848891, 11848909, 11848909, 11848919, 11848919, - + 11848931, 11848931, 11848937, 11848937, 11848961, 11848961, - + 11848981, 11848981, 11849021, 11849021, 11849039, 11849039 / - data (iparam(1,i),iparam(2,i),i= 60, 89) / - + 11849053, 11849053, 11849059, 11849059, 11849069, 11849069, - + 11849077, 11849077, 11849087, 11849087, 11849093, 11849093, - + 11849107, 11849107, 11849111, 11849111, 11849129, 11849129, - + 11849137, 11849137, 11849177, 11849177, 11849183, 11849183, - + 11849203, 11849203, 11849231, 11849231, 11849237, 11849237, - + 11849239, 11849239, 11849249, 11849249, 11849251, 11849251, - + 11849269, 11849269, 11849273, 11849273, 11849291, 11849291, - + 11849297, 11849297, 11849309, 11849309, 11849339, 11849339, - + 11849359, 11849359, 11849363, 11849363, 11849399, 11849399, - + 11849401, 11849401, 11849413, 11849413, 11849417, 11849417 / - data (iparam(1,i),iparam(2,i),i= 90, 119) / - + 11849437, 11849437, 11849443, 11849443, 11849473, 11849473, - + 11849491, 11849491, 11849503, 11849503, 11849507, 11849507, - + 11849557, 11849557, 11849567, 11849567, 11849569, 11849569, - + 11849573, 11849573, 11849587, 11849587, 11849599, 11849599, - + 11849633, 11849633, 11849641, 11849641, 11849653, 11849653, - + 11849659, 11849659, 11849671, 11849671, 11849683, 11849683, - + 11849689, 11849689, 11849693, 11849693, 11849699, 11849699, - + 11849701, 11849701, 11849707, 11849707, 11849713, 11849713, - + 11849723, 11849723, 11849741, 11849741, 11849743, 11849743, - + 11849759, 11849759, 11849767, 11849767, 11849771, 11849771 / - data (iparam(1,i),iparam(2,i),i= 120, 149) / - + 11849791, 11849791, 11849801, 11849801, 11849809, 11849809, - + 11849813, 11849813, 11849869, 11849869, 11849881, 11849881, - + 11849891, 11849891, 11849909, 11849909, 11849923, 11849923, - + 11849933, 11849933, 11849947, 11849947, 11849987, 11849987, - + 11850001, 11850001, 11850011, 11850011, 11850019, 11850019, - + 11850023, 11850023, 11850031, 11850031, 11850049, 11850049, - + 11850061, 11850061, 11850073, 11850073, 11850077, 11850077, - + 11850103, 11850103, 11850109, 11850109, 11850121, 11850121, - + 11850127, 11850127, 11850133, 11850133, 11850149, 11850149, - + 11850161, 11850161, 11850169, 11850169, 11850191, 11850191 / - data (iparam(1,i),iparam(2,i),i= 150, 179) / - + 11850233, 11850233, 11850247, 11850247, 11850259, 11850259, - + 11850269, 11850269, 11850283, 11850283, 11850301, 11850301, - + 11850341, 11850341, 11850347, 11850347, 11850367, 11850367, - + 11850373, 11850373, 11850379, 11850379, 11850389, 11850389, - + 11850407, 11850407, 11850427, 11850427, 11850437, 11850437, - + 11850469, 11850469, 11850481, 11850481, 11850511, 11850511, - + 11850529, 11850529, 11850541, 11850541, 11850557, 11850557, - + 11850607, 11850607, 11850611, 11850611, 11850667, 11850667, - + 11850677, 11850677, 11850679, 11850679, 11850701, 11850701, - + 11850731, 11850731, 11850739, 11850739, 11850749, 11850749 / - data (iparam(1,i),iparam(2,i),i= 180, 209) / - + 11850791, 11850791, 11850803, 11850803, 11850829, 11850829, - + 11850833, 11850833, 11850859, 11850859, 11850877, 11850877, - + 11850899, 11850899, 11850907, 11850907, 11850913, 11850913, - + 11850919, 11850919, 11850931, 11850931, 11850941, 11850941, - + 11850947, 11850947, 11850953, 11850953, 11850961, 11850961, - + 11850983, 11850983, 11850991, 11850991, 11850997, 11850997, - + 11851031, 11851031, 11851033, 11851033, 11851051, 11851051, - + 11851061, 11851061, 11851067, 11851067, 11851093, 11851093, - + 11851109, 11851109, 11851123, 11851123, 11851127, 11851127, - + 11851139, 11851139, 11851157, 11851157, 11851163, 11851163 / - data (iparam(1,i),iparam(2,i),i= 210, 239) / - + 11851181, 11851181, 11851201, 11851201, 11851219, 11851219, - + 11851291, 11851291, 11851303, 11851303, 11851309, 11851309, - + 11851313, 11851313, 11851319, 11851319, 11851349, 11851349, - + 11851351, 11851351, 11851361, 11851361, 11851373, 11851373, - + 11851403, 11851403, 11851409, 11851409, 11851423, 11851423, - + 11851447, 11851447, 11851451, 11851451, 11851481, 11851481, - + 11851493, 11851493, 11851519, 11851519, 11851523, 11851523, - + 11851529, 11851529, 11851547, 11851547, 11851549, 11851549, - + 11851559, 11851559, 11851577, 11851577, 11851589, 11851589, - + 11851591, 11851591, 11851597, 11851597, 11851603, 11851603 / - data (iparam(1,i),iparam(2,i),i= 240, 269) / - + 11851607, 11851607, 11851613, 11851613, 11851621, 11851621, - + 11851627, 11851627, 11851639, 11851639, 11851673, 11851673, - + 11851681, 11851681, 11851727, 11851727, 11851753, 11851753, - + 11851759, 11851759, 11851787, 11851787, 11851793, 11851793, - + 11851799, 11851799, 11851813, 11851813, 11851841, 11851841, - + 11851859, 11851859, 11851867, 11851867, 11851891, 11851891, - + 11851909, 11851909, 11851919, 11851919, 11851927, 11851927, - + 11851933, 11851933, 11851949, 11851949, 11851967, 11851967, - + 11851997, 11851997, 11852017, 11852017, 11852051, 11852051, - + 11852053, 11852053, 11852059, 11852059, 11852083, 11852083 / - data (iparam(1,i),iparam(2,i),i= 270, 299) / - + 11852089, 11852089, 11852129, 11852129, 11852147, 11852147, - + 11852149, 11852149, 11852161, 11852161, 11852171, 11852171, - + 11852177, 11852177, 11852209, 11852209, 11852221, 11852221, - + 11852237, 11852237, 11852251, 11852251, 11852263, 11852263, - + 11852273, 11852273, 11852279, 11852279, 11852287, 11852287, - + 11852293, 11852293, 11852297, 11852297, 11852303, 11852303, - + 11852311, 11852311, 11852327, 11852327, 11852339, 11852339, - + 11852341, 11852341, 11852359, 11852359, 11852369, 11852369, - + 11852437, 11852437, 11852453, 11852453, 11852459, 11852459, - + 11852473, 11852473, 11852513, 11852513, 11852531, 11852531 / - data (iparam(1,i),iparam(2,i),i= 300, 329) / - + 11852537, 11852537, 11852539, 11852539, 11852557, 11852557, - + 11852573, 11852573, 11852579, 11852579, 11852591, 11852591, - + 11852609, 11852609, 11852611, 11852611, 11852623, 11852623, - + 11852641, 11852641, 11852647, 11852647, 11852657, 11852657, - + 11852663, 11852663, 11852717, 11852717, 11852719, 11852719, - + 11852741, 11852741, 11852759, 11852759, 11852767, 11852767, - + 11852773, 11852773, 11852803, 11852803, 11852807, 11852807, - + 11852809, 11852809, 11852831, 11852831, 11852833, 11852833, - + 11852837, 11852837, 11852857, 11852857, 11852873, 11852873, - + 11852879, 11852879, 11852891, 11852891, 11852917, 11852917 / - data (iparam(1,i),iparam(2,i),i= 330, 359) / - + 11852921, 11852921, 11852957, 11852957, 11852959, 11852959, - + 11852969, 11852969, 11852983, 11852983, 11852989, 11852989, - + 11853001, 11853001, 11853013, 11853013, 11853019, 11853019, - + 11853031, 11853031, 11853089, 11853089, 11853133, 11853133, - + 11853157, 11853157, 11853161, 11853161, 11853181, 11853181, - + 11853203, 11853203, 11853217, 11853217, 11853221, 11853221, - + 11853227, 11853227, 11853241, 11853241, 11853307, 11853307, - + 11853319, 11853319, 11853323, 11853323, 11853329, 11853329, - + 11853367, 11853367, 11853383, 11853383, 11853419, 11853419, - + 11853421, 11853421, 11853427, 11853427, 11853449, 11853449 / - data (iparam(1,i),iparam(2,i),i= 360, 389) / - + 11853451, 11853451, 11853463, 11853463, 11853529, 11853529, - + 11853557, 11853557, 11853571, 11853571, 11853601, 11853601, - + 11853613, 11853613, 11853617, 11853617, 11853629, 11853629, - + 11853649, 11853649, 11853659, 11853659, 11853679, 11853679, - + 11853689, 11853689, 11853719, 11853719, 11853731, 11853731, - + 11853757, 11853757, 11853761, 11853761, 11853773, 11853773, - + 11853791, 11853791, 11853817, 11853817, 11853839, 11853839, - + 11853847, 11853847, 11853857, 11853857, 11853869, 11853869, - + 11853883, 11853883, 11853887, 11853887, 11853889, 11853889, - + 11853893, 11853893, 11853899, 11853899, 11853911, 11853911 / - data (iparam(1,i),iparam(2,i),i= 390, 419) / - + 11853931, 11853931, 11853943, 11853943, 11853979, 11853979, - + 11853991, 11853991, 11854001, 11854001, 11854009, 11854009, - + 11854019, 11854019, 11854057, 11854057, 11854061, 11854061, - + 11854147, 11854147, 11854159, 11854159, 11854163, 11854163, - + 11854169, 11854169, 11854211, 11854211, 11854247, 11854247, - + 11854261, 11854261, 11854267, 11854267, 11854279, 11854279, - + 11854303, 11854303, 11854327, 11854327, 11854331, 11854331, - + 11854333, 11854333, 11854363, 11854363, 11854379, 11854379, - + 11854399, 11854399, 11854411, 11854411, 11854429, 11854429, - + 11854433, 11854433, 11854439, 11854439, 11854441, 11854441 / - data (iparam(1,i),iparam(2,i),i= 420, 449) / - + 11854463, 11854463, 11854477, 11854477, 11854489, 11854489, - + 11854517, 11854517, 11854519, 11854519, 11854523, 11854523, - + 11854529, 11854529, 11854567, 11854567, 11854571, 11854571, - + 11854573, 11854573, 11854603, 11854603, 11854607, 11854607, - + 11854681, 11854681, 11854691, 11854691, 11854709, 11854709, - + 11854723, 11854723, 11854757, 11854757, 11854783, 11854783, - + 11854793, 11854793, 11854813, 11854813, 11854847, 11854847, - + 11854853, 11854853, 11854873, 11854873, 11854877, 11854877, - + 11854883, 11854883, 11854891, 11854891, 11854897, 11854897, - + 11854901, 11854901, 11854919, 11854919, 11854937, 11854937 / - data (iparam(1,i),iparam(2,i),i= 450, 479) / - + 11854961, 11854961, 11854963, 11854963, 11854979, 11854979, - + 11855003, 11855003, 11855017, 11855017, 11855023, 11855023, - + 11855029, 11855029, 11855033, 11855033, 11855111, 11855111, - + 11855141, 11855141, 11855147, 11855147, 11855149, 11855149, - + 11855159, 11855159, 11855177, 11855177, 11855203, 11855203, - + 11855213, 11855213, 11855219, 11855219, 11855231, 11855231, - + 11855267, 11855267, 11855269, 11855269, 11855303, 11855303, - + 11855309, 11855309, 11855321, 11855321, 11855329, 11855329, - + 11855339, 11855339, 11855351, 11855351, 11855353, 11855353, - + 11855357, 11855357, 11855359, 11855359, 11855381, 11855381 / - data (iparam(1,i),iparam(2,i),i= 480, 509) / - + 11855383, 11855383, 11855387, 11855387, 11855399, 11855399, - + 11855407, 11855407, 11855413, 11855413, 11855489, 11855489, - + 11855491, 11855491, 11855507, 11855507, 11855521, 11855521, - + 11855531, 11855531, 11855549, 11855549, 11855551, 11855551, - + 11855567, 11855567, 11855581, 11855581, 11855587, 11855587, - + 11855593, 11855593, 11855633, 11855633, 11855653, 11855653, - + 11855663, 11855663, 11855687, 11855687, 11855689, 11855689, - + 11855699, 11855699, 11855713, 11855713, 11855731, 11855731, - + 11855737, 11855737, 11855743, 11855743, 11855747, 11855747, - + 11855759, 11855759, 11855773, 11855773, 11855801, 11855801 / - data (iparam(1,i),iparam(2,i),i= 510, 539) / - + 11855807, 11855807, 11855813, 11855813, 11855827, 11855827, - + 11855839, 11855839, 11855869, 11855869, 11855881, 11855881, - + 11855903, 11855903, 11855911, 11855911, 11855933, 11855933, - + 11855959, 11855959, 11855989, 11855989, 11855993, 11855993, - + 11855999, 11855999, 11856001, 11856001, 11856023, 11856023, - + 11856049, 11856049, 11856071, 11856071, 11856101, 11856101, - + 11856107, 11856107, 11856113, 11856113, 11856139, 11856139, - + 11856151, 11856151, 11856161, 11856161, 11856179, 11856179, - + 11856193, 11856193, 11856199, 11856199, 11856223, 11856223, - + 11856239, 11856239, 11856263, 11856263, 11856269, 11856269 / - data (iparam(1,i),iparam(2,i),i= 540, 569) / - + 11856281, 11856281, 11856287, 11856287, 11856307, 11856307, - + 11856311, 11856311, 11856329, 11856329, 11856343, 11856343, - + 11856359, 11856359, 11856371, 11856371, 11856373, 11856373, - + 11856409, 11856409, 11856419, 11856419, 11856461, 11856461, - + 11856469, 11856469, 11856473, 11856473, 11856479, 11856479, - + 11856511, 11856511, 11856517, 11856517, 11856541, 11856541, - + 11856547, 11856547, 11856553, 11856553, 11856583, 11856583, - + 11856629, 11856629, 11856641, 11856641, 11856653, 11856653, - + 11856659, 11856659, 11856673, 11856673, 11856697, 11856697, - + 11856709, 11856709, 11856727, 11856727, 11856731, 11856731 / - data (iparam(1,i),iparam(2,i),i= 570, 599) / - + 11856763, 11856763, 11856809, 11856809, 11856811, 11856811, - + 11856821, 11856821, 11856841, 11856841, 11856857, 11856857, - + 11856877, 11856877, 11856883, 11856883, 11856899, 11856899, - + 11856919, 11856919, 11856947, 11856947, 11856953, 11856953, - + 11856979, 11856979, 11857003, 11857003, 11857033, 11857033, - + 11857037, 11857037, 11857039, 11857039, 11857049, 11857049, - + 11857061, 11857061, 11857067, 11857067, 11857073, 11857073, - + 11857081, 11857081, 11857091, 11857091, 11857093, 11857093, - + 11857099, 11857099, 11857123, 11857123, 11857127, 11857127, - + 11857147, 11857147, 11857151, 11857151, 11857193, 11857193 / - data (iparam(1,i),iparam(2,i),i= 600, 629) / - + 11857217, 11857217, 11857229, 11857229, 11857243, 11857243, - + 11857249, 11857249, 11857267, 11857267, 11857277, 11857277, - + 11857291, 11857291, 11857303, 11857303, 11857309, 11857309, - + 11857327, 11857327, 11857331, 11857331, 11857333, 11857333, - + 11857361, 11857361, 11857367, 11857367, 11857369, 11857369, - + 11857393, 11857393, 11857399, 11857399, 11857409, 11857409, - + 11857421, 11857421, 11857423, 11857423, 11857451, 11857451, - + 11857453, 11857453, 11857457, 11857457, 11857477, 11857477, - + 11857481, 11857481, 11857493, 11857493, 11857499, 11857499, - + 11857519, 11857519, 11857523, 11857523, 11857529, 11857529 / - data (iparam(1,i),iparam(2,i),i= 630, 659) / - + 11857543, 11857543, 11857561, 11857561, 11857589, 11857589, - + 11857591, 11857591, 11857613, 11857613, 11857621, 11857621, - + 11857661, 11857661, 11857667, 11857667, 11857693, 11857693, - + 11857697, 11857697, 11857709, 11857709, 11857711, 11857711, - + 11857751, 11857751, 11857753, 11857753, 11857759, 11857759, - + 11857763, 11857763, 11857777, 11857777, 11857787, 11857787, - + 11857793, 11857793, 11857801, 11857801, 11857817, 11857817, - + 11857819, 11857819, 11857831, 11857831, 11857837, 11857837, - + 11857873, 11857873, 11857877, 11857877, 11857883, 11857883, - + 11857889, 11857889, 11857907, 11857907, 11857913, 11857913 / - data (iparam(1,i),iparam(2,i),i= 660, 689) / - + 11857931, 11857931, 11857969, 11857969, 11857991, 11857991, - + 11857999, 11857999, 11858009, 11858009, 11858017, 11858017, - + 11858023, 11858023, 11858029, 11858029, 11858039, 11858039, - + 11858051, 11858051, 11858057, 11858057, 11858059, 11858059, - + 11858101, 11858101, 11858111, 11858111, 11858131, 11858131, - + 11858149, 11858149, 11858159, 11858159, 11858177, 11858177, - + 11858191, 11858191, 11858201, 11858201, 11858227, 11858227, - + 11858243, 11858243, 11858267, 11858267, 11858269, 11858269, - + 11858279, 11858279, 11858281, 11858281, 11858291, 11858291, - + 11858311, 11858311, 11858323, 11858323, 11858359, 11858359 / - data (iparam(1,i),iparam(2,i),i= 690, 719) / - + 11858377, 11858377, 11858381, 11858381, 11858387, 11858387, - + 11858423, 11858423, 11858443, 11858443, 11858447, 11858447, - + 11858479, 11858479, 11858533, 11858533, 11858543, 11858543, - + 11858551, 11858551, 11858557, 11858557, 11858569, 11858569, - + 11858573, 11858573, 11858579, 11858579, 11858597, 11858597, - + 11858599, 11858599, 11858629, 11858629, 11858657, 11858657, - + 11858659, 11858659, 11858683, 11858683, 11858701, 11858701, - + 11858719, 11858719, 11858723, 11858723, 11858729, 11858729, - + 11858747, 11858747, 11858779, 11858779, 11858783, 11858783, - + 11858801, 11858801, 11858807, 11858807, 11858813, 11858813 / - data (iparam(1,i),iparam(2,i),i= 720, 749) / - + 11858839, 11858839, 11858851, 11858851, 11858893, 11858893, - + 11858897, 11858897, 11858921, 11858921, 11858947, 11858947, - + 11858953, 11858953, 11858969, 11858969, 11858971, 11858971, - + 11858989, 11858989, 11859017, 11859017, 11859031, 11859031, - + 11859049, 11859049, 11859061, 11859061, 11859073, 11859073, - + 11859077, 11859077, 11859079, 11859079, 11859083, 11859083, - + 11859101, 11859101, 11859109, 11859109, 11859137, 11859137, - + 11859139, 11859139, 11859151, 11859151, 11859157, 11859157, - + 11859163, 11859163, 11859167, 11859167, 11859179, 11859179, - + 11859187, 11859187, 11859229, 11859229, 11859233, 11859233 / - data (iparam(1,i),iparam(2,i),i= 750, 779) / - + 11859241, 11859241, 11859247, 11859247, 11859269, 11859269, - + 11859293, 11859293, 11859307, 11859307, 11859311, 11859311, - + 11859349, 11859349, 11859359, 11859359, 11859371, 11859371, - + 11859377, 11859377, 11859383, 11859383, 11859427, 11859427, - + 11859433, 11859433, 11859451, 11859451, 11859457, 11859457, - + 11859461, 11859461, 11859473, 11859473, 11859481, 11859481, - + 11859487, 11859487, 11859493, 11859493, 11859503, 11859503, - + 11859509, 11859509, 11859539, 11859539, 11859541, 11859541, - + 11859563, 11859563, 11859569, 11859569, 11859571, 11859571, - + 11859583, 11859583, 11859599, 11859599, 11859611, 11859611 / - data (iparam(1,i),iparam(2,i),i= 780, 809) / - + 11859643, 11859643, 11859707, 11859707, 11859713, 11859713, - + 11859719, 11859719, 11859739, 11859739, 11859751, 11859751, - + 11859791, 11859791, 11859817, 11859817, 11859821, 11859821, - + 11859833, 11859833, 11859847, 11859847, 11859853, 11859853, - + 11859877, 11859877, 11859889, 11859889, 11859893, 11859893, - + 11859901, 11859901, 11859907, 11859907, 11859917, 11859917, - + 11859923, 11859923, 11859929, 11859929, 11859961, 11859961, - + 11859979, 11859979, 11859989, 11859989, 11859997, 11859997, - + 11860021, 11860021, 11860031, 11860031, 11860039, 11860039, - + 11860049, 11860049, 11860081, 11860081, 11860087, 11860087 / - data (iparam(1,i),iparam(2,i),i= 810, 839) / - + 11860097, 11860097, 11860103, 11860103, 11860109, 11860109, - + 11860117, 11860117, 11860133, 11860133, 11860151, 11860151, - + 11860171, 11860171, 11860207, 11860207, 11860223, 11860223, - + 11860231, 11860231, 11860243, 11860243, 11860267, 11860267, - + 11860301, 11860301, 11860307, 11860307, 11860327, 11860327, - + 11860379, 11860379, 11860397, 11860397, 11860411, 11860411, - + 11860469, 11860469, 11860477, 11860477, 11860483, 11860483, - + 11860487, 11860487, 11860489, 11860489, 11860493, 11860493, - + 11860517, 11860517, 11860547, 11860547, 11860567, 11860567, - + 11860573, 11860573, 11860613, 11860613, 11860619, 11860619 / - data (iparam(1,i),iparam(2,i),i= 840, 869) / - + 11860627, 11860627, 11860637, 11860637, 11860643, 11860643, - + 11860649, 11860649, 11860661, 11860661, 11860669, 11860669, - + 11860687, 11860687, 11860691, 11860691, 11860697, 11860697, - + 11860699, 11860699, 11860703, 11860703, 11860727, 11860727, - + 11860741, 11860741, 11860753, 11860753, 11860777, 11860777, - + 11860787, 11860787, 11860789, 11860789, 11860811, 11860811, - + 11860837, 11860837, 11860859, 11860859, 11860867, 11860867, - + 11860889, 11860889, 11860897, 11860897, 11860963, 11860963, - + 11860969, 11860969, 11860973, 11860973, 11860993, 11860993, - + 11861011, 11861011, 11861033, 11861033, 11861071, 11861071 / - data (iparam(1,i),iparam(2,i),i= 870, 899) / - + 11861081, 11861081, 11861089, 11861089, 11861093, 11861093, - + 11861099, 11861099, 11861107, 11861107, 11861131, 11861131, - + 11861141, 11861141, 11861159, 11861159, 11861167, 11861167, - + 11861191, 11861191, 11861197, 11861197, 11861207, 11861207, - + 11861219, 11861219, 11861221, 11861221, 11861231, 11861231, - + 11861237, 11861237, 11861273, 11861273, 11861293, 11861293, - + 11861299, 11861299, 11861303, 11861303, 11861327, 11861327, - + 11861351, 11861351, 11861357, 11861357, 11861363, 11861363, - + 11861371, 11861371, 11861401, 11861401, 11861407, 11861407, - + 11861411, 11861411, 11861413, 11861413, 11861429, 11861429 / - data (iparam(1,i),iparam(2,i),i= 900, 929) / - + 11861441, 11861441, 11861467, 11861467, 11861527, 11861527, - + 11861539, 11861539, 11861543, 11861543, 11861557, 11861557, - + 11861569, 11861569, 11861573, 11861573, 11861579, 11861579, - + 11861581, 11861581, 11861599, 11861599, 11861611, 11861611, - + 11861617, 11861617, 11861627, 11861627, 11861639, 11861639, - + 11861651, 11861651, 11861659, 11861659, 11861671, 11861671, - + 11861683, 11861683, 11861687, 11861687, 11861693, 11861693, - + 11861701, 11861701, 11861711, 11861711, 11861713, 11861713, - + 11861749, 11861749, 11861791, 11861791, 11861803, 11861803, - + 11861819, 11861819, 11861827, 11861827, 11861849, 11861849 / - data (iparam(1,i),iparam(2,i),i= 930, 959) / - + 11861873, 11861873, 11861879, 11861879, 11861887, 11861887, - + 11861911, 11861911, 11861917, 11861917, 11861921, 11861921, - + 11861923, 11861923, 11861953, 11861953, 11861959, 11861959, - + 11861987, 11861987, 11862007, 11862007, 11862013, 11862013, - + 11862029, 11862029, 11862031, 11862031, 11862049, 11862049, - + 11862077, 11862077, 11862083, 11862083, 11862157, 11862157, - + 11862167, 11862167, 11862199, 11862199, 11862203, 11862203, - + 11862217, 11862217, 11862223, 11862223, 11862229, 11862229, - + 11862233, 11862233, 11862239, 11862239, 11862241, 11862241, - + 11862259, 11862259, 11862269, 11862269, 11862271, 11862271 / - data (iparam(1,i),iparam(2,i),i= 960, 989) / - + 11862293, 11862293, 11862307, 11862307, 11862313, 11862313, - + 11862317, 11862317, 11862343, 11862343, 11862353, 11862353, - + 11862373, 11862373, 11862391, 11862391, 11862439, 11862439, - + 11862469, 11862469, 11862493, 11862493, 11862527, 11862527, - + 11862547, 11862547, 11862563, 11862563, 11862569, 11862569, - + 11862577, 11862577, 11862581, 11862581, 11862611, 11862611, - + 11862623, 11862623, 11862661, 11862661, 11862673, 11862673, - + 11862679, 11862679, 11862701, 11862701, 11862703, 11862703, - + 11862713, 11862713, 11862761, 11862761, 11862791, 11862791, - + 11862803, 11862803, 11862839, 11862839, 11862841, 11862841 / - data (iparam(1,i),iparam(2,i),i= 990,1019) / - + 11862857, 11862857, 11862869, 11862869, 11862881, 11862881, - + 11862911, 11862911, 11862919, 11862919, 11862959, 11862959, - + 11862979, 11862979, 11862989, 11862989, 11862997, 11862997, - + 11863021, 11863021, 11863031, 11863031, 11863037, 11863037, - + 11863039, 11863039, 11863057, 11863057, 11863067, 11863067, - + 11863073, 11863073, 11863099, 11863099, 11863109, 11863109, - + 11863121, 11863121, 11863123, 11863123, 11863133, 11863133, - + 11863151, 11863151, 11863153, 11863153, 11863171, 11863171, - + 11863183, 11863183, 11863207, 11863207, 11863213, 11863213, - + 11863237, 11863237, 11863249, 11863249, 11863253, 11863253 / - data (iparam(1,i),iparam(2,i),i=1020,1021) / - + 11863259, 11863259, 11863279, 11863279 / - end diff --git a/source/unres/src_MD/readrtns.F b/source/unres/src_MD/readrtns.F index 5b74f87..fd00153 100644 --- a/source/unres/src_MD/readrtns.F +++ b/source/unres/src_MD/readrtns.F @@ -860,12 +860,36 @@ C 12/1/95 Added weight for the multi-body term WCORR call reada(weightcard,"V2SS",v2ss,7.61d0) call reada(weightcard,"V3SS",v3ss,13.7d0) call reada(weightcard,"EBR",ebr,-5.50D0) + dyn_ss=(index(weightcard,'DYN_SS').gt.0) + do i=1,maxres + dyn_ss_mask(i)=.false. + enddo + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo + enddo + call reada(weightcard,"HT",Ht,0.0D0) + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + endif + if(me.eq.king.or..not.out1file) then write (iout,*) "Parameters of the SS-bond potential:" write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, & " AKCT",akct write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr + write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth + write (iout,*)" HT",Ht print *,'indpdb=',indpdb,' pdbref=',pdbref endif if (indpdb.gt.0 .or. pdbref) then @@ -916,8 +940,8 @@ C 10/03/12 Adam: Recalculate coordinates with new side chain positions call chainbuild endif C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "After sideadd" - call intout +c write (iout,*) "After sideadd" +c call intout endif if (indpdb.eq.0) then C Read sequence if not taken from the pdb file. @@ -932,6 +956,20 @@ C Convert sequence to numeric code do i=1,nres itype(i)=rescode(i,sequence(i),iscode) enddo + if (itype(2).eq.10.and.itype(1).eq.ntyp1) then + write (iout,*) + & "Glycine is the first full residue, initial dummy deleted" + do i=1,nres + itype(i)=itype(i+1) + enddo + nres=nres-1 + endif + if (itype(nres-1).eq.10.and.itype(nres).eq.ntyp1) then + write (iout,*) + & "Glycine is the last full residue, terminal dummy deleted" + nres=nres-1 + endif + C Assign initial virtual bond lengths do i=2,nres vbld(i)=vbl @@ -1225,18 +1263,35 @@ C Generate distance constraints, if the PDB structure is to be regularized. write (iout,'(/a,i3,a)') & 'The chain contains',ns,' disulfide-bridging cysteines.' write (iout,'(20i4)') (iss(i),i=1,ns) + if (dyn_ss) then + write(iout,*)"Running with dynamic disulfide-bond formation" + else write (iout,'(/a/)') 'Pre-formed links are:' do i=1,nss i1=ihpb(i)-nres i2=jhpb(i)-nres it1=itype(i1) it2=itype(i2) - if (me.eq.king.or..not.out1file) - & write (iout,'(2a,i3,3a,i3,a,3f10.3)') + write (iout,'(2a,i3,3a,i3,a,3f10.3)') & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), & ebr,forcon(i) enddo write (iout,'(a)') + endif + endif + if (ns.gt.0.and.dyn_ss) then + do i=nss+1,nhpb + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. + enddo endif if (i2ndstr.gt.0) call secstrp2dihc c call geom_to_var(nvar,x) @@ -1300,10 +1355,12 @@ C Check whether the specified bridging residues are cystines. do i=1,ns if (itype(iss(i)).ne.1) then if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' #ifdef MPI call MPI_Finalize(MPI_COMM_WORLD,ierror) @@ -1314,7 +1371,8 @@ C Check whether the specified bridging residues are cystines. C Read preformed bridges. if (ns.gt.0) then read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) + if(fg_rank.eq.0) + & write(iout,*)'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) if (nss.gt.0) then nhpb=nss C Check if the residues involved in bridges are in the specified list of @@ -2442,7 +2500,7 @@ c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) if (wfrag_(i).gt.0.0d0) then do j=ifrag_(1,i),ifrag_(2,i)-1 do k=j+1,ifrag_(2,i) - write (iout,*) "j",j," k",k +c write (iout,*) "j",j," k",k ddjk=dist(j,k) if (constr_dist.eq.1) then nhpb=nhpb+1 diff --git a/source/unres/src_MD/readrtns.F.orig b/source/unres/src_MD/readrtns.F.orig deleted file mode 100644 index f3ccdd9..0000000 --- a/source/unres/src_MD/readrtns.F.orig +++ /dev/null @@ -1,2668 +0,0 @@ - subroutine readrtns - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SBRIDGE' - include 'COMMON.IOUNITS' - logical file_exist -C Read force-field parameters except weights - call parmread -C Read job setup parameters - call read_control -C Read control parameters for energy minimzation if required - if (minim) call read_minim -C Read MCM control parameters if required - if (modecalc.eq.3 .or. modecalc.eq.6) call mcmread -C Read MD control parameters if reqjuired - if (modecalc.eq.12) call read_MDpar -C Read MREMD control parameters if required - if (modecalc.eq.14) then - call read_MDpar - call read_REMDpar - endif -C Read MUCA control parameters if required - if (lmuca) call read_muca -C Read CSA control parameters if required (from fort.40 if exists -C otherwise from general input file) -csa if (modecalc.eq.8) then -csa inquire (file="fort.40",exist=file_exist) -csa if (.not.file_exist) call csaread -csa endif -cfmc if (modecalc.eq.10) call mcmfread -C Read molecule information, molecule geometry, energy-term weights, and -C restraints if requested - call molread -C Print restraint information -#ifdef MPI - if (.not. out1file .or. me.eq.king) then -#endif - if (nhpb.gt.nss) - &write (iout,'(a,i5,a)') "The following",nhpb-nss, - & " distance constraints have been imposed" - do i=nss+1,nhpb - write (iout,'(3i6,i2,3f10.5)') i-nss,ihpb(i),jhpb(i), - & ibecarb(i),dhpb(i),dhpb1(i),forcon(i) - enddo -#ifdef MPI - endif -#endif -c print *,"Processor",myrank," leaves READRTNS" - return - end -C------------------------------------------------------------------------------- - subroutine read_control -C -C Read contorl data -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MP - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' - COMMON /MACHSW/ KDIAG,ICORFL,IXDR - character*8 diagmeth(0:3) /'Library','EVVRSP','Givens','Jacobi'/ - character*80 ucase - character*320 controlcard - - nglob_csa=0 - eglob_csa=1d99 - nmin_csa=0 - read (INP,'(a)') titel - call card_concat(controlcard) -c out1file=index(controlcard,'OUT1FILE').gt.0 .or. fg_rank.gt.0 -c print *,"Processor",me," fg_rank",fg_rank," out1file",out1file - call reada(controlcard,'SEED',seed,0.0D0) - call random_init(seed) -C Set up the time limit (caution! The time must be input in minutes!) - read_cart=index(controlcard,'READ_CART').gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - call reada(controlcard,'TIMLIM',timlim,960.0D0) ! default 16 hours - unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 - call reada(controlcard,'SAFETY',safety,30.0D0) ! default 30 minutes - call reada(controlcard,'RMSDBC',rmsdbc,3.0D0) - call reada(controlcard,'RMSDBC1',rmsdbc1,0.5D0) - call reada(controlcard,'RMSDBC1MAX',rmsdbc1max,1.5D0) - call reada(controlcard,'RMSDBCM',rmsdbcm,3.0D0) - call reada(controlcard,'DRMS',drms,0.1D0) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write (iout,'(a,f10.1)')'RMSDBC = ',rmsdbc - write (iout,'(a,f10.1)')'RMSDBC1 = ',rmsdbc1 - write (iout,'(a,f10.1)')'RMSDBC1MAX = ',rmsdbc1max - write (iout,'(a,f10.1)')'DRMS = ',drms - write (iout,'(a,f10.1)')'RMSDBCM = ',rmsdbcm - write (iout,'(a,f10.1)') 'Time limit (min):',timlim - endif - call readi(controlcard,'NZ_START',nz_start,0) - call readi(controlcard,'NZ_END',nz_end,0) - call readi(controlcard,'IZ_SC',iz_sc,0) - timlim=60.0D0*timlim - safety = 60.0d0*safety - timem=timlim - modecalc=0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - minim=(index(controlcard,'MINIMIZE').gt.0) - dccart=(index(controlcard,'CART').gt.0) - overlapsc=(index(controlcard,'OVERLAP').gt.0) - overlapsc=.not.overlapsc - searchsc=(index(controlcard,'NOSEARCHSC').gt.0) - searchsc=.not.searchsc - sideadd=(index(controlcard,'SIDEADD').gt.0) - energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) - outpdb=(index(controlcard,'PDBOUT').gt.0) - outmol2=(index(controlcard,'MOL2OUT').gt.0) - pdbref=(index(controlcard,'PDBREF').gt.0) - refstr=pdbref .or. (index(controlcard,'REFSTR').gt.0) - indpdb=index(controlcard,'PDBSTART') - extconf=(index(controlcard,'EXTCONF').gt.0) - call readi(controlcard,'IPRINT',iprint,0) - call readi(controlcard,'MAXGEN',maxgen,10000) - call readi(controlcard,'MAXOVERLAP',maxoverlap,1000) - call readi(controlcard,"KDIAG",kdiag,0) - call readi(controlcard,"RESCALE_MODE",rescale_mode,2) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) - & write (iout,*) "RESCALE_MODE",rescale_mode - split_ene=index(controlcard,'SPLIT_ENE').gt.0 - if (index(controlcard,'REGULAR').gt.0.0D0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - modecalc=1 - refstr=.true. - endif - if (index(controlcard,'CHECKGRAD').gt.0) then - modecalc=5 - if (index(controlcard,'CART').gt.0) then - icheckgrad=1 - elseif (index(controlcard,'CARINT').gt.0) then - icheckgrad=2 - else - icheckgrad=3 - endif - elseif (index(controlcard,'THREAD').gt.0) then - modecalc=2 - call readi(controlcard,'THREAD',nthread,0) - if (nthread.gt.0) then - call reada(controlcard,'WEIDIS',weidis,0.1D0) - else - if (fg_rank.eq.0) - & write (iout,'(a)')'A number has to follow the THREAD keyword.' - stop 'Error termination in Read_Control.' - endif - else if (index(controlcard,'MCMA').gt.0) then - modecalc=3 - else if (index(controlcard,'MCEE').gt.0) then - modecalc=6 - else if (index(controlcard,'MULTCONF').gt.0) then - modecalc=4 - else if (index(controlcard,'MAP').gt.0) then - modecalc=7 - call readi(controlcard,'MAP',nmap,0) - else if (index(controlcard,'CSA').gt.0) then - write(*,*) "CSA not supported in this version" - stop -csa modecalc=8 -crc else if (index(controlcard,'ZSCORE').gt.0) then -crc -crc ZSCORE is rm from UNRES, modecalc=9 is available -crc -crc modecalc=9 -cfcm else if (index(controlcard,'MCMF').gt.0) then -cfmc modecalc=10 - else if (index(controlcard,'SOFTREG').gt.0) then - modecalc=11 - else if (index(controlcard,'CHECK_BOND').gt.0) then - modecalc=-1 - else if (index(controlcard,'TEST').gt.0) then - modecalc=-2 - else if (index(controlcard,'MD').gt.0) then - modecalc=12 - else if (index(controlcard,'RE ').gt.0) then - modecalc=14 - endif - - lmuca=index(controlcard,'MUCA').gt.0 - call readi(controlcard,'MUCADYN',mucadyn,0) - call readi(controlcard,'MUCASMOOTH',muca_smooth,0) - if (lmuca .and. (me.eq.king .or. .not.out1file )) - & then - write (iout,*) 'MUCADYN=',mucadyn - write (iout,*) 'MUCASMOOTH=',muca_smooth - endif - - iscode=index(controlcard,'ONE_LETTER') - indphi=index(controlcard,'PHI') - indback=index(controlcard,'BACK') - iranconf=index(controlcard,'RAND_CONF') - i2ndstr=index(controlcard,'USE_SEC_PRED') - gradout=index(controlcard,'GRADOUT').gt.0 - gnorm_check=index(controlcard,'GNORM_CHECK').gt.0 - - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') diagmeth(kdiag), - & ' routine used to diagonalize matrices.' - return - end -c-------------------------------------------------------------------------- - subroutine read_REMDpar -C -C Read REMD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.REMD' - include 'COMMON.CONTROL' - include 'COMMON.SETUP' - character*80 ucase - character*320 controlcard - character*3200 controlcard1 - integer iremd_m_total - - if(me.eq.king.or..not.out1file) - & write (iout,*) "REMD setup" - - call card_concat(controlcard) - call readi(controlcard,"NREP",nrep,3) - call readi(controlcard,"NSTEX",nstex,1000) - call reada(controlcard,"RETMIN",retmin,10.0d0) - call reada(controlcard,"RETMAX",retmax,1000.0d0) - mremdsync=(index(controlcard,'SYNC').gt.0) - call readi(controlcard,"NSYN",i_sync_step,100) - restart1file=(index(controlcard,'REST1FILE').gt.0) - traj1file=(index(controlcard,'TRAJ1FILE').gt.0) - call readi(controlcard,"TRAJCACHE",max_cache_traj_use,1) - if(max_cache_traj_use.gt.max_cache_traj) - & max_cache_traj_use=max_cache_traj - if(me.eq.king.or..not.out1file) then -cd if (traj1file) then -crc caching is in testing - NTWX is not ignored -cd write (iout,*) "NTWX value is ignored" -cd write (iout,*) " trajectory is stored to one file by master" -cd write (iout,*) " before exchange at NSTEX intervals" -cd endif - write (iout,*) "NREP= ",nrep - write (iout,*) "NSTEX= ",nstex - write (iout,*) "SYNC= ",mremdsync - write (iout,*) "NSYN= ",i_sync_step - write (iout,*) "TRAJCACHE= ",max_cache_traj_use - endif - - t_exchange_only=(index(controlcard,'TONLY').gt.0) - call readi(controlcard,"HREMD",hremd,0) - if((me.eq.king.or..not.out1file).and.hremd.gt.0) then - write (iout,*) "Hamiltonian REMD with ",hremd," sets of weights" - endif - if(usampl.and.hremd.gt.0) then - write (iout,'(//a)') - & "========== ERROR: USAMPL and HREMD cannot be used together" -#ifdef MPI - call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) -#endif - stop - endif - - - remd_tlist=.false. - if (index(controlcard,'TLIST').gt.0) then - remd_tlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_t(i),i=1,nrep) - if(me.eq.king.or..not.out1file) - & write (iout,*)'tlist',(remd_t(i),i=1,nrep) - endif - remd_mlist=.false. - if (index(controlcard,'MLIST').gt.0) then - remd_mlist=.true. - call card_concat(controlcard1) - read(controlcard1,*) (remd_m(i),i=1,nrep) - if(me.eq.king.or..not.out1file) then - write (iout,*)'mlist',(remd_m(i),i=1,nrep) - iremd_m_total=0 - do i=1,nrep - iremd_m_total=iremd_m_total+remd_m(i) - enddo - if(hremd.gt.1)then - write (iout,*) 'Total number of replicas ', - & iremd_m_total*hremd - else - write (iout,*) 'Total number of replicas ',iremd_m_total - endif - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of REMD run setup " - return - end -c-------------------------------------------------------------------------- - subroutine read_MDpar -C -C Read MD settings -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.MD' -#ifndef LANG0 - include 'COMMON.LANGEVIN' -#else - include 'COMMON.LANGEVIN.lang0' -#endif - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.GEO' - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.SPLITELE' - character*80 ucase - character*320 controlcard - - call card_concat(controlcard) - call readi(controlcard,"NSTEP",n_timestep,1000000) - call readi(controlcard,"NTWE",ntwe,100) - call readi(controlcard,"NTWX",ntwx,1000) - call reada(controlcard,"DT",d_time,1.0d-1) - call reada(controlcard,"DVMAX",dvmax,2.0d1) - call reada(controlcard,"DAMAX",damax,1.0d1) - call reada(controlcard,"EDRIFTMAX",edriftmax,1.0d+1) - call readi(controlcard,"LANG",lang,0) - RESPA = index(controlcard,"RESPA") .gt. 0 - call readi(controlcard,"NTIME_SPLIT",ntime_split,1) - ntime_split0=ntime_split - call readi(controlcard,"MAXTIME_SPLIT",maxtime_split,64) - ntime_split0=ntime_split - call reada(controlcard,"R_CUT",r_cut,2.0d0) - call reada(controlcard,"LAMBDA",rlamb,0.3d0) - rest = index(controlcard,"REST").gt.0 - tbf = index(controlcard,"TBF").gt.0 - call readi(controlcard,"HMC",hmc,0) - tnp = index(controlcard,"NOSEPOINCARE99").gt.0 - tnp1 = index(controlcard,"NOSEPOINCARE01").gt.0 - tnh = index(controlcard,"NOSEHOOVER96").gt.0 - if (RESPA.and.tnh)then - xiresp = index(controlcard,"XIRESP").gt.0 - endif - call reada(controlcard,"Q_NP",Q_np,0.1d0) - usampl = index(controlcard,"USAMPL").gt.0 - - mdpdb = index(controlcard,"MDPDB").gt.0 - call reada(controlcard,"T_BATH",t_bath,300.0d0) - call reada(controlcard,"TAU_BATH",tau_bath,1.0d-1) - call reada(controlcard,"EQ_TIME",eq_time,1.0d+4) - call readi(controlcard,"RESET_MOMENT",count_reset_moment,1000) - if (count_reset_moment.eq.0) count_reset_moment=1000000000 - call readi(controlcard,"RESET_VEL",count_reset_vel,1000) - reset_moment=lang.eq.0 .and. tbf .and. count_reset_moment.gt.0 - reset_vel=lang.eq.0 .and. tbf .and. count_reset_vel.gt.0 - if (count_reset_vel.eq.0) count_reset_vel=1000000000 - large = index(controlcard,"LARGE").gt.0 - print_compon = index(controlcard,"PRINT_COMPON").gt.0 - rattle = index(controlcard,"RATTLE").gt.0 -c if performing umbrella sampling, fragments constrained are read from the fragment file - nset=0 - if(usampl) then - call read_fragments - endif - - if(me.eq.king.or..not.out1file) then - write (iout,*) - write (iout,'(27(1h=),a26,27(1h=))') " Parameters of the MD run " - write (iout,*) - write (iout,'(a)') "The units are:" - write (iout,'(a)') "positions: angstrom, time: 48.9 fs" - write (iout,'(2a)') "velocity: angstrom/(48.9 fs),", - & " acceleration: angstrom/(48.9 fs)**2" - write (iout,'(a)') "energy: kcal/mol, temperature: K" - write (iout,*) - write (iout,'(a60,i10)') "Number of time steps:",n_timestep - write (iout,'(a60,f10.5,a)') - & "Initial time step of numerical integration:",d_time, - & " natural units" - write (iout,'(60x,f10.5,a)') d_time*48.9," fs" - if (RESPA) then - write (iout,'(2a,i4,a)') - & "A-MTS algorithm used; initial time step for fast-varying", - & " short-range forces split into",ntime_split," steps." - write (iout,'(a,f5.2,a,f5.2)') "Short-range force cutoff", - & r_cut," lambda",rlamb - endif - write (iout,'(2a,f10.5)') - & "Maximum acceleration threshold to reduce the time step", - & "/increase split number:",damax - write (iout,'(2a,f10.5)') - & "Maximum predicted energy drift to reduce the timestep", - & "/increase split number:",edriftmax - write (iout,'(a60,f10.5)') - & "Maximum velocity threshold to reduce velocities:",dvmax - write (iout,'(a60,i10)') "Frequency of property output:",ntwe - write (iout,'(a60,i10)') "Frequency of coordinate output:",ntwx - if (rattle) write (iout,'(a60)') - & "Rattle algorithm used to constrain the virtual bonds" - endif - reset_fricmat=1000 - if (lang.gt.0) then - call reada(controlcard,"ETAWAT",etawat,0.8904d0) - call reada(controlcard,"RWAT",rwat,1.4d0) - call reada(controlcard,"SCAL_FRIC",scal_fric,2.0d-2) - surfarea=index(controlcard,"SURFAREA").gt.0 - call readi(controlcard,"RESET_FRICMAT",reset_fricmat,1000) - if(me.eq.king.or..not.out1file)then - write (iout,'(/a,$)') "Langevin dynamics calculation" - if (lang.eq.1) then - write (iout,'(a/)') - & " with direct integration of Langevin equations" - else if (lang.eq.2) then - write (iout,'(a/)') " with TINKER stochasic MD integrator" - else if (lang.eq.3) then - write (iout,'(a/)') " with Ciccotti's stochasic MD integrator" - else if (lang.eq.4) then - write (iout,'(a/)') " in overdamped mode" - else - write (iout,'(//a,i5)') - & "=========== ERROR: Unknown Langevin dynamics mode:",lang - stop - endif - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Viscosity of the solvent:",etawat - write (iout,'(a60,f10.5)') "Radius of solvent molecule:",rwat - write (iout,'(a60,f10.5)') - & "Scaling factor of the friction forces:",scal_fric - if (surfarea) write (iout,'(2a,i10,a)') - & "Friction coefficients will be scaled by solvent-accessible", - & " surface area every",reset_fricmat," steps." - endif -c Calculate friction coefficients and bounds of stochastic forces - eta=6*pi*cPoise*etawat - if(me.eq.king.or..not.out1file) - & write(iout,'(a60,f10.5)')"Eta of the solvent in natural units:" - & ,eta - gamp=scal_fric*(pstok+rwat)*eta - stdfp=dsqrt(2*Rb*t_bath/d_time) - do i=1,ntyp - gamsc(i)=scal_fric*(restok(i)+rwat)*eta - stdfsc(i)=dsqrt(2*Rb*t_bath/d_time) - enddo - if(me.eq.king.or..not.out1file)then - write (iout,'(/2a/)') - & "Radii of site types and friction coefficients and std's of", - & " stochastic forces of fully exposed sites" - write (iout,'(a5,f5.2,2f10.5)')'p',pstok,gamp,stdfp*dsqrt(gamp) - do i=1,ntyp - write (iout,'(a5,f5.2,2f10.5)') restyp(i),restok(i), - & gamsc(i),stdfsc(i)*dsqrt(gamsc(i)) - enddo - endif - else if (tbf) then - if(me.eq.king.or..not.out1file)then - write (iout,'(a)') "Berendsen bath calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Coupling constant (tau):",tau_bath - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - endif - else if (tnp .or. tnp1 .or. tnh) then - if (tnp .or. tnp1) then - write (iout,'(a)') "Nose-Poincare bath calculation" - if (tnp) write (iout,'(a)') - & "J.Comput.Phys. 151 114 (1999) S.D.Bond B.J.Leimkuhler B.B.Laird" - if (tnp1) write (iout,'(a)') "JPSJ 70 75 (2001) S. Nose" - else - write (iout,'(a)') "Nose-Hoover bath calculation" - write (iout,'(a)') "Mol.Phys. 87 1117 (1996) Martyna et al." - nresn=1 - nyosh=1 - nnos=1 - do i=1,nnos - qmass(i)=Q_np - xlogs(i)=1.0 - vlogs(i)=0.0 - enddo - do i=1,nyosh - WDTI(i) = 1.0*d_time/nresn - WDTI2(i)=WDTI(i)/2 - WDTI4(i)=WDTI(i)/4 - WDTI8(i)=WDTI(i)/8 - enddo - if (RESPA) then - if(xiresp) then - write (iout,'(a)') "NVT-XI-RESPA algorithm" - else - write (iout,'(a)') "NVT-XO-RESPA algorithm" - endif - do i=1,nyosh - WDTIi(i) = 1.0*d_time/nresn/ntime_split - WDTIi2(i)=WDTIi(i)/2 - WDTIi4(i)=WDTIi(i)/4 - WDTIi8(i)=WDTIi(i)/8 - enddo - endif - endif - - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,f10.5)') "Q =",Q_np - if (reset_moment) - & write (iout,'(a,i10,a)') "Momenta will be reset at zero every", - & count_reset_moment," steps" - if (reset_vel) - & write (iout,'(a,i10,a)') - & "Velocities will be reset at random every",count_reset_vel, - & " steps" - - else if (hmc.gt.0) then - write (iout,'(a)') "Hybrid Monte Carlo calculation" - write (iout,'(a60,f10.5)') "Temperature:",t_bath - write (iout,'(a60,i10)') - & "Number of MD steps between Metropolis tests:",hmc - - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a31)') "Microcanonical mode calculation" - endif - if(me.eq.king.or..not.out1file)then - if (rest) write (iout,'(/a/)') "===== Calculation restarted ====" - if (usampl) then - write(iout,*) "MD running with constraints." - write(iout,*) "Equilibration time ", eq_time, " mtus." - write(iout,*) "Constraining ", nfrag," fragments." - write(iout,*) "Length of each fragment, weight and q0:" - do iset=1,nset - write (iout,*) "Set of restraints #",iset - do i=1,nfrag - write(iout,'(2i5,f8.1,f7.4)') ifrag(1,i,iset), - & ifrag(2,i,iset),wfrag(i,iset),qinfrag(i,iset) - enddo - write(iout,*) "constraints between ", npair, "fragments." - write(iout,*) "constraint pairs, weights and q0:" - do i=1,npair - write(iout,'(2i5,f8.1,f7.4)') ipair(1,i,iset), - & ipair(2,i,iset),wpair(i,iset),qinpair(i,iset) - enddo - write(iout,*) "angle constraints within ", nfrag_back, - & "backbone fragments." - write(iout,*) "fragment, weights:" - do i=1,nfrag_back - write(iout,'(2i5,3f8.1)') ifrag_back(1,i,iset), - & ifrag_back(2,i,iset),wfrag_back(1,i,iset), - & wfrag_back(2,i,iset),wfrag_back(3,i,iset) - enddo - enddo - iset=mod(kolor,nset)+1 - endif - endif - if(me.eq.king.or..not.out1file) - & write (iout,'(/30(1h=),a,29(1h=)/)') " End of MD run setup " - return - end -c------------------------------------------------------------------------------ - subroutine molread -C -C Read molecular data. -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - integer error_msg -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.CONTACTS' - include 'COMMON.TORCNSTR' - include 'COMMON.TIME1' - include 'COMMON.BOUNDS' - include 'COMMON.MD' - include 'COMMON.REMD' - include 'COMMON.SETUP' - character*4 sequence(maxres) - integer rescode - double precision x(maxvar) - character*256 pdbfile - character*320 weightcard - character*80 weightcard_t,ucase - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - logical seq_comp,fail - double precision energia(0:n_ene) - integer ilen - external ilen -C -C Body -C -C Read weights of the subsequent energy terms. - if(hremd.gt.0) then - - k=0 - do il=1,hremd - do i=1,nrep - do j=1,remd_m(i) - i2set(k)=il - k=k+1 - enddo - enddo - enddo - - if(me.eq.king.or..not.out1file) then - write (iout,*) 'Reading ',hremd,' sets of weights for HREMD' - write (iout,*) 'Current weights for processor ', - & me,' set ',i2set(me) - endif - - do i=1,hremd - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - - hweights(i,1)=wsc - hweights(i,2)=wscp - hweights(i,3)=welec - hweights(i,4)=wcorr - hweights(i,5)=wcorr5 - hweights(i,6)=wcorr6 - hweights(i,7)=wel_loc - hweights(i,8)=wturn3 - hweights(i,9)=wturn4 - hweights(i,10)=wturn6 - hweights(i,11)=wang - hweights(i,12)=wscloc - hweights(i,13)=wtor - hweights(i,14)=wtor_d - hweights(i,15)=wstrain - hweights(i,16)=wvdwpp - hweights(i,17)=wbond - hweights(i,18)=scal14 - hweights(i,21)=wsccor - - enddo - - do i=1,n_ene - weights(i)=hweights(i2set(me),i) - enddo - wsc =weights(1) - wscp =weights(2) - welec =weights(3) - wcorr =weights(4) - wcorr5 =weights(5) - wcorr6 =weights(6) - wel_loc=weights(7) - wturn3 =weights(8) - wturn4 =weights(9) - wturn6 =weights(10) - wang =weights(11) - wscloc =weights(12) - wtor =weights(13) - wtor_d =weights(14) - wstrain=weights(15) - wvdwpp =weights(16) - wbond =weights(17) - scal14 =weights(18) - wsccor =weights(21) - - - else - call card_concat(weightcard) - call reada(weightcard,'WLONG',wlong,1.0D0) - call reada(weightcard,'WSC',wsc,wlong) - call reada(weightcard,'WSCP',wscp,wlong) - call reada(weightcard,'WELEC',welec,1.0D0) - call reada(weightcard,'WVDWPP',wvdwpp,welec) - call reada(weightcard,'WEL_LOC',wel_loc,1.0D0) - call reada(weightcard,'WCORR4',wcorr4,0.0D0) - call reada(weightcard,'WCORR5',wcorr5,0.0D0) - call reada(weightcard,'WCORR6',wcorr6,0.0D0) - call reada(weightcard,'WTURN3',wturn3,1.0D0) - call reada(weightcard,'WTURN4',wturn4,1.0D0) - call reada(weightcard,'WTURN6',wturn6,1.0D0) - call reada(weightcard,'WSCCOR',wsccor,1.0D0) - call reada(weightcard,'WSTRAIN',wstrain,1.0D0) - call reada(weightcard,'WBOND',wbond,1.0D0) - call reada(weightcard,'WTOR',wtor,1.0D0) - call reada(weightcard,'WTORD',wtor_d,1.0D0) - call reada(weightcard,'WANG',wang,1.0D0) - call reada(weightcard,'WSCLOC',wscloc,1.0D0) - call reada(weightcard,'SCAL14',scal14,0.4D0) - call reada(weightcard,'SCALSCP',scalscp,1.0d0) - call reada(weightcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(weightcard,'DELT_CORR',delt_corr,0.5d0) - call reada(weightcard,'TEMP0',temp0,300.0d0) - if (index(weightcard,'SOFT').gt.0) ipot=6 -C 12/1/95 Added weight for the multi-body term WCORR - call reada(weightcard,'WCORRH',wcorr,1.0D0) - if (wcorr4.gt.0.0d0) wcorr=wcorr4 - weights(1)=wsc - weights(2)=wscp - weights(3)=welec - weights(4)=wcorr - weights(5)=wcorr5 - weights(6)=wcorr6 - weights(7)=wel_loc - weights(8)=wturn3 - weights(9)=wturn4 - weights(10)=wturn6 - weights(11)=wang - weights(12)=wscloc - weights(13)=wtor - weights(14)=wtor_d - weights(15)=wstrain - weights(16)=wvdwpp - weights(17)=wbond - weights(18)=scal14 - weights(21)=wsccor - endif - - if(me.eq.king.or..not.out1file) - & write (iout,10) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 10 format (/'Energy-term weights (unscaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlation)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file)then - if (wcorr4.gt.0.0d0) then - write (iout,'(/2a/)') 'Local-electrostatic type correlation ', - & 'between contact pairs of peptide groups' - write (iout,'(2(a,f5.3/))') - & 'Cutoff on 4-6th order correlation terms: ',cutoff_corr, - & 'Range of quenching the correlation terms:',2*delt_corr - else if (wcorr.gt.0.0d0) then - write (iout,'(/2a/)') 'Hydrogen-bonding correlation ', - & 'between contact pairs of peptide groups' - endif - write (iout,'(a,f8.3)') - & 'Scaling factor of 1,4 SC-p interactions:',scal14 - write (iout,'(a,f8.3)') - & 'General scaling factor of SC-p interactions:',scalscp - endif - r0_corr=cutoff_corr-delt_corr - do i=1,20 - aad(i,1)=scalscp*aad(i,1) - aad(i,2)=scalscp*aad(i,2) - bad(i,1)=scalscp*bad(i,1) - bad(i,2)=scalscp*bad(i,2) - enddo - call rescale_weights(t_bath) - if(me.eq.king.or..not.out1file) - & write (iout,22) wsc,wscp,welec,wvdwpp,wbond,wang,wscloc,wtor, - & wtor_d,wstrain,wel_loc,wcorr,wcorr5,wcorr6,wsccor,wturn3, - & wturn4,wturn6 - 22 format (/'Energy-term weights (scaled):'// - & 'WSCC= ',f10.6,' (SC-SC)'/ - & 'WSCP= ',f10.6,' (SC-p)'/ - & 'WELEC= ',f10.6,' (p-p electr)'/ - & 'WVDWPP= ',f10.6,' (p-p VDW)'/ - & 'WBOND= ',f10.6,' (stretching)'/ - & 'WANG= ',f10.6,' (bending)'/ - & 'WSCLOC= ',f10.6,' (SC local)'/ - & 'WTOR= ',f10.6,' (torsional)'/ - & 'WTORD= ',f10.6,' (double torsional)'/ - & 'WSTRAIN=',f10.6,' (SS bridges & dist. cnstr.)'/ - & 'WEL_LOC=',f10.6,' (multi-body 3-rd order)'/ - & 'WCORR4= ',f10.6,' (multi-body 4th order)'/ - & 'WCORR5= ',f10.6,' (multi-body 5th order)'/ - & 'WCORR6= ',f10.6,' (multi-body 6th order)'/ - & 'WSCCOR= ',f10.6,' (back-scloc correlatkion)'/ - & 'WTURN3= ',f10.6,' (turns, 3rd order)'/ - & 'WTURN4= ',f10.6,' (turns, 4th order)'/ - & 'WTURN6= ',f10.6,' (turns, 6th order)') - if(me.eq.king.or..not.out1file) - & write (iout,*) "Reference temperature for weights calculation:", - & temp0 - call reada(weightcard,"D0CM",d0cm,3.78d0) - call reada(weightcard,"AKCM",akcm,15.1d0) - call reada(weightcard,"AKTH",akth,11.0d0) - call reada(weightcard,"AKCT",akct,12.0d0) - call reada(weightcard,"V1SS",v1ss,-1.08d0) - call reada(weightcard,"V2SS",v2ss,7.61d0) - call reada(weightcard,"V3SS",v3ss,13.7d0) - call reada(weightcard,"EBR",ebr,-5.50D0) - if(me.eq.king.or..not.out1file) then - write (iout,*) "Parameters of the SS-bond potential:" - write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, - & " AKCT",akct - write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss - write (iout,*) "EBR",ebr - print *,'indpdb=',indpdb,' pdbref=',pdbref - endif - if (indpdb.gt.0 .or. pdbref) then - read(inp,'(a)') pdbfile - if(me.eq.king.or..not.out1file) - & write (iout,'(2a)') 'PDB data will be read from file ', - & pdbfile(:ilen(pdbfile)) - open(ipdbin,file=pdbfile,status='old',err=33) - goto 34 - 33 write (iout,'(a)') 'Error opening PDB file.' - stop - 34 continue -c print *,'Begin reading pdb data' - call readpdb -c print *,'Finished reading pdb data' - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3,a,i3)')'nsup=',nsup, - & ' nstart_sup=',nstart_sup - do i=1,nres - itype_pdb(i)=itype(i) - enddo - close (ipdbin) - nnt=nstart_sup - nct=nstart_sup+nsup-1 - call contact(.false.,ncont_ref,icont_ref,co) - - if (sideadd) then -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "Before sideadd" - call intout - if(me.eq.king.or..not.out1file) - & write(iout,*)'Adding sidechains' - maxsi=1000 - do i=2,nres-1 - iti=itype(i) - if (iti.ne.10) then - nsi=0 - fail=.true. - do while (fail.and.nsi.le.maxsi) - call gen_side(iti,theta(i+1),alph(i),omeg(i),fail) - nsi=nsi+1 - enddo - if(fail) write(iout,*)'Adding sidechain failed for res ', - & i,' after ',nsi,' trials' - endif - enddo -C 10/03/12 Adam: Recalculate coordinates with new side chain positions - call chainbuild - endif -C Following 2 lines for diagnostics; comment out if not needed - write (iout,*) "After sideadd" - call intout - endif - if (indpdb.eq.0) then -C Read sequence if not taken from the pdb file. - read (inp,*) nres -c print *,'nres=',nres - if (iscode.gt.0) then - read (inp,'(80a1)') (sequence(i)(1:1),i=1,nres) - else - read (inp,'(20(1x,a3))') (sequence(i),i=1,nres) - endif -C Convert sequence to numeric code - do i=1,nres - itype(i)=rescode(i,sequence(i),iscode) - enddo -C Assign initial virtual bond lengths - do i=2,nres - vbld(i)=vbl - vbld_inv(i)=vblinv - enddo - do i=2,nres-1 - vbld(i+nres)=dsc(itype(i)) - vbld_inv(i+nres)=dsc_inv(itype(i)) -c write (iout,*) "i",i," itype",itype(i), -c & " dsc",dsc(itype(i))," vbld",vbld(i),vbld(i+nres) - enddo - endif -c print *,nres -c print '(20i4)',(itype(i),i=1,nres) - do i=1,nres -#ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then -#else - if (itype(i).eq.21) then -#endif - itel(i)=0 -#ifdef PROCOR - else if (itype(i+1).ne.20) then -#else - else if (itype(i).ne.20) then -#endif - itel(i)=1 - else - itel(i)=2 - endif - enddo - if(me.eq.king.or..not.out1file)then - write (iout,*) "ITEL" - do i=1,nres-1 - write (iout,*) i,itype(i),itel(i) - enddo - print *,'Call Read_Bridge.' - endif - call read_bridge -C 8/13/98 Set limits to generating the dihedral angles - do i=1,nres - phibound(1,i)=-pi - phibound(2,i)=pi - enddo - read (inp,*) ndih_constr - if (ndih_constr.gt.0) then - read (inp,*) ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) - if(me.eq.king.or..not.out1file)then - write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' - do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) - enddo - endif - do i=1,ndih_constr - phi0(i)=deg2rad*phi0(i) - drange(i)=deg2rad*drange(i) - enddo - if(me.eq.king.or..not.out1file) - & write (iout,*) 'FTORS',ftors - do i=1,ndih_constr - ii = idih_constr(i) - phibound(1,ii) = phi0(i)-drange(i) - phibound(2,ii) = phi0(i)+drange(i) - enddo - endif - nnt=1 -#ifdef MPI - if (me.eq.king) then -#endif - write (iout,'(a)') 'Boundaries in phi angle sampling:' - do i=1,nres - write (iout,'(a3,i5,2f10.1)') - & restyp(itype(i)),i,phibound(1,i)*rad2deg,phibound(2,i)*rad2deg - enddo -#ifdef MP - endif -#endif - nct=nres -cd print *,'NNT=',NNT,' NCT=',NCT - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (iout,'(a,i3)') 'nsup=',nsup - nstart_seq=nnt - if (nsup.le.(nct-nnt+1)) then - do i=0,nct-nnt+1-nsup - if (seq_comp(itype(nnt+i),itype_pdb(nstart_sup),nsup)) then - nstart_seq=nnt+i - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - stop - else - do i=0,nsup-(nct-nnt+1) - if (seq_comp(itype(nnt),itype_pdb(nstart_sup+i),nct-nnt+1)) - & then - nstart_sup=nstart_sup+i - nsup=nct-nnt+1 - goto 111 - endif - enddo - write (iout,'(a)') - & 'Error - sequences to be superposed do not match.' - endif - 111 continue - if (nsup.eq.0) nsup=nct-nnt - if (nstart_sup.eq.0) nstart_sup=nnt - if (nstart_seq.eq.0) nstart_seq=nnt - if(me.eq.king.or..not.out1file) - & write (iout,*) 'nsup=',nsup,' nstart_sup=',nstart_sup, - & ' nstart_seq=',nstart_seq - endif -c--- Zscore rms ------- - if (nz_start.eq.0) nz_start=nnt - if (nz_end.eq.0 .and. nsup.gt.0) then - nz_end=nnt+nsup-1 - else if (nz_end.eq.0) then - nz_end=nct - endif - if(me.eq.king.or..not.out1file)then - write (iout,*) 'NZ_START=',nz_start,' NZ_END=',nz_end - write (iout,*) 'IZ_SC=',iz_sc - endif -c---------------------- - call init_int_table - if (refstr) then - if (.not.pdbref) then - call read_angles(inp,*38) - goto 39 - 38 write (iout,'(a)') 'Error reading reference structure.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERROR) - stop 'Error reading reference structure' -#endif - 39 call chainbuild - call setup_var -czscore call geom_to_var(nvar,coord_exp_zs(1,1)) - nstart_sup=nnt - nstart_seq=nnt - nsup=nct-nnt+1 - do i=1,2*nres - do j=1,3 - cref(j,i)=c(j,i) - enddo - enddo - call contact(.true.,ncont_ref,icont_ref,co) - endif - if(me.eq.king.or..not.out1file) - & write (iout,*) 'Contact order:',co - if (pdbref) then - if(me.eq.king.or..not.out1file) - & write (2,*) 'Shifting contacts:',nstart_seq,nstart_sup - do i=1,ncont_ref - do j=1,2 - icont_ref(j,i)=icont_ref(j,i)+nstart_seq-nstart_sup - enddo - if(me.eq.king.or..not.out1file) - & write (2,*) i,' ',restyp(itype(icont_ref(1,i))),' ', - & icont_ref(1,i),' ', - & restyp(itype(icont_ref(2,i))),' ',icont_ref(2,i) - enddo - endif - endif -c write (iout,*) "constr_dist",constr_dist,nstart_sup,nsup - if (constr_dist.gt.0) then - call read_dist_constr - endif - if (nhpb.gt.0) call hpb_partition -c write (iout,*) "After read_dist_constr nhpb",nhpb -c call flush(iout) - if (indpdb.eq.0 .and. modecalc.ne.2 .and. modecalc.ne.4 - & .and. modecalc.ne.8 .and. modecalc.ne.9 .and. - & modecalc.ne.10) then -C If input structure hasn't been supplied from the PDB file read or generate -C initial geometry. - if (iranconf.eq.0 .and. .not. extconf) then - if(me.eq.king.or..not.out1file .and.fg_rank.eq.0) - & write (iout,'(a)') 'Initial geometry will be read in.' - if (read_cart) then - read(inp,'(8f10.5)',end=36,err=36) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc_norm(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc_norm(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - return - else - call read_angles(inp,*36) - endif - goto 37 - 36 write (iout,'(a)') 'Error reading angle file.' -#ifdef MPI - call mpi_finalize( MPI_COMM_WORLD,IERR ) -#endif - stop 'Error reading angle file.' - 37 continue - else if (extconf) then - if(me.eq.king.or..not.out1file .and. fg_rank.eq.0) - & write (iout,'(a)') 'Extended chain initial geometry.' - do i=3,nres - theta(i)=90d0*deg2rad - enddo - do i=4,nres - phi(i)=180d0*deg2rad - enddo - do i=2,nres-1 - alph(i)=110d0*deg2rad - enddo - do i=2,nres-1 - omeg(i)=-120d0*deg2rad - enddo - else - if(me.eq.king.or..not.out1file) - & write (iout,'(a)') 'Random-generated initial geometry.' - - -#ifdef MPI - if (me.eq.king .or. fg_rank.eq.0 .and. ( - & modecalc.eq.12 .or. modecalc.eq.14) ) then -#endif - do itrial=1,100 - itmp=1 - call gen_rand_conf(itmp,*30) - goto 40 - 30 write (iout,*) 'Failed to generate random conformation', - & ', itrial=',itrial - write (*,*) 'Processor:',me, - & ' Failed to generate random conformation', - & ' itrial=',itrial - call intout - -#ifdef AIX - call flush_(iout) -#else - call flush(iout) -#endif - enddo - write (iout,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - write (*,'(a,i3,a)') 'Processor:',me, - & ' error in generating random conformation.' - call flush(iout) -#ifdef MPI - call MPI_Abort(mpi_comm_world,error_msg,ierrcode) - 40 continue - endif -#else - 40 continue -#endif - endif - elseif (modecalc.eq.4) then - read (inp,'(a)') intinname - open (intin,file=intinname,status='old',err=333) - if (me.eq.king .or. .not.out1file.and.fg_rank.eq.0) - & write (iout,'(a)') 'intinname',intinname - write (*,'(a)') 'Processor',myrank,' intinname',intinname - goto 334 - 333 write (iout,'(2a)') 'Error opening angle file ',intinname -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,IERR) -#endif - stop 'Error opening angle file.' - 334 continue - - endif -C Generate distance constraints, if the PDB structure is to be regularized. - if (nthread.gt.0) then - call read_threadbase - endif - call setup_var - if (me.eq.king .or. .not. out1file) - & call intout - if (ns.gt.0 .and. (me.eq.king .or. .not.out1file) ) then - write (iout,'(/a,i3,a)') - & 'The chain contains',ns,' disulfide-bridging cysteines.' - write (iout,'(20i4)') (iss(i),i=1,ns) - write (iout,'(/a/)') 'Pre-formed links are:' - do i=1,nss - i1=ihpb(i)-nres - i2=jhpb(i)-nres - it1=itype(i1) - it2=itype(i2) - if (me.eq.king.or..not.out1file) - & write (iout,'(2a,i3,3a,i3,a,3f10.3)') - & restyp(it1),'(',i1,') -- ',restyp(it2),'(',i2,')',dhpb(i), - & ebr,forcon(i) - enddo - write (iout,'(a)') - endif - if (i2ndstr.gt.0) call secstrp2dihc -c call geom_to_var(nvar,x) -c call etotal(energia(0)) -c call enerprint(energia(0)) -c call briefout(0,etot) -c stop -cd write (iout,'(2(a,i3))') 'NNT',NNT,' NCT',NCT -cd write (iout,'(a)') 'Variable list:' -cd write (iout,'(i4,f10.5)') (i,rad2deg*x(i),i=1,nvar) -#ifdef MPI - if (me.eq.king .or. (fg_rank.eq.0 .and. .not.out1file)) - & write (iout,'(//80(1h*)/20x,a,i4,a/80(1h*)//)') - & 'Processor',myrank,': end reading molecular data.' -#endif - return - end -c-------------------------------------------------------------------------- - logical function seq_comp(itypea,itypeb,length) - implicit none - integer length,itypea(length),itypeb(length) - integer i - do i=1,length - if (itypea(i).ne.itypeb(i)) then - seq_comp=.false. - return - endif - enddo - seq_comp=.true. - return - end -c----------------------------------------------------------------------------- - subroutine read_bridge -C Read information about disulfide bridges. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - include 'COMMON.SETUP' -C Read bridging residues. - read (inp,*) ns,(iss(i),i=1,ns) - print *,'ns=',ns - if(me.eq.king.or..not.out1file) - & write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) -C Check whether the specified bridging residues are cystines. - do i=1,ns - if (itype(iss(i)).ne.1) then - if (me.eq.king.or..not.out1file) write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, - & ' can form a disulfide bridge?!!!' - write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, - & ' can form a disulfide bridge?!!!' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo -C Read preformed bridges. - if (ns.gt.0) then - read (inp,*) nss,(ihpb(i),jhpb(i),i=1,nss) - write (iout,*) 'nss=',nss,' ihpb,jhpb: ',(ihpb(i),jhpb(i),i=1,nss) - if (nss.gt.0) then - nhpb=nss -C Check if the residues involved in bridges are in the specified list of -C bridging residues. - do i=1,nss - do j=1,i-1 - if (ihpb(i).eq.ihpb(j).or.ihpb(i).eq.jhpb(j) - & .or.jhpb(i).eq.ihpb(j).or.jhpb(i).eq.jhpb(j)) then - write (iout,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' - write (*,'(a,i3,a)') 'Disulfide pair',i, - & ' contains residues present in other pairs.' -#ifdef MPI - call MPI_Finalize(MPI_COMM_WORLD,ierror) - stop -#endif - endif - enddo - do j=1,ns - if (ihpb(i).eq.iss(j)) goto 10 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 10 continue - do j=1,ns - if (jhpb(i).eq.iss(j)) goto 20 - enddo - write (iout,'(a,i3,a)') 'Pair',i,' contains unknown cystine.' - 20 continue - dhpb(i)=dbr - forcon(i)=fbr - enddo - do i=1,nss - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - enddo - endif - endif - return - end -c---------------------------------------------------------------------------- - subroutine read_x(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' - include 'COMMON.LOCAL' - include 'COMMON.INTERACT' -c Read coordinates from input -c - read(kanal,'(8f10.5)',end=10,err=10) - & ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) - do j=1,3 - c(j,nres+1)=c(j,1) - c(j,2*nres)=c(j,nres) - enddo - call int_from_cart1(.false.) - do i=1,nres-1 - do j=1,3 - dc(j,i)=c(j,i+1)-c(j,i) - dc_norm(j,i)=dc(j,i)*vbld_inv(i+1) - enddo - enddo - do i=nnt,nct - if (itype(i).ne.10) then - do j=1,3 - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres) - enddo - endif - enddo - - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine read_threadbase - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Read pattern database for threading. - read (icbase,*) nseq - do i=1,nseq - read (icbase,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), - & nres_base(2,i),nres_base(3,i) - read (icbase,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, - & nres_base(1,i)) -c write (iout,'(i5,2x,a8,2i4)') nres_base(1,i),str_nam(i), -c & nres_base(2,i),nres_base(3,i) -c write (iout,'(9f8.3)') ((cart_base(k,j,i),k=1,3),j=1, -c & nres_base(1,i)) - enddo - close (icbase) - if (weidis.eq.0.0D0) weidis=0.1D0 - do i=nnt,nct - do j=i+2,nct - nhpb=nhpb+1 - ihpb(nhpb)=i - jhpb(nhpb)=j - forcon(nhpb)=weidis - enddo - enddo - read (inp,*) nexcl,(iexam(1,i),iexam(2,i),i=1,nexcl) - write (iout,'(a,i5)') 'nexcl: ',nexcl - write (iout,'(2i5)') (iexam(1,i),iexam(2,i),i=1,nexcl) - return - end -c------------------------------------------------------------------------------ - subroutine setup_var - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' -C Set up variable list. - ntheta=nres-2 - nphi=nres-3 - nvar=ntheta+nphi - nside=0 - do i=2,nres-1 - if (itype(i).ne.10) then - nside=nside+1 - ialph(i,1)=nvar+nside - ialph(nside,2)=i - endif - enddo - if (indphi.gt.0) then - nvar=nphi - else if (indback.gt.0) then - nvar=nphi+ntheta - else - nvar=nvar+2*nside - endif -cd write (iout,'(3i4)') (i,ialph(i,1),ialph(i,2),i=2,nres-1) - return - end -c---------------------------------------------------------------------------- - subroutine gen_dist_constr -C Generate CA distance constraints. - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.INTERACT' - include 'COMMON.LOCAL' - include 'COMMON.NAMES' - include 'COMMON.CHAIN' - include 'COMMON.FFIELD' - include 'COMMON.SBRIDGE' - include 'COMMON.HEADER' - include 'COMMON.CONTROL' - include 'COMMON.DBASE' - include 'COMMON.THREAD' - include 'COMMON.TIME1' - dimension itype_pdb(maxres) - common /pizda/ itype_pdb - character*2 iden -cd print *,'gen_dist_constr: nnt=',nnt,' nct=',nct -cd write (2,*) 'gen_dist_constr: nnt=',nnt,' nct=',nct, -cd & ' nstart_sup',nstart_sup,' nstart_seq',nstart_seq, -cd & ' nsup',nsup - do i=nstart_sup,nstart_sup+nsup-1 -cd write (2,*) 'i',i,' seq ',restyp(itype(i+nstart_seq-nstart_sup)), -cd & ' seq_pdb', restyp(itype_pdb(i)) - do j=i+2,nstart_sup+nsup-1 - nhpb=nhpb+1 - ihpb(nhpb)=i+nstart_seq-nstart_sup - jhpb(nhpb)=j+nstart_seq-nstart_sup - forcon(nhpb)=weidis - dhpb(nhpb)=dist(i,j) - enddo - enddo -cd write (iout,'(a)') 'Distance constraints:' -cd do i=nss+1,nhpb -cd ii=ihpb(i) -cd jj=jhpb(i) -cd iden='CA' -cd if (ii.gt.nres) then -cd iden='SC' -cd ii=ii-nres -cd jj=jj-nres -cd endif -cd write (iout,'(a,1x,a,i4,3x,a,1x,a,i4,2f10.3)') -cd & restyp(itype(ii)),iden,ii,restyp(itype(jj)),iden,jj, -cd & dhpb(i),forcon(i) -cd enddo - return - end -c---------------------------------------------------------------------------- - subroutine map_read - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MAP' - include 'COMMON.IOUNITS' - character*3 angid(4) /'THE','PHI','ALP','OME'/ - character*80 mapcard,ucase - do imap=1,nmap - read (inp,'(a)') mapcard - mapcard=ucase(mapcard) - if (index(mapcard,'PHI').gt.0) then - kang(imap)=1 - else if (index(mapcard,'THE').gt.0) then - kang(imap)=2 - else if (index(mapcard,'ALP').gt.0) then - kang(imap)=3 - else if (index(mapcard,'OME').gt.0) then - kang(imap)=4 - else - write(iout,'(a)')'Error - illegal variable spec in MAP card.' - stop 'Error - illegal variable spec in MAP card.' - endif - call readi (mapcard,'RES1',res1(imap),0) - call readi (mapcard,'RES2',res2(imap),0) - if (res1(imap).eq.0) then - res1(imap)=res2(imap) - else if (res2(imap).eq.0) then - res2(imap)=res1(imap) - endif - if(res1(imap)*res2(imap).eq.0 .or. res1(imap).gt.res2(imap))then - write (iout,'(a)') - & 'Error - illegal definition of variable group in MAP.' - stop 'Error - illegal definition of variable group in MAP.' - endif - call reada(mapcard,'FROM',ang_from(imap),0.0D0) - call reada(mapcard,'TO',ang_to(imap),0.0D0) - call readi(mapcard,'NSTEP',nstep(imap),0) - if (ang_from(imap).eq.ang_to(imap) .or. nstep(imap).eq.0) then - write (iout,'(a)') - & 'Illegal boundary and/or step size specification in MAP.' - stop 'Illegal boundary and/or step size specification in MAP.' - endif - enddo ! imap - return - end -c---------------------------------------------------------------------------- -csa subroutine csaread -csa implicit real*8 (a-h,o-z) -csa include 'DIMENSIONS' -csa include 'COMMON.IOUNITS' -csa include 'COMMON.GEO' -csa include 'COMMON.CSA' -csa include 'COMMON.BANK' -csa include 'COMMON.CONTROL' -csa character*80 ucase -csa character*620 mcmcard -csa call card_concat(mcmcard) -csa -csa call readi(mcmcard,'NCONF',nconf,50) -csa call readi(mcmcard,'NADD',nadd,0) -csa call readi(mcmcard,'JSTART',jstart,1) -csa call readi(mcmcard,'JEND',jend,1) -csa call readi(mcmcard,'NSTMAX',nstmax,500000) -csa call readi(mcmcard,'N0',n0,1) -csa call readi(mcmcard,'N1',n1,6) -csa call readi(mcmcard,'N2',n2,4) -csa call readi(mcmcard,'N3',n3,0) -csa call readi(mcmcard,'N4',n4,0) -csa call readi(mcmcard,'N5',n5,0) -csa call readi(mcmcard,'N6',n6,10) -csa call readi(mcmcard,'N7',n7,0) -csa call readi(mcmcard,'N8',n8,0) -csa call readi(mcmcard,'N9',n9,0) -csa call readi(mcmcard,'N14',n14,0) -csa call readi(mcmcard,'N15',n15,0) -csa call readi(mcmcard,'N16',n16,0) -csa call readi(mcmcard,'N17',n17,0) -csa call readi(mcmcard,'N18',n18,0) -csa -csa vdisulf=(index(mcmcard,'DYNSS').gt.0) -csa -csa call readi(mcmcard,'NDIFF',ndiff,2) -csa call reada(mcmcard,'DIFFCUT',diffcut,0.0d0) -csa call readi(mcmcard,'IS1',is1,1) -csa call readi(mcmcard,'IS2',is2,8) -csa call readi(mcmcard,'NRAN0',nran0,4) -csa call readi(mcmcard,'NRAN1',nran1,2) -csa call readi(mcmcard,'IRR',irr,1) -csa call readi(mcmcard,'NSEED',nseed,20) -csa call readi(mcmcard,'NTOTAL',ntotal,10000) -csa call reada(mcmcard,'CUT1',cut1,2.0d0) -csa call reada(mcmcard,'CUT2',cut2,5.0d0) -csa call reada(mcmcard,'ESTOP',estop,-3000.0d0) -csa call readi(mcmcard,'ICMAX',icmax,3) -csa call readi(mcmcard,'IRESTART',irestart,0) -csac!bankt call readi(mcmcard,'NBANKTM',ntbankm,0) -csa ntbankm=0 -csac!bankt -csa call reada(mcmcard,'DELE',dele,20.0d0) -csa call reada(mcmcard,'DIFCUT',difcut,720.0d0) -csa call readi(mcmcard,'IREF',iref,0) -csa call reada(mcmcard,'RMSCUT',rmscut,4.0d0) -csa call reada(mcmcard,'PNCCUT',pnccut,0.5d0) -csa call readi(mcmcard,'NCONF_IN',nconf_in,0) -csa call reada(mcmcard,'RDIH_BIAS',rdih_bias,0.5d0) -csa write (iout,*) "NCONF_IN",nconf_in -csa return -csa end -c---------------------------------------------------------------------------- -cfmc subroutine mcmfread -cfmc implicit real*8 (a-h,o-z) -cfmc include 'DIMENSIONS' -cfmc include 'COMMON.MCMF' -cfmc include 'COMMON.IOUNITS' -cfmc include 'COMMON.GEO' -cfmc character*80 ucase -cfmc character*620 mcmcard -cfmc call card_concat(mcmcard) -cfmc -cfmc call readi(mcmcard,'MAXRANT',maxrant,1000) -cfmc write(iout,*)'MAXRANT=',maxrant -cfmc call readi(mcmcard,'MAXFAM',maxfam,maxfam_p) -cfmc write(iout,*)'MAXFAM=',maxfam -cfmc call readi(mcmcard,'NNET1',nnet1,5) -cfmc write(iout,*)'NNET1=',nnet1 -cfmc call readi(mcmcard,'NNET2',nnet2,4) -cfmc write(iout,*)'NNET2=',nnet2 -cfmc call readi(mcmcard,'NNET3',nnet3,4) -cfmc write(iout,*)'NNET3=',nnet3 -cfmc call readi(mcmcard,'ILASTT',ilastt,0) -cfmc write(iout,*)'ILASTT=',ilastt -cfmc call readi(mcmcard,'MAXSTR',maxstr,maxstr_mcmf) -cfmc write(iout,*)'MAXSTR=',maxstr -cfmc maxstr_f=maxstr/maxfam -cfmc write(iout,*)'MAXSTR_F=',maxstr_f -cfmc call readi(mcmcard,'NMCMF',nmcmf,10) -cfmc write(iout,*)'NMCMF=',nmcmf -cfmc call readi(mcmcard,'IFOCUS',ifocus,nmcmf) -cfmc write(iout,*)'IFOCUS=',ifocus -cfmc call readi(mcmcard,'NLOCMCMF',nlocmcmf,1000) -cfmc write(iout,*)'NLOCMCMF=',nlocmcmf -cfmc call readi(mcmcard,'INTPRT',intprt,1000) -cfmc write(iout,*)'INTPRT=',intprt -cfmc call readi(mcmcard,'IPRT',iprt,100) -cfmc write(iout,*)'IPRT=',iprt -cfmc call readi(mcmcard,'IMAXTR',imaxtr,100) -cfmc write(iout,*)'IMAXTR=',imaxtr -cfmc call readi(mcmcard,'MAXEVEN',maxeven,1000) -cfmc write(iout,*)'MAXEVEN=',maxeven -cfmc call readi(mcmcard,'MAXEVEN1',maxeven1,3) -cfmc write(iout,*)'MAXEVEN1=',maxeven1 -cfmc call readi(mcmcard,'INIMIN',inimin,200) -cfmc write(iout,*)'INIMIN=',inimin -cfmc call readi(mcmcard,'NSTEPMCMF',nstepmcmf,10) -cfmc write(iout,*)'NSTEPMCMF=',nstepmcmf -cfmc call readi(mcmcard,'NTHREAD',nthread,5) -cfmc write(iout,*)'NTHREAD=',nthread -cfmc call readi(mcmcard,'MAXSTEPMCMF',maxstepmcmf,2500) -cfmc write(iout,*)'MAXSTEPMCMF=',maxstepmcmf -cfmc call readi(mcmcard,'MAXPERT',maxpert,9) -cfmc write(iout,*)'MAXPERT=',maxpert -cfmc call readi(mcmcard,'IRMSD',irmsd,1) -cfmc write(iout,*)'IRMSD=',irmsd -cfmc call reada(mcmcard,'DENEMIN',denemin,0.01D0) -cfmc write(iout,*)'DENEMIN=',denemin -cfmc call reada(mcmcard,'RCUT1S',rcut1s,3.5D0) -cfmc write(iout,*)'RCUT1S=',rcut1s -cfmc call reada(mcmcard,'RCUT1E',rcut1e,2.0D0) -cfmc write(iout,*)'RCUT1E=',rcut1e -cfmc call reada(mcmcard,'RCUT2S',rcut2s,0.5D0) -cfmc write(iout,*)'RCUT2S=',rcut2s -cfmc call reada(mcmcard,'RCUT2E',rcut2e,0.1D0) -cfmc write(iout,*)'RCUT2E=',rcut2e -cfmc call reada(mcmcard,'DPERT1',d_pert1,180.0D0) -cfmc write(iout,*)'DPERT1=',d_pert1 -cfmc call reada(mcmcard,'DPERT1A',d_pert1a,180.0D0) -cfmc write(iout,*)'DPERT1A=',d_pert1a -cfmc call reada(mcmcard,'DPERT2',d_pert2,90.0D0) -cfmc write(iout,*)'DPERT2=',d_pert2 -cfmc call reada(mcmcard,'DPERT2A',d_pert2a,45.0D0) -cfmc write(iout,*)'DPERT2A=',d_pert2a -cfmc call reada(mcmcard,'DPERT2B',d_pert2b,90.0D0) -cfmc write(iout,*)'DPERT2B=',d_pert2b -cfmc call reada(mcmcard,'DPERT2C',d_pert2c,60.0D0) -cfmc write(iout,*)'DPERT2C=',d_pert2c -cfmc d_pert1=deg2rad*d_pert1 -cfmc d_pert1a=deg2rad*d_pert1a -cfmc d_pert2=deg2rad*d_pert2 -cfmc d_pert2a=deg2rad*d_pert2a -cfmc d_pert2b=deg2rad*d_pert2b -cfmc d_pert2c=deg2rad*d_pert2c -cfmc call reada(mcmcard,'KT_MCMF1',kt_mcmf1,1.0D0) -cfmc write(iout,*)'KT_MCMF1=',kt_mcmf1 -cfmc call reada(mcmcard,'KT_MCMF2',kt_mcmf2,1.0D0) -cfmc write(iout,*)'KT_MCMF2=',kt_mcmf2 -cfmc call reada(mcmcard,'DKT_MCMF1',dkt_mcmf1,10.0D0) -cfmc write(iout,*)'DKT_MCMF1=',dkt_mcmf1 -cfmc call reada(mcmcard,'DKT_MCMF2',dkt_mcmf2,1.0D0) -cfmc write(iout,*)'DKT_MCMF2=',dkt_mcmf2 -cfmc call reada(mcmcard,'RCUTINI',rcutini,3.5D0) -cfmc write(iout,*)'RCUTINI=',rcutini -cfmc call reada(mcmcard,'GRAT',grat,0.5D0) -cfmc write(iout,*)'GRAT=',grat -cfmc call reada(mcmcard,'BIAS_MCMF',bias_mcmf,0.0D0) -cfmc write(iout,*)'BIAS_MCMF=',bias_mcmf -cfmc -cfmc return -cfmc end -c---------------------------------------------------------------------------- - subroutine mcmread - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MCM' - include 'COMMON.MCE' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 mcmcard - call card_concat(mcmcard) - call readi(mcmcard,'MAXACC',maxacc,100) - call readi(mcmcard,'MAX_MCM_IT',max_mcm_it,10000) - call readi(mcmcard,'MAXTRIAL',maxtrial,100) - call readi(mcmcard,'MAXTRIAL_ITER',maxtrial_iter,1000) - call readi(mcmcard,'MAXREPM',maxrepm,200) - call reada(mcmcard,'RANFRACT',RanFract,0.5D0) - call reada(mcmcard,'POOL_FRACT',pool_fraction,0.01D0) - call reada(mcmcard,'OVERLAP',overlap_cut,1.0D3) - call reada(mcmcard,'E_UP',e_up,5.0D0) - call reada(mcmcard,'DELTE',delte,0.1D0) - call readi(mcmcard,'NSWEEP',nsweep,5) - call readi(mcmcard,'NSTEPH',nsteph,0) - call readi(mcmcard,'NSTEPC',nstepc,0) - call reada(mcmcard,'TMIN',tmin,298.0D0) - call reada(mcmcard,'TMAX',tmax,298.0D0) - call readi(mcmcard,'NWINDOW',nwindow,0) - call readi(mcmcard,'PRINT_MC',print_mc,0) - print_stat=(index(mcmcard,'NO_PRINT_STAT').le.0) - print_int=(index(mcmcard,'NO_PRINT_INT').le.0) - ent_read=(index(mcmcard,'ENT_READ').gt.0) - call readi(mcmcard,'SAVE_FREQ',save_frequency,1000) - call readi(mcmcard,'MESSAGE_FREQ',message_frequency,1000) - call readi(mcmcard,'POOL_READ_FREQ',pool_read_freq,5000) - call readi(mcmcard,'POOL_SAVE_FREQ',pool_save_freq,1000) - call readi(mcmcard,'PRINT_FREQ',print_freq,1000) - if (nwindow.gt.0) then - read (inp,*) (winstart(i),winend(i),i=1,nwindow) - do i=1,nwindow - winlen(i)=winend(i)-winstart(i)+1 - enddo - endif - if (tmax.lt.tmin) tmax=tmin - if (tmax.eq.tmin) then - nstepc=0 - nsteph=0 - endif - if (nstepc.gt.0 .and. nsteph.gt.0) then - tsteph=(tmax/tmin)**(1.0D0/(nsteph+0.0D0)) - tstepc=(tmax/tmin)**(1.0D0/(nstepc+0.0D0)) - endif -C Probabilities of different move types - sumpro_type(0)=0.0D0 - call reada(mcmcard,'MULTI_BOND',sumpro_type(1),1.0d0) - call reada(mcmcard,'ONE_ANGLE' ,sumpro_type(2),2.0d0) - sumpro_type(2)=sumpro_type(1)+sumpro_type(2) - call reada(mcmcard,'THETA' ,sumpro_type(3),0.0d0) - sumpro_type(3)=sumpro_type(2)+sumpro_type(3) - call reada(mcmcard,'SIDE_CHAIN',sumpro_type(4),0.5d0) - sumpro_type(4)=sumpro_type(3)+sumpro_type(4) - do i=1,MaxMoveType - print *,'i',i,' sumprotype',sumpro_type(i) - sumpro_type(i)=sumpro_type(i)/sumpro_type(MaxMoveType) - print *,'i',i,' sumprotype',sumpro_type(i) - enddo - return - end -c---------------------------------------------------------------------------- - subroutine read_minim - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.MINIM' - include 'COMMON.IOUNITS' - character*80 ucase - character*320 minimcard - call card_concat(minimcard) - call readi(minimcard,'MAXMIN',maxmin,2000) - call readi(minimcard,'MAXFUN',maxfun,5000) - call readi(minimcard,'MINMIN',minmin,maxmin) - call readi(minimcard,'MINFUN',minfun,maxmin) - call reada(minimcard,'TOLF',tolf,1.0D-2) - call reada(minimcard,'RTOLF',rtolf,1.0D-4) - print_min_stat=min0(index(minimcard,'PRINT_MIN_STAT'),1) - print_min_res=min0(index(minimcard,'PRINT_MIN_RES'),1) - print_min_ini=min0(index(minimcard,'PRINT_MIN_INI'),1) - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Options in energy minimization:' - write (iout,'(4(a,i5),a,1pe14.5,a,1pe14.5)') - & 'MaxMin:',MaxMin,' MaxFun:',MaxFun, - & 'MinMin:',MinMin,' MinFun:',MinFun, - & ' TolF:',TolF,' RTolF:',RTolF - return - end -c---------------------------------------------------------------------------- - subroutine read_angles(kanal,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.CONTROL' -c Read angles from input -c - read (kanal,*,err=10,end=10) (theta(i),i=3,nres) - read (kanal,*,err=10,end=10) (phi(i),i=4,nres) - read (kanal,*,err=10,end=10) (alph(i),i=2,nres-1) - read (kanal,*,err=10,end=10) (omeg(i),i=2,nres-1) - - do i=1,nres -c 9/7/01 avoid 180 deg valence angle - if (theta(i).gt.179.99d0) theta(i)=179.99d0 -c - theta(i)=deg2rad*theta(i) - phi(i)=deg2rad*phi(i) - alph(i)=deg2rad*alph(i) - omeg(i)=deg2rad*omeg(i) - enddo - return - 10 return1 - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch) - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,err=10,end=10) wartosc - return - 10 wartosc=default - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine openunits - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' - character*16 form,nodename - integer nodelen -#endif - include 'COMMON.SETUP' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - integer lenpre,lenpot,ilen,lentmp - external ilen - character*3 out1file_text,ucase - character*3 ll - external ucase -c print *,"Processor",myrank,"fg_rank",fg_rank," entered openunits" - call getenv_loc("PREFIX",prefix) - pref_orig = prefix - call getenv_loc("POT",pot) - call getenv_loc("DIRTMP",tmpdir) - call getenv_loc("CURDIR",curdir) - call getenv_loc("OUT1FILE",out1file_text) -c print *,"Processor",myrank,"fg_rank",fg_rank," did GETENV" - out1file_text=ucase(out1file_text) - if (out1file_text(1:1).eq."Y") then - out1file=.true. - else - out1file=fg_rank.gt.0 - endif - lenpre=ilen(prefix) - lenpot=ilen(pot) - lentmp=ilen(tmpdir) - if (lentmp.gt.0) then - write (*,'(80(1h!))') - write (*,'(a,19x,a,19x,a)') "!"," A T T E N T I O N ","!" - write (*,'(80(1h!))') - write (*,*)"All output files will be on node /tmp directory." -#ifdef MPI - call MPI_GET_PROCESSOR_NAME( nodename, nodelen, IERROR ) - if (me.eq.king) then - write (*,*) "The master node is ",nodename - else if (fg_rank.eq.0) then - write (*,*) "I am the CG slave node ",nodename - else - write (*,*) "I am the FG slave node ",nodename - endif -#endif - PREFIX = tmpdir(:lentmp)//'/'//prefix(:lenpre) - lenpre = lentmp+lenpre+1 - endif - entname=prefix(:lenpre)//'_'//pot(:lenpot)//'.entr' -C Get the names and open the input files -#if defined(WINIFL) || defined(WINPGI) - open(1,file=pref_orig(:ilen(pref_orig))// - & '.inp',status='old',readonly,shared) - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',readonly,shared) - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',readonly,shared) -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',readonly,shared) -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',readonly,shared) -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',readonly,shared) - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',readonly,shared) - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',readonly,shared) - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',readonly,shared) - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - & action='read') -c print *,"Processor",myrank," opened file 1" - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -c print *,"Processor",myrank," opened file 9" -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') -c print *,"Processor",myrank," opened file IBOND" - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -c print *,"Processor",myrank," opened file ITHEP" -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old',action='read') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -c print *,"Processor",myrank," opened file IROTAM" -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORP" - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') -c print *,"Processor",myrank," opened file ITORDP" - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') -c print *,"Processor",myrank," opened file ISCCOR" - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') -c print *,"Processor",myrank," opened file IFOURIER" - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') -c print *,"Processor",myrank," opened file IELEP" - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -c print *,"Processor",myrank," opened file ISIDEP" -c print *,"Processor",myrank," opened parameter files" -#elif (defined G77) - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - open (ithep_pdb,file=thetname_pdb,status='old') -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') -#else - open(1,file=pref_orig(:ilen(pref_orig))//'.inp',status='old', - &action='read') - open (9,file=prefix(:ilen(prefix))//'.intin',status='unknown') -C open (18,file=prefix(:ilen(prefix))//'.entin',status='unknown') -C Get parameter filenames and open the parameter files. - call getenv_loc('BONDPAR',bondname) - open (ibond,file=bondname,status='old',action='read') - call getenv_loc('THETPAR',thetname) - open (ithep,file=thetname,status='old',action='read') -#ifndef CRYST_THETA - call getenv_loc('THETPARPDB',thetname_pdb) - print *,"thetname_pdb ",thetname_pdb - open (ithep_pdb,file=thetname_pdb,status='old',action='read') - print *,ithep_pdb," opened" -#endif - call getenv_loc('ROTPAR',rotname) - open (irotam,file=rotname,status='old',action='read') -#ifndef CRYST_SC - call getenv_loc('ROTPARPDB',rotname_pdb) - open (irotam_pdb,file=rotname_pdb,status='old',action='read') -#endif - call getenv_loc('TORPAR',torname) - open (itorp,file=torname,status='old',action='read') - call getenv_loc('TORDPAR',tordname) - open (itordp,file=tordname,status='old',action='read') - call getenv_loc('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old',action='read') - call getenv_loc('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old',action='read') - call getenv_loc('ELEPAR',elename) - open (ielep,file=elename,status='old',action='read') - call getenv_loc('SIDEPAR',sidename) - open (isidep,file=sidename,status='old',action='read') -#endif -#ifndef OLDSCP -C -C 8/9/01 In the newest version SCp interaction constants are read from a file -C Use -DOLDSCP to use hard-coded constants instead. -C - call getenv_loc('SCPPAR',scpname) -#if defined(WINIFL) || defined(WINPGI) - open (iscpp,file=scpname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (iscpp,file=scpname,status='old',action='read') -#elif (defined G77) - open (iscpp,file=scpname,status='old') -#else - open (iscpp,file=scpname,status='old',action='read') -#endif -#endif - call getenv_loc('PATTERN',patname) -#if defined(WINIFL) || defined(WINPGI) - open (icbase,file=patname,status='old',readonly,shared) -#elif (defined CRAY) || (defined AIX) - open (icbase,file=patname,status='old',action='read') -#elif (defined G77) - open (icbase,file=patname,status='old') -#else - open (icbase,file=patname,status='old',action='read') -#endif -#ifdef MPI -C Open output file only for CG processes -c print *,"Processor",myrank," fg_rank",fg_rank - if (fg_rank.eq.0) then - - if (nodes.eq.1) then - npos=3 - else - npos = dlog10(dfloat(nodes-1))+1 - endif - if (npos.lt.3) npos=3 - write (liczba,'(i1)') npos - form = '(bz,i'//liczba(:ilen(liczba))//'.'//liczba(:ilen(liczba)) - & //')' - write (liczba,form) me - outname=prefix(:lenpre)//'.out_'//pot(:lenpot)// - & liczba(:ilen(liczba)) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//liczba(:ilen(liczba)) - & //'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //liczba(:ilen(liczba))//'.stat') - rest2name=prefix(:ilen(prefix))//"_"//liczba(:ilen(liczba)) - & //'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)// - & liczba(:ilen(liczba))//'.const' - endif - - endif -#else - outname=prefix(:lenpre)//'.out_'//pot(:lenpot) - intname=prefix(:lenpre)//'_'//pot(:lenpot)//'.int' - pdbname=prefix(:lenpre)//'_'//pot(:lenpot)//'.pdb' - mol2name=prefix(:lenpre)//'_'//pot(:lenpot)//'.mol2' - statname=prefix(:lenpre)//'_'//pot(:lenpot)//'.stat' - if (lentmp.gt.0) - & call copy_to_tmp(pref_orig(:ilen(pref_orig))//'_'//pot(:lenpot) - & //'.stat') - rest2name=prefix(:ilen(prefix))//'.rst' - if(usampl) then - qname=prefix(:lenpre)//'_'//pot(:lenpot)//'.const' - endif -#endif -#if defined(AIX) || defined(PGI) - if (me.eq.king .or. .not. out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',position='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',position='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#else - if (me.eq.king .or. .not.out1file) - & open(iout,file=outname,status='unknown') -c#define DEBUG -#ifdef DEBUG - if (fg_rank.gt.0) then - print "Processor",fg_rank," opening output file" - write (liczba,'(i3.3)') myrank/nfgtasks - write (ll,'(bz,i3.3)') fg_rank - open(iout,file="debug"//liczba(:ilen(liczba))//"."//ll, - & status='unknown') - endif -#endif -c#undef DEBUG - if(me.eq.king) then - open(igeom,file=intname,status='unknown',access='append') - open(ipdb,file=pdbname,status='unknown') - open(imol2,file=mol2name,status='unknown') - open(istat,file=statname,status='unknown',access='append') - else -c1out open(iout,file=outname,status='unknown') - endif -#endif -csa csa_rbank=prefix(:lenpre)//'.CSA.rbank' -csa csa_seed=prefix(:lenpre)//'.CSA.seed' -csa csa_history=prefix(:lenpre)//'.CSA.history' -csa csa_bank=prefix(:lenpre)//'.CSA.bank' -csa csa_bank1=prefix(:lenpre)//'.CSA.bank1' -csa csa_alpha=prefix(:lenpre)//'.CSA.alpha' -csa csa_alpha1=prefix(:lenpre)//'.CSA.alpha1' -csac!bankt csa_bankt=prefix(:lenpre)//'.CSA.bankt' -csa csa_int=prefix(:lenpre)//'.int' -csa csa_bank_reminimized=prefix(:lenpre)//'.CSA.bank_reminimized' -csa csa_native_int=prefix(:lenpre)//'.CSA.native.int' -csa csa_in=prefix(:lenpre)//'.CSA.in' -c print *,"Processor",myrank,"fg_rank",fg_rank," opened files" -C Write file names - if (me.eq.king)then - write (iout,'(80(1h-))') - write (iout,'(30x,a)') "FILE ASSIGNMENT" - write (iout,'(80(1h-))') - write (iout,*) "Input file : ", - & pref_orig(:ilen(pref_orig))//'.inp' - write (iout,*) "Output file : ", - & outname(:ilen(outname)) - write (iout,*) - write (iout,*) "Sidechain potential file : ", - & sidename(:ilen(sidename)) -#ifndef OLDSCP - write (iout,*) "SCp potential file : ", - & scpname(:ilen(scpname)) -#endif - write (iout,*) "Electrostatic potential file : ", - & elename(:ilen(elename)) - write (iout,*) "Cumulant coefficient file : ", - & fouriername(:ilen(fouriername)) - write (iout,*) "Torsional parameter file : ", - & torname(:ilen(torname)) - write (iout,*) "Double torsional parameter file : ", - & tordname(:ilen(tordname)) - write (iout,*) "SCCOR parameter file : ", - & sccorname(:ilen(sccorname)) - write (iout,*) "Bond & inertia constant file : ", - & bondname(:ilen(bondname)) - write (iout,*) "Bending parameter file : ", - & thetname(:ilen(thetname)) - write (iout,*) "Rotamer parameter file : ", - & rotname(:ilen(rotname)) - write (iout,*) "Threading database : ", - & patname(:ilen(patname)) - if (lentmp.ne.0) - &write (iout,*)" DIRTMP : ", - & tmpdir(:lentmp) - write (iout,'(80(1h-))') - endif - return - end -c---------------------------------------------------------------------------- - subroutine card_concat(card) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.IOUNITS' - character*(*) card - character*80 karta,ucase - external ilen - read (inp,'(a)') karta - karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end -c---------------------------------------------------------------------------------- - subroutine readrst - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - open(irest2,file=rest2name,status='unknown') - read(irest2,*) totT,EK,potE,totE,t_bath - do i=1,2*nres - read(irest2,'(3e15.5)') (d_t(j,i),j=1,3) - enddo - do i=1,2*nres - read(irest2,'(3e15.5)') (dc(j,i),j=1,3) - enddo - if(usampl) then - read (irest2,*) iset - endif - close(irest2) - return - end -c--------------------------------------------------------------------------------- - subroutine read_fragments - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.MD' - include 'COMMON.CONTROL' - read(inp,*) nset,nfrag,npair,nfrag_back - if(me.eq.king.or..not.out1file) - & write(iout,*) "nset",nset," nfrag",nfrag," npair",npair, - & " nfrag_back",nfrag_back - do iset=1,nset - read(inp,*) mset(iset) - do i=1,nfrag - read(inp,*) wfrag(i,iset),ifrag(1,i,iset),ifrag(2,i,iset), - & qinfrag(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wfrag(i,iset),ifrag(1,i,iset), - & ifrag(2,i,iset), qinfrag(i,iset) - enddo - do i=1,npair - read(inp,*) wpair(i,iset),ipair(1,i,iset),ipair(2,i,iset), - & qinpair(i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "R ",i,wpair(i,iset),ipair(1,i,iset), - & ipair(2,i,iset), qinpair(i,iset) - enddo - do i=1,nfrag_back - read(inp,*) wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset), - & ifrag_back(1,i,iset),ifrag_back(2,i,iset) - if(me.eq.king.or..not.out1file) - & write(iout,*) "A",i,wfrag_back(1,i,iset),wfrag_back(2,i,iset), - & wfrag_back(3,i,iset),ifrag_back(1,i,iset),ifrag_back(2,i,iset) - enddo - enddo - return - end -c------------------------------------------------------------------------------- - subroutine read_dist_constr - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef MPI - include 'mpif.h' -#endif - include 'COMMON.SETUP' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.IOUNITS' - include 'COMMON.SBRIDGE' - integer ifrag_(2,100),ipair_(2,100) - double precision wfrag_(100),wpair_(100) - character*500 controlcard -c write (iout,*) "Calling read_dist_constr" -c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup -c call flush(iout) - call card_concat(controlcard) - call readi(controlcard,"NFRAG",nfrag_,0) - call readi(controlcard,"NPAIR",npair_,0) - call readi(controlcard,"NDIST",ndist_,0) - call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) - call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) - call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) - call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) - call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) -c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ -c write (iout,*) "IFRAG" -c do i=1,nfrag_ -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) -c enddo -c write (iout,*) "IPAIR" -c do i=1,npair_ -c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) -c enddo - if (.not.refstr .and. nfrag.gt.0) then - write (iout,*) - & "ERROR: no reference structure to compute distance restraints" - write (iout,*) - & "Restraints must be specified explicitly (NDIST=number)" - stop - endif - if (nfrag.lt.2 .and. npair.gt.0) then - write (iout,*) "ERROR: Less than 2 fragments specified", - & " but distance restraints between pairs requested" - stop - endif - call flush(iout) - do i=1,nfrag_ - if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup - if (ifrag_(2,i).gt.nstart_sup+nsup-1) - & ifrag_(2,i)=nstart_sup+nsup-1 -c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) - call flush(iout) - if (wfrag_(i).gt.0.0d0) then - do j=ifrag_(1,i),ifrag_(2,i)-1 - do k=j+1,ifrag_(2,i) - write (iout,*) "j",j," k",k - ddjk=dist(j,k) - if (constr_dist.eq.1) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - else if (constr_dist.eq.2) then - if (ddjk.le.dist_cut) then - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i) - endif - else - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - dhpb(nhpb)=ddjk - forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) - endif -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,npair_ - if (wpair_(i).gt.0.0d0) then - ii = ipair_(1,i) - jj = ipair_(2,i) - if (ii.gt.jj) then - itemp=ii - ii=jj - jj=itemp - endif - do j=ifrag_(1,ii),ifrag_(2,ii) - do k=ifrag_(1,jj),ifrag_(2,jj) - nhpb=nhpb+1 - ihpb(nhpb)=j - jhpb(nhpb)=k - forcon(nhpb)=wpair_(i) - dhpb(nhpb)=dist(j,k) -#ifdef MPI - if (.not.out1file .or. me.eq.king) - & write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#else - write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", - & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) -#endif - enddo - enddo - endif - enddo - do i=1,ndist_ - read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), - & ibecarb(i),forcon(nhpb+1) - if (forcon(nhpb+1).gt.0.0d0) then - nhpb=nhpb+1 - if (ibecarb(i).gt.0) then - ihpb(i)=ihpb(i)+nres - jhpb(i)=jhpb(i)+nres - endif - if (dhpb(nhpb).eq.0.0d0) - & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) - endif - enddo -#ifdef MPI - if (.not.out1file .or. me.eq.king) then -#endif - do i=1,nhpb - write (iout,'(a,3i5,2f8.2,i2,f10.1)') "+dist.constr ", - & i,ihpb(i),jhpb(i),dhpb(i),dhpb1(i),ibecarb(i),forcon(i) - enddo - call flush(iout) -#ifdef MPI - endif -#endif - return - end -c------------------------------------------------------------------------------- -#ifdef WINIFL - subroutine flush(iu) - return - end -#endif -#ifdef AIX - subroutine flush(iu) - call flush_(iu) - return - end -#endif -c------------------------------------------------------------------------------ - subroutine copy_to_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - character* 256 tmpfile - integer ilen - external ilen - logical ex - tmpfile=curdir(:ilen(curdir))//"/"//source(:ilen(source)) - inquire(file=tmpfile,exist=ex) - if (ex) then - write (*,*) "Copying ",tmpfile(:ilen(tmpfile)), - & " to temporary directory..." - write (*,*) "/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir - call system("/bin/cp "//tmpfile(:ilen(tmpfile))//" "//tmpdir) - endif - return - end -c------------------------------------------------------------------------------ - subroutine move_from_tmp(source) - include "DIMENSIONS" - include "COMMON.IOUNITS" - character*(*) source - integer ilen - external ilen - write (*,*) "Moving ",source(:ilen(source)), - & " from temporary directory to working directory" - write (*,*) "/bin/mv "//source(:ilen(source))//" "//curdir - call system("/bin/mv "//source(:ilen(source))//" "//curdir) - return - end -c------------------------------------------------------------------------------ - subroutine random_init(seed) -C -C Initialize random number generator -C - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' -#ifdef AMD64 - integer*8 iseedi8 -#endif -#ifdef MPI - include 'mpif.h' - logical OKRandom, prng_restart - real*8 r1 - integer iseed_array(4) -#endif - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.THREAD' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.MCM' - include 'COMMON.MAP' - include 'COMMON.HEADER' -csa include 'COMMON.CSA' - include 'COMMON.CHAIN' - include 'COMMON.MUCA' - include 'COMMON.MD' - include 'COMMON.FFIELD' - include 'COMMON.SETUP' -c iseed=-dint(dabs(seed)) - iseed=dint(dabs(seed)) - if (iseed.eq.0) then - write (iout,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' - write (*,'(/80(1h*)/20x,a/80(1h*))') - & 'Random seed undefined. The program will stop.' -#ifdef MPI - call mpi_finalize(mpi_comm_world,ierr) -#endif - stop 'Bad random seed.' - endif -#ifdef MPI - if (fg_rank.eq.0) then - seed=seed*(me+1)+1 -#ifdef AMD64 - iseedi8=dint(seed) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - write (*,*) 'MPI: node= ', me, ' iseed= ',iseedi8 - OKRandom = prng_restart(me,iseedi8) -#else - do i=1,4 - tmp=65536.0d0**(4-i) - iseed_array(i) = dint(seed/tmp) - seed=seed-iseed_array(i)*tmp - enddo - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'MPI: node= ', me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - write (*,*) 'MPI: node= ',me, ' iseed(4)= ', - & (iseed_array(i),i=1,4) - OKRandom = prng_restart(me,iseed_array) -#endif - if (OKRandom) then - r1=ran_number(0.0D0,1.0D0) - if(me.eq.king .or. .not. out1file) - & write (iout,*) 'ran_num',r1 - if (r1.lt.0.0d0) OKRandom=.false. - endif - if (.not.OKRandom) then - write (iout,*) 'PRNG IS NOT WORKING!!!' - print *,'PRNG IS NOT WORKING!!!' - if (me.eq.0) then - call flush(iout) - call mpi_abort(mpi_comm_world,error_msg,ierr) - stop - else - write (iout,*) 'too many processors for parallel prng' - write (*,*) 'too many processors for parallel prng' - call flush(iout) - stop - endif - endif - endif -#else - call vrndst(iseed) - write (iout,*) 'ran_num',ran_number(0.0d0,1.0d0) -#endif - return - end diff --git a/source/unres/src_MD/unres.F b/source/unres/src_MD/unres.F index 053eec6..b8dd5ec 100644 --- a/source/unres/src_MD/unres.F +++ b/source/unres/src_MD/unres.F @@ -248,6 +248,7 @@ crc overlap test time1=tcpu() #endif call minim_dc(etot,iretcode,nfun) + if(iretcode.eq.8) call check_ecartint else if (indpdb.ne.0) then call bond_regular @@ -397,7 +398,7 @@ c--------------------------------------------------------------------------- include 'COMMON.SBRIDGE' double precision varia(maxvar) dimension ind(6) - double precision energy(0:max_ene) + double precision energy(0:n_ene) logical eof eof=.false. #ifdef MPI @@ -408,14 +409,14 @@ c--------------------------------------------------------------------------- close (intin) open(intin,file=intinname,status='old') - write (istat,'(a5,20a12)')"# ", + write (istat,'(a5,30a12)')"# ", & (wname(print_order(i)),i=1,nprint_ene) if (refstr) then - write (istat,'(a5,20a12)')"# ", + write (istat,'(a5,30a12)')"# ", & (ename(print_order(i)),i=1,nprint_ene), - & "ETOT total","RMSD","nat.contact","nnt.contact" + & "ETOT total","RMSD","nat.contact","nnt.contact","cont.order" else - write (istat,'(a5,20a12)')"# ", + write (istat,'(a5,30a12)')"# ", & (ename(print_order(i)),i=1,nprint_ene),"ETOT total" endif @@ -443,12 +444,12 @@ c Broadcast the order to compute internal coordinates to the slaves. etot=energy(0) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,20(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot, & rms,frac,frac_nn,co cjlee end else - write (istat,'(i5,16(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot endif enddo @@ -481,8 +482,9 @@ c Broadcast the order to compute internal coordinates to the slaves. call geom_to_var(nvar,varia) call chainbuild endif - write (iout,'(a,i7)') 'Conformation #',iconf + n=n+1 + write (iout,*) 'Conformation #',iconf,' read' imm=imm+1 ind(1)=1 ind(2)=n @@ -519,7 +521,8 @@ c print *,'result received from worker ',man,' sending now' iconf=ind(2) write (iout,*) write (iout,*) - write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5) + write (iout,*) 'Conformation #',iconf," sumsl return code ", + & ind(5) etot=energy(0) call enerprint(energy(0)) @@ -527,17 +530,17 @@ c print *,'result received from worker ',man,' sending now' c if (minim) call briefout(it,etot) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,19(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot, & rms,frac,frac_nn,co else - write (istat,'(i5,15(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot endif imm=imm-1 if (read_cart) then - read (intin,'(e15.10,e15.5)',end=1101,err=1101) time,ene + read (intin,'(e15.10,e15.5)',end=11,err=11) time,ene call read_x(intin,*11) #ifdef MPI c Broadcast the order to compute internal coordinates to the slaves. @@ -546,12 +549,13 @@ c Broadcast the order to compute internal coordinates to the slaves. #endif call int_from_cart1(.false.) else - read (intin,'(i5)',end=1101,err=1101) iconf + read (intin,'(i5)',end=11,err=11) iconf call read_angles(intin,*11) call geom_to_var(nvar,varia) call chainbuild endif n=n+1 + write (iout,*) 'Conformation #',iconf,' read' imm=imm+1 ind(1)=1 ind(2)=n @@ -589,18 +593,19 @@ c Broadcast the order to compute internal coordinates to the slaves. iconf=ind(2) write (iout,*) write (iout,*) - write (iout,'(a,2i7)') 'Conformation #',iconf,ind(5) + write (iout,*) 'Conformation #',iconf," sumsl return code ", + & ind(5) etot=energy(0) call enerprint(energy(0)) call briefout(it,etot) if (refstr) then call rms_nac_nnc(rms,frac,frac_nn,co,.true.) - write (istat,'(i5,19(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot, & rms,frac,frac_nn,co else - write (istat,'(i5,15(f12.3))') iconf, + write (istat,'(i5,30(f12.3))') iconf, & (energy(print_order(i)),i=1,nprint_ene),etot endif nmin=nmin+1 @@ -693,7 +698,7 @@ c--------------------------------------------------------------------------- include 'COMMON.MD' include 'COMMON.SBRIDGE' common /srutu/ icall - double precision energy(0:max_ene) + double precision energy(0:n_ene) c do i=2,nres c vbld(i)=vbld(i)+ran_number(-0.1d0,0.1d0) c if (itype(i).ne.10) @@ -732,6 +737,7 @@ c enddo print *,'icheckgrad=',icheckgrad goto (10,20,30) icheckgrad 10 call check_ecartint + call check_ecartint return 20 call check_cartgrad return @@ -769,7 +775,7 @@ c--------------------------------------------------------------------------- include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CONTROL' - double precision energy(0:max_ene) + double precision energy(0:n_ene) logical debug /.false./ call chainbuild call etotal(energy(0)) diff --git a/source/unres/src_MD_DFA/CMakeLists.txt b/source/unres/src_MD_DFA/CMakeLists.txt index 3e45fa9..71479a0 100644 --- a/source/unres/src_MD_DFA/CMakeLists.txt +++ b/source/unres/src_MD_DFA/CMakeLists.txt @@ -60,6 +60,7 @@ set(UNRES_MD_DFA_SRC0 parmread.F pinorm.f printmat.f + prng_32.F q_measure.F randgens.f rattle.F @@ -81,15 +82,6 @@ set(UNRES_MD_DFA_SRC0 unres.F ) -if(Fortran_COMPILER_NAME STREQUAL "ifort") - set(UNRES_MD_DFA_SRC0 ${UNRES_MD_DFA_SRC0} prng.f ) -elseif(Fortran_COMPILER_NAME STREQUAL "mpif90") - set(UNRES_MD_SRC0 ${UNRES_MD_SRC0} prng.f ) -else() - set(UNRES_MD_DFA_SRC0 ${UNRES_MD_DFA_SRC0} prng_32.F ) -endif (Fortran_COMPILER_NAME STREQUAL "ifort") - - set(UNRES_MD_DFA_SRC3 energy_p_new_barrier.F energy_p_new-sep_barrier.F @@ -163,10 +155,10 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS1 "${FFLAGS1} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS2 "${FFLAGS2} -I${MPIF_INCLUDE_DIRECTORIES}") - set(FFLAGS3 "${FFLAGS3} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS1 "${FFLAGS1} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS2 "${FFLAGS2} -I${MPI_Fortran_INCLUDE_PATH}") + set(FFLAGS3 "${FFLAGS3} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_MD_DFA_SRC0} APPEND PROPERTY COMPILE_FLAGS ${FFLAGS0} ) @@ -219,6 +211,13 @@ if (UNRES_WITH_MPI) endif(UNRES_WITH_MPI) #========================================= +# add 64-bit specific preprocessor flags +#========================================= +if (architektura STREQUAL "64") + set(CPPFLAGS "${CPPFLAGS} -DAMD64") +endif (architektura STREQUAL "64") + +#========================================= # Apply preprocesor flags to *.F files #========================================= set_property(SOURCE ${UNRES_MD_DFA_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS} ) @@ -229,10 +228,10 @@ set_property(SOURCE ${UNRES_MD_DFA_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLA #======================================== if(UNRES_WITH_MPI) # binary with mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") + set(UNRES_BIN "unresMD-DFA_${Fortran_COMPILER_NAME}_MPICH_${UNRES_MD_FF}.exe") else(UNRES_WITH_MPI) # binary without mpi - set(UNRES_BIN "unres_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") + set(UNRES_BIN "unresMD-DFA_${Fortran_COMPILER_NAME}_single_${UNRES_MD_FF}.exe") endif(UNRES_WITH_MPI) #========================================= @@ -278,7 +277,7 @@ set(UNRES_MD_DFA_SRCS ${UNRES_MD_DFA_SRC0} ${UNRES_MD_DFA_SRC3} ${CMAKE_CURRENT_ #========================================= add_executable(UNRES_BIN-MD-DFA ${UNRES_MD_DFA_SRCS} ) set_target_properties(UNRES_BIN-MD-DFA PROPERTIES OUTPUT_NAME ${UNRES_BIN}) -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_BIN-MD-DFA PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) @@ -287,7 +286,7 @@ set_target_properties(UNRES_BIN-MD-DFA PROPERTIES OUTPUT_NAME ${UNRES_BIN}) #========================================= # link MPI library (libmpich.a) if(UNRES_WITH_MPI) - target_link_libraries( UNRES_BIN-MD-DFA ${MPIF_LIBRARIES} ) + target_link_libraries( UNRES_BIN-MD-DFA ${MPI_Fortran_LIBRARIES} ) endif(UNRES_WITH_MPI) # link libxdrf.a #message("UNRES_XDRFLIB=${UNRES_XDRFLIB}") @@ -317,16 +316,23 @@ target_link_libraries( UNRES_BIN-MD-DFA xdrf ) #========================================= # test_single_ala.sh #========================================= +# +# Set parmaeters depending on force field +if(UNRES_MD_FF STREQUAL "GAB") + set(UNRES_BONDPAR "bond.parm") +elseif(UNRES_MD_FF STREQUAL "E0LL2Y") + set(UNRES_BONDPAR "bond_AM1.parm") +endif(UNRES_MD_FF STREQUAL "GAB") FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/test_single_ala.sh "#!/bin/sh export POT=GB export PREFIX=ala10 #----------------------------------------------------------------------------- -UNRES_BIN=./${UNRES_BIN} +UNRES_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_BIN} #----------------------------------------------------------------------------- DD=${CMAKE_SOURCE_DIR}/PARAM -export BONDPAR=$DD/bond.parm +export BONDPAR=$DD/${UNRES_BONDPAR} export THETPAR=$DD/thetaml.5parm export ROTPAR=$DD/scgauss.parm export TORPAR=$DD/torsion_631Gdp.parm @@ -384,12 +390,12 @@ XAAAAAAAAAAX if(NOT UNRES_WITH_MPI) - add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + add_test(NAME UNRES_MD_DFA_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) else(NOT UNRES_WITH_MPI) - add_test(NAME UNRES_MD_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) + add_test(NAME UNRES_MD_DFA_MPI_Ala10 COMMAND mpiexec -boot ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) endif(NOT UNRES_WITH_MPI) diff --git a/source/unres/src_MD_DFA/COMMON.DFA b/source/unres/src_MD_DFA/COMMON.DFA index 1c750cf..c6add4f 100644 --- a/source/unres/src_MD_DFA/COMMON.DFA +++ b/source/unres/src_MD_DFA/COMMON.DFA @@ -51,7 +51,7 @@ C NMAP - mapping between dfanum and ndis, nphi, nthe, nnei INTEGER IDFADIS,IDFAPHI,IDFATHE,IDFANEI, & IDISLIS,IPHILIS,ITHELIS,INEILIS, & IDISNUM,IPHINUM,ITHENUM,INEINUM, - & FNEI, + & FNEI,DFACMD, DFANUM, & NCA,ICAIDX, & STOAGDF, NMAP, IDFACAT, KDISNUM, KSHELL & ishiftca,ilastca @@ -82,7 +82,7 @@ C & FTHE1, FTHE2, & DIS_INC, PHI_INC, THE_INC, NEI_INC, BETA_INC, & WSHET, EDFABET, - & CK, SCK + & CK, SCK, S1, S2 c & ,DFAEXP COMMON /RDFA/ SCCDIST(IDFAMAX,IDMAXMIN),FDIST(IDFAMAX,IDMAXMIN), diff --git a/source/unres/src_MD_DFA/COMMON.REMD b/source/unres/src_MD_DFA/COMMON.REMD index 182acae..b283b5b 100644 --- a/source/unres/src_MD_DFA/COMMON.REMD +++ b/source/unres/src_MD_DFA/COMMON.REMD @@ -17,7 +17,7 @@ common /remdrestart/ i2rep,i2set,ifirst,nupa,ndowna,t_restart1, & iset_restart1 real totT_cache,EK_cache,potE_cache,t_bath_cache,Uconst_cache, - & qfrag_cache,qpair_cache,c_cache, + & qfrag_cache,qpair_cache,c_cache,uscdiff_cache, & ugamma_cache,utheta_cache integer ntwx_cache,ii_write,max_cache_traj_use common /traj1cache/ totT_cache(max_cache_traj), diff --git a/source/unres/src_MD_DFA/MREMD.F b/source/unres/src_MD_DFA/MREMD.F index 0e4045f..576e43d 100644 --- a/source/unres/src_MD_DFA/MREMD.F +++ b/source/unres/src_MD_DFA/MREMD.F @@ -1828,7 +1828,6 @@ ctime call flush(iout) integer*2 i_index & (maxprocs/4,maxprocs/20,maxprocs/200,maxprocs/200) common /przechowalnia/ d_restart1 - integer i2set_(0:maxprocs) write (*,*) "Processor",me," called read1restart" if(me.eq.king)then @@ -1987,16 +1986,13 @@ c & (d_restart1(j,i+2*nres*il),j=1,3) enddo endif #endif -c Corrected AL 8/19/2014: each processor needs whole iset array not only its -c own element -c call mpi_scatter(i2set,1,mpi_integer, -c & iset,1,mpi_integer,king, -c & CG_COMM,ierr) - call mpi_bcast(i2set(0),nodes,mpi_integer,king, - & CG_COMM,ierr) - iset=i2set(me) + call mpi_scatter(i2set,1,mpi_integer, + & iset,1,mpi_integer,king, + & CG_COMM,ierr) + endif + if(me.eq.king) close(irest2) return end diff --git a/source/unres/src_MD_DFA/initialize_p.F b/source/unres/src_MD_DFA/initialize_p.F index 8cdab32..16ba578 100644 --- a/source/unres/src_MD_DFA/initialize_p.F +++ b/source/unres/src_MD_DFA/initialize_p.F @@ -293,11 +293,11 @@ c--------------------------------------------------------------------------- include 'COMMON.IOUNITS' include 'COMMON.DERIV' include 'COMMON.CONTACTS' - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1), + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1), & ntask_cont_from_all(0:max_fg_procs-1), & itask_cont_from_all(0:max_fg_procs-1,0:max_fg_procs-1), & ntask_cont_to_all(0:max_fg_procs-1), @@ -1117,15 +1117,16 @@ c--------------------------------------------------------------------------- include "COMMON.INTERACT" include "COMMON.SETUP" include "COMMON.IOUNITS" - integer ii,jj,itask(4),ntask_cont_to,itask_cont_to(0:MaxProcs-1) + integer ii,jj,itask(4), + & ntask_cont_to,itask_cont_to(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,isent,k,l c Determines whether to send interaction ii,jj to other processors; a given c interaction can be sent to at most 2 processors. @@ -1207,15 +1208,15 @@ c--------------------------------------------------------------------------- include "COMMON.SETUP" include "COMMON.IOUNITS" integer ii,jj,itask(2),ntask_cont_from, - & itask_cont_from(0:MaxProcs-1) + & itask_cont_from(0:max_fg_procs-1) logical flag integer iturn3_start_all,iturn3_end_all,iturn4_start_all, & iturn4_end_all,iatel_s_all,iatel_e_all,ielstart_all,ielend_all - common /przechowalnia/ iturn3_start_all(0:MaxProcs), - & iturn3_end_all(0:MaxProcs),iturn4_start_all(0:MaxProcs), - & iturn4_end_all(0:MaxProcs),iatel_s_all(0:MaxProcs), - & iatel_e_all(0:MaxProcs),ielstart_all(maxres,0:MaxProcs-1), - & ielend_all(maxres,0:MaxProcs-1) + common /przechowalnia/ iturn3_start_all(0:max_fg_procs), + & iturn3_end_all(0:max_fg_procs),iturn4_start_all(0:max_fg_procs), + & iturn4_end_all(0:max_fg_procs),iatel_s_all(0:max_fg_procs), + &iatel_e_all(0:max_fg_procs),ielstart_all(maxres,0:max_fg_procs-1), + & ielend_all(maxres,0:max_fg_procs-1) integer iproc,k,l do iproc=fg_rank+1,nfgtasks-1 do k=iturn3_start_all(iproc),iturn3_end_all(iproc) @@ -1267,7 +1268,7 @@ c--------------------------------------------------------------------------- subroutine add_task(iproc,ntask_cont,itask_cont) implicit none include "DIMENSIONS" - integer iproc,ntask_cont,itask_cont(0:MaxProcs-1) + integer iproc,ntask_cont,itask_cont(0:max_fg_procs-1) integer ii do ii=1,ntask_cont if (itask_cont(ii).eq.iproc) return diff --git a/source/unres/src_MD_DFA/unres.F b/source/unres/src_MD_DFA/unres.F index 053eec6..06ddd69 100644 --- a/source/unres/src_MD_DFA/unres.F +++ b/source/unres/src_MD_DFA/unres.F @@ -719,7 +719,7 @@ c enddo totT=1.d0 eq_time=0.0d0 call read_fragments - read(inp,*) t_bath +cc read(inp,*) t_bath call rescale_weights(t_bath) call chainbuild_cart call cartprint diff --git a/source/unres/src_MIN/CMakeLists.txt b/source/unres/src_MIN/CMakeLists.txt index 0ebc88f..079f58c 100644 --- a/source/unres/src_MIN/CMakeLists.txt +++ b/source/unres/src_MIN/CMakeLists.txt @@ -35,6 +35,7 @@ set(UNRES_MIN_SRC0 readrtns_min.F refsys.f rescode.f + refsys.f rmdd.f sc_move.F sumsld.f @@ -208,41 +209,17 @@ set(UNRES_MIN_SRCS ${UNRES_MIN_SRC0} ${UNRES_MIN_SRC1} ${UNRES_MIN_SRC2} ${UNRES #========================================= # Build the binary #========================================= -add_executable(UNRES_BIN-MIN ${UNRES_MIN_SRCS} ) -set_target_properties(UNRES_BIN-MIN PROPERTIES OUTPUT_NAME ${UNRES_BIN}) +add_executable(UNRES_MIN_BIN ${UNRES_MIN_SRCS} ) +set_target_properties(UNRES_MIN_BIN PROPERTIES OUTPUT_NAME ${UNRES_BIN}) if (Fortran_COMPILER_NAME STREQUAL "ifort") - target_link_libraries (UNRES_BIN-MIN ${CMAKE_THREAD_LIBS_INIT}) + target_link_libraries (UNRES_MIN_BIN ${CMAKE_THREAD_LIBS_INIT}) endif (Fortran_COMPILER_NAME STREQUAL "ifort") +set_property(TARGET UNRES_MIN_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) #========================================= -# TESTS -#========================================= - -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) - -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) - +# Install Path #========================================= -# Generate data test files -#========================================= - -#if(NOT UNRES_WITH_MPI) - -# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) +install(TARGETS UNRES_MIN_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}/unres/MINIM) -#endif(NOT UNRES_WITH_MPI) - diff --git a/source/unres/src_MIN/COMMON.SCCOR b/source/unres/src_MIN/COMMON.SCCOR index 5217de7..a28f621 100644 --- a/source/unres/src_MIN/COMMON.SCCOR +++ b/source/unres/src_MIN/COMMON.SCCOR @@ -1,6 +1,6 @@ C Parameters of the SCCOR term double precision v1sccor,v2sccor integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), + common/sccor/v1sccor(maxterm_sccor,20,20), & v2sccor(maxterm_sccor,20,20), & nterm_sccor diff --git a/source/unres/src_MIN/Makefile_gfortran_single b/source/unres/src_MIN/Makefile_gfortran_single index 5701c47..39edc5e 100644 --- a/source/unres/src_MIN/Makefile_gfortran_single +++ b/source/unres/src_MIN/Makefile_gfortran_single @@ -12,8 +12,8 @@ LIBS = ARCH = LINUX PP = /lib/cpp -P - -all: unres +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" .SUFFIXES: .F.f .F.o: @@ -30,9 +30,11 @@ object = unres_min.o arcos.o cartprint.o chainbuild.o initialize_p.o \ cored.o rmdd.o geomout_min.o readpdb.o \ intcartderiv.o \ MP.o printmat.o convert.o int_to_cart.o \ - djacob.o gen_rand_conf.o sc_move.o + djacob.o gen_rand_conf.o sc_move.o refsys.o + +no_option: -GAB: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ +GAB: CPPFLAGS = -DPROCOR -DLINUX -DG77 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC GAB: BIN = ../../../bin/unres/MINIM/unres_gfortran_MIN_single_GAB.exe GAB: ${object} @@ -41,7 +43,16 @@ GAB: ${object} ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} -E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DUNRES -DISNAN \ +4P: CPPFLAGS = -DLINUX -DUNRES -DG77 -DISNAN \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ../../../bin/unres/MINIM/unres_gfortran_MIN_single_4P.exe +4P: ${object} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DG77 -DUNRES -DISNAN \ -DSPLITELE -DLANG0 E0LL2Y: BIN = ../../../bin/unres/MINIM/unres_gfortran_MIN_single_E0LL2Y.exe E0LL2Y: ${object} diff --git a/source/unres/src_MIN/Makefile_ifort_single b/source/unres/src_MIN/Makefile_ifort_single index 1e5d224..47a052c 100644 --- a/source/unres/src_MIN/Makefile_ifort_single +++ b/source/unres/src_MIN/Makefile_ifort_single @@ -12,8 +12,8 @@ LIBS = -lpthread ARCH = LINUX PP = /lib/cpp -P - -all: unres +all: no_option + @echo "Specify force field: GAB, 4P or E0LL2Y" .SUFFIXES: .F.f .F.o: @@ -21,7 +21,6 @@ all: unres .f.o: ${FC} ${FFLAGS} ${CPPFLAGS} $*.f - object = unres_min.o arcos.o cartprint.o chainbuild.o initialize_p.o \ matmult.o readrtns_min.o parmread.o \ pinorm.o randgens.o rescode.o intcor.o timing.o misc.o intlocal.o \ @@ -32,6 +31,8 @@ object = unres_min.o arcos.o cartprint.o chainbuild.o initialize_p.o \ MP.o printmat.o convert.o int_to_cart.o \ djacob.o gen_rand_conf.o sc_move.o refsys.o +no_option: + GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC GAB: BIN = ../../../bin/unres/MINIM/unres_ifort_MIN_single_GAB.exe @@ -41,6 +42,15 @@ GAB: ${object} ${FC} ${FFLAGS} cinfo.f ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} +4P: CPPFLAGS = -DLINUX -DPGI -DUNRES -DISNAN \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +4P: BIN = ../../../bin/unres/MINIM/unres_ifort_MIN_single_4P.exe +4P: ${object} + cc -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${object} cinfo.o ${LIBS} -o ${BIN} + E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DUNRES -DISNAN \ -DSPLITELE -DLANG0 E0LL2Y: BIN = ../../../bin/unres/MINIM/unres_ifort_MIN_single_E0LL2Y.exe diff --git a/source/wham/src-M-SAXS-homology/COMMON.CHAIN b/source/wham/src-M-SAXS-homology/COMMON.CHAIN index fcbe118..7369baa 100644 --- a/source/wham/src-M-SAXS-homology/COMMON.CHAIN +++ b/source/wham/src-M-SAXS-homology/COMMON.CHAIN @@ -1,13 +1,14 @@ integer nres,nres0,nsup,nstart_sup,nend_sup,nstart_seq, & ishift_pdb,chain_length,chain_border,ichanres,tabpermchain, & nchain ,npermchain,ireschain,iz_sc - double precision c,cref,dc,xloc,xrot,dc_norm,t,r,prod,rt, - & rmssing,anatemp + double precision c,cref,crefjlee,dc,xloc,xrot,dc_norm,t,r,prod,rt, + & rmssing,anatemp,chomo common /chain/ c(3,maxres2+2),dc(3,maxres2),xloc(3,maxres), & xrot(3,maxres),dc_norm(3,maxres2),nres,nres0 common /rotmat/ t(3,3,maxres),r(3,3,maxres),prod(3,3,maxres), & rt(3,3,maxres) - common /refstruct/ cref(3,maxres2+2),rmssing,anatemp,iz_sc,nsup, + common /refstruct/ cref(3,maxres2+2),crefjlee(3,maxres2+2), + & rmssing,anatemp,iz_sc,nsup, & nstart_sup,nend_sup,chain_length(maxchain),npermchain, & ireschain(maxres),tabpermchain(maxchain,maxperm), & chain_border(2,maxchain),nchain,nstart_seq,ishift_pdb @@ -16,4 +17,4 @@ & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick - + common /chomo_models/ chomo(3,maxres2+2,max_template) diff --git a/source/wham/src-M-SAXS-homology/COMMON.CONTROL b/source/wham/src-M-SAXS-homology/COMMON.CONTROL index 88b43f8..0c25c29 100644 --- a/source/wham/src-M-SAXS-homology/COMMON.CONTROL +++ b/source/wham/src-M-SAXS-homology/COMMON.CONTROL @@ -1,18 +1,16 @@ integer iscode,indpdb,outpdb,outmol2,icomparfunc,pdbint, - & ensembles,constr_dist,symetr,shield_mode,tor_mode,nsaxs, - & saxs_mode,homol_nset,constr_homology + & ensembles,constr_dist,symetr,shield_mode,tor_mode, + & homol_nset,constr_homology logical refstr,pdbref,punch_dist,print_rms,caonly,verbose, - & merge_helices,bxfile,cxfile,histfile,entfile,zscfile, + & merge_helices,bxfile,cxfile,histfile,entfile,zscfile,unres_pdb, & rmsrgymap,with_dihed_constr,check_conf,histout,with_theta_constr, - & energy_dec,adaptive,read2sigma,l_homo,read_homol_frag - real*8 Psaxs(maxsaxs),distsaxs(maxsaxs),CSAXS(3,maxsaxs), - & scal_rad,wsaxs0,saxs_cutoff + & energy_dec,adaptive,read2sigma,read_homol_frag, + & out_template_coord,out_template_restr common /cntrl/ iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_rms,caonly,verbose,icomparfunc,pdbint, - & merge_helices,bxfile,cxfile,histfile,entfile,zscfile,rmsrgymap, - & ensembles,with_dihed_constr,constr_dist,check_conf,histout, - & with_theta_constr, + & merge_helices,bxfile,cxfile,histfile,entfile,zscfile,unres_pdb, + & rmsrgymap,ensembles,with_dihed_constr,constr_dist,check_conf, + & histout,with_theta_constr, & constr_homology,homol_nset,read2sigma,read_homol_frag, + & out_template_coord,out_template_restr, & symetr,tor_mode,shield_mode,energy_dec,adaptive - common /saxsretr/ Psaxs,distsaxs,csaxs,Wsaxs0,scal_rad, - & saxs_cutoff,nsaxs,saxs_mode diff --git a/source/wham/src-M-SAXS-homology/COMMON.FREE b/source/wham/src-M-SAXS-homology/COMMON.FREE index 163eb58..370dcfc 100644 --- a/source/wham/src-M-SAXS-homology/COMMON.FREE +++ b/source/wham/src-M-SAXS-homology/COMMON.FREE @@ -1,11 +1,12 @@ integer nQ,nparmset,stot(maxslice),rescale_mode,iparmprint,myparm logical hamil_rep,separate_parset double precision Kh(MaxQ,MaxR,MaxT_h,max_parm), - & q0(MaxQ,MaxR,MaxT_h,max_parm),delta,deltrms,deltrgy,fimin, + & q0(MaxQ,MaxR,MaxT_h,max_parm),tole,delta,deltrms,deltrgy,fimin, & f(maxR,maxT_h,max_parm),beta_h(MaxT_h,max_parm) integer nR(maxT_h,max_parm),snk(MaxR,MaxT_h,max_parm,MaxSlice), & nT_h(max_parm),maxit,totraj(maxR,max_parm),nRR(maxT_h,max_parm) logical replica(max_parm),umbrella(max_parm),read_iset(max_parm) - common /wham/ Kh,q0,f,beta_h,delta,deltrms,deltrgy,fimin,snk,nR, + common /wham/ Kh,q0,f,beta_h,delta,tole,deltrms,deltrgy,fimin, + & snk,nR, & nRR,nT_h,nQ,stot,nparmset,maxit,rescale_mode,replica,umbrella, & read_iset,totraj,hamil_rep,separate_parset,iparmprint,myparm diff --git a/source/wham/src-M-SAXS-homology/COMMON.HOMOLOGY b/source/wham/src-M-SAXS-homology/COMMON.HOMOLOGY index 04aef39..03740bf 100644 --- a/source/wham/src-M-SAXS-homology/COMMON.HOMOLOGY +++ b/source/wham/src-M-SAXS-homology/COMMON.HOMOLOGY @@ -1,4 +1,5 @@ - integer constr_homology,homol_nset,iset,ihset + logical l_homo + integer iset,ihset real*8 waga_homology real*8 waga_dist, waga_angle, waga_theta, waga_d, dist_cut, & dist2_cut diff --git a/source/wham/src-M-SAXS-homology/COMMON.VAR b/source/wham/src-M-SAXS-homology/COMMON.VAR index 326d6ec..5141f66 100644 --- a/source/wham/src-M-SAXS-homology/COMMON.VAR +++ b/source/wham/src-M-SAXS-homology/COMMON.VAR @@ -3,12 +3,13 @@ C Store the geometric variables in the following COMMON block. double precision theta,phi,alph,omeg,vbld,vbld_ref, & theta_ref,phi_ref,alph_ref,omeg_ref, & costtab,sinttab,cost2tab,sint2tab,tauangle,omicron, - & xxtab,yytab,zztab + & xxtab,yytab,zztab, + & thetaref,phiref,xxref,yyref,zzref common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & vbld(2*maxres), + & vbld(2*maxres),thetaref(maxres),phiref(maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres), + & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar, & omicron(2,maxres),tauangle(3,maxres) C Angles from experimental structure diff --git a/source/wham/src-M-SAXS-homology/Makefile_MPICH_ifort-okeanos b/source/wham/src-M-SAXS-homology/Makefile_MPICH_ifort-okeanos index cbbec53..28f86e7 100644 --- a/source/wham/src-M-SAXS-homology/Makefile_MPICH_ifort-okeanos +++ b/source/wham/src-M-SAXS-homology/Makefile_MPICH_ifort-okeanos @@ -1,9 +1,9 @@ BIN = ~/bin FC = ftn -#OPT = -intel-static -mcmodel=medium -O3 -ip -w -#OPT = -O3 -ip -mcmodel=medium -shared-intel -dynamic +OPT = -mcmodel=medium -shared-intel -O3 -dynamic +#OPT = -O3 -intel-static -mcmodel=medium #OPT = -O3 -ip -w -OPT = -g -CB -mcmodel=medium -shared-intel -dynamic +#OPT = -g -CB -mcmodel=medium -shared-intel -dynamic FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a @@ -34,6 +34,7 @@ objects = \ icant.o \ intcor.o \ int_from_cart.o \ + refsys.o \ make_ensemble1.o \ matmult.o \ misc.o \ @@ -128,7 +129,7 @@ NEWCORR: ${objects} ${objects_compar} xdrf/libxdrf.a $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ ${LIBS} -o ${BIN}/wham_ifort_KCC_MPICH-okeanos_NEWCORR-SAXS-homology.exe -NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DPGI -DISNAN -DAMD64 -DWHAM +NEWCORR_DFA: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DNEWCORR -DCORRCD -DDFA -DPGI -DISNAN -DAMD64 -DWHAM -DDFA NEWCORR_DFA: ${objects} ${objects_compar} dfa.o xdrf/libxdrf.a gcc -o compinfo compinfo.c ./compinfo diff --git a/source/wham/src-M-SAXS-homology/conf_compar.F b/source/wham/src-M-SAXS-homology/conf_compar.F index bce364a..a23c753 100644 --- a/source/wham/src-M-SAXS-homology/conf_compar.F +++ b/source/wham/src-M-SAXS-homology/conf_compar.F @@ -147,12 +147,12 @@ c write (iout,*) "j",j," ishif",ishif," rms",rmsfrag(j,1) do while (rms.gt.rmscutfrag(1,j,1) .and. & ishiff.lt.n_shift(1,j,1)) ishiff=ishiff+1 - rms=rmscalc_frag(-ishiff,1,j,jcon,lprn) + rms=rmscalc_frag(-ishiff,1,j,jcon,ipermmin,lprn) c write(iout,*)"jcon,i,j,ishiff",jcon,i,j,-ishiff, c & " rms",rms," rmscut",rmscutfrag(1,j,1) if (lprn) write (iout,*) "rms",rmsfrag(j,1) if (rms.gt.rmscutfrag(1,j,1)) then - rms=rmscalc_frag(ishiff,1,j,jcon,lprn) + rms=rmscalc_frag(ishiff,1,j,jcon,ipermmin,lprn) c write (iout,*) "jcon,1,j,ishiff",jcon,1,j,ishiff, c & " rms",rms endif @@ -280,7 +280,7 @@ c & " rmscutfrag",rmscutfrag(1,j,i) c print *,"jcon,i,j,ishif",jcon,i,j,-ishif," rms",rms if (lprn) write (iout,*) "rms",rmsfrag(j,i) if (rms.gt.rmscutfrag(1,j,i)) then - rms=rmscalc_frag(ishif,i,j,jcon,lprn) + rms=rmscalc_frag(ishif,i,j,jcon,ipermmin,lprn) c print *,"jcon,i,j,ishif",jcon,i,j,ishif," rms",rms endif if (lprn) write (iout,*) "rms",rms diff --git a/source/wham/src-M-SAXS-homology/dfa.F b/source/wham/src-M-SAXS-homology/dfa.F index 381afa3..0ca5045 100644 --- a/source/wham/src-M-SAXS-homology/dfa.F +++ b/source/wham/src-M-SAXS-homology/dfa.F @@ -357,6 +357,7 @@ C DFA torsion angle double precision aphi(2),athe(2),tdx(5),tdy(5),tdz(5) double precision cwidth, cwidth2 PARAMETER(CWIDTH=0.1D0,CWIDTH2=0.2D0,PAI=3.14159265358979323846D0) + parameter (TENM20=1.0d-20) edfator= 0.0d0 enephi = 0.0d0 @@ -444,8 +445,8 @@ c ps_tmp = dfaexp(idint(dtmp*1000)+1) tfphi2=tfphi2+sccphi(i,j)*ddps2/cwidth*ps_tmp scc=scc+sccphi(i,j) -C write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), -C & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) +c write(*,'(2i8,8f12.6)')i,j,aphi(1),fphi1(i,j), +c & aphi(2),fphi2(i,j),tfphi1,tfphi2,ephi,sccphi(i,j) ENDDO ephi=-ephi/scc*phi_inc*wwangle @@ -646,8 +647,8 @@ c th_tmp = dfaexp ( idint(dtmp*1000)+1 ) tfthe1=tfthe1+sccthe(i,j)*ddth1/cwidth*th_tmp !-dv/dcos(the1) tfthe2=tfthe2+sccthe(i,j)*ddth2/cwidth*th_tmp !-dv/dcos(the2) scc=scc+sccthe(i,j) -C write(*,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), -C & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) +c write(2,'(2i8,8f12.6)')i,j,athe(1),fthe1(i,j), +c & athe(2),fthe2(i,j),tfthe1,tfthe2,ethe,sccthe(i,j) enddo ethe=-ethe/scc*the_inc*wwangle diff --git a/source/wham/src-M-SAXS-homology/enecalc1.F b/source/wham/src-M-SAXS-homology/enecalc1.F index 6bd06e2..69564ad 100644 --- a/source/wham/src-M-SAXS-homology/enecalc1.F +++ b/source/wham/src-M-SAXS-homology/enecalc1.F @@ -32,7 +32,7 @@ integer errmsg_count,maxerrmsg_count /100/ double precision rmsnat,gyrate external rmsnat,gyrate - double precision tole /1.0d-1/ +c double precision tole /1.0d-1/ integer i,itj,ii,iii,j,k,l,licz,ipermin integer ir,ib,ipar,iparm integer iscor,islice,scount_buff(0:99) @@ -163,8 +163,8 @@ C write (iout,*) "tuz przed energia" C write (iout,*) "tuz za energia" #ifdef DEBUG write (iout,*) "Conformation",i - write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), - & ((c(l,k+nres),l=1,3),k=nnt,nct) +c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), +c & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors(1)",ftors(1) @@ -200,19 +200,20 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0) #endif if (ipar.eq.iparm .and. einicheck.gt.0 .and. +! & dabs(eini-energia(0)-energia(27)).gt.tole) then & dabs(eini-energia(0)).gt.tole) then if (errmsg_count.le.maxerrmsg_count) then write (iout,'(2a,2e15.5,a,2i8,a,f8.1)') & "Warning: energy differs remarkably from ", - & " the value read in: ",energia(0),eini," point", +! & " the value read in: ",energia(0)+energia(27),eini," point", + & " the value read in: ",energia(0),eini," point", & iii+1,indstart(me1)+iii," T", & 1.0d0/(1.987D-3*beta_h(ib,ipar)) write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), & ((c(l,k+nres),l=1,3),k=nnt,nct) c call intout call pdbout(indstart(me1)+iii, - & 1.0d0/(1.987D-3*beta_h(ib,ipar)), - &energia(0),eini,0.0d0,0.0d0) + & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0) call enerprint(energia(0),fT) errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) @@ -260,7 +261,6 @@ c call enerprint(energia(0),fT) iii=iii+1 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) & q(1,iii)=qwolynes(0,0,ipermin) - write (iout,*) "q",(q(k,iii),k=1,nQ)," rms",q(nQ+1,iii) write (ientout,rec=iii) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), diff --git a/source/wham/src-M-SAXS-homology/energy_p_new.F b/source/wham/src-M-SAXS-homology/energy_p_new.F index d00fa84..6abf7f0 100644 --- a/source/wham/src-M-SAXS-homology/energy_p_new.F +++ b/source/wham/src-M-SAXS-homology/energy_p_new.F @@ -504,45 +504,46 @@ C Bartek edfanei = energia(30) edfabet = energia(31) #ifdef SPLITELE - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr, + write(iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1,wvdwpp, + & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), + & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3), + & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5),eel_loc, + & wel_loc*fact(2),eello_turn3,wturn3*fact(2), + & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), + & esccor,wsccor*fact(1),edihcnstr, & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc, & etube,wtube,esaxs,wsaxs,ehomology_constr, & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei, & edfabet,wdfa_beta, & etot 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, + & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ + & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ + & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ + & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/ + & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ + & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ + & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ + & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ + & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ + & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6, & ' (SS bridges & dist. cnstr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ + & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ + & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ + & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ + & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ + & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ + & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/ + & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ + & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/ + & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/ & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/ @@ -551,44 +552,45 @@ C Bartek & 'ETOT= ',1pE16.6,' (total)') #else - write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, - & estr,wbond,ebe,wang, - & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, - & ecorr,wcorr, - & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, - & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr, + write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1), + & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), + & etors_d,wtor_d*fact(2),ehpb,wstrain,ecorr,wcorr*fact(3), + & ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), + & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), + & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), + & esccor,wsccor*fact(1),edihcnstr, & ethetacnstr,ebr*nss,Uconst,wumb,eliptran,wliptran,Eafmforc, & etube,wtube,esaxs,wsaxs,ehomology_constr, & edfadis,wdfa_dist,edfator,wdfa_tor,edfanei,wdfa_nei, & edfabet,wdfa_beta, & etot 10 format (/'Virtual-chain energies:'// - & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ - & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ - & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ - & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ - & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ - & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ - & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ - & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ - & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, + & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/ + & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/ + & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/ + & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/ + & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/ + & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/ + & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/ + & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/ + & 'EHBP= ',1pE16.6,' WEIGHT=',1pE16.6, & ' (SS bridges & dist. restr.)'/ - & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ - & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ - & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ - & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ - & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ - & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ + & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/ + & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/ + & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/ + & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/ + & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/ + & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (virtual-bond dihedral angle restraints)'/ & 'ETHETC=',1pE16.6,' (virtual-bond angle restraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ - & 'UCONST=',1pE16.6,' WEIGHT=',1pD16.6' (umbrella restraints)'/ - & 'ELT= ',1pE16.6,' WEIGHT=',1pD16.6,' (Lipid transfer)'/ + & 'UCONST=',1pE16.6,' WEIGHT=',1pE16.6' (umbrella restraints)'/ + & 'ELT= ',1pE16.6,' WEIGHT=',1pE16.6,' (Lipid transfer)'/ & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ - & 'ETUBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (tube confinment)'/ - & 'E_SAXS=',1pE16.6,' WEIGHT=',1pD16.6,' (SAXS restraints)'/ + & 'ETUBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (tube confinment)'/ + & 'E_SAXS=',1pE16.6,' WEIGHT=',1pE16.6,' (SAXS restraints)'/ & 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/ & 'EDFAD= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA distance energy)'/ & 'EDFAT= ',1pE16.6,' WEIGHT=',1pE16.6,' (DFA torsion energy)'/ @@ -10302,6 +10304,7 @@ c---------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.LANGEVIN' + include 'COMMON.SAXS' c double precision Esaxs_constr integer i,iint,j,k,l @@ -10555,6 +10558,7 @@ c---------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.LANGEVIN' + include 'COMMON.SAXS' c double precision Esaxs_constr integer i,iint,j,k,l diff --git a/source/wham/src-M-SAXS-homology/initialize_p.F b/source/wham/src-M-SAXS-homology/initialize_p.F index 141bde8..baf3aa2 100644 --- a/source/wham/src-M-SAXS-homology/initialize_p.F +++ b/source/wham/src-M-SAXS-homology/initialize_p.F @@ -304,12 +304,42 @@ c------------------------------------------------------------------------- ! 15 16 17 18 19 20 21 & "WHPB ","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC", ! 22 23 24 25 26 27 28 - & "WLIPTRAN","WAFM","WTHETC","WSHIELD","WSAXS","WHOMO","WDFADIS", + & "WLIPTRAN","WAFM","WTHETC","WSHIELD","WSAXS","WHOMO","WDFAD", ! 29 30 31 - & "WDFATOR","WDFANEI","WDFABET"/ - data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0, - & 1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0, - & 0.0d0,0.0,0.0d0,0.0d0,0.0d0,0.0d0,0.0d0/ + & "WDFAT","WDFAN","WDFAB"/ + data ww0 / + 1 1.0d0, ! WSC + 2 1.0d0, ! WSCP + 3 1.0d0, ! WELEC + 4 0.0d0, ! WCORR + 5 0.0d0, ! WCORR5 + 6 0.0d0, ! WCORR6 + 7 1.0d0, ! WEL_LOC + 8 1.0d0, ! WTURN3 + 9 1.0d0, ! WTURN4 + @ 0.0d0, ! WTURN6 + 1 1.0d0, ! WANG + 2 1.0d0, ! WSCLOC + 3 1.0d0, ! WTOR + 4 1.0d0, ! WTORD + 5 1.0d0, ! WHPB + 6 1.0d0, ! WVDWPP + 7 0.4d0, ! WSCP14 + 8 1.0d0, ! WBOND + 9 1.0d0, ! WSCCOR + @ 0.0d0, ! WDIHC + 1 0.0d0, ! WSC_T + 2 0.0d0, ! WLIPTRAN + 3 0.0d0, ! WAFM + 4 0.0d0, ! WTHETC + 5 0.0d0, ! WSHIELD + 6 0.0d0, ! WSAXS + 7 0.0d0, ! WHOMO + 8 0.0d0, ! WDFADIS + 9 0.0d0, ! WDFATOR + @ 0.0d0, ! WDFANEI + 1 0.0d0 ! WDFABET + & / #ifdef DFA #if defined(SCP14) && defined(SPLITELE) data nprint_ene /31/ @@ -545,3 +575,28 @@ c------------------------------------------------------------------------------ & ' link_end_peak',link_end_peak return end +c------------------------------------------------------------------------------ + subroutine homology_partition + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.FREE' + include 'COMMON.SBRIDGE' + include 'COMMON.IOUNITS' + include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' + include 'COMMON.HOMRESTR' + include 'COMMON.INTERACT' +cd write(iout,*)"homology_partition: lim_odl=",lim_odl, +cd & " lim_dih",lim_dih + link_start_homo=1 + link_end_homo=lim_odl + idihconstr_start_homo=nnt+3 + idihconstr_end_homo=lim_dih+nnt-1+3 + write (iout,*) + & ' lim_odl',lim_odl,' link_start=',link_start_homo, + & ' link_end',link_end_homo,' lim_dih',lim_dih, + & ' idihconstr_start_homo',idihconstr_start_homo, + & ' idihconstr_end_homo',idihconstr_end_homo + return + end + diff --git a/source/wham/src-M-SAXS-homology/make_ensemble1.F b/source/wham/src-M-SAXS-homology/make_ensemble1.F index 74868c7..a07dbeb 100644 --- a/source/wham/src-M-SAXS-homology/make_ensemble1.F +++ b/source/wham/src-M-SAXS-homology/make_ensemble1.F @@ -11,6 +11,7 @@ #endif include "COMMON.IOUNITS" include "COMMON.CONTROL" + include "COMMON.HOMOLOGY" include "COMMON.FREE" include "COMMON.ENERGIES" include "COMMON.FFIELD" @@ -370,6 +371,7 @@ c write (iout,*) "qfree",qfree & ctemper(:ilen(ctemper))//"pdb" endif open(ipdb,file=pdbname) + write (iout,*) "Before reading nlist",nlist do i=1,nlist read (ientout,rec=iperm(i)) & ((csingle(l,k),l=1,3),k=1,nres), diff --git a/source/wham/src-M-SAXS-homology/molread_zs.F b/source/wham/src-M-SAXS-homology/molread_zs.F index 57acbeb..d7f586d 100644 --- a/source/wham/src-M-SAXS-homology/molread_zs.F +++ b/source/wham/src-M-SAXS-homology/molread_zs.F @@ -16,6 +16,7 @@ C include 'COMMON.SBRIDGE' include 'COMMON.TORCNSTR' include 'COMMON.CONTROL' + include 'COMMON.SAXS' character*4 sequence(maxres) integer rescode,tperm double precision x(maxvar) @@ -24,19 +25,6 @@ C logical seq_comp double precision secprob(3,maxdih_constr),phihel,phibet call card_concat(controlcard,.true.) - call reada(controlcard,'SCAL14',scal14,0.4d0) - call reada(controlcard,'SCALSCP',scalscp,1.0d0) - call reada(controlcard,'CUTOFF',cutoff_corr,7.0d0) - call reada(controlcard,'DELT_CORR',delt_corr,0.5d0) - r0_corr=cutoff_corr-delt_corr -C Bartek - call reada(controlcard,'WDFAD',wdfa_dist,0.0d0) - call reada(controlcard,'WDFAT',wdfa_tor,0.0d0) - call reada(controlcard,'WDFAN',wdfa_nei,0.0d0) - call reada(controlcard,'WDFAB',wdfa_beta,0.0d0) - write (iout,*) "wdfa_dist",wdfa_dist," wdfa_tor",wdfa_tor, - & " wdfa_nei",wdfa_nei," wdfa_beta",wdfa_beta - r0_corr=cutoff_corr-delt_corr call readi(controlcard,"NRES",nres,0) iscode=index(controlcard,"ONE_LETTER") if (nres.le.0) then @@ -105,25 +93,6 @@ C Convert sequence to numeric code if (itype(1).eq.ntyp1) nnt=2 if (itype(nres).eq.ntyp1) nct=nct-1 write(iout,*) 'NNT=',NNT,' NCT=',NCT -#ifdef DFA -C Juyong:READ init_vars -C Initialize variables! -C Juyong:READ read_info -C READ fragment information!! -C both routines should be in dfa.F file!! - - if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. - & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then - write (iout,*) "Calling init_dfa_vars" - call flush(iout) - call init_dfa_vars - write (iout,*) 'init_dfa_vars finished!' - call flush(iout) - call read_dfa_info - write (iout,*) 'read_dfa_info finished!' - call flush(iout) - endif -#endif if (with_dihed_constr) then read (inp,*) ndih_constr @@ -466,6 +435,7 @@ c------------------------------------------------------------------------------- include 'COMMON.CHAIN' include 'COMMON.IOUNITS' include 'COMMON.SBRIDGE' + include 'COMMON.SAXS' double precision cm(3) c read(inp,*) nsaxs write (iout,*) "Calling read_saxs nsaxs",nsaxs diff --git a/source/wham/src-M-SAXS-homology/openunits.F b/source/wham/src-M-SAXS-homology/openunits.F index 5ce0279..2d6fcfc 100644 --- a/source/wham/src-M-SAXS-homology/openunits.F +++ b/source/wham/src-M-SAXS-homology/openunits.F @@ -100,6 +100,8 @@ C & thetname(:ilen(thetname)) write (iout,*) "Rotamer parameter file : ", & rotname(:ilen(rotname)) + write (iout,*) "Lipid-transfer parameter file : ", + & liptranname(:ilen(liptranname)) write (iout,'(80(1h-))') write (iout,*) return diff --git a/source/wham/src-M-SAXS-homology/parmread.F b/source/wham/src-M-SAXS-homology/parmread.F index 1db4446..ecf40a7 100644 --- a/source/wham/src-M-SAXS-homology/parmread.F +++ b/source/wham/src-M-SAXS-homology/parmread.F @@ -45,7 +45,6 @@ C Body C call getenv("PRINT_PARM",lancuch) lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") - write (iout,*) "lprint ",lprint C Set LPRINT=.TRUE. for debugging dwa16=2.0d0**(1.0d0/6.0d0) itypro=20 @@ -57,8 +56,14 @@ C Assign virtual-bond length wname(4)="WCORRH" do i=1,n_ene key = wname(i)(:ilen(wname(i))) - call reada(controlcard,key(:ilen(key)),ww(i),1.0d0) + call reada(controlcard,key(:ilen(key)),ww(i),ww0(i)) + write (iout,*) i,key(:ilen(key)),ww(i) enddo + call reada(controlcard,'SCAL14',scal14,0.4d0) + call reada(controlcard,'SCALSCP',scalscp,1.0d0) + call reada(controlcard,'CUTOFF',cutoff_corr,7.0d0) + call reada(controlcard,'DELT_CORR',delt_corr,0.5d0) + r0_corr=cutoff_corr-delt_corr write (iout,*) "iparm",iparm," myparm",myparm c If reading not own parameters, skip assignment @@ -75,11 +80,6 @@ c If reading not own parameters, skip assignment call reada(controlcard,"BTRISS",btriss,0.02D0) call reada(controlcard,"CTRISS",ctriss,1.0D0) dyn_ss=(index(controlcard,'DYN_SS').gt.0) - write(iout,*) "ATRISS",atriss - write(iout,*) "BTRISS",btriss - write(iout,*) "CTRISS",ctriss - write(iout,*) "DTRISS",dtriss - C do i=1,maxres C dyn_ss_mask(i)=.false. C enddo @@ -150,15 +150,35 @@ c wliptran=ww(22) wshield=ww(25) wsaxs=ww(26) - write (iout,*) "PARMREAD: wsaxs",wsaxs - wdfa_dist=ww(23) - wdfa_tor=ww(24) - wdfa_nei=ww(25) - wdfa_beta=ww(26) - write(iout,*)"PARMREAD: wdfa_dist",wdfa_dist," wdfa_tor",wdfa_tor, - & " wdfa_nei",wdfa_nei," wdfa_beta",wdfa_beta +c write (iout,*) "PARMREAD: wsaxs",wsaxs + wdfa_dist=ww(28) + wdfa_tor=ww(29) + wdfa_nei=ww(30) + wdfa_beta=ww(31) +c write(iout,*)"PARMREAD: wdfa_dist",wdfa_dist," wdfa_tor",wdfa_tor, +c & " wdfa_nei",wdfa_nei," wdfa_beta",wdfa_beta endif +#ifdef DFA +C Juyong:READ init_vars +C Initialize variables! +C Juyong:READ read_info +C READ fragment information!! +C both routines should be in dfa.F file!! + write (iout,*) "Before initializing DFA",wdfa_dist,wdfa_tor, + & wdfa_nei,wdfa_beta + if (.not. (wdfa_dist.eq.0.0 .and. wdfa_tor.eq.0.0 .and. + & wdfa_nei.eq.0.0 .and. wdfa_beta.eq.0.0)) then + write (iout,*) "Calling init_dfa_vars" + call flush(iout) + call init_dfa_vars + write (iout,*) 'init_dfa_vars finished!' + call flush(iout) + call read_dfa_info + write (iout,*) 'read_dfa_info finished!' + call flush(iout) + endif +#endif call card_concat(controlcard,.false.) c Return if not own parameters @@ -271,15 +291,20 @@ c enddo enddo endif - write (iout,*) "iliptranpar",iliptranpar - write (iout,*) "liptranname ",liptranname +c write (iout,*) "iliptranpar",iliptranpar +c write (iout,*) "liptranname ",liptranname read(iliptranpar,*,end=1161,err=1161) pepliptran - write (iout,*) "pepliptran",pepliptran do i=1,ntyp - read(iliptranpar,*,end=1161,err=1161) liptranene(i) - write (iout,*) i,liptranene(i) + read(iliptranpar,*,end=1161,err=1161) liptranene(i) enddo rewind iliptranpar + if (lprint) then + write (iout,'(/a)') "Water-lipid transfer parameters" + write (iout,'(a3,3x,f10.5)') 'p',pepliptran + do i=1,ntyp + write (iout,'(a3,3x,f10.5)') restyp(i),liptranene(i) + enddo + endif #ifdef CRYST_THETA C C Read the parameters of the probability distribution/energy expression @@ -354,7 +379,7 @@ c do i=1,ntyp c write (iout,'(a3,i4,2x,5(1pe14.5))') restyp(i),i,theta0(i), c & sig0(i),(gthet(j,i),j=1,3) c enddo - write (iout,'(a)') + write (iout,'(/a)') & 'Parameters of the virtual-bond valence angles:' write (iout,'(/a/9x,5a/79(1h-))') & 'Coefficients of expansion', @@ -560,7 +585,7 @@ C here will be the apropriate recalibrating for D-aminoacid enddo enddo if (lprint) then - write (iout,'(a)') + write (iout,'(/a)') & "Parameters of the valence-only potentials" do i=-nthetyp+1,nthetyp-1 write (iout,'(2a)') "Type ",toronelet(i) @@ -1298,7 +1323,7 @@ c AL 4/8/16: Calculate coefficients from one-body parameters do i=-ntyp1,ntyp1 itortyp(i)=itype2loc(i) enddo - write (iout,*) + if (lprint) write (iout,*) &"Val-tor parameters calculated from cumulant coefficients ntortyp" & ,ntortyp do i=-ntortyp+1,ntortyp-1 @@ -1336,7 +1361,7 @@ cf(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(t if (tor_mode.gt.0 .and. lprint) then c Print valence-torsional parameters - write (iout,'(a)') + write (iout,'(/a)') & "Parameters of the valence-torsional potentials" do i=-ntortyp+1,ntortyp-1 do j=-ntortyp+1,ntortyp-1 @@ -1479,10 +1504,8 @@ C bpp (i,j)=-2.0D0*epp(i,j)*rri ael6(i,j)=elpp6(i,j)*4.2D0**6 ael3(i,j)=elpp3(i,j)*4.2D0**3 - lprint=.true. if (lprint) write(iout,'(2i3,4(1pe15.4))')i,j,app(i,j),bpp(i,j), & ael6(i,j),ael3(i,j) - lprint=.false. enddo enddo C @@ -1534,7 +1557,7 @@ C---------------------- GB or BP potential ----------------------------- do i=1,ntyp read (isidep,*,end=117,err=117)(epslip(i,j),j=i,ntyp) C write(iout,*) "WARNING!!",i,ntyp - write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) + if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) C do j=1,ntyp C epslip(i,j)=epslip(i,j)+0.05d0 C enddo @@ -1695,7 +1718,7 @@ C enddo if (lprint) then - write (iout,*) "Parameters of SC-p interactions:" + write (iout,'(/a)') "Parameters of SC-p interactions:" do i=1,20 write (iout,'(4f8.3,4e12.4)') eps_scp(i,1),rscp(i,1), & eps_scp(i,2),rscp(i,2),aad(i,1),bad(i,1),aad(i,2),bad(i,2) @@ -1723,7 +1746,8 @@ C AKCT = 12.0d0 C V1SS =-1.08d0 C V2SS = 7.61d0 C V3SS = 13.7d0 - write (iout,*) dyn_ss,'dyndyn' + if (dyn_ss) + & write (iout,*) 'Dynamic formation/breaking of disulfides' if (dyn_ss) then ss_depth=ebr/wsc-0.25*eps(1,1) C write(iout,*) akcm,whpb,wsc,'KURWA' @@ -1740,12 +1764,19 @@ C write(iout,*) akcm,whpb,wsc,'KURWA' endif C if (lprint) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss + if (lprint) then + write (iout,'(/a)') "Disulfide bridge parameters:" + write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr + write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm + write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct + write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, + & ' v3ss:',v3ss + write (iout,'(a)') "Parameters of the 'trisulfide' potential" + write(iout,*) "ATRISS",atriss + write(iout,*) "BTRISS",btriss + write(iout,*) "CTRISS",ctriss + write(iout,*) "DTRISS",dtriss + endif C endif if (shield_mode.gt.0) then pi=3.141592d0 diff --git a/source/wham/src-M-SAXS-homology/read_constr_homology.F b/source/wham/src-M-SAXS-homology/read_constr_homology.F index 2ed24e7..ebd23a9 100644 --- a/source/wham/src-M-SAXS-homology/read_constr_homology.F +++ b/source/wham/src-M-SAXS-homology/read_constr_homology.F @@ -34,7 +34,7 @@ c & sigma_odl_temp(maxres,maxres,max_template) logical lprn /.true./ integer ilen external ilen - logical unres_pdb,liiflag + logical liiflag c c FP - Nov. 2014 Temporary specifications for new vars c @@ -63,12 +63,12 @@ c Alternative: reading from input if (homol_nset.gt.1)then call card_concat(controlcard,.true.) read(controlcard,*) (waga_homology(i),i=1,homol_nset) - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then - write(iout,*) "iset homology_weight " +c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then +c write(iout,*) "iset homology_weight " c do i=1,homol_nset c write(iout,*) i,waga_homology(i) c enddo - endif +c endif iset=mod(kolor,homol_nset)+1 else iset=1 @@ -141,7 +141,13 @@ c tpl_k_rescore="template"//kic2//".sco" unres_pdb=.false. - call readpdb + if (read2sigma) then + call readpdb_template(k) + else + call readpdb + endif + +c call readpdb do i=1,2*nres do j=1,3 crefjlee(j,i)=c(j,i) @@ -152,9 +158,9 @@ c write (iout,'(i5,3f8.3,5x,3f8.3)') i,(crefjlee(j,i),j=1,3), & (crefjlee(j,i+nres),j=1,3) enddo -#endif write (iout,*) "read_constr_homology: after reading pdb file" call flush(iout) +#endif c c Distance restraints @@ -411,7 +417,7 @@ c Print restraints c if (.not.lprn) return cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d - if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then +c if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then write (iout,*) "Distance restraints from templates" do ii=1,lim_odl write(iout,'(3i5,100(2f8.2,1x,l1,4x))') @@ -437,7 +443,7 @@ cd write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d & (xxtpl(ki,i),yytpl(ki,i),zztpl(ki,i), & 1.0d0/dsqrt(sigma_d(ki,i)),ki=1,constr_homology) enddo - endif +c endif c ----------------------------------------------------------------- return end @@ -452,6 +458,7 @@ c---------------------------------------------------------------------- #endif include 'COMMON.SETUP' include 'COMMON.CONTROL' + include 'COMMON.HOMOLOGY' include 'COMMON.CHAIN' include 'COMMON.IOUNITS' include 'COMMON.GEO' @@ -470,7 +477,7 @@ c---------------------------------------------------------------------- logical lprn /.true./ integer ilen external ilen - logical unres_pdb,liiflag + logical liiflag c c double precision rescore_tmp,x12,y12,z12,rescore2_tmp @@ -483,7 +490,6 @@ c For new homol impl c include 'COMMON.VAR' c - double precision chomo(3,maxres2+2,max_template) call getenv("FRAGFILE",fragfile) open(ientin,file=fragfile,status="old",err=10) read(ientin,*) constr_homology,nclust @@ -503,12 +509,12 @@ c Read pdb files stop 34 continue unres_pdb=.false. - call readpdb - do i=1,2*nres - do j=1,3 - chomo(j,i,k)=c(j,i) - enddo - enddo + call readpdb_template(k) +c do i=1,2*nres +c do j=1,3 +c chomo(j,i,k)=c(j,i) +c enddo +c enddo do i=1,nres rescore(k,i)=0.2d0 rescore2(k,i)=1.0d0 @@ -698,7 +704,12 @@ c enddo enddo endif - +#ifdef DEBUG + write (iout,*) "ires_homo and jres_homo arrays, lim_odl",lim_odl + do i=1,lim_odl + write (iout,*) i,ires_homo(i),jres_homo(i) + enddo +#endif return - 10 stop "Error infragment file" + 10 stop "Error in fragment file" end diff --git a/source/wham/src-M-SAXS-homology/readrtns.F b/source/wham/src-M-SAXS-homology/readrtns.F index dc24d53..84a366f 100644 --- a/source/wham/src-M-SAXS-homology/readrtns.F +++ b/source/wham/src-M-SAXS-homology/readrtns.F @@ -20,6 +20,7 @@ include "COMMON.SPLITELE" include "COMMON.SBRIDGE" include "COMMON.SHIELD" + include "COMMON.SAXS" character*800 controlcard integer i,j,k,ii,n_ene_found integer ind,itype1,itype2,itypf,itypsc,itypp @@ -79,6 +80,7 @@ energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) if (index(controlcard,"CLASSIFY").gt.0) indpdb=1 call reada(controlcard,"DELTA",delta,1.0d-2) + call reada(controlcard,"TOLE",tole,1.0d-1) call readi(controlcard,"EINICHECK",einicheck,2) call reada(controlcard,"DELTRMS",deltrms,5.0d-2) call reada(controlcard,"DELTRGY",deltrgy,5.0d-2) @@ -95,6 +97,7 @@ c Cutoff range for interactions call reada(controlcard,"LAMBDA",rlamb,0.3d0) call reada(controlcard,"LIPTHICK",lipthick,0.0d0) call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0) + unres_pdb = index(controlcard,'UNRES_PDB') .gt. 0 if (lipthick.gt.0.0d0) then bordliptop=(boxzsize+lipthick)/2.0 bordlipbot=bordliptop-lipthick @@ -153,10 +156,14 @@ C enddo call readi(controlcard,'CONSTR_DIST',constr_dist,0) call readi(controlcard,'CONSTR_HOMOL',constr_homology,0) +c if (constr_homology) tole=dmax1(tole,1.5d0) write (iout,*) "with_homology_constr ",with_dihed_constr, & " CONSTR_HOMOLOGY",constr_homology read_homol_frag = index(controlcard,"READ_HOMOL_FRAG").gt.0 - + out_template_coord = index(controlcard,"OUT_TEMPLATE_COORD").gt.0 + out_template_restr = index(controlcard,"OUT_TEMPLATE_RESTR").gt.0 + write (iout,*) "out_template_coord ",OUT_TEMPLATE_COORD + write (iout,*) "out_template_restr",OUT_TEMPLATE_RESTR dyn_ss=index(controlcard,"DYN_SS").gt.0 adaptive = index(controlcard,"ADAPTIVE").gt.0 call readi(controlcard,'NSAXS',nsaxs,0) diff --git a/source/wham/src-M-SAXS-homology/wham_calc1.F b/source/wham/src-M-SAXS-homology/wham_calc1.F index 37ab7b0..31de33e 100644 --- a/source/wham/src-M-SAXS-homology/wham_calc1.F +++ b/source/wham/src-M-SAXS-homology/wham_calc1.F @@ -31,6 +31,7 @@ c parameter (MaxHdim=200) include "COMMON.IOUNITS" include "COMMON.FREE" include "COMMON.ENERGIES" + include "COMMON.HOMOLOGY" include "COMMON.FFIELD" include "COMMON.SBRIDGE" include "COMMON.PROT" @@ -233,12 +234,10 @@ c potEmin=potEmin_t/2 #endif c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet -#define DEBUG #ifdef DEBUG write (iout,'(2i5,21f8.2)') i,iparm, & (enetb(k,i,iparm),k=1,22) #endif -#undef DEBUG call restore_parm(iparm) #ifdef DEBUG write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc, @@ -293,7 +292,6 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft endif evdw=enetb(1,i,iparm) evdw_t=enetb(21,i,iparm) - write (iout,*) "evdw",evdw," evdw_t",evdw_t #ifdef SCP14 evdw2_14=enetb(17,i,iparm) evdw2=enetb(2,i,iparm)+evdw2_14 @@ -1391,6 +1389,7 @@ c-------------------------------------------------------------------- include 'COMMON.FFIELD' include "COMMON.SBRIDGE" include 'COMMON.ENERGIES' + include "COMMON.HOMOLOGY" include "COMMON.IOUNITS" integer t,iparm double precision fT(6),fTprim(6),fTbis(6), @@ -1398,7 +1397,7 @@ c-------------------------------------------------------------------- double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, & escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor, - & eliptran,esaxs + & eliptran,esaxs,ehomology_constr,edfadis,edfator,edfanei,edfabet evdw=enetb(21,t,iparm) evdw_t=enetb(1,t,iparm) #ifdef SCP14 @@ -1432,11 +1431,11 @@ c-------------------------------------------------------------------- edihcnstr=enetb(20,t,iparm) eliptran=enetb(22,t,iparm) esaxs=enetb(26,t,iparm) - ehomology_constr=enetb(27,i,iparm) - edfadis=enetb(28,i,iparm) - edfator=enetb(29,i,iparm) - edfanei=enetb(30,i,iparm) - edfabet=enetb(31,i,iparm) + ehomology_constr=enetb(27,t,iparm) + edfadis=enetb(28,t,iparm) + edfator=enetb(29,t,iparm) + edfanei=enetb(30,t,iparm) + edfabet=enetb(31,t,iparm) #ifdef SPLITELE if (shield_mode.gt.0) then etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 diff --git a/source/wham/src-M-SAXS-homology/wham_multparm.F b/source/wham/src-M-SAXS-homology/wham_multparm.F index a3a862f..fd62f05 100644 --- a/source/wham/src-M-SAXS-homology/wham_multparm.F +++ b/source/wham/src-M-SAXS-homology/wham_multparm.F @@ -54,13 +54,15 @@ c NaNQ initialization call initialize call openunits call cinfo + write (iout,*) "calling read_general_data" call read_general_data(*10) -c write (iout,*) "read_general_data" -c call flush(iout) + write (iout,*) "read_general_data" + call flush(iout) + write (iout,*) "calling molread" call molread(*10) -c write (iout,*) "molread" -c call flush(iout) -c write (iout,*) "MAIN: constr_dist",constr_dist + write (iout,*) "molread" + call flush(iout) + write (iout,*) "MAIN: constr_dist",constr_dist if (constr_dist.gt.0) call read_dist_constr #ifdef MPI c write (iout,*) "Calling proc_groups" @@ -69,16 +71,16 @@ c write (iout,*) "proc_groups exited" c call flush(iout) #endif do ipar=1,nParmSet -c write (iout,*) "Calling parmread",ipar + write (iout,*) "Calling parmread",ipar call parmread(ipar,*10) if (.not.separate_parset) then call store_parm(ipar) -c write (iout,*) "Finished storing parameters",ipar + write (iout,*) "Finished storing parameters",ipar else if (ipar.eq.myparm) then call store_parm(1) -c write (iout,*) "Finished storing parameters",ipar + write (iout,*) "Finished storing parameters",ipar endif -c call flush(iout) + call flush(iout) enddo call read_efree(*10) if (adaptive) call PMFread diff --git a/source/wham/src-M/CMakeLists.txt b/source/wham/src-M/CMakeLists.txt index c788207..678a85f 100644 --- a/source/wham/src-M/CMakeLists.txt +++ b/source/wham/src-M/CMakeLists.txt @@ -61,6 +61,7 @@ set(UNRES_WHAM_M_SRC0 proc_cont.f define_pairs.f mysort.f + ssMD.F ) set(UNRES_WHAM_M_PP_SRC @@ -96,9 +97,11 @@ set(UNRES_WHAM_M_PP_SRC # Set comipiler flags for different sourcefiles #================================================ if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-g -CB -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres -I${MPIF_INCLUDE_DIRECTORIES}" ) + set(FFLAGS0 "-g -CB -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 "-std=legacy -g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres -I${MPIF_INCLUDE_DIRECTORIES}" ) + set(FFLAGS0 "-std=legacy -g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) +else () + set(FFLAGS0 "-g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") @@ -106,16 +109,31 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags #========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_WHAM_M_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) #========================================= -# WHAM preprocesor flags +# Settings for GAB force field #========================================= +if(UNRES_MD_FF STREQUAL "GAB" ) + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) -set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) + +#========================================= +# Settings for E0LL2Y force field +#========================================= +elseif(UNRES_MD_FF STREQUAL "E0LL2Y") + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DSCCORPDB" ) +endif(UNRES_MD_FF STREQUAL "GAB") + +#========================================= +# Additional flags +#========================================= +set(CPPFLAGS "${CPPFLAGS} -DUNRES -DISNAN") #========================================= # System specific flags @@ -137,6 +155,9 @@ elseif (Fortran_COMPILER_NAME STREQUAL "f95") elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") # Add old gfortran flags set(CPPFLAGS "${CPPFLAGS} -DG77") +else (Fortran_COMPILER_NAME STREQUAL "ifort") + # Default preprocessor flags + set(CPPFLAGS "${CPPFLAGS} -DPGI") endif (Fortran_COMPILER_NAME STREQUAL "ifort") #========================================= @@ -160,7 +181,7 @@ set_property(SOURCE ${UNRES_WHAM_M_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLA #======================================== # Setting binary name #======================================== -set(UNRES_WHAM_M_BIN "wham_${Fortran_COMPILER_NAME}.exe") +set(UNRES_WHAM_M_BIN "wham_M_${Fortran_COMPILER_NAME}_${UNRES_MD_FF}.exe") #========================================= # cinfo.f workaround for CMake @@ -204,18 +225,24 @@ set(UNRES_WHAM_M_SRCS ${UNRES_WHAM_M_SRC0} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f p #========================================= add_executable(UNRES_WHAM_M_BIN ${UNRES_WHAM_M_SRCS} ) set_target_properties(UNRES_WHAM_M_BIN PROPERTIES OUTPUT_NAME ${UNRES_WHAM_M_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_WHAM_M_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= # Link libraries #========================================= # link MPI library (libmpich.a) -target_link_libraries( UNRES_WHAM_M_BIN ${MPIF_LIBRARIES} ) +target_link_libraries( UNRES_WHAM_M_BIN ${MPI_Fortran_LIBRARIES} ) # link libxdrf.a target_link_libraries( UNRES_WHAM_M_BIN xdrf ) + +#========================================= +# Install Path +#========================================= +install(TARGETS UNRES_WHAM_M_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}/wham) + + #========================================= # TESTS #========================================= diff --git a/source/wham/src-M/COMMON.ALLPARM b/source/wham/src-M/COMMON.ALLPARM index ba107a6..71d6784 100644 --- a/source/wham/src-M/COMMON.ALLPARM +++ b/source/wham/src-M/COMMON.ALLPARM @@ -3,73 +3,108 @@ & vbldsc0_all(maxbondterm,ntyp,max_parm), & aksc_all(maxbondterm,ntyp,max_parm), & abond0_all(maxbondterm,ntyp,max_parm), - & a0thet_all(ntyp,max_parm),athet_all(2,ntyp,max_parm), - & bthet_all(2,ntyp,max_parm),polthet_all(0:3,ntyp,max_parm), - & gthet_all(3,ntyp,max_parm),theta0_all(ntyp,max_parm), - & sig0_all(ntyp,max_parm),sigc0_all(ntyp,max_parm), - & aa0thet_all(maxthetyp1,maxthetyp1,maxthetyp1,max_parm), - & aathet_all(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1,max_parm), - & bbthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), - & ccthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), - & ddthet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), - & eethet_all(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), - & ffthet_all(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), - & ggthet_all(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1,max_parm), + & a0thet_all(-ntyp:ntyp,max_parm), + & athet_all(2,-ntyp:ntyp,-1:1,-1:1,max_parm), + & bthet_all(2,-ntyp:ntyp,-1:1,-1:1,max_parm), + & polthet_all(0:3,-ntyp:ntyp,max_parm), + & gthet_all(3,-ntyp:ntyp,max_parm),theta0_all(-ntyp:ntyp,max_parm), + & sig0_all(-ntyp:ntyp,max_parm),sigc0_all(-ntyp:ntyp,max_parm), + & aa0thet_all(-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,2,max_parm), + & aathet_all(maxtheterm,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm), + & bbthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2,max_parm), + & ccthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,2,max_parm), + & ddthet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,2,max_parm), + & eethet_all(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,2,max_parm), + & ffthet_all1(maxdouble,maxdouble,maxtheterm3, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,max_parm), + & ggthet_all1(maxdouble,maxdouble,maxtheterm3, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,max_parm), + & ffthet_all2(maxdouble,maxdouble,maxtheterm3, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,max_parm), + & ggthet_all2(maxdouble,maxdouble,maxtheterm3, + & -maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1, + & -maxthetyp1:maxthetyp1,max_parm), & dsc_all(ntyp1,max_parm),bsc_all(maxlob,ntyp,max_parm), - & censc_all(3,maxlob,ntyp,max_parm), - & gaussc_all(3,3,maxlob,ntyp,max_parm),dsc0_all(ntyp1,max_parm), + & censc_all(3,maxlob,-ntyp:ntyp,max_parm), + & gaussc_all(3,3,maxlob,-ntyp:ntyp,max_parm), + & dsc0_all(ntyp1,max_parm), & sc_parmin_all(65,ntyp,max_parm), - & v0_all(maxtor,maxtor,max_parm), - & v1_all(maxterm,maxtor,maxtor,max_parm), - & v2_all(maxterm,maxtor,maxtor,max_parm), + & v0_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm), + & v1_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm), + & v2_all(maxterm,-maxtor:maxtor,-maxtor:maxtor,2,max_parm), & vlor1_all(maxlor,maxtor,maxtor,max_parm), & vlor2_all(maxlor,maxtor,maxtor,max_parm), & vlor3_all(maxlor,maxtor,maxtor,max_parm), - & v1c_all(2,maxtermd_1,maxtor,maxtor,maxtor,max_parm), - & v1s_all(2,maxtermd_1,maxtor,maxtor,maxtor,max_parm), - & v2c_all(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor,max_parm), - & v2s_all(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor,max_parm), - & b1_all(2,maxtor,max_parm),b2_all(2,maxtor,max_parm), - & cc_all(2,2,maxtor,max_parm),dd_all(2,2,maxtor,max_parm), - & ee_all(2,2,maxtor,max_parm),ctilde_all(2,2,maxtor,max_parm), - & dtilde_all(2,2,maxtor,max_parm),b1tilde_all(2,maxtor,max_parm), + & v1c_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2,max_parm), + & v1s_all(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2,max_parm), + & v2c_all(maxtermd_2,maxtermd_2,-maxtor:maxtor, + & -maxtor:maxtor,-maxtor:maxtor,2,max_parm), + & v2s_all(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2,max_parm), + & b_all(5,-maxtor:maxtor,max_parm), + & ccold_all(2,2,-maxtor:maxtor,max_parm), + & ddold_all(2,2,-maxtor:maxtor,max_parm), + & eeold_all(2,2,-maxtor:maxtor,max_parm), + & bnew1_all(3,2,-maxtor:maxtor,max_parm), + & bnew2_all(3,2,-maxtor:maxtor,max_parm), + & ccnew_all(3,2,-maxtor:maxtor,max_parm), + & ddnew_all(3,2,-maxtor:maxtor,max_parm), + & eenew_all(2,2,2,-maxtor:maxtor,max_parm), + & e0new_all(2,-maxtor:maxtor,max_parm), & app_all(2,2,max_parm),bpp_all(2,2,max_parm), & ael6_all(2,2,max_parm),ael3_all(2,2,max_parm), & aad_all(ntyp,2,max_parm),bad_all(ntyp,2,max_parm), - & aa_all(ntyp,ntyp,max_parm),bb_all(ntyp,ntyp,max_parm), + & aa_aq_all(ntyp,ntyp,max_parm),bb_aq_all(ntyp,ntyp,max_parm), + & aa_lip_all(ntyp,ntyp,max_parm),bb_lip_all(ntyp,ntyp,max_parm), & augm_all(ntyp,ntyp,max_parm),eps_all(ntyp,ntyp,max_parm), + & epslip_all(ntyp,ntyp,max_parm), & sigma_all(ntyp,ntyp,max_parm),r0_all(ntyp,ntyp,max_parm), & chi_all(ntyp,ntyp,max_parm),chip_all(ntyp,max_parm), & alp_all(ntyp,max_parm),ebr_all(max_parm),d0cm_all(max_parm), & akcm_all(max_parm),akth_all(max_parm),akct_all(max_parm), & v1ss_all(max_parm),v2ss_all(max_parm),v3ss_all(max_parm), - & v1sccor_all(maxterm_sccor,ntyp,ntyp,max_parm), - & v2sccor_all(maxterm_sccor,ntyp,ntyp,max_parm) - integer nlob_all(ntyp1,max_parm),nlor_all(maxtor,maxtor,max_parm), - & nterm_all(maxtor,maxtor,max_parm), - & ntermd1_all(maxtor,maxtor,maxtor,max_parm), - & ntermd2_all(maxtor,maxtor,maxtor,max_parm), + & v1sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm), + & v2sccor_all(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp,max_parm) + integer nlob_all(ntyp1,max_parm), + & nlor_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm), + & nterm_all(-maxtor:maxtor,-maxtor:maxtor,2,max_parm), + & ntermd1_all(-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2,max_parm), + & ntermd2_all(-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2,max_parm), & nbondterm_all(ntyp,max_parm),nthetyp_all(max_parm), - & ithetyp_all(ntyp1,max_parm),ntheterm_all(max_parm), + & ithetyp_all(-ntyp1:ntyp1,max_parm),ntheterm_all(max_parm), & ntheterm2_all(max_parm),ntheterm3_all(max_parm), & nsingle_all(max_parm),ndouble_all(max_parm), - & nntheterm_all(max_parm),nterm_sccor_all(max_parm) + & nntheterm_all(max_parm), + &nterm_sccor_all(-ntyp:ntyp,-ntyp:ntyp,max_parm) common /allparm/ ww_all,vbldp0_all,akp_all,vbldsc0_all,aksc_all, & abond0_all,aa0thet_all,aathet_all,bbthet_all,ccthet_all, - & ddthet_all,eethet_all,ffthet_all,ggthet_all, + & ddthet_all,eethet_all,ffthet_all1,ggthet_all1, + & ffthet_all2,ggthet_all2, & a0thet_all,athet_all,bthet_all,polthet_all,gthet_all,theta0_all, & sig0_all,sigc0_all,dsc_all,bsc_all,censc_all,gaussc_all,dsc0_all, & sc_parmin_all, & v0_all,v1_all,v2_all,vlor1_all,vlor2_all,vlor3_all,v1c_all, - & v1s_all,v2c_all,v2s_all,b1_all,b2_all,cc_all,dd_all,ee_all, - & ctilde_all,dtilde_all,b1tilde_all,app_all,bpp_all,ael6_all, - & ael3_all,aad_all,bad_all,aa_all,bb_all,augm_all, + & v1s_all,v2c_all,v2s_all,b_all,ccold_all,ddold_all,eeold_all, + & bnew1_all,bnew2_all,ccnew_all,ddnew_all,eenew_all,e0new_all, + & app_all,bpp_all,ael6_all, + & ael3_all,aad_all,bad_all,aa_aq_all,bb_aq_all,augm_all, + & aa_lip_all,bb_lip_all,epslip_all, & eps_all,sigma_all,r0_all,chi_all,chip_all,alp_all,ebr_all, & d0cm_all,akcm_all,akth_all,akct_all,v1ss_all,v2ss_all,v3ss_all, & v1sccor_all,v2sccor_all,nbondterm_all, diff --git a/source/wham/src-M/COMMON.CHAIN b/source/wham/src-M/COMMON.CHAIN index 8dcdd98..24b8c56 100644 --- a/source/wham/src-M/COMMON.CHAIN +++ b/source/wham/src-M/COMMON.CHAIN @@ -12,3 +12,9 @@ &nsup,nstart_sup,anatemp, &nend_sup,chain_length,tabperm(maxperm,maxsym),nperm, & nstart_seq,ishift_pdb + double precision boxxsize,boxysize,boxzsize,enecut,sscut,sss, + &sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick + common /box/ boxxsize,boxysize,boxzsize,enecut,sscut,sss,sssgrad, + & buflipbot, bufliptop,bordlipbot,bordliptop,lipbufthick,lipthick + diff --git a/source/wham/src-M/COMMON.CONTROL b/source/wham/src-M/COMMON.CONTROL index 6c87389..a41cd91 100644 --- a/source/wham/src-M/COMMON.CONTROL +++ b/source/wham/src-M/COMMON.CONTROL @@ -1,10 +1,12 @@ integer iscode,indpdb,outpdb,outmol2,icomparfunc,pdbint, - & ensembles,constr_dist,symetr + & ensembles,constr_dist,symetr,shield_mode,tor_mode logical refstr,pdbref,punch_dist,print_rms,caonly,verbose, & merge_helices,bxfile,cxfile,histfile,entfile,zscfile, - & rmsrgymap,with_dihed_constr,check_conf,histout + & rmsrgymap,with_dihed_constr,check_conf,histout,with_theta_constr, + & energy_dec,adaptive common /cntrl/ iscode,indpdb,refstr,pdbref,outpdb,outmol2, & punch_dist,print_rms,caonly,verbose,icomparfunc,pdbint, & merge_helices,bxfile,cxfile,histfile,entfile,zscfile,rmsrgymap, & ensembles,with_dihed_constr,constr_dist,check_conf,histout, - &symetr + & with_theta_constr, + &symetr,tor_mode,shield_mode,energy_dec,adaptive diff --git a/source/wham/src-M/COMMON.IOUNITS b/source/wham/src-M/COMMON.IOUNITS index 23783bb..188d55e 100644 --- a/source/wham/src-M/COMMON.IOUNITS +++ b/source/wham/src-M/COMMON.IOUNITS @@ -10,11 +10,12 @@ C----------------------------------------------------------------------- C General I/O units & files integer inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep,irotam, & itorp,itordp,ifourier,ielep,isidep,iscpp,isccor,icbase, - & istat,ientin,ientout,isidep1,ibond,ihist,izsc,idistr + & istat,ientin,ientout,isidep1,ibond,ihist,izsc,idistr, + & iliptranpar common /iounits/ inp,iout,igeom,intin,ipdb,imol2,ipdbin,ithep, & irotam,itorp,itordp,ifourier,ielep,isidep,iscpp,isccor, & icbase,istat,ientin,ientout,isidep1,ibond,ihist,izsc, - & idistr + & idistr,iliptranpar character*256 outname,intname,pdbname,mol2name,statname,intinname, & entname,restartname,prefix,scratchdir,sidepname,pdbfile, & histname,zscname @@ -23,9 +24,11 @@ C General I/O units & files & sidepname,pdbfile,histname,zscname C Parameter files character*256 bondname,thetname,rotname,torname,tordname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & liptranname common /parfiles/ thetname,rotname,torname,tordname,bondname, - & fouriername,elename,sidename,scpname,sccorname,patname + & fouriername,elename,sidename,scpname,sccorname,patname, + & liptranname character*3 pot C----------------------------------------------------------------------- C INP - main input file diff --git a/source/wham/src-M/COMMON.VAR b/source/wham/src-M/COMMON.VAR index ad412d0..326d6ec 100644 --- a/source/wham/src-M/COMMON.VAR +++ b/source/wham/src-M/COMMON.VAR @@ -2,14 +2,15 @@ C Store the geometric variables in the following COMMON block. integer ntheta,nphi,nside,nvar,ialph,ivar double precision theta,phi,alph,omeg,vbld,vbld_ref, & theta_ref,phi_ref,alph_ref,omeg_ref, - & costtab,sinttab,cost2tab,sint2tab, + & costtab,sinttab,cost2tab,sint2tab,tauangle,omicron, & xxtab,yytab,zztab common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), & vbld(2*maxres), & costtab(maxres), sinttab(maxres), cost2tab(maxres), & sint2tab(maxres),xxtab(maxres),yytab(maxres), & zztab(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar + & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar, + & omicron(2,maxres),tauangle(3,maxres) C Angles from experimental structure common /varref/ vbld_ref(maxres), & theta_ref(maxres),phi_ref(maxres), diff --git a/source/wham/src-M/DIMENSIONS b/source/wham/src-M/DIMENSIONS index c41916e..72c8963 100644 --- a/source/wham/src-M/DIMENSIONS +++ b/source/wham/src-M/DIMENSIONS @@ -14,13 +14,14 @@ c parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres c parameter (maxres=250) - parameter (maxres=100) + parameter (maxres=1600) C Appr. max. number of interaction sites integer maxres2 parameter (maxres2=2*maxres) C Max number of symetries integer maxsym,maxperm - parameter (maxsym=5,maxperm=120) + parameter (maxsym=12,maxperm=120) +c parameter (maxsym=1,maxperm=1) C Max. number of variables integer maxvar parameter (maxvar=4*maxres) @@ -31,24 +32,32 @@ C Max. number of derivatives of virtual-bond and side-chain vectors in theta C or phi. integer maxdim parameter (maxdim=(maxres-1)*(maxres-2)/2) +c parameter (maxdim=10000) C Max. number of SC contacts integer maxcont parameter (maxcont=12*maxres) +c parameter (maxcont=4*maxres) C Max. number of contacts per residue integer maxconts parameter (maxconts=maxres) +c parameter (maxconts=10) C Number of AA types (at present only natural AA's will be handled integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) + parameter (ntyp=24,ntyp1=ntyp+1) integer nntyp parameter (nntyp=ntyp*(ntyp+1)/2) C Max. number of types of dihedral angles & multiplicity of torsional barriers C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 + integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2,maxtor_kcc, + & maxval_kcc parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) + parameter (maxtor_kcc=6,maxval_kcc=6) +c Max number of new valence-angle (only) terms + integer maxang_kcc + parameter (maxang_kcc=36) c Max number of torsional terms in SCCOR integer maxterm_sccor - parameter (maxterm_sccor=3) + parameter (maxterm_sccor=6) C Max. number of residue types and parameters in expressions for C virtual-bond angle bending potentials integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, diff --git a/source/wham/src-M/DIMENSIONS.FREE b/source/wham/src-M/DIMENSIONS.FREE index 691d9b2..7a397d9 100644 --- a/source/wham/src-M/DIMENSIONS.FREE +++ b/source/wham/src-M/DIMENSIONS.FREE @@ -1,11 +1,12 @@ integer Max_Parm integer MaxQ,MaxQ1 - integer MaxR,MaxT_h + integer MaxR,MaxT_h,maxHdim integer MaxSlice - parameter (Max_Parm=1) - parameter (MaxQ=1,MaxQ1=MaxQ+2) - parameter(MaxR=1,MaxT_h=32) + parameter (Max_Parm=5) + parameter (MaxQ=4,MaxQ1=MaxQ+2) + parameter(MaxR=8,MaxT_h=36) parameter(MaxSlice=40) + parameter(maxHdim=200) integer MaxN parameter (MaxN=100) integer MaxPrintConf diff --git a/source/wham/src-M/DIMENSIONS.ZSCOPT b/source/wham/src-M/DIMENSIONS.ZSCOPT index 2f5ee76..7f31d7f 100644 --- a/source/wham/src-M/DIMENSIONS.ZSCOPT +++ b/source/wham/src-M/DIMENSIONS.ZSCOPT @@ -3,10 +3,10 @@ c Maximum number of structures in the database, energy components, proteins, c and structural classes c#ifdef JUBL - parameter (maxstr=200000,max_ene=21,maxprot=7,maxclass=5000) + parameter (maxstr=200000,max_ene=25,maxprot=7,maxclass=10) parameter (maxclass1=10) c Maximum number of structures to be dealt with by one processor - parameter (maxstr_proc=10000) + parameter (maxstr_proc=20000) c Maximum number of temperatures integer maxT parameter (maxT=10) @@ -25,7 +25,7 @@ c Maximum number of grid points in energy map evaluation parameter (max_x=200,max_y=200,max_minim=1000) c Maximum number of processors integer MaxProcs - parameter (MaxProcs = 2048) + parameter (MaxProcs = 128) c Maximum number of optimizable parameters integer max_paropt parameter (max_paropt=500) diff --git a/source/wham/src-M/Makefile b/source/wham/src-M/Makefile index 7018157..ee054bf 120000 --- a/source/wham/src-M/Makefile +++ b/source/wham/src-M/Makefile @@ -1 +1 @@ -Makefile-ifort-MPICH \ No newline at end of file +Makefile_MPICH_ifort-okeanos \ No newline at end of file diff --git a/source/wham/src-M/Makefile-ifort-MPICH b/source/wham/src-M/Makefile-ifort-MPICH deleted file mode 100644 index 61ae4e2..0000000 --- a/source/wham/src-M/Makefile-ifort-MPICH +++ /dev/null @@ -1,82 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN = /users/adam/unres/bin/wham -FC= ifort -OPT = -mcmodel=medium -O3 -ip -w -#OPT = -mcmodel=medium -g -CA -CB -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - gnmr1.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - read_dist_constr.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - permut.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -GAB: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH-M-GAB.exe - -E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 -E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH-M-E0LL2Y.exe - -xdrf/libxdrf.a: - cd xdrf && make - - -clean: - /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean - diff --git a/source/wham/src-M/Makefile-pgi b/source/wham/src-M/Makefile-pgi deleted file mode 100644 index 40cc442..0000000 --- a/source/wham/src-M/Makefile-pgi +++ /dev/null @@ -1,74 +0,0 @@ -BIN = /users/adam/ZSCOREZ/bin -CC = cc -FC = mpif90 -#FC = ifc -OPT = -fast -pc 64 -tp p6 -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -FFLAGS = ${OPT} -c -I. -I./include_unres -LIBS = -L../../MEY_MD/src_Tc/xdrf -lxdrf -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} -Wl,-Bstatic ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-T-sccor - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile1_jump b/source/wham/src-M/Makefile1_jump deleted file mode 100644 index 1df1586..0000000 --- a/source/wham/src-M/Makefile1_jump +++ /dev/null @@ -1,60 +0,0 @@ -BIN = ../bin -CC = cc -FC = mpxlf90 -qfixed -w -OPT = -q64 -FFLAGS = -c ${OPT} -O3 -I./include_unres -LIBS = xdrf/libxdrf.o xdrf/ftocstr.o -CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm1-T-procor - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile1_matrix b/source/wham/src-M/Makefile1_matrix deleted file mode 100644 index d05b4cf..0000000 --- a/source/wham/src-M/Makefile1_matrix +++ /dev/null @@ -1,73 +0,0 @@ -INSTALL_DIR = /usr/local/mpich-1.2.7p1_pgi64-6.2-3_ssh -BIN = ./ -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I../src_MD -I/users/adam/UNRES/NEW/src -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I../src_MD -I/users/adam/UNRES/NEW/src -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -I. -I/users/adam/ZSCOREZ/src_MD -I/users/adam/UNRES/NEW/src -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} -Wl,-Bstatic ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm1-OPTERON-T__ - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_jubl b/source/wham/src-M/Makefile_jubl deleted file mode 100644 index 5f37ee7..0000000 --- a/source/wham/src-M/Makefile_jubl +++ /dev/null @@ -1,95 +0,0 @@ -CPPFLAGS = -WF,-DOLD_GINV \ - -WF,-DUNRES -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DISNAN \ - -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -WF,-DJUBL -#-WF,-DNOXDR -#-WF,-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc -FC = /usr/bin/blrts_xlf90 -#-pg -g - -# try -qarch=440 first, then use -qarch=440d for 2nd FPU later on -# (SIMDization requires at least -O3) -# use -qlist -qsource with 440d and look for Parallel ASM instructions. -# -OPT= -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -qfixed -w -qnosave -CFLAGS= -O3 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -FFLAGS= -c -O3 ${OPT} -I./include_unres -# -LIBS_MPI = -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts -LIBSF_MPI = -lmpich.rts -lfmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts - -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/wham_multparm-T-procor.rts -LIBS = ${LIBSF_MPI} ../src_Tc/xdrf/libxdrf.a -#LIBS = ${LIBSF_MPI} - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objects = \ - wham_multparm.o \ - cxread.o \ - enecalc.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - store_parm.o \ - timing.o \ - wham_calc.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - - -unresCSA: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objects} ${objects_compar} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_jump b/source/wham/src-M/Makefile_jump deleted file mode 100644 index e79c218..0000000 --- a/source/wham/src-M/Makefile_jump +++ /dev/null @@ -1,69 +0,0 @@ -BIN = ../bin -CC = cc -CFLAGS = -DAIX -c -FC = mpxlf90 -qlistopt -qfixed -w -OPT = -q64 -FFLAGS = -c ${OPT} -O3 -I./include_unres -#FFLAGS = -c ${OPT} -g -C -I./include_unres -LIBS = xdrf/libxdrf.o xdrf/ftocstr.o -CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -.SUFFIXES: .c -.c.o: - ${CC} ${CFLAGS} $*.c - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-T-procor-c1 - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix b/source/wham/src-M/Makefile_matrix deleted file mode 100644 index d16bc8c..0000000 --- a/source/wham/src-M/Makefile_matrix +++ /dev/null @@ -1,67 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN = ../bin -FC= ifort -#OPT = -mcmodel=medium -O3 -ip -w -OPT = -mcmodel=medium -g -CB -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_multparm-ham_rep - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix-oldparm b/source/wham/src-M/Makefile_matrix-oldparm deleted file mode 100644 index 11aac6c..0000000 --- a/source/wham/src-M/Makefile_matrix-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN = ../bin -CC = cc -FC = ifort -#OPT = -O3 -ip -w -OPT = -g -CB -FFLAGS = -c ${OPT} -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = -c -g -C -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - gnmr1.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - read_dist_constr.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o permut.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-D-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix_PGI b/source/wham/src-M/Makefile_matrix_PGI deleted file mode 100644 index 362d3b2..0000000 --- a/source/wham/src-M/Makefile_matrix_PGI +++ /dev/null @@ -1,77 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -#OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -C -g -OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - gnmr1.f \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ - ${LIBS} -o ${BIN}/wham_multparm-hamrep-sep-D - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix_PGI-SCT-oldparm b/source/wham/src-M/Makefile_matrix_PGI-SCT-oldparm deleted file mode 100644 index 82001ca..0000000 --- a/source/wham/src-M/Makefile_matrix_PGI-SCT-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCT -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ - ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCT-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix_PGI-SCTF-oldparm b/source/wham/src-M/Makefile_matrix_PGI-SCTF-oldparm deleted file mode 100644 index 66ebf03..0000000 --- a/source/wham/src-M/Makefile_matrix_PGI-SCTF-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCTH -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} -Bstatic_pgi cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCTF-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/Makefile_matrix_PGI-oldparm b/source/wham/src-M/Makefile_matrix_PGI-oldparm deleted file mode 100644 index 8b6756c..0000000 --- a/source/wham/src-M/Makefile_matrix_PGI-oldparm +++ /dev/null @@ -1,77 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - gnmr1.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -Bstatic -o ${BIN}/wham_multparm-OPTERON-D-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src-M/arcos.f b/source/wham/src-M/arcos.f index 69810ea..afc6724 100644 --- a/source/wham/src-M/arcos.f +++ b/source/wham/src-M/arcos.f @@ -2,7 +2,7 @@ implicit real*8 (a-h,o-z) include 'COMMON.GEO' IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=0.5D0*(PI+DSIGN(1.0D0,X)*PI) + ARCOS=0.5D0*(PI-DSIGN(1.0D0,X)*PI) RETURN 1 ARCOS=DACOS(X) RETURN diff --git a/source/wham/src-M/cartder.f b/source/wham/src-M/cartder.f index ed14f18..693fd60 100644 --- a/source/wham/src-M/cartder.f +++ b/source/wham/src-M/cartder.f @@ -263,7 +263,7 @@ cd print '(3f8.3)',(dcdv(k,ind1),k=1,3) * Derivatives in alpha and omega: * do i=2,nres-1 - dsci=dsc(itype(i)) + dsci=dsc(iabs(itype(i))) alphi=alph(i) omegi=omeg(i) cd print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi diff --git a/source/wham/src-M/contact.f b/source/wham/src-M/contact.f index 40ed61d..91de1d4 100644 --- a/source/wham/src-M/contact.f +++ b/source/wham/src-M/contact.f @@ -29,10 +29,10 @@ endif 110 format (a,'(',i3,')',9f8.3) do i=ist,ien-kkk - iti=itype(i) + iti=iabs(itype(i)) if (iti.le.0 .or. iti.gt.ntyp) cycle do j=i+kkk,ien - itj=itype(j) + itj=iabs(itype(j)) if (itj.le.0 .or. itj.gt.ntyp) cycle itypi=iti itypj=itj @@ -94,7 +94,7 @@ c & csc it2=itype(i2) write (iout,'(i3,2x,a,i4,2x,a,i4,5f8.3,3f10.5)') & i,restyp(it1),i1,restyp(it2),i2,cscore(i), - & sc_cutoff(it1,it2),ddsc(i),ddla(i),ddlb(i), + & sc_cutoff(iabs(it1),iabs(it2)),ddsc(i),ddla(i),ddlb(i), & omt1(i),omt2(i),omt12(i) enddo endif diff --git a/source/wham/src-M/cxread.F b/source/wham/src-M/cxread.F index 7bb2f6a..82d05c2 100644 --- a/source/wham/src-M/cxread.F +++ b/source/wham/src-M/cxread.F @@ -30,8 +30,11 @@ double precision ts(MaxSlice),te(MaxSlice),time_slice integer slice logical conf_check + write (iout,*) "cxread" + call flush(iout) call set_slices(is,ie,ts,te,iR,ib,iparm) - + write (iout,*) "after set_slices" + call flush(iout) do i=1,nQ rprop(i)=0.0d0 enddo @@ -58,13 +61,20 @@ c print *,"bumbum" c print *,"rtime",rtime," iret",iret call xdrffloat_(ixdrf, rpotE, iret) c write (iout,*) "rpotE",rpotE," iret",iret - call flush(iout) +c call flush(iout) call xdrffloat_(ixdrf, ruconst, iret) call xdrffloat_(ixdrf, rt_bath, iret) call xdrfint_(ixdrf, nss, iret) do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j), iret) + call xdrfint(ixdrf, jdssb(j), iret) + idssb(j)=idssb(j)-nres + jdssb(j)=jdssb(j)-nres + else + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nprop, iret) if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) @@ -76,13 +86,20 @@ c write (iout,*) "rpotE",rpotE," iret",iret call xdrffloat(ixdrf, rtime, iret) call xdrffloat(ixdrf, rpotE, iret) c write (iout,*) "rpotE",rpotE," iret",iret - call flush(iout) +c call flush(iout) call xdrffloat(ixdrf, ruconst, iret) call xdrffloat(ixdrf, rt_bath, iret) call xdrfint(ixdrf, nss, iret) +c write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss +c call flush(iout) do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j), iret) + call xdrfint(ixdrf, jdssb(j), iret) + else + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nprop, iret) c write (iout,*) "nprop",nprop @@ -160,9 +177,21 @@ c call flush(iout) ii=ii+1 kk(islice)=kk(islice)+1 mm(islice)=mm(islice)+1 +#ifdef DEBUG + write (iout,*) "islice",islice," ii",ii," kk",kk(islice), + & " mm",mm(islice) + write (iout,*) "itraj",itraj," nstep",nstep(itraj), + & " isampl",isampl(iparm) + call flush(iout) +#endif if (mod(nstep(itraj),isampl(iparm)).eq.0 .and. & conf_check(ll(islice)+1,1)) then if (replica(iparm)) then + if (rt_bath.eq.0.0d0) then + write (iout,*) "ERROR: zero temperature", + & islice,kk(islice),mm(islice) + call flush(iout) + endif rt_bath=1.0d0/(rt_bath*1.987D-3) do i=1,nT_h(iparm) if (abs(real(beta_h(i,iparm))-rt_bath).lt.1.0e-4) then @@ -206,13 +235,15 @@ c call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) write (iout,*) "ntraj",ntraj," itraj",itraj, & " nstep",nstep(itraj) write (iout,*) "pote",rpotE," time",rtime + write (iout,*) "nss",nss + write (iout,*) (ihpb(k),jhpb(k),k=1,nss) c if (replica(iparm)) then c write (iout,*) "TEMP",1.0d0/(rt_bath*1.987D-3) c write (iout,*) "TEMP list" c write (iout,*) c & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) c endif - write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ +c write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ c write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss c write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 call flush(iout) diff --git a/source/wham/src-M/elecont.f b/source/wham/src-M/elecont.f index 5de56cb..720f860 100644 --- a/source/wham/src-M/elecont.f +++ b/source/wham/src-M/elecont.f @@ -14,11 +14,12 @@ double precision rri,xi,yi,zi,dxi,dyi,dzi,xmedi,ymedi,zmedi, & xj,yj,zj,dxj,dyj,dzj,aaa,bbb,ael6i,ael3i,rrmij,rmij,r3ij,r6ij, & vrmij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,evdwij,el1,el2, - & eesij,ees,evdw,ene + & eesij,ees,evdw,ene, rij,zj_temp,xj_temp,yj_temp, + & sscale,sscagrad,dist_temp,xj_safe,yj_safe,zj_safe,dist_init double precision elpp6c(2,2),elpp3c(2,2),ael6c(2,2),ael3c(2,2), & appc(2,2),bppc(2,2) double precision elcutoff,elecutoff_14 - integer ncont,icont(2,maxcont) + integer ncont,icont(2,maxcont),xshift,yshift,zshift,isubchap double precision econt(maxcont) * * Load the constants of peptide bond - peptide bond interactions. @@ -59,6 +60,12 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ xmedi=xi+0.5*dxi ymedi=yi+0.5*dyi zmedi=zi+0.5*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize do 4 j=i+2,ien-1 ind=ind+1 iteli=itel(i) @@ -73,9 +80,49 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ dxj=c(1,j+1)-c(1,j) dyj=c(2,j+1)-c(2,j) dzj=c(3,j+1)-c(3,j) - xj=c(1,j)+0.5*dxj-xmedi - yj=c(2,j)+0.5*dyj-ymedi - zj=c(3,j)+0.5*dzj-zmedi + xj=c(1,j)+0.5*dxj + yj=c(2,j)+0.5*dyj + zj=c(3,j)+0.5*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) rrmij=1.0/(xj*xj+yj*yj+zj*zj) rmij=sqrt(rrmij) r3ij=rrmij*rmij @@ -101,7 +148,7 @@ c data rpp / 4.5088d0, 4.5395d0, 4.5395d0, 4.4846d0/ econt(ncont)=eesij endif ees=ees+eesij - evdw=evdw+evdwij + evdw=evdw+evdwij*sss 4 continue 1 continue if (lprint) then diff --git a/source/wham/src-M/enecalc1.F b/source/wham/src-M/enecalc1.F index 5ce2fff..77cecc2 100644 --- a/source/wham/src-M/enecalc1.F +++ b/source/wham/src-M/enecalc1.F @@ -35,7 +35,7 @@ double precision tole /1.0d-1/ integer i,itj,ii,iii,j,k,l,licz integer ir,ib,ipar,iparm - integer iscor,islice + integer iscor,islice,scount_buff(0:99) real*4 csingle(3,maxres2) double precision energ double precision temp @@ -51,7 +51,8 @@ iii=0 ii=0 errmsg_count=0 - write (iout,*) "enecalc: nparmset ",nparmset +c write (iout,*) "enecalc: nparmset ",nparmset +c write (iout,*) "enecalc: tormode ",tor_mode #ifdef MPI do iparm=1,nParmSet do ib=1,nT_h(iparm) @@ -60,6 +61,8 @@ enddo enddo enddo + write (iout,*) "indstart(me1),indend(me1)" + &,indstart(me1),indend(me1) do i=indstart(me1),indend(me1) #else do iparm=1,nParmSet @@ -71,6 +74,7 @@ enddo do i=1,ntot #endif + read(ientout,rec=i,err=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), @@ -154,19 +158,23 @@ c & " kfac",kfac,"quot",quot," fT",fT & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc, & wtor_d,wsccor,wbond #endif +C write (iout,*) "tuz przed energia" call etotal(energia(0),fT) +C write (iout,*) "tuz za energia" +#define DEBUG #ifdef DEBUG - write (iout,*) "Conformation",i - write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) - write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) +c write (iout,*) "Conformation",i +c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), +c & ((c(l,k+nres),l=1,3),k=nnt,nct) call enerprint(energia(0),fT) - write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) - write (iout,*) "ftors",ftors - call briefout(i,energia(0)) - temp=1.0d0/(beta_h(ib,ipar)*1.987D-3) - write (iout,*) "temp", temp - call pdbout(i,temp,energia(0),energia(0),0.0d0,0.0d0) +c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) +c write (iout,*) "ftors(1)",ftors(1) +c call briefout(i,energia(0)) +c temp=1.0d0/(beta_h(ib,ipar)*1.987D-3) +c write (iout,*) "temp", temp +c call pdbout(i,temp,energia(0),energia(0),0.0d0,0.0d0) #endif +#undef DEBUG if (energia(0).ge.1.0d20) then write (iout,*) "NaNs detected in some of the energy", & " components for conformation",ii+1 @@ -201,6 +209,13 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) & " the value read in: ",energia(0),eini," point", & iii+1,indstart(me1)+iii," T", & 1.0d0/(1.987D-3*beta_h(ib,ipar)) + write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) +c call intout + call pdbout(indstart(me1)+iii, + & 1.0d0/(1.987D-3*beta_h(ib,ipar)), + &energia(0),eini,0.0d0,0.0d0) + call enerprint(energia(0),fT) errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) & write (iout,*) "Too many warning messages" @@ -215,8 +230,9 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) endif endif endif +C write (iout,*) "Czy tu dochodze" potE(iii+1,iparm)=energia(0) - do k=1,21 + do k=1,22 enetb(k,iii+1,iparm)=energia(k) enddo #ifdef DEBUG @@ -250,6 +266,7 @@ c call enerprint(energia(0),fT) & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar + write (iout,*) "q",(q(k,iii),k=1,nQ)," rms",q(nQ+1,iii) c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree #ifdef MPI if (separate_parset) then @@ -265,12 +282,15 @@ c & " snk",snk_p(iR,ib,ipar) 121 continue enddo #ifdef MPI - scount(me)=iii - write (iout,*) "Me",me," scount",scount(me) + scount_buff(me)=iii + write (iout,*) "Me",me," scount_buff",scount_buff(me) call flush(iout) c Master gathers updated numbers of conformations written by all procs. - call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1, +c call MPI_AllGather(MPI_IN_PLACE,1,MPI_DATATYPE_NULL,scount(0),1, +c & MPI_INTEGER, WHAM_COMM, IERROR) + call MPI_AllGather( scount_buff(me), 1, MPI_INTEGER, scount(0), 1, & MPI_INTEGER, WHAM_COMM, IERROR) + indstart(0)=1 indend(0)=scount(0) do i=1, Nprocs-1 @@ -342,6 +362,7 @@ c------------------------------------------------------------------------------ include "COMMON.ENERGIES" include "COMMON.COMPAR" include "COMMON.PROT" + include "COMMON.CONTACTS1" character*64 nazwa character*80 bxname,cxname character*64 bprotfile_temp @@ -355,7 +376,8 @@ c------------------------------------------------------------------------------ double precision energ integer ilen,iroof external ilen,iroof - integer ir,ib,iparm + integer ir,ib,iparm, scount_buff(0:99) + integer isecstr(maxres) write (licz2,'(bz,i2.2)') islice call opentmp(islice,ientout,bprotfile_temp) write (iout,*) "bprotfile_temp ",bprotfile_temp @@ -454,8 +476,12 @@ c write (iout,*) iR,ib,iparm,eini,efree iscore=0 c write (iout,*) "Calling conf_compar",i c call flush(iout) + anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3) if (indpdb.gt.0) then call conf_compar(i,.false.,.true.) +c else +c call elecont(.false.,ncont,icont,nnt,nct) +c call secondary2(.false.,.false.,ncont,icont,isecstr) endif c write (iout,*) "Exit conf_compar",i c call flush(iout) @@ -655,8 +681,13 @@ c write (iout,*) "xdrf3dfcoord" c call flush(iout) call xdrfint_(ixdrf, nss, iret) do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint_(ixdrf, ihpb(j), iret) + call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrffloat_(ixdrf,real(eini),iret) call xdrffloat_(ixdrf,real(efree),iret) @@ -667,8 +698,13 @@ c call flush(iout) call xdrfint(ixdrf, nss, iret) do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j)+nres, iret) + call xdrfint(ixdrf, jdssb(j)+nres, iret) + else + call xdrfint(ixdrf, ihpb(j), iret) + call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrffloat(ixdrf,real(eini),iret) call xdrffloat(ixdrf,real(efree),iret) @@ -706,14 +742,14 @@ c------------------------------------------------------------------------------ include "COMMON.CONTROL" include "COMMON.TORCNSTR" integer j,k,l,ii,itj,iprint - if (.not.check_conf) then - conf_check=.true. - return - endif +c if (.not.check_conf) then +c conf_check=.true. +c return +c endif call int_from_cart1(.false.) do j=nnt+1,nct - if (itype(j-1).ne.21 .and. itype(j).ne.21 .and. - & (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0)) then + if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and. + & (vbld(j).lt.2.0d0 .or. vbld(j).gt.6.5d0)) then if (iprint.gt.0) & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j), & " for conformation",ii @@ -737,8 +773,8 @@ c------------------------------------------------------------------------------ enddo do j=nnt,nct itj=itype(j) - if (itype(j).ne.10 .and.itype(j).ne.21 .and. - & (vbld(nres+j)-dsc(itj)).gt.2.0d0) then + if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and. + & (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0) then if (iprint.gt.0) & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j), & " for conformation",ii diff --git a/source/wham/src-M/energy_p_new.F b/source/wham/src-M/energy_p_new.F index fcc52c0..5296188 100644 --- a/source/wham/src-M/energy_p_new.F +++ b/source/wham/src-M/energy_p_new.F @@ -12,18 +12,17 @@ cMS$ATTRIBUTES C :: proc_proc include 'COMMON.IOUNITS' double precision energia(0:max_ene),energia1(0:max_ene+1) -#ifdef MPL - include 'COMMON.INFO' - external d_vadd - integer ready -#endif include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' double precision fact(6) -cd write(iout, '(a,i2)')'Calling etotal ipot=',ipot +c write(iout, '(a,i2)')'Calling etotal ipot=',ipot +c call flush(iout) cd print *,'nnt=',nnt,' nct=',nct C C Compute the side-chain and electrostatic interaction energy @@ -44,11 +43,20 @@ C Gay-Berne potential (shifted LJ, angular dependence). goto 106 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). 105 call egbv(evdw,evdw_t) +C write(iout,*) 'po elektostatyce' C C Calculate electrostatic (H-bonding) energy of the main chain. C - 106 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) -C + 106 continue + call vec_and_deriv + if (shield_mode.eq.1) then + call set_shield_fac + else if (shield_mode.eq.2) then + call set_shield_fac2 + endif + call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) +C write(iout,*) 'po eelec' + C Calculate excluded-volume interaction energy between peptide groups C and side chains. C @@ -56,8 +64,9 @@ C c c Calculate the bond-stretching energy c + call ebond(estr) -c write (iout,*) "estr",estr +C write (iout,*) "estr",estr C C Calculate the disulfide-bridge and other energy and the contributions C from other distance constraints. @@ -67,26 +76,60 @@ cd print *,'EHPB exitted succesfully.' C C Calculate the virtual-bond-angle energy. C - call ebend(ebe) +C print *,'Bend energy finished.' + if (wang.gt.0d0) then + if (tor_mode.eq.0) then + call ebend(ebe) + else +C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call ebend_kcc(ebe) + endif + else + ebe=0.0d0 + endif + ethetacnstr=0.0d0 + if (with_theta_constr) call etheta_constr(ethetacnstr) +c call ebend(ebe,ethetacnstr) cd print *,'Bend energy finished.' C C Calculate the SC local energy. C call esc(escloc) -cd print *,'SCLOC energy finished.' +C print *,'SCLOC energy finished.' C C Calculate the virtual-bond torsional energy. C -cd print *,'nterm=',nterm - call etor(etors,edihcnstr,fact(1)) + if (wtor.gt.0.0d0) then + if (tor_mode.eq.0) then + call etor(etors,fact(1)) + else +C etor kcc is Kubo cumulant clustered rigorous attemp to derive the +C energy function + call etor_kcc(etors,fact(1)) + endif + else + etors=0.0d0 + endif + edihcnstr=0.0d0 + if (ndih_constr.gt.0) call etor_constr(edihcnstr) +c print *,"Processor",myrank," computed Utor" C C 6/23/01 Calculate double-torsional energy C - call etor_d(etors_d,fact(2)) -C -C 21/5/07 Calculate local sicdechain correlation energy + if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then + call etor_d(etors_d,fact(2)) + else + etors_d=0 + endif +c print *,"Processor",myrank," computed Utord" C call eback_sc_corr(esccor) + + if (wliptran.gt.0) then + call Eliptransfer(eliptran) + endif + C C 12/1/95 Multi-body terms C @@ -94,33 +137,66 @@ C n_corr1=0 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 & .or. wturn6.gt.0.0d0) then -c print *,"calling multibody_eello" +c write(iout,*)"calling multibody_eello" call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) -c write (*,*) 'n_corr=',n_corr,' n_corr1=',n_corr1 -c print *,ecorr,ecorr5,ecorr6,eturn6 +c write (iout,*) 'n_corr=',n_corr,' n_corr1=',n_corr1 +c write (iout,*) ecorr,ecorr5,ecorr6,eturn6 + else + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eturn6=0.0d0 endif if (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) then +c write (iout,*) "Calling multibody_hbond" call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) endif c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t #ifdef SPLITELE + if (shield_mode.gt.0) then + etot=fact(1)*wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2 + & +welec*fact(1)*ees + & +fact(1)*wvdwpp*evdw1 + & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 + & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 + & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + else etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees & +wvdwpp*evdw1 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + endif #else + if (shield_mode.gt.0) then + etot=fact(1)wsc*(evdw+fact(6)*evdw_t)+fact(1)*wscp*evdw2 + & +welec*fact(1)*(ees+evdw1) + & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 + & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 + & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + else etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2 & +welec*fact(1)*(ees+evdw1) & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d - & +wbond*estr+wsccor*fact(1)*esccor + & +wbond*estr+wsccor*fact(1)*esccor+ethetacnstr + & +wliptran*eliptran + endif #endif energia(0)=etot energia(1)=evdw @@ -154,6 +230,8 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t energia(19)=esccor energia(20)=edihcnstr energia(21)=evdw_t + energia(24)=ethetacnstr + energia(22)=eliptran c detecting NaNQ #ifdef ISNAN #ifdef AIX @@ -173,6 +251,9 @@ c detecting NaNQ #ifdef MPL c endif #endif +#ifdef DEBUG + call enerprint(energia,fact) +#endif if (calc_grad) then C C Sum up the components of the Cartesian gradient. @@ -180,6 +261,7 @@ C #ifdef SPLITELE do i=1,nct do j=1,3 + if (shield_mode.eq.0) then gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*fact(1)*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ & wbond*gradb(j,i)+ @@ -192,14 +274,57 @@ C & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ & wsccor*fact(2)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + else + gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i) + & +fact(1)*wscp*gvdwc_scp(j,i)+ + & welec*fact(1)*gelc(j,i)+fact(1)*wvdwpp*gvdwpp(j,i)+ + & wbond*gradb(j,i)+ + & wstrain*ghpbc(j,i)+ + & wcorr*fact(3)*gradcorr(j,i)+ + & wel_loc*fact(2)*gel_loc(j,i)+ + & wturn3*fact(2)*gcorr3_turn(j,i)+ + & wturn4*fact(3)*gcorr4_turn(j,i)+ + & wcorr5*fact(4)*gradcorr5(j,i)+ + & wcorr6*fact(5)*gradcorr6(j,i)+ + & wturn6*fact(5)*gcorr6_turn(j,i)+ + & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + + gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i) + & +fact(1)*wscp*gradx_scp(j,i)+ + & wbond*gradbx(j,i)+ + & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ + & wsccor*fact(2)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + & +welec*gshieldx(j,i) + & +wcorr*gshieldx_ec(j,i) + & +wturn3*gshieldx_t3(j,i) + & +wturn4*gshieldx_t4(j,i) + & +wel_loc*gshieldx_ll(j,i) + + + endif enddo #else do i=1,nct do j=1,3 + if (shield_mode.eq.0) then gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+ & wbond*gradb(j,i)+ @@ -211,10 +336,50 @@ C & wcorr6*fact(5)*gradcorr6(j,i)+ & wturn6*fact(5)*gcorr6_turn(j,i)+ & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ & wbond*gradbx(j,i)+ & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ & wsccor*fact(1)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + else + gradc(j,i,icg)=fact(1)*wsc*gvdwc(j,i)+ + & fact(1)*wscp*gvdwc_scp(j,i)+ + & welec*fact(1)*gelc(j,i)+wstrain*ghpbc(j,i)+ + & wbond*gradb(j,i)+ + & wcorr*fact(3)*gradcorr(j,i)+ + & wel_loc*fact(2)*gel_loc(j,i)+ + & wturn3*fact(2)*gcorr3_turn(j,i)+ + & wturn4*fact(3)*gcorr4_turn(j,i)+ + & wcorr5*fact(4)*gradcorr5(j,i)+ + & wcorr6*fact(5)*gradcorr6(j,i)+ + & wturn6*fact(5)*gcorr6_turn(j,i)+ + & wsccor*fact(2)*gsccorc(j,i) + & +wliptran*gliptranc(j,i) + & +welec*gshieldc(j,i) + & +welec*gshieldc_loc(j,i) + & +wcorr*gshieldc_ec(j,i) + & +wcorr*gshieldc_loc_ec(j,i) + & +wturn3*gshieldc_t3(j,i) + & +wturn3*gshieldc_loc_t3(j,i) + & +wturn4*gshieldc_t4(j,i) + & +wturn4*gshieldc_loc_t4(j,i) + & +wel_loc*gshieldc_ll(j,i) + & +wel_loc*gshieldc_loc_ll(j,i) + + gradx(j,i,icg)=fact(1)*wsc*gvdwx(j,i)+ + & fact(1)*wscp*gradx_scp(j,i)+ + & wbond*gradbx(j,i)+ + & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ + & wsccor*fact(1)*gsccorx(j,i) + & +wliptran*gliptranx(j,i) + & +welec*gshieldx(j,i) + & +wcorr*gshieldx_ec(j,i) + & +wturn3*gshieldx_t3(j,i) + & +wturn4*gshieldx_t4(j,i) + & +wel_loc*gshieldx_ll(j,i) + + endif enddo #endif enddo @@ -228,9 +393,11 @@ C & +wturn3*fact(2)*gel_loc_turn3(i) & +wturn6*fact(5)*gel_loc_turn6(i) & +wel_loc*fact(2)*gel_loc_loc(i) - & +wsccor*fact(1)*gsccor_loc(i) +c & +wsccor*fact(1)*gsccor_loc(i) +c BYLA ROZNICA Z CLUSTER< OSTATNIA LINIA DODANA enddo endif + if (dyn_ss) call dyn_set_nss return end C------------------------------------------------------------------------ @@ -241,6 +408,7 @@ C------------------------------------------------------------------------ include 'COMMON.IOUNITS' include 'COMMON.FFIELD' include 'COMMON.SBRIDGE' + include 'COMMON.CONTROL' double precision energia(0:max_ene),fact(6) etot=energia(0) evdw=energia(1)+fact(6)*energia(21) @@ -268,7 +436,20 @@ C------------------------------------------------------------------------ esccor=energia(19) edihcnstr=energia(20) estr=energia(18) + ethetacnstr=energia(24) + eliptran=energia(22) #ifdef SPLITELE + if (shield_mode.gt.0) then + write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(1),ees, + & welec*fact(1),evdw1,wvdwpp*fact(1), + & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), + & etors_d,wtor_d*fact(2),ehpb,wstrain, + & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), + & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), + & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), + & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss, + & eliptran,wliptran,etot + else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),evdw1, & wvdwpp, & estr,wbond,ebe,wang,escloc,wscloc,etors,wtor*fact(1), @@ -276,7 +457,9 @@ C------------------------------------------------------------------------ & ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4),ecorr6,wcorr6*fact(5), & eel_loc,wel_loc*fact(2),eello_turn3,wturn3*fact(2), & eello_turn4,wturn4*fact(3),eello_turn6,wturn6*fact(5), - & esccor,wsccor*fact(1),edihcnstr,ebr*nss,etot + & esccor,wsccor*fact(1),edihcnstr,ethetacnstr,ebr*nss, + & eliptran,wliptran,etot + endif 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -298,16 +481,29 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ & 'ETOT= ',1pE16.6,' (total)') #else + if (shield_mode.gt.0) then + write (iout,10) evdw,wsc*fact(1),evdw2,wscp*fact(2),ees, + & welec*fact(1),estr,wbond, + & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2, + & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4), + & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), + & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), + & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, + & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot + else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec*fact(1),estr,wbond, & ebe,wang,escloc,wscloc,etors,wtor*fact(1),etors_d,wtor_d*fact2, & ehpb,wstrain,ecorr,wcorr*fact(3),ecorr5,wcorr5*fact(4), & ecorr6,wcorr6*fact(5),eel_loc,wel_loc*fact(2), & eello_turn3,wturn3*fact(2),eello_turn4,wturn4*fact(3), & eello_turn6,wturn6*fact(5),esccor*fact(1),wsccor, - & edihcnstr,ebr*nss,etot + & edihcnstr,ethetacnstr,ebr*nss,eliptran,wliptran,etot + endif 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ @@ -328,7 +524,9 @@ C------------------------------------------------------------------------ & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ + & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ + & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -360,17 +558,20 @@ C integer icant external icant cd print *,'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon +c ROZNICA z cluster do i=1,210 do j=1,2 eneps_temp(j,i)=0.0d0 enddo enddo +cROZNICA + evdw=0.0D0 evdw_t=0.0d0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -383,8 +584,8 @@ C cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -394,19 +595,22 @@ C Change 12/1/95 to calculate four-body interactions c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e1+e2 ij=icant(itypi,itypj) +c ROZNICA z cluster eneps_temp(1,ij)=eneps_temp(1,ij)+e1/dabs(eps0ij) eneps_temp(2,ij)=eneps_temp(2,ij)+e2/eps0ij +c + cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - if (bb(itypi,itypj).gt.0.0d0) then + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij @@ -541,9 +745,9 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 evdw_t=0.0d0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -552,8 +756,8 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi @@ -564,8 +768,8 @@ C rij=1.0D0/r_inv_ij r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) fac=r_shift_inv**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=e_augm+e1+e2 ij=icant(itypi,itypj) eneps_temp(1,ij)=eneps_temp(1,ij)+(e1+a_augm) @@ -578,7 +782,7 @@ cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, cd & (c(k,i),k=1,3),(c(k,j),k=1,3) - if (bb(itypi,itypj).gt.0.0d0) then + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij @@ -654,9 +858,9 @@ c else c endif ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -670,8 +874,8 @@ C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -710,8 +914,8 @@ C Calculate the angle-dependent terms of energy & contributions to derivatives. C Calculate whole angle-dependent part of epsilon and contributions C to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -721,15 +925,15 @@ C to its derivatives eneps_temp(1,ij)=eneps_temp(1,ij)+e1*aux & /dabs(eps(itypi,itypj)) eneps_temp(2,ij)=eneps_temp(2,ij)+e2*aux/eps(itypi,itypj) - if (bb(itypi,itypj).gt.0.0d0) then + if (bb.gt.0.0d0) then evdw=evdw+evdwij else evdw_t=evdw_t+evdwij endif if (calc_grad) then if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa write (iout,'(2(a3,i3,2x),15(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, & epsi,sigm,chi1,chi2,chip1,chip2, @@ -766,6 +970,7 @@ C include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include "DIMENSIONS.COMPAR" + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -776,9 +981,10 @@ C include 'COMMON.ENEPS' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' logical lprn common /srutu/icall - integer icant + integer icant,xshift,yshift,zshift external icant do i=1,210 do j=1,2 @@ -792,12 +998,42 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +C returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) + &.and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -807,9 +1043,31 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) +c write (iout,*) "i j",i,j," dyn_ss_mask",dyn_ss_mask(i), +c & dyn_ss_mask(j) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') + & 'evdw',i,j,evdwij,' ss',evdw,evdw_t +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + call triple_ssbond_ene(i,j,k,evdwij) +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij +C write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') +C & 'evdw',i,j,evdwij,'tss',evdw,evdw_t + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) @@ -831,17 +1089,96 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +C returning jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + &.and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) then + +C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, +C & bb_aq(itypi,itypj)-bb, +C & sslipi,sslipj +C endif + +C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) +C checking the distance + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C finding the closest + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) c write (iout,*) i,j,xj,yj,zj rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + if (sss.le.0.0) cycle C Calculate angle-dependent terms of energy and contributions to their C derivatives. + call sc_angular sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) @@ -855,16 +1192,16 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt evdwij=evdwij*eps2rt*eps3rt - if (bb(itypi,itypj).gt.0) then - evdw=evdw+evdwij + if (bb.gt.0) then + evdw=evdw+evdwij*sss else - evdw_t=evdw_t+evdwij + evdw_t=evdw_t+evdwij*sss endif ij=icant(itypi,itypj) aux=eps1*eps2rt**2*eps3rt**2 @@ -875,8 +1212,9 @@ c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), c & aux*e2/eps(itypi,itypj) c if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa +c#define DEBUG #ifdef DEBUG write (iout,'(2(a3,i3,2x),17(0pf7.3))') & restyp(itypi),i,restyp(itypj),j, @@ -886,13 +1224,17 @@ c if (lprn) then & evdwij write (iout,*) "partial sum", evdw, evdw_t #endif +c#undef DEBUG c endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'evdw',i,j,evdwij if (calc_grad) then C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac @@ -900,6 +1242,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif +C write(iout,*) "partial sum", evdw, evdw_t + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -915,6 +1259,7 @@ C include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include "DIMENSIONS.COMPAR" + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -925,6 +1270,7 @@ C include 'COMMON.ENEPS' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' common /srutu/ icall logical lprn integer icant @@ -942,12 +1288,45 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon c if (icall.gt.0) lprn=.true. ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) - if (itypi.eq.21) cycle - itypi1=itype(i+1) + itypi=iabs(itype(i)) + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) +C returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) + & .and.(zi.lt.bordliptop)) then +C the energy transfer exist + if (zi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -957,9 +1336,29 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') + & 'evdw',i,j,evdwij,' ss',evdw,evdw_t +C triple bond artifac removal + do k=j+1,iend(i,iint) +C search over all next residues + if (dyn_ss_mask(k)) then +C check if they are cysteins +C write(iout,*) 'k=',k + call triple_ssbond_ene(i,j,k,evdwij) +C call the energy function that removes the artifical triple disulfide +C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3,2f10.3)') + & 'evdw',i,j,evdwij,'tss',evdw,evdw_t + endif!dyn_ss_mask(k) + enddo! k + ELSE ind=ind+1 - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle dscj_inv=vbld_inv(j+nres) sig0ij=sigma(itypi,itypj) r0ij=r0(itypi,itypj) @@ -982,16 +1381,96 @@ c chip12=0.0D0 c alf1=0.0D0 c alf2=0.0D0 c alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +C returning jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) + & .and.(zj.lt.bordliptop)) then +C the energy transfer exist + if (zj.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((zj-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 + & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +C if (aa.ne.aa_aq(itypi,itypj)) then + +C write(iout,*) "tu,", i,j,aa_aq(itypi,itypj)-aa, +C & bb_aq(itypi,itypj)-bb, +C & sslipi,sslipj +C endif + +C write(iout,*),aa,aa_lip(itypi,itypj),aa_aq(itypi,itypj) +C checking the distance + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C finding the closest + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if (dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) +c write (iout,*) i,j,xj,yj,zj rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss=sscale((1.0d0/rij)/sigma(itypi,itypj)) + sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj)) + if (sss.le.0.0) cycle C Calculate angle-dependent terms of energy and contributions to their C derivatives. + call sc_angular sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) @@ -1005,43 +1484,53 @@ C I hate to put IF's in the loops, but here don't have another choice!!!! c--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm evdwij=evdwij*eps2rt*eps3rt - if (bb(itypi,itypj).gt.0.0d0) then - evdw=evdw+evdwij+e_augm + if (bb.gt.0) then + evdw=evdw+evdwij*sss+e_augm else - evdw_t=evdw_t+evdwij+e_augm + evdw_t=evdw_t+evdwij*sss+e_augm endif +c evdw=evdw+evdwij+e_augm ij=icant(itypi,itypj) aux=eps1*eps2rt**2*eps3rt**2 - eneps_temp(1,ij)=eneps_temp(1,ij)+aux*(e1+e_augm) + eneps_temp(1,ij)=eneps_temp(1,ij)+aux*e1 & /dabs(eps(itypi,itypj)) eneps_temp(2,ij)=eneps_temp(2,ij)+aux*e2/eps(itypi,itypj) -c eneps_temp(ij)=eneps_temp(ij) -c & +(evdwij+e_augm)/eps(itypi,itypj) +c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, +c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), +c & aux*e2/eps(itypi,itypj) c if (lprn) then -c sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) -c epsi=bb(itypi,itypj)**2/aa(itypi,itypj) -c write (iout,'(2(a3,i3,2x),17(0pf7.3))') -c & restyp(itypi),i,restyp(itypj),j, -c & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), -c & chi1,chi2,chip1,chip2, -c & eps1,eps2rt**2,eps3rt**2, -c & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, -c & evdwij+e_augm +c#define DEBUG +#ifdef DEBUG + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa + write (iout,'(2(a3,i3,2x),17(0pf7.3))') + & restyp(itypi),i,restyp(itypj),j, + & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), + & chi1,chi2,chip1,chip2, + & eps1,eps2rt**2,eps3rt**2, + & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, + & evdwij+e_augm + write (iout,*) "partial sum", evdw, evdw_t +#endif +c#undef DEBUG c endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'evdw',i,j,evdwij if (calc_grad) then C Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder - fac=rij*fac-2*expon*rrij*e_augm + fac=rij*fac + fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij C Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac @@ -1049,6 +1538,7 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif + ENDIF enddo ! j enddo ! iint enddo ! i @@ -1166,6 +1656,8 @@ C Compute the Z-axis call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) costh=dcos(pi-theta(nres)) fac=1.0d0/dsqrt(1.0d0-costh*costh) +c write (iout,*) "i",i," dc_norm",dc_norm(:,i),dc_norm(:,i-1), +c & " uz",uz(:,i) do k=1,3 uz(k,i)=fac*uz(k,i) enddo @@ -1189,7 +1681,7 @@ C Compute the derivatives of uz uzder(1,3,2)= dc_norm(2,i) uzder(2,3,2)=-dc_norm(1,i) uzder(3,3,2)= 0.0d0 - endif + endif ! calc_grad C Compute the Y-axis facy=fac do k=1,3 @@ -1300,288 +1792,25 @@ C Compute the derivatives of uy endif return end -C----------------------------------------------------------------------------- - subroutine vec_and_deriv_test +C-------------------------------------------------------------------------- + subroutine set_matrices implicit real*8 (a-h,o-z) include 'DIMENSIONS' +#ifdef MPI + include "mpif.h" + integer IERR + integer status(MPI_STATUS_SIZE) +#endif include 'DIMENSIONS.ZSCOPT' include 'COMMON.IOUNITS' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uyder(3,3,2),uzder(3,3,2) -C Compute the local reference systems. For reference system (i), the -C X-axis points from CA(i) to CA(i+1), the Y axis is in the -C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. - do i=1,nres-1 - if (i.eq.nres-1) then -C Case of the last full residue -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) - costh=dcos(pi-theta(nres)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) -c write (iout,*) 'fac',fac, -c & 1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i-1) - uzder(3,1,1)= dc_norm(2,i-1) - uzder(1,2,1)= dc_norm(3,i-1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i-1) - uzder(1,3,1)=-dc_norm(2,i-1) - uzder(2,3,1)= dc_norm(1,i-1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - do k=1,3 - uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) - enddo - facy=fac - facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* - & (scalar(dc_norm(1,i-1),dc_norm(1,i-1))**2- - & scalar(dc_norm(1,i),dc_norm(1,i-1))**2)) - do k=1,3 -c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - uy(k,i)= -c & facy*( - & dc_norm(k,i-1)*scalar(dc_norm(1,i),dc_norm(1,i)) - & -scalar(dc_norm(1,i),dc_norm(1,i-1))*dc_norm(k,i) -c & ) - enddo -c write (iout,*) 'facy',facy, -c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - do k=1,3 - uy(k,i)=facy*uy(k,i) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i-1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo -c uyder(j,j,1)=uyder(j,j,1)-costh -c uyder(j,j,2)=1.0d0+uyder(j,j,2) - uyder(j,j,1)=uyder(j,j,1) - & -scalar(dc_norm(1,i),dc_norm(1,i-1)) - uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) - & +uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - else -C Other residues -C Compute the Z-axis - call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) - costh=dcos(pi-theta(i+2)) - fac=1.0d0/dsqrt(1.0d0-costh*costh) - fac=1.0d0/dsqrt(scalar(uz(1,i),uz(1,i))) - do k=1,3 - uz(k,i)=fac*uz(k,i) - enddo -C Compute the derivatives of uz - uzder(1,1,1)= 0.0d0 - uzder(2,1,1)=-dc_norm(3,i+1) - uzder(3,1,1)= dc_norm(2,i+1) - uzder(1,2,1)= dc_norm(3,i+1) - uzder(2,2,1)= 0.0d0 - uzder(3,2,1)=-dc_norm(1,i+1) - uzder(1,3,1)=-dc_norm(2,i+1) - uzder(2,3,1)= dc_norm(1,i+1) - uzder(3,3,1)= 0.0d0 - uzder(1,1,2)= 0.0d0 - uzder(2,1,2)= dc_norm(3,i) - uzder(3,1,2)=-dc_norm(2,i) - uzder(1,2,2)=-dc_norm(3,i) - uzder(2,2,2)= 0.0d0 - uzder(3,2,2)= dc_norm(1,i) - uzder(1,3,2)= dc_norm(2,i) - uzder(2,3,2)=-dc_norm(1,i) - uzder(3,3,2)= 0.0d0 -C Compute the Y-axis - facy=fac - facy=1.0d0/dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))* - & (scalar(dc_norm(1,i+1),dc_norm(1,i+1))**2- - & scalar(dc_norm(1,i),dc_norm(1,i+1))**2)) - do k=1,3 -c uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) - uy(k,i)= -c & facy*( - & dc_norm(k,i+1)*scalar(dc_norm(1,i),dc_norm(1,i)) - & -scalar(dc_norm(1,i),dc_norm(1,i+1))*dc_norm(k,i) -c & ) - enddo -c write (iout,*) 'facy',facy, -c & 1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - facy=1.0d0/dsqrt(scalar(uy(1,i),uy(1,i))) - do k=1,3 - uy(k,i)=facy*uy(k,i) - enddo -C Compute the derivatives of uy - do j=1,3 - do k=1,3 - uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) - & -dc_norm(k,i)*dc_norm(j,i+1) - uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) - enddo -c uyder(j,j,1)=uyder(j,j,1)-costh -c uyder(j,j,2)=1.0d0+uyder(j,j,2) - uyder(j,j,1)=uyder(j,j,1) - & -scalar(dc_norm(1,i),dc_norm(1,i+1)) - uyder(j,j,2)=scalar(dc_norm(1,i),dc_norm(1,i)) - & +uyder(j,j,2) - enddo - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=uyder(l,k,j) - uzgrad(l,k,j,i)=uzder(l,k,j) - enddo - enddo - enddo - call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) - call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) - call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) - call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) - endif - enddo - do i=1,nres-1 - do j=1,2 - do k=1,3 - do l=1,3 - uygrad(l,k,j,i)=vblinv*uygrad(l,k,j,i) - uzgrad(l,k,j,i)=vblinv*uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - return - end -C----------------------------------------------------------------------------- - subroutine check_vecgrad - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.VECTORS' - dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres) - dimension uyt(3,maxres),uzt(3,maxres) - dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3) - double precision delta /1.0d-7/ - call vec_and_deriv -cd do i=1,nres -crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i) -crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i) -crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i) -cd write(iout,'(2i5,2(3f10.5,5x))') i,1, -cd & (dc_norm(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3) -cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3) -cd write(iout,'(a)') -cd enddo - do i=1,nres - do j=1,2 - do k=1,3 - do l=1,3 - uygradt(l,k,j,i)=uygrad(l,k,j,i) - uzgradt(l,k,j,i)=uzgrad(l,k,j,i) - enddo - enddo - enddo - enddo - call vec_and_deriv - do i=1,nres - do j=1,3 - uyt(j,i)=uy(j,i) - uzt(j,i)=uz(j,i) - enddo - enddo - do i=1,nres -cd write (iout,*) 'i=',i - do k=1,3 - erij(k)=dc_norm(k,i) - enddo - do j=1,3 - do k=1,3 - dc_norm(k,i)=erij(k) - enddo - dc_norm(j,i)=dc_norm(j,i)+delta -c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) -c do k=1,3 -c dc_norm(k,i)=dc_norm(k,i)/fac -c enddo -c write (iout,*) (dc_norm(k,i),k=1,3) -c write (iout,*) (erij(k),k=1,3) - call vec_and_deriv - do k=1,3 - uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta - uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta - uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta - uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta - enddo -c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3), -c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3) - enddo - do k=1,3 - dc_norm(k,i)=erij(k) - enddo -cd do k=1,3 -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3), -cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3) -cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') -cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3), -cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3) -cd write (iout,'(a)') -cd enddo - enddo - return - end -C-------------------------------------------------------------------------- - subroutine set_matrices - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'COMMON.IOUNITS' - include 'COMMON.GEO' - include 'COMMON.VAR' - include 'COMMON.LOCAL' - include 'COMMON.CHAIN' - include 'COMMON.DERIV' - include 'COMMON.INTERACT' - include 'COMMON.CONTACTS' - include 'COMMON.TORSION' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' double precision auxvec(2),auxmat(2,2) @@ -1589,6 +1818,132 @@ C C Compute the virtual-bond-torsional-angle dependent quantities needed C to calculate the el-loc multibody terms of various order. C +c write(iout,*) 'SET_MATRICES nphi=',nphi,nres + do i=3,nres+1 + if (i.gt. nnt+2 .and. i.lt.nct+2) then + iti = itype2loc(itype(i-2)) + else + iti=nloctyp + endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then + if (i.gt. nnt+1 .and. i.lt.nct+1) then + iti1 = itype2loc(itype(i-1)) + else + iti1=nloctyp + endif +#ifdef NEWCORR + cost1=dcos(theta(i-1)) + sint1=dsin(theta(i-1)) + sint1sq=sint1*sint1 + sint1cub=sint1sq*sint1 + sint1cost1=2*sint1*cost1 +#ifdef DEBUG + write (iout,*) "bnew1",i,iti + write (iout,*) (bnew1(k,1,iti),k=1,3) + write (iout,*) (bnew1(k,2,iti),k=1,3) + write (iout,*) "bnew2",i,iti + write (iout,*) (bnew2(k,1,iti),k=1,3) + write (iout,*) (bnew2(k,2,iti),k=1,3) +#endif + do k=1,2 + b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1 + b1(k,i-2)=sint1*b1k + gtb1(k,i-2)=cost1*b1k-sint1sq* + & (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1) + b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1 + b2(k,i-2)=sint1*b2k + if (calc_grad) gtb2(k,i-2)=cost1*b2k-sint1sq* + & (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1) + enddo + do k=1,2 + aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1 + cc(1,k,i-2)=sint1sq*aux + if (calc_grad) gtcc(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1) + aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1 + dd(1,k,i-2)=sint1sq*aux + if (calc_grad) gtdd(1,k,i-2)=sint1cost1*aux-sint1cub* + & (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1) + enddo + cc(2,1,i-2)=cc(1,2,i-2) + cc(2,2,i-2)=-cc(1,1,i-2) + gtcc(2,1,i-2)=gtcc(1,2,i-2) + gtcc(2,2,i-2)=-gtcc(1,1,i-2) + dd(2,1,i-2)=dd(1,2,i-2) + dd(2,2,i-2)=-dd(1,1,i-2) + gtdd(2,1,i-2)=gtdd(1,2,i-2) + gtdd(2,2,i-2)=-gtdd(1,1,i-2) + do k=1,2 + do l=1,2 + aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1 + EE(l,k,i-2)=sint1sq*aux + if (calc_grad) + & gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti) + enddo + enddo + EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1 + EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1 + EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti) + EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti) + if (calc_grad) then + gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1 + gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1 + gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1 + endif +c b1tilde(1,i-2)=b1(1,i-2) +c b1tilde(2,i-2)=-b1(2,i-2) +c b2tilde(1,i-2)=b2(1,i-2) +c b2tilde(2,i-2)=-b2(2,i-2) +#ifdef DEBUG + write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2) + write(iout,*) 'b1=',(b1(k,i-2),k=1,2) + write(iout,*) 'b2=',(b2(k,i-2),k=1,2) + write (iout,*) 'theta=', theta(i-1) +#endif +#else +c if (i.gt. nnt+2 .and. i.lt.nct+2) then +c iti = itype2loc(itype(i-2)) +c else +c iti=nloctyp +c endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then +c if (i.gt. nnt+1 .and. i.lt.nct+1) then +c iti1 = itype2loc(itype(i-1)) +c else +c iti1=nloctyp +c endif + b1(1,i-2)=b(3,iti) + b1(2,i-2)=b(5,iti) + b2(1,i-2)=b(2,iti) + b2(2,i-2)=b(4,iti) + do k=1,2 + do l=1,2 + CC(k,l,i-2)=ccold(k,l,iti) + DD(k,l,i-2)=ddold(k,l,iti) + EE(k,l,i-2)=eeold(k,l,iti) + enddo + enddo +#endif + b1tilde(1,i-2)= b1(1,i-2) + b1tilde(2,i-2)=-b1(2,i-2) + b2tilde(1,i-2)= b2(1,i-2) + b2tilde(2,i-2)=-b2(2,i-2) +c + Ctilde(1,1,i-2)= CC(1,1,i-2) + Ctilde(1,2,i-2)= CC(1,2,i-2) + Ctilde(2,1,i-2)=-CC(2,1,i-2) + Ctilde(2,2,i-2)=-CC(2,2,i-2) +c + Dtilde(1,1,i-2)= DD(1,1,i-2) + Dtilde(1,2,i-2)= DD(1,2,i-2) + Dtilde(2,1,i-2)=-DD(2,1,i-2) + Dtilde(2,2,i-2)=-DD(2,2,i-2) +#ifdef DEBUG + write(iout,*) "i",i," iti",iti + write(iout,*) 'b1=',(b1(k,i-2),k=1,2) + write(iout,*) 'b2=',(b2(k,i-2),k=1,2) +#endif + enddo do i=3,nres+1 if (i .lt. nres+1) then sin1=dsin(phi(i)) @@ -1656,37 +2011,44 @@ C Ug2der(2,1,i-2)=0.0d0 Ug2der(2,2,i-2)=0.0d0 endif +c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then if (i.gt. nnt+2 .and. i.lt.nct+2) then - if (itype(i-2).le.ntyp) then - iti = itortyp(itype(i-2)) - else - iti=ntortyp+1 - endif + iti = itype2loc(itype(i-2)) else - iti=ntortyp+1 + iti=nloctyp endif +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then - if (itype(i-1).le.ntyp) then - iti1 = itortyp(itype(i-1)) - else - iti1=ntortyp+1 - endif + iti1 = itype2loc(itype(i-1)) else - iti1=ntortyp+1 + iti1=nloctyp endif cd write (iout,*) '*******i',i,' iti1',iti cd write (iout,*) 'b1',b1(:,iti) cd write (iout,*) 'b2',b2(:,iti) cd write (iout,*) 'Ug',Ug(:,:,i-2) -c print *,"itilde1 i iti iti1",i,iti,iti1 - if (i .gt. iatel_s+2) then - call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) - call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) - call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) - call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) +c if (i .gt. iatel_s+2) then + if (i .gt. nnt+2) then + call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2)) +#ifdef NEWCORR + call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2)) +c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj" +#endif +c write(iout,*) "co jest kurwa", iti, EE(1,1,i),EE(2,1,i), +c & EE(1,2,iti),EE(2,2,i) + call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2)) + call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2)) +c write(iout,*) "Macierz EUG", +c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2), +c & eug(2,2,i-2) + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) + & then + call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2)) + endif else do k=1,2 Ub2(k,i-2)=0.0d0 @@ -1700,63 +2062,76 @@ c print *,"itilde1 i iti iti1",i,iti,iti1 enddo enddo endif -c print *,"itilde2 i iti iti1",i,iti,iti1 - call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) - call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) - call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) - call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) - call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) - call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) - call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) -c print *,"itilde3 i iti iti1",i,iti,iti1 + call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2)) + call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2)) do k=1,2 muder(k,i-2)=Ub2der(k,i-2) enddo +c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then if (itype(i-1).le.ntyp) then - iti1 = itortyp(itype(i-1)) + iti1 = itype2loc(itype(i-1)) else - iti1=ntortyp+1 + iti1=nloctyp endif else - iti1=ntortyp+1 + iti1=nloctyp endif do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) + mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) enddo +#ifdef MUOUT + write (iout,'(2hmu,i3,3f8.1,12f10.5)') i-2,rad2deg*theta(i-1), + & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2), + & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2), + & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2) + & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2), + & ((ee(l,k,i-2),l=1,2),k=1,2) +#endif +cd write (iout,*) 'mu1',mu1(:,i-2) +cd write (iout,*) 'mu2',mu2(:,i-2) + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) + & then + if (calc_grad) then + call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2)) + call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2)) + call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) + call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2)) + call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2)) + endif C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) + call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1)) call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) + call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2)) + call matmat2(EUg(1,1,i-2),CC(1,1,i-1),EUgC(1,1,i-2)) + call matmat2(EUg(1,1,i-2),DD(1,1,i-1),EUgD(1,1,i-2)) + if (calc_grad) then call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) - call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) - call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) - call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) - call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) -cd write (iout,*) 'i',i,' mu ',(mu(k,i-2),k=1,2), -cd & ' mu1',(b1(k,i-2),k=1,2),' mu2',(Ub2(k,i-2),k=1,2) + call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2)) + call matmat2(EUgder(1,1,i-2),CC(1,1,i-1),EUgCder(1,1,i-2)) + call matmat2(EUgder(1,1,i-2),DD(1,1,i-1),EUgDder(1,1,i-2)) + endif + endif enddo C Matrices dependent on two consecutive virtual-bond dihedrals. C The order of matrices is from left to right. + if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) + &then do i=2,nres-1 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i)) + if (calc_grad) then call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i)) call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i)) + endif call transpose2(DtUg2(1,1,i-1),auxmat(1,1)) call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i)) + if (calc_grad) then call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i)) call transpose2(DtUg2der(1,1,i-1),auxmat(1,1)) call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i)) + endif enddo -cd do i=1,nres -cd iti = itortyp(itype(i)) -cd write (iout,*) i -cd do j=1,2 -cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') -cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) -cd enddo -cd enddo + endif return end C-------------------------------------------------------------------------- @@ -1769,6 +2144,9 @@ C The potential depends both on the distance of peptide-group centers and on C the orientation of the CA-CA virtual bonds. C implicit real*8 (a-h,o-z) +#ifdef MPI + include 'mpif.h' +#endif include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'COMMON.CONTROL' @@ -1783,13 +2161,21 @@ C include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' + include 'COMMON.TIME1' + include 'COMMON.SPLITELE' dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1 + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions +#ifdef MOMENT + double precision scal_el /1.0d0/ +#else double precision scal_el /0.5d0/ +#endif C 12/13/98 C 13-go grudnia roku pamietnego... double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, @@ -1818,25 +2204,26 @@ c write (iout,*) 'i',i,' fac',fac if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then -cd if (wel_loc.gt.0.0d0) then - if (icheckgrad.eq.1) then - call vec_and_deriv_test - else - call vec_and_deriv - endif +c call vec_and_deriv +#ifdef TIMING + time01=MPI_Wtime() +#endif call set_matrices +#ifdef TIMING + time_mat=time_mat+MPI_Wtime()-time01 +#endif endif cd do i=1,nres-1 cd write (iout,*) 'i=',i cd do k=1,3 -cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) +cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) cd enddo cd do k=1,3 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) cd enddo cd enddo - num_conti_hb=0 + t_eelecij=0.0d0 ees=0.0D0 evdw1=0.0D0 eel_loc=0.0d0 @@ -1852,9 +2239,32 @@ cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e gel_loc_loc(i)=0.0d0 gcorr_loc(i)=0.0d0 enddo - do i=iatel_s,iatel_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle - if (itel(i).eq.0) goto 1215 +c +c +c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms +C +C Loop over i,i+2 and i,i+3 pairs of the peptide groups +C +C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition + do i=iturn3_start,iturn3_end +c if (i.le.1) cycle +C write(iout,*) "tu jest i",i + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +C Adam: Unnecessary: handled by iturn3_end and iturn3_start +c & .or.((i+4).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana +C dobra zmiana wycofana + & .or. itype(i+2).eq.ntyp1 + & .or. itype(i+3).eq.ntyp1) cycle +C Adam: Instructions below will switch off existing interactions +c if(i.gt.1)then +c if(itype(i-1).eq.ntyp1)cycle +c end if +c if(i.LT.nres-3)then +c if (itype(i+4).eq.ntyp1) cycle +c end if dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1864,23 +2274,226 @@ cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 + call eelecij(i,i+2,ees,evdw1,eel_loc) + if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) + num_cont_hb(i)=num_conti + enddo + do i=iturn4_start,iturn4_end + if (i.lt.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+5).gt.nres) +c & .or.((i-1).le.0) +C end of changes suggested by Ana + & .or. itype(i+3).eq.ntyp1 + & .or. itype(i+4).eq.ntyp1 +c & .or. itype(i+5).eq.ntyp1 +c & .or. itype(i).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle + dxi=dc(1,i) + dyi=dc(2,i) + dzi=dc(3,i) + dx_normi=dc_norm(1,i) + dy_normi=dc_norm(2,i) + dz_normi=dc_norm(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi +C Return atom into box, boxxsize is size of box in x dimension +c 194 continue +c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((0.5d0)*boxxsize)).or. +c & (xmedi.lt.((-0.5d0)*boxxsize))) then +c go to 194 +c endif +c 195 continue +c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((0.5d0)*boxysize)).or. +c & (ymedi.lt.((-0.5d0)*boxysize))) then +c go to 195 +c endif +c 196 continue +c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +C Condition for being inside the proper box +c if ((zmedi.gt.((0.5d0)*boxzsize)).or. +c & (zmedi.lt.((-0.5d0)*boxzsize))) then +c go to 196 +c endif + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + + num_conti=num_cont_hb(i) +c write(iout,*) "JESTEM W PETLI" + call eelecij(i,i+3,ees,evdw1,eel_loc) + if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) + & call eturn4(i,eello_turn4) + num_cont_hb(i)=num_conti + enddo ! i +C Loop over all neighbouring boxes +C do xshift=-1,1 +C do yshift=-1,1 +C do zshift=-1,1 +c +c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 +c +CTU KURWA + do i=iatel_s,iatel_e +C do i=75,75 +c if (i.le.1) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((i+2).gt.nres) +c & .or.((i-1).le.0) +C end of changes by Ana +c & .or. itype(i+2).eq.ntyp1 +c & .or. itype(i-1).eq.ntyp1 + & ) cycle + dxi=dc(1,i) + dyi=dc(2,i) + dzi=dc(3,i) + dx_normi=dc_norm(1,i) + dy_normi=dc_norm(2,i) + dz_normi=dc_norm(3,i) + xmedi=c(1,i)+0.5d0*dxi + ymedi=c(2,i)+0.5d0*dyi + zmedi=c(3,i)+0.5d0*dzi + xmedi=mod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=mod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=mod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize +C xmedi=xmedi+xshift*boxxsize +C ymedi=ymedi+yshift*boxysize +C zmedi=zmedi+zshift*boxzsize + +C Return tom into box, boxxsize is size of box in x dimension +c 164 continue +c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize +c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize +C Condition for being inside the proper box +c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or. +c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then +c go to 164 +c endif +c 165 continue +c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize +c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize +C Condition for being inside the proper box +c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or. +c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then +c go to 165 +c endif +c 166 continue +c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize +c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize +cC Condition for being inside the proper box +c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or. +c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then +c go to 166 +c endif + c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) + num_conti=num_cont_hb(i) +C I TU KURWA do j=ielstart(i),ielend(i) - if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle - if (itel(j).eq.0) goto 1216 - ind=ind+1 +C do j=16,17 +C write (iout,*) i,j +C if (j.le.1) cycle + if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1 +C changes suggested by Ana to avoid out of bounds +c & .or.((j+2).gt.nres) +c & .or.((j-1).le.0) +C end of changes by Ana +c & .or.itype(j+2).eq.ntyp1 +c & .or.itype(j-1).eq.ntyp1 + &) cycle + call eelecij(i,j,ees,evdw1,eel_loc) + enddo ! j + num_cont_hb(i)=num_conti + enddo ! i +C enddo ! zshift +C enddo ! yshift +C enddo ! xshift + +c write (iout,*) "Number of loop steps in EELEC:",ind +cd do i=1,nres +cd write (iout,'(i3,3f10.5,5x,3f10.5)') +cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) +cd enddo +c 12/7/99 Adam eello_turn3 will be considered as a separate energy term +ccc eel_loc=eel_loc+eello_turn3 +cd print *,"Processor",fg_rank," t_eelecij",t_eelecij + return + end +C------------------------------------------------------------------------------- + subroutine eelecij(i,j,ees,evdw1,eel_loc) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' +#ifdef MPI + include "mpif.h" +#endif + include 'COMMON.CONTROL' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' + include 'COMMON.VECTORS' + include 'COMMON.FFIELD' + include 'COMMON.TIME1' + include 'COMMON.SPLITELE' + include 'COMMON.SHIELD' + dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), + & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) + double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), + & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4), + & gmuij2(4),gmuji2(4) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 +c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions +#ifdef MOMENT + double precision scal_el /1.0d0/ +#else + double precision scal_el /0.5d0/ +#endif +C 12/13/98 +C 13-go grudnia roku pamietnego... + double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, + & 0.0d0,1.0d0,0.0d0, + & 0.0d0,0.0d0,1.0d0/ + integer xshift,yshift,zshift +c time00=MPI_Wtime() +cd write (iout,*) "eelecij",i,j +c ind=ind+1 iteli=itel(i) itelj=itel(j) if (j.eq.i+2 .and. itelj.eq.2) iteli=2 aaa=app(iteli,itelj) bbb=bpp(iteli,itelj) -C Diagnostics only!!! -c aaa=0.0D0 -c bbb=0.0D0 -c ael6i=0.0D0 -c ael3i=0.0D0 -C End diagnostics ael6i=ael6(iteli,itelj) ael3i=ael3(iteli,itelj) dxj=dc(1,j) @@ -1889,10 +2502,86 @@ C End diagnostics dx_normj=dc_norm(1,j) dy_normj=dc_norm(2,j) dz_normj=dc_norm(3,j) - xj=c(1,j)+0.5D0*dxj-xmedi - yj=c(2,j)+0.5D0*dyj-ymedi - zj=c(3,j)+0.5D0*dzj-zmedi +C xj=c(1,j)+0.5D0*dxj-xmedi +C yj=c(2,j)+0.5D0*dyj-ymedi +C zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ" + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + isubchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif +C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC +c 174 continue +c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize +c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize +C Condition for being inside the proper box +c if ((xj.gt.((0.5d0)*boxxsize)).or. +c & (xj.lt.((-0.5d0)*boxxsize))) then +c go to 174 +c endif +c 175 continue +c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize +c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize +C Condition for being inside the proper box +c if ((yj.gt.((0.5d0)*boxysize)).or. +c & (yj.lt.((-0.5d0)*boxysize))) then +c go to 175 +c endif +c 176 continue +c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize +c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize +C Condition for being inside the proper box +c if ((zj.gt.((0.5d0)*boxzsize)).or. +c & (zj.lt.((-0.5d0)*boxzsize))) then +c go to 176 +c endif +C endif !endPBC condintion +C xj=xj-xmedi +C yj=yj-ymedi +C zj=zj-zmedi rij=xj*xj+yj*yj+zj*zj + + sss=sscale(sqrt(rij)) + sssgrad=sscagrad(sqrt(rij)) +c write (iout,*) "ij",i,j," rij",sqrt(rij)," r_cut",r_cut, +c & " rlamb",rlamb," sss",sss +c if (sss.gt.0.0d0) then rrmij=1.0D0/rij rij=dsqrt(rij) rmij=1.0D0/rij @@ -1908,97 +2597,233 @@ c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions ev2=bbb*r6ij fac3=ael6i*r6ij fac4=ael3i*r3ij - evdwij=ev1+ev2 + evdwij=(ev1+ev2) el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) el2=fac4*fac - eesij=el1+el2 -c write (iout,*) "i",i,iteli," j",j,itelj," eesij",eesij +C MARYSIA +C eesij=(el1+el2) C 12/26/95 - for the evaluation of multi-body H-bonding interactions ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) + if (shield_mode.gt.0) then +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + el1=el1*fac_shield(i)**2*fac_shield(j)**2 + el2=el2*fac_shield(i)**2*fac_shield(j)**2 + eesij=(el1+el2) ees=ees+eesij - evdw1=evdw1+evdwij + else + fac_shield(i)=1.0 + fac_shield(j)=1.0 + eesij=(el1+el2) + ees=ees+eesij + endif + evdw1=evdw1+evdwij*sss cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, cd & 1.0D0/dsqrt(rrmij),evdwij,eesij, cd & xmedi,ymedi,zmedi,xj,yj,zj + + if (energy_dec) then + write (iout,'(a6,2i5,0pf7.3,2i5,3e11.3)') + &'evdw1',i,j,evdwij + &,iteli,itelj,aaa,evdw1,sss + write (iout,'(a6,2i5,0pf7.3,2f8.3)') 'ees',i,j,eesij, + &fac_shield(i),fac_shield(j) + endif + C C Calculate contributions to the Cartesian gradient. C #ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) + facvdw=-6*rrmij*(ev1+evdwij)*sss facel=-3*rrmij*(el1+eesij) fac1=fac erij(1)=xj*rmij erij(2)=yj*rmij erij(3)=zj*rmij - if (calc_grad) then + * * Radial derivatives. First process both termini of the fragment (i,j) -* +* + if (calc_grad) then ggg(1)=facel*xj ggg(2)=facel*yj ggg(3)=facel*zj + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C if (iresshield.gt.i) then +C do ishi=i+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C else +C do ishi=iresshield,i +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,i)*eesij/fac_shield(i) +C +C enddo +C endif + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) + & *2.0 + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C gshieldc_loc(k,iresshield)=gshieldc_loc(k,iresshield) +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C if (iresshield.gt.j) then +C do ishi=j+1,iresshield-1 +C gshieldc(k,ishi)=gshieldc(k,ishi)+rlocshield +C & +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C +C enddo +C else +C do ishi=iresshield,j +C gshieldc(k,ishi)=gshieldc(k,ishi)-rlocshield +C & -grad_shield_loc(k,ilist,j)*eesij/fac_shield(j) +C enddo +C endif + enddo + enddo + + do k=1,3 + gshieldc(k,i)=gshieldc(k,i)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j)=gshieldc(k,j)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + gshieldc(k,i-1)=gshieldc(k,i-1)+ + & grad_shield(k,i)*eesij/fac_shield(i)*2.0 + gshieldc(k,j-1)=gshieldc(k,j-1)+ + & grad_shield(k,j)*eesij/fac_shield(j)*2.0 + + enddo + endif +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c gelc(k,j)=gelc(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end +C print *,"before", gelc_long(1,i), gelc_long(1,j) do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - gelc(k,j)=gelc(k,j)+ghalf + gelc_long(k,j)=gelc_long(k,j)+ggg(k) +C & +grad_shield(k,j)*eesij/fac_shield(j) + gelc_long(k,i)=gelc_long(k,i)-ggg(k) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,i-1)=gelc_long(k,i-1) +C & +grad_shield(k,i)*eesij/fac_shield(i) +C gelc_long(k,j-1)=gelc_long(k,j-1) +C & +grad_shield(k,j)*eesij/fac_shield(j) enddo +C print *,"bafter", gelc_long(1,i), gelc_long(1,j) + * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo - enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo + if (sss.gt.0.0) then + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj + else + ggg(1)=0.0 + ggg(2)=0.0 + ggg(3)=0.0 + endif +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gvdwpp(k,i)=gvdwpp(k,i)+ghalf +c gvdwpp(k,j)=gvdwpp(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end do k=1,3 - ghalf=0.5D0*ggg(k) - gvdwpp(k,i)=gvdwpp(k,i)+ghalf - gvdwpp(k,j)=gvdwpp(k,j)+ghalf + gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) + gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) - enddo - enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) +cgrad enddo +cgrad enddo + endif ! calc_grad #else - facvdw=ev1+evdwij - facel=el1+eesij +C MARYSIA + facvdw=(ev1+evdwij)*sss + facel=(el1+eesij) fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel) erij(1)=xj*rmij erij(2)=yj*rmij erij(3)=zj*rmij - if (calc_grad) then * * Radial derivatives. First process both termini of the fragment (i,j) * + if (calc_grad) then ggg(1)=fac*xj +C+eesij*grad_shield(1,i)+eesij*grad_shield(1,j) ggg(2)=fac*yj +C+eesij*grad_shield(2,i)+eesij*grad_shield(2,j) ggg(3)=fac*zj +C+eesij*grad_shield(3,i)+eesij*grad_shield(3,j) +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c gelc(k,j)=gelc(k,j)+ghalf +c enddo +c 9/28/08 AL Gradient compotents will be summed only at the end do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - gelc(k,j)=gelc(k,j)+ghalf + gelc_long(k,j)=gelc(k,j)+ggg(k) + gelc_long(k,i)=gelc(k,i)-ggg(k) enddo * * Loop over residues i+1 thru j-1. * - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo +c 9/28/08 AL Gradient compotents will be summed only at the end + ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj + ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj + ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj + do k=1,3 + gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) + gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + endif ! calc_grad #endif * * Angular part * + if (calc_grad) then ecosa=2.0D0*fac3*fac1+fac4 fac4=-3.0D0*fac4 fac3=-6.0D0*fac3 @@ -2011,24 +2836,41 @@ C cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), cd & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))* + & fac_shield(i)**2*fac_shield(j)**2 enddo +c do k=1,3 +c ghalf=0.5D0*ggg(k) +c gelc(k,i)=gelc(k,i)+ghalf +c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) +c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) +c gelc(k,j)=gelc(k,j)+ghalf +c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) +c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) +c enddo +cgrad do k=i+1,j-1 +cgrad do l=1,3 +cgrad gelc(l,k)=gelc(l,k)+ggg(l) +cgrad enddo +cgrad enddo +C print *,"before22", gelc_long(1,i), gelc_long(1,j) do k=1,3 - ghalf=0.5D0*ggg(k) - gelc(k,i)=gelc(k,i)+ghalf - & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) - & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gelc(k,j)=gelc(k,j)+ghalf - & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) - & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - enddo - do k=i+1,j-1 - do l=1,3 - gelc(l,k)=gelc(l,k)+ggg(l) - enddo + gelc(k,i)=gelc(k,i) + & +((ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) + & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)) + & *fac_shield(i)**2*fac_shield(j)**2 + gelc(k,j)=gelc(k,j) + & +((ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) + & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)) + & *fac_shield(i)**2*fac_shield(j)**2 + gelc_long(k,j)=gelc_long(k,j)+ggg(k) + gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo - endif +C print *,"before33", gelc_long(1,i), gelc_long(1,j) +C MARYSIA +c endif !sscale + endif ! calc_grad IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN @@ -2039,6 +2881,7 @@ C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al. C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms C are computed for EVERY pair of non-contiguous peptide groups. C + if (j.lt.nres-1) then j1=j+1 j2=j-1 @@ -2047,15 +2890,32 @@ C j2=j-2 endif kkk=0 + lll=0 do k=1,2 do l=1,2 kkk=kkk+1 muij(kkk)=mu(k,i)*mu(l,j) +c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l +#ifdef NEWCORR + if (calc_grad) then + gmuij1(kkk)=gtb1(k,i+1)*mu(l,j) +c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j) + gmuij2(kkk)=gUb2(k,i)*mu(l,j) + gmuji1(kkk)=mu(k,i)*gtb1(l,j+1) +c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i) + gmuji2(kkk)=mu(k,i)*gUb2(l,j) + endif +#endif enddo enddo -cd write (iout,*) 'EELEC: i',i,' j',j -cd write (iout,*) 'j',j,' j1',j1,' j2',j2 -cd write(iout,*) 'muij',muij +#ifdef DEBUG + write (iout,*) 'EELEC: i',i,' j',j + write (iout,*) 'j',j,' j1',j1,' j2',j2 + write(iout,*) 'muij',muij + write (iout,*) "uy",uy(:,i) + write (iout,*) "uz",uz(:,j) + write (iout,*) "erij",erij +#endif ury=scalar(uy(1,i),erij) urz=scalar(uz(1,i),erij) vry=scalar(uy(1,j),erij) @@ -2064,15 +2924,7 @@ cd write(iout,*) 'muij',muij a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz a32=scalar(uz(1,i),uy(1,j))-3*urz*vry a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz -C For diagnostics only -cd a22=1.0d0 -cd a23=1.0d0 -cd a32=1.0d0 -cd a33=1.0d0 fac=dsqrt(-ael6i)*r3ij -cd write (2,*) 'fac=',fac -C For diagnostics only -cd fac=1.0d0 a22=a22*fac a23=a23*fac a32=a32*fac @@ -2080,22 +2932,17 @@ cd fac=1.0d0 cd write (iout,'(4i5,4f10.5)') cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij -cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') (uy(k,i),k=1,3), -cd & (uz(k,i),k=1,3),(uy(k,j),k=1,3),(uz(k,j),k=1,3) +cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), +cd & uy(:,j),uz(:,j) cd write (iout,'(4f10.5)') cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)), cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j)) cd write (iout,'(4f10.5)') ury,urz,vry,vrz -cd write (iout,'(2i3,9f10.5/)') i,j, +cd write (iout,'(9f10.5/)') cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij - if (calc_grad) then C Derivatives of the elements of A in virtual-bond vectors + if (calc_grad) then call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1)) -cd do k=1,3 -cd do l=1,3 -cd erder(k,l)=0.0d0 -cd enddo -cd enddo do k=1,3 uryg(k,1)=scalar(erder(1,k),uy(1,i)) uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1)) @@ -2110,24 +2957,12 @@ cd enddo vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1)) vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1)) enddo -cd do k=1,3 -cd do l=1,3 -cd uryg(k,l)=0.0d0 -cd urzg(k,l)=0.0d0 -cd vryg(k,l)=0.0d0 -cd vrzg(k,l)=0.0d0 -cd enddo -cd enddo C Compute radial contributions to the gradient facr=-3.0d0*rrmij a22der=a22*facr a23der=a23*facr a32der=a32*facr a33der=a33*facr -cd a22der=0.0d0 -cd a23der=0.0d0 -cd a32der=0.0d0 -cd a33der=0.0d0 agg(1,1)=a22der*xj agg(2,1)=a22der*yj agg(3,1)=a22der*zj @@ -2150,36 +2985,36 @@ C Add the contributions coming from er enddo do k=1,3 C Derivatives in DC(i) - ghalf1=0.5d0*agg(k,1) - ghalf2=0.5d0*agg(k,2) - ghalf3=0.5d0*agg(k,3) - ghalf4=0.5d0*agg(k,4) +cgrad ghalf1=0.5d0*agg(k,1) +cgrad ghalf2=0.5d0*agg(k,2) +cgrad ghalf3=0.5d0*agg(k,3) +cgrad ghalf4=0.5d0*agg(k,4) aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) - & -3.0d0*uryg(k,2)*vry)+ghalf1 + & -3.0d0*uryg(k,2)*vry)!+ghalf1 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) - & -3.0d0*uryg(k,2)*vrz)+ghalf2 + & -3.0d0*uryg(k,2)*vrz)!+ghalf2 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) - & -3.0d0*urzg(k,2)*vry)+ghalf3 + & -3.0d0*urzg(k,2)*vry)!+ghalf3 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) - & -3.0d0*urzg(k,2)*vrz)+ghalf4 + & -3.0d0*urzg(k,2)*vrz)!+ghalf4 C Derivatives in DC(i+1) aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) - & -3.0d0*uryg(k,3)*vry)+agg(k,1) + & -3.0d0*uryg(k,3)*vry)!+agg(k,1) aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) - & -3.0d0*uryg(k,3)*vrz)+agg(k,2) + & -3.0d0*uryg(k,3)*vrz)!+agg(k,2) aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) - & -3.0d0*urzg(k,3)*vry)+agg(k,3) + & -3.0d0*urzg(k,3)*vry)!+agg(k,3) aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) - & -3.0d0*urzg(k,3)*vrz)+agg(k,4) + & -3.0d0*urzg(k,3)*vrz)!+agg(k,4) C Derivatives in DC(j) aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) - & -3.0d0*vryg(k,2)*ury)+ghalf1 + & -3.0d0*vryg(k,2)*ury)!+ghalf1 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) - & -3.0d0*vrzg(k,2)*ury)+ghalf2 + & -3.0d0*vrzg(k,2)*ury)!+ghalf2 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) - & -3.0d0*vryg(k,2)*urz)+ghalf3 + & -3.0d0*vryg(k,2)*urz)!+ghalf3 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) - & -3.0d0*vrzg(k,2)*urz)+ghalf4 + & -3.0d0*vrzg(k,2)*urz)!+ghalf4 C Derivatives in DC(j+1) or DC(nres-1) aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) & -3.0d0*vryg(k,3)*ury) @@ -2189,41 +3024,20 @@ C Derivatives in DC(j+1) or DC(nres-1) & -3.0d0*vryg(k,3)*urz) aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) & -3.0d0*vrzg(k,3)*urz) -cd aggi(k,1)=ghalf1 -cd aggi(k,2)=ghalf2 -cd aggi(k,3)=ghalf3 -cd aggi(k,4)=ghalf4 -C Derivatives in DC(i+1) -cd aggi1(k,1)=agg(k,1) -cd aggi1(k,2)=agg(k,2) -cd aggi1(k,3)=agg(k,3) -cd aggi1(k,4)=agg(k,4) -C Derivatives in DC(j) -cd aggj(k,1)=ghalf1 -cd aggj(k,2)=ghalf2 -cd aggj(k,3)=ghalf3 -cd aggj(k,4)=ghalf4 -C Derivatives in DC(j+1) -cd aggj1(k,1)=0.0d0 -cd aggj1(k,2)=0.0d0 -cd aggj1(k,3)=0.0d0 -cd aggj1(k,4)=0.0d0 - if (j.eq.nres-1 .and. i.lt.j-2) then - do l=1,4 - aggj1(k,l)=aggj1(k,l)+agg(k,l) -cd aggj1(k,l)=agg(k,l) - enddo - endif +cgrad if (j.eq.nres-1 .and. i.lt.j-2) then +cgrad do l=1,4 +cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l) +cgrad enddo +cgrad endif enddo - endif -c goto 11111 -C Check the loc-el terms by numerical integration + endif ! calc_grad acipa(1,1)=a22 acipa(1,2)=a23 acipa(2,1)=a32 acipa(2,2)=a33 a22=-a22 a23=-a23 + if (calc_grad) then do l=1,2 do k=1,3 agg(k,l)=-agg(k,l) @@ -2233,6 +3047,7 @@ C Check the loc-el terms by numerical integration aggj1(k,l)=-aggj1(k,l) enddo enddo + endif ! calc_grad if (j.lt.nres-1) then a22=-a22 a32=-a32 @@ -2261,63 +3076,188 @@ C Check the loc-el terms by numerical integration enddo endif ENDIF ! WCORR -11111 continue IF (wel_loc.gt.0.0d0) THEN C Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) -cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij -cd write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) +#ifdef DEBUG + write (iout,*) "muij",muij," a22",a22," a23",a23," a32",a32, + & " a33",a33 + write (iout,*) "ij",i,j," eel_loc_ij",eel_loc_ij, + & " wel_loc",wel_loc +#endif + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif + eel_loc_ij=eel_loc_ij + & *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'eelloc',i,j,eel_loc_ij +c if (eel_loc_ij.ne.0) +c & write (iout,'(a4,2i4,8f9.5)')'chuj', +c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4) + eel_loc=eel_loc+eel_loc_ij -C Partial derivatives in virtual-bond dihedral angles gamma +C Now derivative over eel_loc if (calc_grad) then + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij + & /fac_shield(i) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij + & /fac_shield(j) +C & *2.0 + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_ll(k,i)=gshieldc_ll(k,i)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j)=gshieldc_ll(k,j)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ + & grad_shield(k,i)*eel_loc_ij/fac_shield(i) + gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ + & grad_shield(k,j)*eel_loc_ij/fac_shield(j) + enddo + endif + + +c write (iout,*) 'i',i,' j',j,itype(i),itype(j), +c & ' eel_loc_ij',eel_loc_ij +C write(iout,*) 'muije=',i,j,muij(1),muij(2),muij(3),muij(4) +C Calculate patrial derivative for theta angle +#ifdef NEWCORR + geel_loc_ij=(a22*gmuij1(1) + & +a23*gmuij1(2) + & +a32*gmuij1(3) + & +a33*gmuij1(4)) + & *fac_shield(i)*fac_shield(j) +c write(iout,*) "derivative over thatai" +c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3), +c & a33*gmuij1(4) + gloc(nphi+i,icg)=gloc(nphi+i,icg)+ + & geel_loc_ij*wel_loc +c write(iout,*) "derivative over thatai-1" +c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3), +c & a33*gmuij2(4) + geel_loc_ij= + & a22*gmuij2(1) + & +a23*gmuij2(2) + & +a32*gmuij2(3) + & +a33*gmuij2(4) + gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ + & geel_loc_ij*wel_loc + & *fac_shield(i)*fac_shield(j) + +c Derivative over j residue + geel_loc_ji=a22*gmuji1(1) + & +a23*gmuji1(2) + & +a32*gmuji1(3) + & +a33*gmuji1(4) +c write(iout,*) "derivative over thataj" +c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3), +c & a33*gmuji1(4) + + gloc(nphi+j,icg)=gloc(nphi+j,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) + + geel_loc_ji= + & +a22*gmuji2(1) + & +a23*gmuji2(2) + & +a32*gmuji2(3) + & +a33*gmuji2(4) +c write(iout,*) "derivative over thataj-1" +c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3), +c & a33*gmuji2(4) + gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+ + & geel_loc_ji*wel_loc + & *fac_shield(i)*fac_shield(j) +#endif +cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij + +C Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ - & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) - & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) - gel_loc_loc(j-1)=gel_loc_loc(j-1)+ - & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) - & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) -cd call checkint3(i,j,mu1,mu2,a22,a23,a32,a33,acipa,eel_loc_ij) -cd write(iout,*) 'agg ',agg -cd write(iout,*) 'aggi ',aggi -cd write(iout,*) 'aggi1',aggi1 -cd write(iout,*) 'aggj ',aggj -cd write(iout,*) 'aggj1',aggj1 + & (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) + & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) + & *fac_shield(i)*fac_shield(j) + gel_loc_loc(j-1)=gel_loc_loc(j-1)+ + & (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) + & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) + & *fac_shield(i)*fac_shield(j) C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ - & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) - enddo - do k=i+2,j2 - do l=1,3 - gel_loc(l,k)=gel_loc(l,k)+ggg(l) - enddo + ggg(l)=(agg(l,1)*muij(1)+ + & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) + gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) +cgrad ghalf=0.5d0*ggg(l) +cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf +cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo +cgrad do k=i+1,j2 +cgrad do l=1,3 +cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l) +cgrad enddo +cgrad enddo C Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ - & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ - & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ - & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ - & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ + & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ + & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ + & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ + & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)) + & *fac_shield(i)*fac_shield(j) + enddo - endif + endif ! calc_grad ENDIF - if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then -C Contributions from turns - a_temp(1,1)=a22 - a_temp(1,2)=a23 - a_temp(2,1)=a32 - a_temp(2,2)=a33 - call eturn34(i,j,eello_turn3,eello_turn4) - endif + + C Change 12/26/95 to calculate four-body contributions to H-bonding energy - if (j.gt.i+1 .and. num_conti.le.maxconts) then +c if (j.gt.i+1 .and. num_conti.le.maxconts) then + if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 + & .and. num_conti.le.maxconts) then +c write (iout,*) i,j," entered corr" C C Calculate the contact function. The ith column of the array JCONT will C contain the numbers of atoms that make contacts with the atom I (of numbers @@ -2335,6 +3275,8 @@ c r0ij=1.55D0*rpp(iteli,itelj) & ' will skip next contacts for this conf.' else jcont_hb(num_conti,i)=j +cd write (iout,*) "i",i," j",j," num_conti",num_conti, +cd & " jcont_hb",jcont_hb(num_conti,i) IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el @@ -2347,42 +3289,10 @@ C --- Electrostatic-interaction matrix --- a_chuj(2,1,num_conti,i)=a32 a_chuj(2,2,num_conti,i)=a33 C --- Gradient of rij + if (calc_grad) then do kkk=1,3 grij_hb_cont(kkk,num_conti,i)=erij(kkk) enddo -c if (i.eq.1) then -c a_chuj(1,1,num_conti,i)=-0.61d0 -c a_chuj(1,2,num_conti,i)= 0.4d0 -c a_chuj(2,1,num_conti,i)= 0.65d0 -c a_chuj(2,2,num_conti,i)= 0.50d0 -c else if (i.eq.2) then -c a_chuj(1,1,num_conti,i)= 0.0d0 -c a_chuj(1,2,num_conti,i)= 0.0d0 -c a_chuj(2,1,num_conti,i)= 0.0d0 -c a_chuj(2,2,num_conti,i)= 0.0d0 -c endif -C --- and its gradients -cd write (iout,*) 'i',i,' j',j -cd do kkk=1,3 -cd write (iout,*) 'iii 1 kkk',kkk -cd write (iout,*) agg(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 2 kkk',kkk -cd write (iout,*) aggi(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 3 kkk',kkk -cd write (iout,*) aggi1(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 4 kkk',kkk -cd write (iout,*) aggj(kkk,:) -cd enddo -cd do kkk=1,3 -cd write (iout,*) 'iii 5 kkk',kkk -cd write (iout,*) aggj1(kkk,:) -cd enddo kkll=0 do k=1,2 do l=1,2 @@ -2393,12 +3303,10 @@ cd enddo a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll) a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll) a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll) -c do mm=1,5 -c a_chuj_der(k,l,m,mm,num_conti,i)=0.0d0 -c enddo enddo enddo enddo + endif ! calc_grad ENDIF IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN C Calculate contact energies @@ -2408,21 +3316,42 @@ C Calculate contact energies cosbg2=cosb-cosg c fac3=dsqrt(-ael6i)/r0ij**3 fac3=dsqrt(-ael6i)*r3ij - ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) - ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) +c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1) + ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 + if (ees0tmp.gt.0) then + ees0pij=dsqrt(ees0tmp) + else + ees0pij=0 + endif +c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) + ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 + if (ees0tmp.gt.0) then + ees0mij=dsqrt(ees0tmp) + else + ees0mij=0 + endif c ees0mij=0.0D0 + if (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + else + ees0plist(num_conti,i)=j +C fac_shield(i)=0.4d0 +C fac_shield(j)=0.6d0 + endif ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) + & *fac_shield(i)*fac_shield(j) ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + & *fac_shield(i)*fac_shield(j) C Diagnostics. Comment out or remove after debugging! c ees0p(num_conti,i)=0.5D0*fac3*ees0pij c ees0m(num_conti,i)=0.5D0*fac3*ees0mij c ees0m(num_conti,i)=0.0D0 C End diagnostics. -c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, -c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont - facont_hb(num_conti,i)=fcont - if (calc_grad) then +c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij, +c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont C Angular derivatives of the contact function + ees0pij1=fac3/ees0pij ees0mij1=fac3/ees0mij fac3p=-3.0D0*fac3*rrmij @@ -2449,6 +3378,9 @@ c ecosam=0.0D0 c ecosbm=0.0D0 c ecosgm=0.0D0 C End diagnostics + facont_hb(num_conti,i)=fcont + + if (calc_grad) then fprimcont=fprimcont/rij cd facont_hb(num_conti,i)=1.0D0 C Following line is for diagnostics. @@ -2472,24 +3404,39 @@ C Derivatives due to the contact function gacont_hbr(2,num_conti,i)=fprimcont*yj gacont_hbr(3,num_conti,i)=fprimcont*zj do k=1,3 - ghalfp=0.5D0*gggp(k) - ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)=ghalfp +c +c 10/24/08 cgrad and ! comments indicate the parts of the code removed +c following the change of gradient-summation algorithm. +c +cgrad ghalfp=0.5D0*gggp(k) +cgrad ghalfm=0.5D0*gggm(k) + gacontp_hb1(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)=ghalfp + & *fac_shield(i)*fac_shield(j) + + gacontp_hb2(k,num_conti,i)=!ghalfp & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)=ghalfm + & *fac_shield(i)*fac_shield(j) + + gacontm_hb1(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)=ghalfm + & *fac_shield(i)*fac_shield(j) + + gacontm_hb2(k,num_conti,i)=!ghalfm & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + & *fac_shield(i)*fac_shield(j) + gacontm_hb3(k,num_conti,i)=gggm(k) + & *fac_shield(i)*fac_shield(j) + enddo - endif C Diagnostics. Comment out or remove after debugging! cdiag do k=1,3 cdiag gacontp_hb1(k,num_conti,i)=0.0D0 @@ -2499,25 +3446,37 @@ cdiag gacontm_hb1(k,num_conti,i)=0.0D0 cdiag gacontm_hb2(k,num_conti,i)=0.0D0 cdiag gacontm_hb3(k,num_conti,i)=0.0D0 cdiag enddo + + endif ! calc_grad + ENDIF ! wcorr endif ! num_conti.le.maxconts endif ! fcont.gt.0 endif ! j.gt.i+1 - 1216 continue - enddo ! j - num_cont_hb(i)=num_conti - 1215 continue - enddo ! i -cd do i=1,nres -cd write (iout,'(i3,3f10.5,5x,3f10.5)') -cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) -cd enddo -c 12/7/99 Adam eello_turn3 will be considered as a separate energy term -ccc eel_loc=eel_loc+eello_turn3 + if (calc_grad) then + if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then + do k=1,4 + do l=1,3 + ghalf=0.5d0*agg(l,k) + aggi(l,k)=aggi(l,k)+ghalf + aggi1(l,k)=aggi1(l,k)+agg(l,k) + aggj(l,k)=aggj(l,k)+ghalf + enddo + enddo + if (j.eq.nres-1 .and. i.lt.j-2) then + do k=1,4 + do l=1,3 + aggj1(l,k)=aggj1(l,k)+agg(l,k) + enddo + enddo + endif + endif + endif ! calc_grad +c t_eelecij=t_eelecij+MPI_Wtime()-time00 return end C----------------------------------------------------------------------------- - subroutine eturn34(i,j,eello_turn3,eello_turn4) + subroutine eturn3(i,eello_turn3) C Third- and fourth-order contributions from turns implicit real*8 (a-h,o-z) include 'DIMENSIONS' @@ -2533,14 +3492,25 @@ C Third- and fourth-order contributions from turns include 'COMMON.TORSION' include 'COMMON.VECTORS' include 'COMMON.FFIELD' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' dimension ggg(3) double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), - & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2), + & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2), + & auxgmat2(2,2),auxgmatt2(2,2) double precision agg(3,4),aggi(3,4),aggi1(3,4), - & aggj(3,4),aggj1(3,4),a_temp(2,2) - common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 - if (j.eq.i+2) then + & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 + j=i+2 +c write (iout,*) "eturn3",i,j,j1,j2 + a_temp(1,1)=a22 + a_temp(1,2)=a23 + a_temp(2,1)=a32 + a_temp(2,2)=a33 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Third-order contributions @@ -2553,47 +3523,132 @@ C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn3(i,a_temp,eello_turn3_num) call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) +c auxalary matices for theta gradient +c auxalary matrix for i+1 and constant i+2 + call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1)) +c auxalary matrix for i+2 and constant i+1 + call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1)) call transpose2(auxmat(1,1),auxmat1(1,1)) + call transpose2(auxgmat1(1,1),auxgmatt1(1,1)) + call transpose2(auxgmat2(1,1),auxgmatt2(1,1)) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) + call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1)) + call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.4 +C fac_shield(j)=0.6 + endif eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + eello_t3=0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(6heturn3,2i5,0pf7.3)') i,i+2, + & eello_t3 + if (calc_grad) then +C#ifdef NEWCORR +C Derivatives in theta + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg) + & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3 + & *fac_shield(i)*fac_shield(j) +C#endif + +C Derivatives in shield mode + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j) +C & *2.0 + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t3(k,i)=gshieldc_t3(k,i)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j)=gshieldc_t3(k,j)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ + & grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ + & grad_shield(k,j)*eello_t3/fac_shield(j) + enddo + endif + +C if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') cd write (2,*) 'i,',i,' j',j,'eello_turn3', cd & 0.5d0*(pizda(1,1)+pizda(2,2)), cd & ' eello_turn3_num',4*eello_turn3_num - if (calc_grad) then C Derivatives in gamma(i) call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),pizda(1,1)) - call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) + call transpose2(auxmat2(1,1),auxmat3(1,1)) + call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) - call transpose2(auxmat2(1,1),pizda(1,1)) - call matmat2(a_temp(1,1),pizda(1,1),pizda(1,1)) + call transpose2(auxmat2(1,1),auxmat3(1,1)) + call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) gel_loc_turn3(i+1)=gel_loc_turn3(i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) C Cartesian derivatives do l=1,3 - a_temp(1,1)=aggi(l,1) - a_temp(1,2)=aggi(l,2) - a_temp(2,1)=aggi(l,3) - a_temp(2,2)=aggi(l,4) +c ghalf1=0.5d0*agg(l,1) +c ghalf2=0.5d0*agg(l,2) +c ghalf3=0.5d0*agg(l,3) +c ghalf4=0.5d0*agg(l,4) + a_temp(1,1)=aggi(l,1)!+ghalf1 + a_temp(1,2)=aggi(l,2)!+ghalf2 + a_temp(2,1)=aggi(l,3)!+ghalf3 + a_temp(2,2)=aggi(l,4)!+ghalf4 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i)=gcorr3_turn(l,i) & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggi1(l,1) - a_temp(1,2)=aggi1(l,2) - a_temp(2,1)=aggi1(l,3) - a_temp(2,2)=aggi1(l,4) + & *fac_shield(i)*fac_shield(j) + + a_temp(1,1)=aggi1(l,1)!+agg(l,1) + a_temp(1,2)=aggi1(l,2)!+agg(l,2) + a_temp(2,1)=aggi1(l,3)!+agg(l,3) + a_temp(2,2)=aggi1(l,4)!+agg(l,4) call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) & +0.5d0*(pizda(1,1)+pizda(2,2)) - a_temp(1,1)=aggj(l,1) - a_temp(1,2)=aggj(l,2) - a_temp(2,1)=aggj(l,3) - a_temp(2,2)=aggj(l,4) + & *fac_shield(i)*fac_shield(j) + a_temp(1,1)=aggj(l,1)!+ghalf1 + a_temp(1,2)=aggj(l,2)!+ghalf2 + a_temp(2,1)=aggj(l,3)!+ghalf3 + a_temp(2,2)=aggj(l,4)!+ghalf4 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j)=gcorr3_turn(l,j) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -2601,9 +3656,46 @@ C Cartesian derivatives call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) gcorr3_turn(l,j1)=gcorr3_turn(l,j1) & +0.5d0*(pizda(1,1)+pizda(2,2)) + & *fac_shield(i)*fac_shield(j) enddo - endif - else if (j.eq.i+3 .and. itype(i+2).ne.21) then + + endif ! calc_grad + + return + end +C------------------------------------------------------------------------------- + subroutine eturn4(i,eello_turn4) +C Third- and fourth-order contributions from turns + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.IOUNITS' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.CONTACTS' + include 'COMMON.TORSION' + include 'COMMON.VECTORS' + include 'COMMON.FFIELD' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' + dimension ggg(3) + double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), + & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), + & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2), + & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2), + & gte1t(2,2),gte2t(2,2),gte3t(2,2), + & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2), + & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2) + double precision agg(3,4),aggi(3,4),aggi1(3,4), + & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) + common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, + & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, + & num_conti,j1,j2 + j=i+3 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C Fourth-order contributions @@ -2616,52 +3708,188 @@ C (i+1)o----i C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd call checkint_turn4(i,a_temp,eello_turn4_num) - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) +c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 +c write(iout,*)"WCHODZE W PROGRAM" + a_temp(1,1)=a22 + a_temp(1,2)=a23 + a_temp(2,1)=a32 + a_temp(2,2)=a33 + iti1=itype2loc(itype(i+1)) + iti2=itype2loc(itype(i+2)) + iti3=itype2loc(itype(i+3)) +c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 call transpose2(EUg(1,1,i+1),e1t(1,1)) call transpose2(Eug(1,1,i+2),e2t(1,1)) call transpose2(Eug(1,1,i+3),e3t(1,1)) +C Ematrix derivative in theta + call transpose2(gtEUg(1,1,i+1),gte1t(1,1)) + call transpose2(gtEug(1,1,i+2),gte2t(1,1)) + call transpose2(gtEug(1,1,i+3),gte3t(1,1)) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) +c eta1 in derivative theta + call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) +c auxgvec is derivative of Ub2 so i+3 theta + call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1)) +c auxalary matrix of E i+1 + call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1)) +c s1=0.0 +c gs1=0.0 + s1=scalar2(b1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+3 + gs23=scalar2(gtb1(1,i+2),auxvec(1)) +c derivative of theta i+2 with constant i+2 + gs32=scalar2(b1(1,i+2),auxgvec(1)) +c derivative of E matix in theta of i+1 + gsE13=scalar2(b1(1,i+2),auxgEvec1(1)) + call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) +c ea31 in derivative theta + call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) +c auxilary matrix auxgvec of Ub2 with constant E matirx + call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1)) +c auxilary matrix auxgEvec1 of E matix with Ub2 constant + call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1)) + +c s2=0.0 +c gs2=0.0 + s2=scalar2(b1(1,i+1),auxvec(1)) +c derivative of theta i+1 with constant i+3 + gs13=scalar2(gtb1(1,i+1),auxvec(1)) +c derivative of theta i+2 with constant i+1 + gs21=scalar2(b1(1,i+1),auxgvec(1)) +c derivative of theta i+3 with constant i+1 + gsE31=scalar2(b1(1,i+1),auxgEvec3(1)) +c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2), +c & gtb1(1,i+1) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) +c two derivatives over diffetent matrices +c gtae3e2 is derivative over i+3 + call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1)) +c ae3gte2 is derivative over i+2 + call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) +c three possible derivative over theta E matices +c i+1 + call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1)) +c i+2 + call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1)) +c i+3 + call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) + + gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2)) + gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2)) + gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2)) + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 +C else +C fac_shield(i)=0.6 +C fac_shield(j)=0.4 + endif eello_turn4=eello_turn4-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) + eello_t4=-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) +c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)') + & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3 +C Now derivative over shield: + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (shield_mode.gt.0)) then +C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j) +C & *2.0 + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ + & rlocshield + & +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) + & +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t4(k,i)=gshieldc_t4(k,i)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j)=gshieldc_t4(k,j)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ + & grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ + & grad_shield(k,j)*eello_t4/fac_shield(j) + enddo + endif cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), cd & ' eello_turn4_num',8*eello_turn4_num +#ifdef NEWCORR + gloc(nphi+i,icg)=gloc(nphi+i,icg) + & -(gs13+gsE13+gsEE1)*wturn4 + & *fac_shield(i)*fac_shield(j) + gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg) + & -(gs23+gs21+gsEE2)*wturn4 + & *fac_shield(i)*fac_shield(j) + + gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg) + & -(gs32+gsE31+gsEE3)*wturn4 + & *fac_shield(i)*fac_shield(j) + +c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)- +c & gs2 +#endif + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') + & 'eturn4',i,j,-(s1+s2+s3) +c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), +c & ' eello_turn4_num',8*eello_turn4_num C Derivatives in gamma(i) - if (calc_grad) then call transpose2(EUgder(1,1,i+1),e1tder(1,1)) call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+1) call transpose2(EUgder(1,1,i+2),e2tder(1,1)) call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) + & *fac_shield(i)*fac_shield(j) C Derivatives in gamma(i+2) call transpose2(EUgder(1,1,i+3),e3tder(1,1)) call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) - call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1)) - call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) + s2=scalar2(b1(1,i+1),auxvec(1)) + call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) + call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) + if (calc_grad) then C Cartesian derivatives C Derivatives of this turn contributions in DC(i+2) if (j.lt.nres-1) then @@ -2672,15 +3900,16 @@ C Derivatives of this turn contributions in DC(i+2) a_temp(2,2)=agg(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) ggg(l)=-(s1+s2+s3) gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo endif C Remaining derivatives of this turn contribution @@ -2691,59 +3920,65 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggi(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) a_temp(2,2)=aggi1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) a_temp(2,2)=aggj(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) a_temp(2,2)=aggj1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,iti2),auxvec(1)) + s1=scalar2(b1(1,i+2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,iti1),auxvec(1)) + s2=scalar2(b1(1,i+1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) +c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) + & *fac_shield(i)*fac_shield(j) enddo - endif - endif + + endif ! calc_grad + return end C----------------------------------------------------------------------------- @@ -2789,6 +4024,7 @@ C implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' + include 'COMMON.CONTROL' include 'COMMON.GEO' include 'COMMON.VAR' include 'COMMON.LOCAL' @@ -2804,7 +4040,7 @@ cd print '(a)','Enter ESCP' c write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e, c & ' scal14',scal14 do i=iatscp_s,iatscp_e - if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) c write (iout,*) "i",i," iteli",iteli," nscp_gr",nscp_gr(i), c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) @@ -2812,37 +4048,94 @@ c & " iscp",(iscpstart(i,j),iscpend(i,j),j=1,nscp_gr(i)) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) - +C Returning the ith atom to box + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) - if (itypj.eq.21) cycle + itypj=iabs(itype(j)) + if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions c xj=c(1,nres+j)-xi c yj=c(2,nres+j)-yi c zj=c(3,nres+j)-zi C Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) +C returning the jth atom to box + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 +C Finding the closest jth atom + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif rrij=1.0D0/(xj*xj+yj*yj+zj*zj) +C sss is scaling function for smoothing the cutoff gradient otherwise +C the gradient would not be continuouse + sss=sscale(1.0d0/(dsqrt(rrij))) + if (sss.le.0.0d0) cycle + sssgrad=sscagrad(1.0d0/(dsqrt(rrij))) fac=rrij**expon2 e1=fac*fac*aad(itypj,iteli) e2=fac*bad(itypj,iteli) if (iabs(j-i) .le. 2) then e1=scal14*e1 e2=scal14*e2 - evdw2_14=evdw2_14+e1+e2 + evdw2_14=evdw2_14+(e1+e2)*sss endif evdwij=e1+e2 -c write (iout,*) i,j,evdwij - evdw2=evdw2+evdwij +c write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') +c & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli), +c & bad(itypj,iteli) + evdw2=evdw2+evdwij*sss + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') + & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli), + & bad(itypj,iteli) + if (calc_grad) then C C Calculate contributions to the gradient in the virtual-bond and SC vectors. C - fac=-(evdwij+e1)*rrij + fac=-(evdwij+e1)*rrij*sss + fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -2872,7 +4165,7 @@ cd write (iout,*) ggg(1),ggg(2),ggg(3) gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) enddo enddo - endif + endif ! calc_grad enddo enddo ! iint 1225 continue @@ -2907,10 +4200,13 @@ C include 'COMMON.DERIV' include 'COMMON.VAR' include 'COMMON.INTERACT' + include 'COMMON.CONTROL' + include 'COMMON.IOUNITS' dimension ggg(3) ehpb=0.0D0 -cd print *,'edis: nhpb=',nhpb,' fbr=',fbr -cd print *,'link_start=',link_start,' link_end=',link_end +c write (iout,*)'edis: nhpb=',nhpb,' fbr=',fbr +c write (iout,*)'link_start=',link_start,' link_end=',link_end +C write(iout,*) link_end, "link_end" if (link_end.eq.0) return do i=link_start,link_end C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a @@ -2927,24 +4223,102 @@ C iii and jjj point to the residues for which the distance is assigned. endif C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. - if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then +C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. +C & iabs(itype(jjj)).eq.1) then +C write(iout,*) constr_dist,"const" + if (.not.dyn_ss .and. i.le.nss) then + if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. + & iabs(itype(jjj)).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij - else -C Calculate the distance between the two points and its difference from the -C target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) + endif !ii.gt.neres + else if (ii.gt.nres .and. jj.gt.nres) then +c Restraints from contact prediction + dd=dist(ii,jj) + if (constr_dist.eq.11) then +C ehpb=ehpb+fordepth(i)**4.0d0 +C & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj, + & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd +C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, +C & ehpb,fordepth(i),dd +C write(iout,*) ehpb,"atu?" +C ehpb,"tu?" +C fac=fordepth(i)**4.0d0 +C & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "beta nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + dd=dist(ii,jj) + rdis=dd-dhpb(i) C Get the force constant corresponding to this distance. - waga=forcon(i) + waga=forcon(i) C Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "beta reg",dd,waga*rdis*rdis C C Evaluate gradient. C - fac=waga*rdis/dd -cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -cd & ' waga=',waga,' fac=',fac + fac=waga*rdis/dd + endif !end dhpb1(i).gt.0 + endif !end const_dist=11 + do j=1,3 + ggg(j)=fac*(c(j,jj)-c(j,ii)) + enddo + do j=1,3 + ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) + ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) + enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo + else !ii.gt.nres +C write(iout,*) "before" + dd=dist(ii,jj) +C write(iout,*) "after",dd + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)!**4.0d0 + & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + if (energy_dec) write (iout,'(a6,2i5,6f10.3)') "edisl",ii,jj, + & dd,dhpb(i),dhpb1(i),forcon(i),fordepth(i),ehpb + fac=fordepth(i)!**4.0d0 + & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd +C ehpb=ehpb+fordepth(i)**4*rlornmr1(dd,dhpb(i),dhpb1(i)) +C fac=fordepth(i)**4*rlornmr1prim(dd,dhpb(i),dhpb1(i))/dd +C print *,ehpb,"tu?" +C write(iout,*) ehpb,"btu?", +C & dd,dhpb(i),dhpb1(i),fordepth(i),forcon(i) +C write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, +C & ehpb,fordepth(i),dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +c write (iout,*) "alph nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + rdis=dd-dhpb(i) +C Get the force constant corresponding to this distance. + waga=forcon(i) +C Calculate the contribution to energy. + ehpb=ehpb+waga*rdis*rdis +c write (iout,*) "alpha reg",dd,waga*rdis*rdis +C +C Evaluate gradient. +C + fac=waga*rdis/dd + endif + endif + do j=1,3 ggg(j)=fac*(c(j,jj)-c(j,ii)) enddo @@ -2964,7 +4338,7 @@ C Cartesian gradient in the SC vectors (ghpbx). enddo endif enddo - ehpb=0.5D0*ehpb + if (constr_dist.ne.11) ehpb=0.5D0*ehpb return end C-------------------------------------------------------------------------- @@ -2987,7 +4361,7 @@ C include 'COMMON.VAR' include 'COMMON.IOUNITS' double precision erij(3),dcosom1(3),dcosom2(3),gg(3) - itypi=itype(i) + itypi=iabs(itype(i)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -2995,7 +4369,7 @@ C dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=dsc_inv(itypi) - itypj=itype(j) + itypj=iabs(itype(j)) dscj_inv=dsc_inv(itypj) xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -3070,42 +4444,48 @@ c include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' - logical energy_dec /.false./ double precision u(3),ud(3) estr=0.0d0 - write (iout,*) "distchainmax",distchainmax + estr1=0.0d0 +c write (iout,*) "distchainmax",distchainmax do i=nnt+1,nct - if (itype(i-1).eq.21 .or. itype(i).eq.21) then - estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) - do j=1,3 - gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) - & *dc(j,i-1)/vbld(i) - enddo - if (energy_dec) write(iout,*) - & "estr1",i,vbld(i),distchainmax, - & gnmr1(vbld(i),-1.0d0,distchainmax) - else + if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle +C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) +C do j=1,3 +C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) +C & *dc(j,i-1)/vbld(i) +C enddo +C if (energy_dec) write(iout,*) +C & "estr1",i,vbld(i),distchainmax, +C & gnmr1(vbld(i),-1.0d0,distchainmax) +C else + if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then + diff = vbld(i)-vbldpDUM +C write(iout,*) i,diff + else diff = vbld(i)-vbldp0 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff + endif estr=estr+diff*diff do j=1,3 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) enddo - endif - +C endif +C write (iout,'(a7,i5,4f7.3)') +C & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff enddo - estr=0.5d0*AKP*estr + estr=0.5d0*AKP*estr+estr1 c c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included c do i=nnt,nct - iti=itype(i) - if (iti.ne.10 .and. iti.ne.21) then + iti=iabs(itype(i)) + if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff +C write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, +C & AKSC(1,iti),AKSC(1,iti)*diff*diff estr=estr+0.5d0*AKSC(1,iti)*diff*diff do j=1,3 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) @@ -3147,7 +4527,7 @@ c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi) end #ifdef CRYST_THETA C-------------------------------------------------------------------------- - subroutine ebend(etheta) + subroutine ebend(etheta,ethetacnstr) C C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral C angles gamma and its derivatives in consecutive thetas and gammas. @@ -3164,27 +4544,48 @@ C include 'COMMON.IOUNITS' include 'COMMON.NAMES' include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' common /calcthet/ term1,term2,termm,diffak,ratak, & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, & delthe0,sig0inv,sigtc,sigsqtc,delthec,it double precision y(2),z(2) delta=0.02d0*pi - time11=dexp(-2*time) - time12=1.0d0 +c time11=dexp(-2*time) +c time12=1.0d0 etheta=0.0D0 c write (iout,*) "nres",nres c write (*,'(a,i2)') 'EBEND ICG=',icg c write (iout,*) ithet_start,ithet_end do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle +C if (itype(i-1).eq.ntyp1) cycle + if (i.le.2) cycle + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle C Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) it=itype(i-1) - if (i.gt.3 .and. itype(i-2).ne.21) then + ichir1=isign(1,itype(i-2)) + ichir2=isign(1,itype(i)) + if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) + if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) + if (itype(i-1).eq.10) then + itype1=isign(10,itype(i-2)) + ichir11=isign(1,itype(i-2)) + ichir12=isign(1,itype(i-2)) + itype2=isign(10,itype(i)) + ichir21=isign(1,itype(i)) + ichir22=isign(1,itype(i)) + endif + if (i.eq.3) then + y(1)=0.0D0 + y(2)=0.0D0 + else + + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) - icrc=0 - call proc_proc(phii,icrc) +c icrc=0 +c call proc_proc(phii,icrc) if (icrc.eq.1) phii=150.0 #else phii=phi(i) @@ -3195,11 +4596,12 @@ C Zero the energy function and its derivative at 0 or pi. y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.21) then + endif + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) - icrc=0 - call proc_proc(phii1,icrc) +c icrc=0 +c call proc_proc(phii1,icrc) if (icrc.eq.1) phii1=150.0 phii1=pinorm(phii1) z(1)=cos(phii1) @@ -3217,8 +4619,12 @@ C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). C In following comments this theta will be referred to as t_c. thet_pred_mean=0.0d0 do k=1,2 - athetk=athet(k,it) - bthetk=bthet(k,it) + athetk=athet(k,it,ichir1,ichir2) + bthetk=bthet(k,it,ichir1,ichir2) + if (it.eq.10) then + athetk=athet(k,itype1,ichir11,ichir12) + bthetk=bthet(k,itype2,ichir21,ichir22) + endif thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) enddo c write (iout,*) "thet_pred_mean",thet_pred_mean @@ -3226,8 +4632,16 @@ c write (iout,*) "thet_pred_mean",thet_pred_mean thet_pred_mean=thet_pred_mean*ss+a0thet(it) c write (iout,*) "thet_pred_mean",thet_pred_mean C Derivatives of the "mean" values in gamma1 and gamma2. - dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss - dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss + dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) + &+athet(2,it,ichir1,ichir2)*y(1))*ss + dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) + & +bthet(2,it,ichir1,ichir2)*z(1))*ss + if (it.eq.10) then + dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) + &+athet(2,itype1,ichir11,ichir12)*y(1))*ss + dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) + & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss + endif if (theta(i).gt.pi-delta) then call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, & E_tc0) @@ -3250,12 +4664,41 @@ C Derivatives of the "mean" values in gamma1 and gamma2. & E_theta,E_tc) endif etheta=etheta+ethetai +c write (iout,'(a6,i5,0pf7.3,f7.3,i5)') +c & 'ebend',i,ethetai,theta(i),itype(i) c write (iout,'(2i3,3f8.3,f10.5)') i,it,rad2deg*theta(i), c & rad2deg*phii,rad2deg*phii1,ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) - 1215 continue +c 1215 continue + enddo + ethetacnstr=0.0d0 +C print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=1,ntheta_constr + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif +C if (energy_dec) then +C write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", +C & i,itheta,rad2deg*thetiii, +C & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), +C & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, +C & gloc(itheta+nphi-2,icg) +C endif enddo C Ufff.... We've done all this!!! return @@ -3390,6 +4833,7 @@ C include 'COMMON.NAMES' include 'COMMON.FFIELD' include 'COMMON.CONTROL' + include 'COMMON.TORCNSTR' double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), @@ -3398,37 +4842,53 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end - if (itype(i-1).eq.21) cycle +C if (i.eq.2) cycle +C if (itype(i-1).eq.ntyp1) cycle + if (i.le.2) cycle + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle + if (iabs(itype(i+1)).eq.20) iblock=2 + if (iabs(itype(i+1)).ne.20) iblock=1 dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 theti2=0.5d0*theta(i) - ityp2=ithetyp(itype(i-1)) + ityp2=ithetyp((itype(i-1))) do k=1,nntheterm coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.21) then + if (i.eq.3) then + phii=0.0d0 + ityp1=nthetyp+1 + do k=1,nsingle + cosph1(k)=0.0d0 + sinph1(k)=0.0d0 + enddo + else + if (i.gt.3 .and. itype(i-3).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) #endif - ityp1=ithetyp(itype(i-2)) + ityp1=ithetyp((itype(i-2))) do k=1,nsingle cosph1(k)=dcos(k*phii) sinph1(k)=dsin(k*phii) enddo else phii=0.0d0 - ityp1=nthetyp+1 +c ityp1=nthetyp+1 do k=1,nsingle + ityp1=ithetyp((itype(i-2))) cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.21) then + endif + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3436,14 +4896,15 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) #else phii1=phi(i+1) #endif - ityp3=ithetyp(itype(i)) + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=dcos(k*phii1) sinph2(k)=dsin(k*phii1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 +c ityp3=nthetyp+1 + ityp3=ithetyp((itype(i))) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -3452,7 +4913,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) c write (iout,*) "i",i," ityp1",itype(i-2),ityp1, c & " ityp2",itype(i-1),ityp2," ityp3",itype(i),ityp3 c call flush(iout) - ethetai=aa0thet(ityp1,ityp2,ityp3) + ethetai=aa0thet(ityp1,ityp2,ityp3,iblock) do k=1,ndouble do l=1,k-1 ccl=cosph1(l)*cosph2(k-l) @@ -3474,11 +4935,12 @@ c call flush(iout) enddo endif do k=1,ntheterm - ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) - dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) + ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k) + dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) & *coskt(k) if (lprn) - & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), + & write (iout,*) "k",k," + & aathet",aathet(k,ityp1,ityp2,ityp3,iblock), & " ethetai",ethetai enddo if (lprn) then @@ -3497,24 +4959,24 @@ c call flush(iout) endif do m=1,ntheterm2 do k=1,nsingle - aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) - & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) - & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) - & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) + aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) + & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) + & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) + & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*aux*coskt(m) dephii=dephii+k*sinkt(m)*( - & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- - & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)) dephii1=dephii1+k*sinkt(m)*( - & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- - & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) + & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)) if (lprn) & write (iout,*) "m",m," k",k," bbthet", - & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", - & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", - & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", - & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", + & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", + & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", + & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai enddo enddo if (lprn) @@ -3522,28 +4984,29 @@ c call flush(iout) do m=1,ntheterm3 do k=2,ndouble do l=1,k-1 - aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) + aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l) ethetai=ethetai+sinkt(m)*aux dethetai=dethetai+0.5d0*m*coskt(m)*aux dephii=dephii+l*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) dephii1=dephii1+(k-l)*sinkt(m)*( - & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ - & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ - & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- - & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)) if (lprn) then write (iout,*) "m",m," k",k," l",l," ffthet", - & ffthet(l,k,m,ityp1,ityp2,ityp3), - & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", - & ggthet(l,k,m,ityp1,ityp2,ityp3), - & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai + & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet", + & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock), + & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock), + & " ethetai",ethetai write (iout,*) cosph1ph2(l,k)*sinkt(m), & cosph1ph2(k,l)*sinkt(m), & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) @@ -3558,7 +5021,8 @@ c call flush(iout) etheta=etheta+ethetai if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 - gloc(nphi+i-2,icg)=wang*dethetai +c gloc(nphi+i-2,icg)=wang*dethetai + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai enddo return end @@ -3586,14 +5050,14 @@ C ALPHA and OMEGA. common /sccalc/ time11,time12,time112,theti,it,nlobit delta=0.02d0*pi escloc=0.0D0 -c write (iout,'(a)') 'ESC' +C write (iout,*) 'ESC' do i=loc_start,loc_end it=itype(i) - if (it.eq.21) cycle + if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 - nlobit=nlob(it) + nlobit=nlob(iabs(it)) c print *,'i=',i,' it=',it,' nlobit=',nlobit -c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad +C write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad theti=theta(i+1)-pipol x(1)=dtan(theti) x(2)=alph(i) @@ -3629,8 +5093,8 @@ c write (iout,*) "i",i," x",x(1),x(2),x(3) dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) enddo dersc(2)=dersc(2)+ssd*(escloci-esclocbi) -c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd + write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, + & esclocbi,ss,ssd escloci=ss*escloci+(1.0d0-ss)*esclocbi c escloci=esclocbi c write (iout,*) escloci @@ -3664,15 +5128,17 @@ c write (iout,*) escloci enddo dersc(2)=dersc(2)+ssd*(escloci-esclocbi) c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, -c & esclocbi,ss,ssd +c & esclocbi,ss,ssd escloci=ss*escloci+(1.0d0-ss)*esclocbi -c write (iout,*) escloci +C write (iout,*) 'i=',i, escloci else call enesc(x,escloci,dersc,ddummy,.false.) endif escloc=escloc+escloci -c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc +C write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc + write (iout,'(a6,i5,0pf7.3)') + & 'escloc',i,escloci gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ & wscloc*dersc(1) @@ -3746,7 +5212,7 @@ C Compute the contribution to SC energy and derivatives do iii=-1,1 do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin) cd print *,'j=',j,' expfac=',expfac escloc_i=escloc_i+expfac do k=1,3 @@ -3827,7 +5293,7 @@ C Compute the contribution to SC energy and derivatives dersc12=0.0d0 do j=1,nlobit - expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) + expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin) escloc_i=escloc_i+expfac do k=1,2 dersc(k)=dersc(k)+Ax(k,j)*expfac @@ -3882,7 +5348,7 @@ C delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.21) cycle + if (itype(i).eq.ntyp1) cycle costtab(i+1) =dcos(theta(i+1)) sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) @@ -3891,7 +5357,7 @@ C cosfac=dsqrt(cosfac2) sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) - it=itype(i) + it=iabs(itype(i)) if (it.eq.10) goto 1 c C Compute the axes of tghe local cartesian coordinates system; store in @@ -3909,7 +5375,7 @@ C & dc_norm(3,i+nres) y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac enddo do j = 1,3 - z_prime(j) = -uz(j,i-1) + z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i))) enddo c write (2,*) "i",i c write (2,*) "x_prime",(x_prime(j),j=1,3) @@ -3941,7 +5407,7 @@ C C Compute the energy of the ith side cbain C c write (2,*) "xx",xx," yy",yy," zz",zz - it=itype(i) + it=iabs(itype(i)) do j = 1,65 x(j) = sc_parmin(j,it) enddo @@ -3949,7 +5415,7 @@ c write (2,*) "xx",xx," yy",yy," zz",zz Cc diagnostics - remove later xx1 = dcos(alph(2)) yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsin(alph(2))*dsin(omeg(2)) + zz1 = -dsign(1.0d0,itype(i))*dsin(alph(2))*dsin(omeg(2)) write(2,'(3f8.1,3f9.3,1x,3f9.3)') & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, & xx1,yy1,zz1 @@ -3992,6 +5458,8 @@ c & dscp1,dscp2,sumene c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) escloc = escloc + sumene c write (2,*) "escloc",escloc +c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i), +c & zz,xx,yy if (.not. calc_grad) goto 1 #ifdef DEBUG C @@ -4120,8 +5588,10 @@ c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) dZZ_Ci1(k)=0.0d0 dZZ_Ci(k)=0.0d0 do j=1,3 - dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) - dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) + dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) + dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) + & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) enddo dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) @@ -4252,7 +5722,7 @@ c------------------------------------------------------------------------------ C----------------------------------------------------------------------------- #ifdef CRYST_TOR C----------------------------------------------------------------------------- - subroutine etor(etors,edihcnstr,fact) + subroutine etor(etors,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' @@ -4273,8 +5743,8 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1) cycle itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) @@ -4314,30 +5784,11 @@ C Proline-Proline pair is a special case... gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=phii-phi0(i) - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - endif -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr return end c------------------------------------------------------------------------------ #else - subroutine etor(etors,edihcnstr,fact) + subroutine etor(etors,fact) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' @@ -4358,17 +5809,25 @@ C Set lprn=.true. for debugging c lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21) cycle + if (i.le.2) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle +C if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 +C & .or. itype(i).eq.ntyp1) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0) goto 1215 + if (iabs(itype(i)).eq.20) then + iblock=2 + else + iblock=1 + endif itori=itortyp(itype(i-2)) itori1=itortyp(itype(i-1)) phii=phi(i) gloci=0.0D0 C Regular cosine and sine terms - do j=1,nterm(itori,itori1) - v1ij=v1(j,itori,itori1) - v2ij=v2(j,itori,itori1) + do j=1,nterm(itori,itori1,iblock) + v1ij=v1(j,itori,itori1,iblock) + v2ij=v2(j,itori,itori1,iblock) cosphi=dcos(j*phii) sinphi=dsin(j*phii) etors=etors+v1ij*cosphi+v2ij*sinphi @@ -4381,52 +5840,28 @@ C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 C cosphi=dcos(0.5d0*phii) sinphi=dsin(0.5d0*phii) - do j=1,nlor(itori,itori1) + do j=1,nlor(itori,itori1,iblock) vl1ij=vlor1(j,itori,itori1) vl2ij=vlor2(j,itori,itori1) vl3ij=vlor3(j,itori,itori1) pom=vl2ij*cosphi+vl3ij*sinphi pom1=1.0d0/(pom*pom+1.0d0) etors=etors+vl1ij*pom1 +c if (energy_dec) etors_ii=etors_ii+ +c & vl1ij*pom1 pom=-pom*pom1*pom1 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom enddo C Subtract the constant term - etors=etors-v0(itori,itori1) + etors=etors-v0(itori,itori1,iblock) if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) + & (v1(j,itori,itori1,1),j=1,6),(v2(j,itori,itori1,1),j=1,6) gloc(i-3,icg)=gloc(i-3,icg)+wtor*fact*gloci c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) 1215 continue enddo -! 6/20/98 - dihedral angle constraints - edihcnstr=0.0d0 - do i=1,ndih_constr - itori=idih_constr(i) - phii=phi(itori) - difi=pinorm(phii-phi0(i)) - edihi=0.0d0 - if (difi.gt.drange(i)) then - difi=difi-drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - edihi=0.25d0*ftors*difi**4 - else if (difi.lt.-drange(i)) then - difi=difi+drange(i) - edihcnstr=edihcnstr+0.25d0*ftors*difi**4 - gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 - edihi=0.25d0*ftors*difi**4 - else - difi=0.0d0 - endif -c write (iout,'(2i5,4f10.5,e15.5)') i,itori,phii,phi0(i),difi, -c & drange(i),edihi -! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, -! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) - enddo -! write (iout,*) 'edihcnstr',edihcnstr return end c---------------------------------------------------------------------------- @@ -4452,8 +5887,12 @@ C Set lprn=.true. for debugging c lprn=.true. etors_d=0.0D0 do i=iphi_start,iphi_end-1 - if (itype(i-2).eq.21 .or. itype(i-1).eq.21 - & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle + if (i.le.3) cycle +C if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 +C & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or. + & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or. + & (itype(i+1).eq.ntyp1)) cycle if (itel(i-2).eq.0 .or. itel(i-1).eq.0 .or. itel(i).eq.0) & goto 1215 itori=itortyp(itype(i-2)) @@ -4463,12 +5902,14 @@ c lprn=.true. phii1=phi(i+1) gloci1=0.0D0 gloci2=0.0D0 + iblock=1 + if (iabs(itype(i+1)).eq.20) iblock=2 C Regular cosine and sine terms - do j=1,ntermd_1(itori,itori1,itori2) - v1cij=v1c(1,j,itori,itori1,itori2) - v1sij=v1s(1,j,itori,itori1,itori2) - v2cij=v1c(2,j,itori,itori1,itori2) - v2sij=v1s(2,j,itori,itori1,itori2) + do j=1,ntermd_1(itori,itori1,itori2,iblock) + v1cij=v1c(1,j,itori,itori1,itori2,iblock) + v1sij=v1s(1,j,itori,itori1,itori2,iblock) + v2cij=v1c(2,j,itori,itori1,itori2,iblock) + v2sij=v1s(2,j,itori,itori1,itori2,iblock) cosphi1=dcos(j*phii) sinphi1=dsin(j*phii) cosphi2=dcos(j*phii1) @@ -4478,12 +5919,12 @@ C Regular cosine and sine terms gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) enddo - do k=2,ntermd_2(itori,itori1,itori2) + do k=2,ntermd_2(itori,itori1,itori2,iblock) do l=1,k-1 - v1cdij = v2c(k,l,itori,itori1,itori2) - v2cdij = v2c(l,k,itori,itori1,itori2) - v1sdij = v2s(k,l,itori,itori1,itori2) - v2sdij = v2s(l,k,itori,itori1,itori2) + v1cdij = v2c(k,l,itori,itori1,itori2,iblock) + v2cdij = v2c(l,k,itori,itori1,itori2,iblock) + v1sdij = v2s(k,l,itori,itori1,itori2,iblock) + v2sdij = v2s(l,k,itori,itori1,itori2,iblock) cosphi1p2=dcos(l*phii+(k-l)*phii1) cosphi1m2=dcos(l*phii-(k-l)*phii1) sinphi1p2=dsin(l*phii+(k-l)*phii1) @@ -4493,7 +5934,7 @@ C Regular cosine and sine terms gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 - & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) + & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) enddo enddo gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*fact2*gloci1 @@ -4503,6 +5944,299 @@ C Regular cosine and sine terms return end #endif +c--------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine etor_kcc(etors,fact) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + double precision c1(0:maxval_kcc),c2(0:maxval_kcc) + logical lprn +c double precision thybt1(maxtermkcc),thybt2(maxtermkcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode + etors=0.0D0 + do i=iphi_start,iphi_end +C ANY TWO ARE DUMMY ATOMS in row CYCLE +c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or. +c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or. +c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle + if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 + & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle + itori=itortyp(itype(i-2)) + itori1=itortyp(itype(i-1)) + phii=phi(i) + glocig=0.0D0 + glocit1=0.0d0 + glocit2=0.0d0 +C to avoid multiple devision by 2 +c theti22=0.5d0*theta(i) +C theta 12 is the theta_1 /2 +C theta 22 is theta_2 /2 +c theti12=0.5d0*theta(i-1) +C and appropriate sinus function + sinthet1=dsin(theta(i-1)) + sinthet2=dsin(theta(i)) + costhet1=dcos(theta(i-1)) + costhet2=dcos(theta(i)) +C to speed up lets store its mutliplication + sint1t2=sinthet2*sinthet1 + sint1t2n=1.0d0 +C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma) +C +d_n*sin(n*gamma)) * +C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2))) +C we have two sum 1) Non-Chebyshev which is with n and gamma + nval=nterm_kcc_Tb(itori,itori1) + c1(0)=0.0d0 + c2(0)=0.0d0 + c1(1)=1.0d0 + c2(1)=1.0d0 + do j=2,nval + c1(j)=c1(j-1)*costhet1 + c2(j)=c2(j-1)*costhet2 + enddo + etori=0.0d0 + do j=1,nterm_kcc(itori,itori1) + cosphi=dcos(j*phii) + sinphi=dsin(j*phii) + sint1t2n1=sint1t2n + sint1t2n=sint1t2n*sint1t2 + sumvalc=0.0d0 + gradvalct1=0.0d0 + gradvalct2=0.0d0 + do k=1,nval + do l=1,nval + sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalct1=gradvalct1+ + & (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalct2=gradvalct2+ + & (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalct1=-gradvalct1*sinthet1 + gradvalct2=-gradvalct2*sinthet2 + sumvals=0.0d0 + gradvalst1=0.0d0 + gradvalst2=0.0d0 + do k=1,nval + do l=1,nval + sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l) + gradvalst1=gradvalst1+ + & (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l) + gradvalst2=gradvalst2+ + & (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1) + enddo + enddo + gradvalst1=-gradvalst1*sinthet1 + gradvalst2=-gradvalst2*sinthet2 + etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi) +C glocig is the gradient local i site in gamma + glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi) +C now gradient over theta_1 + glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi) + & +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi) + glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi) + & +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi) + enddo ! j + etors=etors+etori +C derivative over gamma + gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig +C derivative over theta1 + gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1 +C now derivative over theta2 + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2 + if (lprn) then + write (iout,*) i-2,i-1,itype(i-2),itype(i-1),itori,itori1, + & theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori + write (iout,*) "c1",(c1(k),k=0,nval), + & " c2",(c2(k),k=0,nval) + write (iout,*) "sumvalc",sumvalc," sumvals",sumvals + endif + enddo + return + end +c--------------------------------------------------------------------------------------------- + subroutine etor_constr(edihcnstr) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' +! 6/20/98 - dihedral angle constraints + edihcnstr=0.0d0 +c do i=1,ndih_constr +c write (iout,*) "idihconstr_start",idihconstr_start, +c & " idihconstr_end",idihconstr_end + + if (raw_psipred) then + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + gaudih_i=vpsipred(1,i) + gauder_i=0.0d0 + do j=1,2 + s = sdihed(j,i) + cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2 + dexpcos_i=dexp(-cos_i*cos_i) + gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i + gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) + & *cos_i*dexpcos_i/s**2 + enddo + edihcnstr=edihcnstr-wdihc*dlog(gaudih_i) + gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i + if (energy_dec) + & write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') + & i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i), + & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i), + & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, + & -wdihc*dlog(gaudih_i) + enddo + else + + do i=idihconstr_start,idihconstr_end + itori=idih_constr(i) + phii=phi(itori) + difi=pinorm(phii-phi0(i)) + if (difi.gt.drange(i)) then + difi=difi-drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 + else + difi=0.0 + endif + enddo + + endif + +c write (iout,*) "ETOR_CONSTR",edihcnstr + return + end +c---------------------------------------------------------------------------- +C The rigorous attempt to derive energy function + subroutine ebend_kcc(etheta) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + logical lprn + double precision thybt1(maxang_kcc) +C Set lprn=.true. for debugging + lprn=energy_dec +c lprn=.true. +C print *,"wchodze kcc" + if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode + etheta=0.0D0 + do i=ithet_start,ithet_end +c print *,i,itype(i-1),itype(i),itype(i-2) + if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1 + & .or.itype(i).eq.ntyp1) cycle + iti=iabs(itortyp(itype(i-1))) + sinthet=dsin(theta(i)) + costhet=dcos(theta(i)) + do j=1,nbend_kcc_Tb(iti) + thybt1(j)=v1bend_chyb(j,iti) + enddo + sumth1thyb=v1bend_chyb(0,iti)+ + & tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) + if (lprn) write (iout,*) i-1,itype(i-1),iti,theta(i)*rad2deg, + & sumth1thyb + ihelp=nbend_kcc_Tb(iti)-1 + gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) + etheta=etheta+sumth1thyb +C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet + enddo + return + end +c------------------------------------------------------------------------------------- + subroutine etheta_constr(ethetacnstr) + + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.VAR' + include 'COMMON.GEO' + include 'COMMON.LOCAL' + include 'COMMON.TORSION' + include 'COMMON.INTERACT' + include 'COMMON.DERIV' + include 'COMMON.CHAIN' + include 'COMMON.NAMES' + include 'COMMON.IOUNITS' + include 'COMMON.FFIELD' + include 'COMMON.TORCNSTR' + include 'COMMON.CONTROL' + ethetacnstr=0.0d0 +C print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=ithetaconstr_start,ithetaconstr_end + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) + & +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif + if (energy_dec) then + write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", + & i,itheta,rad2deg*thetiii, + & rad2deg*theta_constr0(i), rad2deg*theta_drange(i), + & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, + & gloc(itheta+nphi-2,icg) + endif + enddo + return + end +c------------------------------------------------------------------------------ c------------------------------------------------------------------------------ subroutine eback_sc_corr(esccor) c 7/21/2007 Correlations between the backbone-local and side-chain-local @@ -4532,26 +6266,50 @@ C Set lprn=.true. for debugging c lprn=.true. c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor esccor=0.0D0 - do i=iphi_start,iphi_end - if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle + do i=itau_start,itau_end + if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle esccor_ii=0.0D0 - itori=itype(i-2) - itori1=itype(i-1) + isccori=isccortyp(itype(i-2)) + isccori1=isccortyp(itype(i-1)) phii=phi(i) + do intertyp=1,3 !intertyp +cc Added 09 May 2012 (Adasko) +cc Intertyp means interaction type of backbone mainchain correlation: +c 1 = SC...Ca...Ca...Ca +c 2 = Ca...Ca...Ca...SC +c 3 = SC...Ca...Ca...SCi gloci=0.0D0 - do j=1,nterm_sccor - v1ij=v1sccor(j,itori,itori1) - v2ij=v2sccor(j,itori,itori1) - cosphi=dcos(j*phii) - sinphi=dsin(j*phii) - esccor=esccor+v1ij*cosphi+v2ij*sinphi - gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) - enddo + if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. + & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-1).eq.ntyp1))) + & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) + & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) + & .or.(itype(i).eq.ntyp1))) + & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. + & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + & (itype(i-3).eq.ntyp1)))) cycle + if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle + if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) + & cycle + do j=1,nterm_sccor(isccori,isccori1) + v1ij=v1sccor(j,intertyp,isccori,isccori1) + v2ij=v2sccor(j,intertyp,isccori,isccori1) + cosphi=dcos(j*tauangle(intertyp,i)) + sinphi=dsin(j*tauangle(intertyp,i)) + esccor=esccor+v1ij*cosphi+v2ij*sinphi + gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) + enddo +C write (iout,*)"EBACK_SC_COR",esccor,i +c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp, +c & nterm_sccor(isccori,isccori1),isccori,isccori1 +c gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci if (lprn) & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, - & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) - gsccor_loc(i-3)=gloci + & (v1sccor(j,1,itori,itori1),j=1,6) + & ,(v2sccor(j,1,itori,itori1),j=1,6) +c gsccor_loc(i-3)=gloci + enddo !intertyp enddo return end @@ -4653,192 +6411,21 @@ cd & k,l,(gacont(m,kk,k),m=1,3) return end c------------------------------------------------------------------------------ -#ifdef MPL - subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,20,maxres,7), - & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), - & num_cont_hb(maxres),jcont_hb(20,maxres) - num_kont=num_cont_hb(atom) - do i=1,num_kont - do k=1,7 - do j=1,3 - buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k) - enddo ! j - enddo ! k - buffer(i,indx+22)=facont_hb(i,atom) - buffer(i,indx+23)=ees0p(i,atom) - buffer(i,indx+24)=ees0m(i,atom) - buffer(i,indx+25)=dfloat(jcont_hb(i,atom)) - enddo ! i - buffer(1,indx+26)=dfloat(num_kont) - return - end -c------------------------------------------------------------------------------ - subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - integer dimen1,dimen2,atom,indx - double precision buffer(dimen1,dimen2) - double precision zapas - common /contacts_hb/ zapas(3,20,maxres,7), - & facont_hb(20,maxres),ees0p(20,maxres),ees0m(20,maxres), - & num_cont_hb(maxres),jcont_hb(20,maxres) - num_kont=buffer(1,indx+26) - num_kont_old=num_cont_hb(atom) - num_cont_hb(atom)=num_kont+num_kont_old - do i=1,num_kont - ii=i+num_kont_old - do k=1,7 - do j=1,3 - zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j) - enddo ! j - enddo ! k - facont_hb(ii,atom)=buffer(i,indx+22) - ees0p(ii,atom)=buffer(i,indx+23) - ees0m(ii,atom)=buffer(i,indx+24) - jcont_hb(ii,atom)=buffer(i,indx+25) - enddo ! i - return - end -c------------------------------------------------------------------------------ -#endif subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) C This subroutine calculates multi-body contributions to hydrogen-bonding implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' -#endif include 'COMMON.FFIELD' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' -#ifdef MPL - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+2)) - parameter (msglen1=max_cont*max_dim*4) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) -#endif double precision gx(3),gx1(3) logical lprn,ldone C Set lprn=.true. for debugging lprn=.false. -#ifdef MPL - n_corr=0 - n_corr1=0 - if (fgProcs.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=MyID+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(MyRank,2) -cd write (iout,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -cd write (iout,*) 'The BUFFER array:' -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -cd enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -cd enddo - num_cont_hb(iatel_s)=0 - endif -cd write (iout,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen -cd write (*,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -cd write (iout,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -cd write (*,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID - msglen=msglen1 - endif ! (MyRank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.lt.fgProcs-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -cd write (*,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - nbytes=-1 - do while (nbytes.le.0) - call mp_probe(MyID+1,CorrelType,nbytes) - enddo -cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes - call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -cd write (iout,*) 'Processor',MyID, -cd & ' has received correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' nbytes=',nbytes -cd write (iout,*) 'The received BUFFER array:' -cd do i=1,max_cont -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -cd enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call mp_stopall(Error) - endif ! msglen.eq.msglen1 - endif ! MyRank.lt.fgProcs-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif if (lprn) then write (iout,'(a)') 'Contact function values:' do i=nnt,nct-2 @@ -4899,139 +6486,31 @@ C This subroutine calculates multi-body contributions to hydrogen-bonding include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' +#ifdef MPI + include "mpif.h" #endif include 'COMMON.FFIELD' include 'COMMON.DERIV' + include 'COMMON.LOCAL' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' -#ifdef MPL - parameter (max_cont=maxconts) - parameter (max_dim=2*(8*3+2)) - parameter (msglen1=max_cont*max_dim*4) - parameter (msglen2=2*msglen1) - integer source,CorrelType,CorrelID,Error - double precision buffer(max_cont,max_dim) -#endif + include 'COMMON.CHAIN' + include 'COMMON.CONTROL' + include 'COMMON.SHIELD' double precision gx(3),gx1(3) + integer num_cont_hb_old(maxres) logical lprn,ldone - + double precision eello4,eello5,eelo6,eello_turn6 + external eello4,eello5,eello6,eello_turn6 C Set lprn=.true. for debugging lprn=.false. eturn6=0.0d0 -#ifdef MPL - n_corr=0 - n_corr1=0 - if (fgProcs.le.1) goto 30 - if (lprn) then - write (iout,'(a)') 'Contact function values:' - do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) - enddo - endif -C Caution! Following code assumes that electrostatic interactions concerning -C a given atom are split among at most two processors! - CorrelType=477 - CorrelID=MyID+1 - ldone=.false. - do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo - enddo - mm=mod(MyRank,2) -cd write (iout,*) 'MyRank',MyRank,' mm',mm - if (mm) 20,20,10 - 10 continue -cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.gt.0) then -C Send correlation contributions to the preceding processor - msglen=msglen1 - nn=num_cont_hb(iatel_s) - call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) -cd write (iout,*) 'The BUFFER array:' -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,26) -cd enddo - if (ielstart(iatel_s).gt.iatel_s+ispp) then - msglen=msglen2 - call pack_buffer(max_cont,max_dim,iatel_s+1,26,buffer) -C Clear the contacts of the atom passed to the neighboring processor - nn=num_cont_hb(iatel_s+1) -cd do i=1,nn -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+26),j=1,26) -cd enddo - num_cont_hb(iatel_s)=0 - endif -cd write (iout,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen -cd write (*,*) 'Processor ',MyID,MyRank, -cd & ' is sending correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - call mp_bsend(buffer,msglen,MyID-1,CorrelType,CorrelID) -cd write (iout,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID -cd write (*,*) 'Processor ',MyID, -cd & ' has sent correlation contribution to processor',MyID-1, -cd & ' msglen=',msglen,' CorrelID=',CorrelID - msglen=msglen1 - endif ! (MyRank.gt.0) - if (ldone) goto 30 - ldone=.true. - 20 continue -cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone - if (MyRank.lt.fgProcs-1) then -C Receive correlation contributions from the next processor - msglen=msglen1 - if (ielend(iatel_e).lt.nct-1) msglen=msglen2 -cd write (iout,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType -cd write (*,*) 'Processor',MyID, -cd & ' is receiving correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' CorrelType=',CorrelType - nbytes=-1 - do while (nbytes.le.0) - call mp_probe(MyID+1,CorrelType,nbytes) - enddo -cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes - call mp_brecv(buffer,msglen,MyID+1,CorrelType,nbytes) -cd write (iout,*) 'Processor',MyID, -cd & ' has received correlation contribution from processor',MyID+1, -cd & ' msglen=',msglen,' nbytes=',nbytes -cd write (iout,*) 'The received BUFFER array:' -cd do i=1,max_cont -cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) -cd enddo - if (msglen.eq.msglen1) then - call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) - else if (msglen.eq.msglen2) then - call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) - call unpack_buffer(max_cont,max_dim,iatel_e+1,26,buffer) - else - write (iout,*) - & 'ERROR!!!! message length changed while processing correlations.' - write (*,*) - & 'ERROR!!!! message length changed while processing correlations.' - call mp_stopall(Error) - endif ! msglen.eq.msglen1 - endif ! MyRank.lt.fgProcs-1 - if (ldone) goto 30 - ldone=.true. - goto 10 - 30 continue -#endif if (lprn) then write (iout,'(a)') 'Contact function values:' do i=nnt,nct-2 - write (iout,'(2i3,50(1x,i2,f5.2))') - & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), - & j=1,num_cont_hb(i)) + write (iout,'(2i3,50(1x,i2,5f6.3))') + & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i), + & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i)) enddo endif ecorr=0.0D0 @@ -5050,22 +6529,35 @@ C Calculate the dipole-dipole interaction energies num_conti=num_cont_hb(i) do jj=1,num_conti j=jcont_hb(jj,i) +#ifdef MOMENT call dipole(i,j,jj) +#endif enddo enddo endif C Calculate the local-electrostatic correlation terms - do i=iatel_s,iatel_e+1 +c write (iout,*) "gradcorr5 in eello5 before loop" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo + do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1) +c write (iout,*) "corr loop i",i i1=i+1 num_conti=num_cont_hb(i) num_conti1=num_cont_hb(i+1) do jj=1,num_conti j=jcont_hb(jj,i) + jp=iabs(j) do kk=1,num_conti1 j1=jcont_hb(kk,i1) -c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, + jp1=iabs(j1) +c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1 .or. j1.eq.j-1) then +c if (j1.eq.j+1 .or. j1.eq.j-1) then + if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 + & .or. j.lt.0 .and. j1.gt.0) .and. + & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. C The system gains extra energy. n_corr=n_corr+1 @@ -5075,8 +6567,8 @@ C The system gains extra energy. IF (sred_geom.lt.cutoff_corr) THEN call gcont(sred_geom,r0_corr,1.0D0,delt_corr, & ekont,fprimcont) -c write (*,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk +cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1, +cd & ' jj=',jj,' kk=',kk fac_prim1=0.5d0*sqd2/sqd1*fprimcont fac_prim2=0.5d0*sqd1/sqd2*fprimcont do l=1,3 @@ -5085,64 +6577,86 @@ c & ' jj=',jj,' kk=',kk enddo n_corr1=n_corr1+1 cd write (iout,*) 'sred_geom=',sred_geom, -cd & ' ekont=',ekont,' fprim=',fprimcont - call calc_eello(i,j,i+1,j1,jj,kk) +cd & ' ekont=',ekont,' fprim=',fprimcont, +cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2 +cd write (iout,*) "g_contij",g_contij +cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i) +cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1) + call calc_eello(i,jp,i+1,jp1,jj,kk) if (wcorr4.gt.0.0d0) - & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk) + & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk) +CC & *fac_shield(i)**2*fac_shield(j)**2 + if (energy_dec.and.wcorr4.gt.0.0d0) + 1 write (iout,'(a6,4i5,0pf7.3)') + 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk) +c write (iout,*) "gradcorr5 before eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo if (wcorr5.gt.0.0d0) - & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk) -c print *,"wcorr5",ecorr5 + & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk) +c write (iout,*) "gradcorr5 after eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo + if (energy_dec.and.wcorr5.gt.0.0d0) + 1 write (iout,'(a6,4i5,0pf7.3)') + 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk) cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 -cd write(2,*)'ijkl',i,j,i+1,j1 - if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 +cd write(2,*)'ijkl',i,jp,i+1,jp1 + if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 & .or. wturn6.eq.0.0d0))then cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 - ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) + ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk) + if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') + 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk) cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, cd & 'ecorr6=',ecorr6 cd write (iout,'(4e15.5)') sred_geom, -cd & dabs(eello4(i,j,i+1,j1,jj,kk)), -cd & dabs(eello5(i,j,i+1,j1,jj,kk)), -cd & dabs(eello6(i,j,i+1,j1,jj,kk)) +cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)), +cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)), +cd & dabs(eello6(i,jp,i+1,jp1,jj,kk)) else if (wturn6.gt.0.0d0 - & .and. (j.eq.i+4 .and. j1.eq.i+3)) then -cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1 + & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then +cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1 eturn6=eturn6+eello_turn6(i,jj,kk) -cd write (2,*) 'multibody_eello:eturn6',eturn6 - endif - ENDIF -1111 continue - else if (j1.eq.j) then -C Contacts I-J and I-(J+1) occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) - endif - enddo ! kk - do kk=1,num_conti - j1=jcont_hb(kk,i) -c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, -c & ' jj=',jj,' kk=',kk - if (j1.eq.j+1) then -C Contacts I-J and (I+1)-J occur simultaneously. -C The system loses extra energy. -c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) - endif ! j1==j+1 + if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') + 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk) +cd write (2,*) 'multibody_eello:eturn6',eturn6 + endif + ENDIF +1111 continue + endif enddo ! kk enddo ! jj enddo ! i + do i=1,nres + num_cont_hb(i)=num_cont_hb_old(i) + enddo +c write (iout,*) "gradcorr5 in eello5" +c do iii=1,nres +c write (iout,'(i5,3f10.5)') +c & iii,(gradcorr5(jjj,iii),jjj=1,3) +c enddo return end c------------------------------------------------------------------------------ double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) implicit real*8 (a-h,o-z) include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' include 'COMMON.IOUNITS' include 'COMMON.DERIV' include 'COMMON.INTERACT' include 'COMMON.CONTACTS' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' double precision gx(3),gx1(3) logical lprn lprn=.false. +C print *,"wchodze",fac_shield(i),shield_mode eij=facont_hb(jj,i) ekl=facont_hb(kk,k) ees0pij=ees0p(jj,i) @@ -5151,57 +6665,157 @@ c------------------------------------------------------------------------------ ees0mkl=ees0m(kk,k) ekont=eij*ekl ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) +C* +C & fac_shield(i)**2*fac_shield(j)**2 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) C Following 4 lines for diagnostics. cd ees0pkl=0.0D0 cd ees0pij=1.0D0 cd ees0mkl=0.0D0 cd ees0mij=1.0D0 -c write (iout,*)'Contacts have occurred for peptide groups',i,j, -c & ' and',k,l -c write (iout,*)'Contacts have occurred for peptide groups', -c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l -c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees +c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)') +c & 'Contacts ',i,j, +c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l +c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees, +c & 'gradcorr_long' C Calculate the multi-body contribution to energy. - ecorr=ecorr+ekont*ees - if (calc_grad) then +C ecorr=ecorr+ekont*ees C Calculate multi-body contributions to the gradient. + coeffpees0pij=coeffp*ees0pij + coeffmees0mij=coeffm*ees0mij + coeffpees0pkl=coeffp*ees0pkl + coeffmees0mkl=coeffm*ees0mkl do ll=1,3 - ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,i)=gradcorr(ll,i)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb1(ll,jj,i)) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf - & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb2(ll,jj,i)) - ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,k)=gradcorr(ll,k)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb1(ll,kk,k)) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf - & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb2(ll,kk,k)) - enddo - do m=i+1,j-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*ekl*gacont_hbr(ll,jj,i)- - & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ - & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) - enddo +cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i) + gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi + & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb1(ll,jj,i)) + gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi + & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb2(ll,jj,i)) +cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k) + gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk + & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ + & coeffmees0mij*gacontm_hb1(ll,kk,k)) + gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk + & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ + & coeffmees0mij*gacontm_hb2(ll,kk,k)) + gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- + & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ + & coeffmees0mkl*gacontm_hb3(ll,jj,i)) + gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij + gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij + gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- + & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ + & coeffmees0mij*gacontm_hb3(ll,kk,k)) + gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl + gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl +c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl enddo - do m=k+1,l-1 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ - & ees*eij*gacont_hbr(ll,kk,k)- - & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ - & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) - enddo - enddo - endif +c write (iout,*) +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ +cgrad & ees*ekl*gacont_hbr(ll,jj,i)- +cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ +cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ +cgrad & ees*eij*gacont_hbr(ll,kk,k)- +cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ +cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) +cgrad enddo +cgrad enddo +c write (iout,*) "ehbcorr",ekont*ees +C print *,ekont,ees,i,k ehbcorr=ekont*ees +C now gradient over shielding +C return + if (shield_mode.gt.0) then + j=ees0plist(jj,i) + l=ees0plist(kk,k) +C print *,i,j,fac_shield(i),fac_shield(j), +C &fac_shield(k),fac_shield(l) + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. + & (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + &+rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + + do ilist=1,ishield_list(k) + iresshield=shield_list(ilist,k) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo + do ilist=1,ishield_list(l) + iresshield=shield_list(ilist,l) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l) +C & *2.0 + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ + & rlocshield + & +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) + & +rlocshield + enddo + enddo +C print *,gshieldx(m,iresshield) + do m=1,3 + gshieldc_ec(m,i)=gshieldc_ec(m,i)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j)=gshieldc_ec(m,j)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ + & grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ + & grad_shield(m,j)*ehbcorr/fac_shield(j) + + gshieldc_ec(m,k)=gshieldc_ec(m,k)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l)=gshieldc_ec(m,l)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ + & grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ + & grad_shield(m,l)*ehbcorr/fac_shield(l) + + enddo + endif + endif return end +#ifdef MOMENT C--------------------------------------------------------------------------- subroutine dipole(i,j,jj) implicit real*8 (a-h,o-z) @@ -5220,21 +6834,17 @@ C--------------------------------------------------------------------------- & auxmat(2,2) iti1 = itortyp(itype(i+1)) if (j.lt.nres-1) then - if (itype(j).le.ntyp) then - itj1 = itortyp(itype(j+1)) - else - itj=ntortyp+1 - endif + itj1 = itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif do iii=1,2 dipi(iii,1)=Ub2(iii,i) dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,iti1) + dipi(iii,2)=b1(iii,i+1) dipj(iii,1)=Ub2(iii,j) dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,itj1) + dipj(iii,2)=b1(iii,j+1) enddo kkk=0 do iii=1,2 @@ -5244,7 +6854,6 @@ C--------------------------------------------------------------------------- dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) enddo enddo - if (.not.calc_grad) return do kkk=1,5 do lll=1,3 mmm=0 @@ -5269,6 +6878,7 @@ C--------------------------------------------------------------------------- enddo return end +#endif C--------------------------------------------------------------------------- subroutine calc_eello(i,j,k,l,jj,kk) C @@ -5294,6 +6904,8 @@ C cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, cd & ' jj=',jj,' kk=',kk cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return +cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2) +cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2) do iii=1,2 do jjj=1,2 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) @@ -5312,17 +6924,17 @@ cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return enddo if (l.eq.j+1) then C parallel orientation of the two CA-CA-CA frames. - if (i.gt.1 .and. itype(i).le.ntyp) then - iti=itortyp(itype(i)) + if (i.gt.1) then + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) - if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then - itl1=itortyp(itype(l+1)) + itk1=itype2loc(itype(k+1)) + itj=itype2loc(itype(j)) + if (l.lt.nres-1) then + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif C A1 kernel(j+1) A2T cd do iii=1,2 @@ -5413,26 +7025,26 @@ C They are needed only when the fifth- or the sixth-order cumulants are C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) @@ -5441,20 +7053,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj), + call matvec2(auxmat(1,1),b1(1,j), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -5465,18 +7077,18 @@ C Calculate the Cartesian derivatives of the vectors. C End vectors else C Antiparallel orientation of the two CA-CA-CA frames. - if (i.gt.1 .and. itype(i).le.ntyp) then - iti=itortyp(itype(i)) + if (i.gt.1) then + iti=itype2loc(itype(i)) else - iti=ntortyp+1 + iti=nloctyp endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) - if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then - itj1=itortyp(itype(j+1)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) + if (j.lt.nres-1) then + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif C A2 kernel(j-1)T A1T call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), @@ -5551,26 +7163,26 @@ C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) @@ -5579,20 +7191,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,iti), + call matvec2(auxmat(1,1),b1(1,i), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,itl), + call matvec2(auxmat(1,1),b1(1,l), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,l), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -5717,51 +7329,49 @@ cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num l2=l-2 endif do ll=1,3 -cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i) - ggg1(ll)=eel4*g_contij(ll,1) - ggg2(ll)=eel4*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) -cd ghalf=0.0d0 - gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1) +cgrad ggg1(ll)=eel4*g_contij(ll,1) +cgrad ggg2(ll)=eel4*g_contij(ll,2) + glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1) + glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2) +cgrad ghalf=0.5d0*ggg1(ll) + gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1) gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) - gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1) gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) -cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) -cd ghalf=0.0d0 - gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij + gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij +cgrad ghalf=0.5d0*ggg2(ll) + gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2) gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) - gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2) gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) + gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl + gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl enddo -cd goto 1112 - do m=i+1,j-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i) - gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 -cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k) - gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,gcorr_loc(iii) cd enddo - endif + endif ! calc_grad eello4=ekont*eel4 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello4',ekont*eel4 @@ -5820,9 +7430,9 @@ cd endif cd write (iout,*) cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, cd & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk=itype2loc(itype(k)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) eello5_1=0.0d0 eello5_2=0.0d0 eello5_3=0.0d0 @@ -5851,7 +7461,7 @@ cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) vv(2)=pizda(1,2)+pizda(2,1) eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) - if (calc_grad) then + if (calc_grad) then C Explicit gradient in virtual-dihedral angles. if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) @@ -5889,15 +7499,15 @@ C Cartesian gradient enddo enddo enddo + endif ! calc_grad c goto 1112 - endif c1111 continue C Contribution from graph II - call transpose2(EE(1,1,itk),auxmat(1,1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) + eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -5908,11 +7518,11 @@ C Explicit gradient in virtual-dihedral angles. vv(2)=pizda(2,1)-pizda(1,2) if (l.eq.j+1) then g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) else g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) endif C Cartesian gradient @@ -5924,13 +7534,13 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) enddo enddo enddo + endif ! calc_grad cd goto 1112 - endif cd1111 continue if (l.eq.j+1) then cd goto 1110 @@ -5975,16 +7585,14 @@ C Cartesian gradient enddo enddo cd goto 1112 - endif C Contribution from graph IV cd1110 continue - call transpose2(EE(1,1,itl),auxmat(1,1)) + call transpose2(EE(1,1,l),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) - if (calc_grad) then C Explicit gradient in virtual-dihedral angles. g_corr5_loc(l-1)=g_corr5_loc(l-1) & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) @@ -5992,7 +7600,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l))) C Cartesian gradient do iii=1,2 @@ -6003,12 +7611,12 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) enddo enddo enddo - endif + endif ! calc_grad else C Antiparallel orientation C Contribution from graph III @@ -6051,15 +7659,15 @@ C Cartesian gradient enddo enddo enddo + endif ! calc_grad cd goto 1112 - endif C Contribution from graph IV 1110 continue - call transpose2(EE(1,1,itj),auxmat(1,1)) + call transpose2(EE(1,1,j),auxmat(1,1)) call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -6069,7 +7677,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j))) C Cartesian gradient do iii=1,2 @@ -6080,12 +7688,12 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) enddo enddo enddo - endif + endif ! calc_grad endif 1112 continue eel5=eello5_1+eello5_2+eello5_3+eello5_4 @@ -6117,52 +7725,70 @@ cd eij=1.0d0 cd ekl=1.0d0 cd ekont=1.0d0 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont +C 2/11/08 AL Gradients over DC's connecting interacting sites will be +C summed up outside the subrouine as for the other subroutines +C handling long-range interactions. The old code is commented out +C with "cgrad" to keep track of changes. do ll=1,3 - ggg1(ll)=eel5*g_contij(ll,1) - ggg2(ll)=eel5*g_contij(ll,2) +cgrad ggg1(ll)=eel5*g_contij(ll,1) +cgrad ggg2(ll)=eel5*g_contij(ll,2) + gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1) + gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2) +c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)') +c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1), +c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2), +c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont +c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)') +c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1), +c & gradcorr5ij, +c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1) + gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1) gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) - gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1) gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) + gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij + gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) - ghalf=0.5d0*ggg2(ll) +cgrad ghalf=0.5d0*ggg2(ll) cd ghalf=0.0d0 - gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2) gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) - gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2) gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) + gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl + gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl enddo + endif ! calc_grad cd goto 1112 - do m=i+1,j-1 - do ll=1,3 +cgrad do m=i+1,j-1 +cgrad do ll=1,3 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) - gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) - enddo - enddo +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo c1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr5_loc(iii) cd enddo - endif eello5=ekont*eel5 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello5',ekont*eel5 @@ -6232,12 +7858,12 @@ cd ekont=1.0d0 endif C If turn contributions are considered, they will be handled separately. eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 -cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num -cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num -cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num -cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num -cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num -cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num +cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num +cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num +cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num +cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num +cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num +cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num cd goto 1112 if (calc_grad) then if (j.lt.nres-1) then @@ -6255,51 +7881,57 @@ cd goto 1112 l2=l-2 endif do ll=1,3 - ggg1(ll)=eel6*g_contij(ll,1) - ggg2(ll)=eel6*g_contij(ll,2) +cgrad ggg1(ll)=eel6*g_contij(ll,1) +cgrad ggg2(ll)=eel6*g_contij(ll,2) cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) - ghalf=0.5d0*ggg1(ll) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1) + gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1) + gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2) + gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1) gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) - gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1) + gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1) gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) - ghalf=0.5d0*ggg2(ll) + gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij + gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij +cgrad ghalf=0.5d0*ggg2(ll) cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) cd ghalf=0.0d0 - gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2) + gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2) gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) - gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2) + gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2) gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) + gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl + gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl enddo + endif ! calc_grad cd goto 1112 - do m=i+1,j-1 - do ll=1,3 +cgrad do m=i+1,j-1 +cgrad do ll=1,3 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) - gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) - enddo - enddo +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad1112 continue +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr6_loc(iii) cd enddo - endif eello6=ekont*eel6 cd write (2,*) 'ekont',ekont cd write (iout,*) 'eello6',ekont*eel6 @@ -6323,7 +7955,7 @@ c-------------------------------------------------------------------------- logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C @@ -6336,7 +7968,7 @@ C o o o o C C i i C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) + itk=itype2loc(itype(k)) s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) @@ -6345,12 +7977,12 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) - vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) + vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) + vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) - if (.not. calc_grad) return + if (calc_grad) then if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) @@ -6360,8 +7992,8 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) - vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) + vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) + vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) if (l.eq.j+1) then g_corr6_loc(l-1)=g_corr6_loc(l-1) & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) @@ -6400,15 +8032,16 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) + vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) + & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) + vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) + & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) s5=scalar2(vv(1),Dtobr2(1,i)) derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- @@ -6426,7 +8059,7 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC @@ -6436,12 +8069,12 @@ C C C o o C C \ /l\ /j\ / C C \ / \ / \ / C -C o| o | | o |o C +C o| o | | o |o C C \ j|/k\| \ |/k\|l C C \ / \ \ / \ C C o o C -C i i C -C C +C i i C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l C AL 7/4/01 s1 would occur in the sixth-order moment, @@ -6465,8 +8098,8 @@ cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 eello6_graph2=-(s2+s3+s4) #endif c eello6_graph2=-s3 - if (.not. calc_grad) return C Derivatives in gamma(i-1) + if (calc_grad) then if (i.gt.1) then #ifdef MOMENT s1=dipderg(1,jj,i)*dip(1,kk,k) @@ -6596,6 +8229,7 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- @@ -6617,8 +8251,8 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C Parallel Antiparallel C C C -C o o C -C /l\ / \ /j\ C +C o o C +C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C C j|/k\| / |/k\|l / C @@ -6631,46 +8265,47 @@ C C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. iti=itortyp(itype(i)) - if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then - itj1=itortyp(itype(j+1)) + if (j.lt.nres-1) then + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - if (l.lt.nres-1 .and. itype(l+1).le.ntyp) then - itl1=itortyp(itype(l+1)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) + if (l.lt.nres-1) then + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif #ifdef MOMENT s1=dip(4,jj,i)*dip(4,kk,k) #endif - call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) - call transpose2(EE(1,1,itk),auxmat(1,1)) + call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + call transpose2(EE(1,1,k),auxmat(1,1)) call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) -cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 +cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4, +cd & "sum",-(s2+s3+s4) #ifdef MOMENT eello6_graph3=-(s1+s2+s3+s4) #else eello6_graph3=-(s2+s3+s4) #endif c eello6_graph3=-s4 - if (.not. calc_grad) return C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + if (calc_grad) then + call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) + call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) @@ -6687,12 +8322,12 @@ C Cartesian derivatives. s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) endif #endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), + call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), & auxvec(1)) - s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), + s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), & auxvec(1)) - s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), & pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) @@ -6712,6 +8347,7 @@ c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- @@ -6732,7 +8368,7 @@ c---------------------------------------------------------------------------- & auxvec1(2),auxmat1(2,2) logical swap CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C +C C C Parallel Antiparallel C C C C o o C @@ -6740,33 +8376,33 @@ C /l\ / \ /j\ C C / \ / \ / \ C C /| o |o o| o |\ C C \ j|/k\| \ |/k\|l C -C \ / \ \ / \ C +C \ / \ \ / \ C C o \ o \ C C i i C -C C +C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 4/7/01 AL Component s1 was removed, because it pertains to the respective C energy moment and not to the cluster cumulant. cd write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) - if (j.lt.nres-1 .and. itype(j+1).le.ntyp) then - itj1=itortyp(itype(j+1)) + iti=itype2loc(itype(i)) + itj=itype2loc(itype(j)) + if (j.lt.nres-1) then + itj1=itype2loc(itype(j+1)) else - itj1=ntortyp+1 + itj1=nloctyp endif - itk=itortyp(itype(k)) - if (k.lt.nres-1 .and. itype(k+1).le.ntyp) then - itk1=itortyp(itype(k+1)) + itk=itype2loc(itype(k)) + if (k.lt.nres-1) then + itk1=itype2loc(itype(k+1)) else - itk1=ntortyp+1 + itk1=nloctyp endif - itl=itortyp(itype(l)) + itl=itype2loc(itype(l)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itype2loc(itype(l+1)) else - itl1=ntortyp+1 + itl1=nloctyp endif cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, @@ -6781,11 +8417,11 @@ cd & ' itl',itl,' itl1',itl1 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUg(1,1,k),auxmat(1,1)) call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) @@ -6798,8 +8434,8 @@ cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 #else eello6_graph4=-(s2+s3+s4) #endif - if (.not. calc_grad) return C Derivatives in gamma(i-1) + if (calc_grad) then if (i.gt.1) then #ifdef MOMENT if (imat.eq.1) then @@ -6810,11 +8446,11 @@ C Derivatives in gamma(i-1) #endif s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then @@ -6843,11 +8479,11 @@ C Derivatives in gamma(k-1) call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) endif call transpose2(EUgder(1,1,k),auxmat1(1,1)) call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) @@ -6913,12 +8549,12 @@ C Cartesian derivatives. s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itj1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) + & b1(1,j+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) else call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,itl1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) + & b1(1,l+1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) endif call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), & pizda(1,1)) @@ -6958,6 +8594,7 @@ C Cartesian derivatives. enddo enddo enddo + endif ! calc_grad return end c---------------------------------------------------------------------------- @@ -6980,15 +8617,19 @@ c---------------------------------------------------------------------------- & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to C the respective energy moment and not to the cluster cumulant. + s1=0.0d0 + s8=0.0d0 + s13=0.0d0 +c eello_turn6=0.0d0 j=i+4 k=i+1 l=i+3 - iti=itortyp(itype(i)) - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + iti=itype2loc(itype(i)) + itk=itype2loc(itype(k)) + itk1=itype2loc(itype(k+1)) + itl=itype2loc(itype(l)) + itj=itype2loc(itype(j)) cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj cd write (2,*) 'i',i,' k',k,' j',j,' l',l cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then @@ -7015,21 +8656,17 @@ cd write (2,*) 'eello6_5',eello6_5 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmat(1,1)) call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,itl)) + ss1=scalar2(Ub2(1,i+2),b1(1,l)) s1 = (auxmat(1,1)+auxmat(2,2))*ss1 -#else - s1 = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,itk),vtemp1(1)) + s2 = scalar2(b1(1,k),vtemp1(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atemp(1,1)) call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) - call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) - s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8=0.0d0 + call matvec2(Ug2(1,1,i+2),dd(1,1,k+1),vtemp2(1)) + s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) @@ -7039,10 +8676,8 @@ cd write (2,*) 'eello6_5',eello6_5 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,itk),vtemp4(1)) + ss13 = scalar2(b1(1,k),vtemp4(1)) s13 = (gtemp(1,1)+gtemp(2,2))*ss13 -#else - s13=0.0d0 #endif c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 c s1=0.0d0 @@ -7051,17 +8686,17 @@ c s8=0.0d0 c s12=0.0d0 c s13=0.0d0 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) - if (calc_grad) then C Derivatives in gamma(i+2) + if (calc_grad) then + s1d =0.0d0 + s8d =0.0d0 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 call transpose2(AEAderg(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d=0.0d0 + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) @@ -7076,25 +8711,21 @@ C Derivatives in gamma(i+3) #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) + ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d -#else - s1d=0.0d0 #endif - call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT - call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) - s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) + call matvec2(Ug2der(1,1,i+2),dd(1,1,k+1),vtemp2d(1)) + s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,l),vtemp2d(1)) #endif s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) #ifdef MOMENT call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#else - s13d=0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7116,8 +8747,6 @@ C Derivatives in gamma(i+4) call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) s13d = (gtempd(1,1)+gtempd(2,2))*ss13 -#else - s13d = 0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7134,27 +8763,21 @@ C Derivatives in gamma(i+5) call transpose2(AEAderg(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#else - s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) - s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d = 0.0d0 + s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,l),vtemp2(1)) #endif call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) #ifdef MOMENT call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d -#else - s13d = 0.0d0 #endif c s1d=0.0d0 c s2d=0.0d0 @@ -7176,20 +8799,16 @@ C Cartesian derivatives call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 -#else - s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), & vtemp1d(1)) - s2d = scalar2(b1(1,itk),vtemp1d(1)) + s2d = scalar2(b1(1,k),vtemp1d(1)) #ifdef MOMENT call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) s8d = -(atempd(1,1)+atempd(2,2))* - & scalar2(cc(1,1,itl),vtemp2(1)) -#else - s8d = 0.0d0 + & scalar2(cc(1,1,l),vtemp2(1)) #endif call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), & auxmatd(1,1)) @@ -7228,7 +8847,7 @@ c s13d=0.0d0 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), & vtemp4d(1)) - ss13d = scalar2(b1(1,itk),vtemp4d(1)) + ss13d = scalar2(b1(1,k),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d enddo @@ -7252,57 +8871,184 @@ cd goto 1112 l2=l-2 endif do ll=1,3 - ggg1(ll)=eel_turn6*g_contij(ll,1) - ggg2(ll)=eel_turn6*g_contij(ll,2) - ghalf=0.5d0*ggg1(ll) +cgrad ggg1(ll)=eel_turn6*g_contij(ll,1) +cgrad ggg2(ll)=eel_turn6*g_contij(ll,2) +cgrad ghalf=0.5d0*ggg1(ll) cd ghalf=0.0d0 - gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf + gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1) + gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2) + gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf & +ekont*derx_turn(ll,2,1) gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) - gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf + gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf & +ekont*derx_turn(ll,4,1) gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) - ghalf=0.5d0*ggg2(ll) + gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij + gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij +cgrad ghalf=0.5d0*ggg2(ll) cd ghalf=0.0d0 - gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf + gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf & +ekont*derx_turn(ll,2,2) gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) - gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf + gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf & +ekont*derx_turn(ll,4,2) gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) + gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl + gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl enddo cd goto 1112 - do m=i+1,j-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) - enddo - enddo - do m=k+1,l-1 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) - enddo - enddo -1112 continue - do m=i+2,j2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) - enddo - enddo - do m=k+2,l2 - do ll=1,3 - gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) - enddo - enddo +cgrad do m=i+1,j-1 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) +cgrad enddo +cgrad enddo +cgrad do m=k+1,l-1 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) +cgrad enddo +cgrad enddo +cgrad1112 continue +cgrad do m=i+2,j2 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) +cgrad enddo +cgrad enddo +cgrad do m=k+2,l2 +cgrad do ll=1,3 +cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) +cgrad enddo +cgrad enddo cd do iii=1,nres-3 cd write (2,*) iii,g_corr6_loc(iii) cd enddo - endif + endif ! calc_grad eello_turn6=ekont*eel_turn6 cd write (2,*) 'ekont',ekont cd write (2,*) 'eel_turn6',ekont*eel_turn6 return end + crc------------------------------------------------- +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + subroutine Eliptransfer(eliptran) + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.GEO' + include 'COMMON.VAR' + include 'COMMON.LOCAL' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.INTERACT' + include 'COMMON.IOUNITS' + include 'COMMON.CALC' + include 'COMMON.CONTROL' + include 'COMMON.SPLITELE' + include 'COMMON.SBRIDGE' +C this is done by Adasko +C print *,"wchodze" +C structure of box: +C water +C--bordliptop-- buffore starts +C--bufliptop--- here true lipid starts +C lipid +C--buflipbot--- lipid ends buffore starts +C--bordlipbot--buffore ends + eliptran=0.0 + do i=1,nres +C do i=1,1 + if (itype(i).eq.ntyp1) cycle + + positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,i +C first for peptide groups +c for each residue check if it is in lipid or lipid water border area + if ((positi.gt.bordlipbot) + &.and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then +C what fraction I am in + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran +C print *, "doing sscalefor top part" +C print *,i,sslip,fracinbuf,ssgradlip + else + eliptran=eliptran+pepliptran +C print *,"I am in true lipid" + endif +C else +C eliptran=elpitran+0.0 ! I am in water + endif + enddo +C print *, "nic nie bylo w lipidzie?" +C now multiply all by the peptide group transfer factor +C eliptran=eliptran*pepliptran +C now the same for side chains +CV do i=1,1 + do i=1,nres + if (itype(i).eq.ntyp1) cycle + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +c for each residue check if it is in lipid or lipid water border area +C respos=mod(c(3,i+nres),boxzsize) +C print *,positi,bordlipbot,buflipbot + if ((positi.gt.bordlipbot) + & .and.(positi.lt.bordliptop)) then +C the energy transfer exist + if (positi.lt.buflipbot) then + fracinbuf=1.0d0- + & ((positi-bordlipbot)/lipbufthick) +C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *,"doing sccale for lower part" + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0- + &((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i)) + gliptranx(3,i)=gliptranx(3,i) + &+ssgradlip*liptranene(itype(i)) + gliptranc(3,i-1)= gliptranc(3,i-1) + &+ssgradlip*liptranene(itype(i)) +C print *, "doing sscalefor top part",sslip,fracinbuf + else + eliptran=eliptran+liptranene(itype(i)) +C print *,"I am in true lipid" + endif + endif ! if in lipid or buffor +C else +C eliptran=elpitran+0.0 ! I am in water + enddo + return + end + + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + SUBROUTINE MATVEC2(A1,V1,V2) implicit real*8 (a-h,o-z) include 'DIMENSIONS' @@ -7436,4 +9182,446 @@ C----------------------------------------------------------------------------- scalar=sc return end +C----------------------------------------------------------------------- + double precision function sscale(r) + double precision r,gamm + include "COMMON.SPLITELE" + if(r.lt.r_cut-rlamb) then + sscale=1.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale=0d0 + endif + return + end +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscagrad(r) + double precision r,gamm + include "COMMON.SPLITELE" + if(r.lt.r_cut-rlamb) then + sscagrad=0.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscagrad=gamm*(6*gamm-6.0d0)/rlamb + else + sscagrad=0.0d0 + endif + return + end +C----------------------------------------------------------------------- +C----------------------------------------------------------------------- + double precision function sscalelip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscale=1.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscalelip=1.0d0+r*r*(2*r-3.0d0) +C else +C sscale=0d0 +C endif + return + end +C----------------------------------------------------------------------- + double precision function sscagradlip(r) + double precision r,gamm + include "COMMON.SPLITELE" +C if(r.lt.r_cut-rlamb) then +C sscagrad=0.0d0 +C else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then +C gamm=(r-(r_cut-rlamb))/rlamb + sscagradlip=r*(6*r-6.0d0) +C else +C sscagrad=0.0d0 +C endif + return + end + +C----------------------------------------------------------------------- + subroutine set_shield_fac + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0*sh_frac_dist-3.0d0) + fac_help_scale=6.0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C if ((i.eq.3).and.(k.eq.2)) then +C print *,i,sh_frac_dist,dist_pep,fac_help_scale,scale_fac_dist +C & ,"TU" +C endif + +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0+short**2/dist_pep_side**2) +C now costhet_grad +C costhet=0.0d0 + costhet_fac=costhet**3*short**2*(-0.5)/dist_pep_side**4 +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0+rkprim**2/dist_pep_side**2) + cosphi_fac=cosphi**3*rkprim**2*(-0.5)/dist_pep_side**4 + + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) + + cosphi_grad_loc(j)=cosphi**3*0.5/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) + enddo + + VofOverlap=VSolvSphere/2.0d0*(1.0-costhet)*(1.0-cosphi) + & /VSolvSphere_div + & *wshield +C now the gradient... +C grad_shield is gradient of Calfa for peptide groups +C write(iout,*) "shield_compon",i,k,VSolvSphere,scale_fac_dist, +C & costhet,cosphi +C write(iout,*) "cosphi_compon",i,k,pep_side0pept_group, +C & dist_pep_side,dist_side_calf,c(1,k+nres),c(1,k),itype(k) + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j) +C gradient po costhet + &-scale_fac_dist*costhet_grad(j)/(1.0-costhet) + &-scale_fac_dist*(cosphi_grad_long(j)) + &/(1.0-cosphi) )*div77_81 + &*VofOverlap +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & +scale_fac_dist*costhet_grad(j)*2.0d0/(1.0-costhet) + & +scale_fac_dist*(cosphi_grad_long(j)) + & *2.0d0/(1.0-cosphi)) + & *div77_81*VofOverlap + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*cosphi_grad_loc(j) + & *2.0d0/(1.0-cosphi) + & *div77_81*VofOverlap + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*div77_81+div4_81 +C write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i) + enddo + return + end +C-------------------------------------------------------------------------- +C first for shielding is setting of function of side-chains + subroutine set_shield_fac2 + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'COMMON.CHAIN' + include 'COMMON.DERIV' + include 'COMMON.IOUNITS' + include 'COMMON.SHIELD' + include 'COMMON.INTERACT' +C this is the squar root 77 devided by 81 the epislion in lipid (in protein) + double precision div77_81/0.974996043d0/, + &div4_81/0.2222222222d0/,sh_frac_dist_grad(3) + +C the vector between center of side_chain and peptide group + double precision pep_side(3),long,side_calf(3), + &pept_group(3),costhet_grad(3),cosphi_grad_long(3), + &cosphi_grad_loc(3),pep_side_norm(3),side_calf_norm(3) +C the line belowe needs to be changed for FGPROC>1 + do i=1,nres-1 + if ((itype(i).eq.ntyp1).and.itype(i+1).eq.ntyp1) cycle + ishield_list(i)=0 +Cif there two consequtive dummy atoms there is no peptide group between them +C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k).eq.ntyp1).or.(itype(k).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +C pep_side(j)=2.0d0 +C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=dsqrt(dist_pep_side) + dist_pept_group=dsqrt(dist_pept_group) + dist_side_calf=dsqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +C print *,buff_shield,"buff" +C now sscale + if (sh_frac_dist.le.0.0) cycle +C If we reach here it means that this side chain reaches the shielding sphere +C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +C ishield_list is a list of non 0 side-chain that contribute to factor gradient +C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist + & *(2.0d0*sh_frac_dist-3.0d0) + fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) + & /dist_pep_side/buff_shield*0.5d0 +C remember for the final gradient multiply sh_frac_dist_grad(j) +C for side_chain by factor -2 ! + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +C sh_frac_dist_grad(j)=0.0d0 +C scale_fac_dist=1.0d0 +C print *,"jestem",scale_fac_dist,fac_help_scale, +C & sh_frac_dist_grad(j) + enddo + endif +C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k)) + long=long_r_sidechain(itype(k)) + costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2) + sinthet=short/dist_pep_side*costhet +C now costhet_grad +C costhet=0.6d0 +C sinthet=0.8 + costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4 +C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet +C & -short/dist_pep_side**2/costhet) +C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +C remember for the final gradient multiply costhet_grad(j) +C for side_chain by factor -2 ! +C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0d0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ + & (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0d0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +C rkprim=short + +C now costhet_grad + cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2) +C cosphi=0.6 + cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4 + sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ + & dist_pep_side**2) +C sinphi=0.8 + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) + &+cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa/ + &((dist_pep_side*dist_side_calf))* + &((side_calf(j))-cosalfa* + &((pep_side(j)/dist_pep_side)*dist_side_calf)) +C cosphi_grad_long(j)=0.0d0 + cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) + &*(long-short)/fac_alfa_sin*cosalfa + &/((dist_pep_side*dist_side_calf))* + &(pep_side(j)- + &cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) +C cosphi_grad_loc(j)=0.0d0 + enddo +C print *,sinphi,sinthet + VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) + & /VSolvSphere_div +C & *wshield +C now the gradient... + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) +C gradient po skalowaniu + & +(sh_frac_dist_grad(j)*VofOverlap +C gradient po costhet + & +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield +C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)= + & (sh_frac_dist_grad(j)*(-2.0d0) + & *VofOverlap + & -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( + & sinphi/sinthet*costhet*costhet_grad(j) + & +sinthet/sinphi*cosphi*cosphi_grad_long(j))) + & )*wshield + + grad_shield_loc(j,ishield_list(i),i)= + & scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0* + &(1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*( + & sinthet/sinphi*cosphi*cosphi_grad_loc(j) + & )) + & *wshield + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield) +c write(2,*) "TOTAL VOLUME",i,VolumeTotal,fac_shield(i), +c & " wshield",wshield +c write(2,*) "TU",rpp(1,1),short,long,buff_shield + enddo + return + end +C-------------------------------------------------------------------------- + double precision function tschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=y + do i=2,n + yy(i)=2*yy(1)*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i)*yy(i) + enddo + tschebyshev=aux + return + end +C-------------------------------------------------------------------------- + double precision function gradtschebyshev(m,n,x,y) + implicit none + include "DIMENSIONS" + integer i,m,n + double precision x(n+1),y,yy(0:maxvar),aux +c Tschebyshev polynomial. Note that the first term is omitted +c m=0: the constant term is included +c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=2.0d0*y + do i=2,n + yy(i)=2*y*yy(i-1)-yy(i-2) + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i+1)*yy(i)*(i+1) +C print *, x(i+1),yy(i),i + enddo + gradtschebyshev=aux + return + end diff --git a/source/wham/src-M/geomout.F b/source/wham/src-M/geomout.F index 941810f..097040f 100644 --- a/source/wham/src-M/geomout.F +++ b/source/wham/src-M/geomout.F @@ -22,7 +22,7 @@ ires=0 do i=nnt,nct iti=itype(i) - if (iti.eq.21) then + if (iti.eq.ntyp1) then ichain=ichain+1 ires=0 write (ipdb,'(a)') 'TER' @@ -41,12 +41,12 @@ enddo write (ipdb,'(a)') 'TER' do i=nnt,nct-1 - if (itype(i).eq.21) cycle - if (itype(i).eq.10 .and. itype(i+1).ne.21) then + if (itype(i).eq.ntyp1) cycle + if (itype(i).eq.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1) - else if (itype(i).ne.10 .and. itype(i+1).ne.21) then + else if (itype(i).ne.10 .and. itype(i+1).ne.ntyp1) then write (ipdb,30) ica(i),ica(i+1),ica(i)+1 - else if (itype(i).ne.10 .and. itype(i+1).eq.21) then + else if (itype(i).ne.10 .and. itype(i+1).eq.ntyp1) then write (ipdb,30) ica(i),ica(i)+1 endif enddo @@ -54,7 +54,11 @@ write (ipdb,30) ica(nct),ica(nct)+1 endif do i=1,nss - write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 + if (dyn_ss) then + write (iunit,30) ica(idssb(i))+1,ica(jdssb(i))+1 + else + write (ipdb,30) ica(ihpb(i)-nres)+1,ica(jhpb(i)-nres)+1 + endif enddo write (ipdb,'(a6)') 'ENDMDL' 10 FORMAT ('ATOM',I7,' CA ',A3,1X,A1,I4,4X,3F8.3,f15.3) @@ -105,7 +109,18 @@ C format. write (imol2,'(i5,2i6,i2)') i-nnt+1,i-nnt+1,i-nnt+2,1 enddo do i=1,nss - write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 +C write (imol2,'(i5,2i6,i2)') nct-nnt+i,ihpb(i),jhpb(i),1 + if (dyn_ss) then + write(imol2,'(a6,i4,1x,a3,i7,4x,a3,i7)') + & 'SSBOND',i,'CYS',ihpb(i)-1-nres, + & 'CYS',jhpb(i)-1-nres +C & 'SSBOND',i,'CYS',idssb(i)-nnt+1, +C & 'CYS',jdssb(i)-nnt+1 + else + write(imol2,'(a6,i4,1x,a3,i7,4x,a3,i7)') + & 'SSBOND',i,'CYS',ihpb(i)-nnt+1-nres, + & 'CYS',jhpb(i)-nnt+1-nres + endif enddo write (imol2,'(a)') '\@SUBSTRUCTURE' do i=nnt,nct diff --git a/source/wham/src-M/gnmr1.f b/source/wham/src-M/gnmr1.f index 905e746..8bfc43a 100644 --- a/source/wham/src-M/gnmr1.f +++ b/source/wham/src-M/gnmr1.f @@ -41,3 +41,33 @@ c------------------------------------------------------------------------------- return end c--------------------------------------------------------------------------------- + double precision function rlornmr1(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl) + else if (y.gt.ymax) then + rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl) + else + rlornmr1=0.0d0 + endif + return + end +c------------------------------------------------------------------------------ + double precision function rlornmr1prim(y,ymin,ymax,sigma) + implicit none + double precision y,ymin,ymax,sigma + double precision wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ + & ((ymin-y)**wykl+sigma**wykl)**2 + else if (y.gt.ymax) then + rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ + & ((y-ymax)**wykl+sigma**wykl)**2 + else + rlornmr1prim=0.0d0 + endif + return + end + diff --git a/source/wham/src-M/include_unres/COMMON.CALC b/source/wham/src-M/include_unres/COMMON.CALC index 67b4bb9..bf255c9 100644 --- a/source/wham/src-M/include_unres/COMMON.CALC +++ b/source/wham/src-M/include_unres/COMMON.CALC @@ -5,11 +5,11 @@ & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg + & dsci_inv,dscj_inv,gg,gg_lipi,gg_lipj common /calc/ erij(3),rij,xj,yj,zj,dxi,dyi,dzi,dxj,dyj,dzj, & chi1,chi2,chi12,chip1,chip2,chip12,alf1,alf2,alf12,om1,om2,om12, & om1om2,chiom1,chiom2,chiom12,chipom1,chipom2,chipom12,eps1, & faceps1,faceps1_inv,eps1_om12,facsig,sigsq,sigsq_om1,sigsq_om2, & sigsq_om12,facp,facp_inv,facp1,eps2rt,eps2rt_om1,eps2rt_om2, & eps2rt_om12,eps3rt,eom1,eom2,eom12,evdwij,eps2der,eps3der,sigder, - & dsci_inv,dscj_inv,gg(3),i,j + & dsci_inv,dscj_inv,gg(3),gg_lipi(3),gg_lipj(3),i,j diff --git a/source/wham/src-M/include_unres/COMMON.CONTACTS b/source/wham/src-M/include_unres/COMMON.CONTACTS index d07a0f0..4525a07 100644 --- a/source/wham/src-M/include_unres/COMMON.CONTACTS +++ b/source/wham/src-M/include_unres/COMMON.CONTACTS @@ -26,18 +26,21 @@ C Interactions of pseudo-dipoles generated by loc-el interactions. C 10/30/99 Added other pre-computed vectors and matrices needed C to calculate three - six-order el-loc correlation terms double precision Ug,Ugder,Ug2,Ug2der,obrot,obrot2,obrot_der, - & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder, - & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der + & obrot2_der,Ub2,Ub2der,mu,muder,EUg,EUgder,CUg,CUgder,gmu,gUb2, + & DUg,DUgder,DtUg2,DtUg2der,Ctobr,Ctobrder,Dtobr2,Dtobr2der, + & gtEUg common /rotat/ Ug(2,2,maxres),Ugder(2,2,maxres),Ug2(2,2,maxres), & Ug2der(2,2,maxres),obrot(2,maxres),obrot2(2,maxres), & obrot_der(2,maxres),obrot2_der(2,maxres) C This common block contains vectors and matrices dependent on a single C amino-acid residue. common /precomp1/ Ub2(2,maxres),Ub2der(2,maxres),mu(2,maxres), + & gmu(2,maxres),gUb2(2,maxres), & EUg(2,2,maxres),EUgder(2,2,maxres),CUg(2,2,maxres), & CUgder(2,2,maxres),DUg(2,2,maxres),Dugder(2,2,maxres), & DtUg2(2,2,maxres),DtUg2der(2,2,maxres),Ctobr(2,maxres), - & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres) + & Ctobrder(2,maxres),Dtobr2(2,maxres),Dtobr2der(2,maxres), + & gtEUg(2,2,maxres) C This common block contains vectors and matrices dependent on two C consecutive amino-acid residues. double precision Ug2Db1t,Ug2Db1tder,CUgb2,CUgb2der,EUgC, diff --git a/source/wham/src-M/include_unres/COMMON.DERIV b/source/wham/src-M/include_unres/COMMON.DERIV index 79f8630..7f9733f 100644 --- a/source/wham/src-M/include_unres/COMMON.DERIV +++ b/source/wham/src-M/include_unres/COMMON.DERIV @@ -1,25 +1,54 @@ - double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gvdwpp, - & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gvdwx,gradcorr,gradxorr, - & gradcorr5,gradcorr6,gel_loc,gcorr3_turn,gcorr4_turn,gcorr6_turn, - & gel_loc_loc,gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc, - & g_corr5_loc,g_corr6_loc,gradb,gradbx,gsccorc,gsccorx,gsccor_loc, - & gscloc,gsclocx + double precision dcdv,dxdv,dxds,gradx,gradc,gvdwc,gelc,gelc_long, + & gvdwpp,gel_loc,gel_loc_long,gvdwc_scpp,gliptranc,gliptranx, + & gradx_scp,gvdwc_scp,ghpbx,ghpbc,gloc,gloc_x,dtheta,dphi,dalpha, + & domega,gscloc,gsclocx,gradcorr,gradcorr_long,gradcorr5_long, + & gradcorr6_long,gcorr6_turn_long,gvdwx,gshieldx,gradafm, + & gg_tube,gg_tube_SC, + & gshieldc, gshieldc_loc, gshieldx_ec, gshieldc_ec, + & gshieldc_loc_ec, gshieldx_t3,gshieldc_t3,gshieldc_loc_t3, + & gshieldx_t4, gshieldc_t4,gshieldc_loc_t4,gshieldx_ll, + & gshieldc_ll, gshieldc_loc_ll integer nfl,icg logical calc_grad common /derivat/ dcdv(6,maxdim),dxdv(6,maxdim),dxds(6,maxres), - & gradx(3,maxres,2),gradc(3,maxres,2),gvdwx(3,maxres), - & gvdwc(3,maxres),gelc(3,maxres),gvdwpp(3,maxres), - & gradx_scp(3,maxres), - & gvdwc_scp(3,maxres),ghpbx(3,maxres),ghpbc(3,maxres), - & gloc(maxvar,2),gradcorr(3,maxres),gradxorr(3,maxres), - & gradcorr5(3,maxres),gradcorr6(3,maxres), - & gel_loc(3,maxres),gcorr3_turn(3,maxres),gcorr4_turn(3,maxres), - & gcorr6_turn(3,maxres),gradb(3,maxres),gradbx(3,maxres), - & gel_loc_loc(maxvar),gel_loc_turn3(maxvar),gel_loc_turn4(maxvar), - & gel_loc_turn6(maxvar),gcorr_loc(maxvar), - & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,maxres), - & gsccorx(3,maxres),gsccor_loc(maxres), - & gscloc(3,maxres),gsclocx(3,maxres),nfl,icg,calc_grad + & gradx(3,-1:maxres,2),gradc(3,-1:maxres,2),gvdwx(3,-1:maxres), + & gvdwc(3,-1:maxres),gelc(3,-1:maxres),gelc_long(3,-1:maxres), + & gvdwpp(3,-1:maxres),gvdwc_scpp(3,-1:maxres), + & gliptranc(3,-1:maxres), + & gliptranx(3,-1:maxres), + & gshieldx(3,-1:maxres), gshieldc(3,-1:maxres), + & gshieldc_loc(3,-1:maxres), + & gshieldx_ec(3,-1:maxres), gshieldc_ec(3,-1:maxres), + & gshieldc_loc_ec(3,-1:maxres), + & gshieldx_t3(3,-1:maxres), gshieldc_t3(3,-1:maxres), + & gshieldc_loc_t3(3,-1:maxres), + & gshieldx_t4(3,-1:maxres), gshieldc_t4(3,-1:maxres), + & gshieldc_loc_t4(3,-1:maxres), + & gshieldx_ll(3,-1:maxres), gshieldc_ll(3,-1:maxres), + & gshieldc_loc_ll(3,-1:maxres), + & gradafm(3,-1:maxres),gg_tube(3,-1:maxres), + & gg_tube_sc(3,-1:maxres), + & gradx_scp(3,-1:maxres),gvdwc_scp(3,-1:maxres), + & ghpbx(3,-1:maxres), + & ghpbc(3,-1:maxres),gloc(maxvar,2),gradcorr(3,-1:maxres), + & gradcorr_long(3,-1:maxres),gradcorr5_long(3,-1:maxres), + & gradcorr6_long(3,-1:maxres),gcorr6_turn_long(3,-1:maxres), + & gradxorr(3,-1:maxres),gradcorr5(3,-1:maxres), + & gradcorr6(3,-1:maxres), + & gloc_x(maxvar,2),gel_loc(3,-1:maxres),gel_loc_long(3,-1:maxres), + & gcorr3_turn(3,-1:maxres), + & gcorr4_turn(3,-1:maxres),gcorr6_turn(3,-1:maxres), + & gradb(3,-1:maxres), + & gradbx(3,-1:maxres),gel_loc_loc(maxvar),gel_loc_turn3(maxvar), + & gel_loc_turn4(maxvar),gel_loc_turn6(maxvar), + & gcorr_loc(maxvar), + & g_corr5_loc(maxvar),g_corr6_loc(maxvar),gsccorc(3,-1:maxres), + & gsccorx(3,-1:maxres),gsccor_loc(-1:maxres), + & dtheta(3,2,-1:maxres), + & gscloc(3,-1:maxres),gsclocx(3,-1:maxres), + & dphi(3,3,-1:maxres),dalpha(3,3,-1:maxres),domega(3,3,-1:maxres), + & nfl, + & icg,calc_grad double precision derx,derx_turn common /deriv_loc/ derx(3,5,2),derx_turn(3,5,2) double precision dXX_C1tab(3,maxres),dYY_C1tab(3,maxres), @@ -28,3 +57,6 @@ & dZZ_XYZtab(3,maxres) common /deriv_scloc/ dXX_C1tab,dYY_C1tab,dZZ_C1tab,dXX_Ctab, & dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,dZZ_XYZtab + integer igrad_start,igrad_end,jgrad_start(maxres), + & jgrad_end(maxres) + common /mpgrad/ igrad_start,igrad_end,jgrad_start,jgrad_end diff --git a/source/wham/src-M/include_unres/COMMON.FFIELD b/source/wham/src-M/include_unres/COMMON.FFIELD index 0c169f7..6c432a9 100644 --- a/source/wham/src-M/include_unres/COMMON.FFIELD +++ b/source/wham/src-M/include_unres/COMMON.FFIELD @@ -6,11 +6,11 @@ C----------------------------------------------------------------------- double precision wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, & wturn6,wvdwpp,wbond,weights,scal14,cutoff_corr,delt_corr, - & r0_corr + & r0_corr,wliptran integer ipot,n_ene_comp common /ffield/ wsc,wscp,welec,wstrain,wtor,wtor_d,wang,wscloc, & wcorr,wcorr4,wcorr5,wcorr6,wsccor,wel_loc,wturn3,wturn4, - & wturn6,wvdwpp,wbond,weights(max_ene), + & wturn6,wvdwpp,wbond,wliptran,weights(max_ene), & scal14,cutoff_corr,delt_corr,r0_corr,ipot,n_ene_comp common /potentials/ potname(5) character*3 potname diff --git a/source/wham/src-M/include_unres/COMMON.INTERACT b/source/wham/src-M/include_unres/COMMON.INTERACT index d4a58b5..7d6b59f 100644 --- a/source/wham/src-M/include_unres/COMMON.INTERACT +++ b/source/wham/src-M/include_unres/COMMON.INTERACT @@ -1,8 +1,10 @@ - double precision aa,bb,augm,aad,bad,app,bpp,ael6,ael3 + double precision aa_aq,bb_aq,augm,aad,bad,app,bpp,ael6,ael3, + & aa_lip,bb_lip integer nnt,nct,nint_gr,istart,iend,itype,itel,itypro,ielstart, & ielend,nscp_gr,iscpstart,iscpend,iatsc_s,iatsc_e,iatel_s, & iatel_e,iatscp_s,iatscp_e,ispp,iscp,expon,expon2 - common /interact/aa(ntyp,ntyp),bb(ntyp,ntyp),augm(ntyp,ntyp), + common /interact/aa_aq(ntyp,ntyp),bb_aq(ntyp,ntyp), + & augm(ntyp,ntyp),aa_lip(ntyp,ntyp),bb_lip(ntyp,ntyp), & aad(ntyp,2),bad(ntyp,2),app(2,2),bpp(2,2),ael6(2,2),ael3(2,2), & expon,expon2,nnt,nct,nint_gr(maxres),istart(maxres,maxint_gr), & iend(maxres,maxint_gr),itype(maxres),itel(maxres),itypro, @@ -12,15 +14,23 @@ C 12/1/95 Array EPS included in the COMMON block. double precision eps,sigma,sigmaii,rs0,chi,chip,chip0,alp,signa0, & sigii,sigma0,rr0,r0,r0e,r0d,rpp,epp,elpp6,elpp3,eps_scp,rscp, - & eps_orig + & eps_orig,epslip common /body/eps(ntyp,ntyp),sigma(ntyp,ntyp),sigmaii(ntyp,ntyp), + &epslip(ntyp,ntyp), & rs0(ntyp,ntyp),chi(ntyp,ntyp),chip(ntyp),chip0(ntyp),alp(ntyp), & sigma0(ntyp),sigii(ntyp),rr0(ntyp),r0(ntyp,ntyp),r0e(ntyp,ntyp), & r0d(ntyp,2),rpp(2,2),epp(2,2),elpp6(2,2),elpp3(2,2), - & eps_scp(20,2),rscp(20,2),eps_orig(ntyp,ntyp) + & eps_scp(ntyp,2),rscp(ntyp,2),eps_orig(ntyp,ntyp) c 12/5/03 modified 09/18/03 Bond stretching parameters. double precision vbldp0,vbldsc0,akp,aksc,abond0,distchainmax + &,vbldpDUM integer nbondterm common /stretch/ vbldp0,vbldsc0(maxbondterm,ntyp),akp, & aksc(maxbondterm,ntyp),abond0(maxbondterm,ntyp), & distchainmax,nbondterm(ntyp) + &,vbldpDUM +C 01/29/15 Lipidic parameters + double precision pepliptran,liptranene + common /lipid/ pepliptran,liptranene(ntyp) + + diff --git a/source/wham/src-M/include_unres/COMMON.LOCAL b/source/wham/src-M/include_unres/COMMON.LOCAL index 1d0f3aa..3e68e82 100644 --- a/source/wham/src-M/include_unres/COMMON.LOCAL +++ b/source/wham/src-M/include_unres/COMMON.LOCAL @@ -1,36 +1,53 @@ double precision a0thet,athet,bthet,polthet,gthet,theta0,sig0, - & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0,vbl,vblinv,vblinv2, - & vbl_cis,vbl0,vbld_inv - integer nlob,loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end + & sigc0,dsc,dsc_inv,bsc,censc,gaussc,dsc0 + integer nlob C Parameters of the virtual-bond-angle probability distribution - common /thetas/ a0thet(ntyp),athet(2,ntyp),bthet(2,ntyp), - & polthet(0:3,ntyp),gthet(3,ntyp),theta0(ntyp),sig0(ntyp), - & sigc0(ntyp) -C Parameters of ab initio-derived potential of virtual-bond-angle bending - integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, - & ithetyp(ntyp1),nntheterm - double precision aa0thet(maxthetyp1,maxthetyp1,maxthetyp1), - & aathet(maxtheterm,maxthetyp1,maxthetyp1,maxthetyp1), - & bbthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ccthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ddthet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & eethet(maxsingle,maxtheterm2,maxthetyp1,maxthetyp1,maxthetyp1), - & ffthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1), - & ggthet(maxdouble,maxdouble,maxtheterm3,maxthetyp1,maxthetyp1, - & maxthetyp1) - common /theta_abinitio/aa0thet,aathet,bbthet,ccthet,ddthet,eethet, - & ffthet, - & ggthet,ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, - & ndouble,nntheterm + common /thetas/ a0thet(-ntyp:ntyp),athet(2,-ntyp:ntyp,-1:1,-1:1), + & bthet(2,-ntyp:ntyp,-1:1,-1:1),polthet(0:3,-ntyp:ntyp), + & gthet(3,-ntyp:ntyp),theta0(-ntyp:ntyp),sig0(-ntyp:ntyp), + & sigc0(-ntyp:ntyp) C Parameters of the side-chain probability distribution common /sclocal/ dsc(ntyp1),dsc_inv(ntyp1),bsc(maxlob,ntyp), - & censc(3,maxlob,ntyp),gaussc(3,3,maxlob,ntyp),dsc0(ntyp1), + & censc(3,maxlob,-ntyp:ntyp),gaussc(3,3,maxlob,-ntyp:ntyp), + &dsc0(ntyp1), & nlob(ntyp1) +C Parameters of ab initio-derived potential of virtual-bond-angle bending + integer nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle,ndouble, + & ithetyp(-ntyp1:ntyp1),nntheterm + common /theta_abinitio/ aa0thet(-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & aathet(maxtheterm,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & bbthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ccthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ddthet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & eethet(maxsingle,maxtheterm2,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1,-maxthetyp1:maxthetyp1,2), + & ffthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2), + & ggthet(maxdouble,maxdouble,maxtheterm3,-maxthetyp1:maxthetyp1, + &-maxthetyp1:maxthetyp1, -maxthetyp1:maxthetyp1,2), + & ithetyp,nthetyp,ntheterm,ntheterm2,ntheterm3,nsingle, + & ndouble,nntheterm + + double precision aa0thet,aathet,bbthet,ccthet,ddthet,eethet, + & ffthet, + & ggthet C Virtual-bond lenghts + double precision vbl,vblinv,vblinv2,vbl_cis,vbl0,vbld_inv + integer loc_start,loc_end,ithet_start,ithet_end,iphi_start, + & iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, + & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, + & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, + & iint_end,iphi1_start,iphi1_end,itau_start,itau_end common /peptbond/ vbl,vblinv,vblinv2,vbl_cis,vbl0 common /indices/ loc_start,loc_end,ithet_start,ithet_end, - & iphi_start,iphi_end + & iphi_start,iphi_end,iphid_start,iphid_end,ibond_start,ibond_end, + & ibondp_start,ibondp_end,ivec_start,ivec_end,iset_start,iset_end, + & iturn3_start,iturn3_end,iturn4_start,iturn4_end,iint_start, + & iint_end,iphi1_start,iphi1_end,itau_start,itau_end C Inverses of the actual virtual bond lengths common /invlen/ vbld_inv(maxres2) diff --git a/source/wham/src-M/include_unres/COMMON.NAMES b/source/wham/src-M/include_unres/COMMON.NAMES index a266339..7beefb7 100644 --- a/source/wham/src-M/include_unres/COMMON.NAMES +++ b/source/wham/src-M/include_unres/COMMON.NAMES @@ -1,6 +1,7 @@ character*3 restyp character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) + common /names/ restyp(-ntyp1:ntyp1), + & onelet(-ntyp1:ntyp1) character*10 ename,wname integer nprint_ene,print_order common /namterm/ ename(max_ene),wname(max_ene),nprint_ene, diff --git a/source/wham/src-M/include_unres/COMMON.SBRIDGE b/source/wham/src-M/include_unres/COMMON.SBRIDGE index 5c87412..028f9ae 100644 --- a/source/wham/src-M/include_unres/COMMON.SBRIDGE +++ b/source/wham/src-M/include_unres/COMMON.SBRIDGE @@ -1,9 +1,20 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,dhpb, - & forcon,weidis - integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,ns,nss, - & nfree,iss(maxss) - common /links/ dhpb(maxdim),forcon(maxdim),ihpb(maxdim), - & jhpb(maxdim),nhpb + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + integer ns,nss,nfree,iss + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + & ns,nss,nfree,iss(maxss) + double precision dhpb,dhpb1,forcon,fordepth + integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb + common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), + & fordepth(maxdim), + & ihpb(maxdim),jhpb(maxdim),nhpb + double precision weidis common /restraints/ weidis + integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij,dtriss,atriss,btriss,ctriss + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dtriss,atriss,btriss,ctriss,Ht, + & dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim),ibecarb(maxdim) + common /dyn_ss_logic/ + & dyn_ss,dyn_ss_mask(maxres) diff --git a/source/wham/src-M/include_unres/COMMON.SCCOR b/source/wham/src-M/include_unres/COMMON.SCCOR index 5217de7..33a865d 100644 --- a/source/wham/src-M/include_unres/COMMON.SCCOR +++ b/source/wham/src-M/include_unres/COMMON.SCCOR @@ -1,6 +1,20 @@ -C Parameters of the SCCOR term - double precision v1sccor,v2sccor - integer nterm_sccor - common/torsion/v1sccor(maxterm_sccor,20,20), - & v2sccor(maxterm_sccor,20,20), - & nterm_sccor +cc Parameters of the SCCOR term + double precision v1sccor,v2sccor,vlor1sccor, + & vlor2sccor,vlor3sccor,gloc_sc, + & dcostau,dsintau,dtauangle,dcosomicron, + & domicron,v0sccor + integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor + common /sccor/ v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor1sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor2sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor3sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & gloc_sc(3,0:maxres2,10), + & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), + & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), + & domicron(3,3,3,maxres2), + & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), + & nsccortyp, + & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp) + diff --git a/source/wham/src-M/include_unres/COMMON.SCROT b/source/wham/src-M/include_unres/COMMON.SCROT index 2da7b8f..a352775 100644 --- a/source/wham/src-M/include_unres/COMMON.SCROT +++ b/source/wham/src-M/include_unres/COMMON.SCROT @@ -1,3 +1,3 @@ C Parameters of the SC rotamers (local) term double precision sc_parmin - common/scrot/sc_parmin(maxsccoef,20) + common/scrot/sc_parmin(maxsccoef,ntyp) diff --git a/source/wham/src-M/include_unres/COMMON.TORCNSTR b/source/wham/src-M/include_unres/COMMON.TORCNSTR index f8fc3a1..8958b81 100644 --- a/source/wham/src-M/include_unres/COMMON.TORCNSTR +++ b/source/wham/src-M/include_unres/COMMON.TORCNSTR @@ -1,5 +1,17 @@ - integer ndih_constr,idih_constr(maxdih_constr) + integer ndih_constr,idih_constr(maxdih_constr),ntheta_constr, + & itheta_constr(maxdih_constr) integer ndih_nconstr,idih_nconstr(maxdih_constr) - double precision phi0(maxdih_constr),drange(maxdih_constr),ftors - common /torcnstr/ phi0,drange,ftors,ndih_constr,idih_constr, - & ndih_nconstr,idih_nconstr + integer idihconstr_start,idihconstr_end,ithetaconstr_start, + & ithetaconstr_end + logical raw_psipred + double precision phi0(maxdih_constr),drange(maxdih_constr), + & ftors(maxdih_constr),theta_constr0(maxdih_constr), + & theta_drange(maxdih_constr),for_thet_constr(maxdih_constr), + & vpsipred(3,maxdih_constr),sdihed(2,maxdih_constr), + & phibound(2,maxres),wdihc + common /torcnstr/ phi0,drange,ftors,theta_constr0,theta_drange, + & for_thet_constr,vpsipred,sdihed,phibound,wdihc, + & ndih_constr,idih_constr, + & ndih_nconstr,idih_nconstr,idihconstr_start,idihconstr_end, + & ntheta_constr,itheta_constr,ithetaconstr_start, + & ithetaconstr_end,raw_psipred diff --git a/source/wham/src-M/include_unres/COMMON.TORSION b/source/wham/src-M/include_unres/COMMON.TORSION index 55cc7f4..cd576c8 100644 --- a/source/wham/src-M/include_unres/COMMON.TORSION +++ b/source/wham/src-M/include_unres/COMMON.TORSION @@ -1,25 +1,60 @@ C Torsional constants of the rotation about virtual-bond dihedral angles - double precision v1,v2,vlor1,vlor2,vlor3,v0 - integer itortyp,ntortyp,nterm,nlor,nterm_old - common/torsion/v0(maxtor,maxtor),v1(maxterm,maxtor,maxtor), - & v2(maxterm,maxtor,maxtor),vlor1(maxlor,maxtor,maxtor), + double precision v1,v2,vlor1,vlor2,vlor3,v0,v1_kcc,v2_kcc, + & v11_chyb,v21_chyb,v12_chyb,v22_chyb,v1bend_chyb + integer itortyp,ntortyp,nterm,nlor,nterm_old,nterm_kcc_Tb, + & nterm_kcc,itortyp_kcc,nbend_kcc_Tb + common/torsion/v0(-maxtor:maxtor,-maxtor:maxtor,2), + & v1(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & v2(maxterm,-maxtor:maxtor,-maxtor:maxtor,2), + & vlor1(maxlor,-maxtor:maxtor,-maxtor:maxtor), & vlor2(maxlor,maxtor,maxtor),vlor3(maxlor,maxtor,maxtor), - & itortyp(ntyp),ntortyp,nterm(maxtor,maxtor), - & nlor(maxtor,maxtor),nterm_old + & v1_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v2_kcc(maxval_kcc,maxval_kcc,maxtor_kcc, + & -maxtor:maxtor,-maxtor:maxtor), + & v1bend_chyb(0:maxang_kcc,-maxtor:maxtor), + & itortyp(-ntyp1:ntyp1),ntortyp, + & itortyp_kcc(-ntyp1:ntyp1), + & nterm(-maxtor:maxtor,-maxtor:maxtor,2), + & nlor(-maxtor:maxtor,-maxtor:maxtor,2), + & nterm_kcc_Tb(-maxtor:maxtor,-maxtor:maxtor), + & nterm_kcc(-maxtor:maxtor,-maxtor:maxtor), + & nbend_kcc_Tb(-maxtor:maxtor), + & nterm_old C 6/23/01 - constants for double torsionals double precision v1c,v1s,v2c,v2s integer ntermd_1,ntermd_2 - common /torsiond/ v1c(2,maxtermd_1,maxtor,maxtor,maxtor), - & v1s(2,maxtermd_1,maxtor,maxtor,maxtor), - & v2c(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & v2s(maxtermd_2,maxtermd_2,maxtor,maxtor,maxtor), - & ntermd_1(maxtor,maxtor,maxtor),ntermd_2(maxtor,maxtor,maxtor) + common /torsiond/ + &v1c(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v1s(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + &v2c(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + &v2s(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor, + & -maxtor:maxtor,2), + & ntermd_1(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2), + & ntermd_2(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) C 9/18/99 - added Fourier coeffficients of the expansion of local energy C surface - double precision b1,b2,cc,dd,ee,ctilde,dtilde,b1tilde - integer nloctyp - common/fourier/ b1(2,maxtor),b2(2,maxtor),cc(2,2,maxtor), - & dd(2,2,maxtor),ee(2,2,maxtor),ctilde(2,2,maxtor), - & dtilde(2,2,maxtor),b1tilde(2,maxtor),nloctyp - double precision b - common /fourier1/ b(13,maxtor) + double precision b1,b2,cc,dd,ee,ctilde,dtilde,b2tilde,b1tilde, + & b,bnew1,bnew2,ccold,ddold,ccnew,ddnew,eenew,e0new,gtb1,gtb2, + & eeold,gtcc,gtdd,gtee, + & bnew1tor,bnew2tor,ccnewtor,ddnewtor,eenewtor,e0newtor + integer nloctyp,iloctyp(-ntyp1:ntyp1),itype2loc(-ntyp1:ntyp1) + logical SPLIT_FOURIERTOR + common/fourier/ b1(2,maxres),b2(2,maxres),b(13,-ntyp:ntyp), + & bnew1(3,2,-ntyp:ntyp),bnew2(3,2,-ntyp:ntyp), + & ccnew(3,2,-ntyp:ntyp),ddnew(3,2,-ntyp:ntyp), + & bnew1tor(3,2,-ntyp:ntyp),bnew2tor(3,2,-ntyp:ntyp), + & ccnewtor(3,2,-ntyp:ntyp),ddnewtor(3,2,-ntyp:ntyp), + & ccold(2,2,-ntyp:ntyp),ddold(2,2,-ntyp:ntyp), + & cc(2,2,maxres), + & dd(2,2,maxres),eeold(2,2,-ntyp:ntyp), + & e0new(3,-ntyp:ntyp),eenew(2,2,2,-ntyp:ntyp), + & e0newtor(3,-ntyp:ntyp),eenewtor(2,2,2,-ntyp:ntyp), + & ee(2,2,maxres), + & ctilde(2,2,maxres), + & dtilde(2,2,maxres),b1tilde(2,maxres), + & b2tilde(2,maxres), + & gtb1(2,maxres),gtb2(2,maxres),gtCC(2,2,maxres), + & gtDD(2,2,maxres),gtEE(2,2,maxres), + & nloctyp,iloctyp,itype2loc,SPLIT_FOURIERTOR diff --git a/source/wham/src-M/include_unres/COMMON.WEIGHTS b/source/wham/src-M/include_unres/COMMON.WEIGHTS index d7e6e23..86f8d7a 100644 --- a/source/wham/src-M/include_unres/COMMON.WEIGHTS +++ b/source/wham/src-M/include_unres/COMMON.WEIGHTS @@ -10,13 +10,13 @@ & epp_low(2,2),epp_up(2,2),rpp_low(2,2),rpp_up(2,2), & elpp6_low(2,2),elpp6_up(2,2),elpp3_low(2,2),elpp3_up(2,2), & b_low(13,3),b_up(13,3),x_up(max_paropt),x_low(max_paropt), - & epscp_low(0:20,2),epscp_up(0:20,2),rscp_low(0:20,2), - & rscp_up(0:20,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp), + & epscp_low(0:ntyp,2),epscp_up(0:ntyp,2),rscp_low(0:ntyp,2), + & rscp_up(0:ntyp,2),epss_low(ntyp),epss_up(ntyp),epsp_low(nntyp), & epsp_up(nntyp), & xm(max_paropt,0:maxprot),xm1(max_paropt,0:maxprot), & xm2(max_paropt,0:maxprot), & imask(max_ene),nsingle_sc,npair_sc,ityp_ssc(ntyp), & ityp_psc(2,nntyp),mask_elec(2,2,4), & mask_fourier(13,3), - & mask_scp(0:20,2,2),mod_other_params,mod_fourier(0:3), + & mask_scp(0:ntyp,2,2),mod_other_params,mod_fourier(0:3), & mod_elec,mod_scp,mod_side,indz(maxbatch+1,maxprot),iw(max_ene) diff --git a/source/wham/src-M/initialize_p.F b/source/wham/src-M/initialize_p.F index 710496d..3ab5712 100644 --- a/source/wham/src-M/initialize_p.F +++ b/source/wham/src-M/initialize_p.F @@ -21,6 +21,7 @@ C include "COMMON.WEIGHTS" include "COMMON.NAMES" include "COMMON.TIME1" + include "COMMON.TORCNSTR" C C The following is just to define auxiliary variables used in angle conversion C @@ -62,6 +63,8 @@ C ihist=30 iweight=31 izsc=32 +C Lipidic input file for parameters range 60-79 + iliptranpar=60 C C Set default weights of the energy terms. C @@ -88,8 +91,10 @@ C enddo do i=1,ntyp do j=1,ntyp - aa(i,j)=0.0D0 - bb(i,j)=0.0D0 + aa_lip(i,j)=0.0D0 + bb_lip(i,j)=0.0D0 + aa_aq(i,j)=0.0D0 + bb_aq(i,j)=0.0D0 augm(i,j)=0.0D0 sigma(i,j)=0.0D0 r0(i,j)=0.0D0 @@ -104,9 +109,13 @@ C sigii(i)=0.0D0 rr0(i)=0.0D0 a0thet(i)=0.0D0 - do j=1,2 - athet(j,i)=0.0D0 - bthet(j,i)=0.0D0 + do j=1,2 + do ichir1=-1,1 + do ichir2=-1,1 + athet(j,i,ichir1,ichir2)=0.0D0 + bthet(j,i,ichir1,ichir2)=0.0D0 + enddo + enddo enddo do j=0,3 polthet(j,i)=0.0D0 @@ -132,15 +141,37 @@ C enddo nlob(ntyp1)=0 dsc(ntyp1)=0.0D0 - do i=1,maxtor - itortyp(i)=0 - do j=1,maxtor - do k=1,maxterm - v1(k,j,i)=0.0D0 - v2(k,j,i)=0.0D0 + do i=-maxtor,maxtor + itortyp(i)=0 + do iblock=1,2 + do j=-maxtor,maxtor + do k=1,maxterm + v1(k,j,i,iblock)=0.0D0 + v2(k,j,i,iblock)=0.0D0 enddo enddo + enddo enddo + do iblock=1,2 + do i=-maxtor,maxtor + do j=-maxtor,maxtor + do k=-maxtor,maxtor + do l=1,maxtermd_1 + v1c(1,l,i,j,k,iblock)=0.0D0 + v1s(1,l,i,j,k,iblock)=0.0D0 + v1c(2,l,i,j,k,iblock)=0.0D0 + v1s(2,l,i,j,k,iblock)=0.0D0 + enddo !l + do l=1,maxtermd_2 + do m=1,maxtermd_2 + v2c(m,l,i,j,k,iblock)=0.0D0 + v2s(m,l,i,j,k,iblock)=0.0D0 + enddo !m + enddo !l + enddo !k + enddo !j + enddo !i + enddo !iblock do i=1,maxres itype(i)=0 itel(i)=0 @@ -158,6 +189,12 @@ C Initialize the bridge arrays do i=1,maxres ihpb(i)=0 jhpb(i)=0 + dyn_ss_mask(i)=.false. + enddo + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo enddo C C Initialize timing. @@ -218,28 +255,37 @@ c------------------------------------------------------------------------- include 'COMMON.NAMES' include 'COMMON.WEIGHTS' include 'COMMON.FFIELD' + include 'COMMON.SHIELD' data restyp / + &'DD','DAU','DAI','DDB','DSM','DPR','DLY','DAR','DHI','DAS','DGL', + & 'DSG','DGN','DSN','DTH', + &'DYY','DAL','DTY','DTR','DVA','DLE','DIL','DPN','MED','DCY','ZER', &'CYS','MET','PHE','ILE','LEU','VAL','TRP','TYR','ALA','GLY','THR', - &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','D'/ + &'SER','GLN','ASN','GLU','ASP','HIS','ARG','LYS','PRO','SME','DBZ', + &'AIB','ABU','D'/ data onelet / + &'z','z','z','z','z','p','k','r','h','d','e','n','q','s','t','g', + &'a','y','w','v','l','i','f','m','c','x', &'C','M','F','I','L','V','W','Y','A','G','T', - &'S','Q','N','E','D','H','R','K','P','X'/ + &'S','Q','N','E','D','H','R','K','P','z','z','z','z','X'/ data potname /'LJ','LJK','BP','GB','GBV'/ data ename / & "EVDW SC-SC","EVDW2 SC-p","EES p-p","ECORR4 ","ECORR5 ", & "ECORR6 ","EELLO ","ETURN3 ","ETURN4 ","ETURN6 ", & "EBE bend","ESC SCloc","ETORS ","ETORSD ","EHPB","EVDWPP", - & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T"/ + & "EVDW2_14","ESTR","ESCCOR","EDIHC","EVDW_T","ELIPTRAN", + & "EAFM","ETHETC","EMPTY"/ data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC"/ + & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC", + & "WLIPTRAN","WAFM","WTHETC","WSHIELD"/ data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0, & 1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0, - & 0.0d0,0.0/ - data nprint_ene /21/ + & 0.0d0,0.0,0.0d0,0.0d0,0.0d0,0.0d0/ + data nprint_ene /22/ data print_order /1,2,3,18,11,12,13,14,4,5,6,7,8,9,10,19, - & 16,15,17,20,21/ + & 16,15,17,20,21,24,22,23,1/ end c--------------------------------------------------------------------------- subroutine init_int_table @@ -257,26 +303,8 @@ c--------------------------------------------------------------------------- include 'COMMON.LOCAL' include 'COMMON.SBRIDGE' include 'COMMON.IOUNITS' + include "COMMON.TORCNSTR" logical scheck,lprint -#ifdef MPL - integer my_sc_int(0:max_fg_Procs-1),my_sc_intt(0:max_fg_Procs), - & my_ele_int(0:max_fg_Procs-1),my_ele_intt(0:max_fg_Procs) -C... Determine the numbers of start and end SC-SC interaction -C... to deal with by current processor. - lprint=.false. - if (lprint) - &write (iout,*) 'INIT_INT_TABLE nres=',nres,' nnt=',nnt,' nct=',nct - n_sc_int_tot=(nct-nnt+1)*(nct-nnt)/2-nss - MyRank=MyID-(MyGroup-1)*fgProcs - call int_bounds(n_sc_int_tot,my_sc_inds,my_sc_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' n_sc_int_tot',n_sc_int_tot,' my_sc_inds=',my_sc_inds, - & ' my_sc_inde',my_sc_inde - ind_sctint=0 - iatsc_s=0 - iatsc_e=0 -#endif lprint=.false. do i=1,maxres nint_gr(i)=0 @@ -296,6 +324,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) goto 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. @@ -307,66 +336,30 @@ cd & (ihpb(i),jhpb(i),i=1,nss) cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj if (scheck) then if (jj.eq.i+1) then -#ifdef MPL - write (iout,*) 'jj=i+1' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+2,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+2 iend(i,1)=nct -#endif else if (jj.eq.nct) then -#ifdef MPL - write (iout,*) 'jj=nct' - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct-1,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+1 iend(i,1)=nct-1 -#endif else -#ifdef MPL - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,jj-1,nint_gr(i),istart(i,1),iend(i,1),*12) - ii=nint_gr(i)+1 - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,jj+1,nct,nint_gr(i),istart(i,ii),iend(i,ii),*12) -#else nint_gr(i)=2 istart(i,1)=i+1 iend(i,1)=jj-1 istart(i,2)=jj+1 iend(i,2)=nct -#endif endif else -#ifdef MPL - call int_partition(ind_scint,my_sc_inds,my_sc_inde,i, - & iatsc_s,iatsc_e,i+1,nct,nint_gr(i),istart(i,1),iend(i,1),*12) -#else nint_gr(i)=1 istart(i,1)=i+1 iend(i,1)=nct ind_scint=int_scint+nct-i -#endif endif -#ifdef MPL - ind_scint_old=ind_scint -#endif enddo 12 continue -#ifndef MPL iatsc_s=nnt iatsc_e=nct-1 -#endif -#ifdef MPL - if (lprint) then - write (iout,*) 'Processor',MyID,' Group',MyGroup - write (iout,*) 'iatsc_s=',iatsc_s,' iatsc_e=',iatsc_e - endif -#endif if (lprint) then write (iout,'(a)') 'Interaction array:' do i=iatsc_s,iatsc_e @@ -375,33 +368,12 @@ cd write (iout,*) 'i=',i,' scheck=',scheck,' jj=',jj enddo endif ispp=2 -#ifdef MPL -C Now partition the electrostatic-interaction array - npept=nct-nnt - nele_int_tot=(npept-ispp)*(npept-ispp+1)/2 - call int_bounds(nele_int_tot,my_ele_inds,my_ele_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' nele_int_tot',nele_int_tot,' my_ele_inds=',my_ele_inds, - & ' my_ele_inde',my_ele_inde - iatel_s=0 - iatel_e=0 - ind_eleint=0 - ind_eleint_old=0 - do i=nnt,nct-3 - ijunk=0 - call int_partition(ind_eleint,my_ele_inds,my_ele_inde,i, - & iatel_s,iatel_e,i+ispp,nct-1,ijunk,ielstart(i),ielend(i),*13) - enddo ! i - 13 continue -#else iatel_s=nnt iatel_e=nct-3 do i=iatel_s,iatel_e - ielstart(i)=i+2 + ielstart(i)=i+4 ielend(i)=nct-1 enddo -#endif if (lprint) then write (iout,'(a)') 'Electrostatic interaction array:' do i=iatel_s,iatel_e @@ -411,40 +383,6 @@ C Now partition the electrostatic-interaction array c iscp=3 iscp=2 C Partition the SC-p interaction array -#ifdef MPL - nscp_int_tot=(npept-iscp+1)*(npept-iscp+1) - call int_bounds(nscp_int_tot,my_scp_inds,my_scp_inde) - if (lprint) - & write (iout,*) 'Processor',MyID,' MyRank',MyRank, - & ' nscp_int_tot',nscp_int_tot,' my_scp_inds=',my_scp_inds, - & ' my_scp_inde',my_scp_inde - iatscp_s=0 - iatscp_e=0 - ind_scpint=0 - ind_scpint_old=0 - do i=nnt,nct-1 - if (i.lt.nnt+iscp) then -cd write (iout,*) 'i.le.nnt+iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else if (i.gt.nct-iscp) then -cd write (iout,*) 'i.gt.nct-iscp' - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - else - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,nnt,i-iscp,nscp_gr(i),iscpstart(i,1), - & iscpend(i,1),*14) - ii=nscp_gr(i)+1 - call int_partition(ind_scpint,my_scp_inds,my_scp_inde,i, - & iatscp_s,iatscp_e,i+iscp,nct,nscp_gr(i),iscpstart(i,ii), - & iscpend(i,ii),*14) - endif - enddo ! i - 14 continue -#else iatscp_s=nnt iatscp_e=nct-1 do i=nnt,nct-1 @@ -464,7 +402,6 @@ cd write (iout,*) 'i.gt.nct-iscp' iscpend(i,2)=nct endif enddo ! i -#endif if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e @@ -473,40 +410,22 @@ cd write (iout,*) 'i.gt.nct-iscp' enddo endif ! lprint C Partition local interactions -#ifdef MPL - call int_bounds(nres-2,loc_start,loc_end) - loc_start=loc_start+1 - loc_end=loc_end+1 - call int_bounds(nres-2,ithet_start,ithet_end) - ithet_start=ithet_start+2 - ithet_end=ithet_end+2 - call int_bounds(nct-nnt-2,iphi_start,iphi_end) - iphi_start=iphi_start+nnt+2 - iphi_end=iphi_end+nnt+2 - if (lprint) then - write (iout,*) 'Processor:',MyID, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end - write (*,*) 'Processor:',MyID, - & ' loc_start',loc_start,' loc_end',loc_end, - & ' ithet_start',ithet_start,' ithet_end',ithet_end, - & ' iphi_start',iphi_start,' iphi_end',iphi_end - endif - if (fgprocs.gt.1 .and. MyID.eq.BossID) then - write(iout,'(i10,a,i10,a,i10,a/a,i3,a)') n_sc_int_tot,' SC-SC ', - & nele_int_tot,' electrostatic and ',nscp_int_tot, - & ' SC-p interactions','were distributed among',fgprocs, - & ' fine-grain processors.' - endif -#else loc_start=2 loc_end=nres-1 - ithet_start=3 + ithet_start=3 ithet_end=nres + iturn3_start=nnt + iturn3_end=nct-3 + iturn4_start=nnt + iturn4_end=nct-4 iphi_start=nnt+3 iphi_end=nct -#endif + idihconstr_start=1 + idihconstr_end=ndih_constr + ithetaconstr_start=1 + ithetaconstr_end=ntheta_constr + itau_start=4 + itau_end=nres return end c--------------------------------------------------------------------------- @@ -555,15 +474,10 @@ c------------------------------------------------------------------------------ include 'DIMENSIONS' include 'COMMON.SBRIDGE' include 'COMMON.IOUNITS' -#ifdef MPL - include 'COMMON.INFO' - call int_bounds(nhpb,link_start,link_end) -#else link_start=1 link_end=nhpb -#endif -cd write (iout,*) 'Processor',MyID,' MyRank',MyRank, -cd & ' nhpb',nhpb,' link_start=',link_start, -cd & ' link_end',link_end + write (iout,*) 'HPB_PARTITION', + & ' nhpb',nhpb,' link_start=',link_start, + & ' link_end',link_end return end diff --git a/source/wham/src-M/int_from_cart.f b/source/wham/src-M/int_from_cart.f index 12d0c9c..6e22094 100644 --- a/source/wham/src-M/int_from_cart.f +++ b/source/wham/src-M/int_from_cart.f @@ -26,6 +26,9 @@ enddo be=0.0D0 if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) + if (i.gt.2) tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres) + if (i.gt.2) tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1) + if (i.gt.2) tauangle(2,i+1)=beta(i-2,i-1,i,i+nres) omeg(i)=beta(nres+i,i,maxres2,i+1) theta(i+1)=alpha(i-1,i,i+1) alph(i)=alpha(nres+i,i,maxres2) diff --git a/source/wham/src-M/make_ensemble1.F b/source/wham/src-M/make_ensemble1.F index 5d7b750..e26e7b7 100644 --- a/source/wham/src-M/make_ensemble1.F +++ b/source/wham/src-M/make_ensemble1.F @@ -23,7 +23,7 @@ double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl, & eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/ double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, - & escloc, + & escloc,eliptran, & ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor,tt integer i,ii,ik,iproc,iscor,j,k,l,ib,iparm,iprot,nlist @@ -34,7 +34,7 @@ character*5 ctemper integer ilen external ilen - real*4 Fdimless(MaxStr) + real*4 Fdimless(MaxStr),Fdimless_(MaxStr) double precision enepot(MaxStr) integer iperm(MaxStr) integer islice @@ -162,7 +162,20 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft estr=enetb(18,i,iparm) esccor=enetb(19,i,iparm) edihcnstr=enetb(20,i,iparm) + eliptran=enetb(22,i,iparm) #ifdef SPLITELE + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*ees + & +ft(1)*wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc + & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc @@ -171,8 +184,20 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+wliptran*eliptran + endif #else + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc + & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc @@ -181,10 +206,12 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+wliptran*eliptran + endif + #endif #ifdef MPI - Fdimless(i)= + Fdimless_(i)= & beta_h(ib,iparm)*etot-entfac(i) potE(i,iparm)=etot #ifdef DEBUG @@ -198,7 +225,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft #endif enddo ! i #ifdef MPI - call MPI_Gatherv(Fdimless(1),scount(me), + call MPI_Gatherv(Fdimless_(1),scount(me), & MPI_REAL,Fdimless(1), & scount(0),idispl(0),MPI_REAL,Master, & WHAM_COMM, IERROR) diff --git a/source/wham/src-M/molread_zs.F b/source/wham/src-M/molread_zs.F index 885c57b..b39002c 100644 --- a/source/wham/src-M/molread_zs.F +++ b/source/wham/src-M/molread_zs.F @@ -22,6 +22,7 @@ C character*320 controlcard,ucase dimension itype_pdb(maxres) logical seq_comp + double precision secprob(3,maxdih_constr),phihel,phibet call card_concat(controlcard,.true.) call reada(controlcard,'SCAL14',scal14,0.4d0) call reada(controlcard,'SCALSCP',scalscp,1.0d0) @@ -52,54 +53,148 @@ C Convert sequence to numeric code write (iout,'(20i4)') (itype(i),i=1,nres) do i=1,nres-1 #ifdef PROCOR - if (itype(i).eq.21 .or. itype(i+1).eq.21) then + if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) then #else - if (itype(i).eq.21) then + if (itype(i).eq.ntyp1) then #endif itel(i)=0 #ifdef PROCOR - else if (itype(i+1).ne.20) then + else if (iabs(itype(i+1)).ne.20) then #else - else if (itype(i).ne.20) then + else if (iabs(itype(i)).ne.20) then #endif itel(i)=1 else itel(i)=2 endif enddo + write (iout,*) "ITEL" + do i=1,nres-1 + write (iout,*) i,itype(i),itel(i) + enddo call read_bridge + nnt=1 + nct=nres + if (itype(1).eq.ntyp1) nnt=2 + if (itype(nres).eq.ntyp1) nct=nct-1 + write(iout,*) 'NNT=',NNT,' NCT=',NCT if (with_dihed_constr) then read (inp,*) ndih_constr + write (iout,*) "ndih_constr",ndih_constr if (ndih_constr.gt.0) then - read (inp,*) ftors - write (iout,*) 'FTORS',ftors - read (inp,*) (idih_constr(i),phi0(i),drange(i),i=1,ndih_constr) + raw_psipred=.false. +C read (inp,*) ftors +C write (iout,*) 'FTORS',ftors + read (inp,*) (idih_constr(i),phi0(i),drange(i),ftors(i), + & i=1,ndih_constr) write (iout,*) - & 'There are',ndih_constr,' constraints on phi angles.' + & 'There are',ndih_constr,' restraints on gamma angles.' do i=1,ndih_constr - write (iout,'(i5,2f8.3)') idih_constr(i),phi0(i),drange(i) + write (iout,'(i5,3f8.3)') idih_constr(i),phi0(i),drange(i), + & ftors(i) enddo do i=1,ndih_constr phi0(i)=deg2rad*phi0(i) drange(i)=deg2rad*drange(i) enddo - endif + else if (ndih_constr.lt.0) then + raw_psipred=.true. + call card_concat(controlcard,.true.) + call reada(controlcard,"PHIHEL",phihel,50.0D0) + call reada(controlcard,"PHIBET",phibet,180.0D0) + call reada(controlcard,"SIGMAHEL",sigmahel,30.0d0) + call reada(controlcard,"SIGMABET",sigmabet,40.0d0) + call reada(controlcard,"WDIHC",wdihc,0.591d0) + write (iout,*) "Weight of the dihedral restraint term",wdihc + read(inp,'(9x,3f7.3)') + & (secprob(1,i),secprob(2,i),secprob(3,i),i=nnt,nct) + write (iout,*) "The secprob array" + do i=nnt,nct + write (iout,'(i5,3f8.3)') i,(secprob(j,i),j=1,3) + enddo + ndih_constr=0 + do i=nnt+3,nct + if (itype(i-3).ne.ntyp1 .and. itype(i-2).ne.ntyp1 + & .and. itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1) then + ndih_constr=ndih_constr+1 + idih_constr(ndih_constr)=i + sumv=0.0d0 + do j=1,3 + vpsipred(j,ndih_constr)=secprob(j,i-1)*secprob(j,i-2) + sumv=sumv+vpsipred(j,ndih_constr) + enddo + do j=1,3 + vpsipred(j,ndih_constr)=vpsipred(j,ndih_constr)/sumv + enddo + phibound(1,ndih_constr)=phihel*deg2rad + phibound(2,ndih_constr)=phibet*deg2rad + sdihed(1,ndih_constr)=sigmahel*deg2rad + sdihed(2,ndih_constr)=sigmabet*deg2rad + endif + enddo + write (iout,*) + & 'There are',ndih_constr, + & ' bimodal restraints on gamma angles.' + do i=1,ndih_constr + write(iout,'(i5,1x,a4,i5,1h-,a4,i5,4f8.3,3f10.5)') i, + & restyp(itype(idih_constr(i)-2)),idih_constr(i)-2, + & restyp(itype(idih_constr(i)-1)),idih_constr(i)-1, + & phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg, + & phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg, + & (vpsipred(j,i),j=1,3) + enddo endif - nnt=1 - nct=nres - if (itype(1).eq.21) nnt=2 - if (itype(nres).eq.21) nct=nct-1 - write(iout,*) 'NNT=',NNT,' NCT=',NCT + endif + if (with_theta_constr) then +C with_theta_constr is keyword allowing for occurance of theta constrains + read (inp,*) ntheta_constr +C ntheta_constr is the number of theta constrains + if (ntheta_constr.gt.0) then +C read (inp,*) ftors + read (inp,*) (itheta_constr(i),theta_constr0(i), + & theta_drange(i),for_thet_constr(i), + & i=1,ntheta_constr) +C the above code reads from 1 to ntheta_constr +C itheta_constr(i) residue i for which is theta_constr +C theta_constr0 the global minimum value +C theta_drange is range for which there is no energy penalty +C for_thet_constr is the force constant for quartic energy penalty +C E=k*x**4 +C if(me.eq.king.or..not.out1file)then + write (iout,*) + & 'There are',ntheta_constr,' constraints on phi angles.' + do i=1,ntheta_constr + write (iout,'(i5,3f8.3)') itheta_constr(i),theta_constr0(i), + & theta_drange(i), + & for_thet_constr(i) + enddo +C endif + do i=1,ntheta_constr + theta_constr0(i)=deg2rad*theta_constr0(i) + theta_drange(i)=deg2rad*theta_drange(i) + enddo +C if(me.eq.king.or..not.out1file) +C & write (iout,*) 'FTORS',ftors +C do i=1,ntheta_constr +C ii = itheta_constr(i) +C thetabound(1,ii) = phi0(i)-drange(i) +C thetabound(2,ii) = phi0(i)+drange(i) +C enddo + endif ! ntheta_constr.gt.0 + endif! with_theta_constr call setup_var call init_int_table if (ns.gt.0) then write (iout,'(/a,i3,a)') 'The chain contains',ns, & ' disulfide-bridging cysteines.' write (iout,'(20i4)') (iss(i),i=1,ns) + if (dyn_ss) then + write(iout,*)"Running with dynamic disulfide-bond formation" + else write (iout,'(/a/)') 'Pre-formed links are:' do i=1,nss i1=ihpb(i)-nres @@ -111,7 +206,25 @@ C Convert sequence to numeric code & dhpb(i),ebr,forcon(i) enddo endif + endif write (iout,'(a)') + write (iout,*) "setting ss mask dyn_ss",dyn_ss + if (ns.gt.0.and.dyn_ss) then + do i=nss+1,nhpb + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. + write (iout,*) "i",i," iss",iss(i), + & " mask",dyn_ss_mask(iss(i)) + enddo + endif return end c----------------------------------------------------------------------------- @@ -148,12 +261,14 @@ C Read bridging residues. write (iout,*) 'ns=',ns,' iss:',(iss(i),i=1,ns) C Check whether the specified bridging residues are cystines. do i=1,ns - if (itype(iss(i)).ne.1) then + if (iabs(itype(iss(i))).ne.1) then write (iout,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' write (*,'(2a,i3,a)') - & 'Do you REALLY think that the residue ',restyp(iss(i)),i, + & 'Do you REALLY think that the residue ', + & restyp(itype(iss(i))),i, & ' can form a disulfide bridge?!!!' stop endif diff --git a/source/wham/src-M/openunits.F b/source/wham/src-M/openunits.F index b9f54b7..5ce0279 100644 --- a/source/wham/src-M/openunits.F +++ b/source/wham/src-M/openunits.F @@ -29,25 +29,27 @@ C Get the names and open the input files open (1,file=prefix(:ilen(prefix))//'.inp',status='old') C Get parameter filenames and open the parameter files. call mygetenv('BONDPAR',bondname) - open (ibond,file=bondname,status='old') +c open (ibond,file=bondname,status='old') call mygetenv('THETPAR',thetname) - open (ithep,file=thetname,status='old') +c open (ithep,file=thetname,status='old') call mygetenv('ROTPAR',rotname) - open (irotam,file=rotname,status='old') +c open (irotam,file=rotname,status='old') call mygetenv('TORPAR',torname) - open (itorp,file=torname,status='old') +c open (itorp,file=torname,status='old') call mygetenv('TORDPAR',tordname) - open (itordp,file=tordname,status='old') +c open (itordp,file=tordname,status='old') call mygetenv('FOURIER',fouriername) - open (ifourier,file=fouriername,status='old') +c open (ifourier,file=fouriername,status='old') call mygetenv('SCCORPAR',sccorname) - open (isccor,file=sccorname,status='old') +c open (isccor,file=sccorname,status='old') call mygetenv('ELEPAR',elename) - open (ielep,file=elename,status='old') +c open (ielep,file=elename,status='old') call mygetenv('SIDEPAR',sidename) - open (isidep,file=sidename,status='old') +c open (isidep,file=sidename,status='old') call mygetenv('SIDEP',sidepname) open (isidep1,file=sidepname,status="old") + call mygetenv('LIPTRANPAR',liptranname) + open (iliptranpar,file=liptranname,status='old',action='read') #ifndef OLDSCP C C 8/9/01 In the newest version SCp interaction constants are read from a file diff --git a/source/wham/src-M/parmread.F b/source/wham/src-M/parmread.F index ee048d8..27db9ac 100644 --- a/source/wham/src-M/parmread.F +++ b/source/wham/src-M/parmread.F @@ -21,8 +21,11 @@ C include 'COMMON.SCCOR' include 'COMMON.SCROT' include 'COMMON.FREE' + include 'COMMON.SHIELD' + include 'COMMON.CONTROL' character*1 t1,t2,t3 character*1 onelett(4) /"G","A","P","D"/ + character*1 toronelet(-2:2) /"p","a","G","A","P"/ logical lprint dimension blower(3,3,maxlob) character*800 controlcard @@ -34,12 +37,16 @@ C character*16 key integer iparm double precision ip,mp + character*6 res1 + character*3 lancuch,ucase +C write (iout,*) "KURWA" C C Body C + call getenv("PRINT_PARM",lancuch) + lprint = (ucase(lancuch).eq."YES" .or. ucase(lancuch).eq."Y") C Set LPRINT=.TRUE. for debugging dwa16=2.0d0**(1.0d0/6.0d0) - lprint=.false. itypro=20 C Assign virtual-bond length vbl=3.8D0 @@ -54,6 +61,31 @@ C Assign virtual-bond length write (iout,*) "iparm",iparm," myparm",myparm c If reading not own parameters, skip assignment + call reada(controlcard,"D0CM",d0cm,3.78d0) + call reada(controlcard,"AKCM",akcm,15.1d0) + call reada(controlcard,"AKTH",akth,11.0d0) + call reada(controlcard,"AKCT",akct,12.0d0) + call reada(controlcard,"V1SS",v1ss,-1.08d0) + call reada(controlcard,"V2SS",v2ss,7.61d0) + call reada(controlcard,"V3SS",v3ss,13.7d0) + call reada(controlcard,"EBR",ebr,-5.50D0) + call reada(controlcard,"DTRISS",dtriss,1.0D0) + call reada(controlcard,"ATRISS",atriss,0.3D0) + call reada(controlcard,"BTRISS",btriss,0.02D0) + call reada(controlcard,"CTRISS",ctriss,1.0D0) +c dyn_ss=(index(controlcard,'DYN_SS').gt.0) + write (iout,*) "DYN_SS",dyn_ss + write(iout,*) "ATRISS",atriss + write(iout,*) "BTRISS",btriss + write(iout,*) "CTRISS",ctriss + write(iout,*) "DTRISS",dtriss + call reada(controlcard,"HT",Ht,0.0D0) +c +c Old arbitrary potential - commented out. +c +c dbr= 4.20D0 +c fbr= 3.30D0 +c if (iparm.eq.myparm .or. .not.separate_parset) then @@ -77,7 +109,10 @@ c wvdwpp=ww(16) wbond=ww(18) wsccor=ww(19) - + whpb=ww(15) + wstrain=ww(15) + wliptran=ww(22) + wshield=ww(25) endif call card_concat(controlcard,.false.) @@ -99,9 +134,12 @@ c Return if not own parameters open (itorp,file=torname_t,status='old') rewind(itorp) call reads(controlcard,"TORDPAR",tordname_t,tordname) - open (itordp,file=tordname_t,status='old') + write (iout,*) "tor_mode",tor_mode + call flush(iout) + if (tor_mode.eq.0) + & open (itordp,file=tordname_t,status='old') rewind(itordp) - call reads(controlcard,"SCCORAR",sccorname_t,sccorname) + call reads(controlcard,"SCCORPAR",sccorname_t,sccorname) open (isccor,file=sccorname_t,status='old') rewind(isccor) call reads(controlcard,"FOURIER",fouriername_t,fouriername) @@ -149,10 +187,10 @@ c Read the virtual-bond parameters, masses, and moments of inertia c and Stokes' radii of the peptide group and side chains c #ifdef CRYST_BOND - read (ibond,*) vbldp0,akp + read (ibond,*,end=121,err=121) vbldp0,vbldpdum,akp do i=1,ntyp nbondterm(i)=1 - read (ibond,*) vbldsc0(1,i),aksc(1,i) + read (ibond,*,end=121,err=121) vbldsc0(1,i),aksc(1,i) dsc(i) = vbldsc0(1,i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -161,10 +199,10 @@ c endif enddo #else - read (ibond,*) ijunk,vbldp0,akp,rjunk + read (ibond,*,end=121,err=121) ijunk,vbldp0,vbldpdum,akp,rjunk do i=1,ntyp - read (ibond,*) nbondterm(i),(vbldsc0(j,i),aksc(j,i),abond0(j,i), - & j=1,nbondterm(i)) + read (ibond,*,end=121,err=121) nbondterm(i),(vbldsc0(j,i), + & aksc(j,i),abond0(j,i),j=1,nbondterm(i)) dsc(i) = vbldsc0(1,i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -187,17 +225,61 @@ c enddo enddo endif + write (iout,*) "iliptranpar",iliptranpar + write (iout,*) "liptranname ",liptranname + read(iliptranpar,*,end=1161,err=1161) pepliptran + write (iout,*) "pepliptran",pepliptran + do i=1,ntyp + read(iliptranpar,*,end=1161,err=1161) liptranene(i) + write (iout,*) i,liptranene(i) + enddo + rewind iliptranpar #ifdef CRYST_THETA C C Read the parameters of the probability distribution/energy expression C of the virtual-bond valence angles theta C do i=1,ntyp - read (ithep,*) a0thet(i),(athet(j,i),j=1,2),(bthet(j,i),j=1,2) - read (ithep,*) (polthet(j,i),j=0,3) - read (ithep,*) (gthet(j,i),j=1,3) - read (ithep,*) theta0(i),sig0(i),sigc0(i) - sigc0(i)=sigc0(i)**2 + read (ithep,*,end=111,err=111) a0thet(i),(athet(j,i,1,1),j=1,2), + & (bthet(j,i,1,1),j=1,2) + read (ithep,*,end=111,err=111) (polthet(j,i),j=0,3) + read (ithep,*,end=111,err=111) (gthet(j,i),j=1,3) + read (ithep,*,end=111,err=111) theta0(i),sig0(i),sigc0(i) + sigc0(i)=sigc0(i)**2 + enddo + do i=1,ntyp + athet(1,i,1,-1)=athet(1,i,1,1) + athet(2,i,1,-1)=athet(2,i,1,1) + bthet(1,i,1,-1)=-bthet(1,i,1,1) + bthet(2,i,1,-1)=-bthet(2,i,1,1) + athet(1,i,-1,1)=-athet(1,i,1,1) + athet(2,i,-1,1)=-athet(2,i,1,1) + bthet(1,i,-1,1)=bthet(1,i,1,1) + bthet(2,i,-1,1)=bthet(2,i,1,1) + enddo + do i=-ntyp,-1 + a0thet(i)=a0thet(-i) + athet(1,i,-1,-1)=athet(1,-i,1,1) + athet(2,i,-1,-1)=-athet(2,-i,1,1) + bthet(1,i,-1,-1)=bthet(1,-i,1,1) + bthet(2,i,-1,-1)=-bthet(2,-i,1,1) + athet(1,i,-1,1)=athet(1,-i,1,1) + athet(2,i,-1,1)=-athet(2,-i,1,1) + bthet(1,i,-1,1)=-bthet(1,-i,1,1) + bthet(2,i,-1,1)=bthet(2,-i,1,1) + athet(1,i,1,-1)=-athet(1,-i,1,1) + athet(2,i,1,-1)=athet(2,-i,1,1) + bthet(1,i,1,-1)=bthet(1,-i,1,1) + bthet(2,i,1,-1)=-bthet(2,-i,1,1) + theta0(i)=theta0(-i) + sig0(i)=sig0(-i) + sigc0(i)=sigc0(-i) + do j=0,3 + polthet(j,i)=polthet(j,-i) + enddo + do j=1,3 + gthet(j,i)=gthet(j,-i) + enddo enddo close (ithep) if (lprint) then @@ -234,7 +316,8 @@ c enddo & ' b1*10^1 ',' b2*10^1 ' do i=1,ntyp write(iout,'(a3,1h&,2x,5(f8.3,1h&))') restyp(i), - & a0thet(i),(100*athet(j,i),j=1,2),(10*bthet(j,i),j=1,2) + & a0thet(i),(100*athet(j,i,1,1),j=1,2), + & (10*bthet(j,i,1,1),j=1,2) enddo write (iout,'(/a/9x,5a/79(1h-))') & 'Parameters of the expression for sigma(theta_c):', @@ -254,58 +337,72 @@ c enddo enddo endif #else + IF (tor_mode.eq.0) THEN C C Read the parameters of Utheta determined from ab initio surfaces C Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 C - read (ithep,*) nthetyp,ntheterm,ntheterm2, + read (ithep,*,end=111,err=111) nthetyp,ntheterm,ntheterm2, & ntheterm3,nsingle,ndouble nntheterm=max0(ntheterm,ntheterm2,ntheterm3) - read (ithep,*) (ithetyp(i),i=1,ntyp1) - do i=1,maxthetyp - do j=1,maxthetyp - do k=1,maxthetyp - aa0thet(i,j,k)=0.0d0 + read (ithep,*,end=111,err=111) (ithetyp(i),i=1,ntyp1) + do i=-ntyp1,-1 + ithetyp(i)=-ithetyp(-i) + enddo + do iblock=1,2 + do i=-maxthetyp,maxthetyp + do j=-maxthetyp,maxthetyp + do k=-maxthetyp,maxthetyp + aa0thet(i,j,k,iblock)=0.0d0 do l=1,ntheterm - aathet(l,i,j,k)=0.0d0 + aathet(l,i,j,k,iblock)=0.0d0 enddo do l=1,ntheterm2 do m=1,nsingle - bbthet(m,l,i,j,k)=0.0d0 - ccthet(m,l,i,j,k)=0.0d0 - ddthet(m,l,i,j,k)=0.0d0 - eethet(m,l,i,j,k)=0.0d0 + bbthet(m,l,i,j,k,iblock)=0.0d0 + ccthet(m,l,i,j,k,iblock)=0.0d0 + ddthet(m,l,i,j,k,iblock)=0.0d0 + eethet(m,l,i,j,k,iblock)=0.0d0 enddo enddo do l=1,ntheterm3 do m=1,ndouble do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=0.0d0 - ggthet(mm,m,l,i,j,k)=0.0d0 + ffthet(mm,m,l,i,j,k,iblock)=0.0d0 + ggthet(mm,m,l,i,j,k,iblock)=0.0d0 enddo enddo enddo enddo enddo enddo - do i=1,nthetyp - do j=1,nthetyp - do k=1,nthetyp - read (ithep,'(3a)') res1,res2,res3 - read (ithep,*) aa0thet(i,j,k) - read (ithep,*)(aathet(l,i,j,k),l=1,ntheterm) - read (ithep,*) - & ((bbthet(lll,ll,i,j,k),lll=1,nsingle), - & (ccthet(lll,ll,i,j,k),lll=1,nsingle), - & (ddthet(lll,ll,i,j,k),lll=1,nsingle), - & (eethet(lll,ll,i,j,k),lll=1,nsingle),ll=1,ntheterm2) - read (ithep,*) - & (((ffthet(llll,lll,ll,i,j,k),ffthet(lll,llll,ll,i,j,k), - & ggthet(llll,lll,ll,i,j,k),ggthet(lll,llll,ll,i,j,k), + enddo +C write (iout,*) "KURWA1" + do iblock=1,2 + do i=0,nthetyp + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + read (ithep,'(6a)',end=111,err=111) res1 + write(iout,*) res1,i,j,k + read (ithep,*,end=111,err=111) aa0thet(i,j,k,iblock) + read (ithep,*,end=111,err=111)(aathet(l,i,j,k,iblock), + & l=1,ntheterm) + read (ithep,*,end=111,err=111) + & ((bbthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ccthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (ddthet(lll,ll,i,j,k,iblock),lll=1,nsingle), + & (eethet(lll,ll,i,j,k,iblock),lll=1,nsingle) + & ,ll=1,ntheterm2) + read (ithep,*,end=111,err=111) + & (((ffthet(llll,lll,ll,i,j,k,iblock), + & ffthet(lll,llll,ll,i,j,k,iblock), + & ggthet(llll,lll,ll,i,j,k,iblock) + & ,ggthet(lll,llll,ll,i,j,k,iblock), & llll=1,lll-1),lll=2,ndouble),ll=1,ntheterm3) enddo enddo enddo +C write(iout,*) "KURWA1.1" C C For dummy ends assign glycine-type coefficients of theta-only terms; the C coefficients of theta-and-gamma-dependent terms are zero. @@ -313,38 +410,77 @@ C do i=1,nthetyp do j=1,nthetyp do l=1,ntheterm - aathet(l,i,j,nthetyp+1)=aathet(l,i,j,1) - aathet(l,nthetyp+1,i,j)=aathet(l,1,i,j) + aathet(l,i,j,nthetyp+1,iblock)=0.0d0 + aathet(l,nthetyp+1,i,j,iblock)=0.0d0 enddo - aa0thet(i,j,nthetyp+1)=aa0thet(i,j,1) - aa0thet(nthetyp+1,i,j)=aa0thet(1,i,j) + aa0thet(i,j,nthetyp+1,iblock)=0.0d0 + aa0thet(nthetyp+1,i,j,iblock)=0.0d0 enddo do l=1,ntheterm - aathet(l,nthetyp+1,i,nthetyp+1)=aathet(l,1,i,1) + aathet(l,nthetyp+1,i,nthetyp+1,iblock)=0.0d0 enddo - aa0thet(nthetyp+1,i,nthetyp+1)=aa0thet(1,i,1) + aa0thet(nthetyp+1,i,nthetyp+1,iblock)=0.0d0 + enddo enddo +C write(iout,*) "KURWA1.5" +C Substitution for D aminoacids from symmetry. + do iblock=1,2 + do i=-nthetyp,0 + do j=-nthetyp,nthetyp + do k=-nthetyp,nthetyp + aa0thet(i,j,k,iblock)=aa0thet(-i,-j,-k,iblock) + do l=1,ntheterm + aathet(l,i,j,k,iblock)=aathet(l,-i,-j,-k,iblock) + enddo + do ll=1,ntheterm2 + do lll=1,nsingle + bbthet(lll,ll,i,j,k,iblock)=bbthet(lll,ll,-i,-j,-k,iblock) + ccthet(lll,ll,i,j,k,iblock)=-ccthet(lll,ll,-i,-j,-k,iblock) + ddthet(lll,ll,i,j,k,iblock)=ddthet(lll,ll,-i,-j,-k,iblock) + eethet(lll,ll,i,j,k,iblock)=-eethet(lll,ll,-i,-j,-k,iblock) + enddo + enddo + do ll=1,ntheterm3 + do lll=2,ndouble + do llll=1,lll-1 + ffthet(llll,lll,ll,i,j,k,iblock)= + & ffthet(llll,lll,ll,-i,-j,-k,iblock) + ffthet(lll,llll,ll,i,j,k,iblock)= + & ffthet(lll,llll,ll,-i,-j,-k,iblock) + ggthet(llll,lll,ll,i,j,k,iblock)= + & -ggthet(llll,lll,ll,-i,-j,-k,iblock) + ggthet(lll,llll,ll,i,j,k,iblock)= + & -ggthet(lll,llll,ll,-i,-j,-k,iblock) + enddo !ll + enddo !lll + enddo !llll + enddo !k + enddo !j + enddo !i + enddo !iblock + C C Control printout of the coefficients of virtual-bond-angle potentials C if (lprint) then write (iout,'(//a)') 'Parameter of virtual-bond-angle potential' + do iblock=1,2 do i=1,nthetyp+1 do j=1,nthetyp+1 do k=1,nthetyp+1 write (iout,'(//4a)') & 'Type ',onelett(i),onelett(j),onelett(k) write (iout,'(//a,10x,a)') " l","a[l]" - write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k) + write (iout,'(i2,1pe15.5)') 0,aa0thet(i,j,k,iblock) write (iout,'(i2,1pe15.5)') - & (l,aathet(l,i,j,k),l=1,ntheterm) + & (l,aathet(l,i,j,k,iblock),l=1,ntheterm) do l=1,ntheterm2 write (iout,'(//2h m,4(9x,a,3h[m,i1,1h]))') & "b",l,"c",l,"d",l,"e",l do m=1,nsingle write (iout,'(i2,4(1pe15.5))') m, - & bbthet(m,l,i,j,k),ccthet(m,l,i,j,k), - & ddthet(m,l,i,j,k),eethet(m,l,i,j,k) + & bbthet(m,l,i,j,k,iblock),ccthet(m,l,i,j,k,iblock), + & ddthet(m,l,i,j,k,iblock),eethet(m,l,i,j,k,iblock) enddo enddo do l=1,ntheterm3 @@ -353,24 +489,53 @@ C do m=2,ndouble do n=1,m-1 write (iout,'(i1,1x,i1,4(1pe15.5))') n,m, - & ffthet(n,m,l,i,j,k),ffthet(m,n,l,i,j,k), - & ggthet(n,m,l,i,j,k),ggthet(m,n,l,i,j,k) + & ffthet(n,m,l,i,j,k,iblock), + & ffthet(m,n,l,i,j,k,iblock), + & ggthet(n,m,l,i,j,k,iblock), + & ggthet(m,n,l,i,j,k,iblock) enddo enddo enddo enddo enddo enddo + enddo call flush(iout) endif -#endif + ELSE + +C here will be the apropriate recalibrating for D-aminoacid + read (ithep,*,end=111,err=111) nthetyp + do i=-nthetyp+1,nthetyp-1 + read (ithep,*,end=111,err=111) nbend_kcc_Tb(i) + do j=0,nbend_kcc_Tb(i) + read (ithep,*,end=111,err=111) ijunk,v1bend_chyb(j,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Parameters of the valence-only potentials" + do i=-nthetyp+1,nthetyp-1 + write (iout,'(2a)') "Type ",toronelet(i) + do k=0,nbend_kcc_Tb(i) + write(iout,'(i5,f15.5)') k,v1bend_chyb(k,i) + enddo + enddo + endif + + ENDIF ! TOR_MODE + + close(ithep) +#endif +C write(iout,*) 'KURWA2' #ifdef CRYST_SC C C Read the parameters of the probability distribution/energy expression C of the side chains. C do i=1,ntyp +cc write (iout,*) "tu dochodze",i read (irotam,'(3x,i3,f8.3)') nlob(i),dsc(i) if (i.eq.10) then dsc_inv(i)=0.0D0 @@ -386,11 +551,19 @@ C enddo enddo bsc(1,i)=0.0D0 - read(irotam,*)(censc(k,1,i),k=1,3),((blower(k,l,1),l=1,k),k=1,3) + read(irotam,*,end=112,err=112)(censc(k,1,i),k=1,3), + & ((blower(k,l,1),l=1,k),k=1,3) + censc(1,1,-i)=censc(1,1,i) + censc(2,1,-i)=censc(2,1,i) + censc(3,1,-i)=-censc(3,1,i) do j=2,nlob(i) - read (irotam,*) bsc(j,i) - read (irotam,*) (censc(k,j,i),k=1,3), + read (irotam,*,end=112,err=112) bsc(j,i) + read (irotam,*,end=112,err=112) (censc(k,j,i),k=1,3), & ((blower(k,l,j),l=1,k),k=1,3) + censc(1,j,-i)=censc(1,j,i) + censc(2,j,-i)=censc(2,j,i) + censc(3,j,-i)=-censc(3,j,i) +C BSC is amplitude of Gaussian enddo do j=1,nlob(i) do k=1,3 @@ -401,6 +574,14 @@ C enddo gaussc(k,l,j,i)=akl gaussc(l,k,j,i)=akl + if (((k.eq.3).and.(l.ne.3)) + & .or.((l.eq.3).and.(k.ne.3))) then + gaussc(k,l,j,-i)=-akl + gaussc(l,k,j,-i)=-akl + else + gaussc(k,l,j,-i)=akl + gaussc(l,k,j,-i)=akl + endif enddo enddo enddo @@ -445,29 +626,419 @@ C Read scrot parameters for potentials determined from all-atom AM1 calculations C added by Urszula Kozlowska 07/11/2007 C do i=1,ntyp - read (irotam,*) + read (irotam,*,end=112,err=112) if (i.eq.10) then - read (irotam,*) + read (irotam,*,end=112,err=112) else do j=1,65 - read(irotam,*) sc_parmin(j,i) + read(irotam,*,end=112,err=112) sc_parmin(j,i) enddo endif enddo #endif close(irotam) +C +C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local +C interaction energy of the Gly, Ala, and Pro prototypes. +C + read (ifourier,*,end=115,err=115) nloctyp + SPLIT_FOURIERTOR = nloctyp.lt.0 + nloctyp = iabs(nloctyp) +#ifdef NEWCORR + read (ifourier,*,end=115,err=115) (itype2loc(i),i=1,ntyp) + read (ifourier,*,end=115,err=115) (iloctyp(i),i=0,nloctyp-1) + itype2loc(ntyp1)=nloctyp + iloctyp(nloctyp)=ntyp1 + do i=1,ntyp1 + itype2loc(-i)=-itype2loc(i) + enddo +#else + iloctyp(0)=10 + iloctyp(1)=9 + iloctyp(2)=20 + iloctyp(3)=ntyp1 +#endif + do i=1,nloctyp + iloctyp(-i)=-iloctyp(i) + enddo +c write (iout,*) "itype2loc",(itype2loc(i),i=1,ntyp1) +c write (iout,*) "nloctyp",nloctyp, +c & " iloctyp",(iloctyp(i),i=0,nloctyp) +#ifdef NEWCORR + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1" +c write (iout,*) ((bnew1(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2" +c write (iout,*) ((bnew2(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnew(kk,1,i) + read (ifourier,*,end=115,err=115) ccnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnew(kk,1,i) + read (ifourier,*,end=115,err=115) ddnew(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW" +c write (iout,*) ((ddnew(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenew(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1" +c write(iout,*)(((eenew(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0new(ii,i) + enddo +c write (iout,*) (e0new(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW" + do i=0,nloctyp-1 + do ii=1,3 + ccnew(ii,1,i)=ccnew(ii,1,i)/2 + ccnew(ii,2,i)=ccnew(ii,2,i)/2 + ddnew(ii,1,i)=ddnew(ii,1,i)/2 + ddnew(ii,2,i)=ddnew(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1(ii,1,-i)= bnew1(ii,1,i) + bnew1(ii,2,-i)=-bnew1(ii,2,i) + bnew2(ii,1,-i)= bnew2(ii,1,i) + bnew2(ii,2,-i)=-bnew2(ii,2,i) + enddo + do ii=1,3 +c ccnew(ii,1,i)=ccnew(ii,1,i)/2 +c ccnew(ii,2,i)=ccnew(ii,2,i)/2 +c ddnew(ii,1,i)=ddnew(ii,1,i)/2 +c ddnew(ii,2,i)=ddnew(ii,2,i)/2 + ccnew(ii,1,-i)=ccnew(ii,1,i) + ccnew(ii,2,-i)=-ccnew(ii,2,i) + ddnew(ii,1,-i)=ddnew(ii,1,i) + ddnew(ii,2,-i)=-ddnew(ii,2,i) + enddo + e0new(1,-i)= e0new(1,i) + e0new(2,-i)=-e0new(2,i) + e0new(3,-i)=-e0new(3,i) + do kk=1,2 + eenew(kk,1,1,-i)= eenew(kk,1,1,i) + eenew(kk,1,2,-i)=-eenew(kk,1,2,i) + eenew(kk,2,1,-i)=-eenew(kk,2,1,i) + eenew(kk,2,2,-i)= eenew(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') "Coefficients of the multibody terms" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') j,(bnew1(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') j,(bnew2(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of C" + write (iout,'(3hC11,3f10.5)') (ccnew(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of D" + write (iout,'(3hD11,3f10.5)') (ddnew(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnew(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of E" + write (iout,'(2hE0,3f10.5)') (e0new(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') j,k,(eenew(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + IF (SPLIT_FOURIERTOR) THEN + do i=0,nloctyp-1 +c write (iout,*) "NEWCORR TOR",i + read (ifourier,*,end=115,err=115) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew1tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW1 TOR" +c write (iout,*) ((bnew1tor(ii,j,i),ii=1,3),j=1,2) + do ii=1,3 + do j=1,2 + read (ifourier,*,end=115,err=115) bnew2tor(ii,j,i) + enddo + enddo +c write (iout,*) "NEWCORR BNEW2 TOR" +c write (iout,*) ((bnew2tor(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ccnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ccnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR CCNEW TOR" +c write (iout,*) ((ccnew(ii,j,i),ii=1,3),j=1,2) + do kk=1,3 + read (ifourier,*,end=115,err=115) ddnewtor(kk,1,i) + read (ifourier,*,end=115,err=115) ddnewtor(kk,2,i) + enddo +c write (iout,*) "NEWCORR DDNEW TOR" +c write (iout,*) ((ddnewtor(ii,j,i),ii=1,3),j=1,2) + do ii=1,2 + do jj=1,2 + do kk=1,2 + read (ifourier,*,end=115,err=115) eenewtor(ii,jj,kk,i) + enddo + enddo + enddo +c write (iout,*) "NEWCORR EENEW1 TOR" +c write(iout,*)(((eenewtor(ii,jj,kk,i),kk=1,2),jj=1,2),ii=1,2) + do ii=1,3 + read (ifourier,*,end=115,err=115) e0newtor(ii,i) + enddo +c write (iout,*) (e0newtor(ii,i),ii=1,3) + enddo +c write (iout,*) "NEWCORR EENEW TOR" + do i=0,nloctyp-1 + do ii=1,3 + ccnewtor(ii,1,i)=ccnewtor(ii,1,i)/2 + ccnewtor(ii,2,i)=ccnewtor(ii,2,i)/2 + ddnewtor(ii,1,i)=ddnewtor(ii,1,i)/2 + ddnewtor(ii,2,i)=ddnewtor(ii,2,i)/2 + enddo + enddo + do i=1,nloctyp-1 + do ii=1,3 + bnew1tor(ii,1,-i)= bnew1tor(ii,1,i) + bnew1tor(ii,2,-i)=-bnew1tor(ii,2,i) + bnew2tor(ii,1,-i)= bnew2tor(ii,1,i) + bnew2tor(ii,2,-i)=-bnew2tor(ii,2,i) + enddo + do ii=1,3 + ccnewtor(ii,1,-i)=ccnewtor(ii,1,i) + ccnewtor(ii,2,-i)=-ccnewtor(ii,2,i) + ddnewtor(ii,1,-i)=ddnewtor(ii,1,i) + ddnewtor(ii,2,-i)=-ddnewtor(ii,2,i) + enddo + e0newtor(1,-i)= e0newtor(1,i) + e0newtor(2,-i)=-e0newtor(2,i) + e0newtor(3,-i)=-e0newtor(3,i) + do kk=1,2 + eenewtor(kk,1,1,-i)= eenewtor(kk,1,1,i) + eenewtor(kk,1,2,-i)=-eenewtor(kk,1,2,i) + eenewtor(kk,2,1,-i)=-eenewtor(kk,2,1,i) + eenewtor(kk,2,2,-i)= eenewtor(kk,2,2,i) + enddo + enddo + if (lprint) then + write (iout,'(a)') + & "Single-body coefficients of the torsional potentials" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) "Type: ",onelet(iloctyp(i)) + write (iout,*) "Coefficients of the expansion of B1tor" + do j=1,2 + write (iout,'(3hB1(,i1,1h),3f10.5)') + & j,(bnew1tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of B2tor" + do j=1,2 + write (iout,'(3hB2(,i1,1h),3f10.5)') + & j,(bnew2tor(k,j,i),k=1,3) + enddo + write (iout,*) "Coefficients of the expansion of Ctor" + write (iout,'(3hC11,3f10.5)') (ccnewtor(j,1,i),j=1,3) + write (iout,'(3hC12,3f10.5)') (ccnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Dtor" + write (iout,'(3hD11,3f10.5)') (ddnewtor(j,1,i),j=1,3) + write (iout,'(3hD12,3f10.5)') (ddnewtor(j,2,i),j=1,3) + write (iout,*) "Coefficients of the expansion of Etor" + write (iout,'(2hE0,3f10.5)') (e0newtor(j,i),j=1,3) + do j=1,2 + do k=1,2 + write (iout,'(1hE,2i1,2f10.5)') + & j,k,(eenewtor(l,j,k,i),l=1,2) + enddo + enddo + enddo + endif + ELSE + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1tor(ii,j,i)=bnew1(ii,j,i) + enddo + enddo + do ii=1,3 + do j=1,2 + bnew2tor(ii,j,i)=bnew2(ii,j,i) + enddo + enddo + do ii=1,3 + ccnewtor(ii,1,i)=ccnew(ii,1,i) + ccnewtor(ii,2,i)=ccnew(ii,2,i) + ddnewtor(ii,1,i)=ddnew(ii,1,i) + ddnewtor(ii,2,i)=ddnew(ii,2,i) + enddo + enddo + ENDIF !SPLIT_FOURIER_TOR +#else + if (lprint) + & write (iout,*) "Coefficients of the expansion of Eloc(l1,l2)" + do i=0,nloctyp-1 + read (ifourier,*,end=115,err=115) + read (ifourier,*,end=115,err=115) (b(ii,i),ii=1,13) + if (lprint) then + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) + endif + if (i.gt.0) then + b(2,-i)= b(2,i) + b(3,-i)= b(3,i) + b(4,-i)=-b(4,i) + b(5,-i)=-b(5,i) + endif +c B1(1,i) = b(3) +c B1(2,i) = b(5) +c B1(1,-i) = b(3) +c B1(2,-i) = -b(5) +c b1(1,i)=0.0d0 +c b1(2,i)=0.0d0 +c B1tilde(1,i) = b(3) +c B1tilde(2,i) =-b(5) +c B1tilde(1,-i) =-b(3) +c B1tilde(2,-i) =b(5) +c b1tilde(1,i)=0.0d0 +c b1tilde(2,i)=0.0d0 +c B2(1,i) = b(2) +c B2(2,i) = b(4) +c B2(1,-i) =b(2) +c B2(2,-i) =-b(4) +cc B1tilde(1,i) = b(3,i) +cc B1tilde(2,i) =-b(5,i) +C B1tilde(1,-i) =-b(3,i) +C B1tilde(2,-i) =b(5,i) +cc b1tilde(1,i)=0.0d0 +cc b1tilde(2,i)=0.0d0 +cc B2(1,i) = b(2,i) +cc B2(2,i) = b(4,i) +C B2(1,-i) =b(2,i) +C B2(2,-i) =-b(4,i) + +c b2(1,i)=0.0d0 +c b2(2,i)=0.0d0 + CCold(1,1,i)= b(7,i) + CCold(2,2,i)=-b(7,i) + CCold(2,1,i)= b(9,i) + CCold(1,2,i)= b(9,i) + CCold(1,1,-i)= b(7,i) + CCold(2,2,-i)=-b(7,i) + CCold(2,1,-i)=-b(9,i) + CCold(1,2,-i)=-b(9,i) +c CC(1,1,i)=0.0d0 +c CC(2,2,i)=0.0d0 +c CC(2,1,i)=0.0d0 +c CC(1,2,i)=0.0d0 +c Ctilde(1,1,i)= CCold(1,1,i) +c Ctilde(1,2,i)= CCold(1,2,i) +c Ctilde(2,1,i)=-CCold(2,1,i) +c Ctilde(2,2,i)=-CCold(2,2,i) + +c Ctilde(1,1,i)=0.0d0 +c Ctilde(1,2,i)=0.0d0 +c Ctilde(2,1,i)=0.0d0 +c Ctilde(2,2,i)=0.0d0 + DDold(1,1,i)= b(6,i) + DDold(2,2,i)=-b(6,i) + DDold(2,1,i)= b(8,i) + DDold(1,2,i)= b(8,i) + DDold(1,1,-i)= b(6,i) + DDold(2,2,-i)=-b(6,i) + DDold(2,1,-i)=-b(8,i) + DDold(1,2,-i)=-b(8,i) +c DD(1,1,i)=0.0d0 +c DD(2,2,i)=0.0d0 +c DD(2,1,i)=0.0d0 +c DD(1,2,i)=0.0d0 +c Dtilde(1,1,i)= DD(1,1,i) +c Dtilde(1,2,i)= DD(1,2,i) +c Dtilde(2,1,i)=-DD(2,1,i) +c Dtilde(2,2,i)=-DD(2,2,i) + +c Dtilde(1,1,i)=0.0d0 +c Dtilde(1,2,i)=0.0d0 +c Dtilde(2,1,i)=0.0d0 +c Dtilde(2,2,i)=0.0d0 + EEold(1,1,i)= b(10,i)+b(11,i) + EEold(2,2,i)=-b(10,i)+b(11,i) + EEold(2,1,i)= b(12,i)-b(13,i) + EEold(1,2,i)= b(12,i)+b(13,i) + EEold(1,1,-i)= b(10,i)+b(11,i) + EEold(2,2,-i)=-b(10,i)+b(11,i) + EEold(2,1,-i)=-b(12,i)+b(13,i) + EEold(1,2,-i)=-b(12,i)-b(13,i) + write(iout,*) "TU DOCHODZE" + print *,"JESTEM" +c ee(1,1,i)=1.0d0 +c ee(2,2,i)=1.0d0 +c ee(2,1,i)=0.0d0 +c ee(1,2,i)=0.0d0 +c ee(2,1,i)=ee(1,2,i) + enddo + if (lprint) then + write (iout,*) + write (iout,*) + &"Coefficients of the cumulants (independent of valence angles)" + do i=-nloctyp+1,nloctyp-1 + write (iout,*) 'Type ',onelet(iloctyp(i)) + write (iout,*) 'B1' + write(iout,'(2f10.5)') B(3,i),B(5,i) + write (iout,*) 'B2' + write(iout,'(2f10.5)') B(2,i),B(4,i) + write (iout,*) 'CC' + do j=1,2 + write (iout,'(2f10.5)') CCold(j,1,i),CCold(j,2,i) + enddo + write(iout,*) 'DD' + do j=1,2 + write (iout,'(2f10.5)') DDold(j,1,i),DDold(j,2,i) + enddo + write(iout,*) 'EE' + do j=1,2 + write (iout,'(2f10.5)') EEold(j,1,i),EEold(j,2,i) + enddo + enddo + endif +#endif +C write (iout,*) 'KURWAKURWA' #ifdef CRYST_TOR C C Read torsional parameters in old format C - read (itorp,*) ntortyp,nterm_old + read (itorp,*,end=113,err=113) ntortyp,nterm_old write (iout,*) 'ntortyp,nterm',ntortyp,nterm_old - read (itorp,*) (itortyp(i),i=1,ntyp) + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) do i=1,ntortyp do j=1,ntortyp - read (itorp,'(a)') + read (itorp,'(a)',end=113,err=113) do k=1,nterm_old - read (itorp,*) kk,v1(k,j,i),v2(k,j,i) + read (itorp,*,end=113,err=113) kk,v1(k,j,i),v2(k,j,i) enddo enddo enddo @@ -481,45 +1052,67 @@ C enddo enddo endif - - #else C C Read torsional parameters C - read (itorp,*) ntortyp - read (itorp,*) (itortyp(i),i=1,ntyp) + IF (TOR_MODE.eq.0) THEN + + read (itorp,*,end=113,err=113) ntortyp + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) + do i=1,ntyp1 + itype2loc(i)=itortyp(i) + enddo write (iout,*) 'ntortyp',ntortyp - do i=1,ntortyp - do j=1,ntortyp - read (itorp,*) nterm(i,j),nlor(i,j) + do i=1,ntyp1 + itype2loc(-i)=-itype2loc(i) + enddo + itortyp(ntyp1)=ntortyp + do iblock=1,2 + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo +c write (iout,*) 'ntortyp',ntortyp + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + read (itorp,*,end=113,err=113) nterm(i,j,iblock), + & nlor(i,j,iblock) + nterm(-i,-j,iblock)=nterm(i,j,iblock) + nlor(-i,-j,iblock)=nlor(i,j,iblock) v0ij=0.0d0 si=-1.0d0 - do k=1,nterm(i,j) - read (itorp,*) kk,v1(k,i,j),v2(k,i,j) - v0ij=v0ij+si*v1(k,i,j) + do k=1,nterm(i,j,iblock) + read (itorp,*,end=113,err=113) kk,v1(k,i,j,iblock), + & v2(k,i,j,iblock) + v1(k,-i,-j,iblock)=v1(k,i,j,iblock) + v2(k,-i,-j,iblock)=-v2(k,i,j,iblock) + v0ij=v0ij+si*v1(k,i,j,iblock) si=-si - enddo - do k=1,nlor(i,j) - read (itorp,*) kk,vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) + enddo + do k=1,nlor(i,j,iblock) + read (itorp,*,end=113,err=113) kk,vlor1(k,i,j), + & vlor2(k,i,j),vlor3(k,i,j) v0ij=v0ij+vlor1(k,i,j)/(1+vlor3(k,i,j)**2) enddo - v0(i,j)=v0ij + v0(i,j,iblock)=v0ij + v0(-i,-j,iblock)=v0ij enddo enddo + enddo close (itorp) if (lprint) then - write (iout,'(/a/)') 'Torsional constants:' - do i=1,ntortyp - do j=1,ntortyp + write (iout,'(/a/)') 'Torsional constants:' + do i=1,ntortyp + do j=1,ntortyp write (iout,*) 'ityp',i,' jtyp',j write (iout,*) 'Fourier constants' - do k=1,nterm(i,j) - write (iout,'(2(1pe15.5))') v1(k,i,j),v2(k,i,j) + do k=1,nterm(i,j,iblock) + write (iout,'(2(1pe15.5))') v1(k,i,j,iblock), + & v2(k,i,j,iblock) enddo write (iout,*) 'Lorenz constants' - do k=1,nlor(i,j) - write (iout,'(3(1pe15.5))') + do k=1,nlor(i,j,iblock) + write (iout,'(3(1pe15.5))') & vlor1(k,i,j),vlor2(k,i,j),vlor3(k,i,j) enddo enddo @@ -528,147 +1121,297 @@ C C C 6/23/01 Read parameters for double torsionals C - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - read (itordp,'(3a1)') t1,t2,t3 - if (t1.ne.onelett(i) .or. t2.ne.onelett(j) - & .or. t3.ne.onelett(k)) then + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + read (itordp,'(3a1)',end=114,err=114) t1,t2,t3 +c write (iout,*) "OK onelett", +c & i,j,k,t1,t2,t3 + + if (t1.ne.toronelet(i) .or. t2.ne.toronelet(j) + & .or. t3.ne.toronelet(k)) then write (iout,*) "Error in double torsional parameter file", & i,j,k,t1,t2,t3 +#ifdef MPI + call MPI_Finalize(Ierror) +#endif stop "Error in double torsional parameter file" endif - read (itordp,*) ntermd_1(i,j,k),ntermd_2(i,j,k) - read (itordp,*) (v1c(1,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1s(1,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1c(2,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) (v1s(2,l,i,j,k),l=1,ntermd_1(i,j,k)) - read (itordp,*) ((v2c(l,m,i,j,k),v2c(m,l,i,j,k), - & v2s(l,m,i,j,k),v2s(m,l,i,j,k),m=1,l-1),l=1,ntermd_2(i,j,k)) - enddo - enddo - enddo + read (itordp,*,end=114,err=114) ntermd_1(i,j,k,iblock), + & ntermd_2(i,j,k,iblock) + ntermd_1(-i,-j,-k,iblock)=ntermd_1(i,j,k,iblock) + ntermd_2(-i,-j,-k,iblock)=ntermd_2(i,j,k,iblock) + read (itordp,*,end=114,err=114) (v1c(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(1,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1c(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) + read (itordp,*,end=114,err=114) (v1s(2,l,i,j,k,iblock),l=1, + & ntermd_1(i,j,k,iblock)) +C Martix of D parameters for one dimesional foureir series + do l=1,ntermd_1(i,j,k,iblock) + v1c(1,l,-i,-j,-k,iblock)=v1c(1,l,i,j,k,iblock) + v1s(1,l,-i,-j,-k,iblock)=-v1s(1,l,i,j,k,iblock) + v1c(2,l,-i,-j,-k,iblock)=v1c(2,l,i,j,k,iblock) + v1s(2,l,-i,-j,-k,iblock)=-v1s(2,l,i,j,k,iblock) +c write(iout,*) "whcodze" , +c & v1s(2,l,-i,-j,-k,iblock),v1s(2,l,i,j,k,iblock) + enddo + read (itordp,*,end=114,err=114) ((v2c(l,m,i,j,k,iblock), + & v2c(m,l,i,j,k,iblock),v2s(l,m,i,j,k,iblock), + & v2s(m,l,i,j,k,iblock), + & m=1,l-1),l=1,ntermd_2(i,j,k,iblock)) +C Martix of D parameters for two dimesional fourier series + do l=1,ntermd_2(i,j,k,iblock) + do m=1,l-1 + v2c(l,m,-i,-j,-k,iblock)=v2c(l,m,i,j,k,iblock) + v2c(m,l,-i,-j,-k,iblock)=v2c(m,l,i,j,k,iblock) + v2s(l,m,-i,-j,-k,iblock)=-v2s(l,m,i,j,k,iblock) + v2s(m,l,-i,-j,-k,iblock)=-v2s(m,l,i,j,k,iblock) + enddo!m + enddo!l + enddo!k + enddo!j + enddo!i + enddo!iblock if (lprint) then - write (iout,*) + write (iout,*) write (iout,*) 'Constants for double torsionals' - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp + do iblock=1,2 + do i=0,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 write (iout,*) 'ityp',i,' jtyp',j,' ktyp',k, - & ' nsingle',ntermd_1(i,j,k),' ndouble',ntermd_2(i,j,k) + & ' nsingle',ntermd_1(i,j,k,iblock), + & ' ndouble',ntermd_2(i,j,k,iblock) write (iout,*) write (iout,*) 'Single angles:' - do l=1,ntermd_1(i,j,k) - write (iout,'(i5,2f10.5,5x,2f10.5)') l, - & v1c(1,l,i,j,k),v1s(1,l,i,j,k), - & v1c(2,l,i,j,k),v1s(2,l,i,j,k) + do l=1,ntermd_1(i,j,k,iblock) + write (iout,'(i5,2f10.5,5x,2f10.5,5x,2f10.5)') l, + & v1c(1,l,i,j,k,iblock),v1s(1,l,i,j,k,iblock), + & v1c(2,l,i,j,k,iblock),v1s(2,l,i,j,k,iblock), + & v1s(1,l,-i,-j,-k,iblock),v1s(2,l,-i,-j,-k,iblock) enddo write (iout,*) write (iout,*) 'Pairs of angles:' - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2c(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2c(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) - write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k)) - do l=1,ntermd_2(i,j,k) - write (iout,'(i5,20f10.5)') - & l,(v2s(l,m,i,j,k),m=1,ntermd_2(i,j,k)) + write (iout,'(3x,20i10)') (l,l=1,ntermd_2(i,j,k,iblock)) + do l=1,ntermd_2(i,j,k,iblock) + write (iout,'(i5,20f10.5)') + & l,(v2s(l,m,i,j,k,iblock),m=1,ntermd_2(i,j,k,iblock)), + & (v2s(l,m,-i,-j,-k,iblock),m=1,ntermd_2(i,j,k,iblock)) enddo write (iout,*) enddo enddo enddo + enddo endif + + ELSE IF (TOR_MODE.eq.1) THEN + +C read valence-torsional parameters + read (itorp,*,end=113,err=113) ntortyp + nkcctyp=ntortyp + write (iout,*) "Valence-torsional parameters read in ntortyp", + & ntortyp + read (itorp,*,end=113,err=113) (itortyp(i),i=1,ntyp) + write (iout,*) "itortyp_kcc",(itortyp(i),i=1,ntyp) + do i=-ntyp,-1 + itortyp(i)=-itortyp(-i) + enddo + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 +C first we read the cos and sin gamma parameters + read (itorp,'(13x,a)',end=113,err=113) string + write (iout,*) i,j,string + read (itorp,*,end=113,err=113) + & nterm_kcc(j,i),nterm_kcc_Tb(j,i) +C read (itorkcc,*,end=121,err=121) nterm_kcc_Tb(j,i) + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + read (itorp,*,end=113,err=113) ii,jj,kk, + & v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) + enddo + enddo + enddo + enddo + enddo + + ELSE +c AL 4/8/16: Calculate coefficients from one-body parameters + ntortyp=nloctyp + do i=-ntyp1,ntyp1 + itortyp(i)=itype2loc(i) + enddo + write (iout,*) + &"Val-tor parameters calculated from cumulant coefficients ntortyp" + & ,ntortyp + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + nterm_kcc(j,i)=2 + nterm_kcc_Tb(j,i)=3 + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) + v1_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,1,j) + & +bnew1tor(k,2,i)*bnew2tor(l,2,j) + v2_kcc(k,l,1,i,j)=bnew1tor(k,1,i)*bnew2tor(l,2,j) + & +bnew1tor(k,2,i)*bnew2tor(l,1,j) + enddo + enddo + do k=1,nterm_kcc_Tb(j,i) + do l=1,nterm_kcc_Tb(j,i) +#ifdef CORRCD + v1_kcc(k,l,2,i,j)=-(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) +#else + v1_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,1,i)*ddnewtor(l,1,j) + & -ccnewtor(k,2,i)*ddnewtor(l,2,j)) + v2_kcc(k,l,2,i,j)=-0.25*(ccnewtor(k,2,i)*ddnewtor(l,1,j) + & +ccnewtor(k,1,i)*ddnewtor(l,2,j)) #endif -C -C 5/21/07 (AL) Read coefficients of the backbone-local sidechain-local -C correlation energies. -C - read (isccor,*) nterm_sccor - do i=1,20 - do j=1,20 - read (isccor,'(a)') - do k=1,nterm_sccor - read (isccor,*) - & kk,v1sccor(k,i,j),v2sccor(k,i,j) + enddo enddo +cf(theta,gamma)=-(b21(theta)*b11(theta)+b12(theta)*b22(theta))*cos(gamma)-(b22(theta)*b11(theta)+b21(theta)*b12(theta))*sin(gamma)+(c11(theta)*d11(theta)-c12(theta)*d12(theta))*cos(2*gamma)+(c12(theta)*d11(theta)+c11(theta)*d12(theta))*sin(2*gamma) enddo enddo - close (isccor) - if (lprint) then - write (iout,'(/a/)') 'Torsional constants of SCCORR:' - do i=1,20 - do j=1,20 - write (iout,*) 'ityp',i,' jtyp',j - do k=1,nterm_sccor - write (iout,'(2(1pe15.5))') v1sccor(k,i,j),v2sccor(k,i,j) + + ENDIF ! TOR_MODE + + if (tor_mode.gt.0 .and. lprint) then +c Print valence-torsional parameters + write (iout,'(a)') + & "Parameters of the valence-torsional potentials" + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + write (iout,'(3a)') "Type ",toronelet(i),toronelet(j) + write (iout,'(3a5,2a15)') "itor","ival","jval","v_kcc","v2_kcc" + do k=1,nterm_kcc(j,i) + do l=1,nterm_kcc_Tb(j,i) + do ll=1,nterm_kcc_Tb(j,i) + write (iout,'(3i5,2f15.4)') + & k,l-1,ll-1,v1_kcc(ll,l,k,j,i),v2_kcc(ll,l,k,j,i) enddo enddo enddo + enddo + enddo endif + +#endif +C Read of Side-chain backbone correlation parameters +C Modified 11 May 2012 by Adasko +CCC C -C 9/18/99 (AL) Read coefficients of the Fourier expansion of the local -C interaction energy of the Gly, Ala, and Pro prototypes. -C - read (ifourier,*) nloctyp - do i=1,nloctyp - read (ifourier,*) - read (ifourier,*) (b(ii,i),ii=1,13) - if (lprint) then - write (iout,*) 'Type',i - write (iout,'(a,i2,a,f10.5)') ('b(',ii,')=',b(ii,i),ii=1,13) - endif - B1(1,i) = b(3,i) - B1(2,i) = b(5,i) - B1tilde(1,i) = b(3,i) - B1tilde(2,i) =-b(5,i) - B2(1,i) = b(2,i) - B2(2,i) = b(4,i) - CC(1,1,i)= b(7,i) - CC(2,2,i)=-b(7,i) - CC(2,1,i)= b(9,i) - CC(1,2,i)= b(9,i) - Ctilde(1,1,i)=b(7,i) - Ctilde(1,2,i)=b(9,i) - Ctilde(2,1,i)=-b(9,i) - Ctilde(2,2,i)=b(7,i) - DD(1,1,i)= b(6,i) - DD(2,2,i)=-b(6,i) - DD(2,1,i)= b(8,i) - DD(1,2,i)= b(8,i) - Dtilde(1,1,i)=b(6,i) - Dtilde(1,2,i)=b(8,i) - Dtilde(2,1,i)=-b(8,i) - Dtilde(2,2,i)=b(6,i) - EE(1,1,i)= b(10,i)+b(11,i) - EE(2,2,i)=-b(10,i)+b(11,i) - EE(2,1,i)= b(12,i)-b(13,i) - EE(1,2,i)= b(12,i)+b(13,i) + read (isccor,*,end=119,err=119) nsccortyp + read (isccor,*,end=119,err=119) (isccortyp(i),i=1,ntyp) + do i=-ntyp,-1 + isccortyp(i)=-isccortyp(-i) enddo - if (lprint) then - do i=1,nloctyp - write (iout,*) 'Type',i - write (iout,*) 'B1' -c write (iout,'(f10.5)') B1(:,i) - write(iout,*) B1(1,i),B1(2,i) - write (iout,*) 'B2' -c write (iout,'(f10.5)') B2(:,i) - write(iout,*) B2(1,i),B2(2,i) - write (iout,*) 'CC' - do j=1,2 - write (iout,'(2f10.5)') CC(j,1,i),CC(j,2,i) + iscprol=isccortyp(20) +c write (iout,*) 'ntortyp',ntortyp + maxinter=3 +cc maxinter is maximum interaction sites + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + read (isccor,*,end=119,err=119) + &nterm_sccor(i,j),nlor_sccor(i,j) +c write (iout,*) nterm_sccor(i,j) + v0ijsccor=0.0d0 + v0ijsccor1=0.0d0 + v0ijsccor2=0.0d0 + v0ijsccor3=0.0d0 + si=-1.0d0 + nterm_sccor(-i,j)=nterm_sccor(i,j) + nterm_sccor(-i,-j)=nterm_sccor(i,j) + nterm_sccor(i,-j)=nterm_sccor(i,j) +c write (iout,*) nterm_sccor(i,j),nterm_sccor(-i,j), +c & nterm_sccor(-i,-j),nterm_sccor(i,-j) + do k=1,nterm_sccor(i,j) + read (isccor,*,end=119,err=119) kk,v1sccor(k,l,i,j) + & ,v2sccor(k,l,i,j) + if (j.eq.iscprol) then + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j)*0.5d0 + & +v2sccor(k,l,i,j)*dsqrt(0.75d0) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j)*0.5d0 + & +v1sccor(k,l,i,j)*dsqrt(0.75d0) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + else + if (i.eq.isccortyp(10)) then + v1sccor(k,l,i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + else + if (j.eq.isccortyp(10)) then + v1sccor(k,l,-i,j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,j) + else + v1sccor(k,l,i,-j)=-v1sccor(k,l,i,j) + v2sccor(k,l,i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,-j)=v1sccor(k,l,i,j) + v2sccor(k,l,-i,-j)=-v2sccor(k,l,i,j) + v1sccor(k,l,-i,j)=v1sccor(k,l,i,-j) + v2sccor(k,l,-i,j)=-v2sccor(k,l,i,-j) + endif + endif + endif + v0ijsccor=v0ijsccor+si*v1sccor(k,l,i,j) + v0ijsccor1=v0ijsccor+si*v1sccor(k,l,-i,j) + v0ijsccor2=v0ijsccor+si*v1sccor(k,l,i,-j) + v0ijsccor3=v0ijsccor+si*v1sccor(k,l,-i,-j) + si=-si + enddo + do k=1,nlor_sccor(i,j) + read (isccor,*,end=119,err=119) kk,vlor1sccor(k,i,j), + & vlor2sccor(k,i,j),vlor3sccor(k,i,j) + v0ijsccor=v0ijsccor+vlor1sccor(k,i,j)/ + &(1+vlor3sccor(k,i,j)**2) + enddo + v0sccor(l,i,j)=v0ijsccor + v0sccor(l,-i,j)=v0ijsccor1 + v0sccor(l,i,-j)=v0ijsccor2 + v0sccor(l,-i,-j)=v0ijsccor3 + enddo enddo - write(iout,*) 'DD' - do j=1,2 - write (iout,'(2f10.5)') DD(j,1,i),DD(j,2,i) + enddo + close (isccor) + if (lprint) then + write (iout,'(/a/)') 'Torsional constants of SCCORR:' + do l=1,maxinter + do i=1,nsccortyp + do j=1,nsccortyp + write (iout,*) 'ityp',i,' jtyp',j + write (iout,*) 'Fourier constants' + do k=1,nterm_sccor(i,j) + write (iout,'(2(1pe15.5))') + & v1sccor(k,l,i,j),v2sccor(k,l,i,j) + enddo + write (iout,*) 'Lorenz constants' + do k=1,nlor_sccor(i,j) + write (iout,'(3(1pe15.5))') + & vlor1sccor(k,i,j),vlor2sccor(k,i,j),vlor3sccor(k,i,j) + enddo + enddo enddo - write(iout,*) 'EE' - do j=1,2 - write (iout,'(2f10.5)') EE(j,1,i),EE(j,2,i) enddo - enddo endif C C Read electrostatic-interaction parameters @@ -678,10 +1421,10 @@ C write (iout,'(1x,a,1x,a,10x,a,11x,a,11x,a,11x,a)') & 'IT','JT','APP','BPP','AEL6','AEL3' endif - read (ielep,*) ((epp(i,j),j=1,2),i=1,2) - read (ielep,*) ((rpp(i,j),j=1,2),i=1,2) - read (ielep,*) ((elpp6(i,j),j=1,2),i=1,2) - read (ielep,*) ((elpp3(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((epp(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((rpp(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((elpp6(i,j),j=1,2),i=1,2) + read (ielep,*,end=116,err=116) ((elpp3(i,j),j=1,2),i=1,2) close (ielep) do i=1,2 do j=1,2 @@ -697,7 +1440,7 @@ C C C Read side-chain interaction parameters. C - read (isidep,*) ipot,expon + read (isidep,*,end=117,err=117) ipot,expon if (ipot.lt.1 .or. ipot.gt.5) then write (iout,'(2a)') 'Error while reading SC interaction', & 'potential file - unknown potential type.' @@ -708,7 +1451,8 @@ C & ', exponents are ',expon,2*expon goto (10,20,30,30,40) ipot C----------------------- LJ potential --------------------------------- - 10 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp),(sigma0(i),i=1,ntyp) + 10 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), + & (sigma0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJ potential:' write (iout,'(a/)') 'The epsilon array:' @@ -719,7 +1463,7 @@ C----------------------- LJ potential --------------------------------- endif goto 50 C----------------------- LJK potential -------------------------------- - 20 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), + 20 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp) if (lprint) then write (iout,'(/a/)') 'Parameters of the LJK potential:' @@ -732,13 +1476,25 @@ C----------------------- LJK potential -------------------------------- endif goto 50 C---------------------- GB or BP potential ----------------------------- - 30 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(sigii(i),i=1,ntyp),(chip0(i),i=1,ntyp), - & (alp(i),i=1,ntyp) + 30 do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) + do i=1,ntyp + read (isidep,*,end=117,err=117)(epslip(i,j),j=i,ntyp) +C write(iout,*) "WARNING!!",i,ntyp + write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) +C do j=1,ntyp +C epslip(i,j)=epslip(i,j)+0.05d0 +C enddo + enddo C For the GB potential convert sigma'**2 into chi' if (ipot.eq.4) then do i=1,ntyp - chip(i)=(chip0(i)-1.0D0)/(chip0(i)+1.0D0) + chip(i)=(chip(i)-1.0D0)/(chip(i)+1.0D0) enddo endif if (lprint) then @@ -753,9 +1509,21 @@ C For the GB potential convert sigma'**2 into chi' endif goto 50 C--------------------- GBV potential ----------------------------------- - 40 read (isidep,*)((eps(i,j),j=i,ntyp),i=1,ntyp), - & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), - & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) +c 40 read (isidep,*,end=117,err=117)((eps(i,j),j=i,ntyp),i=1,ntyp), +c & (sigma0(i),i=1,ntyp),(rr0(i),i=1,ntyp),(sigii(i),i=1,ntyp), +c & (chip(i),i=1,ntyp),(alp(i),i=1,ntyp) + 40 do i=1,ntyp + read (isidep,*,end=117,err=117)(eps(i,j),j=i,ntyp) + enddo + read (isidep,*,end=117,err=117)(sigma0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(rr0(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(sigii(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(chip(i),i=1,ntyp) + read (isidep,*,end=117,err=117)(alp(i),i=1,ntyp) + do i=1,ntyp + read (isidep,*,end=1161,err=1161)(epslip(i,j),j=i,ntyp) + if (lprint) write(iout,*) "epslip", i, (epslip(i,j),j=i,ntyp) + enddo if (lprint) then write (iout,'(/a/)') 'Parameters of the GBV potential:' write (iout,'(a/)') 'The epsilon array:' @@ -773,6 +1541,7 @@ C Calculate the "working" parameters of SC interactions. do i=2,ntyp do j=1,i-1 eps(i,j)=eps(j,i) + epslip(i,j)=epslip(j,i) enddo enddo do i=1,ntyp @@ -790,6 +1559,7 @@ C Calculate the "working" parameters of SC interactions. do i=1,ntyp do j=i,ntyp epsij=eps(i,j) + epsijlip=epslip(i,j) if (ipot.eq.1 .or. ipot.eq.3 .or. ipot.eq.4) then rrij=sigma(i,j) else @@ -801,10 +1571,16 @@ C Calculate the "working" parameters of SC interactions. epsij=eps(i,j) sigeps=dsign(1.0D0,epsij) epsij=dabs(epsij) - aa(i,j)=epsij*rrij*rrij - bb(i,j)=-sigeps*epsij*rrij - aa(j,i)=aa(i,j) - bb(j,i)=bb(i,j) + aa_aq(i,j)=epsij*rrij*rrij + bb_aq(i,j)=-sigeps*epsij*rrij + aa_aq(j,i)=aa_aq(i,j) + bb_aq(j,i)=bb_aq(i,j) + sigeps=dsign(1.0D0,epsijlip) + epsijlip=dabs(epsijlip) + aa_lip(i,j)=epsijlip*rrij*rrij + bb_lip(i,j)=-sigeps*epsijlip*rrij + aa_lip(j,i)=aa_lip(i,j) + bb_lip(j,i)=bb_lip(i,j) if (ipot.gt.2) then sigt1sq=sigma0(i)**2 sigt2sq=sigma0(j)**2 @@ -837,7 +1613,7 @@ c augm(i,j)=0.5D0**(2*expon)*aa(i,j) endif if (lprint) then write (iout,'(2(a3,2x),3(1pe10.3),5(0pf8.3))') - & restyp(i),restyp(j),aa(i,j),bb(i,j),augm(i,j), + & restyp(i),restyp(j),aa_aq(i,j),bb_aq(i,j),augm(i,j), & sigma(i,j),r0(i,j),chi(i,j),chi(j,i) endif enddo @@ -873,7 +1649,7 @@ C C 8/9/01 Read the SC-p interaction constants from file C do i=1,ntyp - read (iscpp,*) (eps_scp(i,j),rscp(i,j),j=1,2) + read (iscpp,*,end=118,err=118) (eps_scp(i,j),rscp(i,j),j=1,2) enddo do i=1,ntyp aad(i,1)=dabs(eps_scp(i,1))*rscp(i,1)**12 @@ -893,7 +1669,7 @@ C C C Define the constants of the disulfide bridge C - ebr=-5.50D0 +C ebr=-12.0D0 c c Old arbitrary potential - commented out. c @@ -904,21 +1680,84 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G** c energy surface of diethyl disulfide. c A. Liwo and U. Kozlowska, 11/24/03 c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 +C D0CM = 3.78d0 +C AKCM = 15.1d0 +C AKTH = 11.0d0 +C AKCT = 12.0d0 +C V1SS =-1.08d0 +C V2SS = 7.61d0 +C V3SS = 13.7d0 + write (iout,*) dyn_ss,'Dynamic disulfide parameters' + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + if (wstrain.ne.0.0) then + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + else + ss_depth=0.0 + endif + endif - if (lprint) then +C if (lprint) then write (iout,'(/a)') "Disulfide bridge parameters:" write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, & ' v3ss:',v3ss - endif +C endif + if (shield_mode.gt.0) then + pi=3.141592d0 +C VSolvSphere the volume of solving sphere +C print *,pi,"pi" +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters + VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 + VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 + write (iout,*) "VSolvSphere",VSolvSphere," VSolvSphere_div", + & VSolvSphere_div +C long axis of side chain + do i=1,ntyp + long_r_sidechain(i)=vbldsc0(1,i) + short_r_sidechain(i)=sigma0(i) + enddo + buff_shield=1.0d0 + endif + return + 111 write (iout,*) "Error reading bending energy parameters." + goto 999 + 112 write (iout,*) "Error reading rotamer energy parameters." + goto 999 + 113 write (iout,*) "Error reading torsional energy parameters." + goto 999 + 114 write (iout,*) "Error reading double torsional energy parameters." + goto 999 + 115 write (iout,*) + & "Error reading cumulant (multibody energy) parameters." + goto 999 + 116 write (iout,*) "Error reading electrostatic energy parameters." + goto 999 + 1161 write (iout,*) "Error reading lipid parameters." + goto 999 + 117 write (iout,*) "Error reading side chain interaction parameters." + goto 999 + 118 write (iout,*) "Error reading SCp interaction parameters." + goto 999 + 119 write (iout,*) "Error reading SCCOR parameters" + goto 999 + 121 write (iout,*) "Error reading bond parameters" + 999 continue +#ifdef MPI + call MPI_Finalize(Ierror) +#endif + stop return end diff --git a/source/wham/src-M/promienie.f b/source/wham/src-M/promienie.f index 12a2e80..c2d8732 100644 --- a/source/wham/src-M/promienie.f +++ b/source/wham/src-M/promienie.f @@ -36,7 +36,7 @@ enddo close (isidep1) do i=1,ntyp1 - if (i.eq.10 .or. i.eq.21) then + if (i.eq.10 .or. i.eq.ntyp1) then dsc_inv(i)=0.0d0 else dsc_inv(i)=1.0d0/dsc(i) diff --git a/source/wham/src-M/read_dist_constr.F b/source/wham/src-M/read_dist_constr.F index 3d803bb..4c02f02 100644 --- a/source/wham/src-M/read_dist_constr.F +++ b/source/wham/src-M/read_dist_constr.F @@ -13,9 +13,12 @@ character*500 controlcard logical lprn /.true./ write (iout,*) "Calling read_dist_constr" - write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup +C write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup +C call flush(iout) + write(iout,*) "TU sie wywalam?" + call card_concat(controlcard,.false.) + write (iout,*) controlcard call flush(iout) - call card_concat(controlcard) call readi(controlcard,"NFRAG",nfrag_,0) call readi(controlcard,"NPAIR",npair_,0) call readi(controlcard,"NDIST",ndist_,0) @@ -96,14 +99,31 @@ c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) endif enddo do i=1,ndist_ + if (constr_dist.eq.11) then + read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), + & ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1) + fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1) +C write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", +C & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) + else read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1) + endif if (forcon(nhpb+1).gt.0.0d0) then nhpb=nhpb+1 - dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) + if (ibecarb(i).gt.0) then + ihpb(i)=ihpb(i)+nres + jhpb(i)=jhpb(i)+nres + endif + if (dhpb(nhpb).eq.0.0d0) + & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) +C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) endif +C endif enddo + write (iout,*) "Calling HPB_PARTINION" + call hpb_partition call flush(iout) return end diff --git a/source/wham/src-M/read_ref_str.F b/source/wham/src-M/read_ref_str.F index 2245a59..6473d95 100644 --- a/source/wham/src-M/read_ref_str.F +++ b/source/wham/src-M/read_ref_str.F @@ -29,10 +29,13 @@ C logical seq_comp integer i,j,k,nres_pdb,iaux double precision ddsc,dist + integer nnt_old,nct_old integer ilen,kkk external ilen C nres0=nres + nnt_old=nnt + nct_old=nct write (iout,*) "pdbref",pdbref if (pdbref) then read(inp,'(a)') pdbfile @@ -164,5 +167,8 @@ c print *,"Calling elecont" & 'Number of residues to be superposed:',nsup, & ' (from residue',nstart_sup,' to residue', & nend_sup,').' + nres=nres0 + nnt=nnt_old + nct=nct_old return end diff --git a/source/wham/src-M/readpdb.f b/source/wham/src-M/readpdb.f index 93c9cbe..ff0eaf2 100644 --- a/source/wham/src-M/readpdb.f +++ b/source/wham/src-M/readpdb.f @@ -14,7 +14,7 @@ C geometry. include 'COMMON.NAMES' character*3 seq,atom,res character*80 card - double precision sccor(3,20) + double precision sccor(3,50) integer i,j,iii,ibeg,ishift,ishift1,ity,ires,ires_old double precision dcj integer rescode,kkk,lll,icha,cou,kupa,iprzes @@ -26,8 +26,10 @@ C geometry. goto 10 else if (card(:3).eq.'TER') then C End current chain - ires_old=ires+1 - itype(ires_old)=21 +c ires_old=ires+1 + ires_old=ires+2 + itype(ires_old-1)=ntyp1 + itype(ires_old)=ntyp1 ibeg=2 c write (iout,*) "Chain ended",ires,ishift,ires_old call sccenter(ires,iii,sccor) @@ -42,13 +44,13 @@ C Calculate the CM of the preceding residue. endif C Start new residue. c write (iout,'(a80)') card - read (card(24:26),*) ires + read (card(23:26),*) ires read (card(18:20),'(a3)') res if (ibeg.eq.1) then ishift=ires-1 if (res.ne.'GLY' .and. res.ne. 'ACE') then ishift=ishift-1 - itype(1)=21 + itype(1)=ntyp1 endif c write (iout,*) "ires",ires," ibeg",ibeg," ishift",ishift ibeg=0 @@ -72,7 +74,9 @@ c write (2,*) "ires",ires," ishift",ishift do j=1,3 sccor(j,iii)=c(j,ires) enddo - else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. + else if (atom.ne.'O '.and.atom(1:1).ne.'H' .and. + & atom(1:1).ne.'Q' .and. atom(1:2).ne.'1H' .and. + & atom(1:2).ne.'2H' .and. atom(1:2).ne.'3H' .and. & atom.ne.'N ' .and. atom.ne.'C ') then iii=iii+1 read(card(31:54),'(3f8.3)') (sccor(j,iii),j=1,3) @@ -85,14 +89,51 @@ C system nres=ires do i=2,nres-1 c write (iout,*) i,itype(i) - if (itype(i).eq.21) then -c write (iout,*) "dummy",i,itype(i) - do j=1,3 - c(j,i)=((c(j,i-1)+c(j,i+1))/2+2*c(j,i-1)-c(j,i-2))/2 -c c(j,i)=(c(j,i-1)+c(j,i+1))/2 - dc(j,i)=c(j,i) - enddo - endif + + if (itype(i).eq.ntyp1) then + if (itype(i+1).eq.ntyp1) then +C 16/01/2014 by Adasko: Adding to dummy atoms in the chain +C first is connected prevous chain (itype(i+1).eq.ntyp1)=true +C second dummy atom is conected to next chain itype(i+1).eq.ntyp1=false +C if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the last dummy residue +C call refsys(i-3,i-2,i-1,e1,e2,e3,fail) +C if (fail) then +C e2(1)=0.0d0 +C e2(2)=1.0d0 +C e2(3)=0.0d0 +C endif !fail +C do j=1,3 +C c(j,i)=c(j,i-1)-1.9d0*e2(j) +C enddo +C else !unres_pdb + do j=1,3 + dcj=(c(j,i-2)-c(j,i-3))/2.0 + c(j,i)=c(j,i-1)+dcj + c(j,nres+i)=c(j,i) + enddo +C endif !unres_pdb + else !itype(i+1).eq.ntyp1 +C if (unres_pdb) then +C 2/15/2013 by Adam: corrected insertion of the first dummy residue +C call refsys(i+1,i+2,i+3,e1,e2,e3,fail) +C if (fail) then +C e2(1)=0.0d0 +C e2(2)=1.0d0 +C e2(3)=0.0d0 +C endif +C do j=1,3 +C c(j,i)=c(j,i+1)-1.9d0*e2(j) +C enddo +C else !unres_pdb + do j=1,3 + dcj=(c(j,i+3)-c(j,i+2))/2.0 + c(j,i)=c(j,i+1)-dcj + c(j,nres+i)=c(j,i) + enddo +C endif !unres_pdb + endif !itype(i+1).eq.ntyp1 + endif !itype.eq.ntyp1 enddo C Calculate the CM of the last side chain. call sccenter(ires,iii,sccor) @@ -100,9 +141,9 @@ C Calculate the CM of the last side chain. nstart_sup=1 if (itype(nres).ne.10) then nres=nres+1 - itype(nres)=21 + itype(nres)=ntyp1 do j=1,3 - dcj=c(j,nres-2)-c(j,nres-3) + dcj=(c(j,nres-2)-c(j,nres-3))/2.0 c(j,nres)=c(j,nres-1)+dcj c(j,2*nres)=c(j,nres) enddo @@ -116,11 +157,11 @@ C Calculate the CM of the last side chain. c(j,nres+1)=c(j,1) c(j,2*nres)=c(j,nres) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then nsup=nsup-1 nstart_sup=2 do j=1,3 - dcj=c(j,4)-c(j,3) + dcj=(c(j,4)-c(j,3))/2.0 c(j,1)=c(j,2)-dcj c(j,nres+1)=c(j,1) enddo @@ -163,7 +204,7 @@ C Splits to single chain if occurs lll=lll+1 cc write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) if (i.gt.1) then - if (itype(i-1).eq.21) then + if ((itype(i-1).eq.ntyp1).and.(i.gt.2).and.(i.ne.nres)) then chain_length=lll-1 kkk=kkk+1 c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) @@ -179,6 +220,8 @@ c write (iout,*) "spraw lancuchy",(c(j,i),j=1,3) endif enddo enddo + if (chain_length.eq.0) chain_length=nres + write (iout,*) chain_length do j=1,3 chain_rep(j,chain_length,symetr)=chain_rep(j,chain_length,1) chain_rep(j,chain_length+nres,symetr) @@ -281,20 +324,20 @@ c--------------------------------------------------------------------------- do i=2,nres iti=itype(i) write (iout,*) i,i-1,(c(j,i),j=1,3),(c(j,i-1),j=1,3),dist(i,i-1) - if (itype(i-1).ne.21 .and. itype(i).ne.21 .and. - & (dist(i,i-1).lt.2.0D0 .or. dist(i,i-1).gt.5.0D0)) then + if (itype(i-1).ne.ntyp1 .and. itype(i).ne.ntyp1 .and. + & (dist(i,i-1).lt.1.0D0 .or. dist(i,i-1).gt.6.0D0)) then write (iout,'(a,i4)') 'Bad Cartesians for residue',i stop endif theta(i+1)=alpha(i-1,i,i+1) if (i.gt.2) phi(i+1)=beta(i-2,i-1,i,i+1) enddo - if (itype(1).eq.21) then + if (itype(1).eq.ntyp1) then do j=1,3 c(j,1)=c(j,2)+(c(j,3)-c(j,4)) enddo endif - if (itype(nres).eq.21) then + if (itype(nres).eq.ntyp1) then do j=1,3 c(j,nres)=c(j,nres-1)+(c(j,nres-2)-c(j,nres-3)) enddo diff --git a/source/wham/src-M/readrtns.F b/source/wham/src-M/readrtns.F index 36c13b1..1bf78e8 100644 --- a/source/wham/src-M/readrtns.F +++ b/source/wham/src-M/readrtns.F @@ -17,6 +17,9 @@ include "COMMON.FREE" include "COMMON.CONTROL" include "COMMON.ENERGIES" + include "COMMON.SPLITELE" + include "COMMON.SBRIDGE" + include "COMMON.SHIELD" character*800 controlcard integer i,j,k,ii,n_ene_found integer ind,itype1,itype2,itypf,itypsc,itypp @@ -25,7 +28,7 @@ character*16 ucase character*16 key external ucase - + double precision pi call card_concat(controlcard,.true.) call readi(controlcard,"N_ENE",n_ene,max_ene) if (n_ene.gt.max_ene) then @@ -48,6 +51,13 @@ hamil_rep=index(controlcard,"HAMIL_REP").gt.0 write (iout,*) "Number of energy parameter sets",nparmset call multreadi(controlcard,"ISAMPL",isampl,nparmset,1) + do i=1,nparmset + if (isampl(i).eq.0) then + write (iout,*) "ERROR: isampl is 0 for parmset",i + call flush(iout) + stop + endif + enddo write (iout,*) "MaxSlice",MaxSlice call readi(controlcard,"NSLICE",nslice,1) call flush(iout) @@ -66,6 +76,8 @@ return1 endif indpdb=0 + energy_dec=(index(controlcard,'ENERGY_DEC').gt.0) + rmsrgymap = (index(controlcard,'RMSRGYMAP').gt.0) if (index(controlcard,"CLASSIFY").gt.0) indpdb=1 call reada(controlcard,"DELTA",delta,1.0d-2) call readi(controlcard,"EINICHECK",einicheck,2) @@ -73,7 +85,33 @@ call reada(controlcard,"DELTRGY",deltrgy,5.0d-2) call readi(controlcard,"RESCALE",rescale_mode,1) check_conf=index(controlcard,"NO_CHECK_CONF").eq.0 + call readi(controlcard,'TORMODE',tor_mode,0) +C if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then + write(iout,*) "torsional and valence angle mode",tor_mode call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0) + call reada(controlcard,'BOXX',boxxsize,100.0d0) + call reada(controlcard,'BOXY',boxysize,100.0d0) + call reada(controlcard,'BOXZ',boxzsize,100.0d0) +c Cutoff range for interactions + call reada(controlcard,"R_CUT",r_cut,15.0d0) + call reada(controlcard,"LAMBDA",rlamb,0.3d0) + call reada(controlcard,"LIPTHICK",lipthick,0.0d0) + call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0) + if (lipthick.gt.0.0d0) then + bordliptop=(boxzsize+lipthick)/2.0 + bordlipbot=bordliptop-lipthick +C endif + if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0)) + & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE" + buflipbot=bordlipbot+lipbufthick + bufliptop=bordliptop-lipbufthick + if ((lipbufthick*2.0d0).gt.lipthick) + &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF" + endif + write(iout,*) "bordliptop=",bordliptop + write(iout,*) "bordlipbot=",bordlipbot + write(iout,*) "bufliptop=",bufliptop + write(iout,*) "buflipbot=",buflipbot call readi(controlcard,'SYM',symetr,1) write (iout,*) "DISTCHAINMAX",distchainmax write (iout,*) "delta",delta @@ -90,7 +128,34 @@ zscfile=index(controlcard,"ZSCFILE").gt.0 with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0 write (iout,*) "with_dihed_constr ",with_dihed_constr + with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0 + write (iout,*) "with_theta_constr ",with_theta_constr + call readi(controlcard,'SHIELD',shield_mode,0) + write(iout,*) "shield_mode",shield_mode +C endif + call readi(controlcard,'TORMODE',tor_mode,0) + write(iout,*) "torsional and valence angle mode",tor_mode + if (shield_mode.gt.0) then + pi=3.141592d0 +C VSolvSphere the volume of solving sphere +C print *,pi,"pi" +C rpp(1,1) is the energy r0 for peptide group contact and will be used for it +C there will be no distinction between proline peptide group and normal peptide +C group in case of shielding parameters + VSolvSphere=4.0/3.0*pi*rpp(1,1)**3 + VSolvSphere_div=VSolvSphere-4.0/3.0*pi*(rpp(1,1)/2.0)**3 + write (iout,*) VSolvSphere,VSolvSphere_div +C long axis of side chain +C do i=1,ntyp +C long_r_sidechain(i)=vbldsc0(1,i) +C short_r_sidechain(i)=sigma0(i) +C enddo + buff_shield=1.0d0 + endif + call readi(controlcard,'CONSTR_DIST',constr_dist,0) + dyn_ss=index(controlcard,"DYN_SS").gt.0 + adaptive = index(controlcard,"ADAPTIVE").gt.0 return end c------------------------------------------------------------------------------ @@ -400,7 +465,7 @@ c------------------------------------------------------------------------------- external ilen,iroof double precision rmsdev,energia(0:max_ene),efree,eini,temp double precision prop(maxQ) - integer ntot_all(maxslice,0:maxprocs-1) + integer ntot_all(maxslice,0:maxprocs-1), maxslice_buff integer iparm,ib,iib,ir,nprop,nthr,npars double precision etot,time integer ixdrf,iret @@ -531,7 +596,13 @@ c DA scratchfile. #ifdef MPI c Check if everyone has the same number of conformations - call MPI_Allgather(stot(1),maxslice,MPI_INTEGER, + +c call MPI_ALLgather(MPI_IN_PLACE,stot(1),MPI_DATATYPE_NULL, +c & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR) + + maxslice_buff=maxslice + + call MPI_Allgather(stot(1),maxslice_buff,MPI_INTEGER, & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR) lerr=.false. do i=0,nprocs-1 @@ -772,3 +843,156 @@ c------------------------------------------------------------------------------- iroof = ii return end +c------------------------------------------------------------------------------- + subroutine read_dist_constr + implicit real*8 (a-h,o-z) + include 'DIMENSIONS' + include 'COMMON.CONTROL' + include 'COMMON.CHAIN' + include 'COMMON.IOUNITS' + include 'COMMON.SBRIDGE' + integer ifrag_(2,100),ipair_(2,100) + double precision wfrag_(100),wpair_(100) + character*500 controlcard + logical normalize + print *, "WCHODZE" + write (iout,*) "Calling read_dist_constr" +c write (iout,*) "nres",nres," nstart_sup",nstart_sup," nsup",nsup +c call flush(iout) + call card_concat(controlcard,.true.) + call readi(controlcard,"NFRAG",nfrag_,0) + call readi(controlcard,"NPAIR",npair_,0) + call readi(controlcard,"NDIST",ndist_,0) + call reada(controlcard,'DIST_CUT',dist_cut,5.0d0) + call multreadi(controlcard,"IFRAG",ifrag_(1,1),2*nfrag_,0) + call multreadi(controlcard,"IPAIR",ipair_(1,1),2*npair_,0) + call multreada(controlcard,"WFRAG",wfrag_(1),nfrag_,0.0d0) + call multreada(controlcard,"WPAIR",wpair_(1),npair_,0.0d0) + normalize = index(controlcard,"NORMALIZE").gt.0 +c write (iout,*) "NFRAG",nfrag_," NPAIR",npair_," NDIST",ndist_ +c write (iout,*) "IFRAG" +c do i=1,nfrag_ +c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) +c enddo +c write (iout,*) "IPAIR" +c do i=1,npair_ +c write (iout,*) i,ipair_(1,i),ipair_(2,i),wpair_(i) +c enddo + call flush(iout) + do i=1,nfrag_ + if (ifrag_(1,i).lt.nstart_sup) ifrag_(1,i)=nstart_sup + if (ifrag_(2,i).gt.nstart_sup+nsup-1) + & ifrag_(2,i)=nstart_sup+nsup-1 +c write (iout,*) i,ifrag_(1,i),ifrag_(2,i),wfrag_(i) + call flush(iout) + if (wfrag_(i).gt.0.0d0) then + do j=ifrag_(1,i),ifrag_(2,i)-1 + do k=j+1,ifrag_(2,i) +c write (iout,*) "j",j," k",k + ddjk=dist(j,k) + if (constr_dist.eq.1) then + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i) + else if (constr_dist.eq.2) then + if (ddjk.le.dist_cut) then + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i) + endif + else + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + dhpb(nhpb)=ddjk + forcon(nhpb)=wfrag_(i)*dexp(-0.5d0*(ddjk/dist_cut)**2) + endif + write (iout,'(a,3i5,f8.2,1pe12.2)') "+dist.constr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) + enddo + enddo + endif + enddo + do i=1,npair_ + if (wpair_(i).gt.0.0d0) then + ii = ipair_(1,i) + jj = ipair_(2,i) + if (ii.gt.jj) then + itemp=ii + ii=jj + jj=itemp + endif + do j=ifrag_(1,ii),ifrag_(2,ii) + do k=ifrag_(1,jj),ifrag_(2,jj) + nhpb=nhpb+1 + ihpb(nhpb)=j + jhpb(nhpb)=k + forcon(nhpb)=wpair_(i) + dhpb(nhpb)=dist(j,k) + write (iout,'(a,3i5,f8.2,f10.1)') "+dist.constr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),dhpb(nhpb),forcon(nhpb) + enddo + enddo + endif + enddo + write (iout,*) "Distance restraints as read from input" + do i=1,ndist_ + if (constr_dist.eq.11) then + read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), + & ibecarb(i),forcon(nhpb+1),fordepth(nhpb+1) +c fordepth(nhpb+1)=fordepth(nhpb+1)/forcon(nhpb+1) + if (forcon(nhpb+1).le.0.0d0.or.fordepth(nhpb+1).le.0.0d0)cycle + nhpb=nhpb+1 + write (iout,'(a,4i5,2f8.2,2f10.5)') "+dist.restr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(nhpb),dhpb(nhpb), + & dhpb1(nhpb),forcon(nhpb),fordepth(nhpb) + if (ibecarb(i).gt.0) then + ihpb(i)=ihpb(i)+nres + jhpb(i)=jhpb(i)+nres + endif + else +C print *,"in else" + read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),dhpb(i),dhpb1(i), + & ibecarb(i),forcon(nhpb+1) + if (forcon(nhpb+1).gt.0.0d0) then + nhpb=nhpb+1 + if (ibecarb(i).gt.0) then + ihpb(i)=ihpb(i)+nres + jhpb(i)=jhpb(i)+nres + endif + if (dhpb(nhpb).eq.0.0d0) + & dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) + endif + write (iout,'(a,4i5,f8.2,f10.1)') "+dist.restr ", + & nhpb,ihpb(nhpb),jhpb(nhpb),ibecarb(i),dhpb(nhpb),forcon(nhpb) + endif +C read (inp,*) ihpb(nhpb+1),jhpb(nhpb+1),forcon(nhpb+1) +C if (forcon(nhpb+1).gt.0.0d0) then +C nhpb=nhpb+1 +C dhpb(nhpb)=dist(ihpb(nhpb),jhpb(nhpb)) + enddo + if (constr_dist.eq.11 .and. normalize) then + fordepthmax=fordepth(1) + do i=2,nhpb + if (fordepth(i).gt.fordepthmax) fordepthmax=fordepth(i) + enddo + do i=1,nhpb + fordepth(i)=fordepth(i)/fordepthmax + enddo + write (iout,'(/a/4a5,2a8,2a10)') + & "Normalized Lorenzian-like distance restraints", + & " Nr"," res1"," res2"," beta"," d1"," d2"," k"," V" + do i=1,nhpb + write (iout,'(4i5,2f8.2,2f10.5)')i,ihpb(i),jhpb(i),ibecarb(i), + & dhpb(i),dhpb1(i),forcon(i),fordepth(i) + enddo + endif + write (iout,*) + call hpb_partition + call flush(iout) + return + end diff --git a/source/wham/src-M/rescode.f b/source/wham/src-M/rescode.f index b516fed..dbbb459 100644 --- a/source/wham/src-M/rescode.f +++ b/source/wham/src-M/rescode.f @@ -7,7 +7,7 @@ if (itype.eq.0) then - do i=1,ntyp1 + do i=-ntyp1,ntyp1 if (ucase(nam).eq.restyp(i)) then rescode=i return @@ -16,7 +16,7 @@ else - do i=1,ntyp1 + do i=-ntyp1,ntyp1 if (nam(1:1).eq.onelet(i)) then rescode=i return diff --git a/source/wham/src-M/rmscalc.f b/source/wham/src-M/rmscalc.f index 826167f..6b03ac5 100644 --- a/source/wham/src-M/rmscalc.f +++ b/source/wham/src-M/rmscalc.f @@ -155,20 +155,28 @@ c------------------------------------------------------------------------- rminrms=10.0d10 rmsminsing=10d10 nperm=1 +C write (iout,*) "tu2", nres,nsup + noverlap=nres + if (nres.gt.nsup+nnt-1) noverlap=nsup+nnt-1 +c write (iout,*) "tu3,",noverlap do i=1,symetr nperm=nperm*i enddo do kkk=1,nperm + write (iout,*) "kkk",kkk nnsup=0 - do i=1,nres - if (itype(i).ne.21) then + do i=1,noverlap + if (itype(i).ne.ntyp1) then nnsup=nnsup+1 do j=1,3 cc(j,nnsup)=c(j,i) ccref(j,nnsup)=cref(j,i,kkk) enddo + write (iout,'(2i5,3f10.5,5x,3f10.5)') + & i,nnsup,(cc(j,nnsup),j=1,3),(ccref(j,nnsup),j=1,3) endif enddo + call fitsq(rms,cc(1,1),ccref(1,1),nnsup,przes,obrot,non_conv) if (non_conv) then print *,'Error: FITSQ non-convergent, jcon',jcon,i diff --git a/source/wham/src-M/secondary.f b/source/wham/src-M/secondary.f index 9c9bc7d..4088831 100644 --- a/source/wham/src-M/secondary.f +++ b/source/wham/src-M/secondary.f @@ -656,13 +656,13 @@ cd write (iout,*)'helix',nhelix,ii1,j1 if (lprint) then - write(iout,*) 'UNRES seq:' + write(iout,*) 'UNRES seq:',anatemp do j=1,nbfrag write(iout,*) 'beta ',(bfrag(i,j),i=1,4) enddo do j=1,nhfrag - write(iout,*) 'helix ',(hfrag(i,j),i=1,2) + write(iout,*) 'helix ',(hfrag(i,j),i=1,2),anatemp enddo endif diff --git a/source/wham/src-M/store_parm.F b/source/wham/src-M/store_parm.F index 0727c01..01bac6d 100644 --- a/source/wham/src-M/store_parm.F +++ b/source/wham/src-M/store_parm.F @@ -1,4 +1,4 @@ - subroutine store_parm(iparm) + subroutine store_parm(iparm) C C Store parameters of set IPARM C valence angles and the side chains and energy parameters. @@ -19,7 +19,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,ii,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Store weights ww_all(1,iparm)=wsc @@ -40,6 +40,7 @@ c Store weights ww_all(16,iparm)=wvdwpp ww_all(17,iparm)=wbond ww_all(19,iparm)=wsccor + ww_all(22,iparm)=wliptran c Store bond parameters vbldp0_all(iparm)=vbldp0 akp_all(iparm)=akp @@ -53,11 +54,15 @@ c Store bond parameters enddo c Store bond angle parameters #ifdef CRYST_THETA - do i=1,ntyp + do i=-ntyp,ntyp a0thet_all(i,iparm)=a0thet(i) + do ichir1=-1,1 + do ichir2=-1,1 do j=1,2 - athet_all(j,i,iparm)=athet(j,i) - bthet_all(j,i,iparm)=bthet(j,i) + athet_all(j,i,ichir1,ichir2,iparm)=athet(j,i,ichir1,ichir2) + bthet_all(j,i,ichir1,ichir2,iparm)=bthet(j,i,ichir1,ichir2) + enddo + enddo enddo do j=0,3 polthet_all(j,i,iparm)=polthet(j,i) @@ -77,42 +82,60 @@ c Store bond angle parameters nsingle_all(iparm)=nsingle ndouble_all(iparm)=ndouble nntheterm_all(iparm)=nntheterm - do i=1,ntyp1 + do i=-ntyp,ntyp ithetyp_all(i,iparm)=ithetyp(i) enddo - do i=1,maxthetyp1 - do j=1,maxthetyp1 - do k=1,maxthetyp1 - aa0thet_all(i,j,k,iparm)=aa0thet(i,j,k) + do iblock=1,2 + do i=-maxthetyp1,maxthetyp1 + do j=-maxthetyp1,maxthetyp1 + do k=-maxthetyp1,maxthetyp1 + aa0thet_all(i,j,k,iblock,iparm)=aa0thet(i,j,k,iblock) do l=1,ntheterm - aathet_all(l,i,j,k,iparm)=aathet(l,i,j,k) + aathet_all(l,i,j,k,iblock,iparm)=aathet(l,i,j,k,iblock) enddo do l=1,ntheterm2 do m=1,nsingle - bbthet_all(m,l,i,j,k,iparm)=bbthet(m,l,i,j,k) - ccthet_all(m,l,i,j,k,iparm)=ccthet(m,l,i,j,k) - ddthet_all(m,l,i,j,k,iparm)=ddthet(m,l,i,j,k) - eethet_all(m,l,i,j,k,iparm)=eethet(m,l,i,j,k) + bbthet_all(m,l,i,j,k,iblock,iparm)= + & bbthet(m,l,i,j,k,iblock) + ccthet_all(m,l,i,j,k,iblock,iparm)= + &ccthet(m,l,i,j,k,iblock) + ddthet_all(m,l,i,j,k,iblock,iparm)= + &ddthet(m,l,i,j,k,iblock) + eethet_all(m,l,i,j,k,iblock,iparm)= + &eethet(m,l,i,j,k,iblock) enddo enddo do l=1,ntheterm3 do m=1,ndouble do mm=1,ndouble - ffthet_all(mm,m,l,i,j,k,iparm)=ffthet(mm,m,l,i,j,k) - ggthet_all(mm,m,l,i,j,k,iparm)=ggthet(mm,m,l,i,j,k) + if (iblock.eq.1) then + ffthet_all1(mm,m,l,i,j,k,iparm)= + & ffthet(mm,m,l,i,j,k,iblock) + ggthet_all1(mm,m,l,i,j,k,iparm)= + &ggthet(mm,m,l,i,j,k,iblock) + else + ffthet_all2(mm,m,l,i,j,k,iparm)= + & ffthet(mm,m,l,i,j,k,iblock) + ggthet_all2(mm,m,l,i,j,k,iparm)= + &ggthet(mm,m,l,i,j,k,iblock) + endif enddo enddo enddo enddo enddo enddo + enddo #endif #ifdef CRYST_SC c Store the sidechain rotamer parameters - do i=1,ntyp - nlob_all(i,iparm)=nlob(i) - do j=1,nlob(i) - bsc_all(j,i,iparm)=bsc(j,i) + do i=-ntyp,ntyp + iii=iabs(i) +cc write (iout,*) i,"storeparm1" + if (i.eq.0) cycle + nlob_all(iii,iparm)=nlob(iii) + do j=1,nlob(iii) + bsc_all(j,iii,iparm)=bsc(j,iii) do k=1,3 censc_all(k,j,i,iparm)=censc(k,j,i) enddo @@ -131,59 +154,86 @@ c Store the sidechain rotamer parameters enddo #endif c Store the torsional parameters - do i=1,ntortyp - do j=1,ntortyp - v0_all(i,j,iparm)=v0(i,j) - nterm_all(i,j,iparm)=nterm(i,j) - nlor_all(i,j,iparm)=nlor(i,j) - do k=1,nterm(i,j) - v1_all(k,i,j,iparm)=v1(k,i,j) - v2_all(k,i,j,iparm)=v2(i,i,j) + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + v0_all(i,j,iblock,iparm)=v0(i,j,iblock) + nterm_all(i,j,iblock,iparm)=nterm(i,j,iblock) + nlor_all(i,j,iblock,iparm)=nlor(i,j,iblock) + do k=1,nterm(i,j,iblock) + v1_all(k,i,j,iblock,iparm)=v1(k,i,j,iblock) + v2_all(k,i,j,iblock,iparm)=v2(k,i,j,iblock) enddo - do k=1,nlor(i,j) + do k=1,nlor(i,j,iblock) vlor1_all(k,i,j,iparm)=vlor1(k,i,j) vlor2_all(k,i,j,iparm)=vlor2(k,i,j) vlor3_all(k,i,j,iparm)=vlor3(k,i,j) enddo enddo + enddo enddo c Store the double torsional parameters - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - ntermd1_all(i,j,k,iparm)=ntermd_1(i,j,k) - ntermd2_all(i,j,k,iparm)=ntermd_2(i,j,k) - do l=1,ntermd_1(i,j,k) - v1c_all(1,l,i,j,k,iparm)=v1c(1,l,i,j,k) - v1c_all(2,l,i,j,k,iparm)=v1c(2,l,i,j,k) - v2c_all(1,l,i,j,k,iparm)=v2c(1,l,i,j,k) - v2c_all(2,l,i,j,k,iparm)=v2c(2,l,i,j,k) + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + ntermd1_all(i,j,k,iblock,iparm)=ntermd_1(i,j,k,iblock) + ntermd2_all(i,j,k,iblock,iparm)=ntermd_2(i,j,k,iblock) + do l=1,ntermd_1(i,j,k,iblock) + v1c_all(1,l,i,j,k,iblock,iparm)=v1c(1,l,i,j,k,iblock) + v1c_all(2,l,i,j,k,iblock,iparm)=v1c(2,l,i,j,k,iblock) + v2c_all(1,l,i,j,k,iblock,iparm)=v2c(1,l,i,j,k,iblock) + v2c_all(2,l,i,j,k,iblock,iparm)=v2c(2,l,i,j,k,iblock) enddo - do l=1,ntermd_2(i,j,k) - do m=1,ntermd_2(i,j,k) - v2s_all(l,m,i,j,k,iparm)=v2s(l,m,i,j,k) + do l=1,ntermd_2(i,j,k,iblock) + do m=1,ntermd_2(i,j,k,iblock) + v2s_all(l,m,i,j,k,iblock,iparm)=v2s(l,m,i,j,k,iblock) enddo enddo enddo enddo enddo + enddo c Store parameters of the cumulants - do i=1,nloctyp +#ifdef NEWCORR + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1_all(ii,j,i,iparm)=bnew1(ii,j,i) + bnew2_all(ii,j,i,iparm)=bnew2(ii,j,i) + enddo + enddo do j=1,2 - b1_all(j,i,iparm)=b1(j,i) - b1tilde_all(j,i,iparm)=b1tilde(j,i) - b2_all(j,i,iparm)=b2(j,i) + do k=1,3 + ccnew_all(k,j,i,iparm)=ccnew(k,j,i) + ddnew_all(k,j,i,iparm)=ddnew(k,j,i) + enddo + enddo + do ii=1,2 + do j=1,2 + do k=1,2 + eenew_all(k,j,ii,i,iparm)=eenew(k,j,ii,i) + enddo + enddo + enddo + do ii=1,2 + e0new_all(ii,i,iparm)=e0new(ii,i) + enddo + enddo +#else + do i=-nloctyp,nloctyp + do j=1,5 + b_all(j,i,iparm)=b(j,i) enddo do j=1,2 do k=1,2 - cc_all(k,j,i,iparm)=cc(k,j,i) - ctilde_all(k,j,i,iparm)=ctilde(k,j,i) - dd_all(k,j,i,iparm)=dd(k,j,i) - dtilde_all(k,j,i,iparm)=dtilde(k,j,i) - ee_all(k,j,i,iparm)=ee(k,j,i) + ccold_all(k,j,i,iparm)=ccold(k,j,i) + ddold_all(k,j,i,iparm)=ddold(k,j,i) + eeold_all(k,j,i,iparm)=eeold(k,j,i) enddo enddo enddo +#endif c Store the parameters of electrostatic interactions do i=1,2 do j=1,2 @@ -196,13 +246,16 @@ c Store the parameters of electrostatic interactions c Store sidechain parameters do i=1,ntyp do j=1,ntyp - aa_all(j,i,iparm)=aa(j,i) - bb_all(j,i,iparm)=bb(j,i) + aa_aq_all(j,i,iparm)=aa_aq(j,i) + bb_aq_all(j,i,iparm)=bb_aq(j,i) + aa_lip_all(j,i,iparm)=aa_lip(j,i) + bb_lip_all(j,i,iparm)=bb_lip(j,i) r0_all(j,i,iparm)=r0(j,i) sigma_all(j,i,iparm)=sigma(j,i) chi_all(j,i,iparm)=chi(j,i) augm_all(j,i,iparm)=augm(j,i) eps_all(j,i,iparm)=eps(j,i) + epslip_all(j,i,iparm)=epslip(j,i) enddo enddo do i=1,ntyp @@ -226,12 +279,17 @@ c Store disulfide-bond parameters v2ss_all(iparm)=v2ss v3ss_all(iparm)=v3ss c Store SC-backbone correlation parameters - nterm_sccor_all(iparm)=nterm_sccor - do i=1,20 - do j=1,20 - do k=1,nterm_sccor - v1sccor_all(k,i,j,iparm)=v1sccor(k,i,j) - v2sccor_all(k,i,j,iparm)=v2sccor(k,i,j) + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + + nterm_sccor_all(j,i,iparm)=nterm_sccor(j,i) +c do i=1,20 +c do j=1,20 + do l=1,3 + do k=1,nterm_sccor(j,i) + v1sccor_all(k,l,j,i,iparm)=v1sccor(k,l,j,i) + v2sccor_all(k,l,j,i,iparm)=v2sccor(k,l,j,i) + enddo enddo enddo enddo @@ -259,7 +317,7 @@ C include 'COMMON.SCROT' include 'COMMON.SCCOR' include 'COMMON.ALLPARM' - integer i,j,k,l,m,mm,iparm + integer i,ii,j,k,l,m,mm,iparm,ichir1,ichir2,iblock,iii c Restore weights wsc=ww_all(1,iparm) @@ -280,6 +338,7 @@ c Restore weights wvdwpp=ww_all(16,iparm) wbond=ww_all(17,iparm) wsccor=ww_all(19,iparm) + wliptran=ww_all(22,iparm) c Restore bond parameters vbldp0=vbldp0_all(iparm) akp=akp_all(iparm) @@ -293,11 +352,15 @@ c Restore bond parameters enddo c Restore bond angle parameters #ifdef CRYST_THETA - do i=1,ntyp + do i=-ntyp,ntyp a0thet(i)=a0thet_all(i,iparm) + do ichir1=-1,1 + do ichir2=-1,1 do j=1,2 - athet(j,i)=athet_all(j,i,iparm) - bthet(j,i)=bthet_all(j,i,iparm) + athet(j,i,ichir1,ichir2)=athet_all(j,i,ichir1,ichir2,iparm) + bthet(j,i,ichir1,ichir2)=bthet_all(j,i,ichir1,ichir2,iparm) + enddo + enddo enddo do j=0,3 polthet(j,i)=polthet_all(j,i,iparm) @@ -317,42 +380,59 @@ c Restore bond angle parameters nsingle=nsingle_all(iparm) ndouble=ndouble_all(iparm) nntheterm=nntheterm_all(iparm) - do i=1,ntyp1 + do i=-ntyp,ntyp ithetyp(i)=ithetyp_all(i,iparm) enddo - do i=1,maxthetyp1 - do j=1,maxthetyp1 - do k=1,maxthetyp1 - aa0thet(i,j,k)=aa0thet_all(i,j,k,iparm) + do iblock=1,2 + do i=-maxthetyp1,maxthetyp1 + do j=-maxthetyp1,maxthetyp1 + do k=-maxthetyp1,maxthetyp1 + aa0thet(i,j,k,iblock)=aa0thet_all(i,j,k,iblock,iparm) do l=1,ntheterm - aathet(l,i,j,k)=aathet_all(l,i,j,k,iparm) + aathet(l,i,j,k,iblock)=aathet_all(l,i,j,k,iblock,iparm) enddo do l=1,ntheterm2 do m=1,nsingle - bbthet(m,l,i,j,k)=bbthet_all(m,l,i,j,k,iparm) - ccthet(m,l,i,j,k)=ccthet_all(m,l,i,j,k,iparm) - ddthet(m,l,i,j,k)=ddthet_all(m,l,i,j,k,iparm) - eethet(m,l,i,j,k)=eethet_all(m,l,i,j,k,iparm) + bbthet(m,l,i,j,k,iblock)= + &bbthet_all(m,l,i,j,k,iblock,iparm) + ccthet(m,l,i,j,k,iblock)= + &ccthet_all(m,l,i,j,k,iblock,iparm) + ddthet(m,l,i,j,k,iblock)= + &ddthet_all(m,l,i,j,k,iblock,iparm) + eethet(m,l,i,j,k,iblock)= + &eethet_all(m,l,i,j,k,iblock,iparm) enddo enddo do l=1,ntheterm3 do m=1,ndouble do mm=1,ndouble - ffthet(mm,m,l,i,j,k)=ffthet_all(mm,m,l,i,j,k,iparm) - ggthet(mm,m,l,i,j,k)=ggthet_all(mm,m,l,i,j,k,iparm) + if (iblock.eq.1) then + ffthet(mm,m,l,i,j,k,iblock)= + &ffthet_all1(mm,m,l,i,j,k,iparm) + ggthet(mm,m,l,i,j,k,iblock)= + &ggthet_all1(mm,m,l,i,j,k,iparm) + else + ffthet(mm,m,l,i,j,k,iblock)= + &ffthet_all2(mm,m,l,i,j,k,iparm) + ggthet(mm,m,l,i,j,k,iblock)= + &ggthet_all2(mm,m,l,i,j,k,iparm) + endif enddo enddo enddo enddo enddo enddo + enddo #endif c Restore the sidechain rotamer parameters #ifdef CRYST_SC - do i=1,ntyp - nlob(i)=nlob_all(i,iparm) - do j=1,nlob(i) - bsc(j,i)=bsc_all(j,i,iparm) + do i=-ntyp,ntyp + if (i.eq.0) cycle + iii=iabs(i) + nlob(iii)=nlob_all(iii,iparm) + do j=1,nlob(iii) + bsc(j,iii)=bsc_all(j,iii,iparm) do k=1,3 censc(k,j,i)=censc_all(k,j,i,iparm) enddo @@ -371,59 +451,86 @@ c Restore the sidechain rotamer parameters enddo #endif c Restore the torsional parameters - do i=1,ntortyp - do j=1,ntortyp - v0(i,j)=v0_all(i,j,iparm) - nterm(i,j)=nterm_all(i,j,iparm) - nlor(i,j)=nlor_all(i,j,iparm) - do k=1,nterm(i,j) - v1(k,i,j)=v1_all(k,i,j,iparm) - v2(i,i,j)=v2_all(k,i,j,iparm) + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + v0(i,j,iblock)=v0_all(i,j,iblock,iparm) + nterm(i,j,iblock)=nterm_all(i,j,iblock,iparm) + nlor(i,j,iblock)=nlor_all(i,j,iblock,iparm) + do k=1,nterm(i,j,iblock) + v1(k,i,j,iblock)=v1_all(k,i,j,iblock,iparm) + v2(k,i,j,iblock)=v2_all(k,i,j,iblock,iparm) enddo - do k=1,nlor(i,j) + do k=1,nlor(i,j,iblock) vlor1(k,i,j)=vlor1_all(k,i,j,iparm) vlor2(k,i,j)=vlor2_all(k,i,j,iparm) vlor3(k,i,j)=vlor3_all(k,i,j,iparm) enddo enddo enddo + enddo c Restore the double torsional parameters - do i=1,ntortyp - do j=1,ntortyp - do k=1,ntortyp - ntermd_1(i,j,k)=ntermd1_all(i,j,k,iparm) - ntermd_2(i,j,k)=ntermd2_all(i,j,k,iparm) - do l=1,ntermd_1(i,j,k) - v1c(1,l,i,j,k)=v1c_all(1,l,i,j,k,iparm) - v1c(2,l,i,j,k)=v1c_all(2,l,i,j,k,iparm) - v2c(1,l,i,j,k)=v2c_all(1,l,i,j,k,iparm) - v2c(2,l,i,j,k)=v2c_all(2,l,i,j,k,iparm) + do iblock=1,2 + do i=-ntortyp+1,ntortyp-1 + do j=-ntortyp+1,ntortyp-1 + do k=-ntortyp+1,ntortyp-1 + ntermd_1(i,j,k,iblock)=ntermd1_all(i,j,k,iblock,iparm) + ntermd_2(i,j,k,iblock)=ntermd2_all(i,j,k,iblock,iparm) + do l=1,ntermd_1(i,j,k,iblock) + v1c(1,l,i,j,k,iblock)=v1c_all(1,l,i,j,k,iblock,iparm) + v1c(2,l,i,j,k,iblock)=v1c_all(2,l,i,j,k,iblock,iparm) + v2c(1,l,i,j,k,iblock)=v2c_all(1,l,i,j,k,iblock,iparm) + v2c(2,l,i,j,k,iblock)=v2c_all(2,l,i,j,k,iblock,iparm) enddo - do l=1,ntermd_2(i,j,k) - do m=1,ntermd_2(i,j,k) - v2s(l,m,i,j,k)=v2s_all(l,m,i,j,k,iparm) + do l=1,ntermd_2(i,j,k,iblock) + do m=1,ntermd_2(i,j,k,iblock) + v2s(l,m,i,j,k,iblock)=v2s_all(l,m,i,j,k,iblock,iparm) enddo enddo enddo enddo enddo + enddo c Restore parameters of the cumulants - do i=1,nloctyp +#ifdef NEWCORR + do i=-nloctyp+1,nloctyp-1 + do ii=1,3 + do j=1,2 + bnew1(ii,j,i)=bnew1_all(ii,j,i,iparm) + bnew2(ii,j,i)=bnew2_all(ii,j,i,iparm) + enddo + enddo do j=1,2 - b1(j,i)=b1_all(j,i,iparm) - b1tilde(j,i)=b1tilde_all(j,i,iparm) - b2(j,i)=b2_all(j,i,iparm) + do k=1,3 + ccnew(k,j,i)=ccnew_all(k,j,i,iparm) + ddnew(k,j,i)=ddnew_all(k,j,i,iparm) + enddo + enddo + do ii=1,2 + do j=1,2 + do k=1,2 + eenew(k,j,ii,i)=eenew_all(k,j,ii,i,iparm) + enddo + enddo + enddo + do ii=1,2 + e0new(ii,i)=e0new_all(ii,i,iparm) + enddo + enddo +#else + do i=-nloctyp,nloctyp + do j=1,5 + b(j,i)=b_all(j,i,iparm) enddo do j=1,2 do k=1,2 - cc(k,j,i)=cc_all(k,j,i,iparm) - ctilde(k,j,i)=ctilde_all(k,j,i,iparm) - dd(k,j,i)=dd_all(k,j,i,iparm) - dtilde(k,j,i)=dtilde_all(k,j,i,iparm) - ee(k,j,i)=ee_all(k,j,i,iparm) + ccold(k,j,i)=ccold_all(k,j,i,iparm) + ddold(k,j,i)=ddold_all(k,j,i,iparm) + eeold(k,j,i)=eeold_all(k,j,i,iparm) enddo enddo enddo +#endif c Restore the parameters of electrostatic interactions do i=1,2 do j=1,2 @@ -436,13 +543,16 @@ c Restore the parameters of electrostatic interactions c Restore sidechain parameters do i=1,ntyp do j=1,ntyp - aa(j,i)=aa_all(j,i,iparm) - bb(j,i)=bb_all(j,i,iparm) + aa_aq(j,i)=aa_aq_all(j,i,iparm) + bb_aq(j,i)=bb_aq_all(j,i,iparm) + aa_lip(j,i)=aa_lip_all(j,i,iparm) + bb_lip(j,i)=bb_lip_all(j,i,iparm) r0(j,i)=r0_all(j,i,iparm) sigma(j,i)=sigma_all(j,i,iparm) chi(j,i)=chi_all(j,i,iparm) augm(j,i)=augm_all(j,i,iparm) eps(j,i)=eps_all(j,i,iparm) + epslip(j,i)=epslip_all(j,i,iparm) enddo enddo do i=1,ntyp @@ -466,12 +576,15 @@ c Restore disulfide-bond parameters v2ss=v2ss_all(iparm) v3ss=v3ss_all(iparm) c Restore SC-backbone correlation parameters - nterm_sccor=nterm_sccor_all(iparm) - do i=1,20 - do j=1,20 - do k=1,nterm_sccor - v1sccor(k,i,j)=v1sccor_all(k,i,j,iparm) - v2sccor(k,i,j)=v2sccor_all(k,i,j,iparm) + do i=-nsccortyp,nsccortyp + do j=-nsccortyp,nsccortyp + + nterm_sccor(j,i)=nterm_sccor_all(j,i,iparm) + do l=1,3 + do k=1,nterm_sccor(j,i) + v1sccor(k,l,j,i)=v1sccor_all(k,l,j,i,iparm) + v2sccor(k,l,j,i)=v2sccor_all(k,l,j,i,iparm) + enddo enddo enddo enddo diff --git a/source/wham/src-M/timing.F b/source/wham/src-M/timing.F index 1012457..de9d5ca 100644 --- a/source/wham/src-M/timing.F +++ b/source/wham/src-M/timing.F @@ -8,6 +8,9 @@ c implicit none double precision tcpu include 'COMMON.TIME1' +#ifdef MP + include 'mpif.h' +#endif C Diminish the assigned time limit a little so that there is some time to C end a batch job c timlim=batime-150.0 @@ -18,47 +21,114 @@ cd print *,' in SET_TIMERS stime=',stime end C------------------------------------------------------------------------------ logical function stopx(nf) -C This function returns .true. in case of time up on the master node. - implicit none +C This function returns .true. if one of the following reasons to exit SUMSL +C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block: +C +C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false. +C... 1 - Time up in current node; +C... 2 - STOP signal was received from another node because the +C... node's task was accomplished (parallel only); +C... -1 - STOP signal was received from another node because of error; +C... -2 - STOP signal was received from another node, because +C... the node's time was up. + implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' integer nf logical ovrtim -#ifdef MPI +#ifdef MP include 'mpif.h' - include 'COMMON.MPI' + include 'COMMON.INFO' #endif include 'COMMON.IOUNITS' include 'COMMON.TIME1' + integer Kwita + +cd print *,'Processor',MyID,' NF=',nf +#ifndef MPI if (ovrtim()) then C Finish if time is up. stopx = .true. WhatsUp=1 - else if (cutoffviol) then - stopx = .true. - WhatsUp=2 +#ifdef MPL + else if (mod(nf,100).eq.0) then +C Other processors might have finished. Check this every 100th function +C evaluation. +C Master checks if any other processor has sent accepted conformation(s) to it. + if (MyID.ne.MasterID) call receive_mcm_info + if (MyID.eq.MasterID) call receive_conf +cd print *,'Processor ',MyID,' is checking STOP: nf=',nf + call recv_stop_sig(Kwita) + if (Kwita.eq.-1) then + write (iout,'(a,i4,a,i5)') 'Processor', + & MyID,' has received STOP signal in STOPX; NF=',nf + write (*,'(a,i4,a,i5)') 'Processor', + & MyID,' has received STOP signal in STOPX; NF=',nf + stopx=.true. + WhatsUp=2 + elseif (Kwita.eq.-2) then + write (iout,*) + & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' + write (*,*) + & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.' + WhatsUp=-2 + stopx=.true. + else if (Kwita.eq.-3) then + write (iout,*) + & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' + write (*,*) + & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.' + WhatsUp=-1 + stopx=.true. + else + stopx=.false. + WhatsUp=0 + endif +#endif else - stopx=.false. + stopx = .false. + WhatsUp=0 endif +#else + stopx=.false. +#endif + +#ifdef OSF +c Check for FOUND_NAN flag + if (FOUND_NAN) then + write(iout,*)" *** stopx : Found a NaN" + stopx=.true. + endif +#endif + return end C-------------------------------------------------------------------------- logical function ovrtim() - implicit none + include 'DIMENSIONS' + include 'COMMON.IOUNITS' include 'COMMON.TIME1' - real*8 tcpu,curtim + real*8 tcpu +#ifdef MPI + include "mpif.h" + curtim = MPI_Wtime()-walltime +#else curtim= tcpu() -c print *,'curtim=',curtim,' timlim=',timlim +#endif C curtim is the current time in seconds. -c ovrtim=(curtim .ge. timlim - safety ) -c ovrtim does not work sometimes and crashes the program ! CHUUUJ ! -c setting always to false - ovrtim=.false. +c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety + if (curtim .ge. timlim - safety) then + write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') + & "***************** Elapsed time (",curtim, + & " s) is within the safety limit (",safety, + & " s) of the allocated time (",timlim," s). Terminating." + ovrtim=.true. + else + ovrtim=.false. + endif return end ************************************************************************** double precision function tcpu() - implicit none include 'COMMON.TIME1' #ifdef ES9000 **************************** @@ -89,7 +159,7 @@ C return the elapsed time in seconds #ifdef SGI **************************** C Next definitions for sgi - real timar(2), etime, seconds + real timar(2), etime seconds = etime(timar) Cd print *,'seconds=',seconds,' stime=',stime C usrsec = timar(1) @@ -101,7 +171,7 @@ C syssec = timar(2) #ifdef LINUX **************************** C Next definitions for sgi - real timar(2), etime, seconds + real timar(2), etime seconds = etime(timar) Cd print *,'seconds=',seconds,' stime=',stime C usrsec = timar(1) @@ -129,7 +199,14 @@ C Next definitions for RS6000 i1 = mclock() tcpu = (i1+0.0D0)/100.0D0 #endif -#ifdef WIN +#ifdef WINPGI +**************************** +c next definitions for windows NT Digital fortran + real time_real + call cpu_time(time_real) + tcpu = time_real +#endif +#ifdef WINIFL **************************** c next definitions for windows NT Digital fortran real time_real @@ -141,9 +218,7 @@ c next definitions for windows NT Digital fortran end C--------------------------------------------------------------------------- subroutine dajczas(rntime,hrtime,mintime,sectime) - implicit none include 'COMMON.IOUNITS' - integer ihr,imn,isc real*8 rntime,hrtime,mintime,sectime hrtime=rntime/3600.0D0 hrtime=aint(hrtime) diff --git a/source/wham/src-M/wham_calc1.F b/source/wham/src-M/wham_calc1.F index 15d6716..35a9278 100644 --- a/source/wham/src-M/wham_calc1.F +++ b/source/wham/src-M/wham_calc1.F @@ -18,9 +18,8 @@ parameter (NGridT=400) integer MaxBinRms,MaxBinRgy parameter (MaxBinRms=100,MaxBinRgy=100) - integer MaxHdim -c parameter (MaxHdim=200000) - parameter (MaxHdim=200) +c integer MaxHdim +c parameter (MaxHdim=200) integer maxinde parameter (maxinde=200) #ifdef MPI @@ -36,6 +35,7 @@ c parameter (MaxHdim=200000) include "COMMON.SBRIDGE" include "COMMON.PROT" include "COMMON.ENEPS" + include "COMMON.SHIELD" integer MaxPoint,MaxPointProc parameter (MaxPoint=MaxStr, & MaxPointProc=MaxStr_Proc) @@ -50,7 +50,8 @@ c parameter (MaxHdim=200000) double precision energia(0:max_ene) #ifdef MPI integer tmax_t,upindE_p - double precision fi_p(MaxR,MaxT_h,Max_Parm) + double precision fi_p(MaxR,MaxT_h,Max_Parm), + & fimax_p(MaxR,MaxT_h,Max_Parm) double precision sumW_p(0:nGridT,Max_Parm), & sumE_p(0:nGridT,Max_Parm),sumEsq_p(0:nGridT,Max_Parm), & sumQ_p(MaxQ1,0:nGridT,Max_Parm), @@ -63,6 +64,8 @@ c parameter (MaxHdim=200000) & hrmsrgy_p(0:MaxBinRgy,0:MaxBinRms,maxT_h) double precision rgymin_t,rmsmin_t,rgymax_t,rmsmax_t double precision potEmin_t,entmin_p,entmax_p + double precision ePMF,ePMF_q + double precision weimax_(0:ngridT) integer histent_p(0:2000) logical lprint /.true./ #endif @@ -74,17 +77,19 @@ c parameter (MaxHdim=200000) & sumEprim(0:NGridT,Max_Parm),sumEbis(0:NGridT,Max_Parm),betaT, & weight,econstr double precision fi(MaxR,maxT_h,Max_Parm), + & fimax(MaxR,maxT_h,Max_Parm), & dd,dd1,dd2,hh,dmin,denom,finorm,avefi,pom, & hfin(0:MaxHdim,maxT_h),histE(0:maxindE), & hrmsrgy(0:MaxBinRgy,0:MaxBinRms,maxT_h), & potEmin,ent, - & hfin_ent(0:MaxHdim),vmax,aux + & hfin_ent(0:MaxHdim),vmax,aux,weimax(0:nGridT,Max_Parm) double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl, & eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/,startGridT/200.0d0/, & eplus,eminus,logfac,tanhT,tt double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, & escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, - & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor + & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor, + & eliptran integer ind_point(maxpoint),upindE,indE character*16 plik @@ -112,11 +117,13 @@ c parameter (MaxHdim=200000) do t=0,MaxN htot(t)=0 enddo +C#define DEBUG #ifdef MPI do i=1,scount(me1) #else do i=1,ntot(islice) #endif +c write (iout,*) "i",i," potE",(potE(i,j),j=1,nParmset) do j=1,nParmSet if (potE(i,j).le.potEmin) potEmin=potE(i,j) enddo @@ -134,7 +141,7 @@ c parameter (MaxHdim=200000) endif c write (iout,*) "i",i," j",j," q",q(j,i)," ind_point", c & ind_point(i) - call flush(iout) +c call flush(iout) if (ind_point(i).lt.0 .or. ind_point(i).gt.MaxHdim) then write (iout,*) "Error - index exceeds range for point",i, & " q=",q(j,i)," ind",ind_point(i) @@ -154,8 +161,8 @@ c & ind_point(i) call flush(iout) #endif enddo ! i - call flush(iout) + write (iout,*) "potEmin before reduce",potEmin nbin=nbin1**nQ-1 write (iout,'(a)') "Numbers of counts in Q bins" do t=0,tmax @@ -194,7 +201,8 @@ c & ind_point(i) & MPI_MIN,WHAM_COMM,IERROR) call MPI_AllReduce(rgymax,rgymax_t,1,MPI_DOUBLE_PRECISION, & MPI_MAX,WHAM_COMM,IERROR) - potEmin=potEmin_t/2 +c potEmin=potEmin_t/2 + potEmin=potEmin_t rgymin=rgymin_t rgymax=rgymax_t rmsmin=rmsmin_t @@ -227,7 +235,7 @@ c write (9,'(3i5,f10.5)') i,(iparm,potE(i,iparm),iparm=1,nParmSet) do iparm=1,nParmSet #ifdef DEBUG write (iout,'(2i5,21f8.2)') i,iparm, - & (enetb(k,i,iparm),k=1,21) + & (enetb(k,i,iparm),k=1,22) #endif call restore_parm(iparm) #ifdef DEBUG @@ -312,6 +320,8 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft estr=enetb(18,i,iparm) esccor=enetb(19,i,iparm) edihcnstr=enetb(20,i,iparm) + eliptran=enetb(22,i,iparm) + #ifdef DEBUG write (iout,'(3i5,6f5.2,14f12.3)') i,ib,iparm,(ft(l),l=1,6), & evdw+evdw_t,evdw2,ees,evdw1,ecorr,eel_loc,estr,ebe,escloc, @@ -319,30 +329,61 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft #endif #ifdef SPLITELE + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*ees + & +ft(1)*wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +! & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+wliptran*eliptran + endif #else + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr + & +wbond*estr+wliptran*eliptran + endif + #endif #ifdef DEBUG write (iout,*) i,iparm,1.0d0/(beta_h(ib,iparm)*1.987D-3), & etot,potEmin #endif +#define DEBUG #ifdef DEBUG if (iparm.eq.1 .and. ib.eq.1) then write (iout,*)"Conformation",i @@ -353,6 +394,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft call enerprint(energia(0),fT) endif #endif +#undef DEBUG do kk=1,nR(ib,iparm) Econstr=0.0d0 do j=1,nQ @@ -360,6 +402,11 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft Econstr=Econstr+Kh(j,kk,ib,iparm) & *(dd-q0(j,kk,ib,iparm))**2 enddo +c Adaptive potential contribution + if (adaptive) then + call PMF_energy(q(1,i),ib,kk,iparm,ePMF,ePMF_q) + Econstr=Econstr+ePMF + endif v(i,kk,ib,iparm)= & -beta_h(ib,iparm)*(etot-potEmin+Econstr) #ifdef DEBUG @@ -406,6 +453,31 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft write (iout,*) t,"vmax",vmax," denom",denom,"entfac",entfac(t) #endif enddo + + do iparm=1,nParmSet + do iib=1,nT_h(iparm) + do ii=1,nR(iib,iparm) +#ifdef MPI + fimax_p(ii,iib,iparm)=v(1,ii,iib,iparm)+entfac(1) + do t=2,scount(me) + if(v(t,ii,iib,iparm)+entfac(t).gt.fimax_p(ii,iib,iparm)) + & fimax_p(ii,iib,iparm)=v(t,ii,iib,iparm)+entfac(t) + enddo +#else + fimax(ii,iib,iparm)=v(1,ii,iib,iparm)+entfac(1) + do t=2,ntot(islice) + if(v(t,ii,iib,iparm)+entfac(t).gt.fimax(ii,iib,iparm)) + & fimax(ii,iib,iparm)=v(t,ii,iib,iparm)+entfac(t) + enddo +#endif + enddo ! ii + enddo ! iib + enddo ! iparm +#ifdef MPI + call MPI_AllReduce(fimax_p(1,1,1),fimax(1,1,1), + & maxR*MaxT_h*nParmSet,MPI_DOUBLE_PRECISION, + & MPI_MAX,WHAM_COMM,IERROR) +#endif do iparm=1,nParmSet do iib=1,nT_h(iparm) do ii=1,nR(iib,iparm) @@ -413,7 +485,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft fi_p(ii,iib,iparm)=0.0d0 do t=1,scount(me) fi_p(ii,iib,iparm)=fi_p(ii,iib,iparm) - & +dexp(v(t,ii,iib,iparm)+entfac(t)) + & +dexp(v(t,ii,iib,iparm)+entfac(t)-fimax(ii,iib,iparm)) #ifdef DEBUG write (iout,'(4i5,3e15.5)') t,ii,iib,iparm, & v(t,ii,iib,iparm),entfac(t),fi_p(ii,iib,iparm) @@ -423,7 +495,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft fi(ii,iib,iparm)=0.0d0 do t=1,ntot(islice) fi(ii,iib,iparm)=fi(ii,iib,iparm) - & +dexp(v(t,ii,iib,iparm)+entfac(t)) + & +dexp(v(t,ii,iib,iparm)+entfac(t)-fimax(ii,iib,iparm)) enddo #endif enddo ! ii @@ -441,10 +513,10 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft enddo enddo #endif - write (iout,*) "REDUCE size",maxR,MaxT_h,nParmSet, - & maxR*MaxT_h*nParmSet - write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD, - & " WHAM_COMM",WHAM_COMM +c write (iout,*) "REDUCE size",maxR,MaxT_h,nParmSet, +c & maxR*MaxT_h*nParmSet +c write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD, +c & " WHAM_COMM",WHAM_COMM call MPI_Reduce(fi_p(1,1,1),fi(1,1,1),maxR*MaxT_h*nParmSet, & MPI_DOUBLE_PRECISION, & MPI_SUM,Master,WHAM_COMM,IERROR) @@ -464,7 +536,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft do iparm=1,nParmSet do ib=1,nT_h(iparm) do i=1,nR(ib,iparm) - fi(i,ib,iparm)=-dlog(fi(i,ib,iparm)) + fi(i,ib,iparm)=-dlog(fi(i,ib,iparm))-fimax(i,ib,iparm) avefi=avefi+fi(i,ib,iparm) enddo enddo @@ -607,12 +679,12 @@ c ient=-dlog(entfac(t))-entmin write(iout,'(2f15.4)') entmin+i,histent(i) enddo #endif - -#ifdef MPI -c write (iout,*) "me1",me1," scount",scount(me1) - do iparm=1,nParmSet + call restore_parm(iparm) +c +C Histograms +c #ifdef MPI do ib=1,nT_h(iparm) do t=0,tmax @@ -642,182 +714,102 @@ c write (iout,*) "me1",me1," scount",scount(me1) enddo enddo enddo - +#ifdef MPI do t=1,scount(me1) #else do t=1,ntot(islice) #endif - ind = ind_point(t) + indE = aint(potE(t,iparm)-aint(potEmin)) + if (indE.ge.0 .and. indE.le.maxinde) then + if (indE.gt.upindE_p) upindE_p=indE + histE_p(indE)=histE_p(indE)+dexp(-entfac(t)) + endif #ifdef MPI - hfin_ent_p(ind)=hfin_ent_p(ind)+dexp(entfac(t)) + do ib=1,nT_h(iparm) + expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) + hfin_p(ind,ib)=hfin_p(ind,ib)+ + & dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) + if (rmsrgymap) then + indrgy=dint((q(nQ+2,t)-rgymin)/deltrgy) + indrms=dint((q(nQ+1,t)-rmsmin)/deltrms) + hrmsrgy_p(indrgy,indrms,ib)= + & hrmsrgy_p(indrgy,indrms,ib)+expfac + endif + enddo #else - hfin_ent(ind)=hfin_ent(ind)+dexp(entfac(t)) + do ib=1,nT_h(iparm) + expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) + hfin(ind,ib)=hfin(ind,ib)+ + & dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) + if (rmsrgymap) then + indrgy=dint((q(nQ+2,t)-rgymin)/deltrgy) + indrms=dint((q(nQ+1,t)-rmsmin)/deltrms) + hrmsrgy(indrgy,indrms,ib)= + & hrmsrgy(indrgy,indrms,ib)+expfac + endif + enddo #endif -c write (iout,'(2i5,20f8.2)') t,t,(enetb(k,t,iparm),k=1,18) - call restore_parm(iparm) - evdw=enetb(21,t,iparm) - evdw_t=enetb(1,t,iparm) -#ifdef SCP14 - evdw2_14=enetb(17,t,iparm) - evdw2=enetb(2,t,iparm)+evdw2_14 + enddo ! t +c +c Thermo and ensemble averages +c + do k=0,nGridT + betaT=startGridT+k*delta_T + call temp_scalfac(betaT,ft,ftprim,ftbis,*10) +c write (iout,*) "ftprim",ftprim +c write (iout,*) "ftbis",ftbis + betaT=1.0d0/(1.987D-3*betaT) +c 7/10/18 AL Determine the max Botzmann weights for each temerature + call sum_ene(1,iparm,ft,etot) + weimax(k,iparm)=-betaT*(etot-potEmin)+entfac(1) +c write (iout,*) "k",k," t",1," weight",weimax(k,iparm) +#ifdef MPI + do t=2,scount(me1) #else - evdw2=enetb(2,t,iparm) - evdw2_14=0.0d0 + do t=2,ntot(islice) #endif -#ifdef SPLITELE - ees=enetb(3,t,iparm) - evdw1=enetb(16,t,iparm) -#else - ees=enetb(3,t,iparm) - evdw1=0.0d0 + call sum_ene(t,iparm,ft,etot) + weight=-betaT*(etot-potEmin)+entfac(t) +c write (iout,*) "k",k," t",t," weight",weight + if (weight.gt.weimax(k,iparm)) weimax(k,iparm)=weight + enddo +#ifdef MPI + enddo +#ifdef DEBUG + write (iout,*) "weimax before REDUCE" + write (iout,*) (weimax(k,iparm),k=0,ngridt) #endif - ecorr=enetb(4,t,iparm) - ecorr5=enetb(5,t,iparm) - ecorr6=enetb(6,t,iparm) - eel_loc=enetb(7,t,iparm) - eello_turn3=enetb(8,t,iparm) - eello_turn4=enetb(9,t,iparm) - eturn6=enetb(10,t,iparm) - ebe=enetb(11,t,iparm) - escloc=enetb(12,t,iparm) - etors=enetb(13,t,iparm) - etors_d=enetb(14,t,iparm) - ehpb=enetb(15,t,iparm) - estr=enetb(18,t,iparm) - esccor=enetb(19,t,iparm) - edihcnstr=enetb(20,t,iparm) - edihcnstr=0.0d0 - do k=0,nGridT - betaT=startGridT+k*delta_T - temper=betaT -c fT=T0/betaT -c ft=2*T0/(T0+betaT) - if (rescale_mode.eq.1) then - quot=betaT/T0 - quotl=1.0d0 - kfacl=1.0d0 - do l=1,5 - quotl1=quotl - quotl=quotl*quot - kfacl=kfacl*kfac - denom=kfacl-1.0d0+quotl - fT(l)=kfacl/denom - ftprim(l)=-l*ft(l)*quotl1/(T0*denom) - ftbis(l)=l*kfacl*quotl1* - & (2*l*quotl-(l-1)*denom)/(quot*t0*t0*denom**3) - enddo -#if defined(FUNCTH) - ft(6)=(320.0d0+80.0d0*dtanh((betaT-320.0d0)/80.0d0))/ - & 320.0d0 - ftprim(6)=1.0d0/(320.0d0*dcosh((betaT-320.0d0)/80.0d0)**2) - ftbis(6)=-2.0d0*dtanh((betaT-320.0d0)/80.0d0) - & /(320.0d0*80.0d0*dcosh((betaT-320.0d0)/80.0d0)**3) -#elif defined(FUNCT) - fT(6)=betaT/T0 - ftprim(6)=1.0d0/T0 - ftbis(6)=0.0d0 -#else - fT(6)=1.0d0 - ftprim(6)=0.0d0 - ftbis(6)=0.0d0 + do k=0,nGridT + weimax_(k)=weimax(k,iparm) + enddo + call MPI_Allreduce(weimax_(0),weimax(0,iparm),nGridT+1, + & MPI_DOUBLE_PRECISION,MPI_MAX,WHAM_COMM,IERROR) +#ifdef DEBUG + write (iout,*) "weimax" + write (iout,*) (weimax(k,iparm),k=0,ngridt) #endif - else if (rescale_mode.eq.2) then - quot=betaT/T0 - quotl=1.0d0 - do l=1,5 - quotl1=quotl - quotl=quotl*quot - eplus=dexp(quotl) - eminus=dexp(-quotl) - logfac=1.0d0/dlog(eplus+eminus) - tanhT=(eplus-eminus)/(eplus+eminus) - fT(l)=1.12692801104297249644d0*logfac - ftprim(l)=-l*quotl1*ft(l)*tanhT*logfac/T0 - ftbis(l)=(l-1)*ftprim(l)/(quot*T0)- - & 2*l*quotl1/T0*logfac* - & (2*l*quotl1*ft(l)/(T0*(eplus+eminus)**2) - & +ftprim(l)*tanhT) - enddo -#if defined(FUNCTH) - ft(6)=(320.0d0+80.0d0*dtanh((betaT-320.0d0)/80.0d0))/ - & 320.0d0 - ftprim(6)=1.0d0/(320.0d0*dcosh((betaT-320.0d0)/80.0d0)**2) - ftbis(6)=-2.0d0*dtanh((betaT-320.0d0)/80.0d0) - & /(320.0d0*80.0d0*dcosh((betaT-320.0d0)/80.0d0)**3) -#elif defined(FUNCT) - fT(6)=betaT/T0 - ftprim(6)=1.0d0/T0 - ftbis(6)=0.0d0 + do k=0,nGridT + temper=startGridT+k*delta_T + betaT=1.0d0/(1.987D-3*temper) + call temp_scalfac(temper,ft,ftprim,ftbis,*10) + do t=1,scount(me1) #else - fT(6)=1.0d0 - ftprim(6)=0.0d0 - ftbis(6)=0.0d0 + do t=1,ntot(islice) #endif - else if (rescale_mode.eq.0) then - do l=1,5 - fT(l)=1.0d0 - ftprim(l)=0.0d0 - enddo - else - write (iout,*) "Error in WHAM_CALC: wrong RESCALE_MODE", - & rescale_mode - call flush(iout) - return1 - endif -c write (iout,*) "ftprim",ftprim -c write (iout,*) "ftbis",ftbis - betaT=1.0d0/(1.987D-3*betaT) -#ifdef SPLITELE - etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees - & +wvdwpp*evdw1 - & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 - & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 - & +ft(2)*wturn3*eello_turn3 - & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc - & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr - eprim=ftprim(6)*evdw_t+ftprim(1)*welec*ees - & +ftprim(1)*wtor*etors+ - & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ - & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ - & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ - & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ - & ftprim(1)*wsccor*esccor - ebis=ftbis(1)*welec*ees+ftbis(1)*wtor*etors+ - & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ - & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ - & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ - & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ - & ftbis(1)*wsccor*esccor + ind = ind_point(t) +#ifdef MPI + hfin_ent_p(ind)=hfin_ent_p(ind)+dexp(entfac(t)) #else - etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 - & +ft(1)*welec*(ees+evdw1) - & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 - & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 - & +ft(2)*wturn3*eello_turn3 - & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr - & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor - & +wbond*estr - eprim=ftprim(6)*evdw_t+ftprim(1)*welec*(ees+evdw1) - & +ftprim(1)*wtor*etors+ - & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ - & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ - & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ - & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ - & ftprim(1)*wsccor*esccor - ebis=ftbis(1)*welec*(ees+evdw1)+ftbis(1)*wtor*etors+ - & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ - & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ - & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ - & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ - & ftprim(1)*wsccor*esccor + hfin_ent(ind)=hfin_ent(ind)+dexp(entfac(t)) #endif - weight=dexp(-betaT*(etot-potEmin)+entfac(t)) +c write (iout,'(2i5,20f8.2)') t,t,(enetb(k,t,iparm),k=1,18) +c call restore_parm(iparm) + call sum_ene_deriv(t,iparm,ft,ftprim,ftbis,etot,eprim,ebis) + weight=dexp(-betaT*(etot-potEmin)+entfac(t)-weimax(k,iparm)) #ifdef DEBUG write (iout,*) "iparm",iparm," t",t," betaT",betaT, - & " etot",etot," entfac",entfac(t), + & " etot",etot," entfac",entfac(t)," boltz", + & -betaT*(etot-potEmin)+entfac(t)," weimax",weimax(k,iparm), & " weight",weight," ebis",ebis #endif etot=etot-temper*eprim @@ -844,38 +836,8 @@ c write (iout,*) "ftbis",ftbis & +etot*q(j,t)*weight enddo #endif - enddo - indE = aint(potE(t,iparm)-aint(potEmin)) - if (indE.ge.0 .and. indE.le.maxinde) then - if (indE.gt.upindE_p) upindE_p=indE - histE_p(indE)=histE_p(indE)+dexp(-entfac(t)) - endif -#ifdef MPI - do ib=1,nT_h(iparm) - expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) - hfin_p(ind,ib)=hfin_p(ind,ib)+ - & dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) - if (rmsrgymap) then - indrgy=dint((q(nQ+2,t)-rgymin)/deltrgy) - indrms=dint((q(nQ+1,t)-rmsmin)/deltrms) - hrmsrgy_p(indrgy,indrms,ib)= - & hrmsrgy_p(indrgy,indrms,ib)+expfac - endif - enddo -#else - do ib=1,nT_h(iparm) - expfac=dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) - hfin(ind,ib)=hfin(ind,ib)+ - & dexp(-beta_h(ib,iparm)*(etot-potEmin)+entfac(t)) - if (rmsrgymap) then - indrgy=dint((q(nQ+2,t)-rgymin)/deltrgy) - indrms=dint((q(nQ+1,t)-rmsmin)/deltrms) - hrmsrgy(indrgy,indrms,ib)= - & hrmsrgy(indrgy,indrms,ib)+expfac - endif - enddo -#endif - enddo ! t + enddo ! t + enddo ! k do ib=1,nT_h(iparm) if (histout) call MPI_Reduce(hfin_p(0,ib),hfin(0,ib),nbin, & MPI_DOUBLE_PRECISION,MPI_SUM,Master,WHAM_COMM,IERROR) @@ -1094,7 +1056,7 @@ c write (iout,*) "ftbis",ftbis sumEQ(j,i,iparm)=sumEQ(j,i,iparm)/sumW(i,iparm) & -sumQ(j,i,iparm)*sumE(i,iparm) enddo - sumW(i,iparm)=-dlog(sumW(i,iparm))*(1.987D-3* + sumW(i,iparm)=(-dlog(sumW(i,iparm))-weimax(i,iparm))*(1.987D-3* & (startGridT+i*delta_T))+potEmin write (iout,'(f7.1,2f15.5,$)') startGridT+i*delta_T, & sumW(i,iparm),sumE(i,iparm) @@ -1190,5 +1152,359 @@ c write (iout,*) "ftbis",ftbis #endif return - +C#undef DEBUG + 10 return1 + end +c------------------------------------------------------------------------ + subroutine temp_scalfac(betaT,ft,ftprim,ftbis,*) + implicit none + include "DIMENSIONS" + include "DIMENSIONS.FREE" + include "COMMON.CONTROL" + include "COMMON.FREE" + include "COMMON.IOUNITS" + double precision fT(6),fTprim(6),fTbis(6),quot,quotl1,quotl,kfacl, + & kfac/2.4d0/,T0/300.0d0/,startGridT/200.0d0/, + & logfac,tanhT,betaT,denom,eplus,eminus + integer l + if (rescale_mode.eq.1) then + quot=betaT/T0 + quotl=1.0d0 + kfacl=1.0d0 + do l=1,5 + quotl1=quotl + quotl=quotl*quot + kfacl=kfacl*kfac + denom=kfacl-1.0d0+quotl + fT(l)=kfacl/denom + ftprim(l)=-l*ft(l)*quotl1/(T0*denom) + ftbis(l)=l*kfacl*quotl1* + & (2*l*quotl-(l-1)*denom)/(quot*t0*t0*denom**3) + enddo +#if defined(FUNCTH) + ft(6)=(320.0d0+80.0d0*dtanh((betaT-320.0d0)/80.0d0))/ + & 320.0d0 + ftprim(6)=1.0d0/(320.0d0*dcosh((betaT-320.0d0)/80.0d0)**2) + ftbis(6)=-2.0d0*dtanh((betaT-320.0d0)/80.0d0) + & /(320.0d0*80.0d0*dcosh((betaT-320.0d0)/80.0d0)**3) +#elif defined(FUNCT) + fT(6)=betaT/T0 + ftprim(6)=1.0d0/T0 + ftbis(6)=0.0d0 +#else + fT(6)=1.0d0 + ftprim(6)=0.0d0 + ftbis(6)=0.0d0 +#endif + else if (rescale_mode.eq.2) then + quot=betaT/T0 + quotl=1.0d0 + do l=1,5 + quotl1=quotl + quotl=quotl*quot + eplus=dexp(quotl) + eminus=dexp(-quotl) + logfac=1.0d0/dlog(eplus+eminus) + tanhT=(eplus-eminus)/(eplus+eminus) + fT(l)=1.12692801104297249644d0*logfac + ftprim(l)=-l*quotl1*ft(l)*tanhT*logfac/T0 + ftbis(l)=(l-1)*ftprim(l)/(quot*T0)- + & 2*l*quotl1/T0*logfac* + & (2*l*quotl1*ft(l)/(T0*(eplus+eminus)**2) + & +ftprim(l)*tanhT) + enddo +#if defined(FUNCTH) + ft(6)=(320.0d0+80.0d0*dtanh((betaT-320.0d0)/80.0d0))/ + & 320.0d0 + ftprim(6)=1.0d0/(320.0d0*dcosh((betaT-320.0d0)/80.0d0)**2) + ftbis(6)=-2.0d0*dtanh((betaT-320.0d0)/80.0d0) + & /(320.0d0*80.0d0*dcosh((betaT-320.0d0)/80.0d0)**3) +#elif defined(FUNCT) + fT(6)=betaT/T0 + ftprim(6)=1.0d0/T0 + ftbis(6)=0.0d0 +#else + fT(6)=1.0d0 + ftprim(6)=0.0d0 + ftbis(6)=0.0d0 +#endif + else if (rescale_mode.eq.0) then + do l=1,5 + fT(l)=1.0d0 + ftprim(l)=0.0d0 + enddo + else + write (iout,*) "Error in WHAM_CALC: wrong RESCALE_MODE", + & rescale_mode + call flush(iout) + return1 + endif + return + end +c-------------------------------------------------------------------- + subroutine sum_ene(t,iparm,ft,etot) + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'DIMENSIONS.FREE' + include 'COMMON.CONTROL' + include 'COMMON.FFIELD' + include "COMMON.SBRIDGE" + include "COMMON.ENERGIES" + include "COMMON.IOUNITS" + integer t,iparm + double precision fT(6) + double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, + & escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, + & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor, + & eliptran + evdw=enetb(21,t,iparm) + evdw_t=enetb(1,t,iparm) +#ifdef SCP14 + evdw2_14=enetb(17,t,iparm) + evdw2=enetb(2,t,iparm)+evdw2_14 +#else + evdw2=enetb(2,t,iparm) + evdw2_14=0.0d0 +#endif +#ifdef SPLITELE + ees=enetb(3,t,iparm) + evdw1=enetb(16,t,iparm) +#else + ees=enetb(3,t,iparm) + evdw1=0.0d0 +#endif + ecorr=enetb(4,t,iparm) + ecorr5=enetb(5,t,iparm) + ecorr6=enetb(6,t,iparm) + eel_loc=enetb(7,t,iparm) + eello_turn3=enetb(8,t,iparm) + eello_turn4=enetb(9,t,iparm) + eturn6=enetb(10,t,iparm) + ebe=enetb(11,t,iparm) + escloc=enetb(12,t,iparm) + etors=enetb(13,t,iparm) + etors_d=enetb(14,t,iparm) + ehpb=enetb(15,t,iparm) + estr=enetb(18,t,iparm) + esccor=enetb(19,t,iparm) + edihcnstr=enetb(20,t,iparm) + edihcnstr=0.0d0 +#ifdef SPLITELE + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*ees + & +ft(1)*wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else + etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees + & +wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + endif +#else + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + else + etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + endif +#endif + return + end +c-------------------------------------------------------------------- + subroutine sum_ene_deriv(t,iparm,ft,ftprim,ftbis,etot,eprim,ebis) + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'DIMENSIONS.FREE' + include 'COMMON.CONTROL' + include 'COMMON.FFIELD' + include "COMMON.SBRIDGE" + include 'COMMON.ENERGIES' + include "COMMON.IOUNITS" + integer t,iparm + double precision fT(6),fTprim(6),fTbis(6), + & eprim,ebis,temper + double precision etot,evdw,evdw_t,evdw2,ees,evdw1,ebe,etors, + & escloc,ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3, + & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor, + & eliptran + evdw=enetb(21,t,iparm) + evdw_t=enetb(1,t,iparm) +#ifdef SCP14 + evdw2_14=enetb(17,t,iparm) + evdw2=enetb(2,t,iparm)+evdw2_14 +#else + evdw2=enetb(2,t,iparm) + evdw2_14=0.0d0 +#endif +#ifdef SPLITELE + ees=enetb(3,t,iparm) + evdw1=enetb(16,t,iparm) +#else + ees=enetb(3,t,iparm) + evdw1=0.0d0 +#endif + ecorr=enetb(4,t,iparm) + ecorr5=enetb(5,t,iparm) + ecorr6=enetb(6,t,iparm) + eel_loc=enetb(7,t,iparm) + eello_turn3=enetb(8,t,iparm) + eello_turn4=enetb(9,t,iparm) + eturn6=enetb(10,t,iparm) + ebe=enetb(11,t,iparm) + escloc=enetb(12,t,iparm) + etors=enetb(13,t,iparm) + etors_d=enetb(14,t,iparm) + ehpb=enetb(15,t,iparm) + estr=enetb(18,t,iparm) + esccor=enetb(19,t,iparm) + edihcnstr=enetb(20,t,iparm) + edihcnstr=0.0d0 +#ifdef SPLITELE + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*ees + & +ft(1)*wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + eprim=ftprim(1)*(ft(6)*evdw_t+evdw) +C & +ftprim(6)*evdw_t + & +ftprim(1)*wscp*evdw2 + & +ftprim(1)*welec*ees + & +ftprim(1)*wvdwpp*evdw1 + & +ftprim(1)*wtor*etors+ + & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ + & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ + & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ + & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + ebis=ftbis(1)*wsc*(evdw+ft(6)*evdw_t) + & +ftbis(1)*wscp*evdw2+ + & ftbis(1)*welec*ees + & +ftbis(1)*wvdwpp*evdw + & +ftbis(1)*wtor*etors+ + & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ + & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ + & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ + & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ + & ftbis(1)*wsccor*esccor + else + etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees + & +wvdwpp*evdw1 + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc + & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + eprim=ftprim(6)*evdw_t+ftprim(1)*welec*ees + & +ftprim(1)*wtor*etors+ + & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ + & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ + & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ + & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + ebis=ftbis(1)*welec*ees+ftbis(1)*wtor*etors+ + & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ + & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ + & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ + & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ + & ftbis(1)*wsccor*esccor + endif +#else + if (shield_mode.gt.0) then + etot=ft(1)*wsc*(evdw+ft(6)*evdw_t)+ft(1)*wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + eprim=ftprim(1)*(evdw+ft(6)*evdw_t) + & +ftprim(1)*welec*(ees+evdw1) + & +ftprim(1)*wtor*etors+ + & ftprim(1)*wscp*evdw2+ + & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ + & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ + & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ + & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + ebis= ftbis(1)*(evdw+ft(6)*evdw_t) + & +ftbis(1)*wscp*evdw2 + & +ftbis(1)*welec*(ees+evdw1)+ftbis(1)*wtor*etors+ + & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ + & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ + & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ + & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + else + etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 + & +ft(1)*welec*(ees+evdw1) + & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc +c & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 + & +ft(2)*wturn3*eello_turn3 + & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr + & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor + & +wbond*estr+wliptran*eliptran + eprim=ftprim(6)*evdw_t+ftprim(1)*welec*(ees+evdw1) + & +ftprim(1)*wtor*etors+ + & ftprim(3)*wcorr*ecorr+ftprim(4)*wcorr5*ecorr5+ + & ftprim(5)*wcorr6*ecorr6+ftprim(3)*wturn4*eello_turn4+ + & ftprim(2)*wturn3*eello_turn3+ftprim(5)*wturn6*eturn6+ + & ftprim(2)*wel_loc*eel_loc+ftprim(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + ebis=ftbis(1)*welec*(ees+evdw1)+ftbis(1)*wtor*etors+ + & ftbis(3)*wcorr*ecorr+ftbis(4)*wcorr5*ecorr5+ + & ftbis(5)*wcorr6*ecorr6+ftbis(3)*wturn4*eello_turn4+ + & ftbis(2)*wturn3*eello_turn3+ftbis(5)*wturn6*eturn6+ + & ftbis(2)*wel_loc*eel_loc+ftbis(2)*wtor_d*etors_d+ + & ftprim(1)*wsccor*esccor + endif +#endif + return end diff --git a/source/wham/src-M/wham_multparm.F b/source/wham/src-M/wham_multparm.F index e80a39d..a3a862f 100644 --- a/source/wham/src-M/wham_multparm.F +++ b/source/wham/src-M/wham_multparm.F @@ -55,43 +55,48 @@ c NaNQ initialization call openunits call cinfo call read_general_data(*10) - call flush(iout) +c write (iout,*) "read_general_data" +c call flush(iout) call molread(*10) - call flush(iout) +c write (iout,*) "molread" +c call flush(iout) +c write (iout,*) "MAIN: constr_dist",constr_dist + if (constr_dist.gt.0) call read_dist_constr #ifdef MPI - write (iout,*) "Calling proc_groups" +c write (iout,*) "Calling proc_groups" call proc_groups - write (iout,*) "proc_groups exited" - call flush(iout) +c write (iout,*) "proc_groups exited" +c call flush(iout) #endif do ipar=1,nParmSet - write (iout,*) "Calling parmread",ipar +c write (iout,*) "Calling parmread",ipar call parmread(ipar,*10) if (.not.separate_parset) then call store_parm(ipar) - write (iout,*) "Finished storing parameters",ipar +c write (iout,*) "Finished storing parameters",ipar else if (ipar.eq.myparm) then call store_parm(1) - write (iout,*) "Finished storing parameters",ipar +c write (iout,*) "Finished storing parameters",ipar endif - call flush(iout) +c call flush(iout) enddo call read_efree(*10) - write (iout,*) "Finished READ_EFREE" - call flush(iout) + if (adaptive) call PMFread +c write (iout,*) "Finished READ_EFREE" +c call flush(iout) call read_protein_data(*10) - write (iout,*) "Finished READ_PROTEIN_DATA" - call flush(iout) +c write (iout,*) "Finished READ_PROTEIN_DATA" +c call flush(iout) if (indpdb.gt.0) then call promienie call read_compar call read_ref_structure(*10) call proc_cont call fragment_list - if (constr_dist.gt.0) call read_dist_constr endif - write (iout,*) "Begin read_database" - call flush(iout) +C if (constr_dist.gt.0) call read_dist_constr +c write (iout,*) "Begin read_database" +c call flush(iout) call read_database(*10) write (iout,*) "Finished read_database" call flush(iout) diff --git a/source/wham/src-NEWSC-NEWCORR/energy_p_new.F b/source/wham/src-NEWSC-NEWCORR/energy_p_new.F index b847313..0ee066f 100644 --- a/source/wham/src-NEWSC-NEWCORR/energy_p_new.F +++ b/source/wham/src-NEWSC-NEWCORR/energy_p_new.F @@ -3406,11 +3406,11 @@ C iti1=ntortyp+1 endif cd write (iout,*) '*******i',i,' iti1',iti -cd write (iout,*) 'b1',b1(:,i-2) -cd write (iout,*) 'b2',b2(:,i-2) +cd write (iout,*) 'b1',b1(:,iti) +cd write (iout,*) 'b2',b2(:,iti) cd write (iout,*) 'Ug',Ug(:,:,i-2) if (i .gt. iatel_s+2) then - call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2)) + call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) @@ -3430,7 +3430,7 @@ cd write (iout,*) 'Ug',Ug(:,:,i-2) enddo enddo endif - call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2)) + call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) @@ -3446,10 +3446,10 @@ cd write (iout,*) 'Ug',Ug(:,:,i-2) iti1=ntortyp+1 endif do k=1,2 - mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1) + mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) enddo C Vectors and matrices dependent on a single virtual-bond dihedral. - call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1)) + call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) @@ -4346,10 +4346,10 @@ cd call checkint_turn4(i,a_temp,eello_turn4_num) call transpose2(Eug(1,1,i+3),e3t(1,1)) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4361,14 +4361,14 @@ C Derivatives in gamma(i) call transpose2(EUgder(1,1,i+1),e1tder(1,1)) call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) C Derivatives in gamma(i+1) call transpose2(EUgder(1,1,i+2),e2tder(1,1)) call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4376,10 +4376,10 @@ C Derivatives in gamma(i+1) C Derivatives in gamma(i+2) call transpose2(EUgder(1,1,i+3),e3tder(1,1)) call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(auxmat(1,1),e2t(1,1),auxmat(1,1)) call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4394,10 +4394,10 @@ C Derivatives of this turn contributions in DC(i+2) a_temp(2,2)=agg(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4413,10 +4413,10 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggi(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4427,10 +4427,10 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggi1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4441,10 +4441,10 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggj(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -4455,10 +4455,10 @@ C Remaining derivatives of this turn contribution a_temp(2,2)=aggj1(l,4) call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) - s1=scalar2(b1(1,i+2),auxvec(1)) + s1=scalar2(b1(1,iti2),auxvec(1)) call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) - s2=scalar2(b1(1,i+1),auxvec(1)) + s2=scalar2(b1(1,iti1),auxvec(1)) call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) @@ -7013,10 +7013,10 @@ C--------------------------------------------------------------------------- do iii=1,2 dipi(iii,1)=Ub2(iii,i) dipderi(iii)=Ub2der(iii,i) - dipi(iii,2)=b1(iii,i+1) + dipi(iii,2)=b1(iii,iti1) dipj(iii,1)=Ub2(iii,j) dipderj(iii)=Ub2der(iii,j) - dipj(iii,2)=b1(iii,j+1) + dipj(iii,2)=b1(iii,itj1) enddo kkk=0 do iii=1,2 @@ -7195,26 +7195,26 @@ C They are needed only when the fifth- or the sixth-order cumulants are C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2)) + call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) @@ -7223,20 +7223,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), + call matvec2(auxmat(1,1),b1(1,iti), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j), + call matvec2(auxmat(1,1),b1(1,itj), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -7333,26 +7333,26 @@ C indluded. IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN call transpose2(AEA(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1)) + call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) call transpose2(AEAderg(1,1,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1)) + call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) - call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1)) - call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1)) + call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) + call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) call transpose2(AEA(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) call transpose2(AEAderg(1,1,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2)) + call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) - call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2)) - call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2)) + call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) + call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) @@ -7361,20 +7361,20 @@ C Calculate the Cartesian derivatives of the vectors. do kkk=1,5 do lll=1,3 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,i), + call matvec2(auxmat(1,1),b1(1,iti), & AEAb1derx(1,lll,kkk,iii,1,1)) call matvec2(auxmat(1,1),Ub2(1,i), & AEAb2derx(1,lll,kkk,iii,1,1)) - call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1), + call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), & AEAb1derx(1,lll,kkk,iii,2,1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), & AEAb2derx(1,lll,kkk,iii,2,1)) call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) - call matvec2(auxmat(1,1),b1(1,l), + call matvec2(auxmat(1,1),b1(1,itl), & AEAb1derx(1,lll,kkk,iii,1,2)) call matvec2(auxmat(1,1),Ub2(1,l), & AEAb2derx(1,lll,kkk,iii,1,2)) - call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1), + call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), & AEAb1derx(1,lll,kkk,iii,2,2)) call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), & AEAb2derx(1,lll,kkk,iii,2,2)) @@ -7679,7 +7679,7 @@ C Contribution from graph II call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_2=scalar2(AEAb1(1,2,1),b1(1,k)) + eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -7690,11 +7690,11 @@ C Explicit gradient in virtual-dihedral angles. vv(2)=pizda(2,1)-pizda(1,2) if (l.eq.j+1) then g_corr5_loc(l-1)=g_corr5_loc(l-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) else g_corr5_loc(j-1)=g_corr5_loc(j-1) - & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k)) + & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) & -0.5d0*scalar2(vv(1),Ctobr(1,k))) endif C Cartesian gradient @@ -7706,7 +7706,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) & -0.5d0*scalar2(vv(1),Ctobr(1,k)) enddo enddo @@ -7764,7 +7764,7 @@ cd1110 continue call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,l)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -7774,7 +7774,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) & -0.5d0*scalar2(vv(1),Ctobr(1,l))) C Cartesian gradient do iii=1,2 @@ -7785,7 +7785,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,iii)=derx(lll,kkk,iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) & -0.5d0*scalar2(vv(1),Ctobr(1,l)) enddo enddo @@ -7841,7 +7841,7 @@ C Contribution from graph IV call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) - eello5_4=scalar2(AEAb1(1,2,2),b1(1,j)) + eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) if (calc_grad) then C Explicit gradient in virtual-dihedral angles. @@ -7851,7 +7851,7 @@ C Explicit gradient in virtual-dihedral angles. vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) g_corr5_loc(k-1)=g_corr5_loc(k-1) - & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j)) + & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) & -0.5d0*scalar2(vv(1),Ctobr(1,j))) C Cartesian gradient do iii=1,2 @@ -7862,7 +7862,7 @@ C Cartesian gradient vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) - & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j)) + & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) & -0.5d0*scalar2(vv(1),Ctobr(1,j)) enddo enddo @@ -8127,8 +8127,8 @@ CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k) - vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k) + vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) + vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) s5=scalar2(vv(1),Dtobr2(1,i)) cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) @@ -8142,8 +8142,8 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) - vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k) - vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k) + vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) + vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) if (l.eq.j+1) then g_corr6_loc(l-1)=g_corr6_loc(l-1) & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) @@ -8182,10 +8182,10 @@ cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 vv1(1)=pizda1(1,1)-pizda1(2,2) vv1(2)=pizda1(1,2)+pizda1(2,1) s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) - vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k) - & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k) - vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k) - & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k) + vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) + & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) + vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) + & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) s5=scalar2(vv(1),Dtobr2(1,i)) derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) enddo @@ -8428,10 +8428,10 @@ C energy moment and not to the cluster cumulant. #ifdef MOMENT s1=dip(4,jj,i)*dip(4,kk,k) #endif - call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) + call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) call transpose2(EE(1,1,itk),auxmat(1,1)) call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) @@ -8446,13 +8446,13 @@ cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 c eello6_graph3=-s4 if (.not. calc_grad) return C Derivatives in gamma(k-1) - call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) C Derivatives in gamma(l-1) - call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) + call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) + s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) vv(2)=pizda(2,1)-pizda(1,2) @@ -8469,12 +8469,12 @@ C Cartesian derivatives. s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) endif #endif - call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1), + call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), & auxvec(1)) - s2=0.5d0*scalar2(b1(1,k),auxvec(1)) - call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1), + s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) + call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), & auxvec(1)) - s3=0.5d0*scalar2(b1(1,j+1),auxvec(1)) + s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), & pizda(1,1)) vv(1)=pizda(1,1)+pizda(2,2) @@ -8563,11 +8563,11 @@ cd & ' itl',itl,' itl1',itl1 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) else - call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) + call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) endif call transpose2(EUg(1,1,k),auxmat(1,1)) call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) @@ -8592,11 +8592,11 @@ C Derivatives in gamma(i-1) #endif s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) endif s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then @@ -8625,11 +8625,11 @@ C Derivatives in gamma(k-1) call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) if (j.eq.l+1) then - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) else - call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1)) - s3=-0.5d0*scalar2(b1(1,tl),auxvec1(1)) + call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) + s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) endif call transpose2(EUgder(1,1,k),auxmat1(1,1)) call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) @@ -8695,12 +8695,12 @@ C Cartesian derivatives. s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) if (j.eq.l+1) then call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,j+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,j),auxvec(1)) + & b1(1,itj1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) else call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), - & b1(1,l+1),auxvec(1)) - s3=-0.5d0*scalar2(b1(1,l),auxvec(1)) + & b1(1,itl1),auxvec(1)) + s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) endif call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), & pizda(1,1)) @@ -8797,14 +8797,14 @@ cd write (2,*) 'eello6_5',eello6_5 #ifdef MOMENT call transpose2(AEA(1,1,1),auxmat(1,1)) call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) - ss1=scalar2(Ub2(1,i+2),b1(1,l)) + ss1=scalar2(Ub2(1,i+2),b1(1,itl)) s1 = (auxmat(1,1)+auxmat(2,2))*ss1 #else s1 = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) - s2 = scalar2(b1(1,k),vtemp1(1)) + s2 = scalar2(b1(1,itk),vtemp1(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atemp(1,1)) call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) @@ -8821,7 +8821,7 @@ cd write (2,*) 'eello6_5',eello6_5 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) - ss13 = scalar2(b1(1,k),vtemp4(1)) + ss13 = scalar2(b1(1,itk),vtemp4(1)) s13 = (gtemp(1,1)+gtemp(2,2))*ss13 #else s13=0.0d0 @@ -8858,14 +8858,14 @@ C Derivatives in gamma(i+3) #ifdef MOMENT call transpose2(AEA(1,1,1),auxmatd(1,1)) call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) - ss1d=scalar2(Ub2der(1,i+2),b1(1,l)) + ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d #else s1d=0.0d0 #endif - call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1)) + call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) + s2d = scalar2(b1(1,itk),vtemp1d(1)) #ifdef MOMENT call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) @@ -8919,9 +8919,9 @@ C Derivatives in gamma(i+5) #else s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1)) + call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) + s2d = scalar2(b1(1,itk),vtemp1d(1)) #ifdef MOMENT call transpose2(AEA(1,1,2),atempd(1,1)) call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) @@ -8933,7 +8933,7 @@ C Derivatives in gamma(i+5) s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) #ifdef MOMENT call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) + ss13d = scalar2(b1(1,itk),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d #else s13d = 0.0d0 @@ -8961,10 +8961,10 @@ C Cartesian derivatives #else s1d = 0.0d0 #endif - call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1)) + call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), & vtemp1d(1)) - s2d = scalar2(b1(1,k),vtemp1d(1)) + s2d = scalar2(b1(1,itk),vtemp1d(1)) #ifdef MOMENT call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) @@ -9010,7 +9010,7 @@ c s13d=0.0d0 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), & vtemp4d(1)) - ss13d = scalar2(b1(1,k),vtemp4d(1)) + ss13d = scalar2(b1(1,itk),vtemp4d(1)) s13d = (gtemp(1,1)+gtemp(2,2))*ss13d derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d enddo diff --git a/source/wham/src-NEWSC-NEWCORR/parmread.F b/source/wham/src-NEWSC-NEWCORR/parmread.F index 43a24b8..ba6ec3e 100644 --- a/source/wham/src-NEWSC-NEWCORR/parmread.F +++ b/source/wham/src-NEWSC-NEWCORR/parmread.F @@ -694,10 +694,10 @@ C EEold(2,2,i)=-b(10,i)+b(11,i) EEold(2,1,i)= b(12,i)-b(13,i) EEold(1,2,i)= b(12,i)+b(13,i) -c EEold(1,1,-i)= b(10,i)+b(11,i) -c EEold(2,2,-i)=-b(10,i)+b(11,i) -c EEold(2,1,-i)=-b(12,i)+b(13,i) -c EEold(1,2,-i)=-b(12,i)-b(13,i) + EEold(1,1,-i)= b(10,i)+b(11,i) + EEold(2,2,-i)=-b(10,i)+b(11,i) + EEold(2,1,-i)=-b(12,i)+b(13,i) + EEold(1,2,-i)=-b(12,i)-b(13,i) #else EE(1,1,i)= b(10,i)+b(11,i) EE(2,2,i)=-b(10,i)+b(11,i) diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/Makefile b/source/wham/src-NEWSC-NEWCORR/xdrf/Makefile deleted file mode 100644 index f03276e..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/ftocstr.c b/source/wham/src-NEWSC-NEWCORR/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4 b/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4 deleted file mode 100644 index aecb5b5..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1233 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4.org b/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4.org deleted file mode 100644 index b14b374..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/libxdrf.m4.org +++ /dev/null @@ -1,1230 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/underscore.m4 b/source/wham/src-NEWSC-NEWCORR/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/wham/src-NEWSC-NEWCORR/xdrf/xdrf.h b/source/wham/src-NEWSC-NEWCORR/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/wham/src-NEWSC-NEWCORR/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/wham/src-NEWSC/CMakeLists.txt b/source/wham/src-NEWSC/CMakeLists.txt old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.ALLPARM b/source/wham/src-NEWSC/COMMON.ALLPARM old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.CHAIN b/source/wham/src-NEWSC/COMMON.CHAIN old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.COMPAR b/source/wham/src-NEWSC/COMMON.COMPAR old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.CONTACTS1 b/source/wham/src-NEWSC/COMMON.CONTACTS1 old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.CONTROL b/source/wham/src-NEWSC/COMMON.CONTROL old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.CONTROL.org b/source/wham/src-NEWSC/COMMON.CONTROL.org old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.EMP b/source/wham/src-NEWSC/COMMON.EMP old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.ENEPS b/source/wham/src-NEWSC/COMMON.ENEPS old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.ENERGIES b/source/wham/src-NEWSC/COMMON.ENERGIES old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.FREE b/source/wham/src-NEWSC/COMMON.FREE old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.IOUNITS b/source/wham/src-NEWSC/COMMON.IOUNITS old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.MPI b/source/wham/src-NEWSC/COMMON.MPI old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.OBCINKA b/source/wham/src-NEWSC/COMMON.OBCINKA old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.PEPTCONT b/source/wham/src-NEWSC/COMMON.PEPTCONT old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.PROT b/source/wham/src-NEWSC/COMMON.PROT old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.PROTFILES b/source/wham/src-NEWSC/COMMON.PROTFILES old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/COMMON.VAR b/source/wham/src-NEWSC/COMMON.VAR old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/DIMENSIONS b/source/wham/src-NEWSC/DIMENSIONS old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/DIMENSIONS.COMPAR b/source/wham/src-NEWSC/DIMENSIONS.COMPAR old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/DIMENSIONS.FREE b/source/wham/src-NEWSC/DIMENSIONS.FREE old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/DIMENSIONS.FREE.old b/source/wham/src-NEWSC/DIMENSIONS.FREE.old old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/DIMENSIONS.ZSCOPT b/source/wham/src-NEWSC/DIMENSIONS.ZSCOPT old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile b/source/wham/src-NEWSC/Makefile deleted file mode 120000 index 8453cdd..0000000 --- a/source/wham/src-NEWSC/Makefile +++ /dev/null @@ -1 +0,0 @@ -Makefile_MPICH_ifort \ No newline at end of file diff --git a/source/wham/src-NEWSC/Makefile b/source/wham/src-NEWSC/Makefile new file mode 100755 index 0000000..8b92f57 --- /dev/null +++ b/source/wham/src-NEWSC/Makefile @@ -0,0 +1,89 @@ +INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1 +BIN = /users/adam/bin +FC= ifort +OPT = -mcmodel=medium -O3 -ip -w +#OPT = -mcmodel=medium -g -CA -CB +FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include +LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a + +.f.o: + ${FC} ${FFLAGS} $*.f + +.F.o: + ${FC} ${FFLAGS} ${CPPFLAGS} $*.F + +objects = \ + wham_multparm.o \ + bxread.o \ + xread.o \ + cxread.o \ + enecalc1.o \ + energy_p_new.o \ + gnmr1.o \ + initialize_p.o \ + molread_zs.o \ + openunits.o \ + readrtns.o \ + arcos.o \ + cartder.o \ + cartprint.o \ + chainbuild.o \ + geomout.o \ + icant.o \ + intcor.o \ + int_from_cart.o \ + make_ensemble1.o \ + matmult.o \ + misc.o \ + mygetenv.o \ + parmread.o \ + pinorm.o \ + printmat.o \ + proc_proc.o \ + rescode.o \ + setup_var.o \ + slices.o \ + store_parm.o \ + timing.o \ + wham_calc1.o + +objects_compar = \ + readrtns_compar.o \ + readpdb.o fitsq.o contact.o \ + elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ + angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ + rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o + +GABs: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCALREP +GABs: ${objects} ${objects_compar} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_MM-KN-DEBUG-scalrep.exe + +GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ + -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: ${objects} ${objects_compar} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_MM-KN-DEBUG.exe + +E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 +E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a + cc -o compinfo compinfo.c + ./compinfo + ${FC} -c ${FFLAGS} cinfo.f + $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ + ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_MM-PH.exe + +xdrf/libxdrf.a: + cd xdrf && make + + +clean: + /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean + diff --git a/source/wham/src-NEWSC/Makefile-pgi b/source/wham/src-NEWSC/Makefile-pgi old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile1_jump b/source/wham/src-NEWSC/Makefile1_jump old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_MPICH_ifort b/source/wham/src-NEWSC/Makefile_MPICH_ifort old mode 100644 new mode 100755 index 1be9758..8b92f57 --- a/source/wham/src-NEWSC/Makefile_MPICH_ifort +++ b/source/wham/src-NEWSC/Makefile_MPICH_ifort @@ -1,4 +1,4 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh +INSTALL_DIR = /users/local/mpi64/mpich-1.2.7p1 BIN = /users/adam/bin FC= ifort OPT = -mcmodel=medium -O3 -ip -w diff --git a/source/wham/src-NEWSC/Makefile_jubl b/source/wham/src-NEWSC/Makefile_jubl old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_jump b/source/wham/src-NEWSC/Makefile_jump old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_matrix b/source/wham/src-NEWSC/Makefile_matrix old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_matrix_PGI b/source/wham/src-NEWSC/Makefile_matrix_PGI old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_matrix_PGI-SCT-oldparm b/source/wham/src-NEWSC/Makefile_matrix_PGI-SCT-oldparm old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_matrix_PGI-SCTF-oldparm b/source/wham/src-NEWSC/Makefile_matrix_PGI-SCTF-oldparm old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/Makefile_matrix_PGI-oldparm b/source/wham/src-NEWSC/Makefile_matrix_PGI-oldparm old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/a.sh b/source/wham/src-NEWSC/a.sh old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/angnorm.f b/source/wham/src-NEWSC/angnorm.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/arcos.f b/source/wham/src-NEWSC/arcos.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/bxread.F b/source/wham/src-NEWSC/bxread.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/cartder.f b/source/wham/src-NEWSC/cartder.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/cartprint.f b/source/wham/src-NEWSC/cartprint.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/chainbuild.F b/source/wham/src-NEWSC/chainbuild.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/chainbuild.f b/source/wham/src-NEWSC/chainbuild.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/compinfo.c b/source/wham/src-NEWSC/compinfo.c old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/conf_compar.F b/source/wham/src-NEWSC/conf_compar.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/cont_frag.f b/source/wham/src-NEWSC/cont_frag.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/contact.f b/source/wham/src-NEWSC/contact.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/contfunc.f b/source/wham/src-NEWSC/contfunc.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/cxread.F b/source/wham/src-NEWSC/cxread.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/cxread.F.org b/source/wham/src-NEWSC/cxread.F.org old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/define_pairs.f b/source/wham/src-NEWSC/define_pairs.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/elecont.f b/source/wham/src-NEWSC/elecont.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/enecalc1.F b/source/wham/src-NEWSC/enecalc1.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/energy_p_new.F b/source/wham/src-NEWSC/energy_p_new.F old mode 100644 new mode 100755 index 37bd887..113d499 --- a/source/wham/src-NEWSC/energy_p_new.F +++ b/source/wham/src-NEWSC/energy_p_new.F @@ -6256,8 +6256,8 @@ c amino-acid residues. include 'COMMON.CONTROL' logical lprn C Set lprn=.true. for debugging -c lprn=.false. - lprn=.true. + lprn=.false. +c lprn=.true. c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor esccor=0.0D0 do i=itau_start,itau_end @@ -6289,27 +6289,22 @@ c 3 = SC...Ca...Ca...SCi if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21)) & cycle - esccori=0.0d0 do j=1,nterm_sccor(isccori,isccori1) v1ij=v1sccor(j,intertyp,isccori,isccori1) v2ij=v2sccor(j,intertyp,isccori,isccori1) cosphi=dcos(j*tauangle(intertyp,i)) sinphi=dsin(j*tauangle(intertyp,i)) - esccori=esccori+v1ij*cosphi+v2ij*sinphi + esccor=esccor+v1ij*cosphi+v2ij*sinphi gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo - esccor=esccor+esccori gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi c &gloc_sc(intertyp,i-3,icg) - if (lprn) then - write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') - & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1, - & (v1sccor(j,intertyp,isccori,isccori1),j=1,6) - & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6) - write (iout,*) "esccori",esccori - call flush(iout) - endif + if (lprn) + & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') + & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, + & (v1sccor(j,intertyp,itori,itori1),j=1,6) + & ,(v2sccor(j,intertyp,itori,itori1),j=1,6) gsccor_loc(i-3)=gsccor_loc(i-3)+gloci enddo !intertyp enddo diff --git a/source/wham/src-NEWSC/energy_p_new.F.org b/source/wham/src-NEWSC/energy_p_new.F.org old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/fitsq.f b/source/wham/src-NEWSC/fitsq.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/geomout.F b/source/wham/src-NEWSC/geomout.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/gnmr1.f b/source/wham/src-NEWSC/gnmr1.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/icant.f b/source/wham/src-NEWSC/icant.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/initialize_p.F b/source/wham/src-NEWSC/initialize_p.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/initialize_p.F.org b/source/wham/src-NEWSC/initialize_p.F.org old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/int_from_cart.f b/source/wham/src-NEWSC/int_from_cart.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/intcor.f b/source/wham/src-NEWSC/intcor.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/make_ensemble1.F b/source/wham/src-NEWSC/make_ensemble1.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/match_contact.f b/source/wham/src-NEWSC/match_contact.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/matmult.f b/source/wham/src-NEWSC/matmult.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/misc.f b/source/wham/src-NEWSC/misc.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/molread_zs.F b/source/wham/src-NEWSC/molread_zs.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/mygetenv.F b/source/wham/src-NEWSC/mygetenv.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/mysort.f b/source/wham/src-NEWSC/mysort.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/odlodc.f b/source/wham/src-NEWSC/odlodc.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/openunits.F b/source/wham/src-NEWSC/openunits.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/parmread.F b/source/wham/src-NEWSC/parmread.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/pinorm.f b/source/wham/src-NEWSC/pinorm.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/printmat.f b/source/wham/src-NEWSC/printmat.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/proc_cont.f b/source/wham/src-NEWSC/proc_cont.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/proc_proc.c b/source/wham/src-NEWSC/proc_proc.c old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/promienie.f b/source/wham/src-NEWSC/promienie.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/qwolynes.f b/source/wham/src-NEWSC/qwolynes.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/read_ref_str.F b/source/wham/src-NEWSC/read_ref_str.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/readpdb.f b/source/wham/src-NEWSC/readpdb.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/readrtns.F b/source/wham/src-NEWSC/readrtns.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/readrtns.F.org b/source/wham/src-NEWSC/readrtns.F.org old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/readrtns_compar.F b/source/wham/src-NEWSC/readrtns_compar.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/rescode.f b/source/wham/src-NEWSC/rescode.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/rmscalc.f b/source/wham/src-NEWSC/rmscalc.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/secondary.f b/source/wham/src-NEWSC/secondary.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/setup_var.f b/source/wham/src-NEWSC/setup_var.f old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/slices.F b/source/wham/src-NEWSC/slices.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/store_parm.F b/source/wham/src-NEWSC/store_parm.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/timing.F b/source/wham/src-NEWSC/timing.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/wham_calc1.F b/source/wham/src-NEWSC/wham_calc1.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/wham_calc1.F.safe b/source/wham/src-NEWSC/wham_calc1.F.safe old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/wham_multparm.F b/source/wham/src-NEWSC/wham_multparm.F old mode 100644 new mode 100755 diff --git a/source/wham/src-NEWSC/xdrf/Makefile b/source/wham/src-NEWSC/xdrf/Makefile deleted file mode 100644 index f03276e..0000000 --- a/source/wham/src-NEWSC/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/wham/src-NEWSC/xdrf/ftocstr.c b/source/wham/src-NEWSC/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/wham/src-NEWSC/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/wham/src-NEWSC/xdrf/libxdrf.m4 b/source/wham/src-NEWSC/xdrf/libxdrf.m4 deleted file mode 100644 index aecb5b5..0000000 --- a/source/wham/src-NEWSC/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1233 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-NEWSC/xdrf/libxdrf.m4.org b/source/wham/src-NEWSC/xdrf/libxdrf.m4.org deleted file mode 100644 index b14b374..0000000 --- a/source/wham/src-NEWSC/xdrf/libxdrf.m4.org +++ /dev/null @@ -1,1230 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -#include -#include -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/wham/src-NEWSC/xdrf/underscore.m4 b/source/wham/src-NEWSC/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/wham/src-NEWSC/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/wham/src-NEWSC/xdrf/xdrf.h b/source/wham/src-NEWSC/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/wham/src-NEWSC/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - diff --git a/source/wham/src-NEWSC/xread.F b/source/wham/src-NEWSC/xread.F old mode 100644 new mode 100755 diff --git a/source/wham/src/CMakeLists.txt b/source/wham/src/CMakeLists.txt index aca8eb4..51ed5be 100644 --- a/source/wham/src/CMakeLists.txt +++ b/source/wham/src/CMakeLists.txt @@ -37,6 +37,7 @@ set(UNRES_WHAM_SRC0 rescode.f setup_var.f slices.F + ssMD.F store_parm.F timing.F wham_calc1.F @@ -79,6 +80,7 @@ set(UNRES_WHAM_PP_SRC readrtns_compar.F readrtns.F slices.F + ssMD.F store_parm.F timing.F wham_calc1.F @@ -92,9 +94,13 @@ set(UNRES_WHAM_PP_SRC # Set comipiler flags for different sourcefiles #================================================ if (Fortran_COMPILER_NAME STREQUAL "ifort") - set(FFLAGS0 "-mcmodel=medium -g -CB -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) + set(FFLAGS0 "-mcmodel=medium -shared-intel -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") - set(FFLAGS0 "-std=legacy -g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) + set(FFLAGS0 "-std=legacy -mcmodel=medium -g -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) +elseif (Fortran_COMPILER_NAME STREQUAL "pgf90") + set(FFLAGS0 "-mcmodel=medium -Mlarge_arrays -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) +else () + set(FFLAGS0 "-g -mcmodel=medium -I. -I${CMAKE_CURRENT_SOURCE_DIR}/include_unres" ) endif (Fortran_COMPILER_NAME STREQUAL "ifort") @@ -102,16 +108,35 @@ endif (Fortran_COMPILER_NAME STREQUAL "ifort") # Add MPI compiler flags #========================================= if(UNRES_WITH_MPI) - set(FFLAGS0 "${FFLAGS0} -I${MPIF_INCLUDE_DIRECTORIES}") + set(FFLAGS0 "${FFLAGS0} -I${MPI_Fortran_INCLUDE_PATH}") endif(UNRES_WITH_MPI) set_property(SOURCE ${UNRES_WHAM_SRC0} PROPERTY COMPILE_FLAGS ${FFLAGS0} ) #========================================= -# WHAM preprocesor flags +# Settings for GAB force field #========================================= -set(CPPFLAGS "PROCOR -DUNRES -DISNAN -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC" ) +if(UNRES_MD_FF STREQUAL "GAB" ) + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) + +#========================================= +# Settings for E0LL2Y force field +#========================================= +elseif(UNRES_MD_FF STREQUAL "E0LL2Y") + # set preprocesor flags + set(CPPFLAGS "PROCOR -DSPLITELE -DSCCORPDB" ) +elseif(UNRES_MD_FF STREQUAL "4P") + set(CPPFLAGS "SPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC -DSCCORPDB" ) +endif(UNRES_MD_FF STREQUAL "GAB") + + +#========================================= +# Additional flags +#========================================= +set(CPPFLAGS "${CPPFLAGS} -DUNRES -DISNAN -DWHAM ") + #========================================= # System specific flags @@ -133,6 +158,11 @@ elseif (Fortran_COMPILER_NAME STREQUAL "f95") elseif (Fortran_COMPILER_NAME STREQUAL "gfortran") # Add old gfortran flags set(CPPFLAGS "${CPPFLAGS} -DG77") +elseif (Fortran_COMPILER_NAME STREQUAL "pgf90") + set(CPPFLAGS "${CPPFLAGS} -DPGI") + FILE(COPY ${CMAKE_SOURCE_DIR}/source/lib/isnan_pgi.f DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + list(APPEND UNRES_WHAM_SRC0 ${CMAKE_CURRENT_BINARY_DIR}/isnan_pgi.f) + set(CMAKE_EXE_LINKER_FLAGS "-Bdynamic") endif (Fortran_COMPILER_NAME STREQUAL "ifort") #========================================= @@ -156,7 +186,7 @@ set_property(SOURCE ${UNRES_WHAM_PP_SRC} PROPERTY COMPILE_DEFINITIONS ${CPPFLAGS #======================================== # Setting binary name #======================================== -set(UNRES_WHAM_BIN "wham_${Fortran_COMPILER_NAME}.exe") +set(UNRES_WHAM_BIN "wham_${Fortran_COMPILER_NAME}_MPI_${UNRES_MD_FF}.exe") #========================================= # cinfo.f workaround for CMake @@ -200,99 +230,100 @@ set(UNRES_WHAM_SRCS ${UNRES_WHAM_SRC0} ${CMAKE_CURRENT_BINARY_DIR}/cinfo.f proc_ #========================================= add_executable(UNRES_WHAM_BIN ${UNRES_WHAM_SRCS} ) set_target_properties(UNRES_WHAM_BIN PROPERTIES OUTPUT_NAME ${UNRES_WHAM_BIN}) - -#set_property(TARGET ${UNRES_BIN} PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin/unres/MD ) +set_property(TARGET UNRES_WHAM_BIN PROPERTY RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin ) #add_dependencies (${UNRES_BIN} ${UNRES_XDRFLIB}) #========================================= # Link libraries #========================================= -# link MPI library (libmpich.a) -target_link_libraries( UNRES_WHAM_BIN ${MPIF_LIBRARIES} ) +# link MPI libraries +target_link_libraries( UNRES_WHAM_BIN ${MPI_Fortran_LIBRARIES} ) # link libxdrf.a target_link_libraries( UNRES_WHAM_BIN xdrf ) #========================================= -# TESTS +# Install Path #========================================= +install(TARGETS UNRES_WHAM_BIN DESTINATION ${CMAKE_INSTALL_PREFIX}/wham) -#-- Copy all the data files from the test directory into the source directory -#SET(UNRES_TEST_FILES -# ala10.inp -# ) - -#FOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) -# SET (unres_test_dest "${CMAKE_CURRENT_BINARY_DIR}/${UNRES_TEST_FILE}") -# MESSAGE (STATUS " Copying ${UNRES_TEST_FILE} from ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} to ${unres_test_dest}") -# ADD_CUSTOM_COMMAND ( -# TARGET ${UNRES_BIN} -# POST_BUILD -# COMMAND ${CMAKE_COMMAND} -E copy ${CMAKE_SOURCE_DIR}/examples/unres/MD/ff_gab/${UNRES_TEST_FILE} ${unres_test_dest} -# ) -#ENDFOREACH (UNRES_TEST_FILE ${UNRES_TEST_FILES}) #========================================= -# Generate data test files -#========================================= -# test_single_ala.sh +# TESTS #========================================= -#FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh -#"#!/bin/sh -#export POT=GB -#export PREFIX=ala10 +# MESSAGE (STATUS "${MPI_Fortran_LIBRARIES}") + if ("${MPI_Fortran_LIBRARIES}" MATCHES "lam") + MESSAGE (STATUS "LAM MPI library detected") + set (boot_lam "-boot") + else() + set (boot_lam "") + endif() + + if (UNRES_SRUN) + set (np "-n") + set (mpiexec "srun") + elseif(UNRES_MPIRUN) + set (np "-np") + set (mpiexec "mpirun") + else() + set (np "-np") + set (mpiexec "mpiexec") + endif() + + +FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/scripts/wham_mpi_E0LL2Y.sh +"#!/bin/sh +export POT=GB +export PREFIX=$1 #----------------------------------------------------------------------------- -#UNRES_BIN=./${UNRES_BIN} +WHAM_BIN=${CMAKE_BINARY_DIR}/bin/${UNRES_WHAM_BIN} #----------------------------------------------------------------------------- -#DD=${CMAKE_SOURCE_DIR}/PARAM -#export BONDPAR=$DD/bond.parm -#export THETPAR=$DD/thetaml.5parm -#export ROTPAR=$DD/scgauss.parm -#export TORPAR=$DD/torsion_631Gdp.parm -#export TORDPAR=$DD/torsion_double_631Gdp.parm -#export ELEPAR=$DD/electr_631Gdp.parm -#export SIDEPAR=$DD/sc_GB_opt.1gab_3S_qclass5no310-shan2-sc-16-10-8k -#export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 -#export SCPPAR=$DD/scp.parm -#export SCCORPAR=$DD/rotcorr_AM1.parm -#export PATTERN=$DD/patterns.cart +DD=${CMAKE_SOURCE_DIR}/PARAM +export BONDPAR=$DD/bond_AM1.parm +export THETPAR=$DD/theta_abinitio.parm +export ROTPAR=$DD/rotamers_AM1_aura.10022007.parm +export TORPAR=$DD/torsion_631Gdp.parm +export TORDPAR=$DD/torsion_double_631Gdp.parm +export ELEPAR=$DD/electr_631Gdp.parm +export SIDEPAR=$DD/scinter_$POT.parm +export FOURIER=$DD/fourier_opt.parm.1igd_hc_iter3_3 +export SCPPAR=$DD/scp.parm +export SCCORPAR=$DD/sccor_am1_pawel.dat +export THETPARPDB=$DD/thetaml.5parm +export ROTPARPDB=$DD/scgauss.parm +export PATTERN=$DD/patterns.cart +export CONTFUNC=GB +export SIDEP=$DD/contact.3.parm +export SCRATCHDIR=. #----------------------------------------------------------------------------- -#$UNRES_BIN -#") +echo CTEST_FULL_OUTPUT +${mpiexec} ${boot_lam} ${np} $2 $WHAM_BIN +./wham_check.sh $1 +") + +# +# File permissions workaround +# +FILE( COPY ${CMAKE_CURRENT_BINARY_DIR}/scripts/wham_mpi_E0LL2Y.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/wham_check.sh + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} + FILE_PERMISSIONS OWNER_READ OWNER_WRITE OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE +) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_wham.inp + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y_remd_MD000.cx + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) + +FILE(COPY ${CMAKE_SOURCE_DIR}/ctest/1L2Y.pdb + DESTINATION ${CMAKE_CURRENT_BINARY_DIR} ) -#========================================= -# ala10.inp -#========================================= -#file(WRITE ${CMAKE_CURRENT_BINARY_DIR}/ala10.inp -#"ala10 unblocked -#SEED=-1111333 MD ONE_LETTER rescale_mode=2 PDBOUT -#nstep=15000 ntwe=100 ntwx=1000 dt=0.1 lang=0 tbf t_bath=300 damax=1.0 & -#reset_moment=1000 reset_vel=1000 MDPDB -#WLONG=1.35279 WSCP=1.59304 WELEC=0.71534 WBOND=1.00000 WANG=1.13873 & -#WSCLOC=0.16258 WTOR=1.98599 WTORD=1.57069 WCORRH=0.42887 WCORR5=0.00000 & -#WCORR6=0.00000 WEL_LOC=0.16036 WTURN3=1.68722 WTURN4=0.66230 WTURN6=0.00000 & -#WVDWPP=0.11371 WHPB=1.00000 & -#CUTOFF=7.00000 WCORR4=0.00000 -#12 -#XAAAAAAAAAAX -# 0 -# 0 -# 90.0000 90.0000 90.0000 90.000 90.000 90.000 90.000 90.000 -# 90.0000 90.0000 -# 180.0000 180.0000 180.0000 180.000 180.000 180.000 180.000 180.000 -# 180.0000 -# 110.0000 110.0000 110.0000 100.000 110.000 100.000 110.000 110.000 -# 110.0000 110.0000 -# -120.0000 -120.0000 -120.000 -120.000 -120.000 -120.000 -120.000 -120.000 -# -120.0000 -120.0000 -#") - - -# Add tests - -#if(NOT UNRES_WITH_MPI) - -# add_test(NAME UNRES_MD_Ala10 COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/test_single_ala.sh ) - -#endif(NOT UNRES_WITH_MPI) +if(UNRES_MD_FF STREQUAL "E0LL2Y") + add_test(NAME WHAM_remd COMMAND sh ${CMAKE_CURRENT_BINARY_DIR}/wham_mpi_E0LL2Y.sh 1L2Y_wham 2 ) +endif(UNRES_MD_FF STREQUAL "E0LL2Y") diff --git a/source/wham/src/COMMON.ALLPARM b/source/wham/src/COMMON.ALLPARM index 896b5a2..729dab9 100644 --- a/source/wham/src/COMMON.ALLPARM +++ b/source/wham/src/COMMON.ALLPARM @@ -47,6 +47,7 @@ & sigma_all(ntyp,ntyp,max_parm),r0_all(ntyp,ntyp,max_parm), & chi_all(ntyp,ntyp,max_parm),chip_all(ntyp,max_parm), & alp_all(ntyp,max_parm),ebr_all(max_parm),d0cm_all(max_parm), + & ss_depth_all(max_parm),ht_all(max_parm), & akcm_all(max_parm),akth_all(max_parm),akct_all(max_parm), & v1ss_all(max_parm),v2ss_all(max_parm),v3ss_all(max_parm), & v1sccor_all(maxterm_sccor,3,ntyp,ntyp,max_parm), @@ -59,7 +60,7 @@ & ithetyp_all(ntyp1,max_parm),ntheterm_all(max_parm), & ntheterm2_all(max_parm),ntheterm3_all(max_parm), & nsingle_all(max_parm),ndouble_all(max_parm), - & nntheterm_all(max_parm),nterm_sccor_all(max_parm,ntyp,ntyp) + & nntheterm_all(max_parm),nterm_sccor_all(ntyp,ntyp,max_parm) common /allparm/ ww_all,vbldp0_all,akp_all,vbldsc0_all,aksc_all, & abond0_all,aa0thet_all,aathet_all,bbthet_all,ccthet_all, & ddthet_all,eethet_all,ffthet_all,ggthet_all, @@ -71,6 +72,7 @@ & ctilde_all,dtilde_all,b1tilde_all,app_all,bpp_all,ael6_all, & ael3_all,aad_all,bad_all,aa_all,bb_all,augm_all, & eps_all,sigma_all,r0_all,chi_all,chip_all,alp_all,ebr_all, + & ss_depth_all,ht_all, & d0cm_all,akcm_all,akth_all,akct_all,v1ss_all,v2ss_all,v3ss_all, & v1sccor_all,v2sccor_all,nbondterm_all, & nlob_all,nlor_all,nterm_all,ntermd1_all,ntermd2_all, diff --git a/source/wham/src/DIMENSIONS b/source/wham/src/DIMENSIONS index 4d9279d..db2f678 100644 --- a/source/wham/src/DIMENSIONS +++ b/source/wham/src/DIMENSIONS @@ -6,15 +6,15 @@ ******************************************************************************** c implicit real*8 (a-h,o-z) C Max. number of processors. -c parameter (maxprocs=128) +C parameter (maxprocs=128) C Max. number of fine-grain processors -c parameter (max_fg_procs=maxprocs) +C parameter (max_fg_procs=maxprocs) C Max. number of coarse-grain processors c parameter (max_cg_procs=maxprocs) C Max. number of AA residues integer maxres -c parameter (maxres=250) - parameter (maxres=400) + parameter (maxres=800) +c parameter (maxres=400) C Appr. max. number of interaction sites integer maxres2 parameter (maxres2=2*maxres) diff --git a/source/wham/src/DIMENSIONS.FREE b/source/wham/src/DIMENSIONS.FREE index a2eb4e5..8df70f5 100644 --- a/source/wham/src/DIMENSIONS.FREE +++ b/source/wham/src/DIMENSIONS.FREE @@ -2,10 +2,10 @@ integer MaxQ,MaxQ1 integer MaxR,MaxT_h integer MaxSlice - parameter (Max_Parm=128) + parameter (Max_Parm=32) parameter (MaxQ=4,MaxQ1=MaxQ+2) - parameter(MaxR=1,MaxT_h=32) - parameter(MaxSlice=40) + parameter(MaxR=10,MaxT_h=36) + parameter(MaxSlice=20) integer MaxN parameter (MaxN=100) integer MaxPrintConf diff --git a/source/wham/src/DIMENSIONS.FREE.orig b/source/wham/src/DIMENSIONS.FREE.orig deleted file mode 100644 index 21d967d..0000000 --- a/source/wham/src/DIMENSIONS.FREE.orig +++ /dev/null @@ -1,14 +0,0 @@ - integer Max_Parm - integer MaxQ,MaxQ1 - integer MaxR,MaxT_h - integer MaxSlice - parameter (Max_Parm=8) - parameter (MaxQ=4,MaxQ1=MaxQ+2) - parameter(MaxR=1,MaxT_h=32) - parameter(MaxSlice=40) - integer MaxN - parameter (MaxN=100) - integer MaxPrintConf - parameter (MaxPrintConf=1000) - integer Max_GridT - parameter (Max_GridT=400) diff --git a/source/wham/src/DIMENSIONS.ZSCOPT b/source/wham/src/DIMENSIONS.ZSCOPT index 689173b..bba6a76 100644 --- a/source/wham/src/DIMENSIONS.ZSCOPT +++ b/source/wham/src/DIMENSIONS.ZSCOPT @@ -25,7 +25,8 @@ c Maximum number of grid points in energy map evaluation parameter (max_x=200,max_y=200,max_minim=1000) c Maximum number of processors integer MaxProcs - parameter (MaxProcs = 2048) +c parameter (MaxProcs = 2048) + parameter (MaxProcs = 128) c Maximum number of optimizable parameters integer max_paropt parameter (max_paropt=500) diff --git a/source/wham/src/DIMENSIONS.orig b/source/wham/src/DIMENSIONS.orig deleted file mode 100644 index 04c57a5..0000000 --- a/source/wham/src/DIMENSIONS.orig +++ /dev/null @@ -1,142 +0,0 @@ -******************************************************************************** -* Settings for the program of united-residue peptide simulation in real space * -* * -* ------- As of 6/23/01 ----------- * -* * -******************************************************************************** -c implicit real*8 (a-h,o-z) -C Max. number of processors. -c parameter (maxprocs=128) -C Max. number of fine-grain processors -c parameter (max_fg_procs=maxprocs) -C Max. number of coarse-grain processors -c parameter (max_cg_procs=maxprocs) -C Max. number of AA residues - integer maxres - parameter (maxres=250) -c parameter (maxres=400) -C Appr. max. number of interaction sites - integer maxres2 - parameter (maxres2=2*maxres) -C Max. number of variables - integer maxvar - parameter (maxvar=4*maxres) -C Max. number of groups of interactions that a given SC is involved in - integer maxint_gr - parameter (maxint_gr=2) -C Max. number of derivatives of virtual-bond and side-chain vectors in theta -C or phi. - integer maxdim - parameter (maxdim=(maxres-1)*(maxres-2)/2) -C Max. number of SC contacts - integer maxcont - parameter (maxcont=12*maxres) -C Max. number of contacts per residue - integer maxconts - parameter (maxconts=maxres) -C Number of AA types (at present only natural AA's will be handled - integer ntyp,ntyp1 - parameter (ntyp=20,ntyp1=ntyp+1) - integer nntyp - parameter (nntyp=ntyp*(ntyp+1)/2) -C Max. number of types of dihedral angles & multiplicity of torsional barriers -C and the number of terms in double torsionals - integer maxtor,maxterm,maxlor,maxtermd_1,maxtermd_2 - parameter (maxtor=4,maxterm=10,maxlor=3,maxtermd_1=8,maxtermd_2=8) -c Max number of torsional terms in SCCOR - integer maxterm_sccor - parameter (maxterm_sccor=6) -C Max. number of residue types and parameters in expressions for -C virtual-bond angle bending potentials - integer maxthetyp,maxthetyp1,maxtheterm,maxtheterm2,maxtheterm3, - & maxsingle,maxdouble,mmaxtheterm - parameter (maxthetyp=3,maxthetyp1=maxthetyp+1,maxtheterm=20, - & maxtheterm2=6,maxtheterm3=4,maxsingle=6,maxdouble=4, - & mmaxtheterm=maxtheterm) -C Max. number of lobes in SC distribution - integer maxlob - parameter (maxlob=4) -C Max. number of S-S bridges - integer maxss - parameter (maxss=20) -C Max. number of dihedral angle constraints - integer maxdih_constr - parameter (maxdih_constr=maxres) -C Max. number of patterns in the pattern database - integer maxseq - parameter (maxseq=1000) -C Max. number of residues in a peptide in the database - integer maxres_base - parameter (maxres_base=1000) -C Max. number of threading attempts - integer maxthread - parameter (maxthread=2000) -C Max. number of move types in MCM - integer maxmovetype - parameter (maxmovetype=4) -C Max. number of stored confs. in MC/MCM simulation - integer maxsave - parameter (maxsave=2000) -C Max. number of conformations in Master's cache array - integer max_cache - parameter (max_cache=1000) -C Max. number of conformations in the pool - integer max_pool - parameter (max_pool=1000) -C Number of threads in deformation - integer max_thread,max_thread2 - parameter (max_thread=40,max_thread2=2*max_thread) -C Number of steps in DSM - integer max_step - parameter (max_step=1) -C Number of structures to compare at t=0 - integer max_threadss,max_threadss2 - parameter (max_threadss=80,max_threadss2=2*max_threadss) -C Maxmimum number of angles per residue - integer mxang - parameter (mxang=4) -C Maximum number of groups of angles - integer mxgr - parameter (mxgr=2*maxres) -C Maximum number of chains - integer mxch - parameter (mxch=1) -C Maximum number of generated conformations - integer mxio - parameter (mxio=1000) -C Maximum number of seed - integer max_seed - parameter (max_seed=100) -C Maximum number of structures for ZSCORE for each protein - integer maxzs - parameter (maxzs=2) -C Maximum number of structures stored for comparison for ZSCORE for each protein - integer maxzs1 - parameter (maxzs1=6) -C Maximum number of proteins for ZSCORE - integer maxprotzs - parameter (maxprotzs=1) -C Maximum number of conf in rmsdbank - integer maxrmsdb - parameter (maxrmsdb=110) -C Maximum number of bankt conformations - integer mxiot - parameter (mxiot=mxio) -c Maximum number of conformations in MCMF - integer maxstr_mcmf - parameter (maxstr_mcmf=800) -c Maximum number of families in MCMF - integer maxfam_p - parameter (maxfam_p=20) -c Maximum number of structures in family in MCMF - integer maxstr_fam - parameter (maxstr_fam=40) -C Maximum number of threads in MCMF - integer maxthread_mcmf - parameter (maxthread_mcmf=10) -C Maximum number of SC local term fitting function coefficiants - integer maxsccoef - parameter (maxsccoef=65) -C Maximum number of terms in SC bond-stretching potential - integer maxbondterm - parameter (maxbondterm=3) diff --git a/source/wham/src/Makefile-pgi b/source/wham/src/Makefile-pgi deleted file mode 100644 index 40cc442..0000000 --- a/source/wham/src/Makefile-pgi +++ /dev/null @@ -1,74 +0,0 @@ -BIN = /users/adam/ZSCOREZ/bin -CC = cc -FC = mpif90 -#FC = ifc -OPT = -fast -pc 64 -tp p6 -Minline=name:scalar2,scalar,transpose2,matvec2,prodmat3 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -FFLAGS = ${OPT} -c -I. -I./include_unres -LIBS = -L../../MEY_MD/src_Tc/xdrf -lxdrf -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} -Wl,-Bstatic ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-T-sccor - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile1_jump b/source/wham/src/Makefile1_jump deleted file mode 100644 index 1df1586..0000000 --- a/source/wham/src/Makefile1_jump +++ /dev/null @@ -1,60 +0,0 @@ -BIN = ../bin -CC = cc -FC = mpxlf90 -qfixed -w -OPT = -q64 -FFLAGS = -c ${OPT} -O3 -I./include_unres -LIBS = xdrf/libxdrf.o xdrf/ftocstr.o -CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm1-T-procor - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_MPICH_ifort b/source/wham/src/Makefile_MPICH_ifort index abbc1bc..dfcd343 100644 --- a/source/wham/src/Makefile_MPICH_ifort +++ b/source/wham/src/Makefile_MPICH_ifort @@ -1,10 +1,15 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN = ../../../bin/wham -FC= ifort -OPT = -mcmodel=medium -O3 -ip -w -#OPT = -mcmodel=medium -g -CB +################################################################### +INSTALL_DIR = /opt/cray/mpt/7.3.2/gni/mpich-intel/15.0 + + +CC = gcc +FC = /opt/cray/craype/2.5.3/bin/ftn + +OPT = -O3 -ip -dynamic -mcmodel=medium +#OPT = -g -CA -CB + FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a +LIBS = -L$(INSTALL_DIR)/lib -lmpich xdrf/libxdrf.a .f.o: ${FC} ${FFLAGS} $*.f @@ -12,6 +17,8 @@ LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a .F.o: ${FC} ${FFLAGS} ${CPPFLAGS} $*.F +all: make_dbase + objects = \ wham_multparm.o \ bxread.o \ @@ -19,10 +26,10 @@ objects = \ cxread.o \ enecalc1.o \ energy_p_new.o \ - gnmr1.o \ initialize_p.o \ molread_zs.o \ openunits.o \ + gnmr1.o \ readrtns.o \ arcos.o \ cartder.o \ @@ -45,7 +52,8 @@ objects = \ slices.o \ store_parm.o \ timing.o \ - wham_calc1.o + wham_calc1.o \ + ssMD.o objects_compar = \ readrtns_compar.o \ @@ -54,27 +62,31 @@ objects_compar = \ angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o -GAB: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 \ - -DCRYST_BOND -DCRYST_THETA -DCRYST_SC +GAB: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMPI -DWHAM \ + -DSPLITELE -DLANG0 -DCRYST_BOND -DCRYST_THETA -DCRYST_SC\ + -DSCCORPDB +GAB: BIN = /lustre/tetyda/home/liwo/bin/wham_intel_MPI_GAB.exe GAB: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_GAB-DEBUG.exe + ${CC} -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${objects} ${objects_compar} cinfo.o ${LIBS} -o ${BIN} -E0LL2Y: CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 +E0LL2Y: CPPFLAGS = -DPROCOR -DLINUX -DPGI -DAMD64 -DUNRES -DISNAN -DMPI -DWHAM \ + -DSPLITELE -DLANG0 +E0LL2Y: BIN = /lustre/tetyda/home/liwo/bin/unres/MD/wham_intel_MPI_E0LL2Y.exe E0LL2Y: ${objects} ${objects_compar} xdrf/libxdrf.a - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_ifort_MPICH_E0LL2Y.exe + ${CC} -o compinfo compinfo.c + ./compinfo | true + ${FC} ${FFLAGS} cinfo.f + ${FC} ${OPT} ${objects} ${objects_compar} cinfo.o ${LIBS} -o ${BIN} xdrf/libxdrf.a: - cd xdrf && make + cd ../../lib/xdrf && make clean: /bin/rm -f *.o && /bin/rm -f compinfo && cd xdrf && make clean +clean: + /bin/rm *.o diff --git a/source/wham/src/Makefile_jubl b/source/wham/src/Makefile_jubl deleted file mode 100644 index 5f37ee7..0000000 --- a/source/wham/src/Makefile_jubl +++ /dev/null @@ -1,95 +0,0 @@ -CPPFLAGS = -WF,-DOLD_GINV \ - -WF,-DUNRES -WF,-DMPI \ - -WF,-DSPLITELE -WF,-DISNAN \ - -WF,-DAIX -WF,-DLANG0 -WF,-DPROCOR -WF,-DJUBL -#-WF,-DNOXDR -#-WF,-DPROCOR -## -DMOMENT -#-DCO_BIAS -#-DCRYST_TOR -#-DDEBUG - -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc -FC = /usr/bin/blrts_xlf90 -#-pg -g - -# try -qarch=440 first, then use -qarch=440d for 2nd FPU later on -# (SIMDization requires at least -O3) -# use -qlist -qsource with 440d and look for Parallel ASM instructions. -# -OPT= -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -qfixed -w -qnosave -CFLAGS= -O3 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 -FFLAGS= -c -O3 ${OPT} -I./include_unres -# -LIBS_MPI = -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts -LIBSF_MPI = -lmpich.rts -lfmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts - -FFLAGS1 = -c ${OPT} -O2 -FFLAGS2 = -c ${OPT} -O -FFLAGSE = -c ${OPT} -O4 - - -BIN = ${HOME}/UNRES/bin/wham_multparm-T-procor.rts -LIBS = ${LIBSF_MPI} ../src_Tc/xdrf/libxdrf.a -#LIBS = ${LIBSF_MPI} - -ARCH = LINUX -PP = /lib/cpp -P - -all: unresCSA - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - - -objects = \ - wham_multparm.o \ - cxread.o \ - enecalc.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - store_parm.o \ - timing.o \ - wham_calc.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - - -unresCSA: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo | true - ${FC} ${FFLAGS} cinfo.f - ${FC} ${OPT} ${objects} ${objects_compar} cinfo.o ${LIBS} -o ${BIN} - - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_jump b/source/wham/src/Makefile_jump deleted file mode 100644 index e79c218..0000000 --- a/source/wham/src/Makefile_jump +++ /dev/null @@ -1,69 +0,0 @@ -BIN = ../bin -CC = cc -CFLAGS = -DAIX -c -FC = mpxlf90 -qlistopt -qfixed -w -OPT = -q64 -FFLAGS = -c ${OPT} -O3 -I./include_unres -#FFLAGS = -c ${OPT} -g -C -I./include_unres -LIBS = xdrf/libxdrf.o xdrf/ftocstr.o -CPPFLAGS = -WF,-DMPI -WF,-DAIX -WF,-DUNRES -WF,-DSPLITELE -WF,-DPROCOR -WF,-DISNAN - -.SUFFIXES: .F -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -.SUFFIXES: .c -.c.o: - ${CC} ${CFLAGS} $*.c - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-T-procor-c1 - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix b/source/wham/src/Makefile_matrix deleted file mode 100644 index d16bc8c..0000000 --- a/source/wham/src/Makefile_matrix +++ /dev/null @@ -1,67 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_intel-10.1_em64_ssh -BIN = ../bin -FC= ifort -#OPT = -mcmodel=medium -O3 -ip -w -OPT = -mcmodel=medium -g -CB -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DISNAN -DAMD64 - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -static-intel -o ${BIN}/wham_multparm-ham_rep - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI b/source/wham/src/Makefile_matrix_PGI deleted file mode 100644 index bb4982d..0000000 --- a/source/wham/src/Makefile_matrix_PGI +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -#OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -C -g -OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ - ${LIBS} -o ${BIN}/wham_multparm-hamrep-sep - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-SCT-oldparm b/source/wham/src/Makefile_matrix_PGI-SCT-oldparm deleted file mode 100644 index 82001ca..0000000 --- a/source/wham/src/Makefile_matrix_PGI-SCT-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCT -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o -Bstatic_pgi \ - ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCT-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm b/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm deleted file mode 100644 index 66ebf03..0000000 --- a/source/wham/src/Makefile_matrix_PGI-SCTF-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /users/software/mpich-1.2.7p1_pgi_9.0_64bit_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -DFUNCTH -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} -Bstatic_pgi cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCTF-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src/Makefile_matrix_PGI-oldparm b/source/wham/src/Makefile_matrix_PGI-oldparm deleted file mode 100644 index 1c9d56b..0000000 --- a/source/wham/src/Makefile_matrix_PGI-oldparm +++ /dev/null @@ -1,76 +0,0 @@ -INSTALL_DIR = /usr/local/mpich-1.2.7p1_pgi64-6.2-3_ssh -BIN = ../bin -CC = cc -FC = pgf90 -#FC = ifc -OPT = -mcmodel=medium -Mlarge_arrays -fast -pc 64 -tp amd64 -#OPT = -mcmodel=medium -Mlarge_arrays -tp amd64 -#FFLAGS = ${OPT} -g -c -I. -I./include_unres -I$(INSTALL_DIR)/include -#FFLAGS = ${OPT} -c -C -g -I. -I./include_unres -I$(INSTALL_DIR)/include -FFLAGS = ${OPT} -c -I. -I./include_unres -I$(INSTALL_DIR)/include -LIBS = -L$(INSTALL_DIR)/lib -lmpich -lpmpich xdrf/libxdrf.a -#LIBS = -L$(INSTALL_DIR)/lib_pgi -lmpich -lpmpich -Vaxlib -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DMOMENT -DCHECKGRAD -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DCHECKGRAD -DPGI -DMYGETENV -CPPFLAGS = -DMPI -DLINUX -DUNRES -DSPLITELE -DPROCOR -DPGI -DCRYST_BOND -DCRYST_SC -DCRYST_THETA -#CPPFLAGS = -DMPI -DLINUX -DUNRES -DPGI -#CPPFLAGS = -DMPI -DLINUX -DUNRES - -.f.o: - ${FC} ${FFLAGS} $*.f - -.F.o: - ${FC} ${FFLAGS} ${CPPFLAGS} $*.F - -all: make_dbase - -objects = \ - wham_multparm.o \ - bxread.o \ - xread.o \ - cxread.o \ - enecalc1.o \ - energy_p_new.o \ - initialize_p.o \ - molread_zs.o \ - openunits.o \ - readrtns.o \ - arcos.o \ - cartder.o \ - cartprint.o \ - chainbuild.o \ - geomout.o \ - icant.o \ - intcor.o \ - int_from_cart.o \ - make_ensemble1.o \ - matmult.o \ - misc.o \ - mygetenv.o \ - parmread.o \ - pinorm.o \ - printmat.o \ - proc_proc.o \ - rescode.o \ - setup_var.o \ - slices.o \ - store_parm.o \ - timing.o \ - wham_calc1.o - -objects_compar = \ - readrtns_compar.o \ - readpdb.o fitsq.o contact.o \ - elecont.o contfunc.o cont_frag.o conf_compar.o match_contact.o \ - angnorm.o odlodc.o promienie.o qwolynes.o read_ref_str.o \ - rmscalc.o secondary.o proc_cont.o define_pairs.o mysort.o - -make_dbase: ${objects} ${objects_compar} - cc -o compinfo compinfo.c - ./compinfo - ${FC} -c ${FFLAGS} cinfo.f - $(FC) ${OPT} ${objects} ${objects_compar} cinfo.o \ - ${LIBS} -o ${BIN}/wham_multparm-OPTERON-SCTF-sccor-oldparm - -clean: - /bin/rm *.o diff --git a/source/wham/src/arcos.f b/source/wham/src/arcos.f index 69810ea..afc6724 100644 --- a/source/wham/src/arcos.f +++ b/source/wham/src/arcos.f @@ -2,7 +2,7 @@ implicit real*8 (a-h,o-z) include 'COMMON.GEO' IF (DABS(X).LT.1.0D0) GOTO 1 - ARCOS=0.5D0*(PI+DSIGN(1.0D0,X)*PI) + ARCOS=0.5D0*(PI-DSIGN(1.0D0,X)*PI) RETURN 1 ARCOS=DACOS(X) RETURN diff --git a/source/wham/src/bxread.F b/source/wham/src/bxread.F index c459499..bebf420 100644 --- a/source/wham/src/bxread.F +++ b/source/wham/src/bxread.F @@ -22,7 +22,7 @@ real*4 csingle(3,maxres2) character*64 nazwa,bprotfile_temp character*3 liczba - integer i,is,ie,j,ii,jj,k,kk,l,ll,mm,if + integer i,is,ie,j,ii,jj,k,kk,l,ll,mm,if,m integer nrec,nlines,iscor,islice double precision energ integer ilen,iroof @@ -48,6 +48,8 @@ & eini,efree,rmsdev,(prop(j),j=1,nQ),iscor ii=ii+1 kk=kk+1 + write(iout,*) 'BXWEJ',eini,l + flush(iout) if (mod(kk,isampl(iparm)).eq.0) then jj=jj+1 write(ientout,rec=jj) @@ -56,16 +58,16 @@ & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,(prop(j),j=1,nQ),iR,ib,iparm #ifdef DEBUG - do i=1,2*nres + do l=1,2*nres do j=1,3 - c(j,i)=csingle(j,i) + c(j,l)=csingle(j,l) enddo enddo call int_from_cart1(.false.) write (iout,*) "Writing conformation, record",jj write (iout,*) "Cartesian coordinates" - write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres) - write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct) + write (iout,'(8f10.5)') ((c(j,m),j=1,3),m=1,nres) + write (iout,'(8f10.5)') ((c(j,m+nres),j=1,3),m=nnt,nct) write (iout,*) "Internal coordinates" write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) diff --git a/source/wham/src/cxread.F b/source/wham/src/cxread.F index 65372e3..a662f7a 100644 --- a/source/wham/src/cxread.F +++ b/source/wham/src/cxread.F @@ -70,8 +70,15 @@ c print *,"bumbum" write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss #endif do j=1,nss + if (dyn_ss) then + call xdrfint_(ixdrf, idssb(j), iret) + call xdrfint_(ixdrf, jdssb(j), iret) + idssb(j)=idssb(j)-nres + jdssb(j)=jdssb(j)-nres + else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) + endif enddo call xdrfint_(ixdrf, nprop, iret) if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) @@ -96,8 +103,16 @@ c print *,"bumbum" write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss #endif do j=1,nss + if (dyn_ss) then + call xdrfint(ixdrf, idssb(j), iret) + call xdrfint(ixdrf, jdssb(j), iret) +cc idssb(j)=idssb(j)-nres +cc jdssb(j)=jdssb(j)-nres +cc write(iout,*) idssb(j),jdssb(j) + else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) + endif enddo call xdrfint(ixdrf, nprop, iret) c write (iout,*) "nprop",nprop diff --git a/source/wham/src/cxread.F.orig b/source/wham/src/cxread.F.orig deleted file mode 100644 index c09d1df..0000000 --- a/source/wham/src/cxread.F.orig +++ /dev/null @@ -1,330 +0,0 @@ - subroutine cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,*) - implicit real*8 (a-h,o-z) - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'DIMENSIONS.FREE' - integer MaxTraj - parameter (MaxTraj=2050) - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.NAMES' - include 'COMMON.IOUNITS' - include 'COMMON.HEADER' - include 'COMMON.SBRIDGE' - include 'COMMON.PROTFILES' - include 'COMMON.OBCINKA' - include 'COMMON.FREE' - include 'COMMON.VAR' - include 'COMMON.GEO' - include 'COMMON.PROT' - character*64 nazwa,bprotfile_temp - real*4 rtime,rpotE,ruconst,rt_bath,rprop(maxQ) - double precision time - integer iret,itmp,itraj,ntraj - real xoord(3,maxres2+2),prec - integer nstep(0:MaxTraj-1) - integer ilen - external ilen - integer ii,jj(maxslice),kk(maxslice),ll(maxslice),mm(maxslice) - integer is(MaxSlice),ie(MaxSlice),nrec_slice - double precision ts(MaxSlice),te(MaxSlice),time_slice - integer slice - logical conf_check - call set_slices(is,ie,ts,te,iR,ib,iparm) - - do i=1,nQ - rprop(i)=0.0d0 - enddo - do i=0,MaxTraj-1 - nstep(i)=0 - enddo - ntraj=0 - it=0 - iret=1 -#if (defined(AIX) && !defined(JUBL)) - call xdrfopen_(ixdrf,nazwa, "r", iret) -#else - call xdrfopen(ixdrf,nazwa, "r", iret) -#endif - if (iret.eq.0) return1 - - islice1=1 - call opentmp(islice1,ientout,bprotfile_temp) -c print *,"bumbum" - do while (iret.gt.0) - -#if (defined(AIX) && !defined(JUBL)) -#ifdef DEBUG - write (iout,*) "ii",ii," itraj",itraj," it",it -#endif - call xdrffloat_(ixdrf, rtime, iret) - call xdrffloat_(ixdrf, rpotE, iret) -#ifdef DEBUG - write (iout,*) "rtime",rtime," rpotE",rpotE," iret",iret -#endif - call flush(iout) - call xdrffloat_(ixdrf, ruconst, iret) - call xdrffloat_(ixdrf, rt_bath, iret) - call xdrfint_(ixdrf, nss, iret) -#ifdef DEBUG - write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss -#endif - do j=1,nss - call xdrfint_(ixdrf, ihpb(j), iret) - call xdrfint_(ixdrf, jhpb(j), iret) - enddo - call xdrfint_(ixdrf, nprop, iret) - if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) - & call xdrfint(ixdrf, iset, iret) - do i=1,nprop - call xdrffloat_(ixdrf, rprop(i), iret) - enddo -#else -#ifdef DEBUG - write (iout,*) "ii",ii," itraj",itraj," it",it -#endif - call xdrffloat(ixdrf, rtime, iret) - call xdrffloat(ixdrf, rpotE, iret) -#ifdef DEBUG - write (iout,*) "rtime",rtime," rpotE",rpotE," iret",iret -#endif - call flush(iout) - call xdrffloat(ixdrf, ruconst, iret) - call xdrffloat(ixdrf, rt_bath, iret) - call xdrfint(ixdrf, nss, iret) -#ifdef DEBUG - write (iout,*) "ruconst",ruconst," rt_bath",rt_bath," nss",nss -#endif - do j=1,nss - call xdrfint(ixdrf, ihpb(j), iret) - call xdrfint(ixdrf, jhpb(j), iret) - enddo - call xdrfint(ixdrf, nprop, iret) -#ifdef DEBUG - write (iout,*) "nprop",nprop - call flush(iout) -#endif - if (it.gt.0 .and. nprop.ne.nprop_prev) then - write (iout,*) "Warning previous nprop",nprop_prev, - & " current",nprop - nprop=nprop_prev - else - nprop_prev=nprop - endif - if (umbrella(iparm) .or. read_iset(iparm) .or. hamil_rep) - & call xdrfint(ixdrf, iset, iret) - do i=1,nprop - call xdrffloat(ixdrf, rprop(i), iret) - enddo -#ifdef DEBUG - write (iout,*) "rprop",(rprop(i),i=1,nprop) - call flush(iout) -#endif -#endif - if (iret.eq.0) exit - itraj=mod(it,totraj(iR,iparm)) - if (iset.eq.0) iset = 1 - call flush(iout) - it=it+1 - if (itraj.gt.ntraj) ntraj=itraj - nstep(itraj)=nstep(itraj)+1 -c rprop(2)=dsqrt(rprop(2)) -c rprop(3)=dsqrt(rprop(3)) -#ifdef DEBUG - write (iout,*) "umbrella ",umbrella - write (iout,*) rtime,rpotE,rt_bath,nss, - & (ihpb(j),jhpb(j),j=1,nss),(rprop(j),j=1,nprop) - write (iout,*) "nprop",nprop," iset",iset," myparm",myparm - call flush(iout) -#endif - prec=10000.0 - - itmp=0 -#if (defined(AIX) && !defined(JUBL)) - call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) -#else - call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret) -#endif -#ifdef DEBUG - write (iout,'(10f8.3)') ((xoord(j,i),j=1,3),i=1,itmp) -#endif - if (iret.eq.0) exit - if (itmp .ne. nres + nct - nnt + 1) then - write (iout,*) "Error: inconsistent sizes",itmp,nres+nct-nnt+1 - call flush(iout) - exit - endif - - time=rtime -#ifdef DEBUG - write (iout,*) "calling slice" - call flush(iout) -#endif - islice=slice(nstep(itraj),time,is,ie,ts,te) -#ifdef DEBUG - write (iout,*) "islice",islice - call flush(iout) -#endif - do i=1,nres - do j=1,3 - c(j,i)=xoord(j,i) - enddo - enddo - do i=1,nct-nnt+1 - do j=1,3 - c(j,i+nres+nnt-1)=xoord(j,i+nres) - enddo - enddo - -c write (iout,*) "islice",islice," nslice",nslice, -c & " separate_parset",separate_parset," iset",iset," myparm",myparm -c call flush(iout) - if (islice.gt.0 .and. islice.le.nslice .and. (.not.separate_parset - & .or. iset.eq.myparm)) then - ii=ii+1 - kk(islice)=kk(islice)+1 - mm(islice)=mm(islice)+1 -#ifdef DEBUG - write (iout,*) "islice",islice," kk",kk(islice)," mm",mm(islice) - write (iout,*) "itraj",itraj," nstep",nstep(itraj), - & " iparm",iparm," isampl",isampl(iparm) - call flush(iout) - write (iout,*) "islice",islice," ll",ll(islice)," conf_check ", - & conf_check(ll(islice)+1,1) - call flush(iout) -#endif - if (mod(nstep(itraj),isampl(iparm)).eq.0 .and. - & conf_check(ll(islice)+1,1)) then - if (replica(iparm)) then - rt_bath=1.0d0/(rt_bath*1.987D-3) - do i=1,nT_h(iparm) - if (abs(real(beta_h(i,iparm))-rt_bath).lt.1.0e-4) then - iib = i - goto 22 - endif - enddo - 22 continue - if (i.gt.nT_h(iparm)) then - write (iout,*) "Error - temperature of conformation", - & ii,1.0d0/(rt_bath*1.987D-3), - & " does not match any of the list" - write (iout,*) - & 1.0d0/(rt_bath*1.987D-3), - & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) - call flush(iout) -c exit -c call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE) - ii=ii-1 - kk(islice)=kk(islice)-1 - mm(islice)=mm(islice)-1 - goto 112 - endif - else - iib = ib - endif - - efree=0.0d0 - jj(islice)=jj(islice)+1 - write (iout,*) "islice",islice," jj",jj(islice) - call flush(iout) - if (umbrella(iparm)) then - snk(iset,iib,iparm,islice)=snk(iset,iib,iparm,islice)+1 - else if (hamil_rep) then - snk(1,iib,iparm,islice)=snk(1,iib,iparm,islice)+1 - else - snk(iR,iib,iparm,islice)=snk(iR,iib,iparm,islice)+1 - endif - ll(islice)=ll(islice)+1 -#ifdef DEBUG - write (iout,*) "Writing conformation, record",ll(islice) - write (iout,*) "ib",ib," iib",iib - write (iout,*) "ntraj",ntraj," itraj",itraj, - & " nstep",nstep(itraj) - write (iout,*) "pote",rpotE," time",rtime -c if (replica(iparm)) then -c write (iout,*) "TEMP",1.0d0/(rt_bath*1.987D-3) -c write (iout,*) "TEMP list" -c write (iout,*) -c & (1.0d0/(beta_h(i,iparm)*1.987D-3),i=1,nT_h(iparm)) -c endif - write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ -c write (iout,*) "nres",nres," nnt",nnt," nct",nct," nss",nss -c write (iout,*) "length",nres*4+(nct-nnt+1)*4+4+2*nss*4 - call flush(iout) -#endif - if (islice.ne.islice1) then -c write (iout,*) "islice",islice," islice1",islice1 - close(ientout) -c write (iout,*) "Closing file ", -c & bprotfile_temp(:ilen(bprotfile_temp)) - call opentmp(islice,ientout,bprotfile_temp) -c write (iout,*) "Opening file ", -c & bprotfile_temp(:ilen(bprotfile_temp)) - islice1=islice - endif - if (umbrella(iparm)) then - write(ientout,rec=ll(islice)) - & ((xoord(l,k),l=1,3),k=1,nres), - & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1), - & nss,(ihpb(k),jhpb(k),k=1,nss), - & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ), - & iset,iib,iparm - else if (hamil_rep) then - write(ientout,rec=ll(islice)) - & ((xoord(l,k),l=1,3),k=1,nres), - & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1), - & nss,(ihpb(k),jhpb(k),k=1,nss), - & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ), - & iR,iib,iset - else - write(ientout,rec=ll(islice)) - & ((xoord(l,k),l=1,3),k=1,nres), - & ((xoord(l,k),l=1,3),k=nres+1,nres+nct-nnt+1), - & nss,(ihpb(k),jhpb(k),k=1,nss), - & rpotE+0.0d0,efree,rmsdev,(rprop(i)+0.0d0,i=1,nQ), - & iR,iib,iparm - endif -#ifdef DEBUG - call int_from_cart1(.false.) - write (iout,*) "Writing conformation, record",ll(islice) - write (iout,*) "Cartesian coordinates" - write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres) - write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct) - write (iout,*) "Internal coordinates" - write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) - write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct) - write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres) - write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres) - write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1) - write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1) - write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss) -c write (iout,'(8f10.5)') (rprop(j),j=1,nQ) - write (iout,'(16i5)') iscor - call flush(iout) -#endif - endif - endif - - 112 continue - - enddo - close(ientout) -#if (defined(AIX) && !defined(JUBL)) - call xdrfclose_(ixdrf, iret) -#else - call xdrfclose(ixdrf, iret) -#endif - write (iout,'(i10," trajectories found in file.")') ntraj+1 - write (iout,'(a)') "Numbers of steps in trajectories:" - write (iout,'(8i10)') (nstep(i),i=0,ntraj) - write (iout,*) ii," conformations read from file", - & nazwa(:ilen(nazwa)) - do islice=1,nslice - write (iout,*) mm(islice)," conformations read so far, slice", - & islice - write (iout,*) ll(islice), - & " conformations stored so far, slice",islice - enddo - call flush(iout) - return - end diff --git a/source/wham/src/enecalc1.F b/source/wham/src/enecalc1.F index 4b9414d..c71b9c0 100644 --- a/source/wham/src/enecalc1.F +++ b/source/wham/src/enecalc1.F @@ -44,8 +44,9 @@ double precision fT(6),quot,quotl,kfacl,kfac /2.4d0/,T0 /3.0d2/ double precision tt integer snk_p(MaxR,MaxT_h,Max_parm) + integer scount_(0:MaxProcs) logical lerr - character*64 bprotfile_temp + character*128 bprotfile_temp call opentmp(islice,ientout,bprotfile_temp) iii=0 ii=0 @@ -75,6 +76,7 @@ & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar +cc write(iout,*), 'NAWEJ',i,eini if (indpdb.gt.0) then do k=1,nres do l=1,3 @@ -153,7 +155,6 @@ c & " kfac",kfac,"quot",quot," fT",fT & wtor_d,wsccor,wbond #endif call etotal(energia(0),fT) -#define DEBUG #ifdef DEBUG write (iout,*) "Conformation",i call enerprint(energia(0),fT) @@ -161,7 +162,6 @@ c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors",ftors c call intout #endif -#undef DEBUG if (energia(0).ge.1.0d20) then write (iout,*) "NaNs detected in some of the energy", & " components for conformation",ii+1 @@ -196,6 +196,11 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) & " the value read in: ",energia(0),eini," point", & iii+1,indstart(me1)+iii," T", & 1.0d0/(1.987D-3*beta_h(ib,ipar)) + call enerprint(energia(0),fT) + call pdbout(iii+1,beta_h(ib,ipar), + & eini,energia(0),0.0d0,rmsdev) + write (iout,*) + errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) & write (iout,*) "Too many warning messages" @@ -214,6 +219,8 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) do k=1,21 enetb(k,iii+1,iparm)=energia(k) enddo +c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i) +c call enerprint(energia(0),fT) #ifdef DEBUG write (iout,'(2i5,f10.1,3e15.5)') i,iii, & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree @@ -263,11 +270,12 @@ c & " snk",snk_p(iR,ib,ipar) 121 continue enddo #ifdef MPI - scount(me)=iii +c scount(me)=iii + scount_(me)=iii write (iout,*) "Me",me," scount",scount(me) call flush(iout) c Master gathers updated numbers of conformations written by all procs. - call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1, + call MPI_AllGather( scount_(me), 1, MPI_INTEGER, scount(0), 1, & MPI_INTEGER, WHAM_COMM, IERROR) indstart(0)=1 indend(0)=scount(0) @@ -342,7 +350,7 @@ c------------------------------------------------------------------------------ include "COMMON.PROT" character*64 nazwa character*80 bxname,cxname - character*64 bprotfile_temp + character*128 bprotfile_temp character*3 liczba,licz character*2 licz2 integer i,itj,ii,iii,j,k,l @@ -437,12 +445,22 @@ c------------------------------------------------------------------------------ #else do i=1,ntot(islice) #endif +cc if (dyn_ss) then +cc read(ientout,rec=i,err=101) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k),jdssb(k),k=1,nss), +cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm +cc idssb(k)=idssb(k)-nres +cc jdssb(k)=jdssb(k)-nres +cc else read(ientout,rec=i,err=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm -c write (iout,*) iR,ib,iparm,eini,efree +cc endif +cc write (iout,*) 'CC', iR,ib,iparm,eini,efree do j=1,2*nres do k=1,3 c(k,j)=csingle(k,j) @@ -452,14 +470,24 @@ c write (iout,*) iR,ib,iparm,eini,efree iscore=0 if (indpdb.gt.0) then call conf_compar(i,.false.,.true.) - endif + endif +c if (dyn_ss) then if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), c & potE(i,iparm),-entfac(i),rms_nat,iscore & potE(i,nparmset),-entfac(i),rms_nat,iscore -c write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i) +c else + if (bxfile .or.cxfile .or. ensembles.gt.0) write + & (ientin,rec=i) + & ((csingle(l,k),l=1,3),k=1,nres), + & ((csingle(l,k+nres),l=1,3),k=nnt,nct), + & nss,(ihpb(k),jhpb(k),k=1,nss), +c & potE(i,iparm),-entfac(i),rms_nat,iscore + & potE(i,nparmset),-entfac(i),rms_nat,iscore +c endif + write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i) #ifndef MPI if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset), & -entfac(i),rms_nat,iscore) @@ -538,17 +566,37 @@ c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j) c call flush(iout) do i=indstart(j),indend(j) iii = iii+1 +cc if (dyn_ss) then +cc read(ientin,rec=iii,err=101) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k),jdssb(k),k=1,nss), +cc & eini,efree,rmsdev,iscor +cc idssb(k)=idssb(k)-nres +cc jdssb(k)=jdssb(k)-nres +cc else read(ientin,rec=iii,err=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,iscor +cc endif if (bxfile .or. ensembles.gt.0) then - write (ientout,rec=i) +cc if (dyn_ss) then +cc write (ientout,rec=i) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss), +cc & eini,efree,rmsdev,iscor +cc else + write (ientout,rec=i) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,iscor +cc write(iout,*) "W poszukiwaniu zlotych galotow" +cc write(iout,*) "efree=",efree,iii +cc endif endif if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) #ifdef DEBUG @@ -642,6 +690,7 @@ c call flush(iout) c write (iout,*) "itmp",itmp c call flush(iout) +c write (iout,*) "CNZ",eini,dyn_ss #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) @@ -649,8 +698,13 @@ c write (iout,*) "xdrf3dfcoord" c call flush(iout) call xdrfint_(ixdrf, nss, iret) do j=1,nss +cc if (dyn_ss) then +cc call xdrfint_(ixdrf, idssb(j)+nres, iret) +cc call xdrfint_(ixdrf, jdssb(j)+nres, iret) +cc else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) +cc endif enddo call xdrffloat_(ixdrf,real(eini),iret) call xdrffloat_(ixdrf,real(efree),iret) @@ -661,11 +715,18 @@ c call flush(iout) call xdrfint(ixdrf, nss, iret) do j=1,nss +cc if (dyn_ss) then +cc call xdrfint(ixdrf, idssb(j), iret) +cc call xdrfint(ixdrf, jdssb(j), iret) +cc idssb(j)=idssb(j)-nres +cc jdssb(j)=jdssb(j)-nres +cc else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) +cc endif enddo call xdrffloat(ixdrf,real(eini),iret) - call xdrffloat(ixdrf,real(efree),iret) + call xdrffloat(ixdrf,real(efree),iret) call xdrffloat(ixdrf,real(rmsdev),iret) call xdrfint(ixdrf,iscor,iret) #endif diff --git a/source/wham/src/energy_p_new.F b/source/wham/src/energy_p_new.F index 9b69cf7..652749c 100644 --- a/source/wham/src/energy_p_new.F +++ b/source/wham/src/energy_p_new.F @@ -107,7 +107,7 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2+welec*fact(1)*ees & +wvdwpp*evdw1 & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d @@ -116,7 +116,7 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t etot=wsc*(evdw+fact(6)*evdw_t)+wscp*evdw2 & +welec*fact(1)*(ees+evdw1) & +wang*ebe+wtor*fact(1)*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 + & +wstrain*ehpb+wcorr*fact(3)*ecorr+wcorr5*fact(4)*ecorr5 & +wcorr6*fact(5)*ecorr6+wturn4*fact(3)*eello_turn4 & +wturn3*fact(2)*eello_turn3+wturn6*fact(5)*eturn6 & +wel_loc*fact(2)*eel_loc+edihcnstr+wtor_d*fact(2)*etors_d @@ -154,6 +154,7 @@ c write (iout,*) "ft(6)",fact(6)," evdw",evdw," evdw_t",evdw_t energia(19)=esccor energia(20)=edihcnstr energia(21)=evdw_t +c if (dyn_ss) call dyn_set_nss c detecting NaNQ #ifdef ISNAN #ifdef AIX @@ -770,6 +771,7 @@ C include 'COMMON.ENEPS' include 'COMMON.IOUNITS' include 'COMMON.CALC' + include 'COMMON.SBRIDGE' logical lprn common /srutu/icall integer icant @@ -800,6 +802,21 @@ C Calculate SC interaction energy. C do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) +C in case of diagnostics write (iout,*) "TU SZUKAJ",i,j,dyn_ss_mask(i),dyn_ss_mask(j) +C /06/28/2013 Adasko: In case of dyn_ss - dynamic disulfide bond +C formation no electrostatic interactions should be calculated. If it +C would be allowed NaN would appear + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN +C /06/28/2013 Adasko: dyn_ss_mask is logical statement wheather this Cys +C residue can or cannot form disulfide bond. There is still bug allowing +C Cys...Cys...Cys bond formation + call dyn_ssbond_ene(i,j,evdwij) +C /06/28/2013 Adasko: dyn_ssbond_ene is dynamic SS bond foration energy +C function in ssMD.F + evdw=evdw+evdwij +c if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') +c & 'evdw',i,j,evdwij,' ss' + ELSE ind=ind+1 itypj=itype(j) dscj_inv=vbld_inv(j+nres) @@ -866,6 +883,7 @@ c--------------------------------------------------------------- c write (iout,*) "i",i," j",j," itypi",itypi," itypj",itypj, c & " ij",ij," eneps",aux*e1/dabs(eps(itypi,itypj)), c & aux*e2/eps(itypi,itypj) +c write (iout,'(a6,2i5,0pf7.3)') 'evdw',i,j,evdwij if (lprn) then sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) epsi=bb(itypi,itypj)**2/aa(itypi,itypj) @@ -889,6 +907,7 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. call sc_grad endif + ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i @@ -2869,24 +2888,16 @@ C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. C implicit real*8 (a-h,o-z) include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' include 'COMMON.SBRIDGE' include 'COMMON.CHAIN' include 'COMMON.DERIV' include 'COMMON.VAR' include 'COMMON.INTERACT' include 'COMMON.IOUNITS' - include 'COMMON.NAMES' dimension ggg(3) ehpb=0.0D0 -#ifdef DEBUG - do i=1,nres - write (iout,'(a4,2x,i4,3f10.5,5x,3f10.5)') restyp(itype(i)),i, - & (c(j,i),j=1,3),(c(j,i+nres),j=1,3) - enddo cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr cd write(iout,*)'link_start=',link_start,' link_end=',link_end -#endif if (link_end.eq.0) return do i=link_start,link_end C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a @@ -2901,15 +2912,16 @@ C iii and jjj point to the residues for which the distance is assigned. iii=ii jjj=jj endif -#ifdef DEBUG - write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, - & dhpb(i),dhpb1(i),forcon(i) -#endif +c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, +c & dhpb(i),dhpb1(i),forcon(i) C 24/11/03 AL: SS bridges handled separately because of introducing a specific C distance and angle dependent SS bond potential. + if (.not.dyn_ss .and. i.le.nss) then +C 15/02/13 CC dynamic SSbond - additional check if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij + endif cd write (iout,*) "eij",eij else if (ii.gt.nres .and. jj.gt.nres) then c Restraints from contact prediction @@ -2917,10 +2929,8 @@ c Restraints from contact prediction if (dhpb1(i).gt.0.0d0) then ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -#ifdef DEBUG - write (iout,*) "beta nmr", - & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) -#endif +c write (iout,*) "beta nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) else dd=dist(ii,jj) rdis=dd-dhpb(i) @@ -2928,9 +2938,7 @@ C Get the force constant corresponding to this distance. waga=forcon(i) C Calculate the contribution to energy. ehpb=ehpb+waga*rdis*rdis -#ifdef DEBUG - write (iout,*) "beta reg",dd,waga*rdis*rdis -#endif +c write (iout,*) "beta reg",dd,waga*rdis*rdis C C Evaluate gradient. C @@ -2954,19 +2962,15 @@ C target distance. if (dhpb1(i).gt.0.0d0) then ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd -#ifdef DEBUG - write (iout,*) "alph nmr", - & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) -#endif +c write (iout,*) "alph nmr", +c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) else rdis=dd-dhpb(i) C Get the force constant corresponding to this distance. waga=forcon(i) C Calculate the contribution to energy. ehpb=ehpb+waga*rdis*rdis -#ifdef DEBUG - write (iout,*) "alpha reg",dd,waga*rdis*rdis -#endif +c write (iout,*) "alpha reg",dd,waga*rdis*rdis C C Evaluate gradient. C @@ -3050,11 +3054,12 @@ C deltat12=om2-om1+2.0d0 cosphi=om12-om1*om2 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) - & +akct*deltad*deltat12 + & +akct*deltad*deltat12+ebr +c & +akct*deltad*deltat12 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi -c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -c & " deltat12",deltat12," eij",eij + write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, + & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, + & " deltat12",deltat12," eij",eij,"ebr",ebr ed=2*akcm*deltad+akct*deltat12 pom1=akct*deltad pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi @@ -3099,6 +3104,7 @@ c include 'COMMON.FFIELD' include 'COMMON.CONTROL' double precision u(3),ud(3) + logical :: lprn=.false. estr=0.0d0 do i=nnt+1,nct diff = vbld(i)-vbldp0 @@ -3118,8 +3124,9 @@ c nbi=nbondterm(iti) if (nbi.eq.1) then diff=vbld(i+nres)-vbldsc0(1,iti) -c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, -c & AKSC(1,iti),AKSC(1,iti)*diff*diff + if (lprn) + & write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, + & AKSC(1,iti),AKSC(1,iti)*diff*diff estr=estr+0.5d0*AKSC(1,iti)*diff*diff do j=1,3 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) @@ -3148,8 +3155,9 @@ c & AKSC(1,iti),AKSC(1,iti)*diff*diff usum=usum+uprod1 usumsqder=usumsqder+ud(j)*uprod2 enddo -c write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti), -c & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi) + if (lprn) + & write (iout,*) i,iti,vbld(i+nres),(vbldsc0(j,iti), + & AKSC(j,iti),abond0(j,iti),u(j),j=1,nbi) estr=estr+uprod/usum do j=1,3 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) @@ -3429,6 +3437,8 @@ C etheta=0.0D0 c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) do i=ithet_start,ithet_end + if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. + &(itype(i).eq.ntyp1)) cycle dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 @@ -3438,7 +3448,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3) then + if (i.gt.3 .and. itype(max0(i-3,1)).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 @@ -3452,13 +3462,13 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres) then + if (i.lt.nres .and. itype(i+1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -3473,7 +3483,7 @@ c write (iout,*) "ithetyp",(ithetyp(i),i=1,ntyp1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 + ityp3=ithetyp(itype(i)) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -3582,10 +3592,13 @@ c call flush(iout) enddo enddo 10 continue - if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') - & i,theta(i)*rad2deg,phii*rad2deg, +c lprn1=.true. + if (lprn1) write (iout,'(a4,i2,3f8.1,9h ethetai ,f10.5)') + & 'ebe',i,theta(i)*rad2deg,phii*rad2deg, & phii1*rad2deg,ethetai +c lprn1=.false. etheta=etheta+ethetai + if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 gloc(nphi+i-2,icg)=wang*dethetai @@ -4021,7 +4034,8 @@ c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) escloc = escloc + sumene c write (2,*) "escloc",escloc if (.not. calc_grad) goto 1 -#ifdef DEBUG + +#ifdef DEBUG2 C C This section to check the numerical derivatives of the energy of ith side C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert @@ -4556,6 +4570,8 @@ c write (iout,*) "EBACK_SC_COR",itau_start,itau_end,nterm_sccor esccor=0.0D0 do i=itau_start,itau_end esccor_ii=0.0D0 + + if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle isccori=isccortyp(itype(i-2)) isccori1=isccortyp(itype(i-1)) phii=phi(i) @@ -4589,6 +4605,9 @@ c 3 = SC...Ca...Ca...SCi cosphi=dcos(j*tauangle(intertyp,i)) sinphi=dsin(j*tauangle(intertyp,i)) esccor=esccor+v1ij*cosphi+v2ij*sinphi +#ifdef DEBUG + esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi +#endif gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci @@ -6474,7 +6493,7 @@ c---------------------------------------------------------------------------- include 'COMMON.GEO' logical swap double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), - & auxvec1(2),auxvec2(1),auxmat1(2,2) + & auxvec1(2),auxvec2(2),auxmat1(2,2) logical lprn common /kutas/ lprn CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC diff --git a/source/wham/src/geomout.F b/source/wham/src/geomout.F index 9506eed..35f3d77 100644 --- a/source/wham/src/geomout.F +++ b/source/wham/src/geomout.F @@ -40,7 +40,11 @@ write (ipdb,30) ica(nct),ica(nct)+1 endif do i=1,nss +c if(dyn_ss) then +c write (ipdb,30) ica(idssb(i))+1,ica(jdssb(i))+1 +c else write (ipdb,30) ica(ihpb(i))+1,ica(jhpb(i))+1 +c endif enddo 10 FORMAT ('ATOM',I7,' CA ',A3,I6,4X,3F8.3) 20 FORMAT ('ATOM',I7,' CB ',A3,I6,4X,3F8.3) diff --git a/source/wham/src/include_unres/COMMON.NAMES b/source/wham/src/include_unres/COMMON.NAMES deleted file mode 100644 index a266339..0000000 --- a/source/wham/src/include_unres/COMMON.NAMES +++ /dev/null @@ -1,7 +0,0 @@ - character*3 restyp - character*1 onelet - common /names/ restyp(ntyp+1),onelet(ntyp+1) - character*10 ename,wname - integer nprint_ene,print_order - common /namterm/ ename(max_ene),wname(max_ene),nprint_ene, - & print_order(max_ene) diff --git a/source/wham/src/include_unres/COMMON.SBRIDGE b/source/wham/src/include_unres/COMMON.SBRIDGE index 7bba010..f866aa7 100644 --- a/source/wham/src/include_unres/COMMON.SBRIDGE +++ b/source/wham/src/include_unres/COMMON.SBRIDGE @@ -1,10 +1,17 @@ - double precision ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,dhpb, - & dhpb1,forcon,weidis - integer ns,nss,nfree,iss,ihpb,jhpb,nhpb,link_start,link_end, - & ibecarb - common /sbridge/ ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss,ns,nss, - & nfree,iss(maxss) + double precision ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss + integer ns,nss,nfree,iss + common /sbridge/ ss_depth,ebr,d0cm,akcm,akth,akct,v1ss,v2ss,v3ss, + & ns,nss,nfree,iss(maxss) + double precision dhpb,dhpb1,forcon + integer ihpb,jhpb,nhpb,idssb,jdssb,ibecarb common /links/ dhpb(maxdim),dhpb1(maxdim),forcon(maxdim), & ihpb(maxdim),jhpb(maxdim),ibecarb(maxdim),nhpb + double precision weidis common /restraints/ weidis + integer link_start,link_end common /links_split/ link_start,link_end + double precision Ht,dyn_ssbond_ij + logical dyn_ss,dyn_ss_mask + common /dyn_ssbond/ dyn_ssbond_ij(maxres,maxres), + & idssb(maxdim),jdssb(maxdim), + & Ht,dyn_ss,dyn_ss_mask(maxres) diff --git a/source/wham/src/include_unres/COMMON.SCCOR b/source/wham/src/include_unres/COMMON.SCCOR index 28d748a..b9ec40d 100644 --- a/source/wham/src/include_unres/COMMON.SCCOR +++ b/source/wham/src/include_unres/COMMON.SCCOR @@ -4,15 +4,17 @@ cc Parameters of the SCCOR term & dcostau,dsintau,dtauangle,dcosomicron, & domicron,v0sccor integer nterm_sccor,isccortyp,nsccortyp,nlor_sccor - common /sccor/ v1sccor(maxterm_sccor,3,20,20), - & v2sccor(maxterm_sccor,3,20,20), - & v0sccor(ntyp,ntyp), - & vlor1sccor(maxterm_sccor,20,20), - & vlor2sccor(maxterm_sccor,20,20), - & vlor3sccor(maxterm_sccor,20,20),gloc_sc(3,0:maxres2,10), + common /sccor/ v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp), + & v0sccor(-ntyp:ntyp,-ntyp:ntyp), + & vlor1sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor2sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & vlor3sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp), + & gloc_sc(3,0:maxres2,10), & dcostau(3,3,3,maxres2),dsintau(3,3,3,maxres2), & dtauangle(3,3,3,maxres2),dcosomicron(3,3,3,maxres2), & domicron(3,3,3,maxres2), - & nterm_sccor(ntyp,ntyp),isccortyp(ntyp),nsccortyp, - & nlor_sccor(ntyp,ntyp) + & nterm_sccor(-ntyp:ntyp,-ntyp:ntyp),isccortyp(-ntyp:ntyp), + & nsccortyp, + & nlor_sccor(-ntyp:ntyp,-ntyp:ntyp) diff --git a/source/wham/src/include_unres/COMMON.VAR b/source/wham/src/include_unres/COMMON.VAR deleted file mode 100644 index d560c87..0000000 --- a/source/wham/src/include_unres/COMMON.VAR +++ /dev/null @@ -1,21 +0,0 @@ -C Store the geometric variables in the following COMMON block. - integer ntheta,nphi,nside,nvar,Origin,nstore,ialph,ivar, - & mask_theta,mask_phi,mask_side - double precision theta,phi,alph,omeg,varsave,esave,varall,vbld, - & thetaref,phiref,costtab,sinttab,cost2tab,sint2tab, - & xxtab,yytab,zztab,xxref,yyref,zzref - common /var/ theta(maxres),phi(maxres),alph(maxres),omeg(maxres), - & omicron(2,maxres),tauangle(3,maxres), - & vbld(2*maxres),thetaref(maxres),phiref(maxres), - & costtab(maxres), sinttab(maxres), cost2tab(maxres), - & sint2tab(maxres),xxtab(maxres),yytab(maxres), - & zztab(maxres),xxref(maxres),yyref(maxres),zzref(maxres), - & ialph(maxres,2),ivar(4*maxres2),ntheta,nphi,nside,nvar -C Store the angles and variables corresponding to old conformations (for use -C in MCM). - common /oldgeo/ varsave(maxvar,maxsave),esave(maxsave), - & Origin(maxsave),nstore -C freeze some variables - logical mask_r - common /restr/ varall(maxvar),mask_r,mask_theta(maxres), - & mask_phi(maxres),mask_side(maxres) diff --git a/source/wham/src/initialize_p.F b/source/wham/src/initialize_p.F index 7ca29e0..6631c8a 100644 --- a/source/wham/src/initialize_p.F +++ b/source/wham/src/initialize_p.F @@ -159,6 +159,9 @@ C Initialize the bridge arrays ihpb(i)=0 jhpb(i)=0 enddo + do i=1,maxres + dyn_ss_mask(i)=.false. + enddo C C Initialize timing. C @@ -233,7 +236,7 @@ c------------------------------------------------------------------------- data wname / & "WSC","WSCP","WELEC","WCORR","WCORR5","WCORR6","WEL_LOC", & "WTURN3","WTURN4","WTURN6","WANG","WSCLOC","WTOR","WTORD", - & "WHPB","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC"/ + & "WSTRAIN","WVDWPP","WSCP14","WBOND","WSCCOR","WDIHC","WSC"/ data ww0 /1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0, & 1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,1.0d0,0.4d0,1.0d0,1.0d0, & 0.0d0,0.0/ @@ -296,6 +299,7 @@ cd write (iout,*) 'ns=',ns,' nss=',nss,' ihpb,jhpb', cd & (ihpb(i),jhpb(i),i=1,nss) do i=nnt,nct-1 scheck=.false. + if (dyn_ss) go to 10 do ii=1,nss if (ihpb(ii).eq.i+nres) then scheck=.true. @@ -465,7 +469,7 @@ cd write (iout,*) 'i.gt.nct-iscp' endif enddo ! i #endif - if (lprint) then + if (lprint) then write (iout,'(a)') 'SC-p interaction array:' do i=iatscp_s,iatscp_e write (iout,'(i3,2(2x,2i3))') diff --git a/source/wham/src/make_ensemble1.F b/source/wham/src/make_ensemble1.F index 5d7b750..5402f2c 100644 --- a/source/wham/src/make_ensemble1.F +++ b/source/wham/src/make_ensemble1.F @@ -34,7 +34,7 @@ character*5 ctemper integer ilen external ilen - real*4 Fdimless(MaxStr) + real*4 Fdimless(MaxStr),Fdimless_(MaxStr) double precision enepot(MaxStr) integer iperm(MaxStr) integer islice @@ -166,7 +166,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc @@ -176,7 +176,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr @@ -184,11 +184,11 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft & +wbond*estr #endif #ifdef MPI - Fdimless(i)= + Fdimless_(i)= & beta_h(ib,iparm)*etot-entfac(i) potE(i,iparm)=etot #ifdef DEBUG - write (iout,*) i,indstart(me)+i-1,ib, + write (iout,*) 'EEE',i,indstart(me)+i-1,ib, & 1.0d0/(1.987d-3*beta_h(ib,iparm)),potE(i,iparm), & -entfac(i),Fdimless(i) #endif @@ -198,7 +198,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft #endif enddo ! i #ifdef MPI - call MPI_Gatherv(Fdimless(1),scount(me), + call MPI_Gatherv(Fdimless_(1),scount(me), & MPI_REAL,Fdimless(1), & scount(0),idispl(0),MPI_REAL,Master, & WHAM_COMM, IERROR) @@ -336,7 +336,15 @@ c write (iout,*) "qfree",qfree enddo eini=fdimless(i) call pdbout(iperm(i),temper,eini,enepot(i),efree,rmsdev) +cc if (temper.eq.300.0d0) then +cc write(iout,*) 'Gral i=',iperm(i) ,eini,enepot(i),efree +cc flush(iout) +cc endif enddo +cc if (temper.eq.300.0d0) then +cc write(iout,*) 'Gral i=',i ,eini,enepot(i),efree +cc flush(iout) +cc endif #ifdef MPI endif #endif diff --git a/source/wham/src/molread_zs.F b/source/wham/src/molread_zs.F index 431680d..cdc6f45 100644 --- a/source/wham/src/molread_zs.F +++ b/source/wham/src/molread_zs.F @@ -48,6 +48,19 @@ C Convert sequence to numeric code do i=1,nres itype(i)=rescode(i,sequence(i),iscode) enddo + if (itype(2).eq.10.and.itype(1).eq.ntyp1) then + write (iout,*) + & "Glycine is the first full residue, initial dummy deleted" + do i=1,nres + itype(i)=itype(i+1) + enddo + nres=nres-1 + endif + if (itype(nres-1).eq.10.and.itype(nres).eq.ntyp1) then + write (iout,*) + & "Glycine is the last full residue, terminal dummy deleted" + nres=nres-1 + endif write (iout,*) "Numeric code:" write (iout,'(20i4)') (itype(i),i=1,nres) do i=1,nres-1 @@ -204,6 +217,25 @@ C bridging residues. enddo endif endif + if (ns.gt.0.and.dyn_ss) then +C /06/28/2013 Adasko:ns is number of Cysteins bonded also called half of +C the bond + do i=nss+1,nhpb +C /06/28/2013 Adasko: nss number of full SS bonds + ihpb(i-nss)=ihpb(i) + jhpb(i-nss)=jhpb(i) + forcon(i-nss)=forcon(i) + dhpb(i-nss)=dhpb(i) + enddo + nhpb=nhpb-nss + nss=0 + call hpb_partition + do i=1,ns + dyn_ss_mask(iss(i))=.true. +C /06/28/2013 Adasko: dyn_ss_mask which Cysteins can form disulfidebond +c write(iout,*) i,iss(i),dyn_ss_mask(iss(i)),"ATU" + enddo + endif return end c------------------------------------------------------------------------------ diff --git a/source/wham/src/parmread.F b/source/wham/src/parmread.F index 1b66ce0..435ee09 100644 --- a/source/wham/src/parmread.F +++ b/source/wham/src/parmread.F @@ -51,10 +51,31 @@ C Assign virtual-bond length key = wname(i)(:ilen(wname(i))) call reada(controlcard,key(:ilen(key)),ww(i),1.0d0) enddo - + call reada(controlcard,"D0CM",d0cm,3.78d0) + call reada(controlcard,"AKCM",akcm,15.1d0) + call reada(controlcard,"AKTH",akth,11.0d0) + call reada(controlcard,"AKCT",akct,12.0d0) + call reada(controlcard,"V1SS",v1ss,-1.08d0) + call reada(controlcard,"V2SS",v2ss,7.61d0) + call reada(controlcard,"V3SS",v3ss,13.7d0) + call reada(controlcard,"EBR",ebr,-5.50D0) +c dyn_ss=(index(controlcard,'DYN_SS').gt.0) write (iout,*) "iparm",iparm," myparm",myparm -c If reading not own parameters, skip assignment +c do i=1,maxres +c dyn_ss_mask(i)=.false. +c enddo + do i=1,maxres-1 + do j=i+1,maxres + dyn_ssbond_ij(i,j)=1.0d300 + enddo + enddo + call reada(controlcard,"HT",Ht,0.0D0) +c if(me.eq.king.or..not.out1file) then +c print *,'indpdb=',indpdb,' pdbref=',pdbref +c endif +c If reading not own parameters, skip assignment +cc write(iout,*) "KURWA", ww(15) if (iparm.eq.myparm .or. .not.separate_parset) then c @@ -80,6 +101,7 @@ c wsccor=ww(19) endif +cc write(iout,*) "KURWA", wstrain,akcm,akth,wsc,dyn_ss call card_concat(controlcard,.false.) @@ -870,8 +892,27 @@ c augm(i,j)=0.5D0**(2*expon)*aa(i,j) enddo enddo C -C Define the SC-p interaction constants -C +C Define the SC-p interaction constants and SS bond potentials +C + if (dyn_ss) then + ss_depth=ebr/wsc-0.25*eps(1,1) + Ht=Ht/wsc-0.25*eps(1,1) + akcm=akcm*wstrain/wsc + akth=akth*wstrain/wsc + akct=akct*wstrain/wsc + v1ss=v1ss*wstrain/wsc + v2ss=v2ss*wstrain/wsc + v3ss=v3ss*wstrain/wsc + else + ss_depth=ebr/wstrain-0.25*eps(1,1)*wsc/wstrain + endif + write (iout,*) "Parameters of the SS-bond potential:" + write (iout,*) "D0CM",d0cm," AKCM",akcm," AKTH",akth, + & " AKCT",akct + write (iout,*) "V1SS",v1ss," V2SS",v2ss," V3SS",v3ss + write (iout,*) "EBR",ebr," SS_DEPTH",ss_depth + write (iout,*)" HT",Ht + #ifdef OLDSCP do i=1,20 C "Soft" SC-p repulsion (causes helices to be too flat, but facilitates @@ -920,7 +961,7 @@ C C C Define the constants of the disulfide bridge C - ebr=-5.50D0 +c ebr=-5.50D0 c c Old arbitrary potential - commented out. c @@ -931,21 +972,21 @@ c Constants of the disulfide-bond potential determined based on the RHF/6-31G** c energy surface of diethyl disulfide. c A. Liwo and U. Kozlowska, 11/24/03 c - D0CM = 3.78d0 - AKCM = 15.1d0 - AKTH = 11.0d0 - AKCT = 12.0d0 - V1SS =-1.08d0 - V2SS = 7.61d0 - V3SS = 13.7d0 +c D0CM = 3.78d0 +c AKCM = 15.1d0 +c AKTH = 11.0d0 +c AKCT = 12.0d0 +c V1SS =-1.08d0 +c V2SS = 7.61d0 +c V3SS = 13.7d0 - if (lprint) then - write (iout,'(/a)') "Disulfide bridge parameters:" - write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr - write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm - write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct - write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, - & ' v3ss:',v3ss - endif +c if (lprint) then +c write (iout,'(/a)') "Disulfide bridge parameters:" +c write (iout,'(a,f10.2)') 'S-S bridge energy: ',ebr +c write (iout,'(2(a,f10.2))') 'd0cm:',d0cm,' akcm:',akcm +c write (iout,'(2(a,f10.2))') 'akth:',akth,' akct:',akct +c write (iout,'(3(a,f10.2))') 'v1ss:',v1ss,' v2ss:',v2ss, +c & ' v3ss:',v3ss +c endif return end diff --git a/source/wham/src/readrtns.F b/source/wham/src/readrtns.F index c13b16e..9fa6137 100644 --- a/source/wham/src/readrtns.F +++ b/source/wham/src/readrtns.F @@ -17,6 +17,7 @@ include "COMMON.FREE" include "COMMON.CONTROL" include "COMMON.ENERGIES" + include "COMMON.SBRIDGE" character*800 controlcard integer i,j,k,ii,n_ene_found integer ind,itype1,itype2,itypf,itypsc,itypp @@ -94,6 +95,10 @@ & " CONSTR_DIST",constr_dist refstr = index(controlcard,'REFSTR').gt.0 pdbref = index(controlcard,'PDBREF').gt.0 + dyn_ss=(index(controlcard,'DYN_SS').gt.0) +C /06/28/2013 Adasko: dyn_ss is keyword allowing to break and create bond +C disulfide bond. Note that in conterary to dynamics this in +C CONTROLCARD. The bond are read in molread_zs.F call flush(iout) return end diff --git a/source/wham/src/readrtns.F.orig b/source/wham/src/readrtns.F.orig deleted file mode 100644 index fa86e6f..0000000 --- a/source/wham/src/readrtns.F.orig +++ /dev/null @@ -1,779 +0,0 @@ - subroutine read_general_data(*) - implicit none - include "DIMENSIONS" - include "DIMENSIONS.ZSCOPT" - include "DIMENSIONS.FREE" - include "COMMON.TORSION" - include "COMMON.INTERACT" - include "COMMON.IOUNITS" - include "COMMON.TIME1" - include "COMMON.PROT" - include "COMMON.PROTFILES" - include "COMMON.CHAIN" - include "COMMON.NAMES" - include "COMMON.FFIELD" - include "COMMON.ENEPS" - include "COMMON.WEIGHTS" - include "COMMON.FREE" - include "COMMON.CONTROL" - include "COMMON.ENERGIES" - character*800 controlcard - integer i,j,k,ii,n_ene_found - integer ind,itype1,itype2,itypf,itypsc,itypp - integer ilen - external ilen - character*16 ucase - character*16 key - external ucase - - call card_concat(controlcard,.true.) - call readi(controlcard,"N_ENE",n_ene,max_ene) - if (n_ene.gt.max_ene) then - write (iout,*) "Error: parameter out of range: N_ENE",n_ene, - & max_ene - return1 - endif - call readi(controlcard,"NPARMSET",nparmset,1) - separate_parset = index(controlcard,"SEPARATE_PARSET").gt.0 - call readi(controlcard,"IPARMPRINT",iparmprint,1) - write (iout,*) "PARMPRINT",iparmprint - if (nparmset.gt.max_parm) then - write (iout,*) "Error: parameter out of range: NPARMSET", - & nparmset, Max_Parm - return1 - endif - call readi(controlcard,"MAXIT",maxit,5000) - call reada(controlcard,"FIMIN",fimin,1.0d-3) - call readi(controlcard,"ENSEMBLES",ensembles,0) - hamil_rep=index(controlcard,"HAMIL_REP").gt.0 - write (iout,*) "Number of energy parameter sets",nparmset - call multreadi(controlcard,"ISAMPL",isampl,nparmset,1) - write (iout,*) "MaxSlice",MaxSlice - call readi(controlcard,"NSLICE",nslice,1) - call flush(iout) - if (nslice.gt.MaxSlice) then - write (iout,*) "Error: parameter out of range: NSLICE",nslice, - & MaxSlice - return1 - endif - write (iout,*) "Frequency of storing conformations", - & (isampl(i),i=1,nparmset) - write (iout,*) "Maxit",maxit," Fimin",fimin - call readi(controlcard,"NQ",nQ,1) - if (nQ.gt.MaxQ) then - write (iout,*) "Error: parameter out of range: NQ",nq, - & maxq - return1 - endif - indpdb=0 - if (index(controlcard,"CLASSIFY").gt.0) indpdb=1 - call reada(controlcard,"DELTA",delta,1.0d-2) - call readi(controlcard,"EINICHECK",einicheck,2) - call reada(controlcard,"DELTRMS",deltrms,5.0d-2) - call readi(controlcard,"NGRIDT",NGridT,400) - call reada(controlcard,"STARTGRIDT",StartGridT,200.0d0) - call reada(controlcard,"DELTA_T",Delta_T,1.0d0) - call reada(controlcard,"DELTRGY",deltrgy,5.0d-2) - call readi(controlcard,"RESCALE",rescale_mode,1) - check_conf=index(controlcard,"NO_CHECK_CONF").eq.0 - write (iout,*) "delta",delta - write (iout,*) "einicheck",einicheck - write (iout,*) "rescale_mode",rescale_mode - call flush(iout) - bxfile=index(controlcard,"BXFILE").gt.0 - cxfile=index(controlcard,"CXFILE").gt.0 - if (nslice .eq. 1 .and. .not.bxfile .and. .not.cxfile) - & bxfile=.true. - histfile=index(controlcard,"HISTFILE").gt.0 - histout=index(controlcard,"HISTOUT").gt.0 - entfile=index(controlcard,"ENTFILE").gt.0 - zscfile=index(controlcard,"ZSCFILE").gt.0 - with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0 - call readi(controlcard,'CONSTR_DIST',constr_dist,0) - write (iout,*) "with_dihed_constr ",with_dihed_constr, - & " CONSTR_DIST",constr_dist - refstr = index(controlcard,'REFSTR').gt.0 - pdbref = index(controlcard,'PDBREF').gt.0 - call flush(iout) - return - end -c------------------------------------------------------------------------------ - subroutine read_efree(*) -C -C Read molecular data -C - implicit none - include 'DIMENSIONS' - include 'DIMENSIONS.ZSCOPT' - include 'DIMENSIONS.COMPAR' - include 'DIMENSIONS.FREE' - include 'COMMON.IOUNITS' - include 'COMMON.TIME1' - include 'COMMON.SBRIDGE' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.HEADER' - include 'COMMON.GEO' - include 'COMMON.FREE' - character*320 controlcard,ucase - integer iparm,ib,i,j,npars - integer ilen - external ilen - - if (hamil_rep) then - npars=1 - else - npars=nParmSet - endif - - do iparm=1,npars - - call card_concat(controlcard,.true.) - call readi(controlcard,'NT',nT_h(iparm),1) - write (iout,*) "iparm",iparm," nt",nT_h(iparm) - call flush(iout) - if (nT_h(iparm).gt.MaxT_h) then - write (iout,*) "Error: parameter out of range: NT",nT_h(iparm), - & MaxT_h - return1 - endif - replica(iparm)=index(controlcard,"REPLICA").gt.0 - umbrella(iparm)=index(controlcard,"UMBRELLA").gt.0 - read_iset(iparm)=index(controlcard,"READ_ISET").gt.0 - write (iout,*) "nQ",nQ," nT",nT_h(iparm)," replica ", - & replica(iparm)," umbrella ",umbrella(iparm), - & " read_iset",read_iset(iparm) - call flush(iout) - do ib=1,nT_h(iparm) - call card_concat(controlcard,.true.) - call readi(controlcard,'NR',nR(ib,iparm),1) - if (umbrella(iparm)) then - nRR(ib,iparm)=1 - else - nRR(ib,iparm)=nR(ib,iparm) - endif - if (nR(ib,iparm).gt.MaxR) then - write (iout,*) "Error: parameter out of range: NR", - & nR(ib,iparm),MaxR - return1 - endif - call reada(controlcard,'TEMP',beta_h(ib,iparm),298.0d0) - beta_h(ib,iparm)=1.0d0/(beta_h(ib,iparm)*1.987D-3) - call multreada(controlcard,'FI',f(1,ib,iparm),nR(ib,iparm), - & 0.0d0) - do i=1,nR(ib,iparm) - call card_concat(controlcard,.true.) - call multreada(controlcard,'KH',KH(1,i,ib,iparm),nQ, - & 100.0d0) - call multreada(controlcard,'Q0',Q0(1,i,ib,iparm),nQ, - & 0.0d0) - enddo - enddo - do ib=1,nT_h(iparm) - write (iout,*) "ib",ib," beta_h", - & 1.0d0/(0.001987*beta_h(ib,iparm)) - write (iout,*) "nR",nR(ib,iparm) - write (iout,*) "fi",(f(i,ib,iparm),i=1,nR(ib,iparm)) - do i=1,nR(ib,iparm) - write (iout,*) "i",i," Kh",(Kh(j,i,ib,iparm),j=1,nQ), - & "q0",(q0(j,i,ib,iparm),j=1,nQ) - enddo - call flush(iout) - enddo - - enddo - - if (hamil_rep) then - - do iparm=2,nParmSet - nT_h(iparm)=nT_h(1) - do ib=1,nT_h(iparm) - nR(ib,iparm)=nR(ib,1) - if (umbrella(iparm)) then - nRR(ib,iparm)=1 - else - nRR(ib,iparm)=nR(ib,1) - endif - beta_h(ib,iparm)=beta_h(ib,1) - do i=1,nR(ib,iparm) - f(i,ib,iparm)=f(i,ib,1) - do j=1,nQ - KH(j,i,ib,iparm)=KH(j,i,ib,1) - Q0(j,i,ib,iparm)=Q0(j,i,ib,1) - enddo - enddo - replica(iparm)=replica(1) - umbrella(iparm)=umbrella(1) - read_iset(iparm)=read_iset(1) - enddo - enddo - - endif - - return - end -c----------------------------------------------------------------------------- - subroutine read_protein_data(*) - implicit none - include "DIMENSIONS" - include "DIMENSIONS.ZSCOPT" - include "DIMENSIONS.FREE" -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) - include "COMMON.MPI" -#endif - include "COMMON.CHAIN" - include "COMMON.IOUNITS" - include "COMMON.PROT" - include "COMMON.PROTFILES" - include "COMMON.NAMES" - include "COMMON.FREE" - include "COMMON.OBCINKA" - character*64 nazwa - character*16000 controlcard - integer i,ii,ib,iR,iparm,ilen,iroof,nthr,npars - external ilen,iroof - if (hamil_rep) then - npars=1 - else - npars=nparmset - endif - - do iparm=1,npars - -C Read names of files with conformation data. - if (replica(iparm)) then - nthr = 1 - else - nthr = nT_h(iparm) - endif - do ib=1,nthr - do ii=1,nRR(ib,iparm) - write (iout,*) "Parameter set",iparm," temperature",ib, - & " window",ii - call flush(iout) - call card_concat(controlcard,.true.) - write (iout,*) controlcard(:ilen(controlcard)) - call readi(controlcard,"NFILE_BIN",nfile_bin(ii,ib,iparm),0) - call readi(controlcard,"NFILE_ASC",nfile_asc(ii,ib,iparm),0) - call readi(controlcard,"NFILE_CX",nfile_cx(ii,ib,iparm),0) - call readi(controlcard,"REC_START",rec_start(ii,ib,iparm),1) - call readi(controlcard,"REC_END",rec_end(ii,ib,iparm), - & maxstr*isampl(iparm)+rec_start(ii,ib,iparm)-1) - call reada(controlcard,"TIME_START", - & time_start_collect(ii,ib,iparm),0.0d0) - call reada(controlcard,"TIME_END",time_end_collect(ii,ib,iparm), - & 1.0d10) - write (iout,*) "rec_start",rec_start(ii,ib,iparm), - & " rec_end",rec_end(ii,ib,iparm) - write (iout,*) "time_start",time_start_collect(ii,ib,iparm), - & " time_end",time_end_collect(ii,ib,iparm) - call flush(iout) - if (replica(iparm)) then - call readi(controlcard,"TOTRAJ",totraj(ii,iparm),1) - write (iout,*) "Number of trajectories",totraj(ii,iparm) - call flush(iout) - endif - if (nfile_bin(ii,ib,iparm).lt.2 - & .and. nfile_asc(ii,ib,iparm).eq.0 - & .and. nfile_cx(ii,ib,iparm).eq.0) then - write (iout,*) "Error - no action specified!" - return1 - endif - if (nfile_bin(ii,ib,iparm).gt.0) then - call card_concat(controlcard,.false.) - call split_string(controlcard,protfiles(1,1,ii,ib,iparm), - & maxfile_prot,nfile_bin(ii,ib,iparm)) -#ifdef DEBUG - write(iout,*)"nfile_bin",nfile_bin(ii,ib,iparm) - write(iout,*) (protfiles(i,1,ii,ib,iparm), - & i=1,nfile_bin(ii,ib,iparm)) -#endif - endif - if (nfile_asc(ii,ib,iparm).gt.0) then - call card_concat(controlcard,.false.) - call split_string(controlcard,protfiles(1,2,ii,ib,iparm), - & maxfile_prot,nfile_asc(ii,ib,iparm)) -#ifdef DEBUG - write(iout,*) "nfile_asc(ii,ib,iparm)",nfile_asc(ii,ib,iparm) - write(iout,*) (protfiles(i,2,ii,ib,iparm), - & i=1,nfile_asc(ii,ib,iparm)) -#endif - else if (nfile_cx(ii,ib,iparm).gt.0) then - call card_concat(controlcard,.false.) - call split_string(controlcard,protfiles(1,2,ii,ib,iparm), - & maxfile_prot,nfile_cx(ii,ib,iparm)) -#ifdef DEBUG - write(iout,*) "nfile_cx(ii,ib,iparm)",nfile_cx(ii,ib,iparm) - write(iout,*) (protfiles(i,2,ii,ib,iparm), - & i=1,nfile_cx(ii,ib,iparm)) -#endif - endif - call flush(iout) - enddo - enddo - - enddo - - return - end -c------------------------------------------------------------------------------- - subroutine opentmp(islice,iunit,bprotfile_temp) - implicit none - include "DIMENSIONS" - include "DIMENSIONS.ZSCOPT" - include "DIMENSIONS.FREE" -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) - include "COMMON.MPI" -#endif - include "COMMON.IOUNITS" - include "COMMON.PROTFILES" - include "COMMON.PROT" - include "COMMON.FREE" - character*64 bprotfile_temp - character*3 liczba,liczba2 - character*2 liczba1 - integer iunit,islice - integer ilen,iroof - external ilen,iroof - logical lerr - - write (liczba1,'(bz,i2.2)') islice - write (liczba,'(bz,i3.3)') me -#ifdef MPI -c write (iout,*) "separate_parset ",separate_parset, -c & " myparm",myparm - if (separate_parset) then - write (liczba2,'(bz,i3.3)') myparm - bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// - & prefix(:ilen(prefix))//liczba//"_"//liczba2//".xbin.tmp"//liczba1 - open (iunit,file=bprotfile_temp,status="unknown", - & form="unformatted",access="direct",recl=lenrec) - else - bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// - & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 - open (iunit,file=bprotfile_temp,status="unknown", - & form="unformatted",access="direct",recl=lenrec) - endif -#else - bprotfile_temp = scratchdir(:ilen(scratchdir))// - & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 - open (iunit,file=bprotfile_temp,status="unknown", - & form="unformatted",access="direct",recl=lenrec) -#endif -c write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp", -c & bprotfile_temp -c call flush(iout) - return - end -c------------------------------------------------------------------------------- - subroutine read_database(*) - implicit none - include "DIMENSIONS" - include "DIMENSIONS.ZSCOPT" - include "DIMENSIONS.FREE" -#ifdef MPI - include "mpif.h" - integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) - include "COMMON.MPI" -#endif - include "COMMON.CHAIN" - include "COMMON.IOUNITS" - include "COMMON.PROTFILES" - include "COMMON.NAMES" - include "COMMON.VAR" - include "COMMON.GEO" - include "COMMON.ENEPS" - include "COMMON.PROT" - include "COMMON.INTERACT" - include "COMMON.FREE" - include "COMMON.SBRIDGE" - include "COMMON.OBCINKA" - real*4 csingle(3,maxres2) - character*64 nazwa,bprotfile_temp - character*3 liczba - character*2 liczba1 - integer i,j,ii,jj(maxslice),k,kk(maxslice),l, - & ll(maxslice),mm(maxslice),if - integer nrec,nlines,iscor,iunit,islice - double precision energ - integer ilen,iroof - external ilen,iroof - double precision rmsdev,energia(0:max_ene),efree,eini,temp - double precision prop(maxQ) - integer ntot_all(maxslice,0:maxprocs-1) - integer iparm,ib,iib,ir,nprop,nthr,npars - double precision etot,time - integer ixdrf,iret - logical lerr,linit - - lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24 - lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ - lenrec=lenrec2+8 - write (iout,*) "lenrec",lenrec," lenrec1",lenrec1, - & " lenrec2",lenrec2 - - write (iout,*) "nparmset",nparmset - if (hamil_rep) then - npars=1 - else - npars=nparmset - endif - do iparm=1,npars - - if (replica(iparm)) then - nthr = 1 - else - nthr = nT_h(iparm) - endif - - do i=1,nQ - prop(i)=0.0d0 - enddo - do islice=1,nslice - ll(islice)=0 - mm(islice)=0 - enddo - - do ib=1,nthr - do iR=1,nRR(ib,iparm) - - write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ - do islice=1,nslice - jj(islice)=0 - kk(islice)=0 - enddo - - IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN -c Read conformations from binary DA files (one per batch) and write them to -c a binary DA scratchfile. - write (liczba,'(bz,i3.3)') me - do if=1,nfile_bin(iR,ib,iparm) - nazwa=protfiles(if,1,iR,ib,iparm) - & (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx" - open (ientin,file=nazwa,status="old",form="unformatted", - & access="direct",recl=lenrec2,err=1111) - ii=0 - do islice=1,nslice - call opentmp(islice,ientout,bprotfile_temp) - call bxread(nazwa,ii,jj(islice),kk(islice),ll(islice), - & mm(islice),iR,ib,iparm) - close(ientout) - enddo - close(ientin) - enddo - ENDIF ! NFILE_BIN>0 -c - IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN -c Read conformations from multiple ASCII int files and write them to a binary -c DA scratchfile. - do if=1,nfile_asc(iR,ib,iparm) - nazwa=protfiles(if,2,iR,ib,iparm) - & (:ilen(protfiles(if,2,iR,ib,iparm)))//".x" - open(unit=ientin,file=nazwa,status='old',err=1111) - write(iout,*) "reading ",nazwa(:ilen(nazwa)) - ii=0 - call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) - enddo ! if - ENDIF - IF (NFILE_CX(iR,ib,iparm).gt.0) THEN -c Read conformations from cx files and write them to a binary -c DA scratchfile. - do if=1,nfile_cx(iR,ib,iparm) - nazwa=protfiles(if,2,iR,ib,iparm) - & (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx" - write(iout,*) "reading ",nazwa(:ilen(nazwa)) - ii=0 - print *,"Calling cxread" - call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm, - & *1111) - close(ientout) - write (iout,*) "exit cxread" - call flush(iout) - enddo - ENDIF - - do islice=1,nslice - stot(islice)=stot(islice)+jj(islice) - enddo - - enddo - enddo - write (iout,*) "IPARM",iparm - enddo - - if (nslice.eq.1) then -#ifdef MPI - write (liczba,'(bz,i3.3)') me - bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// - & prefix(:ilen(prefix))//liczba//".xbin.tmp" -#else - bprotfile_temp = scratchdir(:ilen(scratchdir))// - & "/"//prefix(:ilen(prefix))//".xbin.tmp" -#endif - write(iout,*) mm(1)," conformations read",ll(1), - & " conformations written to ", - & bprotfile_temp(:ilen(bprotfile_temp)) - else - do islice=1,nslice - write (liczba1,'(bz,i2.2)') islice -#ifdef MPI - write (liczba,'(bz,i3.3)') me - bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// - & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 -#else - bprotfile_temp = scratchdir(:ilen(scratchdir))// - & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 -#endif - write(iout,*) mm(islice)," conformations read",ll(islice), - & " conformations written to ", - & bprotfile_temp(:ilen(bprotfile_temp)) - enddo - endif - -#ifdef MPI -c Check if everyone has the same number of conformations - call MPI_Allgather(stot(1),maxslice,MPI_INTEGER, - & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR) - lerr=.false. - do i=0,nprocs-1 - if (i.ne.me) then - do islice=1,nslice - if (stot(islice).ne.ntot_all(islice,i)) then - write (iout,*) "Number of conformations at processor",i, - & " differs from that at processor",me, - & stot(islice),ntot_all(islice,i)," slice",islice - lerr = .true. - endif - enddo - endif - enddo - if (lerr) then - write (iout,*) - write (iout,*) "Numbers of conformations read by processors" - write (iout,*) - do i=0,nprocs-1 - write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice) - enddo - write (iout,*) "Calculation terminated." - call flush(iout) - return1 - endif - do islice=1,nslice - ntot(islice)=stot(islice) - enddo - return -#endif - 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa)) - call flush(iout) - return1 - end -c------------------------------------------------------------------------------ - subroutine card_concat(card,to_upper) - implicit none - include 'DIMENSIONS.ZSCOPT' - include "COMMON.IOUNITS" - character*(*) card - character*80 karta,ucase - logical to_upper - integer ilen - external ilen - read (inp,'(a)') karta - if (to_upper) karta=ucase(karta) - card=' ' - do while (karta(80:80).eq.'&') - card=card(:ilen(card)+1)//karta(:79) - read (inp,'(a)') karta - if (to_upper) karta=ucase(karta) - enddo - card=card(:ilen(card)+1)//karta - return - end -c------------------------------------------------------------------------------ - subroutine readi(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - integer wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*) wartosc - return - end -c---------------------------------------------------------------------------- - subroutine reada(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch - character*80 aux - double precision wartosc,default - integer ilen,iread - external ilen - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*) wartosc - return - end -c---------------------------------------------------------------------------- - subroutine multreadi(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - integer tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine multreada(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - double precision tablica(dim),default - character*(*) rekord,lancuch - character*80 aux - integer ilen,iread - external ilen - do i=1,dim - tablica(i)=default - enddo - iread=index(rekord,lancuch(:ilen(lancuch))//"=") - if (iread.eq.0) return - iread=iread+ilen(lancuch)+1 - read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) - 10 return - end -c---------------------------------------------------------------------------- - subroutine reads(rekord,lancuch,wartosc,default) - implicit none - character*(*) rekord,lancuch,wartosc,default - character*80 aux - integer ilen,lenlan,lenrec,iread,ireade - external ilen - logical iblnk - external iblnk - lenlan=ilen(lancuch) - lenrec=ilen(rekord) - iread=index(rekord,lancuch(:lenlan)//"=") -c print *,"rekord",rekord," lancuch",lancuch -c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec - if (iread.eq.0) then - wartosc=default - return - endif - iread=iread+lenlan+1 -c print *,"iread",iread -c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) - do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) - iread=iread+1 -c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) - enddo -c print *,"iread",iread - if (iread.gt.lenrec) then - wartosc=default - return - endif - ireade=iread+1 -c print *,"ireade",ireade - do while (ireade.lt.lenrec .and. - & .not.iblnk(rekord(ireade:ireade))) - ireade=ireade+1 - enddo - wartosc=rekord(iread:ireade) - return - end -c---------------------------------------------------------------------------- - subroutine multreads(rekord,lancuch,tablica,dim,default) - implicit none - integer dim,i - character*(*) rekord,lancuch,tablica(dim),default - character*80 aux - integer ilen,lenlan,lenrec,iread,ireade - external ilen - logical iblnk - external iblnk - do i=1,dim - tablica(i)=default - enddo - lenlan=ilen(lancuch) - lenrec=ilen(rekord) - iread=index(rekord,lancuch(:lenlan)//"=") -c print *,"rekord",rekord," lancuch",lancuch -c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec - if (iread.eq.0) return - iread=iread+lenlan+1 - do i=1,dim -c print *,"iread",iread -c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) - do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) - iread=iread+1 -c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) - enddo -c print *,"iread",iread - if (iread.gt.lenrec) return - ireade=iread+1 -c print *,"ireade",ireade - do while (ireade.lt.lenrec .and. - & .not.iblnk(rekord(ireade:ireade))) - ireade=ireade+1 - enddo - tablica(i)=rekord(iread:ireade) - iread=ireade+1 - enddo - end -c---------------------------------------------------------------------------- - subroutine split_string(rekord,tablica,dim,nsub) - implicit none - integer dim,nsub,i,ii,ll,kk - character*(*) tablica(dim) - character*(*) rekord - integer ilen - external ilen - do i=1,dim - tablica(i)=" " - enddo - ii=1 - ll = ilen(rekord) - nsub=0 - do i=1,dim -C Find the start of term name - kk = 0 - do while (ii.le.ll .and. rekord(ii:ii).eq." ") - ii = ii+1 - enddo -C Parse the name into TABLICA(i) until blank found - do while (ii.le.ll .and. rekord(ii:ii).ne." ") - kk = kk+1 - tablica(i)(kk:kk)=rekord(ii:ii) - ii = ii+1 - enddo - if (kk.gt.0) nsub=nsub+1 - if (ii.gt.ll) return - enddo - return - end -c-------------------------------------------------------------------------------- - integer function iroof(n,m) - ii = n/m - if (ii*m .lt. n) ii=ii+1 - iroof = ii - return - end diff --git a/source/wham/src/store_parm.F b/source/wham/src/store_parm.F index 6aa33c5..ce0047f 100644 --- a/source/wham/src/store_parm.F +++ b/source/wham/src/store_parm.F @@ -217,6 +217,8 @@ c Store the SCp parameters enddo enddo c Store disulfide-bond parameters + ht_all(iparm)=ht + ss_depth_all(iparm)=ss_depth ebr_all(iparm)=ebr d0cm_all(iparm)=d0cm akcm_all(iparm)=akcm @@ -460,6 +462,8 @@ c Restore the SCp parameters enddo enddo c Restore disulfide-bond parameters + ht=ht_all(iparm) + ss_depth=ss_depth_all(iparm) ebr=ebr_all(iparm) d0cm=d0cm_all(iparm) akcm=akcm_all(iparm) diff --git a/source/wham/src/wham_calc1.F b/source/wham/src/wham_calc1.F index a6044cd..3146448 100644 --- a/source/wham/src/wham_calc1.F +++ b/source/wham/src/wham_calc1.F @@ -92,9 +92,9 @@ c parameter (MaxHdim=200000) character*2 licz2 character*3 licz3 character*128 nazwa + character*30 frm_write integer ilen external ilen - write(licz2,'(bz,i2.2)') islice nbin1 = 1.0d0/delta write (iout,'(//80(1h-)/"Solving WHAM equations for slice", @@ -316,7 +316,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc @@ -326,7 +326,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr @@ -532,8 +532,8 @@ c#endif do i=1,nR(ib,iparm) fi(i,ib,iparm)=fi(i,ib,iparm)-avefi enddo - write (iout,'(8f10.5)') (fi(i,ib,iparm),i=1,nR(ib,iparm)) - write (iout,'(8f10.5)') (f(i,ib,iparm),i=1,nR(ib,iparm)) + write (iout,'(6f15.5)') (fi(i,ib,iparm),i=1,nR(ib,iparm)) + write (iout,'(6f15.5)') (f(i,ib,iparm),i=1,nR(ib,iparm)) enddo enddo @@ -675,7 +675,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc @@ -685,7 +685,7 @@ c write (iout,*) 1.0d0/(beta_h(ib,iparm)*1.987D-3),ft etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr @@ -733,7 +733,8 @@ C Determine the minimum energes for all parameter sets and temperatures do i=1,nParmSet write (iout,*) "Parameter set",i do j=1,nT_h(i) - write (iout,*) j,PotEmin_all(j,i) + write (iout,*) j,1.0d0/(1.987d-3*beta_h(j,i)), + & PotEmin_all(j,i) enddo enddo write (iout,*) "potEmin_min",potEmin_min @@ -991,29 +992,43 @@ c write (iout,*) "ftprim",ftprim c write (iout,*) "ftbis",ftbis betaT=1.0d0/(1.987D-3*betaT) if (betaT.ge.beta_h(1,iparm)) then - potEmin=potEmin_all(1,iparm) -c write(iout,*) "first",temper,potEmin - else if (betaT.lt.beta_h(nT_h(iparm),iparm)) then - potEmin=potEmin_all(nT_h(iparm),iparm) -c write (iout,*) "last",temper,potEmin + potEmin=potEmin_all(1,iparm)+ + & (potEmin_all(1,iparm)-potEmin_all(2,iparm))/ + & (1.0/beta_h(1,iparm)-1.0/beta_h(2,iparm))* + & (1.0/betaT-1.0/beta_h(1,iparm)) +#ifdef DEBUG + write(iout,*) "first",temper,potEmin +#endif + else if (betaT.le.beta_h(nT_h(iparm),iparm)) then + potEmin=potEmin_all(nT_h(iparm),iparm)+ + &(potEmin_all(nT_h(iparm),iparm)-potEmin_all(nT_h(iparm)-1,iparm))/ + &(1.0/beta_h(nT_h(iparm),iparm)-1.0/beta_h(nT_h(iparm)-1,iparm))* + &(1.0/betaT-1.0/beta_h(nt_h(iparm),iparm)) +#ifdef DEBUG + write (iout,*) "last",temper,potEmin +#endif else do l=1,nT_h(iparm)-1 if (betaT.le.beta_h(l,iparm) .and. & betaT.gt.beta_h(l+1,iparm)) then potEmin=potEmin_all(l,iparm) -c write (iout,*) "l",l, -c & betaT,1.0d0/(1.987D-3*beta_h(l,iparm)), -c & 1.0d0/(1.987D-3*beta_h(l+1,iparm)),temper,potEmin +#ifdef DEBUG + write (iout,*) "l",l, + & betaT,1.0d0/(1.987D-3*beta_h(l,iparm)), + & 1.0d0/(1.987D-3*beta_h(l+1,iparm)),temper,potEmin +#endif exit endif enddo endif -c write (iout,*) ib," PotEmin",potEmin +#ifdef DEBUG + write (iout,*) "k",k," potEmin",potEmin +#endif #ifdef SPLITELE etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2+ft(1)*welec*ees & +wvdwpp*evdw1 & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc @@ -1036,7 +1051,7 @@ c write (iout,*) ib," PotEmin",potEmin etot=wsc*(evdw+ft(6)*evdw_t)+wscp*evdw2 & +ft(1)*welec*(ees+evdw1) & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc - & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 + & +wstrain*ehpb+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5 & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4 & +ft(2)*wturn3*eello_turn3 & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr @@ -1342,6 +1357,9 @@ c write (iout,*) ib," PotEmin",potEmin endif enddo endif + +c write (iout,*) "i",i," potEmin",potEmin + sumE(i,iparm)=sumE(i,iparm)/sumW(i,iparm) sumEbis(i,iparm)=(startGridT+i*delta_T)*sumEbis(i,iparm)/ & sumW(i,iparm) @@ -1364,8 +1382,10 @@ c write (iout,*) ib," PotEmin",potEmin write (iout,*) write (34,'(f7.1,2f15.5,$)') startGridT+i*delta_T, & sumW(i,iparm),sumE(i,iparm) - write (34,'(f10.5,$)') (sumQ(j,i,iparm),j=1,nQ+2) - write (34,'(e15.5,$)') sumEsq(i,iparm)-sumEbis(i,iparm), + write(frm_write,'( "(",i3,"e15.5,$)" )' ) nQ+2 + write (34,frm_write) (sumQ(j,i,iparm),j=1,nQ+2) + write(frm_write,'( "(",i3,"e15.5,$)" )' ) (nQ+2)*2+1 + write (34,frm_write) sumEsq(i,iparm)-sumEbis(i,iparm), & (sumQsq(j,i,iparm),j=1,nQ+2),(sumEQ(j,i,iparm),j=1,nQ+2) write (34,*) enddo diff --git a/source/xdrfpdb/src/xdrf/Makefile b/source/xdrfpdb/src/xdrf/Makefile deleted file mode 100644 index 02c29f6..0000000 --- a/source/xdrfpdb/src/xdrf/Makefile +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = gcc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/xdrfpdb/src/xdrf/Makefile_jubl b/source/xdrfpdb/src/xdrf/Makefile_jubl deleted file mode 100644 index 8dc35cf..0000000 --- a/source/xdrfpdb/src/xdrf/Makefile_jubl +++ /dev/null @@ -1,31 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -BGLSYS = /bgl/BlueLight/ppcfloor/bglsys - -CC = /usr/bin/blrts_xlc -CPPC = /usr/bin/blrts_xlc - -CFLAGS= -O2 -I$(BGLSYS)/include -L$(BGLSYS)/lib -qarch=440d -qtune=440 - -M4 = m4 -M4FILE = RS6K.m4 - -libxdrf.a: libxdrf.o ftocstr.o xdr_array.o xdr.o xdr_float.o xdr_stdio.o - ar cr libxdrf.a $? - -clean: - rm -f *.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c -# rm -f libxdrf.c - diff --git a/source/xdrfpdb/src/xdrf/Makefile_linux b/source/xdrfpdb/src/xdrf/Makefile_linux deleted file mode 100644 index f03276e..0000000 --- a/source/xdrfpdb/src/xdrf/Makefile_linux +++ /dev/null @@ -1,27 +0,0 @@ -# This make file is part of the xdrf package. -# -# (C) 1995 Frans van Hoesel, hoesel@chem.rug.nl -# -# 2006 modified by Cezary Czaplewski - -# Set C compiler and flags for ARCH -CC = cc -CFLAGS = -O - -M4 = m4 -M4FILE = underscore.m4 - -libxdrf.a: libxdrf.o ftocstr.o - ar cr libxdrf.a $? - -clean: - rm -f libxdrf.o ftocstr.o libxdrf.a - -ftocstr.o: ftocstr.c - $(CC) $(CFLAGS) -c ftocstr.c - -libxdrf.o: libxdrf.m4 $(M4FILE) - $(M4) $(M4FILE) libxdrf.m4 > libxdrf.c - $(CC) $(CFLAGS) -c libxdrf.c - rm -f libxdrf.c - diff --git a/source/xdrfpdb/src/xdrf/RS6K.m4 b/source/xdrfpdb/src/xdrf/RS6K.m4 deleted file mode 100644 index 0331d97..0000000 --- a/source/xdrfpdb/src/xdrf/RS6K.m4 +++ /dev/null @@ -1,20 +0,0 @@ -divert(-1) -undefine(`len') -# -# do nothing special to FORTRAN function names -# -define(`FUNCTION',`$1') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) - diff --git a/source/xdrfpdb/src/xdrf/ftocstr.c b/source/xdrfpdb/src/xdrf/ftocstr.c deleted file mode 100644 index ed2113f..0000000 --- a/source/xdrfpdb/src/xdrf/ftocstr.c +++ /dev/null @@ -1,35 +0,0 @@ - - -int ftocstr(ds, dl, ss, sl) - char *ds, *ss; /* dst, src ptrs */ - int dl; /* dst max len */ - int sl; /* src len */ -{ - char *p; - - for (p = ss + sl; --p >= ss && *p == ' '; ) ; - sl = p - ss + 1; - dl--; - ds[0] = 0; - if (sl > dl) - return 1; - while (sl--) - (*ds++ = *ss++); - *ds = '\0'; - return 0; -} - - -int ctofstr(ds, dl, ss) - char *ds; /* dest space */ - int dl; /* max dest length */ - char *ss; /* src string (0-term) */ -{ - while (dl && *ss) { - *ds++ = *ss++; - dl--; - } - while (dl--) - *ds++ = ' '; - return 0; -} diff --git a/source/xdrfpdb/src/xdrf/libxdrf.m4 b/source/xdrfpdb/src/xdrf/libxdrf.m4 deleted file mode 100644 index a6da458..0000000 --- a/source/xdrfpdb/src/xdrf/libxdrf.m4 +++ /dev/null @@ -1,1238 +0,0 @@ -/*____________________________________________________________________________ - | - | libxdrf - portable fortran interface to xdr. some xdr routines - | are C routines for compressed coordinates - | - | version 1.1 - | - | This collection of routines is intended to write and read - | data in a portable way to a file, so data written on one type - | of machine can be read back on a different type. - | - | all fortran routines use an integer 'xdrid', which is an id to the - | current xdr file, and is set by xdrfopen. - | most routines have in integer 'ret' which is the return value. - | The value of 'ret' is zero on failure, and most of the time one - | on succes. - | - | There are three routines useful for C users: - | xdropen(), xdrclose(), xdr3dfcoord(). - | The first two replace xdrstdio_create and xdr_destroy, and *must* be - | used when you plan to use xdr3dfcoord(). (they are also a bit - | easier to interface). For writing data other than compressed coordinates - | you should use the standard C xdr routines (see xdr man page) - | - | xdrfopen(xdrid, filename, mode, ret) - | character *(*) filename - | character *(*) mode - | - | this will open the file with the given filename (string) - | and the given mode, it returns an id in xdrid, which is - | to be used in all other calls to xdrf routines. - | mode is 'w' to create, or update an file, for all other - | values of mode the file is opened for reading - | - | you need to call xdrfclose to flush the output and close - | the file. - | Note that you should not use xdrstdio_create, which comes with the - | standard xdr library - | - | xdrfclose(xdrid, ret) - | flush the data to the file, and closes the file; - | You should not use xdr_destroy (which comes standard with - | the xdr libraries. - | - | xdrfbool(xdrid, bp, ret) - | integer pb - | - | This filter produces values of either 1 or 0 - | - | xdrfchar(xdrid, cp, ret) - | character cp - | - | filter that translate between characters and their xdr representation - | Note that the characters in not compressed and occupies 4 bytes. - | - | xdrfdouble(xdrid, dp, ret) - | double dp - | - | read/write a double. - | - | xdrffloat(xdrid, fp, ret) - | float fp - | - | read/write a float. - | - | xdrfint(xdrid, ip, ret) - | integer ip - | - | read/write integer. - | - | xdrflong(xdrid, lp, ret) - | integer lp - | - | this routine has a possible portablility problem due to 64 bits longs. - | - | xdrfshort(xdrid, sp, ret) - | integer *2 sp - | - | xdrfstring(xdrid, sp, maxsize, ret) - | character *(*) - | integer maxsize - | - | read/write a string, with maximum length given by maxsize - | - | xdrfwrapstring(xdris, sp, ret) - | character *(*) - | - | read/write a string (it is the same as xdrfstring accept that it finds - | the stringlength itself. - | - | xdrfvector(xdrid, cp, size, xdrfproc, ret) - | character *(*) - | integer size - | external xdrfproc - | - | read/write an array pointed to by cp, with number of elements - | defined by 'size'. the routine 'xdrfproc' is the name - | of one of the above routines to read/write data (like xdrfdouble) - | In contrast with the c-version you don't need to specify the - | byte size of an element. - | xdrfstring is not allowed here (it is in the c version) - | - | xdrf3dfcoord(xdrid, fp, size, precision, ret) - | real (*) fp - | real precision - | integer size - | - | this is *NOT* a standard xdr routine. I named it this way, because - | it invites people to use the other xdr routines. - | It is introduced to store specifically 3d coordinates of molecules - | (as found in molecular dynamics) and it writes it in a compressed way. - | It starts by multiplying all numbers by precision and - | rounding the result to integer. effectively converting - | all floating point numbers to fixed point. - | it uses an algorithm for compression that is optimized for - | molecular data, but could be used for other 3d coordinates - | as well. There is subtantial overhead involved, so call this - | routine only if you have a large number of coordinates to read/write - | - | ________________________________________________________________________ - | - | Below are the routines to be used by C programmers. Use the 'normal' - | xdr routines to write integers, floats, etc (see man xdr) - | - | int xdropen(XDR *xdrs, const char *filename, const char *type) - | This will open the file with the given filename and the - | given mode. You should pass it an allocated XDR struct - | in xdrs, to be used in all other calls to xdr routines. - | Mode is 'w' to create, or update an file, and for all - | other values of mode the file is opened for reading. - | You need to call xdrclose to flush the output and close - | the file. - | - | Note that you should not use xdrstdio_create, which - | comes with the standard xdr library. - | - | int xdrclose(XDR *xdrs) - | Flush the data to the file, and close the file; - | You should not use xdr_destroy (which comes standard - | with the xdr libraries). - | - | int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) - | This is \fInot\fR a standard xdr routine. I named it this - | way, because it invites people to use the other xdr - | routines. - | - | (c) 1995 Frans van Hoesel, hoesel@chem.rug.nl -*/ - - -#include -#include -#include -/* #include -#include */ -#include "xdr.h" -#include -#include -#include "xdrf.h" - -int ftocstr(char *, int, char *, int); -int ctofstr(char *, int, char *); - -#define MAXID 20 -static FILE *xdrfiles[MAXID]; -static XDR *xdridptr[MAXID]; -static char xdrmodes[MAXID]; -static unsigned int cnt; - -typedef void (* FUNCTION(xdrfproc)) (int *, void *, int *); - -void -FUNCTION(xdrfbool) ARGS(`xdrid, pb, ret') -int *xdrid, *ret; -int *pb; -{ - *ret = xdr_bool(xdridptr[*xdrid], (bool_t *) pb); - cnt += sizeof(int); -} - -void -FUNCTION(xdrfchar) ARGS(`xdrid, cp, ret') -int *xdrid, *ret; -char *cp; -{ - *ret = xdr_char(xdridptr[*xdrid], cp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfdouble) ARGS(`xdrid, dp, ret') -int *xdrid, *ret; -double *dp; -{ - *ret = xdr_double(xdridptr[*xdrid], dp); - cnt += sizeof(double); -} - -void -FUNCTION(xdrffloat) ARGS(`xdrid, fp, ret') -int *xdrid, *ret; -float *fp; -{ - *ret = xdr_float(xdridptr[*xdrid], fp); - cnt += sizeof(float); -} - -void -FUNCTION(xdrfint) ARGS(`xdrid, ip, ret') -int *xdrid, *ret; -int *ip; -{ - *ret = xdr_int(xdridptr[*xdrid], ip); - cnt += sizeof(int); -} - -void -FUNCTION(xdrflong) ARGS(`xdrid, lp, ret') -int *xdrid, *ret; -long *lp; -{ - *ret = xdr_long(xdridptr[*xdrid], lp); - cnt += sizeof(long); -} - -void -FUNCTION(xdrfshort) ARGS(`xdrid, sp, ret') -int *xdrid, *ret; -short *sp; -{ - *ret = xdr_short(xdridptr[*xdrid], sp); - cnt += sizeof(sp); -} - -void -FUNCTION(xdrfuchar) ARGS(`xdrid, ucp, ret') -int *xdrid, *ret; -char *ucp; -{ - *ret = xdr_u_char(xdridptr[*xdrid], ucp); - cnt += sizeof(char); -} - -void -FUNCTION(xdrfulong) ARGS(`xdrid, ulp, ret') -int *xdrid, *ret; -unsigned long *ulp; -{ - *ret = xdr_u_long(xdridptr[*xdrid], ulp); - cnt += sizeof(unsigned long); -} - -void -FUNCTION(xdrfushort) ARGS(`xdrid, usp, ret') -int *xdrid, *ret; -unsigned short *usp; -{ - *ret = xdr_u_short(xdridptr[*xdrid], usp); - cnt += sizeof(unsigned short); -} - -void -FUNCTION(xdrf3dfcoord) ARGS(`xdrid, fp, size, precision, ret') -int *xdrid, *ret; -float *fp; -int *size; -float *precision; -{ - *ret = xdr3dfcoord(xdridptr[*xdrid], fp, size, precision); -} - -void -FUNCTION(xdrfstring) ARGS(`xdrid, STRING_ARG(sp), maxsize, ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -int *maxsize; -{ - char *tsp; - - tsp = (char*) malloc(((STRING_LEN(sp)) + 1) * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, *maxsize+1, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int) *maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += *maxsize; - free(tsp); -} - -void -FUNCTION(xdrfwrapstring) ARGS(`xdrid, STRING_ARG(sp), ret') -int *xdrid, *ret; -STRING_ARG_DECL(sp); -{ - char *tsp; - int maxsize; - maxsize = (STRING_LEN(sp)) + 1; - tsp = (char*) malloc(maxsize * sizeof(char)); - if (tsp == NULL) { - *ret = -1; - return; - } - if (ftocstr(tsp, maxsize, STRING_PTR(sp), STRING_LEN(sp))) { - *ret = -1; - free(tsp); - return; - } - *ret = xdr_string(xdridptr[*xdrid], (char **) &tsp, (u_int)maxsize); - ctofstr( STRING_PTR(sp), STRING_LEN(sp), tsp); - cnt += maxsize; - free(tsp); -} - -void -FUNCTION(xdrfopaque) ARGS(`xdrid, cp, ccnt, ret') -int *xdrid, *ret; -caddr_t *cp; -int *ccnt; -{ - *ret = xdr_opaque(xdridptr[*xdrid], (caddr_t)*cp, (u_int)*ccnt); - cnt += *ccnt; -} - -void -FUNCTION(xdrfsetpos) ARGS(`xdrid, pos, ret') -int *xdrid, *ret; -int *pos; -{ - *ret = xdr_setpos(xdridptr[*xdrid], (u_int) *pos); -} - -void -FUNCTION(xdrf) ARGS(`xdrid, pos') -int *xdrid, *pos; -{ - *pos = xdr_getpos(xdridptr[*xdrid]); -} - -void -FUNCTION(xdrfvector) ARGS(`xdrid, cp, size, elproc, ret') -int *xdrid, *ret; -char *cp; -int *size; -FUNCTION(xdrfproc) elproc; -{ - int lcnt; - cnt = 0; - for (lcnt = 0; lcnt < *size; lcnt++) { - elproc(xdrid, (cp+cnt) , ret); - } -} - - -void -FUNCTION(xdrfclose) ARGS(`xdrid, ret') -int *xdrid; -int *ret; -{ - *ret = xdrclose(xdridptr[*xdrid]); - cnt = 0; -} - -void -FUNCTION(xdrfopen) ARGS(`xdrid, STRING_ARG(fp), STRING_ARG(mode), ret') -int *xdrid; -STRING_ARG_DECL(fp); -STRING_ARG_DECL(mode); -int *ret; -{ - char fname[512]; - char fmode[3]; - - if (ftocstr(fname, sizeof(fname), STRING_PTR(fp), STRING_LEN(fp))) { - *ret = 0; - } - if (ftocstr(fmode, sizeof(fmode), STRING_PTR(mode), - STRING_LEN(mode))) { - *ret = 0; - } - - *xdrid = xdropen(NULL, fname, fmode); - if (*xdrid == 0) - *ret = 0; - else - *ret = 1; -} - -/*___________________________________________________________________________ - | - | what follows are the C routines for opening, closing xdr streams - | and the routine to read/write compressed coordinates together - | with some routines to assist in this task (those are marked - | static and cannot be called from user programs) -*/ -#define MAXABS INT_MAX-2 - -#ifndef MIN -#define MIN(x,y) ((x) < (y) ? (x):(y)) -#endif -#ifndef MAX -#define MAX(x,y) ((x) > (y) ? (x):(y)) -#endif -#ifndef SQR -#define SQR(x) ((x)*(x)) -#endif -static int magicints[] = { - 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8, 10, 12, 16, 20, 25, 32, 40, 50, 64, - 80, 101, 128, 161, 203, 256, 322, 406, 512, 645, - 812, 1024, 1290, 1625, 2048, 2580, 3250, 4096, 5060, 6501, - 8192, 10321, 13003, 16384, 20642, 26007, 32768, 41285, 52015, 65536, - 82570, 104031, 131072, 165140, 208063, 262144, 330280, 416127, 524287, 660561, - 832255, 1048576, 1321122, 1664510, 2097152, 2642245, 3329021, 4194304, 5284491, 6658042, - 8388607, 10568983, 13316085, 16777216 }; - -#define FIRSTIDX 9 -/* note that magicints[FIRSTIDX-1] == 0 */ -#define LASTIDX (sizeof(magicints) / sizeof(*magicints)) - - -/*__________________________________________________________________________ - | - | xdropen - open xdr file - | - | This versions differs from xdrstdio_create, because I need to know - | the state of the file (read or write) so I can use xdr3dfcoord - | in eigther read or write mode, and the file descriptor - | so I can close the file (something xdr_destroy doesn't do). - | -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type) { - static int init_done = 0; - enum xdr_op lmode; - const char *type1; - int xdrid; - - if (init_done == 0) { - for (xdrid = 1; xdrid < MAXID; xdrid++) { - xdridptr[xdrid] = NULL; - } - init_done = 1; - } - xdrid = 1; - while (xdrid < MAXID && xdridptr[xdrid] != NULL) { - xdrid++; - } - if (xdrid == MAXID) { - return 0; - } - if (*type == 'w' || *type == 'W') { - type = "w+"; - type1 = "w+"; - lmode = XDR_ENCODE; - } else if (*type == 'a' || *type == 'A') { - type = "w+"; - type1 = "a+"; - lmode = XDR_ENCODE; - } else { - type = "r"; - type1 = "r"; - lmode = XDR_DECODE; - } - xdrfiles[xdrid] = fopen(filename, type1); - if (xdrfiles[xdrid] == NULL) { - xdrs = NULL; - return 0; - } - xdrmodes[xdrid] = *type; - /* next test isn't usefull in the case of C language - * but is used for the Fortran interface - * (C users are expected to pass the address of an already allocated - * XDR staructure) - */ - if (xdrs == NULL) { - xdridptr[xdrid] = (XDR *) malloc(sizeof(XDR)); - xdrstdio_create(xdridptr[xdrid], xdrfiles[xdrid], lmode); - } else { - xdridptr[xdrid] = xdrs; - xdrstdio_create(xdrs, xdrfiles[xdrid], lmode); - } - return xdrid; -} - -/*_________________________________________________________________________ - | - | xdrclose - close a xdr file - | - | This will flush the xdr buffers, and destroy the xdr stream. - | It also closes the associated file descriptor (this is *not* - | done by xdr_destroy). - | -*/ - -int xdrclose(XDR *xdrs) { - int xdrid; - - if (xdrs == NULL) { - fprintf(stderr, "xdrclose: passed a NULL pointer\n"); - exit(1); - } - for (xdrid = 1; xdrid < MAXID; xdrid++) { - if (xdridptr[xdrid] == xdrs) { - - xdr_destroy(xdrs); - fclose(xdrfiles[xdrid]); - xdridptr[xdrid] = NULL; - return 1; - } - } - fprintf(stderr, "xdrclose: no such open xdr file\n"); - exit(1); - -} - -/*____________________________________________________________________________ - | - | sendbits - encode num into buf using the specified number of bits - | - | This routines appends the value of num to the bits already present in - | the array buf. You need to give it the number of bits to use and you - | better make sure that this number of bits is enough to hold the value - | Also num must be positive. - | -*/ - -static void sendbits(int buf[], int num_of_bits, int num) { - - unsigned int cnt, lastbyte; - int lastbits; - unsigned char * cbuf; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = (unsigned int) buf[0]; - lastbits = buf[1]; - lastbyte =(unsigned int) buf[2]; - while (num_of_bits >= 8) { - lastbyte = (lastbyte << 8) | ((num >> (num_of_bits -8)) /* & 0xff*/); - cbuf[cnt++] = lastbyte >> lastbits; - num_of_bits -= 8; - } - if (num_of_bits > 0) { - lastbyte = (lastbyte << num_of_bits) | num; - lastbits += num_of_bits; - if (lastbits >= 8) { - lastbits -= 8; - cbuf[cnt++] = lastbyte >> lastbits; - } - } - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - if (lastbits>0) { - cbuf[cnt] = lastbyte << (8 - lastbits); - } -} - -/*_________________________________________________________________________ - | - | sizeofint - calculate bitsize of an integer - | - | return the number of bits needed to store an integer with given max size - | -*/ - -static int sizeofint(const int size) { - unsigned int num = 1; - int num_of_bits = 0; - - while (size >= num && num_of_bits < 32) { - num_of_bits++; - num <<= 1; - } - return num_of_bits; -} - -/*___________________________________________________________________________ - | - | sizeofints - calculate 'bitsize' of compressed ints - | - | given the number of small unsigned integers and the maximum value - | return the number of bits needed to read or write them with the - | routines receiveints and sendints. You need this parameter when - | calling these routines. Note that for many calls I can use - | the variable 'smallidx' which is exactly the number of bits, and - | So I don't need to call 'sizeofints for those calls. -*/ - -static int sizeofints( const int num_of_ints, unsigned int sizes[]) { - int i, num; - unsigned int num_of_bytes, num_of_bits, bytes[32], bytecnt, tmp; - num_of_bytes = 1; - bytes[0] = 1; - num_of_bits = 0; - for (i=0; i < num_of_ints; i++) { - tmp = 0; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - num = 1; - num_of_bytes--; - while (bytes[num_of_bytes] >= num) { - num_of_bits++; - num *= 2; - } - return num_of_bits + num_of_bytes * 8; - -} - -/*____________________________________________________________________________ - | - | sendints - send a small set of small integers in compressed format - | - | this routine is used internally by xdr3dfcoord, to send a set of - | small integers to the buffer. - | Multiplication with fixed (specified maximum ) sizes is used to get - | to one big, multibyte integer. Allthough the routine could be - | modified to handle sizes bigger than 16777216, or more than just - | a few integers, this is not done, because the gain in compression - | isn't worth the effort. Note that overflowing the multiplication - | or the byte buffer (32 bytes) is unchecked and causes bad results. - | - */ - -static void sendints(int buf[], const int num_of_ints, const int num_of_bits, - unsigned int sizes[], unsigned int nums[]) { - - int i; - unsigned int bytes[32], num_of_bytes, bytecnt, tmp; - - tmp = nums[0]; - num_of_bytes = 0; - do { - bytes[num_of_bytes++] = tmp & 0xff; - tmp >>= 8; - } while (tmp != 0); - - for (i = 1; i < num_of_ints; i++) { - if (nums[i] >= sizes[i]) { - fprintf(stderr,"major breakdown in sendints num %d doesn't " - "match size %d\n", nums[i], sizes[i]); - exit(1); - } - /* use one step multiply */ - tmp = nums[i]; - for (bytecnt = 0; bytecnt < num_of_bytes; bytecnt++) { - tmp = bytes[bytecnt] * sizes[i] + tmp; - bytes[bytecnt] = tmp & 0xff; - tmp >>= 8; - } - while (tmp != 0) { - bytes[bytecnt++] = tmp & 0xff; - tmp >>= 8; - } - num_of_bytes = bytecnt; - } - if (num_of_bits >= num_of_bytes * 8) { - for (i = 0; i < num_of_bytes; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits - num_of_bytes * 8, 0); - } else { - for (i = 0; i < num_of_bytes-1; i++) { - sendbits(buf, 8, bytes[i]); - } - sendbits(buf, num_of_bits- (num_of_bytes -1) * 8, bytes[i]); - } -} - - -/*___________________________________________________________________________ - | - | receivebits - decode number from buf using specified number of bits - | - | extract the number of bits from the array buf and construct an integer - | from it. Return that value. - | -*/ - -static int receivebits(int buf[], int num_of_bits) { - - int cnt, num; - unsigned int lastbits, lastbyte; - unsigned char * cbuf; - int mask = (1 << num_of_bits) -1; - - cbuf = ((unsigned char *)buf) + 3 * sizeof(*buf); - cnt = buf[0]; - lastbits = (unsigned int) buf[1]; - lastbyte = (unsigned int) buf[2]; - - num = 0; - while (num_of_bits >= 8) { - lastbyte = ( lastbyte << 8 ) | cbuf[cnt++]; - num |= (lastbyte >> lastbits) << (num_of_bits - 8); - num_of_bits -=8; - } - if (num_of_bits > 0) { - if (lastbits < num_of_bits) { - lastbits += 8; - lastbyte = (lastbyte << 8) | cbuf[cnt++]; - } - lastbits -= num_of_bits; - num |= (lastbyte >> lastbits) & ((1 << num_of_bits) -1); - } - num &= mask; - buf[0] = cnt; - buf[1] = lastbits; - buf[2] = lastbyte; - return num; -} - -/*____________________________________________________________________________ - | - | receiveints - decode 'small' integers from the buf array - | - | this routine is the inverse from sendints() and decodes the small integers - | written to buf by calculating the remainder and doing divisions with - | the given sizes[]. You need to specify the total number of bits to be - | used from buf in num_of_bits. - | -*/ - -static void receiveints(int buf[], const int num_of_ints, int num_of_bits, - unsigned int sizes[], int nums[]) { - int bytes[32]; - int i, j, num_of_bytes, p, num; - - bytes[1] = bytes[2] = bytes[3] = 0; - num_of_bytes = 0; - while (num_of_bits > 8) { - bytes[num_of_bytes++] = receivebits(buf, 8); - num_of_bits -= 8; - } - if (num_of_bits > 0) { - bytes[num_of_bytes++] = receivebits(buf, num_of_bits); - } - for (i = num_of_ints-1; i > 0; i--) { - num = 0; - for (j = num_of_bytes-1; j >=0; j--) { - num = (num << 8) | bytes[j]; - p = num / sizes[i]; - bytes[j] = p; - num = num - p * sizes[i]; - } - nums[i] = num; - } - nums[0] = bytes[0] | (bytes[1] << 8) | (bytes[2] << 16) | (bytes[3] << 24); -} - -/*____________________________________________________________________________ - | - | xdr3dfcoord - read or write compressed 3d coordinates to xdr file. - | - | this routine reads or writes (depending on how you opened the file with - | xdropen() ) a large number of 3d coordinates (stored in *fp). - | The number of coordinates triplets to write is given by *size. On - | read this number may be zero, in which case it reads as many as were written - | or it may specify the number if triplets to read (which should match the - | number written). - | Compression is achieved by first converting all floating numbers to integer - | using multiplication by *precision and rounding to the nearest integer. - | Then the minimum and maximum value are calculated to determine the range. - | The limited range of integers so found, is used to compress the coordinates. - | In addition the differences between succesive coordinates is calculated. - | If the difference happens to be 'small' then only the difference is saved, - | compressing the data even more. The notion of 'small' is changed dynamically - | and is enlarged or reduced whenever needed or possible. - | Extra compression is achieved in the case of GROMOS and coordinates of - | water molecules. GROMOS first writes out the Oxygen position, followed by - | the two hydrogens. In order to make the differences smaller (and thereby - | compression the data better) the order is changed into first one hydrogen - | then the oxygen, followed by the other hydrogen. This is rather special, but - | it shouldn't harm in the general case. - | - */ - -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) { - - - static int *ip = NULL; - static int oldsize; - static int *buf; - - int minint[3], maxint[3], mindiff, *lip, diff; - int lint1, lint2, lint3, oldlint1, oldlint2, oldlint3, smallidx; - int minidx, maxidx; - unsigned sizeint[3], sizesmall[3], bitsizeint[3], size3, *luip; - int flag, k; - int small, smaller, larger, i, is_small, is_smaller, run, prevrun; - float *lfp, lf; - int tmp, *thiscoord, prevcoord[3]; - unsigned int tmpcoord[30]; - - int bufsize, xdrid, lsize; - unsigned int bitsize; - float inv_precision; - int errval = 1; - - /* find out if xdrs is opened for reading or for writing */ - xdrid = 0; - while (xdridptr[xdrid] != xdrs) { - xdrid++; - if (xdrid >= MAXID) { - fprintf(stderr, "xdr error. no open xdr stream\n"); - exit (1); - } - } - if (xdrmodes[xdrid] == 'w') { - - /* xdrs is open for writing */ - - if (xdr_int(xdrs, size) == 0) - return 0; - size3 = *size * 3; - /* when the number of coordinates is small, don't try to compress; just - * write them as floats using xdr_vector - */ - if (*size <= 9 ) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - /* buf[0-2] are special and do not contain actual data */ - buf[0] = buf[1] = buf[2] = 0; - minint[0] = minint[1] = minint[2] = INT_MAX; - maxint[0] = maxint[1] = maxint[2] = INT_MIN; - prevrun = -1; - lfp = fp; - lip = ip; - mindiff = INT_MAX; - oldlint1 = oldlint2 = oldlint3 = 0; - while(lfp < fp + size3 ) { - /* find nearest integer */ - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint1 = lf; - if (lint1 < minint[0]) minint[0] = lint1; - if (lint1 > maxint[0]) maxint[0] = lint1; - *lip++ = lint1; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint2 = lf; - if (lint2 < minint[1]) minint[1] = lint2; - if (lint2 > maxint[1]) maxint[1] = lint2; - *lip++ = lint2; - lfp++; - if (*lfp >= 0.0) - lf = *lfp * *precision + 0.5; - else - lf = *lfp * *precision - 0.5; - if (fabs(lf) > MAXABS) { - /* scaling would cause overflow */ - errval = 0; - } - lint3 = lf; - if (lint3 < minint[2]) minint[2] = lint3; - if (lint3 > maxint[2]) maxint[2] = lint3; - *lip++ = lint3; - lfp++; - diff = abs(oldlint1-lint1)+abs(oldlint2-lint2)+abs(oldlint3-lint3); - if (diff < mindiff && lfp > fp + 3) - mindiff = diff; - oldlint1 = lint1; - oldlint2 = lint2; - oldlint3 = lint3; - } - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - if ((float)maxint[0] - (float)minint[0] >= MAXABS || - (float)maxint[1] - (float)minint[1] >= MAXABS || - (float)maxint[2] - (float)minint[2] >= MAXABS) { - /* turning value in unsigned by subtracting minint - * would cause overflow - */ - errval = 0; - } - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - lip = ip; - luip = (unsigned int *) ip; - smallidx = FIRSTIDX; - while (smallidx < LASTIDX && magicints[smallidx] < mindiff) { - smallidx++; - } - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - larger = magicints[maxidx] / 2; - i = 0; - while (i < *size) { - is_small = 0; - thiscoord = (int *)(luip) + i * 3; - if (smallidx < maxidx && i >= 1 && - abs(thiscoord[0] - prevcoord[0]) < larger && - abs(thiscoord[1] - prevcoord[1]) < larger && - abs(thiscoord[2] - prevcoord[2]) < larger) { - is_smaller = 1; - } else if (smallidx > minidx) { - is_smaller = -1; - } else { - is_smaller = 0; - } - if (i + 1 < *size) { - if (abs(thiscoord[0] - thiscoord[3]) < small && - abs(thiscoord[1] - thiscoord[4]) < small && - abs(thiscoord[2] - thiscoord[5]) < small) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = thiscoord[3]; - thiscoord[3] = tmp; - tmp = thiscoord[1]; thiscoord[1] = thiscoord[4]; - thiscoord[4] = tmp; - tmp = thiscoord[2]; thiscoord[2] = thiscoord[5]; - thiscoord[5] = tmp; - is_small = 1; - } - - } - tmpcoord[0] = thiscoord[0] - minint[0]; - tmpcoord[1] = thiscoord[1] - minint[1]; - tmpcoord[2] = thiscoord[2] - minint[2]; - if (bitsize == 0) { - sendbits(buf, bitsizeint[0], tmpcoord[0]); - sendbits(buf, bitsizeint[1], tmpcoord[1]); - sendbits(buf, bitsizeint[2], tmpcoord[2]); - } else { - sendints(buf, 3, bitsize, sizeint, tmpcoord); - } - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - thiscoord = thiscoord + 3; - i++; - - run = 0; - if (is_small == 0 && is_smaller == -1) - is_smaller = 0; - while (is_small && run < 8*3) { - if (is_smaller == -1 && ( - SQR(thiscoord[0] - prevcoord[0]) + - SQR(thiscoord[1] - prevcoord[1]) + - SQR(thiscoord[2] - prevcoord[2]) >= smaller * smaller)) { - is_smaller = 0; - } - - tmpcoord[run++] = thiscoord[0] - prevcoord[0] + small; - tmpcoord[run++] = thiscoord[1] - prevcoord[1] + small; - tmpcoord[run++] = thiscoord[2] - prevcoord[2] + small; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - i++; - thiscoord = thiscoord + 3; - is_small = 0; - if (i < *size && - abs(thiscoord[0] - prevcoord[0]) < small && - abs(thiscoord[1] - prevcoord[1]) < small && - abs(thiscoord[2] - prevcoord[2]) < small) { - is_small = 1; - } - } - if (run != prevrun || is_smaller != 0) { - prevrun = run; - sendbits(buf, 1, 1); /* flag the change in run-length */ - sendbits(buf, 5, run+is_smaller+1); - } else { - sendbits(buf, 1, 0); /* flag the fact that runlength did not change */ - } - for (k=0; k < run; k+=3) { - sendints(buf, 3, smallidx, sizesmall, &tmpcoord[k]); - } - if (is_smaller != 0) { - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - smaller = magicints[smallidx-1] / 2; - } else { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx]; - } - } - if (buf[1] != 0) buf[0]++;; - xdr_int(xdrs, &(buf[0])); /* buf[0] holds the length in bytes */ - return errval * (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0])); - } else { - - /* xdrs is open for reading */ - - if (xdr_int(xdrs, &lsize) == 0) - return 0; - if (*size != 0 && lsize != *size) { - fprintf(stderr, "wrong number of coordinates in xdr3dfcoor; " - "%d arg vs %d in file", *size, lsize); - } - *size = lsize; - size3 = *size * 3; - if (*size <= 9) { - return (xdr_vector(xdrs, (char *) fp, size3, sizeof(*fp), - (xdrproc_t)xdr_float)); - } - xdr_float(xdrs, precision); - if (ip == NULL) { - ip = (int *)malloc(size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)malloc(bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } else if (*size > oldsize) { - ip = (int *)realloc(ip, size3 * sizeof(*ip)); - if (ip == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - bufsize = size3 * 1.2; - buf = (int *)realloc(buf, bufsize * sizeof(*buf)); - if (buf == NULL) { - fprintf(stderr,"malloc failed\n"); - exit(1); - } - oldsize = *size; - } - buf[0] = buf[1] = buf[2] = 0; - - xdr_int(xdrs, &(minint[0])); - xdr_int(xdrs, &(minint[1])); - xdr_int(xdrs, &(minint[2])); - - xdr_int(xdrs, &(maxint[0])); - xdr_int(xdrs, &(maxint[1])); - xdr_int(xdrs, &(maxint[2])); - - sizeint[0] = maxint[0] - minint[0]+1; - sizeint[1] = maxint[1] - minint[1]+1; - sizeint[2] = maxint[2] - minint[2]+1; - - /* check if one of the sizes is to big to be multiplied */ - if ((sizeint[0] | sizeint[1] | sizeint[2] ) > 0xffffff) { - bitsizeint[0] = sizeofint(sizeint[0]); - bitsizeint[1] = sizeofint(sizeint[1]); - bitsizeint[2] = sizeofint(sizeint[2]); - bitsize = 0; /* flag the use of large sizes */ - } else { - bitsize = sizeofints(3, sizeint); - } - - xdr_int(xdrs, &smallidx); - maxidx = MIN(LASTIDX, smallidx + 8) ; - minidx = maxidx - 8; /* often this equal smallidx */ - smaller = magicints[MAX(FIRSTIDX, smallidx-1)] / 2; - small = magicints[smallidx] / 2; - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - larger = magicints[maxidx]; - - /* buf[0] holds the length in bytes */ - - if (xdr_int(xdrs, &(buf[0])) == 0) - return 0; - if (xdr_opaque(xdrs, (caddr_t)&(buf[3]), (u_int)buf[0]) == 0) - return 0; - buf[0] = buf[1] = buf[2] = 0; - - lfp = fp; - inv_precision = 1.0 / * precision; - run = 0; - i = 0; - lip = ip; - while ( i < lsize ) { - thiscoord = (int *)(lip) + i * 3; - - if (bitsize == 0) { - thiscoord[0] = receivebits(buf, bitsizeint[0]); - thiscoord[1] = receivebits(buf, bitsizeint[1]); - thiscoord[2] = receivebits(buf, bitsizeint[2]); - } else { - receiveints(buf, 3, bitsize, sizeint, thiscoord); - } - - i++; - thiscoord[0] += minint[0]; - thiscoord[1] += minint[1]; - thiscoord[2] += minint[2]; - - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - - - flag = receivebits(buf, 1); - is_smaller = 0; - if (flag == 1) { - run = receivebits(buf, 5); - is_smaller = run % 3; - run -= is_smaller; - is_smaller--; - } - if (run > 0) { - thiscoord += 3; - for (k = 0; k < run; k+=3) { - receiveints(buf, 3, smallidx, sizesmall, thiscoord); - i++; - thiscoord[0] += prevcoord[0] - small; - thiscoord[1] += prevcoord[1] - small; - thiscoord[2] += prevcoord[2] - small; - if (k == 0) { - /* interchange first with second atom for better - * compression of water molecules - */ - tmp = thiscoord[0]; thiscoord[0] = prevcoord[0]; - prevcoord[0] = tmp; - tmp = thiscoord[1]; thiscoord[1] = prevcoord[1]; - prevcoord[1] = tmp; - tmp = thiscoord[2]; thiscoord[2] = prevcoord[2]; - prevcoord[2] = tmp; - *lfp++ = prevcoord[0] * inv_precision; - *lfp++ = prevcoord[1] * inv_precision; - *lfp++ = prevcoord[2] * inv_precision; - } else { - prevcoord[0] = thiscoord[0]; - prevcoord[1] = thiscoord[1]; - prevcoord[2] = thiscoord[2]; - } - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - } else { - *lfp++ = thiscoord[0] * inv_precision; - *lfp++ = thiscoord[1] * inv_precision; - *lfp++ = thiscoord[2] * inv_precision; - } - smallidx += is_smaller; - if (is_smaller < 0) { - small = smaller; - if (smallidx > FIRSTIDX) { - smaller = magicints[smallidx - 1] /2; - } else { - smaller = 0; - } - } else if (is_smaller > 0) { - smaller = small; - small = magicints[smallidx] / 2; - } - sizesmall[0] = sizesmall[1] = sizesmall[2] = magicints[smallidx] ; - } - } - return 1; -} - - - diff --git a/source/xdrfpdb/src/xdrf/types.h b/source/xdrfpdb/src/xdrf/types.h deleted file mode 100644 index 871f3fd..0000000 --- a/source/xdrfpdb/src/xdrf/types.h +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -/* fixincludes should not add extern "C" to this file */ -/* - * Rpc additions to - */ -#ifndef _RPC_TYPES_H -#define _RPC_TYPES_H 1 - -typedef int bool_t; -typedef int enum_t; -/* This needs to be changed to uint32_t in the future */ -typedef unsigned long rpcprog_t; -typedef unsigned long rpcvers_t; -typedef unsigned long rpcproc_t; -typedef unsigned long rpcprot_t; -typedef unsigned long rpcport_t; - -#define __dontcare__ -1 - -#ifndef FALSE -# define FALSE (0) -#endif - -#ifndef TRUE -# define TRUE (1) -#endif - -#ifndef NULL -# define NULL 0 -#endif - -#include /* For malloc decl. */ -#define mem_alloc(bsize) malloc(bsize) -/* - * XXX: This must not use the second argument, or code in xdr_array.c needs - * to be modified. - */ -#define mem_free(ptr, bsize) free(ptr) - -#ifndef makedev /* ie, we haven't already included it */ -#include -#endif - -#ifndef __u_char_defined -typedef __u_char u_char; -typedef __u_short u_short; -typedef __u_int u_int; -typedef __u_long u_long; -typedef __quad_t quad_t; -typedef __u_quad_t u_quad_t; -typedef __fsid_t fsid_t; -# define __u_char_defined -#endif -#ifndef __daddr_t_defined -typedef __daddr_t daddr_t; -typedef __caddr_t caddr_t; -# define __daddr_t_defined -#endif - -#include -#include - -#include - -#ifndef INADDR_LOOPBACK -#define INADDR_LOOPBACK (u_long)0x7F000001 -#endif -#ifndef MAXHOSTNAMELEN -#define MAXHOSTNAMELEN 64 -#endif - -#endif /* rpc/types.h */ diff --git a/source/xdrfpdb/src/xdrf/underscore.m4 b/source/xdrfpdb/src/xdrf/underscore.m4 deleted file mode 100644 index 4d620a0..0000000 --- a/source/xdrfpdb/src/xdrf/underscore.m4 +++ /dev/null @@ -1,19 +0,0 @@ -divert(-1) -undefine(`len') -# -# append an underscore to FORTRAN function names -# -define(`FUNCTION',`$1_') -# -# FORTRAN character strings are passed as follows: -# a pointer to the base of the string is passed in the normal -# argument list, and the length is passed by value as an extra -# argument, after all of the other arguments. -# -define(`ARGS',`($1`'undivert(1))') -define(`SAVE',`divert(1)$1`'divert(0)') -define(`STRING_ARG',`$1_ptr`'SAVE(`, $1_len')') -define(`STRING_ARG_DECL',`char * $1_ptr; int $1_len') -define(`STRING_LEN',`$1_len') -define(`STRING_PTR',`$1_ptr') -divert(0) diff --git a/source/xdrfpdb/src/xdrf/xdr.c b/source/xdrfpdb/src/xdrf/xdr.c deleted file mode 100644 index 33b8544..0000000 --- a/source/xdrfpdb/src/xdrf/xdr.c +++ /dev/null @@ -1,752 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr.c 1.35 87/08/12"; -#endif - -/* - * xdr.c, Generic XDR routines implementation. - * - * Copyright (C) 1986, Sun Microsystems, Inc. - * - * These are the "generic" xdr routines used to serialize and de-serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include -#include -#include - -#include "types.h" -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -#endif - -/* - * constants specific to the xdr "protocol" - */ -#define XDR_FALSE ((long) 0) -#define XDR_TRUE ((long) 1) -#define LASTUNSIGNED ((u_int) 0-1) - -/* - * for unit alignment - */ -static const char xdr_zero[BYTES_PER_XDR_UNIT] = {0, 0, 0, 0}; - -/* - * Free a data structure using XDR - * Not a filter, but a convenient utility nonetheless - */ -void -xdr_free (xdrproc_t proc, char *objp) -{ - XDR x; - - x.x_op = XDR_FREE; - (*proc) (&x, objp); -} - -/* - * XDR nothing - */ -bool_t -xdr_void (void) -{ - return TRUE; -} -INTDEF(xdr_void) - -/* - * XDR integers - */ -bool_t -xdr_int (XDR *xdrs, int *ip) -{ - -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *ip; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ip = (int) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif INT_MAX == LONG_MAX - return INTUSE(xdr_long) (xdrs, (long *) ip); -#elif INT_MAX == SHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) ip); -#else -#error unexpected integer sizes in_xdr_int() -#endif -} -INTDEF(xdr_int) - -/* - * XDR unsigned integers - */ -bool_t -xdr_u_int (XDR *xdrs, u_int *up) -{ -#if UINT_MAX < ULONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * up; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *up = (u_int) (u_long) l; - case XDR_FREE: - return TRUE; - } - return FALSE; -#elif UINT_MAX == ULONG_MAX - return INTUSE(xdr_u_long) (xdrs, (u_long *) up); -#elif UINT_MAX == USHRT_MAX - return INTUSE(xdr_short) (xdrs, (short *) up); -#else -#error unexpected integer sizes in_xdr_u_int() -#endif -} -INTDEF(xdr_u_int) - -/* - * XDR long integers - * The definition of xdr_long() is kept for backward - * compatibility. Instead xdr_int() should be used. - */ -bool_t -xdr_long (XDR *xdrs, long *lp) -{ - - if (xdrs->x_op == XDR_ENCODE - && (sizeof (int32_t) == sizeof (long) - || (int32_t) *lp == *lp)) - return XDR_PUTLONG (xdrs, lp); - - if (xdrs->x_op == XDR_DECODE) - return XDR_GETLONG (xdrs, lp); - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_long) - -/* - * XDR unsigned long integers - * The definition of xdr_u_long() is kept for backward - * compatibility. Instead xdr_u_int() should be used. - */ -bool_t -xdr_u_long (XDR *xdrs, u_long *ulp) -{ - switch (xdrs->x_op) - { - case XDR_DECODE: - { - long int tmp; - - if (XDR_GETLONG (xdrs, &tmp) == FALSE) - return FALSE; - - *ulp = (uint32_t) tmp; - return TRUE; - } - - case XDR_ENCODE: - if (sizeof (uint32_t) != sizeof (u_long) - && (uint32_t) *ulp != *ulp) - return FALSE; - - return XDR_PUTLONG (xdrs, (long *) ulp); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_long) - -/* - * XDR hyper integers - * same as xdr_u_hyper - open coded to save a proc call! - */ -bool_t -xdr_hyper (XDR *xdrs, quad_t *llp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (long) ((*llp) >> 32); - t2 = (long) (*llp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *llp = ((quad_t) t1) << 32; - *llp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_hyper) - - -/* - * XDR hyper integers - * same as xdr_hyper - open coded to save a proc call! - */ -bool_t -xdr_u_hyper (XDR *xdrs, u_quad_t *ullp) -{ - long int t1, t2; - - if (xdrs->x_op == XDR_ENCODE) - { - t1 = (unsigned long) ((*ullp) >> 32); - t2 = (unsigned long) (*ullp); - return (XDR_PUTLONG(xdrs, &t1) && XDR_PUTLONG(xdrs, &t2)); - } - - if (xdrs->x_op == XDR_DECODE) - { - if (!XDR_GETLONG(xdrs, &t1) || !XDR_GETLONG(xdrs, &t2)) - return FALSE; - *ullp = ((u_quad_t) t1) << 32; - *ullp |= (uint32_t) t2; - return TRUE; - } - - if (xdrs->x_op == XDR_FREE) - return TRUE; - - return FALSE; -} -INTDEF(xdr_u_hyper) - -bool_t -xdr_longlong_t (XDR *xdrs, quad_t *llp) -{ - return INTUSE(xdr_hyper) (xdrs, llp); -} - -bool_t -xdr_u_longlong_t (XDR *xdrs, u_quad_t *ullp) -{ - return INTUSE(xdr_u_hyper) (xdrs, ullp); -} - -/* - * XDR short integers - */ -bool_t -xdr_short (XDR *xdrs, short *sp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (long) *sp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *sp = (short) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_short) - -/* - * XDR unsigned short integers - */ -bool_t -xdr_u_short (XDR *xdrs, u_short *usp) -{ - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = (u_long) * usp; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *usp = (u_short) (u_long) l; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_u_short) - - -/* - * XDR a char - */ -bool_t -xdr_char (XDR *xdrs, char *cp) -{ - int i; - - i = (*cp); - if (!INTUSE(xdr_int) (xdrs, &i)) - { - return FALSE; - } - *cp = i; - return TRUE; -} - -/* - * XDR an unsigned char - */ -bool_t -xdr_u_char (XDR *xdrs, u_char *cp) -{ - u_int u; - - u = (*cp); - if (!INTUSE(xdr_u_int) (xdrs, &u)) - { - return FALSE; - } - *cp = u; - return TRUE; -} - -/* - * XDR booleans - */ -bool_t -xdr_bool (XDR *xdrs, bool_t *bp) -{ - long lb; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - lb = *bp ? XDR_TRUE : XDR_FALSE; - return XDR_PUTLONG (xdrs, &lb); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &lb)) - { - return FALSE; - } - *bp = (lb == XDR_FALSE) ? FALSE : TRUE; - return TRUE; - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bool) - -/* - * XDR enumerations - */ -bool_t -xdr_enum (XDR *xdrs, enum_t *ep) -{ - enum sizecheck - { - SIZEVAL - }; /* used to find the size of an enum */ - - /* - * enums are treated as ints - */ - if (sizeof (enum sizecheck) == 4) - { -#if INT_MAX < LONG_MAX - long l; - - switch (xdrs->x_op) - { - case XDR_ENCODE: - l = *ep; - return XDR_PUTLONG (xdrs, &l); - - case XDR_DECODE: - if (!XDR_GETLONG (xdrs, &l)) - { - return FALSE; - } - *ep = l; - case XDR_FREE: - return TRUE; - - } - return FALSE; -#else - return INTUSE(xdr_long) (xdrs, (long *) ep); -#endif - } - else if (sizeof (enum sizecheck) == sizeof (short)) - { - return INTUSE(xdr_short) (xdrs, (short *) ep); - } - else - { - return FALSE; - } -} -INTDEF(xdr_enum) - -/* - * XDR opaque data - * Allows the specification of a fixed size sequence of opaque bytes. - * cp points to the opaque object and cnt gives the byte length. - */ -bool_t -xdr_opaque (XDR *xdrs, caddr_t cp, u_int cnt) -{ - u_int rndup; - static char crud[BYTES_PER_XDR_UNIT]; - - /* - * if no data we are done - */ - if (cnt == 0) - return TRUE; - - /* - * round byte count to full xdr units - */ - rndup = cnt % BYTES_PER_XDR_UNIT; - if (rndup > 0) - rndup = BYTES_PER_XDR_UNIT - rndup; - - switch (xdrs->x_op) - { - case XDR_DECODE: - if (!XDR_GETBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_GETBYTES (xdrs, (caddr_t)crud, rndup); - - case XDR_ENCODE: - if (!XDR_PUTBYTES (xdrs, cp, cnt)) - { - return FALSE; - } - if (rndup == 0) - return TRUE; - return XDR_PUTBYTES (xdrs, xdr_zero, rndup); - - case XDR_FREE: - return TRUE; - } - return FALSE; -} -INTDEF(xdr_opaque) - -/* - * XDR counted bytes - * *cpp is a pointer to the bytes, *sizep is the count. - * If *cpp is NULL maxsize bytes are allocated - */ -bool_t -xdr_bytes (xdrs, cpp, sizep, maxsize) - XDR *xdrs; - char **cpp; - u_int *sizep; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int nodesize; - - /* - * first deal with the length since xdr bytes are counted - */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - nodesize = *sizep; - if ((nodesize > maxsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (nodesize == 0) - { - return TRUE; - } - if (sp == NULL) - { - *cpp = sp = (char *) mem_alloc (nodesize); - } - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_bytes: out of memory\n"); - return FALSE; - } - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, nodesize); - - case XDR_FREE: - if (sp != NULL) - { - mem_free (sp, nodesize); - *cpp = NULL; - } - return TRUE; - } - return FALSE; -} -INTDEF(xdr_bytes) - -/* - * Implemented here due to commonality of the object. - */ -bool_t -xdr_netobj (xdrs, np) - XDR *xdrs; - struct netobj *np; -{ - - return INTUSE(xdr_bytes) (xdrs, &np->n_bytes, &np->n_len, MAX_NETOBJ_SZ); -} -INTDEF(xdr_netobj) - -/* - * XDR a discriminated union - * Support routine for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * an entry with a null procedure pointer. The routine gets - * the discriminant value and then searches the array of xdrdiscrims - * looking for that value. It calls the procedure given in the xdrdiscrim - * to handle the discriminant. If there is no specific routine a default - * routine may be called. - * If there is no specific or default routine an error is returned. - */ -bool_t -xdr_union (xdrs, dscmp, unp, choices, dfault) - XDR *xdrs; - enum_t *dscmp; /* enum to decide which arm to work on */ - char *unp; /* the union itself */ - const struct xdr_discrim *choices; /* [value, xdr proc] for each arm */ - xdrproc_t dfault; /* default xdr routine */ -{ - enum_t dscm; - - /* - * we deal with the discriminator; it's an enum - */ - if (!INTUSE(xdr_enum) (xdrs, dscmp)) - { - return FALSE; - } - dscm = *dscmp; - - /* - * search choices for a value that matches the discriminator. - * if we find one, execute the xdr routine for that value. - */ - for (; choices->proc != NULL_xdrproc_t; choices++) - { - if (choices->value == dscm) - return (*(choices->proc)) (xdrs, unp, LASTUNSIGNED); - } - - /* - * no match - execute the default xdr routine if there is one - */ - return ((dfault == NULL_xdrproc_t) ? FALSE : - (*dfault) (xdrs, unp, LASTUNSIGNED)); -} -INTDEF(xdr_union) - - -/* - * Non-portable xdr primitives. - * Care should be taken when moving these routines to new architectures. - */ - - -/* - * XDR null terminated ASCII strings - * xdr_string deals with "C strings" - arrays of bytes that are - * terminated by a NULL character. The parameter cpp references a - * pointer to storage; If the pointer is null, then the necessary - * storage is allocated. The last parameter is the max allowed length - * of the string as specified by a protocol. - */ -bool_t -xdr_string (xdrs, cpp, maxsize) - XDR *xdrs; - char **cpp; - u_int maxsize; -{ - char *sp = *cpp; /* sp is the actual string pointer */ - u_int size; - u_int nodesize; - - /* - * first deal with the length since xdr strings are counted-strings - */ - switch (xdrs->x_op) - { - case XDR_FREE: - if (sp == NULL) - { - return TRUE; /* already free */ - } - /* fall through... */ - case XDR_ENCODE: - if (sp == NULL) - return FALSE; - size = strlen (sp); - break; - case XDR_DECODE: - break; - } - if (!INTUSE(xdr_u_int) (xdrs, &size)) - { - return FALSE; - } - if (size > maxsize) - { - return FALSE; - } - nodesize = size + 1; - if (nodesize == 0) - { - /* This means an overflow. It a bug in the caller which - provided a too large maxsize but nevertheless catch it - here. */ - return FALSE; - } - - /* - * now deal with the actual bytes - */ - switch (xdrs->x_op) - { - case XDR_DECODE: - if (sp == NULL) - *cpp = sp = (char *) mem_alloc (nodesize); - if (sp == NULL) - { - fprintf (NULL, "%s", "xdr_string: out of memory\n"); - return FALSE; - } - sp[size] = 0; - /* fall into ... */ - - case XDR_ENCODE: - return INTUSE(xdr_opaque) (xdrs, sp, size); - - case XDR_FREE: - mem_free (sp, nodesize); - *cpp = NULL; - return TRUE; - } - return FALSE; -} -INTDEF(xdr_string) - -/* - * Wrapper for xdr_string that can be called directly from - * routines like clnt_call - */ -bool_t -xdr_wrapstring (xdrs, cpp) - XDR *xdrs; - char **cpp; -{ - if (INTUSE(xdr_string) (xdrs, cpp, LASTUNSIGNED)) - { - return TRUE; - } - return FALSE; -} diff --git a/source/xdrfpdb/src/xdrf/xdr.h b/source/xdrfpdb/src/xdrf/xdr.h deleted file mode 100644 index 2602ad9..0000000 --- a/source/xdrfpdb/src/xdrf/xdr.h +++ /dev/null @@ -1,379 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr.h, External Data Representation Serialization Routines. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - */ - -#ifndef _RPC_XDR_H -#define _RPC_XDR_H 1 - -#include -#include -#include "types.h" - -/* We need FILE. */ -#include - -__BEGIN_DECLS - -/* - * XDR provides a conventional way for converting between C data - * types and an external bit-string representation. Library supplied - * routines provide for the conversion on built-in C data types. These - * routines and utility routines defined here are used to help implement - * a type encode/decode routine for each user-defined type. - * - * Each data type provides a single procedure which takes two arguments: - * - * bool_t - * xdrproc(xdrs, argresp) - * XDR *xdrs; - * *argresp; - * - * xdrs is an instance of a XDR handle, to which or from which the data - * type is to be converted. argresp is a pointer to the structure to be - * converted. The XDR handle contains an operation field which indicates - * which of the operations (ENCODE, DECODE * or FREE) is to be performed. - * - * XDR_DECODE may allocate space if the pointer argresp is null. This - * data can be freed with the XDR_FREE operation. - * - * We write only one procedure per data type to make it easy - * to keep the encode and decode procedures for a data type consistent. - * In many cases the same code performs all operations on a user defined type, - * because all the hard work is done in the component type routines. - * decode as a series of calls on the nested data types. - */ - -/* - * Xdr operations. XDR_ENCODE causes the type to be encoded into the - * stream. XDR_DECODE causes the type to be extracted from the stream. - * XDR_FREE can be used to release the space allocated by an XDR_DECODE - * request. - */ -enum xdr_op { - XDR_ENCODE = 0, - XDR_DECODE = 1, - XDR_FREE = 2 -}; - -/* - * This is the number of bytes per unit of external data. - */ -#define BYTES_PER_XDR_UNIT (4) -/* - * This only works if the above is a power of 2. But it's defined to be - * 4 by the appropriate RFCs. So it will work. And it's normally quicker - * than the old routine. - */ -#if 1 -#define RNDUP(x) (((x) + BYTES_PER_XDR_UNIT - 1) & ~(BYTES_PER_XDR_UNIT - 1)) -#else /* this is the old routine */ -#define RNDUP(x) ((((x) + BYTES_PER_XDR_UNIT - 1) / BYTES_PER_XDR_UNIT) \ - * BYTES_PER_XDR_UNIT) -#endif - -/* - * The XDR handle. - * Contains operation which is being applied to the stream, - * an operations vector for the particular implementation (e.g. see xdr_mem.c), - * and two private fields for the use of the particular implementation. - */ -typedef struct XDR XDR; -struct XDR - { - enum xdr_op x_op; /* operation; fast additional param */ - struct xdr_ops - { - bool_t (*x_getlong) (XDR *__xdrs, long *__lp); - /* get a long from underlying stream */ - bool_t (*x_putlong) (XDR *__xdrs, __const long *__lp); - /* put a long to " */ - bool_t (*x_getbytes) (XDR *__xdrs, caddr_t __addr, u_int __len); - /* get some bytes from " */ - bool_t (*x_putbytes) (XDR *__xdrs, __const char *__addr, u_int __len); - /* put some bytes to " */ - u_int (*x_getpostn) (__const XDR *__xdrs); - /* returns bytes off from beginning */ - bool_t (*x_setpostn) (XDR *__xdrs, u_int __pos); - /* lets you reposition the stream */ - int32_t *(*x_inline) (XDR *__xdrs, u_int __len); - /* buf quick ptr to buffered data */ - void (*x_destroy) (XDR *__xdrs); - /* free privates of this xdr_stream */ - bool_t (*x_getint32) (XDR *__xdrs, int32_t *__ip); - /* get a int from underlying stream */ - bool_t (*x_putint32) (XDR *__xdrs, __const int32_t *__ip); - /* put a int to " */ - } - *x_ops; - caddr_t x_public; /* users' data */ - caddr_t x_private; /* pointer to private data */ - caddr_t x_base; /* private used for position info */ - u_int x_handy; /* extra private word */ - }; - -/* - * A xdrproc_t exists for each data type which is to be encoded or decoded. - * - * The second argument to the xdrproc_t is a pointer to an opaque pointer. - * The opaque pointer generally points to a structure of the data type - * to be decoded. If this pointer is 0, then the type routines should - * allocate dynamic storage of the appropriate size and return it. - * bool_t (*xdrproc_t)(XDR *, caddr_t *); - */ -typedef bool_t (*xdrproc_t) (XDR *, void *,...); - - -/* - * Operations defined on a XDR handle - * - * XDR *xdrs; - * int32_t *int32p; - * long *longp; - * caddr_t addr; - * u_int len; - * u_int pos; - */ -#define XDR_GETINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) -#define xdr_getint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_getint32)(xdrs, int32p) - -#define XDR_PUTINT32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) -#define xdr_putint32(xdrs, int32p) \ - (*(xdrs)->x_ops->x_putint32)(xdrs, int32p) - -#define XDR_GETLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) -#define xdr_getlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_getlong)(xdrs, longp) - -#define XDR_PUTLONG(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) -#define xdr_putlong(xdrs, longp) \ - (*(xdrs)->x_ops->x_putlong)(xdrs, longp) - -#define XDR_GETBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) -#define xdr_getbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_getbytes)(xdrs, addr, len) - -#define XDR_PUTBYTES(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) -#define xdr_putbytes(xdrs, addr, len) \ - (*(xdrs)->x_ops->x_putbytes)(xdrs, addr, len) - -#define XDR_GETPOS(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) -#define xdr_getpos(xdrs) \ - (*(xdrs)->x_ops->x_getpostn)(xdrs) - -#define XDR_SETPOS(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) -#define xdr_setpos(xdrs, pos) \ - (*(xdrs)->x_ops->x_setpostn)(xdrs, pos) - -#define XDR_INLINE(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) -#define xdr_inline(xdrs, len) \ - (*(xdrs)->x_ops->x_inline)(xdrs, len) - -#define XDR_DESTROY(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) -#define xdr_destroy(xdrs) \ - do { \ - if ((xdrs)->x_ops->x_destroy) \ - (*(xdrs)->x_ops->x_destroy)(xdrs); \ - } while (0) - -/* - * Support struct for discriminated unions. - * You create an array of xdrdiscrim structures, terminated with - * a entry with a null procedure pointer. The xdr_union routine gets - * the discriminant value and then searches the array of structures - * for a matching value. If a match is found the associated xdr routine - * is called to handle that part of the union. If there is - * no match, then a default routine may be called. - * If there is no match and no default routine it is an error. - */ -#define NULL_xdrproc_t ((xdrproc_t)0) -struct xdr_discrim -{ - int value; - xdrproc_t proc; -}; - -/* - * Inline routines for fast encode/decode of primitive data types. - * Caveat emptor: these use single memory cycles to get the - * data from the underlying buffer, and will fail to operate - * properly if the data is not aligned. The standard way to use these - * is to say: - * if ((buf = XDR_INLINE(xdrs, count)) == NULL) - * return (FALSE); - * <<< macro calls >>> - * where ``count'' is the number of bytes of data occupied - * by the primitive data types. - * - * N.B. and frozen for all time: each data type here uses 4 bytes - * of external representation. - */ - -#define IXDR_GET_INT32(buf) ((int32_t)ntohl((uint32_t)*(buf)++)) -#define IXDR_PUT_INT32(buf, v) (*(buf)++ = (int32_t)htonl((uint32_t)(v))) -#define IXDR_GET_U_INT32(buf) ((uint32_t)IXDR_GET_INT32(buf)) -#define IXDR_PUT_U_INT32(buf, v) IXDR_PUT_INT32(buf, (int32_t)(v)) - -/* WARNING: The IXDR_*_LONG defines are removed by Sun for new platforms - * and shouldn't be used any longer. Code which use this defines or longs - * in the RPC code will not work on 64bit Solaris platforms ! - */ -#define IXDR_GET_LONG(buf) ((long)IXDR_GET_U_INT32(buf)) -#define IXDR_PUT_LONG(buf, v) ((long)IXDR_PUT_INT32(buf, (long)(v))) -#define IXDR_GET_U_LONG(buf) ((u_long)IXDR_GET_LONG(buf)) -#define IXDR_PUT_U_LONG(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - - -#define IXDR_GET_BOOL(buf) ((bool_t)IXDR_GET_LONG(buf)) -#define IXDR_GET_ENUM(buf, t) ((t)IXDR_GET_LONG(buf)) -#define IXDR_GET_SHORT(buf) ((short)IXDR_GET_LONG(buf)) -#define IXDR_GET_U_SHORT(buf) ((u_short)IXDR_GET_LONG(buf)) - -#define IXDR_PUT_BOOL(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_ENUM(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) -#define IXDR_PUT_U_SHORT(buf, v) IXDR_PUT_LONG(buf, (long)(v)) - -/* - * These are the "generic" xdr routines. - * None of these can have const applied because it's not possible to - * know whether the call is a read or a write to the passed parameter - * also, the XDR structure is always updated by some of these calls. - */ -extern bool_t xdr_void (void) __THROW; -extern bool_t xdr_short (XDR *__xdrs, short *__sp) __THROW; -extern bool_t xdr_u_short (XDR *__xdrs, u_short *__usp) __THROW; -extern bool_t xdr_int (XDR *__xdrs, int *__ip) __THROW; -extern bool_t xdr_u_int (XDR *__xdrs, u_int *__up) __THROW; -extern bool_t xdr_long (XDR *__xdrs, long *__lp) __THROW; -extern bool_t xdr_u_long (XDR *__xdrs, u_long *__ulp) __THROW; -extern bool_t xdr_hyper (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_hyper (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_longlong_t (XDR *__xdrs, quad_t *__llp) __THROW; -extern bool_t xdr_u_longlong_t (XDR *__xdrs, u_quad_t *__ullp) __THROW; -extern bool_t xdr_int8_t (XDR *__xdrs, int8_t *__ip) __THROW; -extern bool_t xdr_uint8_t (XDR *__xdrs, uint8_t *__up) __THROW; -extern bool_t xdr_int16_t (XDR *__xdrs, int16_t *__ip) __THROW; -extern bool_t xdr_uint16_t (XDR *__xdrs, uint16_t *__up) __THROW; -extern bool_t xdr_int32_t (XDR *__xdrs, int32_t *__ip) __THROW; -extern bool_t xdr_uint32_t (XDR *__xdrs, uint32_t *__up) __THROW; -extern bool_t xdr_int64_t (XDR *__xdrs, int64_t *__ip) __THROW; -extern bool_t xdr_uint64_t (XDR *__xdrs, uint64_t *__up) __THROW; -extern bool_t xdr_quad_t (XDR *__xdrs, quad_t *__ip) __THROW; -extern bool_t xdr_u_quad_t (XDR *__xdrs, u_quad_t *__up) __THROW; -extern bool_t xdr_bool (XDR *__xdrs, bool_t *__bp) __THROW; -extern bool_t xdr_enum (XDR *__xdrs, enum_t *__ep) __THROW; -extern bool_t xdr_array (XDR * _xdrs, caddr_t *__addrp, u_int *__sizep, - u_int __maxsize, u_int __elsize, xdrproc_t __elproc) - __THROW; -extern bool_t xdr_bytes (XDR *__xdrs, char **__cpp, u_int *__sizep, - u_int __maxsize) __THROW; -extern bool_t xdr_opaque (XDR *__xdrs, caddr_t __cp, u_int __cnt) __THROW; -extern bool_t xdr_string (XDR *__xdrs, char **__cpp, u_int __maxsize) __THROW; -extern bool_t xdr_union (XDR *__xdrs, enum_t *__dscmp, char *__unp, - __const struct xdr_discrim *__choices, - xdrproc_t dfault) __THROW; -extern bool_t xdr_char (XDR *__xdrs, char *__cp) __THROW; -extern bool_t xdr_u_char (XDR *__xdrs, u_char *__cp) __THROW; -extern bool_t xdr_vector (XDR *__xdrs, char *__basep, u_int __nelem, - u_int __elemsize, xdrproc_t __xdr_elem) __THROW; -extern bool_t xdr_float (XDR *__xdrs, float *__fp) __THROW; -extern bool_t xdr_double (XDR *__xdrs, double *__dp) __THROW; -extern bool_t xdr_reference (XDR *__xdrs, caddr_t *__xpp, u_int __size, - xdrproc_t __proc) __THROW; -extern bool_t xdr_pointer (XDR *__xdrs, char **__objpp, - u_int __obj_size, xdrproc_t __xdr_obj) __THROW; -extern bool_t xdr_wrapstring (XDR *__xdrs, char **__cpp) __THROW; -extern u_long xdr_sizeof (xdrproc_t, void *) __THROW; - -/* - * Common opaque bytes objects used by many rpc protocols; - * declared here due to commonality. - */ -#define MAX_NETOBJ_SZ 1024 -struct netobj -{ - u_int n_len; - char *n_bytes; -}; -typedef struct netobj netobj; -extern bool_t xdr_netobj (XDR *__xdrs, struct netobj *__np) __THROW; - -/* - * These are the public routines for the various implementations of - * xdr streams. - */ - -/* XDR using memory buffers */ -extern void xdrmem_create (XDR *__xdrs, __const caddr_t __addr, - u_int __size, enum xdr_op __xop) __THROW; - -/* XDR using stdio library */ -extern void xdrstdio_create (XDR *__xdrs, FILE *__file, enum xdr_op __xop) - __THROW; - -/* XDR pseudo records for tcp */ -extern void xdrrec_create (XDR *__xdrs, u_int __sendsize, - u_int __recvsize, caddr_t __tcp_handle, - int (*__readit) (char *, char *, int), - int (*__writeit) (char *, char *, int)) __THROW; - -/* make end of xdr record */ -extern bool_t xdrrec_endofrecord (XDR *__xdrs, bool_t __sendnow) __THROW; - -/* move to beginning of next record */ -extern bool_t xdrrec_skiprecord (XDR *__xdrs) __THROW; - -/* true if no more input */ -extern bool_t xdrrec_eof (XDR *__xdrs) __THROW; - -/* free memory buffers for xdr */ -extern void xdr_free (xdrproc_t __proc, char *__objp) __THROW; - -__END_DECLS - -#endif /* rpc/xdr.h */ diff --git a/source/xdrfpdb/src/xdrf/xdr_array.c b/source/xdrfpdb/src/xdrf/xdr_array.c deleted file mode 100644 index 836405c..0000000 --- a/source/xdrfpdb/src/xdrf/xdr_array.c +++ /dev/null @@ -1,174 +0,0 @@ -# define INTUSE(name) name -# define INTDEF(name) -/* @(#)xdr_array.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_array.c 1.10 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_array.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "non-trivial" xdr primitives used to serialize and de-serialize - * arrays. See xdr.h for more info on the interface to xdr. - */ - -#include -#include -#include "types.h" -#include "xdr.h" -#include -#include - -#ifdef USE_IN_LIBIO -# include -#endif - -#define LASTUNSIGNED ((u_int)0-1) - - -/* - * XDR an array of arbitrary elements - * *addrp is a pointer to the array, *sizep is the number of elements. - * If addrp is NULL (*sizep * elsize) bytes are allocated. - * elsize is the size (in bytes) of each element, and elproc is the - * xdr procedure to call to handle each element of the array. - */ -bool_t -xdr_array (xdrs, addrp, sizep, maxsize, elsize, elproc) - XDR *xdrs; - caddr_t *addrp; /* array pointer */ - u_int *sizep; /* number of elements */ - u_int maxsize; /* max numberof elements */ - u_int elsize; /* size in bytes of each element */ - xdrproc_t elproc; /* xdr routine to handle each element */ -{ - u_int i; - caddr_t target = *addrp; - u_int c; /* the actual element count */ - bool_t stat = TRUE; - u_int nodesize; - - /* like strings, arrays are really counted arrays */ - if (!INTUSE(xdr_u_int) (xdrs, sizep)) - { - return FALSE; - } - c = *sizep; - /* - * XXX: Let the overflow possibly happen with XDR_FREE because mem_free() - * doesn't actually use its second argument anyway. - */ - if ((c > maxsize || c > UINT_MAX / elsize) && (xdrs->x_op != XDR_FREE)) - { - return FALSE; - } - nodesize = c * elsize; - - /* - * if we are deserializing, we may need to allocate an array. - * We also save time by checking for a null array if we are freeing. - */ - if (target == NULL) - switch (xdrs->x_op) - { - case XDR_DECODE: - if (c == 0) - return TRUE; - *addrp = target = mem_alloc (nodesize); - if (target == NULL) - { - fprintf (stderr, "%s", "xdr_array: out of memory\n"); - return FALSE; - } - __bzero (target, nodesize); - break; - - case XDR_FREE: - return TRUE; - default: - break; - } - - /* - * now we xdr each element of array - */ - for (i = 0; (i < c) && stat; i++) - { - stat = (*elproc) (xdrs, target, LASTUNSIGNED); - target += elsize; - } - - /* - * the array may need freeing - */ - if (xdrs->x_op == XDR_FREE) - { - mem_free (*addrp, nodesize); - *addrp = NULL; - } - return stat; -} -INTDEF(xdr_array) - -/* - * xdr_vector(): - * - * XDR a fixed length array. Unlike variable-length arrays, - * the storage of fixed length arrays is static and unfreeable. - * > basep: base of the array - * > size: size of the array - * > elemsize: size of each element - * > xdr_elem: routine to XDR each element - */ -bool_t -xdr_vector (xdrs, basep, nelem, elemsize, xdr_elem) - XDR *xdrs; - char *basep; - u_int nelem; - u_int elemsize; - xdrproc_t xdr_elem; -{ - u_int i; - char *elptr; - - elptr = basep; - for (i = 0; i < nelem; i++) - { - if (!(*xdr_elem) (xdrs, elptr, LASTUNSIGNED)) - { - return FALSE; - } - elptr += elemsize; - } - return TRUE; -} diff --git a/source/xdrfpdb/src/xdrf/xdr_float.c b/source/xdrfpdb/src/xdrf/xdr_float.c deleted file mode 100644 index 15d3c88..0000000 --- a/source/xdrfpdb/src/xdrf/xdr_float.c +++ /dev/null @@ -1,307 +0,0 @@ -/* @(#)xdr_float.c 2.1 88/07/29 4.0 RPCSRC */ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ -#if !defined(lint) && defined(SCCSIDS) -static char sccsid[] = "@(#)xdr_float.c 1.12 87/08/11 Copyr 1984 Sun Micro"; -#endif - -/* - * xdr_float.c, Generic XDR routines implementation. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * These are the "floating point" xdr routines used to (de)serialize - * most common data items. See xdr.h for more info on the interface to - * xdr. - */ - -#include -#include - -#include "types.h" -#include "xdr.h" - -/* - * NB: Not portable. - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#define LSW (__FLOAT_WORD_ORDER == __BIG_ENDIAN) - -#ifdef vax - -/* What IEEE single precision floating point looks like on a Vax */ -struct ieee_single { - unsigned int mantissa: 23; - unsigned int exp : 8; - unsigned int sign : 1; -}; - -/* Vax single precision floating point */ -struct vax_single { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; -}; - -#define VAX_SNG_BIAS 0x81 -#define IEEE_SNG_BIAS 0x7f - -static struct sgl_limits { - struct vax_single s; - struct ieee_single ieee; -} sgl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff }, /* Max Vax */ - { 0x0, 0xff, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0 }, /* Min Vax */ - { 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; -#endif /* vax */ - -bool_t -xdr_float(xdrs, fp) - XDR *xdrs; - float *fp; -{ -#ifdef vax - struct ieee_single is; - struct vax_single vs, *vsp; - struct sgl_limits *lim; - int i; -#endif - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vs = *((struct vax_single *)fp); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((vs.mantissa2 == lim->s.mantissa2) && - (vs.exp == lim->s.exp) && - (vs.mantissa1 == lim->s.mantissa1)) { - is = lim->ieee; - goto shipit; - } - } - is.exp = vs.exp - VAX_SNG_BIAS + IEEE_SNG_BIAS; - is.mantissa = (vs.mantissa1 << 16) | vs.mantissa2; - shipit: - is.sign = vs.sign; - return (XDR_PUTLONG(xdrs, (long *)&is)); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_PUTLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp = *(int *)fp; - return (XDR_PUTLONG(xdrs, &tmp)); - } - break; -#endif - - case XDR_DECODE: -#ifdef vax - vsp = (struct vax_single *)fp; - if (!XDR_GETLONG(xdrs, (long *)&is)) - return (FALSE); - for (i = 0, lim = sgl_limits; - i < sizeof(sgl_limits)/sizeof(struct sgl_limits); - i++, lim++) { - if ((is.exp == lim->ieee.exp) && - (is.mantissa == lim->ieee.mantissa)) { - *vsp = lim->s; - goto doneit; - } - } - vsp->exp = is.exp - IEEE_SNG_BIAS + VAX_SNG_BIAS; - vsp->mantissa2 = is.mantissa; - vsp->mantissa1 = (is.mantissa >> 16); - doneit: - vsp->sign = is.sign; - return (TRUE); -#else - if (sizeof(float) == sizeof(long)) - return (XDR_GETLONG(xdrs, (long *)fp)); - else if (sizeof(float) == sizeof(int)) { - long tmp; - if (XDR_GETLONG(xdrs, &tmp)) { - *(int *)fp = tmp; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} - -/* - * This routine works on Suns (Sky / 68000's) and Vaxen. - */ - -#ifdef vax -/* What IEEE double precision floating point looks like on a Vax */ -struct ieee_double { - unsigned int mantissa1 : 20; - unsigned int exp : 11; - unsigned int sign : 1; - unsigned int mantissa2 : 32; -}; - -/* Vax double precision floating point */ -struct vax_double { - unsigned int mantissa1 : 7; - unsigned int exp : 8; - unsigned int sign : 1; - unsigned int mantissa2 : 16; - unsigned int mantissa3 : 16; - unsigned int mantissa4 : 16; -}; - -#define VAX_DBL_BIAS 0x81 -#define IEEE_DBL_BIAS 0x3ff -#define MASK(nbits) ((1 << nbits) - 1) - -static struct dbl_limits { - struct vax_double d; - struct ieee_double ieee; -} dbl_limits[2] = { - {{ 0x7f, 0xff, 0x0, 0xffff, 0xffff, 0xffff }, /* Max Vax */ - { 0x0, 0x7ff, 0x0, 0x0 }}, /* Max IEEE */ - {{ 0x0, 0x0, 0x0, 0x0, 0x0, 0x0}, /* Min Vax */ - { 0x0, 0x0, 0x0, 0x0 }} /* Min IEEE */ -}; - -#endif /* vax */ - - -bool_t -xdr_double(xdrs, dp) - XDR *xdrs; - double *dp; -{ -#ifdef vax - struct ieee_double id; - struct vax_double vd; - register struct dbl_limits *lim; - int i; -#endif - - switch (xdrs->x_op) { - - case XDR_ENCODE: -#ifdef vax - vd = *((struct vax_double *)dp); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((vd.mantissa4 == lim->d.mantissa4) && - (vd.mantissa3 == lim->d.mantissa3) && - (vd.mantissa2 == lim->d.mantissa2) && - (vd.mantissa1 == lim->d.mantissa1) && - (vd.exp == lim->d.exp)) { - id = lim->ieee; - goto shipit; - } - } - id.exp = vd.exp - VAX_DBL_BIAS + IEEE_DBL_BIAS; - id.mantissa1 = (vd.mantissa1 << 13) | (vd.mantissa2 >> 3); - id.mantissa2 = ((vd.mantissa2 & MASK(3)) << 29) | - (vd.mantissa3 << 13) | - ((vd.mantissa4 >> 3) & MASK(13)); - shipit: - id.sign = vd.sign; - dp = (double *)&id; -#endif - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_PUTLONG(xdrs, lp+!LSW) && - XDR_PUTLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - tmp[0] = ip[!LSW]; - tmp[1] = ip[LSW]; - return (XDR_PUTLONG(xdrs, tmp) && - XDR_PUTLONG(xdrs, tmp+1)); - } - break; - - case XDR_DECODE: -#ifdef vax - lp = (long *)&id; - if (!XDR_GETLONG(xdrs, lp++) || !XDR_GETLONG(xdrs, lp)) - return (FALSE); - for (i = 0, lim = dbl_limits; - i < sizeof(dbl_limits)/sizeof(struct dbl_limits); - i++, lim++) { - if ((id.mantissa2 == lim->ieee.mantissa2) && - (id.mantissa1 == lim->ieee.mantissa1) && - (id.exp == lim->ieee.exp)) { - vd = lim->d; - goto doneit; - } - } - vd.exp = id.exp - IEEE_DBL_BIAS + VAX_DBL_BIAS; - vd.mantissa1 = (id.mantissa1 >> 13); - vd.mantissa2 = ((id.mantissa1 & MASK(13)) << 3) | - (id.mantissa2 >> 29); - vd.mantissa3 = (id.mantissa2 >> 13); - vd.mantissa4 = (id.mantissa2 << 3); - doneit: - vd.sign = id.sign; - *dp = *((double *)&vd); - return (TRUE); -#else - if (2*sizeof(long) == sizeof(double)) { - long *lp = (long *)dp; - return (XDR_GETLONG(xdrs, lp+!LSW) && - XDR_GETLONG(xdrs, lp+LSW)); - } else if (2*sizeof(int) == sizeof(double)) { - int *ip = (int *)dp; - long tmp[2]; - if (XDR_GETLONG(xdrs, tmp+!LSW) && - XDR_GETLONG(xdrs, tmp+LSW)) { - ip[0] = tmp[0]; - ip[1] = tmp[1]; - return (TRUE); - } - } - break; -#endif - - case XDR_FREE: - return (TRUE); - } - return (FALSE); -} diff --git a/source/xdrfpdb/src/xdrf/xdr_stdio.c b/source/xdrfpdb/src/xdrf/xdr_stdio.c deleted file mode 100644 index 12b1709..0000000 --- a/source/xdrfpdb/src/xdrf/xdr_stdio.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * Sun RPC is a product of Sun Microsystems, Inc. and is provided for - * unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify Sun RPC without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * SUN RPC IS PROVIDED AS IS WITH NO WARRANTIES OF ANY KIND INCLUDING THE - * WARRANTIES OF DESIGN, MERCHANTIBILITY AND FITNESS FOR A PARTICULAR - * PURPOSE, OR ARISING FROM A COURSE OF DEALING, USAGE OR TRADE PRACTICE. - * - * Sun RPC is provided with no support and without any obligation on the - * part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY SUN RPC - * OR ANY PART THEREOF. - * - * In no event will Sun Microsystems, Inc. be liable for any lost revenue - * or profits or other special, indirect and consequential damages, even if - * Sun has been advised of the possibility of such damages. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * xdr_stdio.c, XDR implementation on standard i/o file. - * - * Copyright (C) 1984, Sun Microsystems, Inc. - * - * This set of routines implements a XDR on a stdio stream. - * XDR_ENCODE serializes onto the stream, XDR_DECODE de-serializes - * from the stream. - */ - -#include "types.h" -#include -#include "xdr.h" - -#ifdef USE_IN_LIBIO -# include -# define fflush(s) INTUSE(_IO_fflush) (s) -# define fread(p, m, n, s) INTUSE(_IO_fread) (p, m, n, s) -# define ftell(s) INTUSE(_IO_ftell) (s) -# define fwrite(p, m, n, s) INTUSE(_IO_fwrite) (p, m, n, s) -#endif - -static bool_t xdrstdio_getlong (XDR *, long *); -static bool_t xdrstdio_putlong (XDR *, const long *); -static bool_t xdrstdio_getbytes (XDR *, caddr_t, u_int); -static bool_t xdrstdio_putbytes (XDR *, const char *, u_int); -static u_int xdrstdio_getpos (const XDR *); -static bool_t xdrstdio_setpos (XDR *, u_int); -static int32_t *xdrstdio_inline (XDR *, u_int); -static void xdrstdio_destroy (XDR *); -static bool_t xdrstdio_getint32 (XDR *, int32_t *); -static bool_t xdrstdio_putint32 (XDR *, const int32_t *); - -/* - * Ops vector for stdio type XDR - */ -static const struct xdr_ops xdrstdio_ops = -{ - xdrstdio_getlong, /* deserialize a long int */ - xdrstdio_putlong, /* serialize a long int */ - xdrstdio_getbytes, /* deserialize counted bytes */ - xdrstdio_putbytes, /* serialize counted bytes */ - xdrstdio_getpos, /* get offset in the stream */ - xdrstdio_setpos, /* set offset in the stream */ - xdrstdio_inline, /* prime stream for inline macros */ - xdrstdio_destroy, /* destroy stream */ - xdrstdio_getint32, /* deserialize a int */ - xdrstdio_putint32 /* serialize a int */ -}; - -/* - * Initialize a stdio xdr stream. - * Sets the xdr stream handle xdrs for use on the stream file. - * Operation flag is set to op. - */ -void -xdrstdio_create (XDR *xdrs, FILE *file, enum xdr_op op) -{ - xdrs->x_op = op; - /* We have to add the const since the `struct xdr_ops' in `struct XDR' - is not `const'. */ - xdrs->x_ops = (struct xdr_ops *) &xdrstdio_ops; - xdrs->x_private = (caddr_t) file; - xdrs->x_handy = 0; - xdrs->x_base = 0; -} - -/* - * Destroy a stdio xdr stream. - * Cleans up the xdr stream handle xdrs previously set up by xdrstdio_create. - */ -static void -xdrstdio_destroy (XDR *xdrs) -{ - (void) fflush ((FILE *) xdrs->x_private); - /* xx should we close the file ?? */ -}; - -static bool_t -xdrstdio_getlong (XDR *xdrs, long *lp) -{ - u_int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *lp = (long) ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putlong (XDR *xdrs, const long *lp) -{ - int32_t mycopy = htonl ((u_int32_t) *lp); - - if (fwrite ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_getbytes (XDR *xdrs, const caddr_t addr, u_int len) -{ - if ((len != 0) && (fread (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static bool_t -xdrstdio_putbytes (XDR *xdrs, const char *addr, u_int len) -{ - if ((len != 0) && (fwrite (addr, (int) len, 1, - (FILE *) xdrs->x_private) != 1)) - return FALSE; - return TRUE; -} - -static u_int -xdrstdio_getpos (const XDR *xdrs) -{ - return (u_int) ftell ((FILE *) xdrs->x_private); -} - -static bool_t -xdrstdio_setpos (XDR *xdrs, u_int pos) -{ - return fseek ((FILE *) xdrs->x_private, (long) pos, 0) < 0 ? FALSE : TRUE; -} - -static int32_t * -xdrstdio_inline (XDR *xdrs, u_int len) -{ - /* - * Must do some work to implement this: must insure - * enough data in the underlying stdio buffer, - * that the buffer is aligned so that we can indirect through a - * long *, and stuff this pointer in xdrs->x_buf. Doing - * a fread or fwrite to a scratch buffer would defeat - * most of the gains to be had here and require storage - * management on this buffer, so we don't do this. - */ - return NULL; -} - -static bool_t -xdrstdio_getint32 (XDR *xdrs, int32_t *ip) -{ - int32_t mycopy; - - if (fread ((caddr_t) &mycopy, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - *ip = ntohl (mycopy); - return TRUE; -} - -static bool_t -xdrstdio_putint32 (XDR *xdrs, const int32_t *ip) -{ - int32_t mycopy = htonl (*ip); - - ip = &mycopy; - if (fwrite ((caddr_t) ip, 4, 1, (FILE *) xdrs->x_private) != 1) - return FALSE; - return TRUE; -} - -/* libc_hidden_def (xdrstdio_create) */ diff --git a/source/xdrfpdb/src/xdrf/xdrf.h b/source/xdrfpdb/src/xdrf/xdrf.h deleted file mode 100644 index dedf5a2..0000000 --- a/source/xdrfpdb/src/xdrf/xdrf.h +++ /dev/null @@ -1,10 +0,0 @@ -/*_________________________________________________________________ - | - | xdrf.h - include file for C routines that want to use the - | functions below. -*/ - -int xdropen(XDR *xdrs, const char *filename, const char *type); -int xdrclose(XDR *xdrs) ; -int xdr3dfcoord(XDR *xdrs, float *fp, int *size, float *precision) ; - -- 1.7.9.5

Bc4_dr_X;M@9^9a@yxM$=9zCi^Vek1KSVr@XVslE=aXeT3!XmUKIdUp&pcNc&xYsO zh-anMGtURcTf@_GcKVzi6CoI8QDFXlPY_&j*VL_Bwa`#OIPJnReo{^^QH z{lLf5=X{azQskKr?sHyd_3Y~{<4fV$<%#t990<<&aL&2LE8rOs@!W3p%rn{eYIr_~ zcs5x*^ZaCdJv>LwOYiFpaQ4MK{fuvdXL`i*jMX#G3&yMA`7`3#bAFQ3^XzTB!Pewp zy#U;=`)I3Yo*Rs3!Shnh`&;CUh9dDrThr_y*HJgrL7=W{r?U-vG?d&6^m#52|EndbrH z{owgD;`z<$IiHLLb?09IPY-aP^SM^fJOhjmf#=bP=T)m`o;Qq-fT!`o^f|W%=bV}6 z0OLjQ42yVfwtD87V0;2R6%o%D;Jz<@mwJ7^YVvf_7oV@Hw?Tk zJK}lD>X~Pe@d|jVBc7d~O>%mk7RD>#`9E;qcUM_G^IU6u9Xu~bJe5|@`Fvu06FmDo zmpYa^ZmOKbD1=XY@C&-pD8ZTEaq zPoDXE!n=a|bveW8XTa0Xcosa9Bc8cd&pb~W&xU71#FOzt-Tch6z407)^1!{Xv%DUC zonyQmJoiLA^R1qF78=im=i7*9_x~h)@wyk|oV*R3*Q+Z$lZ0?(|8`P%gNwA|7nr>3aQum=akib zUFL6ZocRZU`}}VbKB;CtqmyGJ<8$+{uWyaBuQsnFdE7r1Jp5_+JxA8RAoY4(+Pqrp z(Vw^PDqMfw{;mlB5uC5fbLki3y>MMRFR6W9{XFMXaC&$S^fBHCp1UKSC#;@%N{ko4 z^Fzdwxirb?d72s@0?#Sn;ksyF1Hr?&6z(tldHXAchtCH(m(yvP%IOo7T#~Ck%=cb6~0jp=8nZ_r<^LfPcD>&!LpSN%HdXhiz zFwcINXDe{ezmM^$c-;ZuKF_PIp82nH4$sRG&vN09X4l?dD#4kb>)}`PbN+uCpM%#u z?v3>8I1rq3VE&7YFM_8e;(6WbnP<82GI*Mlr{~!Z-1D?Ez5@Z1{l%(Z&vdD8e6cz%j_8o!z3^gLO{GybUA zG&NtRf&2O&V)e{3%y<)co{V^22j}zrrl*six8ET3`W*fY3+S<6Yrd9PzBQ`W!sB ze_*^9JlX$E@9Pk7_QgD%jOW91WyEv0)ick1#{0qZMZ}Z&R+7{6G&MdDo_^qdy)LzS z<{56h5S~R5&vL8hd@78OhG*xu)8~8;xUchWQm^~v6maer{=EH&i046Y&W-)fGG2_F zUxWMH8djvwznSqV@SF+mo=dErc?ylsfM-F(Q||Rx=l?Z651wZ4q|d)KxX^;{1(883t9jfm%StLJ>y8!w0Fkd^6uodV9jnCA@RtKhjW;wiCu=6S|=6+Ayj zJWbzCa(bR!jBkYJ4Di3LA8_9o}tEjz%xJMSz`5^Pr31Ycp83? zKIa^8_QgDHjQ5A{CGf0`cz&~b=E?Xt z${*ZF*m)gR?K@ z>1(_lJToJn*Q}m--Zb6`p53a_^Bf57d2)^C!E<@UQ*8CjGtqc&c;1S5z6SUG@~716 zerfz^(iiv34BQ_N1$WOm;NEY6@qWnp7`U&`*R7uYE;l|9o?SjmpMN`W&vTIRLU=BX zc*a{j^W18DG(5{Ao=>el2k+y)G+qqP{-3A!bqqNBVxI2CC&4o=;+bLf%=3uxsqk!! zcp9%ua(bRDwf76 z&izt~{W2ornF`LivEK)bmm}vIaG%>RR?mKaH@*s~ig;eLdS0(Ljc3Bsczybu zTZ6MN<~hK4b9gR}c#5o^dB!`3=ksf`w)-Z@ z&z$|?`4_ma^L|#(Jm(r80?&gH&ofrfJTDk8gy*-2XXlM|^D|EiQCDy;je@rW;=b&nFSjW~=9%tBsezbL98wbIu3%IiG2K1w8jeJoBuc zc@`M2gy+YIr{Si$bLM=S8LxupRB)g3AggDdi;b^`=ZT1Csns*jGUHp|Y4k(-oO8fA zXXa^RJY&1${&-=;Gsfzf=SJgA;8_y!ya(?4VhcF;1%EDLhaZ!^ynYI}_chIUHu8J~ z?$>Lx)w8c^scu+3~0JIp=`0FXm}ud>}j*Mm(dfo_TICUI@>t z5zmKK&pd04kA`ROpVRv~6x`SOaZ<0(SEqyX`HDYpe`&py%yY5vQh1(-cwV)7 z&gTu|W$q!HyU3B&ytAeL#t<=HO8yp*?VhxUx$OU zFXriDd?P%gBc9vAeZS0WffcX?zoStKVz$sOJ#y(AUJhGcx*|^H-dVqrpArzl>MIe_F(IJGk$cha>eR z=4W5e7;jKNncLEcXS+Yr`)v;H{k9bTYRw#eZ6@v+*qC84d3J-edLb>we?e z@T`q^ezSV6pNv0~ewi}|p5wti&xKacJeL@62hYNYryM-YGpzFx{2Jokfh&NFh8dCnIe=FGpRuT(rb=dZz;hkbo-ydUy(+%CPZlfmg> zU#A-{fajiw=P9dao<+uoz*8OZG_RNB^gMeQFNEh@a9=;e!F|r-h3k5rBp#jf3*gMd zzFsyy3VG_+PoMMN;Pi0Lt)0U&B;vUaJiJQCUobOSKV!ucK2IpZ&y(LS9{u||XGwkd z{R{Rr$9OUFY!r{~iya!IU$4f-C&6b9;JjW{_&uhJ#iM;)W_$+v9V34I`~JoY z51#3$pJ;p$_%!2-!5=n04}7li+2GF@Ukd(TaIOc=f2HxMnA;xPr?0Ed;Ph}^9c_FD zJmVssiBcctQ-+)~!NaTT-)}o#Ji1?A6n^9$wZAX$x%hRxtv5agIXmo--fvHE@Ao9* zCGgx4@jPPnod4s-OX2w@;;FY|lGF3-XnZj|y}*6_pKtZdbD{Avcpi^X~P}@m27=9`Sqv9@6Ub$+yDw@1tqZFzJi+rFfoc zEyYa9zUsUxD?1B)HGv7~_@5f1`NxoSbg;oWsM$tKj(};`z<$d0jFZCH*qz zdU(2l`+DnV^~`gw@s03281X!3^~|%__$GKV8YekD&z|7S&pdk@uZHJ>i05jnXP)bv zH%Q)hyd3eoZ}rUcvGE4*v}%&xS4VKJLq1n`7q08@|AdEi&UJgSa9!uufOFlh!n(Z+ zob%)y?lqo?{A-G<;=N#%at-Ic`;5h-@ukYznANE%Tat;O$Hod=GAs)TI+#y`= zFDr%X?}s*TRyQZ-u!r$%0@qBCb%=4r1_3#|MQ{@3a`hn2?j;AydQZBF(46WsG0VZ0YS*F`)JSUvO1G~NfE4H3^a@Q_yTcg=T6 z@`wKo&;J!y*Zf1x*WTb^o#=k)3hsS%GhTo^4u<_~eJQ49MwfYQvzPHTy9C(`UmgMw22Y|CL<~i7S2|QOsJjLKX=lg`~`|(G_ zqjP=@oO#&So5o9#XXh5_edU7F!@dqPz7(F(5zlz3*Y{2LfrnQQ_qCES$=|2;h%^K*t( z#`!tJYUBKzVV!Y)&alZiKWEr}k7S;l8}~~i<2jhyDd2t%46%Cdmtn>`z_TFYdBf_N zXNB?3@HE{seLb`WXJ5>7fbp*ITpaO?wR+|$Hl7F1iiqb+t7o2XjQ57;ke2Cv9S6?7 znCC>}{ouJR;+bjn%=4J>{_w1ic(#Fazih($=$%?6`NRL}`;oT7!~Uv9{o%s({Z3Et zu-?Lc;rs4$ztws`cpI%-jn5UcZ3Gj@Mc<#4)=9yu9Dm4!Ldz3Dzwrb zCxO$$IpiCk1ke2u&wQ(Ao`uHqc1-g85%J{gljQU~ZH(u`QwZ+&kz(-hYT$bFuLW8jh7?O$>2Wc z!B)?{h8kZ5Pf5hH%<7rvE#p=2?9wKE&Ig10oI4ud2+zofXCgS~T!#0X4++=zn~#e} z=lljZ^RTZK#;cJht8IE;?ZN5coDVVH0Q-7)#52L_ndeU9S@66U@%&)*%=5GHYJcb=R>mhm#ovk$n>^HQtl9EKZT0nc+0 z&%0L7Je9^P;o1A3^m!fw?(3wx@hW(3jd*5&hgZ@2?=!;nyeboquK!QKnTLISW_&&J zv^_YzuRL&iIOpSxZ-M8Qh-aqNGtXnrv2MSKcy>Ib?)qV#CdQkBk>w4}f9-Z@r;6CR|jOQWGLhw58MU*n7y;CY~2JlfYft7l&uj1Pt9pib$1bq5cB8rIv4%{Bi}^VJKS{qpnPGsL4m zFE>Q$wXb2uMQ5?ic)dxkJFcuTIAKIrhKAub*R| zC|p0sKHWG!$3D+EKgYh%I6ud})HpxKzQ#B|$DRou`qKG7X1o}4`(8Xc|6LDH=1C9d zpKW|9JO$u>-d%CBM?7n-o_W?8&xWVN5$Wrp8@NB$ohsu59iV(d`^Cyc=TMoADr`HUo(tXAkRAS==%TD>N)57 zN7e1O5}xD1y{`hRXP!aEtKgX%@w{gB%=4!4jqo(XggZrEh7ar!!pO@$+9-Z^~ z;6CRIjaMVjeDUah^W0*5AUtnIJXKcDJYN_ugs1JX>3tmy&c2xEU&cqnGdALR$m*GA zw((+kzKM7m<)yEmos3U{=PYnvKevDfTR2w>+t&O;&DUb#`u^e#@#wzz2AuO@Uz?0i zMV?OG(&u~%I6a*68OCSBb8o~m-|CrXq45%UHb*>-{uPw0h>b#CSP8 z^CF%lR?qpA8(#%a!|v&G-W!~AW}eo@tKb3!vavoGd3&Uk}{$@Anb5zk`q@G45 zg*-#Sef`{I_3Z05Y3+j05TU!$y^dBzwY1cV z3!E2$`#QYTI6sdXEq?txYMgNWJZge*ejYW|I6se?VVs{w%`wi;qZS$G=TR%bxehu1 zcZ_es+_FzepW6}O^l<)NjaS1nHsYBe_4+>XVes(k`aW@o_Ve?-UptiBc5ee&pdA# zFMwyK)6>^advIPC<~hXpKzIrxo;l#*RrLMid&2eS{W8x;@_7AW!u96~j{^_$4EvEk z*LoQ^^K%X(j1NKnQt{}0cBR#G4j&jF0Z+?5>GM1k-18i6ya=9=5zp;jkLQ`m#wWnD zD&qOt>N%h9jZcLq_ssOZjt6I7oKJ7#v*DQ-@yxP%=9y!>1fC5MPsUkEPS3Nw@x}1; z1o!>e-|Cs?eB$bENSt@LUt|OtO0Bx!ZZ;N(#{xYl1PT<;^-f%Cq=pBsMy+^-(f2`pjh7(LRPpFOeahp^uBt7voGd3 z&3Gm}cSSs<;Nexm-=ABI{|?wvsn^dX_8OGr@%op*nI{LYyTo{A)1F_1`!Z9dKAcw>LzCYhe^mT$)YSiu`Mf0c z;avJ(zs9rK@8C$k;D77acn$}6nNq*+!dTwmI7jm8s?)SCJt)Bb$ zD&zU^ycqGk56*te@ZVkeSUjQM99+jQ#iQS6`9|vX9M~jWJwF-GgTMYIwbxfaCvPk~ zc)Fr~SL1!a_cq=ie1GG;!4EOs1H6mzf#7F=`*rMRydUQOka+ZY=_RY@bzEY+0G>ue zYv-e$UBN@1FrNbCYzNNkn{{S#-gXp^uG{Xy+snChw{ZRMP`wN8bEq^v1o`(KmY)9@ zaC$h0?#2t@xi#XM11vuxx`|mqaALdYqb+T6cdOrUm^>z9+Ud(UCdl0_Pm~-{JX9Jlb#L%WJQT?(6R0-fu7CCCE8hJbL~-YxV5+KgP@8+2M-XJnCr+ z?s*P0UIEWl5zjQMXPyU*SHZI(;@NI^k~2I_>+kh91rOIf>^uHm|EZDs%fY>`tBh|# zo)^Wh^I2{6?CVqG)$p_%kv```!9yOsU-twL|5kWz=lOY()a(8_Tl{)%TrTx`Zd_$N zqgnDkDTK2*RSzRc-mc=-fuT>_QmtCCwQ2H_H~+gbRV5BT+fZW#iRY+XFLlz zKNXMmn{ic=pX-GEZf`srp5EYo{+ucG;rdqLzHl+P&*3tu*Ex(4zh2+FrM^zT&e^Yc z>hwD@(y#G$>=)eo9R%)uT`V5$>q_zH^&Kxse=~c#i z!SiCo^SacB`S7{@V{l$yKDU1<9$mLT3)lPm!Plhs+tGMFa$X1S{XT53*k8*-1CgHdgi&sco96SBA$)let)l)dcD6NH9E=f^_PPCx*BeL67swN z?tOh|_3Uen@u~2%8I$C3&%xj!Psm@EQ}YisU){mOzonnc^^*Fq4*9;|Eb;64f2q{# zc{tqo4E8G?J^w%SdhEwF#^(cu@2HgAV4j$&9eVrm6-ACsM*Yp1_@o2yI8ZSZ4 zHR92J|FC*q-+I?4eR2Ji!gB(+U*7@X?3d4JgT)j2<>zl#h)4UqQMmRyOFX)M<_Hh| z9Nb^#8|QuDKjPQ>!V=-Z!~4Q=<%)${sZYrGtuS0kR~QXl5S`$82suRHGx--t)A?{C8OzR>Z8^nN=VuRzYR z;NI_}R?mK)FkS`E&k;|H8`JZ&G`l6VlAr5@{qAVIGd!n&`}OTB^=)eo9SqLC_`ZIqc(kvP;?e7Svv9q>bHo$o z$^9~4c<}Q+xX?K7gJt5^`(U~7;Ng9+!Z`1PtBvzMxXw85gBy+WK3Hv>_ra{bahajQ4}*jfkg0>cf0^AN&HG*PZvlP2$n(n{i9hSIDXN!Oq~^ zckK6Q;|0iBEFN9YPgp(sEiqmQ&uW{Sg{H$=LYn~q>^_N;b_t$Xa z6?okz#iRS{HLK@(e$)7Bc(%X2_WG))B{;7y^W+#`56?Lf&lOhBJR^;7foEaFQ*QOl z^Izi`m~-YG>3!`D&c2wZwecqK{5#^g((0M#8spjUJQMM(uzKcs$9QXanoLUXYhQ5o z#XS2P&xL0|#B;UPGtYI#yTbE)#Pd0LNE^<*jPQRoUoGxT@-t^Ic-n*eJ{oKF?5o&# zA9$9DN7r+e)w8cJj2FPu_OA3fcLisD=ILg9C_FbtJkzY6c^))A3ZAtQ&rep*JX?*A zgQv^n^uA69XJ5?I*Z3rOrbaxAte$zEH$EMnj4A1P_6GMnt&Puy=aPu$Zt(Cbx(=Tc zuJ7X(i$6R^W#Dt0H^r~d`JYL>KIeaBd>(Qhe0O@kCxd&xryE}c&$NhVA$WKd?dv)5 zXkV|2N1p>%3fJfSjC+#&%*pG!z467!*%REKyUw+GuD1ck%i)<7@jP$!%=41*Rq$+! zcv{?Bw=d>tX}k)a{@~u%6;{tYBaLr_r!?Yu+v=HTmGNqLcAJ{Mt_}tF>vg#C20JIu zCu1U>=~mA?4;ya+&-#dGmuX4P@V{X{7U5a2lW<+PM}mj^x^9mL5A)ak_;0D#{W#Eg zbL4zNJbJ%))9Tsp+s0eL)8fAL`5yuv{#5(w1nzwuD<0jCrwZ5oI95E`Z?W;#$oaN- zwBPTnp8ak%-T|JY?oaRc3~=_#pOfqd&VKnhzy;#b@3&ql_1f1p#ycU;f5fAGt+aaf z^?~s`c(SLb_jNG1@1u^!d&4s#;It z7xSE8ybzvSBc4Uz;Z^iL`?`3-{^fOFZafe7*$>69pZ|O+Jb3u|&j#cC{O2d*{QTz+ ze=rs<5S>S7x8Shdd`2F z@#*m7&8Y2H^YjI0U(D0r_-uF{hBc7~>lboJsH{*-oISbsMLxx&C z^IUFxF+2++o@G|g`MhO(DLgyPOrLWbaQ4MK?TxR1=aPu$MyqF@n~kr6r##|WWA)7Q zx$)KTw4RmTR~K;h#XNb&*THi`#Pb+)$F?Kg!%U|-g}qix$YuxUne(P zJ@Zd6-Upsl5zp6F&ph87?+;JzBkA)z9^B{I+xS3uCPqB7te$!17#|AHhKMKQ(YkZy ze6}|}0-m1WKIaRpo_U5C9}Q1Q#PgQbGtaxm$HCL`vGh3~3eGt*&*8==z%w%9x!vlS zXR`4r@T`h>zP5Vi`QG?+cyi~Y_jNot`(mEn#%IGbG2(dvJiLnT$6q6S&$)Hi3G?r5 zd?U_*0&rg^BdwnKM;qS)&x;YyyH?LUmBxREXOG9z=a~!c^E}LW1I+WPh-ZS;GtZsI zo4~U&;@M#JoX>a0o5OR+6X|^&2hP5j=S1VJ;JGd0nQ8UR^O*70@T`w`{U=U6@S6d3OW&%+VVb5_qhi;Z`M=Z}b|`TV;1nP(5dC2aPO-KJlJ$U zmPYtlPu6|iGWgFiK4;hD{x}odU-uQO&qMv|#!JAPK9#(#d-ekle>$<|IlRv~HUCia zbtpL3A#)yXycGUk5zlyVf8F~d^^cpMeLZD-DPH%Li04mmf8FLK$sD}jmcn1HnZxhR zk~!pp2hW5WKJTmKx|{{>^EtX&Ys4r z;O`&tOau3MJ{_rl)%@)14dWZ}x}QWmdoE1xw-dPc+eNru$DZN|y!TGY^(_GR`3y2% zjhu7Equ22@t7pG&8qa8+te<92r}woFxc7AkxaaI-JQM!z5l<1gU&qOj`kCfuUym7Y zj@NxQ;@J%Due-ydWDeeMQ{j3Y4*>T$9Be!Xd9DKY*S*K;+1LHX+rjgB#IqIL^JhMj z^yN958qbA42i!g9f_wfEk@~UbXJ5s}yW(~4k9aD<{dK>O)c-78uUF=?$sB@5&(DLw zeLfwH_d?F=#H0J}VXJ4qj~dU1=ZA==@pDN|pZ^}vjAGc<|`?c^J6Q=P2Wa$a$@J^g7;U_3Zav<0Igy zjCekk`tW&gURH9>Zvqcp>wov`C#esgPtL&Sll7lZ<`eqW@8j$S?)~m*d=zq?BOdMd z3ae+oBaM%Sr!?YO4(@$bh)4VSSUmdq>NmpQuKC^HuX9)}e!afmNqzYK4xf8B8!txAPXDQ0CwhHP z0_WV=Z@%#f@Z1^k%m(+q=88xAS|lF5zDtGc_5Dgb+V4i=laTYE#p(U_0QY`RFg^vI zTO*zaz}as>^0<^SQ#_&H6719Y;?eKZEsWGZCtS~m#lnNX0{%C}uiy7sDLmA#K>bI? z*MWa&d?WaG##e#=YKD{0ncj@ z&s$O-a&AJ-D)7)n_`Xj?{p7!A@{M?O-TtOr&ZTZI)y^UOUVop5j{a+<3!^E%W)$vlV z`?t6866BmH9?d!1>e=sHw&&`6c4XSeoPy zc|!gooEtlVhd$ ze?AYK0v`S?eI7VlJbHaEQZDD@gW}iqJj-}4a(*Ws&AIa%Nq)|a{kCup&-vhfPTpYk zd>*^Wcs@MuL_Axpo_T&XUI0&z^7Q%l2lsPth}7#jIWi^JaQqUBKBF^W+(y0nZH)&s3{t zo(GK2gJ(^|v&HI}=U3yU@Eo-~y|2^2*%$MiWqdI__eMOgfQMK4>%7JHSw0c2_qET& zujl_J@#}r9-ijnYbF$wZog-&2aNocGwtDtE(D+h#9*KBL!9yzT>qYTsU*+P_bMHOj zdSClVJbLbJHC~RKUH+SXeNPAH+}Lkl6H#;f4j67e*CtL}AVo-E@V z;W-W5uj62=XP%+PtKpd+@hr7^=2>REL5sg0KQkJ=oj&IraL$=|+8ED*=fa3*jMX#G zjmDe9vn1mA7CfX4`!R2qnt!PIYFLrv5C5y{wi$THuj{rIxIbqeEcLoRI~vbM&Jp6# z`|@p8&weKvZw1dg5zjhs?`wm2w687V(fzpHJIQ=Pzq%jy0r%_M)_4wb4i=C0d!5y@ z-?7F!z_T>s`N-Hcn*Izy{}`zxt{sHU=VotxAZcy5vUFdx1zxF0;c zy1p-XR6M#LpH?pK3qBUVo*F`*2te*3qX1o}lk0PEQ zte*4#+4v-Qj(9)4uam*q7xSEMd@4MXBc8{to_U@!J_DXj5zh`EBso1#W8-t+=?(7p z{R^y~d4?D-foE>S^Rm@*K1+?4!m};nX;E3XFXm}!ybPYRz`d`bUXPz2yWDs=Jo6%+ zC05To<;E-EssCa6`Z)kR{Hgx@+u#VF3hvkU0pp!_PoAT`0QWi6|0sQ)na<(K2Y1hf zR?q8uiSb_W%!_!ISpEOzX*?gEh99TTb8m2;Piy1-;29M0jJA5_xxsh=Jg-JPYptI1 zS!a9*JRMf2_jMvT`(mC`jTgdmZ^Sd->X~Pu@lo(>j(8eX+GF}8vKKS3(kJU5J zCB}>4nHTXav3ky@-1sDT8m>v7^Wos(Pjx?D5#f`;d0m))s_{yk10RC>95z`!^Z#VL z3ZBE)rswYs?s-l#z8;>tBA&Tc&pb~W-vrP15zqEjb=L{!)5v%=JSTzsd=cVAxKZA2KUYwoW zAGceVK8L-)>B&L;zQ!kkUl{RR4IW-)V$J6R{Q2;k&BL4%j8BFC{)nd%-1o~jk@~IX zXJ6Zl&&KOE`=WNvn*Stlf8FyU^@D`#&&3sibIzQ@c;h9=vkcr{_Y13MUtb$9h3DWe z)319saKB!sf_u(B#>?QpAmW(;?)jgN)W2$e_VtGG6?onEBc5HqO7FKVxc7UIaJ^n# z#iKuu`fqTb&p_jq$T?3u`Z>u8t7pIO7_Wk7kM-$&<$`-($AEjz?#9={e^$gZ8Qibq zb_){OoJ0@m6@<$0D9};QqS5 zMC$((uGcZ^o7(lD`>`Xq&!@BTcF0*I9=(n;te*WoVmud~ZzG-t8`H1jF5sSXcjKMm zZy)gt2KRYh7pb3Ue)e^j@g8{HMNB84_;69&R|nCkSt&H)d9s_X4y;d)&z0}pf1>oP|Cy58=PdY%6iHQuD9{yDOIuYFaI#WEl-UbQR^>&YVwBP%UXJKEg6_57&o7J=5 zjIBvuT!-24^Z@t$^?%^u-wNkB|2v2O7Eid2IXE{i7LWe^)b&!YeT_4ogFNNp(Y`+O zdVD_cmGO4)9Qa%Mb?gQn{#5VFJ;8Y$+1E+N^U&|v;@6+kIA3^}Pgm4mWV{dfmB#yn zk1^f@e7y1A;CC7y2>vKIuRG6;CyeJ}Zr_VX=im7Ey6cDQD$96hc=~|*x;j_t!+Z*m z^D=O*H~x40t`U#!qg#ddmgj`!!u9vL>idzcH7eP z>|lHnJja83p7X4pc`h(M1)kXv&nw^|RX7KVa>B4{em_IFp7ZaCKU^0+FMTe4y?^~A z^?L4YH9i$NyJR%^>-D|g)4{oa*>7Lt)8UyK@jL+@`qjQl#G`%vM?AXTmJ8SQmbqP$ zpEZkXc3-0|MW_$!ZS4BLxfctv8T|C;? zH1X(qn=4$`+ehNje%Crj&ixvs_j@e3_uIqxJa~#Do;#&J^u_zyEbuUg@EpazpZ!Vk zXumHB*ZbNB!Y9>uM*nqM)cii;_UZfXP~+9ee>J%8yJ=R>b^f67%$CXf*)JoW`a7iO z$uyn~Pd>QkDYSa#xzcz$cwUTnR)UAr;dvnM^e%rjutw^``On|$+*qJ@XVBUk^`3#PbC>=f>Zk z{Xyz=&g~o4oipoC0QWhcV!Si1`(5DP*F39dUki-q!ShqZ)2vbYoOde=sA z#tYziA>ye3=lRLcOWzZZ_EjYwJy$mg*ZWAvCh7flHa-bC$AWvmv#p-}&NV(Ao-Gki zqo(P3b}~K(o_ui6GuY~xXXyXabtiCEj_n`7pY|!GBuput5{-(cv`k4RMI&KKGTMwn zNy`+e2!m*mnzYDk8>JegviGW(5{-mGv_$rT*tR_wVOi=l4JN`F!44zV5ls zb=}YXJZHJD(<{CLah~(U*#hT!D~z}Yo}I?+^Oi46e0yAeHu3FxJ7UJ$$MH(XCeFiZ z+J;Bdb^6xLYzB2aUO*0dV9#kv2`sraqN0~ z!MI&-Uz<3#-o4^$kY}s9$?MI6YrU6<7bDJGPn_lOu-@=-DtOmjPga;XVZC{H-{Vyi z$G)$))r_}weJEand`>t%d0nmHT30*qQpB0$i8C9{b<4-)c_xmnYmqqLS6pV|+xHb$ z8V}>}eZ^PA`M%;talWs(MV#*|ek9KK6~7SY`-;EAId8mf92DPydFxUy`TXa=8Hd-6 z!Qy3z^Q0%vGiH1^KYabQ4$k$)_Z2srIQBf+Zrr~9DmPvbUAKJwb-@X)F6Pg9=p~-k zF!r(|co44F&lhAo=iycH48%F=iPP}J#Q9qu)o#*aw9X}1Ob=j;aYJZ+rbaLuQWcrM~B@Wgpu#xtK+#77{`-<~*iPIh_nI-kpbhs}8SxW?Bh z&EaAG;dP1c=eLK4>(f3z>1D>-$F*M%kCXQWiR~xsF<1vTbhU??PIcB_l92wym z{|H>`Dij}q$F*-vd^^uaWIXGt)Wqe__%|a?Pq;qr=gN3KPrFV$A90@c#Cc1`GoLNu z(-G&`rpf2I8CY99!>bb>#WHiDT=1SH`p6Qt=gtQ?FU_ zdRxHt__l_#UOtYr6X)Z|`6j-79O-4;K92Mi=i|r_aXyY*FV4r2G2(n2xmBExBXi(9 zA9;Sw7hi*U+hO9^`QI<&Isbo&7bDKOrzM~N3*nq+K91zTxeobyaF~f>*V|3T?c>NS z;|1pR;2yZn!*}8-xDKCndh+})g)Kaak{(hB#H4C(q|JxaQMB zJOgpYd*V!k^YMkR2j`jb_VK0IGk!0e`LM2i;w4xo?bDLibp@PpIL`ybcOcGUPnDCR&dRyjrc*tne2%(8_s#=>%sq+@phg!d&VDvGauF!v~c;;_u{zs zfa~M$5E;*T9wxpYah7}Hte5f3XQOy-cf8&$}*w^SJQ% z_7dNLJQtWaw%%7{JnLO6{te<(O^@ee<1~b8K25~S5of3;&SV+SeC`lGj5u$2;(Q|G zIX}C^QyRPL)yZv=*VPuzx|mN#@p_0e$rER`jAuUc#3P8a%@gNW9glwO{o<_%i!TW*me7oiEm#A?J(o*`S`hb2J$@R?BscNg6sTu74L#L zcY5N?mGPYah2oirv)vQt7a7m>@Vj^q#A(+qd0jo>;r!cq?hV&@zS6|8*N5T8?e*a) z6UWZ~)8Zp=9_=@A?0J1cdzZh?e*^KG5$8I%J`cG~#&iDj#q$wogD1`o8PECuTznSd zoYEor{I`R%F6Prod=cW@>WMQ~#xtLV;!h#Yc2AsrGM@STPkc4voZT^bU6;aH7xTGX zd>!J<_r&=auGfbk!`-j0+bVEfx5vZv@w%fKZ`WrR@e<^DyNP4h=OP);dLI+tia1|* z;*`sH&i?`NQpD-dDf#?g0@wNPE4~eJ=6T{QgX=s$YvS1J@GB;cy*|8c++H94G;!?w z9~RHTbu6=U@_Glrwce}6`ytK}Pn`eCc+UUp;<<=()D!2#b6lR9&&lGW5N8lvuUF$` zJoA|-J_&Kwc;b8@1 zXs`2i#mf+909>z!lVm*exn2Bc#CgjT=QA14`6&}Wh&WBoPd?8XaLzOHIaj=LQ@0N9 z@Wh!fI&iI(AQ9*R}BQ{0;xT!Aa5Y;q7UUzXj(!F#j#$ zX}I5GdL+N!rf|k#{>{bPAL&h`zL*iwK)BU34`CkRse1?ecMVu!*abA(}%xA55 zIpQ4l#HrgWah-5}P7*(eI5}{gpRqEY`P?iX;Bn+-Pn?frJoDKuo`N`yFHSzs=fXM9 z%;$XZI*2pV6Q@wdGoPj6sfhEPC(b`Ip7~VlojCsy#OV&#dA>@oL z`e_c=_0vjxI^vA>#F;ANna>RI0>s(kiBk^O^D(Wj%U}H>xaNPU_!_+aodeh7vP{M^ z|7XRE5$9)5oQjtxt`i>LYT_k`lLgm&u9or4=UVYn#98WzvsT74pJMSHh*P0o@^z95 z=R7l?M&f0NGsF|;W*N_XCX4SyoYy>YK9upy=Tq@=#5w7T;-`Pm>|f;bfiCZFf}aLzOHIYqn_ajy2nxfibI z<9d&OEAg5CkK(Dg-?oF2=bsJN{I5_)oX0$IUX=07XN`Co;{4@_Q)h7EI^letAfApm z{o%S!M#*^QGfq4MabEDmc}K=GpZCQx5vTT$XR;^GLo%NEJSv`z zINx~U{4L{|&r$Il#L2umd0kh+Sr_veB%X^nk9p#}DC3#W8u1Z`^Oq-1om|iQ5zj-M z{%~DC_rUdh-01N;uSvY$V!U58RlMj__kK-`9BbS zf0+M&E|6oVae+~4X*XJGH(Cf z?4EF)hu-3)$fp3V^{$Zdtm}F49f)(l6DQ?bSC{60B3$!4S-cGKTX^COhim?~ddAO? z_^fNT_|LfC$2@U%!S#OkdB*QIZjV=;>yn>eCx{pj~6V^3WydLiNZcm&y;CjEGdd7cl+#auk zaOT5#_(wc~e7X%!eqIlTGY;z-DxQWo%RF)Z3)kbdS>iCyt>Wp3|CuLF>WJj|w}k8c zc7|(R=ZSa0{a)&cb3a^<*W;e?OO4y(wI0rVI1d}evye~K8IG@9H-pW1Wk4k*jRe7YF2iAKn?)P}O=ARAM`yJ*PKhn58 zUJt=}znq6h#q*HQcDUZ}FEXBW{VqNQan8Ci`El<7*L*G#pN=?FJ#ik9@yw@Cd_LlQ z=85y0jOYCPAzp|$ZAK-pD+|uLn9n8RD-dV8C(aA-a6Q=l`UayD*Uvh{X(qk~J_sHj z$3xNQb%(L9@wkjMC>k5x=B>FwPU2i-* zzJ*vPH=FpjUvah>Z|j{WUXDC>n>e=Ke`GxCtvEjM{5^;`7sK^D?Ptc@{BMMF9{9PW zJQ-h%dhamt?Rl}tjJNeZCLWyTo^O9=;@Ent-IQ1t>#ZrCf;d;ewcb3q)-}Pz3Fm=z z<(oKm-L5b`tYQ2*T=C}ky0ZVi{h4q+j_~|#D_#fr-)7?2d3aRDa~_@)Peq&`J#nf` zaCvebcs;BE=Q_`g&P8~uZ9JTxQXKb2@Nk~(I`3%4+vDCvJc2y$HF0dc%Va$3eO5dT zarS%S{A0%3{OjG4I1gOs_2ImZm80I~@UULH&byiMw%!ZH(~;*K6UWxOTE?^9m&G#> z=ZGgx{fWuzIt8wEodFN)vg`bEGv3yfBc6$T9yM`nU2AkaUZ<}Y&qkaIlj7%*jne?G z=TT$vT*MjXiF2on=R8jp&qJINPn@0b@akp%{pxScczb==XWV|i`_##^X!he6e^6l|F!@BsmUmLF1!;8##d%P|cUyXbgnmG1&y&~gT*IMyn z#Hn;ge0|zD5xCCtY2u}bGujj90U6JH9uzM_oL!zczryu8cF2sk*TYJ8#_O`z!*+0u zlLOa!2aA^@&t)dQowv<0p7m}OKZrOd0anj*jSG@kThx57-iLR~i*4cQt-uOH! z%fz?OqlTLCcD)T34^9tfD*FFlVdB_4Ka}yT_fzo{#A$q2@_N(YVO=)=^WdBZK9A}l zTkkmWI>_@i6UWy3nT%(>W#XxbbH?4t>+J#8x-Noq9#~gD6USZ; z=a})fuKD5-qZ~r_PTMaC(d#>=ZE#K5YI)P2TXiB|0mv?IM1B_lf_3M z&b4rz|664|^SM(z4{?e;akk5N=CfP;X2fZ9U-J3SfODPm^IM+X)M-4FX z?RkB*86O_6%y>3i1<858D#PgBQCnk=q>kk>vx(Zc_>`3|6|N}d;Pz~xV`=tdE)#C=e)7rU&YIiXU44L^M4hb zaaivV@x6$%+!JTLjAuR@#mf<=(gVr!X#m%J8jJ5ooLoD z7vTM|$4q>CUavCa?fQR7{2=l?VB*;Gy5{V}b;bEVPP}q+_k6f7T-VzO8PEA2EnWw4 zR(j&RCF7aT7V(CNbIhFN$FT{V$C3G*E}n)s!##2Cknzmt9`SaFv&j?Z7kIcHVvpBH z+(u(i5TAd0+^dN5`M~k;aQ^LjIL(Z=>!F2sCi1+|#Ift)ZXJ*3pVP#9AWn%V&S&tj zUc1iAOdR|Cw@e0oF(IV9OsH>BhD^QoN^h@b#*{I2XQ() zn0$R+0_XZZd8mwMKEuVQ zBTkVg&KokG`D_xOk2qE4C!gmCT(83y8V}FMAS@($%Ylc-C0w7SxDH=$;@kHV^38a= zKJOJTM4s=PIQG2zRmQX4{o+N4bMAuV^=*p7{(HKa4m=bW>I1T=jysmUO>ta6b#WN7+7Ehc9WIXeEP`n4?eC&zy7d$*qZNFBP zN8l!MajeMRl@$Gq9BI8-td*Xu-=Y&V&dD=KF;hImn_z1)q=ZQ02 z#xtJ>#BWBN_dRjGk?}n4KZxfePK(Eq*VPTqx|q*};-A^6jAuR*#aAQF8c&=LWIX3*oA^4!IpK-q^V|~7x|mP8cnRW+ z^Te4hks9sbzkXFr*Ed^ryp z;$_Hx3S5uxLK)9_ctreX#QD+_=b(&dKL3axM4WDmULJoEWMd=289S(JR9d%`)-%%`__3E~uZ;w*)SSE;ZsYxVL@u?yDwX1smh z_zO567Xo*A3;y)P>HKu^`9DuQA9>yb*ZF@^#udPZ`hoIV|1`aWYpVuWK-zbupiz;^~O?(8P9w^P)D4To=cujI$ZN}%M%6R7Ug?LI!S6I^* zlh1!wxXyof@l?c_=801%K=ONAxPn_RmJoEWOJRfm7 zzmmMJesI>se6A8NK%B=sabAGy`TLF;Z_nSIaGt+eIDZd%;xv6Vab2zyfHggEbe;_NbRUw{1w59_k8ACFm+JpVf4t8u^m;F^D)jA#B6#ETK3ID6D%-_N5$ELpCSO0D;JSXgikBhI-JUpwGM>kGsd!2&w@`lY#HsRH;yiPHYKW&I z&ZTgj=ixG*`HT`zL!8x~I9p^q^Z7tL196UDn|z+r;Cg=bG2`v|bq$>7*Cd=@w|e5N zhx0hH-i_krIF417wCnSHIM-(p*5^P^ zod3YJ-Y3K($n$Hs9>)rAC0`F!#akgxFSy1TB;z^%*N9I-oTZ*P8)Q7^|84Q7420|Yxmm_DpUL9oh_l`kXS#rGo4r=B>!%6QJte(`d| z$@nmNUH#y!i}_q79<+8B*2g??UXk(4XRUZ0#5wATQ~#sn>*o~l2;vNd>-w1p*LD6V zoaY7mBA)k*@AGkDKCG+1csla=4_xzkMaFZU*Q#@VJaJODCC{gkcsAl(1J`_Rlkv^2Dk3Y2rL{ zerk#@LY!>4&hrg2p81RsFG8FbJaM+lc;@q=_!`7HVSDmkch*SBq)mkN&QE#j_FT9Z#Gu;Cj9sFyrm{Qf0TRi|0$O zd)N$`!8J}EJY4@aPU|n@^AkRQ8#UJbdqf>Pev!uqd3>zL--L7ib1^?9;#qB6Vb#mx zdD^~(RO2@P)8UL?hWIVTdn0~lPn@yF?fu>>ahU&1@odC@*Ar)#ahv~MiNpN&iT6YN z!=5;8_9UOTo^Z|&^Y1O5gZK}4;yh~H=KqYuVg9Sc2O<9Jo;bf7xAR~9D_581f2=y< zUk2Cf{}AIg|4|Z$`HvI77V+~vab7lV^Dj1T?{~Y$fA)B#uj9wp#@YRS;{4Otc9duX6d|jiC`@3BozdxpqlV*)N7J8|A zb(iO_;+5dF5RY|L3QzFpt)+VSL@s*ksg4tAn0hTY{x0=noj;~t+xZ&fN6qp2#N+={ z$MLF*`3QfF#li7vt&Zb$i8_wgjp{gFGu1J_Me4|JlRAFir;g)N2jBnApT|WV$K^uf zLB!2v`1M+k-z|=EgC*ifFW4Z?>t~rbub)T7dHrmRI%0<@nkTQHUB!9*94H?Bli2NE z@n-O+#na$#iSzndX1qcKgQMRLdps5M9p+yl5`KyPFM4aIj`h|@9qVn3Iu5{Wb*#5% z)Un<+t7E-=t&RhER2|1D6$dmdr@)+dtv#M4&UG?Woa^BZaUS=F#3SKkMsF{O^EhJL zBsT3~o_xIfPR8?bEx>h%b!En)2f@kWS?~_xd_3wS&c~fm;<<=3U3>(5iFh9Tb@55? zo#OfM{o>Q%$Kv|RdJEt!#23LY6wkzZzDAt=oOg+5WBe21Iq4F0=5LFwZ)xowpGW_Brn@UVcW0Se%jKW!F2OE?&CC`C{?nGUw~W zS2yYyi~osu;Q;6V6Oa7ky!LTYSLcjaoHNCPiOw$;FMrYbaPhKo=hMVX&vc(_TP|Ka z()ng_ehzMrc;Pp0{9*BeCY@vXH>{gjSN;&^UB!!6InNajDx4FGbGLYAU+0D5`AeJ^ zix=;AUM3z~*d-SKuz2P}&Qp(1%s+jb^N!+?$H@%Z{5 z@u0rT;|1~j)0}S+FFxJ*SKh!C{asjPn13d`m3S`vLh*d~HR4m@lf|dQ z=ZepQKPS$A&$C2)O5=3nQ2Z!KOl)_HI774YHW+ps?G z5kGv7i}R#-v)Rtqi{HH1`A+douQ)#-UIITZ)%|zYwH1D*IM0_};@dEOxcCluzW8qV z!{TM|)yAJT=f!4^?-A#D@sBvqixY5ug!P8;d0w0;9$=kZD4yTd%~!5?l*+;`TSiS^t}JRfh+bP+Fv_ZKgQ=ZTlW zXNd=cT^>utGw}xKM)CZs-T2+cKaCzQ-v01--ILvju--RhkAEl5{Evv^>0EF^Lsv(bb{HSaJ~&exzXm<5eOqX83iI$7hT4`oCP9&wpMQ&udmOb|<@xSB=Cd_T_&bKL&Ff)*FuJytNRo zhxxonJQaSuctbe%P#8Y~?~CUVv2_)_Z|;u_5Wl5+EdAiz7VdjE-tLd|^Z00SuB&O{ zJl~%b$J4#wHE~`Cwu$3uYVfN#uMgE*CgzXREodelal?YH;=DdwC64I|ZV_*VI0fSA z@Mp!_!QT?kfR~APf&VR@2|ob|@Obrrw-L{RUn1TcK3qH-ez$l(_#@&u@R!90!QVG- z_eXy4c$G8VABJ_s#)m&dZ%x$Q=@@iX$K%>Sbu7@y>UdmRppN%HUslKapQY+p=zG=i z{%5tbTpg^7`y;2R*Kp&ys~_Y1YW14VZ&R=3{9*NDoxiM(_lZi4+x?M!9{@2Vj{x z*4svPthX=KvEB};<3OHtwkzb{y0G5TjobZ^o*vH?=Q_Dnoakz+a}*2Vpi zR^oYxf06Nu5fl~ucCE+nFm7KzF7Wts;wiX`x5VqfcZ;XO_lxuTc5FvCAS@@$CxY>( zi}U){)wq5A*x%#h#0wFBrZ|uL5^=tMTqj)`?M zh)W}QT09N@mUue6OdQh{{9*hhQ&;Wt+#iPXZ@syAc0D&PQ@jufT_w)_g7M;+eO#Q` z;@n4gMm&AC8^2jRf3fp##Q8e&u!>D zU!1Ss9~OTK?=!q8UIgDNz5@QO@oJIa-&=)l?#D0->y5>E9M2Kwam*3tahxFj?{PG~ zv+=*_1VtX-C|-y^*)7iN$wBc5o-frs-~C~Q=(q5G3-P?@O!0g?|G7{+f)h1Yycm9$ z@stRXjDCC6bbb@Txsr9jxnGcvJBa@J#Vh@Bzj@G3#xd#~%7-__$+iDP*N6U6!WGFP0B zFVBcaTspxfnjVoR3G}iu3*C3R&*H!sA#q;(iXl*7tZ@an4&GalW6NC(iei9}wsJ$xn;({p2@| z+rFmHJicF?eNDA4ay5qahH==})Lfi>P2I%V*ECR^eN7X@+1E5%oPAACi?gq3vpD;j zz7=O*(@}BuHP!ExSTFmU+KRKU=`wNlHH{LlgTAJj;_PcG5@%o2CUN#PeIw4krpgy5 z=Fh&SX5#E?>MG8@rmMu+*ECt2eNB&uv#)8rIQyEu6lY)4KjQ3bYSdfmLSNIl;_Pd> zN}PR76U5oqG+&&3O{>J&*YvJ9`4R<4}#r#omemXnobjEUsG3c_BG{*v#)8KIQyDriLs;7Z4zf+ zQ<*sXnvRIGuc-lEe~0TfJihE}>LAX(roQ6rYZ@cYzNVStJYSZJv#)8BIQyDD7iVA7 zAL8t5s?|4s9Bp4yGmm!_=Xo(eoae=Oah?}5#o5=iM4Ww1>&4mE^ocn8n##pIQyFVh_kQh266T^-6hVxriaDZ*Yu(|`Eqa*vM{PjPn_OcQ5cQ=xcyctS;QYsLBcakn`8n*J7NUsJs+T)Z&s z#^`yY^yT4<- z^Wm+3#}F zS#Kepi9hHjo)6Cv58T}bW5x5~GsT07F3?i(eE0_OppqN^xp*f0pz-PvBpLlyE64pD zreVFgal8N0)#Lred7h3DuYMrvko$pkah;zmo`&%m;;rC)#na)V z#oNKBiD$qUi+6#q6VHTi7w-Z8T|5h3d$9X~_2Ol0aE3UZP6s{2@$elC7RTuyOcX~N zL4k4GhxV+;H>+cPeyxt{b}%GfS1dlR&yCcvK+jRf^MotatGc)o)vGywP#p{X8TIOJ z{5#_8L;GGG&rhmcomf|;W8Cje)Nvx6tB&U_1J#dpaVDzc`No6BZ6Deyk8f4S@%mXE z$E$j7yslV$9Ixi;I9?a1<9J=Gj^lN=I*!-l>NsAT)p5LjROfNICWzg_GGqDUxI~Nx z5jQ6M+STKO#8GZ=yExJe9uepD^EGi^KX;1r`uUeQub-(yUCtH4Z;>Eq=za~_i%0)c z>~^(yGx$B?Y49h+dHsCNc!dZCN56gQ@&BpE5)Oi6hq=EEf2|OSeyJG!U-Z^e9qTPi z9S2~9I@a4%b*#51)v?~ztK&fKRL6STZ~T}@EcMuzTGzUt!@8`u6i52O1>#&k!^BH| zcX97DUewrG`1N6rza$=+cXsTLJ`~UI{eH}U5-;lSy!v&q{~UyMZ8i6s=J71?-2eV3 z7GQ*U@p$*S>FMH;R;96(QY4=L?a0_lDG@Jwyh^3;4!#%9%qfg{%Js3k|2O}_-HdX;ee0P)Pn znG4xt!%^Z~hxdwe9X=_}_4c|r_dC82FV1lDd`LX= zGv_DYm{>38xufw-X5RXEe3Ur*rlyN?KA#fjzS8UBoagPvx0rl>^LU+6@w&qCy#AbF ze4mMv>G470nJ#QFNjx7uSDcLk7_rzn?0e2|ri7 zINgmOC?2$NK3O~;zEC{qh+~-qtHg2GgU#Z6e*Tqs1o<2h$6*N?Omzdodc!<1%|Uzd48*zExb2U< z*5gyedEHnb&g;fXab7nzi}SkiwK%WON5$DU+wk6ay$(aWroGX8-Z{Nz>x>#`;}RLL2e2aA8Mpmx!}(cDOkEX73iyujb-BA|Ans z`m#8$^Pd_|iMSZy*WWx|bGjQ7rX3sa9>#;_>Mh*3^VP>YAFTeG^GWLHo1LeQzS))P z=$qZ5j(*hd#Mw7nX@99>Vc_ z96VK=k4K%w**DwYc-3ee-o|)*nmFfenK=7q-x6ov>{sIKn>`}VzS-2-F0*jm&Nl0T z&ll7$lJV@D9V*Vg*(u`en_Vc*zS-5{?3>*p&c4~N#o0G|M4WxI4d*1*%f8vp;_RF4 zC(gdvG2-l-ohHt{*{8(WH@iWceY0PRvv2kvarVvDFOa(M?*VoaXW#5q;_RE9EY7~! zdE)GwT`A7K+4sfSH(M^wzS+8S6Z2=^Y&&uG&Gr>%-|TpC{(FEAinDKar8xU$w}`WE z_6KqH%~pOeF@N^WM#R}Sn<37=*=%w4&5jXg-|S4|wr_T^$BV_wUE0AH#w$gD(Qk)5 zUVok&6J8&}@qB*UQJk+w`ib+pI!>Ig7iNpIZ}vHHUWd1evv2k%alVgKb$&emu^SszB&hz3+arVs~6ldRT-9_T0H3H ze4;q}W@n4DZ+4kD`(|GkXW#6n;`wL<`9-`Cp7L;Fy~XgR;$`rz;_REfQk;FWH;c1x zcD8ZbH(TWKP2wpo?O?Y!`(_V_vv0PJ+qR7D8;1AG*N<()**ANcIQwRAFmC&@@;&~r zIA52&D9*ax6R(MSzZ0(m4<3mh$1tCI@RP+;;qAp6!n4IA@R8!p;P;B-@*gY~Z-w#e z#M9y1#oNJu6VHIxeAN9AKE8zYc7dNRo(bvvjoW^$6CQH|!g{T@Q4a@1ZR6yl)vLJi8`P^h-=kj5`C)Y| z^m>oG|Nd`X)!pxBi?d&=k9rL^eysX2&hJ;piL_k3mK*<;`mxUUsMmIW*m$fT$#GEs z3HL)-m-P z^sZyKcf^~)_lc*$t1osxR0zLCqW>R4~TsAIhyv&7v`m_~(2^b6Kob9EfZ?&?@?1C850@ChC-5I-+^*Wv9M<252N zihX(0B^z;w^B;+gHcOhx?4Y z?eloG=M%^Cd}$)i^P-bD*MC3p2<|vfoa=d(csj-}7w6;qdgFFK^iz-jBF=rZYA?j= z4dWCdp@=x&XXqr(eY7jY`ToN=alXGfTb%o$&x-T)*IVM;5B*Y{`=Nh{^ZkwEUrel* z`=PDGxgXk7obP+&igQ2oR&nl!&J*W;=nCW2A~@*LZzUf8PMpWF;!E+m!ZUIQK($igQ17zc}|pYrPz=H_Vg!q0Pm)ADU%6 zB|1O64fFUN>J{BzJgnZr`Ah2KoqwSIn)4sku^(FH75Cr6>5Aov{m_Uy_CvdP?n?>O-Y{C?whKeWi> zo5b<7CHO|1c~<;yysj`lUM>Vp#F>9r@p{PfO5=9l^CpkqZ`|&O7JB?uaqjDtigQ2o z2XXF)R>Aoio{!=EazFGGaqfp^h;u)*kMSxIOhWYA^&X!h&d0$8;(R<>A`=QIkxgWYoocp2Qh;u)*@*9cyb3Zg9&i&9X;@l4%D9-)RTg15^`k*-X zL!S}ne&|MV?uV9%b3gR3al0Q{uQ*<>^|s>WZdj0Qyix=h{WjX;_lxuS?bG6XJ@U3V zud82+^YucoA&A|=>t2`-_d^?t^E%vBocp1J#kn6k!MJ^$KF8zFh@a=u3pN?IuhT#G z_@Ck*Ap*Z(>_la|#xB6R&b#b5f zG;!|pb`$4yV2C*Pd2bWvKJR>S?(;q;&VAlZ#_c}uXC6Nw&hz59x8wE3;?#G)pCQik zqMJDPc?XE+cXe@Y7Uw?iEOGAhE*H?q`+H?^YvzyIA3oL z73b^C+r?86{~_^)@E61*@U7y_;NOdx$)r75;gJNc0O1Ks$A;w`_H+x6$fYZ!^?! zAeX9Ry{$98D*E`s+cuB?EY9Ot2`>P{y23aS1Zp78KX4u2ESE&FMOeRIs8TOgYd25L6~s# zwpTm_p7M$N@2sm1{B-eDcsKC~e4uz5e6n~t{2}oS_$%U>@DIeZ;6ICVKdb7eiFM^* zd=v3pc&7LW_|@Wh@H@pP!T%$k4}Vd7I((~m0sK4hMeqvS6YDC3Hxe&`cM@L>?NCaJ-*TZi`&+IN=lj^VinG6EzBv0^o)c$(%iG4QMO@C|*RMPt-~l2$j^TJ7 z$A;oOj-AAL9Q%v^dmN41{+1aYUm{)@%`3dE7cX;aM8BZF zrLj8tTRN+wzooxA`dh|}v%h7IIQv_k6K8+RyW;F``Cgp;EtP&stc(3EO~l#Xa*lD^ z-_qCPW5kQx-39lFXJfq;it~NEwc_k=*(T2ZmVM&vZ%O$%Ua#$AY3%XN;wi|#zc?RX z#*6du<$m!9;w&|8`&%}8{0nisTnmnfGtY+m;`Q48mUG0Je~x%Pzop9m67y$& zOJi~Nw{#X~f6D-I_P0zCXMfA%;_PoJ7H5CU7vk)1IU>&fmQ#LDtc(3EoyFPT(qEkY zEfd7q-%=pX{+1Qu>~Gm5&i~F~y=lcx9#o6C-w{hFwvdH7B#JP`O zBF_GnGI8$X9~5VQOPxRC^~Ul^bHAsFN8sJWGvNcobKy6O=fmfSv%h7zIQv`P5NChO zXX5N{`9qxjEwv9O*315uGsM~7a=tkGTLz1>zvWhO_O~n$XMfA{;_PqvK%D(8KZ&!y zrP^PKb+NzYRB`sVoF~rymVx5D4onhff6D@K_P4AQXMf9ParU=-Vchn&9PoJUzvK0W z<9S}R6z6%-U7Y8|KymiB+$_%imf7O$Z&@bJ{+12mxtT8S&&1i^^1C?uTWTCite5>Q zO~u*Y(pjASEq%q=-!f91{Vh|)+28WGIQv^(6K8+R$Kvd7DHmsdOO3V(*>p1apye^(4&ez4yiL<}uU2*oed~4kHw;cBP3ID|F4af8KW@~ZQb&+^Y z)H_tX4t$DuJ@`Z7sqp8;8^X7WN8sOyH-lF=;(iFHH>?Yn|KJqyRv4clo({iUyd8YB zcm{mBco+C$@l5!7@gDG<;#u$m;=SRukGdaNZ#KMzct3b|@f`SI@j>ugjNAT}xgLK` z9qarZb-a)FojUffD+TTk!>_UX#R6@jUd1JPu6kAHgVn1!pQMh3UZ7sxjbA0s{+9RD zYq;@0sUPFKT7|^AD&a&rRlSxQ-%b5k=Y!R2JD+6S_O~qX_zUVdULUFBc>Su5<5dgq zn}&ZLyI&lymg+cOz0`5MMyTU>O;yM7dQKh3t5luGMIFbbYNhyb2_kMT!>`Ree!e)$ z4Tgy$&EPI^UOx-PdHsAtoY&7U#d-ZaBF^jQ$(0l9VrdtMH$%xch^N8t73cM{(0By~ zkN(X%kMB@-=>_}MvEGiW63;&tAM5QbbsT_8)v?}2s$;!PQ^$H+qK*UkhC0^Ur^ao6 z%P$_Uiha?rx^O&?V&c~NG#rZh$ znRqVZ>=z#auT?F6e8YLjgEtqS1n(xE4<9H#9e#^=0ep`5B6yK_A$+5F5qy{UYWV-e z*T9cSNvyXRe!6%GyqkC_e31AK_$2W%_~*fYeu49a6850r=AoaA3n6OkENyf-EG{s)9S~^ z+y0hwJbs0E3i25%UI#u+JQcoJJOY1RJPp1}JRN>OJOh4AgLqxGzonVSyNI(d;tKIX zBs4~x?;B4OXJ5n;alW7YhB*6Mc8jyWI+&Hmb_P2BtXMf8T;_Po3Yuxs?+~@Jd;zc-)uZd^7^nz{Td>`*uarU>Q zMB;UY`LMsGi8%XPx)`_pEth+Ij5r@(W{UIiWtli1U)~UpU>1~DEpoc%4k#o6ETw>bM->YXO_mUW21S>o((=_$_smTSe?-*T5Y`&*t6 zXMf9jarU?D6lZ_SU*ha=eK`~^Yuu*GvalH@p)ZsBhJ?g zmx{B$Wwbc2!?VQM-}0t%mS3vu?hbQfoT%V2T#x7;Gm{+7Ao>~C2q z&i*MSw{>~DEToc%3d ziL<}ukU0BW>Yf#^*Y>xZ;qmU`JTI;m=Xo(voae3- zv0nDKG!tikOIPEzza_`xH;bp>`aes2uS+9XDqapR7U%2YJ>u+dIV#Tnmil;~H4JO} zThcv#kvLy(4ijfxw~O=j=0b74-drut*PHK(^L6yM;tesMLEHFo4C{)(8;Cc9w-?9d zKj4-B;ydC^WalQ|{PP_}oe=42{|4qCHyw=%?^=84(5bq7|E}jh^BHj-^ zQ9K7eR~)BT@QiWW-}08n_o%yaf`8QUK3;=%@p@zNv47oB9Sigdb?je{Q^)@GTy^YU zuTaNA-=vQH>#xPx-%_D{V*ZuTN6}aveH7=Y<3zer9sMm6)Y0EER~`K=D~#LzmUle< zojQ(JRrj(s2!D;m!SOm(9mlJiI*!-X>Ns9^sN;A&s*dBeMjgj%k2;Q5<&N>=63d^* zMIFbbv+*E;lOp;p$K$t%quk&jaikf%EY9oaHgR4*e;4QV^Z1N-U16TQezq0o_46`u zmNr?u8A^UkJPrO|ab7>S8Lza!>usny4#3^& zSZ|N3W4*0a$9mhYjsy9-I@Vi_&hg_C?icgc)Z?ASc^vzQM-XU)IFHMn;(YviNSu#T ztHd)Af3tWN{7Z2@zWgc9$C29SB+f%F;-ra>fOiwmgAWv+1fL+D51%7G9sZ1X0sKwz zMeyC?h44Sbi{Qt0NvwA@{B-d(@bkor;RD1=;1k44;RWJ5;48$-;3eXF;opdt!z-Md zSl2;#1M%329Q|({#8cd#2mQtCz;6~$h0hU>z@HY!+e*P^aXdW^z7@x1DyZDm1q{E2 z=V>P5Hxkc+cNWiv_Y=>7j}^~_&lVp6e@;9P{+{?G_+IgRc!l%a58>CauIcaw;sx+_ z;)~#yi5J3e6fc5L6JHHqEWQT*hIlc2w|EKsckxnq^-T9e_%*C|FTAn%&+rW6w!fvX z#|K{=j~_m?u#e?B@j-Z;e#p4J{;%@*X7SYMeT26!#3L~cf&=1d@S45jd4~6!4sRx& z0q-K73GXMK1s^4z4WBBW1AkOJ7yh#N2>AQrdGNjBli(FENvt;?-cWoxyrXylJX?Gb z{08wt_&wr9@JGZ~!(S9%1K%oM4F6ud1YYsd#Cl8Njl_4rJBgRUuMpo0A17W8pDlh6 zzFa(T=>>0!r@+4!uLG}eSz=wO@P^_Mcn9$`ct7!U_;~RQ_*`+E{=qZiSs1@rJR818 zJO_SQJQsd4{xJMCJWof!JB#PR2Z&FCPY}Pls<3&w%e1&xG$6&w|&)<9s+9VO`nqX5u;UF5-uM?jR-!5JNFBe|~uRbV#+{1bc;irlh!Osz24ZmD`4SbY% zF?^bM34F15DSW;74){*-GWY@Uz3}4(C)QgIKTG@|yr(#y*9{X-abbgd#OuJH6i~kUL6w^ z{uzWP2+<@?F__~I#U)~Xa{98Bfnrq|Z!`C%=*k`#-Jkt#e z7KoR@HyF4520J|dn|PROcsu60cs^mA6vx47;@mImDqaWUbHuq{c9VE2#y=p={jwtQ z2*z&|ZwCKdJPrQ0IQPryU7uKQI>xsaXTQNk;u#o!tvLG)?hwz!_=m-Nz+V>6f`2I9 z8~&4cHoWTa#JbpT&{#YN<2#A7-=ME?+ix)1<1^H;K9{Ovoo`gfe&UzvSfKx?V?VL} zhkFv7dOqIQtErR>!{fW_9dqf31!a>8LvT4I15$SXU+V z8+1}fzd=9aw%=f!$7ieKc&${&@p@Ms$Lj}m9It949mlJOI*wPaI*!*2 zbsVo1>O3y$I4)lq4ddv zub+R4v$Q6o66*o~X6&O7FH;X*}lDbPHC{@RL+oz88R%3KL|JeQF z0JKoYdb>~^>us1i*4v%xIFOI1W4%3Z+D4kidjW<06UXu-N0p;yjMK#d#e666bL|aa{a3hWGpLaWrl}PkoWchlv+P za}RH~i}U&L!{Yor^^4;CJoWqH{5ZZn1BC!->U(WS-jykS; zH>tO9v1Y5|^VCnP@}e4e_kI6qH)nK(aBJzAWf zr@mjDpQm0f&d*c7DbCMR?-A$csSg>qpQo;SbG$C=XNec#P+lmW?fyK-6=&c0ZQ}eq z^?dQtChiWN6X)ltON`skQ-A64zs33Za^i$|yMilQ!hHCAsg3cKQRnRvk6&lp?i=3f@wwvM|9VE8`-X3d zbKmewaqb%)6z9HS-HGvf!#uff*wT2F2&;`=cRk);oR5QJ#rb%2pE&mo7aOl??)Np1 ze=N><`=2=X4UfYcQ(@I%eC`{bCC+`rUgF$0yw>)SVyjq<5m6OG}UpY^l`;{xi`8n>*;@q$NR-F5l zm2OR}i~E(0#JOMDQJnjg+2Y)<94*fM%9-NauPhSh=eXY%=YHi^;@q#Sc$?I9W~Uf5 z73Y5C`QqHK93;;D%8BCKuY5?H`<4F{=YHj9;@q$NN1XeWCr?SNi~E)5h;zSkpg8v{ zCyH~wa-KN%D_;=je&u`O+^_sWocom(Zcogg`<3;@xnJ2)ocooR8@KzFH+p=AcsVY` z%Z*nu*U3#D|4N+KpWu#oU11zve;SGNdfr)_uT!oR=YHia;=KMZ5a)j7OX9rlePG;v z-uYXP9~S55I#0MWUT-W;eK(#H##QAyW?&AEs^B{44-uV`Be%^VGI6v?Fj5t5{Jirtaem(U32}bj`Bia#-uXjue%|>faem&p z+SJ5)`FZDvI6v=vt~fvMe5G;wdFOE+e?UCNO=qxFe6LF{cwM|4zEhm9TmKg4=bcmU zjn^CI$h+K&61CyD>D(7nO2+<5qwYrf-PgE-%}*=gMFZ&-lIzTUiFoUfyoiu3*XV(|!$<1X=L@B`v_cnRu0m{>30pKm3e zjyOHV+rh69=lj4@#JRt@P&^ZHo)_-{e@{FM{)2dLc%^xXb!Ed(5$^}@D4qlFBhLNJ zk;d)*=Di+&Qr)E&tXIc+-ldNHi$B$|Ku?$-uQ!$t_AlC~WB;O$I`%I{sbir}Rmc9t z5^?TtZcxWQ+L!9sM?0jB6X~P{iFH-N{$_i1>~Ho_$NuIh<92^@hR2tw<9NNTj^p*U zI*wO`h4K7j_lx7zSRKc!t2&O?AaxwCN$NOWPpad1ZBplPQO9xl+jtPcNfG^)`cS+s z>m9^VZg8bI(hMeu^ZGeooY&76#d-bwSe)0-|B3VZS$k1p{w%GNcr%ndSUe3rS)A9; z`Nk_Sc=T^pdwi?9OE1`~j`j9`blrQLRnz~+@!frLE7w9e)yPORDs-b$LJ|hWL@^<{ zh^btLT*f68Q7M#5Mn#E|OGIdtR7yf6*NP$~LZPqJZ}!=r_iumB>+#t0$8Wwpe`oet zpS{-Ed#}&>oTb`?xc!;q+jwh0w+`q)xAAs4-NxGxx{bHT>DH02(QUjfaqibQ*CzN* zxW>tWPsH(t$I*B=4z7Mb6Rs|}60Ux{6R!K+1i0>NFFW_^n~M{C9bD^TJK<&4paY(a z;|-6m`TKEjt&5!n*S!8JxYjpI;acB(8m@WGn{cgfehSz6<`%f}2GyR*j!WyCN5Zwf z*$S?F!i8|HZ(ax2`sPr$);A|Q57!y>^LB!-fvX?4!_|-bKOM $)=<0{s8`(YasW z?3Lg{;AIxTqwsZ6GlEy(dQM&n*ZSsmky1#UW>;7^TJZ0zM4(EP-^N9q11Fq+#)o`_Q zJ6z982TqFP3g1`l&xh-I>1^kIeY1Ch-{IV^Z$6UXFTk}sJFlkBs_3)A1iv1x``|FR?ne{hTHk!zd3E=`pC$MfxX#;NQ{s5T z<7j>JSh&_V&xC7z^GdkZH*a_D*Eb(Y@E72^uYCa5bI4k_^85{6jN=N&zVbYc;dK{B zH-NjH-&OJYmiEDT!g=_pnty5ZK>P;0tb632!2|Qn^m@_jE58)CGxI3CHfqn2@S=gy z>srIh?fLvd=RP0RH^J|L>-z8%T-S#;;JQA10@wB7XSl8pRcFNUhV9gK??|}jQ?1|? zLp1Yq5j@xYdU&4sgK*8Ko`dW8yd2)bj`I~<&+R+l%170jnH_K1j?)<4(fmw!C-W=e zUCeKX7nnZ|?`l2^UTFRiT=}RUocny#?gT&V!W`LC)4e@>ms_1=VH1I(1+X*AvPQ8Ve5kNSvi z`KXP~eLkx4D{=e1A4RwRYDc&J>Or^ux{YrAHJ)z$^(Ni=YZcx4>vy{K*I}FO7{^~+%ALCQW96~D$L_{(q$H&_9;W(L2)b^YA;wYdG^`|A4H1g`667r3sU{o%TP z4u>nWSK+x9@@jaV`5$myKlgn-Zhs{myy9<;P4F}5(Vqvs=r-Q&q}zCVl5QO^mu}&PZ_8*d$)`+QVkf)9dgoQ#BPJWPSB-{-;A1z*F}kAK5;zdPWK zINq@Ry07Iq_xY&y3Emy9JjNin@)!@o^}II)t~^FLT+e~uz?F~M30FSqkT>Ia!?^Su zo)1?(sxw^qsH@@1N8JfmKI(C}@=>qC_58mSu6)!+xbjiE;mSwVnG?qw=8N>xJi#x3 zs~-oz)sGLr)sIu*|KE?!eLm`|1m6xXvjFycD~>BX&bsKIL1Vb`Q61sRM_mC|KB@$+ zeAFXw)!V=3Jd@9{b}mowpXqkptNL~vSLQgDk2;EO`KZ=(%SUyiSB{QbOt*a0gLKPB zO{H5tY5`pNsC97VqjtlUkE%B}J6`3ZTEdl&>IzprY7kucsFBWnK5BA;&x231e*6Mn zVB_s~xbji^yc5S2zOV98N5fatkKW)kxbjimo%?)Lae_Yx*ZpNGT=$m+aNS?Nfv4;| z{N>!|qYivGj@NrrxSp5JhpU|f;Cfyf30M1Hfa`f_zH^_C`Yyr$a_;j{d%qXQ<-Gx1 zd6hPB<)ga7m5(ZhD<3riu6)#Fxbji&IIpJ8s_3&%6Z|K*?t{U+INtC$x*yenD<9R| zd3E=`=Op;maGke%;mSu%f-4_253YRF*Kp;db~yL>sJ+YMc)d4(>%Mj>T+bneaOI;m zeHb4<9Q(>UZG-Rb9X;T#Tok`Pd?YQhywh*+0`tQc$FKMKpJoYu4qTtd-f(>$?}F>| zI3BLgMf1?H*Pq#e7sdW1wb*EeY=N7ueH=X+By$X_Mxcwb!mc^z%ATh z0^FJzyb0I!b2VJo&mC}GKM(#Sjw@`ZuAeR7x_({&S7<}vxfb#>@I3Rma9uxFJFldJ zSNzQ%3BKQoxc!;eNB;~O(`~$+MYr*GHQhSkKDv#!GP;eocj-3XzNA}6?x5Rv+xycv zE}#FYpWtoa8YkW08V>{D>i6Mrb-@(4`mr3Y``y=Y-PeA1?(;u;eHO>-y#ZW#gEnyG z4Z6bhd^G^Byuk>#p1YodEB`YeuKdqhxSo4=!j=Cy@bm0=mH#;&uKdqgaOHoB;L86D zf$MpD99;RInQ-NQ7QvPOS?Ap6e|9DKVJqW!!`G`HPll@>FM_Kdi{by@kIsGmXL5qS z3oi?zpD*C+qGktw!j=EocU2r$_`b^jGs@KOt<{cNVxJpFTj=mSp--9XCqws zpGse3$EEzw5pd;y+Q60n>E_($f38dL;qYnJk7e+JsCmKLaOHni!Il5{6~3Z=^aeH7 z#PNphRQ{)dbD#fdmEc|By1x{|b$=NN*Zt)=c*@ShJm)^o^G$;P1K0CX-7n*K!{ex( zC&Tr;)D5oo4}$A?=|Sf{|1&kg=Q;Ozo|Or{1+F|s)vw~X!s96aa|B%ZpH^_?e=dY8 z|8pH&`JbWAtEsap`s|4Wp9R-_a0y)ZqjhlQe|9;q?%wyHujBLJ{dl;}TNk+UKmFm# z{|tvK|1$-y{Lg#N!+i|&vpT_lgKOV|oNwZ|!sBS)g9dQzd(alHeGe{%Yu|%nxb{65 z0oT3N~_WwN(aM!L{!}SGe{)xDl>>4<3VS--9`D?R)SQT>BpU z1J}L>b=PLMU;7@kglpe}u5j&pPz=|;2czKH_h33)`yPA<*S-he!L{$fUvTYvaF9L7 zh0%qdFYSAf@7(Wu&?&*Mfp4=9{C&==q;wSsf@c$a9$e42-@-K?`5#=@)jI3r{tDk$ z^Mw|0?R#($T-V`2aP50A2Cn?`OV0hi2lEsBOSrz@{Rdp%@80YCI4=L+d2ayMz6Y)0 zflW{^gs05=!_(&X!Hdi%!b{EHf@|M{PvP44;Agn@J*f6WcD&m6AO+XH2d&`R_uwM9 z_C2@`u6+-N!L{$f6u9<1m;oi9;|_D--F-b+V>!5V;q;?_u!}mZw1%qq8nVFive)$doUEPeGl|K z^{`c8d$jMt9K2rp9;|?C--9jiqI7hPtM((}Z6Em&@G|ojaP5201+IM$u7+#hgWKWS z_h1}c`yR}MYu|&#aP51r0j_-y{)21ZgTsExJ`dXWpoR0*?)mV%1n&pWiB4y54}4Sf zcEOYIZRT&lHGlj9u6+-7z_sr|ZF{5euzRPhF%`d#P4KhenwRy0E3UiXi~o$?<4Nb! z+v;E zd$W zNARxZKfuSCSK6K(*Gltx&VP32r+I>(Lr+B~=qh?T@*(u{$j8&uQTt}o+eiM1^K#eD zjS0RBZp{e}+!3FL@HnMWbArb3AbMHQ9$sqR10F<|=inB2srguV5Z&&Am*HvikDS*` zStBcctxfQq&V4;(t-s=Uy*GmEdfpzc`(qEd?q4@KAMN^OWP(2jx65iU4{n#k;A^}Sw+%7-C>F}0zs(ZrI<|Xh>=40Un<}=}i=1bs3<{ROC%!7Zj z<0>{k9A096GQ8CM0{C$A{_xS}!{Fo1C&TUI8@vbaWS^Js;05Np;DzROcV@?1WPT#N zk9h(7I`e_>V)KWcS58?_6~A6c@HKl!ALQ`Q!-<{he%HZQcZhBbUmO&_{;rDG>-phN z`0$*H|7XR|J_pCI4@;U>^oTA5jo{nN+rb0#LU`F_(QyXC)8-Gr*I9k?6nLrmd+=HI zzH8v4&3}g%nD2E+cD(sLqjolg*EVkhFSg@c<9y##cqXHtyAu2fxSjrBHeBo1E8w;5 z_*>vwzph>F6Lw41?DfoyPALK+}G8Ao8W)J!_Rj3Q~S_3-tagY zCyn76C#Su7@U*pmB3$F-ZMeqCYPiP9Hn_&g-iK$$rE!uAFSPcY2Jc~hiF039KPbT; zrrUjIIz4J$u!tUA4ucJJ8=#fz#c^fYWAl+C=~g#;8r|wgs3G zZ636YZuQ%n==MRXdPH_y+UK(Y-RkO3quacuyK`Sxe{+J5rCWc!Mz{W2LAU<;m2UmD z&yjIlnf6$J9Y?qRI-73&)thep^)TJ~>lM2Cg>L=wlk*^DgTLZewWH$pdv6H0aD$F; zYi4jIT-VRL;ktg7!FByChwJ*e7Ov~(F1SK#l**1P*Fx?L&ojRUuIuOB&MWEQ6@T+| zg1<$#@wSR?gt2Mxc$DazD|NShflMPJO{3PPH(vCB1++^tDgX0Q9pWv zSK%cMBLCRAudCmX;CtY@zZ`ySd>+E%=>BpFT=$m(c*@R0Kj*%#eprG}hU(o$TD#)nAz4{ha%{`nwYRF}Ui(Uxur$elc8i^&8--tN#zK zy81fD#pfYxr|RnSomW$5RrJ{z34R$|_rV+Cx*t6VS6%&7=hfZ&&P(t$aGkfm;i{`Y zq)8laczo5>H;1dP{(QLV>iatPb@g{A_!Dr|)xQQ;UH!*!)z$w5S6zLjgun8tFC@1Ty^!6 z;i{`&09Rf84{+7h?}4kX{_yYs(Hu6`a|b@g96 z_jUDuCiwm*#&LzO-&S!g41bzBuae48=Kpj_@P2ST-wuasKJpw~*VXxO%@@|fRad_o zuIum-&EmMi_N%VGEnMrBmpJ!z^#c<8KDg?KpN6aMVm4g$!ym&{SHBUi1Tiduu6`U`b@j90s;gfLS6%%Exa#V6!&O&br$u(W zs;h4XS6%)2aMjiKgR8Foez@xDr@&QLUk<-C;rhIs z3s+rzKe+1Z?}e+b{wcWX>R)s2>*_yB@C|T%E`pQexH8AF|ITJzxIP#8aMjhH4Odeo8=b@e+F{NR>xyy5F}qSF%`54Uph;7quc)djua znm^tHS6zJ>Ty^zxo$sBp##H=Tnc#oGH80zzRUB7%9L3cbuDbd&o%_1_q68lTS6%&h zxauKag{!W9g>zq5|679BY8}TFzFu|pP2sAmKOe5T`WxV?s~-hdUHweB>gqp%tFC@4 zTy^y|+GMw1b@lb(s;h4cS6zJ%xa#U}g{!Xq5$C?H{)Gfz2v|XB_0tl35nShgJzVF1H(ckxPP;hX@O?E7o5M8@yTCOL`@l8chQjrn{~TO( z_4DDXtN$LZ^Ss-+udA<{j^py)9Io|(^Wi$5{o$HV4TbAGPjv3<=jSB&7jRvFwmJ88 z^)=eZad~eDPe+%NpdGx_yb!J%=S}dm-B2Hamz%!`Pg|mMF}&1#BfQ*v4_tNiM|8-J zS9SGm;F{lE3@=SZ0pA2KHy;OAUHwdWxn19u!Btnk8Lqnes;6hSUv>2j;Hs-n!&O(` z6Rx`YTi~jzALHED)lW_E_u!?`X$w}-ZJqizy45Yz>=?(Jd0$J2H-xLMz8ze3^_Rg_ zSAP>+b@dO!RagHKTy^z}ocp@^?-Kkkx{aUx&WPj9948%}xJLBy$WNzRVQvxK>gsQE z?(6DDC-_vjH79rvUK%wgSOpI%MgNaq;HBm@&Wz*Dv?uy!&;VX)ei~eL^_Rj`SAUc9 znkj2!#jghve2Q~lKmT@ue+t+2{1>?Hk2TJU;|-6m`&Y`jud6>L!3*Ga`3(BO?Q$60 z57#=^GjN@vx8ZiV3O-Qk7iH^Pg|N5lJ= zzX&fj{}5hcz8+p`z6(Cw{E)M=;~j0@3_jlcJh**)gT8Rp)sKK{9d;^Qb@dD2MfSP- z2ClmLf8naDuh%&{F4fhya$Y%QK~?%$VO)D=-7R~z^W zt9$PT4=#^hKLEbYUOyB*%e)L;X2+QeFEw8cPn-V=A8p64UX&eIvH6kk0`r#elpVh- zJh1aq3}0uje-K_|J{ewa{)uy6AO2&4?|~~XbZDkLaMd@y0Z-ZMSHN@4x4?Bh&$%)?F4Z?SfalwBPKCEHzXaaWd=Omq;UnQ`d;L^+ zNAm@6-7nU{yV&b@!VAm~x+*)~uI9(X3(e1ht3JHQxvvi&lHiZi?K<-sJ!)RCf*xH4 zf~|BLpnG2($K~t8kD*)r=UH^C|Gbi(6P<|L=vMzZ0j~P+H|h2~zlv^k$iLI=gS2n& z?6_1PejMHE!_T5yefX8meSP>{3H}t_`s*FK_1Bkl>#x7*)?Wu-6UXK2!&}g;zb>R( ze_cf4Hun55RT(d;zZO z=MuQCpPS&iepc&~-F}7E6rO7#Uj)xHzX7i6=L60w>EIQA^L&EOr`ve@j&9@aU%HLA zx_#rgGVg00(2{QR?yhtjZv*Kz-X5Y`N4`L}@ix!7uMc09;J?8&PHOgxcg*u zt3G@PT=n7OoQHMV`k9sB%i-$B&2aT&jRA37;qldvx$yt*N9Vpi{E`G82rsh$9)z#6 z>&aAj%B~yl!&M*t4P5o%JK!n%pw_xRj@Q?R=R42TQCmCDN$_jv(P4wT>5ZcUJw>ch9vtv)>GhB&TF`>j4am)<#gT^g?Wa8J1E!-v3CA3g!D`taFs)rWry zSAFBFp>v?GzTi@*M0B~xb8>e;HnRw<-EFk-^B^O9CH;zXY!O@WF7^hmVD;KKwPf>cc;W zt3G@yT=n5Ow`8|p_2GGN)rWV6t3LcXxaz|nhO0jOCAjLtm%&vZ{tI07;W;JQ?N@zx zE?o8Dr^8hremPwA;kUt6AN~kj_2JXust;cbSAF;f=e|CCSArjQYaFky4{zzbio0HQ zOYp&PJ>QOjYd$g)uIuVjxaJF+;HnR=aa-K}u${UNH-f7^{0z9(-HM$1`tX|*{2{pN zV4sJpe&9X0>R?yHRUiHcgLg zt3LcKxaz}K!c`x>6|Va58nc0r8~0YQhoRlaMg#mg6s2gF1|_;Ya8hri?8*N1n*tI!#{OVSABRsT=n6d;HnS560Z92+u^DY9}ic3_$zSLhcAb#K75n&u-;ogl}qDz zy&nnBu|GH&uKMuv;i?bs2iN@ZLAdI}Ux2GV`~&BEr_}l&_%^}+g==1R@ZE8|;c*mK zbGYim&v)+Y!}})qeQ?!>KMPk~-(0xr!@qRy>%;#^@VfWJaryf2mT=XF7s6E^UIJHr z_;|SL!{3CfK70*a_2GZPRUcma-t6|PKD;qp_2Fm0RUh6PuKMtM;HnRQ(z&k>e>K6E z!_|+Q;i?a>d|w=wuLG}};LYI5D|Ut}-`g9m=dQcps>^)>uIH{faMkO60aqRMAI^Op zc+H`4yxw!+W%k_C2CjH7g6sM7dbsk~_rsNceip8H--0Wym2lOE{|Z-q_}=$t$E*7A zqv5I#?*Lcba!AKnqJ`P~)p(o_`io$zw=r{Ss(e-mDA*SA%0)rbEHSAF=t z4`#=u`tal6st-RKuKMt6;HnQVg{waN3Fp2(d{%-lf|o|8E%=UZ>(u|yt#09fk#W4f zKD-HB_2Hf1st>;!uKMsh;i?aR9IpEC*>Kf|uW;_`!+%QfJ#-sCbsmc2_4VOR>E+Q0 z?LtpS3xR#>%m!Y z)rVgNSAF=M&TFQukrltjCio2JVg0s#79{vra9z)Lz;%DDJt~ejJihK<$2#}*;pqhL z4!6r^Fc_|Nu2FEUb4`P%EZ_xjyIcj|z*R@_H(YfT`;U&}_4VOR;GOJ!&w>}2UkNWX zzXM)mJ^|jx{B?M-`6uua^Ud&5^J-(V;~H*$6nwOK8~AwhOW^kL4F#(!n zst;cVFS5_wM!4$3t3Hw)m+HfhhO0ijgY(KM3##H*&ji2Oxvvi&li<_gdW#R>rS{fq z;p@zI!gZbx8XL#!>%*JCgXm>JM|f59fzQXs33Cam55E=u#s|?2Z$pCr0`IysdVTTK z`1oO|R=(9yzwSJIU%mbvc=;dEaeBXyeVhV2&O^?99oOUpe;1x(=lKhGZS&vYbbS0S?(4YjOz@}R>c=^7_2VkI`tc9=|M%mJI4)nub##KagO}O(><(XN*XNty zs^c03R~^@MxaznTz*F`?{T8nI*KX&&j_c5walGDJ(4&_H=hLl@s~_F!xQ5cLj;oAr zbzF1lR>!rPZgpIL&^t#B-S6e>xKzh=99(r=XTw#;buC~xYl81JD~>CC{WKeI4d8lyXbV>!{t~$AxQgMb;~D`kX%M~f6z9Hjh81)y_F^)p30RSNpfaRmZjOt8rYu zj_cS2Z|~gKab29?1K_Ghx*x7Ou4mw?bQP|tB$M2YjM2Q)L9jMRxiPu z!F3-z2d?|km2lN@-Ra!daXpscFT-`-mcv!YwH2;9uDxE5;|IfQPs-f!8o^b^)e){bt}EfH zzc-8Zx2QXN-oxazoiz*Wa}8(eixz%?Ja9j@!@1i0o4Z@^W@wF<85@OHTBxDI?fJ1*tNPH^t)xH=~IWpLH2 z+z3~meDpTO9<9Y`kO3QwC?pBu*;##LmVf|r`Nfvb+|BDm_f`omSn zH4Lsgu1Rp!am|IRj%yWMbzHx~RmWBHo$Pp3$JGd~I2lKPz>SKO5 zyx9C?c!~K1@KW>Z;KR-DhmSU&1Rrny9$fkPFX37T*$G!3qt1ftc(o4F9A0F3wk~k3 zgY<`M9b_b2>mV;U_v;`ZB=~pE{k|nT5`4c8;<&=sEB}xO&$08_0j~VRW$@be`kUa& zKa7UgwbxIF>wEVL;VFClT6nJc|KNG%brxpFtMA>P2+z0IcY(JszXsmY{BF4REqM~2 zw%5M_?`ZxRyp#E_@Gj;#A7;l@VBQek)x0gd(EMV!_AR-=x!TU5C(~_Tf{W?lVpqk_K)Ma|5%ikT>!-oBZ^?&rt25a^xBW4K z#o6tzVjrY>^nIiEZB4g*OD?9{z9j>l`+Z9uPVg7$)?Z8M)?b_G)?d|^#BpWb*ZM1$ zZuL2*)2+XH(XGGkpj&@EPq+SBLRY`gtzY&y|NonHMHd|LQ5=`|HgF3!=mEE82Dia= z{hR>T^>Yqf*UvR@T|fVZ>-u@n((Lx9qG1)B2G2FW5}s#%CtTOh3C=5}?8OzoW+(Wk zbQ^D5={DZ>S{AoIb9@_b$Iz_<&Z66RyNYh(t(0!#?J2r-5HtakUAq@e_O*wn0~VujbC%ISJki zu6)I9aOLa9z_o5N!+CZ0z6%rlJGjo_b(3yzt()B7+^?Gq zOYkzd)=l1mYu)5?xYkX!!nJNvNo%;i|K1I*b(6txt(%O2Yu)5U zxYkV;!nJPl9bD@s|H8FyQun*;c(rbFGF;z(?+VwtNikgOCZpk6H<<<3y2%Q-)=f6U zwQf>vZFc*$ZgMnS>n3NxwQkZEu62_K;aWF&0j_nEC2*~q{0!H+Nwsy^?bo_VeYn<5 z(r~StTn5*=$t`fLn~Z{M-DE0U>n01~S~pqm+^?JLOz=AE<9Pk|-%oO0#a*v1Oz>j3 z)=eIUYu)5UxUQ><;aWG@2-mtv)$il>hwapLxFKBYCLQ2fHz{=P>)!?@_z1Y_rY6D5 z>_KxbT<2#cTy<01;5u*n{1C?*wo~v7k>wH|jDT2G{3eDO~$1Y=CP$ZZ}-(afkdIpNFvhT8}#sUX+fm!{@-Y9(NU7 z>v6Zi(;cGYJObBx+;q6sv7xRT94arb9TI1k82Fqdfe%7t;ZF?wH|ky zbH5%pF2QHPbE4A|EQV`6ZarMm8Ps;l1c)0Q{XE^uymYxY-0xz@UkAW-SG99jb%L2IaE$f{7e9Qk5yzbv|yguJ@ za)Mt3SH7jcbDwW1P4LIz${WmrE8nsNu6)ZzxbiK#;mWtv{U?q$Y^U-qCp!1}mNOH) z2VD1~o8WqG90^yxWtwxJZz)gkFX1|G|G<@Rsk1YV*XLVWz?E+)fGgk9&$-XH+>_u> z!j*4%9j<)Ka=7v>o8Zc~RQ_Kam(RD83|Xu<$1XBE#+|K zTfT%V-|`n+`IZC!&5l?3mJ{L1x10}GzNJ50`IZOa%D21-SH5K_T=|xbaOGQqUD@qd zz9j`$zNG_P`If8U%D3DPSH5KmT=|v{;L5jbfGgh;{FmK+-#GXAmhB0C!0tF+pKr-`UPU*@ihJ0(3Em&BdFTkZ@&?bt zbzNNm*SvlmT=|wga9xLw+!MzYwqN;{Q{l?DT^zKg?!OoILV_=Z>-lygT-TyxemM{tjGuiB)jrCAPwqm#9`PjyHT?%`dsvZD_?gvT=}{u;mX&& z23NjrIlL$xeZDrqm9GnGX2+|1T^+dcbxq;Q*PR7dzU~UR@^!bsm9HBESHA8=xbk(2 z;L6vngDYS6A6)smI(x$!arTwP`pTJI}?YrZfBuJyhb;acze0Iv1EZ=L(~zMTnPXWuy9@b&7) z=5Y060bKn!0Iq%<=G@n-PfYMP;d(Cm6t2(97Py{^s_qxZ6~3>Yi;jfrxu_Lf&wCfa zmA}0nUUBL&Kf~d<=9A&}u?WiHs<-?Ko^Qw50dHYmt5$ZrEzKLl+nRTTr_HZ`cQhXY z?_~Zsyo>oO@B;H?@UG??;f3aV;62Ri){f)#_3F(N{Cv92Q~J}RXG4RouEeu!>$(J#>LgS3!t_3A&+ ztzLZ(-Rjj3J0OnB*Q=kB;9cp~UpLaNzsAt5zh0(We|=21{`!S({k7MDXutJWBf9n1 z`E={AL3H&C-TGyk^B|QOBANg5VS;afTev~BgW~pw$FXJx4dJ?ec7W^p*$b}g=iP8! zKg-~{e!dG=Xg|SoE#$oq&TfC6`7v-^KRY6 zY@^$F+vkutu1q^^yd6uo@pcB?I6Xt-(=DHQ8Qt=kH`6Vj`3T+e znKR+aXD)>+pZPOf`OF$eXUC;{W<$90neE`pXZD0EpLvUOpU-?a!KcHgSwGH)E1&rd ze1(m-zv0Sf)@~HX8@5OJ%wyroXLfY%^Olz-_|0%#&mV#7x;+!F>+>Rb%Fe@j=RTjg zJHZb-CXP3Jz3w}$;c90gT=$(@;A;Okxb8bMocny{k_2Dte0D`U^|K?vYvsjpg|Aop zkAV&O;}UqD`8asK`OEN@<{vrtdD?Xe{x@9tsM^QI@n(*5X!HhoaOI=Y zaOG(W;eiEK3{RPlfTztT!Hdk_ftQ+p0au>(H@Nb&H5zBft2}K(xbn28!Ih`I1g<>o zK)CX>55SeDeGaZX?R>cMwBN#&r`-uxp0>_$+3_k*+Z?Vu?fG!!Y5T*KryT}Yo^~=^ zd6;sz^0eQ=m8bm+t~_n6CfRW*Pus}3&&Qsc;FrMlxfl#rp7uewJ{ObW%G16BSDtn? zTzT4G;mXt2JU)&$jH@UeeNG#~m8We3SDyAlxbn39;L6k916Q8*3ApmKufmn5T?SX4 z_D8t#w3ScDj#qiw!{N%)wuCEBd!cimr@b!0hr@I1dRqopp7t%c^0X`AdVbgeSDyC3 zrg6MsJC&zB-np-jIwQd^hpRs77P#u8#=un{^&(vLQ48VvKH6Hi>ZAUFt3K+${5ak) zF4ae!2v>d7`Eb=o^@XcG>R!0&qn?7RKI$#F>Z4Y}RUfq-uKK70PDEU}m09Sp~ zd2rQ7T@P1%)WdMqM@@sPK57A6^-({-RUcKYS$6wXA9V~|^-*WTRUdUNT=h}I;Hr-*ta2bm04ebjuo);re2RUZ|cl-+*S zM;+qauR}FW@U!4r*C>LQ*>mHqaGjq=;9A$13DFaOKbUz?FYEtW9>jE$sL$;L1y!57+u*UwGP%b055;c^SNu`8)6~=Bwca=D)+c zn(x&%JFY_WT)5UBPj&9s9}5%wM!KypjHX+Dcm_RcUhom!2IwZbtuItPHI6IOPFr8d zrQ7;KJGu?@OX#+~a5G%%kK^dJ&h;wY*149`?Sr(LZtIUZr)9@g#nvBl>9+pZ&beQI z?2+KN(yhNH(5=7Tpj&^fq+5UeLAUSs%W*G$Ll4_|NL294p?%%Bro*UxL=x_;gd*Y)#xxUQcI;ktf)53guy=4YSw z+3n9Y&xhxkcY*8rd9CwGDSL6nuX_{x8M=+PxpW(EYv?xKcF?T@4(<@gm1&QSw-f0$ z-p-@jcEj=Z04<87kz*DCIh`k9m9pTpbPA8d8LS4u|-g6gNoad}U{KeIn+2cKf+ z`3m?n^PAzj%ttx*`^`R|;Pc=b|6js2&Ue5yp7-k*$Lsf-Jr=I<*#WNmcu%pK4iyrM~&pH*;O=eNQ0 z?Dczf%8pCd`Nr^kd;QsPJttoaZ)vZ;7p~{zXW(gj{af&k=AXeknQw)6F|U4hc3cJK z_2GI>KBsH^`ta7Gx{-_Ew~vl)Bv)J zjqG(v+#X*yk_%VeNISUdMhfAo8yN&w-N;zynYs>Z=gb6OLbv<=2D;Ua?4euT$YF(X zyqWj4x{;IURyR^Wx4M!3bgLT~Mz^|=$#B(;l*3gw@*P}tBfH?L8>!npJ1*6Yw1BH_ zqhQP@MqxDtRLTm>pK4_d_~mk;1{^+Myg#J$K~rrj)bdjq?L1DH&T$` z{o%Sk4}AaJBPfxX$whaGmD?@H{*JBjEYwQ{cMq%yaJRMph;G zFL14oSL+$a>+432fNOpHB)IBE&V>gSSZ{dB{7!h<{Bd}Z`77{J^JQ?=jckCcZe$l+ zbt82z&pr>T8)*(#-AEU>>PD`Ct8U~jxavlpfU9ogO}OetK7*@nuDX$qaMg_z!BsbMJ6v@m{YOKJt9H z>PF6jt8U~9xavl3fvaw06kK&9Q{k!`c^|I2k+0#Z8~Gcqx{=yfX2+|#k>la28#&9l zuN&!=;CH}tqSF~X3Rm68Ot|VsmcaG=uo< z+z(gXNEuvpBX7f1H?k70x{A_rg^-@-$p^BXi)Y8(9Na-N^so zsvD_yO?F(W8#xWGx{)4m)s5T^SKY`{aMg{>fvaw0C0unQf5KHavfs7Y?N{AMW4P)@ zI>1#oaw%MOBPDRvjf`{d>qcHm@Q>iz?E16Gd6kr5#jk38;<&swglj#$JzVt%7f_t8U~QxavlB!gZbx?3W#{>PC)-t8U~hxca3RTy-P2!Bsc%C|vzD6Rx_E#cPF6kt8Sz}Ty-PE;Hn#W*14}6nUmn3!o%EX__GDB=fG;$$8q_(kt5;C5440U zk8u%Pd4mCP<->==Q<+u;+%Jl@H$zSN@^a4cYN3AAT%cd5Mm2<-;$B zr>&j0!aJHj3h!k83S9Z{rSJlK{f}_v!}q`o?e&KiXUE&ayqR-fH*#)*_odr9&QQAL zhbPgaW(4!-HbB3n+q&>hx~&TzIxvna(|%hQZb7$!-i2=K!u{c@8yP{j`h=-;t4~-! zw}jwYy48*RN4L6>LkDHYRmJK?S~&N0BNrt2^>pj6hw0W|FVd~Qme8%gexh4{RUaI; z-`9=g(yhPJbnCCabnCB?boC3}`enZJAZ3HU;@7$a-wn5LgQISY;|h;s%?wV3D-YZQ zuIuLzxUQd1!gc+88?Ni;7jT7E>89*<=32-{!}HAB!*%`a;k=R#Uhy|22|kW)<82n* z#@okq8*iKG)&YCn9LJSukBzrRbh|#BPPg%P1>HJw2;IipSm(ZOWJZE7hO2Jmd*{AB z{6e_y*Vn<*6=OF183ykZaWDz4`|P`L-A~uRi|jbt;eE_&-I^V5v3X;7 ziTN4uQu8ACaP!;XqsOhWz&zczBFe;6RU+?QZ4o~ot;AQr{=fhR+(I1|Q-YyslSG`9W zT=gDr!By|^Ib8J~+ns0XF07rk9*E=h-k5Ip>oe$9?@>gzdXFJ=tM_<}ZuK6o(5>EM z8QtnVHqou#qw0g%ajD*;K3w%4?cl2S=m}T7$E|SHdprtPy~k^C)q8yG+}C?-Nbq1} z99Q`IY1WT*;krIIgRijhb}n4?9@oINPsm+x)q6bQ+}C@&lHkkWIoAG7@Y?28ABy7* zk6+jP2zbi;6z9I)qicc}!}Xj$8m@NEgzGu~W4PMC8LsF2Di6nT`Ff9|61> zy?!dZh57sNmge8UmH+t*p0?NTKRP?!j^@Y1JDHyi?_z!xyukcUcvths;f3a}z?J{` z$hpt|Y)tSw5CUY9$Z4V0eTbN=67T0Hotp?Zu7fkbQ|a!=r+Hr z@{P8}x=8w<7HGiA~*ZlD_xaN<4I`{L$ z{mSBay&p@r&wEF@%^$Cz+x+o1y3HRSrQ7^*7TxBLOX)U${E2S!$12Ze$EEpW3aiRSd%!h+EP-qOI1aA)M#BurguW!s z9dAeTCh$(?o#0)}uY?zv-vRGx{usQ_d=^~u$0g4F{Bc8q2UFv?{QR*V-R>8y=+U1C z7t?Kk-blCS!_joRUC*N1^Wjpu4fG%A_Iy}*T6SETKc?t5PdSaQc?#V=NH^1M{y2_q z^T%0qn?Ejf?&pu261>_Aaa?}>cr@Mms{`HotB7v>btm2W>uI|6*Ic^w*B5kMn5Lus z)?W?j>KD58OLymf{&-7*KMJ>SgE!!6=1RD(pMS!2{XF2sI4(bbYzEi$^8&c$kJrOf z_IV!<&ozGso@c%WuIuNY&MT$t#TCD5y%e|K`*C!eKb}Rm@pd)c#@pR=>wstJHs0Q) z+j#qmZsYAQx^?6MGZ2@Jw-cQE`D3R9zY4B#awlBl;R(3L9giF&EYGGB0mp4+PoipoB2?< zzE4#KuWj%97QEQ}bNDPf{?G7Y^Znn5-n(vQw?&tf{6MP|D*MaqLT?hVy>pF1A+&JFweN%QG@}2wn{<#U> z7p~{J5pcD0DqPQXAHvoCAK;o7?{eb)Ds>-VQU8Lsac6~Og9qkeFG&*(n5zGw6_T;DUA z1K0OWK85RhMqA+eo>A5Jvg6YCjE-<#LxZ+r?6ykqOW^9q!Ep8CXt?@u23-BP*ty@I z;kyLi0oV7?_nQ~T>-T491lRY_PlIcJhKu2W-N>(pr_6`J)8=LHBJ;Q5rRJ;P+Mi)7 zT>CRrE6CS81lRry8{pcXA^0FWUhU6tC|vt9 zoDA3g3&bUK5HaP80VCVZRaNj`(?`Rz}*_Gj3CVH~gDpW!&?54-u= z=?UHguKgKqf@^<Gc15>e}-@2+MnSsxb|n*|HC-mFfRRfJ(|L`Kf}3j z?ay#6T>CTJ4cGn*Pr$W5!<%sJ&#)4%{Tcp%Yk!8?ix8LX&(H*}{TaHzwLimkaP7}9 z60ZFjo`-9HhWFvxpJ6>*`!iHooZWuy&u}zc`!k#c*ZvH>;o6^JC|vt9JO|hQ4DZ9W zKf||h?a#0auKgM6EXj^b`!h6$Yk!7w;M$+zD!BG%xErqh8J>3T_h*=$;Ge^{+4bjl z=T%aM6~FfTD2~f}6S$ryJHz$-e=S`1>-*q(K7SUj{Ta&PdJbO;*ZvH<;o6_!kfm{4 z{(JPtC3pw8z7KvGT;HR=5w8FK!f3d@NB;s`-=kju*Z1hZabC^!*Y62lV_6(;_({}XB={L{ z&G)Z>>wbMJT=V@$;F|Bh1lN3j5nOqU^>D4@?1HNc4q2WZZ*CC%oCvpRO>iDu>o|Sj z`F5Op;aUfO8m@fl9JtoOKZB?3_*>x}&1-&=9akswqv2i5+rbOWFNJFzd@#JwUjGnW z>)_8j_v_&AC-}E?dw$zVw>;`0_8=F&EOY!Q{Gd7A2IvKJTjv@;w{@E0Di|DovK9Fwf;1AJl9ekQ|zYe}I!M~?l ze^vf0Zhz)D)?Y`_t-nsCTYp_fxBj|~Zv8c$ZvFK--TLcWy7gD^Iohv&p^w-> zhoa(F*90E~w{U~8aBF7p3S8IE6>wcYe}n7#S!-n+SJ+NnKTm+``gsmqq1^<}wU8&k z^UP<%b^To7ypj%H@i)IDc+RT0{h8O>c*~{Rcxz9$@pd`gI^a&ajkhQ0Hs0Q(+j#q& zZXNj>-Nsvu)p1<@d-U}aye+(4#W@RqE_S|GDnpt7b3=lUfa`no)8P6Z{bIPjN52-X z@6rF`+<%Y0))#TS-t*uZ{~h2O=a<7Zo^OHcR6GLL_ zTbj>s?&}#ACHQ)HnH}d}xau70{2a#{9zPZRGdK~hI)^TB)j9NrtIpvrxau6rocnr) zxe30SZuj5c=~m~k&*nI;%<-+x;TXErIdq^~okLH$)j5>Vt!Byw*Fl}I}cnMtBfpKtM2WG)_9asWS*?IWExvz5ww#IRJuLrls z#-J@+?YtDO=k{CSYX4(!J-5H?+}ATKP4JD*eLiPbf*<^A9B=q~#nlw9xXy+vt}Ee+ z>vp)}dK|9)dIhfe$TGP4@khAsca?t2jw{dl{YbdxBQ4>&{$B)dVaFK&*L`6)T=|?y z@U$K0U3f?HFX5fccfh-t*V>jHZ-IGZcvth&;f3Zs;mYUS?A+&b#w7R*x;9U!T#fzkZ`zf9?Bc99QOjt-p?=TYq(? zTYvSTTYue0xBi+zxBgl|SHIA$U#f49+aILtLs9W7H^Do=E!^NLxHU7l8?NhT8C=)T zd2n4n*TQxE+zr?D^Y9(naVfMj;JFrZUwEGRP`Iw2WzH+<;1z%KPJ*wY+j!efxAC_B zUvc|0$B+IQoItk@IFD}QtsmXS+c3I~x5;$t$a!=dZ(ln1^TF*2UiJMZ|<)6eZy0xd0!KF=W5Z3IR3x*^`Vs8{H`NBZGI_S|DB2Jo%{LV zeF;7huJbbouJf}3uJf}6uJco4cN|yP9*y&c@cfFH!=KaOEh7#taqj1X0~7o~c$ppN zIk@J7@5418{2H$L;9qdf2W#z#FceUfhT!8hnO zAN-VV^TA)}HXp2EPp;u*B-2it4>q9NeDE~7%?B@qYd&}jT=T(4;hGP=2G@M>6S(Gs zTi}`x)~pm=&=i;EgAJYg`C#h=zZgEv`tf?W=7YoGE23c&OonSd_zqn2!Bue02e&!* z^T8UG<9NL{fa^MN8eG?bOX0c>42GxdJUryw&-=YBqTQ-Y6j?&pKgC-^+L;`$PoT~W zXKse8A4kJ;t$$yH=b0~t>v`sTxUT>I!CTmI>Qu{)SNDZxaLot1z|(e|YvCQu?}c|V ze+J&g{4IEa`AT?K^R4hg^BUE&#y7B>KD58%Pi+X%03hozm_NXFK`Pt*mtkE{o!$}nZa>zT|Ya+b^YuM*Y$G*T-VQO za9uwa!WG(Y@LUV|z`e8EpJ(0_uIp!K=aqEuiodxg!SA8lc$-MK@iv!k<82MyI^Z9= zjkkmLiQ~$&)5hD0bQ^Ey(yb%=(rvum>)g)=CnosYaE+5M;2IBqz}4@2?Hk7xzOTBV z5j?k|Pr{!$`^T>j|Ci={3@z*T4a7+l}mdKIqv+vRY5|85Ih-@nT_C_66Ii#CAk`*&^O`u^R;aMkw~!}a~U z5paF~ZVFs=s_(+}{kt#V`u^QExW0c^^WZq%8mVyPL_bF-_~~%<;}vlA?+ z@nz>epRh2&*TVJr+6mX^YyU&yc*EoC^VI~Nvh&ahZo@OU8lG>jzYE^d{Q5fa`-cBZ zpQD@MWi_ME*MoJlUoRgE|KDEG>mNNd`}Ojt;m@BDz5epU+{#hT_Z#OvANW^-*FGwaH++4WwWl#$`M@*b z$_Ey~l@A;OS3YnYJY^?zCS3WzPn>7+Y}U@r30^G~$CY`#J-?;smJe)0w|wBmbjt@0 zq+334B;E3XQ|XouTtK&c;99uyfxFpJicJZ0zMfQE6rJ|EaL!Oww5e;ow<;cDjyxaNJ+;A;OuxaNJ|IrsU%|0VcA zxp7?c-8gBS;O*h1c76)!HlG?qxB2x*xDuex!%Ho{F&`e-y7qVQ0`q_1UCsADIy>HR z=1t)%%{x2)*`1$W34SZx2GAIKIy!ML(90wLke-evz(3I2NB*Dla@WoS8^!T@Zw$BQ z1nuFaQFDSqcwqDK8{nnp55NPv&OZk)HGdx-*!=xlc-s6Q=QUH-$ckV49uvpwJw&z8r1f+Lz-J z_^x}S^M4au`*MtdYhR8TaP7;n1g?EKHo~)_g#;~%*8<*3~x`#fl0j>d59%h3_8eL0HY+Lz;2 zxc23E46c1SW;yr!a(tBFKf-gO(;4iBYhR8!$H(!8$KPi6i)L^=PhJGqz8nMLbL@HJ zLFeKA75bT+;P1e-FUKml_T~5uu6;Rbo)E_szOVM>Xb9K79H+vyFUQ4j?aMI`u6;R1 z!L={P47m2?SOnL;9P8oQm*anM?aNW8X?DEYm!kz-`*K_e*S;LZ@NKp)$4I#L<#-9M zeL0rFwJ*mnaP7-cJwLns+Lxm~T>EmghihMstKiy~V<=qva!iG5Uyg-v?aQ$du6;SG zotWKz?aNUgu6;R9g==4q9&qi;aSL4ga*Ty*Uyc{y+LvPiT>EmYhihMs|D5}MISy_X z$Lqa0e4BmXFK}KZrK>;?T%X`0;mT7@hbynR2(J6}2DtKmm72%x58I=CIZ|-t_u9d= zFURF@?aOhqbH6Xgg9$zfuKgwE!nH5QO1Spr*ap|W95q|S@rLcuz8nqV+LxoP^J=cY zE=cfe;X41NaGlS`;o6tuHRsjc`z}rJ4RD>eDksJ9hR4yq91Y;wm!lnA`*K_c*S;Ks zo%`TBS+c0TWh+jK3M z2-kZ09C*GR=W}=q^Q~~@rE^+l$EA9t2Jo~U=Tvw{^X~9Y<~PB+n2&-Nm`{gyHD3TP zH2)T^dZfRc`+B7PTgCBuKb~&SrDxMEUvUlH@)Gybqqhs5rQ7rByL78J_?8|my9NKy zZJ^g~jkv7dpebDSNaxZmFV~-LbuYu{_CcCVw|w3EbgM`DmacrAb6<~iaGN+T@6G7e zUl-D?ziyyge?3IE{(6ya{q+&u`fC&2`m1VNwBP#cc)Imh0bTt zj&9?v(7E4#562|m^N zPZi@wKl2j&E4b<$w!_P8fF5*u99MY!Y3429FPV3PueAK<&G0qmCl|!W5C50ya882{ zzbCp7e0*X2dS9ROV}kF7E8aR6WgkcJ=EF5#J{zvOj^1$1qwj{RK4&6a^*M9ln)j`O zt3Ky9xaxCicFm4U^Yn&r)#tQ@t3KxvxaOP1aMkBL09Sp^WVq^c-f`~hbJisIUvTx~ z0o~$w!{ewQo5IzPUEu1+E1ml~oRS281fF9byqDm$%|C$GHD3#_2qE+HFWf#}L7j`^ zc*Az)+v}UbTbiHa+}G#yPVl?nWpT{;TRiCo}uKJv{aMkDh2UmSgo$hg5zCP!K1n&%=X8m|2T=(VM z;aX359IpDDS#Z_oEP<;&XM=NJpYv~mA986NZ}@s$2b#fk9XJoJ>%g_}l%0pWo%{Nn zi3$ETJZfDKd<9oK|AA{BROhlduJC=;{uXe}gU)sC>vQ@h_`S}3ea?ggp9L?q^RtL< z^NaO#n{WOL*TnDO9&x;3dsLruB3$)3=fYK=b1hu;Ii+yb=S+mFKIbjxzCLF~f^VX0 z0QHRH${Z&how&O6^2kr3+XM84bgR#~&bhC{xhKIVz^ysKEO=?uoL~_=u=~z;@KW=g zaMkA=ba{Lp!gi`YCm*i*oGx(H=UnT&X382_@$2>k|3A9!Jl>}A{r~tflN1{Hkc~qp zQ7ZGeiIT)2Aw!M|DRE>j)lMoYW05405|SxOgB(SPNJN7Yl@LWrgQ0$B?RCAs>t3(N zZ=F9npU?BLt$knXzSpqV^=3cgxSP*;EymZul|%Rzt{lQ~xN-<3dWQA-@2h-H6}Xof z)X*57Fz*CUnh%6$n?DXunZE>AKIdJy@;RTwmCrc}S3akBcC=pQb28w{=QM#UpVJwx ze9k>^<#Q&&mCsoSS3c)Mxbita!j;eQdPVC}KBpX9`J8%i<#Rg1mCwn6>vP9=xbis* z;mYTH09QWe8@Td0zdP>cbI!Omtk?AnxQ>e?T*pNhxQ>e)xV|^%ak%n1bK%P8yaQK0 zXD2*68600n;mYR}y)9a=@;MdY%IDODE1%O2u6#~kxbisu}|BK7}iv za{#VTvv)UK`J6}L%ID01>wfZmxbiuB;L7KmaNN!3 zl-wc|<#SrVmCv~au6)i2xbitu;L7JLf-9f19JS3aj3T=|@# zaOHC*!IjTh3Rga78(jIEKj6yeoPS4j{L1Ilf-9fX5w3jB5V-O=li-CLrJ@?CjE1xqFuIGD;;mYT1hAW@5&v7@Ob0Wq|-4)j5zg{_$ zYH;Oqu7)e0(-W?I&Iq{jIaA=u=e+88A!ojFV|*uE`~L`B`?GNWuwH-r%I8#ays-1W z4PyL8xc1vUaOHC*!x2L2c^AQTA5ssl=PK>tdaiO8T+dY= zh3k3IY`FT%@4&URcEB@iUXH@;q?Kuo{v?hTmQWc-TLo+>9)`xq+9=e7F_w9cj@+A?rXZ`K>noLfmHgQ zXk7&?pHq`=`J6U%%jfiU+|A*PiSapfo3FKWo3Gt;o3B%Jo3FBi!@APrvH7Y`xB2Q! zxA_`OxA~e$xA|H_*SyeeUXDBNCG4Qc`*qHcaQv=c0k?9!4saW$mjl=Nb0S>l&&6<^ zKexbj{`>{5^XC~uqvKa;wcr_6au;}}`4G6ypA#L=r;X?RnO9@{Bf71(ALzE;ykX(^ z)7!W8R-SGX(3o!P?Pj{Iw_$W!Z&T)H}{GH-7EpN;TV0ek!4x*mBWqIK!I^FMgDZKp2$4)YH1 z9P_*3Bh1IbQ|5EwW6f8?Cz*c*pKg8}ZtVrHHQ z^CDdNoDbm2=j?IZ&F7qq@$>Hu>vHosm&N#XaOE6sgU_}F`Y>GioVjr2bJoF?&)El8 zK4;Nm;rRXkr5w%*_~+Au6Tz;r;p^Re&L1&;=Ht=VtKKSb)!PKF&&!?R%5@Be>vQx( zxbiuR;L7KG4Adc*a3^8vW>In&|F=PZLO zpR>_%KUbrlpJKe=6JcHc>ot!FxaP4jT=Uo!u6fLH+|B1a8soF!MXi9h;U&$t!7nub z1)f)0`lr~FVZHu%>~Qp|z-!v;lkj@xH#_d;a|Xxwc=&AF&MWXecHa8{u6)k7aOHFU zhAW>_YJ6C)o6orvu6#}#$J6;18)x4bA5FLWndj-2&sjyce9m^d<#T?eTRx}Qgs`sk zI4z%(LAQKPl5Y8&?r`OEM#7cPc?Pb0&PurQIiJCm&-n$ed`|I+(Yln+sp7bs&uJ9n zUEuR=9&_NjE{}t&pYk$X`JDIQ%IACmS3c*M<8D5u*rc#t*E8Tc4CO6aW|i{D8@IygHe0l0l3Clcyd^mzkPiUssh*eo5S@vsGH+%K4*B0Pj=kR=e!c* z@4-{He|FIA^TiRmecmiKC9F67zE*H$xbito;mYT9gDami6s~;E1i11!i{Q%VY=D1h z&l7%xcc~rhh=NZ=>-w^5;1wKqb3S!qye&NuY^M)B8TbSA+`yls+l}}ty5)SfIqv3s z4#fC>a2t+y{?p-pNat{Z;dnLRo?X9Mz*FWu;mY~k3s=r(8eBP_<#6SEHalJ{VS~*3 z^?i(=cHGVRoHI47*Y#>}mkt~|qFxN<&Ez;%N%7oNxrYI_%+G~WTwHa`MS znV&H&TCZ|GmEg+xG=MAT(+RGe&mg#RKI7oZ`Md;I&Sy1TIiD}#%K03JE9X=4nP|Pr z`BaB1=hGUloKGLPaz3Ns%K6NKE9dhzTsfbeaD9IH9j=^D$?4I$l=Ha+uAEPExN<%> zJMQLra$hW;5sgL!jeUx*wGDsSQ`or!8DLpS$47`8?vd zoAY@g#@~S#4R*7)9j=_uVYqTWMV<@m^50kYrI~Q$e6E2j=acQYo97u38!az1~o;h&keAdF1^VtPg&gW0Kaz5wJ ziq@r^Pd&JDK3(C;`HX@q=Q9JYoX^{E<$S(|E9dhkTsfc8FGR<$oX-_-<$T(}mGij+ zuAEN_uAI+wxN<&kz?Jja=D3^l`8mdm&JOGHUw_ojKUEzskTA^qb#;vQg6nzLgK#~c zoC(+U`YpJgAMS)J=W`sc=Y;3Z3G4F5ubj_SaOHficiheSWXJe$xbiBK;L7XODxc2`|aP80jaOHf)I$qd$-`O$#7F_%7OSp1A zf5DaWId^VYum8Tv`P76f=hMn@H|KL}jNcD$>IFZ~IPT_rmd5x-xN<%R;mY|Gdnv5T z-@bA_3Al1T4IFoKKJ8=tPI&Nco;L=r`;b|1J)e0KuIDqK!S#IRFkH`_3cnoI>yKZ3 z>Wc8ZU6KB22+uI@1h-qM#aOHgdf+uY|rRPQKZDD>H zyp?%tcpLNE;aTPn!aJHzhj%ew4p+`+ljCmA=cgFY|4LX_`t|l4<085}_ijkHK7JQ^ zuvu>y-JY{ep<5q+IoB$GwCd6nVc!#`rUEE7w~Ew_$oa;W~dFhwJ=#?yF&4{&;l$tOeKk z^G3MNpE+=qHUpkvCBFyHH2)f|^XGBL^J(LGf2P!;aQv>B$K9Myix}?#*E$&v*Lrvgu6bVs*A#pN*F5fl z>w0$*uIt))i^F>Tx{`Tw>;Ke*w+h(19wMS|p7%%6KZD^J<`dwV=JVk?A8vrxwAb&4>wdD(^62>M+3PF9bwAk{p0w9@hPN=! zfwwY$0^Y{_C3u$k8o2H!hph?6@Bc65qaJ{_ogbW7d*+6(_hpZLzx*(`cYAQ6f6;OG zbIn^Zz6~C{o97*dYaJF|8;-}{zSdy{xYl8PxYl7uxYpqSxYpt0@PzH>x$q40_uyKG zyWm=f$KhIsCEt(Mt94inu65WFu65WGp0sh^3vXdQ4X$;#9Ikcv30&)NKV0k3`yg6Z z7kl5b@b2bUIqrV0X&d8r((OF_DBbQ`=F;uHC6^uy+uKdI`<4@QyKgDGF03~_e!Fj} zO}B-91KsXh`os0PW*pt_pXbx<{&^kU4x~MF`&{!c-9FcpT_3GW-*;TwarbjghZrA7 zxA~e#xA|H`xB1#gxA{6ixA`jaVL1NuIBmYF&~3h&(QUr&q}zOrr)ys5HZLDI?j>yT z=l$9nZI;uJdOPxXz!W;5vWKgzNnI4qWHYFX1XJ|Ay!|GpyvQ z@J#dOaGgJUIG#@%&-*hYV|*&z*4r|=t+y?7TW^QxHUY&y4(m#f$JX1$bX#vN=(gUn z={Aw0=(gUbIqvoW7svQVaPK$q{`;yAco|%Mz*cbe0eivK2OI@g zA8-a-eZW<4^#QlR)dxHbS0Av@rf6O216G2o57-p0zwh4zu0G&>aP&M{V4X6%RAFvHveZT>5^#Lcr)dyS-S08XITz$Z!aPb@}5_AMjGR`c|#s>I3$Js}DHF zaW~I4BgU7(mFL+ASDxp4xbi$F;L5p`-Wt}M9*+WuAEz`&!Y7z=XNPvIky&Y<=lG0m2(>fSI+GjxN>fgI;L5r6fa`d<7p|P!GjQeHmco^D`xvgA+aAZ=oZDY9 zUTS+-um5@-7d7BIE?UBMT=ak|=Qa$koZBS0a&GhC%DH_2&rSyCxNqUgxgCcq=XU1j z(R!70%YZBA)(EbgTSvHZZvElPxjhP3&TTeaIk$J=%DL@;E9Z6$uAJMMJHmS1oLkix zZw}Yzh^}zu+y=vybDIEH&TR=?Ik(Ml<=hT9UOewQqMv*_!@69r01sZ}dG+C{t22DV z@4-6^c6@%`aiO2_F+Lxjcy6;qZ_P+= zzdJnlp4#b8Jfq-=>RZ!36Q0_4XZn-SyYM};3Z*{@?Sdz}%uf3$`0P>*(*rO2CC0xg znAlqI#4W|rpPbsllfN}edp~&gn4Gjf4o_Y1QrhRi=T{7TjpKhf`*~-KAA@Ti&-yB? zE4`g(XQuaORmVSYw%;hmJHhq$4F|yW_dp+q>%MC)+-n(p(0vcC`>t=`$!WpsPr~=S z7x?*KhxM*?>Z%drt>ClmzNjZ$^$v&Y{&Nakf4_AhTz@ZhJzVvE3s+r#!xJUb%ik-# zD_U=MufQ*d&t4w*b?`j}f(HkE;Hm0?KLk(Q6!;79-1`H6+wnEd{@)Sff55f>&-x~; z%ioUn|D|y4{}ynq!)&^S8ls>jnGy2t2tf@Uy>-)}{S?spIRM z{nj$Zv*G%C#G~NapVQ&`JhdFI{k+NXjm~)X#dyKpVO{>~b^a;u_%F_OYQ=aKJej^) zcwT>a%KQG#2JK(yH zeHflf1O>kc&oy5QPgV?GzYCsg=eK|0-X+27FW3{UD`|cOJhx`>`gU;diooxNr_9H} zz52oHUxL>(&;M&U9{+!}-V{8DJOf^5ci=6Lgs=A{+xmdr;VJX6j=TNA7h-%BJa{+H z+XmPD+hMq#Zx=cmj?;f%TRvU|xSnq}fb02oN4TDE4}>Rz-RwOM&oF-pZp*}53)l1Q zU2t0t-k)&w2TT4It+$@N@1=0{2V26E_WEpi3-eL%R_4>;ZOoU$v&=Wc)gSx`-o;+; z9gEhb{$Lr$-Tq*$7|)^yw=-UUdT<%>9;XMFUvC~g7@oI|p1%9c>z~u@`M>vjSeM%$ z{2$#G`c-s${@($v{$LK>`cM<-)`wb1w*%=zy7dQtq+5T``y*PH`h)*--0ct6i}9Q2 zHeW;OHeXZdHeXBWHeXxlHebKcZN7>h59>;g-}*Hd(`~-8=r&)2>6#b1&C3GEy@U=5 z&-*CG_ra}PukfGY`2FqJFue@8&YxGqb^g2+uJh+;xXzz*;5vW42Ulqa;2Bo(nSVvc zpJ|>6*ZK2m$Mb39d4Hy7jNeDM_4W+i*4qlYt+&tUHUYoUZM~KFJFF``PFru)=(gUj zq1!~>O1JfPpW|-saY~H83fDSW57&Cw3)j4#fNKiQ`zNf|ACKnoGPtgH*THpNyA7Vq zn_K_q0eGu`y=URN9<6}uy7MVK+qQEEeusJC6VbYI%qzl2m^Xr_%sa!!nh%0cG9M40 zZoUAn+~Yd9a*sd4m3z#8GFq2%j~Bs}d#npr?y(bGxyRvf#y@u4 z?St=)@e^?M!OuAr*6VLaeefD^^}(-&s}J4_u0HsEaP`5ThN}<01g<{#X1My`hv4di z7djoSOMUPPaP`6K!PN)939df)J#h8GC&ASRUkq0td?Q?a@Sox8gP-v)>bf)NYgdD- z58eW`lkrKKSMs z{}HZ!-)Xp>lbn}7tk>Uus!Fg=Yrxe9Zwc20z6U&E7ye=Jr1?a6w)p~h%6uJMeeiGK z>Vy9QS0B7&foQ$zgI@|)AG`%zeehf0>Vpr5r+Nqba|&F2@Fj5d!8gLy2mcAKK6t@` z(Yn+JPr%g&ZvVuzxs}Fuop|D=J4_+l7&%kv%oXq>Vr3hs}J58 zu0HrcxccCa!PN(U0j@syTX6Nkx5L#3KLS@Dyl9bVz3PKkfvXSR)N!{Deshcug%=HW zr#Bw1KKMMi`rvEf>Vtm|S0CIf8rJ2HQ+@FNIqvqmYsGj6cyO1I_naTDy2ioP2cPG- z+Xv5$@m+BB!T*M+)g1>$B!D~A1_Pg7~_&~V&;1l8MgD-)r5B@1!eeff2 z^})|NBb+aPoa%#L4p$%i2DoQ^@V;>M!5@OF4?YvFKKQ$E^})Y_s}Fw6akmd%taws8>I$7XQP`rtP^?)Je4#`xoK^~>hK)qi{!uKTW?aP=R5gX_NQ>@&l9{c)-& z;_DoD`{3Czejj|c-M37EtKNlh-G8o!s}KGyTz&Ar;i|V}iLhRO{Hp6xxccBN;p&6m z3RfR|6kL7qXW{D4u7Il#z74KE_%DvTeej}Zg>|`pFvg>@T<4!G$K5`7-xz-wp0w-x3-FZrD!3k??|`chehjWYc=1wUUH&-L z2hW7758e{4K6p>K`r!A&)dznLuKUVq$b*R$7ehN}<0AD*<==f5CYR}1rt;H}IX zz}uL2glCx#gsTre7T(2P{~}y{@OK<{``|lc{21N8@y`1>>%y?!^meSzbt&EYT&?J~ zK>N^x&3dEh*5`VWZhfxRbX({<=+@`@1Fk-J=`zu}3Ru6jCf)k2ZRmC&-9fiL_@i{| zgTF|(fB$E-<8B}P>lpuwZu50P*|4tkc5J?C(QUpu&~3hQ=r&&y={8@l(QUpyrrUfS zquYF)_dkqZ^Fp_Ix!!RvkzTUt|MZLT$KY13Hy>`p^ge{^{J9UV^Jl?w;rRXW==_-h z*ZK2mxXz#1aFsR=o?#^~hG&{@gzNmd&+&ZPc;27MS3VrS>*eXT-s;nBy>+77dK*l) z33!Tb>um|$*4rm^TW<&GHjxD{LS44r$~*4%!E43%4REcKzHqIFhvAy{nQ%?Pn{dtJ zR=BQrhv2%d6{--{>;C&c33#i#Iro1W!gW3B1lM(E5Ij4*70(+Fzr%b!JjeV4_z3ge z@Ra#K@UiCSB%<|BGQS)?-TZpE`rv)w>VrQDS0DT(xccC^aP`5zf~ybyH(Y)2G8LnB zsSjSqakmfNKF05I-0g!u9OEVvO@s}KGuTz&9^aP`3pR0`|z$D=-YdAR!Eb>QlQ zw}-0_J`k=x_;|Sb;IF{d2VVVq$W>+geq0#_gWC%F3H`7)y8S0B70Tz&AX;p&6;hN}<$7+ihum*MJzuZOD-z7MWG zc)lvp@v9GB9VwaMs}H`? zakmftNsRvl*Kv{m(y*@dcFF|vRTi$};!3#s;Mc>|2k#A6AN+o}`ry;y*~wr$%i;R_ z;2YuUgYSi_5B?8aeehD%qx(U9@Jrz8gExb#58e%~KKM|$`rwn{>Vq$Ys}KGWTz&Ap zj=O#ElQDiljj&$-^+ki->|G95AG{S@eem1h>VuDgFAd(#dlA0Me6{0lAADzw{{h!? zfU_+-jwx~jv~2XE!L+Xufj#_xx#4?Y8~{>2Ko`rz9fcl+SK#dxX9!@B&}s}Ft! zTz&BNaP`3l!PN(!3|Aj~DO`Q<&*18VAAze6UaV$x{OW^OhN}Vxlx zs}ElAs%X9HgI@$!AG{%4{n<`%^}&b0)d!#GxZCeu7~>zqwf}#BYyW$-!n*wJYyX#l zYaP~xYaOcx|});O*hspLfIc zdFnB^_VaAV-G2AmG5!@?=bvMayM6Ftb;5dGuL8H*D6bhjW!L?#a9ucu!;^MFeHxx? z{u*3;@QrZw!S}<}2hUeGT9^9Z72xWFH-_u;T^D#N@1DT_84k})q}iJWS08*SJlD=| zTj1)0ABL+BUbtSgF7?4P;Oc`nhpP|X6Rtk^NVxjoPdV=2E1lamn6T&IKiwPn?e)WP z`j6%(^$r>U55iOC&%txd--IX4x5Bf`55g1X=QRk&VBESfglNt<0;y+n6_nXPI|}tIs|d-o;)&9ndRV+`4o-kZz<~pM4PB`t0NB)@PsZxZ7u6ALHNCZNBn14ae{H*(=a(z8ceQ zzPizEzV4;ld`+j@e666{e0@u|`SOw&zvhK*^HRrgFJT8o-mi`^eh=Kr^`3&;Fui4P zojCFo6rN!vKMT(^UkTUwbF1U|wDG(@b2!F} zHV?<2e!Z=?47!~kn$c~&-9onscz|x}Z3f-e+naP-Z`oNW}T+ek&wFviv zza4$v%!KRv8Cy7B*m>XXF+LQo{q{6m-_Q6uT;I>Q6|V1RJPgcf?z=nPkmVklfWiivRLC>Fq#qj(>#9L0BV%9L1$@ExN;QT;L1@9hAT($1Y9|a z1#smk);sRzD87yHlklTK8u-*K@WP;HfIX9(@z89L1+_&o1!$;R$oE zU0AQ1qbLKt{lY!aOEgwz?Gv|30IC{3tTyh190Ui@?}NqP4y1; zXF0fX6!qcCQFMeWN09?pj$#5_If{jFy$4gzfauglm z%2C`6SB~OQxN;QFJMQKvR>b%gxQ>gT;W{qzcL?k9x3A-(EL=H?tKiB}+yGaOqBmSQ ziWFQqiWzX_D3-&OqxcxE9K~L^auol-m7^$iBld$mfV%{)9L3deVM6ID@XCR<8F@Ps~G~PGMdCc9f&24_A)jX1H<`BjL(XOouB+@fKV;iZ9^GQTzs1j-q(y==hbRs0vq( z;u^Se6t}^ZqZsA5o1=It#+Se~kDK7iQT*Vzo0s?}#?R>z)|>u&{q2JT?^3w>*Vn*x z-<1tl|N1_-?z^6atFOHZuDro^$KAZd&oN%;=CCgR^|S51r5s%SYV{sT`S?rQG5zlj^Z#}If}wvqxC9BQ5mlOeiOKI6y4#F}@bA^Uv3gyLpMP;gIp zuK5FS@1Wx|E}+23L;aTDWo)z2M4G+~@fFdFw$x zlVf~7JY|1i4LumP_Z8jxdcVUxYp|8b4(s*Dld`_*C2-IBr!C=G<~`vZ%}2nWHlGIn z+j z**|k*{2jQ?|DVHk{{IE8^MB#n!g~Gp)%m{?T-Vtq@R}2X+PcAY{T%_7P|_ zyBv9+!)w~>kHG7hm*^AL>wkt;j_y48wBbQRy+z;f_34)Uoxy>c4WHdN@KNww%f(HF z@97u3ela}P{6qL`^WE^2`5AYF<8*U(6=S>sT+b6a!ZnWr;L43W2G{(~fh#xiE?o1z z6RzCIZ}5c8WAT2`dNa(c!nIDWhATJH1FrQm0RYA zGB0~)wB9!6wcuIi?cmDY-2v}nuOAJ!$9~>(j=QuZu52S-Cc)HEk0=muD zHoDE%ak}PZ0LE{*yGtGS5_VAJ{kks3`@*eUZ!Fw~>CJ=d{J9>k^XHFnoj(f>49D+} zQ|HghaGgJsaFuo^Ji|(!0M9gE2-o>@z2o_`@w`8?H^xuXZM~Jr3F}I4$JSdNx~;bx z={5m_>9*b`(rvvhqT71gK(~qfk#6hll;dvhuGFBgF4r^R%8xaJD|gowuH4-)xN>(B z;mX}DfGcAe}U`%yzo6?z5aG|pIjcU++BUg3p?-IKF05aYrj1XSMF{; zT)DgTaOLjy!j-!_>A0ImI%jZLuj|#}$|JReE05F@t~}C6xbjF(!IejP4X!-Whj8VQ z_QI7%`VX!=Qu!g#dX-123s)YgJzRODJK@SBJqA}E=_R=GNbkdyN7@5d9_bWZd8Bef zQCE%NdrTU^l}G9hR~~5?TzRC)aOIJf!Ieka4p$!OI9z$83x-9_a;L0PNf-8@7-l%9@$|GF{S01UQ z<8B_QdyEf*>$sQ#*Kx5BuH)i;xbjH5;L0N%hbxa%;{LE+fBecLWx}(Q!TMD&jydj0V%4gRlpC480n4UYSHA^r4;@iB1w z_~p%ltFCw9$|HU0xSK~h7ULySVO{>~l}D-uS0A|rTzRBh9e49c55@Q#xbjGA;mRZJ zg)5Jg@1bz~{`)GAR1vN`QWCB_QZKmjNDso5M|u{nJkslM<&n0)l}Gv&t~^rl(b2k; zN6K*A%_B98@y>9~<6yY*NKZKK=8@*a_&ad*JGR5shx!$+`>vu7hxMl4w`K4kqcU9g zUCrRihh)Q*+qutiH;*(W#$SWaw)>WKaMk+_T=$=U!PQ?odrVlbKOXhPs=-xnbGYj2 z0aqSrI9z$8r{T&YEru(PvH(Yt76L77!3my&YP3N8V2kW*jTzRC9aOIJPz_p(zIqv3;7RLB`xcZoT z;o6_4;rcvv!DC@v{`+b_*L2*?Bejn4esGG2wZujV&kH9DUVdyaW{`tKgP4*sbIHx zed)p5c@NR8-|-w=d8Cza<&i#vE06RGTzRA-PlWaQbt#XOfGdyG1g<>N&5pZyq?{NZ zOSknio1P4I+$wr*;5+D+M>0MaGBq7E9P5^L~|!@hcs7^GMgn_-$~V|3|@f{+|lh`F}B7 z=l_jxU1xuSE00uQLRhaqeqDbPa6M;e0N4FeN4WAx1K_%jkA*9bGzYHxu6N^}fUCawkiPn{Eo`BzB-VmN+-U&X! zd=NZk{v>>?`8@a}^Y`J?&3D7?vg7>&Zx!60du5)A)~kQdp)Oqip2LmsY}-zM_#Ng? z!1eDrEQ0IbbNJZt{0S>6@7Iqpe%kTldFxO==RY0R<$6uW{bx(cuNhc2tag!x84+Z(`TdGN!s`8b%H0% zM?3E35}%Fn<#2yY{?8}yq5*q9!Gmf&?>~4+dwrQ1;rRXWC|6Spexbd-EnK;pe(;37 z{$Y5A`7C&*`8)9H<~!gu&5y#BOFZMbXkGQ}^;O`F%$vfK=3U_}%!k2SnNNYYF<%7F zGXDs!T;d*h7km8)xIO;&&Y2n3>*f+Ki}BWUJMZg6sU**ztVYc;276ImU<5ZM{vV+j?6}xAnG(ZWC~bZtJbci(y^qaoT#z zpxb&&(rqHU(`~&CbKK3RO^ESV;L5G#!j)V58m`>hA8_T?&YBz6>yJmdwM@8jYt7)w zt#yYhw{|aFxwYwV<<^$Nm0SA+uH4!_xN>XxUqW4{>!w#w1-No+jp53zb%QInHXN?p z+B0zdJ6dnTm0SA)uH4#haOKv{d^uW|a%W^!j)Tl0IuBHG`MnWi{Z+xeF9f*?SSKMZq0iotjqO_ z;79Y$dHzo$#|tFVl>X1nF+Low=QC5`dY-l%uIFQ)!u7oCFkHE{;`770{Bi2JRyDYC zYuCY*Tf5zHH@9|gj8BFupR*9IzQ+6TRFz<#ehpV{?HJs%3)mS8!g~F2Cd@0tlje=! z+2)<#Df2;a<<=gDE4MZWuH4#cxN>V>!j)V54X)f;@rBWPm0Qbzr+NqbvngD;weE1` z)`r8CTYCzw+}bj@a%-F6%B>xQE4NnY)o5MHtyP38x7HZ0jYPBEeEdL+E}=9Yjfe*$zc7g zhAX$W1FqcKVYqT@1z(HStK3>SxN>W?;L5GFfh)Jx2d>;&3a;GROt^AuE8)tmZG$Vf zcGz(@w^n#@Sg-4q;6;Po>@|QZw{|03xwQds<<=&`mj=V|UV|&Qw!v{Xx3)LN|AXuE zQJE!Sz5aGoS6#SrYd1RX=GN|x@v(5_)?S7yZ?Fcg+}gK}yScSfF<#Dgpno&!zh1eu zMsVfUy2F)Q8wFQxZ6;i~wRhmkt$hPmZtVnIxwUhbh4bQ%U%9o*;L5FC2Ul*bA6&V$ zN8!q?z2LZ;TYDqMx4|`!zrvMUE4)0c%gwEoi}5;e^~Ku4)vxRa*L~N+aOH(&!FAvD zE?haHU2x^Q{&d{Ut(AB^tk?BS_-wmxX$n`po#DFwya%p6>^Qjkr!T`*?`pW}`Vy|( z+A+9tYiF;B)~npwC2-}|u7N90)eElN+JkWA)@C^F=GIom_~&r#|6k$S|HW5^b@|)Z z{?CAG9VX#ghd0Bu4u`_E-lo8HpT8Wg+}fvb<<^eCwV#W>5!U7A)~dvK60UxCcewWF z2)I5^O@V7azv{S~TU#IFKf-nXIqkTcTRZp7uwK_|!jpD=Zv#)6_lE1jIU1g{3+fB- zT=P|M<<@q6UTe}>t+}aIr<<{X z!w=!>{YRF2tPj`^?&;q}aop_>E{gH>aNWOs2e)PA{R7wY?b1JnJQd~t3TKQ zp0w@X4R2xoIJ}kl%kVblYv5VtU&GZO{2i|TV2Pii^{PKu)p55!*eu3-(ESrg-p@$7 zJ^!CZx99(_(`|u%Mh}MV{X)0r|0VW^b*0B|&;K*&w$PJwd;Z@OuKwWtbn8PsN4GxI zn{+#nw$rUY_#55&gC!0`>ndRV!A!^9{$R@(zm;zDHJWbo^#a}IYc<{GYZu+->jd5A z>%xO!UFq@LeAS}ceD$E)e5L4`7rM>M8;*O4^pZ{g=kpjp2Dfs(bAArT?{CM3>0JTW z`7;Zy^XEXg&Yu(EI)5&P>-@P1uF{UfGpyt?hoa-pG_MWU`7_J$eA;;4pXndtW9hcu zUZUH2TT8d~wwrDf@GsrgTiL^5UFmV!daFyf^>!oOCUPL%*4yKbyZymAG5$7O{lV>U z^#^}}t3O!em#{AXebpbV2v>iwAzb~zj&St{2g21K91mB2@Kw0_gX`hy4}J$%fADX( z`h(~F8m(9VuEmvb^#`-y>JJWpt3NmnuKwUcxcY+|;pz|m3|D`!;F0L~)gPZgbaPKX}q{w-0#EZ(+TzUjaXwch2*F+Bsezk*4&2`p5V-^2BM;6J$fgBKkO>+;8`=QfSu>JN5@>$$;j$Nj#We#Xc6OK|l;R>SrAaR*#| zkYC{H4;K18tSdbpyMUF4C(P@>ljiN<+2;M=Df2OK^#^Cd)gN2|SATFTT>ZgAaPNL{lSai>JQe1r+No7)&Z{m;6S+ggX7@p56*+DKe!IA{@@JMIcJX){% zgSFu54`#u2yxa{}e{dXJ{lU3#^#|XDt3SBiakoGCbBq`KGpx&hy^f0nT*pN{xQ>e~ zxcYSAXyTT>ZiS;OY-v@KZgo;pz|e zgsVR|60ZK>Q*iYMm%!B@+yGa9a35U#!T%h0`+#Ns4(oNjHoT~vSZ{!KL=NTa1~t7 zb+^IQA3W-~+aEmpL|B*Wm&4T`YzJ3=a3Ea$!HID72baLrAKU_0fA9!g{lO9^G5$?E z(o=IWT>ZgjaPI;!^md+|nf_#1#&Nel zczKLp2Uj1V7hHXrQE=UNO@pg1vkb2Lu213W*Zc}sAFbHwuwJ(hn27O)@Y#0X(gCh| z?}Y3A^AWiEgU`d&A6x}jy<6d`>kwT1!9xE=>s5cS5?uYkMsW29Z-%RHH3Y8y;1sy} zgReR6_6Ik__JNSo zSAQ_S7d&9`4?@2#?dOXecl(3&V*Ez9`hx@E+MiFr^?B-Lxc2jVj=TNAFJt^KxXwQ% z^M&=geZY%j{Azg8uJ1kJDf1CZgKaPJK)C zt3TKcuKU5dA_a9ki+4m{bgV!|g0M9Xhz;U;4I5ox> z!*yS`0j~SH@8NpxeG;zc-sja0>+;8==iW8pdhXpCuIJvp;kJCd2jLlc`_BKF0k`Gj zy$RQI@6X^hgUxt{;p!U}t`n_GeZz`y^$i=sleYa%@D}Fxz+0J5fVVN956?3H0It5_ zH*ob0|Aeb=cy`^eUbk;pEyk~*r|;f8?^e3?1s{SqH~f=seZx}q!@AOaH(L*v z#rXAfo3Fd*HeX}uHed7THec)LHeWx`ZNBm~!1!&x%F}JWuA$p}^`mQE=r%7eIPN8E zr{(=x9pk&;R<3snZo~A-HVo_Xx3BYOeYnn_UEn%@j)3d@`3zj=&lPZ$wi}*dCFgGx z9cQNbMR1)z>pPxL8_)YQH^ulMx~;eIbX#u=>9*cJqT2-Qr`vif&^W9sJqPzuJ1c2&?KzaACJE8pgdgP zcTmUiLJ5uD^RAEaUT{5+y%(;}iId^_zJu2sFYLVU`WW90*M2(<*Y_QiYZ~qcfBX8r zgZglN-@#3Aec!=A$KAg0V=+D(uD86Pll^6{3=|1;q`F!g?Gc%7d{DBU--gi(R$Svt^-$JxFcMB;T*X7!js_Y z3onJMFT545zVOd*^@R&HkB(n`;VN+Tg|CIHFWe8VzVH)p^@SI})ffI4uDJ zw=X<6#>c_c|C$TebAxx_>VIvA=T;3S;1Jxi8%euq+z3}+I0vr2@Z)gxgI**vS6_H0JUba2cW=Pe7v2I_Uw9u} zec{t^^@Y!C9o-M=3)g_FFWeHYzHm>t`obgO>I+YWt1rA5uDF|9d>f&$}V4%YVK4!nNV*3*Q7+Uw9~7 zec`Ea^@Uf!)fe6YS6}#dxc=T~iMG-4t1o;pTz%o@aP@_6g{v?8AY6Un>5jX7;UzJ? z39fnE57*xt{m*f?FMM9RuwK_MhpT^dEnNM$Tj9Fz8U*0r~4eP{^=3N z-M(<)tgtTEE5c{neM>#K>dk`d{_`%l`oa&x)fb)xSG{k*Ro7>5^@R_?)fX<>K3cE( z!j<6a3pa(UU)dF|zVHaR`od2+?)HTj$M|Nr_Wypk_J6?+VO{?Awg1b*wGQjUwGKPL zwGIcswceh9>puTgxcb5y;OYw>fNMV&yfLiH?F(NNi}7#aI{*CXxZ4*l(J`#o^-JJ(8|Afxr|i0a3tSh@``}5tpiYP9nlFQ^FT4e= zzVIQq`oe{7iq@sRaAmmq!p-3NeAgYG%DX4)_AxCuJ1c&3D@@>^n&aA4(@~N`wpIl>-!Ft!}Wa!n;k#s?4KWF{1iPA?4WbI zg!QJklMK8%JvZ>{=*gfV(T8r|caU=2{l0@~G5#9dhU2Y+r-I>lyWpPnM~=Z$<|S?p z>rIcx`X-rhecwR~xW4Zo8?Ns=xXCGJuKTX*;QGFU+u-`XgHdpO-@#PJi#YSXEXF^DYaS25HIGHRhjsbe*F08%YaSaq z?tb4v`xw6qZkI>z5xDxT&%@PMT?N;!_#AGRBkw4@W-#qu@g8Bl{`i#}x$ExG{m;uY}EV%mSZ^1Rc+u`b){|eW<7abI>H^b()GFdDL*1?lD&hOwY%um8wnO|^EwB9!6SHQE(+rX7O>J9H=uYVA(+|hK$ z-Q3aZG5#stu8)W4c6}^5IIJtZeajV8q1ytznr`=9J?X(_y$9)*E0{sIg}$6_xq{E& z${ih{+x=dNAFx*bR@>6SaXjc&Q42kDkOn&G&cJ9;z5Kd0M#{Xw_+Dm65$ zE4_W2ugmE+UpLTgzWUQ`zQ)mQzUI+wzCNYfd>x}}UWQ@(HZPfudkH%z@_tFwBhyNYh>EsJgwkVCii_9Wfb+XA|+xAk`?ihozHsfgN8!pHy$o0G=zX|yN4w$59sTXNn>#9bUs$i}m%x=f zY7STKs5@M_qhWC6jwZqN?@=s-D|hq(T)Cs&aOI9p!Ie8IJ1SbQa!0k`${n?ZD|gfv zuH4ZWxN=8x;L07Xfh%|PEnK;yf8fd;mAM~v)u^97Gu4MHcXTscxud~w<&Gx6l{;Dt zSMF#lT)CrTaOIB9eIPo1<&Lg|D|gfZuH4Z*aOI9Bz?C~%2v_dtW4LlhKf;we@*a$i zU%8_T;mRG=ge!N{7OvdUosPS?qtP)w8-COae%^DufOEdu732TF_4)dOR9LUS9X$`J z1=o4CJzUQ#2Edg&8V}cbcoAH=qfK!2BYtw+%^jVJ@pB#u>+)Z(d_{G*o=dlYD__wa zo?A88|3l!O-Jm=PPnf?9Pny36&o=)Oo-+R(uG~@a(b0O9JE{y_SMF#YT)CsQaOIA6!<9Sw2d>=Fc@IbHRqp62xN=AB;L07{1y}CqF}QL^bK%Mz zt%2)!`3A1s(LZqIj!KV-)}`FhrEukrnmg|1j&6?e!EhZH6X7~8UV-blSOZt?=u5bA zN5|mG9i8z=Sg${R<&LVrvy;Jb*A%YYQD?YvM+4x>9X$$H?r0WVxuZAW${lTiD|d7N zuG~@nN2B#BcXSb4xud#p<&HYSl{*^XxSKl~8{;p*iw3*ddl#PyGW5c@q*DH5) zFdOGgrjvk2dS#af!-h(T5v>UG6(Z6uzjxKsUtjiydaz~Bf${pPTSMF#O zT)CrZaOIAc!j(JP1Xu3p5L~&VqT{0DSMI2y<8JP#UW|8yYaVmp${me$+|3uwit$x& z^)^Wa*C@58kYcfplA`U|f0cJ73*UcWBg=huQO zchnxP+|eMo_Vakh-Q3YDG5$VW{mR{N?avc%eV#gZVpx~|zS_?<9Cvd^*T#4sxXwQh zI_~C+rp5Sjc+xJZTi_}4{cz=u3Qh{^^50jvql$3ljvBy~JL(Kq?q~>HxuXei<&GA? zl{?x9*M00hcq$PTTyS!4$KBk~-7)?M-PX_Z^klH(R?>3=-$qXc*YP8C%N-SaI;_{t z9aV_&I&d3~cLO{X49B}2?ghi~?t`byr@=kzn=FGXceEL<+|fa}az_QHhV>Rp*dX(M zm5K4o9d~m_tztYIuJiv$xX%Am;5z@m3fKAnBe<@!Kfskc@}`CL`s3I2w>(_W8S27y zztkSC+|gZdUB@4RD|a*tuKTXH;JWYH23PLrFkHE#LeE6&Rqp5_$BQ`g-XO-iz%`FU z;F`zDaLwalxaM)4<8JQg>lpt7uFs)oO%Ln!x1)Y*Rk-@9&EVPYgZ@Tb!p9t6fTmb*S zzBXL@`5U-ER4zIJuE=H(iAhVB1eaLv~PaP_sP!!?hu!<7r#4A=Y~ zfGZc2|FvjcNgHQ*cnkCT@K)wG!P}S*glCzLgDV#_7v9BQzZ$Mw&`!tQT+nYZUSe@r zZ~FCi{knv1*RN~n*7v`SZVU7wy4@E&PY;ISt)^Sw|4X_p^rLj^`=7leT9_mSOxhUp48P7rM<$AIH6f9Ta)L#>DuGa4XmQ0B*zd_QG}k z^p=O?_up6N&kAszKbyjJ{=5aQ^XGkVmG&|`!%F@bo@u@huJfn&dN}@k+IZfdDHr4Q z=(gTE(rvvBqT70#K(`54Ot~c2-TY6R7{3j!e9I`f zazRt!$^|WhD;Km8u3XTMaOHwdJ6_0{$I>gq{or~gT=&V%;JRP!0#`0*h~tHw_kA+P zUxsVHt%EBU^aEVEAn%Q^F8_U%3n~X!E~t*K|T+j-*azR_* z$^{*OD;JdS&9L6|_%d@57Y~`VOvK z&}q1GLH}D7tyj6Ax^U%!I>Ytv5e$&l0xbhD(;JHxN<@5;K~Kv4OcE` ztmDNKHkiC$b7FiA+&+GJU%^$^UvTAu&iNp$%gqJVi1Ai%<$`*{|F545S1#yz$K71e zyD|O^T)CiAaOHx^tqbe&x364KBe-%w-Qmgw-3M1LXeL~_pts@51$_=zF6dXdazVw` zN5`*R&?Ru?g06up7u3^nHy1Q4#;3qFkBi~T1%2qan+y6T#{Yz??{L5D`?{eJD1w9huFTr*GS?#!+3;I09kHV97Nj-B@ zSg*gGlzA1nazV}E$_4d=D;G2Zp0o$bQ{gG||$j=+@*DzQ0QmvTYX;K~KHfGZbti{oxC zXh@7d0Z#?H&3ln<&$r*DTfbu`T)Cj5aOHx|+!EHC9;fw{GU3VvHHRw~)D5m&&`7v) zK~FpG=7L_0@ek;>es@TMT)CjP;K~Jk4p%Pd2wb_K;#xUaNRFWgew=c0Iuu! z2XN(rzJcq$>o2(OyGm}0)~j4lHMnv?SHqPH>h5?EXWmD|_%yiYaXDP`_$gfTco?pE z%)dRX%gqH{7~@yM^*OW++%9+C?Qr!~AB1aHJO{VSk@qINrX4cd;L430a(q(W`qWSU z&%=6M{~ug+)rPCC_Hfm8Cp=+q{0Lli&4R10x8SO4J3MLI{}tZKyx5Lty;>wnVr#k?Xu(5g11tC9G+!<54?-{ z1bDXjEATtaKZN%;-w)3*FZe|`{`?6mD(_c?7=M0$_xR;a%+YC*jJ`oqIT}*Uiyg9^=>3?YQep zx17uvy4}~!q1ysoL$}WnyXe8Ny_0my$(;WS>avA?8QpR+H^7ynyNhn0UmmAhUh8GL z9Y|~GmZSTQZaKP>bo;z>{;y$OZjSD%7|){HeC5z>zQ)sSzFwu9*dA9t-PAk2CncUKP5nw`O#k$R2cCZ$lk-b9Cckd=6ZBu(#pL(QSt- zM|T9S99_}h!+QPkC`VTbt{h!M#|t_0m=)uF;QCzoAY7mCrook?Tkd#a=Y2QE_z!UH zxBP#E_4?aUj;}?3RfQ`@*A%XQU#lxzIl2*W<>;otm7`k6|GA-x@vIc=-R-QqZnoa&#@>%F$)Rm7^O4SB~y!xN>xh;L6c$geyn) zljClV?%xbRSu8xi9Z;mQlmhpW$$3s+v~OL%ToFa2{A?%54W(UW1l{x}on z72!$q2Jme2j_{QEK)7;rkHM9rdjYN--8*pQ=yt-DqdNjuj;`3LXuZnORe~!=*BGuG zU01krbVK3F(M^UcN4Es79Ni|ka&-IQ%Fz`#9j!|_x(aaR=o-RxymWypM>iC%9Nh%C za&)i2m7{ylaW_Y|BgT)wbzBtxH>@|koif2XuMF35(Gad2T}QZbbOYeZ(LD-Rj&2S- zI~k1U9k_CI+u_R5{R~%*F8_bgdX=Lq3s;WrO1N@#t>Mbi-40id?g6-RbTi<}(Y+2= zj&3VlIl7-6cXM+|mg`NHx0+fiM$;mXmqcihd<-4)}H!j+?&3;)0T16(<}U5>jsx)U*8 zHh)-`|9a)<8o-sK>k3zn?q0ZZbTi<}(Y*y%j_zx?a&&*gm7^_ya&%+h%F#XVxSOL}5#w9on#aR%<>(3)4C``pbY)|_7F>P0HgNS%`@(hK^$=Y7 zrI~QucfAc)uIVed@@9WH?&j!<7Ygfjy()aR-M2J`tKOU7y8q09t1mnju72)Zxaxfe zuDW)@m7_ZfSB|bk;b^_e(OnEzj;;k<`L3RD<>>B*D@QloaW_ZzdW>&_YyTgHYyTH3 z64vE!U;DojT?dJuKyE(cKV*Go!&Oav|cXM>5i-q;Nei=Mz*Z0=&l=*FNT{u(l zq+L*-hv%BV0auQ0J6t)sqj2Tu&Nw4lmvVHOaOLQ(f$Q^KFL){u6r6(Rn!f;7j_xgZ zuASe$fGbCL9IhPQ*~O!EDMwcWt{mO1C(nPI)@_qE2uWpL%_TEq44YxRLEN0)*tNB1mTIl4FD%F%6e+|AJ)jPZOW z!n)G0xAjwoo(y)}74+P|+tMx2a2MTjbdNah=IEY_@#SzEj`uM<6%5DQ1NYKTKRxd+ zc*?x=S>b+2kH`8ZHQ>t8T?hB9pVAwy99_!sVhI~$-mj@K{;K0{j&5Cye*@R~|2SOd z|Fg~x>-D#<^Z&(go&T?f>pI&Lt{mMcxURp?!u6ctb-3=AHp7*p+Yi@uJYUIZUCPmw zh3menHeB~zZQ;t%-2qpQ?jg8xbTb?;;>`OSG5$GR^LP}lc`Q*Xtk>VZ=CK-F^O$tp z&Czv=@f^5a9=&mJ^;=(rtFO8mu3hmJ+%8Anak%m%B}<3(`r}t_eYlY2Fp?nGc00%qPN==JVj$=Gz>1 z^GgR~Jb#t2F8}p<{!k9Cd9MRk|Ggbt>!BZ9{r53&t&>^s|LecQ6E?xy;Th(?!nLl7 zSB=)I{(BX;)>{&;{8CrA*5OdN@=FupNgL-vcnk9n;jPTShqp05146xZLAUGd8+5zQZl~Mz^eEjH=vkRzUFq@I{aZD9@R-zVO%MLK z*PCt&{eHUT6K2AdUwWHv_l;lDEhqB_-43LZmqhC-VELuX=$2nG9Zn)ur2f-9)$f8br7GnnAbuT20ry&~09RcicTk^uJh-3xXz!8;5vVP0@wNT5M1ZaqSd40S7}$mGpyuJ z@J#c2;5vVfcRZgqp7&=K#Q1u;t+%~&TW|l;ZN2@kMp#$+eQg37(rvwUrrUZOLbvrc ziEb0Qh;Hj`o#SqP>8lt&3Re!N*kxf|{&tjKssvYlsR>;9rOt5Wmj=O=UmE9lA!i<6 zi1C$h-Oq1<>%Mv)T=}JZmxuKhcHXy4j9&@Yerpd`eklj8{L*;1@=FWg$}fH3xSLXAwCcu?nS^!sm=_9!EOZ(u;FZ~Bs zeyPkA(R!6%x)QGZQaiZ*9kBjz<(J06m0y|Ho}& z@pW*0PX8XR=PLifbzUu3JFLrpUp@Dz4_AJv3tZ>n;c(@broq+MSmwB!U-~G+-j+oW{j)<(HbmJ-b2a3{RNnz?0^W!?Vrj!c*q&!IfXy30HpUSGe*^ zXVi_>tNc zm0zj@SAMAjT=}H|aOIcA!F9a60#|-%9bEaPZ{f->{RvlosYLy-E;qlF5#vqZIxf1x zbzIy7*KsipuKdzmxbjP@;mR-VfGfXr6rP<7*4r5kP;axqE5Vgtst;FwsXbizrG9Yb zmmY#Ezw|6z`K8z4$}eq(E5CFQuKZH|hS7SJU#b9CeyP6WZcgdO7#|2P8thK*F}U(e zv*F4wy#rT%=^ME6ODEvUFP+yYtk=&S>F2T-Zv)ro-#&2FH3qKy(rm}w{L+-j+{8BZ?-TcyZG2RcZ{LOqO1t-Xo9g_JGf$+6p82P%ekYPzlWt zm1-+grY1^CxtvU{2^nEfouZml<4n3tC60thk#36Wch>%X-mUL?HQ&E}=Z}t_zI*TW zU2E;N*52zijrygV;p&&B!__aXf~#NJ0$0DZ-*dlTs&GLvFW*mwYdf9`SHE;A~2aNW0B1=n>~30&RCCvaVNRm~>zjh9nBNmIBwpN^jUozfKn9}O?E>y~@q zn(yOqU4K3Y*ZsJ6;JS}?2(I~7yD*t=y!@J1W4QXI3*hRP`oh&O-2hj=^Z;C4%~H7f zrPtu_eFQn_rkRw&WCG1d;zZgZ981o`9H$d zFV*jup0E0)_HeD|-k$sY(w_o;FI@LM7s0hYUxe%P)ONVm^I^~Ze(Cs5$-I1T1=sPX zo9BL~G%(<|z_WHjodM68uYjvx+6-5}v>&d1sZ!@;Uh#6OUpfV@e(3_Z`lUW_^-E*m z>X#mb>pFHhJeP43-V84`{|v5vsmev^c@^97tqENHQYX0jrT%dBOXJ|`mmYzuUs?@U zzw~do`lU}i_xq)CU6OhEUI(6Yt1W6lx9_(vrrZ6FtKgB{c(?_werX0={nFEL^-G)K z>X$x-t6!?zH9cSTOAS5u`=zr3UO>0~XDB`ER$Pu=?0gp8`lYpW>zCg2-0zq61-#tF z$$aDSwm4B8c+M?O)B>)4=_0uLrGfCMynCW?@SOR>aP>-c{^T<6)PaP>>C!gc=r7_RRb%3qS6m#&xU z!__aH3DuOarh1=;U>I83TD{cT> z-N;za{eEd`z?<|>mM8wqtxo9-_^mtLjqRcV$@utBMb-%RFWxVG;{aNRfm5w7iCcVK$Hjcoh2fop&0 z3DEBlWsd`FS=cKjig&wFoo`3E_#A) zJNgE?bp;>7)g48DNH2c{yWaaX-TIbxbbBLRPPgu86y3U`DRk?Op77l7j{X_&U3A-C zl?EsC%0G{7uT$u@y|Q%MUj6B|y>6k~_Ii|V+iNx5wpS_LwpWEeV)?aQ=(b(X@%*Qg zOWCgb`+$#z+jOJpa9hl1C0xhPEpQz_55aZ(Jbp+ruXs6i{A>l+@v{fK>>>G|vG7Lb zGvQ6m*T8lB+~Rq;j14aPbs*r!4o#LnKi>AY-_UJ;>qNKxZ6Mt?z<9dtZ?ovOzpbU) z{`NNAHsm3??QhktPUhuzM<)mTOt|`)-@(-#4TY;angCaKGz+foXf<5jQHkf3yzRIv z;78!P4nOglWIe>sqwC?*;p&dMcwX6i-2nj~3)gyk2(IpE6W=P&t2=rOuI^|ZT;0)|aCJuq;OdTQ3`@^f-O=fAbw{1y z>W&7$)g6t6t2=rSuI^|BT-{L#T;0)UaCJx3uEV?zo}E7eHG``=>IPSLbPZhH(FC}< zqd9PON6*349qoXtJE|}|z5MEq8pG8cb%d)sx(crUZqglabw_jH>W$v*Kzn6xVodQaNUpi#&f?rs&RcXFW(!%)mNMc*Z0!@ z3s+xp9bDbfM0jKuD6`-h^HuPy`DS>b`CfR=yyBnI^Hq0LAFl4G4P4z(0bJeDwQzMu z6W~?4xczW8T;0)XxVob^;OdSJz||d9`*V7}>W-Sg)g5($t2-)$t2-J8S9kOWwQrIS9i1* zuI{M9=w!a}a;iJ}6RxZHKEn z`WCM4=!6^6>p|U73%I(Yu5fingW>9qZu8vlj%Eb>X?PX4nxog@>W+59)g6@^lgulA zU3EvNz||dP;p&dA^xW@`Mg{zSxPAPJmcTWyO>lKbyFK^2qiAe0FW-L!S9f$aT=$DF zg{wOn>ABw>-52m>aCJwU;p&bKz||cccVjZI_;uACwScQT>H$}GGy<;f=w7(GqXlqv zN6*969c_iHJ30zicU1SL^t{v^wf5Zai!KiMV7Rv9c(}Tw8J_#y(XxQQ0@r>ONWnxbAIgExVob%wJ6aR)EpXkhJOJ1FJodI^Uh(tm^HgKF*7NzE`+ZUGfRBOe_%p?GzdKqG z@C|UgjEc6yb9UZ83|Dt_QZAWqz9X^|YHPTAS zUB`Y6&t=?%Pa2<|SFw2;xVobr@M1f@4TGyYnhaNW^f+AI(F<^ON2PFeN8iKM9sTn5 z^t{v^wesBWi@F57KRoAFTQr((-*4YXxBDH7;OdSxz||dXhpRg}0#|o*(jCcs<9Vq& zIs>lms5@NU(Gbu5?&#KlPp8}dvy`57EAAzFvGbkutUHfK6Owu5m&dxJdY=2;QOkgL zf!pFl{oy&cIMHZ$WQ%hTJZHWDuI}gsxVoclaCJxD!POm|G%;BZRWr7bWxtvQJnOmN z7xfAF^>7{kC&P98{~KJ#|MhSk|NjHmdG<@Vx}#c?lKIBVuk-I2aDC6v6|U>0L2z|P z_cs zqp1O34A=Jt8{yhs+u*uy{taB)vDVCFzVY(tzIk)Fw(mu7-8UZy*LJ@d-pID^bh!41 zzr%Ik{B^kYlaJx*j>^wU&rADH1Gu`Qv*1}<&P(B)%!k9fnoovzH-8*nVE!Cj-O+#G zy>0vUos0H$~a6e+2v; zxJ@@Y47bIMYR^rUKYo54Kik4}{OkqS@pBYh$Il1gI({yPYijSo8`+e9fHyU-_qX)& z>-gE$^KyFfvd8oc_;qyK-|nW{{x+X(``ZS(ZGfG0+uweq+x}Mn@nl~4<#+!YolUn5 z*^6%b+c3}l?r40#ABL-+c?z!XXcJuB(Qdf9qaWewj_S@!<{K}kx}(;fSMs)Fmw@+! z>pJ`fxUPrqg{wPSda5(8$Z9gqqcB$M?K-{j;{6G?~d*W z_)NIEqo?8OjyA*99qomyJF2iCnOD3#>W&(~)g7G)S9jDCuI^|AT;0*VaCJuu;OdT^ zhpRh!53cU$8@Rfo6BnlEtL~^ZT-{LtT;0(yxc+-b_rTR1ErF{$dJV4bXg6HlQMpCw zN9V(JKcbK4eqS^q;FI9$E9SuUz4U6h`ijkP zbw_*PkzJtt2+x?;c`{iK@$zTQTfqy>FM;RG{|HxibSqrl(R8@FqZM#W=2a)g8S6S9i1xuI}hNxVod-%hK~z zchnlL_sj3#>W+rN)g4WQt2>$vS9kQZ=YDteTEKV1^}Z;-JegPidF=nMtsY$Oi`H;; zN0-3W9Sw%7JGup~?&x87Vb<+#E8yymHo?^$?SQL0`WCM4sMb^I^`P$PG`PB>3*qXH zu7s;Q8Vy%>G!?GyXfa&f(aUgkM>{;p&c_@!ao@-VXSeaDD#$#ov>8#m}R8HHWJ^>gu`Q7Yz#dEpT;5kHB@mcqLrj z(Hoxo-O=X(ueCCnS3F+bQ7gE*qn>beN7uvE9ZiL+J6aA`cl2+#x}yVdbw^d7PA|W@ zqf_DPj?RaxJL(TtcXTsc-O)79{qE?AfWHjacH9Y9cXY&azdNe6Dw(hEr^9t$qa$4R zoBG3b-8B}j-s1tduDhOss{<*4tIzqwbH6((zdD(h?+xHZcHPnjuK9L{>-uvDT=&s# zgX{j+BXG@k1zhub9j@+Z4_w_*#Wm^qsyq5MT;0*RaP=^k!_^&)f~z~a&vU;!S{(3K z;9CDX;adOEKazRH&#(1g7q0!VEnNFy54iTjYv9`7?u6?)e*s+G(MGtsqmSTP&(Yds zUVe8}FW_zAx?kB7uJw5xT%V`zgljz)dG2>dYXkl+T*se7p8MTV)pf~yeQyl6%c$r= zc+SrISHN}R90SkV33VF0*!)Sjx}!~Sbw_*P>W<2-PtQx;(aCUiN9V!y`K~uSS9VPh z|BQhbXYw3PhpRhU4llOj+rQxIj`qXV9aVlNJuh`fjo|8zI>6N(4S=gVx)HAK=mF3D z?r2fKi{Ux9dZKse_Wkzfbi3bi?6b*y^RH_+9vZ{d9bE`lchnEA?r02L-O&`dx}&9V zbw{sw?srF}0Y6N){io)0$$azAlXWYuDZSWvXS#JqgXq>Bjq}{^j_wcmBDgJ1R1D9# z#fjd5t2_D(uI{L6aWdch^4NWoMsRgUS-85RzHoI%V?3{#v4t%Abx*+OdhT~e>jJ(7 zuH*lHxQ_poo=@f*KfjLuzlQ7h-wv+x?B#HEM}LOv{5u7%?->@ub-lC^uI^|XT<7t_ zaCJwuUP#YZ*Imuwy6)->S9df3uI^|oT;0)B&;9P`$$-BK*LK_k*LJM9A(>bF{MwEU z;o6R8dG2>dzYX{hxSbxO@o?R5odMT<)s=9)1xny{I*Rtg)sq~vF_~|?{OU$Bo=+)r z{hSr>0=VXN4P5h@1lPRgz%{S6aLsEAT=V)2u6b2?F_~{XudGe%RCrhO^Wg>Nec-*# zN5Kotr@)7rKLHi#&qzF@vZIxW%7H; z`1nr+!`+SldGJE>7vVYc9q-Ufcqo~Hm_V&jLwBlC&ymgckJ zHO*JUOU?fcKWKgsUUP(7Z^v#;&#TCmzcIX}jnBdh%&&wO+wG`&_@u$PpD|UvTZQ~2!>J@K-XKnn0@J{AW!MmEj4)1Qh2VP)aetUXe z>J@(l?``AT!qqGG@Z9eeuMYS`x*gvhquX`$vvli`-ly9R`Yqi)uboty%s0QB)+4p0 zyJ1lQ-FEb$bnB7sgsWGaN4L+38|c=>ZKvBC=?L9=#kxDv^QvIIVq3cPiUpqgz2bEN zpG>#ywU}<(>t(uauU&N8UKKt}mOsBdw!KcF+xE)RZF}{l+xD7Bx9zo%uI)m%?Xu1D zC}VGmvR_97UT-aequH)xJa2-Ea!*%?88?NK$7jR9j!AI%k zZ)8)x5Z=_hA6&=Jv7VRHlb1baTELgnZGU@>Zu{F_y6tb3cO}c8e_h)EP3X42b)eh+ zHh^yX+s$;_kPp#qe_Q6c-z#nm`1^2mcVEKQE7sVZ%r}01^@^v#)hl*@t5@s`SFbqQ z^Ge=!oE-2XxIVxC1Fp}}C2;kM`#rDhy>7)l$$Wip0M~kJ4_B{vC0xDYSh#w{X>j$5 zOFj2{#g_uU9j;#SFkHRj@gFDijh|n=Vsp59#f#wT6$|0&6>o&ASDXe{uebuPUay<)|^>3OMFYyelU*bc5<@%M1`ilgD`6(4}BS6l{HuecemUhx22z2b5EFs}vY zdzXo8amdKZdJUtnx{E`PC~ng{xQW1Xr(E2v@Io z8(h8OBXISKtKjMt{{>gCxErosvEu&pywodZJokIWvjcuP{9xHRE&dthd4)`#^8c6` z@MUm)FZViJ-=pq>>$rN%r^&qH*VXr&jo|7PJHmAw9t2mfI3BM1m@_^1d&Lz2e+8~C z>qEHiXMG1(mv#JS$$aD2Rj=3#9@zy-2YAN(N_f_M6ui*J|IK)hmvHt5=)`SFgAXu3qs~xO&CCaP^9n4yNa& zUa=uuz2bRr^@@Gq>J>-B^?tb@u3m8&T)pBy;p!E4z||`r_T29kkNZ5CukWY9^}gr~ z*ZZO$TJ@7oO3zolVk5YE#rAOZioM|K z6^FsqD^7r`SDX!3ueb)TUhz%1dc{xS>J_Vfk)E%5#YUd{z2f-+zXD#xt>)-YaP^9R zfvZ=X4_B}FGF-jlF1UKd=*whYac8KXx&c26uFtcPOSt;66AmZyjhA0t-x;3!U1H~e7s89|x@8Pp^SuwQ z>(9k--G6@puKVU6z%}2m;F?#>ZHX28`eu7;~u ze8Y3USNt^K)xS&T6_3~YZvxl)?+DlW?+e#{I2Nw`a4KB;;gfLfZ=2w{&ff=DuXxOn z^t{w7{syk~+|hHtSL_$?v2b+`)8Ja4%i;PwwF$2Eywh{PSNuNU^^Yd=jmPWw)7Epp zOY9!-q42DoP$$51=Ck0s@wOJOUhy5cdc}iq^@=sVPv#Xbzk0=HaP^9v;OZ3z!PP6~ z;JS`|6rRht39p40o4*TJulNPL*p6?ten`(tyJ^8;)hkYft5=*0SFgAp zu3qtN&;4F;f50pJn9M64pL44%szbAqjU!wWF;;8{Ymu~ydW%R6Dao5s|o!>>baAY3cdd25F_j|>+0=^$^ zixX8S=dO(7`Nq$abBhzzgGcdzvY%G)oOyS6WcN*mz|||>0avd$2d-Xmt>;xU`9;b9 zV{^cFdG7a$KLosX`D8uB<8}OR0WY%mdsn!Q{{!JV{@()Ed3FX|z2Yjk&c9pW`kvua zxUQFusgRzRdc}rtoyX6Gt5@s=*LBwjxUReIf~!}Y3svq zeB<%jj?LiOj$Po|j(>n_JKp5E-z!cD_+q$Qx+vNR*ZtP5aNSq^23|I`{LcxMlKIBV z)6~2Lyrp?JxVn)QwUg(GKSN)!%^jfE!k3u8@XPf0rF-1?P4HXy+Vj|PBL1b%=KFU0uT=Qx;Y&hbSUe?vzHTLa@uG5+Hl z9aOjZ^7(6GJrvJ(oymtuUKe>$jd z_w#?Y{N`Hz9|k+<8yH`R@o#r<7e@C4#!tcceH+~P^?~ul7{6+x8-Fw~UT-!nf3H{F z_~!N|3!}!1x@-mw(KSUmqA>jPc!`b>oi)#z*e2e|o>K_}D>vbIv!5 z@!cx9>-AxQ@gp(*jmmEPlEC=o7=QE_H-2kid@05kRdwU5yI()sUNz0Ny}qmFpnG6^ z0mjeo>|k7Ad=BI9y4}J0!1!W}fAe7n_Hp)S%Ws#}KW(ob3*GqU?)3Px@h#0Y-)^tE z@xub+M`HY$+uZmif$_^RzR0e3_Xoxw#P}0?IH+$u5%;%@xt4$TO>TVO!1zLppFYOH z%)s~}j2|`L!E1r>B^ck{1|AKJ&u@^j^N^Om_nLTyQPkf3`q}o%nrr+SM;r_bj30^d z!w0*tZ%JVMa*Wsi&-K>8_)?75f6unM^@H(W``1e~&9(gM^ScMe7ht@){c(ZuIgD@r zfxF&Y5*WW6<8__6H88#u<8}R6-M!4uwpUGa&A0k?2i*hX3o!oDoestY#_N8mo?q9! znRq8E`;ohUi=smNgIw32MQ~kbmcn&C8Mz2^Wx&xX#Yq4Q?w{1`e9hR%1P^IGWq6*^Ca&PVwJmG?f? zc_(y!37tnm=ZnyJA$0r?9p^*G^U!fSbbJmSheOBP&~de8{wIHk`+xi+{uaeP_@$mD zYyVbI&K-v0gMM5!+lP)w-@atZJU&3$#ckQ2+|LwyT+Y7bkn8dK_daERh#${osQHQe zpG%ZpYKLEYK*oOSSA6u3ue0o6DUJ@FS1bSLBKu!u=`S++gZ-Xcb~O~gLg?|@d-Sl3 z{$Rh~xvPBSt~=9zQPS1Dep=mY`L?I*@#z`5zt!Wjb?h?K9>lR<1Rh^=p!?6NHM4J# z^qPG9kAcUxTjw5cUwY`_KU>xscmMb0zjnQQ{6f20&=c_W>)GSE{ZDx1zdxS)PyFp5 zw_W^N>)vvYzpw21{U5%5o3g*>bH?Ml4RGJHEu7>oE91w-&!nxP{r`f%;}7j>5kyx ZuL(Xr7kK<5wcP9X_CDpu7p#2z{{f7~Px}A> diff --git a/source/cluster/wham/src-M/obackup/fitsq.o b/source/cluster/wham/src-M/obackup/fitsq.o deleted file mode 100644 index a451d83eed1a338bd99e1bd7cb2a1887da8aff3d..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 155472 zcmeFa4|rA8mH&P2O~fEz0-}wI8ZBs4#E=^xRN4mR+Di=@f!JuV1d>3o{D}}STGX@< zOB$i6BV*cPCu5yXrnPNmv~Ai^8!VNm%uH*KLlmPfCc_dYMCHv;edx5dp?nfg@b zP4dPYCO@D?w)fi;l8*(Ds_k2F7Q)H_s z_>4S{T$Hc&dfu;y7YTlxc!l6&VHkyn?tc z??c3w3jR3pDxvdD;?;up5w92gRpJeTA0^%-_@9Y43!VoCqn~#W*Y;mR{6WD>h_?%V zJ@JPHuOi+d_#MRe2)>ngr{KGYKQ4GD@h-vth4>SK?<3w#T-Ue%B;F(V5b<82^9SPl z1RoDg7ya2MbS@;`FL)900ikm(@k4?yB|a$lD&mI)Zz4V<_@{^;6?_lzVdC09Un4#u zcrS4e>KDGiE$a0H;@N^9CZ0oF>;H~;p5Qr<0R5RSbj~9_Meymw3j}{3@u`AW5HA#b zCGqKkHxe%r`~l)6f_D(deh6RMKVK$3Pw=OSmkIvw#1{xYNIWI@o5afn&mQCZvqJE5 zh%Xhqka(5g?;(!;Ww2c3#H$7W2=Q9M8;I8n{t4o11%H@$gWz8x-Y9qv@g~7vB)(Pf zL&Tc}|26ULf_tY^|0(z+;tvWwm3X`0vxz?}c#3$3;I|RqBlue4or2#-{BgnCiFXP9 z81W|re~Ngw;Lj6(O7H>VJ%axa@uvkpPP|v}+#KJ}`vkv)_@J0K&L%!A_)Ww+iPM{R z2XPN4((t;%fAbz9J|uL$M0~nP|D57kUMKaFDbndD?veePzec=T@T0`FpY?q855)T^ zz2-TvFo?lCvzPK)O7Bw@&-Ml>eJ$}h#H*=8T21_e#QTWr{_1w(2Lx{*-Y@tz;s*u) zTjB$P{}b^;f1->X7uakJ5;7<~tEco-p^96r}_!Pm95-$+^1o5eY zPa5a@vrzD9#HR~hN*w1w!E)U|yhQMi5HA({PU7euO?nA__f6A1+OH&R`7b_4T67+c%$IE zh~vC6SgyY(zE$w2h&KzqpZIpcUnRan@Lv&sP;hU8@3(fr&m#V?;Fl8b5PUB2J%X1L z?-YDF@y7+=gVW;*SenOuS3*B=IK%uOi+p_(zF9CHQ^Bdj$Us@uvlU zoOrL`-y*(G@E3{q3I0>!2LvA`-YRt2Z?)d{vgv_b-GYyOm+!Zy z1fN2@NARnOKP~vR#Crv=B)(7Zdg6V8e~kD6!FLhw7yR#u9~As4;sb*3Cw@rqSBVb_ z{wv~#1^3{@7tV8r1V4-TQNb@IJ}mfL;>QFpCq5$ha^lAY-$)$K2M60%3-N5hJBa59 z{uScm1%H-!p5QMNpDg%c;`xHVO?-;rXTXgD=+6SdFCdQRt%Kz%B3>x?b;PF&ehcv; z!PgKk5qvB0Qo%n>e4gNs5ib+`8^jj~-bWnIuLsNZ6XNB9|C)G(;IZ?3zbzGfGVv+`mg@oH4T67`c%$G?5N{IvyTrE&{sZF8g8zc} zcELx8?+|?4`My6N6#PQs?SjuF{;=Q+h<6D7A>w-kzk_(E;P(=LT<~_{U4nm+_!EME zlX$n_FA#r9@I%CV1pf{3rv;Bs@%`2-_}Rqw30_FNPw;Dq9}xUT;{AfJAbwErM&bj4 zf0Fni!9PcQQ1Gu3KP-4J@gc!~Nc^ba|4n>Y@ZS?ZCiwUZe1DDzei8BGf)^9_;QCCk z-6e@<3tmM$NAQmlA20ZQ#PbCI4Drc=KTbSf@NW^HBKV8M3k3fu@u`9j6E74z>q6ge z(*-|=c#+_j6E6{b9`RDaZz4WV@Rh{N1m8@2f#5rcrv(2z@p8exM!Z7sy~LLaevo*T z;J+lkOz=MtuNHj5MZQ041ur08FL;9ZTEVX;-XQp`#2W=)OT0<&`-yKA{2}7ag8u{Y z?Sl6Z-y!%*#2*y=HRA1p|Cac}#PxbMyTJF`9+CcC#5)DQg81Wtzn6HI;1$H55WI$X zx8PfdKP7l8@gBkV5Pw?muM_VT{5j(L1pg87KEa2G9}xVH#QOz5^J3qh2L->F_<-Og z#19Gn0pf##-$uL}&THa}-n{k1M+nei-Y1BAa9tN)wf>v8n|L$v)x^7q4-wbr;s2HR zQNjP6_^{yrMf{lH$B2&ze)=W8-;N7@9&rz@qvA{3a~1Jy!OMu__3B{yCB(-IzKVFB z;CB4N{6c#+@}-|hReMDVG^O9h`p ze4gMRBwi-??Zg)d-atGh_%`C@g8wb?3c>%0INlc!jN{Y9s|5cK;>!eoop`n2ZxOE* zJZGx!w|c?PC%#tj8N?d|pHI9|@TJ6?1Yb>jtKjz#Zx(zf@$G_l65k>Clf)ks{CVQ- zg1GW3LD+K>E@uh-4M!ZV!ZxCN5cpvdwOlPYeD{;=O{uKzyIzhlu0-IQY``|AzPh!Q)r@e(M+fY~lw6FC;!7 z_%*~234SB-LBUrLKP-47@gc!KN&KkbpCdjj_*aP^6TDCHEN>|8`zPCf^A1va5ALJE zm#!zjB;HJ1*ONaGA0j@+Kg^pj-S_9P;046-J{^4N^a9rHzF48|ryi=tAGVyNWaJzzf zeVh0`;<|qJ5$_Xx%nWSfx^|EVyq%-?>1jZpE>S$k;xiNxCpJDNZijTAS65uh< z&bLOTpJ1h5ulSi3zh80f-SqBu#VJ^6>^-J9IVZs3v=)3nm>N5L-U{s&U)RHbTgCI% z1IP3x-Dfbh=RFGlk#GNRwdvvaj_~zCaHUJ91~{hA`<0(Ak6eCtNcuKP|J>7l`p4k< zBEG&sy!J=_b^#Uf8R9dJ`uuhO&Fh8oVZH@#`2fFPfv+D!{h8>!d7?mVd0sWW4+@?| zg&7ju8}A?RCUITnBGNf7(^HkHOtt@IIzG@NQ{!Ob?WRk^lJ{oR>ema6GZwYGG@E=Zx?T3fm?Ay3fbCs1##ExoYy zW^P_fzj~k8(&ulhL*C4t*fO9}C-e3z^G()o=3dbYyOTZplj;k4shZ?Ss-^e-C8=%u zhI=sWckoZDX3T$&8f* zG0!ZMl6Zg8Zek@t%*Cye>`xv?m%lOjL~^7pIRYNc-L>@3Cr%u}uh{B>~cs~!)jU6lhtW6=#@?0`cR>(ywo!q~x} zu_QalWpx}<*d*I3hvEIXR88e^s9_8G2TvrAwu^>CN4B9W;~78(NO3L9BWr=9Zi2MQCVwMx0eo#9SO|U{-Pn`zQ!x6|Z$|i$<~* z!M+zlqPaWY6N z%7>WetQ*v5zQYO==m86jHY*ikhjzpsu*irr!x7u!ZIvTgl@Nd*q}mpB!f>$QW#|y| z7WKTD`;ooyVZ7=Y-^{J*!%{*;_CW?kE;UxMA|tk~N<}PknGt72M$E_x+v35x*mcTvF)+rx@`n>Awk3zM zP9%@E!N1D(Yo5#9^$ftwyU==50OlRUb^)SR+Xf@fyo1;w9&M7VYHdyh#lGy4R1H%%y7gG@tR8P4E@<5c7|$!@n-I_y{ehDRd(aZ{@h5Q z27V5N)HI+i*#SFY?xAPw$%oCz{xFX0Q=oKIEupUNTu}C>ESO09gXA(fWF6gEzVJ_3 zFryA1C_7BanA;HZlCj)m2UUBLoJSilJB$I$l-&N3Zj`h>f7vh%>_xb8%KxU`E^3wkTK=+iq7ghUc)6l)nUjgAF6E z961ox5^jYxV_uG$NBAuxC(vk)!*WS?*$-oveHeg$T%HHV`LmH#xl3`)h|_s$TKKLK z?8LR|s@$vlw&bPux0J#LCOnc4H{8(-+ubHxIv}ZTmTCiA<})xUG%fQTOkFEL++K^c zAeL^XTx9Lcbn04Va%KTW%yZ75W>y<*Rx=Shv?JEcdLzyZN6f|3^SHLkPCVBDH352J z_&fgJF!osUp#NihO5rl3v%nzcIYVHg zwwQdQ%}RyXq3sS#Xp1Q@;>>WwmUz??>V-zzHym?-J_@lz+iiGgjVdzYzTqT}*b$yyE|ZthfBxn-c(D+VRaGm+jwMZ=c8q?Gu5^kt`P1|wSJ==w_5)*)%s$p z^%dwQaeHB_f7KCkZNb#AUVH%;ly^-6qL!Vwnn=N(H}WLGV{i|oNcPggQO`p2%rf`B zqes@jJqQ^LOFN8PS7v0C0$0F8IIVY?KV8r7wpc%RW` zh9h=pyA2QZc)t;6h9kDbqk4S6XfwkRJG9+~hkAU_h%>_xJH(@%W*;)zzTubybcTo> z+7S&OHsZeFB#zh;k6Kkmj5hN)Vu!Zd@X)H_!I?fZ4rDCVWV)n!>vNa__9lBNS$Ypn0%1=YkeD@U`g6v>;JD}aFgSh^{=kWo;2_v` zd$$_>XxLM?9h|~g6}36!82_mC@z~W3 zY`_ukic1-jSs)P$lTq94kI+C?7;zRz#Flu}Kvo%T7D&VnZMWf}fvh&-ERcvT@u(iJ zH`>hOh#lH)!$UpZV8ofn5nJL>J>F!rna2@3w9)VgH@Y?3<6pAbl68zkxLykke2x@& zej{Y8>VU@P=}Ua@SzprIyX7Ldq?ZrND{P4Rq985L_TH8I#(A*2fOfxeIc((Vjq#AG zS6?km;2pAsunXRb@U89k9WQ*Zo$kHGNBgE)AFY5>uyFfrKP(bE;I0w419t%Lz=eV0BMH@xpp_M%yU%^I;6FlLOa!NL7W_2U-%lgCt-Uy~emcM8K{x4(6Y zbH!MfV3vm13dwLtr;rxM+7dX4-(|#E6-8``A9EXiEX?q3qs^))Vu!Z7ZKcJ9;XOv2 zbqa_r@u(i}HQK)6hOh#lH)!$UnjV8ofn5nJMT z-)kA%EznQ*zaE3;0bK(OiLO2Bgs6Xx6h>0Kus3m$pVqmaNxN3uQaNZWWN}06u+Uxn zw795nLq?p%4Y4I2HEzR3o5c;WL)&e5Xxv7OIEx!%F0T4Y9ihF0F#oB9xJ}&NkNukp zU9@m`VwHy3L&t@fXRNf{r3wv4juB_!Kx~Oe4M(2QX5m2W&~_Uh8jgG;&ccD1i?eXF z!7$|CN{%7XO(|MD3QW$dc_8LFXA+M>BhKQ1*b*n@>pB)7-XHh>)a8THbfuhhhfqXyj2LTf!2bU+mT6hMvOR%4q}IRv})!3ksD4c zTf`1+cXYy=xe;g4$+5)s{7ZQU2OmE|!|$X6%QKm?27~yWmn`3ivydQmh(`-afzf6S z2C+jsVn_;&I1344E^dV+-HBmXpc6Zh9EMX=s?{7irl!`(LG@KIb#4mMwDdy_1s!@< z)9C|P!DxEjQU#+}Tk=3FHopTX^y!_W}GN#tfoV zW%@A|CBzPU+=UH|Qne9hQ9^8qM~zaw(PmLX?9g@_9vYMC>rx?T^qvRvB>?NW_+S)Ie4nZ5Bwx4sEyLp@FP7 z;w+GeE%B%xZ!p@-9_7 z9T=W=V#kJGms4F@diKGVPf-KbZcJkVL+mikUGC6;br^9LFvOO4)PQvwZ5A-Z4sEyL zp#keM;w)f@E%B%x?>5@Z#}QlNQ9a&kw3){dJG9+~hkCrvh%=8P zw#5A=Virev=G=kY@t``XK$lH+;;=#|e$?l{=+g<;F>wNjN%+)ohdL;)#ebiuQe-ft z=r_eKoPoc2k^RhPcC(?};t-5W);XHf)SzB}dGSQ`!+rK4QdK$q{pLC=i|T&)bOw z(fvOZ%v|h`+5>qo*K(W$K+H4Gq+~fpoK;4|4)JJ}5wExe4X2X;h#lGyLxPun>?>00 ziVzpql`*~MnAp;uSslacNx=f4%iwejVxDIvk-&>k!2*#uVuyINNZ^&Npy3n=#18F< zktj9dtZ^WAh(|NL%xJTY7_mb;qTwkc&gwp5hj=u@D~vYlju1PvBN|?1#F@ttJH*pd zPwasG(HGWk>HAn!bHJ{*1DeGf`Tn{tZznbqyq#U|!G?q>RORNPdgNA*g9r}mkmE#u zr#c}6XLkG(GLzs-SG0ai4)Jp}rQk4?MKp(38=tV6g4p4chz_qe;;g11w#1{((;AF6 zt0{;b+HS)`=V?twoYfS>mUz@FqRmE|c^t7r+iiI0Io=&coOv9vB_7q|?M9n<9I->& zZFs21JB&Ew?5H19-#wx;73xkEbx*hBc>mTma~*g-tQg^5 zv?jm~R4q*P&LY=NV0!gR%X4)Dj$W#(2dF`z;meCvd--{n0WcSiZt>s! z^DemUFYfb{LfTgMqCb$kSvza9wU%}O@RmV8Ph~Nm&-!~NwhTdv^nBK*{(KhqpeDUj z3DsRj>NDM-XQrrdryf=x7TlMc)$entjl{;m`S>;CT5O+?f)7s)x zQiaiG-3elccEna$WyD!`g4hy|+7DJ6ZRT;r4sEyLq5WXJ5oaDpY>8t}Vb1y-6IVjv zYIk1X9yjNdZYQ*6NT%ClU{aKMeQYoVU|~gU7a(eVY%=03tcWe~s9|k3+AOSy9oiAY zy2FUGup+j^qxJypMw=Oq*rDwp2TLp!43T}GT$ z6~vZ!)T+{Lw3){dJG9+~hxPzHMx1#Zu_f+m^lCzZU4woiks4#ulL*H#ViGY1CS5Q^ zXtpO2<@g1!{Vfe<&jB^1i0AGaJcM_pi@VOF*5qDObmmvYj-tE$8d{V4j5zZvVoN+~ zh3Gfh%y7gGZMWf}6=J}MGs6)(#GOqrtt|%OL8Hx@AYzAhM8k)SIBSB4E%B&TW!Pvl zk0W+yyA2PmDkDamc^okp*Mld{+pxubAE(qfZO2mx4B!NkzD()Q;?4C+I)52B)AAg) zzv$;6@}N})mpN!VTs=U{tybD@m!vBSx-~EkD+0XtUOX*r6TK@KPhrJdW5Q9?kGFqs=^y*r6TK@RSi}9!KmDPoL<=2BW8< z?1X=?!9XI@V9eU~Q!p&S;Dg!G#Ptn$00!-b2VgArAHf#2SNFu%-B2IDOW^vtTjY~^ zIYyj?7qR7~sGVb;(PrUA?9g_HH?(uiH{vY3h#lh2dYRT1!%>0JW`-knXh$@>(1t4fj4W`-knXuAy$?R!g&I5QlvL)_`{w6^egnbGzQ#~h%JBX(#5d0ftq-F?^ zQg?EJb9-`Dkij&d+Stw_ir8Vh+cD|tA{`N!f9hR}Gr?OSk5fsL@2d9X* z56;-OJ5M#IAook4K=niXsq9RBs(3d5smE%8cVWWmaMA3whKb5L3hwt z@@%(5)opBAR(Q52Xe`P0ShD)kK;RpD5qhHZ*#U=+I6LqpJ_hXz@F(!2OKm$l;Don% z(2M#ejXHtfn%vi#>^qU{ZAc?4x7TmsTLlU@mX~&jfRIXELNS0Xx!}#+hiz{+3}v@GDAC2{*qB5sA{dndpo6 z?ADeha0;-t-S`21*#^}|Nb1OX_%6o&mUi-Nn@Zf;(g(6|NNe%{JhB)+SMGzSjaEc`2!{&LMjADohqEdWd-z zL4UcTr=Nd=egEc3_h38B0}<5@AA!FoRPXGow6+Ywu5BZ+#&g=}W4!Su{V}WY4t?Pd z?g&V=?Z#1^2Hx9Yf&v3>@HuYgl;wT>kf%p^zHupzNWp{u6-}{@#zWrLLlj;|Xxoh= z1wKsm6&x{?)h)ehEGyLg%0I#pFnYZ`u&p=i9S$FbZ#jDz#N7Xxhq%aO!RjeucNUR* znNpJjtEY(FIYh6gWhM(&PZ7Jbh+K%2$$|A8h}}6vFGPjOf<*$cJB!GLs4_XQNFa9S z5WNu9CJPn`#O^G@dJA2no%_vA1O8n$e!l@dM((bMp=A2d$o{E@?!hsrBX%1f-9Pmv z3l?O=JPYbk;W3%&w;|mF&MNnP!uN zUl_~>mQsk_IYf`l4wD6o3}T+eJC01d$%#b1?f;ojdjm;88b#5?Ov6_H5JS*sI+zp52 zgzK8XZ=E)ooLEgj9G+8Vg=#igv6_H5JgbZfwZr7ZB850Sr_2h~Zn9#LLL8n|MuqAy zIk89~4$mpGLUo#~Sfmh#XO&T*x=cKLAsNsS&BdC;onw{H+Gl4 zle3OP#v82mAm-lCA&u_vVUq=`HHh6=L~hR`CI?n)5W91TUI-6P5ZhNSS`hOrg3-&U zJ?EI5SVRzq=agA{&NErD$ROrf>EK6>Ouos1MFz1uhv<a{e}K1#FGe^<*RVep~Ejf%r^EhIMIO_^3_v!U5)KGhm=^^rVVjI!zr9HFuQg7^J(L?O8Golk3 zj5v!PVuyIN=rtK_7Cpoc?TCgq8*vsr#9SOM*qZA<9}?Gp7VR7L;?E9~2lG7QkUX#u zC(8u20zFo{$%I7!G0!A}uC~Kyvj`w|Xh)1drx9lnKyZC{P19cDU_ zHW0q~4+R{e0=`ikR6rxCh)MY3T%P(9D4ai?flFoTQhM~~zV<=69p}OkTlL{U$haQ* z-SvJW&RPj#OFZf=dILtAwGzY*ZFegPyU}U)pb=-S1hFOVKiR_Eq=3(i$IGBtCsV54 z9|-Ts4vgB94H+v~PllLV0aq;jJe)n5$VBvH!zL3JBg8xt=*gnSXvAo<7$J6OM~sm- zqH8XT5n?WGyu~292x8WWs`om}inf<0>`UEQp95+7W|TX2e+#5p!{fl|Llu2;v$R zzg-rHt_~(V^RTMVxYG_O%pNjmg(+hy3nXH0Y9_6)!ici~BDTb%w!$i-%>sznp&c=R z)kd5J5V0k$N3h@xyEKAT!#AZ&#G*H{dSeBP4PtJE$s>bC)?hMWF+$8U$)J%n8EqCL z#18Fat?M9r%1+gU_we55mZ59{A z4(*6>=``XjE{M5!ppT=oh=CEzKb`2G>R0Zwg7*$bur6aJ3m#%_rl~#|G_G!w2@4`( zo=FCctH)@wAR=~XM+{=G5obX}%*D+JhJ78*L0lsk1=BTx1zMx{dcr#VA@=Cg$}Y1+ z=W%r{(IYR(x{WxGr&}C)eEU>udde!MR6RzU$J4Ftj%QjNH3DZ`dW|@br(2v)F7RQX zG@!M^+9QLQ^qJgQOc3+hq_iUzt>1{Vm>}ljrXfcki3dy`EH;Qk^2ngG7&Mu%7$N4F zC@%$K)K+=mMEasEE}c6dPT0L-yiR& zP}D)T&vc=@(pz09gfsH&+lDov^18xEx5w4e% z-<*AHdUY-O*ddcUiwR<@iA9ddun}i5LCnS9K}R%V@?fz+9Fj){9gzoj?Ypk{1Lm2i z2#nehWqNMNSis_xGxbco^LLs4|wQ1DRCuNLaAwtZJ$Yk`XFybsUh%ND`qfeF5W}!js&~}F=bQ)Z3 z#93$%bMfHXRG*sz<~+OV7^ZM-nnAU!H|DXRA?D^~60`;*&Vq)Ri<@d0eV*K8@?gP3 z9Fj){9YeFpgar{X&jbP%?d+;@t8+ZVwJGe4TA6nkQ&~U}b5oUe#LC=m#92TQTjEi> zj}D{F0*Tn6?KV7g9P2dVEP#l)c(4`f^9!aGy3Y`aUi6)wBr=w=_;p#9nl_U`eeO1y zus9;-?oib;+I*zPXtOvXc4$Y8W3LfsaYW3;O+(Z{jCPVp#uVD3`NnGQt`%^e2;A>~ z5$Brcw&K@jJy_ep+{rsq3B@+CiQb=enr{ZN_#@^eG68>g@GRmt0y4s6>C`$E68-fL`O zkwR?QLb+gRPnr#?1*YJACL0zj#5|h}V%2Z7S*#E{v?Io9z=*S0A?D)gD1-(J&n`hD z>w-6IWGA5UVf({-lkiL5tAC<)chc@7Pk&pj)uTR%ZN&60ETV|H#o+455AE~7*5DEs zoq|sU1ndxZ_PJrtI@+CMv{@VxJG9+#OpA*Om}kUU91%OjqZyuWw3*?E9oi8MFEHZF zaKsLAUiXISp==mn?jHY-f5<8SZixR9LQTeBPV)m zC^F(KHi&I;7|i`=)zkg$9Sz?jItyVDLXc9ajXZ9>SMbfJx=!-%u; zA$EvI3rwfcW{n21Lpx%l=`!NXaKyGa3k=>wg4GPJ2KWy%PT%AhwIePywZktVngV?# zV%vzQp(!)sehEn&u_YdL5tB07EHsE6+V0SVE@CQ-I13G8OFXK_tBf}DIAVvk+wjoF zP;JDS#}QlNQ9WL7w3){dJG9+~hkCrhh%=8Pw#4b_cVgwBAF!hvhyOhWkw{#IehHr8 z-Ig4N=Voliel8z!Q~g{v7?D9g-fdbm^AKW3A>1Ac4Q-DRXC6Y##i2ka^g}bOJO74H zjP}HgUXuqa0OF85un;H91hsbZ#ip=P42-r z8=j)y*3zlUHxZv0*+jlbwLMw^Q@0ns*It=w{YC2IM=P*RwcgvAYTewGYOU-}wJz#` zjC)cw9)96Yeh=7XfMX;`^zkLJQR2zbl1?hXW_Q@AThC`~F?Z zKSIw3cKX}uhNvWdeL(#Q=uAxZLIW?O27crl*r2!V8xB7EdDP)_*tmpM9mH;zxV=7F zCq81bU{wdPl|^P%$AjVrdm%g(xsNuttp7okR3O6q+npBoMo^a5mD=MhyO=VKnnbTmiN~TQ!Z? z-}W0Z%=Yt=_=h#(zRXV{b{c=MdV^T_BZCv_T}GVM7{o%nEty%{?KU~E8iUxKgS*Cz z)^>YL7Och~7FnQ&!m0}_nc%Uxm;zdbeFJ!U^)7Bs>@~Tw_#k%Vj-?w-95sR~Y9r3# z(`Soky58zHIk5O37Uok9?)Z$>Ee)6~SbPwREbRDDbM-GF;954rYB*?YU{OLWY@i(6 z#T=~~4w)=itPqPVqF1tEqs^j(*r6SQ;$tRGkp~w1 ziHP73kCwo)AF*Wv)CrgbMPByjm@HU)5Q{9L$0yHdv-lu(Xh)1sz7c2fK`g}CwAB$G z_^tEE{ab;_owXdqB6rk|ShPYT&SHXCh-cdHi%bqIGKk$dxGUCZ4ZqZ6!Qz9MXQ8JC zi{K$u{+H%(%3nF)f9HFd`qfJ3_(V4*Mje{UjA1Nvh`C{^T0{(8%80YjAr|794owv% z2NpWS?i}2q8*ON+GFh4VhLKHmXtR)Nlg> zT1AwFH~&#Gv=Bnn%nj3L8L;3d5l8=}r-l5d$w>VF=AS0R5UJK>LZn(3g$P<#*uaJ% z3S7T=6u*4Bzoi3aF5oclh40Z7icXlbr&@3Cg{u^OaFwDTu2Kx7T6Y#eT`6yEDTFt@ zK7${(2tDHudqU6nW1s4nzaX}Pu5xgj-o**UVR%-77P*g2YZVt0;AocsO%bDbl4S=U6-GO)s9r?hkY!W3Kq zhxeCKHMgf5%z{^NMP`nMI4!jXv6Hlz%2W9b$Uq+0R!$)k5wlbKMMyROwSN&Z?9@!< zsr@3Pzi1gvRv3FKzX%!dh=>`Ebui4)bNFT;=Y1zMJUZJSko z-m-RAo3%U|ZGJHivFLQb!tix8%YqkwcfHAijYEh<78&$wM%yXO6ie#@-fUEji0Sf=f9 z&{)WdkJz>_vjJ?#WWk((*que&?m`#?pwJ7R8^Oy&a#9t&t_~X$SSb1i?9L&27n)XnnK^_Q5FFdKnc;{X+7S&; zuiTm8h#lf>5QLgV!w@Vu7e?I=)Li;j$QzRb=e}-(27P2NSgfz{jJBfTCDu#kU~!YK z^NCp2(PU8|J@Kh*x2JB&cB_=?+X}X7`U?fZ*p6UdgHD8Y+~H7l8=ICD#?m_1j|$0l zTC!1>ptP`Mp6zm|x{Xb*Y=yD3vJFSA9xP9CaY zEdsqA91Rl*Ac1ehFMzMC9JvzyKrdYZ-2v2WsM@Mi*7w?PJ6Z(&b3gRY&_`F|Gz6|B z=3xVXYlwNN9Qc5FR^;Ke4Wbo!M5}Uu{t&)IqkilMAReoZ!Gle*d`v~h=F_3oD0m1C zg~RFLo^&{hqj}0(m&jqTu=e$zd!c9G)C9W6>ZMyHyR=!Lq_M6N9`zc@*E? z$UBi7YD*4baE~5&=5*ET9d+Nib2RL$21TNu_Zxi+Vk_WBLk6g{IB%i5ahwfSB@#z$ zi4VCA9||+P%xDLjY71hAHu}gO{nFyX@RSh`_AV`mxj23`1uFAVx?(*@=SZ+(!&MoY zH{cL;v@LlQjL6+pg+tVJ@JAiy9F)`k!r~rvO?$G*xJ;YUtN9o{t~R18=~50LP!e+7uf9 zPCQ!z7YFdI&1+S6W2b8Tx7HRszX3bdTdTT{FugAawc1+LTWd?6zeO@?>P3TBo7#YH zQ|*f7;M7C^-jHfG_K=#c-x$EaPhl5A4vw)4vDMiPr)thtez@j2>oha21Y5^XP1UGh ziAuGWPt8fMwssepT!O9MJ)MdA4e?T=9ju}1WP(+K$WLI!c}sAruVh=|Qk}X>m>uM%)wJk+2DFdUg=(y<42KgOQMNJS~nI>2{*02SIl`rUy~i z&O3q)+^@lo*@53S>~TDF?M%~ypo<;TgQ(;9shvUzR%&?*#;9G9zGr~B*q$e-T4DPl z9XQ^NR?;*fSeKLbG$C?*pm_pwu{}?S>SA^-1+`%kYEKg~cQHGuLi+ZEA!;qA`2usX zJzt1ii~H^FJ?T2B!f%y02Gfucnry)8Qe84sKVYV&AutN4X~+=m8G+LXu4#yCv{2KK zk+$TB8YBjB8nT~HL;Mq~ZED$xPe(fe&wqefN6B3xEw70L?u(9zy1%=aU zFMm(LlFchO)ofhT&{**9X|)9#RuweX*A=YTxN*hZ1=BVa)UVi7uw}*C&2 zRllaDzF^I!g0*#s9Kt8}6#xSg>-#=JiSdQl5c1hQHo%{;N0Et!RWijR~6@ z8XP86&A&w%q2F(%ZT)^N><#|c>C8LqufqQ)(YY1UsQ*G==cC`H&QdrI|LfybUc`{= zZF!tduXXi%uq^obogOdst^>{B|C?bO|1YNhC)+-mp4@-3ZOGR7ddKza|Cag`-0k;d|m)H;QvgH4IU$H)4GxekHODj`z4p# zS|^O_{S}Z$l>ah5T1UUj{W@;?U8mFUn(Oz{Y@EN?<(B1;+c@~f;XfWN_x=Cd+$Y-C znZCbMf9gIu?EPf=VaI8Hvg76cB-9!Fuj`)PmhW0W>|Le@$dF_gg{;8NvO0jUoljRj>F2+Zg4&H7DiYU{i+SFLH>bmxp!-oo{bb!!V3UtVxMoKf2d zr^Bw>u&!avTBumpuW72=RIqr(`qg!t7T2v+)xtk37LQGefqhCMXq5UK%Zla4t{n#< zgZkoSZ|S&yOjc}4Y!Q+s*zUyb3u7O~?Ym*S3%3hmYjAu0dQ5OPfOp64LeL1?-I!on z?Blq-(#zV?0GpS^cB%9m)-SKwuzm~ByfNAHPmjemtxtHEd3;M*cG~mq~9kjJI`yAL>Lt9PRXG79e>q)5R{_L|bpLHwN zt|c^ZclMcZz&%Apsx1}~?gtDh>l#-O=({_6{QF|D8gCESFcu@OUfJX4LMrc{1T2ol z?q0FQds5&lW3eW{&j@^JEVjklFW^P7*hcSV0rO+AJH6K!JnhWfcx(-v{DeBOJYdl`=Ie>`+I5~yQaXdRU0;MTvNBvvT*z~ z*jcyMVaE6?VGp)Jhhj1As%dcSDTO^XD_3l)vvYbs9@MzP4#os5Rh`r46VCB>ZP@HM z3?rosoM~k?;ZoSQa>M#sd(U({s-|Xx?TZPCcI3bw|V64VDewX_LYB zRqI!*tK$`NB7_5M#vR@pLT%y&V8MES-*LGQ!U0uG9XDY-w_@T|@fg-Jwev!`6RHzB zSM4m4JJI#%U$ysIv3C*_0lcsFRmy$uipMtAf$&Cu|0=ov-C*y=x>akMypM@pXM;Bz zz-4WMPr3put$|5EO?~Z}jou?-_gP?#3XihqD`M}YS+E!Dq}uze+zaId@2!Gi!FyTk zJL_C1$+}JIxYy;ri>VZ<4*sv)3k?Cwh;?ub+*}c;8Qy8 zu3WMHqu#stabxl?^7n44tE=^{kUIv`k71u4H%O^pZYf6<(+o19}RnexDa-%Nryu=@C(nQ z-6|f|UhMesU>y)E0Tf*&P!W-PFM`6Gy>?f15sp!)?#IMB8hbgj+i^HFC!=n4P-8BF z2BUVPE2VZp&@vVmE2Xv~5Ev`X43m}2$vf>b2tdP%jdnYk2FfrD`rXUvFbxe>*J)7W zU?fzH_FTE|YB+GiMz!w>xo?izSF3hjBX>f}#Gyg$TqJg0dM5Pe{#dE@FPHnFroeEi z_BG0Vm-wBN+Swv^LN5YCrrP(2+=pEy_1#^3pXZ&Plf5`Ozr3*Ya+pHnlyPhf=9+hp z32gPk*6G=&Exd7Q@&n1mg(W)W8L=!%1)p%^^z3-~O&?fz9moX}v2^JpM*qYP!i{mU z8Jik6&bX;^>5cOj!8zg>0Wgb$iUrqlu;`}pVosJUoi7dom4!F*L`f;UI0?rs76(== zPF}wdPKC$D`}S4bwA9NY)0SMfc>dDsQVSNsB?4{klIvhW!ZTX3a6z(yBPhf53(Etg zT)b$BNP+pH(P?Qk1>BPc*Daa9eDSsOZ@ht{CCMb5=hFsZqSV4AOK(~X7o&sFJ`l-F zo@jn~MQXkSiDY=BFbs_6$6=b~i<65M-nekl!rP>YH_l(W@RsCq>!_dumZp*-I*V@- z0E)@|2w(vx*WPraAmG)-3zOo&WOpmKCrJm9JP<)w!_` zOa%Wl!J4jOOjgzTv8A|qCoBXzHpBJ>u@$(z5q4L>=0*NevlbVMow)xJu`+}O=H@Zk zKY)eUU3y*CnEf(rZqci<#_ShhvynCj*JOVmHt(j*_6^zlU~{A1y<QxteqKWb! zxF>tvnIK1pmuJ@n*1e6{wSjeSLv{@wyME(3Qm@Xg#=HUx-`>sH%K^c%k@U*4KjK&j z_iWDo2qa4{gu6FqFM|bZt+yURnI4z2m%)N{v)3dbELa=777jlQhu3)zariuBat{@> zV?*|`iLqF{w}+>>6VmAQ_~1S1p4jSj{V@SB+jA-h@H7*0{gWlD*KAq8Nmh3+c4jV| zEqP!P)aVshgYO>$;Jn!1AXo_iPL2SW;-4K^2LMin0JxA&mjLLwe@yO$F({Q^W1$k{ zUVxi^#N%74bEn{@U-{!(s&dcAO~3NTw^Zbw7Yo#YhTOApuU~oL6iV)7+|<=8m3tO$ z>ZZ`Mm6w!xY{E3Z*qiQJ0}B#Ixu?a>)rH8~k{Wa7wAlH&l-TfL`+`{FEO5hS)zV@6 zqF5PjZ$UrZhY2o@EkaO>e!6c=?&Zq3I#XS93$bYWG)}`P#v04L3A25(*KL9B$zk+>m=y(6F_+HwMkF_a;rjBi6?yWEjG3W0Zyu1Za zIXpEqc(rwn4&xTYE{%O0vnAIofIQo9n_ROXc13JAZj)?n5IBL?K;!9G_V4 z5x#+Q&*uB|+*9^CxVIhl;%jd@(nR49|Jf*;qKC>;1#W-+D3YOFc1p z3jXlUmc7}(IuCl>I11q_7XMh*gjhT;>$F&T$r7GeVXN`%)FU`t| z70%mJ7=Q9~Ja%l>eW;ohi+^zfZa*@{fb6V$aM$Uvk@$SrRXAf&{72(4=MMb%uW;5k z7XMs2`Q;#TTiN{hcz7?0pAOa(#;=AP%L}1AfC>xaUslI_8n$BbcJ&uNZ$;Bji^cy& zfrqoQ?naOk+fz7iY5ch{kl{l3@I`g#*Hm`7kn*YclPdkI%0s^&3zAEVmd5`{rH>y( zx-{NB7LSgP(~@iVH8;m^gk1-=#v9*cv|#Jexl^epc4^A-(sLKCE6|<+#ghcUUNS@dl|BmuN zx7y!>e>>tc!Jk{>bD%D4RmE+X-_TGP2iL-3UFz>Q)ZdrYUng(EqK}QSgHA5{h!XsY zl|_#t2eYzBwwcWMs^a6as<51w#}>tZprTP&V*FSbA5`U2Mi$1uq~fqP{yjW!WGcAm zE;RIvSmU92hvvn%X2oN3OXBCl-uPQ%uvVRo^~-nO4RAnbB-=^{54gO=M{YuKbKC8Ujh}qFuqGM zQ;*_b#j1FFX^G!3?}w!SJ#%_t{6a{E_0DfP>Ey@9QS!CW=%8hPR>*xuwOa5M^bM1t zMV1D79O$pG%bFNFKj*A*Svk{k@}OIb&xljuDaxcrn|LZ}!HUw9Ux)6S#A=TVw5G7V~-KGhpH?tO3&UNVb~9k&ohthu1v+&HUYZrT;M-`hRcyn7jw#*x@ygz_vUkItliT~ce|Rwep8^WCHxKFsz5@2D{4U7;BRuH9&QF&2OCiUfoBbKs zV;_%k$CoSaQ~X`(ZzgeH7C1hWxbF!Ze=2c55J;a%+{aU$N106GULH99RN}rhkUo>R zKOHzeYTW&+<}gpglX{ISR>J$;>(qN=T~njKceyuX<)%&EjEx&=SHRWd<;82(7Oh&l zVMSvD%!lh5XUy^7_Mhc&y1#LG?V1&<*KgR=xTeNVHnRwBH^9>@%N_e>+N{)5%N|GS zxn$SW>t+v zP*zwiEXT5|1WT4KE?>B`V*YhEEH9B@wgj^zm?J@{1al>rS!5C4)PN;3i>)*Xi&*B) zw9K1nm0+f2@l4C)nU>APmd(YM&Bd0@#g@&*md(YM&Bd0@#g@&*md(YM%?Zoqgk^KW zvN>VdoUm+8ST-jtn-iAJ3Cre$WpjyTbBSehiDh$%WpjyTbBSehiDh$%WpjyTbBSg1 zEX(Fumd&#)n`c=z&$4WuW!XH-vU!$e^DN8eS(eSSEt_XsHqW+fo^9DY+p>AKW%F#y z=Gm6bvn`uvTQ<+JY@TD;Jjb$mj%D*4%jP+j&2uc9=U6t+v231W*<5PbTx!`|YS~$u4Oaa zDP|21MZVS6a6fa7Jyy@0>utIdu1Z*mi;KK(wAGQrXt4VO*rL9jyj(o=T160@=P-W4TCW`(BOaB9-lXHJ*!9w(r%5E>hXPS7SO) zr3Q6@Y~QP4U8J&ouLgFJ%J#h)+C?hc_iAwGsnqB$knMXlzKc}0@6`w|QrW&&W4uUZ z`(BOmB9-lXHO})?YM>X$_PrYFMJn6(YOoinY~QQlUZk>puLgXcN{#pe*}hj}zDQ;J zUXA)9mF;^q?u%5m@72gJQrW&&V?R%&27iHU->czYq_TalCIBLp?Rzx^5UFh6t4RP) zrDg#F*}hlv0Flb}y_yM#RJQNcTtK9(w$@9B5mw7Rn-(ZM|A5 z^Hla&TWpWD#cH)I4z#UT>t&J3_Pts$i&VDn)tXtPvVCulwZ&@L%n!83+G4eE7O8CC ztEIC@W&2(&o<%C#_iFjfQ`uu}u|3uns};03(DuDrLyJ_l@6{?=q_Tal*3lxB?R$Hy zEmliuexN!emAJM{9ayf;kt?+Y>&#tY9TIC*?p^8ii=csl+hW1QY&+j%5EX{s9dZT=lno> zR4!J_bCJsSy;`7)RJQNc5?!RSeXkbjELFlDl@s=;oG7wtPQo6Q6ZWW_ut(*DJt`;c zQ8{6c$_aZ^PS~Sz!XA|q_NbhgY1N#BJt`;cQ8}T`UUL`PqjJJt0VnKHIbn~=342sd z*rRg7UI8cUQ8{6+fD`tpoUm8G342sd*el?KJt`;cQ8{6c$_aZ^PS`8pggq)J>=kgr z9+eaJ3OHep$_aZ^PS~Sz!XA|q_6j&*kID&q1)Q))<%GQgPS~Sz!d?L<>`^&kkID&q zR8H8Va>8B#C+tx5>!6ZWW_uvfqddsI%?E8v7ZDktm} zaKavy6ZQ%?VUM*5d#p{^E8v7Z)+X!~aKavI6ZQ%?VUM*5dj*`Z$J&HF)+X$+Hervo z33~;cu*cejy#h|yV{O7-0VnLSHes)T6ZTk}u*cejJ=P}du{L3^fD`suo3K~F345$f z*el?KJ=T`kV{M5&)|S{~ZHYbBme^x$i9Obq*kf&pJ=T`kV{M5&)|S{~ZHYbBme^x$ zi9Obq*kf&pJ=T`kV{M5&)|S{~ZHYbBme^x$i9Obq*kf&pJ=T`kV{M5&)|S{~ZHYbB zme^x$i9Obq&{%6<3Yq1&JTg0Yb)iI!$q9~d@*@yV@C3rSs6aTA76|8}0^v+rAe@T| zgfnT5)R-&~u6zWtO;uyENM&2E#$=JowqA|NB9(2u8k2b{H6{yWTd&4sk;)E-8k0pT z+xKcr7O8CCt1(%mvVE_{WS&Zm$pYEFS7WkBW&2)@$s(2Qdo?DDRJQNcn9NhDF6Wfo$v5m@HCRzMrMWWRc49{VX*mi&U2H zXQ?q+q_Tal#$=vKjmZMpzE@+iNM-w8jmaXF?RzyQi&VDn)tJmvsWDj~^!==0>zJh$ zy8>Z>1VZZtLf;F7)(eEb7YMBv2z}3y8fyiztyk+`kqT>$K(_U2tQDzj>(y90hxtnl ztO8+yI8tM+Kxn-{=xBk^dV$b-fzbB?q4ffx?*($0ioWNm)L1K!ZM|Cmid44sYW*ux z+19J|uSjKEuhzeFJh&AVzNog`!#h^zsu7IcEi+4vzZ|Irus}El2!!zv2umao#zP=1 zkw6#^fv`jZVLSxFcyOe~Ux6?l0@>E9@mHj>tykl(NM&2E#$S=jwqA|DJe67#GgK68 zQ8R-Z{KRE&&&(pWZ)Oqe*=82a_RQ0>^h1l_(IWIv4){b5PDwwgW5)Uojde3VaAW0F z@C+dMj^m8lx|N$(!?RabZP1_Bu32BFKd)H1a%0^Vy|rp1KK^J%UHx+Uls*{l?OF}@ zjlK8tSd$1e@ycQUrq&F|NQaQ)>2nf}v(^ze-e z4}Nn~z4Vs{;9EGJ{_+YYeHs72OY7%Zcms&3-a(hT!VgFJa$? z5FK4U{B{kNH;2;wt(2heP`u{7^H&c4`J4*0b+YjFiQLnjJPwHPZyIOGk$uWH0 z5u)>Pk-k}__PhrKpG-P?Lv&{07pUMR?Rk&j`K0qP;<8*1iS*4%)$<+^ynu8DLUjID zq$e3~L~tG7_t6)lq&+tWc(9$;5!dC_cHSZQbh7i_5S^X?561W3g^srWhk_T8{$y(8 z(*7%nOFN4MFD0EjLv+4CT(=8d&%YkR_X>S&|MP;EQNE{R=LIim|AoY*{qGh$MLM-1 zI`@n8es0k33SL1vFNWy+G{7+wx?lUP&}pU&ekb@+(jQA-Y{T*fbruA8us+;IT>F9K zz2$;ek$z{0&bLH*ZRgX1SCh`4LUgVe>sz4fgKkIHgzzTf(*An|ucv&UB`)j3k3@QH z|Eq#Gkk0v-A-tr{Oybg>*@8Eb&RrooyF~hCm7C}NjpU?rFhu8nM0%3(ek1q}(kVj6 z!%LRy1H|z#Y--K$A7AByKS(+|Lv$V^j&E2$b$q`fcn<00!*_x4rStW-JnsU*+bR8O z;?n;60zB9*9uhjulmR}F5nnprhe`iyAv#9_JlMW+;9JT;9e)eHqbzs_>3@j0w10ho z2krla&}pU&J}LMf(*Ht;&MN^PwEs6kN85i)@J`a7gB>3Z` z^H7M+mH60Yc%eRaA$mUfHR4(y)8Ok#!MjNR_W_+?dB^AZ$Dw}E&jrM_ezTvW>{}iHA3eRN1mn_$f#I>D%D$iRYcpvFM z9HR3Tk-nLPx&`kio!^G&oDI)4z?b%OA*H{YxU};=!3QY)cZtjL{-;Rata9_bp9rqk zKU3(N?oy|ixU^@E;DcmOQ;5!|MS5+|!-5|soganh42$$sEblGBhe+odcsdZiWVvn( z@L)Y$NnDq=Ssm?ps|7zw`uBwBd?Ubv?foU8L-Jm~;KQUp@f<&ew7-zJwDT&#M@VOV zh)%0WukG0-IT`@3gCRP<4Dg^o|0r~tl?wcMm;XWApH2E_5y#D-&W!;c^k=Qm(ei5q z&msLUhv@7T>6=ODdBO8Y=X83|25tuJxq!GXm$v5;!ShL{CPe2RkzU(#zu;3yr#D3B zKSg?N&rbv|Ae|}a`YB|&62x`6v^}MQPbHnZLv;R`xbFA#`0^vcb$>Voo`i)jov**; zc^3;_NcpZLF73Ztq;Dpn`vjj(I^PY^`H@Jk?Ri!3BGNhkd_RS>r)EyTH;b?n@Hd6`L7*<*OJZ)#HG&9M0#Jv^9~DMPdd{s_ESimdBkaB0fd%9mGFO9OH%ka9+&c zQ7w28@y*1sm{?Zbul{2oeXw7BLhv2rpI-%Zg7M0p=I5{LPqV-2jTQVs()l29+zjee zi}WPp)d}8CI$sLWc}Aqy_Bz)~TlS zw+eoM_~$}&x0`C!ODg=uEiEw^Q0PN$`WDvxK-T*BX&t+p}Kq0n+(;h|cpO zz4p&bf*&HC@iW|hzJ$0gm$v6J$w{X^MCX2yUfZ)>@WZ6@{ScjtujYQ%_FO9X5b3NY zF8zF;NU!bLCiqd(*%zYosz|Tx`I+Fuq*GAj_VXO#+Rxgad4eA!oqI!czCe5&WOEw) zZ>IT1x6sjcenapP(*IqE{)Cy_|Ju$;f*&WHCB&uw*NF7mp7nxz*?xXs57BvEq}TSm zB)EFeDoBkl_VuJaWyH1rwLM9}bI6_tLUbM#>9swN2|k{5ejcLpdy!t-^Jl^HNay_t zce!pMuFIwE`LN)VNoP-p&NIYyz0&8&UlTgo&YugOPx@0!+;(0=T-sSC_!QFlc!bEz(1*G%s5S^a|_&s2n_FL9mx1BkHr$~PxacO6@NU!az6TF;sz7(SK zv`DYp#a_WHNGJXt-+pP&xx}^qwLKRKzLa#9hv>8f_&ou?9S}O&&X)zRBK=9%xb3{0 zxU_SI;LAv7Lx@g`NU!brl;G8*^HPY;>oPr!@4pnhmUIf|xy$uF;<{Ygp6dj!C!Osf zI-eKmbsRedUrRdw6{7RDNU!ZVE_eg!y!XBCaxEpU%cbqPRq#gA`CN$3Pl@YsL65V) z5jxt=V}du4{;c=8?JOrQ?Yvp=t)%l%h)$PCukHD&;LW7->kysO-tXHf?Kwm6?WA)9 zaoMg{i1gZ?Rf6vzoqr6`c~+#?ar~a(50XxHncL6j5!dC?_FN=*JLy!1=-egJYkRf| z{xIo06Qc7faaphaH-t~0@2MC1IXIr)LR^;X!-98^J$nK=!SVD-kzSXpNANwQ^ZO8; z+-rS1r9G1c?DwvGwIslUabHJV zmrL8ZQSe^Ue=?vGthX9v0j3*JvU(>~xX*F567T-u)bf*&NEPlV`ni1gZ?M+F}so!3Hi-V*7xJ%14V z5b0c#a+j-$xNeVnp77NW{$dCpyU^Fy{?X++Q*yHBCgQT5uM+8XxjriRVbXabMCUn? zUfZ)@@FCL4`JmfB7ZKOx()LUh{3z+vh3I@tq}TQ|3qDLbdqZ>vM0#z{PX#|lIv3vH zE>{WhGhp`^_^<7mEBFZM+!Lbn8IfMw^S6Q@C!HUM=o}+H4s1CM?TNu3c+D^O-=&?` z3$6}=q@N@%>(v)TdTr+y1<%IJ;dMAf=PlyePCb5Iw#YwD+BseD9MWG$T-v!^q}O(~ z3O=56UJTJ06zO$*e<64t>0ElFZ@;wXy~K67v_01fKACj3h3I@%q}TR*LGXOi`B{k0 z??ifS&mRS!LOSzqa+hl{aa}HL&xZsrAf1j7ov(}Z+McHbpGrD!h3Jf{aMzza!3#;} zX5unl^&-8tXPw~FN#|=JI{QR=?VlF}FCv{YZg%_mV&dA*+MY`VFCm@PAv%u|*X>UC z5ARx>&NnzODh%N_2RLR~f)0e&dco%r-y*n9e_sgyl;B$Dp%DIffCtw{2Le23=fMCE zmiJhI2j|;4OZ@U-aZpEJ7tRmxpiW_c2lHJU!ka?)-xJqy*Y)R1f|p_@@cLyyCpa(t zvq-P&Pu5cZIITaAbQTbo?cz3(UfZ)=@G{cr4AJ?PNU!aATJQy=^QRD1e%aapbgkzU)gS@3ew`DTdDe&V`)6;k~_;}+jeS$}2{*Z$Y`&lbFb^1Umd6O8XJ zkzU*XH-axEor57d|0B|CdwwH$73maxC|$0gJs%*h%cbop7knA%>k`$ zoF{k#>3o>DEZ0VnUfXk*;Ekly6Qc7vaasS@-R8D)qu@=X|K$Ja?EK@iocBL|msM+4 zjYdO`p%{`5QBLca&T=MU9bu@He&{EqNvSjy6_ZI)3X^`xs+A}e)(CWpF7~-zcrH9+4bODR zv(L-I^Wgc;@cb%y_W6(SsqnPv8osW7I^2))@2zzP=k>;am(<(fPYF-+FEHggqU_UR`)AD)GVXRYMfXQS{r@YK0C=&yaw z1?Rfh=K|pi;PHM&QstqZMot^((}*r&DdsiD11LWw}Y!^faKX{u<*n1EHymEl4qY! zgjc{*|NfxA_Gtpnb+OMS!jHkz%kYepJp1GbKMBuj!?Q*5?DM7Y%5VC5OFFG@__|WS zxi0p(TzE|F;QYRZ=P}8%&p6?+@Vsw$wn?6Sz7ZY|&l&x~*L4{<*Tp_9geSl=!0?Qf zJo`)#&Yv5#&hY%;aDQw0{h34Hd|va<cRjpU1yHZEEmq4E~V8 zpECGNgHInA^ojFs{3Y>vcv*Nd*84rU-{1XudP4HN9wLLH{Y~IW2Uky5$+ORW!c*Xx zXLyPv&psatZw61@2ZEm3=W2($`!xhy=Qd0@e-7Fz$K%dztK`}9YvC=?^V|o+dtL*s zecA|b4bK?EGeh$1^NR3Pcz!TE7Y>fzckW|~@HBV^gX{b!OP+n67oHB!4#QI+dGrq$oChX2|m*Bd?k6# zVW;pe@FWinpTpn4bq?1lhi9DOnI(Dlc};jPc=i~cKP1n6iOG(hb6o2O9+f=%j1fK&o=t|QO!A!19^tw0 zTrxa--~R#5eP^Ex;d$`n8lE>K&pwNVPle~G;YswrIpQ7K=PcpV;pqXcbN){9?DM1W zS@2xuf6?_0_1p-qeQpt+56?8i^Ooe&YQ2YD^T>D%od;vTI49`T#v(Gca z3*gyic#cS(*UvHGh47?}3ZHXVaITAe?i0Qoo`r^|Sn}-iiSU*1oH07Q&z0cXr>Dh~(L4nD8=qRvDfzH19u5mZG@M@Gsf`Dl04`0n(+Pb z>@_@f#sxjKPrUHM@N@>R>7C~O`Dl>j+2U{OmlWnlKN0vjAFgYx@RR7X9$e@1jpVtmUBV-Eg2zjKGPqUGHQ?H( zjqn(FMj4*xCC@(7g~!74wc$A=dCsRocsx8;PY7REM{ur-eL4wGfM<%~Ss;1#StL9W zo`Z&`*2L(2XP-FXN$}hRuKTq}^6axrcw=~u7@oLE;e8qiPlhKGT>JEqJo^j~-UOZk z!?RxUoKLav6nN@B6~6Bmf^*;5Cq;NOcm^4siIQiZXN0$a=X1kTE_wDjAiO0!&7Tfm zS9|a{@9x^(FZSsmyfr*e8=l&^)qeMN=}d#)>u~?AI$y^IIoy5STjp>#U*vE%U+Qo- zfBG}kJzah~IOo85-Yq;8bC~IP+^;XoB+q%S5S|9lF~d`Ta?n%zG!&i=PiJs_9u1H@ z`wSMI0nbvyb3pQ(&o9C|!qe*6>N&gf`4>3X#Xffm&xB`|;aMhm_E{mkGd#x(PlLSZ zIkQiq@GN+42iG}2CwcanCcFzgUm2c*l4qYI%He7GT=<+jfOF35bF1)P@Z=eu`I2X! z0^xn(Ibe7?Oo^UzRUhF4;h74qb6z5O_E|1`Fg(W%PlM;f`y>j_hUa#0?K4pF>@!68 zaCnv(o<>u{`!p6l3ZAau+9zA`>@z}m4m_(2PpRa&U)zL_hv&=}!mq>2!Fe6B&y~U_ z!ZXzHERj6>EEk>&&vC<(I4ye4>~ogzJb1c+|7p&WXP*(mr^2(!@NAJh`+O;UIy{YD z44?CD;G8r2WC@=I&kVy;D0%jITX;S^M-5N>^yoRW&uPNv!1FI~opV3Qv(E#<7r?W` z@WjtB`Uo$8=MHe~Geq+2Gfa3PJgW`Q7RhryUkYCiPotN@_q{nd_nm#N6220iY{OG7 zdGBxx zo_!t{UINcL!}GP|+2=dqrSP2ha`>FD1?QaE=kLO|!ZXhBydrt_d0qH+c*+gW1+P^1 zeAN4p@8_>H_(+G3aPpHJ?!KS@)ZuP^r^DU+euumH=C4-wbomf)o#!y&J28h9j>mm} z`>EtP&o6|R!IPL@-N*G@3a)*w5WX9p!G>poJU4;s z^XNXwv(Np)55u#-@T`+Oum4TLE8vNr9rV{e7lU(M?9)v6F?fa;o<)*ppJl>N!gIv% z#JwIpXZC3zyz+;7deKbqn%>9m_0vc4>@z@kOlXeU=GNfaf>EQ*Un2Q~R7QJQ1GTz;#{yCC@$&3QvNk(C{3RJm*s( zyfHji&kLV(M{ur-eL4wGhG&Z5Ss;1#StPs(JO>R=t@+V&W}i6WDe&9`u5+FvdG>ij zcr$qR8J-#o!u!+~-U6O~f@_~1l4qYj!dt@grs3HrdCq6E@Ye7oyb-?d4}){x+2>K= zsqm~eJfBOReZCT&22aw$@IKAKwa-<;)8WZBJWorWee#57z_Z2h{PoS~edm0x5#AA= zk>I-T(?yl|qVxKJGS@6s-Jbzte%tv?^ z&IkNY^N~FJ%v8?#7@nh&ubPkWUYyTjV?N-2nvd|loR8u8M)K^lOZY%|nl1_Nb3M5B zxk30~cybNTY{|3FeBs&flpCHuB+vbdDU7}zhQreyT=#vc9;rSW-RIhF=?^m%uK<{Y#R&eY0936aE`TN}t_g`nG!r#Z?i5}v z`Ug(l_izpygwKM%)^ac89lF1b!8uRP;e6rw@Z4v3hJx!HUKI~}&JjKb{ym2Oq~zJN z#@oTV*na^$?Z9=tS(0a;uEGo8dByO&EqV4?CA<)x6NV@LouI$Y?R#`|LcS= z$K&RJ>l|K`Jp0cQz7n2q4bKtDv(GW%Yv8$dMX+A&lL^jsvCr+oi{P1NcnT!XK1+pf zfae#(Q+H+bb;UmQg%`tfE4Z$!x8&KUzwi=x-ZVVxB+ovZgqOk-`)>H0CxCO#?2{{e zD?FbVp52mXpS{Aj!*l7X@IL9_+UG{$JK>pZc;1ja`z#h-2G0@06SF$#sn5rFaDRUv z^?vdDa_1WPrbhmHaIQDYfARK?P7e3Kj+FWj$!YQWvz%G^F7RGIs7T7=U9Uu1m_$gbp!7a;pO11-m89G_xm%Q!0E|B z{tn^$!Cx{wZ%LkgRti51&q>2`=KDcU?Q@Rs3V7}X_vh)ZYq;duXSDER@T@gFJ0#Ef zlnFlxPm>SA=iC;Y>tdgF%KdG>Wo&e92h9_V0>@!z*B0PHyPtA2f zPwi7jcoIA}f$O?@OP+oD3vUe1V#BjZ@)2C0CBl>8Nmw5~=S#u4F7~-XcoTSr8lGJa zFR4*|y&Z74``=A|cetBxyCHne?S!YG&y(Oaz0=(5FkkXq*IePv;Mr?#8F>1AQ{Ub>HumJlEAr zct?2V8lLwh&pzvgXTnqGqwx8h56*S5&qcyJ!_(jJ%$7X+%om;oPr2dwL-Ons^Ktb2 zyTH>PT<6?P^6b-7cz1Z_8=ke2XP=G2d%+X8IegCT!TnfmKT!1f#lg| zk??`={A_sYlmw5jed2`=hUaE*opUeAvrj+a+3+khJbNV1`Ro%u9G>Q%1pT#71~}Kn zJ~s;=1O<%%{;nU$62d;B|N%HLT zs_;C{@Xa~bjrg%_V1oPW^p z#C{pvPfvH`>j^Ib?*y*%xnJ_^Gf;RbJc|s^2FbI}N5Z$l6ZcinU;Eq$&ULZREyB0M zGtKZUmpuEtD|{zBHMWQMX#}o)8Y_pVtKrF(Jo}6gz8juZhUW{(b3WUJm&0@B*Wv4G z0nT-?&(*^B!!y+IOp-kNOcs6^o{tPqndI4LkMIh3lD`RG*GO=#i+ys0AA@I|;VF}R zRUhFe;kkH6c%Qc5+NYiHNPKYqXu~sA^6WE1cnmyS4bSB}gU8W6R|=1XXBfCXPxBsuL|J_@Lc_E_?$a}b6xDyNq8bWQw+~m$+OSb!js@R|GV%$*MV!F zbm5KR$u&H)CC@(dg(t&PZg~EXJm(X$EBbn90#AEz-S=*iXP=(JQ{b6zc-BgueKrbj z22WgB_?(l$IcN51D!c_eeGJcN$+OQ`;Vt1=Z+Mz~AE`XF&n3cJ!!rb2=lrbX*=MTo zRCsn8o?j%-`TQn44W8CN1pT$ot>9c2`*aqb4$ljQ=b+@-=ZNqOcv}4!-lr3|_PIlN zM|fT`Jf)InpKZc3;W>AAc%L@l+9yqTXLu$Wp4TMLKJ$cU!L!fs#Ow)rYM;8oyTEfZ zcuns#_xrumB+ouGg?ESNN5fO&r|>?th4+Hz7I5veTJkx_7YXlMFL=Bf{|;`|lLXHB zM36sM_+apEh9_I{>@!06aClZ3o-LARpD%@vf~Qe=_`3Rlb6xB+Ksh|~49|O#XPMwcrc~E#RJPQp^k>uIuL*aSwMD~Txxe++$%s!2U zPle}B!!tF_KvJR2m>J|79shbQL$!q;^+c${~4ZSNQRoF{w%Ja-$OA(CgG zVZsaGS!#H?90+={PZ9DxgfFNciGkL1~BpYYxA zG(8f&t~TIY7yG0MFNbHO;h7?N_IXkGet14NJmr#Sp98`V!;?}GzOL)Qxi0oe7hVC+ z7{inKYqh_Y_u+2;iR>MB8hoh1KLlr=NQ1!hvG8*6Q;!Ds>+8nZ4tM*cfYYA?&*j1o zgQpsvAr5!nCr=O$`{xQj2LC69XSd|pbFc77La_cze+!?(NN}!~eR71y!n4-!lsep< z=Xc^^&mV;+!2gTkx%gOk|F+=Tzn$#XecWTfpjlswM%@ll0KI*antoMO;_&5HX zd2AP+iO&xSZ-LKiql5pc?@0hZNBCgy7Q(yZf!hl&0`KbZTzu@`m2L26gmV`2g~!6b zRye*r6Zu9swkuL0JQ1D-rvxAP%k+CDfnOrLF?hQ0Wbkgnn}ClHo&r8icr)-q;Vr;7 z3vUU&M|f*+UQAq9D)`wLEO{FE)xy)kI|V=RJkAUj_Z}<`sk({^Bt)iJ!UA!=Wi>=3&S?$b%H+p|0Y%S$Aun? z^Qw5=Ab+v&Q^4CR_g`?lqo?vy13pGMo=7v5*9-FRD#!cwZOZZflRszI?>`wc_D%J$ zZsnIM_XFP1K{;IaE6094p&a}5x^nEtI^|dofBs5UPvrRXIjT7Jt0``)IQAt&Irl|5 z_T@2$KkLkm|K8E}yL^@8vE0ZG;rKLiTsU7plhBubzJ9h6&ezX7h4b}um~g&+J}*4k z-(2r_Pk566N4^)H0{**jzJ4ZQu73YKXKpPGo~hhF(L4C}F{?aqP0~EBw|UC30UMR$ zdiy~+uD3sw<9a&>*F{wy>|ZP8n9C+SFa5kk8qO|FFf2u5h^DlYKrA-fLUnU2=N0-_Mh;5I+8=AlJKL zbe?>W@aFr2Tti&goLd6EKYNbwWPHEiIfKs-z7g*io1YQghmU)Wa6WGPApWQKhbwS> zu_yg}p81#227c=k+rST=V&o=RTGg`BKSqALDU-sh{spxnAyLMmgazg-;{hg>#OAfRaWPlD`##I#{($kK7=*pwx8uBGJezn2&*$eCc^~*Mka%$> zj^ww&w#gmIRf*t(%e)&uscYc*Wq5VsY03Nmx958&`{&EUL~?Ep9zQv_sX8mU>Z9O; z+RY;oyzocelYfhxh7B34kMjKEc(tKivlkfW&*&8-Ka_#%`OS^fCF#6{@n382wV!A0^_;_8^nKs_ z$NA`-^L*FZYp=cb<=M~ktaJEiWbvY4AduwHE8u*<377-+-g`~ZJ({aN&2`2&BU~mw zppB68=i`#614xQf?o`G7HJ_=tSGTcuo#L+B20In-DF8JTWN4H|l16w>0*~bDTL4gh zF6j>=g=dH_CZ0n4C&WvM8;h?1PjZq;%X|AB>8}v_ZxCNeJe7(ZQ{1zYHCziuKxhKY z|5^%F7IAY->dqX+z4+9U{UyZL({TyCuOi+<$2ZV>6LFN|t4hB)8;w5kHN+nz9;Gfb zE!j@In7C>0Jg8!O$wXokyyixEV9Ap2s2|kwidcn^pzDe)`;$6gz|5p;< zBKS(;TZx-E)Dzz>IQoHp?hyRniSHtA#`8Af-GYCc_#Wb>UOYzodx@KI{!8Kq1V2Lj z5OHJYAH;hF&w!zZ_WOvNk#{cfV}j=sha&1_^cN8i3BH1On&3AOA3@ysxsLc)p??qY zOrgJ(c$m0}^EZiS3H}`MY~rTgpA#=2ZsL51_(H+|M!cA~u`>b|7K|sh8()S`B)*C` zy*b&$s|240W4!T2Z_Y!+*9-msB)&=TZsJ|U&HQ?q z_!hwr65lHLTg0~uo(2x9`6c*x;=2T&O1xX}%Zcw1yoC5(!DGbt3*JV&NAOPKhXnsD z@m|5dLA+1!=ZKqA1{|u_FNmi>obYA%ABkrO{tod>!8725i17>yejf2G!DkZ3amwp0 zBwir+O5$?`Zy+8O{A0w61%H6}3caA+NATB(A0iH6RIh&!?-l$MSg0|ceZtNp;%0!GaXyPUt_S!s{7T{(1Wdix6VDX9 zk$70x*+4u?@CS)!3;q@21%kgwyo&aRboz9DMZB8$G~Ep6kHohSpF;eH6F2QWop=xNk)(e<@m}Jih%X@SoT7o@CB!p`k0bqN#giSguMHF5Ks-ttSmV$A z#EXejH#^&jmkRwS6%RS37W&FRFc$7GuR-MliUo7}e;>CjRAzmu@uZXV@{B`0hi5q_caEXm^s}g)H@mj$z zAl@SQCB)YWUPOGO;H!w^d4R{KnfU#J-%0!-!9PiSo8XTSe}p&dcJ6%RRcX@W+H-%I*)$w9N8f1Y?Z@inBslXw=K z2k>R$xrcbR;J+eXAo%OV=L#Met>YOLd@S)|!7m`bLhwt7uOe>7TM_YU!B-J)ByRev znRuJvcM@Mu+{EFN#5W242=OlB#-FE&ZxQ@u;#-BC-xJ?1cpvc{f~Uj&1IOns!6y>$ z7CeXe9>Et9-z)ev#P<_7>(ULxdj!9Y_#t7Zi+Hcl{{rzo!M{x$_Z@s3{*?ILH2zJT z|EhS%*-GQTTNiUq1wD*UnC#RNKcDzk;$~jVHu^Mi&AeDld=qgKhce<_#NklAnuu>B zZpKeL@ka#TLi|y|zefBC!Ji`j9C34Aeu+4qZ}DaPJV<=6;BOP(FYFJ8jWNcpN9dnL z{E*<;#CwIE1;qP^8$YimeoXKh;^vmP(O*YAL<^p2*S*9?2>yBExG%t$iT_UG6NLUA z;*$jb74fOU&g;bUi5ouyaN{21Rv`4p5}zyh1;nF*UqZZC@FL5noB%#HX2f zmEd<0uNC$`NxVhqKSF$+;7=3ZDD1pU{BGjL&)*a868e3_w+Q|8u{xd)5jXRFBJpj4 z=MaBH*k4HeQDOfY;=2UDf%p@`&TYh>6TFM~i-LcF_&#C(+r;+^{ygym#7#dQAbwEr zH;5l0ZpL}=G#$62!v1N*`vlJ-eoWZElz0gCNBA=SEFnIExT&|C_*mkm-&=@h3jI$I zzaQ2ie3}0JlHws}6-jO_n~0lsjfM+z zoWEVf$t~wx;@gOu_Rb*wh~QD;j|%=F;!hB#)1FgL9QRrHGW-tW`-GkQi602&Dy5D&q=17C)}NjyXFl+$(GCJ258@hsvdZc~Y83;oN9&k?+Y zcvSEh@lwIth~vHwU#8wp;?=}W+&)XZmblp;euH?6;Lj0XC+z=%_(oy>kHj|#{tofG ziJN}U$kg%NBKUd4w+TLz_zuAfi9aFuO5%G2Zy>&pxQW}xh#w$s;`RXX9>KR0KPc>f zmw2z>KPG-m@ZS?F5#Az9IzD>MG@aKr*J`rC= z|7GHb1n(h!MDW*%_X>WD_)+4pjHuV}@w&f8zqT;k@waWV0Qf`6EJRPb8jiv_=hc(LG{h?fffAn_G~ZzH}^@NW`dC3rXSD#3qD zyqY*oC+7h1Ho^Z$d=qgx4LE(ow+Q_dNI=2!<96b7x^>19-$k6JlXEWdJwiX5_icd?)b&;$|K_M|=)(Gd_Pxyj1A_j`#}VroDeAUM09QLHA3e;G>DJ6MQ1^O~j3# z7ZbmmxET*~h(9FsuOhxx@au?g6LxBdKPvRwi0=~o--tg!+>EyeiN7fHzes$q;ExjD zN8F5u?-4&B^j{|4BlLeu{E*D2th_56*jqKb>{BEKD0CBt?!k4kLjrje< z%{u%o;#-9Nv&0`FZq~7vh(AKyjL#n8PYC@th`&hOjGuoHKS129S0g9temNraClEhI z+^kC%5l@5b349qpFCm^Ocp-7T-olsZ#}&l0iJSSphWH%frrx#0qk^{+FBSZL;;RJz z0`Xen=6w21;&|Q0{d|V_I>Gl6-$>ltC;tucZ9@Nb;*StF?Rtm!F5;%YMu0&)@9ZIN z`s+;M`-T36#19Gkvxy%S`cdK`T9{2gUPF8=apUJ|;$h-uJ!vJLCHO|-*~HDf_&D)= z!9P#DfVipm8^jk9H}UBvUP|1==O@Igg#NFIw+Q=xBEDYeA0ysH+{7n6tovoFurr?c zBgD;lc?$7ef)@~fj<|{E6~tc@{A%L+h@1NcG2#aVZy|n=IBi3n4aEBd|99de;Q9<- zro9h`b$cfeH~q4McouQfFHaLMAa45Q$Hb#T{}tjZg#9DLtAzgFiMJ3pehxoJ`?*o* zpF#Y7VZRr6lDqqMyw|zNO>{jxLUFTNcsx^a)7u_DUvaam@_3%&CW;=v40s?;y+umj zMAy?_p}094c)Uh&6BUo&qPXb|kKe7h866&n@IXq(Uyg?f9SrCXS%SBaJV)?df6xUA z1TQ81%LPC9Z7nDie3iyd3A~SSf^_6KM<(fyYvIk`D#zKBfIpOgKLK5f_Kn>KX`k|a z;PLFwfG&^6=Op0e3HTe(wLH!*LVw_^Pw*XeI-c(cK38cwP7sCy`u{NuIK0gBx97o0 z!Ez|Z*-hCDfAg*uveY)Utf2I3$ zmf+!Aw7vO)J9GmyDtH<#pdS>xn1;-Cf+tbqD+D*sVQPt+7-egBoV8M)rucfni%EZz zumi(Mz3xxI9~O4DW@-Je3f>jd{F{QWf^mkg#|3Z1M0I$*K-{#8%scx8hucl+^@^}# z{Q14$`ITp@t=%65FI_TDMQC}n#GkM*IlwN1Ms(3?R?rlZU4bSze${yDu z?Ni5yNl%Y)GBTnaKZtfbu;L%bk3WuEn#b^ZCED4J0L;#NEEkTA)eX;O>~=hbCcVPlsG{)vj0Q8kj?%%;6@Uc?DtJ z4>3XtS~~RYJzijS%QtUEB^5smo+-b({SaUr$EHhq{UuSwSF*Dm`}{AXGn~JSKBc`F zyIOaosZSy7FT1`zFopp#^*PWiQ4&?+)Q5x1)VIQ4pF*O(yzY+3-rbRX*aIDr{g{u9 z9}bugJ)Q7b4ZKUA9ewvpa3+sdMtY*{-5*^hI;gU!Ckn$Rx_jZIG_>|KWWUk)X~dpF z%a392&r@9tJ%N~wN*F)N_GNd$+`auo=27A4pliO(HII|tHILYDzBAMgO3=hZosmNu z`c50&z8MaWNA~TG>_>q;9n&Dt=(FjI3=I5Gb$0PfXNA?aO&RI}(oH!%)s(@}AVw|&G^H!V@`^|SQ-`g=(g_=dQGqSg% zJqv?!;uxZeiD4J2KGc2zbWv9LOS2>>9TsfY>&!R|Yui=?LtLZvJ-) zz&Be{3xzT5OlAvdL zVUgXq7d?ZOJ+j`iu(@cxT$ztYdOIV%8~T!NpK7Vvm8s=u_~`bJL6wKEf&JYO7J#kL zWWE4kxM871YzJD|zHA(<$#MG8TgOp>_2YKeyzWObkJx9vH~s+ZO*8;^xVEhUh&YaI z2j(5e=; ziXXCPX=hPS5?t4#SI;L}4yqvtd}Py7gV+weRhM4T22!0^*&5yIbWc-ti0$fN7!7u1 zYjbVeLo~i^wX!Y5F0n7nDvJ`XZ0p?$>|yGw;P4SZ$0M+(@9A8A05p zgwtO)IKl@FEr*D`%7?!H-Q$|K;*8jDo~|?S3S%Q?D-NMKo7{f21`c9>ebGT*Hg&n? zt>z%M&BJgx-i<2=Oyz6rVF^?D_%kP%##`JvtR^5%P={_tf7OU9z^!gIR#On$)nG5U zJp-GqWuR}G=W^(=OMwre$JWC#A7=m}_WLpT9^2%ax0;Dqm}gVkYjH>W3OIAo;+<$R zql($WY(jNh-*Z>lo5V+2U4Xg%EN4 zYRvtD_Ei`R`!uPLI87dY6z&xbVdxwJ^Kpg_V%srgd(e};*EMgo8?kNP4e#J5d!Ji} z)rE)?)G?$kbmC8T#CA1evTwv6qcF|mlYJ`iA@o?WJCv;EBKG?+_{qM)HE;D8VqreP zWbXydekMDrn8}_7-J~ab27F?Z9S`+nM-{Jb6Ure>_Em1%tk5C$?7#cTUhP(6g%EN4 zYTU`*2P$H+Dyy=V#I{dEo9At=d8^5Y{pP8;$Gbb)9qfI3byG+*_%Qz9 z%Me<<1YBG&jo3E-F2?M3w+^f05GSZ(NUPfpw;HP{i0x{y7u;2B z_~?yuK;Jaa<#2m@67V7PShhQmtmY#2`!V<)D{#$Q%|tBBCs^IKf@VLf8>*PqZ3n8W zt;{a?#8x*v)T zS2F6le0TdQxKPB8=4$aEUM<%A1uRwS8w#*JxZ1uJh*s*0`UDSw_PSS3)__7R-Pbkf z>C;ao;zD4*TZt7T#BnQeCkjlU`D&sJv31+sO^MYy#BnR888f)n?QkoxT8CIv!Y7St z5jC`^H8j7vKJ655&PRhBJejU>D{zSY z#{JQH*MleQ)^9Zq@qp@oF9uJR>w^^o!~^kxjhHqlA{G~g#NuMk#z*jM{2zE;XQL86 z!pz0QFmvxV49ES9Lo8y(;VwN6yV*GG*5hy&YtHWWYH${ZdbIQUJf+@9n>KEMjWk<<{P9*N%s}c2r4J`+hKm znQ5l&J^j~?MNI8`+}iirwd0|#9aXH_4?+1btFqUt(xfM$iVCTnp2VWo2O5}QY5c}p zF#Yry7BPPBcm3|M{l-J>H>xndJKG&Bv!O2>Cvi=Q?8G&72c0Lb>3ippxQ1;v;}BOs z*ztmA05Jh54cdVU@F-P};r5LFTZV;9%MPKJYBcu3CpH@KP`3E%7VmwhLZg+wsSzrpk@MCJv?!R^{Vrs`zs;(VRZmf2FuEW~JS=Sp(P?Bd@?6d2{WNhlhIPp$cmTUqjSN!!ja{s)xaYe|jH< zD)_*|Fv5&O%xZQAUV@Y=Z{UfA?8T;tZjLhLi%%W_YSTDfzO`)6$LbwA z+gU`R2EG^4TaJ**yot#VXjw|=}Lt}gl!jt9VUMXqio6* zqbX5txBAwCS_P~zw|PYzWz&uOu^SJ7g02-3<0&T;(&F*94xUEhgpc-7k=~B>0y$Bn~2zs{`(bse7^=nCVRS z#&C664e_^~+6uE2FUX8j+u<0JqdVI10T+1}ecXJ-=`qlBqMJX1rJhosFpCcboPjnd;KL*B~HoxqGXT1B&x(I zc}SG(^_N7II3@c4eM~>i02EKEGyO^t?XW%q@B>wfq zkwn)QX;5jLwG%Px6n$xQB;nfWnHSgO8LoM2i9zf)Z%(vu@jv*JK&D%hwQ?f%)zq8d z>tEh}L0o}{UE@|W5DVkp6gA(dSdV>(7vX{4S^M3#9r;R`5eMP$#%_K5k_pAhf7cW=orR2 zd>-+Am;&$>u4|vcuW@a%=TFflIeDnzqwnp4sdKmh{+!TWm$26r#~$7V8-4HJ(cTx} z4-Q?h86v+_SM^F3{12$5{6+?e4G4bgwCQco}tW4}2SpTYSL1@P<{u3VhAsA*Ui~V zqsp3lYnvI%hFI;69KuPVe|!QrcW=TW4EMo)CB6?jF3#o-u|3X}?f5s0;BGGcAcVMw z;y@F%acdGGj$^#@0UZCG3qN+OL){(`@oI|~ufaDs&GpGzI}pe5X^;)haE)6HMjXd@ z=kg5Q+Vvn8tyM^jr{j@Bu#@k60Q(lU)NVE@zIIf3gmaX!aQpjJ*%(6y*358?{?uwGR zvy7(I5GGPL)E#FcA!c#WS4sHW67f>_5>BK&u5oKzA&z65Pozc&s0h76G9-haNPAtM ztcip;j!%PZ@P600)nLSNjJp%5&EHyuL~Hd#+R&Fa`kpah(Ta~f9{BXpqbBZr@ork~ z>;Z#jhD7qZVN4@oPO}L)FpGzL7LhQE-f1Qu+7Ck*e=V!C9S`tqd-o7e4Vh3&oDq$f zRX)TK9d?ad9gH}RaXz9qfr`~*n>Q;Y`gjOaILr0P8qtX3_%z57o$VU88jLuOad$*_ zfn2m!A<SGu0J$lt(x3L=`$K+_pn+`1-xU>YjfFG~8R= zyhJs7BJ9SWxvd2`*Xkb2J7-5#;J8*!W-(O*;WKRNf-Y;gtA=bE=V z9I*j`@6%AvFITyuZ-H^Ez`I<{ygRYFGvH>dxeIGLqZc{@FA&sE z--L$T84e7rIExKpuTHvmbSU9X#)O@b=9;%U1F>!Xgq?x+j&L-an`WET3}Dv@rZakR z4!-A|vDZ4UMEET|b-xRr{~v|!z$U6}ir|pDBg2iCH8&93@lwm|pyx)WYu@S(#J2ep zb_d>iJG}xOZ9g+<+Uc_T0ek=ySWHZ$sbEyCdwz%jyoqUado)9a*k< zt2+?e=15jhlt~+1?vPofXdF+mCfhhntIPg{sJs}H2)95!kyK$B5 zXzhX9FniR;&3oYuZo}+XZ<}$$7VV5=B)AQeA#TG&LEX9ygCN0em^2V6*Yph+eH%vY z5aCV?yXC^~#Nf3!oUk1zN_S$=N}@9~-pA3`YS?`yIIs=Xz3Dzf*FOQH!=#>yLEoxd zB8R{@^yG=^KoxUsm<_e)`U>p&@K9eHq6!;Fo$VNIQyrdesXB8nMIo`lfd*jjm{NEa z6{QsNm4dHJRXXZc_f!}FhhM_20&lvOtC}$u`g$DCI{kzIRZIxxqB_>RGYX$r$nj8z z099BBba-`p#VHyRD~!h$W8jgcU@Za*ixGdmL zY*}6<4$onj4TtZ6KjL0G{8&x2a+rHh3M0glhKgb2#Mx*dW*vlAH5A3ms^A|z8hy_X za9-Ir?L|eX$1*2ZxD`Q{cn=&9+Z7$Yv0u}o4Xa$!*69GTZCbS9(S9ouZK!rDvf6;y zuITW!XxbgSzV8f+P>J?5y4C3RU}Z4j5!=<68dRU$F27YPDiLjIb1Ttpp-K>oN??k_ ze?;DwXi%+pZCf3JIF4<&avXinHTc-T9#54;UIpS#>L#}Wt0NHG6&yZ}$*8tn5f>5s zF4wdbe8jftcN6?AZY5Um5sOL&AN;MZZ7cYQ4`QVsAA5H#i))e_|6sZ ziJckoP@fr5g?Yg|IKdu--EUjP4D0)CNIZ+?Iu(BSnNF7b@MQTJTw?gy&pyxWjvT{j za=0D-n$XvD_s+pW>p=jIT9(6PeJT3PZyH0mCypKyzQK6lAG%d=TDaF{Y7+-*KU_KO*;UCA#T%j$0kAh z;LG19Xdc`kiddzpYQvdVdC7<=vJa<7*&E;R5JMGtrL2lfW#ky15dBtoRAzJiyBgKO`Auiv-eb+t7f7Q}IR{Ak-kCo+Hx&LH- ztL?v@;7PCzsZ_tlxZL)?6Te#GB*AVW;SZ}W-_9FB-3pK6dAC}%=y5ZUig19j?%2Vb zLlyA^Tm5`su;XVJcb__$e>>e+RpV!7yt8@2@zc#6Ce!RDGj^{!kFRcMYPlqwHMwfa zCEs}DoL*791fq*p-wOCs2#_KVklwW)7%v#PDRwW7JDsiuBSxVfdg zsRchYHq_L&*!9=Onwz2W^7?Q?eau(O!0gBBs}flES_c(C6MaoNTz8^)G|= zR5sN#wuH}{Tos0bXs^7fsr=?JwRmlLZEGx1^H96C;U)-mMMG=7GH{}rwFmFIeqR7u z8yn-eP!Pgd;W(w&mM&i$=iSK7dv-wUd&f9P9jCDL+TsX*UocN|dLKsRN+QcZ({apu zL5jAwAUdybN#R0OhJQA4Qy#S!i2sdG=!wxY_RYJo!)^1=MsCXYS5HAmx7)n?+Arhr zULPljZ=sJ<|M<9$yI(&MAFLhHm+c;~A5=bCJRb)|p?ObG{z{UYcYnLIJ=0%&e*Iss zpa1_}U+lP>b;I<7c{l5iIX3e!@w>EZAIte@)&cWw?4D?z8y(~G_<&u9k^A4Zp5gA; zr7>!_8LQ^q@L{5!f{-QyZIkg=+QWHdUVQxjYm7g=u9?^*e%F21U##W%qBI&Qod>}+ z@8+CT94%BKH}8foT!v>c$1(4Q&s$s^MQ+{=Us@Eo0=aq5rZIvn-i!C|$@Ogr`?mq^ zpNbb3UWM^52#tjQFN6KZct?*QZ!co{(7c;@i6e5bYXjQG|A$)E)NOn*?}iWEu5LA! zH*>(en>vi&W-gd_DK}%^yi2*61LmE}wHJ%T`D|?BIo6aL$Y)ayJuY0fU}*_l+?aQBe#Wtm|3h0A%quB{ zPw(#Yc)CXVpR$W>DTx%#E4eD{gd6HHRS{_$sZAwUi@Muj1+&_w&N$O8Pvn zwz1mPSy~rcQ|^?*m34iUX~|L;g9{6bB1@JPE?ok)!WY6Tto}lqBg+aG zE=QL&$M*%(^3*Yg8DDUaRg^6U{|a2J4pP`kV8{e_Su{ zGxh2J*cjnsBC9-aYEAys8LM-$r{zIpe8)3&EcAfT^HqJe=5g4Y-{G(~@7?u4uMt^f z%fz|AwZ-UBJg$f=b;oyq^I`GQ1@qJilFD8^4<=WFx#G?>D=sxT*=qclcL)RPoBv&3 z3b1$7aCWlzXXBguo)m&MDM;VI0->3_V9%{8~gnk#Et zr&X1=;GE>~p9#kkoD}dyp9?0zG5ni6PBQ#I3;x&gkUBS@ECB!GPg7tSbKbz;utuH) z{~H}ly@P*tUhxpTp95l)qiy&cM19oZp9fGMESQe-Ue^}|&+!I3`h@?V4b8{*(eQs1 zh>^izTz^r=_|88YKe3%CpErNO!pNd4qJ?-;qZh{4#0=wVVutmjEh9rd0itKlCx+ug ztO-uKbLfpfuC`Iim^8wk7aBIqRZxq)RNp6YkcF#hOMq8E-2j6L>=(M4wZ2kjO>ub5-(BlHp5in0j&KO6p!*KYIy z^+v$|rd@c9WeQ-d4b*15_;6owKA~NlPf(|tTPVkRq+b}Dc%0iq8$2FRB;o68U)8aI zl_xO0xw1OeRKBKsI$jzyPcN@3ubY0Ix@fv?dUI1{S#@PuMcc(y_?YtIn)>FNs+cos z4Q$LCT3e*ji-MTIw37sk_qC;9+Rl)stq-bduKYxjp&pv4Ox14(bHgHYT42 z7lSn|HFR8^Ja#x7)6uHrQ&ZsxFO0PMisUf})U^kp(&SSRmA5q15h+d{bqXq#I~$>n zVK~^-D|zIpfq*JnQ{~(%MDv1y=9)G2<=GB4J8A8XwJFJ?lLD3XElss$%t&e=GbvC3 zS2-<8(X$>%4T646b7cc`4ti^e#(}853Zm^3B|)jC*lKv*>wHC&N`g{Q1f)Ju@T{Z& zbX+`x!AVL~*HD}5uMCPcw$@ixmsQm?xA?3kWq}x;JGUed=RrWq8|rIs_LsaQDNw7% zrEEkf4J6uVB|OXal?;t_Eip6}T zf>WWV8X8-Cp$q0D1?tt~c)zFsM0f!!y4^`h8XeLj&Kg3&OrXwpL~jSr4h5ZvPl zv0ITJ3bZ)yhzf!;LD?Avxzg77ho@4FO$}Af*-~&BsJA%THg-}{u}(EBS}R4h;~{uB zCFa>>QUf5UZ*Far4M+_@V0F)x#TDmy;@C(0r7r|AbZ)$|4y+MDnAng70{I_SbOM>d zKzX^dR62QPFi=t9tdw{nXt%DZb84jEJTwC%OY#fA4)6_) zInN0Pf@ed>^+f!M6rB$uoQSVT0feQd<>tni^O}_8pd?o7yd?!Qb&;k9zt@*xHMQCY zcwAu(^`tZYl4oJi8=W^K$MvALv2mtzOiFM)07;%R z>`Z%(jDp1lIp0GGU;=9xB!XdmA<%Q^&zr zSzA$C)u=aid~%F~g#<;-mD$c^w!PGGFe1xuZ1nB%#^L&UBizfrQWnStK}AD-Rkm}D z6v4Q_?Uvel)|I#UjGm6`0+xmINS#w<7k5$uqmu*pw4m8)SYTW-oFSWGQFH3;5~+d7 z$pJ_Stc|re|7MGvloV|YYqHFR#wG`1Sc|jOE|MA=pB%VJNp=ZIGTPExyI8${x+g- zax8>bN3zgJY*j37%twyXBD@my6~mrV4(9k}=YtIAjbAbqOI21j_+v3LFC}mTT*CUx zK&x(Otc4A=@WDwL3%;-RPr*~5JHTf(HxAmPIQ5jXz=L`%`>T{ecfb%+W2+^Q16K3#(zeG&J4p%#iYYEmxMW6v8voJYkNrQcA~Y zDQr35No#|Y!b*WYD`}4NF)6;lGu`4mD5W`C3Iomgija+GPL(yq>T2q1>fi={mGih% zgt>tp)T{eZWoT=^RDlVMDzK*Z+9D_A9NioK6U0Oi)Og(?rg7@T@g!FL;gjORkA+Q# z_!OY&NTEnmp>^FSzS6kLx#Bp*VLG|ieG63T*)U<07(*#-hq-4~ zzxXtb7p!A^I@8>$WKB-W1<(PFvr1E`s;R(*sHAfd_{}Dfj4p z>quF2W%iM+35IO(5CHRJY(&Vmf?Ulz2&O|4nQ2$Q2iRTI0P|6okADP)jbJbz z4DSC@TRXZ zBn=PTXA22@DT>)fPlB<-{32Jn*c|uQ6QLb(-6;r#U0^+*`W5ROvVY0x$(_ zP`q%y4In8g*CxwK=ZQjKrErO@6p@CpnUGm&YZaG778S05M|89{6fZ4xlE}4X3rgmd zE{HBHgftN2?y?1tzG<6))Uimhji3#S3NZ!I6oaHlp@H?H)1D5x0^#w%f@Sl{O6Jd7 z0y*Kv4x(j|$U>V$3zwBHExFc){(?wyY$eQ!o)-rRH7qF{1Ly5>s8a@+g7D3|qQdK> zi%aH}7G51G^OfQOz!YygN+nALfM(hn02bN=^X6;Rd<(7m^&Bwc=X;PQOv z0rR-I@79zMFs#7;xH&H`51!+$Uzc1y*?ZpHl6*aTzTB9+_{;!Yzt%ZLVAk7{CNG93 z#c*@2tiH9*xz-k41)|!T%3CVRof=zmC49YUb(Pa*(~JSIFM;$AZs`3iM;aUrK5o3%(`=`mx|K8xQEQ;K&)gCjkSrVJaf-|Im9t+NwoE{4+AMR@xkt{U;N;Hy$*Jr;aj zO4(z$<1TItE9kvEVx`s z=&@j#;OwzrjTE_$1)HUW9t++kxqdA8ZxYjE!TTkr$AS+_PLBouQ*wGN_+81}$AWvL z#CJZ1~u^<%+dkOjzxQooM{$H@ZTW5M&JXmF1Ov+d#o zcr18{U4lOrTxN>~@>sCeF2WuQZWNM1J{EjP7T1pjzhvW+j|ERY7IZT?VNHLZJQmzx zk7Dbw;4@Oj9t*xKW&E+=t5V1x3;tCKt;d3?1@?l*9}A9`GVxgOA}RMC3(gfH^H{K0 zaPe4hr4ZYX1sjFbek`~_O4(z<2ZfA37W}f5S&s#GNhy0Q_(NMZ;Kzao>~g8rW5GA1 zFiSu9GEbobv+WMcS3h$81KQGk-5)#tP=gwcqa9I@srQ;yeA0p9_;DBqs~IuoE#SC(8F{rR$8YaU zltO-cCtC`w+dK1xl;7T2E@k5O&T1+5ZtvVGMCSHRr{LoD&L@P}zPMsJSC;< z_RdQ}#&7TZPRgv?J8w!UyS9hooA$?|Mt#rq>6WY=WSbb^7hXA{q|1k3Tt{< zw|CBvGIo3CLMh|7cP^DeetV}#2<7daGAU=bcUq*3-`;7LLUw!S6H>-*?`*eaC;oYW z$82Sj2eeyalLz!ODKL3JuSx;S1NyU&z2|vA$3+D?4=CeWdn^P^9?&^bp!0xoZ9Jen zpapiB|C>CZ)X}hcF1K^~lQM^^??RM29~3SoO&lI*gl`FS``1RpxXN?qGFgyUi z&bY>Dl7gvFFMPGtxlIU?hYb%@HZ-@ilvg;Lr0kU8@U^RYCHuIPouSL+V!_W!A^3*{ zmGCPk4qr^iSo};%pvg55Yv)xd zfIg_lFQ1gl;i3g>NC~4&|DX{Xwog|4$b41tFj2PGUWg_HESP{Q%H5GPN%uGIc^Lm)Ff zP@aw6IFs!n@CzCsQj+OXGC4g^p(JypB$q{}Q58L9}|c5*-tw(?GOFhw-!z z*`s3wi12&I`0em%LY59OQS$+0Vi2dMpH4FTBDzl)_JsbQ_(;Fdljix$=7SX0h&Aw~ zO`qL4AggLOJk6r=Ugi#lb{32Tbn^tBSkR!)ej4-6M_&%zqX;mxziRnDPfQ_ z#u{7jTWi)R4Q8j~VlKaPlp2JX0>`%C4Pv7QNi}9I{wx^_TWZp2s`XWBcy!7B>F=k0K5Z9B4d|TS?Gl@u-knlFIla$HPC30l zk^Ca~#R>R!{sGA;r}wbrCa3o;DKI&`Nh|G9^uM0dn;{%vIlX5}k;&D?w} zl+*hS$tkDzDalPv?+>NG&FTG_lu%CZZvutO zy<;V(oZfRJr<~qtl2cCarINcjy-_J~b9$Fc3CroNkTR3g+aLs1PVYKf_^xw$J8XOX z|J2WevVfP<`voZ)Tu$!}yZ8WddLOq-@SNVC+MSNd-!dWqKhR^Hg#(!*0*y7kZA;+H5rL|k%Hv7S!2)ot;V*LmO7i^tBC-`nlnbKR zn%pM%aXq=K3S2TG06Z7ue%bsH0r;6!_|Xd~f}gQH`881Z=B)dDPWAQElV1ac?}d6X zc^`cZ^q)Ozi2a&CzaQC85%jA&Fa^B0#UBLVX+C?i;2AnDCe}|K49uP`<|W3!x8&m= zIPp?uWNELc_bHSf!2etq;et-0l=J}n_uf;o=rpxUff&JYs5t`N#*RF-gN@z|Bn*6}NMk!a&)H zD)++MZxD4;EH&sk&wxDeJWV`*NTT}(3p@w=rnvcMuh;@F|LiSW;O3u=f*ldFbb|b| zV5iEsfnWU5KT_uZ!hGkM`kU}I_=D~E>+GEqHMp_1yt!QeI(t&*B>Gl;J^W5!2!4(o z)TU^pe!VBOb}yo7x+MP6PiXCaB)Ng4Ti|@9er6}Mwg=Iyz(_>u2X>OyW&oKJI2{T6 z0?v)_-TTax5D*NT{&qh8Q-AbZ@C7+D;Md>7$)C-IJRx=0FSxeapBL11>&d*JlX*dA zsK0;mf+oQ%;P+#BUeF9FV|hV~q>SeUT_c4&FQ`Tet-PRHg_P$7-6LfpFX(ep?&SqN zDnuqP=sCefUeI14w)27x3aOnJ^tP0;yrAK?+EM3uL1#*tl@~NsN?Bge<+g0Vc|pZ? zIXf??QVK<0P^*;lyr8>;(9R2bNJ_1|ps!1*ofq`16kB;gKbKOL7j#(266OW{O)C2H zf-=|H9Xa013(B@dC-Z{d?|DIU?GCl_f=Z-}^;v5 zDi9Uuyr4o!O+SdiC@<(V$tf@BT**yd&~zyq;FX&b& z7+_w|ouVAe3%XB=SYFUWQfB1^eOXFbUeHb{`bYlUeFy<;^qb2BPA>^=+jbW@`APtft44u(-yw#yr5@od;RAH{X`b< z@`4UX(ctoe4%@{CkQel(U4rKYjrf=~MhB7?G}$h~@`5fCl0oJLEtkc0UQn5h|5fsW z;EN%!x6uzi%_s9qF7T+#DL$Dvgg?1|GI6NXivj)^{>j84m^AQE9{yuVG(!XIpAKQR z`u)hVMEcbon1WsaOh$%2I+-|xc}HBNsX0v*bD=|Ucpi9+%i#+HRnCJu?5 z8ZV9Jgn3el)CQU)6i@H{lsNPbY|~h}kN1zzjDsBz6L^V3(`|v9ICO>0Pn0wikXhrbHF3MK`=rODHSJ|bl-J?LXn#?ym7E`>Zj=!;Tlr3ZaSNO^kD z3sNT1gMKCDUV2ck5SjEK=ks>+MS9Q(A-2$5Bh-++UY_2rPN9fdQD30^q_x8v6UV)<_mVe zp25ZEM+`B=x^)BpY7rIa^q_W0O?uFSQlQg=zHH+Gr3dY@%ltE@2mL^}XwrjTlH8;R z9gqT(9`pw(FzG>m5dxkb^p2FV^q{ma+QT@Rrw5%Xg*-iIq7ZuNK~to}O%KYK5;r~Q zav|}4Ht0$zG3h}oq~M<@J*ZOnW~T?$ODRhax>?G2deBBG24+#-V5Bi7@vGkz3govjHeL=|nmC}R$L$sZz2YpA%C_U&I z$=&pzA4|z3H$CXrQe@JD{wxG;deGl(!O8R>yqmr9gOa~&x#OhtmmZX17cl8T zXGv_*gD#W;N)MVPIi&|Jl$_FoJ}5b*2Ypy_lOA-V6qxj&HX-<5PY-Gr4zTo~E-5nU zL7$ZZH$CVPDKY6m-;sg=rUyMM%CYpIA4w5Q585wfR(jB@Qp(bU{w!txvgtv`MI^lR zpb^`xd73(sr3alMWt1LtzT}i1lqb1K51K0lZhFv_QbOrLrGm5cpbtxtn;ujxC6pf2 zB)LuxS|>532X#nJ=|K-lPU%5kket$kc1Z4~2R$hzZhFuQQo_=Mej#NhJ?NkiSm{B3 zwuSFHJ?I~{z5dgK(!XMluyI~`P^J_OEuPLDTILJUu9Ciw2S&RBjhx=|MLO z$sp5%?vurJdeEnB{4bIol#(`jWT3LP)%tOy(5R7tsv7uK{uk|-q$XcHG7y9B^sl+u zc~Xipm8hk{d0t3@<3Li`+9H3lC^dN^7HL^sUg`Wolu4dEG62s3)sF?dDr8Ae6Up!& zvwlN}gW!Alb|m}= zK|@Pfd?~c9c1=^GEas$)&>_#UVx9uV>Y+K(vlM7;ZB6AZPUx%lOiwur+tN_K+8He+ z(3qNX=)Q?UkV=9we8f6M2vc&fqUM$|WpkD-#UCCX2|oo~D}R{tR7LTzud~1|lA4?k z9Z}Z|BVxIbq-24Em6cAp<>KQ_T6C6y-sMjZF={AFqWzpntsRWbWLwlA>ixPUg-SsPla9F$_IY;bfkckbkmZi&P=7!_8coE~WwI+;6nGI!3+;(0n8_=8!3+2a??*ZC`r_al3zboZ7Vst*Jk&_1k9| zQZ|_f_7RrGS7XR=f=)pIQuhMKL&M>306s$=-}IV#xJaprm9^G4#hRUIjsrjFS_hei z(-t|-!|(jCFZ8GU1xt&HmM)nFC*w%TyalCB;CH_Ve&-0{3zjY^Em^wQ34U$+f4mji zl4Njn9%Q-)d+zLfCiJL*xT{&_1V8oX*SCf~5j2LEE?-hu3i#mW_GdzW8c#SHnYS=f z;sn2V$6sGann7^c{F1_jS45oP!yEQJ9QuVZQ5q>KUNmok6Wn+FXWK$iQoec~6#xFK zcRUk%AcfH4r3>bPtDFBHz(0&4ctvC>RdaWM(1OLwmqBx#;7+V(UkYqbgDR33wctfb zqXNNygpz`Ra8~A);PZi`KwwU0R&YZAP-dnE!QIJ#FAS~#7Ca^C_P~UzCj{pueKatk zg5J&X4HJTkuwd{fxx1?c@}9~@Yys_L~Efy!Ia>nq*DUd2XDu+w_~AQ*dTrUOI7Nn zpq42G`t!-)uaZ!0J=R&Qw6_L7j*7)?!T(05w6|M=H)3I}e6KQe3OHUcIXD{K!UhHJ zM@wxKz*n&B{5jLQ=O0vm=S=%X#e9lg(}Z9t#!^QVqQZ`B8607Bp>?y9G6KP0V3SIN z|CNF+Kdr)4f;G1%Be((oY*yifzwr59^%?%c=Q$9hsgr{XRyVpT;`RFPIs8 zN_A2yjIg5MDEJ$!!>9&RlGY`zsA9rfQ0ZF}AaHY`!YRR1q2QF@rRwiE_j3*mo7)39 z!4IgvXSkowQu=2p{j-9Zz|Ue61eOb$Kp~jIV;n4HS89o;NKMpTwMq9>+)U+;K zEa5drzqx;pOwu1iu)I1WQZnughQPM7VOZ#wAQ_ef;{^_fr9ku5OO}5S9Ke?>KRnb9 zlK#tY85X~MO6X3I^k4q2QxcWG86^Jl3$?oYw;&^a`C*}*5C>LX#bLv+J82EY_~I*G zd?#p;`a6{Pu4Lth65oed`Ju%304qO~_)eg)hGvEuUv?75e=Z*XDXwYFH`l56mRMVh z1OM#IjqvYBHN)?bR;`JZIhEDraFfodFR#PTH7&8S=GaHdR@b#SNMdz0EoD_T zK({tO?P7oV9v4`=xzHp}Pp zET7M_d_K?e`8><#^DLjwvwS|!^7%Z==W~J2=K`P41wNk(d_EWWd@k_$T;TJ$z~^&; z&*uW4&$E3#&-VE|+voF4e<@!pX8T$(+t-TOzE;fkwPLof6|;S<$jSB@%E|Uw%E|Vb z%E|WI%JHLIUwdlttGWKJ&GS2v=XWB{??j&8 zi9Ej(d44DI{PD{3$1BetuROo^`F`*7{od#Mz0dc1??1KW_|Ky``F`*7wfA)mwYh4m zu^KiNur*=lg3!WoB9PxzwJHcLzpHBbwYAjp zE0Et+wXg~;zh7!$6)>0d&T*v)4RMkILt^P$WSeDcx%2vE6<#1 zA6lzt?#z5!nuphnSm7l9qGc_fxoWQ_5VqAuYKLhfwZ#+&$C*IbQvzX634}c*5RNl} zaG?LlpI>=u`ysS^e&wm{htTr*m8X_(q2+TmPwi5Lmfw4|eA`;;v?7o% zs(EUkC$xM~%~LD7(8BRAkl%Z?qUSm0-%GK!0eQK3>IB@-7^_zw;GYm~j(NIq#-KG^ z^VBxXMrsuk2per9wcrYbjkb|mW^AOE8G&$+2;{F(Ei*#PU!z)PgcgQbAPloWIQ0a= zL1H7d%n0Q7US0bOEga$k`Mp<{|3b^}y}AJ)wEW(yTL89}I{yjeH?PirLd$Pno&Rht zwNVzx-)wbe6IwX41@il)&TK-<@0YsIVQZ-y9Rm5sm%7y{@AOXxX|*C3AJ7cE&rHMSMfs2KQPseY@y|ky*fqOT52aQkU#e76e+a)u~(-^ zq2-Ug+KF3Q*?gmG-7~PZ;?{=7S`4gxw6({!_TM>nMOIBYR#iEcdH9#u*tR{#sx8;D znQPh1wQRzUido6EYRI)}$hB**8kB3bDA#&0lV|yoXZez6`I2Y(l4tpnXZez6`I2Y( zl4tpnXZezE`I2w>l5hEvZ~2mwZyC+Wx2)#Ou*~MnuEon==v%Wm&1yS=mQ z_S#pfIkW8c&a&$*u zZTIhNyWZJWy}7V+;Bz(GYHx0~@ zcJJrfy`O9Mey)9MHrE~uxpwd8+P$A^_kOP3`?+@S=i0Y~bM3*9YY&E8dobkMcb9YR zv5^N4!C9x|*(-0Jz4YeUYj2*t+~(QqZJxd0=H*&LCC^@R^Te7f7G1IG+9Nj491e0OJ%i6jDVDgx-w@qrASmZ zm#?l-U)q6BCP$*YiCA^4yeig&2EhVkR$vB&PPu4?e_R#J!&kFfVs(vW4&1SWTFac4 z>R3xTXsP$I@`@TryQpb^yo*?4OGQI{6((g=)l};2jJ35fNY+qaE`vYtb*E|d4K1;0 zS1eh6adQjgHb6c`tfF;ISxx=w2J;!JkD1Tq6%|dfwdQDb6J&ij(_+i5zPn zK=#QS9WE$uil(Gh7P7&Aod`gdj{4K|%MIpMHIA#dF4k<8@xusq)dPjXs z&5BYA(MK3h#m|&B^GV{U)(h+y=5fL6>%@&6I&>ZtyqN62K^zbN%N!NpieEdX-8#_H@r%3QEWapj)c0NNK^9`|G zr61Duy~ONb9p?3WW{1zOqf8&;xt@+4OlgD{+Q9iWm;B5pj_&dK^+BeOc1(P(7JMtU z>l4flkIxRFZ{o94@a<&htps+`&Z&X_cA*?4u25(CJsjg??Rs7C17v5qTHNv53wFD%B#!OEk2liz ztRimOb%^ZT%IxrVbqW1m(*JS-{cj2VKGJ_Sf&M|_=;v$TV-Lmuufomu!QAV@e z&oFV*uCb&)J%N6S&^P^cjo`<~|1Hc8@2_tNebZmx7Th6!-cDd=BrW>Jf8);>!9!$c z8F6%v`%^FUjX%wTr;(jU6WIAJ<9r?H6?QVo&N0TZ>%#CqzOu1F@IpWNIxwHOZ0{9< zhspjXW{0=;b3)&=cbni@Wasw@>;!NC!b`3LXA;L^xU^)Gom}E_94-|4rXLFhFCaU2 zF+03n4-0+Mt}h9`knH>+ft?_26j6-*V%C8P#7(=3$xa?|*{-P2UqSk13G{Ci`m0F) zmIV5DGmh)PBY)5f);8kkKVKhq3HvQ%|0m22UmyNU=&vLFzb4R6g0DQ_3**538B5&6 z&GhdXf>)9Ka}(I9V4U}R1LM5j4Z^+|51Rz9rh4y7VCN;qdA)xSc1*jD2wqF}FCL}B z<2&y}iJSNsKZ^u!Bs=#cu=72pPhF%c`~}nJ>(YNQeVnJ8$o^j#$ML^d4=ZQd(wUM+YR`S}TEhxf}4p>N{3Q}8Wh=dA>GlIg1`IFI;# zI80pnIa%0*X_xWm zD#3S=ovs9SK1W=}?K=th%fi0#{}+O{(Y`!$j5iK>JadRk|7Qxmp6uL|z|MWd(SQ8k z?DMxVeLj!ACG2k^`%g1YTQlYOo6HWMN5kl=TgHDAhf#uek^N=FWj{6webbMvf^Q)^ zk0-G6BjPd+zY%t}lAX7h9ey4eN#D(q?HVI^H;t=h#AUl`g}!OmM+DzPcD|Xw&Wl3d z#Q7z`_mZ7)r^O#{dBjb-j6Vf}?|6@Jh=4CSUrLF~c3mrY zHQD)80z3F4TlkXgdQ#YFBs=?<9p0|jguZE4ui!m2UvkdS^~!c#NnEyTso;mmPFDgu zUlsbspRWtvOLmSXuye|I?Wgo-oZx+A=R?G0yKW#Z*MW~E;GYrpjsKq)+}wA2mAI_; zn9%Q`{a)ZqyIpD2zw?PpJ1dFHaniu_`8sgBu%AKp?_!*<15YtKd>z=!^!YmQGr=>- z{y6$Ru=IaAaoLagf``dYYXUnPiOV=_5q7f3&exe8K3`s8obRh&6Lw6$_X@t9?7yAB zPX1Z(=hx+o^LmSk%lIr8dGS2sJ+ZgBdevP=C7vD{w|2%Qyr-{#x1>Z$} z{w#r=F%#p*=Pbs#pVNq&dd)n_6TF-1y(EF1n;7Tu*~~bv_kQAXynUJJ^Lh7e;>OQC zaBg zu1jF&F~)hl&oR#H{ULD~|KAWdaqgjd-(q(7d_TtcA7Krq)1q@;IDR~{1V2RfYlzGB zZN1Pp@o5*lm+br?ft`Jf^ZPBY5XU$i2LI>KdE|BCCJtsiyeW7e)%y-{^q<>LIR^l| zr2R$2WqV5*=XS17V5f<=@zccTCc)KBP4MH61orPrVE+ZC&&SoPjB`JaB(U=q;}{Eb zeVTqQMn~@h`FtNw+_cL)$2y;JKHrxxJAA&cV*30%8xuSOh4A_kv%}l_q|i5Uepc{I zvXgY4wikpqZs!!ndECYmH{;~)fG&R#aT5nK4zmRhQ@xiYu)iRI{S8c?`*|PZ+|N%X zu=91|#!nNUM+MI!Kc7lqe|G}=sgvTz^EAe}pA(78cxExq$Kf2}#{X>ca~ZSG*S(K2 zeY$n39Q-)b=i~YFOdm~~=dAz9IF9EP)bBrMcKCQcWwMR~`icH$;RkqyiQ{-X3O3CA zx|HePtTgqXrA#0Fq}y)JhnapdsBWj{kvA}oelEm{;PqK%hx_>$)4xTls=q&C`n=u) zOg|YkcTl~D7{_{xson|aYomC`>zzd$!*Z)uQGc&u`n=xjm_F9KD@7Mt%{bP(lIr~w zv%~BCD%0ov@+9MEzdJ?S-^c9marFk%U#C^o-=qul0lLBcA4A-X+dX7|BID?PHThq{ z>~R09nLheC7yrPkPVl{Ce>=0o*Ns;g=YAd$cJ`BA-5=n7UdA}? zXUzTih~Or_WhLX>pBssrxb=`fH!+U>Y$Sia#_Vu^zQH*6=P|*JKTk8x_e(DkH~t(V ze-1HyK2Ba|oY(u7;HKUYQ*=Cy{a&(v9&v0Yw?A9x_mO^a0{zuOUp<5bo3|y<-@^27 z)2^w%k1&1SU*Bc=I5g9+bKtd`aYQCx=Ob3=KCkyXOdspbqwSlD94BTx zq+F!yN4NR-8IyodB|aSV(VuSo1Fsyx!{lcZv%}YiPN6@S##NW#S!Cy>1a^K)JRN*M z|4rW48^Vt9^Qhq2WZ#*pnxW36+|FghF+SY?q6GRYiJSPCc9jcWK=sxou=7>ovfif> z=>LFmp4aqCX6LUEAG06$4RQ1nV;98_@cJv$e~am-T&(4CoSe%zAGbNg-8fKtFJm0h zey9UqA7OU*xV??(<4}u|ox7PnU$4F>^i98iRq(}R=QU=B_it#La?8zYHT^hD@M5xa zC2`qbtAxJsCnk6)+4)ieJ5LIIP~nWd9nb&-?v)#<`s~Vds9bb1&29cD^X| zA0quH66pVwalY^RZ^pSlfm|;RyuVIooX7cm;wBE;$RGHQi+UkPbd<))b<7SQC$&r; z$D3I|DX@ z@cz11=$m$ZSn%h_&gYmN-mY&8ebcV*3jQM5IhMdqdcOAGw9DLYIg7Yy*FLh7PaM0C zx9duwe}MGM6XoLJcP`%$zU?(_B`z7lgM_jgdBIA6Y3E#t0FSNt=nef$B^)lnc>@$m) zKHq14m~p-i-@-Vb7ahz#j+3#}-Uk@Ru3Zm(hOZ}?9X>C9#PqSv#?Kzc(f$Oo|2DJ3 z*MWB!=l*9FVC~-bq$ZJ_>BKQ^+)hO3PbK}83G}x!{ijq-|6gVI9%ob4{{eh6gK@uB zlFLy;la$HjaVa@U47p4Z(@o==qDU%Uer`7I^2Cwnn?RmlP5c`sPewccgy)AG*_XC3lniVs7cA%Q$&;CjBADtXw>nc}06|ARpOZzZ1X{6Tyy@-#i?*!}GdckQ(2 z&+ARRJzgfjxqk|ff2whJyj+3f<$06G9xrd2csK6%AkS74Z;y*T63_killc9})2#im z`ke?&&V#0%xsqoK@(d2-x!t&J=X8_b?T2|;zI}y~|2yPg zW%Ahlu-UlHzfJOghk3A1@+S)>iA|?>@Y~n@a0;CJjq@r?d@0&_jmcxr8+S`Q=hbxa z=aA>UK%TE8p6%Hwz7BaZ6+sXFC+=Ik&wfH^m zKuatO;M%Vu6Ti!cCjWoH#JlrwI(}FBeE)#ky&w4-!(IMA6Y+fia+PtL=X%N0rjpM) z&bT|D?@jZ*+~l$6^Y=}B^7;gMcA0p4T&H#N`PhE`eODd0YrlT7?+4dkn`a1|`)35=$D4S&e`ZQN z+doTu4DuA2Ja)T3NIcuWPkcP`oYnc*?e7g|`zIm(S`%;EKTYEK_jnHn;x`(%^SMa! zEXMvXHg4y0tuCqd+xgrA&h|fpJl#yZZT~eAzY6gMf%r!yel6lx2I60n_zj4EKM?<| z#B)CUAifECn&zbTgPjlO!?_UBMK z`&+`b{cXj+L!NPgJo6=fAL3sy@wWY&CH^4dzYN6xYTVA}^lrXiZ2uADDQ~=7A|#&f z<;Gq9RXG3OY4X_oYfQY$!|{4mJRSM}GI{KLJMKc) zh*VvI^R13}CAJf;=g$I(uZ8%zCf<(MGKpvVmy7f7mVY*RZ2QZ0KX&^oif5ud-Qn8) z>m|M^;wPJU+x{mdz9r&U1>(0ExAWn9$#XyQ{AS$Ehwhkf^?UgK>U{f$ahv}Fc!k7j zZl26T{%*!y{zA;RYfTOS+qW9G z}Fs$A#~& z4@&;`kiSx{@0V+*9hcMK>~9g`+XUisjoWd#O7eV$JcEtfahYWD*m0R=+>XmClgAz} zFNtr*b`P68cAnR~sO0!^TxyH&LY_oq~ z|2q)B!?+!npCr#gUA(6C_Vs{cq=CFF42R8RQvi;_Y!XS>jhAetsbSZMfSt?mO#p zmQ^n6TC&T;+kPF8{6)zBw{h36N$6LLzAl^poYeNK1DyTZjyye0yzSR0xVG~t@z1JM zNw$BJ+#ZG;)fyrxG?{yFCry z+MZ1DgUB;1kY|#_vprMA(=lG}2lDKccwf4g@huU5Ng)0U9wXWs2x&I{==Q~OzA141d0}mbHB_t^iiSNzy za4pt#KioNs3%_UExqH1Bfw&bWzEo*OC+;5)_)hT*tm57qy2br)dGPi+IuSYP*ga88 z@mk5Xqo|j7ZTN8Uy6|b@G59iZ?4D?YcoyQn5^oCsOFSE1FU>z-zgoi27Hn6 zM)5d&hIl9V5^;R26Rj8Tj`%OcbK(1qyW^2dIZQG~*6WK`8|T+(Exzx7_gwMfY`>8a z;#;osK3V)Ze2?e?@m26O#!F+2+?L-D_)hUHt9?6(gHQmKfVsWi=`A22?jWjc! zX13cU;Q8X*Z+D2-!v1_*yf*w5@w)I&jl1h2F8n@iN7mDD0-_h-K&>kto#->Q6fbDx zy}S6j#@+{uM>xR7i^t#(iO1o~#q;6(d+4L>hwqelUI+dm&cD;C=}v-)g?a8p9)2%3 z{eC#Vmz%z(xnF;fuz1{c`aQI9_fM-vpl}{vLdVIFGyc#ETHWNBlE*>GCD}wHy{`(>uCEmUFc1yAN z7QXJ{yvsb#;XK|zd=0#{ad*Elmx}^ELLAd4y4!eJvmX`&{3Y>^uwj0l=9=R2EJmC7 zc@BLkyejIZ^ds=ojJvuAmw3Q0701hWbfY-OYlb+w6D<+vb?G{BUYBkY=XL3?;&su1 zYOI?kp1Xd<;7!Cc;TMQ!!3T;rg^w5Kb?IDjUY9;E&g;_m#Lq!~elNEh64(AXycFL5 z(L2HGiRZxEig$ z-@ncMkcI>4YK_P7Fj*b*Y@s^#`}X1qQR_;2bMuj6Z^`jyOsTrJcwUKgojyhf^H zyk@Fnyq;0Vcx_V0c>Px$<5H`pw4dXmj&bQ`yu8_O!vcP{IJz4>C5~oB8^wA4+$D}_ z7Ny~Y>4w9#hv&~z#CiTaPn_q^tHfh|w?tFLGvUvQXTjeV=lOG&@d{?YMaTISUHh%q zRmXhe_iP`HN3KgW9`kLqItJiDbX>ius$;(GR>wf59WVXDe5-4`qS+6v0^ZBG z`@4HCLj%t5<#wSip7Uys#B=^UE6#bcQJnK+hjsPx1epsCEqiZ&dl8f69 zE)VNhO~hHh;`fxgcw4{fZ{n@oUIO|tC#0&63by%GBs~V@2 z+z+f@H4$h1soEIO|v6h_ikb;e^a_Wc{kHIO|vK z#96=UE6)1WXmQrBW{R_Z^-pouuig^pako>P^{c2+$?;O^tYubPXqe$~~utzYE_ ze4IFsi#g(~Uo98saq*To>sLF(S-(0Y&iYmL#;N__+Ryq`Q}O(`kLxVX`c;2%)~{|7 zXZ>o1IO|tWinD&j@AGu?Fj<$w8^}*2p7kq!pC{v4zbb!f$^No_)kvK6t8>L!zq(wU z^{bnV+xpdg0e@PY*IjRlvwpQ*ob{{U#aX|qjq{e<53W6|U;RUz^{bx7ZT)Ikz$c1# z@Vhs9%($&ztq%AW@sE(_XK~iAs-Bh_N0*=VtH$E2U&W2v`c=Pxj}lKud!~tJz!!`2 z{nxAFynfy)j<-3{esNspMU|SQ`s>=y>*`a*V`xuDahwLDE5xyTBYuCTndzsgdt;Nv>0SM)wmy^{Ca)hm0Sua5fF8g4^-=x+3yIGP!47ss$ie~9z^SqCQ~x1VkOs+~B`pO=dB{CTr@%@U(vPSdJA>Tw_fU)ZzI$(-=?Z#0G6p^zHL;;eEV7* z^X)Hn3}l_=(l5-n7RGJ;s(ZkP8n^YU2?2jdob&2g@oE^a4dR?9+r>FgeiM%&Pn8y_ z{sRLnoZr*vhTFv#BL8TKXZ>orIO|u7#aX{vZ`{_ewgvo=lM8(Kb4EO*J=Ma+y7p@mpHe3jX3ASL~)*H=8JQl ztQO~W+K1wtKm2|wwv+Rx>^UXdAM;P6m^kOp+2TCUX@LHtK&R;i#pE3bJcMkUa5|W{*F4%!+XSeomLKS z+}JOE&e%vD*8?5ZaUfl(UOBnjqTAG~c%Q3Y)%!~0_B!o@fbUhucvXt~eD10Jobfbu zj8_+RjMor#jMpS}jMpM{jMr=G7_Z&xysqvTC6}Y^$8}mGb&N~gxV=v6AMo+w=x+3w zIGP!~BF^*Y7vemB9unvI^F*BQOC@^e+R5{08}Yin`_U!hG58(gneZpXv*53b^ZfaR zaeF=XTfl3a?-RQAC*$3N#B!#3Y3~=RW4;Yj#{k@;j`_A&9rJCyI_BG#>KMpF>X>iU zJNfpy?%2<38V9_+I6rsjE6&erMvC+En(5;Fyk@aDKd*UBoS)ZhHEutz*&FcE7o_^@ z;#oI7Nt~b8G#BURH9d{n&t--N{0?#Mx5vf#dCjZh{JiE1aeiLI@3V5_=)Ql0OZm?J zk$OY%TpXzF#0zmC@%yisXCJNuMo4`8BEP+R#EWqs>|*iknLd8Kc)=p?Ux{fB*_ACncTJb{Pyy#PLzE9aN9!v8p zRO;$~x_-Is7MAhPPZcjH=RGbS%kX}gIKLP1HsjSzzvcw|d3CJwo;vEDyVXbg_LT1C zf4Y7pxBIexUQfNWpFeHXyLs=e{*L#N>fL-pr;GQ2FBQ*&za@SJe3y7WJi4%CzXrqW ziVuUg6CVNZW88g@E0^H`pCY~#D=ZMtMXr~``MF7vcy2|X=tuD_4ZWAe8yT0@wR7yr z-WwXPVdhnvfcF;1w2elJ^ZIJKIIp7?i^qI(qSuVqH0|N{Wx4iS|6StKk>`XS{sH6J z&Q{`;5Z_0f?Y}{s*N4-L*D~!~67coL-Tek!wg&tsaefY4uBTtqrAX$%{Rs`k`8jNB zao(TMOFYW*d9N0a!3)IW@Q20o;V+06z&DHY{)BJEd4IxR;=DhhPOp;tf%hl066gI1 zJ;ix{!Z2~(pKzx*?@yR7&ifNy66gI1MdG|aVV^kfPpE>z0>_v4Co~b~{Ry4Ld4Iw{ zao(SByEyMpcto7nE&med{Ru_lyg%Vbao(R$7S~zq7w=D~XWZVO&@$jX#d%y@E6)29 z?h@y5@rXF@Pk2F`_b0qB&ifO-5$F90(Z#9x>H3u)_s{Ey^Ztb9;=Dhht2pmZ7$DC3 z6K)mf{Rt0<7ohO8Oq};8yeZE66TTGZ{RxM}d4EEU-X-?~?@wqZ&ifO(8n^c+3<~%i z;u(H((OhxfpYWVG?@xGFoUgNc#d&{11r+++e0J^R{Rt-~1@)sSekIIk0Ch{q7W zOdKyS(MIuX#21UVfpb2(F1c$5*7*JQLnqocn*2cvHkr6X&=*Dc%zCuZwfM zz7WUT`sf$&c;uI=1N=`nj&8g@fp-zd&|KMs>WOy-&TY-`)y!yw80{9TWX)_3~)< zppxxp{l9^F1s~U59q)rKRmXvJlX_*JXO?;u?<>@+dVj~bt^e;1c=}+!o*Nf?pGKy7 zX&={7JgnDmsAIh5t7E)gR>ydKs*dscTOH$d@({oMqy6HzsAF96jNAJE%>kb+ zp6)jny(o@mMjwmw{JCG8=g;axQ|)){;ra6{ah^YO#d-d`PCSNo&K1vuzapLm-zv`Y z=YHcAFh|@fRj&3cy8UmxiMk6&ES=SnYmhqTTY)+TpisSx&%ai^toP5=%X$A*9Rpc? znE(CJeqp|yX57~Q&kgt`;;ds|FV6b^6mi!7pAcvLf2}y{|DTGp{{ORaTmMhLCe>f- zb;S9;tc5u1y4}QC{~v1H*8gu0_*`-Bx7FgT|9>LR`u~1$*8elEP4(B-{~HFptvKt( z7mF8W`Mkr$SvQ^}&bo1-IP3pw#aaLVT%7g)-^4jy)rObsFYEtJ#99CEB+mMOe{t6T zZxLtx|3Puilc&X5|KBLi`u|trtpERR+}8hVj!5;_`dQ)}#~$Jw$7{toj#I>sj-zo~ z|9?5)MdF3N+0jqptp8WIF4ZrWpY{Jtan}Dkh_n8mC(io+XmQs6XBoHk|K$OHTOH^5 zUFuDIfBse2;;W?KQZ77#FzSJME??J{r^Mpqjd>!*8j_lO7+XNhxPyZ z;;jF-HE!$wxd9(8o`LpH5w8Y+LY&u8YsF)T|J1mx^B)L!)f@bZ?mEH6^ZKxvINRAn zyb`uMLcAJ$syMF?7a6zp|JMTkxp7w&8;G;c*;<@+&R*iI|6eU0 z;dS#4@fdubcpUz`cs~4H@dEg_;;jGwCC>W)@i+Q`;C^8JzqvT;|2@Q6{~s#O`hS5q z>;Dgnv;MzIob~??#aaK~E6)0V#+Z`*V*S6dIP3rCiL?ISU!3*-apJ81&k<++f2BCD zTRsqH{eQ1G>;GkLD%mgA|Lcph{@=>Dt^aoq_)u{k7k7#CxOhaI$Hhu<*8krXXZ`;h zan}F;6leXv_RXpNVC(S_ZxUzyf2TNKXVb@~`sLcg z`v1w|tpB$&ZtMSj0zOi_1KK~;xUK&$3iw*_kC11ZIP3p^h_n7*1NS|-^R3%1>;GBC zZTqKzuvu zdVMFR;%)u^x`5v;&g+vxaqgd&#d&@5u{ihJkK(m_^P-GNCELmUd9pa`SM9}P$kR_e z6Fyp;`~N=irifoA&T-iw-V*U&iF3RTiL?G+bFyF2jiVcvIP#n+-U;4KJO@5hygR%= zJQx0`cpvyG@jUouan}EL8@KiU(s%n6UB9f?S9bx4rJZ`>7;z*w?`clz0?%H-qC)Q_s?VEtpA^@Uctv-pV1!KTmLV6kN>^vm-SQBF<$4ZW4!X!F>1*$|1S||{r?Sd*8jJOv;P09IP3pa zW~BOS>-?t#ysbFjmt8E*y6!dNtp86oZtMS#1$?zQ_uD7ptpEQa&ia4#nW_G|?Xv!V zs&QNYj|V(YoOR;DJES^q!ozEpo*zc^ma#99CE zD$e@w{{ePD@>;Hd>v;Kel{i*)iI)C$k=ZbS2M~HJA zr;2kNmxv!7N8`5s|9QXd9{r@y^*8k5JXZ^pwIP3qnh_n9xfH>>_ zD~;Rw|N8;|P95j@v=}2H^f>0 z-yzQW|DWQl|DQCgWPe%zZ!OOHe{XTt|8Edy{eQY~TmN4a@Ylqb`sPKSinIQ|Pn>m$ zinCMwa@%G7KU19b|Mudn|K}OE_5YCppC*o%>u8C1HT3HZab8Dl6OSSOSL3$+U*n-v zf32S>&g;XT;%w&#@k-e4baA$Ssdz2KuQzV%|6d0DpmAIOuQDgqFYArOS?4@goORB= z;;eICFV6b^-Qp2mHy;;|!T%*5hi?(jhkq|#053DQWPe%zuP4s>e=Bj;|1T0}{eOfw z>;IF*S^r-k&ielvan}Do7H9o`pE&FP73Y=gFYEuOinIQIfjH~`1H@VXpCHcq|HI;} z|Gy~C`u~UGyl(kPob~^T50~s0>;IYJtpB$cXZ^pAaa;c%9`MQHJT4ZB^SF3PoX5q7 z;;jFFFV6aZ`Xj0Sx^}YuUss&<|JLI9aligW;;jE)BhLDNfjH~`^Tb*Ie@>kB|4rho z{}+q1{(o4U_5WIrmfR1l|7VM{{@+!c_5Y#btp67nxAp%=0=`;2!#6M5EYAA>ZgJNC zOV3aB%Waphv!{r&{@+oY_5Vwa+xq{F0iP+(`u|enw*J39;M>GM!hSd`&ia3y$5Q=u z`C0!zOPuxpF2-&B|H^>hBF=GnK%B3$%fxG={Tsw%@M3YiyhKODvk`y7Rjj`sLccZ(xI@*B6fs^4?B76W&`q3x0!mQ}{ITZ1_Us$D94RCg2~6^ZM-vaoz`< zUYP2y%U{&6W(6k=#RpIE-a)+OME@@z^)vpr+j&?<7y1W|tlulXu6@O1Woxl`R8%SH zuZqVO_<8PD%~$7$(*@)t@xzmID>T=N%8 zJpX>DF50Z|F*w`9&--GM2T!AXakjruob4Bqf7DE@Vve+<3F3H^ z)!aXDZ*|;Pw{iG+iajaeZg-$k>w^>jABOcfCHM=j&*zsV9=P?j4V~~7pzs7n`k%3q zPoq(Z=WcyeoR9u?*R%d%v1~AQG{QglGV#N`yy*HHR{G!PyE$N%n0f3T?rWI%XidyL z<@)+7*VYot$-ez1Eb)ZvulQ%l-{|_40_)#+rH>pV{nzzt2iD&`z(>APa`VZ3ZK-i! z{Y3-)`uVa!c^b9A`lW5s#N*O~kG;NhC;87Y=-9bb1BdwaA5G-9i*CP1;`f@<#s4|Q zM`q#NtE8>Z7qs;fV*sNU0r`%VExHh jf1gW|Sls$sL(tr|bV8Iw{&o diff --git a/source/cluster/wham/src-M/obackup/gnmr1.o b/source/cluster/wham/src-M/obackup/gnmr1.o deleted file mode 100644 index a9313487593c6bb72b3499436403ef4e7fd7cc3b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 5208 zcmbVQUu=_A6u-A$JGyn!mSFDeBc4(LC`(m+kDXM0h1Yw&glb*Mm*=He-ECpY(oH`mZZ|5&WRM zA`5l_O5_hI7cVJ%G`8?_?5$t>Vhd+(#};OmVhf|ovGdW}YyJR(atTUr!ryaqwjW!u z^P{2%(55y2*mWqykbH%#D@eKK4@PeSEM^+YL(q5)e!)X4cgHp2W#~iV>w@?;5F-NS z>k(gr?h-LHh`2G~{~ema=t}IH=&B4O5M8--W5d}Eua_NoeOQu?eV_1md~0MYor_Fy zL?DX0iJF-nK(t<_>pQ{BqcX+256U)DnoH>p=a9i~of%t2dUyn*%P@j!A_LLo(g=ot za~amh3Zww*V|1k!=bHbR$bS_$?$Io)-nxNRSjBy!D3xLfBc$-v{U5?A!i5B<2Jb0M zB%QoHW%tY!oP43jp0qPP$B*<6k3^666!H`CMWecfEhi#t9X7ank z2{xE5I_Zv)&d@+EU(DOtP=78nok~0T&_HU=DTGGs?37a&ang1%HS5U3!R2+2L|+){ zc(#*S{Bh3s84N@)Vx>a3o9`0+e4bgeha23yQ#CWGEFeb#2@_(^0dk_j1EgHiA+u{X z>2Yu4{M7u(G((`Vd{$fjO8?XORHni|Hn`jWWJL`AZt_Sm_iKN1@>wVSb{b(Zyzcf$h2La@ z2bfBJwS1>NyK4LP?0kgtd7MENq(~MIR5&)_$@zVE6FfN{tz0e*SZwUV`-}J7Kf)?% zl#3U8U0W?TpLF$GTs&QTcUPyvh6Q%Ol2`!rmZ2|TS^U#3jRG8@uONTa+v2ml?cM-f zR<1VY^X-EsTvB2Fyze>RUSG)9>lc@T6U|*>vud0@_|Zc5o;h3GbF|+z6nQ&k417Zz>&0q;qz0+MYP+6vNMG zT4dSFX!pj;HR^n-1W9I66)jTQ!@}8I(Fq@Td9=Gw1Wyp9Gd?pFPh}H1s;5&~hwAqD zc;1<%Rw8d_pvy_dRjq6sFE~?>4V>g*F$l6+?pJ*hkRF7x1QeY>O6)JHDZ$N*FB|{h z9s!}HfH=O56MhWpD5m~J30L8lG+gJoqT#yVklL2WkMF(Yw?o5GA9p9pUJcjz-_~%Q z=RFPAc|Or_o#!tNNBw5um9c*{T-T3b;2<IWJ$YVeGx5%@zgK^(aCAet zBJ`Po)3&C+T&Rz6lC-KgiHG#t4V>Pf-_>yB!LdX6Lc=j0(!XrrA(j8%8jd{lR=-2_ zV>j}Uew%?$s`e=jM;`j8)eUtN;*l-Jrd5S-;-RAu$Dd+B)et^FNME)XqxEm7{CH_l5 z9ls#pOw!7xS;d`%BTKslszUB5QkqS|$)4Ifp@R11w@cYGrnW>#HcL-h-2~wG0<<@C zIIZkWeY1TPY^(ppGj>kdlOHP4moAIYFfr^W`;UykOx>kA_S;pUZy=c_ru`l0Gci=Z zpzOyqTdbP8_+7%pQ14G=kMZeZ>f$Men2{#?PJQYy?ald@-=4Gmt66q0wac zJ;dZhyC!w)CzSyf7$eO;tzZ0ZQp-NCKBXMi>~W2o_V|6Jmi^c2YKVXh3ew;@Gwty^ kOfCC0Wq%E9P|zO7%CyJtHMQ)os4MFP*r1?24ykGXAMqcmVgLXD diff --git a/source/cluster/wham/src-M/obackup/hc.o b/source/cluster/wham/src-M/obackup/hc.o deleted file mode 100644 index d736832c6c7b9471d0328d9e95d48422c9473bc7..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 98952 zcmeIb4}28Wx&J@A2@nXFh^SGiu8JC4#3cL+{td$FrUr;WY-+V6gh0>$5dx+PxE9iq zF46QVy=hBrtX6Y-t>(7aqNN%vl~`$SspB$<^UdD9xcIkmj@B35q9e=>1MnJghg(I-$UnSlz_&dZ0h+});k_M?qeckw)k0YJ|Yg{xxk9fA=(}?E?ehu-6;N`?~ z1;3eip5W_=7Ycqi@gl+7h{uTQJb#aPiQs#PmlD_c{55g(7Z=U@h*uET`S}O&8o@_H zSH?Wo5!X6r5^oSZk9b`0tB7wAd?E1`;yT`?#P1Wlfq1LnUn0I;@a@DguefOa$A~{9 zcqj38;yOPs67LZFAn~1o|DAZJ;2ChpVLrPAKb?5D;1h}W5ZC#?f_SgsrNsLLUrfAT z@Ot6{f`5Uy199M@?Y0unAg=TC9pc%7?;@TfbbdiRB6u(HT*2QVj{S@Kldgte2dWe z8Sxgu4-jt^{B7cGg5wl|{j**0vBWzBpFn)4;M0hA3LYcgCHM`*y9KW$-Xr)%;=O{m z5bqQGTg3YX-$8sp@aKrbq^cI(jy=TjIL1ZuH;HEpeuQ`qaeW+}06SuyBZ5bW=L($y z;(3D4CSE9Xt|wk3cn$HG(7ByBjvqX(t;EZP&i%wI1n(eTBlxq#>jd9Vyn#4us^w3_ zT;_ZUZC*C3W65=}rUq`%C@GZo<1pgZGZowZV z-Xr)k#CrvQk$4|**i_5w#QOywAU+^;GBezKLQ2)5+vQB+8N{`IKJje9XA{p6I-epQ z5&UN2I8NiD^*0dD6TF3Zq2Lb^FB1F*#AAX#PrOv{1H{V({|oU7!NVinywwPPGI5+A zcwD)}8w9_UcwF$g#J3RF?NUj+Meus!t%84%c$?r~Bi=6fcZqih-bs8Xaot`o5$_cI zPsFnEuH@_6VHJ0 z9v96YBA!iL>;I7WIKh8LJV)@~6CW>lKk*20Z8r_B_i#MS75o(9d4gX^yioAVh!+Vy zk2ucfJl@5`ONr}v*AibS_!i>j#C8AqI`Im@-ynV?tZ|`Y=kJQAIdE92McWO-C4b0C zUcqaAg5txR2-WYP^@WPVbt?%kBYqii-LOlD&m+Es60iMVOuUx3w!4;io#0!D*9)Dm z6JIatKSn$*_-^8xh0cEBIG^L9{d|M?eM09S#9IX)Gsf*#+l5Yq_(OtECjO|uiH{xA_f1CI|p|g`Xo{!+7^Ya4n148E&;=O|ZmH0uy z)8U2@9*=#3pGy2NaovAEPW)ZLFDHIP@KWOGivw&4FuyhQL5vfO+w6#Q)BHxj4Q8fOae3gUX)xQ2L* zsDA_TTESNkuM;|P;tityy~Njx`VSM|Eb2c=9M2PZ{`V1Y5&RFtTLpiIc$?tEvfaG3 z6W4jjA>Kh;=j{{3cM#Xd=@rCx3Vt2&UBq?&Sweh|sDB&rF2TP5;C~}tPn=fH@Ud>* z)(d_b@y&uyB)(PfD~aDnT<3p2@m9gBiEkG=4a6T3JVE?X;<{hmPke{q|3!Qkah=aS z#JdFl4e|ZNY3000{D9#9Bz}-MbyFw%BsZUj1wWVgyFzCg@gss46Hh0{so1%Z_-Mh` z5nn>*V{{wEX;D1QoL`l?-OFhsUPs%yy&hG3nA1yqHr-s&!a|Qns@ri;D zC=T~q$p0l|Cv%*ew>IL-h@VM31J18;(c@%3@od3o6VDO+Q^X^J-%LE0xX$wi;(3C% z5HA!u4-zjD{0GEifyOBF{Zoji!*wJsnx98JL+~lY zM+-iSc(&m4iH{S!l6a2bb;QRL*LnLk@HBl<@4Bj9pHN)SuE~PkitApPN8moJ`MfUt(xRx6o-o>v7D*6jxt$zvEpztE0&px!^xUh z#>4hl(|V4RTkKZ22v%Md$0?)wy57xhb>}e%^+e~LqY>J!p!E-dqyE2t~z zv2EpVS?(=hWi3&b^S7)MXMg_45aKE|7Ol7t+ZK;2u5x3=iVLxil|)(IUWf)-@95EJ zR|5WR!=}9S*{r*-N;YqFpWDTcb~QEDLa}LS+`yK;3~bR+&{z))gpPJLH8$W|7nF4! zeHK)=et>-fj+a<-Sy!yN8EeFv_Qsli9c%iTYS^ae=0tRJQ#1}ujt5!7*)$N!YJAk~ zOL70c6c6f4c@UaUUqbB3Mm(0PFS#cC`%qiyvX#6H?XjUZ;M zSP>xhv63h&grfrb4ZNy@>u*_~-VMDL+6+tZ_&7?9ue!iC>=W3h!qBI5Kf}I*Y!5VY zvU}A5HQft0uzTUNBKj}{`DnN9YwMwc)z=izeeERbl_~n#mPB+5_BHf87w=x39oyR&fyy{!9(o1G&A~@nYWjv1DPkWVh8k(P zv0_Dv*vATs6uLt~b+)GH0f@E^x)?@lcfj@3+5QZ)>*RuW~A#GC_7B}1Bv;>MH}5Mm!wsoFGEKwFFzD-Rb#flWMj}JqQw8mJmB1PIHe=UpMp+f*-8Q8l$I0Gw#1x+A7Ki*j3ZVG5T|tH_*2krEL$l+oYHb4 znr)^?=m}MDK=_`>91OZ1>M@3`kP!>RsGVxma83Ak@?K-b3J>sN8WF&Sdk<4v0_i_4NwV_ zaA@|&G1$Y2vffLdRTF-mo(4Y-CD7`<{;~H4#U3}KxD`8Mk5|1ZV|PvX$G*i_v0_K; zu`<|x+hVk>2oU>d54GR68Y@-=h&@&Y+yB~(wiN+lAMI2Tr0Rd|#)=gIVvm(xxLVJF z8*wnH-UN5G=z6{+0ax|qcr||*%Ynlc1`;?eZ|sDQn1DID?C_<}ZkU8K5nNmM#+v7V zPu5MG#%!#qUYi;-;Qd<@srF&04ZX;&Jx`%I2dfr=QDy1W6BB*u`snMrL=z_JB_*(2x41Z z9Ukr|3ZtdpDC)-O9%*VIRX0ju$W=qH-bs~YFH}SC&tg?-G;{BzW-r9i_tQV~8*J+YxH4S1rd57@UPJpg|yL1_8t6dP=(kdR`GvmPX!)~K(xsBLI+vLjUQ>Rq( zbC0oNMSxgZaXW$UL64JNQ2Kj~1uG83{uYv<+$I~N*%#gy+cN%M1 zcRvFY)1gXuq1MW}XD!AhKPL=qv3_ISiWISJ{m{pPb^QYyFw$0Fh=uetye%nQZZ_kj z&&cKc!*_Z_Y)gAGw$Xb=U<~<(kzs6EVIcOm<=fkg5ua$XjRmU>5c^v&?LYWva*Qo2 z8pQs#*!fL%GoHHsE$g#B!({Sv#&A~S1E8%lKj>^kjE7b>5c_+09NEY^7_8d{gFFcz$6 z5c^w570ofaY>lyHMT6L5YiM1z&RDRbLF{iKRW!%wvJJ+T6%As4TdBJ2qLf`WJ*zPr zpRO9heJtaom5{iPlgD#uX{=bO*y3YFpI{I2!mPzuu;M`MpX}pk*j8i9iUzT?HR!v^ zZAROQ1F?^GG6>IQEL~0bkEZR$iWLE3X=RA#%pJyp6$fH}3nrATyPv~LS$P6@jG<$v zv1dhu*tU15#=1}*WH;+HW~{If+h+6$j|pq=Cud#8mK73WX$uZb_r@Z8RH!Yp`7U{Z z?B08{r$qa5Sl+_4uA_a=_6}`R8Rf%6*4;nAi{Q`d0qIrQoOr*||53$m6Sb9L#CFtg zZ4D6h@A5rH*UBbhTNivD?5*@(qiy+&*hkxRiLATp{jQ=?eGJrRELl+?wk;hx4W*Ok z;lr{TpM+g>=NR<4UcWJHg^1WTtSy)*2jB4rj4dlj#2#BiJE?Kt64U2_6vX}(Qblu& zktxI2vZ6uku{E@lnrvgiY8%A<7E(oXjFXxiW6O#Lv29C#?x_2NH5@^q`vkFdZf*@k z^3GebD-X|V{N?d<<%kKvN*7`~1nv59q$}6hveJdvV{2$#InP+IqCxC$AyqWT=*or0 zmK6JUpSLp-0aFcz#h5c^w5hBD}TdNszD z6%Ar(YtW|#bw=BY1F?^GG6-*bq&h8VFjlMx5KAjVJfDvn3sxM6{VkYKvhKbRoRa5i z$GQ)`#n`hVLTuYR^n!IhpLNeu@MOEkni&dwZpyV7Q&wn*g{eg;rTx!4TaCIE2x41Z z9grXCSv-t5aQ3dwXI))0!6ru{ZIwN=plW5`s6IJ+3C{T8gEIUm%)Q27^*+Rv0sexO z+LQGL^YK`3@{{VUyI+RfABw|^st%{8-jBxu$GkR^VygiW+bQ<{cr4XG*KVY()YUnW9mfMJZv`q$mJ|0UoH0(51tOyW$tPJ)cs7|A8MS$2xJ5>a!+Mvr=u_8e1 zu`<{;=r-C`1c-gKlM&R*5hmsBmL6lpiU6@~#rH$K*Pz;=MtGq^BkLagn9t)t;Nj70 ztXnZ6wyhsp7Od+(xb+!nD=@^i^bih@exq%mse}Rt_J=sZhhzuA@RuqVB zONZ_QY5lO)M*QADE@VtSVECFf3k~wFk^?G!m!p7f2R?!;k_=KJwi%% zdg%+(gN--Wcw)ti*vFHh#+zrXSn(qEv0{HoO`rb_;+nV6n6rXH>|<`IK@}M*R#1q2 ztf;RN_N%WFs-H5zFVnqizD)NnK6U>p{GtX#JJ>H^#f%?Tw1_=^4E>9frN)XCEn*)l z_EYyQ`l);T;p!no*ao+*eP#v3KDJY}XR2>fwi_!}gou5t(D$&CUmz%idTIiEM@@i( zZpKbC4_nQM*vI@(gX}U^tRNBlSTR8!gl|cVfzz8DsE0wmrM~n`8;7#smn5LDgE9c; z1?m?$tgn$*Ku58@My`PV8u8xTxRZ_{`>XYMtl){|Z=uzPFn;#IZa(8DVvln} zpCS5<6)OdZeXOwgaPU*!fH7sYDPkW}soFHvgy2A1_?;;O_OT+)TJ}aevDfM^=e~>0 zch&%of&1XcR@Aj(Tu+NzI-yzjHg2KqSVH|K((^x2zmv4-a9*tGrhfQ^r0!VL+MZYw zd>IHXIpOnt_=%1=J&BP=pU--HR9XhWo`iF>6AF5=9uMOxG4|-Q@W?!Dp0xYTv(ldZ z<-mJAXhi{SXX%9T>{{$8zatg?Q$Os$$42UwZUwd~&X2{8J?@ay~QM>YQ4 z2eIfr@RifO@WW;}1yVMT!eQ8nL%Qdy*Uc5+6E=FR>iM9-z0O#+4iCiAvSlxMpj3$a zB?*sN|Ck$$WoryTEG$#&ZyE@1kaG&8755HEYuw)iVqwBgX2R{ni8 z%)Vo9bO$zQBHDpx_W$ip(rx~ebX!n6w)qcph()MX;9;`$WJ0Up_tWs{8vizHH&(1R zL+r7#!#{!@K@oHqZL23D_R&rifosA)f}O^S6#-(86==zAHQ3PV$*8g&FotF)7Jm5% zomZ8@KG1H?A@##*dmGDX`)G7W0{)eC;5eR-t&b^(1Jrw28rYnj#!V|3h<)5lm5fx) z*=4L)$w2I}(&`^UYfy7`8*M8B#6H@oB5+OkH)oHrVnu-1V?{S7d<@kJQ<-~g&rTdU z8g0eP6*zCg)}*7d*Bq6-$8l8l8uzRuAog)DRT5G)W1q2NB>}O=%3zPmexq$gfY?Vn zRRpPy$^m1=iU6_43N~Y1@KM3Px6&y(SHpXdNAC>SWe)p(^hBgB^{Q3!ArB>*D zzcsW$xX64MU?mH&PZ+6^m8!X8#)_3J#2zbyJ!(shwiN+lAMI2Tq&jNLjTI{b#2zcU zxqXh>$(=FyDNS_+-&hE%qjTEuM@h=ILlZaO4=2!kCT@y8Y>MtlMBAI9U3;VZ+|n*A-R<_Feg5O-zMye)i#cbpS^%*p zH~Ugf|-@m?@AS0tFdCm zhS%u|eN_FDqp7oZsyXSg6aOGr9xIbl|`N9=e%2VxDlXEwE z^bR@~V%slcpB%%s zK$F3+fv2+BX2^0cFgvjYzY3yof0NFf8u1>Z^*AU(~-LKIi}%JOLo_4d8$Y-~a}24P>hn`aTT8j(R8q4vuoz zw%luO#wzBAi$pm1lZj7S^+hDz3v<|nYqGj8i` zh%2wwZqdybgC9;VZh|I^###8hZ9LAY8&VEVWAKY^bO)*r-TV2_hJ&4uEB?s=b{FVU zh?z_7@5B#bX6iKZC_GdBootXt?2#YraL{G6t>FN%kM^L4gKi`5x{enK;5uTDyx(x( zj_Xa0v1A|7$D2X{$D4Y-XfmF}rsxNI8;d{{dzC(WfzNNV?!F0p0~hh$C45kDTz8mz zO!QWA5sT<;d&yaJsCSrqjb$tEh=pak!we^J@_uOQ`}TeQ77z;yc5LoN2h7qr>IQS@ zBT99@amPwE;*{Q)g=I=L48nuFneRYf;y(6o?g_xBP{JdWng_4fj?$BVeKTb2u-UWRpl8hn?|^S6lD*PxhSZRaiu7Lvfxm1q(xl~po{vCNZImbWuQjS&NGsaH%DSow1ldR#K>>jQG z&Ajfp!?Zu;jjT4f%;0BwG!i4WeKj_cS-C;pGh?RwuZr7^H7hfSZEMgw2YX%LVYIEb zMeL)UjKbTtsjlmH8Y@-=h;1t-U+!bPa2bD-dx8L;QkgQCwg%Z=oyNWuCE@`4$w&v^ zUR}nT6)j@h+7Q~S+h|*nAokHtMlrbd>M>TV2oT#=Oq;+HO7QsvwpVf{I=(jRH9lC8 zA`b8&8SUWPtj}1pB1UXm8$z4)8*M8R#6H@|CPv29J|jXs~6L$Ykt972;t zjA^UCBK9$z4AR?QQ#Dzxv0?>?*tT*UO_pbDSdkzOu#t>r@J&`|tXUBuwyjZ!(G=4J&BGwi_m~#}jnSShIpgY+Li5sHbJaM~d))6`rhNsEIkbO$+a$ zr%`ImO&RxAuX-kQ!@DpB!E;8sj6Uv$AAiqkF2=It{n~zW$FU!8>GgnjtaQNK@EgF= z`>_;Hzv0xv`&p6Oi+#TPo@cK4txO{pu^-Q=eW9^pWf-x?%3x3Ji;T7v0b(ERWIyp9 z>ZwlcW5$XV0b-98IJGZR4<^B9nfSb!Ij^TD+6Nn9+)RsBgor)1ccgrpAXS80j1?{%W~ba zQYwSyhMd&9A;$DfUD>dcC5>g|txqBpkb zAUs5l4i&o9-5fy-P0@XOquqGH2hU01*l{K%Stn6dfG6h;x)s!ubNIJnU~n1i*Fy^- z|NL|VI~LeM?CDYm-A_!K$IZt-LIoeoe8#@Wgws6r74C$3_PTj=u{zDM|NgAJgFyCt z?;v#h50voCz5mbB4dxC)_pxJ9c2dRiq3!gpb0X2Eo4$q8_Uo2d#4y|A<;Q{E;p^KL3cvr`0>)j{E{D{@(lWkrY_z^G|bMP@2m{m%&a5#u0nE4Ctr$o|0?A|ID<)Sivr0 z{!lSuVa3EfyC?*i?SqHFapb`}HPBUI@_!b-6rPCo!>u+uNAUGs8kOLHa!0zYbQle` z>)~x8pTh{T@D^KDr6kp1bj+?-XY9Gzp~DEV$KGIvga)H+&1Hza+Q*LNm_tI`*t1$1 zv2D+DoK(U0Z9c?dbdViJbKJuS&-0q`FoI)3{S7{NSO|`iG>90!fU~JH>>eoFc0!e} zCYo`DhYNf_H|Q^sX2ZU`YtZ3>*bYx=r#f6xeK9J>Sh13bSXeQA-aTBpyoZZA6gJ?4 zx*4!L9DUBAH{ID~z<;P12pTH3z_`R?r*4W^cvS^|2=SPQg|d@sL~b$m+$@ki#2$P7 z{;|M>>_5A-8g1*aK+DBcN#nJ_o$#?ulhzA9zY4TjiydiJ=6WFna?MURn1)} zAJC@lCdXErBDQl3zn-FWl82}FtH;KW|Af|IY+3Dz*xyz{oj~I~vxG_pecw9{JK!<- z*6Bx;PYL&R8zu$8@yRna}UFq{bUwA;)7M5Q5sD@Zo%sKXvY(+@GkkF zkNQTWde%pMMUuJUYP*kycpmrZ0TK9Y5KiG6yWy=qNmm=#U&lg#FwzfpQtmPdavKBF z1V;yA=9&A{&qr~d-fir;4MO%1d+ZJNWU0q!TOA9rSNqr_=`l~1dW}6d7Mg((+xC1$ z(hqr_j(`5QF%NqZ?;Op|3VEIzQs*GsuzTPE`!@Jt?Pm9>O)%ab+6$hm=jU{^pWJW-f@u+JPDDf&NqGO-O@&^_LLG7$+&iaA-p{=5&$On=6W7+v?AVz1kl^e|8}C?pc-9pAp;kjAY3a@n4|(WrA3cnH zK2x1@40;T2H|=Ki6U59a_4$++&Z&MWuftfedIw@3D~WBrP@q1TQ#ZUtdza&VDgXAy zKZcrh_y54&);{*&HTbq|wcDeW`ONx>X&U{oCJuZ-vpqh%NwfWiHur(vc5NjFUrKQw z=xs}F2_E2WEX8c3=%R3DfmO7v4%gOBW^1QwtHZLTZ@I#JjyEP_O?%)5Yv=PnS-NU< z{Uwpy^OjtANo2v=#cQfoFR!bQoO|Aq$f~80`kLxUW!73>uVuO1);h&A z9Y_7Y3fAy{*8Jjy=$~F|y`Z&@^TV!X+{fDQqpmOY{{P;V@k@UOTYjwiQvajgK9>E# zmdpCbyFJ)=2Wt=Xt>aQ3XY%;bT(4#MvHaBgNqczg`Yr#j#y>yX$d23ohZz53*Uv1$ z!4=0b{BO2tjMLkCt;asSt=Dq@56iV)@vM@WILZ%ot?lXcv2?-^^T-gsI_hVB@Lgeg za$A=nIhK~Li&tYNo_X_UM`2Rac`2rCoFgFRP%}AS=y`*e#iGU6#9&s@YmcthKgODC zewg>#UeH>`!{d@M@i_H+k1q8;({9IzMS;dM`gjcJeS_Bg7?Aow{qA%+{sya$$C)}VMPK1QV4aa6d`+(5?UjxbzXJYW8M)}9 zi?A$$|KU9@YMa)x;1I?Ckp3nw`abn&w2f=LmzCm6R=57@fZ$k{?+(FXH+J^{}q~k4~dFOux(1ZA&GGO)0!;gfk0FeA#`@;pwsVRT323|2+GicJ4Y{2l ztsL+Z>*b#7I2d=TdYJ2mR}t64e7-kkB0v`AL;O3?vGt>J^a52{zI{~eCJHJ zjT|QRr(Szh;E?K^+t{zY?qH{ujMUmx|09sMyywFhv76WKQkQ*8UjS+&2?s_L} zT{e)5Lgyn{QN3dEYCt)FCWodVTDcOoBd|R!bQNwdS-wW0+~H|gof;}dw6wNz8C1#x zGCovGmDT_$9G>1iCKS5)W(UIxud7S{`lwK-p}{!=Dy6OKx+DE-u)TcclF6z<+PXb= zq<>|+A_YXY-k$ztm*f-Ka(ntcs6ry0ccgEH&0EMsZThAWVA0(@ylzSQ=V5cX-mFN! z9sF6of-0A%*JeXyy?JB$GEiEwV);s?9bQ+OUXImQE+NzLJJUaf@zCbL#`O81zOt&8 z^h(m_Vm!1JOD`UcdoNXLBOzp3h7Dvx7r>M_%U3O3x~5tUvAR^PLums!Zp&i&ONXZo zoK6i5o8_=M-rc+zHY}<@!`W7R zJ#JxpU|9=n4Np&>ADvm^?xYLaR5g^wY8}>2ooef|B+;!T!X@*rDV`-&dZBFO86i3V zD%Y&BV#bZos53$)aOltLhXXi0^m`cZ+z#ER$j3r&DS|z^Uy(@YeI%+&r>`4O>^wI| zwbkpOT6_aaT^JexLq=$MRV`XiU$;fkyig9(8o1Ad-8LI*P79r{YOY$nq}n|sMvV_; zg{B}xD^M4zMur1DHFTBQy?Xhw8a$wKhi85=bV9OEF3g-2f^L)SC*_$lL*t;u&@;EW zN-~SE3iw4}cIFi*0X3>!l(w$@&diHL*k4tZv~@e~%$%flqV2XjGcO83f2>_qMWpr4 z(I;eup=YdJxx9YOA}84g$7CX3S*I!{acE5DNveLmw;%@!mQ}BE4;E{eGf}D@jv9=` zDwzN!bxRg|3oe9$6{~99vYVs{rmwP{cU_Xd5Oz6?rMud1)~IyV~QtY5X-yVK~C z-I66fMdP7p>8iD>mqXLbphlkuh1In_ZjAl}l;HH>qga4NRdqfkg-}wpxN=Rk*V2`^ zQ$3u4Ngu{wRMoyYA9IRZv}&!-ZrD=FL3c3ai63)5lr3IGW1Uqp5%;R9TIJ2fn91SL z&8t_e@j3`m-CS3@%HxAGdK~z^bYUuG4+^VRr-i19Sb2q_Ep(avh37wXmvFRuXf8{ zkmcuszpJa4E^lypMbXKS%{oX~zu;p(4xU!6uB@-BS+ab!b3_!M1m39TQT}9S*|{4# z6-u#Bs?u|1DZ~lcTM9#wGfkA8bQ(mmVvXAG8d-KWMWOm&xh#bP0b|5Ic#B=;j6MV0 zty)uwChZ=O13dr=7Oh@fx$+igy}jR8bX7sMh%7w|f;Xk!q3SH0qfpVKi_%9&!H z-QjRD>Yf2=%vo^2sA5c|)Q)h^takC#)LyWL@zj}QOi4@5=nJ3$>MB=zkCXF28KyyZ zc&W7;bj*3s<6tIK2kk~#b}{U@YPBl6N0v=jWlL0Hn=FJQ6Q>4M_&rg0{s}OiyK|)~ z-y_SRr@(Zn%6==$&T$7PRrsbXgi!>hOjUM7mf=uIWA~U7t;5P;XSb~z__=Po+R~@A zJ5AXMp|01R6GD4m=eu^9Vm#yRv3BjV$_8L7D>P|M{pv|@3u*4mIZ-%8BmigNHYlBa zl?~?1D=Dzaf`v21PM}ge*RB+m!tHO%`#pU2mw(DQ%yoF90xwc@|{Fw`9 z#by`7tz7Nyf?06YYa3cnJUd!yBZ%SZ;u03+{5cCm4YZ3+C#BI9b%#ycnzdl&qWM?N zoO^Au4x$Co=xm$BiWe-LH~-T%^zMix->x*Xq%=0u2Z?I9C)|eQj)C(wz&eZON9PpJ zEuK?+gLHB3%!S3*M;Cea;t5z7i;C8nKTiM%)6OG+**3Xq-dsT-tMlQOoLwzi614#~ zqad?nvzl%+A)dzHaBn;s3g1!!wV6U9zd$A!Ek;AGu^ZV0G)z7=Fq2XIaKB**=hE{E{te zJU>=IlwY!)Eeownw#lNDU$R{-%fuzyr(}8ZlC4%0=}Wftf{RPGEuz@IWZN!E?Mt@D zWhuL4dsdY3OSYF}nRUr_P?oYww)gC^4}Hm&0e9e&LtDtcWIIC^=DHUp`U>G9S2Si!mCENF8MeikBx2%%9Wb3nw{&mUb zy(;^^b;&khH>h>VHVQtM;)l?A?2_#aS;jBfCdxv7$##V(l$UI!vYcJARm(Dd$+k`w zvP-rtvW#7_ebp}G*In_A{F1FjZRtz4HrS#onUdnUQKvNdsYd(8;p&qKsPV6BG3ydk zT?78>S`04El2>&9hpxr&H1JILcsuM&fp?+M(ezR98p032@l#~@6xwF zxmJrB+ele706zu@UyEU13~LzZJ}`{0p3i`yn>WwL z-LF%--xF5lPrB89>8}1`I67gR`HBiT2K6rw=O~9_9yjhC=5Yh0(;%_$tGy56>jX&B zyBKI#r56*I9?~g&UDZ?REtyfYV^{dE2;wQ)V`BJ3%x(^tDTF446ye+OOxSHAY@Znl ze?6R*9SYZ?#Xn=KLidYi;eYRp2}Yq?Ll<|W`k^ZOU(D)hU}p{5IRP!+itnprBas4hPf3huyy;aKH!_--Vm zc|_W&;BgqjYiS9;jMYn_BrSB`P2oON-sQsU7RJLzaNFIC&48Yq7RqfYiPyA;-@}6X z%fg)_V4dF*es~x(V`;bqtG6f*N-z~S<4Z00U&sz=7z}VcI5Bia#z~oJ8RunW!_Q%a zCxtG}oRN7+W+by9^McW787IOWi!0%QnY3Y!TTpz`wSdF$OiKC`LItpU@kxk=@!gA0 z;sV1bIGLGOKuw&pLnAYbPl87R&UVfjb202U680PBXLb~rRRu}2nP66-q}kD@lh>D# zYh$Eq7{Uq48hqHFHP*p>Gl#(=TJ#nl^%@8N;j1P`AuSErqeo=4;7|$6W$wzn<`%ne z)A8A%(ZjR95Ke~=)|^eJrjLUXIC|1?$C1M!oobQ$-%OnCk54CUN>9HLR>$7|TN7OY zwm-VRDLcIdN{+pMh5AhaXuqWYYX4E`^Pt4LKjsA&zr4T&pIL^I7mQdhL&?i_y)&$b zl9vN)|H0V|qKTI5Vx40rh^tzHFBLRR8)>xBgQu)H>JY3-`Y`nt-hTdM0P5R9*6Ti9_M>p&iD9S;7zZ`=K_z<1s?pXmr=J#&i3=P4ear+R#z>hXE1$LFaYpQn0!p6c;=s>kQ4 zo;*+W_&n9)^E8jo(>y*;^Y}c?*><_xL>B<8z_M=R%Lqg&v;^Jw6wDd@l6(T!{hS|kIyqaKF{#@Jj3Jj43Ez??ZJf7$0d0fxW^Z1^h=W#wi&+EP4l<4)|XHv}fdhatW`pk3`QBMG-#cyQd*{u3@5Gt! zojLQpQ)j++?#%a2p7}I;nrE47s^AIkMe2n7Hh3JndeNHdTNf=|QST*-8sLQ8VN-nm z)T!$9da^oH-Lvk=sy9uBGk%nva8=2*6X0BbMP>aWJgJ8h+R2uJnkfasF+?CdRt3Ug zMIanj1j1oOARJZ%!ePZmYQ_`@4@`k@P!!1Ps+u)LEwA@#-W0XG-m95Y)be_-=1#ko znmh&adatHWQOnyLY62Ctyt!9XsHo-5y_!VrT51**$eVjLkBVB}+^d;X)bi$D&84E2 zH}`5b6}3FMFHqB|RjWWvrviC$U!bN_QOlG20yUkATAth&sOePH^5niiO{aD(HJu9N z$$f#EPDL$G?hDj(Dr$LhU!bN_QOlG20yUkATHf5N>C~>Jrc;5uxmVMvsO8PQnodP6 zZ|-RTWaDIknoh-zUhma(YS&WJsX$)u)pROqdA(QDsi@`kUQMT>mbd4q>C~>Jrc;5u zJx5KaqL#PksOePH^7b4xor+rCo};EyQOlcqHJ#eE)O0G4H}`5f6}7y%SC^xrmN)n6 zf>hM<=3ZTr;sguN6fWYEX~DEYHECDXeGYEIQH2Tk0WZu_Q`Ag7T^$ZnbeVT{W<~Iz zrrOUnG@-1NZ_S)Ff8K%xitvuEE*Ym-PN^$IfiOV=VKxN9wiF1nArQ8ujnwQX5cWiY zuq_3`o+yylRW?dk@y;rlJT}#b=7MiSP27x?&O;$65sO9l%vYHu0EstN5 z)y!bkDo|Il0(n!Yu4P3nkE;dhYF52OgMQhhm zv!6iT9o6h7YI%CjWHtMVS~!LYavKiB~ROyc)h+ zN?S`;jc;JR|N2;0RHU&zB_>bK7hX;z)z;n5p`Tt&AEv{C?3l=z!v~gXc{D)hRmQp9_4I{%EM5W{IIBar z{r?Kk>13SS{e{qplYy56kC6T!19VO$QH+cGpU*gcV6NL`JL4l6?_->|V;UW7I?v>$ zlOcF6`B_X{`cuw0nNm_qg-)Cd+#+}$>E9lp^El%?4}TUq+W&V1FC_iRcyPiZ{lAKF z?tdw9ou9bc+i}VSFCzUV0Xko0ocrG|bV%O$AHid!KMflj7U_SKar9sJhXur?|K)<0 zkp8j&o$ZWs|91-=W=eW!Q-U=c7V=5 z8R!0I!ZT2~NdL11-$MFl5y$*+orR2Z|2GL8Wei@n2;M^a&j;xAFwX7%N$AAMz*~af zNBaK=(76~M0mDVM`wxig{J6Co=SPCKlKyaf>I)XBa~9*=|BHxg{kYoOaS8;BBNo5`J?47wP{wjC23c7aqj3=RjXA9%p z|E~xg?f=&WR}BZozZ0PI2gZ5+XVUYs7#F{eSQWs(9l&1-;70@a`KP#2N>KgKtFPg4MX6e`1`s?~wpL9=^Gbi_V+7x9wUDi z6PI@DMg2GleNOOF(%HgvxSu~}oX7Q&(9wSO2wqP5r_q-Iq@THrbGy@s>pW=xFBQCk z^gkJ(b0_26|5l-+{r`sGHKhM)fX?3-=lvlBU&qBo`afLoI?~S}j+HL-H@OC^OzLSd!R^$4G#C3jDC3v}9@K(~l zD?sO7#(5qd5IS)(@UY-*q`xyj=g*9D|A(LD3QGSo1#c()dBkNNDjDbguM#@i|9ZhY zNdF4~IzM8Z`#&z?@Be9n?Hk#0 z`$_+r0G;)WbGzGwj`sg+f)9}XD*-zFjC21#5IS)(kT$`6qvKM)Uk>PG;%JWRe3EhQ zf0fiB{TjhD(%gba19YBdoZHX@okMws1==_y&p8pXSxPsFE(SjF}{v6^m4>vN7{_FhTEOfO0s{}71{fz-S-)Efr zzfb5;dYoSh9wYsebKM%!{|gxB`JX{t=STa0h2Z#8^|+J<=rl6U{eMvCxGIj*E_eg! z9}dv@fN}2s=nGv%>Hmq6lm5BHF+W_VoN?~|Ta5E|&-l1)SI0F*@N%*{m$+<~n?(IM z2`v`9f^=?WI^3U!8R!1*5<1$?-GbMUe)tn^4e95JjB~r^5+4P-4Tt}6cXuaO@H*0; z9-vdpIQM_M&>?x}0l~MB{_6oc?=jBXeb_`-QTjhh@D|b^Ph9q&>lo+$-z;>r|EmOV zCH?OQ==_v%?*B_dCr$=>1aBk#Hv@Fey2#y8wtFFQogeN0<$|}9{#^k&_cG4?e?aJH z{~s2-gY==_;+p8xk5&j9E3xP8i`WW1a&BQE2u6?`Z8)4_DO-Der+@pcOx9q+FM z?1<|4$G+Li!Qnm>;fF#yI!?Hld^aUoZF; z((eq=c~R7llhAJjZy}vSOo#h<=2Uk_*}lW3B{^^3GXnUf#C6`t9j8d}T=M5Gro;1d zuc#jfX>LmWL(_;Q;AFe#|vIc`kx5UsbHM@zfS0A|L+jIob-1E z=)Ax<_y4y-N9X?)!7E7r&jC8;%t+>k`wtKDt3@8~HxSo(b89)yBEf6OZX46#`ri}v z<0SM$!RtupIi|z&@V|_6{Sz;71*M;-2;M;YpCT^%|5C=e-3Fnf{of!t>2D3t+08ij z|9zoD>2W>~yp{B?y40;9{a?s9`mdM8#C3k+RIp6&Hq!rGfX-u#bN}BFI@<1gg13|Y zrI)!ir2lgm=l*|&xb(k5@D9>n9ia0F4)m_yFnO6`<3?IQRd4p%Zu9P z|H7G25fmQ}>%__L95Zg;EDi7OSy`Lf^{q~8{x^DD-=|Cv|0g3|wN!Lv#K zI^xp*3dXtrD}|2se~sYdNdNNzIzMEb``<5gC_T>q2%baw(`LCf!m#2xQO3Fd3yACd zX#dLvA5Z$r0(7=B&h5U&_(Q?T=f_amodckU!g*4!8Rl<2>G7 zLPy8DTku@ce3@~rd8GePfX??Br>e@}ZsJ;B`~RHag|ySJh+}^s zq;y7ItyYfgCo$q$->v01a|ACUvAY9wzQH)R`=3H5P6j#zkI_!g1n9iWIM4sJ*SLbx z|5CwAN&m~lWgglX$Ev#DJ|=Xu|KAsUA?ZIGpz|K%-2d@0fB(-GyqxqG6PNzq$~gD` zPNAdy-z<0q>E9cm)5SRV|JTK?|GK}WyPMAIf@csvEV!1=rhrcDQmSW;E|K*JHye$W>-=c{FA{t!>0cJ0b1UQA{}+Xh_Ww76-$(j6^Zfn4fN`Gxsl=uKmk8cU`o#e{ z8yV;R-zRjm|6dh+JL&%}K<5zSJpbX#YdkxqfQ99i*R4T+Rzo#<~BW5jxuc3c+`f{sRFz9gOq5JuP&! z|349Y7wNwkpfh5AvR%0UTZrpCX#bl9-$VMp2+;XG<2?Uw2_5Z!zu;Y@e>6a6$^w7? zKS^BrKTq&|q~8*t^G(Ki{=X}9wEy1|d_U>$4$%2K<2?WS7TWz#=l_?2A0Yj)W&U|M zn{l51i;3&}X#b}O-b?zk0(2S}=l-_~9qs>j1wTmoZwKi7lX32U=Jj@dwEx+H_mTct z#O3k3ka6z+w}g)N{}I6tlm6iVospmN_wxk7-zA*|#N|A=T-4Y8tQ7nR={z2w(<=aa;>j`nAs;NwWAB|zt4QD6J>pMsAk zox=e-!*1|zuTg?eAf0Q8%l4`i^|e1s1)oSdj|AxafN?(l>=8OTZ_f)ph4gy@bjEzf zzg^Z5*X^SHzeDiLNPky=&aXs$?dR_VpG`Vv-01I5K5^;KG{H+q=e7Wy7ExdOvrX`Y zr1R?lohxoi`dJ-v-{b2X;@Zy}NoPLecps^Oc4=Tb%Ron8r?<2Ect}@}&NHlj4XfWH z>eo>HHv;M(Wt{te!e?E_wEwlFa}wj|KV7ysGl*mV=l(BY_1j%Z^?DoQ7*`$X-_3M* zT#tzQ4OIUJ0rmffaUNItBG(BW*Lu>)W*p;+xYe9O;xew;tUmg`nRFJg`rQ9UQC}ZN zUlM!^>Ab*n_=zLSu*Zw>tcpK@w z9-xy`>8M5f(@ym-CXW8|e3pp%9aR4_0rl?{^>w_hg6|-m*O(5^{}IOddB~{6w*NX0 zS%U8*{aoT07uUIoac;MUaX$X9Bd+tN?cO2yF0%Wj0G($T=XO63Iy!G@Rd&34NPjNz zFcfp0WsLK9*9sl&|LuZzk^a2_I$ex&yDu@$^Y%xfukF4e_&&1x_W+$wEOGN751s|W`>hBNG z8M)jomwCH|xXgc@;1fvyi2$80#<~B$7CPGhmj$0l`fms5oO`ps|1*e7|E~~y3hCb& zpmR6l-2d%DNBjSP;FpnpM}W@jjPw3;#w~7KqhK{0->Mfl?-P7B=~ok%?byIL_x}q* zNBf@;yp;6s572puaqj;ip`-nOTkso6|KeIVUg`f8jC21>i0k}l|F09ghV&}}bha_h z{r_*Fqy676cs=Q#w!+{4iHvjqFCi}dzf$n^q(47E=ZlPU|Gy!0wEy1{d^7347NGME zEA?Ljz4vb z^ZaiVI@w@Bf9wW&gii@OMdnV}MRG zV|7QuFKGLmML0sm47319h4MIoz|9Qbjlm3?j zbe?0J`+xJgWV@hUns%LA19)=)|BnE^CxHJZfWI5S$KK}e=Xn8qRsesAxbANe%3F`% z8CU_9)9A*mY_AI#=Xtx7xYlnY{UX7$Nq=sDP7~w2y}l`QwEqtYodV}7_!8ROjlMU3I2crN)_LR_}v zXBg-HEEhVu9ajpTNBSEAbiT(p&%^0=`1^mB;Dw}LL0tO3l5y_;=Y@{;|BHebk^Z&- zoo>dt|9=uXI{$A89wYsU>)m*z|Ccb%{hv!5cgIUI?f(M7OG&>nKxaGS-2aCe=XQS@ z!2iHF_QMI(52tQ$9`;2q{f6O?ydmw=SopJ1kxzrDT5x3*jd3Z_io#f}Kce(Xt9xh~@ z`!k(5?#_?L%LMNv{kZ`;n;7SLcuVML|N8~+BK;|!_xJy5#<~9siA(=KE%<)Yza>DY zjdAXO599oE#y5n1FX{h{acswfAvc~2HYMZYpPx=9uKn*LovT=V{<+v4qQ1^&T=2uB zvzzJgxc-}Qp3m2Wjy^8>1b>(G{~n-|zd0E%w|fn79k2GkMDQb|-yERxb;h~>j|&~` z{|>?R-%)rrK-qEAH=V@_v3Tah(U< z?xlinCH*fm9iIPhGCmCK=5b|4yN!{ogG3L!|$20XjctoagN~jB~qx58#n4ZXR^JkCNT##KTa``|YPh{T)<) zX+ZsZ80Y=%exZ{?{r^G6vA^}Y?m0hUI=sKV%sAJ7lj#fxjq#-a7sgRv|2>YZCf5+g z%k{4$uJfb&^K8jUzme(icDavn-Y(w~I=VkRB6u$8{~$o;EylUs>@T@-Y5(&`=K|ug zeP@gMg;ak*K>b@7=lQ=~=v+oRcQQT_TbSboa_IJ>0tX7k^ZZUqkfFW ztC0!UkZj)q#<~7X;-g?U)Q^$=9L7=quq*4VWjfq{+!q(r`7|4!={AYt<&4vGCsH5w*3jS}TqkpGO>ucVU<|=AFg&f!44@S=OmW7=g z7RmMZ7d6+hT_x&gxVt+y3O<_nTEVl4-y`@q;@=TGhxi`B#}og9;1S~Q3qFDPIBH-W zS1$2GR`5LH`tP!7ohiiQqJAOquM2(|@h1c?BHk_dY~uQPXKgn|JY$6WM)MNl z=LlX({Bpq;62D&Xa^m_qL9Kry@g`RP7A&OYp#a_~Iqh>ma_aZ*OHTd!6zX`myRu6i zbc*EE5A^4~ratAjPSz)T3CU^uLCNVLepc`_;=PjNzyiw$lGAu~I_;#a}vOewey5!VeVT#Y_P zd5YloCER*b$0qBeguee-D)>ao!!p73eX2O)7;40ob^eoaem?MQ0DoC<-JkW}x5Btk zNB8HflUzfZQ?oj`g6sZ#mEgKR-z2#1&$kJ#`}4mEuH$`FaNVEx3a6E=o^yL@t$^yYX{9K zKk0ZsS8_VuuaKNN`t_32@xE4YeLirnm*g~#|6Fo9kPb;s3rY{#`(PenE>7(Iki`-g%Hrkgl=>3cI2txZsXsuVP;SKID?XQ2ztx+U|BQ7?t z--blcv0xa!*|p2sG#hA(FHgY!l3}^t|FJW9ZExM(0sG(lvb*0oBH_~3&ja?~`UiLa zOtFL5bY2eF|KEGv{d2?)V$!bJyrM`lu%=a9b^70`{LrXB9OxQ{n#DPvrh*2JHXC^=_v00ghX^uiXFQ mfc@W~{X1bFTyTFJ|(gy%ZsCl5M-%q_Vp$DOf#J z3MC#yJP3O5pl9*qS;b%QAb9X3K@f@+(OYlvz1f-Vb{Y{J$j*D;`@T1`FK=gVWQK#!KCC3RBPHZ-kYt8^O2gnxEvIa^P=FrIRh6FQ(+Cf##=z@ zTc0R6)jAvRt=d^|JDz{vqrUjKigZ<3%B-%Kz+bKr#$OKkkcjcYjq&S@Z@tO(_Y}&731V|`KmkRc*c-hb$ladS0)@k=Sx}o2YaePq&O`Vsx8Zs>>gY}bJ{HPt~o=?Ul-EkVLiw(AVQ3cP!wk3)w+ob5u0 zY=d6|2CP$UZ`+i*jk|==6Hd`nbdiP)-Ii=$RJ28~T9W)j!8|yc<=GX6*z;d`qWYMA z;01PpnEqUu&4E)5!f2kDmFd7SPmhfD`hi`%Ld=p=n3>4CmGNm|Pq`IG*mj}dIkUnW z_v|u+oXI@5*2H<=nINVI?XoUo3<%T40G@*(QA%DE_Lav^hB;mdtbF_=dBAZje*DCE zB;lfZy%Nq{IH|)S@(8~82XNi^32jJx?vlUZhhPZK|IT=>M;#waGQjP7yaREc?eG)z z*v{j4{v$=yn8V~V*NJx)xX=rKKN#`a3%t~9QxN271&!c+B4Zd7`mYf)G-U1|z%qu+ zA%1lYhqCA?bMbzXF(lvNdc3FNL*`;!#*qJ$>+$4@51EVi9b$61`gx&cyqUd39wAwe_i;1*rzU#r VGg*)Kb~C-k8(QoW*GH|a{{tv}_on~= diff --git a/source/cluster/wham/src-M/obackup/initialize_p.o b/source/cluster/wham/src-M/obackup/initialize_p.o deleted file mode 100644 index 0bd33c0e67c8303eca43cc3bdfd56094e43a4806..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 134344 zcmeFa3t&~nwf{fooCE?1Bs|2Zs8Io_;}(w8J|ad7vnb)?_qo;@Cf86-_}uh&1-3AGx1J3UO}JR zi65Y2or7N^eu(ksiT5-93h~2?A0R$JTzmX3@gt09K+$5p!5_Kl@MjTEVLXp`8u4MI zH=B4CBVNq-+r;NG zo+h(0A`--P{+v#{objo|mok0@@nwvc6R#&eobtb#cnjn0#5)-OIPp%#w-Mh!T<8Cn zh;L&2DdJlg{|WJ}jQ0`WMm&}Le~b8b##6und0jI;f%s0wbBXU_{8HjQjF%DL!}y1Y z_cGo>d>?ULz8@pr$M{y_2bj*k6Ypny7x4k&y8V2CxPW?xo96q8>+V6v(S@Ud(tS@dV?y6EA0c3-P6lKT3QV z<4+Q=XZ#1mTNvL*9NQt>MyL<*2J!WbA0fVl@zGE*FrTq~!cFVs5Z^&u=TDUQPR8dF z-^KWK#CsU8C%%Wct|zwe6H&u=9D7~?C6?<5Y*l-xRrKgsz0#CI|N@5HhH!A^dYtqU(Yz+C&>B$pSX=vA7X&`YsAkXJ{)e@Fnk)_ zy5W5nZWAQeu?f*5sSuY^`0Zq>B|e{c4i(f2;>(C{AP(6sw>IKi8UMJ}XZ+uYKhF5$ z#CH*g%S3M9Bi_UKi^TU3*X90O;=POy5XXKPH_ASdo}u#XHO9{(-cMZnlTUnr@wvox z1%&A2c0KV7a!~VIh-VYm`S}szlNjGZJdZeih|du(V*H!Liy8kR@dV@hiI)@C{``^n z&5VbkVq<;7aRF{Re@-FZ!gwz64&wA7E+gK__yXb^h--hUh;L=Qo%nX*+Mm0K?_m6s z#Btn#8-0lXAij(79^ySr=f8;WVf=T*dzsE(iSJ`PW3kt3B;EXr|wEzKpe+kxaoAwBHqIILgMR)>vUBUU(fg|;+q)XKzu9X zpCXRqINWr)o*@1haa~@|5PzKUmxw>f`0K=>Qv%oj9*B6DRJE|Tu!`}@p9rVOs9tUI>uKM-@tUb ziEm~6VdC4F&R2*(&iJ#$cQO7l@#h&oK)jc@PValf_cK0vtjf;=Oy?ZphZ&C%*B7+T z|9QkS2xxvIaU5Ucru|t-d=lfG#PgWW{lsT6{_n&S#C3i9Ht}-C_Yz-9Twiy;CVn&1 ze~WlMZ`Veb~?_&IJ;?Fbw z2=QLVcM{)ET*vzy@z;p!eETi&9LfNl4`+^7`7@RAslKztijARP=YHa8&rZg#Bfg#0pBmyj8E+xp z!}v#t_cDGr@jl|Z{y#*#pSZ67j}aGCVRiVg63-&8>-m2Y&mm57;zz`%5{K?pZu^MO zVmiMgUPfHUdzkpm#PxL-K2_ysEz`*&-cDTma~APV#xEwmiSb#)w=sSV@y8gyk@!x= z8;C!}cn9%4jNe84CB`2l-pBaoi63J8N#X;HKSw-;3Q*_Ii^Q`S{~zKL8Sf{K_kXx) zoukBKjE{zi3+%s&89$SF8RJulFJ=5P;1@XmwfJF;@g?dg~WHT@H2_; zWcmr>yIA<^iTAMZ%Zcw{d=>Ft#@7?yM_i9*?kC>I!aqv<0OMaJ-cMZTTMzL8#(zp& zPzR#(?N`Lpi0k_ECh-j7x*U%XA5UDDd-@rwT(XJNFiV_Hd=k^SfcRA6+MgogF&2Iv zah$inO^3gZ_*~*TKkJB>F`ahei;2^)L)=Mx8FB6ZeZ(7?{%47|Grp7fI>x_8d_8fU zpFbhKiG}|q@vV#>BK|Pr?-75D@sSf%xjar>w{NEr-^F+?@#l%_`Y?m|9^(4G<0|5N z8DB!Ym+90Je~E=}BfgI~J?0c2Bfg*UPY~~8d^_>i82<|K1C0MC@k5ONn0P_+rKv5nsx9HSwDn|1j}ojCT^RW&B>^^^AX-IL=4nrt|qf zh_^8Q6!CV(e?+{4@m~;M$M`|woy4iT5(C7y5U1gq7=E@Ym+g#CAik5hZr>&oe~LI= zej-MEFXMBF?n3*SQg2-ClVcm~Y>;imoBOnf479q%K=bBOEb zo{tls%ff$`c!KG_Kzu3V|4qD}=^P;5NF1h>s zS?=TaxQiP4YdG>(Wc||CU^rQj-5(a$UQV zd)3ixM+f9;zRiw`rt>viR52jlJJe<$P1;25`V_-E=DBZO@; z{2S|yK7^<*lvtb(dOFV(QGYKB;BCOiK<`&few2q*_%A@!@yq|6z%gDO-&8Cp*nSG! zFW&zN;IBXfi#l8D)cLp$61T&^{d9)GytE(Bf%!nwPkn`43>@{h+^TeQ)rXixd>3(j z13oN{&TE}-&$IB`$*`AkF*_t9eueS5bmR1E#<#2B z;vjJyuP(>Gu<(5pUcmKgUKcHsl>eiMYaQ+Xc*ga3<4oW>tjaO<_mTiUCx9aENyS()F;97CV_SWTwBmAUkpVB3d|VY}fNwqu=lESsO^n6A$Ejvkdu;JalK zcFVtE$QreWg{k(ir&4>^@u@u=JMHf3KXUXaR$9d{zttX=tlGn-RqbK#t@f}7QhV6v zs6CiMrakO$6vOLN?ZE{~doXoIdsw2%3e5)X;Xp?*xHY9cxEZ277=D`t*R=sMAh;lT z!5-i7?ykd-ClHb7jvv?^KZI2|Q4>Fq=<2y+QR2?$`*)%3JNPG2Gyg!MJ7ZE}_uNTo z818$pbU7>0{ewjJ1G#@Ydh|P3Am7GfD3L3>6C1k_mv%o>&~pH&0J$uwefb0kdi$~D zF~Il2o_wAskLB&jBX;Bu`MZ87$n_#mTe&WCU}G0zAMHB_B0i2M#Zkj>yx0?0j*~cI zTYP!uAA4lp+>=tAc&0Css9ACdF39!0GUEncAPFyGt3VLj5vu|j|9%C60gQB&d-7I+ zAa>*jTOdn4ZL2^K`)CicK$dypR)HY4#gADaN8^V!#t%W%nVWwKm(S7ofsOG4mt!7f zZvGa4-EsNdn4w=!^`4tn@gcU|RK#T*pVM>@pX9GR`DVB z(H>;+b$a4f@gcUwkGJ@i{oN}*%%jZB2>?#<4K@!pcy3z7huC%#itkY3&Vlhhg_mqo zu)i=0Z;K~x6&_+oe6a2KHc#6sJj6cQ{*EVW9dmrUCvFuUVq2UF?@;2Nlul?2Q=u_D zU^a$>Esh;t#8z=2wj&-&aqRTOt>QrJh!3_nc6r)XaUk~59%OO!c;Z%ZAhyLn=;GMp zMQjxZVmsoY6i2ToZWRY&M|`lwvCq@CiUYBa_8^O+&l9(b1FajsZ{GDh|Xx+Jh_(0sVj)(OSiU*cShwizCg8*eVXhcEm#|jx0~y zDh|Ys_+X18+tap+1F?_xAd4f%6Ss;3u`T{V7e}rau~i(1?TCj`9C@C&RUC*N@xc~H zk*94H2Vx)XK^8}`CvFu7Vq5%}#i57M<1;ru^fnH=^zG+hJNSg>j#WsAZFi`U!p9tM zVUmpTR=Fo`6%t}ce6WSI)YG;K39*m%APZ@kCvFuIVq5&U3Mrhqxf;%d92{&S_rbh{ zIXOT#!H8`?r1l^a+2@H{i9~FRQzCI7nezQ1-c=v)BD0DMu^rh^Qqu2O) z8So;rQi9lyY$z!aa0~3$cLKJ>KZum1d68KuL2O4hl$2z7;#Qd;w#7e)lw^C6St&tm zM>dp{Ego1DdN2n4{Ht&&!L>5P zPI8Cmid8^}ZC8d;Ks!BgtAG$Y;#fc*ai20IC)O~5#zTxP1A@5{cLr*NHrl(Q?9z%t{Gj zJF=mqq}&s?Qi9kP{~%Jb)QikY31U04p`>J)CvK$#u`TYTWav%60k5*F1YyiDovmE-!szrVJBZ;}*84WlX*d*aG*{ovmb_o|ZWO=Op!xMzGt z;vW6%e@Qh{p#{0pK%*_wO6gO41-SNXxo2F&vANQJ#B|FSH8N3n_8{<2i zTs`q5k)-qQ$IX1&YCC6qKotXql)$GShDsNzof@> zmSlSzSy{7O)nwr_XZM)Ss_P-X$43?G)UjmkI<=(Nbe3d$9ofTp8Mvy411^Il`%Gt5 zHI47{QT2B=Da)MgGo2;bK3mqP`aQZOg{uFeS@qSWkkShy;luheIJ_}_SY8Ih;W99; zia$Y*IfRxs&AU`F2_Nj~$2@79~`K$a(NwF8J<@!ct1aJJm^ zI5H)3^O*w>IF2h!U}_Y`{=bH6A6A;E4f7E4MIO_#g&|}?y*C80vH-E`Wx#rcWER*B z!UHXyxRnKnU2!7|Xmm65E;Zrhy-F4Sg@Q%wMhvO)8!IGJWw#s;lzZYTRV0qs5g%-q zy42HFj;m|E3$c&3zvIc4lsUf46IYItIATY9uw81sr>z`U*L@daAMHB_M*3Vz$yOCt zY8qW?izlueCvn8KxY4fQ@{wVQdphxA!JBDlPVP%Q^P7}JuH{SpcPmFeZjyzQDHZ&oizZA2574|YLdrzdY+TZrxKLD!8odI%}m;6-Jn1hE^{;8U{2lebcW*p)X@ zLTfnHBEXyAcCw&Htur_O4!!)gd2U&$M(nyZ*dBJfCvK$~u`BMRS&k|$fT}z6)a~#b zuu_NEbzrcm+v$m0sY7gw>r2<0voc0a=bupec6lyX=|gP0K+V11dd_5X&&EeRp174h z#ICqedPBJO_IOcQ=|Jp8HP~|M^~9}oAa=!#bQq;nC9gaAWdSwB#e3V`T>~Jo2YT@L z`|?9_SZsVx?2;I(t|gvH~Gw2)MVTv$7})LH)-+WvdRVVG2+7VIiASa zJzR$unUyfa!I42hb&r>~bBWzu`=CfMIls@;;081Gl-TlxF zUe^|gP490r_O~1RJBI#GMEog7?-`C<(h$p(p6QH8V<)xHF?e@ZOpmC1H1N^aQ;>zNyk7cz+y|r6*qR z54f#q{D9lmQB!)X3yNK}{cbxN?{|fbtM+L8$j0~)SmKho`6JMc9E}fbj1S10*38X6 z`>X8yy4rzvcj1i6Mmf8AbWeBJI`60(PEm*0Sqm5wZMqx2ox3}}9uL(S-SG{(fv?-`3D)N8kh}cQxrhrj%Qk;$ci#>5`aDmtr*MmTr=E#x( z918vp(hJFkoWaTO!KN)aXtxGZzJvBbrwxZaZrzZhA)mC#M7{Hih#EC@KQJCsw7V-0 zastcr_hXL6H*JLfmu!G!Z;k;5YY_xO>&E!{9ihzi1Mp4mja_)=#w7zspT+!H0r`p- zkAI;D^>Gj6c)nX1gV^z1U-9l*qollj%{-9n$y>#a*p;U%M>cDNPf4B^m6a02Zd8LG zNELbVR!R`t@^FdY*%O9o*MaVo2e8bBP%6b_#>Cl;C}h zPf8Hm@=*1T_MBMF!}}(mq#(BA8d}Z6TQQ%cAhzXoXK1A6;5vAL$`I-q-og1K39%jL z(2}&zleaD=#I8KmGYmO|l=OK~S$zcvjd*Il@i3Z{0C6a`n|ZUq#(BA8d{+Y zc=A?K5Zm&q7d^VisAoec7~wUjR%#I2(G4v%X`Z~58pO6drRD_NfGjUMD>aDi=!TY> zY){@w4PsZ`?tN~9Gloz+IJx7~0w8u{9Q<{I^F=<58e&)e#CjT>Me|7sVmGS6rzF>t zw~7X_E&le|E8X!>F$e;)ySow?)3F`HAlk9*7+gBG1NIEZ z@K8C1L6VMp7=_^i~5a9>TV$OUi>NdgQuw5+X1>u?C#2er0njR1b^|?VWT|8 z`(Vt{gOAG4(wb=K!QVc?rheo4EtrAbT`lOQN|lQFo_i#c4nSsl9w-Hnz4sERuLoa} zEm5Fsrz)JzX6o`6{72Wk^Zr*@t;;+g|M#1j<5?&P6^@rGw;$R-?*694b<2oM4Jy^0q zlNRM(G%6(+8Ps{ib~HK${KC=uM1dN{f}EvZ6e=YY1!5k>pl`pIdD>P%AokIwsiTX* z$}?$xU_sP-Q7HGZDnJe)wxc-sGB!P|fRCB^EuOTM`G{@lp=W-F7loDih-rDcyNZ>0sX zEw2j5y0@UVdr2oY+)Ln$jo#2;1UPH-xv<+0RV@c9gB}_TVAVTz4~(bi9=I3eRS&!m z_KY4F4^2OAQxQNa+ByWR80 zN-kp8pTXZ3?C|8RZbzuD|+$)%00JW4Icdb@=h-gtSmB$dGc0r5WDiKuIb70yWnomtAKDH zsjJ}T#-UZga%kOsI%&kND}yh%rJlT%QpB$OiB-X6UQ||@A$Fr0d`jv)c`GG|U3sg_ zhR`syc#&CYLF`60__TC*@>W_9+w$sidS{<~K^+Xk7bAv{s!lIjD^-Z?Xoq%HZSdr+ zR3UcdPi)qFix-uZ62xv)gD;)4}h1HuZPuI$G#J28G@;uuUxAGjZBR<$X&+)XCYOeJlwF-aiR= zib}!`BMCd)B-Fb}kccM%rW8REf5}B>{Pl4e! z-b+iK8%3^v6ulV51{TEzpD2ppeEjhpon6Il6d1%gQ&v8h{bEsUaRTm^Unjv|`q5F8 zyHOAVwdJg?YFt&9Gr6%gXH9)WO?^&7 zTTWwLTN?zdYLcNFo7dE}=2SPYYLWsF5_^tgY$qK5iq^WSc8Jq+VO2|uj|+3a2lL-t zI57V$EnA3Y5%gJ70`2(g!!*z$-Mb^e$eNl(s}dYbP@Dfktc-tZ%(2VmJjfH;lMQj8If(BCv(glkv7go%TS4f?~9+zGZal^l$?S$Khf0FiT0cPVom50{; zqB-RrH}*>xEiS2m>(Tp+FOUsFsrOk%As|fL+Ls}KsZY?<0ZZ9FNkJTQ%Dw&fsSlR# zMw&c7wcjMD{T=Fg|0vy|`cssGeXbBALU0oT8~#0REuA;?sWo&S1%2vp7&9wtU9`wm zdDAENGw3|6&CeeZQt531!sCYjp9iE@E+=q}iX1evhR|ZD< zgYw1X`aCSDq7+phb-5*v75~Q_t9p{u_dm|Qc<$o&&KXe*uELg9EI&lwmGZN5IUP?b zzVTz5I!Df1cICg0e`4PM+_wJ8BVYW}i}S0CRXEXqWoZ)(2CHh?8=9Nc(DhOw;*E7R z?XAsi?N#j!H8~AFAz)lE=i(MW6NIj8XsWI2xLgQxAHym`WpiV#5IJ(>>jf1#au{kH zSG6~<1dW{K4XthMm2`yXRe6WERJB)vldbKLXxy)Bsugn<&Y!<54qSA#6yki&* zm&kDf+2_RM8@9{-*AYBx`WWhX-FJ4lyppZE3>v(a$fOx#DQk@L?;7x@NkNeXp4DL%&2m|e` zN*V0Kbt|z-i`s?#IQU<=Se;7{J`|5uV(MXk(Ht-B@kNWhwBWfq?QtXRaV$xhcsLjL zrLfe=Sv04yxdt_7$8)Noa!Gw7?QtXRa-Y&3kC&A#)H+7m<3`%$KIL0Hz9^>!E+^EV zH#6KkwaSOJb9;fJ(Qn3mj0t1 z%Z)w@;8T?sl@%OIU+EL|uzc_n{2*N_4?KcA0za?}VcQ+{K( zIV!JFhw@tLsJw=7vW}_Gf*hgp7s9H%RiD#=<8ch_GC!41pnP!)ga!X_SKf2Xz7Fyk z?nfadWmjJV|KL6rBE*DU1OL$J1pLGN#d`s~Sg(bD*nljCf0&Ua@b3orheL5}Nbusv z`@yT=A2uYIS9pGT#X?bb!y-{qF;65);d4>Bm{+z0J{Q2}0 zZ-C>9a&a9rCuQ*^qO>e7$`f%hA8sb+fKEVr3Q&6%7aqfZqhMtvw52w*bX00yQ}*bv(GX6BB!6y z{TJ`oc)!Q`MemUHpFGWGpTKQAKg_U&P$v^2Bxb-T?oWb$A@~=8e?>6*9!W&#H3^p{T%mBGLVG)B{#B)A*Ij=@$-Kpju3ZqHo2a;^9GeDjOSU7j#gnZ| zvi(lB>T*x^bJR*f>z?cvlD$Q;50QJam(*<_oS|FBoMhjW?6H#lm}+6M%SrZm$(~Sp zD*Hzap*CcyFNGGJ7`E+dH`yD@en3LiBj9ebKc`*;8Me`~|5H7S45!*}w0fflh=axy z*h66`JXeoDuoojH`!#9xMlf(LwD6M2-cW_qf0OCJRTx;Ob=@5c`}jNoA6wu97_8$d z@DHCA;?okGn}&B(h!OA)r(egxzbyEd3IE2xzwz)-uIzx%fAsdP4&^s^6uP9XrXB|8 zE2=J8)mGQqc1hK(ZPDq|FIltpma5xoo7b$ZT(Y1dzQ{SgaS`NF{F1iTn#%f`%Ic1b zYgesYx%T3QrnZLKIx)JTsiD20su9MRl`Ye*64=N#=2l#ga}~^Nx5BjaoMvbb8(~WL zs)mlbww#KprWJK<6?KhpGqAc&%}$3yV?&U`NhK#&LXjU04~3d4S5~!%D=&g3Wc92=-~c}|5})l@_5$lA!Wz}hR7gY%`=d)7prkx)9QSkIbBj|zwp zE4FJ*%?#ER`)6Zuccq=Sm>SQB|#v1GXIYa&mnbJ0N+Zrhs3cU3raP_Zp*B0GSs ztmn0Jq8ng;%#ku1O7rZlR;b$kii5p$0mtkCZ~lrrL)3 z%9`e;w)R%agu`ni#b8*|*xa;&qTR42auJ|grh}u$bQM|IcxgBowq-xR{O1+iL80o6EN)T;s ztrJV3Ow3S?R;W5JT(uoeq>Ro?2{ph&mWK8=%Zqg6O{$8T!s+8=c$LkTAsY-U>U=y- zKMSSW8&nQi=S%`iOKr82$n*=qu(G)^>RK*Qr}(KAf(afp`8YibEUnG$Rc>}>U^?5I zTiuf~PEnRxAJarIEpJ}c+EAyehnc91$zZH&^l>BOBCudnYTjDxDro-df-?_VXEqU^L*3;YX^J=*597=_(gYDc37Xqdc>)>6sO{AOw z?$)$bVU%_a$c7pKhRW9Js-|1THv7EP?6Z}%t*)+Ce3=__m9ZW!m*&>B;%RP=DZ5mD zkr_`*OB(aVYuq|kS*sdb>Z`;%+zKrP`Yf&aV&uhk$(?q7Qo3E7#jW|u3KdP{Gu!Eg zQjGI4R(R1 zPKFu>J)yj4Kgn&Ez=_SR()ML;n;~tr()biN!j*|#gEanx8K;bf_FVOq(%#4IP*b40 zl(xTc+qtT7lEz`v?2Bg#v?9=DN?SI!VN*$M_XW01q@-k~hHC1o8k(#QCXx+QTxthS zjhvkts;v)xmG;N4VOdkcJXx^i_ww-G_PdQ$rVm877{6&kYZU zJgBOM#XBp-i?%-^B{egQJ-2+cW93{ZI~=O25`Fdwsi8B%q3UY!CdX$%=v6CLig&r; zJd~*w!!NOGYv_E?0Y0Adiy%CV`_AF~5(p1`8s`NNzOJ!QT*eJW(oi50%#boQ9IESR zX?DloDN(Yx$oK!EpRV+7dI5DQ(Bvy>Jq*jqiIw=+{ey~q)8)s@d!6zEp9Abs?TuS1z@XcZ>y`QMHRCC}hB8wYlC_|n&om-&7 z!016tVtn*yaw|_v<0dEp@EH6p;+9ju-_|@an{&u|z-1gmrnKhOi5oc2L0&7Cb3O?; zlo8~J(G!GHN9SUuw}?*8u{~&PX(<%JIx8ukf5opCQtmt)=QlL zHL~i~7CFCSorCS`t!*{pRenMq7;w~*Ck}8E)QehZvE(2DW|bV#Q?XsZbDgmo!$L3>VkIk-JuKAH;3$R87#6BsQ{`tl2Ty2$89|)nGLsZKA1wtgzlgMaOi?h^ zt%&M*G)wN%VIkmAu)C78hlOC86K*fKNu&(V94^P1RrYOKD0_IQDh~&s;;5Z5siCvM zBrPLg34-Or$+FvSL$AZ_PyTfy+q3TesXmYL*Rp17QwU>Xmu(>yVc8NzAO z0CnqH+agj<)k&?as+M!RcG-@?BvYDivd>K&4XRZt(YG>FCYY*Ks&8keEHKs7$fRv$ zrZHfut(B%PG1FKu)zwK;4>OGe)AHrg^a?Yb0;Uxz8~?~m8DPRGHRy;%TGTGGbjXt? zvhf?2^i#=(mxp7_NgCaONBV_HYk_-i46JPpO)FqN!qJ@tw%X=Z)jqZibVz#Z?2 z2x)&DCO=Z4fCrU}>pqX~*WtPE6i#Y(4pfoEnBa1&(Rq zElv0`ZHhX!2-FQYt+J*;O>~>yMY5#LX~A(m0csS?uGg^1os{vzLy-TpYKa$Z3gjJH zaWv)FrcfOXIyb8AerKm*4R5J$2sk-)9GQL26)BTsVphY=tCi7_Q)KFEW%am)mru&* zG`!1hgLP%rS>e32(CR#~$_}3z&IX(>KF0AGfTQ9*j?V(z*xZ^g9_5xv$`Tb{6s&-bAlT*yKIMLj|i=SMv=El!zN1Zj`fC}0|uB&@;T*vJO!TOx&xWiVV8gn zDwi8iOc^TGvq!TU4Z93XFfek@DaMGfD{)N2M}i5SlDH8K&mv3AJ?T_3O?ORak*Ux% zO$L*CB*Qar_*5{#ZKAJ-GQq1_p=vs(VS?Mi+MAazhljd81&{`*tF3En z_qUFKRJ7*#+eSjwg+aPIAu@9O2zbh0*Hj1Rt#q5nk!OP@tYxigtgBqv4A-U8} z2;);cNUwDnWt|~Sa^~}hokJoek~uQeR^8fAyQ0oIDV#krR9Ed*zVO76p;|wlGcvT? zhlfDF$(^_ejYaIkCjejG3XKv=VQL5>Zh$i;z|u(L+QRwSks%n4+-fH}JPG`)Z>bhJ zcKFor1>k6ND?F_i7cx@_($IkC#JFMd$j~ilxPlul1b5NEyu}IEk@CSEwju0cc{pz* z)>yb@eEzIh36aJ!Ru^?n!Fs z%ygL4^|ORgsj6f7DtCr3JVBc9{?Eyf5t$iq(ZKQrHU%BZ23}LUS|oVho(YByFkH_K z=SoAHSk4XSXM|S3y=jMN=a!3=rABlyOBgNC=5&Y$nI%-9EH&aWZkY*|y2cvuHEy^< zodOM54>N_+z=XcZNs*s$>sX3QTK9A7M6g0F>kw~n3uFaaYQzAym@ae z$pS}Y%Ql`HXDMR`HhbqXV}z1`XHFM++=@vc-9m8%w_*~gA1ULuNnk_Kf=cW%#EsmZ zNA{Sq*K<2Mjpr9C`)X!S%>g@jRxQ?Z%M`M7i2Il+1rw_rmYv^rZXchtqt^xE%RB^@ z4JoLu@S8jYCd>#?D4yXVutH(dqz`+UH5Gl79nExU|2em#kJ4T!?Z4r6toyRxuMux@ z+jMQ~5btr@<=Q4?N5J}5qeV^~hHj}r&3JBtMnIW5#JS8i9BfU?)eGj zC&E48e*28n(Bx5}<|Y`7w~N2nChSV37~UaTd7d(U6s()U6+WY3MYUOFQcfQgS|cq} zm?agpU=bZWdV;~0Q>RklL}hJmg_3-`5;lfW)acQn_J);p_Wes}%4nFg z2JH5(XUp)74J%z!_GozW=YQ7J(YO$1H5lE~Vh~r=a+rJLCKw@scd(MB1hFCh*-ub`q$RF0cc|xiBo>#jhpXp~@@bSCzt|^Uz4;U-`nt zB0{b$np07-curz&X+_dqxhmS0SX4SUUTz~u11xPfQdu#75etFwqSHxfbOo{}3Fa&+ zsjQe?vfvsUEsDqC%PuF z##TkdVq|0vFIKPG4G-b{U|J}W7J6_b)N=1=t95jDs%f*2?2sU2n}-0TC+f-@0N;skC$uP-1h|d2&1dAq5@Y_p)UO;sOUfFOoEG-28 zfAEwPU1=YK%92yOGWOep(~>EK{NTqNp$6AAE_(FBi*KazGVoYwC&LFHCkt2YQ8d